From: Andreas Gerler Date: Tue, 28 Apr 2015 08:12:28 +0000 (+0200) Subject: - update helm to 20150426.2119 X-Git-Url: http://git.bundesbrandschatzamt.de/?a=commitdiff_plain;h=0cc8d2e0cfd0b340acdcf8a31f6deb20706756fb;p=emacsconfig.git - update helm to 20150426.2119 - update org to 20150427 Signed-off-by: Andreas Gerler --- diff --git a/bba.org b/bba.org index 7074bcc9..7d250561 100644 --- a/bba.org +++ b/bba.org @@ -30,7 +30,7 @@ To be precise, this is what's in the first part of my =~/.emacs.d/init.el= (what load-path)) - (add-to-list 'load-path "~/.emacs.d/xemacs-packages/lisp/org-8.2.3c") + (add-to-list 'load-path "~/.emacs/elpa/org-20150427") ;; (add-to-list 'load-path "~/elisp/org-mode/contrib/lisp") ;; Load the rest of the packages @@ -90,6 +90,15 @@ If you are in need enable debugging: #+END_SRC +*** async +#+BEGIN_SRC emacs-lisp + (if (>= emacs-major-version 24) + (progn + (add-to-list 'load-path "~/.emacs.d/elpa/async-20150412.2207") + (require 'async) + ) + ) +#+END_SRC *** [[http://www.emacswiki.org/emacs/ELPA][ELPA]] #+BEGIN_SRC emacs-lisp @@ -1287,7 +1296,7 @@ Some links you might check out: (if (>= emacs-major-version 24) (progn (add-to-list 'load-path - "~/.emacs.d/elpa/helm-20150403.101") + "~/.emacs.d/elpa/helm-20150426.2119") (require 'helm) (helm-mode 1) (global-set-key (kbd "M-y") 'helm-show-kill-ring) diff --git a/elpa/async-20150412.2207/async-autoloads.el b/elpa/async-20150412.2207/async-autoloads.el new file mode 100644 index 00000000..ef6d2102 --- /dev/null +++ b/elpa/async-20150412.2207/async-autoloads.el @@ -0,0 +1,81 @@ +;;; async-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "async" "async.el" (21822 1126 0 0)) +;;; Generated autoloads from async.el + +(autoload 'async-start-process "async" "\ +Start the executable PROGRAM asynchronously. See `async-start'. +PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the +process object when done. If FINISH-FUNC is nil, the future +object will return the process object when the program is +finished. Set DEFAULT-DIRECTORY to change PROGRAM's current +working directory. + +\(fn NAME PROGRAM FINISH-FUNC &rest PROGRAM-ARGS)" nil nil) + +(autoload 'async-start "async" "\ +Execute START-FUNC (often a lambda) in a subordinate Emacs process. +When done, the return value is passed to FINISH-FUNC. Example: + + (async-start + ;; What to do in the child process + (lambda () + (message \"This is a test\") + (sleep-for 3) + 222) + + ;; What to do when it finishes + (lambda (result) + (message \"Async process done, result should be 222: %s\" + result))) + +If FINISH-FUNC is nil or missing, a future is returned that can +be inspected using `async-get', blocking until the value is +ready. Example: + + (let ((proc (async-start + ;; What to do in the child process + (lambda () + (message \"This is a test\") + (sleep-for 3) + 222)))) + + (message \"I'm going to do some work here\") ;; .... + + (message \"Waiting on async process, result should be 222: %s\" + (async-get proc))) + +If you don't want to use a callback, and you don't care about any +return value form the child process, pass the `ignore' symbol as +the second argument (if you don't, and never call `async-get', it +will leave *emacs* process buffers hanging around): + + (async-start + (lambda () + (delete-file \"a remote file on a slow link\" nil)) + 'ignore) + +Note: Even when FINISH-FUNC is present, a future is still +returned except that it yields no value (since the value is +passed to FINISH-FUNC). Call `async-get' on such a future always +returns nil. It can still be useful, however, as an argument to +`async-ready' or `async-wait'. + +\(fn START-FUNC &optional FINISH-FUNC)" nil t) + +;;;*** + +;;;### (autoloads nil nil ("async-bytecomp.el" "async-pkg.el" "dired-async.el" +;;;;;; "smtpmail-async.el") (21822 3160 168227 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; async-autoloads.el ends here diff --git a/elpa/async-20150412.2207/async-bytecomp.el b/elpa/async-20150412.2207/async-bytecomp.el new file mode 100644 index 00000000..047e6057 --- /dev/null +++ b/elpa/async-20150412.2207/async-bytecomp.el @@ -0,0 +1,149 @@ +;;; async-bytecomp.el --- Async functions to compile elisp files async + +;; Copyright (C) 2014 John Wiegley +;; Copyright (C) 2014 Thierry Volpiatto + +;; Authors: John Wiegley +;; Thierry Volpiatto + +;; Keywords: dired async byte-compile +;; X-URL: https://github.com/jwiegley/dired-async + +;; 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 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 package provide the `async-byte-recompile-directory' function +;; which allows, as the name says to recompile a directory outside of +;; your running emacs. +;; The benefit is your files will be compiled in a clean environment without +;; the old *.el files loaded. +;; Among other things, this fix a bug in package.el which recompile +;; the new files in the current environment with the old files loaded, creating +;; errors in most packages after upgrades. +;; +;; NB: This package is advicing the function `package--compile'. + +;;; Code: + +(require 'cl-lib) +(require 'async) + +(defcustom async-bytecomp-allowed-packages '(async helm) + "Packages in this list will be compiled asynchronously by `package--compile'. +All the dependencies of these packages will be compiled async too, +so no need to add dependencies to this list. +The value of this variable can also be a list with a single element, +the symbol `all', in this case packages are always compiled asynchronously." + :group 'async + :type '(repeat (choice symbol))) + +(defvar async-byte-compile-log-file "~/.emacs.d/async-bytecomp.log") + +(defun async-byte-recompile-directory (directory &optional quiet) + "Compile all *.el files in DIRECTORY asynchronously. +All *.elc files are systematically deleted before proceeding." + (cl-loop with dir = (directory-files directory t "\\.elc\\'") + unless dir return nil + for f in dir + when (file-exists-p f) do (delete-file f)) + ;; Ensure async is reloaded when async.elc is deleted. + ;; This happen when recompiling its own directory. + (load "async") + (let ((call-back + `(lambda (&optional ignore) + (if (file-exists-p async-byte-compile-log-file) + (let ((buf (get-buffer-create byte-compile-log-buffer)) + (n 0)) + (with-current-buffer buf + (goto-char (point-max)) + (let ((inhibit-read-only t)) + (insert-file-contents async-byte-compile-log-file) + (compilation-mode)) + (display-buffer buf) + (delete-file async-byte-compile-log-file) + (unless ,quiet + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^.*:Error:" nil t) + (cl-incf n))) + (if (> n 0) + (message "Failed to compile %d files in directory `%s'" n ,directory) + (message "Directory `%s' compiled asynchronously with warnings" ,directory))))) + (unless ,quiet + (message "Directory `%s' compiled asynchronously with success" ,directory)))))) + (async-start + `(lambda () + (require 'bytecomp) + ,(async-inject-variables "\\`\\(load-path\\)\\|byte\\'") + (let ((default-directory (file-name-as-directory ,directory)) + error-data) + (add-to-list 'load-path default-directory) + (byte-recompile-directory ,directory 0 t) + (when (get-buffer byte-compile-log-buffer) + (setq error-data (with-current-buffer byte-compile-log-buffer + (buffer-substring-no-properties (point-min) (point-max)))) + (unless (string= error-data "") + (with-temp-file ,async-byte-compile-log-file + (erase-buffer) + (insert error-data)))))) + call-back) + (message "Started compiling asynchronously directory %s" directory))) + +(defvar package-archive-contents) +(declare-function package-desc-reqs "package.el" (cl-x)) + +(defun async-bytecomp--get-package-deps (pkg &optional only) + (let* ((pkg-desc (cadr (assq pkg package-archive-contents))) + (direct-deps (cl-loop for p in (package-desc-reqs pkg-desc) + for name = (car p) + when (assq name package-archive-contents) + collect name)) + (indirect-deps (unless (eq only 'direct) + (delete-dups + (cl-loop for p in direct-deps append + (async-bytecomp--get-package-deps p)))))) + (cl-case only + (direct direct-deps) + (separate (list direct-deps indirect-deps)) + (indirect indirect-deps) + (t (delete-dups (append direct-deps indirect-deps)))))) + +(defun async-bytecomp-get-allowed-pkgs () + (when (and async-bytecomp-allowed-packages + (listp async-bytecomp-allowed-packages)) + (cl-loop for p in async-bytecomp-allowed-packages + append (async-bytecomp--get-package-deps p) into reqs + finally return + (delete-dups + (append async-bytecomp-allowed-packages reqs))))) + +(defadvice package--compile (around byte-compile-async activate) + (let ((cur-package (package-desc-name pkg-desc))) + (if (or (equal async-bytecomp-allowed-packages '(all)) + (memq cur-package (async-bytecomp-get-allowed-pkgs))) + (progn + (when (eq cur-package 'async) + (fmakunbound 'async-byte-recompile-directory)) + (package-activate-1 pkg-desc) + (load "async-bytecomp") ; emacs-24.3 don't reload new files. + (async-byte-recompile-directory (package-desc-dir pkg-desc) t)) + ad-do-it))) + + +(provide 'async-bytecomp) + +;;; async-bytecomp.el ends here diff --git a/elpa/async-20150412.2207/async-pkg.el b/elpa/async-20150412.2207/async-pkg.el new file mode 100644 index 00000000..7d1eb8b1 --- /dev/null +++ b/elpa/async-20150412.2207/async-pkg.el @@ -0,0 +1,4 @@ +(define-package "async" "20150412.2207" "Asynchronous processing in Emacs" 'nil) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/async-20150412.2207/async.el b/elpa/async-20150412.2207/async.el new file mode 100644 index 00000000..be9c04e5 --- /dev/null +++ b/elpa/async-20150412.2207/async.el @@ -0,0 +1,292 @@ +;;; async --- Asynchronous processing in Emacs + +;; Copyright (C) 2012~2014 John Wiegley + +;; Author: John Wiegley +;; Created: 18 Jun 2012 + +;; Keywords: async +;; X-URL: https://github.com/jwiegley/emacs-async + +;; 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 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: + +;; Adds the ability to call asynchronous functions and process with ease. See +;; the documentation for `async-start' and `async-start-process'. + +;;; Code: + +(defgroup async nil + "Simple asynchronous processing in Emacs" + :group 'emacs) + +(defvar async-debug nil) +(defvar async-send-over-pipe t) +(defvar async-in-child-emacs nil) +(defvar async-callback nil) +(defvar async-callback-for-process nil) +(defvar async-callback-value nil) +(defvar async-callback-value-set nil) +(defvar async-current-process nil) + +(defun async-inject-variables + (include-regexp &optional predicate exclude-regexp) + "Return a `setq' form that replicates part of the calling environment. +It sets the value for every variable matching INCLUDE-REGEXP and +also PREDICATE. It will not perform injection for any variable +matching EXCLUDE-REGEXP (if present). It is intended to be used +as follows: + + (async-start + `(lambda () + (require 'smtpmail) + (with-temp-buffer + (insert ,(buffer-substring-no-properties (point-min) (point-max))) + ;; Pass in the variable environment for smtpmail + ,(async-inject-variables \"\\`\\(smtpmail\\|\\(user-\\)?mail\\)-\") + (smtpmail-send-it))) + 'ignore)" + `(setq + ,@(let (bindings) + (mapatoms + (lambda (sym) + (if (and (boundp sym) + (or (null include-regexp) + (string-match include-regexp (symbol-name sym))) + (not (string-match + (or exclude-regexp "-syntax-table\\'") + (symbol-name sym)))) + (let ((value (symbol-value sym))) + (when (or (null predicate) + (funcall predicate sym)) + (setq bindings (cons `(quote ,value) bindings) + bindings (cons sym bindings))))))) + bindings))) + +(defalias 'async-inject-environment 'async-inject-variables) + +(defun async-handle-result (func result buf) + (if (null func) + (progn + (set (make-local-variable 'async-callback-value) result) + (set (make-local-variable 'async-callback-value-set) t)) + (unwind-protect + (if (and (listp result) + (eq 'async-signal (nth 0 result))) + (signal (car (nth 1 result)) + (cdr (nth 1 result))) + (funcall func result)) + (unless async-debug + (kill-buffer buf))))) + +(defun async-when-done (proc &optional change) + "Process sentinal used to retrieve the value from the child process." + (when (eq 'exit (process-status proc)) + (with-current-buffer (process-buffer proc) + (let ((async-current-process proc)) + (if (= 0 (process-exit-status proc)) + (if async-callback-for-process + (if async-callback + (prog1 + (funcall async-callback proc) + (unless async-debug + (kill-buffer (current-buffer)))) + (set (make-local-variable 'async-callback-value) proc) + (set (make-local-variable 'async-callback-value-set) t)) + (goto-char (point-max)) + (backward-sexp) + (async-handle-result async-callback (read (current-buffer)) + (current-buffer))) + (set (make-local-variable 'async-callback-value) + (list 'error + (format "Async process '%s' failed with exit code %d" + (process-name proc) (process-exit-status proc)))) + (set (make-local-variable 'async-callback-value-set) t)))))) + +(defun async--receive-sexp (&optional stream) + (let ((sexp (decode-coding-string (base64-decode-string + (read stream)) 'utf-8-unix))) + (if async-debug + (message "Received sexp {{{%s}}}" (pp-to-string sexp))) + (setq sexp (read sexp)) + (if async-debug + (message "Read sexp {{{%s}}}" (pp-to-string sexp))) + (eval sexp))) + +(defun async--insert-sexp (sexp) + (prin1 sexp (current-buffer)) + ;; Just in case the string we're sending might contain EOF + (encode-coding-region (point-min) (point-max) 'utf-8-unix) + (base64-encode-region (point-min) (point-max) t) + (goto-char (point-min)) (insert ?\") + (goto-char (point-max)) (insert ?\" ?\n)) + +(defun async--transmit-sexp (process sexp) + (with-temp-buffer + (if async-debug + (message "Transmitting sexp {{{%s}}}" (pp-to-string sexp))) + (async--insert-sexp sexp) + (process-send-region process (point-min) (point-max)))) + +(defun async-batch-invoke () + "Called from the child Emacs process' command-line." + (setq async-in-child-emacs t + debug-on-error async-debug) + (if debug-on-error + (prin1 (funcall + (async--receive-sexp (unless async-send-over-pipe + command-line-args-left)))) + (condition-case err + (prin1 (funcall + (async--receive-sexp (unless async-send-over-pipe + command-line-args-left)))) + (error + (prin1 (list 'async-signal err)))))) + +(defun async-ready (future) + "Query a FUTURE to see if the ready is ready -- i.e., if no blocking +would result from a call to `async-get' on that FUTURE." + (and (memq (process-status future) '(exit signal)) + (with-current-buffer (process-buffer future) + async-callback-value-set))) + +(defun async-wait (future) + "Wait for FUTURE to become ready." + (while (not (async-ready future)) + (sit-for 0.05))) + +(defun async-get (future) + "Get the value from an asynchronously function when it is ready. +FUTURE is returned by `async-start' or `async-start-process' when +its FINISH-FUNC is nil." + (async-wait future) + (with-current-buffer (process-buffer future) + (async-handle-result #'identity async-callback-value (current-buffer)))) + +(defun async-message-p (value) + "Return true of VALUE is an async.el message packet." + (and (listp value) + (plist-get value :async-message))) + +(defun async-send (&rest args) + "Send the given messages to the asychronous Emacs PROCESS." + (let ((args (append args '(:async-message t)))) + (if async-in-child-emacs + (if async-callback + (funcall async-callback args)) + (async--transmit-sexp (car args) (list 'quote (cdr args)))))) + +(defun async-receive (&rest args) + "Send the given messages to the asychronous Emacs PROCESS." + (async--receive-sexp)) + +;;;###autoload +(defun async-start-process (name program finish-func &rest program-args) + "Start the executable PROGRAM asynchronously. See `async-start'. +PROGRAM is passed PROGRAM-ARGS, calling FINISH-FUNC with the +process object when done. If FINISH-FUNC is nil, the future +object will return the process object when the program is +finished. Set DEFAULT-DIRECTORY to change PROGRAM's current +working directory." + (let* ((buf (generate-new-buffer (concat "*" name "*"))) + (proc (let ((process-connection-type nil)) + (apply #'start-process name buf program program-args)))) + (with-current-buffer buf + (set (make-local-variable 'async-callback) finish-func) + (set-process-sentinel proc #'async-when-done) + (unless (string= name "emacs") + (set (make-local-variable 'async-callback-for-process) t)) + proc))) + +;;;###autoload +(defmacro async-start (start-func &optional finish-func) + "Execute START-FUNC (often a lambda) in a subordinate Emacs process. +When done, the return value is passed to FINISH-FUNC. Example: + + (async-start + ;; What to do in the child process + (lambda () + (message \"This is a test\") + (sleep-for 3) + 222) + + ;; What to do when it finishes + (lambda (result) + (message \"Async process done, result should be 222: %s\" + result))) + +If FINISH-FUNC is nil or missing, a future is returned that can +be inspected using `async-get', blocking until the value is +ready. Example: + + (let ((proc (async-start + ;; What to do in the child process + (lambda () + (message \"This is a test\") + (sleep-for 3) + 222)))) + + (message \"I'm going to do some work here\") ;; .... + + (message \"Waiting on async process, result should be 222: %s\" + (async-get proc))) + +If you don't want to use a callback, and you don't care about any +return value form the child process, pass the `ignore' symbol as +the second argument (if you don't, and never call `async-get', it +will leave *emacs* process buffers hanging around): + + (async-start + (lambda () + (delete-file \"a remote file on a slow link\" nil)) + 'ignore) + +Note: Even when FINISH-FUNC is present, a future is still +returned except that it yields no value (since the value is +passed to FINISH-FUNC). Call `async-get' on such a future always +returns nil. It can still be useful, however, as an argument to +`async-ready' or `async-wait'." + (require 'find-func) + (let ((procvar (make-symbol "proc"))) + `(let* ((sexp ,start-func) + (,procvar + (async-start-process + "emacs" (file-truename + (expand-file-name invocation-name + invocation-directory)) + ,finish-func + "-Q" "-l" + ;; Using `locate-library' ensure we use the right file + ;; when the .elc have been deleted. + ,(locate-library "async") + "-batch" "-f" "async-batch-invoke" + (if async-send-over-pipe + "" + (with-temp-buffer + (async--insert-sexp (list 'quote sexp)) + (buffer-string)))))) + (if async-send-over-pipe + (async--transmit-sexp ,procvar (list 'quote sexp))) + ,procvar))) + +(defmacro async-sandbox(func) + "Evaluate FUNC in a separate Emacs process, synchronously." + `(async-get (async-start ,func))) + +(provide 'async) + +;;; async.el ends here diff --git a/elpa/async-20150412.2207/dired-async.el b/elpa/async-20150412.2207/dired-async.el new file mode 100644 index 00000000..59b1d986 --- /dev/null +++ b/elpa/async-20150412.2207/dired-async.el @@ -0,0 +1,310 @@ +;;; dired-async.el --- Copy/move/delete asynchronously in dired. + +;; Copyright (C) 2012~2014 John Wiegley +;; Copyright (C) 2012~2014 Thierry Volpiatto + +;; Authors: John Wiegley +;; Thierry Volpiatto + +;; Keywords: dired async network +;; X-URL: https://github.com/jwiegley/dired-async + +;; 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 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 file provide a redefinition of `dired-create-file' function, +;; which must be loaded *after* dired-aux.el, performs copies, +;; moves and all what is handled by `dired-create-file' in the background +;; using a slave Emacs process, by means of the async.el module. +;; To use it, put this in your .emacs: +;; +;; (eval-after-load "dired-aux" +;; '(require 'dired-async)) +;; +;; + +;;; Code: + +(require 'cl-lib) +(require 'dired-aux) +(require 'async) + +(eval-when-compile + (defvar async-callback)) +(defvar dired-async-operation nil) + +(defgroup dired-async nil + "Copy rename files asynchronously from dired." + :group 'dired) + +(defcustom dired-async-env-variables-regexp + "\\`\\(tramp-\\(default\\|connection\\|remote\\)\\|ange-ftp\\)-.*" + "Variables matching this regexp will be loaded on Child Emacs." + :type 'regexp + :group 'dired-async) + +(defcustom dired-async-message-function 'dired-async-mode-line-message + "Function to use to notify result when operation finish. +Should take same args as `message'." + :group 'dired-async + :type 'function) + +(defcustom dired-async-log-file "/tmp/dired-async.log" + "File use to communicate errors from Child Emacs to host Emacs." + :group 'dired-async + :type 'string) + +(defcustom dired-async-be-async t + "When non--nil make `dired-create-file' async. +This allow to turn off async features provided to this package." + :group 'dired-async + :type 'boolean) + +(defface dired-async-message + '((t (:foreground "yellow"))) + "Face used for mode-line message." + :group 'dired-async) + +(defface dired-async-mode-message + '((t (:background "Firebrick1"))) + "Face used for `dired-async-mode' lighter." + :group 'dired-async) + +(define-minor-mode dired-async-mode + "Notify mode-line that an async process run." + :group 'dired-async + :global t + :lighter (:eval (propertize (format " [%s Async job(s) running]" + (length (dired-async-processes))) + 'face 'dired-async-mode-message)) + (unless dired-async-mode + (let ((visible-bell t)) (ding)))) + +(defun dired-async-mode-line-message (text &rest args) + "Notify end of operation in `mode-line'." + (message nil) + (let ((mode-line-format (concat + " " (propertize + (if args + (apply #'format text args) + text) + 'face 'dired-async-message)))) + (force-mode-line-update) + (sit-for 3) + (force-mode-line-update))) + +(defun dired-async-processes () + (cl-loop for p in (process-list) + when (cl-loop for c in (process-command p) thereis + (string= "async-batch-invoke" c)) + collect p)) + +(defun dired-async-kill-process () + (interactive) + (let* ((processes (dired-async-processes)) + (proc (car (last processes)))) + (delete-process proc) + (unless (> (length processes) 1) + (dired-async-mode -1)))) + +(defun dired-async-after-file-create (len-flist) + "Callback function used for operation handled by `dired-create-file'." + (unless (dired-async-processes) + ;; Turn off mode-line notification + ;; only when last process end. + (dired-async-mode -1)) + (when dired-async-operation + (if (file-exists-p dired-async-log-file) + (progn + (pop-to-buffer (get-buffer-create "*dired async*")) + (erase-buffer) + (insert "Error: ") + (insert-file-contents dired-async-log-file) + (delete-file dired-async-log-file)) + (run-with-timer + 0.1 nil + dired-async-message-function "Asynchronous %s of %s file(s) on %s file(s) done" + (car dired-async-operation) (cadr dired-async-operation) len-flist)))) + +(defun dired-async-maybe-kill-ftp () + "Return a form to kill ftp process in child emacs." + (quote + (progn + (require 'cl-lib) + (let ((buf (cl-loop for b in (buffer-list) + thereis (and (string-match + "\\`\\*ftp.*" + (buffer-name b)) b)))) + (when buf (kill-buffer buf)))))) + +(defun dired-create-files (file-creator operation fn-list name-constructor + &optional marker-char) + "Create one or more new files from a list of existing files FN-LIST. +This function also handles querying the user, updating Dired +buffers, and displaying a success or failure message. + +FILE-CREATOR should be a function. It is called once for each +file in FN-LIST, and must create a new file, querying the user +and updating Dired buffers as necessary. It should accept three +arguments: the old file name, the new name, and an argument +OK-IF-ALREADY-EXISTS with the same meaning as in `copy-file'. + +OPERATION should be a capitalized string describing the operation +performed (e.g. `Copy'). It is used for error logging. + +FN-LIST is the list of files to copy (full absolute file names). + +NAME-CONSTRUCTOR should be a function accepting a single +argument, the name of an old file, and returning either the +corresponding new file name or nil to skip. + +Optional MARKER-CHAR is a character with which to mark every +newfile's entry, or t to use the current marker character if the +old file was marked." + (setq dired-async-operation nil) + (let (dired-create-files-failures failures async-fn-list + skipped (success-count 0) (total (length fn-list)) + (callback `(lambda (&optional ignore) + (dired-async-after-file-create ,(length fn-list))))) + (let (to overwrite-query + overwrite-backup-query) ; for dired-handle-overwrite + (dolist (from fn-list) + (setq to (funcall name-constructor from)) + (if (equal to from) + (progn + (setq to nil) + (dired-log "Cannot %s to same file: %s\n" + (downcase operation) from))) + (if (not to) + (setq skipped (cons (dired-make-relative from) skipped)) + (let* ((overwrite (file-exists-p to)) + (dired-overwrite-confirmed ; for dired-handle-overwrite + (and overwrite + (let ((help-form '(format "\ +Type SPC or `y' to overwrite file `%s', +DEL or `n' to skip to next, +ESC or `q' to not overwrite any of the remaining files, +`!' to overwrite all remaining files with no more questions." to))) + (dired-query 'overwrite-query + "Overwrite `%s'?" to)))) + ;; must determine if FROM is marked before file-creator + ;; gets a chance to delete it (in case of a move). + (actual-marker-char + (cond ((integerp marker-char) marker-char) + (marker-char (dired-file-marker from)) ; slow + (t nil)))) + ;; Handle the `dired-copy-file' file-creator specially + ;; When copying a directory to another directory or + ;; possibly to itself or one of its subdirectories. + ;; e.g "~/foo/" => "~/test/" + ;; or "~/foo/" =>"~/foo/" + ;; or "~/foo/ => ~/foo/bar/") + ;; In this case the 'name-constructor' have set the destination + ;; TO to "~/test/foo" because the old emacs23 behavior + ;; of `copy-directory' was to not create the subdirectory + ;; and instead copy the contents. + ;; With the new behavior of `copy-directory' + ;; (similar to the `cp' shell command) we don't + ;; need such a construction of the target directory, + ;; so modify the destination TO to "~/test/" instead of "~/test/foo/". + (let ((destname (file-name-directory to))) + (when (and (file-directory-p from) + (file-directory-p to) + (eq file-creator 'dired-copy-file)) + (setq to destname)) + ;; If DESTNAME is a subdirectory of FROM, not a symlink, + ;; and the method in use is copying, signal an error. + (and (eq t (car (file-attributes destname))) + (eq file-creator 'dired-copy-file) + (file-in-directory-p destname from) + (error "Cannot copy `%s' into its subdirectory `%s'" + from to))) + (if dired-async-be-async + (if overwrite + (or (and dired-overwrite-confirmed + (push (cons from to) async-fn-list)) + (progn + (push (dired-make-relative from) failures) + (dired-log "%s `%s' to `%s' failed" + operation from to))) + (push (cons from to) async-fn-list)) + (condition-case err + (progn + (funcall file-creator from to dired-overwrite-confirmed) + (if overwrite + ;; If we get here, file-creator hasn't been aborted + ;; and the old entry (if any) has to be deleted + ;; before adding the new entry. + (dired-remove-file to)) + (setq success-count (1+ success-count)) + (message "%s: %d of %d" operation success-count total) + (dired-add-file to actual-marker-char)) + (file-error ; FILE-CREATOR aborted + (progn + (push (dired-make-relative from) + failures) + (dired-log "%s `%s' to `%s' failed:\n%s\n" + operation from to err))))))))) + ;; Handle error happening in host emacs. + (cond + (dired-create-files-failures + (setq failures (nconc failures dired-create-files-failures)) + (dired-log-summary + (format "%s failed for %d file%s in %d requests" + operation (length failures) + (dired-plural-s (length failures)) + total) + failures)) + (failures + (dired-log-summary + (format "%s failed for %d of %d file%s" + operation (length failures) + total (dired-plural-s total)) + failures)) + (skipped + (dired-log-summary + (format "%s: %d of %d file%s skipped" + operation (length skipped) total + (dired-plural-s total)) + skipped)) + (t (message "%s: %s file%s" + operation success-count (dired-plural-s success-count)))) + ;; Start async process. + (when (and async-fn-list dired-async-be-async) + (async-start `(lambda () + (require 'cl-lib) (require 'dired-aux) (require 'dired-x) + ,(async-inject-variables dired-async-env-variables-regexp) + (condition-case err + (let ((dired-recursive-copies (quote always))) + (cl-loop for (f . d) in (quote ,async-fn-list) + do (funcall (quote ,file-creator) f d t))) + (file-error + (with-temp-file ,dired-async-log-file + (insert (format "%S" err))))) + ,(dired-async-maybe-kill-ftp)) + callback) + ;; Run mode-line notifications while process running. + (dired-async-mode 1) + (setq dired-async-operation (list operation (length async-fn-list))) + (message "%s proceeding asynchronously..." operation))) + (unless dired-async-be-async + (dired-move-to-filename))) + + +(provide 'dired-async) + +;;; dired-async.el ends here diff --git a/elpa/async-20150412.2207/smtpmail-async.el b/elpa/async-20150412.2207/smtpmail-async.el new file mode 100644 index 00000000..d487f930 --- /dev/null +++ b/elpa/async-20150412.2207/smtpmail-async.el @@ -0,0 +1,73 @@ +;;; smtpmail-async --- Send e-mail with smtpmail.el asynchronously + +;; Copyright (C) 2012~2014 John Wiegley + +;; Author: John Wiegley +;; Created: 18 Jun 2012 + +;; Keywords: email async +;; X-URL: https://github.com/jwiegley/emacs-async + +;; 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 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: + +;; Send e-mail with smtpmail.el asynchronously. To use: +;; +;; (require 'smtpmail-async) +;; +;; (setq send-mail-function 'async-smtpmail-send-it +;; message-send-mail-function 'async-smtpmail-send-it) +;; +;; This assumes you already have smtpmail.el working. + +;;; Code: + +(defgroup smtpmail-async nil + "Send e-mail with smtpmail.el asynchronously" + :group 'smptmail) + +(require 'async) +(require 'smtpmail) +(require 'message) + +(defvar async-smtpmail-before-send-hook nil + "Hook running in the child emacs in `async-smtpmail-send-it'. +It is called just before calling `smtpmail-send-it'.") + +(defun async-smtpmail-send-it () + (let ((to (message-field-value "To")) + (buf-content (buffer-substring-no-properties + (point-min) (point-max)))) + (message "Delivering message to %s..." to) + (async-start + `(lambda () + (require 'smtpmail) + (with-temp-buffer + (insert ,buf-content) + (set-buffer-multibyte nil) + ;; Pass in the variable environment for smtpmail + ,(async-inject-variables + "\\`\\(smtpmail\\|async-smtpmail\\|\\(user-\\)?mail\\)-\\|auth-sources" + nil "\\`\\(mail-header-format-function\\|smtpmail-address-buffer\\|mail-mode-abbrev-table\\)") + (run-hooks 'async-smtpmail-before-send-hook) + (smtpmail-send-it))) + `(lambda (&optional ignore) + (message "Delivering message to %s...done" ,to))))) + +(provide 'smtpmail-async) + +;;; smtpmail-async.el ends here diff --git a/elpa/helm-20150403.101/emacs-helm.sh b/elpa/helm-20150403.101/emacs-helm.sh deleted file mode 100755 index d24128da..00000000 --- a/elpa/helm-20150403.101/emacs-helm.sh +++ /dev/null @@ -1,96 +0,0 @@ -#!/usr/bin/env bash - - -## Copyright (C) 2012 Thierry Volpiatto -## -## 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 . - -## Commentary: - -# Preconfigured Emacs with a basic helm configuration. -# Useful to start quickly an emacs -Q with helm. -# Run it from this directory. - -TMP="/tmp/helm-cfg.el" -EMACS=emacs - -case $1 in - -P) - shift 1 - declare EMACS=$1 - shift 1 - ;; - -h) - echo "Usage: ${0##*/} [-P} Emacs path [-h} help [--] EMACS ARGS" - exit 2 - ;; -esac - -cd $(dirname "$0") - -# Check if autoload file exists. -# It is maybe in a different directory if -# emacs-helm.sh is a symlink. -LS=$(ls -l $0 | awk '{print $11}') -if [ ! -z $LS ]; then - AUTO_FILE="$(dirname $LS)/helm-autoloads.el" -else - AUTO_FILE="helm-autoloads.el" -fi -if [ ! -e "$AUTO_FILE" ]; then - echo No autoloads found, please run make first to generate autoload file - exit 2 -fi - - -cat > $TMP <\`helm-find-files'\n\ -;; - \`occur'(M-s o) =>\`helm-occur'\n\ -;; - \`list-buffers'(C-x C-b) =>\`helm-buffers-list'\n\ -;; - \`completion-at-point'(M-tab) =>\`helm-lisp-completion-at-point'[1]\n\ -;; - \`dabbrev-expand'(M-/) =>\`helm-dabbrev'\n\n\ -;; Some others native emacs commands are \"helmized\" by \`helm-mode'.\n\ -;; [1] Coming with emacs-24.4 \`completion-at-point' is \"helmized\" by \`helm-mode'\n\ -;; which provide helm completion in many other places like \`shell-mode'.\n\ -;; You will find embeded help for most helm commands with \`C-c ?'.\n\ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n")) - -(setq default-frame-alist '((vertical-scroll-bars . nil) - (tool-bar-lines . 0) - (menu-bar-lines . 0) - (fullscreen . nil))) -(blink-cursor-mode -1) -(add-to-list 'load-path (file-name-directory (file-truename "$0"))) -(require 'helm-config) -(helm-mode 1) -(define-key global-map [remap find-file] 'helm-find-files) -(define-key global-map [remap occur] 'helm-occur) -(define-key global-map [remap list-buffers] 'helm-buffers-list) -(define-key global-map [remap dabbrev-expand] 'helm-dabbrev) -(global-set-key (kbd "M-x") 'helm-M-x) -(unless (boundp 'completion-in-region-function) - (define-key lisp-interaction-mode-map [remap completion-at-point] 'helm-lisp-completion-at-point) - (define-key emacs-lisp-mode-map [remap completion-at-point] 'helm-lisp-completion-at-point)) -(add-hook 'kill-emacs-hook #'(lambda () (and (file-exists-p "$TMP") (delete-file "$TMP")))) -EOF - -$EMACS -Q -l $TMP $@ - diff --git a/elpa/helm-20150403.101/helm-adaptive.el b/elpa/helm-20150403.101/helm-adaptive.el deleted file mode 100644 index d7f05326..00000000 --- a/elpa/helm-20150403.101/helm-adaptive.el +++ /dev/null @@ -1,243 +0,0 @@ -;;; helm-adaptive.el --- Adaptive Sorting of Candidates. -*- lexical-binding: t -*- - -;; Original Author: Tamas Patrovics - -;; Copyright (C) 2007 Tamas Patrovics -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) - - -(defgroup helm-adapt nil - "Adaptative sorting of candidates for Helm." - :group 'helm) - -(defcustom helm-adaptive-history-file - "~/.emacs.d/helm-adaptive-history" - "Path of file where history information is stored." - :type 'string - :group 'helm-adapt) - -(defcustom helm-adaptive-history-length 50 - "Maximum number of candidates stored for a source." - :type 'number - :group 'helm-adapt) - - -;; Internal -(defvar helm-adaptive-done nil - "nil if history information is not yet stored for the current -selection.") - -(defvar helm-adaptive-history nil - "Contains the stored history information. -Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)") - -(defun helm-adaptive-done-reset () - (setq helm-adaptive-done nil)) - -(define-minor-mode helm-adaptive-mode - "Toggle adaptive sorting in all sources." - :group 'helm-adapt - :require 'helm-adaptive - :global t - (if helm-adaptive-mode - (progn - (unless helm-adaptive-history - (helm-adaptive-maybe-load-history)) - (add-hook 'kill-emacs-hook 'helm-adaptive-save-history) - ;; Should run at beginning of `helm-initial-setup'. - (add-hook 'helm-before-initialize-hook 'helm-adaptive-done-reset) - ;; Should run at beginning of `helm-exit-minibuffer'. - (add-hook 'helm-before-action-hook 'helm-adaptive-store-selection) - ;; Should run at beginning of `helm-select-action'. - (add-hook 'helm-select-action-hook 'helm-adaptive-store-selection)) - (helm-adaptive-save-history) - (setq helm-adaptive-history nil) - (remove-hook 'kill-emacs-hook 'helm-adaptive-save-history) - (remove-hook 'helm-before-initialize-hook 'helm-adaptive-done-reset) - (remove-hook 'helm-before-action-hook 'helm-adaptive-store-selection) - (remove-hook 'helm-select-action-hook 'helm-adaptive-store-selection))) - -(defun helm-adapt-use-adaptive-p (&optional source-name) - "Return current source only if it use adaptive history, nil otherwise." - (when helm-adaptive-mode - (let* ((source (or source-name (helm-get-current-source))) - (adapt-source (or (assoc-default 'filtered-candidate-transformer - (assoc (assoc-default 'type source) - helm-type-attributes)) - (assoc-default 'candidate-transformer - (assoc (assoc-default 'type source) - helm-type-attributes)) - (assoc-default 'filtered-candidate-transformer source) - (assoc-default 'candidate-transformer source)))) - (if (listp adapt-source) - (and (member 'helm-adaptive-sort adapt-source) source) - (and (eq adapt-source 'helm-adaptive-sort) source))))) - -(defun helm-adaptive-store-selection () - "Store history information for the selected candidate." - (unless helm-adaptive-done - (setq helm-adaptive-done t) - (let ((source (helm-adapt-use-adaptive-p))) - (when source - (let* ((source-name (or (assoc-default 'type source) - (assoc-default 'name source))) - (source-info (or (assoc source-name helm-adaptive-history) - (progn - (push (list source-name) helm-adaptive-history) - (car helm-adaptive-history)))) - (selection (helm-get-selection)) - (selection-info (progn - (setcdr source-info - (cons - (let ((found (assoc selection (cdr source-info)))) - (if (not found) - ;; new entry - (list selection) - ;; move entry to the beginning of the - ;; list, so that it doesn't get - ;; trimmed when the history is - ;; truncated - (setcdr source-info - (delete found (cdr source-info))) - found)) - (cdr source-info))) - (cadr source-info))) - (pattern-info (progn - (setcdr selection-info - (cons - (let ((found (assoc helm-pattern (cdr selection-info)))) - (if (not found) - ;; new entry - (cons helm-pattern 0) - - ;; move entry to the beginning of the - ;; list, so if two patterns used the - ;; same number of times then the one - ;; used last appears first in the list - (setcdr selection-info - (delete found (cdr selection-info))) - found)) - (cdr selection-info))) - (cadr selection-info)))) - - ;; increase usage count - (setcdr pattern-info (1+ (cdr pattern-info))) - - ;; truncate history if needed - (if (> (length (cdr selection-info)) helm-adaptive-history-length) - (setcdr selection-info - (cl-subseq (cdr selection-info) 0 helm-adaptive-history-length)))))))) - -(defun helm-adaptive-maybe-load-history () - "Load `helm-adaptive-history-file' which contain `helm-adaptive-history'. -Returns nil if `helm-adaptive-history-file' doesn't exist." - (when (file-readable-p helm-adaptive-history-file) - (load-file helm-adaptive-history-file))) - -(defun helm-adaptive-save-history (&optional arg) - "Save history information to file given by `helm-adaptive-history-file'." - (interactive "p") - (with-temp-buffer - (insert - ";; -*- mode: emacs-lisp -*-\n" - ";; History entries used for helm adaptive display.\n") - (prin1 `(setq helm-adaptive-history ',helm-adaptive-history) - (current-buffer)) - (insert ?\n) - (write-region (point-min) (point-max) helm-adaptive-history-file nil - (unless arg 'quiet)))) - -(defun helm-adaptive-sort (candidates source) - "Sort the CANDIDATES for SOURCE by usage frequency. -This is a filtered candidate transformer you can use with the -`filtered-candidate-transformer' attribute." - (let* ((source-name (or (assoc-default 'type source) - (assoc-default 'name source))) - (source-info (assoc source-name helm-adaptive-history))) - (if source-info - (let ((usage - ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT) - ;; pairs - (mapcar (lambda (candidate-info) - (let ((count 0)) - (cl-dolist (pattern-info (cdr candidate-info)) - (if (not (equal (car pattern-info) - helm-pattern)) - (cl-incf count (cdr pattern-info)) - - ;; if current pattern is equal to the previously - ;; used one then this candidate has priority - ;; (that's why its count is boosted by 10000) and - ;; it only has to compete with other candidates - ;; which were also selected with the same pattern - (setq count (+ 10000 (cdr pattern-info))) - (cl-return))) - (cons (car candidate-info) count))) - (cdr source-info)))) - (if (and usage (consp usage)) - ;; sort the list in descending order, so candidates with highest - ;; priorty come first - (progn - (setq usage (sort usage (lambda (first second) - (> (cdr first) (cdr second))))) - - ;; put those candidates first which have the highest usage count - (cl-loop for (info . _freq) in usage - for member = (cl-member info candidates - :test 'helm-adaptive-compare) - when member collect (car member) into sorted - and do - (setq candidates (cl-remove info candidates - :test 'helm-adaptive-compare)) - finally return (append sorted candidates))) - (message "Your `%s' is maybe corrupted or too old, \ -you should reinitialize it with `helm-reset-adaptive-history'" - helm-adaptive-history-file) - (sit-for 1) - candidates)) - ;; if there is no information stored for this source then do nothing - candidates))) - -;;;###autoload -(defun helm-reset-adaptive-history () - "Delete all `helm-adaptive-history' and his file. -Useful when you have a old or corrupted `helm-adaptive-history-file'." - (interactive) - (when (y-or-n-p "Really delete all your `helm-adaptive-history'? ") - (setq helm-adaptive-history nil) - (delete-file helm-adaptive-history-file))) - -(defun helm-adaptive-compare (x y) - "Compare candidates X and Y taking into account that the -candidate can be in (DISPLAY . REAL) format." - (equal (if (listp x) (cdr x) x) - (if (listp y) (cdr y) y))) - - -(provide 'helm-adaptive) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-adaptive.el ends here diff --git a/elpa/helm-20150403.101/helm-aliases.el b/elpa/helm-20150403.101/helm-aliases.el deleted file mode 100644 index 5427920a..00000000 --- a/elpa/helm-20150403.101/helm-aliases.el +++ /dev/null @@ -1,778 +0,0 @@ -;;; helm-aliases.el --- Helm aliases for helm obsoletes functions. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) - - -;;; Helper functions to create aliases with old helm definitions -;; prefixed with "helm-c-" -;; -(defun helm-alias-p (sym) - (cond ((boundp sym) - (not (eq (indirect-variable sym) sym))) - ((fboundp sym) - (symbolp (symbol-function sym))) - (t nil))) - -(defun helm-check-conflicting-prefixes () - (cl-loop for s in (all-completions "helm-c-" obarray) - for rep = (replace-regexp-in-string "helm-c-" "helm-" s) - when (or (and (not (helm-alias-p (intern s))) (fboundp (intern rep))) - (and (not (helm-alias-p (intern s))) (boundp (intern rep)))) - collect rep)) - -(defun helm-collect-functions-with-bad-prefix () - (cl-loop for s in (all-completions "helm-c-" obarray) - for sym = (intern s) - when (and (not (helm-alias-p sym)) (fboundp sym)) - collect s)) - -(defun helm-collect-vars-with-bad-prefix () - (cl-loop for s in (all-completions "helm-c-" obarray) - for sym = (intern s) - when (and (not (helm-alias-p sym)) (boundp sym)) - collect s)) - -(defun helm-insert-fn-aliases () - (cl-loop for s in (helm-collect-functions-with-bad-prefix) - for rep = (replace-regexp-in-string "helm-c-" "helm-" s) - do (insert (format "(defalias '%s '%s)\n(make-obsolete '%s '%s \"1.5.1\")\n" s rep s rep)))) - -(defun helm-insert-var-aliases () - (cl-loop for s in (helm-collect-vars-with-bad-prefix) - for rep = (replace-regexp-in-string "helm-c-" "helm-" s) - do (insert (format "(defvaralias '%s '%s)\n(make-obsolete-variable '%s '%s \"1.5.1\")\n" s rep s rep)))) - - -;;; Alias old functions prefixed with "helm-c-" -;; -;; -(defalias 'helm-c-etags-default-action 'helm-etags-default-action) -(make-obsolete 'helm-c-etags-default-action 'helm-etags-default-action "1.5.1") -(defalias 'helm-c-show-info-in-mode-line 'helm-show-info-in-mode-line) -(make-obsolete 'helm-c-show-info-in-mode-line 'helm-show-info-in-mode-line "1.5.1") -(defalias 'helm-c-grep-highlight-match 'helm-grep-highlight-match) -(make-obsolete 'helm-c-grep-highlight-match 'helm-grep-highlight-match "1.5.1") -(defalias 'helm-c-apropos 'helm-apropos) -(make-obsolete 'helm-c-apropos 'helm-apropos "1.5.1") -(defalias 'helm-c-grep-guess-extensions 'helm-grep-guess-extensions) -(make-obsolete 'helm-c-grep-guess-extensions 'helm-grep-guess-extensions "1.5.1") -(defalias 'helm-c-apt-reinstall 'helm-apt-reinstall) -(make-obsolete 'helm-c-apt-reinstall 'helm-apt-reinstall "1.5.1") -(defalias 'helm-c-reset-adaptive-history 'helm-reset-adaptive-history) -(make-obsolete 'helm-c-reset-adaptive-history 'helm-reset-adaptive-history "1.5.1") -(defalias 'helm-adaptative-mode 'helm-adaptive-mode) -(make-obsolete 'helm-adaptative-mode 'helm-adaptive-mode "1.6.2") -(defalias 'helm-c-highlight-bookmark 'helm-highlight-bookmark) -(make-obsolete 'helm-c-highlight-bookmark 'helm-highlight-bookmark "1.5.1") -(defalias 'helm-c-locate-init 'helm-locate-init) -(make-obsolete 'helm-c-locate-init 'helm-locate-init "1.5.1") -(defalias 'helm-c-delete-file 'helm-delete-file) -(make-obsolete 'helm-c-delete-file 'helm-delete-file "1.5.1") -(defalias 'helm-c-regexp-persistent-action 'helm-regexp-persistent-action) -(make-obsolete 'helm-c-regexp-persistent-action 'helm-regexp-persistent-action "1.5.1") -(defalias 'helm-c-grep-split-line 'helm-grep-split-line) -(make-obsolete 'helm-c-grep-split-line 'helm-grep-split-line "1.5.1") -(defalias 'helm-c-info-display-to-real 'helm-info-display-to-real) -(make-obsolete 'helm-c-info-display-to-real 'helm-info-display-to-real "1.5.1") -(defalias 'helm-c-symbolify 'helm-symbolify) -(make-obsolete 'helm-c-symbolify 'helm-symbolify "1.5.1") -(defalias 'helm-c-zgrep-buffers 'helm-zgrep-buffers) -(make-obsolete 'helm-c-zgrep-buffers 'helm-zgrep-buffers "1.5.1") -(defalias 'helm-c-apt-persistent-action 'helm-apt-persistent-action) -(make-obsolete 'helm-c-apt-persistent-action 'helm-apt-persistent-action "1.5.1") -(defalias 'helm-c-pdfgrep-init 'helm-pdfgrep-init) -(make-obsolete 'helm-c-pdfgrep-init 'helm-pdfgrep-init "1.5.1") -(defalias 'helm-c-walk-directory 'helm-walk-directory) -(make-obsolete 'helm-c-walk-directory 'helm-walk-directory "1.5.1") -(defalias 'helm-c-grep-init 'helm-grep-init) -(make-obsolete 'helm-c-grep-init 'helm-grep-init "1.5.1") -(defalias 'helm-c-ucs-forward-char 'helm-ucs-forward-char) -(make-obsolete 'helm-c-ucs-forward-char 'helm-ucs-forward-char "1.5.1") -(defalias 'helm-c-complete-file-name-at-point 'helm-complete-file-name-at-point) -(make-obsolete 'helm-c-complete-file-name-at-point 'helm-complete-file-name-at-point "1.5.1") -(defalias 'helm-c-timer-real-to-display 'helm-timer-real-to-display) -(make-obsolete 'helm-c-timer-real-to-display 'helm-timer-real-to-display "1.5.1") -(defalias 'helm-c-ucs-init 'helm-ucs-init) -(make-obsolete 'helm-c-ucs-init 'helm-ucs-init "1.5.1") -(defalias 'helm-c-bookmark-run-delete 'helm-bookmark-run-delete) -(make-obsolete 'helm-c-bookmark-run-delete 'helm-bookmark-run-delete "1.5.1") -(defalias 'helm-c-uniq-list 'helm-uniq-list) -(make-obsolete 'helm-c-uniq-list 'helm-uniq-list "1.5.1") -(defalias 'helm-c-pp-bookmarks 'helm-pp-bookmarks) -(make-obsolete 'helm-c-pp-bookmarks 'helm-pp-bookmarks "1.5.1") -(defalias 'helm-c-top-sh-persistent-action 'helm-top-sh-persistent-action) -(make-obsolete 'helm-c-top-sh-persistent-action 'helm-top-sh-persistent-action "1.5.1") -(defalias 'helm-c-grep-action 'helm-grep-action) -(make-obsolete 'helm-c-grep-action 'helm-grep-action "1.5.1") -(defalias 'helm-c-file-buffers 'helm-file-buffers) -(make-obsolete 'helm-c-file-buffers 'helm-file-buffers "1.5.1") -(defalias 'helm-c-google-suggest-fetch 'helm-google-suggest-fetch) -(make-obsolete 'helm-c-google-suggest-fetch 'helm-google-suggest-fetch "1.5.1") -(defalias 'helm-c-arrange-type-attribute 'helm-arrange-type-attribute) -(make-obsolete 'helm-c-arrange-type-attribute 'helm-arrange-type-attribute "1.5.1") -(defalias 'helm-c-yahoo-suggest-action 'helm-yahoo-suggest-action) -(make-obsolete 'helm-c-yahoo-suggest-action 'helm-yahoo-suggest-action "1.5.1") -(defalias 'helm-c-buffer-query-replace-1 'helm-buffer-query-replace-1) -(make-obsolete 'helm-c-buffer-query-replace-1 'helm-buffer-query-replace-1 "1.5.1") -(defalias 'helm-c-make-info-source 'helm-make-info-source) -(make-obsolete 'helm-c-make-info-source 'helm-make-info-source "1.5.1") -(defalias 'helm-c-open-dired 'helm-open-dired) -(make-obsolete 'helm-c-open-dired 'helm-open-dired "1.5.1") -(defalias 'helm-c-kill-ring-transformer 'helm-kill-ring-transformer) -(make-obsolete 'helm-c-kill-ring-transformer 'helm-kill-ring-transformer "1.5.1") -(defalias 'helm-c-etags-init 'helm-etags-init) -(make-obsolete 'helm-c-etags-init 'helm-etags-init "1.5.1") -(defalias 'helm-c-advice-update-current-display-string 'helm-advice-update-current-display-string) -(make-obsolete 'helm-c-advice-update-current-display-string 'helm-advice-update-current-display-string "1.5.1") -(defalias 'helm-c-regexp-get-line 'helm-regexp-get-line) -(make-obsolete 'helm-c-regexp-get-line 'helm-regexp-get-line "1.5.1") -(defalias 'helm-c-grep-run-other-window-action 'helm-grep-run-other-window-action) -(make-obsolete 'helm-c-grep-run-other-window-action 'helm-grep-run-other-window-action "1.5.1") -(defalias 'helm-c-regexp-kill-new 'helm-regexp-kill-new) -(make-obsolete 'helm-c-regexp-kill-new 'helm-regexp-kill-new "1.5.1") -(defalias 'helm-c-grep-run-default-action 'helm-grep-run-default-action) -(make-obsolete 'helm-c-grep-run-default-action 'helm-grep-run-default-action "1.5.1") -(defalias 'helm-c-define-info-index-sources 'helm-define-info-index-sources) -(make-obsolete 'helm-c-define-info-index-sources 'helm-define-info-index-sources "1.5.1") -(defalias 'helm-c-transform-file-browse-url 'helm-transform-file-browse-url) -(make-obsolete 'helm-c-transform-file-browse-url 'helm-transform-file-browse-url "1.5.1") -(defalias 'helm-c-shell-command-if-needed 'helm-shell-command-if-needed) -(make-obsolete 'helm-c-shell-command-if-needed 'helm-shell-command-if-needed "1.5.1") -(defalias 'helm-c-kill-regexp-as-sexp 'helm-kill-regexp-as-sexp) -(make-obsolete 'helm-c-kill-regexp-as-sexp 'helm-kill-regexp-as-sexp "1.5.1") -(defalias 'helm-c-goto-next-or-prec-file 'helm-goto-next-or-prec-file) -(make-obsolete 'helm-c-goto-next-or-prec-file 'helm-goto-next-or-prec-file "1.5.1") -(defalias 'helm-c-insert-file-name-completion-at-point 'helm-insert-file-name-completion-at-point) -(make-obsolete 'helm-c-insert-file-name-completion-at-point 'helm-insert-file-name-completion-at-point "1.5.1") -(defalias 'helm-c-point-file-in-dired 'helm-point-file-in-dired) -(make-obsolete 'helm-c-point-file-in-dired 'helm-point-file-in-dired "1.5.1") -(defalias 'helm-c-info-goto 'helm-info-goto) -(make-obsolete 'helm-c-info-goto 'helm-info-goto "1.5.1") -(defalias 'helm-c-apt-install 'helm-apt-install) -(make-obsolete 'helm-c-apt-install 'helm-apt-install "1.5.1") -(defalias 'helm-c-skip-boring-buffers 'helm-skip-boring-buffers) -(make-obsolete 'helm-c-skip-boring-buffers 'helm-skip-boring-buffers "1.5.1") -(defalias 'helm-c-register-candidates 'helm-register-candidates) -(make-obsolete 'helm-c-register-candidates 'helm-register-candidates "1.5.1") -(defalias 'helm-c-find-function 'helm-find-function) -(make-obsolete 'helm-c-find-function 'helm-find-function "1.5.1") -(defalias 'helm-c-apt-display-to-real 'helm-apt-display-to-real) -(make-obsolete 'helm-c-apt-display-to-real 'helm-apt-display-to-real "1.5.1") -(defalias 'helm-c-org-keywords-init 'helm-org-keywords-init) -(make-obsolete 'helm-c-org-keywords-init 'helm-org-keywords-init "1.5.1") -(defalias 'helm-c-xrandr-screen 'helm-xrandr-screen) -(make-obsolete 'helm-c-xrandr-screen 'helm-xrandr-screen "1.5.1") -(defalias 'helm-c-position 'helm-position) -(make-obsolete 'helm-c-position 'helm-position "1.5.1") -(defalias 'helm-c-imenu-candidates 'helm-imenu-candidates) -(make-obsolete 'helm-c-imenu-candidates 'helm-imenu-candidates "1.5.1") -(defalias 'helm-c-ucs-persistent-forward 'helm-ucs-persistent-forward) -(make-obsolete 'helm-c-ucs-persistent-forward 'helm-ucs-persistent-forward "1.5.1") -(defalias 'helm-c-basename 'helm-basename) -(make-obsolete 'helm-c-basename 'helm-basename "1.5.1") -(defalias 'helm-c-files-in-all-dired-candidates 'helm-files-in-all-dired-candidates) -(make-obsolete 'helm-c-files-in-all-dired-candidates 'helm-files-in-all-dired-candidates "1.5.1") -(defalias 'helm-c-grep-other-window 'helm-grep-other-window) -(make-obsolete 'helm-c-grep-other-window 'helm-grep-other-window "1.5.1") -(defalias 'helm-c-yahoo-suggest-fetch 'helm-yahoo-suggest-fetch) -(make-obsolete 'helm-c-yahoo-suggest-fetch 'helm-yahoo-suggest-fetch "1.5.1") -(defalias 'helm-c-external-commands-list-1 'helm-external-commands-list-1) -(make-obsolete 'helm-c-external-commands-list-1 'helm-external-commands-list-1 "1.5.1") -(defalias 'helm-c-buffers-list-persistent-action 'helm-buffers-list-persistent-action) -(make-obsolete 'helm-c-buffers-list-persistent-action 'helm-buffers-list-persistent-action "1.5.1") -(defalias 'helm-c-show-completion-init-overlay 'helm-show-completion-init-overlay) -(make-obsolete 'helm-c-show-completion-init-overlay 'helm-show-completion-init-overlay "1.5.1") -(defalias 'helm-c-shadow-boring-files 'helm-shadow-boring-files) -(make-obsolete 'helm-c-shadow-boring-files 'helm-shadow-boring-files "1.5.1") -(defalias 'helm-c-bookmark-local-files-setup-alist 'helm-bookmark-local-files-setup-alist) -(make-obsolete 'helm-c-bookmark-local-files-setup-alist 'helm-bookmark-local-files-setup-alist "1.5.1") -(defalias 'helm-c-highlight-local-use 'helm-highlight-local-use) -(make-obsolete 'helm-c-highlight-local-use 'helm-highlight-local-use "1.5.1") -(defalias 'helm-c-skip-current-file 'helm-skip-current-file) -(make-obsolete 'helm-c-skip-current-file 'helm-skip-current-file "1.5.1") -(defalias 'helm-c-goto-next-file 'helm-goto-next-file) -(make-obsolete 'helm-c-goto-next-file 'helm-goto-next-file "1.5.1") -(defalias 'helm-c-info-init 'helm-info-init) -(make-obsolete 'helm-c-info-init 'helm-info-init "1.5.1") -(defalias 'helm-c-query-replace-args 'helm-query-replace-args) -(make-obsolete 'helm-c-query-replace-args 'helm-query-replace-args "1.5.1") -(defalias 'helm-c-bookmark-info-setup-alist 'helm-bookmark-info-setup-alist) -(make-obsolete 'helm-c-bookmark-info-setup-alist 'helm-bookmark-info-setup-alist "1.5.1") -(defalias 'helm-c-ratpoison-commands-execute 'helm-ratpoison-commands-execute) -(make-obsolete 'helm-c-ratpoison-commands-execute 'helm-ratpoison-commands-execute "1.5.1") -(defalias 'helm-c-ucs-persistent-backward 'helm-ucs-persistent-backward) -(make-obsolete 'helm-c-ucs-persistent-backward 'helm-ucs-persistent-backward "1.5.1") -(defalias 'helm-c-info-pages-init 'helm-info-pages-init) -(make-obsolete 'helm-c-info-pages-init 'helm-info-pages-init "1.5.1") -(defalias 'helm-c-grep-save-results 'helm-grep-save-results) -(make-obsolete 'helm-c-grep-save-results 'helm-grep-save-results "1.5.1") -(defalias 'helm-c-read-file-name 'helm-read-file-name) -(make-obsolete 'helm-c-read-file-name 'helm-read-file-name "1.5.1") -(defalias 'helm-c-org-keywords-insert 'helm-org-keywords-insert) -(make-obsolete 'helm-c-org-keywords-insert 'helm-org-keywords-insert "1.5.1") -(defalias 'helm-c-call-interactively 'helm-call-interactively) -(make-obsolete 'helm-c-call-interactively 'helm-call-interactively "1.5.1") -(defalias 'helm-c-adaptative-compare 'helm-adaptive-compare) -(make-obsolete 'helm-c-adaptative-compare 'helm-adaptive-compare "1.5.1") -(defalias 'helm-c-buffer-list 'helm-buffer-list) -(make-obsolete 'helm-c-buffer-list 'helm-buffer-list "1.5.1") -(defalias 'helm-c-thing-before-point 'helm-thing-before-point) -(make-obsolete 'helm-c-thing-before-point 'helm-thing-before-point "1.5.1") -(defalias 'helm-c-ratpoison-commands-display-to-real 'helm-ratpoison-commands-display-to-real) -(make-obsolete 'helm-c-ratpoison-commands-display-to-real 'helm-ratpoison-commands-display-to-real "1.5.1") -(defalias 'helm-c-imenu-default-action 'helm-imenu-default-action) -(make-obsolete 'helm-c-imenu-default-action 'helm-imenu-default-action "1.5.1") -(defalias 'helm-c-describe-function 'helm-describe-function) -(make-obsolete 'helm-c-describe-function 'helm-describe-function "1.5.1") -(defalias 'helm-c-colors-get-name 'helm-colors-get-name) -(make-obsolete 'helm-c-colors-get-name 'helm-colors-get-name "1.5.1") -(defalias 'helm-c-bookmark-help 'helm-bookmark-help) -(make-obsolete 'helm-c-bookmark-help 'helm-bookmark-help "1.5.1") -(defalias 'helm-c-ucs-persistent-delete 'helm-ucs-persistent-delete) -(make-obsolete 'helm-c-ucs-persistent-delete 'helm-ucs-persistent-delete "1.5.1") -(defalias 'helm-c-set-variable 'helm-set-variable) -(make-obsolete 'helm-c-set-variable 'helm-set-variable "1.5.1") -(defalias 'helm-c-grep-save-results-1 'helm-grep-save-results-1) -(make-obsolete 'helm-c-grep-save-results-1 'helm-grep-save-results-1 "1.5.1") -(defalias 'helm-c-adaptative-maybe-load-history 'helm-adaptive-maybe-load-history) -(make-obsolete 'helm-c-adaptative-maybe-load-history 'helm-adaptive-maybe-load-history "1.5.1") -(defalias 'helm-c-w32-pathname-transformer 'helm-w32-pathname-transformer) -(make-obsolete 'helm-c-w32-pathname-transformer 'helm-w32-pathname-transformer "1.5.1") -(defalias 'helm-c-top-display-to-real 'helm-top-display-to-real) -(make-obsolete 'helm-c-top-display-to-real 'helm-top-display-to-real "1.5.1") -(defalias 'helm-c-open-file-externally 'helm-open-file-externally) -(make-obsolete 'helm-c-open-file-externally 'helm-open-file-externally "1.5.1") -(defalias 'helm-c-colors-get-rgb 'helm-colors-get-rgb) -(make-obsolete 'helm-c-colors-get-rgb 'helm-colors-get-rgb "1.5.1") -(defalias 'helm-c-stumpwm-commands-init 'helm-stumpwm-commands-init) -(make-obsolete 'helm-c-stumpwm-commands-init 'helm-stumpwm-commands-init "1.5.1") -(defalias 'helm-c-highlight-world 'helm-highlight-world) -(make-obsolete 'helm-c-highlight-world 'helm-highlight-world "1.5.1") -(defalias 'helm-c-top-sh 'helm-top-sh) -(make-obsolete 'helm-c-top-sh 'helm-top-sh "1.5.1") -(defalias 'helm-c-persistent-xfont-action 'helm-persistent-xfont-action) -(make-obsolete 'helm-c-persistent-xfont-action 'helm-persistent-xfont-action "1.5.1") -(defalias 'helm-c-latex-math-candidates 'helm-latex-math-candidates) -(make-obsolete 'helm-c-latex-math-candidates 'helm-latex-math-candidates "1.5.1") -(defalias 'helm-c-ucs-backward-char 'helm-ucs-backward-char) -(make-obsolete 'helm-c-ucs-backward-char 'helm-ucs-backward-char "1.5.1") -(defalias 'helm-c-calculate-ucs-max-len 'helm-calculate-ucs-max-len) -(make-obsolete 'helm-c-calculate-ucs-max-len 'helm-calculate-ucs-max-len "1.5.1") -(defalias 'helm-c-etags-mtime 'helm-etags-mtime) -(make-obsolete 'helm-c-etags-mtime 'helm-etags-mtime "1.5.1") -(defalias 'helm-c-google-suggest-action 'helm-google-suggest-action) -(make-obsolete 'helm-c-google-suggest-action 'helm-google-suggest-action "1.5.1") -(defalias 'helm-c-elisp-library-scan-init 'helm-elisp-library-scan-init) -(make-obsolete 'helm-c-elisp-library-scan-init 'helm-elisp-library-scan-init "1.5.1") -(defalias 'helm-c-apt-refresh 'helm-apt-refresh) -(make-obsolete 'helm-c-apt-refresh 'helm-apt-refresh "1.5.1") -(defalias 'helm-c-kill-regexp 'helm-kill-regexp) -(make-obsolete 'helm-c-kill-regexp 'helm-kill-regexp "1.5.1") -(defalias 'helm-c-grep-buffers-1 'helm-grep-buffers-1) -(make-obsolete 'helm-c-grep-buffers-1 'helm-grep-buffers-1 "1.5.1") -(defalias 'helm-c-adaptative-store-selection 'helm-adaptive-store-selection) -(make-obsolete 'helm-c-adaptative-store-selection 'helm-adaptive-store-selection "1.5.1") -(defalias 'helm-c-browse-url 'helm-browse-url) -(make-obsolete 'helm-c-browse-url 'helm-browse-url "1.5.1") -(defalias 'helm-c-google-suggest-emacs-lisp 'helm-google-suggest-emacs-lisp) -(make-obsolete 'helm-c-google-suggest-emacs-lisp 'helm-google-suggest-emacs-lisp "1.5.1") -(defalias 'helm-c-ucs-persistent-insert 'helm-ucs-persistent-insert) -(make-obsolete 'helm-c-ucs-persistent-insert 'helm-ucs-persistent-insert "1.5.1") -(defalias 'helm-c-xrandr-output 'helm-xrandr-output) -(make-obsolete 'helm-c-xrandr-output 'helm-xrandr-output "1.5.1") -(defalias 'helm-c-kill-ring-action 'helm-kill-ring-action) -(make-obsolete 'helm-c-kill-ring-action 'helm-kill-ring-action "1.5.1") -(defalias 'helm-c-org-keywords-candidates 'helm-org-keywords-candidates) -(make-obsolete 'helm-c-org-keywords-candidates 'helm-org-keywords-candidates "1.5.1") -(defalias 'helm-c-bookmark-jump 'helm-bookmark-jump) -(make-obsolete 'helm-c-bookmark-jump 'helm-bookmark-jump "1.5.1") -(defalias 'helm-c-shadow-boring-buffers 'helm-shadow-boring-buffers) -(make-obsolete 'helm-c-shadow-boring-buffers 'helm-shadow-boring-buffers "1.5.1") -(defalias 'helm-c-buffer-match-major-mode 'helm-buffer-match-major-mode) -(make-obsolete 'helm-c-buffer-match-major-mode 'helm-buffer-match-major-mode "1.5.1") -(defalias 'helm-c-highlight-bookmark-su 'helm-highlight-bookmark-su) -(make-obsolete 'helm-c-highlight-bookmark-su 'helm-highlight-bookmark-su "1.5.1") -(defalias 'helm-c-grep-other-frame 'helm-grep-other-frame) -(make-obsolete 'helm-c-grep-other-frame 'helm-grep-other-frame "1.5.1") -(defalias 'helm-c-jabber-online-contacts 'helm-jabber-online-contacts) -(make-obsolete 'helm-c-jabber-online-contacts 'helm-jabber-online-contacts "1.5.1") -(defalias 'helm-c-apt-purge 'helm-apt-purge) -(make-obsolete 'helm-c-apt-purge 'helm-apt-purge "1.5.1") -(defalias 'helm-c-adaptative-sort 'helm-adaptive-sort) -(make-obsolete 'helm-c-adaptative-sort 'helm-adaptive-sort "1.5.1") -(defalias 'helm-c-bmkext-addressbook-setup-alist 'helm-bmkext-addressbook-setup-alist) -(make-obsolete 'helm-c-bmkext-addressbook-setup-alist 'helm-bmkext-addressbook-setup-alist "1.5.1") -(defalias 'helm-c-bmkext-filter-setup-alist 'helm-bmkext-filter-setup-alist) -(make-obsolete 'helm-c-bmkext-filter-setup-alist 'helm-bmkext-filter-setup-alist "1.5.1") -(defalias 'helm-c-grep-buffers 'helm-grep-buffers) -(make-obsolete 'helm-c-grep-buffers 'helm-grep-buffers "1.5.1") -(defalias 'helm-c-apt-init 'helm-apt-init) -(make-obsolete 'helm-c-apt-init 'helm-apt-init "1.5.1") -(defalias 'helm-c-grep-run-save-buffer 'helm-grep-run-save-buffer) -(make-obsolete 'helm-c-grep-run-save-buffer 'helm-grep-run-save-buffer "1.5.1") -(defalias 'helm-c-ggs-set-number-result 'helm-ggs-set-number-result) -(make-obsolete 'helm-c-ggs-set-number-result 'helm-ggs-set-number-result "1.5.1") -(defalias 'helm-c-grep-prepare-candidates 'helm-grep-prepare-candidates) -(make-obsolete 'helm-c-grep-prepare-candidates 'helm-grep-prepare-candidates "1.5.1") -(defalias 'helm-c-grep-jump-elscreen 'helm-grep-jump-elscreen) -(make-obsolete 'helm-c-grep-jump-elscreen 'helm-grep-jump-elscreen "1.5.1") -(defalias 'helm-c-show-completion-display-function 'helm-show-completion-display-function) -(make-obsolete 'helm-c-show-completion-display-function 'helm-show-completion-display-function "1.5.1") -(defalias 'helm-c-find-variable 'helm-find-variable) -(make-obsolete 'helm-c-find-variable 'helm-find-variable "1.5.1") -(defalias 'helm-c-build-elvi-list 'helm-build-elvi-list) -(make-obsolete 'helm-c-build-elvi-list 'helm-build-elvi-list "1.5.1") -(defalias 'helm-c-advice-toggle 'helm-advice-toggle) -(make-obsolete 'helm-c-advice-toggle 'helm-advice-toggle "1.5.1") -(defalias 'helm-c-buffers-persistent-kill 'helm-buffers-persistent-kill) -(make-obsolete 'helm-c-buffers-persistent-kill 'helm-buffers-persistent-kill "1.5.1") -(defalias 'helm-c-register-action-transformer 'helm-register-action-transformer) -(make-obsolete 'helm-c-register-action-transformer 'helm-register-action-transformer "1.5.1") -(defalias 'helm-c-kill-ring-candidates 'helm-kill-ring-candidates) -(make-obsolete 'helm-c-kill-ring-candidates 'helm-kill-ring-candidates "1.5.1") -(defalias 'helm-c-generic-browser 'helm-generic-browser) -(make-obsolete 'helm-c-generic-browser 'helm-generic-browser "1.5.1") -(defalias 'helm-c-top-init 'helm-top-init) -(make-obsolete 'helm-c-top-init 'helm-top-init "1.5.1") -(defalias 'helm-c-ucs-delete-backward 'helm-ucs-delete-backward) -(make-obsolete 'helm-c-ucs-delete-backward 'helm-ucs-delete-backward "1.5.1") -(defalias 'helm-c-apt-generic-action 'helm-apt-generic-action) -(make-obsolete 'helm-c-apt-generic-action 'helm-apt-generic-action "1.5.1") -(defalias 'helm-c-pdfgrep-action-1 'helm-pdfgrep-action-1) -(make-obsolete 'helm-c-pdfgrep-action-1 'helm-pdfgrep-action-1 "1.5.1") -(defalias 'helm-c-buffer-query-replace-regexp 'helm-buffer-query-replace-regexp) -(make-obsolete 'helm-c-buffer-query-replace-regexp 'helm-buffer-query-replace-regexp "1.5.1") -(defalias 'helm-c-apropos-init 'helm-apropos-init) -(make-obsolete 'helm-c-apropos-init 'helm-apropos-init "1.5.1") -(defalias 'helm-c-kill-new 'helm-kill-new) -(make-obsolete 'helm-c-kill-new 'helm-kill-new "1.5.1") -(defalias 'helm-c-bookmark-gnus-setup-alist 'helm-bookmark-gnus-setup-alist) -(make-obsolete 'helm-c-bookmark-gnus-setup-alist 'helm-bookmark-gnus-setup-alist "1.5.1") -(defalias 'helm-c-quit-and-execute-action 'helm-quit-and-execute-action) -(make-obsolete 'helm-c-quit-and-execute-action 'helm-quit-and-execute-action "1.5.1") -(defalias 'helm-c-build-info-index-command 'helm-build-info-index-command) -(make-obsolete 'helm-c-build-info-index-command 'helm-build-info-index-command "1.5.1") -(defalias 'helm-c-ratpoison-commands-init 'helm-ratpoison-commands-init) -(make-obsolete 'helm-c-ratpoison-commands-init 'helm-ratpoison-commands-init "1.5.1") -(defalias 'helm-c-etags-select 'helm-etags-select) -(make-obsolete 'helm-c-etags-select 'helm-etags-select "1.5.1") -(defalias 'helm-c-etags-create-buffer 'helm-etags-create-buffer) -(make-obsolete 'helm-c-etags-create-buffer 'helm-etags-create-buffer "1.5.1") -(defalias 'helm-c-yahoo-suggest-set-candidates 'helm-yahoo-suggest-set-candidates) -(make-obsolete 'helm-c-yahoo-suggest-set-candidates 'helm-yahoo-suggest-set-candidates "1.5.1") -(defalias 'helm-c-org-keywords-show-help 'helm-org-keywords-show-help) -(make-obsolete 'helm-c-org-keywords-show-help 'helm-org-keywords-show-help "1.5.1") -(defalias 'helm-c-highlight-files 'helm-highlight-files) -(make-obsolete 'helm-c-highlight-files 'helm-highlight-files "1.5.1") -(defalias 'helm-c-get-pid-from-process-name 'helm-get-pid-from-process-name) -(make-obsolete 'helm-c-get-pid-from-process-name 'helm-get-pid-from-process-name "1.5.1") -(defalias 'helm-c-insert-latex-math 'helm-insert-latex-math) -(make-obsolete 'helm-c-insert-latex-math 'helm-insert-latex-math "1.5.1") -(defalias 'helm-c-buffer-query-replace 'helm-buffer-query-replace) -(make-obsolete 'helm-c-buffer-query-replace 'helm-buffer-query-replace "1.5.1") -(defalias 'helm-c-bmkext-run-edit 'helm-bmkext-run-edit) -(make-obsolete 'helm-c-bmkext-run-edit 'helm-bmkext-run-edit "1.5.1") -(defalias 'helm-c-skip-boring-files 'helm-skip-boring-files) -(make-obsolete 'helm-c-skip-boring-files 'helm-skip-boring-files "1.5.1") -(defalias 'helm-c-transform-file-load-el 'helm-transform-file-load-el) -(make-obsolete 'helm-c-transform-file-load-el 'helm-transform-file-load-el "1.5.1") -(defalias 'helm-c-ucs-insert-char 'helm-ucs-insert-char) -(make-obsolete 'helm-c-ucs-insert-char 'helm-ucs-insert-char "1.5.1") -(defalias 'helm-c-buffer-help 'helm-buffer-help) -(make-obsolete 'helm-c-buffer-help 'helm-buffer-help "1.5.1") -(defalias 'helm-c-current-directory 'helm-current-directory) -(make-obsolete 'helm-c-current-directory 'helm-current-directory "1.5.1") -(defalias 'helm-c-find-file-or-marked 'helm-find-file-or-marked) -(make-obsolete 'helm-c-find-file-or-marked 'helm-find-file-or-marked "1.5.1") -(defalias 'helm-c-query-replace-regexp 'helm-query-replace-regexp) -(make-obsolete 'helm-c-query-replace-regexp 'helm-query-replace-regexp "1.5.1") -(defalias 'helm-c-describe-variable 'helm-describe-variable) -(make-obsolete 'helm-c-describe-variable 'helm-describe-variable "1.5.1") -(defalias 'helm-c-advice-persistent-action 'helm-advice-persistent-action) -(make-obsolete 'helm-c-advice-persistent-action 'helm-advice-persistent-action "1.5.1") -(defalias 'helm-c-show-completion 'helm-show-completion) -(make-obsolete 'helm-c-show-completion 'helm-show-completion "1.5.1") -(defalias 'helm-c-google-suggest-set-candidates 'helm-google-suggest-set-candidates) -(make-obsolete 'helm-c-google-suggest-set-candidates 'helm-google-suggest-set-candidates "1.5.1") -(defalias 'helm-c-grep-persistent-action 'helm-grep-persistent-action) -(make-obsolete 'helm-c-grep-persistent-action 'helm-grep-persistent-action "1.5.1") -(defalias 'helm-c-open-file-with-default-tool 'helm-open-file-with-default-tool) -(make-obsolete 'helm-c-open-file-with-default-tool 'helm-open-file-with-default-tool "1.5.1") -(defalias 'helm-c-run-external-command 'helm-run-external-command) -(make-obsolete 'helm-c-run-external-command 'helm-run-external-command "1.5.1") -(defalias 'helm-c-bookmark-images-setup-alist 'helm-bookmark-images-setup-alist) -(make-obsolete 'helm-c-bookmark-images-setup-alist 'helm-bookmark-images-setup-alist "1.5.1") -(defalias 'helm-c-apt-candidate-transformer 'helm-apt-candidate-transformer) -(make-obsolete 'helm-c-apt-candidate-transformer 'helm-apt-candidate-transformer "1.5.1") -(defalias 'helm-c-grep-run-persistent-action 'helm-grep-run-persistent-action) -(make-obsolete 'helm-c-grep-run-persistent-action 'helm-grep-run-persistent-action "1.5.1") -(defalias 'helm-c-highlight-buffers 'helm-highlight-buffers) -(make-obsolete 'helm-c-highlight-buffers 'helm-highlight-buffers "1.5.1") -(defalias 'helm-c-man-default-action 'helm-man-default-action) -(make-obsolete 'helm-c-man-default-action 'helm-man-default-action "1.5.1") -(defalias 'helm-c-advice-candidates 'helm-advice-candidates) -(make-obsolete 'helm-c-advice-candidates 'helm-advice-candidates "1.5.1") -(defalias 'helm-c-stumpwm-commands-execute 'helm-stumpwm-commands-execute) -(make-obsolete 'helm-c-stumpwm-commands-execute 'helm-stumpwm-commands-execute "1.5.1") -(defalias 'helm-c-ucs-help 'helm-ucs-help) -(make-obsolete 'helm-c-ucs-help 'helm-ucs-help "1.5.1") -(defalias 'helm-c-apt-uninstall 'helm-apt-uninstall) -(make-obsolete 'helm-c-apt-uninstall 'helm-apt-uninstall "1.5.1") -(defalias 'helm-c-bookmark-run-jump-other-window 'helm-bookmark-run-jump-other-window) -(make-obsolete 'helm-c-bookmark-run-jump-other-window 'helm-bookmark-run-jump-other-window "1.5.1") -(defalias 'helm-c-elisp-library-scan-list 'helm-elisp-library-scan-list) -(make-obsolete 'helm-c-elisp-library-scan-list 'helm-elisp-library-scan-list "1.5.1") -(defalias 'helm-c-bookmark-man-setup-alist 'helm-bookmark-man-setup-alist) -(make-obsolete 'helm-c-bookmark-man-setup-alist 'helm-bookmark-man-setup-alist "1.5.1") -(defalias 'helm-c-etags-find-tag-file-directory 'helm-etags-find-tag-file-directory) -(make-obsolete 'helm-c-etags-find-tag-file-directory 'helm-etags-find-tag-file-directory "1.5.1") -(defalias 'helm-c-xrandr-info 'helm-xrandr-info) -(make-obsolete 'helm-c-xrandr-info 'helm-xrandr-info "1.5.1") -(defalias 'helm-c-stringify 'helm-stringify) -(make-obsolete 'helm-c-stringify 'helm-stringify "1.5.1") -(defalias 'helm-c-goto-precedent-file 'helm-goto-precedent-file) -(make-obsolete 'helm-c-goto-precedent-file 'helm-goto-precedent-file "1.5.1") -(defalias 'helm-c-apt-cache-show 'helm-apt-cache-show) -(make-obsolete 'helm-c-apt-cache-show 'helm-apt-cache-show "1.5.1") -(defalias 'helm-c-etags-file-modified-p 'helm-etags-file-modified-p) -(make-obsolete 'helm-c-etags-file-modified-p 'helm-etags-file-modified-p "1.5.1") -(defalias 'helm-c-etags-get-tag-file 'helm-etags-get-tag-file) -(make-obsolete 'helm-c-etags-get-tag-file 'helm-etags-get-tag-file "1.5.1") -(defalias 'helm-c-highlight-not-logged 'helm-highlight-not-logged) -(make-obsolete 'helm-c-highlight-not-logged 'helm-highlight-not-logged "1.5.1") -(defalias 'helm-c-pdfgrep-action 'helm-pdfgrep-action) -(make-obsolete 'helm-c-pdfgrep-action 'helm-pdfgrep-action "1.5.1") -(defalias 'helm-c-adaptative-save-history 'helm-adaptive-save-history) -(make-obsolete 'helm-c-adaptative-save-history 'helm-adaptive-save-history "1.5.1") -(defalias 'helm-c-get-first-line-documentation 'helm-get-first-line-documentation) -(make-obsolete 'helm-c-get-first-line-documentation 'helm-get-first-line-documentation "1.5.1") -(defalias 'helm-approximate-candidate-number 'helm-get-candidate-number) -(make-obsolete 'helm-approximate-candidate-number 'helm-get-candidate-number "1.5.5") -(defalias 'helm-org-headlines 'helm-org-in-buffer-headings) -(make-obsolete 'helm-org-headlines 'helm-org-in-buffer-headings "1.6.5") - - -;;; variables -;; -;; - - -(defvaralias 'helm-c-pdfgrep-default-command 'helm-pdfgrep-default-command) -(make-obsolete-variable 'helm-c-pdfgrep-default-command 'helm-pdfgrep-default-command "1.5.1") -(defvaralias 'helm-c-source-time-world 'helm-source-time-world) -(make-obsolete-variable 'helm-c-source-time-world 'helm-source-time-world "1.5.1") -(defvaralias 'helm-c-grep-default-command 'helm-grep-default-command) -(make-obsolete-variable 'helm-c-grep-default-command 'helm-grep-default-command "1.5.1") -(defvaralias 'helm-c-default-info-index-list 'helm-default-info-index-list) -(make-obsolete-variable 'helm-c-default-info-index-list 'helm-default-info-index-list "1.5.1") -(defvaralias 'helm-c-etags-tag-file-dir 'helm-etags-tag-file-dir) -(make-obsolete-variable 'helm-c-etags-tag-file-dir 'helm-etags-tag-file-dir "1.5.1") -(defvaralias 'helm-c-source-man-pages 'helm-source-man-pages) -(make-obsolete-variable 'helm-c-source-man-pages 'helm-source-man-pages "1.5.1") -(defvaralias 'helm-c-source-bookmark-info 'helm-source-bookmark-info) -(make-obsolete-variable 'helm-c-source-bookmark-info 'helm-source-bookmark-info "1.5.1") -(defvaralias 'helm-c-file-cache-files 'helm-file-cache-files) -(make-obsolete-variable 'helm-c-file-cache-files 'helm-file-cache-files "1.5.1") -(defvaralias 'helm-c-ucs-map 'helm-ucs-map) -(make-obsolete-variable 'helm-c-ucs-map 'helm-ucs-map "1.5.1") -(defvaralias 'helm-c-show-completion-min-window-height 'helm-show-completion-min-window-height) -(make-obsolete-variable 'helm-c-show-completion-min-window-height 'helm-show-completion-min-window-height "1.5.1") -(defvaralias 'helm-c-adaptative-history 'helm-adaptive-history) -(make-obsolete-variable 'helm-c-adaptative-history 'helm-adaptive-history "1.5.1") -(defvaralias 'helm-c-source-bookmarks-local 'helm-source-bookmarks-local) -(make-obsolete-variable 'helm-c-source-bookmarks-local 'helm-source-bookmarks-local "1.5.1") -(defvaralias 'helm-c-grep-map 'helm-grep-map) -(make-obsolete-variable 'helm-c-grep-map 'helm-grep-map "1.5.1") -(defvaralias 'helm-c-source-session 'helm-source-session) -(make-obsolete-variable 'helm-c-source-session 'helm-source-session "1.5.1") -(defvaralias 'helm-c-source-minibuffer-history 'helm-source-minibuffer-history) -(make-obsolete-variable 'helm-c-source-minibuffer-history 'helm-source-minibuffer-history "1.5.1") -(defvaralias 'helm-c-source-files-in-current-dir 'helm-source-files-in-current-dir) -(make-obsolete-variable 'helm-c-source-files-in-current-dir 'helm-source-files-in-current-dir "1.5.1") -(defvaralias 'helm-c-source-etags-select 'helm-source-etags-select) -(make-obsolete-variable 'helm-c-source-etags-select 'helm-source-etags-select "1.5.1") -(defvaralias 'helm-c-show-completion-overlay 'helm-show-completion-overlay) -(make-obsolete-variable 'helm-c-show-completion-overlay 'helm-show-completion-overlay "1.5.1") -(defvaralias 'helm-c-buffer-help-message 'helm-buffer-help-message) -(make-obsolete-variable 'helm-c-buffer-help-message 'helm-buffer-help-message "1.5.1") -(defvaralias 'helm-c-ucs-max-len 'helm-ucs-max-len) -(make-obsolete-variable 'helm-c-ucs-max-len 'helm-ucs-max-len "1.5.1") -(defvaralias 'helm-c-imenu-index-filter 'helm-imenu-index-filter) -(make-obsolete-variable 'helm-c-imenu-index-filter 'helm-imenu-index-filter "1.5.1") -(defvaralias 'helm-c-org-keywords-info-location 'helm-org-keywords-info-location) -(make-obsolete-variable 'helm-c-org-keywords-info-location 'helm-org-keywords-info-location "1.5.1") -(defvaralias 'helm-c-kill-ring-max-lines-number 'helm-kill-ring-max-lines-number) -(make-obsolete-variable 'helm-c-kill-ring-max-lines-number 'helm-kill-ring-max-lines-number "1.5.1") -(defvaralias 'helm-c-source-apt 'helm-source-apt) -(make-obsolete-variable 'helm-c-source-apt 'helm-source-apt "1.5.1") -(defvaralias 'helm-c-bookmark-map 'helm-bookmark-map) -(make-obsolete-variable 'helm-c-bookmark-map 'helm-bookmark-map "1.5.1") -(defvaralias 'helm-c-source-xfonts 'helm-source-xfonts) -(make-obsolete-variable 'helm-c-source-xfonts 'helm-source-xfonts "1.5.1") -(defvaralias 'helm-c-source-kill-ring 'helm-source-kill-ring) -(make-obsolete-variable 'helm-c-source-kill-ring 'helm-source-kill-ring "1.5.1") -(defvaralias 'helm-c-home-url 'helm-home-url) -(make-obsolete-variable 'helm-c-home-url 'helm-home-url "1.5.1") -(defvaralias 'helm-c-etags-cache 'helm-etags-cache) -(make-obsolete-variable 'helm-c-etags-cache 'helm-etags-cache "1.5.1") -(defvaralias 'helm-c-source-latex-math 'helm-source-latex-math) -(make-obsolete-variable 'helm-c-source-latex-math 'helm-source-latex-math "1.5.1") -(defvaralias 'helm-c-source-bookmark-files&dirs 'helm-source-bookmark-files&dirs) -(make-obsolete-variable 'helm-c-source-bookmark-files&dirs 'helm-source-bookmark-files&dirs "1.5.1") -(defvaralias 'helm-c-source-ratpoison-commands 'helm-source-ratpoison-commands) -(make-obsolete-variable 'helm-c-source-ratpoison-commands 'helm-source-ratpoison-commands "1.5.1") -(defvaralias 'helm-c-apt-show-command 'helm-apt-show-command) -(make-obsolete-variable 'helm-c-apt-show-command 'helm-apt-show-command "1.5.1") -(defvaralias 'helm-c-pdfgrep-default-function 'helm-pdfgrep-default-function) -(make-obsolete-variable 'helm-c-pdfgrep-default-function 'helm-pdfgrep-default-function "1.5.1") -(defvaralias 'helm-c-source-register 'helm-source-register) -(make-obsolete-variable 'helm-c-source-register 'helm-source-register "1.5.1") -(defvaralias 'helm-c-boring-buffer-regexp-list 'helm-boring-buffer-regexp-list) -(make-obsolete-variable 'helm-c-boring-buffer-regexp-list 'helm-boring-buffer-regexp-list "1.5.1") -(defvaralias 'helm-c-source-locate 'helm-source-locate) -(make-obsolete-variable 'helm-c-source-locate 'helm-source-locate "1.5.1") -(defvaralias 'helm-c-source-advice 'helm-source-advice) -(make-obsolete-variable 'helm-c-source-advice 'helm-source-advice "1.5.1") -(defvaralias 'helm-c-source-yaoddmuse-emacswiki-edit-or-view 'helm-source-yaoddmuse-emacswiki-edit-or-view) -(defvaralias 'helm-c-ucs-mode-line-string 'helm-ucs-mode-line-string) -(make-obsolete-variable 'helm-c-ucs-mode-line-string 'helm-ucs-mode-line-string "1.5.1") -(defvaralias 'helm-c-xfonts-cache 'helm-xfonts-cache) -(make-obsolete-variable 'helm-c-xfonts-cache 'helm-xfonts-cache "1.5.1") -(defvaralias 'helm-c-source-yahoo-suggest 'helm-source-yahoo-suggest) -(make-obsolete-variable 'helm-c-source-yahoo-suggest 'helm-source-yahoo-suggest "1.5.1") -(defvaralias 'helm-c-rzgrep-cache 'helm-rzgrep-cache) -(make-obsolete-variable 'helm-c-rzgrep-cache 'helm-rzgrep-cache "1.5.1") -(defvaralias 'helm-c-source-org-keywords 'helm-source-org-keywords) -(make-obsolete-variable 'helm-c-source-org-keywords 'helm-source-org-keywords "1.5.1") -(defvaralias 'helm-c-pdfgrep-map 'helm-pdfgrep-map) -(make-obsolete-variable 'helm-c-pdfgrep-map 'helm-pdfgrep-map "1.5.1") -(defvaralias 'helm-c-source-lacarte 'helm-source-lacarte) -(make-obsolete-variable 'helm-c-source-lacarte 'helm-source-lacarte "1.5.1") -(defvaralias 'helm-c-apt-search-command 'helm-apt-search-command) -(make-obsolete-variable 'helm-c-apt-search-command 'helm-apt-search-command "1.5.1") -(defvaralias 'helm-c-default-external-file-browser 'helm-default-external-file-browser) -(make-obsolete-variable 'helm-c-default-external-file-browser 'helm-default-external-file-browser "1.5.1") -(defvaralias 'helm-c-source-evaluation-result 'helm-source-evaluation-result) -(make-obsolete-variable 'helm-c-source-evaluation-result 'helm-source-evaluation-result "1.5.1") -(defvaralias 'helm-c-yahoo-suggest-search-url 'helm-yahoo-suggest-search-url) -(make-obsolete-variable 'helm-c-yahoo-suggest-search-url 'helm-yahoo-suggest-search-url "1.5.1") -(defvaralias 'helm-c-source-occur 'helm-source-occur) -(make-obsolete-variable 'helm-c-source-occur 'helm-source-occur "1.5.1") -(defvaralias 'helm-c-source-calculation-result 'helm-source-calculation-result) -(make-obsolete-variable 'helm-c-source-calculation-result 'helm-source-calculation-result "1.5.1") -(defvaralias 'helm-c-default-zgrep-command 'helm-default-zgrep-command) -(make-obsolete-variable 'helm-c-default-zgrep-command 'helm-default-zgrep-command "1.5.1") -(defvaralias 'helm-c-show-info-in-mode-line-delay 'helm-show-info-in-mode-line-delay) -(make-obsolete-variable 'helm-c-show-info-in-mode-line-delay 'helm-show-info-in-mode-line-delay "1.5.1") -(defvaralias 'helm-c-source-ido-virtual-buffers 'helm-source-ido-virtual-buffers) -(make-obsolete-variable 'helm-c-source-ido-virtual-buffers 'helm-source-ido-virtual-buffers "1.5.1") -(defvaralias 'helm-c-source-top 'helm-source-top) -(make-obsolete-variable 'helm-c-source-top 'helm-source-top "1.5.1") -(defvaralias 'helm-c-source-colors 'helm-source-colors) -(make-obsolete-variable 'helm-c-source-colors 'helm-source-colors "1.5.1") -(defvaralias 'helm-c-read-file-map 'helm-read-file-map) -(make-obsolete-variable 'helm-c-read-file-map 'helm-read-file-map "1.5.1") -(defvaralias 'helm-c-source-file-cache 'helm-source-file-cache) -(make-obsolete-variable 'helm-c-source-file-cache 'helm-source-file-cache "1.5.1") -(defvaralias 'helm-c-google-suggest-default-browser-function 'helm-google-suggest-default-browser-function) -(make-obsolete-variable 'helm-c-google-suggest-default-browser-function 'helm-google-suggest-default-browser-function "1.5.1") -(defvaralias 'helm-c-external-programs-associations 'helm-external-programs-associations) -(make-obsolete-variable 'helm-c-external-programs-associations 'helm-external-programs-associations "1.5.1") -(defvaralias 'helm-c-source-complex-command-history 'helm-source-complex-command-history) -(make-obsolete-variable 'helm-c-source-complex-command-history 'helm-source-complex-command-history "1.5.1") -(defvaralias 'helm-c-cached-imenu-candidates 'helm-cached-imenu-candidates) -(make-obsolete-variable 'helm-c-cached-imenu-candidates 'helm-cached-imenu-candidates "1.5.1") -(defvaralias 'helm-c-external-commands-list 'helm-external-commands-list) -(make-obsolete-variable 'helm-c-external-commands-list 'helm-external-commands-list "1.5.1") -(defvaralias 'helm-c-source-ucs 'helm-source-ucs) -(make-obsolete-variable 'helm-c-source-ucs 'helm-source-ucs "1.5.1") -(defvaralias 'helm-c-adaptative-history-length 'helm-adaptive-history-length) -(make-obsolete-variable 'helm-c-adaptative-history-length 'helm-adaptive-history-length "1.5.1") -(defvaralias 'helm-c-source-customize-face 'helm-source-customize-face) -(make-obsolete-variable 'helm-c-source-customize-face 'helm-source-customize-face "1.5.1") -(defvaralias 'helm-c-source-bookmarks-ssh 'helm-source-bookmarks-ssh) -(make-obsolete-variable 'helm-c-source-bookmarks-ssh 'helm-source-bookmarks-ssh "1.5.1") -(defvaralias 'helm-c-eldoc-in-minibuffer-show-fn 'helm-eldoc-in-minibuffer-show-fn) -(make-obsolete-variable 'helm-c-eldoc-in-minibuffer-show-fn 'helm-eldoc-in-minibuffer-show-fn "1.5.1") -(defvaralias 'helm-c-google-suggest-search-url 'helm-google-suggest-search-url) -(make-obsolete-variable 'helm-c-google-suggest-search-url 'helm-google-suggest-search-url "1.5.1") -(defvaralias 'helm-c-source-bmkext-addressbook 'helm-source-bmkext-addressbook) -(make-obsolete-variable 'helm-c-source-bmkext-addressbook 'helm-source-bmkext-addressbook "1.5.1") -(defvaralias 'helm-c-source-ctags 'helm-source-ctags) -(make-obsolete-variable 'helm-c-source-ctags 'helm-source-ctags "1.5.1") -(defvaralias 'helm-c-apt-installed-packages 'helm-apt-installed-packages) -(make-obsolete-variable 'helm-c-apt-installed-packages 'helm-apt-installed-packages "1.5.1") -(defvaralias 'helm-c-apt-all-packages 'helm-apt-all-packages) -(make-obsolete-variable 'helm-c-apt-all-packages 'helm-apt-all-packages "1.5.1") -(defvaralias 'helm-c-find-files-doc-header 'helm-find-files-doc-header) -(make-obsolete-variable 'helm-c-find-files-doc-header 'helm-find-files-doc-header "1.5.1") -(defvaralias 'helm-c-source-imenu 'helm-source-imenu) -(make-obsolete-variable 'helm-c-source-imenu 'helm-source-imenu "1.5.1") -(defvaralias 'helm-c-grep-default-function 'helm-grep-default-function) -(make-obsolete-variable 'helm-c-grep-default-function 'helm-grep-default-function "1.5.1") -(defvaralias 'helm-c-top-command 'helm-top-command) -(make-obsolete-variable 'helm-c-top-command 'helm-top-command "1.5.1") -(defvaralias 'helm-c-source-bookmark-man 'helm-source-bookmark-man) -(make-obsolete-variable 'helm-c-source-bookmark-man 'helm-source-bookmark-man "1.5.1") -(defvaralias 'helm-c-source-stumpwm-commands 'helm-source-stumpwm-commands) -(make-obsolete-variable 'helm-c-source-stumpwm-commands 'helm-source-stumpwm-commands "1.5.1") -(defvaralias 'helm-c-source-idle-time-timers 'helm-source-idle-time-timers) -(make-obsolete-variable 'helm-c-source-idle-time-timers 'helm-source-idle-time-timers "1.5.1") -(defvaralias 'helm-c-turn-on-show-completion 'helm-turn-on-show-completion) -(make-obsolete-variable 'helm-c-turn-on-show-completion 'helm-turn-on-show-completion "1.5.1") -(defvaralias 'helm-c-esh-help-message 'helm-esh-help-message) -(make-obsolete-variable 'helm-c-esh-help-message 'helm-esh-help-message "1.5.1") -(defvaralias 'helm-c-register-max-offset 'helm-register-max-offset) -(make-obsolete-variable 'helm-c-register-max-offset 'helm-register-max-offset "1.5.1") -(defvaralias 'helm-c-source-bookmark-set 'helm-source-bookmark-set) -(make-obsolete-variable 'helm-c-source-bookmark-set 'helm-source-bookmark-set "1.5.1") -(defvaralias 'helm-c-source-file-name-history 'helm-source-file-name-history) -(make-obsolete-variable 'helm-c-source-file-name-history 'helm-source-file-name-history "1.5.1") -(defvaralias 'helm-c-file-cache-initialized-p 'helm-file-cache-initialized-p) -(make-obsolete-variable 'helm-c-file-cache-initialized-p 'helm-file-cache-initialized-p "1.5.1") -(defvaralias 'helm-c-grep-max-length-history 'helm-grep-max-length-history) -(make-obsolete-variable 'helm-c-grep-max-length-history 'helm-grep-max-length-history "1.5.1") -(defvaralias 'helm-c-source-jabber-contacts 'helm-source-jabber-contacts) -(make-obsolete-variable 'helm-c-source-jabber-contacts 'helm-source-jabber-contacts "1.5.1") -(defvaralias 'helm-c-grep-use-ioccur-style-keys 'helm-grep-use-ioccur-style-keys) -(make-obsolete-variable 'helm-c-grep-use-ioccur-style-keys 'helm-grep-use-ioccur-style-keys "1.5.1") -(defvaralias 'helm-c-ctags-modes 'helm-ctags-modes) -(make-obsolete-variable 'helm-c-ctags-modes 'helm-ctags-modes "1.5.1") -(defvaralias 'helm-c-source-moccur 'helm-source-moccur) -(make-obsolete-variable 'helm-c-source-moccur 'helm-source-moccur "1.5.1") -(defvaralias 'helm-c-locate-command 'helm-locate-command) -(make-obsolete-variable 'helm-c-locate-command 'helm-locate-command "1.5.1") -(defvaralias 'helm-c-etags-tag-file-name 'helm-etags-tag-file-name) -(make-obsolete-variable 'helm-c-etags-tag-file-name 'helm-etags-tag-file-name "1.5.1") -(defvaralias 'helm-c-source-bookmarks-su 'helm-source-bookmarks-su) -(make-obsolete-variable 'helm-c-source-bookmarks-su 'helm-source-bookmarks-su "1.5.1") -(defvaralias 'helm-c-buffer-map 'helm-buffer-map) -(make-obsolete-variable 'helm-c-buffer-map 'helm-buffer-map "1.5.1") -(defvaralias 'helm-c-source-files-in-all-dired 'helm-source-files-in-all-dired) -(make-obsolete-variable 'helm-c-source-files-in-all-dired 'helm-source-files-in-all-dired "1.5.1") -(defvaralias 'helm-c-source-eshell-history 'helm-source-eshell-history) -(make-obsolete-variable 'helm-c-source-eshell-history 'helm-source-eshell-history "1.5.1") -(defvaralias 'helm-c-source-absolute-time-timers 'helm-source-absolute-time-timers) -(make-obsolete-variable 'helm-c-source-absolute-time-timers 'helm-source-absolute-time-timers "1.5.1") -(defvaralias 'helm-c-source-findutils 'helm-source-findutils) -(make-obsolete-variable 'helm-c-source-findutils 'helm-source-findutils "1.5.1") -(defvaralias 'helm-c-ucs-help-message 'helm-ucs-help-message) -(make-obsolete-variable 'helm-c-ucs-help-message 'helm-ucs-help-message "1.5.1") -(defvaralias 'helm-c-source-find-files 'helm-source-find-files) -(make-obsolete-variable 'helm-c-source-find-files 'helm-source-find-files "1.5.1") -(defvaralias 'helm-c-source-recentf 'helm-source-recentf) -(make-obsolete-variable 'helm-c-source-recentf 'helm-source-recentf "1.5.1") -(defvaralias 'helm-c-cache-world 'helm-cache-world) -(make-obsolete-variable 'helm-c-cache-world 'helm-cache-world "1.5.1") -(defvaralias 'helm-c-source-picklist 'helm-source-picklist) -(make-obsolete-variable 'helm-c-source-picklist 'helm-source-picklist "1.5.1") -(defvaralias 'helm-c-source-buffer-not-found 'helm-source-buffer-not-found) -(make-obsolete-variable 'helm-c-source-buffer-not-found 'helm-source-buffer-not-found "1.5.1") -(defvaralias 'helm-c-source-xrandr-change-resolution 'helm-source-xrandr-change-resolution) -(make-obsolete-variable 'helm-c-source-xrandr-change-resolution 'helm-source-xrandr-change-resolution "1.5.1") -(defvaralias 'helm-c-google-suggest-url 'helm-google-suggest-url) -(make-obsolete-variable 'helm-c-google-suggest-url 'helm-google-suggest-url "1.5.1") -(defvaralias 'helm-c-source-semantic 'helm-source-semantic) -(make-obsolete-variable 'helm-c-source-semantic 'helm-source-semantic "1.5.1") -(defvaralias 'helm-c-source-mark-ring 'helm-source-mark-ring) -(make-obsolete-variable 'helm-c-source-mark-ring 'helm-source-mark-ring "1.5.1") -(defvaralias 'helm-c-grep-preferred-ext 'helm-grep-preferred-ext) -(make-obsolete-variable 'helm-c-grep-preferred-ext 'helm-grep-preferred-ext "1.5.1") -(defvaralias 'helm-c-source-bookmarks 'helm-source-bookmarks) -(make-obsolete-variable 'helm-c-source-bookmarks 'helm-source-bookmarks "1.5.1") -(defvaralias 'helm-c-source-elisp-library-scan 'helm-source-elisp-library-scan) -(make-obsolete-variable 'helm-c-source-elisp-library-scan 'helm-source-elisp-library-scan "1.5.1") -(defvaralias 'helm-c-source-info-pages 'helm-source-info-pages) -(make-obsolete-variable 'helm-c-source-info-pages 'helm-source-info-pages "1.5.1") -(defvaralias 'helm-c-source-bookmark-gnus 'helm-source-bookmark-gnus) -(make-obsolete-variable 'helm-c-source-bookmark-gnus 'helm-source-bookmark-gnus "1.5.1") -(defvaralias 'helm-c-source-elscreen 'helm-source-elscreen) -(make-obsolete-variable 'helm-c-source-elscreen 'helm-source-elscreen "1.5.1") -(defvaralias 'helm-c-etags-mtime-alist 'helm-etags-mtime-alist) -(make-obsolete-variable 'helm-c-etags-mtime-alist 'helm-etags-mtime-alist "1.5.1") -(defvaralias 'helm-c-grep-default-recurse-command 'helm-grep-default-recurse-command) -(make-obsolete-variable 'helm-c-grep-default-recurse-command 'helm-grep-default-recurse-command "1.5.1") -(defvaralias 'helm-c-source-google-suggest 'helm-source-google-suggest) -(make-obsolete-variable 'helm-c-source-google-suggest 'helm-source-google-suggest "1.5.1") -(defvaralias 'helm-c-etags-tag-file-search-limit 'helm-etags-tag-file-search-limit) -(make-obsolete-variable 'helm-c-etags-tag-file-search-limit 'helm-etags-tag-file-search-limit "1.5.1") -(defvaralias 'helm-c-source-ff-file-name-history 'helm-source-ff-file-name-history) -(make-obsolete-variable 'helm-c-source-ff-file-name-history 'helm-source-ff-file-name-history "1.5.1") -(defvaralias 'helm-c-source-buffers-list 'helm-source-buffers-list) -(make-obsolete-variable 'helm-c-source-buffers-list 'helm-source-buffers-list "1.5.1") -(defvaralias 'helm-c-cached-imenu-alist 'helm-cached-imenu-alist) -(make-obsolete-variable 'helm-c-cached-imenu-alist 'helm-cached-imenu-alist "1.5.1") -(defvaralias 'helm-c-source-tracker-search 'helm-source-tracker-search) -(make-obsolete-variable 'helm-c-source-tracker-search 'helm-source-tracker-search "1.5.1") -(defvaralias 'helm-c-google-suggest-default-function 'helm-google-suggest-default-function) -(make-obsolete-variable 'helm-c-google-suggest-default-function 'helm-google-suggest-default-function "1.5.1") -(defvaralias 'helm-c-imenu-delimiter 'helm-imenu-delimiter) -(make-obsolete-variable 'helm-c-imenu-delimiter 'helm-imenu-delimiter "1.5.1") -(defvaralias 'helm-c-source-emacs-process 'helm-source-emacs-process) -(make-obsolete-variable 'helm-c-source-emacs-process 'helm-source-emacs-process "1.5.1") -(defvaralias 'helm-c-etags-map 'helm-etags-map) -(make-obsolete-variable 'helm-c-etags-map 'helm-etags-map "1.5.1") -(defvaralias 'helm-c-grep-history 'helm-grep-history) -(make-obsolete-variable 'helm-c-grep-history 'helm-grep-history "1.5.1") -(defvaralias 'helm-c-cached-imenu-tick 'helm-cached-imenu-tick) -(make-obsolete-variable 'helm-c-cached-imenu-tick 'helm-cached-imenu-tick "1.5.1") -(defvaralias 'helm-c-source-esh 'helm-source-esh) -(make-obsolete-variable 'helm-c-source-esh 'helm-source-esh "1.5.1") -(defvaralias 'helm-c-source-global-mark-ring 'helm-source-global-mark-ring) -(make-obsolete-variable 'helm-c-source-global-mark-ring 'helm-source-global-mark-ring "1.5.1") -(defvaralias 'helm-c-man-pages 'helm-man-pages) -(make-obsolete-variable 'helm-c-man-pages 'helm-man-pages "1.5.1") -(defvaralias 'helm-c-adaptative-done 'helm-adaptive-done) -(make-obsolete-variable 'helm-c-adaptative-done 'helm-adaptive-done "1.5.1") -(defvaralias 'helm-c-source-regexp 'helm-source-regexp) -(make-obsolete-variable 'helm-c-source-regexp 'helm-source-regexp "1.5.1") -(defvaralias 'helm-c-boring-file-regexp-list 'helm-boring-file-regexp-list) -(make-obsolete-variable 'helm-c-boring-file-regexp-list 'helm-boring-file-regexp-list "1.5.1") -(defvaralias 'helm-c-show-completion-use-special-display 'helm-show-completion-use-special-display) -(make-obsolete-variable 'helm-c-show-completion-use-special-display 'helm-show-completion-use-special-display "1.5.1") -(defvaralias 'helm-c-apt-query 'helm-apt-query) -(make-obsolete-variable 'helm-c-apt-query 'helm-apt-query "1.5.1") -(defvaralias 'helm-c-pdfgrep-default-read-command 'helm-pdfgrep-default-read-command) -(make-obsolete-variable 'helm-c-pdfgrep-default-read-command 'helm-pdfgrep-default-read-command "1.5.1") -(defvaralias 'helm-c-source-bookmark-images 'helm-source-bookmark-images) -(make-obsolete-variable 'helm-c-source-bookmark-images 'helm-source-bookmark-images "1.5.1") -(defvaralias 'helm-c-source-mac-spotlight 'helm-source-mac-spotlight) -(make-obsolete-variable 'helm-c-source-mac-spotlight 'helm-source-mac-spotlight "1.5.1") -(defvaralias 'helm-c-yahoo-suggest-url 'helm-yahoo-suggest-url) -(make-obsolete-variable 'helm-c-yahoo-suggest-url 'helm-yahoo-suggest-url "1.5.1") -(defvaralias 'helm-c-zgrep-recurse-flag 'helm-zgrep-recurse-flag) -(make-obsolete-variable 'helm-c-zgrep-recurse-flag 'helm-zgrep-recurse-flag "1.5.1") -(defvaralias 'helm-c-source-use-flags 'helm-source-use-flags) -(make-obsolete-variable 'helm-c-source-use-flags 'helm-source-use-flags "1.5.1") -(defvaralias 'helm-c-moccur-map 'helm-moccur-map) -(make-obsolete-variable 'helm-c-moccur-map 'helm-moccur-map "1.5.1") -(defvaralias 'helm-c-adaptative-history-file 'helm-adaptive-history-file) -(make-obsolete-variable 'helm-c-adaptative-history-file 'helm-adaptive-history-file "1.5.1") -(defvaralias 'helm-c-grep-default-directory-fn 'helm-grep-default-directory-fn) -(make-obsolete-variable 'helm-c-grep-default-directory-fn 'helm-grep-default-directory-fn "1.5.1") -(defvaralias 'helm-c-apt-input-history 'helm-apt-input-history) -(make-obsolete-variable 'helm-c-apt-input-history 'helm-apt-input-history "1.5.1") -(defvaralias 'helm-async-be-async 'dired-async-be-async) -(make-obsolete-variable 'helm-async-be-async 'dired-async-be-async "1.5.9") - - -(provide 'helm-aliases) - -;;; helm-aliases.el ends here diff --git a/elpa/helm-20150403.101/helm-apt.el b/elpa/helm-20150403.101/helm-apt.el deleted file mode 100644 index b667c5b3..00000000 --- a/elpa/helm-20150403.101/helm-apt.el +++ /dev/null @@ -1,292 +0,0 @@ -;;; helm-apt.el --- Helm interface for Debian/Ubuntu packages (apt-*) -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-utils) -(require 'helm-external) - -(declare-function term-line-mode "term") -(declare-function term-char-mode "term") -(declare-function term-send-input "term") -(declare-function term-send-eof "term") - - -(defgroup helm-apt nil - "Apt related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-apt-cache-show-function 'helm-apt-cache-show-1 - "Function of one argument used to show apt package. -Default is `helm-apt-cache-show-1' but you can use `apt-utils-show-package-1' -from `apt-utils.el' to have something more enhanced. -If nil default `helm-apt-cache-show-1' will be used." - :type 'function - :group 'helm-apt) - -(defface helm-apt-installed - '((t (:foreground "green"))) - "Face used for apt installed candidates." - :group 'helm-apt) - -(defface helm-apt-deinstalled - '((t (:foreground "DimGray"))) - "Face used for apt deinstalled candidates." - :group 'helm-apt) - - -(defvar helm-apt-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c ?") 'helm-apt-help) - (define-key map (kbd "M-I") 'helm-apt-show-only-installed) - (define-key map (kbd "M-U") 'helm-apt-show-only-not-installed) - (define-key map (kbd "M-D") 'helm-apt-show-only-deinstalled) - (define-key map (kbd "M-A") 'helm-apt-show-all) - map)) - - -(defvar helm-source-apt - `((name . "APT") - (init . helm-apt-init) - (candidates-in-buffer) - (candidate-transformer . helm-apt-candidate-transformer) - (display-to-real . helm-apt-display-to-real) - (update . helm-apt-refresh) - (keymap . ,helm-apt-map) - (mode-line . helm-apt-mode-line) - (action - ("Show package description" . helm-apt-cache-show) - ("Install package" . helm-apt-install) - ("Reinstall package" . helm-apt-reinstall) - ("Remove package" . helm-apt-uninstall) - ("Purge package" . helm-apt-purge)) - (persistent-action . helm-apt-persistent-action) - (persistent-help . "Show package description"))) - -;;; Internals vars -(defvar helm-apt-search-command "apt-cache search '%s'") -(defvar helm-apt-show-command "apt-cache show '%s'") -(defvar helm-apt-installed-packages nil) -(defvar helm-apt-all-packages nil) -(defvar helm-apt-input-history nil) -(defvar helm-apt-show-only 'all) -(defvar helm-apt-term-buffer nil) -(defvar helm-apt-default-archs nil) - -(defun helm-apt-refresh () - "Refresh installed candidates list." - (setq helm-apt-installed-packages nil) - (setq helm-apt-all-packages nil)) - -(defun helm-apt-persistent-action (candidate) - "Persistent action for APT source." - (helm-apt-cache-show candidate)) - -(defun helm-apt--installed-package-name (name) - (cl-loop for arch in helm-apt-default-archs - thereis (or (assoc-default - name helm-apt-installed-packages) - (assoc-default - (format "%s:%s" name arch) - helm-apt-installed-packages)))) - -(defun helm-apt-candidate-transformer (candidates) - "Show installed CANDIDATES and the ones to deinstall in a different color." - (cl-loop for cand in candidates - for name = (helm-apt-display-to-real cand) - for deinstall = (string= - (helm-apt--installed-package-name name) - "deinstall") - for install = (string= - (helm-apt--installed-package-name name) - "install") - for show = (cond ((and deinstall - (memq helm-apt-show-only '(all deinstalled))) - (propertize cand 'face 'helm-apt-deinstalled)) - ((and install - (memq helm-apt-show-only '(all installed))) - (propertize cand 'face 'helm-apt-installed)) - ((and (eq helm-apt-show-only 'noinstalled) - (not install)) cand) - ((eq helm-apt-show-only 'all) cand)) - when show collect show)) - -(defun helm-apt-show-only-installed () - (interactive) - (when helm-alive-p - (setq helm-apt-show-only 'installed) - (helm-update))) - -(defun helm-apt-show-only-not-installed () - (interactive) - (when helm-alive-p - (setq helm-apt-show-only 'noinstalled) - (helm-update))) - -(defun helm-apt-show-only-deinstalled () - (interactive) - (when helm-alive-p - (setq helm-apt-show-only 'deinstalled) - (helm-update))) - -(defun helm-apt-show-all () - (interactive) - (when helm-alive-p - (setq helm-apt-show-only 'all) - (helm-update))) - -(defun helm-apt-init () - "Initialize list of debian packages." - (let ((query "")) - (unless (and helm-apt-installed-packages - helm-apt-all-packages) - (message "Loading package list...") - (setq helm-apt-installed-packages - (with-temp-buffer - (call-process-shell-command "dpkg --get-selections" - nil (current-buffer)) - (cl-loop for i in (split-string (buffer-string) "\n" t) - for p = (split-string i) - collect (cons (car p) (cadr p))))) - (helm-init-candidates-in-buffer - 'global - (setq helm-apt-all-packages - (with-temp-buffer - (call-process-shell-command - (format helm-apt-search-command query) - nil (current-buffer)) - (buffer-string)))) - (message "Loading package list done") - (sit-for 0.5)))) - -(defun helm-apt-display-to-real (line) - "Return only name of a debian package. -LINE is displayed like: -package name - description." - (car (split-string line " - "))) - -(defvar helm-apt-show-current-package nil) -(define-derived-mode helm-apt-show-mode - special-mode "helm-apt-show" - "Mode to display infos on apt packages.") - -(defun helm-apt-cache-show (package) - "Show information on apt package PACKAGE." - (if (and (functionp helm-apt-cache-show-function) - (not (eq helm-apt-cache-show-function - 'helm-apt-cache-show))) - ;; A function, call it. - (funcall helm-apt-cache-show-function package) - ;; nil or whatever use default. - (helm-apt-cache-show-1 package))) - -(defun helm-apt-cache-show-1 (package) - (let* ((command (format helm-apt-show-command package)) - (buf (get-buffer-create "*helm apt show*"))) - (switch-to-buffer buf) - (unless (string= package helm-apt-show-current-package) - (let ((inhibit-read-only t)) - (erase-buffer) - (save-excursion - (call-process-shell-command - command nil (current-buffer) t)))) - (helm-apt-show-mode) - (set (make-local-variable 'helm-apt-show-current-package) - package))) - -(defun helm-apt-install (_package) - "Run 'apt-get install' shell command on PACKAGE." - (helm-apt-generic-action :action 'install)) - -(defun helm-apt-reinstall (_package) - "Run 'apt-get install --reinstall' shell command on PACKAGE." - (helm-apt-generic-action :action 'reinstall)) - -(defun helm-apt-uninstall (_package) - "Run 'apt-get remove' shell command on PACKAGE." - (helm-apt-generic-action :action 'uninstall)) - -(defun helm-apt-purge (_package) - "Run 'apt-get purge' shell command on PACKAGE." - (helm-apt-generic-action :action 'purge)) - -(cl-defun helm-apt-generic-action (&key action) - "Run 'apt-get ACTION'. -Support install, remove and purge actions." - (if (and helm-apt-term-buffer - (buffer-live-p (get-buffer helm-apt-term-buffer))) - (switch-to-buffer helm-apt-term-buffer) - (ansi-term (getenv "SHELL") "term apt") - (setq helm-apt-term-buffer (buffer-name))) - (term-line-mode) - (let ((command (cl-case action - (install "sudo apt-get install ") - (reinstall "sudo apt-get install --reinstall ") - (uninstall "sudo apt-get remove ") - (purge "sudo apt-get purge ") - (t (error "Unknown action")))) - (beg (point)) - end - (cand-list (mapconcat #'(lambda (x) (format "'%s'" x)) - (helm-marked-candidates) " "))) - (goto-char (point-max)) - (insert (concat command cand-list)) - (setq end (point)) - (if (y-or-n-p (format "%s package(s)" (symbol-name action))) - (progn - (setq helm-external-commands-list nil) - (setq helm-apt-installed-packages nil) - (term-char-mode) (term-send-input)) - (delete-region beg end)))) - -;;;###autoload -(defun helm-apt (arg) - "Preconfigured `helm' : frontend of APT package manager. -With a prefix arg reload cache." - (interactive "P") - (setq helm-apt-show-only 'all) - (unless helm-apt-default-archs - (setq helm-apt-default-archs - (append (split-string - (shell-command-to-string - "dpkg --print-architecture") - "\n" t) - (split-string - (shell-command-to-string - "dpkg --print-foreign-architectures") - "\n" t)))) - (let ((query (read-string "Search Package: " nil 'helm-apt-input-history))) - (when arg (helm-apt-refresh)) - (helm :sources 'helm-source-apt - :prompt "Search Package: " - :input query - :buffer "*helm apt*" - :history 'helm-apt-input-history))) - - -(provide 'helm-apt) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-apt.el ends here diff --git a/elpa/helm-20150403.101/helm-autoloads.el b/elpa/helm-20150403.101/helm-autoloads.el deleted file mode 100644 index 33f8ba89..00000000 --- a/elpa/helm-20150403.101/helm-autoloads.el +++ /dev/null @@ -1,1258 +0,0 @@ -;;; helm-autoloads.el --- automatically extracted autoloads -;; -;;; Code: - - -;;;### (autoloads (helm-other-buffer helm helm-debug-open-last-log -;;;;;; helm-define-key-with-subkeys helm-multi-key-defun helm-define-multi-key) -;;;;;; "helm" "helm.el" (21792 6081 0 0)) -;;; Generated autoloads from helm.el - -(autoload 'helm-define-multi-key "helm" "\ -In KEYMAP, define key sequence KEY for function list FUNCTIONS. -Each function run sequentially each time the key KEY is pressed. -If DELAY is specified switch back to initial function of FUNCTIONS list -after DELAY seconds. -The functions in FUNCTIONS list are functions with no args. -e.g - (defun foo () - (message \"Run foo\")) - (defun bar () - (message \"Run bar\")) - (defun baz () - (message \"Run baz\")) - -\(helm-define-multi-key global-map \" q\" '(foo bar baz) 2) - -Each time \" q\" is pressed the next function is executed, if you wait -More than 2 seconds, next hit will run again the first function and so on. - -\(fn KEYMAP KEY FUNCTIONS &optional DELAY)" nil nil) - -(autoload 'helm-multi-key-defun "helm" "\ -Define NAME as a multi-key command running FUNS. -After DELAY seconds the FUNS list is reinitialised. -See `helm-define-multi-key'. - -\(fn NAME DOCSTRING FUNS &optional DELAY)" nil t) - -(put 'helm-multi-key-defun 'lisp-indent-function '2) - -(autoload 'helm-define-key-with-subkeys "helm" "\ -Allow defining in MAP a KEY and SUBKEY to COMMAND. - -This allow typing KEY to call COMMAND the first time and -type only SUBKEY on subsequent calls. - -Arg MAP is the keymap to use, SUBKEY is the initial short keybinding to -call COMMAND. - -Arg OTHER-SUBKEYS is an alist specifying other short keybindings -to use once started. -e.g: - -\(helm-define-key-with-subkeys global-map - (kbd \"C-x v n\") ?n 'git-gutter:next-hunk '((?p . git-gutter:previous-hunk))) - - -In this example, `C-x v n' will run `git-gutter:next-hunk' -subsequent hits on \"n\" will run this command again -and subsequent hits on \"p\" will run `git-gutter:previous-hunk'. - -Arg MENU is a string to display in minibuffer -to describe SUBKEY and OTHER-SUBKEYS. -Arg EXIT-FN specify a function to run on exit. - -Any other keys pressed run their assigned command defined in MAP -and exit the loop running EXIT-FN if specified. - -NOTE: SUBKEY and OTHER-SUBKEYS bindings support -only char syntax actually (e.g ?n) -so don't use strings, vectors or whatever to define them. - -\(fn MAP KEY SUBKEY COMMAND &optional OTHER-SUBKEYS MENU EXIT-FN)" nil nil) - -(put 'helm-define-key-with-subkeys 'lisp-indent-function '1) - -(autoload 'helm-debug-open-last-log "helm" "\ -Open helm log file of last helm session. -If `helm-last-log-file' is nil, switch to `helm-debug-buffer' . - -\(fn)" t nil) - -(autoload 'helm "helm" "\ -Main function to execute helm sources. - -Keywords supported: -:sources :input :prompt :resume :preselect -:buffer :keymap :default :history :allow-nest - -Extra LOCAL-VARS keywords are supported, see below. - -PLIST is a list like (:key1 val1 :key2 val2 ...) or -\(&optional sources input prompt resume - preselect buffer keymap default history). - -Basic keywords are the following: - -:sources - -A list of sources used for this session. It also accepts a -symbol, interpreted as a variable of a helm source -i.e (a symbol can be passed instead of a list of sources). -It also accepts an alist representing a helm source, which is -detected by (assq 'name ANY-SOURCES). -NOTE: In this case the source is embedded in the helm command and -have no symbol name, so it is not reachable from outside. -It will be referenced in `helm-sources' as a whole alist. - -:input - -Temporary value of `helm-pattern', ie. initial input of minibuffer. - -:prompt - -Prompt other than \"pattern: \". - -:resume - -If t, Resurrect previously instance of `helm'. Skip the initialization. -If 'noresume, this instance of `helm' cannot be resumed. - -:preselect - -Initially selected candidate. Specified by exact candidate or a regexp. - -:buffer - -`helm-buffer' instead of *helm*. - -:keymap - -`helm-map' for current `helm' session. - -:default - -A default argument that will be inserted in minibuffer with \\\\[next-history-element]. -When nil or not present `thing-at-point' will be used instead. -If `helm-maybe-use-default-as-input' is non--nil display will be -updated using :default arg as input unless :input is specified, -which in this case will take precedence on :default -This is a string or a list, in this case the car of the list will -be used as initial default input, but you will be able to cycle in this -list with \\\\[next-history-element]. - -:history - -By default all minibuffer input is pushed to `minibuffer-history', -if an argument HISTORY is provided, input will be pushed to HISTORY. -History element should be a symbol. - -:allow-nest - -Allow running this helm command within a running helm session. - -Of course, conventional arguments are supported, the two are same. - -\(helm :sources sources :input input :prompt prompt :resume resume - :preselect preselect :buffer buffer :keymap keymap :default default - :history history) - -and - -\(helm sources input prompt resume preselect buffer keymap default history) - -are the same. - -However the use of non keyword args is deprecated and should not be used. - -Other keywords are interpreted as local variables of this helm session. -The `helm-' prefix can be omitted. For example, - -\(helm :sources 'helm-source-buffers-list - :buffer \"*buffers*\" :candidate-number-limit 10) - -means starting helm session with `helm-source-buffers' -source in *buffers* buffer and set variable `helm-candidate-number-limit' -to 10 as session local variable. - -\(fn &key SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT HISTORY ALLOW-NEST OTHER-LOCAL-VARS)" nil nil) - -(autoload 'helm-other-buffer "helm" "\ -Simplified interface of `helm' with other `helm-buffer'. -Call `helm' with only ANY-SOURCES and ANY-BUFFER as args. - -\(fn ANY-SOURCES ANY-BUFFER)" nil nil) - -;;;*** - -;;;### (autoloads (helm-reset-adaptive-history) "helm-adaptive" "helm-adaptive.el" -;;;;;; (21792 6081 0 0)) -;;; Generated autoloads from helm-adaptive.el - -(autoload 'helm-reset-adaptive-history "helm-adaptive" "\ -Delete all `helm-adaptive-history' and his file. -Useful when you have a old or corrupted `helm-adaptive-history-file'. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-apt) "helm-apt" "helm-apt.el" (21792 6081 -;;;;;; 0 0)) -;;; Generated autoloads from helm-apt.el - -(autoload 'helm-apt "helm-apt" "\ -Preconfigured `helm' : frontend of APT package manager. -With a prefix arg reload cache. - -\(fn ARG)" t nil) - -;;;*** - -;;;### (autoloads (helm-filtered-bookmarks helm-pp-bookmarks helm-bookmarks) -;;;;;; "helm-bookmark" "helm-bookmark.el" (21792 6081 0 0)) -;;; Generated autoloads from helm-bookmark.el - -(autoload 'helm-bookmarks "helm-bookmark" "\ -Preconfigured `helm' for bookmarks. - -\(fn)" t nil) - -(autoload 'helm-pp-bookmarks "helm-bookmark" "\ -Preconfigured `helm' for bookmarks (pretty-printed). - -\(fn)" t nil) - -(autoload 'helm-filtered-bookmarks "helm-bookmark" "\ -Preconfigured helm for bookmarks (filtered by category). -Optional source `helm-source-bookmark-addressbook' is loaded -only if external library addressbook-bookmark.el is available. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-buffers-list) "helm-buffers" "helm-buffers.el" -;;;;;; (21792 6081 0 0)) -;;; Generated autoloads from helm-buffers.el - -(autoload 'helm-buffers-list "helm-buffers" "\ -Preconfigured `helm' to list buffers. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-colors) "helm-color" "helm-color.el" (21792 -;;;;;; 6081 0 0)) -;;; Generated autoloads from helm-color.el - -(autoload 'helm-colors "helm-color" "\ -Preconfigured `helm' for color. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-M-x) "helm-command" "helm-command.el" (21792 -;;;;;; 6081 0 0)) -;;; Generated autoloads from helm-command.el - -(autoload 'helm-M-x "helm-command" "\ -Preconfigured `helm' for Emacs commands. -It is `helm' replacement of regular `M-x' `execute-extended-command'. - -Unlike regular `M-x' emacs vanilla `execute-extended-command' command, -the prefix args if needed, are passed AFTER starting `helm-M-x'. - -You can get help on each command by persistent action. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-configuration) "helm-config" "helm-config.el" -;;;;;; (21792 6081 0 0)) -;;; Generated autoloads from helm-config.el - -(autoload 'helm-configuration "helm-config" "\ -Customize `helm'. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-dabbrev) "helm-dabbrev" "helm-dabbrev.el" -;;;;;; (21792 6081 0 0)) -;;; Generated autoloads from helm-dabbrev.el - -(autoload 'helm-dabbrev "helm-dabbrev" "\ - - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-complex-command-history helm-timers helm-locate-library -;;;;;; helm-manage-advice helm-apropos helm-lisp-completion-or-file-name-at-point -;;;;;; helm-lisp-indent helm-complete-file-name-at-point helm-lisp-completion-at-point) -;;;;;; "helm-elisp" "helm-elisp.el" (21792 6081 0 0)) -;;; Generated autoloads from helm-elisp.el - -(autoload 'helm-lisp-completion-at-point "helm-elisp" "\ -Helm lisp symbol completion at point. - -\(fn)" t nil) - -(autoload 'helm-complete-file-name-at-point "helm-elisp" "\ -Complete file name at point. - -\(fn &optional FORCE)" t nil) - -(autoload 'helm-lisp-indent "helm-elisp" "\ - - -\(fn)" t nil) - -(autoload 'helm-lisp-completion-or-file-name-at-point "helm-elisp" "\ -Complete lisp symbol or filename at point. -Filename completion happen if string start after or between a double quote. - -\(fn)" t nil) - -(autoload 'helm-apropos "helm-elisp" "\ -Preconfigured helm to describe commands, functions, variables and faces. - -\(fn)" t nil) - -(autoload 'helm-manage-advice "helm-elisp" "\ -Preconfigured `helm' to disable/enable function advices. - -\(fn)" t nil) - -(autoload 'helm-locate-library "helm-elisp" "\ - - -\(fn)" t nil) - -(autoload 'helm-timers "helm-elisp" "\ -Preconfigured `helm' for timers. - -\(fn)" t nil) - -(autoload 'helm-complex-command-history "helm-elisp" "\ - - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-list-elisp-packages) "helm-elisp-package" -;;;;;; "helm-elisp-package.el" (21792 6081 0 0)) -;;; Generated autoloads from helm-elisp-package.el - -(autoload 'helm-list-elisp-packages "helm-elisp-package" "\ - - -\(fn ARG)" t nil) - -;;;*** - -;;;### (autoloads (helm-elscreen) "helm-elscreen" "helm-elscreen.el" -;;;;;; (21792 6081 0 0)) -;;; Generated autoloads from helm-elscreen.el - -(autoload 'helm-elscreen "helm-elscreen" "\ -Preconfigured helm to list elscreen. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-eshell-history helm-esh-pcomplete) "helm-eshell" -;;;;;; "helm-eshell.el" (21792 6081 0 0)) -;;; Generated autoloads from helm-eshell.el - -(autoload 'helm-esh-pcomplete "helm-eshell" "\ -Preconfigured helm to provide helm completion in eshell. - -\(fn)" t nil) - -(autoload 'helm-eshell-history "helm-eshell" "\ -Preconfigured helm for eshell history. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-calcul-expression helm-eval-expression-with-eldoc -;;;;;; helm-eval-expression) "helm-eval" "helm-eval.el" (21792 6081 -;;;;;; 0 0)) -;;; Generated autoloads from helm-eval.el - -(autoload 'helm-eval-expression "helm-eval" "\ -Preconfigured helm for `helm-source-evaluation-result'. - -\(fn ARG)" t nil) - -(autoload 'helm-eval-expression-with-eldoc "helm-eval" "\ -Preconfigured helm for `helm-source-evaluation-result' with `eldoc' support. - -\(fn)" t nil) - -(autoload 'helm-calcul-expression "helm-eval" "\ -Preconfigured helm for `helm-source-calculation-result'. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-run-external-command) "helm-external" "helm-external.el" -;;;;;; (21792 6081 0 0)) -;;; Generated autoloads from helm-external.el - -(autoload 'helm-run-external-command "helm-external" "\ -Preconfigured `helm' to run External PROGRAM asyncronously from Emacs. -If program is already running exit with error. -You can set your own list of commands with -`helm-external-commands-list'. - -\(fn PROGRAM)" t nil) - -;;;*** - -;;;### (autoloads (helm-recentf helm-multi-files helm-for-files helm-find-files -;;;;;; helm-find helm-browse-project) "helm-files" "helm-files.el" -;;;;;; (21792 6081 0 0)) -;;; Generated autoloads from helm-files.el - -(autoload 'helm-browse-project "helm-files" "\ -Browse files and see status of project with its vcs. -Only HG and GIT are supported for now. -Fall back to `helm-find-files' or `helm-browse-project-find-files' -if current directory is not under control of one of those vcs. -With a prefix ARG browse files recursively, with two prefix ARG -rebuild the cache. -If the current directory is found in the cache, start -`helm-browse-project-find-files' even with no prefix ARG. -NOTE: The prefix ARG have no effect on the VCS controlled directories. - -Need dependencies for VCS: - -and -. - -\(fn ARG)" t nil) - -(autoload 'helm-find "helm-files" "\ -Preconfigured `helm' for the find shell command. - -\(fn ARG)" t nil) - -(autoload 'helm-find-files "helm-files" "\ -Preconfigured `helm' for helm implementation of `find-file'. -Called with a prefix arg show history if some. -Don't call it from programs, use `helm-find-files-1' instead. -This is the starting point for nearly all actions you can do on files. - -\(fn ARG)" t nil) - -(autoload 'helm-for-files "helm-files" "\ -Preconfigured `helm' for opening files. -Run all sources defined in `helm-for-files-preferred-list'. - -\(fn)" t nil) - -(autoload 'helm-multi-files "helm-files" "\ -Same as `helm-for-files' but allow toggling from locate to others sources. - -\(fn)" t nil) - -(autoload 'helm-recentf "helm-files" "\ -Preconfigured `helm' for `recentf'. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-ucs helm-select-xfont) "helm-font" "helm-font.el" -;;;;;; (21792 6081 0 0)) -;;; Generated autoloads from helm-font.el - -(autoload 'helm-select-xfont "helm-font" "\ -Preconfigured `helm' to select Xfont. - -\(fn)" t nil) - -(autoload 'helm-ucs "helm-font" "\ -Preconfigured helm for `ucs-names' math symbols. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-do-pdfgrep helm-do-zgrep helm-do-grep helm-grep-mode-jump-other-window -;;;;;; helm-grep-mode-jump-other-window-backward helm-grep-mode-jump-other-window-forward -;;;;;; helm-grep-mode-jump helm-gm-precedent-file helm-gm-next-file -;;;;;; helm-grep-mode helm-grep-run-save-buffer helm-goto-next-file -;;;;;; helm-goto-precedent-file) "helm-grep" "helm-grep.el" (21792 -;;;;;; 6081 0 0)) -;;; Generated autoloads from helm-grep.el - -(autoload 'helm-goto-precedent-file "helm-grep" "\ -Go to precedent file in helm grep/etags buffers. - -\(fn)" t nil) - -(autoload 'helm-goto-next-file "helm-grep" "\ -Go to precedent file in helm grep/etags buffers. - -\(fn)" t nil) - -(autoload 'helm-grep-run-save-buffer "helm-grep" "\ -Run grep save results action from `helm-do-grep-1'. - -\(fn)" t nil) - -(autoload 'helm-grep-mode "helm-grep" "\ -Major mode to provide actions in helm grep saved buffer. - -Special commands: -\\{helm-grep-mode-map} - -\(fn)" t nil) - -(autoload 'helm-gm-next-file "helm-grep" "\ - - -\(fn)" t nil) - -(autoload 'helm-gm-precedent-file "helm-grep" "\ - - -\(fn)" t nil) - -(autoload 'helm-grep-mode-jump "helm-grep" "\ - - -\(fn)" t nil) - -(autoload 'helm-grep-mode-jump-other-window-forward "helm-grep" "\ - - -\(fn)" t nil) - -(autoload 'helm-grep-mode-jump-other-window-backward "helm-grep" "\ - - -\(fn)" t nil) - -(autoload 'helm-grep-mode-jump-other-window "helm-grep" "\ - - -\(fn)" t nil) - -(autoload 'helm-do-grep "helm-grep" "\ -Preconfigured helm for grep. -Contrarily to Emacs `grep', no default directory is given, but -the full path of candidates in ONLY. -That allow to grep different files not only in `default-directory' but anywhere -by marking them (C-). If one or more directory is selected -grep will search in all files of these directories. -You can also use wildcard in the base name of candidate. -If a prefix arg is given use the -r option of grep (recurse). -The prefix arg can be passed before or after start file selection. -See also `helm-do-grep-1'. - -\(fn)" t nil) - -(autoload 'helm-do-zgrep "helm-grep" "\ -Preconfigured helm for zgrep. - -\(fn)" t nil) - -(autoload 'helm-do-pdfgrep "helm-grep" "\ -Preconfigured helm for pdfgrep. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-describe-helm-attribute helm-kmacro-help -;;;;;; helm-semantic-help helm-color-help helm-imenu-help helm-M-x-help -;;;;;; helm-el-package-help helm-apt-help helm-top-help helm-moccur-help -;;;;;; helm-buffers-ido-virtual-help helm-esh-help helm-bookmark-help -;;;;;; helm-ucs-help helm-etags-help helm-pdfgrep-help helm-grep-help -;;;;;; helm-generic-file-help helm-read-file-name-help helm-ff-help -;;;;;; helm-buffer-help helm-help helm-documentation) "helm-help" -;;;;;; "helm-help.el" (21792 6081 0 0)) -;;; Generated autoloads from helm-help.el - -(autoload 'helm-documentation "helm-help" "\ -Helm documentation. -With a prefix arg refresh the documentation. - -Find here the documentation of all sources actually documented. - -\(fn ARG)" t nil) - -(autoload 'helm-help "helm-help" "\ -Help of `helm'. - -\(fn)" t nil) - -(autoload 'helm-buffer-help "helm-help" "\ -Help command for helm buffers. - -\(fn)" t nil) - -(autoload 'helm-ff-help "helm-help" "\ -Help command for `helm-find-files'. - -\(fn)" t nil) - -(autoload 'helm-read-file-name-help "helm-help" "\ - - -\(fn)" t nil) - -(autoload 'helm-generic-file-help "helm-help" "\ - - -\(fn)" t nil) - -(autoload 'helm-grep-help "helm-help" "\ - - -\(fn)" t nil) - -(autoload 'helm-pdfgrep-help "helm-help" "\ - - -\(fn)" t nil) - -(autoload 'helm-etags-help "helm-help" "\ -The help function for etags. - -\(fn)" t nil) - -(autoload 'helm-ucs-help "helm-help" "\ -Help command for `helm-ucs'. - -\(fn)" t nil) - -(autoload 'helm-bookmark-help "helm-help" "\ -Help command for bookmarks. - -\(fn)" t nil) - -(autoload 'helm-esh-help "helm-help" "\ -Help command for `helm-find-files-eshell-command-on-file'. - -\(fn)" t nil) - -(autoload 'helm-buffers-ido-virtual-help "helm-help" "\ -Help command for ido virtual buffers. - -\(fn)" t nil) - -(autoload 'helm-moccur-help "helm-help" "\ - - -\(fn)" t nil) - -(autoload 'helm-top-help "helm-help" "\ - - -\(fn)" t nil) - -(autoload 'helm-apt-help "helm-help" "\ - - -\(fn)" t nil) - -(autoload 'helm-el-package-help "helm-help" "\ - - -\(fn)" t nil) - -(autoload 'helm-M-x-help "helm-help" "\ - - -\(fn)" t nil) - -(autoload 'helm-imenu-help "helm-help" "\ - - -\(fn)" t nil) - -(autoload 'helm-color-help "helm-help" "\ - - -\(fn)" t nil) - -(autoload 'helm-semantic-help "helm-help" "\ - - -\(fn)" t nil) - -(autoload 'helm-kmacro-help "helm-help" "\ - - -\(fn)" t nil) - -(defvar helm-buffer-mode-line-string '("Buffer(s)" "\\\\[helm-buffer-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct" "String displayed in mode-line in `helm-source-buffers-list'")) - -(defvar helm-color-mode-line-string '("Colors" "\\\\[helm-color-help]:Help/\\[helm-color-run-insert-name]:Insert name/\\[helm-color-run-insert-rgb]:Insert RGB/with shift: Kill")) - -(defvar helm-buffers-ido-virtual-mode-line-string '("Killed Buffer(s)" "\\\\[helm-buffers-ido-virtual-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct" "String displayed in mode-line in `helm-source-buffers-list'")) - -(defvar helm-ff-mode-line-string "\\\\[helm-ff-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct" "\ -String displayed in mode-line in `helm-source-find-files'") - -(defvar helm-read-file-name-mode-line-string "\\\\[helm-read-file-name-help]:Help C/\\[helm-cr-empty-string]:Empty \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct" "\ -String displayed in mode-line in `helm-source-find-files'.") - -(defvar helm-generic-file-mode-line-string "\\\\[helm-generic-file-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend" "\ -String displayed in mode-line in Locate.") - -(defvar helm-grep-mode-line-string "\\\\[helm-grep-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend" "\ -String displayed in mode-line in `helm-do-grep'.") - -(defvar helm-pdfgrep-mode-line-string "\\\\[helm-pdfgrep-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend" "\ -String displayed in mode-line in `helm-do-pdfgrep'.") - -(defvar helm-etags-mode-line-string "\\\\[helm-etags-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct" "\ -String displayed in mode-line in `helm-etags-select'.") - -(defvar helm-ucs-mode-line-string "\\\\[helm-ucs-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct" "\ -String displayed in mode-line in `helm-ucs'.") - -(defvar helm-bookmark-mode-line-string '("Bookmark(s)" "\\\\[helm-bookmark-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct") "\ -String displayed in mode-line in `helm-source-buffers-list'") - -(defvar helm-occur-mode-line "\\\\[helm-help]:Help \\\\[helm-occur-run-query-replace-regexp]:Query replace regexp \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") - -(defvar helm-moccur-mode-line "\\\\[helm-moccur-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") - -(defvar helm-comp-read-mode-line "\\C/\\[helm-cr-empty-string]:Empty \\\\[helm-help]:Help \\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct") - -(defvar helm-top-mode-line "\\\\[helm-top-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") - -(defvar helm-apt-mode-line "\\\\[helm-apt-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") - -(defvar helm-el-package-mode-line "\\\\[helm-el-package-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") - -(defvar helm-M-x-mode-line "\\\\[helm-M-x-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") - -(defvar helm-imenu-mode-line "\\\\[helm-imenu-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") - -(defvar helm-semantic-mode-line "\\\\[helm-semantic-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") - -(autoload 'helm-describe-helm-attribute "helm-help" "\ -Display the full documentation of HELM-ATTRIBUTE. -HELM-ATTRIBUTE should be a symbol. - -\(fn HELM-ATTRIBUTE)" t nil) - -;;;*** - -;;;### (autoloads (helm-imenu) "helm-imenu" "helm-imenu.el" (21792 -;;;;;; 6081 0 0)) -;;; Generated autoloads from helm-imenu.el - -(autoload 'helm-imenu "helm-imenu" "\ -Preconfigured `helm' for `imenu'. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-info-at-point) "helm-info" "helm-info.el" -;;;;;; (21792 6081 0 0)) -;;; Generated autoloads from helm-info.el - -(autoload 'helm-info-at-point "helm-info" "\ -Preconfigured `helm' for searching info at point. -With a prefix-arg insert symbol at point. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-locate helm-locate-read-file-name) "helm-locate" -;;;;;; "helm-locate.el" (21792 6081 0 0)) -;;; Generated autoloads from helm-locate.el - -(autoload 'helm-locate-read-file-name "helm-locate" "\ - - -\(fn PROMPT)" nil nil) - -(autoload 'helm-locate "helm-locate" "\ -Preconfigured `helm' for Locate. -Note: you can add locate options after entering pattern. -See 'man locate' for valid options and also `helm-locate-command'. - -You can specify a local database with prefix argument ARG. -With two prefix arg, refresh the current local db or create it -if it doesn't exists. -Many databases can be used: navigate and mark them. -See also `helm-locate-with-db'. - -To create a user specific db, use -\"updatedb -l 0 -o db_path -U directory\". -Where db_path is a filename matched by -`helm-locate-db-file-regexp'. - -\(fn ARG)" t nil) - -;;;*** - -;;;### (autoloads (helm-man-woman) "helm-man" "helm-man.el" (21792 -;;;;;; 6081 0 0)) -;;; Generated autoloads from helm-man.el - -(autoload 'helm-man-woman "helm-man" "\ -Preconfigured `helm' for Man and Woman pages. -With a prefix arg reinitialize the cache. - -\(fn ARG)" t nil) - -;;;*** - -;;;### (autoloads (helm-comint-input-ring helm-minibuffer-history -;;;;;; helm-mini helm-stumpwm-commands helm-ratpoison-commands helm-insert-latex-math -;;;;;; helm-world-time helm-browse-menubar) "helm-misc" "helm-misc.el" -;;;;;; (21792 6081 0 0)) -;;; Generated autoloads from helm-misc.el - -(autoload 'helm-browse-menubar "helm-misc" "\ -Helm interface to the menubar using lacarte.el. - -\(fn)" t nil) - -(autoload 'helm-world-time "helm-misc" "\ -Preconfigured `helm' to show world time. - -\(fn)" t nil) - -(autoload 'helm-insert-latex-math "helm-misc" "\ -Preconfigured helm for latex math symbols completion. - -\(fn)" t nil) - -(autoload 'helm-ratpoison-commands "helm-misc" "\ -Preconfigured `helm' to execute ratpoison commands. - -\(fn)" t nil) - -(autoload 'helm-stumpwm-commands "helm-misc" "\ - - -\(fn)" t nil) - -(autoload 'helm-mini "helm-misc" "\ -Preconfigured `helm' lightweight version (buffer -> recentf). - -\(fn)" t nil) - -(autoload 'helm-minibuffer-history "helm-misc" "\ -Preconfigured `helm' for `minibuffer-history'. - -\(fn)" t nil) - -(autoload 'helm-comint-input-ring "helm-misc" "\ -Predefined `helm' that provide completion of `comint' history. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-mode helm-comp-read) "helm-mode" "helm-mode.el" -;;;;;; (21792 6081 0 0)) -;;; Generated autoloads from helm-mode.el - -(autoload 'helm-comp-read "helm-mode" "\ -Read a string in the minibuffer, with helm completion. - -It is helm `completing-read' equivalent. - -- PROMPT is the prompt name to use. - -- COLLECTION can be a list, vector, obarray or hash-table. - It can be also a function that receives three arguments: - the values string, predicate and t. See `all-completions' for more details. - -Keys description: - -- TEST: A predicate called with one arg i.e candidate. - -- INITIAL-INPUT: Same as input arg in `helm'. - -- PRESELECT: See preselect arg of `helm'. - -- DEFAULT: This option is used only for compatibility with regular - Emacs `completing-read' (Same as DEFAULT arg of `completing-read'). - -- BUFFER: Name of helm-buffer. - -- MUST-MATCH: Candidate selected must be one of COLLECTION. - -- REVERSE-HISTORY: When non--nil display history source after current - source completion. - -- REQUIRES-PATTERN: Same as helm attribute, default is 0. - -- HISTORY: A list containing specific history, default is nil. - When it is non--nil, all elements of HISTORY are displayed in - a special source before COLLECTION. - -- INPUT-HISTORY: A symbol. the minibuffer input history will be - stored there, if nil or not provided, `minibuffer-history' - will be used instead. - -- CASE-FOLD: Same as `helm-case-fold-search'. - -- DEL-INPUT: Boolean, when non--nil (default) remove the partial - minibuffer input from HISTORY is present. - -- PERSISTENT-ACTION: A function called with one arg i.e candidate. - -- PERSISTENT-HELP: A string to document PERSISTENT-ACTION. - -- MODE-LINE: A string or list to display in mode line. - Default is `helm-comp-read-mode-line'. - -- KEYMAP: A keymap to use in this `helm-comp-read'. - (the keymap will be shared with history source) - -- NAME: The name related to this local source. - -- EXEC-WHEN-ONLY-ONE: Bound `helm-execute-action-at-once-if-one' - to non--nil. (possibles values are t or nil). - -- VOLATILE: Use volatile attribute (enabled by default). - -- SORT: A predicate to give to `sort' e.g `string-lessp'. - -- FC-TRANSFORMER: A `filtered-candidate-transformer' function. - -- HIST-FC-TRANSFORMER: A `filtered-candidate-transformer' - function for the history source. - -- MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list. - -- NOMARK: When non--nil don't allow marking candidates. - -- ALISTP: (default is non--nil) See `helm-comp-read-get-candidates'. - -- CANDIDATES-IN-BUFFER: when non--nil use a source build with - `helm-candidates-in-buffer' which is much faster. - Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil. - -Any prefix args passed during `helm-comp-read' invocation will be recorded -in `helm-current-prefix-arg', otherwise if prefix args were given before -`helm-comp-read' invocation, the value of `current-prefix-arg' will be used. -That's mean you can pass prefix args before or after calling a command -that use `helm-comp-read' See `helm-M-x' for example. - -\(fn PROMPT COLLECTION &key TEST INITIAL-INPUT DEFAULT PRESELECT (buffer \"*Helm Completions*\") MUST-MATCH FUZZY REVERSE-HISTORY (requires-pattern 0) HISTORY INPUT-HISTORY (case-fold helm-comp-read-case-fold-search) (del-input t) (persistent-action nil) (persistent-help \"DoNothing\") (mode-line helm-comp-read-mode-line) (keymap helm-comp-read-map) (name \"Helm Completions\") CANDIDATES-IN-BUFFER EXEC-WHEN-ONLY-ONE QUIT-WHEN-NO-CAND (volatile t) SORT (fc-transformer (quote helm-cr-default-transformer)) HIST-FC-TRANSFORMER MARKED-CANDIDATES NOMARK (alistp t))" nil nil) - -(defvar helm-mode nil "\ -Non-nil if Helm mode is enabled. -See the command `helm-mode' for a description of this minor mode. -Setting this variable directly does not take effect; -either customize it (see the info node `Easy Customization') -or call the function `helm-mode'.") - -(custom-autoload 'helm-mode "helm-mode" nil) - -(autoload 'helm-mode "helm-mode" "\ -Toggle generic helm completion. - -All functions in Emacs that use `completing-read' -or `read-file-name' and friends will use helm interface -when this mode is turned on. -However you can modify this behavior for functions of your choice -with `helm-completing-read-handlers-alist'. - -Called with a positive arg, turn on unconditionally, with a -negative arg turn off. -You can turn it on with `helm-mode'. - -Some crap emacs functions may not be supported, -e.g `ffap-alternate-file' and maybe others -You can add such functions to `helm-completing-read-handlers-alist' -with a nil value. - -Note: This mode is incompatible with Emacs23. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads (helm-wikipedia-suggest helm-yahoo-suggest helm-google-suggest -;;;;;; helm-surfraw) "helm-net" "helm-net.el" (21792 6081 0 0)) -;;; Generated autoloads from helm-net.el - -(autoload 'helm-surfraw "helm-net" "\ -Preconfigured `helm' to search PATTERN with search ENGINE. - -\(fn PATTERN ENGINE)" t nil) - -(autoload 'helm-google-suggest "helm-net" "\ -Preconfigured `helm' for google search with google suggest. - -\(fn)" t nil) - -(autoload 'helm-yahoo-suggest "helm-net" "\ -Preconfigured `helm' for Yahoo searching with Yahoo suggest. - -\(fn)" t nil) - -(autoload 'helm-wikipedia-suggest "helm-net" "\ -Preconfigured `helm' for Wikipedia lookup with Wikipedia suggest. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-org-capture-templates helm-org-in-buffer-headings -;;;;;; helm-org-agenda-files-headings) "helm-org" "helm-org.el" -;;;;;; (21792 6081 0 0)) -;;; Generated autoloads from helm-org.el - -(autoload 'helm-org-agenda-files-headings "helm-org" "\ - - -\(fn)" t nil) - -(autoload 'helm-org-in-buffer-headings "helm-org" "\ - - -\(fn)" t nil) - -(autoload 'helm-org-capture-templates "helm-org" "\ - - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-multi-occur-from-isearch helm-multi-occur -;;;;;; helm-occur-from-isearch helm-occur helm-regexp helm-moccur-mode -;;;;;; helm-moccur-run-save-buffer) "helm-regexp" "helm-regexp.el" -;;;;;; (21792 6081 0 0)) -;;; Generated autoloads from helm-regexp.el - -(autoload 'helm-moccur-run-save-buffer "helm-regexp" "\ -Run grep save results action from `helm-do-grep-1'. - -\(fn)" t nil) - -(autoload 'helm-moccur-mode "helm-regexp" "\ -Major mode to provide actions in helm moccur saved buffer. - -Special commands: -\\{helm-moccur-mode-map} - -\(fn)" t nil) - -(autoload 'helm-regexp "helm-regexp" "\ -Preconfigured helm to build regexps. -`query-replace-regexp' can be run from there against found regexp. - -\(fn)" t nil) - -(autoload 'helm-occur "helm-regexp" "\ -Preconfigured helm for Occur. - -\(fn)" t nil) - -(autoload 'helm-occur-from-isearch "helm-regexp" "\ -Invoke `helm-occur' from isearch. - -\(fn)" t nil) - -(autoload 'helm-multi-occur "helm-regexp" "\ -Preconfigured helm for multi occur. - - BUFFERS is a list of buffers to search through. -With a prefix arg, reverse the behavior of -`helm-moccur-always-search-in-current'. -The prefix arg can be set before calling `helm-multi-occur' -or during the buffer selection. - -\(fn BUFFERS)" t nil) - -(autoload 'helm-multi-occur-from-isearch "helm-regexp" "\ -Invoke `helm-multi-occur' from isearch. - -With a prefix arg, reverse the behavior of -`helm-moccur-always-search-in-current'. -The prefix arg can be set before calling -`helm-multi-occur-from-isearch' or during the buffer selection. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads (helm-execute-kmacro helm-show-kill-ring helm-register -;;;;;; helm-all-mark-rings helm-global-mark-ring helm-mark-ring) -;;;;;; "helm-ring" "helm-ring.el" (21792 6081 0 0)) -;;; Generated autoloads from helm-ring.el - -(autoload 'helm-mark-ring "helm-ring" "\ -Preconfigured `helm' for `helm-source-mark-ring'. - -\(fn)" t nil) - -(autoload 'helm-global-mark-ring "helm-ring" "\ -Preconfigured `helm' for `helm-source-global-mark-ring'. - -\(fn)" t nil) - -(autoload 'helm-all-mark-rings "helm-ring" "\ -Preconfigured `helm' for `helm-source-global-mark-ring' and `helm-source-mark-ring'. - -\(fn)" t nil) - -(autoload 'helm-register "helm-ring" "\ -Preconfigured `helm' for Emacs registers. - -\(fn)" t nil) - -(autoload 'helm-show-kill-ring "helm-ring" "\ -Preconfigured `helm' for `kill-ring'. -It is drop-in replacement of `yank-pop'. - -First call open the kill-ring browser, next calls move to next line. - -\(fn)" t nil) - -(autoload 'helm-execute-kmacro "helm-ring" "\ -Keyboard macros with helm interface. -Define your macros with `f3' and `f4'. -See (info \"(emacs) Keyboard Macros\") for detailed infos. -This command is useful when used with persistent action. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-semantic-or-imenu helm-semantic) "helm-semantic" -;;;;;; "helm-semantic.el" (21792 6081 0 0)) -;;; Generated autoloads from helm-semantic.el - -(autoload 'helm-semantic "helm-semantic" "\ -Preconfigured `helm' for `semantic'. -If ARG is supplied, pre-select symbol at point instead of current - -\(fn ARG)" t nil) - -(autoload 'helm-semantic-or-imenu "helm-semantic" "\ -Run `helm' with `semantic' or `imenu'. -If ARG is supplied, pre-select symbol at point instead of current -semantic tag in scope. - -If `semantic-mode' is active in the current buffer, then use -semantic for generating tags, otherwise fall back to `imenu'. -Fill in the symbol at point by default. - -\(fn ARG)" t nil) - -;;;*** - -;;;### (autoloads (helm-xrandr-set helm-list-emacs-process helm-top) -;;;;;; "helm-sys" "helm-sys.el" (21792 6081 0 0)) -;;; Generated autoloads from helm-sys.el - -(autoload 'helm-top "helm-sys" "\ -Preconfigured `helm' for top command. - -\(fn)" t nil) - -(autoload 'helm-list-emacs-process "helm-sys" "\ -Preconfigured `helm' for emacs process. - -\(fn)" t nil) - -(autoload 'helm-xrandr-set "helm-sys" "\ - - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (helm-etags-select) "helm-tags" "helm-tags.el" -;;;;;; (21792 6081 0 0)) -;;; Generated autoloads from helm-tags.el - -(autoload 'helm-etags-select "helm-tags" "\ -Preconfigured helm for etags. -If called with a prefix argument or if any of the tag files have -been modified, reinitialize cache. - -This function aggregates three sources of tag files: - - 1) An automatically located file in the parent directories, by `helm-etags-get-tag-file'. - 2) `tags-file-name', which is commonly set by `find-tag' command. - 3) `tags-table-list' which is commonly set by `visit-tags-table' command. - -\(fn ARG)" t nil) - -;;;*** - -;;;### (autoloads (helm-yank-text-at-point helm-w32-shell-execute-open-file -;;;;;; helm-quit-and-find-file helm-display-all-sources helm-show-all-in-this-source-only) -;;;;;; "helm-utils" "helm-utils.el" (21792 6081 0 0)) -;;; Generated autoloads from helm-utils.el - -(autoload 'helm-show-all-in-this-source-only "helm-utils" "\ -Show only current source of this helm session with all its candidates. -With a numeric prefix arg show only the ARG number of candidates. - -\(fn ARG)" t nil) - -(autoload 'helm-display-all-sources "helm-utils" "\ -Display all sources previously hidden by `helm-set-source-filter'. - -\(fn)" t nil) - -(autoload 'helm-quit-and-find-file "helm-utils" "\ -Drop into `helm-find-files' from `helm'. -If current selection is a buffer or a file, `helm-find-files' -from its directory. - -\(fn)" t nil) - -(autoload 'helm-w32-shell-execute-open-file "helm-utils" "\ - - -\(fn FILE)" t nil) - -(autoload 'helm-yank-text-at-point "helm-utils" "\ -Yank text at point in `helm-current-buffer' into minibuffer. -If `helm-yank-symbol-first' is non--nil the first yank -grabs the entire symbol. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads nil nil ("helm-aliases.el" "helm-match-plugin.el" -;;;;;; "helm-pkg.el" "helm-plugin.el" "helm-source.el") (21792 6081 -;;;;;; 828452 0)) - -;;;*** - -(provide 'helm-autoloads) -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; helm-autoloads.el ends here diff --git a/elpa/helm-20150403.101/helm-bookmark.el b/elpa/helm-20150403.101/helm-bookmark.el deleted file mode 100644 index 50fca7e7..00000000 --- a/elpa/helm-20150403.101/helm-bookmark.el +++ /dev/null @@ -1,764 +0,0 @@ -;;; helm-bookmark.el --- Helm for Emacs regular Bookmarks. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: -(require 'cl-lib) -(require 'bookmark) -(require 'helm) -(require 'helm-utils) -(require 'helm-info) -(require 'helm-adaptive) -(require 'helm-net) - -(declare-function addressbook-bookmark-edit "ext:addressbook-bookmark.el" (bookmark)) -(declare-function message-buffers "message.el") -(declare-function addressbook-set-mail-buffer-1 "ext:addressbook-bookmark.el" - (&optional bookmark-name append cc)) - - -(defgroup helm-bookmark nil - "Predefined configurations for `helm.el'." - :group 'helm) - -(defcustom helm-bookmark-show-location nil - "Show location of bookmark on display." - :group 'helm-bookmark - :type 'boolean) - - -(defface helm-bookmark-info - '((t (:foreground "green"))) - "Face used for W3m Emacs bookmarks (not w3m bookmarks)." - :group 'helm-bookmark) - -(defface helm-bookmark-w3m - '((t (:foreground "yellow"))) - "Face used for W3m Emacs bookmarks (not w3m bookmarks)." - :group 'helm-bookmark) - -(defface helm-bookmark-gnus - '((t (:foreground "magenta"))) - "Face used for Gnus bookmarks." - :group 'helm-bookmark) - -(defface helm-bookmark-man - '((t (:foreground "Orange4"))) - "Face used for Woman/man bookmarks." - :group 'helm-bookmark) - -(defface helm-bookmark-file - '((t (:foreground "Deepskyblue2"))) - "Face used for file bookmarks." - :group 'helm-bookmark) - -(defface helm-bookmark-directory - '((t (:inherit helm-ff-directory))) - "Face used for file bookmarks." - :group 'helm-bookmark) - -(defface helm-bookmark-addressbook - '((t (:foreground "tomato"))) - "Face used for addressbook bookmarks." - :group 'helm-bookmark) - - -(defvar helm-bookmark-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c o") 'helm-bookmark-run-jump-other-window) - (define-key map (kbd "C-d") 'helm-bookmark-run-delete) - (define-key map (kbd "C-]") 'helm-bookmark-toggle-filename) - (define-key map (kbd "M-e") 'helm-bookmark-run-edit) - (define-key map (kbd "C-c ?") 'helm-bookmark-help) - map) - "Generic Keymap for emacs bookmark sources.") - -(defclass helm-source-basic-bookmarks (helm-source-in-buffer helm-type-bookmark) - ((init :initform (lambda () - (bookmark-maybe-load-default-file) - (helm-init-candidates-in-buffer - 'global - (bookmark-all-names)))) - (filtered-candidate-transformer :initform 'helm-bookmark-transformer) - (search :initform 'helm-bookmark-search-fn))) - -(defvar helm-source-bookmarks - (helm-make-source "Bookmarks" 'helm-source-basic-bookmarks) - "See (info \"(emacs)Bookmarks\").") - -(defun helm-bookmark-transformer (candidates _source) - (cl-loop for i in candidates - for loc = (bookmark-location i) - for len = (string-width i) - for trunc = (if (> len bookmark-bmenu-file-column) - (helm-substring i bookmark-bmenu-file-column) - i) - for sep = (make-string (- (+ bookmark-bmenu-file-column 2) - (length trunc)) - ? ) - if helm-bookmark-show-location - collect (cons (concat trunc sep (if (listp loc) (car loc) loc)) i) - else collect i)) - -(defun helm-bookmark-match-fn (candidate) - "Match function for bookmark sources using `candidates'." - (if helm-bookmark-show-location - ;; match only location, match-plugin will match also name. - (string-match helm-pattern (bookmark-location candidate)) - (string-match helm-pattern candidate))) - -(defun helm-bookmark-toggle-filename-1 (_candidate) - (let* ((real (helm-get-selection helm-buffer)) - (trunc (if (> (string-width real) bookmark-bmenu-file-column) - (helm-substring real bookmark-bmenu-file-column) - real)) - (loc (bookmark-location real))) - (setq helm-bookmark-show-location (not helm-bookmark-show-location)) - (helm-force-update (if helm-bookmark-show-location - (concat (regexp-quote trunc) - " +" - (regexp-quote - (if (listp loc) (car loc) loc))) - real)))) - -(defun helm-bookmark-toggle-filename () - "Toggle bookmark location visibility." - (interactive) - (with-helm-alive-p - (helm-attrset 'toggle-filename - '(helm-bookmark-toggle-filename-1 . never-split)) - (helm-execute-persistent-action 'toggle-filename))) - -(defun helm-bookmark-jump (candidate) - "Jump to bookmark from keyboard." - (let ((current-prefix-arg helm-current-prefix-arg) - non-essential) - (bookmark-jump candidate))) - -(defun helm-bookmark-jump-other-window (candidate) - (let (non-essential) - (bookmark-jump-other-window candidate))) - - -;;; bookmark-set -;; -(defvar helm-source-bookmark-set - '((name . "Set Bookmark") - (dummy) - (action . bookmark-set)) - "See (info \"(emacs)Bookmarks\").") - - -;;; Colorize bookmarks by category -;; -(defvar helm-source-pp-bookmarks - '((name . "PP-Bookmarks") - (init . (lambda () - (bookmark-maybe-load-default-file) - (helm-init-candidates-in-buffer - 'global (cl-loop for b in (bookmark-all-names) collect - (propertize b 'location (bookmark-location b)))))) - (candidates-in-buffer) - (search helm-bookmark-search-fn) - (match-part . helm-pp-bookmark-match-fn) - (filtered-candidate-transformer - helm-adaptive-sort - helm-highlight-bookmark) - (type . bookmark)) - "See (info \"(emacs)Bookmarks\").") - -(defun helm-bookmark-search-fn (pattern) - "Search function for bookmark sources using `candidates-in-buffer'. -Should be used with `helm-pp-bookmark-match-fn' as `match-part' function." - (if helm-bookmark-show-location - (helm-aif (next-single-property-change (point) 'location) - (goto-char it)) - (re-search-forward pattern nil t))) - -(defun helm-pp-bookmark-match-fn (candidate) - "Search function for bookmark sources using `candidates-in-buffer'. -Should be used with `helm-bookmark-search-fn' as `search' function." - (helm-aif (and helm-bookmark-show-location - (bookmark-location candidate)) - ;; Match against bookmark-name and location. - (concat candidate " " it) - ;; Match against bookmark-name. - candidate)) - - -;;; Predicates -;; -(defconst helm-bookmark--non-file-filename " - no file -" - "Name to use for `filename' entry, for non-file bookmarks.") - -(defun helm-bookmark-gnus-bookmark-p (bookmark) - "Return non-nil if BOOKMARK is a Gnus bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-gnus) - (eq (bookmark-get-handler bookmark) 'gnus-summary-bookmark-jump) - (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-gnus))) - -(defun helm-bookmark-w3m-bookmark-p (bookmark) - "Return non-nil if BOOKMARK is a W3m bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-w3m) - (eq (bookmark-get-handler bookmark) 'bookmark-w3m-bookmark-jump) - (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-w3m))) - -(defun helm-bookmark-woman-bookmark-p (bookmark) - "Return non-nil if BOOKMARK is a Woman bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-woman) - (eq (bookmark-get-handler bookmark) 'woman-bookmark-jump) - (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-woman))) - -(defun helm-bookmark-man-bookmark-p (bookmark) - "Return non-nil if BOOKMARK is a Man bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-man) - (eq (bookmark-get-handler bookmark) 'Man-bookmark-jump) - (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-man))) - -(defun helm-bookmark-woman-man-bookmark-p (bookmark) - "Return non-nil if BOOKMARK is a Man or Woman bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (or (helm-bookmark-man-bookmark-p bookmark) - (helm-bookmark-woman-bookmark-p bookmark))) - -(defun helm-bookmark-info-bookmark-p (bookmark) - "Return non-nil if BOOKMARK is an Info bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (eq (bookmark-get-handler bookmark) 'Info-bookmark-jump)) - -(defun helm-bookmark-image-bookmark-p (bookmark) - "Return non-nil if BOOKMARK bookmarks an image file." - (if (stringp bookmark) - (assoc 'image-type (assoc bookmark bookmark-alist)) - (assoc 'image-type bookmark))) - -(defun helm-bookmark-file-p (bookmark) - "Return non-nil if BOOKMARK bookmarks a file or directory. -BOOKMARK is a bookmark name or a bookmark record. -This excludes bookmarks of a more specific kind (Info, Gnus, and W3m)." - (let* ((filename (bookmark-get-filename bookmark)) - (isnonfile (equal filename helm-bookmark--non-file-filename))) - (and filename (not isnonfile) (not (bookmark-get-handler bookmark))))) - -(defun helm-bookmark-addressbook-p (bookmark) - "Return non--nil if BOOKMARK is a contact recorded with addressbook-bookmark. -BOOKMARK is a bookmark name or a bookmark record." - (if (listp bookmark) - (string= (assoc-default 'type bookmark) "addressbook") - (string= (assoc-default - 'type (assoc bookmark bookmark-alist)) "addressbook"))) - -(defun helm-bookmark-uncategorized-bookmark-p (bookmark) - "Return non--nil if BOOKMARK match no known category." - (and (not (helm-bookmark-addressbook-p bookmark)) - (not (helm-bookmark-gnus-bookmark-p bookmark)) - (not (helm-bookmark-w3m-bookmark-p bookmark)) - (not (helm-bookmark-woman-man-bookmark-p bookmark)) - (not (helm-bookmark-info-bookmark-p bookmark)) - (not (helm-bookmark-image-bookmark-p bookmark)) - (not (helm-bookmark-file-p bookmark)) - (not (helm-bookmark-addressbook-p bookmark)))) - -(defun helm-bookmark-filter-setup-alist (fn) - "Return a filtered `bookmark-alist' sorted alphabetically." - (cl-loop with alist = (cl-loop for b in bookmark-alist - when (funcall fn b) collect b) - for bmk in alist - for name = (car bmk) - collect (propertize name 'location (bookmark-location name)))) - - -;;; Bookmark handlers -;; -(defvar w3m-async-exec) -(defun helm-bookmark-jump-w3m (bookmark) - "Jump to W3m bookmark BOOKMARK, setting a new tab. -If `browse-url-browser-function' is set to something else -than `w3m-browse-url' use it." - (require 'helm-net) - (let ((file (or (bookmark-prop-get bookmark 'filename) - (bookmark-prop-get bookmark 'url))) - (buf (generate-new-buffer-name "*w3m*")) - (w3m-async-exec nil) - (really-use-w3m (equal browse-url-browser-function 'w3m-browse-url))) - (helm-browse-url file really-use-w3m) - (when really-use-w3m - (bookmark-default-handler - `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark)))))) - -;; All bookmarks recorded with the handler provided with w3m -;; (`bookmark-w3m-bookmark-jump') will use our handler which open -;; the bookmark in a new tab or in an external browser depending -;; on `browse-url-browser-function'. -(defalias 'bookmark-w3m-bookmark-jump 'helm-bookmark-jump-w3m) - -;; Provide compatibility with old handlers provided in external -;; packages bookmark-extensions.el and bookmark+. -(defalias 'bmkext-jump-woman 'woman-bookmark-jump) -(defalias 'bmkext-jump-man 'Man-bookmark-jump) -(defalias 'bmkext-jump-w3m 'helm-bookmark-jump-w3m) -(defalias 'bmkext-jump-gnus 'gnus-summary-bookmark-jump) -(defalias 'bookmarkp-jump-gnus 'gnus-summary-bookmark-jump) -(defalias 'bookmarkp-jump-w3m 'helm-bookmark-jump-w3m) -(defalias 'bookmarkp-jump-woman 'woman-bookmark-jump) -(defalias 'bookmarkp-jump-man 'Man-bookmark-jump) - - -;;;; Filtered bookmark sources -;; -;; -(defclass helm-source-filtered-bookmarks (helm-source-in-buffer helm-type-bookmark) - ((search :initform #'helm-bookmark-search-fn) - (match-part :initform #'helm-pp-bookmark-match-fn) - (filtered-candidate-transformer - :initform '(helm-adaptive-sort - helm-highlight-bookmark)))) - -;;; W3m bookmarks. -;; -(defun helm-bookmark-w3m-setup-alist () - "Specialized filter function for bookmarks w3m." - (helm-bookmark-filter-setup-alist 'helm-bookmark-w3m-bookmark-p)) - -(defvar helm-source-bookmark-w3m - (helm-make-source "Bookmark W3m" 'helm-source-filtered-bookmarks - :init (lambda () - (bookmark-maybe-load-default-file) - (helm-init-candidates-in-buffer - 'global (helm-bookmark-w3m-setup-alist))))) - -;;; Images -;; -(defun helm-bookmark-images-setup-alist () - "Specialized filter function for images bookmarks." - (helm-bookmark-filter-setup-alist 'helm-bookmark-image-bookmark-p)) - -(defvar helm-source-bookmark-images - (helm-make-source "Bookmark Images" 'helm-source-filtered-bookmarks - :init (lambda () - (bookmark-maybe-load-default-file) - (helm-init-candidates-in-buffer - 'global (helm-bookmark-images-setup-alist))))) - -;;; Woman Man -;; -(defun helm-bookmark-man-setup-alist () - "Specialized filter function for bookmarks w3m." - (helm-bookmark-filter-setup-alist 'helm-bookmark-woman-man-bookmark-p)) - -(defvar helm-source-bookmark-man - (helm-make-source "Bookmark Woman&Man" 'helm-source-filtered-bookmarks - :init (lambda () - (bookmark-maybe-load-default-file) - (helm-init-candidates-in-buffer - 'global (helm-bookmark-man-setup-alist))))) - -;;; Gnus -;; -(defun helm-bookmark-gnus-setup-alist () - "Specialized filter function for bookmarks gnus." - (helm-bookmark-filter-setup-alist 'helm-bookmark-gnus-bookmark-p)) - -(defvar helm-source-bookmark-gnus - (helm-make-source "Bookmark Gnus" 'helm-source-filtered-bookmarks - :init (lambda () - (bookmark-maybe-load-default-file) - (helm-init-candidates-in-buffer - 'global (helm-bookmark-gnus-setup-alist))))) - -;;; Info -;; -(defun helm-bookmark-info-setup-alist () - "Specialized filter function for bookmarks info." - (helm-bookmark-filter-setup-alist 'helm-bookmark-info-bookmark-p)) - -(defvar helm-source-bookmark-info - (helm-make-source "Bookmark Info" 'helm-source-filtered-bookmarks - :init (lambda () - (bookmark-maybe-load-default-file) - (helm-init-candidates-in-buffer - 'global (helm-bookmark-info-setup-alist))))) - -;;; Files and directories -;; -(defun helm-bookmark-local-files-setup-alist () - "Specialized filter function for bookmarks locals files." - (helm-bookmark-filter-setup-alist 'helm-bookmark-file-p)) - -(defvar helm-source-bookmark-files&dirs - (helm-make-source "Bookmark Files&Directories" 'helm-source-filtered-bookmarks - :init (lambda () - (bookmark-maybe-load-default-file) - (helm-init-candidates-in-buffer - 'global (helm-bookmark-local-files-setup-alist))))) - -;;; Uncategorized bookmarks -;; -(defun helm-bookmark-uncategorized-setup-alist () - "Specialized filter function for uncategorized bookmarks." - (helm-bookmark-filter-setup-alist 'helm-bookmark-uncategorized-bookmark-p)) - -(defvar helm-source-bookmark-uncategorized - (helm-make-source "Bookmark uncategorized" 'helm-source-filtered-bookmarks - :init (lambda () - (bookmark-maybe-load-default-file) - (helm-init-candidates-in-buffer - 'global (helm-bookmark-uncategorized-setup-alist))))) - -;;; Addressbook. -;; -;; -(defclass helm-bookmark-addressbook-class (helm-source-in-buffer) - ((init :initform (lambda () - (require 'addressbook-bookmark nil t) - (bookmark-maybe-load-default-file) - (helm-init-candidates-in-buffer - 'global - (helm-bookmark-addressbook-setup-alist)))) - (search :initform #'helm-bookmark-search-fn) - (match-part :initform #'helm-pp-bookmark-match-fn) - (persistent-action :initform - (lambda (candidate) - (let ((bmk (helm-bookmark-get-bookmark-from-name - candidate))) - (bookmark--jump-via bmk 'switch-to-buffer)))) - (persistent-help :initform "Show contact - Prefix with C-u to append") - (filtered-candidate-transformer :initform - '(helm-adaptive-sort - helm-highlight-bookmark)) - (action :initform (("Show Contact(s)" - . (lambda (candidate) - (let* ((contacts (helm-marked-candidates)) - (current-prefix-arg helm-current-prefix-arg)) - (bookmark-jump - (helm-bookmark-get-bookmark-from-name (car contacts))) - (helm-aif (cdr contacts) - (let ((current-prefix-arg '(4))) - (cl-loop for bmk in it do - (bookmark-jump - (helm-bookmark-get-bookmark-from-name bmk)))))))) - ("Mail To" . helm-bookmark-addressbook-send-mail-1) - ("Mail Cc" . (lambda (_candidate) - (helm-bookmark-addressbook-send-mail-1 nil 'cc))) - ("Mail Bcc" . (lambda (_candidate) - (helm-bookmark-addressbook-send-mail-1 nil 'bcc))) - ("Edit Bookmark" - . (lambda (candidate) - (let ((bmk (helm-bookmark-get-bookmark-from-name - candidate))) - (addressbook-bookmark-edit - (assoc bmk bookmark-alist))))) - ("Delete bookmark(s)" . helm-delete-marked-bookmarks) - ("Insert Email at point" - . (lambda (candidate) - (let* ((bmk (helm-bookmark-get-bookmark-from-name - candidate)) - (mlist (split-string - (assoc-default - 'email (assoc bmk bookmark-alist)) - ", "))) - (insert - (if (> (length mlist) 1) - (helm-comp-read - "Insert Mail Address: " mlist :must-match t) - (car mlist)))))) - ("Show annotation" - . (lambda (candidate) - (let ((bmk (helm-bookmark-get-bookmark-from-name - candidate))) - (bookmark-show-annotation bmk)))) - ("Edit annotation" - . (lambda (candidate) - (let ((bmk (helm-bookmark-get-bookmark-from-name - candidate))) - (bookmark-edit-annotation bmk)))) - ("Show Google map" - . (lambda (candidate) - (let* ((bmk (helm-bookmark-get-bookmark-from-name - candidate)) - (full-bmk (assoc bmk bookmark-alist))) - (addressbook-google-map full-bmk)))))))) - -(defun helm-bookmark-addressbook-send-mail-1 (_candidate &optional cc) - (let* ((contacts (helm-marked-candidates)) - (bookmark (helm-bookmark-get-bookmark-from-name - (car contacts))) - (append (message-buffers))) - (addressbook-set-mail-buffer-1 bookmark append) - (helm-aif (cdr contacts) - (progn - (when cc (addressbook-set-mail-buffer-1 (car it) nil cc)) - (cl-loop for bmk in (cdr it) do - (addressbook-set-mail-buffer-1 - (helm-bookmark-get-bookmark-from-name bmk) 'append cc)))))) - -(defun helm-bookmark-addressbook-setup-alist () - "Specialized filter function for addressbook bookmarks." - (helm-bookmark-filter-setup-alist 'helm-bookmark-addressbook-p)) - -(defvar helm-source-bookmark-addressbook - (helm-make-source "Bookmark Addressbook" 'helm-bookmark-addressbook-class)) - -;;; Transformer -;; - -(defun helm-highlight-bookmark (bookmarks _source) - "Used as `filtered-candidate-transformer' to colorize bookmarks. -Work both with standard Emacs bookmarks and bookmark-extensions.el." - (let ((non-essential t)) - (cl-loop for i in bookmarks - for isfile = (bookmark-get-filename i) - for handlerp = (and (fboundp 'bookmark-get-handler) - (bookmark-get-handler i)) - for isw3m = (and (fboundp 'helm-bookmark-w3m-bookmark-p) - (helm-bookmark-w3m-bookmark-p i)) - for isgnus = (and (fboundp 'helm-bookmark-gnus-bookmark-p) - (helm-bookmark-gnus-bookmark-p i)) - for isman = (and (fboundp 'helm-bookmark-man-bookmark-p) ; Man - (helm-bookmark-man-bookmark-p i)) - for iswoman = (and (fboundp 'helm-bookmark-woman-bookmark-p) ; Woman - (helm-bookmark-woman-bookmark-p i)) - for isannotation = (bookmark-get-annotation i) - for isabook = (string= (bookmark-prop-get i 'type) - "addressbook") - for isinfo = (eq handlerp 'Info-bookmark-jump) - for loc = (bookmark-location i) - for len = (string-width i) - for trunc = (if (and helm-bookmark-show-location - (> len bookmark-bmenu-file-column)) - (helm-substring - i bookmark-bmenu-file-column) - i) - ;; Add a * if bookmark have annotation - if (and isannotation (not (string-equal isannotation ""))) - do (setq trunc (concat "*" (if helm-bookmark-show-location trunc i))) - for sep = (and helm-bookmark-show-location - (make-string (- (+ bookmark-bmenu-file-column 2) - (string-width trunc)) - ? )) - for bmk = (cond ( ;; info buffers - isinfo - (propertize trunc 'face 'helm-bookmark-info - 'help-echo isfile)) - ( ;; w3m buffers - isw3m - (propertize trunc 'face 'helm-bookmark-w3m - 'help-echo isfile)) - ( ;; gnus buffers - isgnus - (propertize trunc 'face 'helm-bookmark-gnus - 'help-echo isfile)) - ( ;; Man Woman - (or iswoman isman) - (propertize trunc 'face 'helm-bookmark-man - 'help-echo isfile)) - ( ;; Addressbook - isabook - (propertize trunc 'face 'helm-bookmark-addressbook)) - ( ;; directories - (and isfile - ;; This is needed because `non-essential' - ;; is not working on Emacs-24.2 and the behavior - ;; of tramp seems to have changed since previous - ;; versions (Need to reenter password even if a - ;; first connection have been established, - ;; probably when host is named differently - ;; i.e machine/localhost) - (not (file-remote-p isfile)) - (file-directory-p isfile)) - (propertize trunc 'face 'helm-bookmark-directory - 'help-echo isfile)) - ( ;; regular files - t - (propertize trunc 'face 'helm-bookmark-file - 'help-echo isfile))) - collect (if helm-bookmark-show-location - (cons (concat bmk sep (if (listp loc) (car loc) loc)) - i) - (cons bmk i))))) - -(defun helm-bookmark-edit-bookmark (bookmark-name) - "Edit bookmark's name and file name, and maybe save them. -BOOKMARK-NAME is the current (old) name of the bookmark to be renamed." - (let ((bmk (helm-bookmark-get-bookmark-from-name bookmark-name)) - (handler (bookmark-prop-get bookmark-name 'handler))) - (if (eq handler 'addressbook-bookmark-jump) - (addressbook-bookmark-edit - (assoc bmk bookmark-alist)) - (helm-bookmark-edit-bookmark-1 bookmark-name handler)))) - -(defun helm-bookmark-edit-bookmark-1 (bookmark-name handler) - (let* ((helm--reading-passwd-or-string t) - (bookmark-fname (bookmark-get-filename bookmark-name)) - (bookmark-loc (bookmark-prop-get bookmark-name 'location)) - (new-name (read-from-minibuffer "Name: " bookmark-name)) - (new-loc (read-from-minibuffer "FileName or Location: " - (or bookmark-fname - (if (consp bookmark-loc) - (car bookmark-loc) - bookmark-loc)))) - (docid (and (eq handler 'mu4e-bookmark-jump) - (read-number "Docid: " (cdr bookmark-loc))))) - (when docid - (setq new-loc (cons new-loc docid))) - (when (and (not (equal new-name "")) (not (equal new-loc "")) - (y-or-n-p "Save changes? ")) - (if bookmark-fname - (progn - (helm-bookmark-rename bookmark-name new-name 'batch) - (bookmark-set-filename new-name new-loc)) - (bookmark-prop-set - (bookmark-get-bookmark bookmark-name) 'location new-loc) - (helm-bookmark-rename bookmark-name new-name 'batch)) - (helm-bookmark-maybe-save-bookmark) - (list new-name new-loc)))) - -(defun helm-bookmark-maybe-save-bookmark () - "Increment save counter and maybe save `bookmark-alist'." - (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)) - (when (bookmark-time-to-save-p) (bookmark-save))) - -(defun helm-bookmark-rename (old &optional new batch) - "Change bookmark's name from OLD to NEW. -Interactively: - If called from the keyboard, then prompt for OLD. - If called from the menubar, select OLD from a menu. -If NEW is nil, then prompt for its string value. - -If BATCH is non-nil, then do not rebuild the menu list. - -While the user enters the new name, repeated `C-w' inserts consecutive -words from the buffer into the new bookmark name." - (interactive (list (bookmark-completing-read "Old bookmark name"))) - (bookmark-maybe-historicize-string old) - (bookmark-maybe-load-default-file) - (save-excursion (skip-chars-forward " ") (setq bookmark-yank-point (point))) - (setq bookmark-current-buffer (current-buffer)) - (let ((newname (or new (read-from-minibuffer - "New name: " nil - (let ((now-map (copy-keymap minibuffer-local-map))) - (define-key now-map "\C-w" 'bookmark-yank-word) - now-map) - nil 'bookmark-history)))) - (bookmark-set-name old newname) - (setq bookmark-current-bookmark newname) - (unless batch (bookmark-bmenu-surreptitiously-rebuild-list)) - (helm-bookmark-maybe-save-bookmark) newname)) - -(defun helm-bookmark-run-edit () - "Run `helm-bookmark-edit-bookmark' from keyboard." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-bookmark-edit-bookmark))) - - -;;; Bookmarks attributes -;; -(define-helm-type-attribute 'bookmark - `((coerce . helm-bookmark-get-bookmark-from-name) - (action . ,(helm-make-actions - "Jump to bookmark" 'helm-bookmark-jump - "Jump to BM other window" 'helm-bookmark-jump-other-window - "Bookmark edit annotation" 'bookmark-edit-annotation - "Bookmark show annotation" 'bookmark-show-annotation - "Delete bookmark(s)" 'helm-delete-marked-bookmarks - "Edit Bookmark" 'helm-bookmark-edit-bookmark - "Rename bookmark" 'helm-bookmark-rename - "Relocate bookmark" 'bookmark-relocate)) - (keymap . ,helm-bookmark-map) - (mode-line . helm-bookmark-mode-line-string)) - "Bookmark name.") - - -(defun helm-bookmark-run-jump-other-window () - "Jump to bookmark from keyboard." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'bookmark-jump-other-window))) - -(defun helm-bookmark-run-delete () - "Delete bookmark from keyboard." - (interactive) - (with-helm-alive-p - (when (y-or-n-p "Delete bookmark(s)?") - (helm-quit-and-execute-action 'helm-delete-marked-bookmarks)))) - -(defun helm-bookmark-get-bookmark-from-name (bmk) - "Return bookmark name even if it is a bookmark with annotation. -e.g prepended with *." - (let ((bookmark (replace-regexp-in-string "\\`\\*" "" bmk))) - (if (assoc bookmark bookmark-alist) bookmark bmk))) - -(defun helm-delete-marked-bookmarks (_ignore) - "Delete this bookmark or all marked bookmarks." - (cl-dolist (i (helm-marked-candidates)) - (bookmark-delete (helm-bookmark-get-bookmark-from-name i) - 'batch))) - - -;;;###autoload -(defun helm-bookmarks () - "Preconfigured `helm' for bookmarks." - (interactive) - (helm :sources '(helm-source-bookmarks - helm-source-bookmark-set) - :buffer "*helm bookmarks*" - :default (buffer-name helm-current-buffer))) - -;;;###autoload -(defun helm-pp-bookmarks () - "Preconfigured `helm' for bookmarks (pretty-printed)." - (interactive) - (helm :sources '(helm-source-pp-bookmarks - helm-source-bookmark-set) - :buffer "*helm pp bookmarks*" - :default (buffer-name helm-current-buffer))) - -;;;###autoload -(defun helm-filtered-bookmarks () - "Preconfigured helm for bookmarks (filtered by category). -Optional source `helm-source-bookmark-addressbook' is loaded -only if external library addressbook-bookmark.el is available." - (interactive) - (helm :sources (append '(helm-source-bookmark-files&dirs - helm-source-bookmark-info - helm-source-bookmark-gnus - helm-source-bookmark-man - helm-source-bookmark-images - helm-source-bookmark-w3m) - (and (locate-library "addressbook-bookmark") - (list 'helm-source-bookmark-addressbook)) - (list helm-source-bookmark-uncategorized - 'helm-source-bookmark-set)) - :prompt "Search Bookmark: " - :buffer "*helm filtered bookmarks*" - :default (list (thing-at-point 'symbol) - (buffer-name helm-current-buffer)))) - -(provide 'helm-bookmark) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-bookmark.el ends here diff --git a/elpa/helm-20150403.101/helm-buffers.el b/elpa/helm-20150403.101/helm-buffers.el deleted file mode 100644 index 6775f329..00000000 --- a/elpa/helm-20150403.101/helm-buffers.el +++ /dev/null @@ -1,854 +0,0 @@ -;;; helm-buffers.el --- helm support for buffers. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-utils) -(require 'helm-elscreen) -(require 'helm-grep) -(require 'helm-plugin) -(require 'helm-regexp) -(require 'helm-help) - -(declare-function ido-make-buffer-list "ido" (default)) -(declare-function ido-add-virtual-buffers-to-list "ido") -(declare-function helm-comp-read "helm-mode") - - -(defgroup helm-buffers nil - "Buffers related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-boring-buffer-regexp-list - '("\\` " "\\*helm" "\\*helm-mode" "\\*Echo Area" "\\*Minibuf") - "The regexp list that match boring buffers. -Buffer candidates matching these regular expression will be -filtered from the list of candidates if the -`helm-skip-boring-buffers' candidate transformer is used." - :type '(repeat (choice regexp)) - :group 'helm-buffers) - -(defcustom helm-buffers-favorite-modes '(lisp-interaction-mode - emacs-lisp-mode - text-mode - org-mode) - "List of preferred mode to open new buffers with." - :type '(repeat (choice function)) - :group 'helm-buffers) - -(defcustom helm-buffer-max-length 20 - "Max length of buffer names before truncate. -When disabled (nil) use the longest buffer-name length found." - :group 'helm-buffers - :type '(choice (const :tag "Disabled" nil) - (integer :tag "Length before truncate"))) - -(defcustom helm-buffer-details-flag t - "Always show details in buffer list when non--nil." - :group 'helm-buffers - :type 'boolean) - -(defcustom helm-buffers-fuzzy-matching nil - "Fuzzy matching buffer names when non--nil. -Only buffer names are fuzzy matched when this is enabled, -`major-mode' matching is not affected by this." - :group 'helm-buffers - :type 'boolean) - -(defcustom helm-buffer-skip-remote-checking nil - "Ignore checking for `file-exists-p' on remote files." - :group 'helm-buffers - :type 'boolean) - -;;; Faces -;; -;; -(defgroup helm-buffers-faces nil - "Customize the appearance of helm-buffers." - :prefix "helm-" - :group 'helm-buffers - :group 'helm-faces) - -(defface helm-buffer-saved-out - '((t (:foreground "red" :background "black"))) - "Face used for buffer files modified outside of emacs." - :group 'helm-buffers-faces) - -(defface helm-buffer-not-saved - '((t (:foreground "Indianred2"))) - "Face used for buffer files not already saved on disk." - :group 'helm-buffers-faces) - -(defface helm-buffer-size - '((((background dark)) :foreground "RosyBrown") - (((background light)) :foreground "SlateGray")) - "Face used for buffer size." - :group 'helm-buffers-faces) - -(defface helm-buffer-process - '((t (:foreground "Sienna3"))) - "Face used for process status in buffer." - :group 'helm-buffers-faces) - -(defface helm-buffer-directory - '((t (:foreground "DarkRed" :background "LightGray"))) - "Face used for directories in `helm-buffers-list'." - :group 'helm-buffers-faces) - -(defface helm-buffer-file - '((t :inherit font-lock-builtin-face)) - "Face for buffer file names in `helm-buffers-list'." - :group 'helm-buffers-faces) - - -;;; Buffers keymap -;; -(defvar helm-buffer-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c ?") 'helm-buffer-help) - ;; No need to have separate command for grep and zgrep - ;; as we don't use recursivity for buffers. - ;; So use zgrep for both as it is capable to handle non--compressed files. - (define-key map (kbd "M-g s") 'helm-buffer-run-zgrep) - (define-key map (kbd "C-s") 'helm-buffers-run-multi-occur) - (define-key map (kbd "C-c o") 'helm-buffer-switch-other-window) - (define-key map (kbd "C-c C-o") 'helm-buffer-switch-other-frame) - (define-key map (kbd "C-c =") 'helm-buffer-run-ediff) - (define-key map (kbd "M-=") 'helm-buffer-run-ediff-merge) - (define-key map (kbd "C-=") 'helm-buffer-diff-persistent) - (define-key map (kbd "M-U") 'helm-buffer-revert-persistent) - (define-key map (kbd "C-c d") 'helm-buffer-run-kill-persistent) - (define-key map (kbd "M-D") 'helm-buffer-run-kill-buffers) - (define-key map (kbd "C-x C-s") 'helm-buffer-save-persistent) - (define-key map (kbd "C-M-%") 'helm-buffer-run-query-replace-regexp) - (define-key map (kbd "M-%") 'helm-buffer-run-query-replace) - (define-key map (kbd "M-m") 'helm-toggle-all-marks) - (define-key map (kbd "M-a") 'helm-mark-all) - (define-key map (kbd "C-]") 'helm-toggle-buffers-details) - (define-key map (kbd "C-c a") 'helm-buffers-toggle-show-hidden-buffers) - (define-key map (kbd "") 'helm-buffers-mark-similar-buffers) - map) - "Keymap for buffer sources in helm.") - -(defvar helm-buffers-ido-virtual-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c ?") 'helm-buffers-ido-virtual-help) - (define-key map (kbd "C-c o") 'helm-ff-run-switch-other-window) - (define-key map (kbd "C-c C-o") 'helm-ff-run-switch-other-frame) - (define-key map (kbd "M-g s") 'helm-ff-run-grep) - (define-key map (kbd "M-g z") 'helm-ff-run-zgrep) - (define-key map (kbd "M-D") 'helm-ff-run-delete-file) - (define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally) - map)) - - -(defvar helm-buffers-list-cache nil) -(defvar helm-buffer-max-len-mode nil) -(defclass helm-source-buffers (helm-source-sync helm-type-buffer) - ((buffer-list - :initarg :buffer-list - :initform #'helm-buffer-list - :custom function - :documentation - " A function with no arguments to create buffer list.") - (init :initform (lambda () - ;; Issue #51 Create the list before `helm-buffer' creation. - (setq helm-buffers-list-cache (funcall (helm-attr 'buffer-list))) - (let ((result (cl-loop for b in helm-buffers-list-cache - maximize (length b) into len-buf - maximize (length (with-current-buffer b - (symbol-name major-mode))) - into len-mode - finally return (cons len-buf len-mode)))) - (unless helm-buffer-max-length - (setq helm-buffer-max-length (car result))) - (unless helm-buffer-max-len-mode - ;; If a new buffer is longer that this value - ;; this value will be updated - (setq helm-buffer-max-len-mode (cdr result)))))) - (candidates :initform helm-buffers-list-cache) - (matchplugin :initform nil) - ;(nohighlight :initform t) - (match :initform 'helm-buffers-match-function) - (persistent-action :initform 'helm-buffers-list-persistent-action) - (resume :initform (lambda () - (run-with-idle-timer - 0.1 nil (lambda () - (with-helm-buffer - (helm-force-update)))))) - (keymap :initform helm-buffer-map) - (volatile :initform t) - (mode-line :initform helm-buffer-mode-line-string) - (persistent-help - :initform - "Show this buffer / C-u \\[helm-execute-persistent-action]: Kill this buffer"))) - -(defvar helm-source-buffers-list nil) - -(defvar helm-source-buffer-not-found - (helm-build-dummy-source - "Create buffer" - :action (helm-make-actions - "Create buffer (C-u choose mode)" - (lambda (candidate) - (let ((mjm (or (and helm-current-prefix-arg - (intern-soft (helm-comp-read - "Major-mode: " - helm-buffers-favorite-modes))) - (cl-loop for (r . m) in auto-mode-alist - when (string-match r candidate) - return m))) - (buffer (get-buffer-create candidate))) - (if mjm - (with-current-buffer buffer (funcall mjm)) - (set-buffer-major-mode buffer)) - (switch-to-buffer buffer)))))) - -(defvar ido-temp-list) -(defvar ido-ignored-list) -(defvar ido-process-ignore-lists) -(defvar ido-use-virtual-buffers) -(defvar ido-virtual-buffers) - -(defvar helm-source-ido-virtual-buffers - (helm-build-sync-source "Ido virtual buffers" - :candidates (lambda () - (let (ido-temp-list - ido-ignored-list - (ido-process-ignore-lists t)) - (when ido-use-virtual-buffers - (ido-add-virtual-buffers-to-list) - ido-virtual-buffers))) - :fuzzy-match helm-buffers-fuzzy-matching - :keymap helm-buffers-ido-virtual-map - :mode-line helm-buffers-ido-virtual-mode-line-string - :action '(("Find file" . helm-find-many-files) - ("Find file other window" . find-file-other-window) - ("Find file other frame" . find-file-other-frame) - ("Find file as root" . helm-find-file-as-root) - ("Grep File(s) `C-u recurse'" . helm-find-files-grep) - ("Zgrep File(s) `C-u Recurse'" . helm-ff-zgrep) - ("View file" . view-file) - ("Delete file(s)" . helm-delete-marked-files) - ("Open file externally (C-u to choose)" - . helm-open-file-externally)))) - - -(defvar ido-use-virtual-buffers) -(defun helm-buffer-list () - "Return the current list of buffers. -Currently visible buffers are put at the end of the list. -See `ido-make-buffer-list' for more infos." - (require 'ido) - (let ((ido-process-ignore-lists t) - ido-ignored-list - ido-use-virtual-buffers) - (ido-make-buffer-list nil))) - -(defun helm-buffer-size (buffer) - "Return size of BUFFER." - (with-current-buffer buffer - (save-restriction - (widen) - (helm-file-human-size - (- (position-bytes (point-max)) - (position-bytes (point-min))))))) - -(defun helm-buffer--show-details (buf-name prefix help-echo - size mode dir face1 face2 - proc details type) - (append - (list - (concat prefix - (propertize buf-name 'face face1 - 'help-echo help-echo - 'type type))) - (and details - (list size mode - (propertize - (if proc - (format "(%s %s in `%s')" - (process-name proc) - (process-status proc) dir) - (format "(in `%s')" dir)) - 'face face2))))) - -(defun helm-buffer--details (buffer &optional details) - (let* ((mode (with-current-buffer buffer (format-mode-line mode-name))) - (buf (get-buffer buffer)) - (size (propertize (helm-buffer-size buf) - 'face 'helm-buffer-size)) - (proc (get-buffer-process buf)) - (dir (with-current-buffer buffer (abbreviate-file-name default-directory))) - (file-name (helm-aif (buffer-file-name buf) (abbreviate-file-name it))) - (name (buffer-name buf)) - (name-prefix (when (file-remote-p dir) - (propertize "@ " 'face 'helm-ff-prefix)))) - ;; No fancy things on remote buffers. - (if (and name-prefix helm-buffer-skip-remote-checking) - (helm-buffer--show-details - name name-prefix file-name size mode dir - 'helm-buffer-file 'helm-buffer-process nil details 'filebuf) - (cond - ( ;; A dired buffer. - (rassoc buf dired-buffers) - (helm-buffer--show-details - name name-prefix dir size mode dir - 'helm-buffer-directory 'helm-buffer-process nil details 'dired)) - ;; A buffer file modified somewhere outside of emacs.=>red - ((and file-name - (file-exists-p file-name) - (not (verify-visited-file-modtime buf))) - (helm-buffer--show-details - name name-prefix file-name size mode dir - 'helm-buffer-saved-out 'helm-buffer-process nil details 'modout)) - ;; A new buffer file not already saved on disk.=>indianred2 - ((and file-name - (not (verify-visited-file-modtime buf))) - (helm-buffer--show-details - name name-prefix file-name size mode dir - 'helm-buffer-not-saved 'helm-buffer-process nil details 'notsaved)) - ;; A buffer file modified and not saved on disk.=>orange - ((and file-name (buffer-modified-p buf)) - (helm-buffer--show-details - name name-prefix file-name size mode dir - 'helm-ff-symlink 'helm-buffer-process nil details 'mod)) - ;; A buffer file not modified and saved on disk.=>green - (file-name - (helm-buffer--show-details - name name-prefix file-name size mode dir - 'helm-buffer-file 'helm-buffer-process nil details 'filebuf)) - ;; Any non--file buffer.=>grey italic - (t - (helm-buffer--show-details - name (and proc name-prefix) dir size mode dir - 'italic 'helm-buffer-process proc details 'nofile)))))) - -(defun helm-highlight-buffers (buffers _source) - "Transformer function to highlight BUFFERS list. -Should be called after others transformers i.e (boring buffers)." - (cl-loop for i in buffers - for (name size mode meta) = (if helm-buffer-details-flag - (helm-buffer--details i 'details) - (helm-buffer--details i)) - for truncbuf = (if (> (string-width name) helm-buffer-max-length) - (helm-substring-by-width - name helm-buffer-max-length) - (concat name (make-string - (- (+ helm-buffer-max-length 3) - (string-width name)) ? ))) - for len = (length mode) - when (> len helm-buffer-max-len-mode) - do (setq helm-buffer-max-len-mode len) - for fmode = (concat (make-string - (- (max helm-buffer-max-len-mode len) len) ? ) - mode) - ;; The max length of a number should be 1023.9X where X is the - ;; units, this is 7 characters. - for formatted-size = (and size (format "%7s" size)) - collect (cons (if helm-buffer-details-flag - (concat truncbuf "\t" formatted-size - " " fmode " " meta) - name) - (get-buffer i)))) - -(defun helm-buffer--get-preselection (buffer) - (let ((bufname (buffer-name buffer))) - (concat "^" - (if (and (null helm-buffer-details-flag) - (numberp helm-buffer-max-length) - (> (string-width bufname) - helm-buffer-max-length)) - (regexp-quote - (helm-substring-by-width - bufname helm-buffer-max-length)) - (concat (regexp-quote bufname) - (if helm-buffer-details-flag - "$" "[[:blank:]]+")))))) - -(defun helm-toggle-buffers-details () - (interactive) - (let ((preselect (helm-buffer--get-preselection - (helm-get-selection)))) - (when helm-alive-p - (setq helm-buffer-details-flag (not helm-buffer-details-flag)) - (helm-force-update preselect)))) - -(defun helm-buffers-sort-transformer (candidates _source) - (if (string= helm-pattern "") - candidates - (sort candidates - #'(lambda (s1 s2) - (< (string-width s1) (string-width s2)))))) - -(defun helm-buffers-mark-similar-buffers-1 () - (with-helm-window - (let ((type (get-text-property - 0 'type (helm-get-selection nil 'withprop)))) - (save-excursion - (goto-char (helm-get-previous-header-pos)) - (helm-next-line) - (let* ((next-head (helm-get-next-header-pos)) - (end (and next-head - (save-excursion - (goto-char next-head) - (forward-line -1) - (point)))) - (maxpoint (or end (point-max)))) - (while (< (point) maxpoint) - (helm-mark-current-line) - (let ((cand (helm-get-selection nil 'withprop))) - (when (and (not (helm-this-visible-mark)) - (eq (get-text-property 0 'type cand) type)) - (helm-make-visible-mark))) - (forward-line 1) (end-of-line)))) - (helm-mark-current-line) - (message "%s candidates marked" (length helm-marked-candidates))))) - -(defun helm-buffers-mark-similar-buffers () - "Mark All buffers that have same property `type' than current. -i.e same color." - (interactive) - (let ((marked (helm-marked-candidates))) - (if (and (>= (length marked) 1) - (with-helm-window helm-visible-mark-overlays)) - (helm-unmark-all) - (helm-buffers-mark-similar-buffers-1)))) - - -;;; match functions -;; -(defun helm-buffer--match-mjm (pattern mjm) - (when (string-match "\\`\\*" pattern) - (cl-loop with patterns = (split-string (substring pattern 1) ",") - for pat in patterns - if (string-match "\\`!" pat) - collect (string-match (substring pat 1) mjm) into neg - else collect (string-match pat mjm) into pos - finally return - (let ((neg-test (cl-loop for i in neg thereis (numberp i))) - (pos-test (cl-loop for i in pos thereis (numberp i)))) - (or - (and neg (not pos) (not neg-test)) - (and pos pos-test) - (and neg neg-test (not neg-test))))))) - -(defun helm-buffer--match-pattern (pattern candidate) - (let ((fun (if (and helm-buffers-fuzzy-matching - (not (string-match "\\`\\^" pattern))) - #'helm--mapconcat-pattern - #'identity))) - (if (string-match "\\`!" pattern) - (not (string-match (funcall fun (substring pattern 1)) - candidate)) - (string-match (funcall fun pattern) candidate)))) - -(defun helm-buffers--match-from-mjm (candidate) - (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate)) - (buf (get-buffer cand)) - (regexp (cl-loop with pattern = helm-pattern - for p in (split-string pattern) - when (string-match "\\`\\*" p) - return p))) - (if regexp - (when buf - (with-current-buffer buf - (let ((mjm (format-mode-line mode-name))) - (helm-buffer--match-mjm regexp mjm)))) - t))) - -(defun helm-buffers--match-from-pat (candidate) - (let ((regexp-list (cl-loop with pattern = helm-pattern - for p in (split-string pattern) - unless (string-match - "\\`\\(\\*\\)\\|\\(/\\)\\|\\(@\\)" p) - collect p))) - (if regexp-list - (cl-loop for re in regexp-list - always (helm-buffer--match-pattern re candidate)) - t))) - -(defun helm-buffers--match-from-inside (candidate) - (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate)) - (buf (get-buffer cand)) - (regexp (cl-loop with pattern = helm-pattern - for p in (split-string pattern) - when (string-match "\\`@\\(.*\\)" p) - return (match-string 1 p)))) - (if regexp - (with-current-buffer buf - (save-excursion - (goto-char (point-min)) - (re-search-forward regexp nil t))) - t))) - -(defun helm-buffers--match-from-directory (candidate) - (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate)) - (buf (get-buffer cand)) - (buf-fname (buffer-file-name buf)) - (regexps (cl-loop with pattern = helm-pattern - for p in (split-string pattern) - when (string-match "\\`/" p) - collect p))) - (if regexps - (cl-loop for re in regexps - thereis - (and buf-fname - (string-match - (substring re 1) (helm-basedir buf-fname)))) - t))) - -(defun helm-buffers-match-function (candidate) - "Default function to match buffers." - (and (helm-buffers--match-from-pat candidate) - (helm-buffers--match-from-mjm candidate) - (helm-buffers--match-from-inside candidate) - (helm-buffers--match-from-directory candidate))) - - -(defun helm-buffer-query-replace-1 (&optional regexp-flag buffers) - "Query replace in marked buffers. -If REGEXP-FLAG is given use `query-replace-regexp'." - (let ((fn (if regexp-flag 'query-replace-regexp 'query-replace)) - (prompt (if regexp-flag "Query replace regexp" "Query replace")) - (bufs (or buffers (helm-marked-candidates))) - (helm--reading-passwd-or-string t)) - (cl-loop with replace = (query-replace-read-from prompt regexp-flag) - with tostring = (unless (consp replace) - (query-replace-read-to - replace prompt regexp-flag)) - for buf in bufs - do - (save-window-excursion - (switch-to-buffer buf) - (save-excursion - (let ((case-fold-search t)) - (goto-char (point-min)) - (if (consp replace) - (apply fn (list (car replace) (cdr replace))) - (apply fn (list replace tostring))))))))) - -(defun helm-buffer-query-replace-regexp (_candidate) - (helm-buffer-query-replace-1 'regexp)) - -(defun helm-buffer-query-replace (_candidate) - (helm-buffer-query-replace-1)) - -(defun helm-buffer-toggle-diff (candidate) - "Toggle diff buffer CANDIDATE with it's file." - (let (helm-persistent-action-use-special-display) - (helm-aif (get-buffer-window "*Diff*") - (progn (kill-buffer "*Diff*") - (set-window-buffer it helm-current-buffer)) - (diff-buffer-with-file (get-buffer candidate))))) - -(defun helm-buffer-diff-persistent () - "Toggle diff buffer without quitting helm." - (interactive) - (with-helm-alive-p - (helm-attrset 'diff-action 'helm-buffer-toggle-diff) - (helm-execute-persistent-action 'diff-action))) - -(defun helm-revert-buffer (candidate) - (with-current-buffer candidate - (helm-aif (buffer-file-name) - (and (file-exists-p it) (revert-buffer t t))))) - -(defun helm-revert-marked-buffers (_ignore) - (mapc 'helm-revert-buffer (helm-marked-candidates))) - -(defun helm-buffer-revert-and-update (_candidate) - (let ((marked (helm-marked-candidates)) - (preselect (helm-buffers--quote-truncated-buffer - (helm-get-selection)))) - (cl-loop for buf in marked do (helm-revert-buffer buf)) - (when (> (length marked) 1) (helm-unmark-all)) - (helm-force-update preselect))) - -(defun helm-buffer-revert-persistent () - "Revert buffer without quitting helm." - (interactive) - (with-helm-alive-p - (helm-attrset 'revert-action '(helm-buffer-revert-and-update . never-split)) - (helm-execute-persistent-action 'revert-action))) - -(defun helm-buffer-save-and-update (_candidate) - (let ((marked (helm-marked-candidates)) - (preselect (helm-get-selection nil t)) - (enable-recursive-minibuffers t)) - (cl-loop for buf in marked do - (with-current-buffer (get-buffer buf) - (when (buffer-file-name) (save-buffer)))) - (when (> (length marked) 1) (helm-unmark-all)) - (helm-force-update (regexp-quote preselect)))) - -(defun helm-buffer-save-persistent () - "Save buffer without quitting helm." - (interactive) - (with-helm-alive-p - (helm-attrset 'save-action '(helm-buffer-save-and-update . never-split)) - (helm-execute-persistent-action 'save-action))) - -(defun helm-buffer-run-kill-persistent () - "Kill buffer without quitting helm." - (interactive) - (with-helm-alive-p - (helm-attrset 'kill-action '(helm-buffers-persistent-kill . never-split)) - (helm-execute-persistent-action 'kill-action))) - -(defun helm-kill-marked-buffers (_ignore) - (mapc 'kill-buffer (helm-marked-candidates)) - (with-helm-buffer - (setq helm-marked-candidates nil - helm-visible-mark-overlays nil))) - -(defun helm-buffer-run-kill-buffers () - "Run kill buffer action from `helm-source-buffers-list'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-kill-marked-buffers))) - -(defun helm-buffer-run-grep () - "Run Grep action from `helm-source-buffers-list'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-grep-buffers))) - -(defun helm-buffer-run-zgrep () - "Run Grep action from `helm-source-buffers-list'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-zgrep-buffers))) - -(defun helm-buffer-run-query-replace-regexp () - "Run Query replace regexp action from `helm-source-buffers-list'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-buffer-query-replace-regexp))) - -(defun helm-buffer-run-query-replace () - "Run Query replace action from `helm-source-buffers-list'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-buffer-query-replace))) - -(defun helm-buffer-switch-other-window () - "Run switch to other window action from `helm-source-buffers-list'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-switch-to-buffers-other-window))) - -(defun helm-buffer-switch-other-frame () - "Run switch to other frame action from `helm-source-buffers-list'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'switch-to-buffer-other-frame))) - -(defun helm-buffer-switch-to-elscreen () - "Run switch to elscreen action from `helm-source-buffers-list'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-find-buffer-on-elscreen))) - -(defun helm-buffer-run-ediff () - "Run ediff action from `helm-source-buffers-list'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-ediff-marked-buffers))) - -(defun helm-buffer-run-ediff-merge () - "Run ediff action from `helm-source-buffers-list'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-ediff-marked-buffers-merge))) - -(defun helm-buffers-persistent-kill-1 (buffer) - "Persistent action to kill buffer." - (with-current-buffer (get-buffer buffer) - (if (and (buffer-modified-p) - (buffer-file-name (current-buffer))) - (progn - (save-buffer) - (kill-buffer buffer)) - (kill-buffer buffer))) - (helm-delete-current-selection) - (with-helm-temp-hook 'helm-after-persistent-action-hook - (helm-force-update (regexp-quote (helm-get-selection nil t))))) - -(defun helm-buffers--quote-truncated-buffer (buffer) - (let ((bufname (and (bufferp buffer) - (buffer-name buffer)))) - (when bufname - (regexp-quote - (if helm-buffer-max-length - (helm-substring-by-width - bufname helm-buffer-max-length - "") - bufname))))) - -(defun helm-buffers-persistent-kill (_buffer) - (let ((marked (helm-marked-candidates))) - (unwind-protect - (cl-loop for b in marked - do (progn (helm-preselect - (format "^%s" - (helm-buffers--quote-truncated-buffer b))) - (when (y-or-n-p (format "kill buffer (%s)? " b)) - (helm-buffers-persistent-kill-1 b)) - (message nil))) - (with-helm-buffer - (setq helm-marked-candidates nil - helm-visible-mark-overlays nil)) - (helm-force-update (helm-buffers--quote-truncated-buffer - (helm-get-selection)))))) - -(defun helm-buffers-list-persistent-action (candidate) - (if current-prefix-arg - (helm-buffers-persistent-kill candidate) - (switch-to-buffer candidate))) - -(defun helm-ediff-marked-buffers (_candidate &optional merge) - "Ediff 2 marked buffers or CANDIDATE and `helm-current-buffer'. -With optional arg MERGE call `ediff-merge-buffers'." - (let ((lg-lst (length (helm-marked-candidates))) - buf1 buf2) - (cl-case lg-lst - (0 - (error "Error:You have to mark at least 1 buffer")) - (1 - (setq buf1 helm-current-buffer - buf2 (cl-first (helm-marked-candidates)))) - (2 - (setq buf1 (cl-first (helm-marked-candidates)) - buf2 (cl-second (helm-marked-candidates)))) - (t - (error "Error:To much buffers marked!"))) - (if merge - (ediff-merge-buffers buf1 buf2) - (ediff-buffers buf1 buf2)))) - -(defun helm-ediff-marked-buffers-merge (candidate) - "Ediff merge `helm-current-buffer' with CANDIDATE. -See `helm-ediff-marked-buffers'." - (helm-ediff-marked-buffers candidate t)) - -(defun helm-multi-occur-as-action (_candidate) - "Multi occur action for `helm-source-buffers-list'. -Can be used by any source that list buffers." - (let ((helm-moccur-always-search-in-current - (if helm-current-prefix-arg - (not helm-moccur-always-search-in-current) - helm-moccur-always-search-in-current)) - (buffers (helm-marked-candidates)) - (input (cl-loop for i in (split-string helm-pattern " " t) - thereis (and (string-match "\\`@\\(.*\\)" i) - (match-string 1 i))))) - (helm-multi-occur-1 buffers input))) - -(defun helm-buffers-run-multi-occur () - "Run `helm-multi-occur-as-action' by key." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-multi-occur-as-action))) - -(defun helm-buffers-toggle-show-hidden-buffers () - (interactive) - (with-helm-alive-p - (let ((filter-attrs (helm-attr 'filtered-candidate-transformer - helm-source-buffers-list))) - (if (memq 'helm-shadow-boring-buffers filter-attrs) - (helm-attrset 'filtered-candidate-transformer - (cons 'helm-skip-boring-buffers - (remove 'helm-shadow-boring-buffers - filter-attrs)) - helm-source-buffers-list t) - (helm-attrset 'filtered-candidate-transformer - (cons 'helm-shadow-boring-buffers - (remove 'helm-skip-boring-buffers - filter-attrs)) - helm-source-buffers-list t)) - (helm-force-update)))) - - -;;; Candidate Transformers -;; -;; -(defun helm-skip-boring-buffers (buffers _source) - (helm-skip-entries buffers helm-boring-buffer-regexp-list)) - -(defun helm-shadow-boring-buffers (buffers _source) - "Buffers matching `helm-boring-buffer-regexp' will be -displayed with the `file-name-shadow' face if available." - (helm-shadow-entries buffers helm-boring-buffer-regexp-list)) - - -(define-helm-type-attribute 'buffer - `((action - . ,(helm-make-actions - "Switch to buffer" 'switch-to-buffer - (lambda () (and (locate-library "popwin") "Switch to buffer in popup window")) - 'popwin:popup-buffer - "Switch to buffer other window `C-c o'" 'switch-to-buffer-other-window - "Switch to buffer other frame `C-c C-o'" 'switch-to-buffer-other-frame - (lambda () (and (locate-library "elscreen") "Display buffer in Elscreen")) - 'helm-find-buffer-on-elscreen - "Query replace regexp `C-M-%'" 'helm-buffer-query-replace-regexp - "Query replace `M-%'" 'helm-buffer-query-replace - "View buffer" 'view-buffer - "Display buffer" 'display-buffer - "Grep buffers `M-g s' (C-u grep all buffers)" 'helm-zgrep-buffers - "Multi occur buffer(s) `C-s'" 'helm-multi-occur-as-action - "Revert buffer(s) `M-U'" 'helm-revert-marked-buffers - "Insert buffer" 'insert-buffer - "Kill buffer(s) `M-D'" 'helm-kill-marked-buffers - "Diff with file" 'diff-buffer-with-file - "Ediff Marked buffers `C-c ='" 'helm-ediff-marked-buffers - "Ediff Merge marked buffers `M-='" (lambda (candidate) - (helm-ediff-marked-buffers candidate t)))) - (persistent-help . "Show this buffer") - (filtered-candidate-transformer helm-skip-boring-buffers - helm-buffers-sort-transformer - helm-highlight-buffers)) - "Buffer or buffer name.") - -;;;###autoload -(defun helm-buffers-list () - "Preconfigured `helm' to list buffers." - (interactive) - (unless helm-source-buffers-list - (setq helm-source-buffers-list - (helm-make-source "Buffers" 'helm-source-buffers))) - (helm :sources '(helm-source-buffers-list - helm-source-ido-virtual-buffers - helm-source-buffer-not-found) - :buffer "*helm buffers*" - :keymap helm-buffer-map - :truncate-lines t)) - -(provide 'helm-buffers) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-buffers.el ends here diff --git a/elpa/helm-20150403.101/helm-color.el b/elpa/helm-20150403.101/helm-color.el deleted file mode 100644 index af4af763..00000000 --- a/elpa/helm-20150403.101/helm-color.el +++ /dev/null @@ -1,163 +0,0 @@ -;;; helm-color.el --- colors and faces -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: -(require 'cl-lib) -(require 'helm) - -;;; Customize Face -;; -;; -(defun helm-custom-faces-init () - "Initialize buffer for `helm-source-customize-face'." - (unless (helm-candidate-buffer) - (save-selected-window - (list-faces-display) - (message nil)) - (helm-init-candidates-in-buffer - 'global - (with-current-buffer (get-buffer "*Faces*") - (buffer-substring - (next-single-char-property-change (point-min) 'face) - (point-max)))) - (kill-buffer "*Faces*"))) - -(defvar helm-source-customize-face - '((name . "Customize Face") - (init . helm-custom-faces-init) - (candidates-in-buffer) - (get-line . buffer-substring) - (action . (("Customize" - . (lambda (line) - (customize-face (intern (car (split-string line)))))) - ("Copy name" - . (lambda (line) - (kill-new (car (split-string line " " t)))))))) - "See (info \"(emacs)Faces\")") - -;;; Colors browser -;; -;; -(defun helm-colors-init () - (unless (helm-candidate-buffer) - (save-selected-window - (list-colors-display) - (message nil)) - (helm-init-candidates-in-buffer - 'global - (with-current-buffer (get-buffer "*Colors*") - (buffer-string))) - (kill-buffer "*Colors*"))) - -(defun helm-color-insert-name (candidate) - (with-helm-current-buffer - (insert (helm-colors-get-name candidate)))) - -(defun helm-color-kill-name (candidate) - (kill-new (helm-colors-get-name candidate))) - -(defun helm-color-insert-rgb (candidate) - (with-helm-current-buffer - (insert (helm-colors-get-rgb candidate)))) - -(defun helm-color-kill-rgb (candidate) - (kill-new (helm-colors-get-rgb candidate))) - -(defun helm-color-run-insert-name () - "Insert name of color from `helm-source-colors'" - (interactive) - (with-helm-alive-p (helm-quit-and-execute-action 'helm-color-insert-name))) - -(defun helm-color-run-kill-name () - "Kill name of color from `helm-source-colors'" - (interactive) - (with-helm-alive-p (helm-quit-and-execute-action 'helm-color-kill-name))) - -(defun helm-color-run-insert-rgb () - "Insert RGB of color from `helm-source-colors'" - (interactive) - (with-helm-alive-p (helm-quit-and-execute-action 'helm-color-insert-rgb))) - -(defun helm-color-run-kill-rgb () - "Kill RGB of color from `helm-source-colors'" - (interactive) - (with-helm-alive-p (helm-quit-and-execute-action 'helm-color-kill-rgb))) - -(defvar helm-color-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c n") 'helm-color-run-insert-name) - (define-key map (kbd "C-c N") 'helm-color-run-kill-name) - (define-key map (kbd "C-c r") 'helm-color-run-insert-rgb) - (define-key map (kbd "C-c R") 'helm-color-run-kill-rgb) - (define-key map (kbd "C-c ?") 'helm-color-help) - map)) - -(defvar helm-source-colors - `((name . "Colors") - (init . helm-colors-init) - (candidates-in-buffer) - (get-line . buffer-substring) - (keymap . ,helm-color-map) - (persistent-help . "Kill entry in RGB format.") - (persistent-action . helm-color-kill-rgb) - (mode-line . helm-color-mode-line-string) - (action - ("Copy Name (C-c N)" . helm-color-kill-name) - ("Copy RGB (C-c R)" . helm-color-kill-rgb) - ("Insert Name (C-c n)" . helm-color-insert-name) - ("Insert RGB (C-c r)" . helm-color-insert-rgb)))) - -(defun helm-colors-get-name (candidate) - "Get color name." - (replace-regexp-in-string - " " "" - (with-temp-buffer - (insert (capitalize candidate)) - (goto-char (point-min)) - (search-forward-regexp "\\s-\\{2,\\}") - (delete-region (point) (point-max)) - (buffer-string)))) - -(defun helm-colors-get-rgb (candidate) - "Get color RGB." - (replace-regexp-in-string - " " "" - (with-temp-buffer - (insert (capitalize candidate)) - (goto-char (point-max)) - (search-backward-regexp "\\s-\\{2,\\}") - (delete-region (point) (point-min)) - (buffer-string)))) - -;;;###autoload -(defun helm-colors () - "Preconfigured `helm' for color." - (interactive) - (helm-other-buffer - '(helm-source-colors helm-source-customize-face) - "*helm colors*")) - -(provide 'helm-color) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-color.el ends here diff --git a/elpa/helm-20150403.101/helm-command.el b/elpa/helm-20150403.101/helm-command.el deleted file mode 100644 index ffafb3f9..00000000 --- a/elpa/helm-20150403.101/helm-command.el +++ /dev/null @@ -1,234 +0,0 @@ -;;; helm-command.el --- Helm execute-exended-command. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-mode) -(require 'helm-elisp) - - -(defgroup helm-command nil - "Emacs command related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-M-x-requires-pattern 0 - "Value of requires-pattern for `helm-M-x'. -Show all candidates on startup when 0 (default)." - :group 'helm-command - :type 'boolean) - -(defcustom helm-M-x-always-save-history nil - "`helm-M-x' Save command in `extended-command-history' even when it fail." - :group 'helm-command - :type 'boolean) - -(defcustom helm-M-x-reverse-history nil - "The history source of `helm-M-x' appear in second position when non--nil." - :group 'helm-command - :type 'boolean) - -(defcustom helm-M-x-fuzzy-match nil - "Enable fuzzy matching in `helm-M-x' when non--nil.") - - -;;; Faces -;; -;; -(defgroup helm-command-faces nil - "Customize the appearance of helm-command." - :prefix "helm-" - :group 'helm-command - :group 'helm-faces) - -(defface helm-M-x-key '((t (:foreground "orange" :underline t))) - "Face used in helm-M-x to show keybinding." - :group 'helm-command-faces) - - -(defvar helm-M-x-input-history nil) - -(defvar helm-M-x-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c ?") 'helm-M-x-help) - map) - "Keymap for `helm-M-x'.") - - -(cl-defun helm-M-x-get-major-mode-command-alist (mode-map) - "Return alist of MODE-MAP." - (cl-loop for key being the key-seqs of mode-map using (key-bindings com) - for str-key = (key-description key) - for ismenu = (string-match "" str-key) - unless ismenu collect (cons str-key com))) - -(defun helm-get-mode-map-from-mode (mode) - "Guess the mode-map name according to MODE. -Some modes don't use conventional mode-map name -so we need to guess mode-map name. e.g python-mode ==> py-mode-map. -Return nil if no mode-map found." - (cl-loop ;; Start with a conventional mode-map name. - with mode-map = (intern-soft (format "%s-map" mode)) - with mode-string = (symbol-name mode) - with mode-name = (replace-regexp-in-string "-mode" "" mode-string) - while (not mode-map) - for count downfrom (length mode-name) - ;; Return when no result after parsing entire string. - when (eq count 0) return nil - for sub-name = (substring mode-name 0 count) - do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode")))) - finally return mode-map)) - -(defun helm-M-x-current-mode-map-alist () - "Return mode-map alist of current `major-mode'." - (let ((map (helm-get-mode-map-from-mode major-mode))) - (when (and map (boundp map)) - (helm-M-x-get-major-mode-command-alist (symbol-value map))))) - - -(defun helm-M-x-transformer-1 (candidates &optional sort) - "Transformer function to show bindings in emacs commands. -Show global bindings and local bindings according to current `major-mode'. -If SORT is non nil sort list with `helm-generic-sort-fn'. -Note that SORT should not be used when fuzzy matching because -fuzzy matching is running its own sort function with a different algorithm." - (with-helm-current-buffer - (cl-loop with local-map = (helm-M-x-current-mode-map-alist) - for cand in candidates - for local-key = (car (rassq cand local-map)) - for key = (substitute-command-keys (format "\\[%s]" cand)) - collect - (cons (cond ((and (string-match "^M-x" key) local-key) - (format "%s (%s)" - cand (propertize - local-key - 'face 'helm-M-x-key))) - ((string-match "^M-x" key) cand) - (t (format "%s (%s)" - cand (propertize - key - 'face 'helm-M-x-key)))) - cand) - into ls - finally return - (if sort (sort ls #'helm-generic-sort-fn) ls)))) - -(defun helm-M-x-transformer (candidates _source) - "Transformer function for `helm-M-x' candidates." - (helm-M-x-transformer-1 candidates (null helm--in-fuzzy))) - -(defun helm-M-x-transformer-hist (candidates _source) - "Transformer function for `helm-M-x' candidates." - (helm-M-x-transformer-1 candidates)) - -(defun helm-M-x--notify-prefix-arg () - ;; Notify a prefix-arg set AFTER calling M-x. - (when prefix-arg - (with-helm-window - (helm-display-mode-line (helm-get-current-source) 'force)))) - -;;;###autoload -(defun helm-M-x () - "Preconfigured `helm' for Emacs commands. -It is `helm' replacement of regular `M-x' `execute-extended-command'. - -Unlike regular `M-x' emacs vanilla `execute-extended-command' command, -the prefix args if needed, are passed AFTER starting `helm-M-x'. - -You can get help on each command by persistent action." - (interactive) - (let* ((history (cl-loop for i in extended-command-history - when (commandp (intern i)) - do (set-text-properties 0 (length i) nil i) - and collect i)) - command sym-com in-help help-cand - (orig-fuzzy-sort-fn helm-fuzzy-sort-fn) - (helm-fuzzy-sort-fn (lambda (candidates source) - (funcall orig-fuzzy-sort-fn candidates source 'real))) - (helm--mode-line-display-prefarg t) - (pers-help #'(lambda (candidate) - (let ((hbuf (get-buffer (help-buffer)))) - (if (and in-help (string= candidate help-cand) - (null helm-persistent-action-use-special-display)) - (progn - ;; When M-x is started from a help buffer, - ;; Don't kill it as it is helm-current-buffer. - (unless (equal hbuf helm-current-buffer) - (kill-buffer hbuf) - (set-window-buffer (get-buffer-window hbuf) - helm-current-buffer)) - (setq in-help nil)) - (helm-describe-function candidate) - (setq in-help t)) - (setq help-cand candidate)))) - (tm (run-at-time 1 0.1 'helm-M-x--notify-prefix-arg))) - (unwind-protect - (let ((msg "Error: Specifying a prefix arg before calling `helm-M-x'")) - (when current-prefix-arg - (ding) - (message "%s" msg) - (while (not (sit-for 1)) - (discard-input)) - (user-error msg)) - (setq current-prefix-arg nil) - (setq command (helm-comp-read - "M-x " obarray - :test 'commandp - :requires-pattern helm-M-x-requires-pattern - :name "Emacs Commands" - :buffer "*helm M-x*" - :persistent-action pers-help - :persistent-help "Describe this command" - :history history - :reverse-history helm-M-x-reverse-history - :del-input nil - :mode-line helm-M-x-mode-line - :must-match t - :fuzzy helm-M-x-fuzzy-match - :nomark t - :keymap helm-M-x-map - :candidates-in-buffer t - :fc-transformer 'helm-M-x-transformer - :hist-fc-transformer 'helm-M-x-transformer-hist))) - (cancel-timer tm) - (setq helm--mode-line-display-prefarg nil)) - (setq sym-com (intern command)) - (setq current-prefix-arg helm-current-prefix-arg) - ;; Avoid having `this-command' set to *exit-minibuffer. - (setq this-command sym-com - ;; Handle C-x z (repeat) Issue #322 - real-this-command sym-com) - (let ((prefix-arg current-prefix-arg)) - ;; This ugly construct is to save history even on error. - (unless helm-M-x-always-save-history - (command-execute sym-com 'record)) - (setq extended-command-history - (cons command (delete command history))) - (when helm-M-x-always-save-history - (command-execute sym-com 'record))))) - -(provide 'helm-command) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-command.el ends here diff --git a/elpa/helm-20150403.101/helm-config.el b/elpa/helm-20150403.101/helm-config.el deleted file mode 100644 index 2d4eb23e..00000000 --- a/elpa/helm-20150403.101/helm-config.el +++ /dev/null @@ -1,228 +0,0 @@ -;;; helm-config.el --- Applications library for `helm.el' -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - - -;;; Require -;; -;; -(require 'easymenu) -(require 'helm-aliases) -(require 'async-bytecomp nil t) - - -(defgroup helm-config nil - "Various configurations for Helm." - :group 'helm) - -(defcustom helm-command-prefix-key "C-x c" - "The key `helm-command-prefix' is bound to in the global map." - :type '(choice (string :tag "Key") (const :tag "no binding")) - :group 'helm-config - :set - (lambda (var key) - (when (and (boundp var) (symbol-value var)) - (define-key (current-global-map) - (read-kbd-macro (symbol-value var)) nil)) - (when key - (define-key (current-global-map) - (read-kbd-macro key) 'helm-command-prefix)) - (set var key))) - -(defcustom helm-minibuffer-history-key "C-r" - "The key `helm-minibuffer-history' is bound to in minibuffer local maps." - :type '(choice (string :tag "Key") (const :tag "no binding")) - :group 'helm-config - :set - (lambda (var key) - (cl-dolist (map '(minibuffer-local-completion-map - minibuffer-local-filename-completion-map - minibuffer-local-filename-must-match-map ; Emacs 23.1.+ - minibuffer-local-isearch-map - minibuffer-local-map - minibuffer-local-must-match-filename-map ; Older Emacsen - minibuffer-local-must-match-map - minibuffer-local-ns-map)) - (when (and (boundp map) (keymapp (symbol-value map))) - (when (and (boundp var) (symbol-value var)) - (define-key (symbol-value map) - (read-kbd-macro (symbol-value var)) nil)) - (when key - (define-key (symbol-value map) - (read-kbd-macro key) 'helm-minibuffer-history)))) - (set var key))) - -;;; Command Keymap -;; -;; -(defvar helm-command-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "a") 'helm-apropos) - (define-key map (kbd "e") 'helm-etags-select) - (define-key map (kbd "l") 'helm-locate) - (define-key map (kbd "s") 'helm-surfraw) - (define-key map (kbd "r") 'helm-regexp) - (define-key map (kbd "m") 'helm-man-woman) - (define-key map (kbd "t") 'helm-top) - (define-key map (kbd "/") 'helm-find) - (define-key map (kbd "i") 'helm-semantic-or-imenu) - (define-key map (kbd "") 'helm-lisp-completion-at-point) - (define-key map (kbd "p") 'helm-list-emacs-process) - (define-key map (kbd "C-x r b") 'helm-filtered-bookmarks) - (define-key map (kbd "M-y") 'helm-show-kill-ring) - (define-key map (kbd "C-c ") 'helm-all-mark-rings) - (define-key map (kbd "C-x C-f") 'helm-find-files) - (define-key map (kbd "f") 'helm-multi-files) - (define-key map (kbd "C-:") 'helm-eval-expression-with-eldoc) - (define-key map (kbd "C-,") 'helm-calcul-expression) - (define-key map (kbd "M-x") 'helm-M-x) - (define-key map (kbd "M-s o") 'helm-occur) - (define-key map (kbd "M-g s") 'helm-do-grep) - (define-key map (kbd "c") 'helm-colors) - (define-key map (kbd "F") 'helm-select-xfont) - (define-key map (kbd "8") 'helm-ucs) - (define-key map (kbd "C-c f") 'helm-recentf) - (define-key map (kbd "C-c g") 'helm-google-suggest) - (define-key map (kbd "h i") 'helm-info-at-point) - (define-key map (kbd "h r") 'helm-info-emacs) - (define-key map (kbd "h g") 'helm-info-gnus) - (define-key map (kbd "C-x C-b") 'helm-buffers-list) - (define-key map (kbd "C-x r i") 'helm-register) - (define-key map (kbd "C-c C-x") 'helm-run-external-command) - (define-key map (kbd "b") 'helm-resume) - map)) - -;; Don't override the keymap we just defined with an empty -;; keymap. This also protect bindings changed by the user. -(defvar helm-command-prefix) -(define-prefix-command 'helm-command-prefix) -(fset 'helm-command-prefix helm-command-map) -(setq helm-command-prefix helm-command-map) - - -;;; Menu -;; -;; -(easy-menu-add-item - nil '("Tools") - '("Helm" - ["Find any Files/Buffers" helm-multi-files t] - ["Helm Everywhere (Toggle)" helm-mode t] - ["Helm resume" helm-resume t] - "----" - ("Files" - ["Find files" helm-find-files t] - ["Recent Files" helm-recentf t] - ["Locate" helm-locate t] - ["Search Files with find" helm-find t] - ["Bookmarks" helm-filtered-bookmarks t]) - ("Buffers" - ["Find buffers" helm-buffers-list t]) - ("Commands" - ["Emacs Commands" helm-M-x t] - ["Externals Commands" helm-run-external-command t]) - ("Help" - ["Helm Apropos" helm-apropos t]) - ("Info" - ["Info at point" helm-info-at-point t] - ["Emacs Manual index" helm-info-emacs t] - ["Gnus Manual index" helm-info-gnus t]) - ("Org" - ["Org keywords" helm-org-keywords t] - ["Org headlines" helm-org-headlines t]) - ("Tools" - ["Occur" helm-occur t] - ["Grep" helm-do-grep t] - ["Etags" helm-etags-select t] - ["Lisp complete at point" helm-lisp-completion-at-point t] - ["Browse Kill ring" helm-show-kill-ring t] - ["Browse register" helm-register t] - ["Mark Ring" helm-all-mark-rings t] - ["Regexp handler" helm-regexp t] - ["Colors & Faces" helm-colors t] - ["Show xfonts" helm-select-xfont t] - ["Ucs Symbols" helm-ucs t] - ["Imenu" helm-imenu t] - ["Semantic or Imenu" helm-semantic-or-imenu t] - ["Google Suggest" helm-google-suggest t] - ["Eval expression" helm-eval-expression-with-eldoc t] - ["Calcul expression" helm-calcul-expression t] - ["Man pages" helm-man-woman t] - ["Top externals process" helm-top t] - ["Emacs internals process" helm-list-emacs-process t]) - "----" - ["Preferred Options" helm-configuration t]) - "Spell Checking") - -(easy-menu-add-item nil '("Tools") '("----") "Spell Checking") - - -;;;###autoload -(defun helm-configuration () - "Customize `helm'." - (interactive) - (customize-group "helm")) - - -;;; Fontlock -(cl-dolist (mode '(emacs-lisp-mode lisp-interaction-mode)) - (font-lock-add-keywords - mode - '(("(\\<\\(with-helm-after-update-hook\\)\\>" 1 font-lock-keyword-face) - ("(\\<\\(with-helm-temp-hook\\)\\>" 1 font-lock-keyword-face) - ("(\\<\\(with-helm-window\\)\\>" 1 font-lock-keyword-face) - ("(\\<\\(with-helm-quittable\\)\\>" 1 font-lock-keyword-face) - ("(\\<\\(with-helm-current-buffer\\)\\>" 1 font-lock-keyword-face) - ("(\\<\\(with-helm-buffer\\)\\>" 1 font-lock-keyword-face) - ("(\\<\\(with-helm-show-completion\\)\\>" 1 font-lock-keyword-face) - ("(\\<\\(with-helm-default-directory\\)\\>" 1 font-lock-keyword-face) - ("(\\<\\(with-helm-display-same-window\\)\\>" 1 font-lock-keyword-face) - ("(\\<\\(with-helm-restore-variables\\)\\>" 1 font-lock-keyword-face) - ("(\\<\\(define-helm-type-attribute\\)\\>" 1 font-lock-keyword-face) - ("(\\<\\(helm-multi-key-defun\\)\\>" 1 font-lock-keyword-face) - ("(\\<\\(helm-while-no-input\\)\\>" 1 font-lock-keyword-face) - ("(\\<\\(helm-aif\\)\\>" 1 font-lock-keyword-face)))) - - -;;; Compatibility emacs-24.4+ -;; Inlined from Emacs trunk. -(defalias 'function-put - ;; We don't want people to just use `put' because we can't conveniently - ;; hook into `put' to remap old properties to new ones. But for now, there's - ;; no such remapping, so we just call `put'. - #'(lambda (f prop value) (put f prop value)) - "Set function F's property PROP to VALUE. -The namespace for PROP is shared with symbols. -So far, F can only be a symbol, not a lambda expression.") - - -;;; Load the autoload file -;; It should have been generated either by -;; package.el or the make file. - -(load "helm-autoloads" nil t) - -(provide 'helm-config) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-config.el ends here diff --git a/elpa/helm-20150403.101/helm-dabbrev.el b/elpa/helm-20150403.101/helm-dabbrev.el deleted file mode 100644 index d9cb2872..00000000 --- a/elpa/helm-20150403.101/helm-dabbrev.el +++ /dev/null @@ -1,338 +0,0 @@ -;;; helm-dabbrev.el --- Helm implementation of dabbrev. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'helm) -(require 'helm-elisp) ; For show-completion. - -(defgroup helm-dabbrev nil - "Dabbrev related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-dabbrev-always-search-all t - "Always search in all buffers when non--nil. -Note that even if nil, a search in all buffers -will occur if the length of candidates is <= than -`helm-dabbrev-max-length-result'." - :group 'helm-dabbrev - :type 'boolean) - -(defcustom helm-dabbrev-max-length-result 20 - "Max length of candidates before searching in all buffers. -If number of candidates found in current-buffer is <= to this, -search in all buffers. -Have no effect when `helm-dabbrev-always-search-all' is non--nil." - :group 'helm-dabbrev - :type 'integer) - -(defcustom helm-dabbrev-ignored-buffers-regexps - '("\\*helm" "\\*Messages" "\\*Echo Area" "\\*Buffer List") - "List of regexps matching names of buffers that helm-dabbrev should not check." - :group 'helm-dabbrev - :type '(repeat regexp)) - -(defcustom helm-dabbrev-related-buffer-fn #'helm-dabbrev--same-major-mode-p - "A function that decide if a buffer to search in is related to `current-buffer'. -This is actually determined by comparing `major-mode' of the buffer to search -and the `current-buffer'. -The function take one arg, the buffer which is current, look at -`helm-dabbrev--same-major-mode-p' for example. - -When nil all buffers are considered related to `current-buffer'." - :group 'helm-dabbrev - :type 'function) - -(defcustom helm-dabbrev-major-mode-assoc - '((emacs-lisp-mode . lisp-interaction-mode)) - "Major mode association alist. -This allow helm-dabbrev searching in buffers with the associated `major-mode'. -e.g \(emacs-lisp-mode . lisp-interaction-mode\) -will allow searching in the lisp-interaction-mode buffer when `current-buffer' -is an `emacs-lisp-mode' buffer and vice versa i.e -no need to provide \(lisp-interaction-mode . emacs-lisp-mode\) association. - -When nil check is the searched buffer have same `major-mode' -than the `current-buffer'. -This have no effect when `helm-dabbrev-related-buffer-fn' is nil or of course -bound to a function that doesn't handle this var." - :type '(alist :key-type symbol :value-type symbol) - :group 'helm-dabbrev) - -(defcustom helm-dabbrev-lineno-around 30 - "Search first in this number of lines before an after point." - :group 'helm-dabbrev - :type 'integer) - -(defcustom helm-dabbrev-cycle-threshold nil - "Number of time helm-dabbrev cycle before displaying helm completion. -When nil or 0 disable cycling." - :group 'helm-dabbrev - :type '(choice (const :tag "Cycling disabled" nil) integer)) - -(defcustom helm-dabbrev-case-fold-search 'smart - "Set `case-fold-search' in `helm-dabbrev'. -Same as `helm-case-fold-search' but for `helm-dabbrev'. -Note that this is not affecting searching in helm buffer, -but the initial search for all candidates in buffer(s)." - :group 'helm-dabbrev - :type '(choice (const :tag "Ignore case" t) - (const :tag "Respect case" nil) - (other :tag "Smart" 'smart))) - - -(defvar helm-dabbrev-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-/") 'helm-next-line) - (define-key map (kbd "M-:") 'helm-previous-line) - map)) - -;; Internal -(defvar helm-dabbrev--exclude-current-buffer-flag nil) -(defvar helm-dabbrev--cache nil) -(defvar helm-dabbrev--data nil) -(defvar helm-dabbrev--regexp "\\s-\\|\t\\|[(\[\{\"'`=<$;]\\|\\s\\\\|^") -(cl-defstruct helm-dabbrev-info dabbrev limits iterator) - - -(defun helm-dabbrev--buffer-list () - (cl-loop with lst = (buffer-list) - for buf in (if helm-dabbrev--exclude-current-buffer-flag - (cdr lst) lst) - unless (cl-loop for r in helm-dabbrev-ignored-buffers-regexps - thereis (string-match r (buffer-name buf))) - collect buf)) - -(defun helm-dabbrev--same-major-mode-p (start-buffer) - ;; START-BUFFER is the current-buffer where we start searching. - ;; Determine the major-mode of START-BUFFER as `cur-maj-mode'. - ;; Each time the loop go in another buffer we try to find if its - ;; `major-mode' is: - ;; - same as the `cur-maj-mode' - ;; - derived from `cur-maj-mode' - ;; - have an assoc entry (major-mode . cur-maj-mode) - ;; - have an rassoc entry (cur-maj-mode . major-mode) - ;; - check if one of these entries inherit from another one in - ;; `helm-dabbrev-major-mode-assoc'. - (let* ((cur-maj-mode (with-current-buffer start-buffer major-mode)) - (c-assoc-mode (assq cur-maj-mode helm-dabbrev-major-mode-assoc)) - (c-rassoc-mode (rassq cur-maj-mode helm-dabbrev-major-mode-assoc)) - (o-assoc-mode (assq major-mode helm-dabbrev-major-mode-assoc)) - (o-rassoc-mode (rassq major-mode helm-dabbrev-major-mode-assoc)) - (cdr-c-assoc-mode (cdr c-assoc-mode)) - (cdr-o-assoc-mode (cdr o-assoc-mode))) - (or (eq major-mode cur-maj-mode) - (derived-mode-p cur-maj-mode) - (or (eq cdr-c-assoc-mode major-mode) - (eq (car c-rassoc-mode) major-mode) - (eq (cdr (assq cdr-c-assoc-mode helm-dabbrev-major-mode-assoc)) - major-mode) - (eq (car (rassq cdr-c-assoc-mode helm-dabbrev-major-mode-assoc)) - major-mode)) - (or (eq cdr-o-assoc-mode cur-maj-mode) - (eq (car o-rassoc-mode) cur-maj-mode) - (eq (cdr (assq cdr-o-assoc-mode helm-dabbrev-major-mode-assoc)) - cur-maj-mode) - (eq (car (rassq cdr-o-assoc-mode helm-dabbrev-major-mode-assoc)) - cur-maj-mode))))) - -(defun helm-dabbrev--collect (str limit ignore-case all) - (let* ((case-fold-search ignore-case) - (buffer1 (current-buffer)) ; start buffer. - (minibuf (minibufferp buffer1)) - result pos-before pos-after - (search-and-store - #'(lambda (pattern direction) - (while (cl-case direction - (1 (search-forward pattern nil t)) - (-1 (search-backward pattern nil t)) - (2 (let ((pos - (save-excursion - (forward-line - helm-dabbrev-lineno-around) - (point)))) - (setq pos-after pos) - (search-forward pattern pos t))) - (-2 (let ((pos - (save-excursion - (forward-line - (- helm-dabbrev-lineno-around)) - (point)))) - (setq pos-before pos) - (search-backward pattern pos t)))) - (let* ((match-1 (helm-aif (thing-at-point 'symbol) - ;; `thing-at-point' returns - ;; the quote outside of e-lisp mode, - ;; e.g in message mode, - ;; `foo' => foo' - ;; but in e-lisp like modes: - ;; `foo' => foo - ;; so remove it [1]. - (replace-regexp-in-string - "[']\\'" "" (substring-no-properties it)))) - (match-2 (helm-aif (thing-at-point 'filename) - ;; Same as in [1]. - (replace-regexp-in-string - "[']\\'" "" (substring-no-properties it)))) - (lst (if (string= match-1 match-2) - (list match-1) - (list match-1 match-2)))) - (cl-loop for match in lst - unless (or (string= str match) - (member match result)) - do (push match result))))))) - (cl-loop for buf in (if all (helm-dabbrev--buffer-list) - (list (current-buffer))) - - do (with-current-buffer buf - (when (or minibuf ; check against all buffers when in minibuffer. - (if helm-dabbrev-related-buffer-fn - (funcall helm-dabbrev-related-buffer-fn buffer1) - t)) - (save-excursion - ;; Start searching before thing before point. - (goto-char (- (point) (length str))) - ;; Search the last 30 lines before point. - (funcall search-and-store str -2)) ; store pos [1] - (save-excursion - ;; Search the next 30 lines after point. - (funcall search-and-store str 2)) ; store pos [2] - (save-excursion - ;; Search all before point. - (goto-char pos-before) ; start from [1] - (funcall search-and-store str -1)) - (save-excursion - ;; Search all after point. - (goto-char pos-after) ; start from [2] - (funcall search-and-store str 1)))) - when (> (length result) limit) return (nreverse result) - finally return (nreverse result)))) - -(defun helm-dabbrev--get-candidates (abbrev) - (cl-assert abbrev nil "[No Match]") - (with-current-buffer (current-buffer) - (let* ((dabbrev-get #'(lambda (str all-bufs) - (helm-dabbrev--collect - str helm-candidate-number-limit - (cl-case helm-dabbrev-case-fold-search - (smart (helm-set-case-fold-search-1 abbrev)) - (t helm-dabbrev-case-fold-search)) - all-bufs))) - (lst (funcall dabbrev-get abbrev helm-dabbrev-always-search-all))) - (if (and (not helm-dabbrev-always-search-all) - (<= (length lst) helm-dabbrev-max-length-result)) - ;; Search all but don't recompute current-buffer. - (let ((helm-dabbrev--exclude-current-buffer-flag t)) - (append lst (funcall dabbrev-get abbrev 'all-bufs))) - lst)))) - -(defun helm-dabbrev-default-action (candidate) - (with-helm-current-buffer - (let* ((limits (helm-bounds-of-thing-before-point - helm-dabbrev--regexp)) - (beg (car limits)) - (end (point))) - (run-with-timer - 0.01 nil - 'helm-insert-completion-at-point - beg end candidate)))) - -;;;###autoload -(defun helm-dabbrev () - (interactive) - (let ((dabbrev (helm-thing-before-point nil helm-dabbrev--regexp)) - (limits (helm-bounds-of-thing-before-point helm-dabbrev--regexp)) - (enable-recursive-minibuffers t) - (cycling-disabled-p (or (null helm-dabbrev-cycle-threshold) - (zerop helm-dabbrev-cycle-threshold))) - (helm-execute-action-at-once-if-one t) - (helm-quit-if-no-candidate - #'(lambda () - (message "[Helm-dabbrev: No expansion found]")))) - (cl-assert (and (stringp dabbrev) (not (string= dabbrev ""))) - nil "[Helm-dabbrev: Nothing found before point]") - (when (and - ;; have been called at least once. - (helm-dabbrev-info-p helm-dabbrev--data) - ;; But user have moved with some other command - ;; in the meaning time. - (not (eq last-command 'helm-dabbrev))) - (setq helm-dabbrev--data nil)) - (when cycling-disabled-p - (setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev))) - (unless (or cycling-disabled-p - (helm-dabbrev-info-p helm-dabbrev--data)) - (setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev)) - (setq helm-dabbrev--data (make-helm-dabbrev-info - :dabbrev dabbrev - :limits limits - :iterator - (helm-iter-list - (cl-loop for i in helm-dabbrev--cache when - (and i (string-match - (concat "^" (regexp-quote dabbrev)) i)) - collect i into selection - when (and selection - (= (length selection) - helm-dabbrev-cycle-threshold)) - ;; When selection len reach - ;; `helm-dabbrev-cycle-threshold' - ;; return selection. - return selection - ;; selection len never reach - ;; `helm-dabbrev-cycle-threshold' - ;; return selection. - finally return selection))))) - (let ((iter (and (helm-dabbrev-info-p helm-dabbrev--data) - (helm-dabbrev-info-iterator helm-dabbrev--data))) - deactivate-mark) - (helm-aif (and iter (helm-iter-next iter)) - (progn - (helm-insert-completion-at-point - (car (helm-dabbrev-info-limits helm-dabbrev--data)) - (cdr limits) it) - ;; Move already tried candidates to end of list. - (setq helm-dabbrev--cache (append (remove it helm-dabbrev--cache) - (list it)))) - (unless cycling-disabled-p - (delete-region (car limits) (point)) - (setq dabbrev (helm-dabbrev-info-dabbrev helm-dabbrev--data) - limits (helm-dabbrev-info-limits helm-dabbrev--data)) - (setq helm-dabbrev--data nil) - (insert dabbrev)) - (with-helm-show-completion (car limits) (cdr limits) - (helm :sources (helm-build-in-buffer-source "Dabbrev Expand" - :data helm-dabbrev--cache - :persistent-action 'ignore - :persistent-help "DoNothing" - :keymap helm-dabbrev-map - :action 'helm-dabbrev-default-action) - :buffer "*helm dabbrev*" - :input (concat "^" dabbrev " ") - :resume 'noresume - :allow-nest t)))))) - -(provide 'helm-dabbrev) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-dabbrev.el ends here diff --git a/elpa/helm-20150403.101/helm-elisp-package.el b/elpa/helm-20150403.101/helm-elisp-package.el deleted file mode 100644 index 5afd362b..00000000 --- a/elpa/helm-20150403.101/helm-elisp-package.el +++ /dev/null @@ -1,297 +0,0 @@ -;;; helm-elisp-package.el --- helm interface for package.el -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: -(require 'cl-lib) -(require 'helm) -(require 'package) - -;; internals vars -(defvar helm-el-package--show-only 'all) -(defvar helm-el-package--initialized-p nil) -(defvar helm-el-package--tabulated-list nil) -(defvar helm-el-package--upgrades nil) -(defvar helm-el-package--removable-packages nil) - -(defun helm-el-package--init () - (when (null package-alist) - (setq helm-el-package--show-only 'all)) - (when (fboundp 'package--removable-packages) - (setq helm-el-package--removable-packages - (package--removable-packages))) - (save-selected-window - (list-packages helm-el-package--initialized-p) - (setq helm-el-package--initialized-p t) - (message nil)) - (helm-init-candidates-in-buffer - 'global - (with-current-buffer (get-buffer "*Packages*") - (setq helm-el-package--tabulated-list tabulated-list-entries) - (buffer-string))) - (setq helm-el-package--upgrades (helm-el-package-menu--find-upgrades)) - (if helm-force-updating-p - (message "Refreshing packages list done") - (setq helm-el-package--show-only 'all)) - (kill-buffer "*Packages*")) - -(defun helm-el-package-describe (candidate) - (let ((id (get-text-property 0 'tabulated-list-id candidate))) - (describe-package (if (fboundp 'package-desc-name) - (package-desc-name id) - (car id))))) - -(defun helm-el-package-install-1 (pkg-list) - (cl-loop with mkd = pkg-list - for p in mkd - for id = (get-text-property 0 'tabulated-list-id p) - do (package-install - (if (fboundp 'package-desc-name) - (package-desc-name id) - (car id))) - collect (if (fboundp 'package-desc-full-name) - id - (car id)) - into installed-list - finally do (progn - (when (boundp 'package-selected-packages) - (customize-save-variable - 'package-selected-packages - (append (mapcar 'package-desc-name installed-list) - package-selected-packages))) - (if (fboundp 'package-desc-full-name) - (message (format "%d packages installed:\n(%s)" - (length installed-list) - (mapconcat #'package-desc-full-name - installed-list ", "))) - (message (format "%d packages installed:\n(%s)" - (length installed-list) - (mapconcat 'symbol-name installed-list ", "))))))) - -(defun helm-el-package-install (_candidate) - (helm-el-package-install-1 (helm-marked-candidates))) - -(defun helm-el-package-uninstall-1 (pkg-list) - (cl-loop with mkd = pkg-list - for p in mkd - for id = (get-text-property 0 'tabulated-list-id p) - do - (condition-case-unless-debug err - (with-no-warnings - (if (fboundp 'package-desc-full-name) - ;; emacs 24.4 - (package-delete id) - ;; emacs 24.3 - (package-delete (symbol-name (car id)) - (package-version-join (cdr id))))) - (error (message (cadr err)))) - unless (assoc (elt id 1) package-alist) - collect (if (fboundp 'package-desc-full-name) - id - (cons (symbol-name (car id)) - (package-version-join (cdr id)))) - into delete-list - finally do (if delete-list - (if (fboundp 'package-desc-full-name) - ;; emacs 24.4 - (message (format "%d packages deleted:\n(%s)" - (length delete-list) - (mapconcat #'package-desc-full-name - delete-list ", "))) - ;; emacs 24.3 - (message (format "%d packages deleted:\n(%s)" - (length delete-list) - (mapconcat (lambda (x) - (concat (car x) "-" (cdr x))) - delete-list ", "))) - ;; emacs 24.3 doesn't update - ;; its `package-alist' after deleting. - (cl-loop for p in package-alist - when (assq (symbol-name (car p)) delete-list) - do (setq package-alist (delete p package-alist)))) - "No package deleted"))) - -(defun helm-el-package-uninstall (_candidate) - (helm-el-package-uninstall-1 (helm-marked-candidates))) - -(defun helm-el-package-menu--find-upgrades () - (cl-loop for entry in helm-el-package--tabulated-list - for pkg-desc = (car entry) - for status = (package-desc-status pkg-desc) - when (member status '("installed" "unsigned" "dependency")) - collect pkg-desc - into installed - when (member status '("available" "new")) - collect (cons (package-desc-name pkg-desc) pkg-desc) - into available - finally return - (cl-loop for pkg in installed - for avail-pkg = (assq (package-desc-name pkg) available) - when (and avail-pkg - (version-list-< (package-desc-version pkg) - (package-desc-version - (cdr avail-pkg)))) - collect avail-pkg))) - -(defun helm-el-package-upgrade-1 (pkg-list) - (cl-loop for p in pkg-list - for pkg-desc = (car p) - for upgrade = (cdr (assq (package-desc-name pkg-desc) - helm-el-package--upgrades)) - do - (cond ((null upgrade) - (ignore)) - ((equal pkg-desc upgrade) - ;;Install. - (package-install pkg-desc)) - (t - ;; Delete. - (if (boundp 'package-selected-packages) - (with-no-warnings - (package-delete pkg-desc t t)) - (package-delete pkg-desc)))))) - -(defun helm-el-package-upgrade (_candidate) - (helm-el-package-upgrade-1 - (cl-loop with pkgs = (helm-marked-candidates) - for p in helm-el-package--tabulated-list - for pkg = (car p) - if (member (symbol-name (package-desc-name pkg)) pkgs) - collect p))) - -(defun helm-el-package-upgrade-all () - (if helm-el-package--upgrades - (with-helm-display-marked-candidates - helm-marked-buffer-name (mapcar (lambda (x) (symbol-name (car x))) - helm-el-package--upgrades) - (when (y-or-n-p "Upgrade all packages? ") - (helm-el-package-upgrade-1 helm-el-package--tabulated-list))) - (message "No packages to upgrade actually!"))) - -(defun helm-el-package-upgrade-all-action (_candidate) - (helm-el-package-upgrade-all)) - -(defun helm-el-package--transformer (candidates _source) - (cl-loop for c in candidates - for id = (get-text-property 0 'tabulated-list-id c) - for name = (if (fboundp 'package-desc-name) - (package-desc-name id) - (car id)) - for installed-p = (assq name package-alist) - for upgrade-p = (assq name helm-el-package--upgrades) - for user-installed-p = (and (boundp 'package-selected-packages) - (memq name package-selected-packages)) - do (when user-installed-p (put-text-property 0 2 'display "S " c)) - do (when (memq name helm-el-package--removable-packages) - (put-text-property 0 2 'display "U " c) - (put-text-property - 2 (+ (length (symbol-name name)) 2) - 'face 'font-lock-variable-name-face c)) - for cand = (cons c (car (split-string c))) - when (or (and upgrade-p - (eq helm-el-package--show-only 'upgrade)) - (and installed-p - (eq helm-el-package--show-only 'installed)) - (and (not installed-p) - (eq helm-el-package--show-only 'uninstalled)) - (eq helm-el-package--show-only 'all)) - collect cand)) - -(defun helm-el-package-show-upgrade () - (interactive) - (with-helm-alive-p - (setq helm-el-package--show-only 'upgrade) - (helm-update))) - -(defun helm-el-package-show-installed () - (interactive) - (with-helm-alive-p - (setq helm-el-package--show-only 'installed) - (helm-update))) - -(defun helm-el-package-show-all () - (interactive) - (with-helm-alive-p - (setq helm-el-package--show-only 'all) - (helm-update))) - -(defun helm-el-package-show-uninstalled () - (interactive) - (with-helm-alive-p - (setq helm-el-package--show-only 'uninstalled) - (helm-update))) - -(defvar helm-el-package-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-I") 'helm-el-package-show-installed) - (define-key map (kbd "M-U") 'helm-el-package-show-upgrade) - (define-key map (kbd "M-A") 'helm-el-package-show-all) - (define-key map (kbd "C-c ?") 'helm-el-package-help) - map)) - -(defvar helm-source-list-el-package nil) -(defclass helm-list-el-package-source (helm-source-in-buffer) - ((init :initform 'helm-el-package--init) - (get-line :initform 'buffer-substring) - (filtered-candidate-transformer :initform 'helm-el-package--transformer) - (action-transformer - :initform - (lambda (actions candidate) - (let ((pkg-desc (get-text-property - 0 'tabulated-list-id candidate)) - (acts (if helm-el-package--upgrades - (append actions '(("Upgrade all packages" - . helm-el-package-upgrade-all-action))) - actions))) - (cond ((cdr (assq (package-desc-name pkg-desc) - helm-el-package--upgrades)) - (append '(("Upgrade package" . helm-el-package-upgrade)) acts)) - ((package-installed-p (package-desc-name pkg-desc)) - (append acts '(("Reinstall package" . helm-el-package-reinstall) - ("Uninstall" . helm-el-package-uninstall)))) - (t (append acts '(("Install" . helm-el-package-install)))))))) - (mode-line :initform helm-el-package-mode-line) - (keymap :initform helm-el-package-map) - (update :initform 'helm-el-package--update) - (candidate-number-limit :initform 9999) - (action :initform '(("Describe" . helm-el-package-describe))))) - -(defun helm-el-package--update () - (setq helm-el-package--initialized-p nil)) - -(defun helm-el-package-reinstall (_pkg) - (cl-loop for p in (helm-marked-candidates) - for pkg-desc = (get-text-property 0 'tabulated-list-id p) - for name = (package-desc-name pkg-desc) - do (if (fboundp 'package-reinstall) - (package-reinstall name) - (package-delete pkg-desc) - (package-install name)))) - -;;;###autoload -(defun helm-list-elisp-packages (arg) - (interactive "P") - (when arg (setq helm-el-package--initialized-p nil)) - (unless helm-source-list-el-package - (setq helm-source-list-el-package - (helm-make-source "list packages" 'helm-list-el-package-source))) - (helm :sources 'helm-source-list-el-package - :buffer "*helm list packages*")) - -(provide 'helm-elisp-package) - -;;; helm-elisp-package.el ends here diff --git a/elpa/helm-20150403.101/helm-elisp.el b/elpa/helm-20150403.101/helm-elisp.el deleted file mode 100644 index 6c69411e..00000000 --- a/elpa/helm-20150403.101/helm-elisp.el +++ /dev/null @@ -1,829 +0,0 @@ -;;; helm-elisp.el --- Elisp symbols completion for helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: -(require 'cl-lib) -(require 'helm) -(require 'helm-utils) -(require 'helm-info) -(require 'helm-eval) -(require 'helm-files) -(require 'advice) - - -(defgroup helm-elisp nil - "Elisp related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-turn-on-show-completion t - "Display candidate in buffer while moving selection when non--nil." - :group 'helm-elisp - :type 'boolean) - -(defcustom helm-show-completion-use-special-display t - "A special display will be used in lisp completion if non--nil. -All functions that are wrapped in macro `with-helm-show-completion' -will be affected." - :group 'helm-elisp - :type 'boolean) - -(defcustom helm-show-completion-min-window-height 7 - "Minimum completion window height used in show completion. -This is used in macro `with-helm-show-completion'." - :group 'helm-elisp - :type 'integer) - -(defcustom helm-lisp-quoted-function-list - '(funcall apply mapc cl-mapc mapcar cl-mapcar - callf callf2 cl-callf cl-callf2 fset - fboundp fmakunbound symbol-function) - "List of function where quoted function completion happen. -e.g give only function names after \(funcall '." - :group 'helm-elisp - :type '(repeat (choice symbol))) - -(defcustom helm-lisp-unquoted-function-list - '(function defadvice) - "List of function where unquoted function completion happen. -e.g give only function names after \(function ." - :group 'helm-elisp - :type '(repeat (choice symbol))) - -(defcustom helm-apropos-fuzzy-match nil - "Enable fuzzy matching for `helm-apropos' when non-nil." - :group 'helm-elisp - :type 'boolean) - -(defcustom helm-lisp-fuzzy-completion nil - "Enable fuzzy matching in emacs-lisp completion when non-nil. -NOTE: This enable fuzzy matching in helm native implementation of -elisp completion, but not on helmized elisp completion, i.e -fuzzy completion is not available in `completion-at-point'." - :group 'helm-elisp - :type 'boolean) - -(defcustom helm-apropos-function-list '(helm-def-source--emacs-commands - helm-def-source--emacs-functions - helm-def-source--eieio-classes - helm-def-source--eieio-generic - helm-def-source--emacs-variables - helm-def-source--emacs-faces - helm-def-source--helm-attributes) - "A list of functions that build helm sources to use in `helm-apropos'." - :group 'helm-elisp - :type '(repeat (choice symbol))) - - -;;; Faces -;; -;; -(defgroup helm-elisp-faces nil - "Customize the appearance of helm-elisp." - :prefix "helm-" - :group 'helm-elisp - :group 'helm-faces) - -(defface helm-lisp-show-completion - '((t (:background "DarkSlateGray"))) - "Face used for showing candidates in `helm-lisp-completion'." - :group 'helm-elisp-faces) - -(defface helm-lisp-completion-info - '((t (:foreground "red"))) - "Face used for showing info in `helm-lisp-completion'." - :group 'helm-elisp-faces) - - -;;; Show completion. -;; -;; Provide show completion with macro `with-helm-show-completion'. - -(defvar helm-show-completion-overlay nil) - -;; Called each time cursor move in helm-buffer. -(defun helm-show-completion () - (with-helm-current-buffer - (overlay-put helm-show-completion-overlay - 'display (substring-no-properties - (helm-get-selection))))) - -(defun helm-show-completion-init-overlay (beg end) - (when (and helm-turn-on-show-completion beg end) - (setq helm-show-completion-overlay (make-overlay beg end)) - (overlay-put helm-show-completion-overlay - 'face 'helm-lisp-show-completion))) - -(defun helm-show-completion-display-function (buffer &rest _args) - "A special resized helm window is used depending on position in BUFFER." - (with-selected-window (selected-window) - (if (window-dedicated-p) - (helm-default-display-buffer buffer) - (let* ((screen-size (+ (count-screen-lines (window-start) (point) t) - 1 ; mode-line - (if header-line-format 1 0))) ; header-line - (def-size (- (window-height) - helm-show-completion-min-window-height)) - (upper-height (max window-min-height (min screen-size def-size))) - split-window-keep-point) - (recenter -1) - (set-window-buffer (if (active-minibuffer-window) - (minibuffer-selected-window) - (split-window nil upper-height)) - buffer))))) - -(defmacro with-helm-show-completion (beg end &rest body) - "Show helm candidate in an overlay at point. -BEG and END are the beginning and end position of the current completion -in `helm-current-buffer'. -BODY is an helm call where we want to enable show completion. -If `helm-turn-on-show-completion' is nil just do nothing." - (declare (indent 2) (debug t)) - `(let ((helm-move-selection-after-hook - (and helm-turn-on-show-completion - (append (list 'helm-show-completion) - helm-move-selection-after-hook)))) - (with-helm-temp-hook 'helm-after-initialize-hook - (with-helm-buffer - (set (make-local-variable 'helm-display-function) - (if helm-show-completion-use-special-display - 'helm-show-completion-display-function - 'helm-default-display-buffer)))) - (unwind-protect - (progn - (helm-show-completion-init-overlay ,beg ,end) - ,@body) - (when (and helm-turn-on-show-completion - helm-show-completion-overlay - (overlayp helm-show-completion-overlay)) - (delete-overlay helm-show-completion-overlay))))) - - -;;; Lisp symbol completion. -;; -;; -(defun helm-lisp-completion--predicate-at-point (beg) - ;; Return a predicate for `all-completions'. - (let ((fn-sym-p (lambda () - (or - (and (eq (char-before) ?\ ) - (save-excursion - (skip-syntax-backward " " (point-at-bol)) - (memq (symbol-at-point) - helm-lisp-unquoted-function-list))) - (and (eq (char-before) ?\') - (save-excursion - (forward-char -1) - (eq (char-before) ?\#))))))) - (save-excursion - (goto-char beg) - (if (or - ;; Complete on all symbols in non--lisp modes (logs mail etc..) - (not (memq major-mode '(emacs-lisp-mode - lisp-interaction-mode - inferior-emacs-lisp-mode))) - (not (or (funcall fn-sym-p) - (and (eq (char-before) ?\') - (save-excursion - (forward-char (if (funcall fn-sym-p) -2 -1)) - (skip-syntax-backward " " (point-at-bol)) - (memq (symbol-at-point) - helm-lisp-quoted-function-list))) - (eq (char-before) ?\())) ; no paren before str. - ;; Looks like we are in a let statement. - (condition-case nil - (progn (up-list -2) (forward-char 1) - (eq (char-after) ?\()) - (error nil))) - (lambda (sym) - (or (boundp sym) (fboundp sym) (symbol-plist sym))) - #'fboundp)))) - -(defun helm-thing-before-point (&optional limits regexp) - "Return symbol name before point. -If REGEXP is specified return what REGEXP find before point. -By default match the beginning of symbol before point. -With LIMITS arg specified return the beginning and end position -of symbol before point." - (save-excursion - (let (beg - (end (point)) - (boundary (field-beginning nil nil (point-at-bol)))) - (if (re-search-backward (or regexp "\\_<") boundary t) - (setq beg (match-end 0)) - (setq beg boundary)) - (unless (= beg end) - (if limits - (cons beg end) - (buffer-substring-no-properties beg end)))))) - -(defun helm-bounds-of-thing-before-point (&optional regexp) - "Get the beginning and end position of `helm-thing-before-point'. -Return a cons \(beg . end\)." - (helm-thing-before-point 'limits regexp)) - -(defun helm-insert-completion-at-point (beg end str) - ;; When there is no space after point - ;; we are completing inside a symbol or - ;; after a partial symbol with the next arg aside - ;; without space, in this case mark the region. - ;; deleting it would remove the - ;; next arg which is unwanted. - (delete-region beg end) - (insert str) - (let ((pos (cdr (or (bounds-of-thing-at-point 'symbol) - ;; needed for helm-dabbrev. - (bounds-of-thing-at-point 'filename))))) - (when (and pos (< (point) pos)) - (push-mark pos t t)))) - -(defvar helm-lisp-completion--cache nil) -(defvar helm-lgst-len nil) -;;;###autoload -(defun helm-lisp-completion-at-point () - "Helm lisp symbol completion at point." - (interactive) - (setq helm-lgst-len 0) - (let* ((target (helm-thing-before-point)) - (beg (car (helm-bounds-of-thing-before-point))) - (end (point)) - (pred (and beg (helm-lisp-completion--predicate-at-point beg))) - (loc-vars (and (fboundp 'elisp--local-variables) - (ignore-errors - (mapcar #'symbol-name (elisp--local-variables))))) - (glob-syms (and target pred (all-completions target obarray pred))) - (candidates (append loc-vars glob-syms)) - (helm-quit-if-no-candidate t) - (helm-execute-action-at-once-if-one t) - (enable-recursive-minibuffers t)) - (setq helm-lisp-completion--cache (cl-loop for sym in candidates - for len = (length sym) - when (> len helm-lgst-len) - do (setq helm-lgst-len len) - collect sym)) - (if candidates - (with-helm-show-completion beg end - ;; Overlay is initialized now in helm-current-buffer. - (helm - :sources (helm-build-in-buffer-source "Lisp completion" - :data helm-lisp-completion--cache - :persistent-action 'helm-lisp-completion-persistent-action - :nomark t - :fuzzy-match helm-lisp-fuzzy-completion - :persistent-help "Show brief doc in mode-line" - :filtered-candidate-transformer 'helm-lisp-completion-transformer - :action `(lambda (candidate) - (with-helm-current-buffer - (run-with-timer - 0.01 nil - 'helm-insert-completion-at-point - ,beg ,end candidate)))) - :input (if helm-lisp-fuzzy-completion - target (concat target " ")) - :resume 'noresume - :buffer "*helm lisp completion*" - :allow-nest t)) - (message "[No Match]")))) - -(defun helm-lisp-completion-persistent-action (candidate) - (let ((cursor-in-echo-area t) - mode-line-in-non-selected-windows) - (helm-show-info-in-mode-line - (propertize - (helm-get-first-line-documentation - (intern candidate)) - 'face 'helm-lisp-completion-info)))) - -(defun helm-lisp-completion-transformer (candidates _source) - "Helm candidates transformer for lisp completion." - (cl-loop for c in candidates - for sym = (intern c) - for annot = (cl-typecase sym - (command " (Com)") - (class " (Class)") - (generic " (Gen)") - (fbound " (Fun)") - (bound " (Var)") - (face " (Face)")) - for spaces = (make-string (- helm-lgst-len (length c)) ? ) - collect (cons (concat c spaces annot) c) into lst - finally return (sort lst #'helm-generic-sort-fn))) - -(defun helm-get-first-line-documentation (sym) - "Return first line documentation of symbol SYM. -If SYM is not documented, return \"Not documented\"." - (let ((doc (cond ((fboundp sym) - (documentation sym t)) - ((boundp sym) - (documentation-property sym 'variable-documentation t)) - ((facep sym) - (face-documentation sym)) - (t nil)))) - (if (and doc (not (string= doc "")) - ;; `documentation' return "\n\n(args...)" - ;; for CL-style functions. - (not (string-match-p "^\n\n" doc))) - (car (split-string doc "\n")) - "Not documented"))) - -;;; File completion. -;; -;; Complete file name at point. - -;;;###autoload -(defun helm-complete-file-name-at-point (&optional force) - "Complete file name at point." - (interactive) - (require 'helm-mode) - (let* ((tap (thing-at-point 'filename)) - beg - (init (and tap - (or force - (save-excursion - (end-of-line) - (search-backward tap (point-at-bol) t) - (setq beg (point)) - (looking-back "[^'`( ]"))) - (expand-file-name - (substring-no-properties tap)))) - (end (point)) - (helm-quit-if-no-candidate t) - (helm-execute-action-at-once-if-one t) - completion) - (with-helm-show-completion beg end - (setq completion (helm-read-file-name "FileName: " - :initial-input init))) - (when (and completion (not (string= completion ""))) - (delete-region beg end) (insert (if (string-match "^~" tap) - (abbreviate-file-name completion) - completion))))) - -;;;###autoload -(defun helm-lisp-indent () - ;; It is meant to use with `helm-define-multi-key' which - ;; does not support args for functions yet, so use `current-prefix-arg' - ;; for now instead of (interactive "P"). - (interactive) - (let ((tab-always-indent (or (eq tab-always-indent 'complete) - tab-always-indent))) - (indent-for-tab-command current-prefix-arg))) - -;;;###autoload -(defun helm-lisp-completion-or-file-name-at-point () - "Complete lisp symbol or filename at point. -Filename completion happen if string start after or between a double quote." - (interactive) - (let* ((tap (thing-at-point 'filename))) - (if (and tap (save-excursion - (end-of-line) - (search-backward tap (point-at-bol) t) - (looking-back "[^'`( ]"))) - (helm-complete-file-name-at-point) - (helm-lisp-completion-at-point)))) - - -;;; Apropos -;; -;; -(defun helm-apropos-init (test default) - "Init candidates buffer for `helm-apropos' sources." - (require 'helm-help) - (helm-init-candidates-in-buffer 'global - (let ((default-symbol (and (stringp default) - (intern-soft default))) - (symbols (all-completions "" obarray test))) - (if (and default-symbol (funcall test default-symbol)) - (cons default-symbol symbols) - symbols)))) - -(defun helm-apropos-init-faces (default) - "Init candidates buffer for faces for `helm-apropos'." - (require 'helm-help) - (with-current-buffer (helm-candidate-buffer 'global) - (goto-char (point-min)) - (let ((default-symbol (and (stringp default) - (intern-soft default))) - (faces (face-list))) - (when (and default-symbol (facep default-symbol)) - (insert (concat default "\n"))) - (insert - (mapconcat #'prin1-to-string - (if default - (cl-remove-if (lambda (sym) (string= sym default)) faces) - faces) - "\n"))))) - -(defun helm-apropos-default-sort-fn (candidates _source) - (if (string= helm-pattern "") - candidates - (sort candidates #'helm-generic-sort-fn))) - -(defun helm-def-source--emacs-variables (&optional default) - (helm-build-in-buffer-source "Variables" - :init `(lambda () - (helm-apropos-init - (lambda (x) (and (boundp x) (not (keywordp x)))) ,default)) - :fuzzy-match helm-apropos-fuzzy-match - :filtered-candidate-transformer (and (null helm-apropos-fuzzy-match) - 'helm-apropos-default-sort-fn) - :nomark t - :action '(("Describe Variable" . helm-describe-variable) - ("Find Variable" . helm-find-variable) - ("Info lookup" . helm-info-lookup-symbol) - ("Set variable" . helm-set-variable)))) - -(defun helm-def-source--emacs-faces (&optional default) - (helm-build-in-buffer-source "Faces" - :init (lambda () (helm-apropos-init-faces default)) - :fuzzy-match helm-apropos-fuzzy-match - :filtered-candidate-transformer - (append (and (null helm-apropos-fuzzy-match) - '(helm-apropos-default-sort-fn)) - (list - (lambda (candidates _source) - (cl-loop for c in candidates - collect (propertize c 'face (intern c)))))) - :nomark t - :action (lambda (candidate) - (describe-face (intern candidate))))) - -(defun helm-def-source--helm-attributes (&optional _default) - (helm-build-sync-source "Helm attributes" - :candidates (lambda () - (mapcar 'symbol-name helm-attributes)) - :fuzzy-match helm-apropos-fuzzy-match - :nomark t - :action (lambda (candidate) - (let (special-display-buffer-names - special-display-regexps - helm-persistent-action-use-special-display) - (with-output-to-temp-buffer "*Help*" - (princ (get (intern candidate) 'helm-attrdoc))))))) - -(defun helm-def-source--emacs-commands (&optional default) - (helm-build-in-buffer-source "Commands" - :init `(lambda () - (helm-apropos-init 'commandp ,default)) - :fuzzy-match helm-apropos-fuzzy-match - :filtered-candidate-transformer (and (null helm-apropos-fuzzy-match) - 'helm-apropos-default-sort-fn) - :nomark t - :action '(("Describe Function" . helm-describe-function) - ("Find Function" . helm-find-function) - ("Info lookup" . helm-info-lookup-symbol)))) - -(defun helm-def-source--emacs-functions (&optional default) - (helm-build-in-buffer-source "Functions" - :init `(lambda () - (helm-apropos-init #'(lambda (x) - (and (fboundp x) - (not (commandp x)) - (not (generic-p x)) - (not (class-p x)))) - ,default)) - :fuzzy-match helm-apropos-fuzzy-match - :filtered-candidate-transformer (and (null helm-apropos-fuzzy-match) - 'helm-apropos-default-sort-fn) - :nomark t - :action '(("Describe Function" . helm-describe-function) - ("Find Function" . helm-find-function) - ("Info lookup" . helm-info-lookup-symbol)))) - -(defun helm-def-source--eieio-classes (&optional default) - (helm-build-in-buffer-source "Classes" - :init `(lambda () - (helm-apropos-init #'(lambda (x) - (class-p x)) - ,default)) - :fuzzy-match helm-apropos-fuzzy-match - :filtered-candidate-transformer (and (null helm-apropos-fuzzy-match) - 'helm-apropos-default-sort-fn) - :nomark t - :action '(("Describe Function" . helm-describe-function) - ("Find Function" . helm-find-function) - ("Info lookup" . helm-info-lookup-symbol)))) - -(defun helm-def-source--eieio-generic (&optional default) - (helm-build-in-buffer-source "Generic functions" - :init `(lambda () - (helm-apropos-init #'(lambda (x) - (generic-p x)) - ,default)) - :fuzzy-match helm-apropos-fuzzy-match - :filtered-candidate-transformer (and (null helm-apropos-fuzzy-match) - 'helm-apropos-default-sort-fn) - :nomark t - :action '(("Describe Function" . helm-describe-function) - ("Find Function" . helm-find-function) - ("Info lookup" . helm-info-lookup-symbol)))) - -(defun helm-info-lookup-symbol (candidate) - (let ((helm-execute-action-at-once-if-one t) - (helm-quit-if-no-candidate - `(lambda () - (message "`%s' Not Documented as a symbol" ,candidate)))) - (helm :sources '(helm-source-info-elisp - helm-source-info-cl - helm-source-info-eieio) - :resume 'noresume - :buffer "*helm lookup*" - :input candidate))) - -;;;###autoload -(defun helm-apropos () - "Preconfigured helm to describe commands, functions, variables and faces." - (interactive) - (let ((default (thing-at-point 'symbol))) - (helm :sources - (mapcar (lambda (func) - (funcall func default)) - helm-apropos-function-list) - :buffer "*helm apropos*" - :preselect (and default (concat "\\_<" (regexp-quote default) "\\_>"))))) - - -;;; Advices -;; -;; -(defvar helm-source-advice - '((name . "Function Advice") - (candidates . helm-advice-candidates) - (action ("Toggle Enable/Disable" . helm-advice-toggle)) - (persistent-action . helm-advice-persistent-action) - (nomark) - (multiline) - (persistent-help . "Describe function / C-u C-j: Toggle advice"))) - -(defun helm-advice-candidates () - (cl-loop for (fname) in ad-advised-functions - for function = (intern fname) - append - (cl-loop for class in ad-advice-classes append - (cl-loop for advice in (ad-get-advice-info-field function class) - for enabled = (ad-advice-enabled advice) - collect - (cons (format - "%s %s %s" - (if enabled "Enabled " "Disabled") - (propertize fname 'face 'font-lock-function-name-face) - (ad-make-single-advice-docstring advice class nil)) - (list function class advice)))))) - -(defun helm-advice-persistent-action (func-class-advice) - (if current-prefix-arg - (helm-advice-toggle func-class-advice) - (describe-function (car func-class-advice)))) - -(defun helm-advice-toggle (func-class-advice) - (cl-destructuring-bind (function _class advice) func-class-advice - (cond ((ad-advice-enabled advice) - (ad-advice-set-enabled advice nil) - (message "Disabled")) - (t - (ad-advice-set-enabled advice t) - (message "Enabled"))) - (ad-activate function) - (and helm-in-persistent-action - (helm-advice-update-current-display-string)))) - -(defun helm-advice-update-current-display-string () - (helm-edit-current-selection - (let ((newword (cond ((looking-at "Disabled") "Enabled") - ((looking-at "Enabled") "Disabled")))) - (when newword - (delete-region (point) (progn (forward-word 1) (point))) - (insert newword))))) - -;;;###autoload -(defun helm-manage-advice () - "Preconfigured `helm' to disable/enable function advices." - (interactive) - (helm-other-buffer 'helm-source-advice "*helm advice*")) - - -;;; Locate elisp library -;; -;; -(defun helm-locate-library-scan-list () - (cl-loop for dir in load-path - when (file-directory-p dir) - append (directory-files dir t (concat (regexp-opt (get-load-suffixes)) - "\\'")) - into lst - finally return (helm-fast-remove-dups lst :test 'equal))) - -;;;###autoload -(defun helm-locate-library () - (interactive) - (helm :sources (helm-build-in-buffer-source "Elisp libraries (Scan)" - :data (lambda () (helm-locate-library-scan-list)) - :fuzzy-match t - :keymap helm-generic-files-map - :match-part (lambda (candidate) - (if helm-ff-transformer-show-only-basename - (helm-basename candidate) candidate)) - :filter-one-by-one (lambda (c) - (if helm-ff-transformer-show-only-basename - (cons (helm-basename c) c) c)) - :action (helm-actions-from-type-file)) - :buffer "*helm locate library*")) - -(defun helm-set-variable (var) - "Set value to VAR interactively." - (let* ((sym (helm-symbolify var)) - (val (default-value sym))) - (set-default sym (eval-minibuffer (format "Set `%s': " var) - (if (or (stringp val) (memq val '(nil t))) - (prin1-to-string val) - (format "'%s" (prin1-to-string val))))))) - - -;;; Type attributes -;; -;; -(let ((actions '(("Describe command" . describe-function) - ("Add command to kill ring" . helm-kill-new) - ("Go to command's definition" . find-function) - ("Debug on entry" . debug-on-entry) - ("Cancel debug on entry" . cancel-debug-on-entry) - ("Trace function" . trace-function) - ("Trace function (background)" . trace-function-background) - ("Untrace function" . untrace-function)))) - (define-helm-type-attribute 'command - `((action ("Call interactively" . helm-call-interactively) - ,@actions) - (coerce . helm-symbolify) - (persistent-action . describe-function)) - "Command. (string or symbol)") - - (define-helm-type-attribute 'function - `((action . ,actions) - (action-transformer helm-transform-function-call-interactively) - (candidate-transformer helm-mark-interactive-functions) - (coerce . helm-symbolify)) - "Function. (string or symbol)")) - -(define-helm-type-attribute 'variable - '((action - ("Describe variable" . describe-variable) - ("Add variable to kill ring" . helm-kill-new) - ("Go to variable's definition" . find-variable) - ("Set variable" . helm-set-variable)) - (coerce . helm-symbolify)) - "Variable.") - -(defun helm-btf--usable-p () - "Return t if current version of `backtrace-frame' accept 2 arguments." - (condition-case nil - (and (backtrace-frame 1 'condition-case) t) - (wrong-number-of-arguments nil))) - -(if (helm-btf--usable-p) ; Check if BTF accept more than one arg. - ;; Emacs 24.4. - (dont-compile - (defvar helm-sexp--last-sexp nil) - ;; This wont work compiled. - (defun helm-sexp-eval-1 () - (interactive) - (unwind-protect - (progn - ;; Trick called-interactively-p into thinking that `cand' is - ;; an interactive call, See `repeat-complex-command'. - (add-hook 'called-interactively-p-functions - #'helm-complex-command-history--called-interactively-skip) - (eval (read helm-sexp--last-sexp))) - (remove-hook 'called-interactively-p-functions - #'helm-complex-command-history--called-interactively-skip))) - - (defun helm-complex-command-history--called-interactively-skip (i _frame1 frame2) - (and (eq 'eval (cadr frame2)) - (eq 'helm-sexp-eval-1 - (cadr (backtrace-frame (+ i 2) #'called-interactively-p))) - 1)) - - (defun helm-sexp-eval (_candidate) - (call-interactively #'helm-sexp-eval-1))) - ;; Emacs 24.3 - (defun helm-sexp-eval (cand) - (let ((sexp (read cand))) - (condition-case err - (if (> (length (remove nil sexp)) 1) - (eval sexp) - (apply 'call-interactively sexp)) - (error (message "Evaluating gave an error: %S" err) - nil))))) - -(define-helm-type-attribute 'sexp - '((action - ("Eval" . (lambda (candidate) - (and (boundp 'helm-sexp--last-sexp) - (setq helm-sexp--last-sexp candidate)) - (run-with-timer 0.1 nil #'helm-sexp-eval candidate))) - ("Edit and eval" . - (lambda (cand) - (minibuffer-with-setup-hook - (lambda () (insert cand)) - (call-interactively #'eval-expression))))) - (persistent-action . helm-sexp-eval)) - "Sexp.") - -(define-helm-type-attribute 'timer - '((action - ("Cancel Timer" . (lambda (_timer) - (let ((mkd (helm-marked-candidates))) - (cl-loop for timer in mkd - do (cancel-timer timer))))) - ("Describe Function" . (lambda (tm) (describe-function (timer--function tm)))) - ("Find Function" . (lambda (tm) (find-function (timer--function tm))))) - (persistent-action . (lambda (tm) (describe-function (timer--function tm)))) - (persistent-help . "Describe Function")) - "Timer.") - - -;;; Elisp Timers. -;; -;; -(defvar helm-source-absolute-time-timers - '((name . "Absolute Time Timers") - (candidates . timer-list) - (filtered-candidate-transformer - . (lambda (candidates _source) - (cl-loop for timer in candidates - collect (cons (helm-elisp--format-timer timer) timer)))) - (allow-dups) - (volatile) - (type . timer))) - -(defvar helm-source-idle-time-timers - '((name . "Idle Time Timers") - (candidates . timer-idle-list) - (allow-dups) - (volatile) - (filtered-candidate-transformer - . (lambda (candidates _source) - (cl-loop for timer in candidates - collect (cons (helm-elisp--format-timer timer) timer)))) - (type . timer))) - -(defun helm-elisp--format-timer (timer) - (format "%s repeat=%s %s(%s)" - (let ((time (timer--time timer))) - (if (timer--idle-delay timer) - (format-time-string "idle-for=%5s" time) - (format-time-string "%m/%d %T" time))) - (or (timer--repeat-delay timer) "nil") - (mapconcat 'identity (split-string - (prin1-to-string (timer--function timer)) - "\n") " ") - (mapconcat 'prin1-to-string (timer--args timer) " "))) - -;;;###autoload -(defun helm-timers () - "Preconfigured `helm' for timers." - (interactive) - (helm-other-buffer '(helm-source-absolute-time-timers - helm-source-idle-time-timers) - "*helm timers*")) - - -;;; Complex command history -;; -;; -(defvar helm-source-complex-command-history - '((name . "Complex Command History") - (candidates . (lambda () - ;; Use cdr to avoid adding - ;; `helm-complex-command-history' here. - (cl-loop for i in command-history - unless (equal i '(helm-complex-command-history)) - collect (prin1-to-string i)))) - (type . sexp))) - -;;;###autoload -(defun helm-complex-command-history () - (interactive) - (helm :sources 'helm-source-complex-command-history - :buffer "*helm complex commands*")) - -(provide 'helm-elisp) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-elisp.el ends here diff --git a/elpa/helm-20150403.101/helm-elscreen.el b/elpa/helm-20150403.101/helm-elscreen.el deleted file mode 100644 index 178d37fe..00000000 --- a/elpa/helm-20150403.101/helm-elscreen.el +++ /dev/null @@ -1,79 +0,0 @@ -;;; helm-elscreen.el -- Elscreen support -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: -(require 'cl-lib) -(require 'helm) - -(declare-function elscreen-find-screen-by-buffer "ext:elscreen.el" (buffer &optional create)) -(declare-function elscreen-find-file "ext:elscreen.el" (filename)) -(declare-function elscreen-goto "ext:elscreen.el" (screen)) - -(defun helm-find-buffer-on-elscreen (candidate) - "Open buffer in new screen, if marked buffers open all in elscreens." - (helm-require-or-error 'elscreen 'helm-find-buffer-on-elscreen) - (helm-aif (helm-marked-candidates) - (cl-dolist (i it) - (let ((target-screen (elscreen-find-screen-by-buffer - (get-buffer i) 'create))) - (elscreen-goto target-screen))) - (let ((target-screen (elscreen-find-screen-by-buffer - (get-buffer candidate) 'create))) - (elscreen-goto target-screen)))) - -(defun helm-elscreen-find-file (file) - (helm-require-or-error 'elscreen 'helm-elscreen-find-file) - (elscreen-find-file file)) - -(defvar helm-source-elscreen - '((name . "Elscreen") - (candidates - . (lambda () - (if (cdr (elscreen-get-screen-to-name-alist)) - (sort - (cl-loop for sname in (elscreen-get-screen-to-name-alist) - append (list (format "[%d] %s" (car sname) (cdr sname)))) - #'(lambda (a b) (compare-strings a nil nil b nil nil)))))) - (action - . (("Change Screen" . - (lambda (candidate) - (elscreen-goto (- (aref candidate 1) (aref "0" 0))))) - ("Kill Screen(s)" . - (lambda (candidate) - (cl-dolist (i (helm-marked-candidates)) - (elscreen-goto (- (aref i 1) (aref "0" 0))) - (elscreen-kill)))) - ("Only Screen" . - (lambda (candidate) - (elscreen-goto (- (aref candidate 1) (aref "0" 0))) - (elscreen-kill-others))))))) - -;;;###autoload -(defun helm-elscreen () - "Preconfigured helm to list elscreen." - (interactive) - (helm-other-buffer 'helm-source-elscreen "*Helm Elscreen*")) - -(provide 'helm-elscreen) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-elscreen.el ends here diff --git a/elpa/helm-20150403.101/helm-eshell.el b/elpa/helm-20150403.101/helm-eshell.el deleted file mode 100644 index 3d85c3c8..00000000 --- a/elpa/helm-20150403.101/helm-eshell.el +++ /dev/null @@ -1,246 +0,0 @@ -;;; helm-eshell.el --- pcomplete and eshell completion for helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;; Enable like this in .emacs: -;; -;; (add-hook 'eshell-mode-hook -;; #'(lambda () -;; (define-key eshell-mode-map [remap pcomplete] 'helm-esh-pcomplete))) -;; - -;;; Code: -(require 'cl-lib) -(require 'helm) -(require 'helm-elisp) -(require 'helm-regexp) - -(declare-function eshell-read-aliases-list "em-alias") -(declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline)) -(declare-function eshell-bol "esh-mode") -(declare-function eshell-parse-arguments "esh-arg" (beg end)) -(declare-function eshell-backward-argument "esh-mode" (&optional arg)) - -(defvar helm-eshell-history-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-p") 'helm-next-line) - map) - "Keymap for `helm-eshell-history'.") - -(defvar helm-esh-completion-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "TAB") 'helm-next-line) - map) - "Keymap for `helm-esh-pcomplete'.") - -(defclass helm-esh-source (helm-source-sync) - ((init :initform (lambda () - (setq pcomplete-current-completions nil - pcomplete-last-completion-raw nil) - ;; Eshell-command add this hook in all minibuffers - ;; Remove it for the helm one. (Fixed in Emacs24) - (remove-hook 'minibuffer-setup-hook 'eshell-mode))) - (candidates :initform 'helm-esh-get-candidates) - (nomark :initform t) - (persistent-action :initform 'ignore) - (filtered-candidate-transformer - :initform - (lambda (candidates _sources) - (cl-loop - for i in candidates - collect - (cond ((string-match "\\`~/?" helm-ec-target) - (abbreviate-file-name i)) - ((string-match "\\`/" helm-ec-target) i) - (t - (file-relative-name i))) - into lst - finally return (sort lst 'helm-generic-sort-fn)))) - (action :initform 'helm-ec-insert)) - "Helm class to define source for Eshell completion.") - -;; Internal. -(defvar helm-ec-target "") -(defun helm-ec-insert (candidate) - "Replace text at point with CANDIDATE. -The function that call this should set `helm-ec-target' to thing at point." - (let ((pt (point))) - (when (and helm-ec-target - (search-backward helm-ec-target nil t) - (string= (buffer-substring (point) pt) helm-ec-target)) - (delete-region (point) pt))) - (when (string-match "\\`\\*" helm-ec-target) (insert "*")) - (cond ((string-match "\\`~/?" helm-ec-target) - (insert (helm-quote-whitespace (abbreviate-file-name candidate)))) - ((string-match "\\`/" helm-ec-target) - (insert (helm-quote-whitespace candidate))) - (t - (insert (concat (and (string-match "\\`[.]/" helm-ec-target) "./") - (helm-quote-whitespace - (file-relative-name candidate))))))) - -(defun helm-esh-get-candidates () - "Get candidates for eshell completion using `pcomplete'." - (catch 'pcompleted - (with-helm-current-buffer - (let* ((pcomplete-stub) - pcomplete-seen pcomplete-norm-func - pcomplete-args pcomplete-last pcomplete-index - (pcomplete-autolist pcomplete-autolist) - (pcomplete-suffix-list pcomplete-suffix-list) - (table (pcomplete-completions)) - (entry (or (try-completion helm-pattern - (pcomplete-entries)) - helm-pattern))) - (cl-loop ;; expand entry too to be able to compare it with file-cand. - with exp-entry = (and (stringp entry) - (not (string= entry "")) - (file-name-as-directory - (expand-file-name entry default-directory))) - for i in (all-completions pcomplete-stub table) - ;; Transform the related names to abs names. - for file-cand = (and exp-entry - (if (file-remote-p i) i - (expand-file-name - i (file-name-directory entry)))) - ;; Compare them to avoid dups. - for file-entry-p = (and (stringp exp-entry) - (stringp file-cand) - ;; Fix :/tmp/foo/ $ cd foo - (not (file-directory-p file-cand)) - (file-equal-p exp-entry file-cand)) - if (and file-cand (or (file-remote-p file-cand) - (file-exists-p file-cand)) - (not file-entry-p)) - collect file-cand into ls - else - ;; Avoid adding entry here. - unless file-entry-p collect i into ls - finally return - (if (and exp-entry - (file-directory-p exp-entry) - ;; If the car of completion list is - ;; an executable, probably we are in - ;; command completion, so don't add a - ;; possible file related entry here. - (and ls (not (executable-find (car ls)))) - ;; Don't add entry if already in prompt. - (not (file-equal-p exp-entry pcomplete-stub))) - (append (list exp-entry) - ;; Entry should not be here now but double check. - (remove entry ls)) - ls)))))) - -;;; Eshell history. -;; -;; -(defclass helm-eshell-history-source (helm-source-in-buffer) - ((init :initform (lambda () - (let (eshell-hist-ignoredups) - (eshell-write-history eshell-history-file-name t) - (with-current-buffer (helm-candidate-buffer 'global) - (insert-file-contents eshell-history-file-name))) - ;; Same comment as in `helm-source-esh' - (remove-hook 'minibuffer-setup-hook 'eshell-mode))) - (nomark :initform t) - (keymap :initform helm-eshell-history-map) - (filtered-candidate-transformer :initform (lambda (candidates sources) - (reverse candidates))) - (candidate-number-limit :initform 9999) - (action :initform (lambda (candidate) - (eshell-kill-input) - (insert candidate)))) - "Helm class to define source for Eshell history.") - -;;;###autoload -(defun helm-esh-pcomplete () - "Preconfigured helm to provide helm completion in eshell." - (interactive) - (let* ((helm-quit-if-no-candidate t) - (helm-execute-action-at-once-if-one t) - (end (point-marker)) - (beg (save-excursion (eshell-bol) (point))) - (args (catch 'eshell-incomplete - (eshell-parse-arguments beg end))) - (target - (or (and (looking-back " ") " ") - (buffer-substring-no-properties - (save-excursion - (eshell-backward-argument 1) (point)) - end))) - (first (car args)) ; Maybe lisp delimiter "(". - last) ; Will be the last but parsed by pcomplete. - (setq helm-ec-target (or target " ") - end (point) - ;; Reset beg for `with-helm-show-completion'. - beg (or (and target (not (string= target " ")) - (- end (length target))) - ;; Nothing at point. - (progn (insert " ") (point)))) - (cond ((eq first ?\() - (helm-lisp-completion-or-file-name-at-point)) - ;; In eshell `pcomplete-parse-arguments' is called - ;; with `pcomplete-parse-arguments-function' - ;; locally bound to `eshell-complete-parse-arguments' - ;; which is calling `lisp-complete-symbol', - ;; calling it before would popup the - ;; *completions* buffer. - (t (setq last (replace-regexp-in-string - "\\`\\*" "" - (car (last (ignore-errors - (pcomplete-parse-arguments)))))) - (with-helm-show-completion beg end - (helm :sources (helm-make-source "Eshell completions" 'helm-esh-source) - :buffer "*helm pcomplete*" - :keymap helm-esh-completion-map - :resume 'noresume - :input (and (stringp last) - (helm-ff-set-pattern last)))))))) - -;;;###autoload -(defun helm-eshell-history () - "Preconfigured helm for eshell history." - (interactive) - (let* ((end (point)) - (beg (save-excursion (eshell-bol) (point))) - (input (buffer-substring beg end)) - flag-empty) - (when (eq beg end) - (insert " ") - (setq flag-empty t) - (setq end (point))) - (unwind-protect - (with-helm-show-completion beg end - (helm :sources (helm-make-source "Eshell history" - 'helm-eshell-history-source) - :buffer "*helm eshell history*" - :resume 'noresume - :input input)) - (when (and flag-empty - (looking-back " ")) - (delete-char -1))))) - -(provide 'helm-eshell) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-eshell ends here diff --git a/elpa/helm-20150403.101/helm-eval.el b/elpa/helm-20150403.101/helm-eval.el deleted file mode 100644 index 850cdf4f..00000000 --- a/elpa/helm-20150403.101/helm-eval.el +++ /dev/null @@ -1,177 +0,0 @@ -;;; helm-eval.el --- eval expressions from helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: -(require 'cl-lib) -(require 'helm) -(require 'eldoc) - - -(defgroup helm-eval nil - "Eval related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-eldoc-in-minibuffer-show-fn - 'helm-show-info-in-mode-line - "A function to display eldoc info. -Should take one arg: the string to display." - :group 'helm-eval - :type 'symbol) - -(defcustom helm-show-info-in-mode-line-delay 12 - "Eldoc will show info in mode-line during this delay if user is idle." - :type 'integer - :group 'helm-eval) - - -(declare-function eldoc-current-symbol "eldoc") -(declare-function eldoc-get-fnsym-args-string "eldoc" (sym &optional index)) -(declare-function eldoc-get-var-docstring "eldoc" (sym)) -(declare-function eldoc-fnsym-in-current-sexp "eldoc") - -;;; Evaluation Result -;; -;; -;; Internal -(defvar helm-eldoc-active-minibuffers-list nil) - -(defvar helm-eval-expression-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "") 'helm-eval-new-line-and-indent) - (define-key map (kbd "") 'lisp-indent-line) - (define-key map (kbd "") 'helm-lisp-completion-at-point) - (define-key map (kbd "C-p") 'previous-line) - (define-key map (kbd "C-n") 'next-line) - (define-key map (kbd "") 'previous-line) - (define-key map (kbd "") 'next-line) - (define-key map (kbd "") 'forward-char) - (define-key map (kbd "") 'backward-char) - map)) - -(defvar helm-source-evaluation-result - '((name . "Evaluation Result") - (init . (lambda () (require 'edebug))) - (dummy) - (multiline) - (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.") - (filtered-candidate-transformer . (lambda (candidates _source) - (list - (condition-case nil - (with-helm-current-buffer - (pp-to-string - (if edebug-active - (edebug-eval-expression - (read helm-pattern)) - (eval (read helm-pattern))))) - (error "Error"))))) - (action . (("Copy result to kill-ring" . (lambda (candidate) - (kill-new - (replace-regexp-in-string - "\n" "" candidate)))) - ("copy sexp to kill-ring" . (lambda (candidate) - (kill-new helm-input))))))) - -(defun helm-eval-new-line-and-indent () - (interactive) - (newline) (lisp-indent-line)) - -(defun helm-eldoc-store-minibuffer () - "Store minibuffer buffer name in `helm-eldoc-active-minibuffers-list'." - (with-selected-window (minibuffer-window) - (push (current-buffer) helm-eldoc-active-minibuffers-list))) - -(defun helm-eldoc-show-in-eval () - "Return eldoc in mode-line for current minibuffer input." - (let ((buf (window-buffer (active-minibuffer-window)))) - (condition-case err - (when (member buf helm-eldoc-active-minibuffers-list) - (with-current-buffer buf - (let* ((sym (save-excursion - (unless (looking-back ")\\|\"") - (forward-char -1)) - (eldoc-current-symbol))) - (info-fn (eldoc-fnsym-in-current-sexp)) - (doc (or (eldoc-get-var-docstring sym) - (eldoc-get-fnsym-args-string - (car info-fn) (cadr info-fn))))) - (when doc (funcall helm-eldoc-in-minibuffer-show-fn doc))))) - (error (message "Eldoc in minibuffer error: %S" err) nil)))) - -(defun helm-show-info-in-mode-line (str) - "Display string STR in mode-line." - (save-selected-window - (with-current-buffer helm-buffer - (let ((mode-line-format (concat " " str))) - (force-mode-line-update) - (sit-for helm-show-info-in-mode-line-delay)) - (force-mode-line-update)))) - -;;; Calculation Result -;; -;; -(defvar helm-source-calculation-result - '((name . "Calculation Result") - (dummy) - (filtered-candidate-transformer . (lambda (candidates _source) - (list - (condition-case nil - (calc-eval helm-pattern) - (error "error"))))) - (action ("Copy result to kill-ring" . kill-new)))) - -;;;###autoload -(defun helm-eval-expression (arg) - "Preconfigured helm for `helm-source-evaluation-result'." - (interactive "P") - (helm :sources 'helm-source-evaluation-result - :input (when arg (thing-at-point 'sexp)) - :buffer "*helm eval*" - :history 'read-expression-history - :keymap helm-eval-expression-map)) - -(defvar eldoc-idle-delay) -;;;###autoload -(defun helm-eval-expression-with-eldoc () - "Preconfigured helm for `helm-source-evaluation-result' with `eldoc' support. " - (interactive) - (let ((timer (run-with-idle-timer - eldoc-idle-delay 'repeat - 'helm-eldoc-show-in-eval))) - (unwind-protect - (minibuffer-with-setup-hook - 'helm-eldoc-store-minibuffer - (call-interactively 'helm-eval-expression)) - (and timer (cancel-timer timer)) - (setq helm-eldoc-active-minibuffers-list - (cdr helm-eldoc-active-minibuffers-list))))) - -;;;###autoload -(defun helm-calcul-expression () - "Preconfigured helm for `helm-source-calculation-result'." - (interactive) - (helm-other-buffer 'helm-source-calculation-result "*helm calcul*")) - -(provide 'helm-eval) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-eval.el ends here diff --git a/elpa/helm-20150403.101/helm-external.el b/elpa/helm-20150403.101/helm-external.el deleted file mode 100644 index 28298e3a..00000000 --- a/elpa/helm-20150403.101/helm-external.el +++ /dev/null @@ -1,216 +0,0 @@ -;;; helm-external.el --- Run Externals commands within Emacs with helm completion. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-net) - - -(defgroup helm-external nil - "External related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-raise-command nil - "A shell command to jump to a window running specific program. -Need external program wmctrl. -This will be use with `format', so use something like \"wmctrl -xa %s\"." - :type 'string - :group 'helm-external) - -(defcustom helm-external-programs-associations nil - "Alist to store externals programs associated with file extension. -This variable overhide setting in .mailcap file. -e.g : '\(\(\"jpg\" . \"gqview\"\) (\"pdf\" . \"xpdf\"\)\) " - :type '(alist :key-type string :value-type string) - :group 'helm-external) - -(defcustom helm-default-external-file-browser "nautilus" - "Default external file browser for your system. -Directories will be opened externally with it when -opening file externally in `helm-find-files'. -Set to nil if you do not have external file browser -or do not want to use it. -Windows users should set that to \"explorer.exe\"." - :group 'helm-external - :type 'string) - - -;;; Internals -(defvar helm-external-command-history nil) -(defvar helm-external-commands-list nil - "A list of all external commands the user can execute. -If this variable is not set by the user, it will be calculated -automatically.") - -(defun helm-external-commands-list-1 (&optional sort) - "Returns a list of all external commands the user can execute. -If `helm-external-commands-list' is non-nil it will -return its contents. Else it calculates all external commands -and sets `helm-external-commands-list'." - (helm-aif helm-external-commands-list - it - (setq helm-external-commands-list - (cl-loop - for dir in (split-string (getenv "PATH") path-separator) - when (and (file-exists-p dir) (file-accessible-directory-p dir)) - for lsdir = (cl-loop for i in (directory-files dir t) - for bn = (file-name-nondirectory i) - when (and (not (member bn completions)) - (not (file-directory-p i)) - (file-executable-p i)) - collect bn) - append lsdir into completions - finally return - (if sort (sort completions 'string-lessp) completions))))) - -(defun helm-run-or-raise (exe &optional file) - "Generic command that run asynchronously EXE. -If EXE is already running just jump to his window if `helm-raise-command' -is non--nil. -When FILE argument is provided run EXE with FILE. -In this case EXE must be provided as \"EXE %s\"." - (let* ((real-com (car (split-string (replace-regexp-in-string - "%s" "" exe)))) - (proc (if file (concat real-com " " file) real-com)) - process-connection-type) - (if (get-process proc) - (if helm-raise-command - (shell-command (format helm-raise-command real-com)) - (error "Error: %s is already running" real-com)) - (when (cl-loop for i in helm-external-commands-list thereis (string= real-com i)) - (message "Starting %s..." real-com) - (if file - (start-process-shell-command - proc nil (format exe (shell-quote-argument - (if (eq system-type 'windows-nt) - (helm-w32-prepare-filename file) - file)))) - (start-process-shell-command proc nil real-com)) - (set-process-sentinel - (get-process proc) - #'(lambda (process event) - (when (and (string= event "finished\n") - helm-raise-command - (not (helm-get-pid-from-process-name real-com))) - (shell-command (format helm-raise-command "emacs"))) - (message "%s process...Finished." process)))) - (setq helm-external-commands-list - (cons real-com - (delete real-com helm-external-commands-list)))))) - -(defun helm-get-mailcap-for-file (filename) - "Get the command to use for FILENAME from mailcap files. -The command is like and is meant to use with `format'." - (mailcap-parse-mailcaps) - (let* ((ext (file-name-extension filename)) - (mime (when ext (mailcap-extension-to-mime ext))) - (result (when mime (mailcap-mime-info mime)))) - ;; If elisp file have no associations in .mailcap - ;; `mailcap-maybe-eval' is returned, in this case just return nil. - (when (stringp result) result))) - -(defun helm-get-default-program-for-file (filename) - "Try to find a default program to open FILENAME. -Try first in `helm-external-programs-associations' and then in mailcap file -if nothing found return nil." - (let* ((ext (file-name-extension filename)) - (def-prog (assoc-default ext helm-external-programs-associations))) - (cond ((and def-prog (not (string= def-prog ""))) - (concat def-prog " %s")) - ((and helm-default-external-file-browser - (file-directory-p filename)) - (concat helm-default-external-file-browser " %s")) - (t (helm-get-mailcap-for-file filename))))) - -(defun helm-open-file-externally (file) - "Open FILE with an external program. -Try to guess which program to use with `helm-get-default-program-for-file'. -If not found or a prefix arg is given query the user which tool to use." - (let* ((fname (expand-file-name file)) - (collection (helm-external-commands-list-1 'sort)) - (def-prog (helm-get-default-program-for-file fname)) - (real-prog-name (if (or helm-current-prefix-arg (not def-prog)) - ;; Prefix arg or no default program. - (prog1 - (helm-comp-read - "Program: " collection - :must-match t - :name "Open file Externally" - :del-input nil - :history helm-external-command-history) - ;; Always prompt to set this program as default. - (setq def-prog nil)) - ;; No prefix arg or default program exists. - (replace-regexp-in-string " %s\\| '%s'" "" def-prog))) - (program (concat real-prog-name " %s"))) - (unless (or def-prog ; Association exists, no need to record it. - ;; Don't try to record non--filenames associations (e.g urls). - (not (file-exists-p fname))) - (when - (y-or-n-p - (format - "Do you want to make `%s' the default program for this kind of files? " - real-prog-name)) - (helm-aif (assoc (file-name-extension fname) - helm-external-programs-associations) - (setq helm-external-programs-associations - (delete it helm-external-programs-associations))) - (push (cons (file-name-extension fname) - (helm-read-string - "Program (Add args maybe and confirm): " real-prog-name)) - helm-external-programs-associations) - (customize-save-variable 'helm-external-programs-associations - helm-external-programs-associations))) - (helm-run-or-raise program file) - (setq helm-external-command-history - (cons real-prog-name - (delete real-prog-name - (cl-loop for i in helm-external-command-history - when (executable-find i) collect i)))))) - -;;;###autoload -(defun helm-run-external-command (program) - "Preconfigured `helm' to run External PROGRAM asyncronously from Emacs. -If program is already running exit with error. -You can set your own list of commands with -`helm-external-commands-list'." - (interactive (list - (helm-comp-read - "RunProgram: " - (helm-external-commands-list-1 'sort) - :must-match t - :del-input nil - :name "External Commands" - :history helm-external-command-history))) - (helm-run-or-raise program) - (setq helm-external-command-history - (cons program (delete program - (cl-loop for i in helm-external-command-history - when (executable-find i) collect i))))) - - -(provide 'helm-external) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-external ends here diff --git a/elpa/helm-20150403.101/helm-files.el b/elpa/helm-20150403.101/helm-files.el deleted file mode 100644 index a13fbc42..00000000 --- a/elpa/helm-20150403.101/helm-files.el +++ /dev/null @@ -1,3165 +0,0 @@ -;;; helm-files.el --- helm file browser and related. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-utils) -(require 'helm-external) -(require 'helm-grep) -(require 'helm-match-plugin) -(require 'helm-help) -(require 'helm-locate) -(require 'helm-bookmark) -(require 'helm-tags) -(require 'helm-buffers) -(require 'thingatpt) -(require 'ffap) -(require 'dired-aux) -(require 'dired-x) -(require 'tramp) -(require 'image-dired) - -(declare-function find-library-name "find-func.el" (library)) -(declare-function w32-shell-execute "ext:w32fns.c" (operation document &optional parameters show-flag)) -(declare-function gnus-dired-attach "ext:gnus-dired.el" (files-to-attach)) -(declare-function image-dired-display-image "image-dired.el" (file &optional original-size)) -(declare-function image-dired-update-property "image-dired.el" (prop value)) -(declare-function eshell-read-aliases-list "em-alias") -(declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline)) -(declare-function eshell-kill-input "esh-mode") -(declare-function eshell-bol "esh-mode") -(declare-function helm-ls-git-ls "ext:helm-ls-git") -(declare-function helm-hg-find-files-in-project "ext:helm-ls-hg") - -(defvar recentf-list) - - -;;; Type attributes -;; -;; -(define-helm-type-attribute 'file - (helm-build-type-file) - "File name.") - - - -(defgroup helm-files nil - "Files applications and libraries for Helm." - :group 'helm) - -(defcustom helm-boring-file-regexp-list - (mapcar (lambda (f) - (concat - (rx-to-string - (replace-regexp-in-string - "/$" "" f) t) "$")) - completion-ignored-extensions) - "The regexp list matching boring files." - :group 'helm-files - :type '(repeat (choice regexp))) - -(defcustom helm-for-files-preferred-list - '(helm-source-buffers-list - helm-source-recentf - helm-source-bookmarks - helm-source-file-cache - helm-source-files-in-current-dir - helm-source-locate) - "Your preferred sources to find files." - :type '(repeat (choice symbol)) - :group 'helm-files) - -(defcustom helm-tramp-verbose 0 - "Just like `tramp-verbose' but specific to helm. -When set to 0 don't show tramp messages in helm. -If you want to have the default tramp messages set it to 3." - :type 'integer - :group 'helm-files) - -(defcustom helm-ff-auto-update-initial-value nil - "Auto update when only one candidate directory is matched. -Default value when starting `helm-find-files' is nil because -it prevent using to delete char backward and by the way -confuse beginners. -For a better experience with `helm-find-files' set this to non--nil -and use C- to toggle it." - :group 'helm-files - :type 'boolean) - -(defcustom helm-ff-lynx-style-map t - "Use arrow keys to navigate with `helm-find-files'. -You will have to restart Emacs or reeval `helm-find-files-map' -and `helm-read-file-map' for this take effect." - :group 'helm-files - :type 'boolean) - -(defcustom helm-ff-history-max-length 100 - "Number of elements shown in `helm-find-files' history." - :group 'helm-files - :type 'integer) - -(defcustom helm-ff-smart-completion t - "Try to complete filenames smarter when non--nil. -See `helm-ff--transform-pattern-for-completion' for more info." - :group 'helm-files - :type 'boolean) - -(defcustom helm-ff-tramp-not-fancy t - "No colors when listing remote files when set to non--nil. -This make listing much faster, specially on slow machines." - :group 'helm-files - :type 'boolean) - -(defcustom helm-ff-exif-data-program "exiftran" - "Program used to extract exif data of an image file." - :group 'helm-files - :type 'string) - -(defcustom helm-ff-exif-data-program-args "-d" - "Arguments used for `helm-ff-exif-data-program'." - :group 'helm-files - :type 'string) - -(defcustom helm-ff-newfile-prompt-p t - "Whether Prompt or not when creating new file. -This set `ffap-newfile-prompt'." - :type 'boolean - :group 'helm-files) - -(defcustom helm-ff-avfs-directory "~/.avfs" - "The default avfs directory, usually '~/.avfs'. -When this is set you will be able to expand archive filenames with `C-j' -inside an avfs directory mounted with mountavfs. -See ." - :type 'string - :group 'helm-files) - -(defcustom helm-ff-file-compressed-list '("gz" "bz2" "zip" "7z") - "Minimal list of compressed files extension." - :type '(repeat (choice string)) - :group 'helm-files) - -(defcustom helm-ff-printer-list nil - "A list of available printers on your system. -When non--nil let you choose a printer to print file. -Otherwise when nil the variable `printer-name' will be used. -On Unix based systems (lpstat command needed) you don't need to set this, -`helm-ff-find-printers' will find a list of available printers for you." - :type '(repeat (choice string)) - :group 'helm-files) - -(defcustom helm-ff-transformer-show-only-basename t - "Show only basename of candidates in `helm-find-files'. -This can be toggled at anytime from `helm-find-files' with \ -\\\\[helm-ff-run-toggle-basename]." - :type 'boolean - :group 'helm-files) - -(defcustom helm-ff-signal-error-on-dot-files t - "Signal error when file is `.' or `..' on file deletion when non--nil. -Default is non--nil. -WARNING: Setting this to nil is unsafe and can cause deletion of a whole tree." - :group 'helm-files - :type 'boolean) - -(defcustom helm-ff-search-library-in-sexp nil - "Search for library in `require' and `declare-function' sexp." - :group 'helm-files - :type 'boolean) - -(defcustom helm-tooltip-hide-delay 25 - "Hide tooltips automatically after this many seconds." - :group 'helm-files - :type 'integer) - -(defcustom helm-ff-file-name-history-use-recentf nil - "Use `recentf-list' instead of `file-name-history' in `helm-find-files'." - :group 'helm-files - :type 'boolean) - -(defcustom helm-ff-skip-boring-files nil - "Non--nil to skip files matching regexps in `helm-boring-file-regexp-list'. -This take effect in `helm-find-files' and file completion used by `helm-mode' -i.e `helm-read-file-name'." - :group 'helm-files - :type 'boolean) - -(defcustom helm-findutils-skip-boring-files t - "Ignore files matching regexps in `completion-ignored-extensions'." - :group 'helm-files - :type 'boolean) - -(defcustom helm-findutils-search-full-path nil - "Search in full path with shell command find when non--nil. -I.e use the -path/ipath arguments of find instead of -name/iname." - :group 'helm-files - :type 'boolean) - -(defcustom helm-files-save-history-extra-sources '("Find" "Locate") - "Extras source that save candidate to `file-name-history'." - :group 'helm-files - :type '(repeat (choice string))) - -(defcustom helm-find-files-before-init-hook nil - "Hook that run before initialization of `helm-find-files'." - :group 'helm-files - :type 'hook) - -(defcustom helm-find-files-after-init-hook nil - "Hook that run after initialization of `helm-find-files'." - :group 'helm-files - :type 'hook) - -(defcustom helm-multi-files-toggle-locate-binding "C-c p" - "Default binding to switch back and forth locate in `helm-multi-files'." - :group 'helm-files - :type 'string) - - -;;; Faces -;; -;; -(defgroup helm-files-faces nil - "Customize the appearance of helm-files." - :prefix "helm-" - :group 'helm-files - :group 'helm-faces) - -(defface helm-ff-prefix - '((t (:background "yellow" :foreground "black"))) - "Face used to prefix new file or url paths in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-executable - '((t (:foreground "green"))) - "Face used for executable files in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-directory - '((t (:foreground "DarkRed" :background "LightGray"))) - "Face used for directories in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-dotted-directory - '((t (:foreground "black" :background "DimGray"))) - "Face used for dotted directories in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-symlink - '((t (:foreground "DarkOrange"))) - "Face used for symlinks in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-invalid-symlink - '((t (:foreground "black" :background "red"))) - "Face used for invalid symlinks in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-ff-file - '((t (:inherit font-lock-builtin-face))) - "Face used for file names in `helm-find-files'." - :group 'helm-files-faces) - -(defface helm-history-deleted - '((t (:inherit helm-ff-invalid-symlink))) - "Face used for deleted files in `file-name-history'." - :group 'helm-files-faces) - -(defface helm-history-remote - '((t (:foreground "Indianred1"))) - "Face used for remote files in `file-name-history'." - :group 'helm-files-faces) - - -;;; Helm-find-files - The helm file browser. -;; -;; Keymaps -(defvar helm-find-files-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-]") 'helm-ff-run-toggle-basename) - (define-key map (kbd "C-x C-f") 'helm-ff-run-locate) - (define-key map (kbd "C-x C-d") 'helm-ff-run-browse-project) - (define-key map (kbd "C-s") 'helm-ff-run-grep) - (define-key map (kbd "M-g s") 'helm-ff-run-grep) - (define-key map (kbd "M-g p") 'helm-ff-run-pdfgrep) - (define-key map (kbd "M-g z") 'helm-ff-run-zgrep) - (define-key map (kbd "M-.") 'helm-ff-run-etags) - (define-key map (kbd "M-R") 'helm-ff-run-rename-file) - (define-key map (kbd "M-C") 'helm-ff-run-copy-file) - (define-key map (kbd "M-B") 'helm-ff-run-byte-compile-file) - (define-key map (kbd "M-L") 'helm-ff-run-load-file) - (define-key map (kbd "M-S") 'helm-ff-run-symlink-file) - (define-key map (kbd "M-H") 'helm-ff-run-hardlink-file) - (define-key map (kbd "M-D") 'helm-ff-run-delete-file) - (define-key map (kbd "M-K") 'helm-ff-run-kill-buffer-persistent) - (define-key map (kbd "C-c d") 'helm-ff-persistent-delete) - (define-key map (kbd "M-e") 'helm-ff-run-switch-to-eshell) - (define-key map (kbd "C-c i") 'helm-ff-run-complete-fn-at-point) - (define-key map (kbd "C-c o") 'helm-ff-run-switch-other-window) - (define-key map (kbd "C-c C-o") 'helm-ff-run-switch-other-frame) - (define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally) - (define-key map (kbd "C-c X") 'helm-ff-run-open-file-with-default-tool) - (define-key map (kbd "M-!") 'helm-ff-run-eshell-command-on-file) - (define-key map (kbd "M-%") 'helm-ff-run-query-replace-on-marked) - (define-key map (kbd "C-c =") 'helm-ff-run-ediff-file) - (define-key map (kbd "M-=") 'helm-ff-run-ediff-merge-file) - (define-key map (kbd "M-p") 'helm-ff-run-switch-to-history) - (define-key map (kbd "C-c h") 'helm-ff-file-name-history) - (define-key map (kbd "M-i") 'helm-ff-properties-persistent) - (define-key map (kbd "C-c ?") 'helm-ff-help) - (define-key map (kbd "C-}") 'helm-narrow-window) - (define-key map (kbd "C-{") 'helm-enlarge-window) - (define-key map (kbd "C-") 'helm-ff-run-toggle-auto-update) - (define-key map (kbd "C-c ") 'helm-ff-run-toggle-auto-update) - (define-key map (kbd "C-c C-a") 'helm-ff-run-gnus-attach-files) - (define-key map (kbd "C-c p") 'helm-ff-run-print-file) - (define-key map (kbd "C-c /") 'helm-ff-run-find-sh-command) - ;; Next 2 have no effect if candidate is not an image file. - (define-key map (kbd "M-l") 'helm-ff-rotate-left-persistent) - (define-key map (kbd "M-r") 'helm-ff-rotate-right-persistent) - (define-key map (kbd "C-.") 'helm-find-files-up-one-level) - (define-key map (kbd "C-l") 'helm-find-files-up-one-level) - (define-key map (kbd "C-h C-b") 'helm-send-bug-report-from-helm) - (define-key map (kbd "C-c r") 'helm-ff-run-find-file-as-root) - (define-key map (kbd "C-c @") 'helm-ff-run-insert-org-link) - (helm-define-key-with-subkeys map (kbd "DEL") ?\d 'helm-ff-delete-char-backward - nil nil 'helm-ff-delete-char-backward--exit-fn) - (when helm-ff-lynx-style-map - (define-key map (kbd "") 'helm-find-files-up-one-level) - (define-key map (kbd "") 'helm-execute-persistent-action)) - (delq nil map)) - "Keymap for `helm-find-files'.") - -(defvar helm-read-file-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "") 'helm-cr-empty-string) - (define-key map (kbd "") 'helm-cr-empty-string) - (define-key map (kbd "C-]") 'helm-ff-run-toggle-basename) - (define-key map (kbd "C-.") 'helm-find-files-up-one-level) - (define-key map (kbd "C-l") 'helm-find-files-up-one-level) - (define-key map (kbd "C-c h") 'helm-ff-file-name-history) - (define-key map (kbd "C-") 'helm-ff-run-toggle-auto-update) - (define-key map (kbd "C-c ") 'helm-ff-run-toggle-auto-update) - (define-key map (kbd "C-c ?") 'helm-read-file-name-help) - (helm-define-key-with-subkeys map (kbd "DEL") ?\d 'helm-ff-delete-char-backward - nil nil 'helm-ff-delete-char-backward--exit-fn) - (when helm-ff-lynx-style-map - (define-key map (kbd "") 'helm-find-files-up-one-level) - (define-key map (kbd "") 'helm-execute-persistent-action) - (define-key map (kbd "") 'helm-previous-source) - (define-key map (kbd "") 'helm-next-source)) - (delq nil map)) - "Keymap for `helm-read-file-name'.") - -(defvar helm-esh-on-file-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c ?") 'helm-esh-help) - map) - "Keymap for `helm-find-files-eshell-command-on-file'.") - - -;; Internal. -(defvar helm-find-files-doc-header " (`C-l': Go up one level)" - "*The doc that is inserted in the Name header of a find-files or dired source.") -(defvar helm-ff-auto-update-flag nil - "Internal, flag to turn on/off auto-update in `helm-find-files'. -Don't set it directly, use instead `helm-ff-auto-update-initial-value'.") -(defvar helm-ff-last-expanded nil - "Store last expanded directory or file.") -(defvar helm-ff-default-directory nil) -(defvar helm-ff-history nil) -(defvar helm-ff-cand-to-mark nil) -(defvar helm-ff-url-regexp - "\\`\\(news\\(post\\)?:\\|nntp:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\):/?/?\\).*" - "Same as `ffap-url-regexp' but match earlier possible url.") -(defvar helm-tramp-file-name-regexp "\\`/\\([^[/:]+\\|[^/]+]\\):") -(defvar helm-marked-buffer-name "*helm marked*") -(defvar helm-ff--auto-update-state nil) -(defvar helm-ff--deleting-char-backward nil) -(defvar helm-multi-files--toggle-locate nil) -(defvar helm-ff--move-to-first-real-candidate t) - - -;;; Helm-find-files -;; -;; -(defvar helm-source-find-files nil - "The main source to browse files. -Should not be used among other sources.") - -(defclass helm-source-ffiles (helm-source-sync) - ((header-name - :initform (lambda (name) - (concat name helm-find-files-doc-header))) - (init - :initform (lambda () - (setq helm-ff-auto-update-flag - helm-ff-auto-update-initial-value) - (setq helm-ff--auto-update-state - helm-ff-auto-update-flag))) - (candidates :initform 'helm-find-files-get-candidates) - (filtered-candidate-transformer :initform 'helm-ff-sort-candidates) - (filter-one-by-one :initform 'helm-ff-filter-candidate-one-by-one) - (persistent-action :initform 'helm-find-files-persistent-action) - (persistent-help :initform "Hit1 Expand Candidate, Hit2 or (C-u) Find file") - (mode-line :initform helm-ff-mode-line-string) - (volatile :initform t) - (nohighlight :initform t) - (candidate-number-limit - :initform 9999) - (action-transformer - :initform 'helm-find-files-action-transformer) - (action - :initform - (helm-make-actions - "Find File" 'helm-find-file-or-marked - "Find file in Dired" 'helm-point-file-in-dired - (lambda () (and (locate-library "elscreen") "Find file in Elscreen")) - 'helm-elscreen-find-file - "View file" 'view-file - "Checksum File" 'helm-ff-checksum - "Query replace fnames on marked" 'helm-ff-query-replace-on-marked - "Query replace contents on marked" 'helm-ff-query-replace - "Query replace regexp contents on marked" 'helm-ff-query-replace-regexp - "Serial rename files" 'helm-ff-serial-rename - "Serial rename by symlinking files" 'helm-ff-serial-rename-by-symlink - "Serial rename by copying files" 'helm-ff-serial-rename-by-copying - "Open file with default tool" 'helm-open-file-with-default-tool - "Find file in hex dump" 'hexl-find-file - "Browse project" 'helm-ff-browse-project - "Complete at point `C-c i'" 'helm-insert-file-name-completion-at-point - "Insert as org link `C-c @'" 'helm-files-insert-as-org-link - "Find shell command `C-c /'" 'helm-ff-find-sh-command - "Add marked files to file-cache" 'helm-ff-cache-add-file - "Open file externally `C-c C-x, C-u to choose'" 'helm-open-file-externally - "Grep File(s) `C-s, C-u Recurse'" 'helm-find-files-grep - "Zgrep File(s) `M-g z, C-u Recurse'" 'helm-ff-zgrep - "Switch to Eshell `M-e'" 'helm-ff-switch-to-eshell - "Etags `M-., C-u reload tag file'" 'helm-ff-etags-select - "Eshell command on file(s) `M-!, C-u take all marked as arguments.'" - 'helm-find-files-eshell-command-on-file - "Find file as root `C-c r'" 'helm-find-file-as-root - "Ediff File `C-='" 'helm-find-files-ediff-files - "Ediff Merge File `C-c ='" 'helm-find-files-ediff-merge-files - "Delete File(s) `M-D'" 'helm-delete-marked-files - "Copy file(s) `M-C, C-u to follow'" 'helm-find-files-copy - "Rename file(s) `M-R, C-u to follow'" 'helm-find-files-rename - "Symlink files(s) `M-S, C-u to follow'" 'helm-find-files-symlink - "Relsymlink file(s) `C-u to follow'" 'helm-find-files-relsymlink - "Hardlink file(s) `M-H, C-u to follow'" 'helm-find-files-hardlink - "Find file other window `C-c o'" 'find-file-other-window - "Switch to history `M-p'" 'helm-find-files-switch-to-hist - "Find file other frame `C-c C-o'" 'find-file-other-frame - "Print File `C-c p, C-u to refresh'" 'helm-ff-print - "Locate `C-x C-f, C-u to specify locate db'" 'helm-ff-locate)) - (before-init-hook :initform 'helm-find-files-before-init-hook) - (after-init-hook :initform 'helm-find-files-after-init-hook))) - -(defun helm-dwim-target-directory () - "Return value of `default-directory' of buffer in other window. -If there is only one window return the value ot `default-directory' -for current buffer." - (with-helm-current-buffer - (let ((num-windows (length (remove (get-buffer-window helm-marked-buffer-name) - (window-list))))) - (expand-file-name - (if (> num-windows 1) - (save-selected-window - (other-window 1) - default-directory) - (car helm-ff-history)))))) - -(defun helm-find-files-do-action (action) - "Generic function for creating actions from `helm-source-find-files'. -ACTION must be an action supported by `helm-dired-action'." - (let* ((ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo' - (helm-marked-candidates :with-wildcard t))) - (cand (helm-get-selection)) ; Target - (prompt (format "%s %s file(s) to: " - (capitalize (symbol-name action)) - (length ifiles))) - helm-ff--move-to-first-real-candidate - (helm-always-two-windows t) - (helm-reuse-last-window-split-state t) - (helm-split-window-default-side - (eq helm-split-window-default-side 'same)) - helm-split-window-in-side-p - (parg helm-current-prefix-arg) - helm-display-source-at-screen-top ; prevent setting window-start. - helm-ff-auto-update-initial-value - (dest (with-helm-display-marked-candidates - helm-marked-buffer-name - (mapcar #'(lambda (f) - (if (file-directory-p f) - (concat (helm-basename f) "/") - (helm-basename f))) - ifiles) - (with-helm-current-buffer - (helm-read-file-name - prompt - :preselect (if helm-ff-transformer-show-only-basename - (helm-basename cand) cand) - :initial-input (helm-dwim-target-directory) - :history (helm-find-files-history :comp-read nil)))))) - (helm-dired-action - dest :files ifiles :action action :follow parg))) - -(defun helm-find-files-copy (_candidate) - "Copy files from `helm-find-files'." - (helm-find-files-do-action 'copy)) - -(defun helm-find-files-rename (_candidate) - "Rename files from `helm-find-files'." - (helm-find-files-do-action 'rename)) - -(defun helm-find-files-symlink (_candidate) - "Symlink files from `helm-find-files'." - (helm-find-files-do-action 'symlink)) - -(defun helm-find-files-relsymlink (_candidate) - "Relsymlink files from `helm-find-files'." - (helm-find-files-do-action 'relsymlink)) - -(defun helm-find-files-hardlink (_candidate) - "Hardlink files from `helm-find-files'." - (helm-find-files-do-action 'hardlink)) - -(defun helm-find-files-byte-compile (_candidate) - "Byte compile elisp files from `helm-find-files'." - (let ((files (helm-marked-candidates :with-wildcard t)) - (parg helm-current-prefix-arg)) - (cl-loop for fname in files - do (byte-compile-file fname parg)))) - -(defun helm-find-files-load-files (_candidate) - "Load elisp files from `helm-find-files'." - (let ((files (helm-marked-candidates :with-wildcard t))) - (cl-loop for fname in files - do (load fname)))) - -(defun helm-find-files-ediff-files-1 (candidate &optional merge) - "Generic function to ediff/merge files in `helm-find-files'." - (let* ((bname (helm-basename candidate)) - (marked (helm-marked-candidates :with-wildcard t)) - (prompt (if merge "Ediff Merge `%s' With File: " - "Ediff `%s' With File: ")) - (fun (if merge 'ediff-merge-files 'ediff-files)) - (input (helm-dwim-target-directory)) - (presel (if helm-ff-transformer-show-only-basename - (helm-basename candidate) - (expand-file-name - (helm-basename candidate) - input)))) - (if (= (length marked) 2) - (funcall fun (car marked) (cadr marked)) - (funcall fun candidate (helm-read-file-name - (format prompt bname) - :initial-input input - :preselect presel))))) - -(defun helm-find-files-ediff-files (candidate) - (helm-find-files-ediff-files-1 candidate)) - -(defun helm-find-files-ediff-merge-files (candidate) - (helm-find-files-ediff-files-1 candidate 'merge)) - -(defun helm-find-files-grep (_candidate) - "Default action to grep files from `helm-find-files'." - (apply 'run-with-timer 0.01 nil - #'helm-do-grep-1 - (helm-marked-candidates :with-wildcard t) - helm-current-prefix-arg)) - -(defun helm-ff-zgrep (_candidate) - "Default action to zgrep files from `helm-find-files'." - (helm-ff-zgrep-1 (helm-marked-candidates :with-wildcard t) helm-current-prefix-arg)) - -(defun helm-ff-pdfgrep (_candidate) - "Default action to pdfgrep files from `helm-find-files'." - (let ((cands (cl-loop for file in (helm-marked-candidates :with-wildcard t) - if (or (string= (file-name-extension file) "pdf") - (string= (file-name-extension file) "PDF")) - collect file)) - (helm-pdfgrep-default-function 'helm-pdfgrep-init)) - (when cands - (helm-do-pdfgrep-1 cands)))) - -(defun helm-ff-etags-select (candidate) - "Default action to jump to etags from `helm-find-files'." - (when (get-buffer helm-action-buffer) - (kill-buffer helm-action-buffer)) - (let* ((source-name (assoc-default 'name (helm-get-current-source))) - (default-directory (if (string= source-name "Find Files") - helm-ff-default-directory - (file-name-directory candidate)))) - (helm-etags-select helm-current-prefix-arg))) - -(defun helm-find-files-switch-to-hist (_candidate) - "Switch to helm-find-files history." - (helm-find-files t)) - -(defvar eshell-command-aliases-list nil) -(defvar helm-eshell-command-on-file-input-history nil) -(defun helm-find-files-eshell-command-on-file-1 (&optional map) - "Run `eshell-command' on CANDIDATE or marked candidates. -This is done possibly with an eshell alias, if no alias found, you can type in -an eshell command. - -Basename of CANDIDATE can be a wild-card. -e.g you can do \"eshell-command command *.el\" -Where \"*.el\" is the CANDIDATE. - -It is possible to do eshell-command command -like this: \"command %s some more args\". - -If MAP is given run `eshell-command' on all marked files at once, -Otherwise, run `eshell-command' on each marked files. -In other terms, with a prefix arg do on the three marked files -\"foo\" \"bar\" \"baz\": - -\"eshell-command command foo bar baz\" - -otherwise do - -\"eshell-command command foo\" -\"eshell-command command bar\" -\"eshell-command command baz\" - -Note: -If `eshell' or `eshell-command' have not been run once, -or if you have no eshell aliases `eshell-command-aliases-list' -will not be loaded first time you use this." - (when (or eshell-command-aliases-list - (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? ")) - (and eshell-command-aliases-list (eshell-read-aliases-list)) - (let* ((cand-list (helm-marked-candidates :with-wildcard t)) - (default-directory (or helm-ff-default-directory - ;; If candidate is an url *-ff-default-directory is nil - ;; so keep value of default-directory. - default-directory)) - (command (helm-comp-read - "Command: " - (cl-loop for (a . c) in eshell-command-aliases-list - when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c)) - collect (propertize a 'help-echo (car c)) into ls - finally return (sort ls 'string<)) - :buffer "*helm eshell on file*" - :name "Eshell command" - :keymap helm-esh-on-file-map - :mode-line - '("Eshell alias" - "C-c ?: Help, \\[universal-argument]: Insert output at point") - :input-history - 'helm-eshell-command-on-file-input-history)) - (alias-value (car (assoc-default command eshell-command-aliases-list)))) - (if (or (equal helm-current-prefix-arg '(16)) - (equal map '(16))) - ;; Two time C-u from `helm-comp-read' mean print to current-buffer. - ;; i.e `eshell-command' will use this value. - (setq current-prefix-arg '(16)) - ;; Else reset the value of `current-prefix-arg' - ;; to avoid printing in current-buffer. - (setq current-prefix-arg nil)) - (if (and (or - ;; One prefix-arg have been passed before `helm-comp-read'. - ;; If map have been set with C-u C-u (value == '(16)) - ;; ignore it. - (and map (equal map '(4))) - ;; One C-u from `helm-comp-read'. - (equal helm-current-prefix-arg '(4)) - ;; An alias that finish with $* - (and alias-value - ;; If command is an alias be sure it accept - ;; more than one arg i.e $*. - (string-match "\\$\\*$" alias-value))) - (cdr cand-list)) - - ;; Run eshell-command with ALL marked files as arguments. - ;; This wont work on remote files, because tramp handlers depends - ;; on `default-directory' (limitation). - (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " "))) - (if (string-match "'%s'\\|\"%s\"\\|%s" command) - (eshell-command (format command mapfiles)) ; See [1] - (eshell-command (format "%s %s" command mapfiles)))) - - ;; Run eshell-command on EACH marked files. - ;; To work with tramp handler we have to call - ;; COMMAND on basename of each file, using - ;; its basedir as `default-directory'. - (cl-loop for f in cand-list - for dir = (and (not (string-match ffap-url-regexp f)) - (helm-basedir f)) - for file = (format "'%s'" (if (and dir (file-remote-p dir)) - (helm-basename f) f)) - for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command) - ;; [1] This allow to enter other args AFTER filename - ;; i.e - (format command file) - (format "%s %s" command file)) - do (let ((default-directory (or dir default-directory))) - (eshell-command com))))))) - -(defun helm-find-files-eshell-command-on-file (_candidate) - "Run `eshell-command' on CANDIDATE or marked candidates. -See `helm-find-files-eshell-command-on-file-1' for more info." - (helm-find-files-eshell-command-on-file-1 helm-current-prefix-arg)) - -(defun helm-ff-switch-to-eshell (_candidate) - "Switch to eshell and cd to `helm-ff-default-directory'." - (let ((cd-eshell #'(lambda () - (eshell-kill-input) - (goto-char (point-max)) - (insert - (format "cd '%s'" helm-ff-default-directory)) - (eshell-send-input)))) - (if (get-buffer "*eshell*") - (switch-to-buffer "*eshell*") - (call-interactively 'eshell)) - (unless (get-buffer-process (current-buffer)) - (funcall cd-eshell)))) - -(defun helm-ff-serial-rename-action (method) - "Rename all marked files in `helm-ff-default-directory' with METHOD. -See `helm-ff-serial-rename-1'." - (let* ((helm--reading-passwd-or-string t) - (cands (helm-marked-candidates :with-wildcard t)) - (def-name (car cands)) - (name (helm-read-string "NewName: " - (replace-regexp-in-string - "[0-9]+$" "" - (helm-basename - def-name - (file-name-extension def-name))))) - (start (read-number "StartAtNumber: ")) - (extension (helm-read-string "Extension: " - (file-name-extension (car cands)))) - (dir (expand-file-name - (helm-read-file-name - "Serial Rename to directory: " - :initial-input - (expand-file-name helm-ff-default-directory) - :test 'file-directory-p - :must-match t))) - done) - (with-helm-display-marked-candidates - helm-marked-buffer-name (mapcar 'helm-basename cands) - (if (y-or-n-p - (format "Rename %s file(s) to <%s> like this ?\n%s " - (length cands) dir (format "%s <-> %s%s.%s" - (helm-basename (car cands)) - name start extension))) - (progn - (helm-ff-serial-rename-1 - dir cands name start extension :method method) - (setq done t) - (message nil)))) - (if done - (with-helm-current-buffer (helm-find-files-1 dir)) - (message "Operation aborted")))) - -(defun helm-ff-member-directory-p (file directory) - (let ((dir-file (expand-file-name - (file-name-as-directory (file-name-directory file)))) - (cur-dir (expand-file-name (file-name-as-directory directory)))) - (string= dir-file cur-dir))) - -(cl-defun helm-ff-serial-rename-1 - (directory collection new-name start-at-num extension &key (method 'rename)) - "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME. -Rename start at number START-AT-NUM - ex: prefixname-01.jpg. -EXTENSION is the file extension to use, in empty prompt, -reuse the original extension of file. -METHOD can be one of rename, copy or symlink. -Files will be renamed if they are files of current directory, otherwise they -will be treated with METHOD. -Default METHOD is rename." - ;; Maybe remove directories selected by error in collection. - (setq collection (cl-remove-if 'file-directory-p collection)) - (let* ((tmp-dir (file-name-as-directory - (concat (file-name-as-directory directory) - (symbol-name (cl-gensym "tmp"))))) - (fn (cl-case method - (copy 'copy-file) - (symlink 'make-symbolic-link) - (rename 'rename-file) - (t (error "Error: Unknown method %s" method))))) - (make-directory tmp-dir) - (unwind-protect - (progn - ;; Rename all files to tmp-dir with new-name. - ;; If files are not from start directory, use method - ;; to move files to tmp-dir. - (cl-loop for i in collection - for count from start-at-num - for fnum = (if (< count 10) "0%s" "%s") - for nname = (concat tmp-dir new-name (format fnum count) - (if (not (string= extension "")) - (format ".%s" (replace-regexp-in-string - "[.]" "" extension)) - (file-name-extension i 'dot))) - do (if (helm-ff-member-directory-p i directory) - (rename-file i nname) - (funcall fn i nname))) - ;; Now move all from tmp-dir to destination. - (cl-loop with dirlist = (directory-files - tmp-dir t directory-files-no-dot-files-regexp) - for f in dirlist do - (if (file-symlink-p f) - (make-symbolic-link (file-truename f) - (concat (file-name-as-directory directory) - (helm-basename f))) - (rename-file f directory)))) - (delete-directory tmp-dir t)))) - -(defun helm-ff-serial-rename (_candidate) - "Serial rename all marked files to `helm-ff-default-directory'. -Rename only file of current directory, and symlink files coming from -other directories. -See `helm-ff-serial-rename-1'." - (helm-ff-serial-rename-action 'rename)) - -(defun helm-ff-serial-rename-by-symlink (_candidate) - "Serial rename all marked files to `helm-ff-default-directory'. -Rename only file of current directory, and symlink files coming from -other directories. -See `helm-ff-serial-rename-1'." - (helm-ff-serial-rename-action 'symlink)) - -(defun helm-ff-serial-rename-by-copying (_candidate) - "Serial rename all marked files to `helm-ff-default-directory'. -Rename only file of current directory, and copy files coming from -other directories. -See `helm-ff-serial-rename-1'." - (helm-ff-serial-rename-action 'copy)) - -(defun helm-ff-query-replace-on-marked-1 (candidates) - (with-helm-display-marked-candidates - helm-marked-buffer-name - (mapcar 'helm-basename candidates) - (let* ((regexp (read-string "Replace regexp on filename(s): ")) - (str (read-string (format "Replace regexp `%s' with: " regexp)))) - (cl-loop with query = "y" - with count = 0 - for old in candidates - for new = (concat (helm-basedir old) - (replace-regexp-in-string - regexp str - (helm-basename old))) - ;; If `regexp' is not matched in `old' - ;; `replace-regexp-in-string' will - ;; return `old' unmodified. - unless (string= old new) - do (progn - (unless (string= query "!") - (while (not (member - (setq query - (string - (read-key - (propertize - (format - "Replace `%s' by `%s' [!,y,n,q]" - old new) - 'face 'minibuffer-prompt)))) - '("y" "!" "n" "q"))) - (message "Please answer by y,n,! or q") (sit-for 1))) - (when (string= query "q") - (cl-return (message "Operation aborted"))) - (unless (string= query "n") - (rename-file old new) - (cl-incf count))) - finally (message "%d Files renamed" count)))) - ;; This fix the emacs bug where "Emacs-Lisp:" is sent - ;; in minibuffer (not the echo area). - (sit-for 0.1) - (with-current-buffer (window-buffer (minibuffer-window)) - (delete-minibuffer-contents))) - -;; The action. -(defun helm-ff-query-replace-on-marked (_candidate) - (let ((marked (helm-marked-candidates))) - (helm-run-after-quit #'helm-ff-query-replace-on-marked-1 marked))) - -;; The command for `helm-find-files-map'. -(defun helm-ff-run-query-replace-on-marked () - (interactive) - (helm-ff-query-replace-on-marked nil)) - -(defun helm-ff-query-replace (_candidate) - (let ((bufs (cl-loop for f in (helm-marked-candidates) - collect (buffer-name (find-file-noselect f))))) - (helm-run-after-quit #'helm-buffer-query-replace-1 nil bufs))) - -(defun helm-ff-query-replace-regexp (_candidate) - (let ((bufs (cl-loop for f in (helm-marked-candidates) - collect (buffer-name (find-file-noselect f))))) - (helm-run-after-quit #'helm-buffer-query-replace-1 'regexp bufs))) - -(defun helm-ff-run-query-replace () - (interactive) - (helm-ff-query-replace nil)) - -(defun helm-ff-run-query-replace-regexp () - (interactive) - (helm-ff-query-replace-regexp nil)) - -(defun helm-ff-toggle-auto-update (_candidate) - (setq helm-ff-auto-update-flag (not helm-ff-auto-update-flag)) - (setq helm-ff--auto-update-state helm-ff-auto-update-flag) - (message "[Auto expansion %s]" - (if helm-ff-auto-update-flag "enabled" "disabled"))) - -(defun helm-ff-run-toggle-auto-update () - (interactive) - (with-helm-alive-p - (helm-attrset 'toggle-auto-update '(helm-ff-toggle-auto-update . never-split)) - (helm-execute-persistent-action 'toggle-auto-update))) - -(defun helm-ff-delete-char-backward () - "Disable helm find files auto update and delete char backward." - (interactive) - (setq helm-ff-auto-update-flag nil) - (setq helm-ff--deleting-char-backward t) - (call-interactively - (lookup-key (current-global-map) - (read-kbd-macro "DEL")))) - -(defun helm-ff-delete-char-backward--exit-fn () - (setq helm-ff-auto-update-flag helm-ff--auto-update-state) - (setq helm-ff--deleting-char-backward nil)) - -(defun helm-ff-run-switch-to-history () - "Run Switch to history action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (when (helm-file-completion-source-p) - (helm-quit-and-execute-action 'helm-find-files-switch-to-hist)))) - -(defun helm-ff-run-grep () - "Run Grep action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-find-files-grep))) - -(defun helm-ff-run-pdfgrep () - "Run Pdfgrep action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-ff-pdfgrep))) - -(defun helm-ff-run-zgrep () - "Run Grep action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-ff-zgrep))) - -(defun helm-ff-run-copy-file () - "Run Copy file action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-find-files-copy))) - -(defun helm-ff-run-rename-file () - "Run Rename file action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-find-files-rename))) - -(defun helm-ff-run-byte-compile-file () - "Run Byte compile file action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-find-files-byte-compile))) - -(defun helm-ff-run-load-file () - "Run Load file action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-find-files-load-files))) - -(defun helm-ff-run-eshell-command-on-file () - "Run eshell command on file action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action - 'helm-find-files-eshell-command-on-file))) - -(defun helm-ff-run-ediff-file () - "Run Ediff file action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-find-files-ediff-files))) - -(defun helm-ff-run-ediff-merge-file () - "Run Ediff merge file action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action - 'helm-find-files-ediff-merge-files))) - -(defun helm-ff-run-symlink-file () - "Run Symlink file action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-find-files-symlink))) - -(defun helm-ff-run-hardlink-file () - "Run Hardlink file action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-find-files-hardlink))) - -(defun helm-ff-run-delete-file () - "Run Delete file action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-delete-marked-files))) - -(defun helm-ff-run-complete-fn-at-point () - "Run complete file name action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action - 'helm-insert-file-name-completion-at-point))) - -(defun helm-ff-run-switch-to-eshell () - "Run switch to eshell action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-ff-switch-to-eshell))) - -(defun helm-ff-run-switch-other-window () - "Run switch to other window action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'find-file-other-window))) - -(defun helm-ff-run-switch-other-frame () - "Run switch to other frame action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'find-file-other-frame))) - -(defun helm-ff-run-open-file-externally () - "Run open file externally command action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-open-file-externally))) - -(defun helm-ff-run-open-file-with-default-tool () - "Run open file externally command action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-open-file-with-default-tool))) - -(defun helm-ff-locate (candidate) - "Locate action function for `helm-find-files'." - (helm-locate-set-command) - (let ((input (concat (helm-basename - (expand-file-name - candidate - helm-ff-default-directory)) - ;; The locate '-b' option doesn't exists - ;; in everything (es). - (unless (and (eq system-type 'windows-nt) - (string-match "^es" helm-locate-command)) - " -b")))) - (helm-locate-1 helm-current-prefix-arg nil 'from-ff input))) - -(defun helm-ff-run-locate () - "Run locate action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-ff-locate))) - -(defun helm-files-insert-as-org-link (candidate) - (insert (format "[[%s][]]" candidate)) - (goto-char (- (point) 2))) - -(defun helm-ff-run-insert-org-link () - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-files-insert-as-org-link))) - -(defun helm-ff-run-find-file-as-root () - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-find-file-as-root))) - -(defun helm-ff-run-gnus-attach-files () - "Run gnus attach files command action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-ff-gnus-attach-files))) - -(defun helm-ff-run-etags () - "Run Etags command action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-ff-etags-select))) - -(defvar lpr-printer-switch) -(defun helm-ff-print (_candidate) - "Print marked files. - -You may to set in order -variables `lpr-command',`lpr-switches' and/or `printer-name', -but with no settings helm should detect your printer(s) and -print with the default `lpr' settings. - -NOTE: DO NOT set the \"-P\" flag in `lpr-switches', if you really -have to modify this, do it in `lpr-printer-switch'. - -Same as `dired-do-print' but for helm." - (require 'lpr) - (when (or helm-current-prefix-arg - (not helm-ff-printer-list)) - (setq helm-ff-printer-list - (helm-ff-find-printers))) - (let* ((file-list (helm-marked-candidates :with-wildcard t)) - (len (length file-list)) - (printer-name (if helm-ff-printer-list - (helm-comp-read - "Printer: " helm-ff-printer-list) - printer-name)) - (lpr-switches - (if (and (stringp printer-name) - (string< "" printer-name)) - (cons (concat lpr-printer-switch printer-name) - lpr-switches) - lpr-switches)) - (command (helm-read-string - (format "Print *%s File(s):\n%s with: " - len - (mapconcat - (lambda (f) (format "- %s\n" f)) - file-list "")) - (when (and lpr-command lpr-switches) - (mapconcat 'identity - (cons lpr-command - (if (stringp lpr-switches) - (list lpr-switches) - lpr-switches)) - " ")))) - (file-args (mapconcat #'(lambda (x) - (format "'%s'" x)) - file-list " ")) - (cmd-line (concat command " " file-args))) - (if command - (start-process-shell-command "helm-print" nil cmd-line) - (error "Error: Please verify your printer settings in Emacs.")))) - -(defun helm-ff-run-print-file () - "Run Print file action from `helm-source-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-ff-print))) - -(defun helm-ff-checksum (file) - "Calculate the checksum of FILE. -The checksum is copied to kill-ring." - (let ((algo (intern (helm-comp-read - "Algorithm: " - '(md5 sha1 sha224 sha256 sha384 sha512))))) - (kill-new (with-temp-buffer - (insert-file-contents-literally file) - (secure-hash algo (current-buffer)))) - (message "Checksum copied to kill-ring."))) - -(defun helm-ff-toggle-basename (_candidate) - (setq helm-ff-transformer-show-only-basename - (not helm-ff-transformer-show-only-basename)) - (let* ((cand (helm-get-selection nil t)) - (target (if helm-ff-transformer-show-only-basename - (helm-basename cand) cand))) - (helm-force-update (regexp-quote target)))) - -(defun helm-ff-run-toggle-basename () - (interactive) - (with-helm-alive-p - (unless (helm-empty-source-p) - (helm-attrset 'toggle-basename '(helm-ff-toggle-basename . never-split)) - (helm-execute-persistent-action 'toggle-basename)))) - -(cl-defun helm-reduce-file-name (fname level &key unix-close expand) - "Reduce FNAME by LEVEL from end or beginning depending LEVEL value. -If LEVEL is positive reduce from end else from beginning. -If UNIX-CLOSE is non--nil close filename with /. -If EXPAND is non--nil expand-file-name." - (let* ((exp-fname (expand-file-name fname)) - (fname-list (split-string (if (or (string= fname "~/") expand) - exp-fname fname) "/" t)) - (len (length fname-list)) - (pop-list (if (< level 0) - (cl-subseq fname-list (* level -1)) - (cl-subseq fname-list 0 (- len level)))) - (result (mapconcat 'identity pop-list "/")) - (empty (string= result ""))) - (when unix-close (setq result (concat result "/"))) - (if (string-match "^~" result) - (if (string= result "~/") "~/" result) - (if (< level 0) - (if empty "../" (concat "../" result)) - (cond ((eq system-type 'windows-nt) - (if empty (expand-file-name "/") ; Expand to "/" or "c:/". - result)) - (empty "/") - (t - (concat "/" result))))))) - -;; Internal -(defvar helm--file-completion-sources - '("Find Files" "Read File Name" "Read File Name History") - "Sources that use the *find-files mechanism can be added here. -Sources generated by `helm-mode' don't need to be added here, it will -be done automatically. -You should not modify this yourself unless you know what you do.") - -(defun helm-file-completion-source-p () - "Return non--nil if current source is a file completion source." - (or minibuffer-completing-file-name - (let ((cur-source (cdr (assoc 'name (helm-get-current-source))))) - (cl-loop for i in helm--file-completion-sources - thereis (string= cur-source i))))) - -(defun helm-find-files-up-one-level (arg) - "Go up one level like unix command `cd ..'. -If prefix numeric arg is given go ARG level up." - (interactive "p") - (with-helm-alive-p - (when (and (helm-file-completion-source-p) - (not (helm-ff-invalid-tramp-name-p))) - (with-helm-window - (when helm-follow-mode - (helm-follow-mode -1) (message nil))) - ;; When going up one level we want to be at the line - ;; corresponding to actual directory, so store this info - ;; in `helm-ff-last-expanded'. - (let ((cur-cand (helm-get-selection)) - (new-pattern (helm-reduce-file-name - helm-pattern arg :unix-close t :expand t))) - (cond ((file-directory-p helm-pattern) - (setq helm-ff-last-expanded helm-ff-default-directory)) - ((file-exists-p helm-pattern) - (setq helm-ff-last-expanded helm-pattern)) - ((and cur-cand (file-exists-p cur-cand)) - (setq helm-ff-last-expanded cur-cand))) - (helm-set-pattern new-pattern helm-suspend-update-flag) - (with-helm-after-update-hook (helm-ff-retrieve-last-expanded)))))) - -(defun helm-ff-retrieve-last-expanded () - "Move overlay to last visited directory `helm-ff-last-expanded'. -This happen after using `helm-find-files-up-one-level', -or hitting C-j on \"..\"." - (when helm-ff-last-expanded - (let ((presel (if helm-ff-transformer-show-only-basename - (helm-basename - (directory-file-name helm-ff-last-expanded)) - (directory-file-name helm-ff-last-expanded)))) - (with-helm-window - (when (re-search-forward (concat "^" (regexp-quote presel) "$") nil t) - (forward-line 0) - (helm-mark-current-line))) - (setq helm-ff-last-expanded nil)))) - -(defun helm-ff-move-to-first-real-candidate () - "When candidate is an incomplete file name move to first real candidate." - (helm-aif (and (helm-file-completion-source-p) - (not (helm-empty-source-p)) - (not (string-match - "\\`[Dd]ired" - (assoc-default 'name (helm-get-current-source)))) - helm-ff--move-to-first-real-candidate - (helm-get-selection)) - (unless (or (not (stringp it)) - (and (string-match helm-tramp-file-name-regexp it) - (not (file-remote-p it nil t))) - (file-exists-p it)) - (helm-next-line)))) -(add-hook 'helm-after-update-hook 'helm-ff-move-to-first-real-candidate) - -;;; Auto-update - helm-find-files auto expansion of directories. -;; -;; -(defun helm-ff-update-when-only-one-matched () - "Expand to directory when sole completion. -When only one candidate is remaining and it is a directory, -expand to this directory. -This happen only when `helm-ff-auto-update-flag' is non--nil -or when `helm-pattern' is equal to \"~/\"." - (when (or (and helm-ff-auto-update-flag - (null helm-ff--deleting-char-backward) - (helm-file-completion-source-p) - ;; Issue #295 - ;; File predicates are returning t - ;; with paths like //home/foo. - ;; So check it is not the case by regexp - ;; to allow user to do C-a / to start e.g - ;; entering a tramp method e.g /sudo::. - (not (string-match "\\`//" helm-pattern)) - (not (helm-ff-invalid-tramp-name-p))) - ;; Fix issue #542. - (string= helm-pattern "~/")) - (let* ((history-p (string= (assoc-default - 'name (helm-get-current-source)) - "Read File Name History")) - (pat (if (string-match helm-tramp-file-name-regexp - helm-pattern) - (helm-create-tramp-name helm-pattern) - helm-pattern)) - (completed-p (string= (file-name-as-directory - (expand-file-name pat)) - helm-ff-default-directory)) - (candnum (helm-get-candidate-number))) - (when (and (or - ;; Only one candidate remaining - ;; and at least 2 char in basename. - (and (<= candnum 2) - (>= (string-width (helm-basename helm-pattern)) 2)) - ;; Already completed. - completed-p) - (not history-p)) ; Don't try to auto complete in history. - (with-helm-window - (let ((cur-cand (prog2 - (unless (or completed-p (file-exists-p pat)) - ;; Only one non--existing candidate - ;; and one directory candidate, move to it. - (helm-next-line)) - (helm-get-selection)))) - (when (and (stringp cur-cand) - (file-accessible-directory-p cur-cand)) - (if (and (not (helm-dir-is-dot cur-cand)) ; [1] - ;; Maybe we are here because completed-p is true - ;; but check this again to be sure. (Windows fix) - (<= candnum 2)) ; [2] - ;; If after going to next line the candidate - ;; is not one of "." or ".." [1] - ;; and only one candidate is remaining [2], - ;; assume candidate is a new directory to expand, and do it. - (helm-set-pattern (file-name-as-directory cur-cand)) - ;; The candidate is one of "." or ".." - ;; that mean we have entered the last letter of the directory name - ;; in prompt, so expansion is already done, just add the "/" at end - ;; of name unless helm-pattern ends with "." - ;; (i.e we are writing something starting with ".") - (unless (string-match "\\`.*[.]\\{1\\}\\'" helm-pattern) - (helm-set-pattern - ;; Need to expand-file-name to avoid e.g /ssh:host:./ in prompt. - (expand-file-name (file-name-as-directory helm-pattern))))) - (helm-check-minibuffer-input)))))))) - -(defun helm-ff-auto-expand-to-home-or-root () - "Allow expanding to home/user directory or root or text yanked after pattern." - (when (and (helm-file-completion-source-p) - (string-match - "/\\$.*/\\|/\\./\\|/\\.\\./\\|/~.*/\\|//\\|\\(/[[:alpha:]]:/\\|\\s\\+\\)" - helm-pattern) - (with-current-buffer (window-buffer (minibuffer-window)) (eolp)) - (not (string-match helm-ff-url-regexp helm-pattern))) - (let* ((match (match-string 0 helm-pattern)) - (input (cond ((string= match "/./") - (expand-file-name default-directory)) - ((string= helm-pattern "/../") "/") - ((string-match-p "\\`/\\$" match) - (let ((sub (substitute-in-file-name match))) - (if (file-directory-p sub) - sub (replace-regexp-in-string "/\\'" "" sub)))) - (t (expand-file-name - (helm-substitute-in-filename helm-pattern) - ;; [Windows] On UNC paths "/" expand to current machine, - ;; so use the root of current Drive. (i.e "C:/") - (and (memq system-type '(windows-nt ms-dos)) - (getenv "SystemDrive")) ; nil on Unix. - ))))) - (if (file-directory-p input) - (setq helm-ff-default-directory - (setq input (file-name-as-directory input))) - (setq helm-ff-default-directory (file-name-as-directory - (file-name-directory input)))) - (with-helm-window - (helm-set-pattern input) - (helm-check-minibuffer-input))))) - -(defun helm-substitute-in-filename (fname) - "Substitute all parts of FNAME from start up to \"~/\" or \"/\". -On windows system substitute from start up to \"/[[:lower:]]:/\". -This function is needed for `helm-ff-auto-expand-to-home-or-root' -and should be used carefully elsewhere, or not at all, using -`substitute-in-file-name' instead." - (if (and ffap-url-regexp - (string-match-p ffap-url-regexp fname)) - fname - (with-temp-buffer - (insert fname) - (goto-char (point-min)) - (skip-chars-forward "/") ;; Avoid infloop in UNC paths Issue #424 - (if (re-search-forward "~.*/?\\|//\\|/[[:alpha:]]:/" nil t) - (let ((match (match-string 0))) - (goto-char (if (or (string= match "//") - (string-match-p "/[[:alpha:]]:/" match)) - (1+ (match-beginning 0)) - (match-beginning 0))) - (buffer-substring-no-properties (point) (point-at-eol))) - fname)))) - -(add-hook 'helm-after-update-hook 'helm-ff-update-when-only-one-matched) -(add-hook 'helm-after-update-hook 'helm-ff-auto-expand-to-home-or-root) - -(defun helm-point-file-in-dired (file) - "Put point on filename FILE in dired buffer." - (unless (and ffap-url-regexp - (string-match-p ffap-url-regexp file)) - (let ((target (expand-file-name (helm-substitute-in-filename file)))) - (dired (file-name-directory target)) - (dired-goto-file target)))) - -(defun helm-create-tramp-name (fname) - "Build filename for `helm-pattern' like /su:: or /sudo::." - (apply #'tramp-make-tramp-file-name - (cl-loop with v = (tramp-dissect-file-name fname) - for i across v collect i))) - -(cl-defun helm-ff-tramp-hostnames (&optional (pattern helm-pattern)) - "Get a list of hosts for tramp method found in `helm-pattern'. -Argument PATTERN default to `helm-pattern', it is here only for debugging -purpose." - (when (string-match helm-tramp-file-name-regexp pattern) - (let ((method (match-string 1 pattern)) - (tn (match-string 0 pattern)) - (all-methods (mapcar 'car tramp-methods))) - (helm-fast-remove-dups - (cl-loop for (f . h) in (tramp-get-completion-function method) - append (cl-loop for e in (funcall f (car h)) - for host = (and (consp e) (cadr e)) - when (and host (not (member host all-methods))) - collect (concat tn host))) - :test 'equal)))) - -(defun helm-ff-before-action-hook-fn () - "Exit helm when user try to execute action on an invalid tramp fname." - (let ((cand (helm-get-selection))) - (when (and (helm-file-completion-source-p) - (stringp cand) - (helm-ff-invalid-tramp-name-p cand) ; Check candidate. - (helm-ff-invalid-tramp-name-p)) ; check helm-pattern. - (error "Error: Unknown file or directory `%s'" cand)))) -(add-hook 'helm-before-action-hook 'helm-ff-before-action-hook-fn) - -(cl-defun helm-ff-invalid-tramp-name-p (&optional (pattern helm-pattern)) - "Return non--nil when PATTERN is an invalid tramp filename." - (string= (helm-ff-set-pattern pattern) - "Invalid tramp file name")) - -(defun helm-ff-set-pattern (pattern) - "Handle tramp filenames in `helm-pattern'." - (let ((methods (mapcar 'car tramp-methods)) - (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:") - cur-method tramp-name) - ;; In some rare cases tramp can return a nil input, - ;; so be sure pattern is a string for safety (Issue #476). - (unless pattern (setq pattern "")) - (cond ((string-match "\\`\\$" pattern) - (substitute-in-file-name pattern)) - ((string= pattern "") "") - ((string-match "\\`[.]\\{1,2\\}/\\'" pattern) - (expand-file-name pattern)) - ((string-match ".*\\(~?/?[.]\\{1\\}/\\)\\'" pattern) - (expand-file-name default-directory)) - ((and (string-match ".*\\(~//\\|//\\)\\'" pattern) - (not (string-match helm-ff-url-regexp helm-pattern))) - (expand-file-name "/")) ; Expand to "/" or "c:/" - ((string-match "\\`\\(~/\\|.*/~/\\)\\'" pattern) - (expand-file-name "~/")) - ;; Match "/method:maybe_hostname:~" - ((and (string-match (concat reg "~") pattern) - (setq cur-method (match-string 1 pattern)) - (member cur-method methods)) - (setq tramp-name (expand-file-name - (helm-create-tramp-name - (match-string 0 pattern)))) - (replace-match tramp-name nil t pattern)) - ;; Match "/method:maybe_hostname:" - ((and (string-match reg pattern) - (setq cur-method (match-string 1 pattern)) - (member cur-method methods)) - (setq tramp-name (helm-create-tramp-name - (match-string 0 pattern))) - (replace-match tramp-name nil t pattern)) - ;; Match "/hostname:" - ((and (string-match helm-tramp-file-name-regexp pattern) - (setq cur-method (match-string 1 pattern)) - (and cur-method (not (member cur-method methods)))) - (setq tramp-name (helm-create-tramp-name - (match-string 0 pattern))) - (replace-match tramp-name nil t pattern)) - ;; Match "/method:" in this case don't try to connect. - ((and (not (string-match reg pattern)) - (string-match helm-tramp-file-name-regexp pattern) - (member (match-string 1 pattern) methods)) - "Invalid tramp file name") ; Write in helm-buffer. - ;; PATTERN is a directory, end it with "/". - ;; This will make PATTERN not ending yet with "/" - ;; candidate for `helm-ff-default-directory', - ;; allowing `helm-ff-retrieve-last-expanded' to retrieve it - ;; when descending level. - ;; However, we don't add automatically the "/" when - ;; `helm-ff-auto-update-flag' is enabled to avoid quick expansion. - ((and (file-accessible-directory-p pattern) - helm-ff-auto-update-flag) - (file-name-as-directory (expand-file-name pattern))) - ;; Return PATTERN unchanged. - (t pattern)))) - -(defun helm-find-files-get-candidates (&optional require-match) - "Create candidate list for `helm-source-find-files'." - (let* ((path (helm-ff-set-pattern helm-pattern)) - (dir-p (file-accessible-directory-p path)) - basedir - invalid-basedir - non-essential - (tramp-verbose helm-tramp-verbose)) ; No tramp message when 0. - (set-text-properties 0 (length path) nil path) - ;; Issue #118 allow creation of newdir+newfile. - (unless (or - ;; A tramp file name not completed. - (string= path "Invalid tramp file name") - ;; An empty pattern - (string= path "") - ;; Check if base directory of PATH is valid. - (helm-aif (file-name-directory path) - ;; If PATH is a valid directory IT=PATH, - ;; else IT=basedir of PATH. - (file-directory-p it))) - ;; BASEDIR is invalid, that's mean user is starting - ;; to write a non--existing path in minibuffer - ;; probably to create a 'new_dir' or a 'new_dir+new_file'. - (setq invalid-basedir t)) - ;; Don't set now `helm-pattern' if `path' == "Invalid tramp file name" - ;; like that the actual value (e.g /ssh:) is passed to - ;; `helm-ff-tramp-hostnames'. - (unless (or (string= path "Invalid tramp file name") - invalid-basedir) ; Leave helm-pattern unchanged. - (setq helm-ff-auto-update-flag ; [1] - ;; Unless auto update is disabled at startup or - ;; interactively, start auto updating only at third char. - (unless (or (null helm-ff-auto-update-initial-value) - (null helm-ff--auto-update-state) - ;; But don't enable auto update when - ;; deleting backward. - helm-ff--deleting-char-backward) - (or (>= (length (helm-basename path)) 3) dir-p))) - (setq helm-pattern (helm-ff--transform-pattern-for-completion path)) - ;; This have to be set after [1] to allow deleting char backward. - (setq basedir (expand-file-name - (if (and dir-p helm-ff-auto-update-flag) - ;; Add the final "/" to path - ;; when `helm-ff-auto-update-flag' is enabled. - (file-name-as-directory path) - (file-name-directory path)))) - (setq helm-ff-default-directory - (if (string= helm-pattern "") - (expand-file-name "/") ; Expand to "/" or "c:/" - ;; If path is an url *default-directory have to be nil. - (unless (or (string-match helm-ff-url-regexp path) - (and ffap-url-regexp - (string-match ffap-url-regexp path))) - basedir)))) - (cond ((string= path "Invalid tramp file name") - (or (helm-ff-tramp-hostnames) ; Hostnames completion. - (prog2 - ;; `helm-pattern' have not been modified yet. - ;; Set it here to the value of `path' that should be now - ;; "Invalid tramp file name" and set the candidates list - ;; to ("Invalid tramp file name") to make `helm-pattern' - ;; match single candidate "Invalid tramp file name". - (setq helm-pattern path) - ;; "Invalid tramp file name" is now printed - ;; in `helm-buffer'. - (list path)))) - ((or (and (file-regular-p path) - (eq last-repeatable-command 'helm-execute-persistent-action)) - ;; `ffap-url-regexp' don't match until url is complete. - (string-match helm-ff-url-regexp path) - invalid-basedir - (and (not (file-exists-p path)) (string-match "/$" path)) - (and ffap-url-regexp (string-match ffap-url-regexp path))) - (list path)) - ((string= path "") (helm-ff-directory-files "/" t)) - ((and (file-directory-p path) (not (file-readable-p path))) - (list (format "Opening directory: access denied, `%s'" path))) - ;; A fast expansion of PATH is made only if `helm-ff-auto-update-flag' - ;; is enabled. - ((and dir-p helm-ff-auto-update-flag) - (helm-ff-directory-files path t)) - (t (append (unless (or require-match - ;; When `helm-ff-auto-update-flag' has been - ;; disabled, whe don't want PATH to be added on top - ;; if it is a directory. - dir-p) - (list path)) - (helm-ff-directory-files basedir t)))))) - -(defsubst helm-ff-directory-files (directory &optional full) - "List contents of DIRECTORY. -Argument FULL mean absolute path. -It is same as `directory-files' but always returns the -dotted filename '.' and '..' even on root directories in Windows -systems." - (setq directory (file-name-as-directory - (expand-file-name directory))) - (let ((ls (directory-files - directory full directory-files-no-dot-files-regexp)) - (dot (concat directory ".")) - (dot2 (concat directory ".."))) - (append (list dot dot2) ls))) - -(defun helm-ff-handle-backslash (fname) - ;; Allow creation of filenames containing a backslash. - (cl-loop with bad = '((92 . "")) - for i across fname - for isbad = (assq i bad) - if isbad concat (cdr isbad) - else concat (string i))) - -(defun helm-ff-smart-completion-p () - (and helm-ff-smart-completion - (not (memq helm-mp-matching-method '(multi1 multi3p))))) - -(defun helm-ff--transform-pattern-for-completion (pattern) - "Maybe return PATTERN with it's basename modified as a regexp. -This happen only when `helm-ff-smart-completion' is enabled. -This provide a similar behavior as `ido-enable-flex-matching'. -See also `helm--mapconcat-pattern'. -If PATTERN is an url returns it unmodified. -When PATTERN contain a space fallback to match-plugin. -If basename contain one or more space fallback to match-plugin. -If PATTERN is a valid directory name,return PATTERN unchanged." - ;; handle bad filenames containing a backslash. - (setq pattern (helm-ff-handle-backslash pattern)) - (let ((bn (helm-basename pattern)) - (bd (or (helm-basedir pattern) "")) - (dir-p (file-directory-p pattern)) - (tramp-p (cl-loop for (m . f) in tramp-methods - thereis (string-match m pattern)))) - ;; Always regexp-quote base directory name to handle - ;; crap dirnames such e.g bookmark+ - (cond - ((or (and dir-p tramp-p (string-match ":\\'" pattern)) - (string= pattern "") - (and dir-p (<= (length bn) 2)) - ;; Fix Issue #541 when BD have a subdir similar - ;; to BN, don't switch to match plugin - ;; which will match both. - (and dir-p (string-match (regexp-quote bn) bd))) - ;; Use full PATTERN on e.g "/ssh:host:". - (regexp-quote pattern)) - ;; Prefixing BN with a space call match-plugin completion. - ;; This allow showing all files/dirs matching BN (Issue #518). - ;; FIXME: some match-plugin methods may not work here. - (dir-p (concat (regexp-quote bd) " " (regexp-quote bn))) - ((or (not (helm-ff-smart-completion-p)) - (string-match "\\s-" bn)) ; Fall back to match-plugin. - (concat (regexp-quote bd) bn)) - ((or (string-match "[*][.]?.*" bn) ; Allow entering wilcard. - (string-match "/$" pattern) ; Allow mkdir. - (string-match helm-ff-url-regexp pattern) - (and (string= helm-ff-default-directory "/") tramp-p)) - ;; Don't treat wildcards ("*") as regexp char. - ;; (e.g ./foo/*.el => ./foo/[*].el) - (concat (regexp-quote bd) - (replace-regexp-in-string "[*]" "[*]" bn))) - (t - (setq bn (if (>= (length bn) 2) ; wait 2nd char before concating. - (helm--mapconcat-pattern bn) - (concat ".*" (regexp-quote bn)))) - (concat (regexp-quote bd) bn))))) - -(defun helm-dir-is-dot (dir) - (string-match "\\(?:/\\|\\`\\)\\.\\{1,2\\}\\'" dir)) - -(defun helm-ff-save-history () - "Store the last value of `helm-ff-default-directory' in `helm-ff-history'. -Note that only existing directories are saved here." - (when (and helm-ff-default-directory - (helm-file-completion-source-p) - (file-directory-p helm-ff-default-directory)) - (set-text-properties 0 (length helm-ff-default-directory) - nil helm-ff-default-directory) - (push helm-ff-default-directory helm-ff-history))) -(add-hook 'helm-cleanup-hook 'helm-ff-save-history) - -(defun helm-files-save-file-name-history (&optional force) - "Save selected file to `file-name-history'." - (let ((src-name (assoc-default 'name (helm-get-current-source)))) - (when (or force (helm-file-completion-source-p) - (member src-name helm-files-save-history-extra-sources)) - (let ((mkd (helm-marked-candidates)) - (history-delete-duplicates t)) - (cl-loop for sel in mkd - when (and sel - (stringp sel) - (file-exists-p sel) - (not (file-directory-p sel))) - do - ;; we use `abbreviate-file-name' here because - ;; other parts of Emacs seems to, - ;; and we don't want to introduce duplicates. - (add-to-history 'file-name-history - (abbreviate-file-name sel))))))) -(add-hook 'helm-exit-minibuffer-hook 'helm-files-save-file-name-history) - -(defun helm-ff-valid-symlink-p (file) - (helm-aif (condition-case-unless-debug nil - ;; `file-truename' send error - ;; on cyclic symlinks (Issue #692). - (file-truename file) - (error nil)) - (file-exists-p it))) - -(defun helm-get-default-mode-for-file (filename) - "Return the default mode to open FILENAME." - (let ((mode (cl-loop for (r . m) in auto-mode-alist - thereis (and (string-match r filename) m)))) - (or (and (symbolp mode) mode) "Fundamental"))) - -(defun helm-ff-properties (candidate) - "Show file properties of CANDIDATE in a tooltip or message." - (let* ((all (helm-file-attributes candidate)) - (dired-line (helm-file-attributes - candidate :dired t :human-size t)) - (type (cl-getf all :type)) - (mode-type (cl-getf all :mode-type)) - (owner (cl-getf all :uid)) - (owner-right (cl-getf all :user t)) - (group (cl-getf all :gid)) - (group-right (cl-getf all :group)) - (other-right (cl-getf all :other)) - (size (helm-file-human-size (cl-getf all :size))) - (modif (cl-getf all :modif-time)) - (access (cl-getf all :access-time)) - (ext (helm-get-default-program-for-file candidate)) - (tooltip-hide-delay (or helm-tooltip-hide-delay tooltip-hide-delay))) - (if (and (window-system) tooltip-mode) - (tooltip-show - (concat - (helm-basename candidate) "\n" - dired-line "\n" - (format "Mode: %s\n" (helm-get-default-mode-for-file candidate)) - (format "Ext prog: %s\n" (or (and ext (replace-regexp-in-string - " %s" "" ext)) - "Not defined")) - (format "Type: %s: %s\n" type mode-type) - (when (string= type "symlink") - (format "True name: '%s'\n" - (cond ((string-match "^\.#" (helm-basename candidate)) - "Autosave symlink") - ((helm-ff-valid-symlink-p candidate) - (file-truename candidate)) - (t "Invalid Symlink")))) - (format "Owner: %s: %s\n" owner owner-right) - (format "Group: %s: %s\n" group group-right) - (format "Others: %s\n" other-right) - (format "Size: %s\n" size) - (format "Modified: %s\n" modif) - (format "Accessed: %s\n" access))) - (message dired-line) (sit-for 5)))) - -(defun helm-ff-properties-persistent () - "Show properties without quitting helm." - (interactive) - (with-helm-alive-p - (helm-attrset 'properties-action '(helm-ff-properties . never-split)) - (helm-execute-persistent-action 'properties-action))) - -(defun helm-ff-persistent-delete () - "Delete current candidate without quitting." - (interactive) - (with-helm-alive-p - (helm-attrset 'quick-delete '(helm-ff-quick-delete . never-split)) - (helm-execute-persistent-action 'quick-delete))) - -(defun helm-ff-dot-file-p (file) - "Check if FILE is `.' or `..'." - (member (helm-basename file) '("." ".."))) - -(defun helm-ff-quick-delete (_candidate) - "Delete file CANDIDATE without quitting." - (let ((marked (helm-marked-candidates))) - (unwind-protect - (save-selected-window - (cl-loop for c in marked do - (progn (helm-preselect (if (and helm-ff-transformer-show-only-basename - (not (helm-ff-dot-file-p c))) - (helm-basename c) c)) - (when (y-or-n-p (format "Really Delete file `%s'? " c)) - (helm-delete-file c helm-ff-signal-error-on-dot-files - 'synchro) - (helm-delete-current-selection) - (message nil))))) - (with-helm-buffer - (setq helm-marked-candidates nil - helm-visible-mark-overlays nil)) - (helm-force-update)))) - -(defun helm-ff-kill-buffer-fname (candidate) - (let ((buf (get-file-buffer candidate))) - (if buf - (progn - (kill-buffer buf) (message "Buffer `%s' killed" buf)) - (message "No buffer to kill")))) - -(defun helm-ff-kill-or-find-buffer-fname (candidate) - "Find file CANDIDATE or kill it's buffer if it is visible. -Never kill `helm-current-buffer'. -Never kill buffer modified. -This is called normally on third hit of \ -\\\\[helm-execute-persistent-action] -in `helm-find-files-persistent-action'." - (let* ((buf (get-file-buffer candidate)) - (buf-name (buffer-name buf)) - (win (get-buffer-window buf)) - (helm--reading-passwd-or-string t)) - (if (and buf win - (not (eq buf (get-buffer helm-current-buffer))) - (not (buffer-modified-p buf))) - (progn - (kill-buffer buf) - (set-window-buffer win helm-current-buffer) - (message "Buffer `%s' killed" buf-name)) - (find-file candidate)))) - -(defun helm-ff-run-kill-buffer-persistent () - "Execute `helm-ff-kill-buffer-fname' whitout quitting." - (interactive) - (with-helm-alive-p - (helm-attrset 'kill-buffer-fname 'helm-ff-kill-buffer-fname) - (helm-execute-persistent-action 'kill-buffer-fname))) - -(defun helm-ff-prefix-filename (fname &optional file-or-symlinkp new-file) - "Return filename FNAME maybe prefixed with [?] or [@]. -If FILE-OR-SYMLINKP is non--nil this mean we assume FNAME is an -existing filename or valid symlink and there is no need to test it. -NEW-FILE when non--nil mean FNAME is a non existing file and -return FNAME prefixed with [?]." - (let* ((prefix-new (propertize - " " 'display - (propertize "[?]" 'face 'helm-ff-prefix))) - (prefix-url (propertize - " " 'display - (propertize "[@]" 'face 'helm-ff-prefix)))) - (cond ((or file-or-symlinkp (file-exists-p fname)) fname) - ((or (string-match helm-ff-url-regexp fname) - (and ffap-url-regexp (string-match ffap-url-regexp fname))) - (concat prefix-url " " fname)) - ((or new-file (not (file-exists-p fname))) - (concat prefix-new " " fname))))) - -(defun helm-ff-score-candidate-for-pattern (str pattern) - (if (member str '("." "..")) - 200 - (helm-score-candidate-for-pattern str pattern))) - -(defun helm-ff-sort-candidates (candidates _source) - "Sort function for `helm-source-find-files'. -Return candidates prefixed with basename of `helm-input' first." - (if (or (and (file-directory-p helm-input) - (string-match "/\\'" helm-input)) - (string-match "\\`\\$" helm-input) - (null candidates)) - candidates - (let* ((c1 (car candidates)) - (cand1real (if (consp c1) (cdr c1) c1)) - (cand1 (unless (file-exists-p cand1real) c1)) - (rest-cand (if cand1 (cdr candidates) candidates)) - (memo-src (make-hash-table :test 'equal)) - (all (sort rest-cand - #'(lambda (s1 s2) - (let* ((score (lambda (str) - (helm-ff-score-candidate-for-pattern - str (helm-basename helm-input)))) - (bn1 (helm-basename (if (consp s1) (cdr s1) s1))) - (bn2 (helm-basename (if (consp s2) (cdr s2) s2))) - (sc1 (or (gethash bn1 memo-src) - (puthash bn1 (funcall score bn1) memo-src))) - (sc2 (or (gethash bn2 memo-src) - (puthash bn2 (funcall score bn2) memo-src)))) - (cond ((= sc1 sc2) - (< (string-width bn1) - (string-width bn2))) - ((> sc1 sc2)))))))) - (if cand1 (cons cand1 all) all)))) - -(defun helm-ff-filter-candidate-one-by-one (file) - "`filter-one-by-one' Transformer function for `helm-source-find-files'." - ;; Handle boring files - (unless (and helm-ff-skip-boring-files - (cl-loop for r in helm-boring-file-regexp-list - ;; Prevent user doing silly thing like - ;; adding the dotted files to boring regexps (#924). - thereis (and (not (string-match "\\.$" file)) - (string-match r file)))) - ;; Handle tramp files. - (if (and (string-match helm-tramp-file-name-regexp helm-pattern) - helm-ff-tramp-not-fancy) - (if helm-ff-transformer-show-only-basename - (if (helm-dir-is-dot file) - file - (cons (or (helm-ff-get-host-from-tramp-invalid-fname file) - (helm-basename file)) - file)) - file) - ;; Now highlight. - (let* ((disp (if (and helm-ff-transformer-show-only-basename - (not (helm-dir-is-dot file)) - (not (and ffap-url-regexp - (string-match ffap-url-regexp file))) - (not (string-match helm-ff-url-regexp file))) - (or (helm-ff-get-host-from-tramp-invalid-fname file) - (helm-basename file)) file)) - (attr (file-attributes file)) - (type (car attr))) - - (cond ((string-match "access denied" file) file) - ( ;; A not already saved file. - (and (stringp type) - (not (helm-ff-valid-symlink-p file)) - (not (string-match "^\.#" (helm-basename file)))) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-invalid-symlink) t) - file)) - ;; A symlink. - ((stringp type) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-symlink) t) - file)) - ;; A dotted directory. - ((and (eq t type) (helm-ff-dot-file-p file)) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-dotted-directory) t) - file)) - ;; A directory. - ((eq t type) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-directory) t) - file)) - ;; An executable file. - ((and attr (string-match "x" (nth 8 attr))) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-executable) t) - file)) - ;; A file. - ((and attr (null type)) - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-file) t) - file)) - ;; A non--existing file. - (t - (cons (helm-ff-prefix-filename - (propertize disp 'face 'helm-ff-file) nil 'new-file) - file))))))) - -(defun helm-find-files-action-transformer (actions candidate) - "Action transformer for `helm-source-find-files'." - (cond ((with-helm-current-buffer - (eq major-mode 'message-mode)) - (append actions - '(("Gnus attach file(s)" . helm-ff-gnus-attach-files)))) - ((string-match (image-file-name-regexp) candidate) - (append actions - '(("Rotate image right `M-r'" . helm-ff-rotate-image-right) - ("Rotate image left `M-l'" . helm-ff-rotate-image-left)))) - ((string-match "\.el$" (helm-aif (helm-marked-candidates) - (car it) candidate)) - (append actions - '(("Byte compile lisp file(s) `M-B, C-u to load'" - . helm-find-files-byte-compile) - ("Load File(s) `M-L'" . helm-find-files-load-files)))) - ((and (string-match "\.html?$" candidate) - (file-exists-p candidate)) - (append actions - '(("Browse url file" . browse-url-of-file)))) - ((or (string= (file-name-extension candidate) "pdf") - (string= (file-name-extension candidate) "PDF")) - (append actions - '(("Pdfgrep File(s)" . helm-ff-pdfgrep)))) - (t actions))) - -(defun helm-ff-gnus-attach-files (_candidate) - "Run `gnus-dired-attach' on `helm-marked-candidates' or CANDIDATE." - (require 'gnus-dired) - (let ((flist (helm-marked-candidates :with-wildcard t))) - (gnus-dired-attach flist))) - -(defvar image-dired-display-image-buffer) -(defun helm-ff-rotate-current-image-1 (file &optional num-arg) - "Rotate current image at NUM-ARG degrees. -This is a destructive operation on FILE made by external tool mogrify." - (setq file (file-truename file)) ; For symlinked images. - ;; When FILE is not an image-file, do nothing. - (when (string-match (image-file-name-regexp) file) - (if (executable-find "mogrify") - (progn - (shell-command (format "mogrify -rotate %s %s" - (or num-arg 90) - (shell-quote-argument file))) - (when (buffer-live-p image-dired-display-image-buffer) - (kill-buffer image-dired-display-image-buffer)) - (image-dired-display-image file) - (message nil) - (display-buffer (get-buffer image-dired-display-image-buffer))) - (error "mogrify not found")))) - -(defun helm-ff-rotate-image-left (candidate) - "Rotate image file CANDIDATE left. -This affect directly file CANDIDATE." - (helm-ff-rotate-current-image-1 candidate -90)) - -(defun helm-ff-rotate-image-right (candidate) - "Rotate image file CANDIDATE right. -This affect directly file CANDIDATE." - (helm-ff-rotate-current-image-1 candidate)) - -(defun helm-ff-rotate-left-persistent () - "Rotate image left without quitting helm." - (interactive) - (with-helm-alive-p - (helm-attrset 'image-action1 'helm-ff-rotate-image-left) - (helm-execute-persistent-action 'image-action1))) - -(defun helm-ff-rotate-right-persistent () - "Rotate image right without quitting helm." - (interactive) - (with-helm-alive-p - (helm-attrset 'image-action2 'helm-ff-rotate-image-right) - (helm-execute-persistent-action 'image-action2))) - -(defun helm-ff-exif-data (candidate) - "Extract exif data from file CANDIDATE using `helm-ff-exif-data-program'." - (if (and helm-ff-exif-data-program - (executable-find helm-ff-exif-data-program)) - (shell-command-to-string (format "%s %s %s" - helm-ff-exif-data-program - helm-ff-exif-data-program-args - candidate)) - (format "No program %s found to extract exif" - helm-ff-exif-data-program))) - -(defun helm-find-files-persistent-action (candidate) - "Open subtree CANDIDATE without quitting helm. -If CANDIDATE is not a directory expand CANDIDATE filename. -If CANDIDATE is alone, open file CANDIDATE filename. -That's mean: -First hit on C-j expand CANDIDATE second hit open file. -If a prefix arg is given or `helm-follow-mode' is on open file." - (let* ((follow (or (buffer-local-value - 'helm-follow-mode - (get-buffer-create helm-buffer)) - helm--temp-follow-flag)) - (new-pattern (helm-get-selection)) - (num-lines-buf (with-current-buffer helm-buffer - (count-lines (point-min) (point-max)))) - (insert-in-minibuffer #'(lambda (fname) - (with-selected-window (minibuffer-window) - (unless follow - (delete-minibuffer-contents) - (set-text-properties 0 (length fname) - nil fname) - (insert fname)))))) - (cond ((and (helm-ff-invalid-tramp-name-p) - (string-match helm-tramp-file-name-regexp candidate)) - ;; First hit insert hostname and - ;; second hit insert ":" and expand. - (if (string= candidate helm-pattern) - (funcall insert-in-minibuffer (concat candidate ":")) - (funcall insert-in-minibuffer candidate))) - ( ;; A symlink directory, expand it's truename. - (and (file-directory-p candidate) (file-symlink-p candidate)) - (funcall insert-in-minibuffer (file-name-as-directory - (file-truename - (expand-file-name candidate))))) - ;; A directory, open it. - ((file-directory-p candidate) - (when (string= (helm-basename candidate) "..") - (setq helm-ff-last-expanded helm-ff-default-directory)) - (funcall insert-in-minibuffer (file-name-as-directory - (expand-file-name candidate)))) - ;; A symlink file, expand to it's true name. (first hit) - ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow)) - (funcall insert-in-minibuffer (file-truename candidate))) - ;; A regular file, expand it, (first hit) - ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow)) - (setq helm-pattern "") ; Force update. - (funcall insert-in-minibuffer new-pattern)) - ;; An image file and it is the second hit on C-j, - ;; show the file in `image-dired'. - ((string-match (image-file-name-regexp) candidate) - (when (buffer-live-p (get-buffer image-dired-display-image-buffer)) - (kill-buffer image-dired-display-image-buffer)) - ;; Fix emacs bug never fixed upstream. - (unless (file-directory-p image-dired-dir) - (make-directory image-dired-dir)) - (image-dired-display-image candidate) - (message nil) - (switch-to-buffer image-dired-display-image-buffer) - (with-current-buffer image-dired-display-image-buffer - (let ((exif-data (helm-ff-exif-data candidate))) - (setq default-directory helm-ff-default-directory) - (image-dired-update-property 'help-echo exif-data)))) - ;; Allow browsing archive on avfs fs. - ;; Assume volume is already mounted with mountavfs. - ((and helm-ff-avfs-directory - (string-match - (regexp-quote (expand-file-name helm-ff-avfs-directory)) - (file-name-directory candidate)) - (helm-ff-file-compressed-p candidate)) - (funcall insert-in-minibuffer (concat candidate "#"))) - ;; On second hit we open file. - ;; On Third hit we kill it's buffer maybe. - (t - (helm-ff-kill-or-find-buffer-fname candidate))))) - -(defun helm-ff-file-compressed-p (candidate) - "Whether CANDIDATE is a compressed file or not." - (member (file-name-extension candidate) - helm-ff-file-compressed-list)) - -(defun helm-insert-file-name-completion-at-point (candidate) - "Insert file name completion at point." - (with-helm-current-buffer - (if buffer-read-only - (error "Error: Buffer `%s' is read-only" (buffer-name)) - (let* ((end (point)) - (tap (thing-at-point 'filename)) - (guess (and (stringp tap) (substring-no-properties tap))) - (beg (- (point) (length guess))) - (full-path-p (and (stringp guess) - (or (string-match-p - (concat "^" (getenv "HOME")) - guess) - (string-match-p - "\\`\\(/\\|[[:lower:][:upper:]]:/\\)" - guess))))) - (set-text-properties 0 (length candidate) nil candidate) - (if (and guess (not (string= guess "")) - (or (string-match "^\\(~/\\|/\\|[[:lower:][:upper:]]:/\\)" - guess) - (file-exists-p candidate))) - (progn - (delete-region beg end) - (insert (cond (full-path-p - (expand-file-name candidate)) - ((string= (match-string 1 guess) "~/") - (abbreviate-file-name candidate)) - (t (file-relative-name candidate))))) - (insert (cond ((equal helm-current-prefix-arg '(4)) - (abbreviate-file-name candidate)) - ((equal helm-current-prefix-arg '(16)) - (file-relative-name candidate)) - (t candidate)))))))) - -(cl-defun helm-find-files-history (&key (comp-read t)) - "The `helm-find-files' history. -Show the first `helm-ff-history-max-length' elements of -`helm-ff-history' in an `helm-comp-read'." - (let ((history (when helm-ff-history - (helm-fast-remove-dups helm-ff-history - :test 'equal)))) - (when history - (setq helm-ff-history - (if (>= (length history) helm-ff-history-max-length) - (cl-subseq history 0 helm-ff-history-max-length) - history)) - (if comp-read - (helm-comp-read - "Switch to Directory: " - helm-ff-history - :name "Helm Find Files History" - :must-match t) - helm-ff-history)))) - -(defun helm-find-files-1 (fname &optional preselect) - "Find FNAME with `helm' completion. -Like `find-file' but with `helm' support. -Use it for non--interactive calls of `helm-find-files'." - (when (get-buffer helm-action-buffer) - (kill-buffer helm-action-buffer)) - (let* ( ;; Be sure we don't erase the precedent minibuffer if some. - (helm-ff-auto-update-initial-value - (and helm-ff-auto-update-initial-value - (not (minibuffer-window-active-p (minibuffer-window))))) - (tap (thing-at-point 'filename)) - (def (and tap (or (file-remote-p tap) - (expand-file-name tap))))) - (unless helm-source-find-files - (setq helm-source-find-files (helm-make-source - "Find Files" 'helm-source-ffiles))) - (helm :sources 'helm-source-find-files - :input fname - :case-fold-search helm-file-name-case-fold-search - :keymap helm-find-files-map - :preselect preselect - :default def - :prompt "Find Files or Url: " - :buffer "*Helm Find Files*"))) - - -(defun helm-find-files-initial-input (&optional input) - "Return INPUT if present, otherwise try to guess it." - (let ((ffap-machine-p-known 'reject)) - (unless (eq major-mode 'image-mode) - (or (and input (or (and (file-remote-p input) input) - (expand-file-name input))) - (helm-find-files-input - (ffap-guesser) - (thing-at-point 'filename)))))) - -(defun helm-find-files-input (file-at-pt thing-at-pt) - "Try to guess a default input for `helm-find-files'." - (let* ((non-essential t) - (remp (or (and file-at-pt (file-remote-p file-at-pt)) - (and thing-at-pt (file-remote-p thing-at-pt)))) - (def-dir (helm-current-directory)) - (urlp (and file-at-pt ffap-url-regexp - (string-match ffap-url-regexp file-at-pt))) - (lib (when helm-ff-search-library-in-sexp - (helm-find-library-at-point))) - (hlink (helm-ff-find-url-at-point)) - (file-p (and file-at-pt - (not (string= file-at-pt "")) - (not remp) - (file-exists-p file-at-pt) - thing-at-pt - (not (string= thing-at-pt "")) - (file-exists-p - (file-name-directory - (expand-file-name thing-at-pt def-dir)))))) - (cond (lib) ; e.g we are inside a require sexp. - (hlink) ; String at point is an hyperlink. - (file-p ; a regular file - (helm-aif (ffap-file-at-point) (expand-file-name it))) - (urlp file-at-pt) ; possibly an url or email. - ((and file-at-pt - (not remp) - (file-exists-p file-at-pt)) - file-at-pt)))) - -(defun helm-ff-find-url-at-point () - "Try to find link to an url in text-property at point." - (let* ((he (get-text-property (point) 'help-echo)) - (ov (overlays-at (point))) - (ov-he (and ov (overlay-get - (car (overlays-at (point))) 'help-echo))) - (w3m-l (get-text-property (point) 'w3m-href-anchor)) - (nt-prop (get-text-property (point) 'nt-link))) - ;; Org link. - (when (and (stringp he) (string-match "^LINK: " he)) - (setq he (replace-match "" t t he))) - (cl-loop for i in (list he ov-he w3m-l nt-prop) - thereis (and (stringp i) ffap-url-regexp (string-match ffap-url-regexp i) i)))) - -(defun helm-find-library-at-point () - "Try to find library path at point. -Find inside `require' and `declare-function' sexp." - (require 'find-func) - (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t))) - (end-sexp (save-excursion (search-forward ")" (point-at-eol) t))) - (sexp (and beg-sexp end-sexp - (buffer-substring-no-properties - (1+ beg-sexp) (1- end-sexp))))) - (ignore-errors - (cond ((and sexp (string-match "require \'.+[^)]" sexp)) - (find-library-name - (replace-regexp-in-string - "'\\|\)\\|\(" "" - ;; If require use third arg, ignore it, - ;; always use library path found in `load-path'. - (cl-second (split-string (match-string 0 sexp)))))) - ((and sexp (string-match-p "^declare-function" sexp)) - (find-library-name - (replace-regexp-in-string - "\"\\|ext:" "" - (cl-third (split-string sexp))))) - (t nil))))) - - -;;; Handle copy, rename, symlink, relsymlink and hardlink from helm. -;; -;; -(defvar dired-async-be-async) -(cl-defun helm-dired-action (candidate - &key action follow (files (dired-get-marked-files))) - "Execute ACTION on FILES to CANDIDATE. -Where ACTION is a symbol that can be one of: -'copy, 'rename, 'symlink,'relsymlink, 'hardlink. -Argument FOLLOW when non--nil specify to follow FILES to destination for the actions -copy and rename." - (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer)) - (let ((fn (cl-case action - (copy 'dired-copy-file) - (rename 'dired-rename-file) - (symlink 'make-symbolic-link) - (relsymlink 'dired-make-relative-symlink) - (hardlink 'dired-hardlink))) - (marker (cl-case action - ((copy rename) dired-keep-marker-copy) - (symlink dired-keep-marker-symlink) - (relsymlink dired-keep-marker-relsymlink) - (hardlink dired-keep-marker-hardlink))) - (dirflag (and (= (length files) 1) - (file-directory-p (car files)) - (not (file-directory-p candidate)))) - ;; When FOLLOW is enabled, disable helm-async. - ;; If it is globally disabled use this nil value. - (dired-async-be-async (and (boundp 'dired-async-be-async) - dired-async-be-async - (not follow)))) - (dired-create-files - fn (symbol-name action) files - ;; CANDIDATE is the destination. - (if (file-directory-p candidate) - ;; When CANDIDATE is a directory, build file-name in this directory. - ;; Else we use CANDIDATE. - #'(lambda (from) - (expand-file-name (file-name-nondirectory from) candidate)) - #'(lambda (_from) candidate)) - marker) - (push (file-name-as-directory - (if (file-directory-p candidate) - (expand-file-name candidate) - (file-name-directory candidate))) - helm-ff-history) - ;; If follow is non--nil we should not be in async mode. - (when (and follow - (not (memq action '(symlink relsymlink hardlink))) - (not (get-buffer dired-log-buffer))) - (let ((target (directory-file-name candidate))) - (unwind-protect - (progn - (setq helm-ff-cand-to-mark - (helm-get-dest-fnames-from-list files candidate dirflag)) - (with-helm-after-update-hook (helm-ff-maybe-mark-candidates)) - (if (and dirflag (eq action 'rename)) - (helm-find-files-1 (file-name-directory target) - (if helm-ff-transformer-show-only-basename - (helm-basename target) target)) - (helm-find-files-1 (file-name-as-directory - (expand-file-name candidate))))) - (setq helm-ff-cand-to-mark nil)))))) - -(defun helm-get-dest-fnames-from-list (flist dest-cand rename-dir-flag) - "Transform filenames of FLIST to abs of DEST-CAND. -If RENAME-DIR-FLAG is non--nil collect the `directory-file-name' of transformed -members of FLIST." - ;; At this point files have been renamed/copied at destination. - ;; That's mean DEST-CAND exists. - (cl-loop - with dest = (expand-file-name dest-cand) - for src in flist - for basename-src = (helm-basename src) - for fname = (cond (rename-dir-flag (directory-file-name dest)) - ((file-directory-p dest) - (concat (file-name-as-directory dest) basename-src)) - (t dest)) - when (file-exists-p fname) - collect fname into tmp-list - finally return (sort tmp-list 'string<))) - -(defun helm-ff-maybe-mark-candidates () - "Mark all candidates of list `helm-ff-cand-to-mark'. -This is used when copying/renaming/symlinking etc... and -following files to destination." - (when (and (string= (assoc-default 'name (helm-get-current-source)) - (assoc-default 'name helm-source-find-files)) - helm-ff-cand-to-mark) - (with-helm-window - (while helm-ff-cand-to-mark - (if (string= (car helm-ff-cand-to-mark) (helm-get-selection)) - (progn - (helm-make-visible-mark) - (helm-next-line) - (setq helm-ff-cand-to-mark (cdr helm-ff-cand-to-mark))) - (helm-next-line))) - (unless (helm-this-visible-mark) - (helm-prev-visible-mark))))) - - -;;; Routines for files -;; -;; -(defun helm-file-buffers (filename) - "Returns a list of buffer names corresponding to FILENAME." - (cl-loop with name = (expand-file-name filename) - for buf in (buffer-list) - for bfn = (buffer-file-name buf) - when (and bfn (string= name bfn)) - collect (buffer-name buf))) - -(defun helm-delete-file (file &optional error-if-dot-file-p synchro) - "Delete the given file after querying the user. -Ask to kill buffers associated with that file, too." - (when (and error-if-dot-file-p - (helm-ff-dot-file-p file)) - (error "Error: Cannot operate on `.' or `..'")) - (let ((buffers (helm-file-buffers file)) - (helm--reading-passwd-or-string t)) - (if (or (< emacs-major-version 24) synchro) - ;; `dired-delete-file' in Emacs versions < 24 - ;; doesn't support delete-by-moving-to-trash - ;; so use `delete-directory' and `delete-file' - ;; that handle it. - (cond ((and (not (file-symlink-p file)) - (file-directory-p file) - (directory-files file t dired-re-no-dot)) - (when (y-or-n-p (format "Recursive delete of `%s'? " file)) - (delete-directory file 'recursive))) - ((and (not (file-symlink-p file)) - (file-directory-p file)) - (delete-directory file)) - (t (delete-file file))) - (dired-delete-file - file dired-recursive-deletes delete-by-moving-to-trash)) - (when buffers - (cl-dolist (buf buffers) - (when (y-or-n-p (format "Kill buffer %s, too? " buf)) - (kill-buffer buf)))))) - -(defun helm-delete-marked-files (_ignore) - (let* ((files (helm-marked-candidates :with-wildcard t)) - (len (length files))) - (with-helm-display-marked-candidates - helm-marked-buffer-name - (mapcar #'(lambda (f) - (if (file-directory-p f) - (concat (helm-basename f) "/") - (helm-basename f))) - files) - (if (not (y-or-n-p (format "Delete *%s File(s)" len))) - (message "(No deletions performed)") - (cl-dolist (i files) - (set-text-properties 0 (length i) nil i) - (helm-delete-file i helm-ff-signal-error-on-dot-files)) - (message "%s File(s) deleted" len))))) - -(defun helm-find-file-or-marked (candidate) - "Open file CANDIDATE or open helm marked files in separate windows. -Called with a prefix arg open files in background without selecting them." - (let ((marked (helm-marked-candidates :with-wildcard t)) - (url-p (and ffap-url-regexp ; we should have only one candidate. - (string-match ffap-url-regexp candidate))) - (ffap-newfile-prompt helm-ff-newfile-prompt-p) - (find-file-wildcards nil) - (make-dir-fn - #'(lambda (dir &optional helm-ff) - (when (y-or-n-p (format "Create directory `%s'? " dir)) - (let ((dirfname (directory-file-name dir))) - (if (file-exists-p dirfname) - (error - "Mkdir: Unable to create directory `%s': file exists." - (helm-basename dirfname)) - (make-directory dir 'parent))) - (when helm-ff - ;; Allow having this new dir in history - ;; to be able to retrieve it immediately - ;; if we want to e.g copy a file from somewhere in it. - (setq helm-ff-default-directory - (file-name-as-directory dir)) - (push helm-ff-default-directory helm-ff-history)) - (or (and helm-ff (helm-find-files-1 dir)) t)))) - (helm--reading-passwd-or-string t)) - (if (cdr marked) - (if helm-current-prefix-arg - (dired-simultaneous-find-file marked nil) - (mapc 'find-file-noselect (cdr marked)) - (find-file (car marked))) - (if (and (not (file-exists-p candidate)) - (not url-p) - (string-match "/$" candidate)) - ;; A a non--existing filename ending with / - ;; Create a directory and jump to it. - (funcall make-dir-fn candidate 'helm-ff) - ;; A non--existing filename NOT ending with / or - ;; an existing filename, create or jump to it. - ;; If the basedir of candidate doesn't exists, - ;; ask for creating it. - (let ((dir (file-name-directory candidate))) - (find-file-at-point - (cond ((and dir (file-directory-p dir)) - (substitute-in-file-name (car marked))) - ;; FIXME Why do we use this on urls ? - (url-p (helm-substitute-in-filename (car marked))) - ((funcall make-dir-fn dir) candidate)))))))) - -(defun helm-shadow-boring-files (files) - "Files matching `helm-boring-file-regexp' will be -displayed with the `file-name-shadow' face if available." - (helm-shadow-entries files helm-boring-file-regexp-list)) - -(defun helm-skip-boring-files (files) - "Files matching `helm-boring-file-regexp' will be skipped." - (helm-skip-entries files helm-boring-file-regexp-list)) - -(defun helm-skip-current-file (files) - "Current file will be skipped." - (remove (buffer-file-name helm-current-buffer) files)) - -(defun helm-w32-pathname-transformer (args) - "Change undesirable features of windows pathnames to ones more acceptable to -other candidate transformers." - (if (eq system-type 'windows-nt) - (helm-transform-mapcar - (lambda (x) - (replace-regexp-in-string - "/cygdrive/\\(.\\)" "\\1:" - (replace-regexp-in-string "\\\\" "/" x))) - args) - args)) - -(defun helm-transform-file-load-el (actions candidate) - "Add action to load the file CANDIDATE if it is an emacs lisp -file. Else return ACTIONS unmodified." - (if (member (file-name-extension candidate) '("el" "elc")) - (append actions '(("Load Emacs Lisp File" . load-file))) - actions)) - -(defun helm-transform-file-browse-url (actions candidate) - "Add an action to browse the file CANDIDATE if it is a html file or URL. -Else return ACTIONS unmodified." - (let ((browse-action '("Browse with Browser" . browse-url))) - (cond ((string-match "^http\\|^ftp" candidate) - (cons browse-action actions)) - ((string-match "\\.html?$" candidate) - (append actions (list browse-action))) - (t actions)))) - -(defun helm-multi-files-toggle-to-locate () - (interactive) - (with-helm-buffer - (if (setq helm-multi-files--toggle-locate - (not helm-multi-files--toggle-locate)) - (progn - (helm-set-sources (unless (memq 'helm-source-locate - helm-sources) - (cons 'helm-source-locate helm-sources))) - (helm-set-source-filter '(helm-source-locate))) - (helm-kill-async-processes) - (helm-set-sources (remove 'helm-source-locate - helm-for-files-preferred-list)) - (helm-set-source-filter nil)))) - - -;;; List of files gleaned from every dired buffer -;; -;; -(defun helm-files-in-all-dired-candidates () - (save-excursion - (cl-loop for (f . b) in dired-buffers - when (buffer-live-p b) - append (let ((dir (with-current-buffer b dired-directory))) - (if (listp dir) (cdr dir) - (directory-files f t dired-re-no-dot)))))) - -;; (dired '("~/" "~/.emacs.d/.emacs-custom.el" "~/.emacs.d/.emacs.bmk")) - -(defvar helm-source-files-in-all-dired - '((name . "Files in all dired buffer.") - (candidates . helm-files-in-all-dired-candidates) - (type . file))) - - -;;; File Cache -;; -;; -(defvar file-cache-alist) - -(defclass helm-file-cache (helm-source-in-buffer helm-type-file) - ((init :initform (lambda () (require 'filecache))) - (keymap :initform helm-generic-files-map) - (help-message :initform helm-generic-file-help-message) - (mode-line :initform helm-generic-file-mode-line-string))) - -(defun helm-file-cache-get-candidates () - (cl-loop for item in file-cache-alist append - (cl-destructuring-bind (base &rest dirs) item - (cl-loop for dir in dirs collect - (concat dir base))))) - -(defvar helm-source-file-cache nil) - -(defcustom helm-file-cache-fuzzy-match nil - "Enable fuzzy matching in `helm-source-file-cache' when non--nil." - :group 'helm-files - :type 'boolean - :set (lambda (var val) - (set var val) - (setq helm-source-file-cache - (helm-make-source "File Cache" 'helm-file-cache - :fuzzy-match helm-file-cache-fuzzy-match - :data 'helm-file-cache-get-candidates)))) - -(cl-defun helm-file-cache-add-directory-recursively - (dir &optional match (ignore-dirs t)) - (require 'filecache) - (cl-loop for f in (helm-walk-directory - dir - :path 'full - :directories nil - :match match - :skip-subdirs ignore-dirs) - do (file-cache-add-file f))) - -(defun helm-ff-cache-add-file (_candidate) - (require 'filecache) - (let ((mkd (helm-marked-candidates :with-wildcard t))) - (mapc 'file-cache-add-file mkd))) - -(defun helm-ff-file-cache-remove-file-1 (file) - "Remove FILE from `file-cache-alist'." - (let ((entry (assoc (helm-basename file) file-cache-alist)) - (dir (helm-basedir file)) - new-entry) - (setq new-entry (remove dir entry)) - (when (= (length entry) 1) - (setq new-entry nil)) - (setq file-cache-alist - (cons new-entry (remove entry file-cache-alist))))) - -(defun helm-ff-file-cache-remove-file (_file) - "Remove marked files from `file-cache-alist.'" - (let ((mkd (helm-marked-candidates))) - (mapc 'helm-ff-file-cache-remove-file-1 mkd))) - -(defun helm-transform-file-cache (actions _candidate) - (let ((source (helm-get-current-source))) - (if (string= (assoc-default 'name source) "File Cache") - (append actions - '(("Remove marked files from file-cache" - . helm-ff-file-cache-remove-file))) - actions))) - - -;;; File name history -;; -;; -(defvar helm-source-file-name-history - `((name . "File Name History") - (candidates . file-name-history) - (persistent-action . ignore) - (filtered-candidate-transformer . helm-file-name-history-transformer) - (action . ,(helm-actions-from-type-file)))) - -(defvar helm-source--ff-file-name-history nil - "[Internal] This source is build to be used with `helm-find-files'. -Don't use it in your own code unless you know what you are doing.") - -(defun helm-file-name-history-transformer (candidates _source) - (cl-loop for c in candidates collect - (cond ((file-remote-p c) - (cons (propertize c 'face 'helm-history-remote) c)) - ((file-exists-p c) - (cons (propertize c 'face 'helm-ff-file) c)) - (t (cons (propertize c 'face 'helm-history-deleted) c))))) - -(defun helm-ff-file-name-history () - "Switch to `file-name-history' without quitting `helm-find-files'." - (interactive) - (unless helm-source--ff-file-name-history - (setq helm-source--ff-file-name-history - (helm-build-sync-source "File name history" - :init (lambda () - (with-helm-alive-p - (when helm-ff-file-name-history-use-recentf - (require 'recentf) - (or recentf-mode (recentf-mode 1))))) - :candidates (lambda () - (if helm-ff-file-name-history-use-recentf - recentf-list - file-name-history)) - :fuzzy-match t - :persistent-action 'ignore - :filtered-candidate-transformer 'helm-file-name-history-transformer - :action (helm-make-actions - "Find file" (lambda (candidate) - (helm-set-pattern - (expand-file-name candidate)) - (with-helm-after-update-hook (helm-exit-minibuffer))) - "Find file in helm" (lambda (candidate) - (helm-set-pattern - (expand-file-name candidate))))))) - (with-helm-alive-p - (helm :sources 'helm-source--ff-file-name-history - :buffer "*helm-file-name-history*" - :allow-nest t - :resume 'noresume))) - -;;; Recentf files -;; -;; -(defvar helm-recentf--basename-flag nil) - -(defun helm-recentf-pattern-transformer (pattern) - (let ((pattern-no-flag (replace-regexp-in-string " -b" "" pattern))) - (cond ((and (string-match " " pattern-no-flag) - (string-match " -b\\'" pattern)) - (setq helm-recentf--basename-flag t) - pattern-no-flag) - ((string-match "\\([^ ]*\\) -b\\'" pattern) - (prog1 (match-string 1 pattern) - (setq helm-recentf--basename-flag t))) - (t (setq helm-recentf--basename-flag nil) - pattern)))) - -(defclass helm-recentf-source (helm-source-sync) - ((init :initform (lambda () - (require 'recentf) - (recentf-mode 1))) - (candidates :initform (lambda () recentf-list)) - (pattern-transformer :initform 'helm-recentf-pattern-transformer) - (match-part :initform (lambda (candidate) - (if (or helm-ff-transformer-show-only-basename - helm-recentf--basename-flag) - (helm-basename candidate) candidate))) - (filter-one-by-one :initform (lambda (c) - (if (and helm-ff-transformer-show-only-basename - (not (consp c))) - (cons (helm-basename c) c) - c))) - (keymap :initform helm-generic-files-map) - (help-message :initform helm-generic-file-help-message) - (mode-line :initform helm-generic-file-mode-line-string) - (action :initform (helm-actions-from-type-file)))) - -(defvar helm-source-recentf nil - "See (info \"(emacs)File Conveniences\"). -Set `recentf-max-saved-items' to a bigger value if default is too small.") - -(defcustom helm-recentf-fuzzy-match nil - "Enable fuzzy matching in `helm-source-recentf' when non--nil." - :group 'helm-files - :type 'boolean - :set (lambda (var val) - (set var val) - (setq helm-source-recentf - (helm-make-source "Recentf" 'helm-recentf-source - :fuzzy-match helm-recentf-fuzzy-match)))) - -;;; Browse project -;; Need dependencies: -;; -;; -;; Only hg and git are supported for now. -(defvar helm--browse-project-cache (make-hash-table :test 'equal)) -(defun helm-browse-project-find-files (directory &optional refresh) - (when refresh (remhash directory helm--browse-project-cache)) - (unless (gethash directory helm--browse-project-cache) - (puthash directory (helm-walk-directory - directory - :directories nil :path 'full :skip-subdirs t) - helm--browse-project-cache)) - (helm :sources (helm-build-in-buffer-source "Browse project" - :data (gethash directory helm--browse-project-cache) - :header-name (lambda (name) - (format - "%s (%s)" - name (abbreviate-file-name directory))) - :match-part (lambda (c) - (if helm-ff-transformer-show-only-basename - (helm-basename c) c)) - :filter-one-by-one - (lambda (c) - (if helm-ff-transformer-show-only-basename - (cons (propertize (helm-basename c) - 'face 'helm-ff-file) - c) - (propertize c 'face 'helm-ff-file))) - :mode-line helm-generic-file-mode-line-string - :keymap helm-generic-files-map - :action (helm-actions-from-type-file)) - :buffer "*helm browse project*")) - -;;;###autoload -(defun helm-browse-project (arg) - "Browse files and see status of project with its vcs. -Only HG and GIT are supported for now. -Fall back to `helm-find-files' or `helm-browse-project-find-files' -if current directory is not under control of one of those vcs. -With a prefix ARG browse files recursively, with two prefix ARG -rebuild the cache. -If the current directory is found in the cache, start -`helm-browse-project-find-files' even with no prefix ARG. -NOTE: The prefix ARG have no effect on the VCS controlled directories. - -Need dependencies for VCS: - -and -." - (interactive "P") - (cond ((and (require 'helm-ls-git nil t) - (fboundp 'helm-ls-git-root-dir) - (helm-ls-git-root-dir)) - (helm-ls-git-ls)) - ((and (require 'helm-ls-hg nil t) - (fboundp 'helm-hg-root) - (helm-hg-root)) - (helm-hg-find-files-in-project)) - (t (let ((cur-dir (helm-current-directory))) - (if (or arg (gethash cur-dir helm--browse-project-cache)) - (helm-browse-project-find-files cur-dir (equal arg '(16))) - (helm-find-files nil)))))) - -(defun helm-ff-browse-project (_candidate) - "Browse project in current directory. -See `helm-browse-project'." - (with-helm-default-directory helm-ff-default-directory - ;; `helm-browse-project' will call `helm-ls-git-ls' - ;; which will set locally `helm-default-directory' - (helm-browse-project helm-current-prefix-arg))) - -(defun helm-ff-run-browse-project () - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-ff-browse-project))) - -;;; session.el files -;; -;; session (http://emacs-session.sourceforge.net/) is an alternative to -;; recentf that saves recent file history and much more. -(defvar helm-source-session - `((name . "Session") - (candidates . (lambda () - (cl-delete-if-not #'(lambda (f) - (or (string-match helm-tramp-file-name-regexp f) - (file-exists-p f))) - (mapcar 'car session-file-alist)))) - (keymap . ,helm-generic-files-map) - (help-message . helm-generic-file-help-message) - (mode-line . helm-generic-file-mode-line-string) - (action . ,(helm-actions-from-type-file))) - "File list from emacs-session.") - - -;;; Files in current dir -;; -;; -(defun helm-highlight-files (files) - "A basic transformer for helm files sources. -Colorize only symlinks, directories and files." - (cl-loop for i in files - for disp = (if (and helm-ff-transformer-show-only-basename - (not (helm-dir-is-dot i)) - (not (and ffap-url-regexp - (string-match ffap-url-regexp i))) - (not (string-match helm-ff-url-regexp i))) - (helm-basename i) i) - for type = (car (file-attributes i)) - collect - (cond ((and helm-ff-tramp-not-fancy - (string-match helm-tramp-file-name-regexp i)) - (cons disp i)) - ((stringp type) - (cons (propertize disp - 'face 'helm-ff-symlink - 'help-echo (expand-file-name i)) - i)) - ((eq type t) - (cons (propertize disp - 'face 'helm-ff-directory - 'help-echo (expand-file-name i)) - i)) - (t (cons (propertize disp - 'face 'helm-ff-file - 'help-echo (expand-file-name i)) - i))))) - -(defclass helm-files-in-current-dir-source (helm-source-sync helm-type-file) - ((candidates :initform (lambda () - (with-helm-current-buffer - (let ((dir (helm-current-directory))) - (when (file-accessible-directory-p dir) - (directory-files dir t)))))) - (pattern-transformer :initform 'helm-recentf-pattern-transformer) - (match-part :initform (lambda (candidate) - (if (or helm-ff-transformer-show-only-basename - helm-recentf--basename-flag) - (helm-basename candidate) candidate))) - (fuzzy-match :initform t) - (keymap :initform helm-generic-files-map) - (help-message :initform helm-generic-file-help-message) - (mode-line :initform helm-generic-file-mode-line-string))) - -(defvar helm-source-files-in-current-dir - (helm-make-source "Files from Current Directory" - helm-files-in-current-dir-source)) - - -;;; External searching file tools. -;; -;; Tracker desktop search -(defvar helm-source-tracker-cand-incomplete nil "Contains incomplete candidate") -(defun helm-source-tracker-transformer (candidates _source) - (helm-log "received: %S" candidates) - (cl-loop for cand in candidates - for path = (when (stringp helm-source-tracker-cand-incomplete) - (caar (helm-highlight-files - (list helm-source-tracker-cand-incomplete)))) - for built = (if (not (stringp cand)) cand - (let ((snippet cand)) - (unless (or (null path) - (string= "" path) - (not (string-match-p - "\\`[[:space:]]*\\.\\.\\." - snippet))) - (let ((complete-candidate - (cons (concat path "\n" snippet) path))) - (setq helm-source-tracker-cand-incomplete nil) - (helm-log "built: %S" complete-candidate) - complete-candidate)))) - when (and (stringp cand) - (string-match "\\`[[:space:]]*file://" cand)) - do (setq helm-source-tracker-cand-incomplete ; save path - (replace-match "" t t cand)) end - collect built)) - -(defvar helm-source-tracker-search - `((name . "Tracker Search") - (candidates-process - . (lambda () - (start-process "tracker-search-process" nil - "tracker-search" - "--disable-color" - "--limit=512" - helm-pattern))) - (filtered-candidate-transformer . helm-source-tracker-transformer) - ;;(multiline) ; https://github.com/emacs-helm/helm/issues/529 - (keymap . ,helm-generic-files-map) - (action . ,(cdr (helm-get-attribute-from-type 'action 'file))) - (action-transformer - helm-transform-file-load-el - helm-transform-file-browse-url) - (requires-pattern . 3)) - "Source for retrieving files matching the current input pattern -with the tracker desktop search.") - -;; Spotlight (MacOS X desktop search) -(defvar helm-source-mac-spotlight - '((name . "mdfind") - (candidates-process - . (lambda () (start-process "mdfind-process" nil "mdfind" helm-pattern))) - (type . file) - (requires-pattern . 3)) - "Source for retrieving files via Spotlight's command line -utility mdfind.") - - -;;; Findutils -;; -;; -(defvar helm-source-findutils - (helm-build-async-source "Find" - :header-name (lambda (name) - (concat name " in [" helm-default-directory "]")) - :candidates-process 'helm-find-shell-command-fn - :filtered-candidate-transformer 'helm-findutils-transformer - :action-transformer 'helm-transform-file-load-el - :action (helm-actions-from-type-file) - :mode-line helm-generic-file-mode-line-string - :keymap helm-generic-files-map - :candidate-number-limit 9999 - :requires-pattern 3)) - -(defun helm-findutils-transformer (candidates _source) - (cl-loop for i in candidates - for type = (car (file-attributes i)) - for abs = (expand-file-name i helm-default-directory) - for disp = (if (and helm-ff-transformer-show-only-basename - (not (string-match "[.]\\{1,2\\}$" i))) - (helm-basename i) abs) - collect (cond ((eq t type) - (cons (propertize disp 'face 'helm-ff-directory) abs)) - ((stringp type) - (cons (propertize disp 'face 'helm-ff-symlink) abs)) - (t (cons (propertize disp 'face 'helm-ff-file) abs))))) - -(defun helm-find-shell-command-fn () - "Asynchronously fetch candidates for `helm-find'. -Additional find options can be sepcified after a \"*\" -separator." - (require 'find-cmd) - (with-helm-default-directory (helm-default-directory) - (let* (process-connection-type - (patterns+options (split-string helm-pattern "\\(\\`\\| +\\)\\* +")) - (fold-case (helm-set-case-fold-search (car patterns+options))) - (patterns (split-string (car patterns+options))) - (additional-options (and (cdr patterns+options) - (list (concat (cadr patterns+options) " ")))) - (ignored-dirs ()) - (ignored-files (when helm-findutils-skip-boring-files - (cl-loop for f in completion-ignored-extensions - if (string-match "/$" f) - do (push (replace-match "" nil t f) - ignored-dirs) - else collect (concat "*" f)))) - (path-or-name (if helm-findutils-search-full-path - '(ipath path) '(iname name))) - (name-or-iname (if fold-case - (car path-or-name) (cadr path-or-name))) - (cmd (find-cmd (and ignored-dirs - `(prune (name ,@ignored-dirs))) - (and ignored-files - `(not (name ,@ignored-files))) - `(and ,@(mapcar - (lambda (pattern) - `(,name-or-iname ,(concat "*" pattern "*"))) - patterns) - ,@additional-options))) - (proc (start-file-process-shell-command "hfind" helm-buffer cmd))) - (helm-log "Find command:\n%s" cmd) - (prog1 proc - (set-process-sentinel - proc - #'(lambda (process event) - (helm-process-deferred-sentinel-hook - process event (helm-default-directory)) - (if (string= event "finished\n") - (with-helm-window - (setq mode-line-format - '(" " mode-line-buffer-identification " " - (:eval (format "L%s" (helm-candidate-number-at-point))) " " - (:eval (propertize - (format "[Find process finished - (%s results)]" - (max (1- (count-lines - (point-min) (point-max))) - 0)) - 'face 'helm-locate-finish)))) - (force-mode-line-update)) - (helm-log "Error: Find %s" - (replace-regexp-in-string "\n" "" event))))))))) - -(defun helm-find-1 (dir) - (helm :sources 'helm-source-findutils - :buffer "*helm find*" - ;; Make these vars local for further resuming. - :default-directory dir ; reset it when called from elsewhere. - :ff-transformer-show-only-basename nil - :case-fold-search helm-file-name-case-fold-search)) - -;; helm-find-files integration. -(defun helm-ff-find-sh-command (_candidate) - "Run `helm-find' from `helm-find-files'." - (helm-find-1 helm-ff-default-directory)) - -(defun helm-ff-run-find-sh-command () - "Run find shell command action with key from `helm-find-files'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-ff-find-sh-command))) - - -;;; Preconfigured commands -;; -;; -;;;###autoload -(defun helm-find (arg) - "Preconfigured `helm' for the find shell command." - (interactive "P") - (let ((directory - (if arg - (file-name-as-directory - (read-directory-name "DefaultDirectory: ")) - default-directory))) - (helm-find-1 directory))) - -(defvar org-directory) -;;;###autoload -(defun helm-find-files (arg) - "Preconfigured `helm' for helm implementation of `find-file'. -Called with a prefix arg show history if some. -Don't call it from programs, use `helm-find-files-1' instead. -This is the starting point for nearly all actions you can do on files." - (interactive "P") - (let* ((hist (and arg helm-ff-history (helm-find-files-history))) - (default-input (or hist (helm-find-files-initial-input))) - (input (cond ((and (eq major-mode 'org-agenda-mode) - org-directory - (not default-input)) - (expand-file-name org-directory)) - ((and (eq major-mode 'dired-mode) default-input) - (file-name-directory default-input)) - ((and (not (string= default-input "")) - default-input)) - (t (expand-file-name (helm-current-directory))))) - (presel (helm-aif (or hist - (buffer-file-name (current-buffer)) - (and (eq major-mode 'dired-mode) - default-input)) - (if helm-ff-transformer-show-only-basename - (helm-basename it) it)))) - (set-text-properties 0 (length input) nil input) - (helm-find-files-1 input (and presel (concat "^" (regexp-quote presel)))))) - -;;;###autoload -(defun helm-for-files () - "Preconfigured `helm' for opening files. -Run all sources defined in `helm-for-files-preferred-list'." - (interactive) - (unless helm-source-buffers-list - (setq helm-source-buffers-list - (helm-make-source "Buffers" 'helm-source-buffers))) - (let ((helm-ff-transformer-show-only-basename nil)) - (helm :sources helm-for-files-preferred-list :buffer "*helm for files*"))) - -;;;###autoload -(defun helm-multi-files () - "Same as `helm-for-files' but allow toggling from locate to others sources." - (interactive) - (unless helm-source-buffers-list - (setq helm-source-buffers-list - (helm-make-source "Buffers" 'helm-source-buffers))) - (setq helm-multi-files--toggle-locate nil) - (let ((sources (remove 'helm-source-locate helm-for-files-preferred-list)) - (helm-ff-transformer-show-only-basename nil) - (old-key (lookup-key - helm-map - (read-kbd-macro helm-multi-files-toggle-locate-binding)))) - (with-helm-temp-hook 'helm-after-initialize-hook - (define-key helm-map (kbd helm-multi-files-toggle-locate-binding) - 'helm-multi-files-toggle-to-locate)) - (unwind-protect - (helm :sources sources - :buffer "*helm multi files*") - (define-key helm-map (kbd helm-multi-files-toggle-locate-binding) - old-key)))) - -;;;###autoload -(defun helm-recentf () - "Preconfigured `helm' for `recentf'." - (interactive) - (let ((helm-ff-transformer-show-only-basename nil)) - (helm-other-buffer 'helm-source-recentf "*helm recentf*"))) - -(provide 'helm-files) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-files.el ends here diff --git a/elpa/helm-20150403.101/helm-font.el b/elpa/helm-20150403.101/helm-font.el deleted file mode 100644 index e7a7d240..00000000 --- a/elpa/helm-20150403.101/helm-font.el +++ /dev/null @@ -1,187 +0,0 @@ -;;; helm-font --- Font and ucs selection for Helm -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) - -(defvar helm-ucs-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "") 'helm-ucs-persistent-delete) - (define-key map (kbd "") 'helm-ucs-persistent-backward) - (define-key map (kbd "") 'helm-ucs-persistent-forward) - (define-key map (kbd "") 'helm-ucs-persistent-insert) - (define-key map (kbd "C-c ?") 'helm-ucs-help) - map) - "Keymap for `helm-ucs'.") - - -;;; Xfont selection -;; -;; -(defun helm-persistent-xfont-action (elm) - "Show current font temporarily" - (let ((current-font (cdr (assoc 'font (frame-parameters)))) - (default-font elm)) - (unwind-protect - (progn (set-frame-font default-font 'keep-size) (sit-for 2)) - (set-frame-font current-font)))) - -(defvar helm-xfonts-cache nil) -(defvar helm-source-xfonts - '((name . "X Fonts") - (init . (lambda () - (unless helm-xfonts-cache - (setq helm-xfonts-cache - (x-list-fonts "*"))))) - (candidates . helm-xfonts-cache) - (action . (("Copy to kill ring" . (lambda (elm) - (kill-new elm))) - ("Set Font" . (lambda (elm) - (kill-new elm) - (set-frame-font elm 'keep-size) - (message "New font have been copied to kill ring"))))) - (persistent-action . helm-persistent-xfont-action) - (persistent-help . "Switch to this font temporarily"))) - -;;; 𝕌𝕔𝕤 𝕊𝕪𝕞𝕓𝕠𝕝 𝕔𝕠𝕞𝕡𝕝𝕖𝕥𝕚𝕠𝕟 -;; -;; -(defvar helm-ucs-max-len 0) -(defun helm-calculate-ucs-max-len () - "Calculate the length of longest `ucs-names' candidate." - (cl-loop with count = 0 - for (n . v) in (ucs-names) - for len = (length n) - if (> len count) - do (setq count len) - finally return count)) - -(defun helm-ucs-init () - "Initialize an helm buffer with ucs symbols. -Only math* symbols are collected." - (unless (> helm-ucs-max-len 0) - (setq helm-ucs-max-len - (helm-calculate-ucs-max-len))) - (with-current-buffer (helm-candidate-buffer - (get-buffer-create "*helm ucs*")) - ;; `ucs-names' fn will not run again, data is cached in - ;; var `ucs-names'. - (cl-loop for (n . v) in (ucs-names) - for len = (length n) - for diff = (+ (- helm-ucs-max-len len) 2) - unless (string= "" n) - do (progn (insert (concat - n ":" - (make-string - diff ? ))) - (if (fboundp 'ucs-insert) - (ucs-insert v) - ;; call `insert-char' with nil nil - ;; to shutup byte compiler in 24.1. - (insert-char v nil nil)) - (insert (format " #x%x" v)) - (insert "\n"))))) - -(defun helm-ucs-forward-char (_candidate) - (with-helm-current-buffer - (forward-char 1))) - -(defun helm-ucs-backward-char (_candidate) - (with-helm-current-buffer - (forward-char -1))) - -(defun helm-ucs-delete-backward (_candidate) - (with-helm-current-buffer - (delete-char -1))) - -(defun helm-ucs-insert (candidate n) - (with-helm-current-buffer - (string-match "^\\([^:]+\\): +\\(.\\) #x\\([a-f0-9]+\\)$" candidate) - (insert (match-string n candidate)))) - -(defun helm-ucs-insert-name (candidate) - (helm-ucs-insert candidate 1)) - -(defun helm-ucs-insert-char (candidate) - (helm-ucs-insert candidate 2)) - -(defun helm-ucs-insert-code (candidate) - (helm-ucs-insert candidate 3)) - -(defun helm-ucs-persistent-insert () - (interactive) - (with-helm-alive-p - (helm-attrset 'action-insert 'helm-ucs-insert-char) - (helm-execute-persistent-action 'action-insert))) - -(defun helm-ucs-persistent-forward () - (interactive) - (with-helm-alive-p - (helm-attrset 'action-forward 'helm-ucs-forward-char) - (helm-execute-persistent-action 'action-forward))) - -(defun helm-ucs-persistent-backward () - (interactive) - (with-helm-alive-p - (helm-attrset 'action-back 'helm-ucs-backward-char) - (helm-execute-persistent-action 'action-back))) - -(defun helm-ucs-persistent-delete () - (interactive) - (with-helm-alive-p - (helm-attrset 'action-delete 'helm-ucs-delete-backward) - (helm-execute-persistent-action 'action-delete))) - -(defvar helm-source-ucs - '((name . "Ucs names") - (init . helm-ucs-init) - (candidate-number-limit . 9999) - (candidates-in-buffer) - (mode-line . helm-ucs-mode-line-string) - (action . (("Insert character" . helm-ucs-insert-char) - ("Insert character name" . helm-ucs-insert-name) - ("Insert character code in hex" . helm-ucs-insert-code) - ("Forward char" . helm-ucs-forward-char) - ("Backward char" . helm-ucs-backward-char) - ("Delete char backward" . helm-ucs-delete-backward)))) - "Source for collecting `ucs-names' math symbols.") - -;;;###autoload -(defun helm-select-xfont () - "Preconfigured `helm' to select Xfont." - (interactive) - (helm-other-buffer 'helm-source-xfonts "*helm select* xfont")) - -;;;###autoload -(defun helm-ucs () - "Preconfigured helm for `ucs-names' math symbols." - (interactive) - (helm :sources 'helm-source-ucs - :keymap helm-ucs-map)) - -(provide 'helm-font) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-font.el ends here diff --git a/elpa/helm-20150403.101/helm-grep.el b/elpa/helm-20150403.101/helm-grep.el deleted file mode 100644 index 004ea1fb..00000000 --- a/elpa/helm-20150403.101/helm-grep.el +++ /dev/null @@ -1,1226 +0,0 @@ -;;; helm-grep.el --- Helm Incremental Grep. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: -(require 'cl-lib) -(require 'helm) -(require 'grep) -(require 'helm-regexp) - -;;; load wgrep proxy if it's available -(require 'wgrep-helm nil t) - -(declare-function helm-buffer-list "helm-buffers") -(declare-function helm-elscreen-find-file "helm-elscreen" (file)) -(declare-function View-quit "view") -(declare-function doc-view-goto-page "doc-view" (page)) - - -(defgroup helm-grep nil - "Grep related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-grep-default-command - "grep --color=never -a -d skip %e -n%cH -e %p %f" - "Default grep format command for `helm-do-grep-1'. -Where: -'%e' format spec is for --exclude or --include grep options or - ack-grep --type option. (Not mandatory) - -'%c' format spec is for case-fold-search, - whether to use the -i option of grep. (Not mandatory) - When you specify this spec, helm grep will use smartcase - that is when a upcase character is found in pattern case will - be respected and no '-i' option will be used, otherwise, when - no upcase character is found in pattern always use '-i'. - If you don't want this behavior, don't use this spec and - specify or not the '-i' option. - Note that with ack-grep this is not needed, just specify - the '--smart-case' option. - -'%p' format spec is for pattern. (Mandatory) - -'%f' format spec is for filenames. (Mandatory) - -If your grep version doesn't support the --exclude/include args -don't specify the '%e' format spec. - -Helm also support ack-grep and git-grep , -here a default command example for ack-grep: - -\(setq helm-grep-default-command \"ack-grep -Hn --no-group --no-color %e %p %f\" - helm-grep-default-recurse-command \"ack-grep -H --no-group --no-color %e %p %f\") - -You can ommit the %e spec if you don't want to be prompted for types. - -NOTE: Helm for ack-grep support ANSI sequences, so you can remove -the \"--no-color\" option safely (recommended). - -To enable ANSI in grep it is a little more difficult: - 1) Modify env var - \(setenv \"GREP_COLORS\" \"ms=01;31:mc=01;31:sl=01;37:cx=:fn=35:ln=32:bn=32:se=36\") - 2) Add the option \"--color=always\". - -To enable ANSI color in git-grep just add \"--color=always\". -To customize the ANSI color in git-grep, GREP_COLORS have no effect, -you will have to setup this in your .gitconfig: - - [color \"grep\"] - match = black yellow - -where \"black\" is the foreground and \"yellow\" the background. -See the git documentation for more infos. - -`helm-grep-default-command' and `helm-grep-default-recurse-command'are -independents, so you can enable `helm-grep-default-command' with ack-grep -and `helm-grep-default-recurse-command' with grep if you want to be faster -on recursive grep. - -NOTE: Remote grepping is not available with ack-grep, - and badly supported with grep because tramp handle badly - repeated remote processes in a short delay (< to 5s)." - :group 'helm-grep - :type 'string) - -(defcustom helm-grep-default-recurse-command - "grep --color=never -a -d recurse %e -n%cH -e %p %f" - "Default recursive grep format command for `helm-do-grep-1'. -See `helm-grep-default-command' for format specs and infos about ack-grep." - :group 'helm-grep - :type 'string) - -(defcustom helm-default-zgrep-command - "zgrep -a -n%cH -e %p %f" - "Default command for Zgrep. -See `helm-grep-default-command' for infos on format specs. -Option --color=always is supported and can be used safely -to replace the helm internal match highlighting, -see `helm-grep-default-command' for more infos." - :group 'helm-grep - :type 'string) - -(defcustom helm-pdfgrep-default-command - "pdfgrep --color never -niH %s %s" - "Default command for pdfgrep. -Option --color always is not supported, expect -errors when executing actions." - :group 'helm-grep - :type 'string) - -(defcustom helm-grep-use-ioccur-style-keys t - "Use Arrow keys to jump to occurences." - :group 'helm-grep - :type 'boolean) - -(defcustom helm-pdfgrep-default-read-command nil - "Default command to read pdf files from pdfgrep. -Where '%f' format spec is filename and '%p' is page number. -e.g In Ubuntu you can set it to: - - \"evince --page-label=%p '%f'\" - -If set to nil `doc-view-mode' will be used instead of an external command." - :group 'helm-grep - :type 'string) - -(defcustom helm-grep-max-length-history 100 - "Max number of elements to save in `helm-grep-history'." - :group 'helm-grep - :type 'integer) - -(defcustom helm-zgrep-file-extension-regexp - ".*\\(\\.gz\\|\\.bz\\|\\.xz\\|\\.lzma\\)$" - "Default file extensions zgrep will search in." - :group 'helm-grep - :type 'string) - -(defcustom helm-do-grep-preselect-candidate nil - "When non--nil the file name of current buffer will be selected." - :group 'helm-grep - :type 'boolean) - -(defcustom helm-grep-preferred-ext nil - "This file extension will be preselected for grep." - :group 'helm-grep - :type 'string) - - -;;; Faces -;; -;; -(defgroup helm-grep-faces nil - "Customize the appearance of helm-grep." - :prefix "helm-" - :group 'helm-grep - :group 'helm-faces) - -(defface helm-grep-match - '((((background light)) :foreground "#b00000") - (((background dark)) :foreground "gold1")) - "Face used to highlight grep matches." - :group 'helm-grep-faces) - -(defface helm-grep-file - '((t (:foreground "BlueViolet" - :underline t))) - "Face used to highlight grep results filenames." - :group 'helm-grep-faces) - -(defface helm-grep-lineno - '((t (:foreground "Darkorange1"))) - "Face used to highlight grep number lines." - :group 'helm-grep-faces) - -(defface helm-grep-running - '((t (:foreground "Red"))) - "Face used in mode line when grep is running." - :group 'helm-grep-faces) - -(defface helm-grep-finish - '((t (:foreground "Green"))) - "Face used in mode line when grep is finish." - :group 'helm-grep-faces) - -(defface helm-grep-cmd-line - '((t (:inherit diff-added))) - "Face used to highlight grep command line when no results." - :group 'helm-grep-faces) - - -;;; Keymaps -;; -;; -(defvar helm-grep-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-") 'helm-goto-next-file) - (define-key map (kbd "M-") 'helm-goto-precedent-file) - (define-key map (kbd "C-c o") 'helm-grep-run-other-window-action) - (define-key map (kbd "C-c C-o") 'helm-grep-run-other-frame-action) - (define-key map (kbd "C-w") 'helm-yank-text-at-point) - (define-key map (kbd "C-x C-s") 'helm-grep-run-save-buffer) - (when helm-grep-use-ioccur-style-keys - (define-key map (kbd "") 'helm-execute-persistent-action) - (define-key map (kbd "") 'helm-grep-run-default-action)) - (define-key map (kbd "C-c ?") 'helm-grep-help) - (delq nil map)) - "Keymap used in Grep sources.") - -(defvar helm-pdfgrep-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-") 'helm-goto-next-file) - (define-key map (kbd "M-") 'helm-goto-precedent-file) - (define-key map (kbd "C-w") 'helm-yank-text-at-point) - (define-key map (kbd "C-c ?") 'helm-pdfgrep-help) - map) - "Keymap used in pdfgrep.") - -(defvar helm-grep-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") 'helm-grep-mode-jump) - (define-key map (kbd "C-o") 'helm-grep-mode-jump-other-window) - (define-key map (kbd "") 'helm-grep-mode-jump-other-window-forward) - (define-key map (kbd "") 'helm-grep-mode-jump-other-window-backward) - (define-key map (kbd "") 'helm-gm-next-file) - (define-key map (kbd "") 'helm-gm-precedent-file) - map)) - - -;;; Internals vars -;; -;; -(defvar helm-rzgrep-cache (make-hash-table :test 'equal)) -(defvar helm-grep-default-function 'helm-grep-init) -(defvar helm-zgrep-recurse-flag nil) -(defvar helm-grep-history nil) -(defvar helm-grep-last-targets nil) -(defvar helm-grep-include-files nil) -(defvar helm-grep-in-recurse nil) -(defvar helm-grep-use-zgrep nil) -(defvar helm-grep-default-directory-fn nil - "A function that should return a directory to expand candidate to. -It is intended to use as a let-bound variable, DON'T set this globaly.") -(defvar helm-pdfgrep-targets nil) -(defvar helm-grep-last-cmd-line nil) -(defvar helm-grep-split-line-regexp "^\\([[:lower:][:upper:]]?:?.*?\\):\\([0-9]+\\):\\(.*\\)") - - -;;; Init -;; -;; -(defun helm-grep-prepare-candidates (candidates in-directory) - "Prepare filenames and directories CANDIDATES for grep command line." - ;; If one or more candidate is a directory, search in all files - ;; of this candidate (e.g /home/user/directory/*). - ;; If r option is enabled search also in subdidrectories. - ;; We need here to expand wildcards to support crap windows filenames - ;; as grep doesn't accept quoted wildcards (e.g "dir/*.el"). - (if helm-zgrep-recurse-flag - (mapconcat 'shell-quote-argument candidates " ") - ;; When candidate is a directory, search in all its files. - ;; NOTE that `file-expand-wildcards' will return also - ;; directories, they will be ignored by grep but not - ;; by ack-grep that will grep all files of this directory - ;; without recursing in their subdirs though, see that as a one - ;; level recursion with ack-grep. - ;; So I leave it as it is, considering it is a feature. [1] - (cl-loop for i in candidates append - (cond ((string-match "^git" helm-grep-default-command) - (list i)) - ;; Candidate is a directory and we use recursion or ack. - ((and (file-directory-p i) - (or helm-grep-in-recurse - ;; ack-grep accept directory [1]. - (helm-grep-use-ack-p))) - (list (expand-file-name i))) - ;; Grep doesn't support directory only when not in recurse. - ((file-directory-p i) - (file-expand-wildcards - (concat (file-name-as-directory (expand-file-name i)) "*") t)) - ;; Candidate is a file or wildcard and we use recursion, use the - ;; current directory instead of candidate. - ((and (or (file-exists-p i) (string-match "[*]" i)) - helm-grep-in-recurse) - (list (expand-file-name - (directory-file-name ; Needed for windoze. - (file-name-directory (directory-file-name i)))))) - ;; Else should be one or more file/directory - ;; possibly marked. - ;; When real is a normal filename without wildcard - ;; file-expand-wildcards returns a list of one file. - ;; wildcards should have been already handled by - ;; helm-read-file-name or helm-find-files but do it from - ;; here too in case we are called from elsewhere. - (t (file-expand-wildcards i t))) into all-files ; [1] - finally return - (let ((files (if (file-remote-p in-directory) - ;; Grep don't understand tramp filenames - ;; use the local name. - (mapcar #'(lambda (x) - (file-remote-p x 'localname)) - all-files) - all-files))) - (if (string-match "^git" helm-grep-default-command) - (mapconcat 'identity files " ") - (mapconcat 'shell-quote-argument files " ")))))) - -(defun helm-grep-command (&optional recursive) - (let* ((com (if recursive - helm-grep-default-recurse-command - helm-grep-default-command)) - (exe (and com (car (split-string com " "))))) - (if (and exe (string= exe "git")) "git-grep" exe))) - -(cl-defun helm-grep-use-ack-p (&key where) - (let* ((rec-com (helm-grep-command t)) - (norm-com (helm-grep-command)) - (norm-com-ack-p (string-match "\\`ack" norm-com)) - (rec-com-ack-p (and rec-com (string-match "\\`ack" rec-com)))) - (cl-case where - (default (and norm-com norm-com-ack-p)) - (recursive (and rec-com rec-com-ack-p)) - (strict (and norm-com rec-com rec-com-ack-p norm-com-ack-p)) - (t (and (not (and norm-com (string= norm-com "git-grep"))) - (or (and norm-com norm-com-ack-p) - (and rec-com rec-com-ack-p))))))) - -(defun helm-grep--prepare-cmd-line (only-files &optional include zgrep) - (let* ((default-directory (or helm-default-directory - (expand-file-name helm-ff-default-directory))) - (fnargs (helm-grep-prepare-candidates only-files default-directory)) - (ignored-files (unless (helm-grep-use-ack-p) - (mapconcat - #'(lambda (x) - (concat "--exclude=" - (shell-quote-argument x))) - grep-find-ignored-files " "))) - (ignored-dirs (unless (helm-grep-use-ack-p) - (mapconcat - ;; Need grep version >=2.5.4 - ;; of Gnuwin32 on windoze. - #'(lambda (x) - (concat "--exclude-dir=" - (shell-quote-argument x))) - grep-find-ignored-directories " "))) - (exclude (unless (helm-grep-use-ack-p) - (if helm-grep-in-recurse - (concat (or include ignored-files) - " " ignored-dirs) - ignored-files))) - (types (and (helm-grep-use-ack-p) - ;; When %e format spec is not specified - ;; in `helm-grep-default-command' - ;; we need to pass an empty string - ;; to types to avoid error. - (or include ""))) - (smartcase (if (helm-grep-use-ack-p) "" - (unless (let ((case-fold-search nil)) - (string-match-p - "[[:upper:]]" helm-pattern)) "i")))) - (format-spec - helm-grep-default-command - (delq nil - (list (unless zgrep - (if types - (cons ?e types) - (cons ?e exclude))) - (cons ?c (or smartcase "")) - (cons ?p (shell-quote-argument helm-pattern)) - (cons ?f fnargs)))))) - -(defun helm-grep-init (cmd-line) - "Start an asynchronous grep process with CMD-LINE using ZGREP if non--nil." - (let* ((default-directory (or (expand-file-name helm-ff-default-directory) - helm-default-directory)) - (zgrep (string-match "\\`zgrep" cmd-line)) - ;; Use pipe only with grep, zgrep or git-grep. - (process-connection-type (and (not zgrep) (helm-grep-use-ack-p))) - (tramp-verbose helm-tramp-verbose) - non-essential) - ;; Start grep process. - (helm-log "Starting Grep process in directory `%s'" default-directory) - (helm-log "Command line used was:\n\n%s" - (concat ">>> " (propertize cmd-line 'face 'helm-grep-cmd-line) "\n\n")) - (prog1 ; This function should return the process first. - (start-file-process-shell-command - "grep" helm-buffer cmd-line) - ;; Init sentinel. - (set-process-sentinel - (get-buffer-process helm-buffer) - #'(lambda (process event) - (let ((noresult (= (process-exit-status process) 1))) - (unless noresult - (helm-process-deferred-sentinel-hook - process event helm-ff-default-directory)) - (cond ((and noresult - ;; [FIXME] This is a workaround for zgrep - ;; that exit with code 1 - ;; after a certain amount of results. - (not (with-helm-buffer helm-grep-use-zgrep))) - (with-current-buffer helm-buffer - (insert (concat "* Exit with code 1, no result found," - " Command line was:\n\n " - (propertize helm-grep-last-cmd-line - 'face 'helm-grep-cmd-line))) - (setq mode-line-format - '(" " mode-line-buffer-identification " " - (:eval (format "L%s" (helm-candidate-number-at-point))) " " - (:eval (propertize - (format - "[%s process finished - (no results)] " - (if helm-grep-use-zgrep - "Zgrep" - (capitalize - (if helm-grep-in-recurse - (helm-grep-command t) - (helm-grep-command))))) - 'face 'helm-grep-finish)))))) - ((string= event "finished\n") - (with-helm-window - (setq mode-line-format - '(" " mode-line-buffer-identification " " - (:eval (format "L%s" (helm-candidate-number-at-point))) " " - (:eval (propertize - (format - "[%s process finished - (%s results)] " - (if helm-grep-use-zgrep - "Zgrep" - (capitalize - (if helm-grep-in-recurse - (helm-grep-command t) - (helm-grep-command)))) - (max (1- (count-lines - (point-min) - (point-max))) - 0)) - 'face 'helm-grep-finish)))) - (force-mode-line-update))) - ;; Catch error output in log. - (t (helm-log - "Error: %s %s" - (if helm-grep-use-zgrep "Zgrep" "Grep") - (replace-regexp-in-string "\n" "" event)))))))))) - -(defun helm-grep-collect-candidates () - (let ((cmd-line (helm-grep--prepare-cmd-line - helm-grep-last-targets - helm-grep-include-files - helm-grep-use-zgrep))) - (set (make-local-variable 'helm-grep-last-cmd-line) cmd-line) - (funcall helm-grep-default-function cmd-line))) - - -;;; Actions -;; -;; -(defun helm-grep-action (candidate &optional where mark) - "Define a default action for `helm-do-grep' on CANDIDATE. -WHERE can be one of other-window, elscreen, other-frame." - (let* ((split (helm-grep-split-line candidate)) - (lineno (string-to-number (nth 1 split))) - (loc-fname (or (with-current-buffer - (if (eq major-mode 'helm-grep-mode) - (current-buffer) - helm-buffer) - (get-text-property (point-at-bol) 'help-echo)) - (car split))) - (tramp-method (file-remote-p (or helm-ff-default-directory - default-directory) 'method)) - (tramp-host (file-remote-p (or helm-ff-default-directory - default-directory) 'host)) - (tramp-prefix (concat "/" tramp-method ":" tramp-host ":")) - (fname (if tramp-host - (concat tramp-prefix loc-fname) loc-fname))) - (cl-case where - (other-window (find-file-other-window fname)) - (elscreen (helm-elscreen-find-file fname)) - (other-frame (find-file-other-frame fname)) - (grep (helm-grep-save-results-1)) - (pdf (if helm-pdfgrep-default-read-command - (helm-pdfgrep-action-1 split lineno (car split)) - (find-file (car split)) (doc-view-goto-page lineno))) - (t (find-file fname))) - (unless (or (eq where 'grep) (eq where 'pdf)) - (helm-goto-line lineno)) - (when mark - (set-marker (mark-marker) (point)) - (push-mark (point) 'nomsg)) - ;; Save history - (unless (or helm-in-persistent-action - (eq major-mode 'helm-grep-mode) - (string= helm-pattern "")) - (setq helm-grep-history - (cons helm-pattern - (delete helm-pattern helm-grep-history))) - (when (> (length helm-grep-history) - helm-grep-max-length-history) - (setq helm-grep-history - (delete (car (last helm-grep-history)) - helm-grep-history)))))) - -(defun helm-grep-persistent-action (candidate) - "Persistent action for `helm-do-grep'. -With a prefix arg record CANDIDATE in `mark-ring'." - (if current-prefix-arg - (helm-grep-action candidate nil 'mark) - (helm-grep-action candidate)) - (helm-highlight-current-line)) - -(defun helm-grep-other-window (candidate) - "Jump to result in other window from helm grep." - (helm-grep-action candidate 'other-window)) - -(defun helm-grep-other-frame (candidate) - "Jump to result in other frame from helm grep." - (helm-grep-action candidate 'other-frame)) - -(defun helm-grep-jump-elscreen (candidate) - "Jump to result in elscreen from helm grep." - (helm-grep-action candidate 'elscreen)) - -(defun helm-goto-next-or-prec-file (n &optional type) - "Go to next or precedent candidate file in helm grep/etags buffers. -If N is positive go forward otherwise go backward." - (let* ((allow-mode (or (eq major-mode 'helm-grep-mode) - (eq major-mode 'helm-moccur-mode))) - (sel (if allow-mode - (buffer-substring (point-at-bol) (point-at-eol)) - (helm-get-selection nil t))) - (current-line-list (if (eq type 'etags) - (split-string sel ": +" t) - (helm-grep-split-line sel))) - (current-fname (nth 0 current-line-list)) - (bob-or-eof (if (eq n 1) 'eobp 'bobp)) - (mark-maybe #'(lambda () - (if allow-mode - (ignore) - (helm-mark-current-line))))) - (catch 'break - (while (not (funcall bob-or-eof)) - (forward-line n) ; Go forward or backward depending of n value. - ;; Exit when current-fname is not matched or in `helm-grep-mode' - ;; the line is not a grep line i.e 'fname:num:tag'. - (setq sel (buffer-substring (point-at-bol) (point-at-eol))) - (unless (or (string= current-fname - (car (if (eq type 'etags) - (split-string sel ": +" t) - (helm-grep-split-line sel)))) - (and (eq major-mode 'helm-grep-mode) - (not (get-text-property (point-at-bol) 'help-echo)))) - (funcall mark-maybe) - (throw 'break nil)))) - (cond ((and (> n 0) (eobp)) - (re-search-backward ".") - (forward-line 0) - (funcall mark-maybe)) - ((and (< n 0) (bobp)) - (helm-aif (next-single-property-change (point-at-bol) 'help-echo) - (goto-char it) - (forward-line 1)) - (funcall mark-maybe))))) - -;;;###autoload -(defun helm-goto-precedent-file () - "Go to precedent file in helm grep/etags buffers." - (interactive) - (let ((etagp (when (string= (assoc-default - 'name (helm-get-current-source)) "Etags") - 'etags))) - (with-helm-window - (helm-goto-next-or-prec-file -1 etagp)))) - -;;;###autoload -(defun helm-goto-next-file () - "Go to precedent file in helm grep/etags buffers." - (interactive) - (let ((etagp (when (string= (assoc-default - 'name (helm-get-current-source)) "Etags") - 'etags))) - (with-helm-window - (helm-goto-next-or-prec-file 1 etagp)))) - -(defun helm-grep-run-default-action () - "Run grep default action from `helm-do-grep-1'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-grep-action))) - -(defun helm-grep-run-other-window-action () - "Run grep goto other window action from `helm-do-grep-1'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-grep-other-window))) - -(defun helm-grep-run-other-frame-action () - "Run grep goto other frame action from `helm-do-grep-1'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-grep-other-frame))) - -;;;###autoload -(defun helm-grep-run-save-buffer () - "Run grep save results action from `helm-do-grep-1'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-grep-save-results))) - - -;;; helm-grep-mode -;; -;; -(defun helm-grep-save-results (candidate) - (helm-grep-action candidate 'grep)) - -(defun helm-grep-save-results-1 () - "Save helm grep result in a `helm-grep-mode' buffer." - (let ((buf "*hgrep*") - new-buf) - (when (get-buffer buf) - (setq new-buf (helm-read-string "GrepBufferName: " buf)) - (cl-loop for b in (helm-buffer-list) - when (and (string= new-buf b) - (not (y-or-n-p - (format "Buffer `%s' already exists overwrite? " - new-buf)))) - do (setq new-buf (helm-read-string "GrepBufferName: " "*hgrep "))) - (setq buf new-buf)) - (with-current-buffer (get-buffer-create buf) - (setq buffer-read-only t) - (let ((inhibit-read-only t)) - (erase-buffer) - (insert "-*- mode: helm-grep -*-\n\n" - (format "Grep Results for `%s':\n\n" helm-pattern)) - (save-excursion - (insert (with-current-buffer helm-buffer - (goto-char (point-min)) (forward-line 1) - (buffer-substring (point) (point-max)))))) - (helm-grep-mode) (pop-to-buffer buf)) - (message "Helm Grep Results saved in `%s' buffer" buf))) - -;;;###autoload -(define-derived-mode helm-grep-mode - special-mode "helm-grep" - "Major mode to provide actions in helm grep saved buffer. - -Special commands: -\\{helm-grep-mode-map}" - (set (make-local-variable 'helm-grep-last-cmd-line) - (with-helm-buffer helm-grep-last-cmd-line)) - (set (make-local-variable 'revert-buffer-function) - #'helm-grep-mode--revert-buffer-function)) - -(defun helm-grep-mode--revert-buffer-function (&optional _ignore-auto _noconfirm) - (goto-char (point-min)) - (re-search-forward "^Grep Results for" nil t) - (forward-line 0) - (when (re-search-forward "^$" nil t) - (forward-line 1)) - (let ((inhibit-read-only t)) - (delete-region (point) (point-max))) - (message "Reverting buffer...") - (set-process-sentinel - (start-file-process-shell-command - "hgrep" (generate-new-buffer "*hgrep revert*") helm-grep-last-cmd-line) - (lambda (process event) - (when (string= event "finished\n") - (with-current-buffer (current-buffer) - (let ((inhibit-read-only t)) - (save-excursion - (cl-loop for line in (with-current-buffer (process-buffer process) - (prog1 (split-string (buffer-string) "\n") - (kill-buffer))) - when (string-match helm-grep-split-line-regexp line) - do (insert (propertize - (car (helm-grep-filter-one-by-one line)) - ;; needed for wgrep. - 'helm-realvalue line) - "\n")))) - (message "Reverting buffer done")))))) - -;;;###autoload -(defun helm-gm-next-file () - (interactive) - (helm-goto-next-or-prec-file 1)) - -;;;###autoload -(defun helm-gm-precedent-file () - (interactive) - (helm-goto-next-or-prec-file -1)) - -;;;###autoload -(defun helm-grep-mode-jump () - (interactive) - (let ((candidate (buffer-substring (point-at-bol) (point-at-eol)))) - (condition-case nil - (progn (helm-grep-action candidate) (delete-other-windows)) - (error nil)))) - -(defun helm-grep-mode-jump-other-window-1 (arg) - (let ((candidate (buffer-substring (point-at-bol) (point-at-eol)))) - (condition-case nil - (progn - (save-selected-window - (helm-grep-action candidate 'other-window) - (recenter)) - (forward-line arg)) - (error nil)))) - -;;;###autoload -(defun helm-grep-mode-jump-other-window-forward () - (interactive) - (helm-grep-mode-jump-other-window-1 1)) - -;;;###autoload -(defun helm-grep-mode-jump-other-window-backward () - (interactive) - (helm-grep-mode-jump-other-window-1 -1)) - -;;;###autoload -(defun helm-grep-mode-jump-other-window () - (interactive) - (let ((candidate (buffer-substring (point-at-bol) (point-at-eol)))) - (condition-case nil - (helm-grep-action candidate 'other-window) - (error nil)))) - - -;;; ack-grep types -;; -;; -(defun helm-grep-hack-types () - "Return a list of known ack-grep types." - (with-temp-buffer - ;; "--help-types" works with both 1.96 and 2.1+, while - ;; "--help types" works only with 1.96 Issue #422. - ;; `helm-grep-command' should return the ack executable - ;; when this function is used in the right context - ;; i.e After checking is we are using ack-grep with - ;; `helm-grep-use-ack-p'. - (call-process (helm-grep-command t) nil t nil "--help-types") - (goto-char (point-min)) - (cl-loop while (re-search-forward - "^ *--\\(\\[no\\]\\)\\([^. ]+\\) *\\(.*\\)" nil t) - collect (cons (concat (match-string 2) - " [" (match-string 3) "]") - (match-string 2)) - collect (cons (concat "no" (match-string 2) - " [" (match-string 3) "]") - (concat "no" (match-string 2)))))) - -(defun helm-grep-ack-types-transformer (candidates _source) - (cl-loop for i in candidates - if (stringp i) - collect (rassoc i helm-grep-ack-types-cache) - else - collect i)) - -(defvar helm-grep-ack-types-cache nil) -(defun helm-grep-read-ack-type () - "Select types for the '--type' argument of ack-grep." - (require 'helm-mode) - (require 'helm-adaptive) - (setq helm-grep-ack-types-cache (helm-grep-hack-types)) - (let ((types (helm-comp-read - "Types: " helm-grep-ack-types-cache - :name "*Ack-grep types*" - :marked-candidates t - :must-match t - :fc-transformer '(helm-adaptive-sort - helm-grep-ack-types-transformer) - :buffer "*helm ack-types*"))) - (mapconcat #'(lambda (type) (concat "--type=" type)) types " "))) - - -;;; grep extensions -;; -;; -(defun helm-grep-guess-extensions (files) - "Try to guess file extensions in FILES list when using grep recurse. -These extensions will be added to command line with --include arg of grep." - (cl-loop with ext-list = (list helm-grep-preferred-ext "*") - with lst = (if (file-directory-p (car files)) - (directory-files - (car files) nil - directory-files-no-dot-files-regexp) - files) - for i in lst - for ext = (file-name-extension i 'dot) - for glob = (and ext (not (string= ext "")) - (concat "*" ext)) - unless (or (not glob) - (and glob-list (member glob glob-list)) - (and glob-list (member glob ext-list)) - (and glob-list (member glob grep-find-ignored-files))) - collect glob into glob-list - finally return (delq nil (append ext-list glob-list)))) - -(defun helm-grep-get-file-extensions (files) - "Try to return a list of file extensions to pass to '--include' arg of grep." - (let* ((all-exts (helm-grep-guess-extensions - (mapcar 'expand-file-name files))) - (extensions (helm-comp-read "Search Only in: " all-exts - :marked-candidates t - :fc-transformer 'helm-adaptive-sort - :buffer "*helm grep exts*" - :name "*helm grep extensions*"))) - (when (listp extensions) ; Otherwise it is empty string returned by C-RET. - ;; If extensions is a list of one string containing spaces, - ;; assume user entered more than one glob separated by space(s) and - ;; split this string to pass it later to mapconcat. - ;; e.g '("*.el *.py") - (cl-loop for i in extensions - append (split-string-and-unquote i " "))))) - - -;;; Set up source -;; -;; -(defvar helm-source-grep nil) -(defun helm-do-grep-1 (targets &optional recurse zgrep exts) - "Launch grep on a list of TARGETS files. -When RECURSE is given use -r option of grep and prompt user -to set the --include args of grep. -You can give more than one arg separated by space. -e.g *.el *.py *.tex. -If you are using ack-grep, you will be prompted for --type -instead. -If prompt is empty '--exclude `grep-find-ignored-files' is used instead. -ZGREP when non--nil use zgrep instead, without prompting for a choice -in recurse, search being made on `helm-zgrep-file-extension-regexp'." - (when (and (helm-grep-use-ack-p) - helm-ff-default-directory - (file-remote-p helm-ff-default-directory)) - (error "Error: Remote operation not supported with ack-grep.")) - (let* (non-essential - (exts (and recurse - ;; [FIXME] I could handle this from helm-walk-directory. - (not zgrep) ; zgrep doesn't handle -r opt. - (not (helm-grep-use-ack-p :where 'recursive)) - (or exts (helm-grep-get-file-extensions targets)))) - (include-files (and exts - (mapconcat #'(lambda (x) - (concat "--include=" - (shell-quote-argument x))) - (if (> (length exts) 1) - (remove "*" exts) - exts) " "))) - (types (and (not include-files) - (not zgrep) - recurse - (helm-grep-use-ack-p :where 'recursive) - ;; When %e format spec is not specified - ;; ignore types and do not prompt for choice. - (string-match "%e" helm-grep-default-command) - (helm-grep-read-ack-type))) - (follow (and helm-follow-mode-persistent - (assoc-default 'follow helm-source-grep)))) - ;; When called as action from an other source e.g *-find-files - ;; we have to kill action buffer. - (when (get-buffer helm-action-buffer) - (kill-buffer helm-action-buffer)) - ;; If `helm-find-files' haven't already started, - ;; give a default value to `helm-ff-default-directory'. - (unless helm-ff-default-directory - (setq helm-ff-default-directory default-directory)) - ;; We need to store these vars locally - ;; to pass infos later to `helm-resume'. - (helm-set-local-variable 'helm-zgrep-recurse-flag (and recurse zgrep) - 'helm-grep-last-targets targets - 'helm-grep-include-files (or include-files types) - 'helm-grep-in-recurse recurse - 'helm-grep-use-zgrep zgrep - 'helm-grep-default-command - (cond (zgrep helm-default-zgrep-command) - (recurse helm-grep-default-recurse-command) - ;; When resuming the local value of - ;; `helm-grep-default-command' is used, only git-grep - ;; should need this. - (t helm-grep-default-command))) - ;; Setup the source. - (setq helm-source-grep - (helm-build-async-source - (if zgrep "Zgrep" (capitalize (if recurse - (helm-grep-command t) - (helm-grep-command)))) - :header-name (lambda (name) - (concat name "(C-c ? Help)")) - :candidates-process 'helm-grep-collect-candidates - :filter-one-by-one 'helm-grep-filter-one-by-one - :nohighlight t - :candidate-number-limit 9999 - :mode-line helm-grep-mode-line-string - :history 'helm-grep-history - :action (helm-make-actions - "Find File" 'helm-grep-action - "Find file other frame" 'helm-grep-other-frame - (lambda () (and (locate-library "elscreen") - "Find file in Elscreen")) - 'helm-grep-jump-elscreen - "Save results in grep buffer" 'helm-grep-save-results - "Find file other window" 'helm-grep-other-window) - :persistent-action 'helm-grep-persistent-action - :persistent-help "Jump to line (`C-u' Record in mark ring)" - :requires-pattern 2 - :follow follow)) - (helm - :sources 'helm-source-grep - :buffer (format "*helm %s*" (if zgrep "zgrep" (helm-grep-command recurse))) - :default-directory helm-ff-default-directory - :keymap helm-grep-map - :history 'helm-grep-history - :truncate-lines t))) - - - -;;; zgrep -;; -;; -(defun helm-ff-zgrep-1 (flist recursive) - (unwind-protect - (let* ((def-dir (or helm-ff-default-directory - default-directory)) - (only (if recursive - (or (gethash def-dir helm-rzgrep-cache) - (puthash - def-dir - (helm-walk-directory - def-dir - :directories nil - :path 'full - :match helm-zgrep-file-extension-regexp) - helm-rzgrep-cache)) - flist))) - (helm-do-grep-1 only recursive 'zgrep)) - (setq helm-zgrep-recurse-flag nil))) - - -;;; transformers -;; -;; -(defun helm-grep-split-line (line) - "Split a grep output line." - ;; The output of grep may send a truncated line in this chunk, - ;; so don't split until grep line is valid, that is - ;; once the second part of the line comes with next chunk - ;; send by process. - (when (string-match helm-grep-split-line-regexp line) - ;; Don't use split-string because buffer/file name or string - ;; may contain a ":". - (cl-loop for n from 1 to 3 collect (match-string n line)))) - -(defun helm-grep--filter-candidate-1 (candidate &optional dir) - (let* ((root (or dir (and helm-grep-default-directory-fn - (funcall helm-grep-default-directory-fn)))) - ansi-color-context ; seems this avoid non--translated fname entries. - (ansi-p (string-match-p ansi-color-regexp candidate)) - (line (if ansi-p (ansi-color-apply candidate) candidate)) - (split (helm-grep-split-line line)) - (fname (if (and root split) - (expand-file-name (car split) root) - (car-safe split))) - (lineno (nth 1 split)) - (str (nth 2 split))) - (when (and fname lineno str) - (cons (concat (propertize (file-name-nondirectory fname) - 'face 'helm-grep-file - 'help-echo fname) - ":" - (propertize lineno 'face 'helm-grep-lineno) - ":" - (if ansi-p str (helm-grep-highlight-match str))) - line)))) - -(defun helm-grep-filter-one-by-one (candidate) - "`filter-one-by-one' transformer function for `helm-do-grep'." - (let ((helm-grep-default-directory-fn - (or helm-grep-default-directory-fn - (lambda () (or helm-ff-default-directory - helm-default-directory - default-directory))))) - (helm-grep--filter-candidate-1 candidate))) - -(defun helm-grep-highlight-match (str &optional multi-match) - "Highlight in string STR all occurences matching `helm-pattern'." - (require 'helm-match-plugin) - (let (beg end) - (condition-case nil - (with-temp-buffer - (insert str) - (goto-char (point-min)) - (cl-loop for reg in (if multi-match - (cl-loop for r in (helm-mp-split-pattern - helm-pattern) - unless (string-match "\\`!" r) - collect r) - (list helm-pattern)) - do - (while (and (re-search-forward reg nil t) - (> (- (setq end (match-end 0)) - (setq beg (match-beginning 0))) 0)) - (add-text-properties beg end '(face helm-grep-match))) - do (goto-char (point-min))) - (buffer-string)) - (error nil)))) - - -;;; Grep from buffer list -;; -;; -(defun helm-grep-buffers-1 (candidate &optional zgrep) - "Run grep on all file--buffers or CANDIDATE if it is a file--buffer. -If one of selected buffers is not a file--buffer, -it is ignored and grep will run on all others file--buffers. -If only one candidate is selected and it is not a file--buffer, -switch to this buffer and run `helm-occur'. -If a prefix arg is given run grep on all buffers ignoring non--file-buffers." - (let* ((prefarg (or current-prefix-arg helm-current-prefix-arg)) - (helm-ff-default-directory - (if (and helm-ff-default-directory - (file-remote-p helm-ff-default-directory)) - default-directory - helm-ff-default-directory)) - (cands (if prefarg - (buffer-list) - (helm-marked-candidates))) - (win-conf (current-window-configuration)) - ;; Non--fname and remote buffers are ignored. - (bufs (cl-loop for buf in cands - for fname = (buffer-file-name (get-buffer buf)) - when (and fname (not (file-remote-p fname))) - collect (expand-file-name fname)))) - (if bufs - (if zgrep - (helm-do-grep-1 bufs nil 'zgrep) - (helm-do-grep-1 bufs)) - ;; bufs is empty, thats mean we have only CANDIDATE - ;; and it is not a buffer-filename, fallback to occur. - (switch-to-buffer candidate) - (when (get-buffer helm-action-buffer) - (kill-buffer helm-action-buffer)) - (helm-occur) - (when (eq helm-exit-status 1) - (set-window-configuration win-conf))))) - -(defun helm-grep-buffers (candidate) - "Action to grep buffers." - (helm-grep-buffers-1 candidate)) - -(defun helm-zgrep-buffers (candidate) - "Action to zgrep buffers." - (helm-grep-buffers-1 candidate 'zgrep)) - - -;;; Helm interface for pdfgrep -;; pdfgrep program -;; and a pdf-reader (e.g xpdf) are needed. -;; -(defvar helm-pdfgrep-default-function 'helm-pdfgrep-init) -(defun helm-pdfgrep-init (only-files) - "Start an asynchronous pdfgrep process in ONLY-FILES list." - (let* ((default-directory (or helm-ff-default-directory - default-directory)) - (fnargs (helm-grep-prepare-candidates - (if (file-remote-p default-directory) - (mapcar #'(lambda (x) - (file-remote-p x 'localname)) - only-files) - only-files) - default-directory)) - (cmd-line (format helm-pdfgrep-default-command - helm-pattern - fnargs)) - process-connection-type) - ;; Start pdf grep process. - (helm-log "Starting Pdf Grep process in directory `%s'" default-directory) - (helm-log "Command line used was:\n\n%s" - (concat ">>> " (propertize cmd-line 'face 'helm-grep-cmd-line) "\n\n")) - (prog1 - (start-file-process-shell-command - "pdfgrep" helm-buffer cmd-line) - (message nil) - (set-process-sentinel - (get-buffer-process helm-buffer) - #'(lambda (_process event) - (if (string= event "finished\n") - (with-helm-window - (setq mode-line-format - '(" " mode-line-buffer-identification " " - (:eval (format "L%s" (helm-candidate-number-at-point))) " " - (:eval (propertize - (format "[Pdfgrep Process Finish - %s result(s)] " - (max (1- (count-lines - (point-min) (point-max))) 0)) - 'face 'helm-grep-finish)))) - (force-mode-line-update)) - (helm-log "Error: Pdf grep %s" - (replace-regexp-in-string "\n" "" event)))))))) - -(defun helm-do-pdfgrep-1 (only) - "Launch pdfgrep with a list of ONLY files." - (unless (executable-find "pdfgrep") - (error "Error: No such program `pdfgrep'.")) - (let* (helm-grep-in-recurse) ; recursion is never used in pdfgrep. - ;; When called as action from an other source e.g *-find-files - ;; we have to kill action buffer. - (when (get-buffer helm-action-buffer) - (kill-buffer helm-action-buffer)) - (setq helm-pdfgrep-targets only) - (helm - :sources (helm-build-async-source "PdfGrep" - :init (lambda () - ;; If `helm-find-files' haven't already started, - ;; give a default value to `helm-ff-default-directory'. - (setq helm-ff-default-directory (or helm-ff-default-directory - default-directory))) - :candidates-process (lambda () - (funcall helm-pdfgrep-default-function helm-pdfgrep-targets)) - :filter-one-by-one #'helm-grep-filter-one-by-one - :candidate-number-limit 9999 - :history 'helm-grep-history - :keymap helm-pdfgrep-map - :mode-line helm-pdfgrep-mode-line-string - :action #'helm-pdfgrep-action - :persistent-help "Jump to PDF Page" - :requires-pattern 2) - :buffer "*helm pdfgrep*" - :history 'helm-grep-history))) - -(defun helm-pdfgrep-action (candidate) - (helm-grep-action candidate 'pdf)) - -(defun helm-pdfgrep-action-1 (_split pageno fname) - (save-selected-window - (start-file-process-shell-command - "pdf-reader" nil - (format-spec helm-pdfgrep-default-read-command - (list (cons ?f fname) (cons ?p pageno)))))) - -;;;###autoload -(defun helm-do-grep () - "Preconfigured helm for grep. -Contrarily to Emacs `grep', no default directory is given, but -the full path of candidates in ONLY. -That allow to grep different files not only in `default-directory' but anywhere -by marking them (C-). If one or more directory is selected -grep will search in all files of these directories. -You can also use wildcard in the base name of candidate. -If a prefix arg is given use the -r option of grep (recurse). -The prefix arg can be passed before or after start file selection. -See also `helm-do-grep-1'." - (interactive) - (require 'helm-mode) - (let* ((preselection (or (dired-get-filename nil t) - (buffer-file-name (current-buffer)))) - (only (helm-read-file-name - "Search in file(s): " - :marked-candidates t - :preselect (and helm-do-grep-preselect-candidate - (if helm-ff-transformer-show-only-basename - (helm-basename preselection) - preselection)))) - (prefarg (or current-prefix-arg helm-current-prefix-arg))) - (helm-do-grep-1 only prefarg))) - -;;;###autoload -(defun helm-do-zgrep () - "Preconfigured helm for zgrep." - (interactive) - (require 'helm-mode) - (let* ((prefarg (or current-prefix-arg helm-current-prefix-arg)) - (preselection (or (dired-get-filename nil t) - (buffer-file-name (current-buffer)))) - (ls (helm-read-file-name - "Search in file(s): " - :marked-candidates t - :preselect (and helm-do-grep-preselect-candidate - (if helm-ff-transformer-show-only-basename - (helm-basename preselection) - preselection))))) - (helm-ff-zgrep-1 ls prefarg))) - -;;;###autoload -(defun helm-do-pdfgrep () - "Preconfigured helm for pdfgrep." - (interactive) - (require 'helm-mode) - (let* ((preselection (or (dired-get-filename nil t) - (buffer-file-name (current-buffer)))) - (only (helm-read-file-name - "Search in file(s): " - :marked-candidates t - :test #'(lambda (file) - (or (string= (file-name-extension file) "pdf") - (string= (file-name-extension file) "PDF") - (file-directory-p file))) - :preselect (and helm-do-grep-preselect-candidate - (if helm-ff-transformer-show-only-basename - (helm-basename preselection) - preselection)))) - (helm-grep-default-function 'helm-pdfgrep-init)) - (helm-do-pdfgrep-1 only))) - - -(provide 'helm-grep) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-grep.el ends here diff --git a/elpa/helm-20150403.101/helm-help.el b/elpa/helm-20150403.101/helm-help.el deleted file mode 100644 index 682b0fd5..00000000 --- a/elpa/helm-20150403.101/helm-help.el +++ /dev/null @@ -1,1711 +0,0 @@ -;;; helm-help.el --- Help messages for Helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: -(require 'helm) -(require 'helm-org) - - -(defgroup helm-help nil - "Embedded help for `helm'." - :group 'helm) - -(defface helm-helper - '((t :inherit helm-header)) - "Face for helm help string in minibuffer." - :group 'helm-help) - -(defcustom helm-documentation-file "~/.emacs.d/helm-doc.org" - "The file where you want to save helm documentation." - :group 'helm-help - :type 'string) - -(defvar helm-help--string-list '(helm-help-message - helm-buffer-help-message - helm-ff-help-message - helm-read-file-name-help-message - helm-generic-file-help-message - helm-grep-help-message - helm-pdfgrep-help-message - helm-etags-help-message - helm-ucs-help-message - helm-bookmark-help-message - helm-esh-help-message - helm-buffers-ido-virtual-help-message - helm-moccur-help-message - helm-top-help-message - helm-apt-help-message - helm-el-package-help-message - helm-M-x-help-message - helm-imenu-help-message - helm-colors-help-message - helm-semantic-help-message - helm-kmacro-help-message)) - - -;;;###autoload -(defun helm-documentation (arg) - "Helm documentation. -With a prefix arg refresh the documentation. - -Find here the documentation of all sources actually documented." - (interactive "P") - (when arg (delete-file helm-documentation-file) - (helm-aif (get-file-buffer helm-documentation-file) - (kill-buffer it))) - (unless (file-exists-p helm-documentation-file) - (with-temp-file helm-documentation-file - (erase-buffer) - (cl-loop for elm in helm-help--string-list - for str = (symbol-value elm) - do (if (functionp str) - (insert (funcall str)) - (insert str))))) - (let ((helm-org-headings--nofilename t)) - (helm :sources (helm-source-org-headings-for-files - (list helm-documentation-file)) - :candidate-number-limit 99999 - :buffer "*helm documentation*"))) - -;;; Global help message - Used by `helm-help' -;; -;; -(defvar helm-help-message - (lambda () - (concat - "\n* Helm generic help\n" - "\\" - "\n`helm' is an Emacs incremental completion and selection narrowing framework. - -Narrow the list by typing some pattern, -Multiple patterns are allowed by splitting by space. -Select with natural Emacs operations, choose with RET. - -** Help - -C-h m : Run this generic help for helm. -C-c ? : Run specific helm help for current source. - -** Basic Operations - -C-p, Up: Previous Line -C-n, Down : Next Line -M-v, PageUp : Previous Page -C-v, PageDown : Next Page -Enter : Execute first (default) action / Select -M-< : First Line -M-> : Last Line -M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window) -M-PageDown, C-M-v : Next Page (other-window) - -Tab, C-i : Show action list -Left : Previous Source -Right, C-o : Next Source -C-k : Delete pattern (with prefix arg delete from point to end) -C-j or C-z: Persistent Action (Execute action with helm session kept) - -** Shortcuts For nth Action - -f1-12: Execute nth 1 to 12 Action(s). - -** Visible Marks - -Visible marks store candidate. Some actions uses marked candidates. - -\\[helm-toggle-visible-mark] : Toggle Visible Mark -\\[helm-prev-visible-mark] : Previous Mark -\\[helm-next-visible-mark] : Next Mark - -** Miscellaneous Commands - -\\[helm-toggle-resplit-window] : Toggle vertical/horizontal split helm window. -\\[helm-quit-and-find-file] : Drop into `find-file'. -\\[helm-delete-current-selection] : Delete selected item (visually). -\\[helm-kill-selection-and-quit] : Kill display value of candidate and quit (with prefix arg kill the real value). -\\[helm-yank-selection] : Yank selection into pattern. -\\[helm-follow-mode] : Toggle automatical execution of persistent action. -\\[helm-follow-action-forward] : Run persistent action and goto next line. -\\[helm-follow-action-backward] : Run persistent action and goto previous line. -\\[helm-force-update] : Recalculate and redisplay candidates. - -** Global Commands - -\\\\[helm-resume] revives last `helm' session. -It is very useful, so you should bind any key.")) - "Detailed help message string for `helm'. -It also accepts function or variable symbol.") - -(defun helm-help-internal (bufname insert-content-fn) - "Show long message during `helm' session in BUFNAME. -INSERT-CONTENT-FN is the function that insert -text to be displayed in BUFNAME." - (let ((winconf (current-frame-configuration))) - (unwind-protect - (progn - (setq helm-suspend-update-flag t) - (set-buffer (get-buffer-create bufname)) - (switch-to-buffer bufname) - (delete-other-windows) - (delete-region (point-min) (point-max)) - (outline-mode) - (save-excursion - (funcall insert-content-fn)) - (setq cursor-type nil) - (buffer-disable-undo) - (helm-help-event-loop)) - (setq helm-suspend-update-flag nil) - (set-frame-configuration winconf)))) - -(defun helm-help-scroll-up (amount) - (condition-case _err - (scroll-up-command amount) - (beginning-of-buffer nil) - (end-of-buffer nil))) - -(defun helm-help-scroll-down (amount) - (condition-case _err - (scroll-down-command amount) - (beginning-of-buffer nil) - (end-of-buffer nil))) - -(defun helm-help-event-loop () - (let ((prompt (propertize - "[SPC,C-v,down,next:NextPage b,M-v,up,prior:PrevPage C-s/r:Isearch q:Quit]" - 'face 'helm-helper)) - scroll-error-top-bottom) - (cl-loop for event = (read-key prompt) do - (cl-case event - ((?\C-v ? down next) (helm-help-scroll-up helm-scroll-amount)) - ((?\M-v ?b up prior) (helm-help-scroll-down helm-scroll-amount)) - (?\C-s (isearch-forward)) - (?\C-r (isearch-backward)) - (?q (cl-return)) - (t (ignore)))))) - -;;;###autoload -(defun helm-help () - "Help of `helm'." - (interactive) - (with-helm-alive-p - (save-selected-window - (helm-help-internal - "*Helm Help*" - (lambda () - (insert (substitute-command-keys - (helm-interpret-value (or (assoc-default - 'help-message - (helm-get-current-source)) - helm-help-message))))))))) - -;;; `helm-buffer-list' help -;; -;; -(defvar helm-buffer-help-message - "\n* Helm Buffer\n - -** Helm buffers tips: - -*** Completion: - -**** Major-mode: - -You can enter a partial name of major-mode (e.g lisp, sh) to narrow down buffers. -To specify the major-mode, prefix it with \"*\" e.g \"*lisp\". -If you want to match all buffers but the ones with a specific major-mode (negation), -prefix the major-mode with \"!\" e.g \"*!lisp\". -If you want to specify more than one major-mode, separate them with \",\", -e.g \"*!lisp,!sh,!fun\" will list all buffers but the ones in lisp-mode, sh-mode and -fundamental-mode. - -Enter then a space and a pattern to narrow down to buffers matching this pattern. - -**** Search inside buffers: - -If you enter a space and a pattern prefixed by \"@\" helm will search for text matching -this pattern INSIDE the buffer (i.e not in the name of buffer). -NOTE that if you enter your pattern prefixed with \"@\" but escaped, helm will search a buffer -matching \"@pattern\" but will not search inside. - -**** Search by directory name: - -If you prefix the beginning of pattern with \"/\" the match will occur on directory name -of buffer, it is interesting to narrow down to one directory for example, subsequent string -entered after a space will match on buffer-name only. -Note that negation is not supported for matching on buffer-file-name. -You can specify more than one directory starting from helm v1.6.8 - -**** Fuzzy matching: - -Note that if `helm-buffers-fuzzy-matching' is non--nil you will have -fuzzy matching on buffer names (not on directory name matching and major-mode though). -A pattern starting with \"^\" will disable fuzzy matching and will match by exact regexp. - -**** Examples: - -if I enter in pattern prompt: -\"*lisp ^helm @moc\" -helm will narrow down the list by selecting only buffers that are in lisp mode, start by helm -and match \"moc\" in their contents. - -if I enter in pattern prompt: -\"*lisp ^helm moc\" -Notice there is no \"@\" this time -helm will look for lisp mode buffers starting by \"helm\" and have \"moc\" in their name. - -if I enter in pattern prompt: -\"*!lisp !helm\" -helm will narrow down to buffers that are not in \"lisp\" mode and that do not match \"helm\" - -if I enter in pattern prompt: -/helm/ w3 -helm will narrow down to buffers that are in any \"helm\" subdirectory and matching w3. - - -*** Creating buffers - -When creating a new buffer use \\[universal-argument] to choose a mode for your buffer in a list. -This list is customizable, see `helm-buffers-favorite-modes'. - -*** Killing buffers - -You have a command to kill buffer(s) and quit emacs and a command to kill buffers one by one -\(no marked\) without quitting helm. -You can run this persistent kill buffer command either with the regular -`helm-execute-persistent-action' called with a prefix arg (C-u C-j) or with its specific command -`helm-buffer-run-kill-persistent' see binding below. - -*** Meaning of colors and prefixes for buffers: - -Remote buffers are prefixed with '@'. -Red => Buffer have its file modified on disk by an external process. -Indianred2 => Buffer exists but its file have been deleted. -Orange => Buffer is modified and its file not saved to disk. -Italic => A non--file buffer. - -\n** Specific commands for `helm-buffers-list': -\\ -\\[helm-buffer-run-zgrep]\t\t->Grep Buffer(s) works as zgrep too (C-u grep all buffers but non--file buffers). -\\[helm-buffers-run-multi-occur]\t\t->Multi Occur buffer or marked buffers. (C-u toggle force searching current-buffer). -\\[helm-buffer-switch-other-window]\t\t->Switch other window. -\\[helm-buffer-switch-other-frame]\t\t->Switch other frame. -\\[helm-buffer-run-query-replace-regexp]\t\t->Query replace regexp in marked buffers. -\\[helm-buffer-run-query-replace]\t\t->Query replace in marked buffers. -\\[helm-buffer-run-ediff]\t\t->Ediff current buffer with candidate. If two marked buffers ediff those buffers. -\\[helm-buffer-run-ediff-merge]\t\t->Ediff merge current buffer with candidate. If two marked buffers ediff merge those buffers. -\\[helm-buffer-diff-persistent]\t\t->Toggle Diff buffer with saved file without quitting. -\\[helm-buffer-revert-persistent]\t\t->Revert buffer without quitting. -\\[helm-buffer-save-persistent]\t\t->Save buffer without quitting. -\\[helm-buffer-run-kill-buffers]\t\t->Delete marked buffers and quit. -\\[helm-buffer-run-kill-persistent]\t\t->Delete buffer without quitting helm. -\\[helm-toggle-all-marks]\t\t->Toggle all marks. -\\[helm-mark-all]\t\t->Mark all. -\\[helm-toggle-buffers-details]\t\t->Toggle details. -\\[helm-buffers-toggle-show-hidden-buffers]\t\t->Show hidden buffers. -\\[helm-buffers-mark-similar-buffers]\t\t->Mark all buffers with same type (color) than current. -\\[helm-buffer-help]\t\t->Display this help. -\n** Helm Map -\\{helm-map}") - -;;;###autoload -(defun helm-buffer-help () - "Help command for helm buffers." - (interactive) - (let ((helm-help-message helm-buffer-help-message)) - (helm-help))) - -;;; Find files help (`helm-find-files') -;; -;; -(defvar helm-ff-help-message - "\n* Helm Find Files\n - -** Helm find files tips: -\n*** Enter `~/' at end of pattern to quickly reach home directory. - -*** Enter `/' at end of pattern to quickly reach root of your file system. - -*** Enter `./' at end of pattern to quickly reach `default-directory' (initial start of session). - If you are already in `default-directory' this will move cursor on top. - -*** Enter `../' at end of pattern will reach upper directory, moving cursor on top. - NOTE: This different to using `C-l' in that `C-l' don't move cursor on top but stay on previous - subdir name. - -*** You can complete with partial basename (start on third char entered) - - e.g \"fob\" or \"fbr\" will complete \"foobar\" - but \"fb\" will wait for a third char for completing. - -*** Use `C-u C-j' to watch an image. - -*** `C-j' on a filename will expand in helm-buffer to this filename. - Second hit on `C-j' will display buffer filename. - Third hit on `C-j' will kill buffer filename. - NOTE: `C-u C-j' will display buffer directly. - -*** To browse images directories turn on `helm-follow-mode' and navigate with arrow keys. - You can also use `helm-follow-action-forward' and `helm-follow-action-backward' - (`C-'). - -*** You can turn off/on (toggle) autoupdate completion at any moment with `C-DEL'. - NOTE: On a terminal C- may not work, use in this case C-c . - -*** You can create a new directory and a new file at the same time. - just write the path in prompt and press `'. - e.g You can create \"~/new/newnew/newnewnew/my_newfile.txt\". - -*** To create a new directory, add a \"/\" at end of new name and press . - -*** To create a new file just write the filename not ending with \"/\". - -*** Recursive search from helm find files - -**** You can use helm browse project (see binding below). - -- With no prefix arg - If your current directory is under version control - with one of git or hg and you have installed helm-ls-git and/or helm-ls-hg - https://github.com/emacs-helm/helm-ls-git.git - https://github.com/emacs-helm/helm-ls-hg - you will see all your files under version control, otherwise - you will be back to helm-find-files. -- With one prefix arg - You will see all the files under this directory - and other subdirectories (recursion) and this list of files will be cached. -- With two prefix args - same but the cache will be refreshed. - -**** You can start a recursive search with Locate of Find (See commands below). - With Locate you can use a local db with a prefix arg; If the localdb doesn't already - exists, you will be prompted for its creation, if it exists and you want to refresh it, - give two prefix args. - -*** Insert filename at point or complete filename at point - -On insertion (no completion, i.e nothing at point): - -- `C-c i' => insert absolute file name. -- `C-u C-c i' => insert abbreviate file name. -- `C-u C-u C-c i' => insert relative file name. - -On completion: - -- target starts by ~/ => insert abbreviate file name. -- target starts by / or [a-z]:/ => insert full path. -- otherwise => insert relative file name. - -*** Using wildcard to select multiple files - -Use of wilcard is supported to give a set of files to an action: - -e.g -You can copy all the files with \".el\" extension by using \"*.el\" -and then run your copy action. - -You can do the same but with \"**.el\" (note the two stars), -this will select recursively all \".el\" files under current directory. - -NOTE: When using an action that involve an external backend (e.g grep), using \"**\" -is not advised (even if it works fine) because it will be slower to select all your files, -you have better time letting the backend doing it, it will be faster. -However, if you know you have not many files it is reasonable to use this, -also using not recursive wilcard (e.g \"*.el\") is perfectly fine for this. - -This feature (\"**\") is activated by default with the option `helm-file-globstar'. -The directory selection with \"**foo/\" like bash shopt globstar option is not supported yet. - -\n** Specific commands for `helm-find-files':\n -\\ -\\[helm-ff-run-locate]\t\t->Run Locate (C-u to specify locate db, M-n insert basename of candidate) -\\[helm-ff-run-browse-project]\t\t->Browse project (`C-u' recurse, `C-u C-u' recurse and refresh db) -\\[helm-ff-run-find-sh-command]\t\t->Run Find shell command from this directory. -\\[helm-ff-run-grep]\t\t->Run Grep (C-u Recursive). -\\[helm-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files. -\\[helm-ff-run-zgrep]\t\t->Run zgrep (C-u Recursive). -\\[helm-ff-run-etags]\t\t->Run Etags (C-u use thing-at-point `C-u C-u' reload cache) -\\[helm-ff-run-rename-file]\t\t->Rename File (C-u Follow). -\\[helm-ff-run-query-replace-on-marked]\t\t->Query replace on marked files. -\\[helm-ff-run-copy-file]\t\t->Copy File (C-u Follow). -\\[helm-ff-run-byte-compile-file]\t\t->Byte Compile File (C-u Load). -\\[helm-ff-run-load-file]\t\t->Load File. -\\[helm-ff-run-symlink-file]\t\t->Symlink File. -\\[helm-ff-run-hardlink-file]\t\t->Hardlink file. -\\[helm-ff-run-delete-file]\t\t->Delete File. -\\[helm-ff-run-kill-buffer-persistent]\t\t->Kill buffer candidate without quitting. -\\[helm-ff-persistent-delete]\t\t->Delete file without quitting. -\\[helm-ff-run-switch-to-eshell]\t\t->Switch to Eshell. -\\[helm-ff-run-eshell-command-on-file]\t\t->Eshell command on file (C-u Apply on marked files, otherwise treat them sequentially). -\\[helm-ff-run-ediff-file]\t\t->Ediff file. -\\[helm-ff-run-ediff-merge-file]\t\t->Ediff merge file. -\\[helm-ff-run-complete-fn-at-point]\t\t->Complete file name at point. -\\[helm-ff-run-switch-other-window]\t\t->Switch other window. -\\[helm-ff-run-switch-other-frame]\t\t->Switch other frame. -\\[helm-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose). -\\[helm-ff-run-open-file-with-default-tool]\t\t->Open file externally with default tool. -\\[helm-ff-rotate-left-persistent]\t\t->Rotate Image Left. -\\[helm-ff-rotate-right-persistent]\t\t->Rotate Image Right. -\\[helm-find-files-up-one-level]\t\t->Go down precedent directory. -\\[helm-ff-run-switch-to-history]\t\t->Switch to last visited directories history. -\\[helm-ff-file-name-history]\t\t->Switch to file name history. -\\[helm-ff-properties-persistent]\t\t->Show file properties in a tooltip. -\\[helm-mark-all]\t\t->Mark all visibles candidates. -\\[helm-ff-run-toggle-auto-update]\t\t->Toggle auto expansion of directories. -\\[helm-unmark-all]\t\t->Unmark all candidates, visibles and invisibles. -\\[helm-ff-run-gnus-attach-files]\t\t->Gnus attach files to message buffer. -\\[helm-ff-run-print-file]\t\t->Print file, (C-u to refresh printers list). -\\[helm-enlarge-window]\t\t->Enlarge helm window. -\\[helm-narrow-window]\t\t->Narrow helm window. -\\[helm-ff-run-toggle-basename]\t\t->Toggle basename/fullpath. -\\[helm-ff-run-find-file-as-root]\t\t->Find file as root. -\\[helm-ff-run-insert-org-link]\t\t->Insert org link. -\\[helm-ff-help]\t\t->Display this help info. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-ff-help () - "Help command for `helm-find-files'." - (interactive) - (let ((helm-help-message helm-ff-help-message)) - (helm-help))) - -;;; Help for `helm-read-file-name' -;; -;; -(defvar helm-read-file-name-help-message - "\n* Helm read file name\n - -** Helm read file name tips: - -\n*** Enter `~/' at end of pattern to quickly reach home directory. - -*** Enter `/' at end of pattern to quickly reach root of your file system. - -*** Enter `./' at end of pattern to quickly reach `default-directory' (initial start of session). - If you are in `default-directory' move cursor on top. - -*** Enter `../' at end of pattern will reach upper directory, moving cursor on top. - NOTE: This different to using `C-l' in that `C-l' don't move cursor on top but stay on previous - subdir name. - -*** You can complete with partial basename (start on third char entered) - - e.g \"fob\" or \"fbr\" will complete \"foobar\" - but \"fb\" will wait for a third char for completing. - -*** Persistent actions: - -By default `helm-read-file-name' use the persistent actions of `helm-find-files'. - -**** Use `C-u C-j' to watch an image. - -**** `C-j' on a filename will expand in helm-buffer to this filename. - Second hit on `C-j' will display buffer filename. - Third hit on `C-j' will kill buffer filename. - NOTE: `C-u C-j' will display buffer directly. - -**** To browse images directories turn on `helm-follow-mode' and navigate with arrow keys. - -**** When you want to delete backward characters to e.g creating a new file or directory, - autoupdate may keep updating to an existent directory - preventing you to do so, in this case just hit C- and then . - This should not needed when copying/renaming files because autoupdate is disabled - by default in this case. - NOTE: On a terminal C- may not work, use in this case C-c . - -**** You can create a new directory and a new file at the same time, just write the path in prompt - and press . - e.g You can create \"~/new/newnew/newnewnew/my_newfile.txt\". - -**** To create a new directory, add a \"/\" at end of new name and press . - -**** To create a new file just write the filename not ending with \"/\". - -\n** Specific commands for helm-read-file-name:\n -\\ -\\[helm-find-files-up-one-level]\t\t->Go down precedent directory. -\\[helm-ff-run-toggle-auto-update]\t\t->Toggle auto expansion of directories. -\\[helm-ff-run-toggle-basename]\t\t->Toggle basename. -\\[helm-ff-file-name-history]\t\t->File name history. -C/\\[helm-cr-empty-string]\t\t->Maybe return empty string (unless `must-match'). -\\[helm-next-source]\t\t->Goto next source. -\\[helm-previous-source]\t->Goto previous source. -\\[helm-read-file-name-help]\t\t->Display this help info. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-read-file-name-help () - (interactive) - (let ((helm-help-message helm-read-file-name-help-message)) - (helm-help))) - -;;; Generic file help - Used by locate. -;; -;; -(defvar helm-generic-file-help-message - "\n* Helm Generic files\n - -** Helm generic file tips:\n - -*** Locate -You can add after writing search pattern any of the locate command line options. -e.g -b, -e, -n ...etc. -See Man locate for more infos. - -Some other sources (at the moment recentf and file in current directory sources) -support the -b flag for compatibility with locate when they are used with it. - -*** Browse project - -When your directory is not under version control, -don't forget to refresh your cache when files have been added/removed in your directory. - -*** Find command - -Recursively search files using \"find\" shell command. - -Candidates are all filenames that match all given globbing patterns. -This respects the options `helm-case-fold-search' and -`helm-findutils-search-full-path'. - -You can pass arbitrary options directly to find after a \"*\" separator. -For example, this would find all files matching \"book\" that are larger -than 1 megabyte: - -book * -size +1M - -\n** Specific commands for helm locate and others files sources: - -\\ -\\[helm-ff-run-toggle-basename]\t\t->Toggle basename. -\\[helm-ff-run-grep]\t\t->Run grep (C-u recurse). -\\[helm-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files. -\\[helm-ff-run-delete-file]\t\t->Delete file. -\\[helm-ff-run-ediff-file]\t\t->Ediff file. -\\[helm-ff-run-ediff-merge-file]\t\t->Ediff merge file. -\\[helm-ff-run-switch-other-window]\t\t->Switch other window. -\\[helm-ff-properties-persistent]\t\t->Show file properties. -\\[helm-ff-run-etags]\t\t->Run etags (C-u use tap, C-u C-u reload DB). -\\[helm-yank-text-at-point]\t\t->Yank text at point. -\\[helm-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose). -\\[helm-ff-run-open-file-with-default-tool]\t\t->Open file externally with default tool. -\\[helm-ff-run-insert-org-link]\t\t->Insert org link. -\\[helm-generic-file-help]\t\t->Show this help. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-generic-file-help () - (interactive) - (let ((helm-help-message helm-generic-file-help-message)) - (helm-help))) - -;;; Grep help -;; -;; -(defvar helm-grep-help-message - "\n* Helm Grep\n -** Helm grep tips:\n -*** You can start grep with a prefix arg to recurse in subdirectories. -*** You can use wild card when selecting files (e.g *.el) -*** You can grep in many differents directories by marking files or wild cards. -*** You can save your results in a grep-mode buffer, see commands below. - -*** Important:\n -Grepping on remote file will work only with grep, not ack-grep, but it is -anyway bad supported as tramp doesn't support multiple process running in a -short delay (less than 5s actually) among other things, -so I strongly advice hitting `C-!' (i.e suspend process) -before entering anything in pattern, and hit again `C-!' when -your regexp is ready to send to remote process, even if helm is handling -this by delaying each process at 5s. -Or even better don't use tramp at all and mount your remote file system on SSHFS. - -\n** Specific commands for Helm Grep:\n -\\ -\\[helm-goto-next-file]\t->Next File. -\\[helm-goto-precedent-file]\t\t->Precedent File. -\\[helm-yank-text-at-point]\t\t->Yank Text at point in minibuffer. -\\[helm-grep-run-other-window-action]\t\t->Jump other window. -\\[helm-grep-run-other-frame-action]\t\t->Jump other frame. -\\[helm-grep-run-persistent-action]\t\t->Run persistent action (Same as `C-j'). -\\[helm-grep-run-default-action]\t\t->Run default action (Same as RET). -\\[helm-grep-run-save-buffer]\t\t->Save to a `grep-mode' enabled buffer. -\\[helm-grep-help]\t\t->Show this help. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-grep-help () - (interactive) - (let ((helm-help-message helm-grep-help-message)) - (helm-help))) - -;;; Pdf grep help -;; -;; -(defvar helm-pdfgrep-help-message - "\n* Helm PdfGrep Map\n -\n** Specific commands for Pdf Grep:\n -\\ -\\[helm-goto-next-file]\t->Next File. -\\[helm-goto-precedent-file]\t\t->Precedent File. -\\[helm-yank-text-at-point]\t\t->Yank Text at point in minibuffer. -\\[helm-pdfgrep-help]\t\t->Show this help. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-pdfgrep-help () - (interactive) - (let ((helm-help-message helm-pdfgrep-help-message)) - (helm-help))) - -;;; Etags help -;; -;; -(defvar helm-etags-help-message - "\n* Helm Etags Map\n -\n** Specific commands for Etags:\n -\\ -\\[helm-goto-next-file]\t->Next File. -\\[helm-goto-precedent-file]\t\t->Precedent File. -\\[helm-yank-text-at-point]\t\t->Yank Text at point in minibuffer. -\\[helm-etags-help]\t\t->Show this help. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-etags-help () - "The help function for etags." - (interactive) - (let ((helm-help-message helm-etags-help-message)) - (helm-help))) - -;;; Ucs help -;; -;; -(defvar helm-ucs-help-message - "\n* Helm Ucs\n -\n** Specific commands for `helm-ucs':\n -\\ -\\[helm-ucs-persistent-insert]\t->Insert char. -\\[helm-ucs-persistent-forward]\t->Forward char. -\\[helm-ucs-persistent-backward]\t->Backward char. -\\[helm-ucs-persistent-delete]\t->Delete char backward. -\\[helm-ucs-help]\t\t->Show this help. - -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-ucs-help () - "Help command for `helm-ucs'." - (interactive) - (let ((helm-help-message helm-ucs-help-message)) - (helm-help))) - -;;; Bookmark help -;; -;; -(defvar helm-bookmark-help-message - "\n* Helm bookmark name\n -\n** Specific commands for bookmarks:\n -\\ -\\[helm-bookmark-run-jump-other-window]\t\t->Jump other window. -\\[helm-bookmark-run-delete]\t\t->Delete bookmark. -\\[helm-bookmark-run-edit]\t\t->Edit bookmark. -\\[helm-bookmark-toggle-filename]\t\t->Toggle bookmark location visibility. -\\[helm-bookmark-help]\t\t->Run this help. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-bookmark-help () - "Help command for bookmarks." - (interactive) - (let ((helm-help-message helm-bookmark-help-message)) - (helm-help))) - -;;; Eshell command on file help -;; -;; -(defvar helm-esh-help-message - "\n* Helm eshell on file\n -** Helm eshell on file tips: - -*** Passing extra args after filename: - -Normally your command or alias will be called with file as argument. - -e.g 'candidate_file' - -But you can also pass an argument or more after 'candidate_file' like this: - - %s [extra_args]\n - -'candidate_file' will be added at '%s' and your command will look at this: - - 'candidate_file' [extra_args] - -*** Specify many files as args (marked files): - -e.g file1 file2 ... - -Call `helm-find-files-eshell-command-on-file' with one prefix-arg -Otherwise you can pass one prefix-arg from the command selection buffer. -NOTE: This is not working on remote files. - -With two prefix-arg before starting or from the command selection buffer -the output is printed to your `current-buffer'. - -Note that with no prefix-arg or a prefix-arg value of '(16) (C-u C-u) -the command is called once for each file like this: - - file1 file2 etc... - -\n** Specific commands for `helm-find-files-eshell-command-on-file':\n -\\ -\\[helm-esh-help]\t\t->Display this help. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-esh-help () - "Help command for `helm-find-files-eshell-command-on-file'." - (interactive) - (let ((helm-help-message helm-esh-help-message)) - (helm-help))) - -;;; Ido virtual buffer help -;; -;; -(defvar helm-buffers-ido-virtual-help-message - "\n* Helm ido virtual buffers\n -\n** Specific commands for ido virtuals buffers:\n -\\ -\\[helm-ff-run-switch-other-window]\t\t->Switch other window. -\\[helm-ff-run-switch-other-frame]\t\t->Switch other frame. -\\[helm-ff-run-grep]\t\t->Grep file. -\\[helm-ff-run-zgrep]\t\t->Zgrep file. -\\[helm-ff-run-delete-file]\t\t->Delete file. -\\[helm-ff-run-open-file-externally]\t\t->Open file externally. -\\[helm-buffers-ido-virtual-help]\t\t->Display this help. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-buffers-ido-virtual-help () - "Help command for ido virtual buffers." - (interactive) - (let ((helm-help-message helm-buffers-ido-virtual-help-message)) - (helm-help))) - -;;; Moccur help -;; -;; -(defvar helm-moccur-help-message - "\n* Helm Moccur\n -** Helm Moccur tips: - -*** Matching -Multiple regexp matching is allowed, just enter a space to separate your regexps. - -Matching empty lines is supported with the regexp \"^$\", you will get the results -with only the buffer-name and the line number, you can of course save and edit these -results. - -*** Jump to the corresponding line in the searched buffer -You can do this with `C-j' (persistent-action), to do it repetitively -you can use `C-' and `C-' or enable `helm-follow-mode' with `C-c C-f'. - -*** Saving results -Same as with helm-grep, you can save the results with `C-x C-s'. -Of course if you don't save your results, you can get back your session -with `helm-resume'. - -*** Refreshing the resumed session. -When the buffer(s) where you ran helm-(m)occur have been modified, you will be -warned of this with the buffer flashing to red, you can refresh the buffer by running -`C-c C-u'. -This can be done automatically by customizing `helm-moccur-auto-update-on-resume'. - -*** Refreshing a saved buffer -Just hit `g' to update your buffer. - -*** Edit a saved buffer - -To do so you have to install wgrep -https://github.com/mhayashi1120/Emacs-wgrep -and then: - -1) C-c C-p to edit the buffer(s). -2) C-x C-s to save your changes. - -Tip: Use the excellent iedit https://github.com/tsdh/iedit -to modify occurences in your buffer. - -\n** Specific commands for Helm Moccur:\n -\\ -\\[helm-goto-next-file]\t->Next Buffer. -\\[helm-goto-precedent-file]\t\t->Precedent Buffer. -\\[helm-yank-text-at-point]\t\t->Yank Text at point in minibuffer. -\\[helm-moccur-run-goto-line-ow]\t\t->Goto line in other window. -\\[helm-moccur-run-goto-line-of]\t\t->Goto line in new frame. -\\[helm-moccur-help]\t\t->Show this help. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-moccur-help () - (interactive) - (let ((helm-help-message helm-moccur-help-message)) - (helm-help))) - -;;; Helm Top -;; -;; -(defvar helm-top-help-message - "\n* Helm Top\n -\n** Helm Top tips: - -\n** Specific commands for Helm Top:\n -\\ -\\[helm-top-run-sort-by-com]\t->Sort by commands. -\\[helm-top-run-sort-by-cpu]\t->Sort by cpu usage. -\\[helm-top-run-sort-by-user]\t->Sort alphabetically by user. -\\[helm-top-run-sort-by-mem]\t->Sort by memory. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-top-help () - (interactive) - (let ((helm-help-message helm-top-help-message)) - (helm-help))) - -;;; Helm Apt -;; -;; -(defvar helm-apt-help-message - "\n* Helm Apt\n -\n** Helm Apt tips: - -\n** Specific commands for Helm Apt:\n -\\ -\\[helm-apt-show-all]\t->Show all packages. -\\[helm-apt-show-only-installed]\t->Show installed packages only. -\\[helm-apt-show-only-not-installed]\t->Show not installed packages only. -\\[helm-apt-show-only-deinstalled]\t-Show deinstalled (not purged yet) packages only.> -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-apt-help () - (interactive) - (let ((helm-help-message helm-apt-help-message)) - (helm-help))) - -;;; Helm elisp package -;; -;; -(defvar helm-el-package-help-message - "\n* Helm elisp package\n -\n** Helm elisp package tips: -*** Upgrade elisp packages - -To see upgradables packages hit . - -Then you can install all upgradables packages with the upgrade all action, -or upgrade only the specific packages by marking them (the new ones) and running -the upgrade action (visible only when there is upgradables packages). -Of course you can upgrade a single package by just running the upgrade action -without marking it. - -*** Meaning of flags prefixing packages (Emacs-25) - -- The flag \"S\" that prefix package names mean that this package is one of `package-selected-packages'. -This feature is only available with emacs-25. - -- The flag \"U\" that prefix package names mean that this package is no more needed. -This feature is only available with emacs-25. - -\n** Specific commands for Helm elisp package:\n -\\ -\\[helm-el-package-show-all]\t->Show all packages. -\\[helm-el-package-show-installed]\t->Show installed packages only. -\\[helm-el-package-show-uninstalled]\t->Show not installed packages only. -\\[helm-el-package-help]\t->Show this help. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-el-package-help () - (interactive) - (let ((helm-help-message helm-el-package-help-message)) - (helm-help))) - -;;; Helm M-x -;; -;; -(defvar helm-M-x-help-message - "\n* Helm M-x\n -\n** Helm M-x tips: - -*** You can get help on any command with persistent action (C-j). - -*** All the prefix args passed BEFORE running `helm-M-x' are ignored, -you should have an error message if you do so. -When you want to pass prefix args, pass them AFTER starting `helm-M-x', -you will have a prefix arg counter appearing in mode-line notifying you -the amount of prefix args entered. - -\n** Specific commands for Helm M-x:\n -\\ -\\[helm-M-x-help]\t\t->Show this help. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-M-x-help () - (interactive) - (let ((helm-help-message helm-M-x-help-message)) - (helm-help))) - -;;; helm-imenu -;; -;; -(defvar helm-imenu-help-message - "\n* Helm imenu\n -\n** Helm imenu tips: - -\n** Specific commands for Helm imenu:\n -\\ -\\[helm-imenu-help]\t->Show this help. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-imenu-help () - (interactive) - (let ((helm-help-message helm-imenu-help-message)) - (helm-help))) - -;;; helm-colors -;; -;; -(defvar helm-colors-help-message - "\n* Helm colors\n -\n** Specific commands for Helm colors:\n -\\ -\\[helm-color-run-insert-name]\t\tInsert the entry'name. -\\[helm-color-run-kill-name]\t\tKill the entry's name. -\\[helm-color-run-insert-rgb]\t\tInsert entry in RGB format. -\\[helm-color-run-kill-rgb]\t\tKill entry in RGB format. -\\[helm-color-help]\t\tShow this help. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-color-help () - (interactive) - (let ((helm-help-message helm-colors-help-message)) - (helm-help))) - -;;; helm semantic -;; -;; -(defvar helm-semantic-help-message - "\n* Helm semantic\n -\n** Helm semantic tips: - -\n** Specific commands for Helm semantic:\n -\\ -\\[helm-semantic-help]\t->Show this help. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-semantic-help () - (interactive) - (let ((helm-help-message helm-semantic-help-message)) - (helm-help))) - -;;; helm kmacro -;; -;; -(defvar helm-kmacro-help-message - "\n* Helm kmacro\n -\n** Helm kmacro tips: -- Start recording some keys with `f3' -- Record new kmacro with `f4' -- Start `helm-execute-kmacro' to list all your macros. - -Use persistent action to run your kmacro as many time as needed, -you can change of kmacro with `helm-next-line' `helm-previous-line'. - -NOTE: You can't record keys running helm commands. - -\n** Specific commands for Helm kmacro:\n -\\ -\\[helm-kmacro-help]\t->Show this help. -\n** Helm Map\n -\\{helm-map}") - -;;;###autoload -(defun helm-kmacro-help () - (interactive) - (let ((helm-help-message helm-kmacro-help-message)) - (helm-help))) - - -;;; Mode line strings -;; -;; -;;;###autoload -(defvar helm-buffer-mode-line-string - '("Buffer(s)" "\ -\\\ -\\[helm-buffer-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct" - "String displayed in mode-line in `helm-source-buffers-list'")) - -;;;###autoload -(defvar helm-color-mode-line-string - '("Colors" "\ -\\\ -\\[helm-color-help]:Help/\ -\\[helm-color-run-insert-name]:Insert name/\ -\\[helm-color-run-insert-rgb]:Insert RGB/\ -with shift: Kill")) - -;;;###autoload -(defvar helm-buffers-ido-virtual-mode-line-string - '("Killed Buffer(s)" "\ -\\\ -\\[helm-buffers-ido-virtual-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct" - "String displayed in mode-line in `helm-source-buffers-list'")) - -;;;###autoload -(defvar helm-ff-mode-line-string "\ -\\\ -\\[helm-ff-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct" - "String displayed in mode-line in `helm-source-find-files'") - -;;;###autoload -(defvar helm-read-file-name-mode-line-string "\ -\\\ -\\[helm-read-file-name-help]:Help \ -C/\\[helm-cr-empty-string]:Empty \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct" - "String displayed in mode-line in `helm-source-find-files'.") - -;;;###autoload -(defvar helm-generic-file-mode-line-string "\ -\\\ -\\[helm-generic-file-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend" - "String displayed in mode-line in Locate.") - -;;;###autoload -(defvar helm-grep-mode-line-string"\ -\\\ -\\[helm-grep-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend" - "String displayed in mode-line in `helm-do-grep'.") - -;;;###autoload -(defvar helm-pdfgrep-mode-line-string "\ -\\\ -\\[helm-pdfgrep-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend" - "String displayed in mode-line in `helm-do-pdfgrep'.") - -;;;###autoload -(defvar helm-etags-mode-line-string "\ -\\\ -\\[helm-etags-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct" - "String displayed in mode-line in `helm-etags-select'.") - -;;;###autoload -(defvar helm-ucs-mode-line-string "\ -\\\ -\\[helm-ucs-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct" - "String displayed in mode-line in `helm-ucs'.") - -;;;###autoload -(defvar helm-bookmark-mode-line-string - '("Bookmark(s)" "\ -\\\ -\\[helm-bookmark-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct") - "String displayed in mode-line in `helm-source-buffers-list'") - -;;;###autoload -(defvar helm-occur-mode-line "\ -\\\ -\\[helm-help]:Help \ -\\\ -\\[helm-occur-run-query-replace-regexp]:Query replace regexp \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend") - -;;;###autoload -(defvar helm-moccur-mode-line "\ -\\\ -\\[helm-moccur-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend") - -;;;###autoload -(defvar helm-comp-read-mode-line "\ -\\\ -C/\\[helm-cr-empty-string]:Empty \ -\\\ -\\[helm-help]:Help \ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct") - -;;;###autoload -(defvar helm-top-mode-line "\ -\\\ -\\[helm-top-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend") - -;;;###autoload -(defvar helm-apt-mode-line "\ -\\\ -\\[helm-apt-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend") - -;;;###autoload -(defvar helm-el-package-mode-line "\ -\\\ -\\[helm-el-package-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend") - -;;;###autoload -(defvar helm-M-x-mode-line "\ -\\\ -\\[helm-M-x-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend") - -;;;###autoload -(defvar helm-imenu-mode-line "\ -\\\ -\\[helm-imenu-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend") - -;;;###autoload -(defvar helm-semantic-mode-line "\ -\\\ -\\[helm-semantic-help]:Help \ -\\\ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct \ -\\[helm-toggle-suspend-update]:Tog.suspend") - - -;;; Attribute Documentation -;; -;; -;;;###autoload -(defun helm-describe-helm-attribute (helm-attribute) - "Display the full documentation of HELM-ATTRIBUTE. -HELM-ATTRIBUTE should be a symbol." - (interactive (list (intern - (completing-read - "Describe helm attribute: " - (mapcar 'symbol-name helm-attributes) - nil t)))) - (with-output-to-temp-buffer "*Help*" - (princ (get helm-attribute 'helm-attrdoc)))) - -(helm-document-attribute 'name "mandatory" - " The name of the source. It is also the heading which appears - above the list of matches from the source. Must be unique.") - -(helm-document-attribute 'header-name "optional" - " A function returning the display string of the header. Its - argument is the name of the source. This attribute is useful to - add an additional information with the source name.") - -(helm-document-attribute 'candidates "mandatory if candidates-in-buffer attribute is not provided" - " Specifies how to retrieve candidates from the source. It can - either be a variable name, a function called with no parameters - or the actual list of candidates. - - The list must be a list whose members are strings, symbols - or (DISPLAY . REAL) pairs. - - In case of (DISPLAY . REAL) pairs, the DISPLAY string is shown - in the Helm buffer, but the REAL one is used as action - argument when the candidate is selected. This allows a more - readable presentation for candidates which would otherwise be, - for example, too long or have a common part shared with other - candidates which can be safely replaced with an abbreviated - string for display purposes. - - Note that if the (DISPLAY . REAL) form is used then pattern - matching is done on the displayed string, not on the real - value. - - If the candidates have to be retrieved asynchronously (for - example, by an external command which takes a while to run) - then the function should start the external command - asynchronously and return the associated process object. - Helm will take care of managing the process (receiving the - output from it, killing it if necessary, etc.). The process - should return candidates matching the current pattern (see - variable `helm-pattern'.) - You should use instead `candidates-process' attribute for - async processes, a warning will popup when using async process - in a `candidates' attribute. - - Note that currently results from asynchronous sources appear - last in the helm buffer regardless of their position in - `helm-sources'.") - -(helm-document-attribute 'candidates-process - "Same as `candidates' attributes but for process function." - " You should use this attribute when using a function involving - an async process instead of `candidates'.") - -(helm-document-attribute 'action "mandatory if type attribute is not provided" - " It is a list of (DISPLAY . FUNCTION) pairs or FUNCTION. - FUNCTION is called with one parameter: the selected candidate. - - An action other than the default can be chosen from this list - of actions for the currently selected candidate (by default - with TAB). The DISPLAY string is shown in the completions - buffer and the FUNCTION is invoked when an action is - selected. The first action of the list is the default.") - -(helm-document-attribute 'coerce "optional" - " It's a function called with one argument: the selected - candidate. - - This function is intended for type convertion. In normal case, - the selected candidate (string) is passed to action - function. If coerce function is specified, it is called just - before action function. - - Example: converting string to symbol - (coerce . intern)") - -(helm-document-attribute 'type "optional if action attribute is provided" - " Indicates the type of the items the source returns. - - Merge attributes not specified in the source itself from - `helm-type-attributes'. - - This attribute is implemented by plug-in.") - -(helm-document-attribute 'init "optional" - " Function called with no parameters when helm is started. It - is useful for collecting current state information which can be - used to create the list of candidates later. - - For example, if a source needs to work with the current - directory then it can store its value here, because later - helm does its job in the minibuffer and in the - `helm-buffer' and the current directory can be different - there.") - -(helm-document-attribute 'match "optional" - " List of functions called with one parameter: a candidate. The - function should return non-nil if the candidate matches the - current pattern (see variable `helm-pattern'). - - This attribute allows the source to override the default - pattern matching based on `string-match'. It can be used, for - example, to implement a source for file names and do the - pattern matching on the basename of files, since it's more - likely one is typing part of the basename when searching for a - file, instead of some string anywhere else in its path. - - If the list contains more than one function then the list of - matching candidates from the source is constructed by appending - the results after invoking the first function on all the - potential candidates, then the next function, and so on. The - matching candidates supplied by the first function appear first - in the list of results and then results from the other - functions, respectively. - - This attribute has no effect for asynchronous sources (see - attribute `candidates'), since they perform pattern matching - themselves.") - -(helm-document-attribute 'candidate-transformer "optional" - " It's a function or a list of functions called with one argument - when the completion list from the source is built. The argument - is the list of candidates retrieved from the source. The - function should return a transformed list of candidates which - will be used for the actual completion. If it is a list of - functions, it calls each function sequentially. - - This can be used to transform or remove items from the list of - candidates. - - Note that `candidates' is run already, so the given transformer - function should also be able to handle candidates with (DISPLAY - . REAL) format.") - -(helm-document-attribute 'filtered-candidate-transformer "optional" - " It has the same format as `candidate-transformer', except the - function is called with two parameters: the candidate list and - the source. - - This transformer is run on the candidate list which is already - filtered by the current pattern. While `candidate-transformer' - is run only once, it is run every time the input pattern is - changed. - - It can be used to transform the candidate list dynamically, for - example, based on the current pattern. - - In some cases it may also be more efficent to perform candidate - transformation here, instead of with `candidate-transformer' - even if this transformation is done every time the pattern is - changed. For example, if a candidate set is very large then - `candidate-transformer' transforms every candidate while only - some of them will actually be dislpayed due to the limit - imposed by `helm-candidate-number-limit'. - - Note that `candidates' and `candidate-transformer' is run - already, so the given transformer function should also be able - to handle candidates with (DISPLAY . REAL) format. - - This option has no effect for asynchronous sources. (Not yet, - at least.") - -(helm-document-attribute 'action-transformer "optional" - " It's a function or a list of functions called with two - arguments when the action list from the source is - assembled. The first argument is the list of actions, the - second is the current selection. If it is a list of functions, - it calls each function sequentially. - - The function should return a transformed action list. - - This can be used to customize the list of actions based on the - currently selected candidate.") - -(helm-document-attribute 'pattern-transformer "optional" - " It's a function or a list of functions called with one argument - before computing matches. Its argument is `helm-pattern'. - Functions should return transformed `helm-pattern'. - - It is useful to change interpretation of `helm-pattern'.") - -(helm-document-attribute 'delayed "optional" - " Candidates from the source are shown only if the user stops - typing and is idle for `helm-idle-delay' seconds. - If a value is given to delayed attr, this value is used instead only - if it is > to `helm-idle-delay'.") - -(helm-document-attribute 'volatile "optional" - " Indicates the source assembles the candidate list dynamically, - so it shouldn't be cached within a single Helm - invocation. It is only applicable to synchronous sources, - because asynchronous sources are not cached.") - -(helm-document-attribute 'requires-pattern "optional" - " If present matches from the source are shown only if the - pattern is not empty. Optionally, it can have an integer - parameter specifying the required length of input which is - useful in case of sources with lots of candidates.") - -(helm-document-attribute 'persistent-action "optional" - " Can be a either a Function called with one parameter (the - selected candidate) or a cons cell where first element is this - same function and second element a symbol (e.g never-split) - that inform `helm-execute-persistent-action'to not split his - window to execute this persistent action.") - -(helm-document-attribute 'candidates-in-buffer "optional" - " Shortcut attribute for making and narrowing candidates using - buffers. This newly-introduced attribute prevents us from - forgetting to add volatile and match attributes. - - See docstring of `helm-candidates-in-buffer'. - - (candidates-in-buffer) is equivalent of three attributes: - (candidates . helm-candidates-in-buffer) - (volatile) - (match identity) - - (candidates-in-buffer . candidates-function) is equivalent of: - (candidates . candidates-function) - (volatile) - (match identity) - - This attribute is implemented by plug-in.") - -(helm-document-attribute 'search "optional" - " List of functions like `re-search-forward' or `search-forward'. - Buffer search function used by `helm-candidates-in-buffer'. - By default, `helm-candidates-in-buffer' uses - `re-search-forward'. This attribute is meant to be used with - (candidates . helm-candidates-in-buffer) or - (candidates-in-buffer) in short.") - -(helm-document-attribute 'get-line "optional" - " A function like `buffer-substring-no-properties' or `buffer-substring'. - This function converts point of line-beginning and point of line-end, - which represents a candidate computed by `helm-candidates-in-buffer'. - By default, `helm-candidates-in-buffer' uses - `buffer-substring-no-properties'.") - -(helm-document-attribute 'display-to-real "optional" - " Function called with one parameter; the selected candidate. - - The function transforms the selected candidate, and the result - is passed to the action function. The display-to-real - attribute provides another way to pass other string than one - shown in Helm buffer. - - Traditionally, it is possible to make candidates, - candidate-transformer or filtered-candidate-transformer - function return a list with (DISPLAY . REAL) pairs. But if REAL - can be generated from DISPLAY, display-to-real is more - convenient and faster.") - -(helm-document-attribute 'real-to-display "optional" - " Function called with one parameter; the selected candidate. - - The inverse of display-to-real attribute. - - The function transforms the selected candidate, which is passed - to the action function, for display. The real-to-display - attribute provides the other way to pass other string than one - shown in Helm buffer. - - Traditionally, it is possible to make candidates, - candidate-transformer or filtered-candidate-transformer - function return a list with (DISPLAY . REAL) pairs. But if - DISPLAY can be generated from REAL, real-to-display is more - convenient. - - Note that DISPLAY parts returned from candidates / - candidate-transformer are IGNORED as the name `display-to-real' - says.") - -(helm-document-attribute 'cleanup "optional" - " Function called with no parameters when *helm* buffer is - closed. It is useful for killing unneeded candidates buffer. - - Note that the function is executed BEFORE performing action.") - -(helm-document-attribute 'candidate-number-limit "optional" - " Override `helm-candidate-number-limit' only for this source.") - -(helm-document-attribute 'accept-empty "optional" - " Pass empty string \"\" to action function.") - -(helm-document-attribute 'dummy "optional" - " Set `helm-pattern' to candidate. If this attribute is - specified, The candidates attribute is ignored. - - This attribute is implemented by plug-in.") - -(helm-document-attribute 'multiline "optional" - " Enable to selection multiline candidates.") - -(helm-document-attribute 'update "optional" - (substitute-command-keys - " Function called with no parameters at before \"init\" function when \ -\\\\[helm-force-update] is pressed.")) - -(helm-document-attribute 'mode-line "optional" - " Source local `helm-mode-line-string' (included in - `mode-line-format'). It accepts also variable/function name.") - -(helm-document-attribute 'header-line "optional" - " Source local `header-line-format'. - It accepts also variable/function name. ") - -(helm-document-attribute - 'resume "optional" - " Function called with no parameters at end of initialization - when `helm-resume' is started. - If this function try to do something against `helm-buffer', \(e.g updating, - searching etc...\) probably you should run it in a timer to ensure - `helm-buffer' is ready.") - -(helm-document-attribute 'keymap "optional" - " Specific keymap for this source. - It is useful to have a keymap per source when using more than - one source. Otherwise, a keymap can be set per command with - `helm' argument KEYMAP. NOTE: when a source have `helm-map' as - keymap attr, the global value of `helm-map' will override the - actual local one.") - -(helm-document-attribute 'help-message "optional" - " Help message for this source. - If not present, `helm-help-message' value will be used.") - -(helm-document-attribute 'match-part "optional" - " Allow matching candidate in the line with `candidates-in-buffer'. - In candidates-in-buffer sources, match is done with - `re-search-forward' which allow matching only a regexp on the - `helm-buffer'; when this search is done, match-part allow - matching only a specific part of the current line e.g with a - line like this: - - filename:candidate-containing-the-word-filename - - What you want is to ignore \"filename\" part and match only - \"candidate-containing-the-word-filename\" - - So give a function matching only the part of candidate after \":\" - - If source contain match-part attribute, match is computed only - on part of candidate returned by the call of function provided - by this attribute. The function should have one arg, candidate, - and return only a specific part of candidate. - - NOTE: This have effect only on sources using - `candidates-in-buffer'.") - -(helm-document-attribute 'match-strict "optional" - " When specifying a match function within a source and - helm-match-plugin is enabled, the result of all matching - functions will be concatened, which in some cases is not what - is wanted. When using `match-strict' only this or these - functions will be used. You can specify those functions as a - list of functions or a single symbol function. For anonymous - function don't add the dot, e.g: - - \(match-strict (lambda () (foo))).") - -(helm-document-attribute 'nohighlight "optional" - " Disable highlight match in this source.") - -(helm-document-attribute 'no-matchplugin "optional" - " Disable matchplugin for this source.") - -(helm-document-attribute 'history "optional" - " Allow passing history variable to helm from source. - It should be a quoted symbol evaluated from source, i.e: - (history . ,'history-var)") - -(helm-document-attribute 'follow "optional" - " Enable `helm-follow-mode' for this source only. - You must give it a value of 1 or -1, though giving a -1 value - is surely not what you want, e.g: (follow . 1) - - See `helm-follow-mode' for more infos") - -(helm-document-attribute 'follow-delay "optional" - " `helm-follow-mode' will execute persistent-action after this delay. -Otherwise value of `helm-follow-input-idle-delay' is used if non--nil, -If none of these are found fallback to `helm-input-idle-delay'.") - -(helm-document-attribute 'allow-dups "optional" - " Allow helm collecting duplicates candidates.") - -(helm-document-attribute 'filter-one-by-one "optional" - " A transformer function that treat candidates one by one. - It is called with one arg the candidate. - It is faster than `filtered-candidate-transformer' or `candidates-transformer', - but should be used only in sources that recompute constantly their candidates, - e.g `helm-source-find-files'. - Filtering happen early and candidates are treated - one by one instead of re-looping on the whole list. - If used with `filtered-candidate-transformer' or `candidates-transformer' - these functions should treat the candidates transformed by the `filter-one-by-one' - function in consequence.") - -(helm-document-attribute 'nomark "optional" - " Don't allow marking candidates when this attribute is present.") - -(provide 'helm-help) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-help.el ends here diff --git a/elpa/helm-20150403.101/helm-imenu.el b/elpa/helm-20150403.101/helm-imenu.el deleted file mode 100644 index 2bf44c42..00000000 --- a/elpa/helm-20150403.101/helm-imenu.el +++ /dev/null @@ -1,183 +0,0 @@ -;;; helm-imenu.el --- Helm interface for Imenu -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'imenu) -(require 'helm-utils) -(require 'helm-help) - - -(defgroup helm-imenu nil - "Imenu related libraries and applications for helm." - :group 'helm) - -(defcustom helm-imenu-delimiter " / " - "Delimit types of candidates and his value in `helm-buffer'." - :group 'helm-imenu - :type 'string) - -(defcustom helm-imenu-execute-action-at-once-if-one t - "Goto the candidate when only one is remaining." - :group 'helm-imenu - :type 'boolean) - -(defcustom helm-imenu-lynx-style-map t - "Use Arrow keys to jump to occurences." - :group 'helm-imenu - :type 'boolean) - - -;;; keymap -(defvar helm-imenu-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c ?") 'helm-imenu-help) - (when helm-imenu-lynx-style-map - (define-key map (kbd "") 'helm-maybe-exit-minibuffer) - (define-key map (kbd "") 'helm-execute-persistent-action)) - (delq nil map))) - - -;;; Internals -(defvar helm-cached-imenu-alist nil) -(make-variable-buffer-local 'helm-cached-imenu-alist) - -(defvar helm-cached-imenu-candidates nil) -(make-variable-buffer-local 'helm-cached-imenu-candidates) - -(defvar helm-cached-imenu-tick nil) -(make-variable-buffer-local 'helm-cached-imenu-tick) - - -(defvar helm-source-imenu nil "See (info \"(emacs)Imenu\")") - -(defclass helm-imenu-source (helm-source-sync) - ((candidates :initform 'helm-imenu-candidates) - (candidate-transformer :initform 'helm-imenu-transformer) - (persistent-action :initform 'helm-imenu-persistent-action) - (persistent-help :initform "Show this entry") - (keymap :initform helm-imenu-map) - (mode-line :initform helm-imenu-mode-line) - (action :initform 'helm-imenu-action))) - -(defcustom helm-imenu-fuzzy-match nil - "Enable fuzzy matching in `helm-source-imenu'." - :group 'helm-imenu - :type 'boolean - :set (lambda (var val) - (set var val) - (setq helm-source-imenu - (helm-make-source "Imenu" 'helm-imenu-source - :fuzzy-match helm-imenu-fuzzy-match)))) - -(defun helm-imenu-action (candidate) - "Default action for `helm-source-imenu'." - (imenu candidate) - ;; If semantic is supported in this buffer - ;; imenu used `semantic-imenu-goto-function' - ;; and position have been highlighted, - ;; no need to highlight again. - (unless (eq imenu-default-goto-function - 'semantic-imenu-goto-function) - (helm-highlight-current-line nil nil nil nil 'pulse))) - -(defun helm-imenu-persistent-action (candidate) - "Default persistent action for `helm-source-imenu'." - (imenu candidate) - (helm-highlight-current-line)) - -(defun helm-imenu-candidates () - (with-helm-current-buffer - (let ((tick (buffer-modified-tick))) - (if (eq helm-cached-imenu-tick tick) - helm-cached-imenu-candidates - (setq imenu--index-alist nil) - (prog1 (setq helm-cached-imenu-candidates - (let ((index (imenu--make-index-alist))) - (helm-imenu--candidates-1 - (delete (assoc "*Rescan*" index) index)))) - (setq helm-cached-imenu-tick tick)))))) - -(defun helm-imenu--candidates-1 (alist) - (cl-loop for elm in alist - append (if (imenu--subalist-p elm) - (helm-imenu--candidates-1 - (cl-loop for (e . v) in (cdr elm) collect - (cons (propertize - e 'helm-imenu-type (car elm)) - v))) - (and (cdr elm) ; bug in imenu, should not be needed. - (list elm))))) - -(defun helm-imenu--get-prop (item) - ;; property value of ITEM can have itself - ;; a property value which have itself a property value - ;; ...and so on; Return a list of all these - ;; properties values starting at ITEM. - (let* ((prop (get-text-property 0 'helm-imenu-type item)) - (lst (list prop item))) - (when prop - (while prop - (setq prop (get-text-property 0 'helm-imenu-type prop)) - (and prop (push prop lst))) - lst))) - -(defun helm-imenu-transformer (candidates) - (cl-loop for (k . v) in candidates - for types = (or (helm-imenu--get-prop k) - (list "Function" k)) - collect - (cons (mapconcat (lambda (x) - (propertize - x 'face (cond ((string= x "Variables") - 'font-lock-variable-name-face) - ((string= x "Function") - 'font-lock-function-name-face) - ((string= x "Types") - 'font-lock-type-face)))) - types helm-imenu-delimiter) - (cons k v)))) - -;;;###autoload -(defun helm-imenu () - "Preconfigured `helm' for `imenu'." - (interactive) - (unless helm-source-imenu - (setq helm-source-imenu - (helm-make-source "Imenu" 'helm-imenu-source - :fuzzy-match helm-imenu-fuzzy-match))) - (let ((imenu-auto-rescan t) - (str (thing-at-point 'symbol)) - (helm-execute-action-at-once-if-one - helm-imenu-execute-action-at-once-if-one)) - (helm :sources 'helm-source-imenu - :default (list (concat "\\_<" str "\\_>") str) - :candidate-number-limit 9999 - :buffer "*helm imenu*"))) - -(provide 'helm-imenu) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-imenu.el ends here diff --git a/elpa/helm-20150403.101/helm-info.el b/elpa/helm-20150403.101/helm-info.el deleted file mode 100644 index e38e64d3..00000000 --- a/elpa/helm-20150403.101/helm-info.el +++ /dev/null @@ -1,183 +0,0 @@ -;;; helm-info.el --- Browse info index with helm -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-plugin) - -(declare-function Info-index-nodes "info" (&optional file)) -(declare-function Info-goto-node "info" (&optional fork)) -(declare-function Info-find-node "info.el" (filename nodename &optional no-going-back)) -(defvar Info-history) - - -(defgroup helm-info nil - "Info related Applications and libraries for Helm." - :group 'helm) - -;;; Build info-index sources with `helm-info-source' class. -;; -;; -(cl-defun helm-info-init (&optional (file (helm-attr 'info-file))) - ;; Allow reinit candidate buffer when using edebug. - (helm-aif (and debug-on-error - (helm-candidate-buffer)) - (kill-buffer it)) - (unless (helm-candidate-buffer) - (save-window-excursion - (info file) - (let ((tobuf (helm-candidate-buffer 'global)) - (infobuf (current-buffer)) - Info-history - start end) - (cl-dolist (node (Info-index-nodes)) - (Info-goto-node node) - (goto-char (point-min)) - (while (search-forward "\n* " nil t) - (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t) - (setq start (point-at-bol) - end (point-at-eol)) - (with-current-buffer tobuf - (insert-buffer-substring infobuf start end) - (insert "\n"))))))))) - -(defun helm-info-goto (node-line) - (Info-goto-node (car node-line)) - (helm-goto-line (cdr node-line))) - -(defun helm-info-display-to-real (line) - (and (string-match - ;; This regexp is stolen from Info-apropos-matches - "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line) - (cons (format "(%s)%s" (helm-attr 'info-file) (match-string 2 line)) - (string-to-number (or (match-string 3 line) "1"))))) - -(defclass helm-info-source (helm-source-in-buffer) - ((info-file :initarg :info-file - :initform nil - :custom 'string) - (init :initform #'helm-info-init) - (display-to-real :initform #'helm-info-display-to-real) - (get-line :initform #'buffer-substring) - (action :initform '(("Goto node" . helm-info-goto))))) - -(defmacro helm-build-info-source (fname &rest args) - `(helm-make-source (concat "Info Index: " ,fname) 'helm-info-source - :info-file ,fname ,@args)) - -(defun helm-build-info-index-command (name doc source buffer) - "Define an helm command NAME with documentation DOC. -Arg SOURCE will be an existing helm source named -`helm-source-info-' and BUFFER a string buffer name." - (defalias (intern (concat "helm-info-" name)) - (lambda () - (interactive) - (helm :sources source - :buffer buffer - :candidate-number-limit 1000)) - doc)) - -(defun helm-define-info-index-sources (var-value &optional commands) - "Define helm sources named helm-source-info-. -Sources are generated for all entries of `helm-default-info-index-list'. -If COMMANDS arg is non--nil build also commands named `helm-info'. -Where NAME is one of `helm-default-info-index-list'." - (cl-loop for str in var-value - for sym = (intern (concat "helm-source-info-" str)) - do (set sym (helm-build-info-source str)) - when commands - do (helm-build-info-index-command - str (format "Predefined helm for %s info." str) - sym (format "*helm info %s*" str)))) - -(defun helm-info-index-set (var value) - (set var value) - (helm-define-info-index-sources value t)) - -(defcustom helm-default-info-index-list - '("elisp" "cl" "org" "gnus" "tramp" "ratpoison" - "zsh" "bash" "coreutils" "fileutils" - "find" "sh-utils" "textutils" "libc" - "make" "automake" "autoconf" "eintr" - "emacs" "elib" "eieio" "gauche-refe" "guile" - "guile-tut" "goops" "screen" "latex" "gawk" - "sed" "m4" "wget" "binutils" "as" "bfd" "gprof" - "ld" "diff" "flex" "grep" "gzip" "libtool" - "texinfo" "info" "gdb" "stabs" "cvsbook" "cvs" - "bison" "id-utils" "global") - "Info Manual entries to use for building helm info index commands." - :group 'helm-info - :type '(repeat (choice string)) - :set 'helm-info-index-set) - -(defcustom helm-info-default-sources - '(helm-source-info-elisp - helm-source-info-cl - helm-source-info-eieio - helm-source-info-pages) - "The default sources to use in `helm-info-at-point'." - :group 'helm-info - :type '(repeat (choice symbol))) - - -;;; Info pages -(defvar helm-info--pages-cache nil - "Cache for all info pages on system.") - -(defun helm-info-pages-init () - "Collect candidates for initial Info node Top." - (if helm-info--pages-cache - helm-info--pages-cache - (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.") - topics) - (require 'info) - (with-temp-buffer - (Info-find-node "dir" "top") - (goto-char (point-min)) - (while (re-search-forward info-topic-regexp nil t) - (push (match-string-no-properties 1) topics)) - (kill-buffer)) - (setq helm-info--pages-cache topics)))) - -(defvar helm-source-info-pages - (helm-build-sync-source "Info Pages" - :init #'helm-info-pages-init - :candidates (lambda () helm-info--pages-cache) - :action '(("Show with Info" .(lambda (node-str) - (info (replace-regexp-in-string - "^[^:]+: " "" node-str))))) - :requires-pattern 2)) - -;;;###autoload -(defun helm-info-at-point () - "Preconfigured `helm' for searching info at point. -With a prefix-arg insert symbol at point." - (interactive) - (helm :sources helm-info-default-sources - :buffer "*helm info*")) - -(provide 'helm-info) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-info.el ends here diff --git a/elpa/helm-20150403.101/helm-locate.el b/elpa/helm-20150403.101/helm-locate.el deleted file mode 100644 index 2c50ea64..00000000 --- a/elpa/helm-20150403.101/helm-locate.el +++ /dev/null @@ -1,345 +0,0 @@ -;;; helm-locate.el --- helm interface for locate. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;; NOTE for WINDOZE users: -;; You have to install Everything with his command line interface here: -;; http://www.voidtools.com/download.php - -;;; Code: - -(require 'cl-lib) -(require 'helm) - - -(defgroup helm-locate nil - "Locate related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-locate-db-file-regexp "m?locate\.db$" - "Default regexp to match locate database. -If nil Search in all files." - :type 'string - :group 'helm-locate) - -(defcustom helm-ff-locate-db-filename "locate.db" - "The basename of the locatedb file you use locally in your directories. -When this is set and `helm' find such a file in the directory from -where you launch locate, it will use this file and will not prompt you -for a db file. -Note that this happen only when locate is launched with a prefix arg." - :group 'helm-locate - :type 'string) - -(defcustom helm-locate-command nil - "A list of arguments for locate program. -Normally you should not have to modify this yourself. - -If nil it will be calculated when `helm-locate' startup -with these default values for different systems: - -Gnu/linux: \"locate %s -e -A %s\" -berkeley-unix: \"locate %s %s\" -windows-nt: \"es %s %s\" -Others: \"locate %s %s\" - -This string will be passed to format so it should end with `%s'. -The first format spec is used for the \"-i\" value of locate/es, -So don't set it directly but use `helm-locate-case-fold-search' -for this. -The \"-r\" option must be the last option, however if not specified you will -be able to specify it during helm invocation by prefixing the pattern -you enter with \"-r\"." - :type 'string - :group 'helm-locate) - -(defcustom helm-locate-create-db-command - "updatedb -l 0 -o %s -U %s" - "Command used to create a locale locate db file." - :type 'string - :group 'helm-locate) - -(defcustom helm-locate-case-fold-search helm-case-fold-search - "It have the same meaning as `helm-case-fold-search'. -The -i option of locate will be used depending of value of -`helm-pattern' when this is set to 'smart. -When nil \"-i\" will not be used at all. -and when non--nil it will always be used. -NOTE: the -i option of the \"es\" command used on windows does -the opposite of \"locate\" command." - :group 'helm-locate - :type 'symbol) - -(defcustom helm-locate-fuzzy-match nil - "Enable fuzzy matching in `helm-locate'." - :group 'helm-locate - :type 'boolean) - - -(defvar helm-generic-files-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-]") 'helm-ff-run-toggle-basename) - (define-key map (kbd "C-s") 'helm-ff-run-grep) - (define-key map (kbd "M-g s") 'helm-ff-run-grep) - (define-key map (kbd "M-g z") 'helm-ff-run-zgrep) - (define-key map (kbd "M-g p") 'helm-ff-run-pdfgrep) - (define-key map (kbd "M-D") 'helm-ff-run-delete-file) - (define-key map (kbd "C-=") 'helm-ff-run-ediff-file) - (define-key map (kbd "C-c =") 'helm-ff-run-ediff-merge-file) - (define-key map (kbd "C-c o") 'helm-ff-run-switch-other-window) - (define-key map (kbd "C-c C-o") 'helm-ff-run-switch-other-frame) - (define-key map (kbd "M-i") 'helm-ff-properties-persistent) - (define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally) - (define-key map (kbd "C-c X") 'helm-ff-run-open-file-with-default-tool) - (define-key map (kbd "M-.") 'helm-ff-run-etags) - (define-key map (kbd "C-w") 'helm-yank-text-at-point) - (define-key map (kbd "C-c @") 'helm-ff-run-insert-org-link) - (define-key map (kbd "C-c ?") 'helm-generic-file-help) - map) - "Generic Keymap for files.") - - -(defface helm-locate-finish - '((t (:foreground "Green"))) - "Face used in mode line when locate process is finish." - :group 'helm-locate) - - -(defun helm-ff-find-locatedb (&optional from-ff) - "Try to find if a local locatedb file is available. -The search is done in `helm-ff-default-directory' or -fall back to `default-directory' if FROM-FF is nil." - (when helm-ff-locate-db-filename - (cond ((and helm-ff-default-directory - from-ff - (file-exists-p (expand-file-name - helm-ff-locate-db-filename - helm-ff-default-directory)) - (expand-file-name - helm-ff-locate-db-filename - helm-ff-default-directory))) - ((and (not from-ff) - (file-exists-p (expand-file-name - helm-ff-locate-db-filename - default-directory)) - (expand-file-name - helm-ff-locate-db-filename - default-directory)))))) - -(defun helm-locate-1 (&optional localdb init from-ff default) - "Generic function to run Locate. -Prefix arg LOCALDB when (4) search and use a local locate db file when it -exists or create it, when (16) force update of existing db file -even if exists. -It have no effect when locate command is 'es'. -INIT is a string to use as initial input in prompt. -See `helm-locate-with-db' and `helm-locate'." - (require 'helm-mode) - (helm-locate-set-command) - (let ((pfn #'(lambda (candidate) - (if (file-directory-p candidate) - (message "Error: The locate Db should be a file") - (if (= (shell-command - (format helm-locate-create-db-command - candidate - helm-ff-default-directory)) - 0) - (message "New locatedb file `%s' created" candidate) - (error "Failed to create locatedb file `%s'" candidate))))) - (locdb (and localdb - (not (string-match "^es" helm-locate-command)) - (or (and (equal '(4) localdb) - (helm-ff-find-locatedb from-ff)) - (helm-read-file-name - "Create Locate Db file: " - :initial-input (expand-file-name "locate.db" - (or helm-ff-default-directory - default-directory)) - :preselect helm-locate-db-file-regexp - :test #'(lambda (x) - (if helm-locate-db-file-regexp - ;; Select only locate db files and directories - ;; to allow navigation. - (or (string-match - helm-locate-db-file-regexp x) - (file-directory-p x)) - x))))))) - (when (and locdb (or (equal localdb '(16)) - (not (file-exists-p locdb)))) - (funcall pfn locdb)) - (helm-locate-with-db (and localdb locdb) init default))) - -(defun helm-locate-set-command () - "Setup `helm-locate-command' if not already defined." - (unless helm-locate-command - (setq helm-locate-command - (cl-case system-type - (gnu/linux "locate %s -e -r %s") - (berkeley-unix "locate %s %s") - (windows-nt "es %s %s") - (t "locate %s %s"))))) - -(defvar helm-file-name-history nil) -(defun helm-locate-with-db (&optional db initial-input default) - "Run locate -d DB. -If DB is not given or nil use locate without -d option. -Argument DB can be given as a string or list of db files. -Argument INITIAL-INPUT is a string to use as initial-input. -See also `helm-locate'." - (when (and db (stringp db)) (setq db (list db))) - (helm-locate-set-command) - (let ((helm-ff-transformer-show-only-basename nil) - (helm-locate-command - (if db - (replace-regexp-in-string - "locate" - (format "locate -d %s" - (mapconcat 'identity - ;; Remove eventually - ;; marked directories by error. - (cl-loop for i in db - unless (file-directory-p i) - collect i) ":")) - helm-locate-command) - helm-locate-command))) - (setq helm-file-name-history (mapcar 'helm-basename file-name-history)) - (helm :sources 'helm-source-locate - :buffer "*helm locate*" - :input initial-input - :default default - :history 'helm-file-name-history))) - -(defun helm-locate-init () - "Initialize async locate process for `helm-source-locate'." - (let* ((locate-is-es (string-match "\\`es" helm-locate-command)) - (real-locate (string-match "\\`locate" helm-locate-command)) - (case-sensitive-flag (if locate-is-es "-i" "")) - (ignore-case-flag (if (or locate-is-es - (not real-locate)) "" "-i")) - (args (split-string helm-pattern " ")) - (cmd (format helm-locate-command - (cl-case helm-locate-case-fold-search - (smart (let ((case-fold-search nil)) - (if (string-match "[[:upper:]]" helm-pattern) - case-sensitive-flag - ignore-case-flag))) - (t (if helm-locate-case-fold-search - ignore-case-flag - case-sensitive-flag))) - (concat - ;; The pattern itself. - (shell-quote-argument (car args)) " " - ;; Possible locate args added - ;; after pattern, don't quote them. - (mapconcat 'identity (cdr args) " "))))) - (helm-log "Starting helm-locate process") - (helm-log "Command line used was:\n\n%s" - (concat ">>> " (propertize cmd 'face 'font-lock-comment-face) "\n\n")) - (prog1 - (start-process-shell-command - "locate-process" helm-buffer - cmd) - (set-process-sentinel - (get-buffer-process helm-buffer) - #'(lambda (_process event) - (if (string= event "finished\n") - (with-helm-window - (setq mode-line-format - '(" " mode-line-buffer-identification " " - (:eval (format "L%s" (helm-candidate-number-at-point))) " " - (:eval (propertize - (format "[Locate process finished - (%s results)]" - (max (1- (count-lines - (point-min) (point-max))) - 0)) - 'face 'helm-locate-finish)))) - (force-mode-line-update)) - (helm-log "Error: Locate %s" - (replace-regexp-in-string "\n" "" event)))))))) - -(defclass helm-locate-source (helm-source-async helm-type-file) - ((init :initform 'helm-locate-set-command) - (candidates-process :initform 'helm-locate-init) - (requires-pattern :initform 3) - (history :initform 'helm-file-name-history) - (keymap :initform helm-generic-files-map) - (help-message :initform helm-generic-file-help-message) - (candidate-number-limit :initform 9999) - (mode-line :initform helm-generic-file-mode-line-string))) - -(defvar helm-source-locate - (helm-make-source "Locate" 'helm-locate-source - :pattern-transformer 'helm-locate-pattern-transformer)) - -(defun helm-locate-pattern-transformer (pattern) - (if helm-locate-fuzzy-match - (cond ((string-match - " " (replace-regexp-in-string " -b" "" pattern)) pattern) - ((string-match "\\([^ ]*\\) -b" pattern) - (concat (helm--mapconcat-pattern - (match-string 1 pattern)) " -b")) - (t (helm--mapconcat-pattern pattern))) - pattern)) - -;;;###autoload -(defun helm-locate-read-file-name (prompt) - (let* (helm-ff-transformer-show-only-basename - (src `((name . "Locate read fname") - (init . helm-locate-set-command) - (candidates-process . helm-locate-init) - (action . identity) - (requires-pattern . 3) - (history . ,'helm-file-name-history) - (candidate-transformer . (helm-skip-boring-files - helm-highlight-files)) - (candidate-number-limit . 9999) - (no-matchplugin)))) - (or (helm :sources src - :prompt prompt - :buffer "*helm locate read fname*" - :resume 'noresume) - (keyboard-quit)))) - -;;;###autoload -(defun helm-locate (arg) - "Preconfigured `helm' for Locate. -Note: you can add locate options after entering pattern. -See 'man locate' for valid options and also `helm-locate-command'. - -You can specify a local database with prefix argument ARG. -With two prefix arg, refresh the current local db or create it -if it doesn't exists. -Many databases can be used: navigate and mark them. -See also `helm-locate-with-db'. - -To create a user specific db, use -\"updatedb -l 0 -o db_path -U directory\". -Where db_path is a filename matched by -`helm-locate-db-file-regexp'." - (interactive "P") - (setq helm-ff-default-directory default-directory) - (helm-locate-1 arg)) - -(provide 'helm-locate) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-locate.el ends here diff --git a/elpa/helm-20150403.101/helm-man.el b/elpa/helm-20150403.101/helm-man.el deleted file mode 100644 index cdf7c2aa..00000000 --- a/elpa/helm-20150403.101/helm-man.el +++ /dev/null @@ -1,102 +0,0 @@ -;;; helm-man.el --- Man and woman UI -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) - -(declare-function woman-file-name-all-completions "woman.el" (topic)) -(declare-function Man-getpage-in-background "man.el" (topic)) -(declare-function helm-generic-sort-fn "helm-utils.el" (S1 S2)) - -(defgroup helm-man nil - "Man and Woman applications for helm." - :group 'helm) - -(defcustom helm-man-or-woman-function 'Man-getpage-in-background - "Default command to display a man page." - :group 'helm-man - :type '(radio :tag "Preferred command to display a man page" - (const :tag "Man" Man-getpage-in-background) - (const :tag "Woman" woman))) - -;; Internal -(defvar helm-man-pages nil - "All man pages on system. -Will be calculated the first time you invoke helm with this -source.") - -(defun helm-man-default-action (candidate) - "Default action for jumping to a woman or man page from helm." - (let ((wfiles (mapcar - 'car (woman-file-name-all-completions candidate)))) - (condition-case nil - (if (> (length wfiles) 1) - (let ((file (helm-comp-read - "ManFile: " wfiles :must-match t))) - (if (eq helm-man-or-woman-function 'Man-getpage-in-background) - (manual-entry (format "-l %s" file)) - (woman-find-file file))) - (funcall helm-man-or-woman-function candidate)) - ;; If woman is unable to format correctly - ;; use man instead. - (error (kill-buffer) ; Kill woman buffer. - (Man-getpage-in-background candidate))))) - -(defvar helm-source-man-pages - '((name . "Manual Pages") - (init . (lambda () - (require 'woman) - (require 'helm-utils) - (unless helm-man-pages - (setq helm-man-pages - (ignore-errors - (woman-file-name "" t) - (sort (mapcar 'car woman-topic-all-completions) - 'string-lessp)))) - (helm-init-candidates-in-buffer 'global helm-man-pages))) - (candidates-in-buffer) - (persistent-action . ignore) - (filtered-candidate-transformer - . (lambda (candidates _source) - (sort candidates #'helm-generic-sort-fn))) - (action . (("Display Man page" . helm-man-default-action))) - ;; Woman does not work OS X - ;; http://xahlee.org/emacs/modernization_man_page.html - (action-transformer . (lambda (actions candidate) - (if (eq system-type 'darwin) - '(("Display Man page" . man)) - actions))))) - -;;;###autoload -(defun helm-man-woman (arg) - "Preconfigured `helm' for Man and Woman pages. -With a prefix arg reinitialize the cache." - (interactive "P") - (when arg (setq helm-man-pages nil)) - (helm-other-buffer 'helm-source-man-pages "*Helm man woman*")) - -(provide 'helm-man) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-man.el ends here diff --git a/elpa/helm-20150403.101/helm-match-plugin.el b/elpa/helm-20150403.101/helm-match-plugin.el deleted file mode 100644 index c9226036..00000000 --- a/elpa/helm-20150403.101/helm-match-plugin.el +++ /dev/null @@ -1,368 +0,0 @@ -;;; helm-match-plugin.el --- Multiple regexp matching methods for helm -*- lexical-binding: t -*- - -;; Original Author: rubikitch - -;; Copyright (C) 2008 ~ 2011 rubikitch -;; Copyright (C) 2011 ~ 2015 Thierry Volpiatto - -;; Author: Thierry Volpiatto -;; URL: http://github.com/emacs-helm/helm - -;; 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 . - -;;; Code: - -(require 'helm) -(require 'cl-lib) - - -(defgroup helm-match-plugin nil - "Helm match plugin." - :group 'helm) - -(defcustom helm-mp-matching-method 'multi3 - "Matching method for helm match plugin. -You can set here different methods to match candidates in helm. -Here are the possible value of this symbol and their meaning: -- multi1: Respect order, prefix of pattern must match. -- multi2: Same but with partial match. -- multi3: The best, multiple regexp match, allow negation. -- multi3p: Same but prefix must match. -Default is multi3." - :type '(radio :tag "Matching methods for helm" - (const :tag "Multiple regexp 1 ordered with prefix match" multi1) - (const :tag "Multiple regexp 2 ordered with partial match" multi2) - (const :tag "Multiple regexp 3 matching no order, partial, best." multi3) - (const :tag "Multiple regexp 3p matching with prefix match" multi3p)) - :group 'helm-match-plugin) - - -;; Internal -(defconst helm-mp-default-match-functions - '(helm-mp-exact-match helm-mp-match)) -(defconst helm-mp-default-search-functions - '(helm-mp-exact-search helm-mp-search)) -(defconst helm-mp-default-search-backward-functions - '(helm-mp-exact-search-backward - helm-mp-search-backward)) - - -;;; Build regexps -;; -;; -(defvar helm-mp-space-regexp "[\\ ] " - "Regexp to represent space itself in multiple regexp match.") - -(defun helm-mp-split-pattern (pattern) - "Split PATTERN if it contain spaces and return resulting list. -If spaces in PATTERN are escaped, don't split at this place. -i.e \"foo bar\"=> (\"foo\" \"bar\") -but \"foo\ bar\"=> (\"foobar\")." - (if (string= pattern "") - '("") - (cl-loop for s in (split-string - (replace-regexp-in-string helm-mp-space-regexp - "\000\000" pattern) - " " t) - collect (replace-regexp-in-string "\000\000" " " s)))) - -(defun helm-mp-1-make-regexp (pattern) - "Replace spaces in PATTERN with \"\.*\"." - (mapconcat 'identity (helm-mp-split-pattern pattern) ".*")) - - -;;; Exact match. -;; -;; -;; Internal. -(defvar helm-mp-exact-pattern-str nil) -(defvar helm-mp-exact-pattern-real nil) - -(defun helm-mp-exact-get-pattern (pattern) - (unless (equal pattern helm-mp-exact-pattern-str) - (setq helm-mp-exact-pattern-str pattern - helm-mp-exact-pattern-real (concat "\n" pattern "\n"))) - helm-mp-exact-pattern-real) - - -(defun helm-mp-exact-match (str &optional pattern) - (string= str (or pattern helm-pattern))) - -(defun helm-mp-exact-search (pattern &rest _ignore) - (and (search-forward (helm-mp-exact-get-pattern pattern) nil t) - (forward-line -1))) - -(defun helm-mp-exact-search-backward (pattern &rest _ignore) - (and (search-backward (helm-mp-exact-get-pattern pattern) nil t) - (forward-line 1))) - - -;;; Prefix match -;; -;; -;; Internal -(defvar helm-mp-prefix-pattern-str nil) -(defvar helm-mp-prefix-pattern-real nil) - -(defun helm-mp-prefix-get-pattern (pattern) - (unless (equal pattern helm-mp-prefix-pattern-str) - (setq helm-mp-prefix-pattern-str pattern - helm-mp-prefix-pattern-real (concat "\n" pattern))) - helm-mp-prefix-pattern-real) - -(defun helm-mp-prefix-match (str &optional pattern) - (setq pattern (or pattern helm-pattern)) - (let ((len (length pattern))) - (and (<= len (length str)) - (string= (substring str 0 len) pattern )))) - -(defun helm-mp-prefix-search (pattern &rest _ignore) - (search-forward (helm-mp-prefix-get-pattern pattern) nil t)) - -(defun helm-mp-prefix-search-backward (pattern &rest _ignore) - (and (search-backward (helm-mp-prefix-get-pattern pattern) nil t) - (forward-line 1))) - - -;;; Multiple regexp patterns 1 (order is preserved / prefix). -;; -;; -;; Internal -(defvar helm-mp-1-pattern-str nil) -(defvar helm-mp-1-pattern-real nil) - -(defun helm-mp-1-get-pattern (pattern) - (unless (equal pattern helm-mp-1-pattern-str) - (setq helm-mp-1-pattern-str pattern - helm-mp-1-pattern-real - (concat "^" (helm-mp-1-make-regexp pattern)))) - helm-mp-1-pattern-real) - -(cl-defun helm-mp-1-match (str &optional (pattern helm-pattern)) - (string-match (helm-mp-1-get-pattern pattern) str)) - -(defun helm-mp-1-search (pattern &rest _ignore) - (re-search-forward (helm-mp-1-get-pattern pattern) nil t)) - -(defun helm-mp-1-search-backward (pattern &rest _ignore) - (re-search-backward (helm-mp-1-get-pattern pattern) nil t)) - - -;;; Multiple regexp patterns 2 (order is preserved / partial). -;; -;; -;; Internal -(defvar helm-mp-2-pattern-str nil) -(defvar helm-mp-2-pattern-real nil) - -(defun helm-mp-2-get-pattern (pattern) - (unless (equal pattern helm-mp-2-pattern-str) - (setq helm-mp-2-pattern-str pattern - helm-mp-2-pattern-real - (concat "^.*" (helm-mp-1-make-regexp pattern)))) - helm-mp-2-pattern-real) - -(cl-defun helm-mp-2-match (str &optional (pattern helm-pattern)) - (string-match (helm-mp-2-get-pattern pattern) str)) - -(defun helm-mp-2-search (pattern &rest _ignore) - (re-search-forward (helm-mp-2-get-pattern pattern) nil t)) - -(defun helm-mp-2-search-backward (pattern &rest _ignore) - (re-search-backward (helm-mp-2-get-pattern pattern) nil t)) - - -;;; Multiple regexp patterns 3 (permutation). -;; -;; -;; Internal -(defvar helm-mp-3-pattern-str nil) -(defvar helm-mp-3-pattern-list nil) - -(defun helm-mp-3-get-patterns (pattern) - "Return `helm-mp-3-pattern-list', a list of predicate/regexp cons cells. -e.g ((identity . \"foo\") (identity . \"bar\")). -This is done only if `helm-mp-3-pattern-str' is same as PATTERN." - (unless (equal pattern helm-mp-3-pattern-str) - (setq helm-mp-3-pattern-str pattern - helm-mp-3-pattern-list - (helm-mp-3-get-patterns-internal pattern))) - helm-mp-3-pattern-list) - -(defun helm-mp-3-get-patterns-internal (pattern) - "Return a list of predicate/regexp cons cells. -e.g ((identity . \"foo\") (identity . \"bar\"))." - (unless (string= pattern "") - (cl-loop for pat in (helm-mp-split-pattern pattern) - collect (if (string= "!" (substring pat 0 1)) - (cons 'not (substring pat 1)) - (cons 'identity pat))))) - -(cl-defun helm-mp-3-match (str &optional (pattern helm-pattern)) - "Check if PATTERN match STR. -When PATTERN contain a space, it is splitted and matching is done -with the several resulting regexps against STR. -e.g \"bar foo\" will match \"foobar\" and \"barfoo\". -Argument PATTERN, a string, is transformed in a list of -cons cell with `helm-mp-3-get-patterns' if it contain a space. -e.g \"foo bar\"=>((identity . \"foo\") (identity . \"bar\")). -Then each predicate of cons cell(s) is called with regexp of same -cons cell against STR (a candidate). -i.e (identity (string-match \"foo\" \"foo bar\")) => t." - (let ((pat (helm-mp-3-get-patterns pattern))) - (cl-loop for (predicate . regexp) in pat - always (funcall predicate - (condition-case _err - ;; FIXME: Probably do nothing when - ;; using fuzzy leaving the job - ;; to the fuzzy fn. - (string-match regexp str) - (invalid-regexp nil)))))) - -(defun helm-mp-3-search-base (pattern searchfn1 searchfn2) - "Try to find PATTERN in `helm-buffer' with SEARCHFN1 and SEARCHFN2. -This is the search function for `candidates-in-buffer' enabled sources. -Use the same method as `helm-mp-3-match' except it search in buffer -instead of matching on a string. -i.e (identity (re-search-forward \"foo\" (point-at-eol) t)) => t." - (cl-loop with pat = (if (stringp pattern) - (helm-mp-3-get-patterns pattern) - pattern) - when (eq (caar pat) 'not) return - ;; Pass the job to `helm-search-match-part'. - (prog1 (list (point-at-bol) (point-at-eol)) - (forward-line 1)) - while (condition-case _err - (funcall searchfn1 (or (cdar pat) "") nil t) - (invalid-regexp nil)) - for bol = (point-at-bol) - for eol = (point-at-eol) - if (cl-loop for (pred . str) in (cdr pat) always - (progn (goto-char bol) - (funcall pred (condition-case _err - (funcall searchfn2 str eol t) - (invalid-regexp nil))))) - do (goto-char eol) and return t - else do (goto-char eol) - finally return nil)) - -(defun helm-mp-3-search (pattern &rest _ignore) - (when (stringp pattern) - (setq pattern (helm-mp-3-get-patterns pattern))) - (helm-mp-3-search-base - pattern 're-search-forward 're-search-forward)) - -(defun helm-mp-3-search-backward (pattern &rest _ignore) - (when (stringp pattern) - (setq pattern (helm-mp-3-get-patterns pattern))) - (helm-mp-3-search-base - pattern 're-search-backward 're-search-backward)) - - -;;; mp-3p- (multiple regexp pattern 3 with prefix search) -;; -;; -(defun helm-mp-3p-match (str &optional pattern) - "Check if PATTERN match STR. -Same as `helm-mp-3-match' but more strict, matching against prefix also. -e.g \"bar foo\" will match \"barfoo\" but not \"foobar\" contrarily to -`helm-mp-3-match'." - (let* ((pat (helm-mp-3-get-patterns (or pattern helm-pattern))) - (first (car pat))) - (and (funcall (car first) (helm-mp-prefix-match str (cdr first))) - (cl-loop for (predicate . regexp) in (cdr pat) - always (funcall predicate (string-match regexp str)))))) - -(defun helm-mp-3p-search (pattern &rest _ignore) - (when (stringp pattern) - (setq pattern (helm-mp-3-get-patterns pattern))) - (helm-mp-3-search-base - pattern 'helm-mp-prefix-search 're-search-forward)) - -(defun helm-mp-3p-search-backward (pattern &rest _ignore) - (when (stringp pattern) - (setq pattern (helm-mp-3-get-patterns pattern))) - (helm-mp-3-search-base - pattern 'helm-mp-prefix-search-backward 're-search-backward)) - - -;;; Generic multi-match/search functions -;; -;; -(cl-defun helm-mp-match (str &optional (pattern helm-pattern)) - (let ((fun (cl-ecase helm-mp-matching-method - (multi1 #'helm-mp-1-match) - (multi2 #'helm-mp-2-match) - (multi3 #'helm-mp-3-match) - (multi3p #'helm-mp-3p-match)))) - (funcall fun str pattern))) - -(defun helm-mp-search (pattern &rest _ignore) - (let ((fun (cl-ecase helm-mp-matching-method - (multi1 #'helm-mp-1-search) - (multi2 #'helm-mp-2-search) - (multi3 #'helm-mp-3-search) - (multi3p #'helm-mp-3p-search)))) - (funcall fun pattern))) - -(defun helm-mp-search-backward (pattern &rest _ignore) - (let ((fun (cl-ecase helm-mp-matching-method - (multi1 #'helm-mp-1-search-backward) - (multi2 #'helm-mp-2-search-backward) - (multi3 #'helm-mp-3-search-backward) - (multi3p #'helm-mp-3p-search-backward)))) - (funcall fun pattern))) - - -;;; source compiler -;; This is used only in old sources defined without helm-source. -;; -(defun helm-compile-source--match-plugin (source) - (if (assoc 'no-matchplugin source) - source - (let* ((searchers helm-mp-default-search-functions) - (defmatch (helm-aif (assoc-default 'match source) - (helm-mklist it))) - (defmatch-strict (helm-aif (assoc-default 'match-strict source) - (helm-mklist it))) - (defsearch (helm-aif (assoc-default 'search source) - (helm-mklist it))) - (defsearch-strict (helm-aif (assoc-default 'search-strict source) - (helm-mklist it))) - (matchfns (cond (defmatch-strict) - (defmatch - (append helm-mp-default-match-functions defmatch)) - (t helm-mp-default-match-functions))) - (searchfns (cond (defsearch-strict) - (defsearch - (append searchers defsearch)) - (t searchers)))) - `(,(if (assoc 'candidates-in-buffer source) - `(search ,@searchfns) `(match ,@matchfns)) - ,@source)))) - - -;; Enable match-plugin by default in old sources. -(add-to-list 'helm-compile-source-functions 'helm-compile-source--match-plugin) - -(provide 'helm-match-plugin) - - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-match-plugin.el ends here diff --git a/elpa/helm-20150403.101/helm-misc.el b/elpa/helm-20150403.101/helm-misc.el deleted file mode 100644 index 5659c7ed..00000000 --- a/elpa/helm-20150403.101/helm-misc.el +++ /dev/null @@ -1,331 +0,0 @@ -;;; helm-misc.el --- Various functions for helm -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: -(require 'cl-lib) -(require 'helm) - - -(defgroup helm-misc nil - "Various Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-time-zone-home-location "Paris" - "The time zone of your home" - :group 'helm-misc - :type 'string) - -(defcustom helm-mini-default-sources '(helm-source-buffers-list - helm-source-recentf - helm-source-buffer-not-found) - "Default sources list used in `helm-mini'." - :group 'helm-misc - :type '(repeat (choice symbol))) - -(defface helm-time-zone-current - '((t (:foreground "green"))) - "Face used to colorize current time in `helm-world-time'." - :group 'helm-misc) - -(defface helm-time-zone-home - '((t (:foreground "red"))) - "Face used to colorize home time in `helm-world-time'." - :group 'helm-misc) - - -;;; Latex completion -(defvar LaTeX-math-menu) -(defun helm-latex-math-candidates () - "Collect candidates for latex math completion." - (cl-loop for i in (cddr LaTeX-math-menu) - for elm = (cl-loop for s in i when (vectorp s) - collect (cons (aref s 0) (aref s 1))) - append elm)) - -(defvar helm-source-latex-math - '((name . "Latex Math Menu") - (init . (lambda () - (with-helm-current-buffer - (LaTeX-math-mode 1)))) - (candidate-number-limit . 9999) - (candidates . helm-latex-math-candidates) - (action . (lambda (candidate) - (call-interactively candidate))))) - - -;;; Jabber Contacts (jabber.el) -(defun helm-jabber-online-contacts () - "List online Jabber contacts." - (with-no-warnings - (cl-loop for item in (jabber-concat-rosters) - when (get item 'connected) - collect - (if (get item 'name) - (cons (get item 'name) item) - (cons (symbol-name item) item))))) - -(defvar helm-source-jabber-contacts - '((name . "Jabber Contacts") - (init . (lambda () (require 'jabber))) - (candidates . (lambda () (mapcar 'car (helm-jabber-online-contacts)))) - (action . (lambda (x) - (jabber-chat-with - (jabber-read-account) - (symbol-name - (cdr (assoc x (helm-jabber-online-contacts))))))))) - -;;; World time -;; -(defun helm-time-zone-transformer (candidates _source) - (cl-loop for i in candidates - collect - (cond ((string-match (format-time-string "%H:%M" (current-time)) i) - (propertize i 'face 'helm-time-zone-current)) - ((string-match helm-time-zone-home-location i) - (propertize i 'face 'helm-time-zone-home)) - (t i)))) - -(defvar helm-source-time-world - '((name . "Time World List") - (init . (lambda () - (require 'time) - (let ((helm-buffer (helm-candidate-buffer 'global))) - (with-current-buffer helm-buffer - (display-time-world-display display-time-world-list))))) - (candidates-in-buffer) - (filtered-candidate-transformer . helm-time-zone-transformer))) - -;;; LaCarte -;; -;; -(declare-function lacarte-get-overall-menu-item-alist "ext:lacarte.el" (&optional MAPS)) - -(defun helm-lacarte-candidate-transformer (cands) - (mapcar (lambda (cand) - (let* ((item (car cand)) - (match (string-match "[^>] \\((.*)\\)$" item))) - (when match - (put-text-property (match-beginning 1) (match-end 1) - 'face 'helm-M-x-key item)) - cand)) - cands)) - -(defclass helm-lacarte (helm-source-sync helm-type-command) - ((init :initform (lambda () (require 'lacarte))) - (candidates :initform 'helm-lacarte-get-candidates) - (candidate-transformer :initform 'helm-lacarte-candidate-transformer) - (candidate-number-limit :initform 9999))) - -(defun helm-lacarte-get-candidates (&optional maps) - "Extract candidates for menubar using lacarte.el. -See http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el. -Optional argument MAPS is a list specifying which keymaps to use: it -can contain the symbols `local', `global', and `minor', mean the -current local map, current global map, and all current minor maps." - (with-helm-current-buffer - ;; FIXME: do we still need to remove possible '(nil) candidates. - (lacarte-get-overall-menu-item-alist maps))) - -;;;###autoload -(defun helm-browse-menubar () - "Helm interface to the menubar using lacarte.el." - (interactive) - (require 'lacarte) - (helm :sources (mapcar - (lambda (spec) (helm-make-source (car spec) 'helm-lacarte - :candidates (lambda () (helm-lacarte-get-candidates (cdr spec))))) - '(("Major Mode" . (local)) - ("Minor Modes" . (minor)) - ("Global Map" . (global)))) - :buffer "*helm lacarte*")) - -(defun helm-call-interactively (cmd-or-name) - "Execute CMD-OR-NAME as Emacs command. -It is added to `extended-command-history'. -`helm-current-prefix-arg' is used as the command's prefix argument." - (setq extended-command-history - (cons (helm-stringify cmd-or-name) - (delete (helm-stringify cmd-or-name) extended-command-history))) - (let ((current-prefix-arg helm-current-prefix-arg) - (cmd (helm-symbolify cmd-or-name))) - (if (stringp (symbol-function cmd)) - (execute-kbd-macro (symbol-function cmd)) - (setq this-command cmd) - (call-interactively cmd)))) - -;;; Minibuffer History -;; -;; -(defvar helm-source-minibuffer-history - '((name . "Minibuffer History") - (header-name . (lambda (name) - (format "%s (%s)" name minibuffer-history-variable))) - (candidates - . (lambda () - (let ((history (cl-loop for i in - (symbol-value minibuffer-history-variable) - unless (string= "" i) collect i))) - (if (consp (car history)) - (mapcar 'prin1-to-string history) - history)))) - (migemo) - (multiline) - (action . (lambda (candidate) - (delete-minibuffer-contents) - (insert candidate))))) - -;;; Shell history -;; -;; -(defun helm-comint-input-ring-action (candidate) - "Default action for comint history." - (with-helm-current-buffer - (delete-region (comint-line-beginning-position) (point-max)) - (insert candidate))) - -(defvar helm-source-comint-input-ring - '((name . "Comint history") - (candidates . (lambda () - (with-helm-current-buffer - (ring-elements comint-input-ring)))) - (action . helm-comint-input-ring-action)) - "Source that provide helm completion against `comint-input-ring'.") - - -;;; Helm ratpoison UI -;; -;; -(defvar helm-source-ratpoison-commands - '((name . "Ratpoison Commands") - (init . helm-ratpoison-commands-init) - (candidates-in-buffer) - (action ("Execute the command" . helm-ratpoison-commands-execute)) - (display-to-real . helm-ratpoison-commands-display-to-real) - (candidate-number-limit))) - -(defun helm-ratpoison-commands-init () - (unless (helm-candidate-buffer) - (with-current-buffer (helm-candidate-buffer 'global) - ;; with ratpoison prefix key - (save-excursion - (call-process "ratpoison" nil (current-buffer) nil "-c" "help")) - (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t) - (replace-match " \\1: \\2")) - (goto-char (point-max)) - ;; direct binding - (save-excursion - (call-process "ratpoison" nil (current-buffer) nil "-c" "help top")) - (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t) - (replace-match "\\1: \\2"))))) - -(defun helm-ratpoison-commands-display-to-real (display) - (and (string-match ": " display) - (substring display (match-end 0)))) - -(defun helm-ratpoison-commands-execute (candidate) - (call-process "ratpoison" nil nil nil "-ic" candidate)) - -;;; Helm stumpwm UI -;; -;; -(defvar helm-source-stumpwm-commands - '((name . "Stumpwm Commands") - (init . helm-stumpwm-commands-init) - (candidates-in-buffer) - (action ("Execute the command" . helm-stumpwm-commands-execute)) - (candidate-number-limit))) - -(defun helm-stumpwm-commands-init () - (with-current-buffer (helm-candidate-buffer 'global) - (save-excursion - (call-process "stumpish" nil (current-buffer) nil "commands")) - (while (re-search-forward "[ ]*\\([^ ]+\\)[ ]*\n?" nil t) - (replace-match "\n\\1\n")) - (delete-blank-lines) - (sort-lines nil (point-min) (point-max)) - (goto-char (point-max)))) - -(defun helm-stumpwm-commands-execute (candidate) - (call-process "stumpish" nil nil nil candidate)) - -;;;###autoload -(defun helm-world-time () - "Preconfigured `helm' to show world time." - (interactive) - (helm-other-buffer 'helm-source-time-world "*helm world time*")) - -;;;###autoload -(defun helm-insert-latex-math () - "Preconfigured helm for latex math symbols completion." - (interactive) - (helm-other-buffer 'helm-source-latex-math "*helm latex*")) - -;;;###autoload -(defun helm-ratpoison-commands () - "Preconfigured `helm' to execute ratpoison commands." - (interactive) - (helm-other-buffer 'helm-source-ratpoison-commands - "*helm ratpoison commands*")) - -;;;###autoload -(defun helm-stumpwm-commands() - (interactive) - (helm-other-buffer 'helm-source-stumpwm-commands - "*helm stumpwm commands*")) - - -;;;###autoload -(defun helm-mini () - "Preconfigured `helm' lightweight version \(buffer -> recentf\)." - (interactive) - (require 'helm-files) - (unless helm-source-buffers-list - (setq helm-source-buffers-list - (helm-make-source "Buffers" 'helm-source-buffers))) - (let ((helm-ff-transformer-show-only-basename nil)) - (helm :sources helm-mini-default-sources - :buffer "*helm mini*" - :truncate-lines t))) - -;;;###autoload -(defun helm-minibuffer-history () - "Preconfigured `helm' for `minibuffer-history'." - (interactive) - (let ((enable-recursive-minibuffers t)) - (helm-other-buffer 'helm-source-minibuffer-history - "*helm minibuffer-history*"))) - -;;;###autoload -(defun helm-comint-input-ring () - "Predefined `helm' that provide completion of `comint' history." - (interactive) - (when (derived-mode-p 'comint-mode) - (helm :sources 'helm-source-comint-input-ring - :input (buffer-substring-no-properties (comint-line-beginning-position) - (point-at-eol)) - :buffer "*helm comint history*"))) - - -(provide 'helm-misc) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-misc.el ends here diff --git a/elpa/helm-20150403.101/helm-mode.el b/elpa/helm-20150403.101/helm-mode.el deleted file mode 100644 index 992a360e..00000000 --- a/elpa/helm-20150403.101/helm-mode.el +++ /dev/null @@ -1,1096 +0,0 @@ -;;; helm-mode.el --- Enable helm completion everywhere. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-files) - - -(defgroup helm-mode nil - "Enable helm completion." - :group 'helm) - -(defcustom helm-completing-read-handlers-alist - '((describe-function . helm-completing-read-symbols) - (describe-variable . helm-completing-read-symbols) - (debug-on-entry . helm-completing-read-symbols) - (find-function . helm-completing-read-symbols) - (trace-function . helm-completing-read-symbols) - (trace-function-foreground . helm-completing-read-symbols) - (trace-function-background . helm-completing-read-symbols) - (find-tag . helm-completing-read-with-cands-in-buffer) - (ffap-alternate-file . nil) - (tmm-menubar . nil)) - "Alist of handlers to replace `completing-read', `read-file-name' in `helm-mode'. -Each entry is a cons cell like \(emacs_command . completing-read_handler\) -where key and value are symbols. - -Each key is an Emacs command that use originaly `completing-read'. - -Each value maybe an helm function that take same arguments as -`completing-read' plus NAME and BUFFER, where NAME is the name of the new -helm source and BUFFER the name of the buffer we will use. -This function prefix name must start by \"helm\". - -See `helm-completing-read-symbols' for example. - -Note that this function will be reused for ALL the `completing-read' -of this command, so it should handle all cases, e.g -If first `completing-read' complete against symbols and -second `completing-read' should handle only buffer, -your specialized function should handle the both. - -If the value of an entry is nil completion will fall back to -emacs vanilla behavior. -e.g If you want to disable helm completion for `describe-function': -\(describe-function . nil\). - -Ido is also supported, you can use `ido-completing-read' and -`ido-read-file-name' as value of an entry or just 'ido. -e.g ido completion for `find-file': -\(find-file . ido\) -same as -\(find-file . ido-read-file-name\) -Note that you don't need to enable `ido-mode' for this to work." - :group 'helm-mode - :type '(alist :key-type symbol :value-type symbol)) - -(defcustom helm-comp-read-case-fold-search helm-case-fold-search - "Default Local setting of `helm-case-fold-search' for `helm-comp-read'. -See `helm-case-fold-search' for more info." - :group 'helm-mode - :type 'symbol) - -(defcustom helm-mode-handle-completion-in-region t - "Whether to replace or not `completion-in-region-function'. -This enable support for `completing-read-multiple' and `completion-at-point' -when non--nil." - :group 'helm-mode - :type 'boolean) - -(defcustom helm-mode-reverse-history t - "Display history source after current source in `helm-mode' handled commands." - :group 'helm-mode - :type 'boolean) - -(defcustom helm-mode-no-completion-in-region-in-modes nil - "A list of modes that do not want helm for `completion-in-region'." - :group 'helm-mode - :type 'boolean) - -(defcustom helm-completion-in-region-fuzzy-match nil - "Whether `helm-completion-in-region' use fuzzy matching or not. -Affect among others `completion-at-point', `completing-read-multiple'." - :group 'helm-mode - :type 'boolean) - - -(defvar helm-comp-read-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "") 'helm-cr-empty-string) - (define-key map (kbd "") 'helm-cr-empty-string) - map) - "Keymap for `helm-comp-read'.") - - -;;; Internal -;; -;; -;; Flag to know if `helm-pattern' have been added -;; to candidate list in `helm-comp-read'. -(defvar helm-cr-unknown-pattern-flag nil) - - -;;; Helm `completing-read' replacement -;; -;; -(defun helm-cr-empty-string () - "Return empty string." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action - #'(lambda (_candidate) - (identity ""))))) - -(defun helm-mode--keyboard-quit () - ;; Use this instead of `keyboard-quit' - ;; to avoid deactivating mark in current-buffer. - (let ((debug-on-quit nil)) - (signal 'quit nil))) - -(defun helm-comp-read-get-candidates (collection &optional test sort-fn alistp) - "Convert COLLECTION to list removing elements that don't match TEST. -See `helm-comp-read' about supported COLLECTION arguments. - -SORT-FN is a predicate to sort COLLECTION. - -ALISTP when non--nil will not use `all-completions' to collect -candidates because it doesn't handle alists correctly for helm. -i.e In `all-completions' the car of each pair is used as value. -In helm we want to use the cdr instead like \(display . real\), -so we return the alist as it is with no transformation by all-completions. - -e.g - -\(setq A '((a . 1) (b . 2) (c . 3))) -==>((a . 1) (b . 2) (c . 3)) -\(helm-comp-read \"test: \" A :alistp nil - :exec-when-only-one t - :initial-input \"a\") -==>\"a\" Which is not what we expect. - -\(helm-comp-read \"test: \" A :alistp t - :exec-when-only-one t - :initial-input \"1\") -==>\"1\" - -See docstring of `all-completions' for more info. - -If COLLECTION is an `obarray', a TEST should be needed. See `obarray'." - - (let ((cands - (cond ((vectorp collection) - (all-completions "" collection test)) - ((and (symbolp collection) (boundp collection) - ;; Issue #324 history is let-bounded and given - ;; quoted as hist argument of completing-read. - ;; See example in `rcirc-browse-url'. - (symbolp (symbol-value collection))) - nil) - ;; When collection is a symbol, most of the time - ;; it should be a symbol used as a minibuffer-history. - ;; The value of this symbol in this case return a list - ;; of string which maybe are converted later as symbol - ;; in special cases. - ;; we treat here commandp as a special case as it return t - ;; also with a string unless its last arg is provided. - ;; Also, the history collections generally collect their - ;; elements as string, so intern them to call predicate. - ((and (symbolp collection) (boundp collection) test) - (let ((predicate `(lambda (elm) - (condition-case err - (if (eq (quote ,test) 'commandp) - (funcall (quote ,test) (intern elm)) - (funcall (quote ,test) elm)) - (wrong-type-argument - (funcall (quote ,test) (intern elm))))))) - (all-completions "" (symbol-value collection) predicate))) - ((and (symbolp collection) (boundp collection)) - (all-completions "" (symbol-value collection))) - ((and alistp test) - (cl-loop for i in collection when (funcall test i) collect i)) - (alistp collection) - (t (all-completions "" collection test))))) - (if sort-fn (sort cands sort-fn) cands))) - -(defun helm-cr-default-transformer (candidates _source) - "Default filter candidate function for `helm-comp-read'." - (cl-loop for c in candidates - for cand = (if (stringp c) (replace-regexp-in-string "\\s\\" "" c) c) - for pat = (replace-regexp-in-string "\\s\\" "" helm-pattern) - if (and (equal cand pat) helm-cr-unknown-pattern-flag) - collect - (cons (concat (propertize - " " 'display - (propertize "[?]" 'face 'helm-ff-prefix)) - c) - c) - into lst - else collect (if (and (stringp c) - (string-match "\n" c)) - (cons (replace-regexp-in-string "\n" "->" c) c) - c) - into lst - finally return (helm-fast-remove-dups lst :test 'equal))) - -(defun helm-comp-read--move-to-first-real-candidate () - (helm-aif (helm-get-selection nil 'withprop) - (when (string= (get-text-property 0 'display it) "[?]") - (helm-next-line)))) - -;;;###autoload -(cl-defun helm-comp-read (prompt collection - &key - test - initial-input - default - preselect - (buffer "*Helm Completions*") - must-match - fuzzy - reverse-history - (requires-pattern 0) - history - input-history - (case-fold helm-comp-read-case-fold-search) - (del-input t) - (persistent-action nil) - (persistent-help "DoNothing") - (mode-line helm-comp-read-mode-line) - (keymap helm-comp-read-map) - (name "Helm Completions") - candidates-in-buffer - exec-when-only-one - quit-when-no-cand - (volatile t) - sort - (fc-transformer 'helm-cr-default-transformer) - hist-fc-transformer - marked-candidates - nomark - (alistp t)) - "Read a string in the minibuffer, with helm completion. - -It is helm `completing-read' equivalent. - -- PROMPT is the prompt name to use. - -- COLLECTION can be a list, vector, obarray or hash-table. - It can be also a function that receives three arguments: - the values string, predicate and t. See `all-completions' for more details. - -Keys description: - -- TEST: A predicate called with one arg i.e candidate. - -- INITIAL-INPUT: Same as input arg in `helm'. - -- PRESELECT: See preselect arg of `helm'. - -- DEFAULT: This option is used only for compatibility with regular - Emacs `completing-read' (Same as DEFAULT arg of `completing-read'). - -- BUFFER: Name of helm-buffer. - -- MUST-MATCH: Candidate selected must be one of COLLECTION. - -- REVERSE-HISTORY: When non--nil display history source after current - source completion. - -- REQUIRES-PATTERN: Same as helm attribute, default is 0. - -- HISTORY: A list containing specific history, default is nil. - When it is non--nil, all elements of HISTORY are displayed in - a special source before COLLECTION. - -- INPUT-HISTORY: A symbol. the minibuffer input history will be - stored there, if nil or not provided, `minibuffer-history' - will be used instead. - -- CASE-FOLD: Same as `helm-case-fold-search'. - -- DEL-INPUT: Boolean, when non--nil (default) remove the partial - minibuffer input from HISTORY is present. - -- PERSISTENT-ACTION: A function called with one arg i.e candidate. - -- PERSISTENT-HELP: A string to document PERSISTENT-ACTION. - -- MODE-LINE: A string or list to display in mode line. - Default is `helm-comp-read-mode-line'. - -- KEYMAP: A keymap to use in this `helm-comp-read'. - (the keymap will be shared with history source) - -- NAME: The name related to this local source. - -- EXEC-WHEN-ONLY-ONE: Bound `helm-execute-action-at-once-if-one' - to non--nil. (possibles values are t or nil). - -- VOLATILE: Use volatile attribute \(enabled by default\). - -- SORT: A predicate to give to `sort' e.g `string-lessp'. - -- FC-TRANSFORMER: A `filtered-candidate-transformer' function. - -- HIST-FC-TRANSFORMER: A `filtered-candidate-transformer' - function for the history source. - -- MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list. - -- NOMARK: When non--nil don't allow marking candidates. - -- ALISTP: \(default is non--nil\) See `helm-comp-read-get-candidates'. - -- CANDIDATES-IN-BUFFER: when non--nil use a source build with - `helm-candidates-in-buffer' which is much faster. - Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil. - -Any prefix args passed during `helm-comp-read' invocation will be recorded -in `helm-current-prefix-arg', otherwise if prefix args were given before -`helm-comp-read' invocation, the value of `current-prefix-arg' will be used. -That's mean you can pass prefix args before or after calling a command -that use `helm-comp-read' See `helm-M-x' for example." - - (when (get-buffer helm-action-buffer) - (kill-buffer helm-action-buffer)) - (let ((action-fn `(("Sole action (Identity)" - . (lambda (candidate) - (if ,marked-candidates - (helm-marked-candidates) - (identity candidate))))))) - ;; Assume completion have been already required, - ;; so always use 'confirm. - (when (eq must-match 'confirm-after-completion) - (setq must-match 'confirm)) - (let* ((minibuffer-completion-confirm must-match) - (must-match-map (when must-match - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") - 'helm-confirm-and-exit-minibuffer) - map))) - (loc-map (if must-match-map - (make-composed-keymap - must-match-map (or keymap helm-map)) - (or keymap helm-map))) - (minibuffer-completion-predicate test) - (minibuffer-completion-table collection) - (helm-read-file-name-mode-line-string - (replace-regexp-in-string "helm-maybe-exit-minibuffer" - "helm-confirm-and-exit-minibuffer" - helm-read-file-name-mode-line-string)) - (get-candidates (lambda () - (let ((cands (helm-comp-read-get-candidates - collection test sort alistp))) - (setq helm-cr-unknown-pattern-flag nil) - (unless (or (eq must-match t) - (string= helm-pattern "") - (assoc helm-pattern cands) - (assoc (intern helm-pattern) cands) - (member helm-pattern cands)) - (setq cands (append (list - ;; Unquote helm-pattern - ;; when it is added - ;; as candidate. - (replace-regexp-in-string - "\\s\\" "" helm-pattern)) - cands)) - (setq helm-cr-unknown-pattern-flag t)) - (if (and default (not (string= default ""))) - (delq nil (cons default (delete default cands))) - cands)))) - (history-get-candidates (lambda () - (let ((all (helm-comp-read-get-candidates - history test nil alistp))) - (when all - (delete - "" - (helm-fast-remove-dups - (if (and default (not (string= default ""))) - (delq nil (cons default - (delete default all))) - all) - :test 'equal)))))) - (src-hist (helm-build-sync-source (format "%s History" name) - :candidates history-get-candidates - :fuzzy-match fuzzy - :filtered-candidate-transformer - (append '((lambda (candidates sources) - (cl-loop for i in candidates - ;; Input is added to history in completing-read's - ;; and may be regexp-quoted, so unquote it. - for cand = (replace-regexp-in-string "\\s\\" "" i) - collect cand))) - (and hist-fc-transformer (helm-mklist hist-fc-transformer))) - :persistent-action persistent-action - :persistent-help persistent-help - :mode-line mode-line - :action action-fn)) - (src (helm-build-sync-source name - :candidates get-candidates - :filtered-candidate-transformer fc-transformer - :requires-pattern requires-pattern - :persistent-action persistent-action - :persistent-help persistent-help - :fuzzy-match fuzzy - :mode-line mode-line - :action action-fn)) - (src-1 (helm-build-in-buffer-source name - :data get-candidates - :filtered-candidate-transformer fc-transformer - :requires-pattern requires-pattern - :persistent-action persistent-action - :fuzzy-match fuzzy - :persistent-help persistent-help - :mode-line mode-line - :action action-fn)) - (src-list (list src-hist - (if candidates-in-buffer - src-1 - (if volatile - (append src '((volatile))) - src)))) - (helm-execute-action-at-once-if-one exec-when-only-one) - (helm-quit-if-no-candidate quit-when-no-cand) - result) - (when nomark - (setq src-list (cl-loop for src in src-list - collect (cons '(nomark) src)))) - (when reverse-history (setq src-list (nreverse src-list))) - (add-hook 'helm-after-update-hook 'helm-comp-read--move-to-first-real-candidate) - (unwind-protect - (setq result (helm - :sources src-list - :input initial-input - :default default - :preselect preselect - :prompt prompt - :resume 'noresume - :case-fold-search case-fold - :keymap loc-map - :history (and (symbolp input-history) input-history) - :buffer buffer)) - (remove-hook 'helm-after-update-hook 'helm-comp-read--move-to-first-real-candidate)) - ;; Avoid adding an incomplete input to history. - (when (and result history del-input) - (cond ((and (symbolp history) ; History is a symbol. - (not (symbolp (symbol-value history)))) ; Fix Issue #324. - ;; Be sure history is not a symbol with a nil value. - (helm-aif (symbol-value history) (setcar it result))) - ((consp history) ; A list with a non--nil value. - (setcar history result)) - (t ; Possibly a symbol with a nil value. - (set history (list result))))) - (or - result - (when (and (eq helm-exit-status 0) - (eq must-match 'confirm)) - ;; Return empty string only if it is the DEFAULT - ;; value and helm-pattern is empty. - ;; otherwise return helm-pattern - (if (and (string= helm-pattern "") default) - default (identity helm-pattern))) - (unless (or (eq helm-exit-status 1) - must-match) ; FIXME this should not be needed now. - default) - (helm-mode--keyboard-quit))))) - -;; Generic completing-read -;; -;; Support also function as collection. -;; e.g M-x man is supported. -;; Support hash-table and vectors as collection. -;; NOTE: -;; Some crap emacs functions may not be supported -;; like ffap-alternate-file (bad use of completing-read) -;; and maybe others. -;; Provide a mode `helm-mode' which turn on -;; helm in all `completing-read' and `read-file-name' in Emacs. -;; -(defvar helm-completion-mode-string " Helm") - -(defvar helm-completion-mode-quit-message - "Helm completion disabled") - -(defvar helm-completion-mode-start-message - "Helm completion enabled") - -;;; Specialized handlers -;; -;; -(defun helm-completing-read-symbols - (prompt _collection test _require-match init - hist default _inherit-input-method name buffer) - "Specialized function for fast symbols completion in `helm-mode'." - (or - (helm - :sources (helm-build-in-buffer-source name - :init (lambda () - (require 'helm-elisp) - (helm-apropos-init (lambda (x) - (and (funcall test x) - (not (keywordp x)))) - default)) - :filtered-candidate-transformer 'helm-apropos-default-sort-fn - :persistent-action 'helm-lisp-completion-persistent-action - :persistent-help "Show brief doc in mode-line") - :prompt prompt - :buffer buffer - :input init - :history hist - :resume 'noresume - :default (or default "")) - (helm-mode--keyboard-quit))) - - -;;; Generic completing read -;; -;; -(defun helm-completing-read-default-1 - (prompt collection test require-match - init hist default _inherit-input-method - name buffer &optional cands-in-buffer exec-when-only-one) - "Call `helm-comp-read' with same args as `completing-read'. -Extra optional arg CANDS-IN-BUFFER mean use `candidates-in-buffer' -method which is faster. -It should be used when candidate list don't need to rebuild dynamically." - (let ((history (or (car-safe hist) hist))) - (when (and default (listp default)) - ;; When DEFAULT is a list move the list on head of COLLECTION - ;; and set it to its car. #bugfix `grep-read-files'. - (setq collection (if (listp collection) - (append default collection) - ;; Else COLLECTION is maybe a function or a table. - (append default (all-completions "" collection)))) - (setq default (car default))) - (helm-comp-read - prompt collection - :test test - :history history - :reverse-history helm-mode-reverse-history - :input-history history - :must-match require-match - :alistp nil ; Be sure `all-completions' is used. - :name name - :requires-pattern (if (and (string= default "") - (or (eq require-match 'confirm) - (eq require-match - 'confirm-after-completion))) - 1 0) - :candidates-in-buffer cands-in-buffer - :exec-when-only-one exec-when-only-one - :buffer buffer - ;; If DEF is not provided, fallback to empty string - ;; to avoid `thing-at-point' to be appended on top of list - :default (or default "") - ;; Fail with special characters (e.g in gnus "nnimap+gmail:") - ;; if regexp-quote is not used. - ;; when init is added to history, it will be unquoted by - ; helm-comp-read. - :initial-input (and (stringp init) (regexp-quote init))))) - -(defun helm-completing-read-with-cands-in-buffer - (prompt collection test require-match - init hist default inherit-input-method - name buffer) - "Same as `helm-completing-read-default-1' but use candidates-in-buffer." - ;; Some commands like find-tag may use `read-file-name' from inside - ;; the calculation of collection. in this case it clash with - ;; candidates-in-buffer that reuse precedent data (files) which is wrong. - ;; So (re)calculate collection outside of main helm-session. - (let ((cands (all-completions "" collection))) - (helm-completing-read-default-1 prompt cands test require-match - init hist default inherit-input-method - name buffer t))) - -(cl-defun helm--completing-read-default - (prompt collection &optional - predicate require-match - initial-input hist def - inherit-input-method) - "An helm replacement of `completing-read'. -This function should be used only as a `completing-read-function'. - -Don't use it directly, use instead `helm-comp-read' in your programs. - -See documentation of `completing-read' and `all-completions' for details." - (let* ((current-command (or (helm-this-command) this-command)) - (str-command (helm-symbol-name current-command)) - (buf-name (format "*helm-mode-%s*" str-command)) - (entry (assq current-command - helm-completing-read-handlers-alist)) - (def-com (cdr-safe entry)) - (str-defcom (and def-com (symbol-name def-com))) - (def-args (list prompt collection predicate require-match - initial-input hist def inherit-input-method)) - ;; Append the two extra args needed to set the buffer and source name - ;; in helm specialized functions. - (any-args (append def-args (list str-command buf-name))) - helm-completion-mode-start-message ; Be quiet - helm-completion-mode-quit-message - ;; Be sure this pesty *completion* buffer doesn't popup. - ;; Note: `minibuffer-with-setup-hook' may setup a lambda - ;; calling `minibuffer-completion-help' or other minibuffer - ;; functions we DONT WANT here, in these cases removing the hook - ;; (a symbol) have no effect. Issue #448. - ;; But because `minibuffer-completion-table' and - ;; `minibuffer-completion-predicate' are not bound - ;; anymore here, these functions should have no effect now. - (minibuffer-setup-hook (remove 'minibuffer-completion-help - minibuffer-setup-hook)) - ;; Disable hack that could be used before `completing-read'. - ;; i.e (push ?\t unread-command-events). - unread-command-events) - (when (eq def-com 'ido) (setq def-com 'ido-completing-read)) - (unless (or (not entry) def-com) - ;; An entry in *read-handlers-alist exists but have - ;; a nil value, so we exit from here, disable `helm-mode' - ;; and run the command again with it original behavior. - ;; `helm-mode' will be restored on exit. - (cl-return-from helm--completing-read-default - (unwind-protect - (progn - (helm-mode -1) - (apply completing-read-function def-args)) - (helm-mode 1)))) - ;; If we use now `completing-read' we MUST turn off `helm-mode' - ;; to avoid infinite recursion and CRASH. It will be reenabled on exit. - (when (or (eq def-com 'completing-read) - ;; All specialized functions are prefixed by "helm" - (and (stringp str-defcom) - (not (string-match "^helm" str-defcom)))) - (helm-mode -1)) - (unwind-protect - (cond (;; An helm specialized function exists, run it. - (and def-com helm-mode) - (apply def-com any-args)) - (;; Try to handle `ido-completing-read' everywhere. - (and def-com (eq def-com 'ido-completing-read)) - (setcar (memq collection def-args) - (all-completions "" collection predicate)) - (apply def-com def-args)) - (;; User set explicitely `completing-read' or something similar - ;; in *read-handlers-alist, use this with exactly the same - ;; args as in `completing-read'. - ;; If we are here `helm-mode' is now disabled. - def-com - (apply def-com def-args)) - (t ; Fall back to classic `helm-comp-read'. - (helm-completing-read-default-1 - prompt collection predicate require-match - initial-input hist def inherit-input-method - str-command buf-name))) - (helm-mode 1) - ;; When exiting minibuffer, `this-command' is set to - ;; `helm-exit-minibuffer', which is unwanted when starting - ;; on another `completing-read', so restore `this-command' to - ;; initial value when exiting. - (setq this-command current-command)))) - -;;; Generic read-file-name -;; -;; -(cl-defun helm-read-file-name - (prompt - &key - (name "Read File Name") - (initial-input (expand-file-name default-directory)) - (buffer "*Helm file completions*") - test - (case-fold helm-file-name-case-fold-search) - preselect - history - must-match - default - marked-candidates - nomark - (alistp t) - (persistent-action 'helm-find-files-persistent-action) - (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file") - (mode-line helm-read-file-name-mode-line-string)) - "Read a file name with helm completion. -It is helm `read-file-name' emulation. - -Argument PROMPT is the default prompt to use. - -Keys description: - -- NAME: Source name, default to \"Read File Name\". - -- INITIAL-INPUT: Where to start read file name, default to `default-directory'. - -- BUFFER: `helm-buffer' name default to \"*Helm Completions*\". - -- TEST: A predicate called with one arg 'candidate'. - -- CASE-FOLD: Same as `helm-case-fold-search'. - -- PRESELECT: helm preselection. - -- HISTORY: Display HISTORY in a special source. - -- MUST-MATCH: Can be 'confirm, nil, or t. - -- MARKED-CANDIDATES: When non--nil return a list of marked candidates. - -- NOMARK: When non--nil don't allow marking candidates. - -- ALISTP: Don't use `all-completions' in history (take effect only on history). - -- PERSISTENT-ACTION: a persistent action function. - -- PERSISTENT-HELP: persistent help message. - -- MODE-LINE: A mode line message, default is `helm-read-file-name-mode-line-string'." - - (when (get-buffer helm-action-buffer) - (kill-buffer helm-action-buffer)) - ;; Assume completion have been already required, - ;; so always use 'confirm. - (when (eq must-match 'confirm-after-completion) - (setq must-match 'confirm)) - (let* ((action-fn `(("Sole action (Identity)" - . (lambda (candidate) - (if ,marked-candidates - (helm-marked-candidates :with-wildcard t) - (identity candidate)))))) - ;; Be sure we don't erase the underlying minibuffer if some. - (helm-ff-auto-update-initial-value - (and helm-ff-auto-update-initial-value - (not (minibuffer-window-active-p (minibuffer-window))))) - helm-full-frame - (hist (and history (helm-comp-read-get-candidates - history nil nil alistp))) - (minibuffer-completion-confirm must-match) - (must-match-map (when must-match - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") - 'helm-confirm-and-exit-minibuffer) - map))) - (cmap (if must-match-map - (make-composed-keymap - must-match-map helm-read-file-map) - helm-read-file-map)) - (minibuffer-completion-predicate test) - (minibuffer-completing-file-name t) - (helm-read-file-name-mode-line-string - (replace-regexp-in-string "helm-maybe-exit-minibuffer" - "helm-confirm-and-exit-minibuffer" - helm-read-file-name-mode-line-string)) - (src-list - (list - ;; History source. - (helm-build-sync-source (format "%s History" name) - :header-name (lambda (hname) - (concat hname helm-find-files-doc-header)) - :mode-line mode-line - :candidates hist - :nohighlight t - :persistent-action persistent-action - :persistent-help persistent-help - :nomark nomark - :action action-fn) - ;; Other source. - (helm-build-sync-source name - :header-name (lambda (hname) - (concat hname helm-find-files-doc-header)) - :init (lambda () - (setq helm-ff-auto-update-flag - helm-ff-auto-update-initial-value) - (setq helm-ff--auto-update-state - helm-ff-auto-update-flag)) - :mode-line mode-line - :nohighlight t - :candidates - (lambda () - (append (and (not (file-exists-p helm-pattern)) - (list helm-pattern)) - (if test - (cl-loop with hn = (helm-ff-tramp-hostnames) - for i in (helm-find-files-get-candidates - must-match) - when (or (member i hn) ; A tramp host - (funcall test i)) ; Test ok - collect i) - (helm-find-files-get-candidates must-match)))) - :filtered-candidate-transformer 'helm-ff-sort-candidates - :filter-one-by-one 'helm-ff-filter-candidate-one-by-one - :persistent-action persistent-action - :candidate-number-limit 9999 - :persistent-help persistent-help - :volatile t - :nomark nomark - :action action-fn))) - ;; Helm result. - (result (helm - :sources src-list - :input initial-input - :prompt prompt - :keymap cmap - :resume 'noresume - :case-fold-search case-fold - :default default - :buffer buffer - :preselect preselect))) - (or - (cond ((and result (stringp result) - (string= result "") "")) - ((and result - (stringp result) - (file-equal-p result initial-input) - default) - (if (listp default) (car default) default)) - ((and result (stringp result)) - (expand-file-name result)) - ((and result (listp result)) - (mapcar #'expand-file-name result)) - (t result)) - (when (and (not (string= helm-pattern "")) - (eq helm-exit-status 0) - (eq must-match 'confirm)) - (identity helm-pattern)) - (helm-mode--keyboard-quit)))) - -(defun helm-mode--default-filename (fname dir initial) - (unless dir (setq dir default-directory)) - (unless (file-name-absolute-p dir) - (setq dir (expand-file-name dir))) - (unless (or fname (consp fname)) - (setq fname (expand-file-name - (or initial buffer-file-name dir) - dir))) - (if (and fname (consp fname)) - (setq fname (cl-loop for f in fname - collect (expand-file-name f dir))) - (if (file-name-absolute-p fname) - fname (expand-file-name fname dir)))) - -(cl-defun helm--generic-read-file-name - (prompt &optional dir default-filename mustmatch initial predicate) - "Generic helm replacement of `read-file-name'. -Don't use it directly, use instead `helm-read-file-name' in your programs." - (let* ((init (or initial dir default-directory)) - (current-command (or (helm-this-command) this-command)) - (str-command (helm-symbol-name current-command)) - (helm--file-completion-sources - (cons str-command - (remove str-command helm--file-completion-sources))) - (buf-name (format "*helm-mode-%s*" str-command)) - (entry (assq current-command - helm-completing-read-handlers-alist)) - (def-com (cdr-safe entry)) - (str-defcom (and def-com (symbol-name def-com))) - (def-args (list prompt dir default-filename mustmatch initial predicate)) - ;; Append the two extra args needed to set the buffer and source name - ;; in helm specialized functions. - (any-args (append def-args (list str-command buf-name))) - (ido-state ido-mode) - helm-completion-mode-start-message ; Be quiet - helm-completion-mode-quit-message ; Same here - fname) - (setq default-filename (helm-mode--default-filename - default-filename dir initial)) - ;; Some functions that normally call `completing-read' can switch - ;; brutally to `read-file-name' (e.g find-tag), in this case - ;; the helm specialized function will fail because it is build - ;; for `completing-read', so set it to 'incompatible to be sure - ;; we switch to `helm-read-file-name' and don't try to call it - ;; with wrong number of args. - (when (eq def-com 'ido) - (setq def-com 'ido-read-file-name) (ido-mode 1)) - (when (and def-com (> (length (help-function-arglist def-com)) 8)) - (setq def-com 'incompatible)) - (unless (or (not entry) def-com) - (cl-return-from helm--generic-read-file-name - (unwind-protect - (progn - (helm-mode -1) - (apply read-file-name-function def-args)) - (helm-mode 1)))) - ;; If we use now `read-file-name' we MUST turn off `helm-mode' - ;; to avoid infinite recursion and CRASH. It will be reenabled on exit. - (when (or (eq def-com 'read-file-name) - (eq def-com 'ido-read-file-name) - (and (stringp str-defcom) - (not (string-match "^helm" str-defcom)))) - (helm-mode -1)) - (unwind-protect - (setq fname - (cond (;; A specialized function exists, run it - ;; with the two extra args specific to helm.. - (and def-com helm-mode - (not (eq def-com 'ido-read-file-name)) - (not (eq def-com 'incompatible))) - (apply def-com any-args)) - (;; Def-com value is `ido-read-file-name' - ;; run it with default args. - (and def-com (eq def-com 'ido-read-file-name)) - (ido-mode 1) - (apply def-com def-args)) - (;; Def-com value is `read-file-name' - ;; run it with default args. - (eq def-com 'read-file-name) - (apply def-com def-args)) - (t ; Fall back to classic `helm-read-file-name'. - (helm-read-file-name - prompt - :name str-command - :buffer buf-name - :default default-filename - :initial-input (expand-file-name init dir) - :alistp nil - :must-match mustmatch - :test predicate)))) - (helm-mode 1) - (ido-mode (if ido-state 1 -1)) - ;; Same comment as in `helm--completing-read-default'. - (setq this-command current-command)) - fname)) - -(defun helm-mode--advice-lisp--local-variables (old--fn &rest args) - (ignore-errors - (apply old--fn args))) - -(defun helm--completion-in-region (start end collection &optional predicate) - "[EXPERIMENTAL] Helm replacement of `completion--in-region'. -Can be used as value for `completion-in-region-function'." - (cl-declare (special require-match prompt)) - (if (memq major-mode helm-mode-no-completion-in-region-in-modes) - (funcall helm--old-completion-in-region-function - start end collection predicate) - (advice-add - 'lisp--local-variables - :around #'helm-mode--advice-lisp--local-variables) - (unwind-protect - (let* ((enable-recursive-minibuffers t) - (input (buffer-substring-no-properties start end)) - (current-command (or (helm-this-command) this-command)) - (str-command (symbol-name current-command)) - (buf-name (format "*helm-mode-%s*" str-command)) - (require-match (or (and (boundp 'require-match) require-match) - minibuffer-completion-confirm - ;; If prompt have not been propagated here, that's - ;; probably mean we have no prompt and we are in - ;; completion-at-point or friend, so use a non--nil - ;; value for require-match. - (not (boundp 'prompt)))) - ;; `completion-extra-properties' is let-bounded in `completion-at-point'. - ;; `afun' is a closure to call against each string in `data'. - ;; it provide the annotation info for each string. - ;; e.g "foo" => "foo " where foo is a function. - ;; See Issue #407. - (afun (plist-get completion-extra-properties :annotation-function)) - (data (all-completions input collection predicate)) - (init-space-suffix (unless helm-completion-in-region-fuzzy-match " ")) - ;; Assume that when `afun' and `predicate' are null - ;; we are in filename completion. - (file-comp-p (or (helm-mode--in-file-completion-p) - (and (null afun) (null predicate)))) - ;; Completion-at-point and friends have no prompt. - (result (if (stringp data) - data - (helm-comp-read - (or (and (boundp 'prompt) prompt) "Pattern: ") - (if file-comp-p - (cl-loop for f in data unless - (string-match "\\`\\.\\{1,2\\}/\\'" f) - collect f) - (if afun - (mapcar (lambda (s) - (let ((ann (funcall afun s))) - (if ann - (cons - (concat - s - (propertize - " " 'display - (propertize - ann - 'face 'completions-annotations))) - s) - s))) - data) - data)) - :name str-command - :fuzzy helm-completion-in-region-fuzzy-match - :nomark t - :initial-input - (cond ((and file-comp-p - (not (string-match "/\\'" input))) - (concat (helm-basename input) - (unless (string= input "") - init-space-suffix))) - ((string-match "/\\'" input) nil) - ((or (null require-match) - (stringp require-match)) - input) - (t (concat input init-space-suffix))) - :buffer buf-name - :fc-transformer (append (list 'helm-cr-default-transformer) - (list (lambda (candidates _source) - (sort candidates 'helm-generic-sort-fn)))) - :exec-when-only-one t - :quit-when-no-cand - #'(lambda () - ;; Delay message to overwrite "Quit". - (run-with-timer - 0.01 nil - #'(lambda () - (message "[No matches]"))) - t) ; exit minibuffer immediately. - :must-match require-match)))) - (when result - (delete-region (if (and file-comp-p - (save-excursion - (re-search-backward "~?/" start t))) - (match-end 0) start) - end) - (insert result))) - (advice-remove 'lisp--local-variables - #'helm-mode--advice-lisp--local-variables)))) - -(defun helm-mode--in-file-completion-p () - (with-helm-current-buffer - (run-hook-with-args-until-success 'file-name-at-point-functions))) - -(when (boundp 'completion-in-region-function) - (defconst helm--old-completion-in-region-function completion-in-region-function)) - -;;;###autoload -(define-minor-mode helm-mode - "Toggle generic helm completion. - -All functions in Emacs that use `completing-read' -or `read-file-name' and friends will use helm interface -when this mode is turned on. -However you can modify this behavior for functions of your choice -with `helm-completing-read-handlers-alist'. - -Called with a positive arg, turn on unconditionally, with a -negative arg turn off. -You can turn it on with `helm-mode'. - -Some crap emacs functions may not be supported, -e.g `ffap-alternate-file' and maybe others -You can add such functions to `helm-completing-read-handlers-alist' -with a nil value. - -Note: This mode is incompatible with Emacs23." - :group 'helm-mode - :global t - :lighter helm-completion-mode-string - (cl-assert (boundp 'completing-read-function) nil - "`helm-mode' not available, upgrade to Emacs-24") - (if helm-mode - (progn - (setq completing-read-function 'helm--completing-read-default - read-file-name-function 'helm--generic-read-file-name) - (when (and (boundp 'completion-in-region-function) - helm-mode-handle-completion-in-region) - (setq completion-in-region-function #'helm--completion-in-region)) - (message helm-completion-mode-start-message)) - (setq completing-read-function (and (fboundp 'completing-read-default) - 'completing-read-default) - read-file-name-function (and (fboundp 'read-file-name-default) - 'read-file-name-default)) - (when (and (boundp 'completion-in-region-function) - (boundp 'helm--old-completion-in-region-function)) - (setq completion-in-region-function helm--old-completion-in-region-function)) - (message helm-completion-mode-quit-message))) - -(provide 'helm-mode) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-mode.el ends here diff --git a/elpa/helm-20150403.101/helm-net.el b/elpa/helm-20150403.101/helm-net.el deleted file mode 100644 index 702a3aa6..00000000 --- a/elpa/helm-20150403.101/helm-net.el +++ /dev/null @@ -1,607 +0,0 @@ -;;; helm-net.el --- helm browse url and search web. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'url) -(require 'xml) -(require 'browse-url) - - -(defgroup helm-net nil - "Net related applications and libraries for Helm." - :group 'helm) - -(defcustom helm-google-suggest-default-browser-function nil - "The browse url function you prefer to use with google suggest. -When nil, use the first browser function available -See `helm-browse-url-default-browser-alist'." - :group 'helm-net - :type 'symbol) - -(defcustom helm-home-url "http://www.google.fr" - "Default url to use as home url." - :group 'helm-net - :type 'string) - -(defcustom helm-surfraw-default-browser-function nil - "The browse url function you prefer to use with surfraw. -When nil, fallback to `browse-url-browser-function'." - :group 'helm-net - :type 'symbol) - -(defcustom helm-google-suggest-url - "http://google.com/complete/search?output=toolbar&q=" - "URL used for looking up Google suggestions." - :type 'string - :group 'helm-net) - -(defcustom helm-google-suggest-search-url - "http://www.google.com/search?ie=utf-8&oe=utf-8&q=%s" - "URL used for Google searching." - :type 'string - :group 'helm-net) - -(defcustom helm-google-suggest-use-curl-p nil - "When non--nil use CURL to get info from `helm-google-suggest-url'. -Otherwise `url-retrieve-synchronously' is used." - :type 'boolean - :group 'helm-net) - -(defcustom helm-yahoo-suggest-url - "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=Generic&query=" - "Url used for looking up Yahoo suggestions." - :type 'string - :group 'helm-net) - -(defcustom helm-yahoo-suggest-search-url - "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p=%s" - "Url used for Yahoo searching." - :type 'string - :group 'helm-net) - -(defcustom helm-surfraw-duckduckgo-url - "https://duckduckgo.com/lite/?q=%s&kp=1" - "The duckduckgo url. -This is a format string, don't forget the `%s'. -If you have personal settings saved on duckduckgo you should have -a personal url, see your settings on duckduckgo." - :type 'string - :group 'helm-net) - -(defcustom helm-wikipedia-suggest-url - "http://en.wikipedia.org/w/api.php?action=opensearch&search=" - "Url used for looking up Wikipedia suggestions." - :type 'string - :group 'helm-net) - -(defcustom helm-search-suggest-action-wikipedia-url - "https://en.wikipedia.org/wiki/Special:Search?search=%s" - "The Wikipedia search url. -This is a format string, don't forget the `%s'." - :type 'string - :group 'helm-net) - -(defcustom helm-wikipedia-summary-url - "http://en.wikipedia.org/w/api.php?action=parse&format=json&prop=text§ion=0&page=" - "URL for getting the summary of a Wikipedia topic." - :type 'string - :group 'helm-net) - -(defcustom helm-wikipedia-follow-delay 2 - "Delay before wikipedia summary popup." - :type 'number - :group 'helm-net) - -(defcustom helm-search-suggest-action-youtube-url - "http://www.youtube.com/results?aq=f&search_query=%s" - "The Youtube search url. -This is a format string, don't forget the `%s'." - :type 'string - :group 'helm-net) - -(defcustom helm-search-suggest-action-imdb-url - "http://www.imdb.com/find?s=all&q=%s" - "The IMDb search url. -This is a format string, don't forget the `%s'." - :type 'string - :group 'helm-net) - -(defcustom helm-search-suggest-action-google-maps-url - "http://maps.google.com/maps?f=q&source=s_q&q=%s" - "The Google Maps search url. -This is a format string, don't forget the `%s'." - :type 'string - :group 'helm-net) - -(defcustom helm-search-suggest-action-google-news-url - "http://www.google.com/search?safe=off&prmd=nvlifd&source=lnms&tbs=nws:1&q=%s" - "The Google News search url. -This is a format string, don't forget the `%s'." - :type 'string - :group 'helm-net) - - -;;; Additional actions for search suggestions -;; -;; -;; Internal - -(defun helm-search-suggest-perform-additional-action (url query) - "Perform the search via URL using QUERY as input." - (browse-url (format url (url-hexify-string query)))) - -(defvar helm-search-suggest-additional-actions - '(("Wikipedia" . (lambda (candidate) - (helm-search-suggest-perform-additional-action - helm-search-suggest-action-wikipedia-url - candidate))) - ("Youtube" . (lambda (candidate) - (helm-search-suggest-perform-additional-action - helm-search-suggest-action-youtube-url - candidate))) - ("IMDb" . (lambda (candidate) - (helm-search-suggest-perform-additional-action - helm-search-suggest-action-imdb-url - candidate))) - ("Google Maps" . (lambda (candidate) - (helm-search-suggest-perform-additional-action - helm-search-suggest-action-google-maps-url - candidate))) - ("Google News" . (lambda (candidate) - (helm-search-suggest-perform-additional-action - helm-search-suggest-action-google-news-url - candidate)))) - "List of additional actions for suggest sources.") - - -;;; Google Suggestions -;; -;; -;; Internal -(defvar helm-ggs-max-length-real-flag 0) -(defvar helm-ggs-max-length-num-flag 0) - -(defun helm-google-suggest-fetch (input) - "Fetch suggestions for INPUT from XML buffer. -Return an alist with elements like (data . number_results)." - (setq helm-ggs-max-length-real-flag 0 - helm-ggs-max-length-num-flag 0) - (let ((request (concat helm-google-suggest-url - (url-hexify-string input))) - (fetch #'(lambda () - (cl-loop - with result-alist = (xml-get-children - (car (xml-parse-region - (point-min) (point-max))) - 'CompleteSuggestion) - for i in result-alist - for data = (cdr (cl-caadr (assoc 'suggestion i))) - for nqueries = (cdr (cl-caadr (assoc 'num_queries i))) - for lqueries = (length (helm-ggs-set-number-result - nqueries)) - for ldata = (length data) - do - (progn - (when (> ldata helm-ggs-max-length-real-flag) - (setq helm-ggs-max-length-real-flag ldata)) - (when (> lqueries helm-ggs-max-length-num-flag) - (setq helm-ggs-max-length-num-flag lqueries))) - collect (cons data nqueries) into cont - finally return cont)))) - (if helm-google-suggest-use-curl-p - (with-temp-buffer - (call-process "curl" nil t nil request) - (funcall fetch)) - (with-current-buffer - (url-retrieve-synchronously request) - (funcall fetch))))) - -(defun helm-google-suggest-set-candidates (&optional request-prefix) - "Set candidates with result and number of google results found." - (let ((suggestions - (cl-loop with suggested-results = (helm-google-suggest-fetch - (or (and request-prefix - (concat request-prefix - " " helm-pattern)) - helm-pattern)) - for (real . numresult) in suggested-results - ;; Prepare number of results with "," - for fnumresult = (helm-ggs-set-number-result numresult) - ;; Calculate number of spaces to add before fnumresult - ;; if it is smaller than longest result - ;; `helm-ggs-max-length-num-flag'. - ;; e.g 1,234,567 - ;; 345,678 - ;; To be sure it is aligned properly. - for nspaces = (if (< (length fnumresult) - helm-ggs-max-length-num-flag) - (- helm-ggs-max-length-num-flag - (length fnumresult)) - 0) - ;; Add now the spaces before fnumresult. - for align-fnumresult = (concat (make-string nspaces ? ) - fnumresult) - for interval = (- helm-ggs-max-length-real-flag - (length real)) - for spaces = (make-string (+ 2 interval) ? ) - for display = (format "%s%s(%s results)" - real spaces align-fnumresult) - collect (cons display real)))) - (if (cl-loop for (_disp . dat) in suggestions - thereis (equal dat helm-pattern)) - suggestions - ;; if there is no suggestion exactly matching the input then - ;; prepend a Search on Google item to the list - (append - suggestions - (list (cons (concat "Search for " "'" helm-input "'" " on Google") - helm-input)))))) - -(defun helm-ggs-set-number-result (num) - (if num - (progn - (and (numberp num) (setq num (number-to-string num))) - (cl-loop for i in (reverse (split-string num "" t)) - for count from 1 - append (list i) into C - when (= count 3) - append (list ",") into C - and do (setq count 0) - finally return - (replace-regexp-in-string - "^," "" (mapconcat 'identity (reverse C) "")))) - "?")) - -(defun helm-google-suggest-action (candidate) - "Default action to jump to a google suggested candidate." - (let ((arg (format helm-google-suggest-search-url - (url-hexify-string candidate)))) - (helm-aif helm-google-suggest-default-browser-function - (funcall it arg) - (helm-browse-url arg)))) - -(defvar helm-google-suggest-default-function - 'helm-google-suggest-set-candidates - "Default function to use in helm google suggest.") - -(defvar helm-source-google-suggest - `((name . "Google Suggest") - (candidates . (lambda () - (funcall helm-google-suggest-default-function))) - (action . ,(cons '("Google Search" . helm-google-suggest-action) - helm-search-suggest-additional-actions)) - (volatile) - (keymap . ,helm-map) - (requires-pattern . 3))) - -(defun helm-google-suggest-emacs-lisp () - "Try to emacs lisp complete with google suggestions." - (helm-google-suggest-set-candidates "emacs lisp")) - - -;;; Yahoo suggestions -;; -;; -(defun helm-yahoo-suggest-fetch (input) - "Fetch Yahoo suggestions for INPUT from XML buffer. -Return an alist with elements like (data . number_results)." - (let ((request (concat helm-yahoo-suggest-url - (url-hexify-string input)))) - (with-current-buffer - (url-retrieve-synchronously request) - (cl-loop with result-alist = - (xml-get-children - (car (xml-parse-region - (point-min) (point-max))) - 'Result) - for i in result-alist - collect (cl-caddr i))))) - -(defun helm-yahoo-suggest-set-candidates () - "Set candidates with Yahoo results found." - (let ((suggestions (helm-yahoo-suggest-fetch helm-input))) - (or suggestions - (append - suggestions - (list (cons (concat "Search for " "'" helm-input "'" " on Yahoo") - helm-input)))))) - -(defun helm-yahoo-suggest-action (candidate) - "Default action to jump to a Yahoo suggested candidate." - (helm-browse-url (format helm-yahoo-suggest-search-url - (url-hexify-string candidate)))) - -(defvar helm-source-yahoo-suggest - `((name . "Yahoo Suggest") - (candidates . helm-yahoo-suggest-set-candidates) - (action . (("Yahoo Search" . helm-yahoo-suggest-action))) - (volatile) - (keymap . ,helm-map) - (requires-pattern . 3))) - -;;; Wikipedia suggestions -;; -;; -(declare-function json-read-from-string "json" (string)) -(defun helm-wikipedia-suggest-fetch () - "Fetch Wikipedia suggestions and return them as a list." - (require 'json) - (let ((request (concat helm-wikipedia-suggest-url - (url-hexify-string helm-pattern)))) - (if helm-google-suggest-use-curl-p - (with-temp-buffer - (call-process "curl" nil t nil request) - (helm-wikipedia--parse-buffer)) - (with-current-buffer - (url-retrieve-synchronously request) - (helm-wikipedia--parse-buffer))))) - -(defun helm-wikipedia--parse-buffer () - (goto-char (point-min)) - (when (re-search-forward "^\\[.+\\[\\(.*\\)\\]\\]" nil t) - (cl-loop for i across (aref (json-read-from-string (match-string 0)) 1) - collect i into result - finally return (or result - (append - result - (list (cons (format "Search for '%s' on wikipedia" - helm-pattern) - helm-pattern))))))) - -(defvar helm-wikipedia--summary-cache (make-hash-table :test 'equal)) -(defun helm-wikipedia-persistent-action (candidate) - (unless (string= (format "Search for '%s' on wikipedia" - helm-pattern) - (helm-get-selection nil t)) - (message "Fetching summary from Wikipedia...") - (let ((buf (get-buffer-create "*helm wikipedia summary*")) - result mess) - (while (progn - (setq result (or (gethash candidate helm-wikipedia--summary-cache) - (puthash candidate - (prog1 - (helm-wikipedia-fetch-summary candidate) - (setq mess "Done")) - helm-wikipedia--summary-cache))) - (when (and result - (listp result)) - (setq candidate (cdr result)) - (message "Redirected to %s" candidate) - t))) - (if (not result) - (message "Error when getting summary.") - (with-current-buffer buf - (erase-buffer) - (setq cursor-type nil) - (insert result) - (fill-region (point-min) (point-max)) - (goto-char (point-min))) - (display-buffer buf) - (message mess))))) - - -(defun helm-wikipedia-fetch-summary (input) - (let* ((request (concat helm-wikipedia-summary-url (url-hexify-string input)))) - (if helm-google-suggest-use-curl-p - (with-temp-buffer - (call-process "curl" nil t nil request) - (helm-wikipedia--parse-summary)) - (with-current-buffer - (url-retrieve-synchronously request) - (helm-wikipedia--parse-summary))))) - - -(defun helm-wikipedia--parse-summary () - (goto-char (point-min)) - (when (search-forward "{" nil t) - (let ((result (cdr (assoc '* - (assoc 'text - (assoc 'parse - (json-read-from-string - (buffer-substring-no-properties - (1- (point)) (point-max))))))))) - (when result - (if (string-match "]+>\\([^<]+\\)" result) - (cons 'redirect (match-string 1 result)) - - ;; find the beginning of the summary text in the result - - ;; check if there is a table before the summary and skip that - (when (or (string-match "\\(\n\\)?\n

" result) - ;; otherwise just find the first paragraph - (string-match "

" result)) - ;; remove cruft and do a simple formatting - (replace-regexp-in-string - "Cite error: .*" "" - (replace-regexp-in-string - " " "" - (replace-regexp-in-string - "\\[[^\]]+\\]" "" - (replace-regexp-in-string - "<[^>]*>" "" - (replace-regexp-in-string - "

\n

" "\n\n" - (substring result (match-end 0))))))))))))) - - -(defvar helm-source-wikipedia-suggest - `((name . "Wikipedia Suggest") - (candidates . helm-wikipedia-suggest-fetch) - (action . (("Wikipedia" . (lambda (candidate) - (helm-search-suggest-perform-additional-action - helm-search-suggest-action-wikipedia-url - candidate))))) - (persistent-action . helm-wikipedia-persistent-action) - (volatile) - (keymap . ,helm-map) - (follow . 1) - (follow-delay . ,helm-wikipedia-follow-delay) - (requires-pattern . 3))) - - -;;; Web browser functions. -;; -;; -;; If default setting of `w3m-command' is not -;; what you want and you modify it, you will have to reeval -;; also `helm-browse-url-default-browser-alist'. - -(defvar helm-browse-url-chromium-program "chromium-browser") -(defvar helm-browse-url-uzbl-program "uzbl-browser") -(defvar helm-browse-url-conkeror-program "conkeror") -(defvar helm-browse-url-default-browser-alist - `((,(or (and (boundp 'w3m-command) w3m-command) - "/usr/bin/w3m") . w3m-browse-url) - (,browse-url-firefox-program . browse-url-firefox) - (,helm-browse-url-chromium-program . helm-browse-url-chromium) - (,helm-browse-url-conkeror-program . helm-browse-url-conkeror) - (,helm-browse-url-uzbl-program . helm-browse-url-uzbl) - (,browse-url-kde-program . browse-url-kde) - (,browse-url-gnome-moz-program . browse-url-gnome-moz) - (,browse-url-mozilla-program . browse-url-mozilla) - (,browse-url-galeon-program . browse-url-galeon) - (,browse-url-netscape-program . browse-url-netscape) - (,browse-url-mosaic-program . browse-url-mosaic) - (,browse-url-xterm-program . browse-url-text-xterm) - ("emacs" . eww-browse-url)) - "*Alist of \(executable . function\) to try to find a suitable url browser.") - -(cl-defun helm-generic-browser (url cmd-name &rest args) - "Browse URL with NAME browser." - (let ((proc (concat cmd-name " " url))) - (message "Starting %s..." cmd-name) - (apply 'start-process proc nil cmd-name - (append args (list url))) - (set-process-sentinel - (get-process proc) - #'(lambda (process event) - (when (string= event "finished\n") - (message "%s process %s" process event)))))) - -(defun helm-browse-url-chromium (url &optional _ignore) - "Browse URL with google chrome browser." - (interactive "sURL: ") - (helm-generic-browser - url helm-browse-url-chromium-program)) - -(defun helm-browse-url-uzbl (url &optional _ignore) - "Browse URL with uzbl browser." - (interactive "sURL: ") - (helm-generic-browser url helm-browse-url-uzbl-program "-u")) - -(defun helm-browse-url-conkeror (url &optional _ignore) - "Browse URL with conkeror browser." - (interactive "sURL: ") - (helm-generic-browser url helm-browse-url-conkeror-program)) - -(defun helm-browse-url-default-browser (url &rest args) - "Find the first available browser and ask it to load URL." - (let ((default-browser-fn - (cl-loop for (exe . fn) in helm-browse-url-default-browser-alist - thereis (and exe (executable-find exe) (fboundp fn) fn)))) - (if default-browser-fn - (apply default-browser-fn url args) - (error "No usable browser found")))) - -(defun helm-browse-url (url &rest args) - "Default command to browse URL." - (if browse-url-browser-function - (browse-url url args) - (helm-browse-url-default-browser url args))) - - -;;; Surfraw -;; -;; Need external program surfraw. -;; - -;; Internal -(defvar helm-surfraw-engines-history nil) -(defvar helm-surfraw-input-history nil) -(defvar helm-surfraw--elvi-cache nil) - -(defun helm-build-elvi-list () - "Return list of all engines and descriptions handled by surfraw." - (or helm-surfraw--elvi-cache - (setq helm-surfraw--elvi-cache - (cdr (with-temp-buffer - (call-process "surfraw" nil t nil "-elvi") - (split-string (buffer-string) "\n")))))) - -;;;###autoload -(defun helm-surfraw (pattern engine) - "Preconfigured `helm' to search PATTERN with search ENGINE." - (interactive (list (read-string "SearchFor: " - nil 'helm-surfraw-input-history - (thing-at-point 'symbol)) - (helm-comp-read - "Engine: " - (helm-build-elvi-list) - :must-match t - :name "Surfraw Search Engines" - :del-input nil - :history helm-surfraw-engines-history))) - (let* ((engine-nodesc (car (split-string engine))) - (url (if (string= engine-nodesc "duckduckgo") - ;; "sr duckduckgo -p foo" is broken, workaround. - (format helm-surfraw-duckduckgo-url - (url-hexify-string pattern)) - (with-temp-buffer - (apply 'call-process "surfraw" nil t nil - (append (list engine-nodesc "-p") (split-string pattern))) - (replace-regexp-in-string - "\n" "" (buffer-string))))) - (browse-url-browser-function (or helm-surfraw-default-browser-function - browse-url-browser-function))) - (if (string= engine-nodesc "W") - (helm-browse-url helm-home-url) - (helm-browse-url url) - (setq helm-surfraw-engines-history - (cons engine (delete engine helm-surfraw-engines-history)))))) - -;;;###autoload -(defun helm-google-suggest () - "Preconfigured `helm' for google search with google suggest." - (interactive) - (helm-other-buffer 'helm-source-google-suggest "*helm google*")) - -;;;###autoload -(defun helm-yahoo-suggest () - "Preconfigured `helm' for Yahoo searching with Yahoo suggest." - (interactive) - (helm-other-buffer 'helm-source-yahoo-suggest "*helm yahoo*")) - -;;;###autoload -(defun helm-wikipedia-suggest () - "Preconfigured `helm' for Wikipedia lookup with Wikipedia suggest." - (interactive) - (helm :sources 'helm-source-wikipedia-suggest - :buffer "*helm wikipedia*")) - - -(provide 'helm-net) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-net.el ends here diff --git a/elpa/helm-20150403.101/helm-org.el b/elpa/helm-20150403.101/helm-org.el deleted file mode 100644 index 22696dec..00000000 --- a/elpa/helm-20150403.101/helm-org.el +++ /dev/null @@ -1,145 +0,0 @@ -;;; helm-org.el --- Helm for org headlines and keywords completion -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: -(require 'cl-lib) -(require 'helm) -(require 'org) - -(defgroup helm-org nil - "Org related functions for helm." - :group 'helm) - -(defcustom helm-org-headings-fontify nil - "Fontify org buffers before parsing them. -This reflect fontification in helm-buffer when non--nil. -NOTE: This will be slow on large org buffers." - :group 'helm-org - :type 'boolean) - -;; Internal -(defvar helm-org-headings--nofilename nil) - -;;; Org capture templates -;; -;; -(defvar org-capture-templates) -(defun helm-source-org-capture-templates () - (helm-build-sync-source "Org Capture Templates:" - :candidates (cl-loop for template in org-capture-templates - collect `(,(nth 1 template) . ,(nth 0 template))) - :action '(("Do capture" . (lambda (template-shortcut) - (org-capture nil template-shortcut)))))) - -;;; Org headings -;; -;; -(defun helm-org-goto-marker (marker) - (switch-to-buffer (marker-buffer marker)) - (goto-char (marker-position marker)) - (org-show-context) - (org-show-entry)) - -(cl-defun helm-source-org-headings-for-files (filenames - &optional (min-depth 1) (max-depth 8)) - (helm-build-sync-source "Org Headings" - :candidates (helm-org-get-candidates filenames min-depth max-depth) - :action '(("Go to line" . helm-org-goto-marker) - ("Refile to this heading" . helm-org-heading-refile) - ("Insert link to this heading" - . helm-org-insert-link-to-heading-at-marker)))) - -(defun helm-org-insert-link-to-heading-at-marker (marker) - (with-current-buffer (marker-buffer marker) - (let ((heading-name (save-excursion (goto-char (marker-position marker)) - (nth 4 (org-heading-components)))) - (file-name (buffer-file-name))) - (with-helm-current-buffer - (org-insert-link - file-name (concat "file:" file-name "::*" heading-name)))))) - -(defun helm-org-heading-refile (marker) - (with-helm-current-buffer - (org-cut-subtree)) - (let ((target-level (with-current-buffer (marker-buffer marker) - (goto-char (marker-position marker)) - (org-current-level)))) - (helm-org-goto-marker marker) - (org-end-of-subtree t t) - (org-paste-subtree (+ target-level 1)))) - -(defun helm-org-get-candidates (filenames min-depth max-depth) - (apply #'append - (mapcar (lambda (filename) - (helm-get-org-candidates-in-file - filename min-depth max-depth - helm-org-headings-fontify - helm-org-headings--nofilename)) - filenames))) - -(defun helm-get-org-candidates-in-file (filename min-depth max-depth - &optional fontify nofname) - (with-current-buffer (find-file-noselect filename) - (and fontify (jit-lock-fontify-now)) - (let ((match-fn (if fontify 'match-string 'match-string-no-properties))) - (save-excursion - (goto-char (point-min)) - (cl-loop with width = (window-width) - while (re-search-forward org-complex-heading-regexp nil t) - if (let ((num-stars (length (match-string-no-properties 1)))) - (and (>= num-stars min-depth) (<= num-stars max-depth))) - collect `(,(let ((heading (funcall match-fn 4)) - (file (unless nofname - (concat (helm-basename filename) ":"))) - (level (length (match-string-no-properties 1)))) - (org-format-outline-path - (append (org-get-outline-path t level heading) - (list heading)) width file)) - . ,(point-marker))))))) - -;;;###autoload -(defun helm-org-agenda-files-headings () - (interactive) - (helm :sources (helm-source-org-headings-for-files (org-agenda-files)) - :candidate-number-limit 99999 - :buffer "*helm org headings*")) - -;;;###autoload -(defun helm-org-in-buffer-headings () - (interactive) - (helm :sources (helm-source-org-headings-for-files - (list (buffer-file-name (current-buffer)))) - :candidate-number-limit 99999 - :buffer "*helm org inbuffer*")) - -;;;###autoload -(defun helm-org-capture-templates () - (interactive) - (helm :sources (helm-source-org-capture-templates) - :candidate-number-limit 99999 - :buffer "*helm org capture templates*")) - - -(provide 'helm-org) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-org.el ends here diff --git a/elpa/helm-20150403.101/helm-pkg.el b/elpa/helm-20150403.101/helm-pkg.el deleted file mode 100644 index 9e258761..00000000 --- a/elpa/helm-20150403.101/helm-pkg.el +++ /dev/null @@ -1,8 +0,0 @@ -(define-package "helm" "20150403.101" "Helm is an Emacs incremental and narrowing framework" - '((emacs "24") - (cl-lib "0.5") - (async "1.2")) - :url "https://emacs-helm.github.io/helm/") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/helm-20150403.101/helm-plugin.el b/elpa/helm-20150403.101/helm-plugin.el deleted file mode 100644 index 976a7349..00000000 --- a/elpa/helm-20150403.101/helm-plugin.el +++ /dev/null @@ -1,137 +0,0 @@ -;;; helm-plugin.el --- Helm plugins -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-utils) - - -;;; Plug-in: `info-index' -;; -;; -(defun helm-make-info-source (source file) - `(,@source - (name . ,(concat "Info Index: " file)) - (info-file . ,file) - (init . helm-info-init) - (display-to-real . helm-info-display-to-real) - (get-line . buffer-substring) - (candidates-in-buffer) - (action ("Goto node" . helm-info-goto)))) - -(defun helm-compile-source--info-index (source) - (helm-aif (helm-interpret-value (assoc-default 'info-index source)) - (helm-make-info-source source it) - source)) - -(add-to-list 'helm-compile-source-functions 'helm-compile-source--info-index) - -(helm-document-attribute 'info-index "info-index plugin" - " Create a source of info index very easily. - - Example: - - (defvar helm-source-info-wget '((info-index . \"wget\"))") - - -;;; Plug-in: `candidates-file' -;; -;; List all lines in a file. -(defun helm-compile-source--candidates-file (source) - (if (assoc-default 'candidates-file source) - `((init helm-p-candidates-file-init - ,@(let ((orig-init (assoc-default 'init source))) - (cond ((null orig-init) nil) - ((functionp orig-init) (list orig-init)) - (t orig-init)))) - (candidates-in-buffer) - ,@source) - source)) -(add-to-list 'helm-compile-source-functions 'helm-compile-source--candidates-file) - -(defun helm-p-candidates-file-init () - (cl-destructuring-bind (file &optional updating) - (helm-mklist (helm-attr 'candidates-file)) - (setq file (helm-interpret-value file)) - (with-current-buffer (helm-candidate-buffer 'global) - (insert-file-contents file) - (when updating - (buffer-disable-undo) - (font-lock-mode -1) - (auto-revert-mode 1))))) - -(helm-document-attribute 'candidates-file "candidates-file plugin" - " Use a file as the candidates buffer. - - 1st argument is a filename, string or function name or variable - name. If optional 2nd argument is non-nil, the file is opened with - `auto-revert-mode' enabled. - - Example: - - \(defvar helm-source-test-file - '((name . \"test1\") - (candidates-file \"~/.emacs.el\" t))) - - Will list all lines in .emacs.el.") - - -;;; Plug-in: `persistent-help' -;; -;; Add help about persistent action in `helm-buffer' header. -(defun helm-compile-source--persistent-help (source) - (if (assoc 'header-line source) - source - (append source '((header-line . helm-persistent-help-string))))) -(add-to-list 'helm-compile-source-functions 'helm-compile-source--persistent-help) - -(defun helm-persistent-help-string () - (substitute-command-keys - (concat "\\\\[helm-execute-persistent-action]: " - (or (helm-interpret-value (helm-attr 'persistent-help)) - (helm-aif (or (assoc-default - 'persistent-action - (helm-get-current-source)) - (assoc-default - 'action (helm-get-current-source))) - (cond ((symbolp it) - (symbol-name it)) - ((listp it) - (or (ignore-errors (caar it)) "")))) - "") - " (keeping session)"))) - - -;;; Document new attributes -;; -;; -(helm-document-attribute 'persistent-help "persistent-help plug-in" - " A string to explain persistent-action of this source. It also - accepts a function or a variable name.") - - -(provide 'helm-plugin) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-plugin ends here diff --git a/elpa/helm-20150403.101/helm-regexp.el b/elpa/helm-20150403.101/helm-regexp.el deleted file mode 100644 index 62e10752..00000000 --- a/elpa/helm-20150403.101/helm-regexp.el +++ /dev/null @@ -1,624 +0,0 @@ -;;; helm-regexp.el --- In buffer regexp searching and replacement for helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-utils) -(require 'helm-plugin) - - -(defgroup helm-regexp nil - "Regexp related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-moccur-always-search-in-current nil - "Helm multi occur always search in current buffer when non--nil." - :group 'helm-regexp - :type 'boolean) - -(defcustom helm-moccur-use-ioccur-style-keys t - "Similar to `helm-grep-use-ioccur-style-keys' but for multi occur." - :group 'helm-regexp - :type 'boolean) - -(defcustom helm-moccur-auto-update-on-resume nil - "Allow auto updating helm-(m)occur buffer when outdated. -noask => Always update without asking -nil => Don't update but signal buffer needs update -never => Never update and do not signal buffer needs update -Any other non--nil value update after confirmation." - :group 'helm-regexp - :type '(radio :tag "Allow auto updating helm-(m)occur buffer when outdated." - (const :tag "Always update without asking" noask) - (const :tag "Never update and do not signal buffer needs update" never) - (const :tag "Don't update but signal buffer needs update" nil) - (const :tag "Update after confirmation" t))) - - -(defface helm-moccur-buffer - '((t (:foreground "DarkTurquoise" :underline t))) - "Face used to highlight moccur buffer names." - :group 'helm-regexp) - -(defface helm-resume-need-update - '((t (:background "red"))) - "Face used to flash moccur buffer when it needs update." - :group 'helm-regexp) - - -(defvar helm-moccur-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-") 'helm-goto-next-file) - (define-key map (kbd "M-") 'helm-goto-precedent-file) - (define-key map (kbd "C-w") 'helm-yank-text-at-point) - (define-key map (kbd "C-c ?") 'helm-moccur-help) - (define-key map (kbd "C-c o") 'helm-moccur-run-goto-line-ow) - (define-key map (kbd "C-c C-o") 'helm-moccur-run-goto-line-of) - (define-key map (kbd "C-x C-s") 'helm-moccur-run-save-buffer) - (when helm-moccur-use-ioccur-style-keys - (define-key map (kbd "") 'helm-execute-persistent-action) - (define-key map (kbd "") 'helm-moccur-run-default-action)) - (delq nil map)) - "Keymap used in Moccur source.") - - -(defvar helm-build-regexp-history nil) -(defun helm-query-replace-regexp (_candidate) - "Query replace regexp from `helm-regexp'. -With a prefix arg replace only matches surrounded by word boundaries, -i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b." - (let ((regexp (funcall (helm-attr 'regexp)))) - (apply 'query-replace-regexp - (helm-query-replace-args regexp)))) - -(defun helm-kill-regexp-as-sexp (_candidate) - "Kill regexp in a format usable in lisp code." - (helm-regexp-kill-new - (prin1-to-string (funcall (helm-attr 'regexp))))) - -(defun helm-kill-regexp (_candidate) - "Kill regexp as it is in `helm-pattern'." - (helm-regexp-kill-new (funcall (helm-attr 'regexp)))) - -(defun helm-query-replace-args (regexp) - "create arguments of `query-replace-regexp' action in `helm-regexp'." - (let ((region-only (helm-region-active-p))) - (list - regexp - (query-replace-read-to regexp - (format "Query replace %sregexp %s" - (if helm-current-prefix-arg "word " "") - (if region-only "in region " "")) - t) - helm-current-prefix-arg - (when region-only (region-beginning)) - (when region-only (region-end))))) - -(defvar helm-source-regexp - '((name . "Regexp Builder") - (init . (lambda () - (helm-init-candidates-in-buffer - 'global (with-temp-buffer - (insert-buffer-substring helm-current-buffer) - (buffer-string))))) - (candidates-in-buffer) - (get-line . helm-regexp-get-line) - (persistent-action . helm-regexp-persistent-action) - (persistent-help . "Show this line") - (multiline) - (no-matchplugin) - (requires-pattern . 2) - (mode-line . "Press TAB to select action.") - (regexp . (lambda () helm-input)) - (action . (("Kill Regexp as sexp" . helm-kill-regexp-as-sexp) - ("Query Replace Regexp (C-u Not inside word.)" - . helm-query-replace-regexp) - ("Kill Regexp" . helm-kill-regexp))))) - -(defun helm-regexp-get-line (s e) - (let ((matches (match-data)) - (line (buffer-substring s e))) - (propertize - (cl-loop with ln = (format "%5d: %s" (line-number-at-pos s) line) - for i from 0 to (1- (/ (length matches) 2)) - concat (format "\n %s'%s'" (format "Group %d: " i) - (match-string i)) - into ln1 - finally return (concat ln ln1)) - 'helm-realvalue s))) - -(defun helm-regexp-persistent-action (pt) - (helm-goto-char pt) - (helm-highlight-current-line)) - -(defun helm-regexp-kill-new (input) - (kill-new input) - (message "Killed: %s" input)) - -(defun helm-quote-whitespace (candidate) - "Quote whitespace, if some, in string CANDIDATE." - (replace-regexp-in-string " " "\\\\ " candidate)) - - -;;; Occur -;; -;; -(defvar helm-source-occur nil) -(defun helm-occur-init-source () - (unless helm-source-occur - (setq helm-source-occur - (helm-make-source "Occur" 'helm-source-multi-occur)))) - - -;;; Multi occur -;; -;; - -;; Internal -(defvar helm-multi-occur-buffer-list nil) -(defvar helm-multi-occur-buffer-tick nil) -(defun helm-moccur-init () - "Create the initial helm multi occur buffer." - (helm-init-candidates-in-buffer - 'global - (cl-loop with buffers = (helm-attr 'moccur-buffers) - for buf in buffers - for bufstr = (with-current-buffer buf (buffer-string)) - do (add-text-properties - 0 (length bufstr) - `(buffer-name ,(buffer-name (get-buffer buf))) - bufstr) - concat bufstr))) - -(defun helm-moccur--next-or-previous-char () - (save-excursion - (or (re-search-forward "^." nil t) - (re-search-backward "^." nil t)))) - -(defun helm-moccur-get-line (beg end) - "Format line for `helm-source-moccur'." - (prog1 - (format "%s:%d:%s" - (get-text-property (if (= beg end) - (helm-moccur--next-or-previous-char) - beg) - 'buffer-name) - (save-restriction - (narrow-to-region (or (previous-single-property-change - (point) 'buffer-name) 1) - (or (next-single-property-change - (if (= beg end) - (helm-moccur--next-or-previous-char) - (point)) - 'buffer-name) - (point-max))) - (line-number-at-pos beg)) - ;; When matching empty line, use empty string - ;; to allow saving and modifying with wgrep. - (if (= beg end) "" (buffer-substring beg end))) - ;; When matching empty line, forward char ("\n") - ;; to not be blocked forever here. - (when (= beg end) (forward-char 1)))) - -(cl-defun helm-moccur-action (candidate - &optional (method (quote buffer)) mark) - "Jump to CANDIDATE with METHOD. -arg METHOD can be one of buffer, buffer-other-window, buffer-other-frame." - (require 'helm-grep) - (let* ((split (helm-grep-split-line candidate)) - (buf (car split)) - (lineno (string-to-number (nth 1 split))) - (split-pat (helm-mp-split-pattern helm-pattern))) - (cl-case method - (buffer (switch-to-buffer buf)) - (buffer-other-window (switch-to-buffer-other-window buf)) - (buffer-other-frame (switch-to-buffer-other-frame buf))) - (helm-goto-line lineno) - ;; Move point to the nearest matching regexp from bol. - (cl-loop for reg in split-pat - when (save-excursion - (condition-case _err - (re-search-forward reg (point-at-eol) t) - (invalid-regexp nil))) - collect (match-beginning 0) into pos-ls - finally (when pos-ls (goto-char (apply #'min pos-ls)))) - (when mark - (set-marker (mark-marker) (point)) - (push-mark (point) 'nomsg)))) - -(defun helm-moccur-persistent-action (candidate) - (helm-moccur-goto-line candidate) - (helm-highlight-current-line)) - -(defun helm-moccur-goto-line (candidate) - "From multi occur, switch to buffer and go to nth 1 CANDIDATE line." - (helm-moccur-action - candidate 'buffer (or current-prefix-arg ; persistent. - helm-current-prefix-arg))) ; exit. - -(defun helm-moccur-goto-line-ow (candidate) - "Go to CANDIDATE line in other window. -Same as `helm-moccur-goto-line' but go in other window." - (helm-moccur-action - candidate 'buffer-other-window - (or current-prefix-arg ; persistent. - helm-current-prefix-arg))) ; exit. - -(defun helm-moccur-goto-line-of (candidate) - "Go to CANDIDATE line in new frame. -Same as `helm-moccur-goto-line' but go in new frame." - (helm-moccur-action - candidate 'buffer-other-frame - (or current-prefix-arg ; persistent. - helm-current-prefix-arg))) ; exit. - -(defun helm-moccur-run-goto-line-ow () - "Run goto line other window action from `helm-source-moccur'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-moccur-goto-line-ow))) - -(defun helm-moccur-run-goto-line-of () - "Run goto line new frame action from `helm-source-moccur'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-moccur-goto-line-of))) - -(defun helm-moccur-run-default-action () - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-moccur-goto-line))) - -(defvar helm-source-moccur nil) -(defclass helm-source-multi-occur (helm-source-in-buffer) - ((init :initform (lambda () - (require 'helm-grep) - (helm-moccur-init))) - (filter-one-by-one :initform 'helm-moccur-filter-one-by-one) - (get-line :initform helm-moccur-get-line) - (nohighlight :initform t) - (migemo :initform t) - (action :initform '(("Go to Line" . helm-moccur-goto-line) - ("Goto line other window" . helm-moccur-goto-line-ow) - ("Goto line new frame" . helm-moccur-goto-line-of))) - (persistent-action :initform 'helm-moccur-persistent-action) - (persistent-help :initform "Go to line") - (recenter :initform t) - (resume :initform 'helm-moccur-resume-fn) - (candidate-number-limit :initform 9999) - (mode-line :initform helm-moccur-mode-line) - (keymap :initform helm-moccur-map) - (history :initform 'helm-grep-history) - (requires-pattern :initform 2))) - -(defun helm-moccur-resume-fn () - (with-helm-buffer - (let (new-tick-ls buffer-is-modified) - (set (make-local-variable 'helm-multi-occur-buffer-list) - (cl-loop for b in helm-multi-occur-buffer-list - when (buffer-live-p (get-buffer b)) - collect b)) - (setq buffer-is-modified (/= (length helm-multi-occur-buffer-list) - (length (helm-attr 'moccur-buffers)))) - (helm-attrset 'moccur-buffers helm-multi-occur-buffer-list) - (setq new-tick-ls (cl-loop for b in helm-multi-occur-buffer-list - collect (buffer-chars-modified-tick (get-buffer b)))) - (when buffer-is-modified - (setq helm-multi-occur-buffer-tick new-tick-ls)) - (cl-assert (> (length helm-multi-occur-buffer-list) 0) nil - "helm-resume error: helm-(m)occur buffer list is empty") - (unless (eq helm-moccur-auto-update-on-resume 'never) - (when (or buffer-is-modified - (cl-loop for b in helm-multi-occur-buffer-list - for new-tick = (buffer-chars-modified-tick (get-buffer b)) - for tick in helm-multi-occur-buffer-tick - thereis (/= tick new-tick))) - (helm-aif helm-moccur-auto-update-on-resume - (when (or (eq it 'noask) - (y-or-n-p "Helm (m)occur Buffer outdated, update? ")) - (run-with-idle-timer 0.1 nil (lambda () - (with-helm-buffer - (helm-force-update) - (message "Helm (m)occur Buffer have been udated") - (sit-for 1) (message nil)))) - (unless buffer-is-modified (setq helm-multi-occur-buffer-tick new-tick-ls))) - (run-with-idle-timer 0.1 nil (lambda () - (with-helm-buffer - (let ((ov (make-overlay (save-excursion - (goto-char (point-min)) - (forward-line 1) - (point)) - (point-max)))) - (overlay-put ov 'face 'helm-resume-need-update) - (sit-for 0.3) (delete-overlay ov) - (message "[Helm occur Buffer outdated (C-c C-u to update)]"))))) - (unless buffer-is-modified - (with-helm-after-update-hook - (setq helm-multi-occur-buffer-tick new-tick-ls) - (message "Helm (m)occur Buffer have been udated"))))))))) - -(defun helm-moccur-filter-one-by-one (candidate) - "`filter-one-by-one' function for `helm-source-moccur'." - (require 'helm-grep) - (let* ((split (helm-grep-split-line candidate)) - (buf (car split)) - (lineno (nth 1 split)) - (str (nth 2 split))) - (cons (concat (propertize - buf - 'face 'helm-moccur-buffer - 'help-echo (buffer-file-name - (get-buffer buf)) - 'buffer-name buf) - ":" - (propertize lineno 'face 'helm-grep-lineno) - ":" - (helm-grep-highlight-match str t)) - candidate))) - -(defun helm-multi-occur-1 (buffers &optional input) - "Main function to call `helm-source-moccur' with BUFFERS list." - (let ((bufs (if helm-moccur-always-search-in-current - (cons - ;; will become helm-current-buffer later. - (buffer-name (current-buffer)) - (remove helm-current-buffer buffers)) - buffers))) - (unless helm-source-moccur - (setq helm-source-moccur - (helm-make-source "Moccur" 'helm-source-multi-occur))) - (helm-attrset 'moccur-buffers bufs helm-source-moccur) - (helm-set-local-variable 'helm-multi-occur-buffer-list bufs) - (helm-set-local-variable - 'helm-multi-occur-buffer-tick - (cl-loop for b in bufs - collect (buffer-chars-modified-tick (get-buffer b))))) - (helm :sources 'helm-source-moccur - :buffer "*helm multi occur*" - :history 'helm-grep-history - :input input - :truncate-lines t)) - -;;;###autoload -(defun helm-moccur-run-save-buffer () - "Run grep save results action from `helm-do-grep-1'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action 'helm-moccur-save-results))) - - -;;; helm-moccur-mode -;; -;; -(defvar helm-moccur-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "RET") 'helm-moccur-mode-goto-line) - (define-key map (kbd "C-o") 'helm-moccur-mode-goto-line-ow) - (define-key map (kbd "") 'undefined) - (define-key map (kbd "") 'undefined) - (define-key map (kbd "") 'helm-gm-next-file) - (define-key map (kbd "") 'helm-gm-precedent-file) - map)) - -(defun helm-moccur-mode-goto-line () - (interactive) - (helm-moccur-goto-line - (buffer-substring (point-at-bol) (point-at-eol)))) - -(defun helm-moccur-mode-goto-line-ow () - (interactive) - (helm-moccur-goto-line-ow - (buffer-substring (point-at-bol) (point-at-eol)))) - -(defun helm-moccur-save-results (_candidate) - "Save helm moccur results in a `helm-moccur-mode' buffer." - (let ((buf "*hmoccur*") - new-buf) - (when (get-buffer buf) - (setq new-buf (helm-read-string "OccurBufferName: " buf)) - (cl-loop for b in (helm-buffer-list) - when (and (string= new-buf b) - (not (y-or-n-p - (format "Buffer `%s' already exists overwrite? " - new-buf)))) - do (setq new-buf (helm-read-string "OccurBufferName: " "*hmoccur "))) - (setq buf new-buf)) - (with-current-buffer (get-buffer-create buf) - (setq buffer-read-only t) - (let ((inhibit-read-only t)) - (erase-buffer) - (insert "-*- mode: helm-moccur -*-\n\n" - (format "Moccur Results for `%s':\n\n" helm-pattern)) - (save-excursion - (insert (with-current-buffer helm-buffer - (goto-char (point-min)) (forward-line 1) - (buffer-substring (point) (point-max)))))) - (helm-moccur-mode) (pop-to-buffer buf)) - (message "Helm Moccur Results saved in `%s' buffer" buf))) - -;;;###autoload -(define-derived-mode helm-moccur-mode - special-mode "helm-moccur" - "Major mode to provide actions in helm moccur saved buffer. - -Special commands: -\\{helm-moccur-mode-map}" - (set (make-local-variable 'helm-multi-occur-buffer-list) - (with-helm-buffer helm-multi-occur-buffer-list)) - (set (make-local-variable 'revert-buffer-function) - #'helm-moccur-mode--revert-buffer-function)) - -(defun helm-moccur-mode--revert-buffer-function (&optional _ignore-auto _noconfirm) - (goto-char (point-min)) - (let (pattern) - (when (re-search-forward "^Moccur Results for `\\(.*\\)'" nil t) - (setq pattern (match-string 1)) - (forward-line 0) - (when (re-search-forward "^$" nil t) - (forward-line 1)) - (let ((inhibit-read-only t) - (buffer (current-buffer)) - (buflst helm-multi-occur-buffer-list)) - (delete-region (point) (point-max)) - (message "Reverting buffer...") - (save-excursion - (with-temp-buffer - (insert - "\n" - (cl-loop for buf in buflst - for bufstr = (or (and (buffer-live-p (get-buffer buf)) - (with-current-buffer buf - (buffer-string))) - "") - unless (string= bufstr "") - do (add-text-properties - 0 (length bufstr) - `(buffer-name ,(buffer-name (get-buffer buf))) - bufstr) - concat bufstr) - "\n") - (goto-char (point-min)) - (cl-loop while (re-search-forward pattern nil t) - for line = (helm-moccur-get-line (point-at-bol) (point-at-eol)) - when line - do (with-current-buffer buffer - (insert - (propertize - (car (helm-moccur-filter-one-by-one line)) - 'helm-real-value line) - "\n"))))) - (message "Reverting buffer done"))))) - - -;;; Predefined commands -;; -;; - -;;;###autoload -(defun helm-regexp () - "Preconfigured helm to build regexps. -`query-replace-regexp' can be run from there against found regexp." - (interactive) - (save-restriction - (when (and (helm-region-active-p) - ;; Don't narrow to region if buffer is already narrowed. - (not (helm-current-buffer-narrowed-p (current-buffer)))) - (narrow-to-region (region-beginning) (region-end))) - (helm :sources helm-source-regexp - :buffer "*helm regexp*" - :prompt "Regexp: " - :history 'helm-build-regexp-history))) - -;;;###autoload -(defun helm-occur () - "Preconfigured helm for Occur." - (interactive) - (helm-occur-init-source) - (let ((bufs (list (buffer-name (current-buffer))))) - (helm-attrset 'moccur-buffers bufs helm-source-occur) - (helm-set-local-variable 'helm-multi-occur-buffer-list bufs) - (helm-set-local-variable - 'helm-multi-occur-buffer-tick - (cl-loop for b in bufs - collect (buffer-chars-modified-tick (get-buffer b))))) - (helm :sources 'helm-source-occur - :buffer "*helm occur*" - :history 'helm-grep-history - :preselect (and (memq 'helm-source-occur helm-sources-using-default-as-input) - (format "%s:%d:" (buffer-name) (line-number-at-pos (point)))) - :truncate-lines t)) - -;;;###autoload -(defun helm-occur-from-isearch () - "Invoke `helm-occur' from isearch." - (interactive) - (let ((input (if isearch-regexp - isearch-string - (regexp-quote isearch-string))) - (bufs (list (buffer-name (current-buffer))))) - (isearch-exit) - (helm-occur-init-source) - (helm-attrset 'moccur-buffers bufs helm-source-occur) - (helm-set-local-variable 'helm-multi-occur-buffer-list bufs) - (helm-set-local-variable - 'helm-multi-occur-buffer-tick - (cl-loop for b in bufs - collect (buffer-chars-modified-tick (get-buffer b)))) - (helm :sources 'helm-source-occur - :buffer "*helm occur*" - :history 'helm-grep-history - :input input - :truncate-lines t))) - -;;;###autoload -(defun helm-multi-occur (buffers) - "Preconfigured helm for multi occur. - - BUFFERS is a list of buffers to search through. -With a prefix arg, reverse the behavior of -`helm-moccur-always-search-in-current'. -The prefix arg can be set before calling `helm-multi-occur' -or during the buffer selection." - (interactive (list (helm-comp-read - "Buffers: " (helm-buffer-list) - :marked-candidates t))) - (let ((helm-moccur-always-search-in-current - (if (or current-prefix-arg - helm-current-prefix-arg) - (not helm-moccur-always-search-in-current) - helm-moccur-always-search-in-current))) - (helm-multi-occur-1 buffers))) - -;;;###autoload -(defun helm-multi-occur-from-isearch (&optional _arg) - "Invoke `helm-multi-occur' from isearch. - -With a prefix arg, reverse the behavior of -`helm-moccur-always-search-in-current'. -The prefix arg can be set before calling -`helm-multi-occur-from-isearch' or during the buffer selection." - (interactive "p") - (let (buf-list - helm-moccur-always-search-in-current - (input (if isearch-regexp - isearch-string - (regexp-quote isearch-string)))) - (isearch-exit) - (setq buf-list (helm-comp-read "Buffers: " - (helm-buffer-list) - :name "Occur in buffer(s)" - :marked-candidates t)) - (setq helm-moccur-always-search-in-current - (if (or current-prefix-arg - helm-current-prefix-arg) - (not helm-moccur-always-search-in-current) - helm-moccur-always-search-in-current)) - (helm-multi-occur-1 buf-list input))) - - -(provide 'helm-regexp) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-regexp.el ends here diff --git a/elpa/helm-20150403.101/helm-ring.el b/elpa/helm-20150403.101/helm-ring.el deleted file mode 100644 index a43895c6..00000000 --- a/elpa/helm-20150403.101/helm-ring.el +++ /dev/null @@ -1,416 +0,0 @@ -;;; helm-ring.el --- kill-ring, mark-ring, and register browsers for helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-utils) -(require 'helm-elisp) - -(declare-function undo-tree-restore-state-from-register "ext:undo-tree.el" (register)) - - -(defgroup helm-ring nil - "Ring related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-kill-ring-threshold 3 - "Minimum length of a candidate to be listed by `helm-source-kill-ring'." - :type 'integer - :group 'helm-ring) - -(defcustom helm-kill-ring-max-lines-number 5 - "Max number of lines displayed per candidate in kill-ring browser. -If nil or zero (disabled), don't truncate candidate, show all." - :type '(choice (const :tag "Disabled" nil) - (integer :tag "Max number of lines")) - :group 'helm-ring) - -(defcustom helm-register-max-offset 160 - "Max size of string register entries before truncating." - :group 'helm-ring - :type 'integer) - - -;;; Kill ring -;; -;; -(defvar helm-kill-ring-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-y") 'helm-next-line) - (define-key map (kbd "M-u") 'helm-previous-line) - map) - "Keymap for `helm-show-kill-ring'.") - -(defvar helm-source-kill-ring - (helm-build-sync-source "Kill Ring" - :init (lambda () (helm-attrset 'last-command last-command)) - :candidates #'helm-kill-ring-candidates - :filtered-candidate-transformer #'helm-kill-ring-transformer - :action '(("Yank" . helm-kill-ring-action) - ("Delete" . (lambda (candidate) - (cl-loop for cand in (helm-marked-candidates) - do (setq kill-ring - (delete cand kill-ring)))))) - :persistent-action (lambda (_candidate) (ignore)) - :persistent-help "DoNothing" - :keymap helm-kill-ring-map - :migemo t - :multiline t) - "Source for browse and insert contents of kill-ring.") - -(defun helm-kill-ring-candidates () - (cl-loop for kill in (helm-fast-remove-dups kill-ring :test 'equal) - unless (or (< (length kill) helm-kill-ring-threshold) - (string-match "\\`[\n[:blank:]]+\\'" kill)) - collect kill)) - -(defun helm-kill-ring-transformer (candidates _source) - "Display only the `helm-kill-ring-max-lines-number' lines of candidate." - (cl-loop for i in candidates - when (get-text-property 0 'read-only i) - do (set-text-properties 0 (length i) '(read-only nil) i) - for nlines = (with-temp-buffer (insert i) (count-lines (point-min) (point-max))) - if (and helm-kill-ring-max-lines-number - (> nlines helm-kill-ring-max-lines-number)) - collect (cons - (with-temp-buffer - (insert i) - (goto-char (point-min)) - (concat - (buffer-substring - (point-min) - (save-excursion - (forward-line helm-kill-ring-max-lines-number) - (point))) - "[...]")) i) - else collect i)) - -(defun helm-kill-ring-action (str) - "Insert STR in `kill-ring' and set STR to the head. -If this action is executed just after `yank', -replace with STR as yanked string." - (with-helm-current-buffer - (setq kill-ring (delete str kill-ring)) - (if (not (eq (helm-attr 'last-command helm-source-kill-ring) 'yank)) - (run-with-timer 0.01 nil `(lambda () (insert-for-yank ,str))) - ;; from `yank-pop' - (let ((inhibit-read-only t) - (before (< (point) (mark t)))) - (if before - (funcall (or yank-undo-function 'delete-region) (point) (mark t)) - (funcall (or yank-undo-function 'delete-region) (mark t) (point))) - (setq yank-undo-function nil) - (set-marker (mark-marker) (point) helm-current-buffer) - (run-with-timer 0.01 nil `(lambda () (insert-for-yank ,str))) - ;; Set the window start back where it was in the yank command, - ;; if possible. - (set-window-start (selected-window) yank-window-start t) - (when before - ;; This is like exchange-point-and-mark, but doesn't activate the mark. - ;; It is cleaner to avoid activation, even though the command - ;; loop would deactivate the mark because we inserted text. - (goto-char (prog1 (mark t) - (set-marker (mark-marker) (point) helm-current-buffer)))))) - (kill-new str))) - - - - -;;;; -;; DO NOT use these sources with other sources use -;; the commands `helm-mark-ring', `helm-global-mark-ring' or -;; `helm-all-mark-rings' instead. - -(defun helm-mark-ring-get-marks (pos) - (save-excursion - (goto-char pos) - (forward-line 0) - (let ((line (car (split-string (thing-at-point 'line) "[\n\r]")))) - (when (string= "" line) - (setq line "")) - (format "%7d: %s" (line-number-at-pos) line)))) - -(defun helm-mark-ring-get-candidates () - (with-helm-current-buffer - (cl-loop with marks = (if (mark t) (cons (mark-marker) mark-ring) mark-ring) - for i in marks - for m = (helm-mark-ring-get-marks i) - unless (and recip (member m recip)) - collect m into recip - finally return recip))) - -(defvar helm-source-mark-ring - (helm-build-sync-source "mark-ring" - :candidates #'helm-mark-ring-get-candidates - :action '(("Goto line" - . (lambda (candidate) - (helm-goto-line (string-to-number candidate))))) - :persistent-action (lambda (candidate) - (helm-goto-line (string-to-number candidate)) - (helm-highlight-current-line)) - :persistent-help "Show this line")) - - -;;; Global-mark-ring -(defvar helm-source-global-mark-ring - (helm-build-sync-source "global-mark-ring" - :candidates #'helm-global-mark-ring-get-candidates - :action '(("Goto line" - . (lambda (candidate) - (let ((items (split-string candidate ":"))) - (switch-to-buffer (cl-second items)) - (helm-goto-line (string-to-number (car items))))))) - :persistent-action (lambda (candidate) - (let ((items (split-string candidate ":"))) - (switch-to-buffer (cl-second items)) - (helm-goto-line (string-to-number (car items))) - (helm-highlight-current-line))) - :persistent-help "Show this line")) - -(defun helm-global-mark-ring-format-buffer (marker) - (with-current-buffer (marker-buffer marker) - (goto-char marker) - (forward-line 0) - (let (line) - (if (string= "" line) - (setq line "") - (setq line (car (split-string (thing-at-point 'line) - "[\n\r]")))) - (format "%7d:%s: %s" - (line-number-at-pos) (marker-buffer marker) line)))) - -(defun helm-global-mark-ring-get-candidates () - (let ((marks global-mark-ring)) - (when marks - (cl-loop for i in marks - for gm = (unless (or (string-match - "^ " (format "%s" (marker-buffer i))) - (null (marker-buffer i))) - (helm-global-mark-ring-format-buffer i)) - when (and gm (not (member gm recip))) - collect gm into recip - finally return recip)))) - - -;;;; -;;; Insert from register -(defvar helm-source-register - (helm-build-sync-source "Registers" - :candidates #'helm-register-candidates - :action-transformer #'helm-register-action-transformer - :multiline t - :action nil) - "See (info \"(emacs)Registers\")") - -(defun helm-register-candidates () - "Collecting register contents and appropriate commands." - (cl-loop for (char . val) in register-alist - for key = (single-key-description char) - for string-actions = - (cond - ((numberp val) - (list (int-to-string val) - 'insert-register - 'increment-register)) - ((markerp val) - (let ((buf (marker-buffer val))) - (if (null buf) - (list "a marker in no buffer") - (list (concat - "a buffer position:" - (buffer-name buf) - ", position " - (int-to-string (marker-position val))) - 'jump-to-register - 'insert-register)))) - ((and (consp val) (window-configuration-p (car val))) - (list "window configuration." - 'jump-to-register)) - ((and (vectorp val) - (fboundp 'undo-tree-register-data-p) - (undo-tree-register-data-p (elt val 1))) - (list - "Undo-tree entry." - 'undo-tree-restore-state-from-register)) - ((or (and (vectorp val) (eq 'registerv (aref val 0))) - (and (consp val) (frame-configuration-p (car val)))) - (list "frame configuration." - 'jump-to-register)) - ((and (consp val) (eq (car val) 'file)) - (list (concat "file:" - (prin1-to-string (cdr val)) - ".") - 'jump-to-register)) - ((and (consp val) (eq (car val) 'file-query)) - (list (concat "file:a file-query reference: file " - (car (cdr val)) - ", position " - (int-to-string (car (cdr (cdr val)))) - ".") - 'jump-to-register)) - ((consp val) - (let ((lines (format "%4d" (length val)))) - (list (format "%s: %s\n" lines - (truncate-string-to-width - (mapconcat 'identity (list (car val)) - "^J") (- (window-width) 15))) - 'insert-register))) - ((stringp val) - (list - ;; without properties - (concat (substring-no-properties - val 0 (min (length val) helm-register-max-offset)) - (if (> (length val) helm-register-max-offset) - "[...]" "")) - 'insert-register - 'append-to-register - 'prepend-to-register)) - (t - "GARBAGE!")) - collect (cons (format "Register %3s:\n %s" key (car string-actions)) - (cons char (cdr string-actions))))) - -(defun helm-register-action-transformer (_actions register-and-functions) - "Decide actions by the contents of register." - (cl-loop with func-actions = - '((insert-register - "Insert Register" . - (lambda (c) (insert-register (car c)))) - (jump-to-register - "Jump to Register" . - (lambda (c) (jump-to-register (car c)))) - (append-to-register - "Append Region to Register" . - (lambda (c) (append-to-register - (car c) (region-beginning) (region-end)))) - (prepend-to-register - "Prepend Region to Register" . - (lambda (c) (prepend-to-register - (car c) (region-beginning) (region-end)))) - (increment-register - "Increment Prefix Arg to Register" . - (lambda (c) (increment-register - helm-current-prefix-arg (car c)))) - (undo-tree-restore-state-from-register - "Restore Undo-tree register" - (lambda (c) (and (fboundp 'undo-tree-restore-state-from-register) - (undo-tree-restore-state-from-register (car c)))))) - for func in (cdr register-and-functions) - for cell = (assq func func-actions) - when cell - collect (cdr cell))) - -;;;###autoload -(defun helm-mark-ring () - "Preconfigured `helm' for `helm-source-mark-ring'." - (interactive) - (helm :sources 'helm-source-mark-ring - :resume 'noresume - :buffer "*helm mark*")) - -;;;###autoload -(defun helm-global-mark-ring () - "Preconfigured `helm' for `helm-source-global-mark-ring'." - (interactive) - (helm :sources 'helm-source-global-mark-ring - :resume 'noresume - :buffer "*helm global mark*")) - -;;;###autoload -(defun helm-all-mark-rings () - "Preconfigured `helm' for `helm-source-global-mark-ring' and \ -`helm-source-mark-ring'." - (interactive) - (helm :sources '(helm-source-mark-ring - helm-source-global-mark-ring) - :resume 'noresume - :buffer "*helm mark ring*")) - -;;;###autoload -(defun helm-register () - "Preconfigured `helm' for Emacs registers." - (interactive) - (helm :sources 'helm-source-register - :resume 'noresume - :buffer "*helm register*")) - -;;;###autoload -(defun helm-show-kill-ring () - "Preconfigured `helm' for `kill-ring'. -It is drop-in replacement of `yank-pop'. - -First call open the kill-ring browser, next calls move to next line." - (interactive) - (let ((enable-recursive-minibuffers t)) - (helm :sources helm-source-kill-ring - :buffer "*helm kill ring*" - :resume 'noresume - :allow-nest t))) - -(defvar helm-kmacro-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c ?") 'helm-kmacro-help) - map)) - -;;;###autoload -(defun helm-execute-kmacro () - "Keyboard macros with helm interface. -Define your macros with `f3' and `f4'. -See (info \"(emacs) Keyboard Macros\") for detailed infos. -This command is useful when used with persistent action." - (interactive) - (helm :sources - (helm-build-sync-source "Kmacro" - :candidates (lambda () - (helm-fast-remove-dups - (cons (kmacro-ring-head) - kmacro-ring) - :test 'equal)) - :multiline t - :keymap helm-kmacro-map - :candidate-transformer - (lambda (candidates) - (cl-loop for c in candidates collect - (propertize (help-key-description (car c) nil) - 'helm-realvalue c))) - :persistent-help "Execute kmacro" - :action - (helm-make-actions - "Execute kmacro (`C-u ' to execute times)" - (lambda (candidate) - (interactive) - ;; Move candidate on top of list for next use. - (setq kmacro-ring (delete candidate kmacro-ring)) - (kmacro-push-ring) - (kmacro-split-ring-element candidate) - (kmacro-exec-ring-item - candidate helm-current-prefix-arg)))) - :buffer "*helm kmacro*")) - -(provide 'helm-ring) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-ring.el ends here diff --git a/elpa/helm-20150403.101/helm-semantic.el b/elpa/helm-20150403.101/helm-semantic.el deleted file mode 100644 index db68f013..00000000 --- a/elpa/helm-20150403.101/helm-semantic.el +++ /dev/null @@ -1,209 +0,0 @@ -;;; helm-semantic.el --- Helm interface for Semantic -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Daniel Hackney -;; Author: Daniel Hackney - -;; 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 . - -;;; Commentary: - -;; Uses `candidates-in-buffer' for speed. - -;;; Code: - -(require 'cl-lib) -(require 'semantic) -(require 'helm-imenu) - -(declare-function pulse-momentary-highlight-one-line "pulse.el" (point &optional face)) - -(defgroup helm-semantic nil - "Semantic tags related libraries and applications for helm." - :group 'helm) - -(defcustom helm-semantic-lynx-style-map t - "Use Arrow keys to jump to occurences." - :group 'helm-semantic - :type 'boolean) - -;;; keymap -(defvar helm-semantic-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c ?") 'helm-semantic-help) - (when helm-imenu-lynx-style-map - (define-key map (kbd "") 'helm-maybe-exit-minibuffer) - (define-key map (kbd "") 'helm-execute-persistent-action)) - (delq nil map))) - -;; Internals vars -(defvar helm-semantic--tags-cache nil) - -(defcustom helm-semantic-display-style 'semantic-format-tag-summarize - "Function to present a semantic tag." - :group 'helm-semantic - :type '(radio - (const :tag "Default" semantic-format-tag-summarize) - (const :tag "Prototype" semantic-format-tag-prototype))) - -(defun helm-semantic--fetch-candidates (tags depth &optional class) - "Write the contents of TAGS to the current buffer." - (let ((class class) cur-type) - (cl-dolist (tag tags) - (when (listp tag) - (cl-case (setq cur-type (semantic-tag-class tag)) - ((function variable type) - (let ((spaces (make-string (* depth 2) ?\s)) - (type-p (eq cur-type 'type))) - (unless (and (> depth 0) (not type-p)) - (setq class nil)) - (insert - (if (and class (not type-p)) - (format "%s%s(%s) " - spaces (if (< depth 2) "" "├►") class) - spaces) - ;; Save the tag for later - (propertize (funcall helm-semantic-display-style tag nil t) - 'semantic-tag tag) - "\n") - (and type-p (setq class (car tag))) - ;; Recurse to children - (unless (eq cur-type 'function) - (helm-semantic--fetch-candidates - (semantic-tag-components tag) (1+ depth) class)))) - - ;; Don't do anything with packages or includes for now - ((package include) - (insert - (propertize (funcall helm-semantic-display-style tag nil t) - 'semantic-tag tag) - "\n") - ) - ;; Catch-all - (t)))))) - -(defun helm-semantic-default-action (_candidate &optional persistent) - ;; By default, helm doesn't pass on the text properties of the selection. - ;; Fix this. - (helm-log-run-hook 'helm-goto-line-before-hook) - (with-current-buffer helm-buffer - (when (looking-at " ") - (goto-char (next-single-property-change - (point-at-bol) 'semantic-tag nil (point-at-eol)))) - (let ((tag (get-text-property (point) 'semantic-tag))) - (semantic-go-to-tag tag) - (unless persistent - (pulse-momentary-highlight-one-line (point)))))) - -(defun helm-semantic--maybe-set-needs-update () - (with-helm-current-buffer - (let ((tick (buffer-modified-tick))) - (unless (eq helm-cached-imenu-tick tick) - (setq helm-cached-imenu-tick tick) - (semantic-parse-tree-set-needs-update))))) - -(defvar helm-source-semantic nil) - -(defclass helm-semantic-source (helm-source-in-buffer) - ((init :initform (lambda () - (helm-semantic--maybe-set-needs-update) - (setq helm-semantic--tags-cache (semantic-fetch-tags)) - (with-current-buffer (helm-candidate-buffer 'global) - (let ((major-mode (with-helm-current-buffer major-mode))) - (helm-semantic--fetch-candidates helm-semantic--tags-cache 0))))) - (get-line :initform 'buffer-substring) - (persistent-help :initform "Show this entry") - (keymap :initform 'helm-semantic-map) - (mode-line :initform helm-semantic-mode-line) - (persistent-action :initform (lambda (elm) - (helm-semantic-default-action elm t) - (helm-highlight-current-line))) - (action :initform 'helm-semantic-default-action))) - -(defcustom helm-semantic-fuzzy-match nil - "Enable fuzzy matching in `helm-source-semantic'." - :group 'helm-semantic - :type 'boolean - :set (lambda (var val) - (set var val) - (setq helm-source-semantic - (helm-make-source "Semantic Tags" 'helm-semantic-source - :fuzzy-match helm-semantic-fuzzy-match)))) - -;;;###autoload -(defun helm-semantic (arg) - "Preconfigured `helm' for `semantic'. -If ARG is supplied, pre-select symbol at point instead of current" - (interactive "P") - (let ((tag (helm-aif (semantic-current-tag-parent) - (cons (format "\\_<%s\\_>" (car it)) - (format "\\_<%s\\_>" (car (semantic-current-tag)))) - (format "\\_<%s\\_>" (car (semantic-current-tag)))))) - (unless helm-source-semantic - (setq helm-source-semantic - (helm-make-source "Semantic Tags" 'helm-semantic-source - :fuzzy-match helm-semantic-fuzzy-match))) - (helm :sources 'helm-source-semantic - :candidate-number-limit 9999 - :preselect (if arg - (thing-at-point 'symbol) - tag) - :buffer "*helm semantic*"))) - -;;;###autoload -(defun helm-semantic-or-imenu (arg) - "Run `helm' with `semantic' or `imenu'. -If ARG is supplied, pre-select symbol at point instead of current -semantic tag in scope. - -If `semantic-mode' is active in the current buffer, then use -semantic for generating tags, otherwise fall back to `imenu'. -Fill in the symbol at point by default." - (interactive "P") - (unless helm-source-semantic - (setq helm-source-semantic - (helm-make-source "Semantic Tags" 'helm-semantic-source - :fuzzy-match helm-semantic-fuzzy-match))) - (unless helm-source-imenu - (setq helm-source-imenu - (helm-make-source "Imenu" 'helm-imenu-source - :fuzzy-match helm-imenu-fuzzy-match))) - (let* ((source (if (semantic-active-p) - 'helm-source-semantic - 'helm-source-imenu)) - (imenu-p (eq source 'helm-source-imenu)) - (imenu-auto-rescan imenu-p) - (helm-execute-action-at-once-if-one - (and imenu-p - helm-imenu-execute-action-at-once-if-one)) - (tag (helm-aif (semantic-current-tag-parent) - (cons (format "\\_<%s\\_>" (car it)) - (format "\\_<%s\\_>" (car (semantic-current-tag)))) - (format "\\_<%s\\_>" (car (semantic-current-tag)))))) - (helm :sources source - :candidate-number-limit 9999 - :preselect (if (or arg imenu-p) - (thing-at-point 'symbol) - tag) - :buffer "*helm semantic/imenu*"))) - -(provide 'helm-semantic) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-semantic.el ends here diff --git a/elpa/helm-20150403.101/helm-source.el b/elpa/helm-20150403.101/helm-source.el deleted file mode 100644 index e229dcec..00000000 --- a/elpa/helm-20150403.101/helm-source.el +++ /dev/null @@ -1,1109 +0,0 @@ -;;; helm-source.el --- Helm source creation. -*- lexical-binding: t -*- - -;; Copyright (C) 2015 Thierry Volpiatto - -;; Author: Thierry Volpiatto -;; URL: http://github.com/emacs-helm/helm - -;; 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 . - -;;; Commentary: - -;; Interface to create helm sources easily. -;; Actually the eieo objects are transformed in alist for compatibility. -;; In the future this package should allow creating source as eieo objects -;; without conversion to alist, teaching helm to read such a structure. -;; The compatibility with alists would be kept. - -;;; Code: - -(require 'cl-lib) -(require 'eieio) - - -(defgeneric helm--setup-source (source) - "Prepare slots and handle slot errors before creating a helm source.") - -(defgeneric helm-setup-user-source (source) - "Allow users modifying slots in SOURCE just before creation.") - - -;;; Classes for sources -;; -;; -(defclass helm-source () - ((name - :initarg :name - :initform nil - :custom string - :documentation - " The name of the source. - A string which is also the heading which appears - above the list of matches from the source. Must be unique.") - - (header-name - :initarg :header-name - :initform nil - :custom function - :documentation - " A function returning the display string of the header. - Its argument is the name of the source. This attribute is useful to - add an additional information with the source name. - It doesn't modify the name of the source.") - - (init - :initarg :init - :initform nil - :custom function - :documentation - " Function called with no parameters when helm is started. - It is useful for collecting current state information which can be - used to create the list of candidates later. - Initialization of `candidates-in-buffer' is done here - with `helm-init-candidates-in-buffer'.") - - (candidates - :initarg :candidates - :initform nil - :custom (choice function list) - :documentation - " Specifies how to retrieve candidates from the source. - It can either be a variable name, a function called with no parameters - or the actual list of candidates. - - The list must be a list whose members are strings, symbols - or (DISPLAY . REAL) pairs. - - In case of (DISPLAY . REAL) pairs, the DISPLAY string is shown - in the Helm buffer, but the REAL one is used as action - argument when the candidate is selected. This allows a more - readable presentation for candidates which would otherwise be, - for example, too long or have a common part shared with other - candidates which can be safely replaced with an abbreviated - string for display purposes. - - Note that if the (DISPLAY . REAL) form is used then pattern - matching is done on the displayed string, not on the real - value.") - - (update - :initarg :update - :initform nil - :custom function - :documentation - " Function called with no parameters at before \"init\" function - when `helm-force-update' is called.") - - (cleanup - :initarg :cleanup - :initform nil - :custom function - :documentation - " Function called with no parameters when *helm* buffer is - closed. It is useful for killing unneeded candidates buffer. - - Note that the function is executed BEFORE performing action.") - - (delayed - :initarg :delayed - :initform nil - :custom (choice null integer) - :documentation - " Candidates from the source are shown only if the user stops - typing and is idle for `helm-idle-delay' seconds. - If a value is given to delayed attr, this value is used instead only - if it is > to `helm-idle-delay'.") - - (keymap - :initarg :keymap - :initform nil - :custom sexp - :documentation - " Specific keymap for this source. - It is useful to have a keymap per source when using more than - one source. Otherwise, a keymap can be set per command with - `helm' argument KEYMAP. NOTE: when a source have `helm-map' as - keymap attr, the global value of `helm-map' will override the - actual local one.") - - (action - :initarg :action - :initform 'identity - :custom (alist :key-type string - :value-type function) - :documentation - " It is a list of (DISPLAY . FUNCTION) pairs or FUNCTION. - FUNCTION is called with one parameter: the selected candidate. - - An action other than the default can be chosen from this list - of actions for the currently selected candidate (by default - with TAB). The DISPLAY string is shown in the completions - buffer and the FUNCTION is invoked when an action is - selected. The first action of the list is the default. - - You should use `helm-make-actions' to build this alist easily.") - - (persistent-action - :initarg :persistent-action - :initform nil - :custom function - :documentation - " Can be a either a Function called with one parameter (the - selected candidate) or a cons cell where first element is this - same function and second element a symbol (e.g never-split) - that inform `helm-execute-persistent-action'to not split his - window to execute this persistent action.") - - (persistent-help - :initarg :persistent-help - :initform nil - :custom string - :documentation - " A string to explain persistent-action of this source. It also - accepts a function or a variable name. - It will be displayed in source header.") - - (help-message - :initarg :help-message - :initform nil - :custom (choice string function) - :documentation - " Help message for this source. - If not present, `helm-help-message' value will be used.") - - (multiline - :initarg :multiline - :initform nil - :custom boolean - :documentation - " Enable to selection multiline candidates.") - - (requires-pattern - :initarg :requires-pattern - :initform nil - :custom integer - :documentation - " If present matches from the source are shown only if the - pattern is not empty. Optionally, it can have an integer - parameter specifying the required length of input which is - useful in case of sources with lots of candidates.") - - (candidate-transformer - :initarg :candidate-transformer - :initform nil - :custom (choice function list) - :documentation - " It's a function or a list of functions called with one argument - when the completion list from the source is built. The argument - is the list of candidates retrieved from the source. The - function should return a transformed list of candidates which - will be used for the actual completion. If it is a list of - functions, it calls each function sequentially. - - This can be used to transform or remove items from the list of - candidates. - - Note that `candidates' is run already, so the given transformer - function should also be able to handle candidates with (DISPLAY - . REAL) format.") - - (filtered-candidate-transformer - :initarg :filtered-candidate-transformer - :initform nil - :custom (choice function list) - :documentation - " It has the same format as `candidate-transformer', except the - function is called with two parameters: the candidate list and - the source. - - This transformer is run on the candidate list which is already - filtered by the current pattern. While `candidate-transformer' - is run only once, it is run every time the input pattern is - changed. - - It can be used to transform the candidate list dynamically, for - example, based on the current pattern. - - In some cases it may also be more efficent to perform candidate - transformation here, instead of with `candidate-transformer' - even if this transformation is done every time the pattern is - changed. For example, if a candidate set is very large then - `candidate-transformer' transforms every candidate while only - some of them will actually be displayed due to the limit - imposed by `helm-candidate-number-limit'. - - Note that `candidates' and `candidate-transformer' is run - already, so the given transformer function should also be able - to handle candidates with (DISPLAY . REAL) format.") - - (filter-one-by-one - :initarg :filter-one-by-one - :initform nil - :custom (choice function list) - :documentation - " A transformer function that treat candidates one by one. - It is called with one arg the candidate. - It is faster than `filtered-candidate-transformer' or - `candidates-transformer', but should be used only in sources - that recompute constantly their candidates, e.g `helm-source-find-files'. - Filtering happen early and candidates are treated - one by one instead of re-looping on the whole list. - If used with `filtered-candidate-transformer' or `candidates-transformer' - these functions should treat the candidates transformed by the - `filter-one-by-one' function in consequence.") - - (display-to-real - :initarg :display-to-real - :initform nil - :custom function - :documentation - " Function called with one parameter; the selected candidate. - - The function transforms the selected candidate, and the result - is passed to the action function. The display-to-real - attribute provides another way to pass to action other string than - the one shown in Helm buffer. - - Traditionally, it is possible to make candidates, - candidate-transformer or filtered-candidate-transformer - function return a list with (DISPLAY . REAL) pairs. But if REAL - can be generated from DISPLAY, display-to-real is more - convenient and faster. - - NOTE: This is deprecated and you have better time using `filter-one-by-one'.") - - (real-to-display - :initarg :real-to-display - :initform nil - :custom function - :documentation - " Function called with one parameter; the selected candidate. - The real value of candidates will be shown in display. - See `display-to-real'.") - - (action-transformer - :initarg :action-transformer - :initform nil - :custom (choice function list) - :documentation - " It's a function or a list of functions called with two - arguments when the action list from the source is - assembled. The first argument is the list of actions, the - second is the current selection. If it is a list of functions, - it calls each function sequentially. - - The function should return a transformed action list. - - This can be used to customize the list of actions based on the - currently selected candidate.") - - (pattern-transformer - :initarg :pattern-transformer - :initform nil - :custom (choice function list) - :documentation - " It's a function or a list of functions called with one argument - before computing matches. Its argument is `helm-pattern'. - Functions should return transformed `helm-pattern'. - - It is useful to change interpretation of `helm-pattern'.") - - (candidate-number-limit - :initarg :candidate-number-limit - :initform nil - :custom integer - :documentation - " Override `helm-candidate-number-limit' only for this source.") - - (volatile - :initarg :volatile - :initform nil - :custom boolean - :documentation - " Indicates the source assembles the candidate list dynamically, - so it shouldn't be cached within a single Helm - invocation. It is only applicable to synchronous sources, - because asynchronous sources are not cached.") - - (match - :initarg :match - :initform nil - :custom (choice function list) - :documentation - " List of functions called with one parameter: a candidate. The - function should return non-nil if the candidate matches the - current pattern (see variable `helm-pattern'). - - When using `candidates-in-buffer' its default value is `identity' and - don't have to be changed, use the `search' slot instead. - - This attribute allows the source to override the default - pattern matching based on `string-match'. It can be used, for - example, to implement a source for file names and do the - pattern matching on the basename of files, since it's more - likely one is typing part of the basename when searching for a - file, instead of some string anywhere else in its path. - - If the list contains more than one function then the list of - matching candidates from the source is constructed by appending - the results after invoking the first function on all the - potential candidates, then the next function, and so on. The - matching candidates supplied by the first function appear first - in the list of results and then results from the other - functions, respectively. - - This attribute has no effect for asynchronous sources (see - attribute `candidates'), since they perform pattern matching - themselves. - - Note that FUZZY-MATCH slot will overhide value of this slot.") - - (fuzzy-match - :initarg :fuzzy-match - :initform nil - :custom boolean - :documentation - " Enable fuzzy matching in this source. - This will overwrite settings in MATCH slot, and for - sources built with child class `helm-source-in-buffer' the SEARCH slot. - This is an easy way of enabling fuzzy matching, but you can use the MATCH - or SEARCH slots yourself if you want something more elaborated, mixing - different type of match (See `helm-source-buffers' class for example).") - - (nomark - :initarg :nomark - :initform nil - :custom boolean - :documentation - " Don't allow marking candidates when this attribute is present.") - - (nohighlight - :initarg :nohighlight - :initform nil - :custom boolean - :documentation - " Disable highlighting matches in this source. - This will disable generic highlighting of matches, - but some specialized highlighting can be done from elsewhere, - i.e from `filtered-candidate-transformer' or `filter-one-by-one' slots. - So use this to either disable completely highlighting in your source, - or to disable highlighting and use a specialized highlighting matches - function for this source. - Remember that this function should run AFTER all filter functions if those - filter functions are modifying face properties, though it is possible to - avoid this by using new `add-face-text-property' in your filter functions.") - - (allow-dups - :initarg :allow-dups - :initform nil - :custom boolean - :documentation - " Allow helm collecting duplicates candidates.") - - (recenter - :initarg :recenter - :initform nil - :custom boolean - :documentation - " `recenter' after jumping to candidate.") - - (history - :initarg :history - :initform nil - :custom symbol - :documentation - " Allow passing history variable to helm from source. - It should be a quoted symbol.") - - (coerce - :initarg :coerce - :initform nil - :custom function - :documentation - " It's a function called with one argument: the selected candidate. - This function is intended for type convertion. In normal case, - the selected candidate (string) is passed to action - function. If coerce function is specified, it is called just - before action function. - - Example: converting string to symbol - (coerce . intern)") - - (mode-line - :initarg :mode-line - :initform nil - :custom (choice string sexp) - :documentation - " Source local `helm-mode-line-string' (included in - `mode-line-format'). It accepts also variable/function name.") - - (header-line - :initarg :header-line - :initform nil - :custom (choice string function) - :documentation - " Source local `header-line-format'. - It accepts also variable/function name.") - - (resume - :initarg :resume - :initform nil - :custom function - :documentation - " Function called with no parameters at end of initialization - when `helm-resume' is started. - If this function try to do something against `helm-buffer', \(e.g updating, - searching etc...\) probably you should run it in a timer to ensure - `helm-buffer' is ready.") - - (follow - :initarg :follow - :initform nil - :custom integer - :documentation - " Enable `helm-follow-mode' for this source only. - You must give it a value of 1 or -1, though giving a -1 value - is surely not what you want, e.g: (follow . 1) - - See `helm-follow-mode' for more infos.") - - (follow-delay - :initarg :follow-delay - :initform nil - :custom integer - :documentation - " `helm-follow-mode' will execute persistent-action after this delay. - Otherwise value of `helm-follow-input-idle-delay' is used if non--nil, - If none of these are found fallback to `helm-input-idle-delay'.") - - (dont-plug - :initarg :dont-plug - :initform '(helm-compile-source--persistent-help) - :custom list - :documentation - " A list of compile functions plugin to ignore.") - - (migemo - :initarg :migemo - :initform nil - :custom boolean - :documentation - " Needed for Japanese input with helm-migemo.el. - If you are not Japanese, ignore this.") - - (matchplugin - :initarg :matchplugin - :initform t - :custom boolean) - - (match-part - :initarg :match-part - :initform nil - :custom function - :documentation - " Allow matching only one part of candidate. - If source contain match-part attribute, match is computed only - on part of candidate returned by the call of function provided - by this attribute. The function should have one arg, candidate, - and return only a specific part of candidate.") - - (before-init-hook - :initarg :before-init-hook - :initform nil - :custom symbol - :documentation - " A local hook that run at beginning of initilization of this source. - i.e Before the creation of `helm-buffer'.") - - (after-init-hook - :initarg :after-init-hook - :initform nil - :custom symbol - :documentation - " A local hook that run at end of initilization of this source. - i.e After the creation of `helm-buffer'.")) - - "Main interface to define helm sources." - :abstract t) - -(defclass helm-source-sync (helm-source) - ((candidates - :initform '("ERROR: You must specify the `candidates' slot, either with a list or a function")) - - (dont-plug - :initform '(helm-compile-source--match-plugin - helm-compile-source--persistent-help)) - - (match-strict - :initarg :match-strict - :initform nil - :custom function - :documentation - " When specifying a match function within a source and - helm-match-plugin is enabled, the result of all matching - functions will be concatened, which in some cases is not what - is wanted. When using `match-strict' only this or these - functions will be used. You can specify those functions as a - list of functions or a single symbol function. - - NOTE: This have the same effect as using :MATCHPLUGIN nil.")) - - "Use this class to make helm sources using a list of candidates. -This list should be given as a normal list, a variable handling a list -or a function returning a list. -Matching is done basically with `string-match' against each candidate.") - -(defclass helm-source-async (helm-source) - ((candidates-process - :initarg :candidates-process - :initform nil - :custom function - :documentation - " You should use this attribute when using a function involving - an async process instead of `candidates'. - The function must return a process.") - - (matchplugin :initform nil) - (dont-plug :initform '(helm-compile-source--match-plugin - helm-compile-source--persistent-help))) - - "Use this class to define a helm source calling an external process. -The :candidates slot is not allowed even if described because this class -inherit from `helm-source'.") - -(defclass helm-source-in-buffer (helm-source) - ((init - :initform 'helm-default-init-source-in-buffer-function) - - (data - :initarg :data - :initform nil - :custom (choice list string) - :documentation - " A string or a list that will be used to feed the `helm-candidates-buffer'. - This data will be passed in a function added to the init slot and - the buffer will be build with `helm-init-candidates-in-buffer'. - This is an easy and fast method to build a `candidates-in-buffer' source.") - - (dont-plug - :initform '(helm-compile-source--candidates-in-buffer - helm-compile-source--match-plugin - helm-compile-source--persistent-help)) - - (candidates - :initform 'helm-candidates-in-buffer) - - (volatile - :initform t) - - (match - :initform '(identity)) - - (get-line - :initarg :get-line - :initform 'buffer-substring-no-properties - :custom function - :documentation - " A function like `buffer-substring-no-properties' or `buffer-substring'. - This function converts point of line-beginning and point of line-end, - which represents a candidate computed by `helm-candidates-in-buffer'. - By default, `helm-candidates-in-buffer' uses - `buffer-substring-no-properties'.") - - (search - :initarg :search - :initform '(helm-candidates-in-buffer-search-default-fn) - :custom (choice function list) - :documentation - " List of functions like `re-search-forward' or `search-forward'. - Buffer search function used by `helm-candidates-in-buffer'. - By default, `helm-candidates-in-buffer' uses `re-search-forward'. - The function should take one arg PATTERN. - If your search function needs to handle negation like matchplugin, - this function should returns in such case a cons cell of two integers defining - the beg and end positions to match in the line previously matched by - `re-search-forward' or similar, and move point to next line - (See how the `helm-mp-3-search-base' and `helm-fuzzy-search' functions are working). - - NOTE: FUZZY-MATCH slot will overhide value of this slot.") - - (search-strict - :initarg :search-strict - :initform nil - :custom function - :documentation - " When specifying a search function within a source and - helm-match-plugin is enabled, the result of all searching - functions will be concatened, which in some cases is not what - is wanted. When using `search-strict' only this or these - functions will be used. You can specify those functions as a - list of functions or a single symbol function. - - NOTE: This have the same effect as using a nil value for - :MATCHPLUGIN slot.")) - - "Use this source to make helm sources storing candidates inside a buffer. -Contrarily to `helm-source-sync' candidates are matched using a function -like `re-search-forward', see below documentation of :search slot.") - -(defclass helm-source-dummy (helm-source) - ((candidates - :initform '("dummy")) - - (filtered-candidate-transformer - :initform 'helm-dummy-candidate) - - (matchplugin - :initform nil) - - (accept-empty - :initarg :accept-empty - :initform t - :custom boolean - :documentation - " Allow exiting with an empty string. - You should keep the default value.") - - (match - :initform 'identity) - - (volatile - :initform t))) - -(defclass helm-source-in-file (helm-source-in-buffer) - ((init :initform (lambda () - (let ((file (helm-attr 'candidates-file))) - (with-current-buffer (helm-candidate-buffer 'global) - (insert-file-contents file))))) - (candidates-file - :initarg :candidates-file - :initform nil - :custom string - :documentation "A filename.")) - - "The contents of the file will be used as candidates in buffer.") - - -;;; Classes for types. -;; -;; Files -(defclass helm-type-file (helm-source) () - "A class to define helm type file.") - -(defmethod helm--setup-source :primary ((_source helm-type-file))) - -(defmethod helm--setup-source :before ((source helm-type-file)) - (set-slot-value source 'action - (helm-make-actions - "Find file" 'helm-find-many-files - "Find file as root" 'helm-find-file-as-root - "Find file other window" 'find-file-other-window - "Find file other frame" 'find-file-other-frame - "Open dired in file's directory" 'helm-open-dired - "Grep File(s) `C-u recurse'" 'helm-find-files-grep - "Zgrep File(s) `C-u Recurse'" 'helm-ff-zgrep - "Pdfgrep File(s)" 'helm-ff-pdfgrep - "Insert as org link" 'helm-files-insert-as-org-link - "Checksum File" 'helm-ff-checksum - "Ediff File" 'helm-find-files-ediff-files - "Ediff Merge File" 'helm-find-files-ediff-merge-files - "Etags `M-., C-u tap, C-u C-u reload tag file'" - 'helm-ff-etags-select - "View file" 'view-file - "Insert file" 'insert-file - "Add marked files to file-cache" 'helm-ff-cache-add-file - "Delete file(s)" 'helm-delete-marked-files - "Open file externally (C-u to choose)" 'helm-open-file-externally - "Open file with default tool" 'helm-open-file-with-default-tool - "Find file in hex dump" 'hexl-find-file)) - (set-slot-value source 'persistent-help "Show this file") - (set-slot-value source 'action-transformer '(helm-transform-file-load-el - helm-transform-file-browse-url - helm-transform-file-cache)) - (set-slot-value source 'candidate-transformer '(helm-skip-boring-files - helm-highlight-files - helm-w32-pathname-transformer))) - -;; Bookmarks -(defclass helm-type-bookmark (helm-source) () - "A class to define type bookmarks.") - -(defmethod helm--setup-source :primary ((_source helm-type-bookmark))) - -(defmethod helm--setup-source :before ((source helm-type-bookmark)) - (set-slot-value source 'action (helm-make-actions - "Jump to bookmark" 'helm-bookmark-jump - "Jump to BM other window" 'helm-bookmark-jump-other-window - "Bookmark edit annotation" 'bookmark-edit-annotation - "Bookmark show annotation" 'bookmark-show-annotation - "Delete bookmark(s)" 'helm-delete-marked-bookmarks - "Edit Bookmark" 'helm-bookmark-edit-bookmark - "Rename bookmark" 'helm-bookmark-rename - "Relocate bookmark" 'bookmark-relocate)) - (set-slot-value source 'keymap helm-bookmark-map) - (set-slot-value source 'mode-line helm-bookmark-mode-line-string)) - -;; Buffers -(defclass helm-type-buffer (helm-source) () - "A class to define type buffer.") - -(defmethod helm--setup-source :primary ((_source helm-type-buffer))) - -(defmethod helm--setup-source :before ((source helm-type-buffer)) - (set-slot-value source 'action (helm-make-actions - "Switch to buffer(s)" 'helm-switch-to-buffers - (lambda () (and (locate-library "popwin") "Switch to buffer in popup window")) - 'popwin:popup-buffer - "Switch to buffer(s) other window `C-c o'" - 'helm-switch-to-buffers-other-window - "Switch to buffer other frame `C-c C-o'" 'switch-to-buffer-other-frame - (lambda () (and (locate-library "elscreen") "Display buffer in Elscreen")) - 'helm-find-buffer-on-elscreen - "Query replace regexp `C-M-%'" 'helm-buffer-query-replace-regexp - "Query replace `M-%'" 'helm-buffer-query-replace - "View buffer" 'view-buffer - "Display buffer" 'display-buffer - "Grep buffers `M-g s' (C-u grep all buffers)" 'helm-zgrep-buffers - "Multi occur buffer(s) `C-s'" 'helm-multi-occur-as-action - "Revert buffer(s) `M-U'" 'helm-revert-marked-buffers - "Insert buffer" 'insert-buffer - "Kill buffer(s) `M-D'" 'helm-kill-marked-buffers - "Diff with file `C-='" 'diff-buffer-with-file - "Ediff Marked buffers `C-c ='" 'helm-ediff-marked-buffers - "Ediff Merge marked buffers `M-='" (lambda (candidate) - (helm-ediff-marked-buffers candidate t)))) - (set-slot-value source 'persistent-help "Show this buffer") - (set-slot-value source 'filtered-candidate-transformer '(helm-skip-boring-buffers - helm-buffers-sort-transformer - helm-highlight-buffers))) - -;; Functions -(defclass helm-type-function (helm-source) () - "A class to define helm type function.") - -(defmethod helm--setup-source :primary ((_source helm-type-function))) - -(defmethod helm--setup-source :before ((source helm-type-function)) - (set-slot-value source 'action (helm-make-actions - "Describe command" 'describe-function - "Add command to kill ring" 'helm-kill-new - "Go to command's definition" 'find-function - "Debug on entry" 'debug-on-entry - "Cancel debug on entry" 'cancel-debug-on-entry - "Trace function" 'trace-function - "Trace function (background)" 'trace-function-background - "Untrace function" 'untrace-function)) - (set-slot-value source 'action-transformer 'helm-transform-function-call-interactively) - (set-slot-value source 'candidate-transformer 'helm-mark-interactive-functions) - (set-slot-value source 'coerce 'helm-symbolify)) - -;; Commands -(defclass helm-type-command (helm-source) () - "A class to define helm type command.") - -(defmethod helm--setup-source :primary ((_source helm-type-command))) - -(defmethod helm--setup-source :before ((source helm-type-command)) - (set-slot-value source 'action (append (helm-make-actions - "Call interactively" 'helm-call-interactively) - (helm-actions-from-type-function))) - (set-slot-value source 'coerce 'helm-symbolify) - (set-slot-value source 'persistent-action 'describe-function)) - - -;;; Error functions -;; -;; -(defun helm-default-init-source-in-buffer-function () - (helm-init-candidates-in-buffer 'global - '("ERROR: No buffer handling your data, use either the `init' slot or the `data' slot."))) - - -;;; Internal Builder functions. -;; -;; -(defun helm--create-source (object) - "[INTERNAL] Build a helm source from OBJECT. -Where OBJECT is an instance of an eieio class." - (cl-loop for s in (object-slots object) - for slot-val = (slot-value object s) - when slot-val - collect (cons s (unless (eq t slot-val) slot-val)))) - -(defun helm-make-source (name class &rest args) - "Build a `helm' source named NAME with ARGS for CLASS. -Argument NAME is a string which define the source name, so no need to use -the keyword :name in your source, NAME will be used instead. -Argument CLASS is an eieio class object. -Arguments ARGS are keyword value pairs as defined in CLASS." - (declare (indent 2)) - (let ((source (apply #'make-instance class name args))) - (set-slot-value source 'name name) - (helm--setup-source source) - (helm-setup-user-source source) - (helm--create-source source))) - -(defun helm-make-type (class &rest args) - (let ((source (apply #'make-instance class args))) - (set-slot-value source 'name nil) - (helm--setup-source source) - (helm--create-source source))) - -(defun helm-source-mp-get-search-or-match-fns (source method) - (require 'helm-match-plugin) - (let ((searchers (and (eq method 'search) - helm-mp-default-search-functions)) - (defmatch (helm-aif (slot-value source 'match) - (helm-mklist it))) - (defmatch-strict (helm-aif (and (eq method 'match) - (slot-value source 'match-strict)) - (helm-mklist it))) - (defsearch (helm-aif (and (eq method 'search) - (slot-value source 'search)) - (helm-mklist it))) - (defsearch-strict (helm-aif (and (eq method 'search-strict) - (slot-value source 'search-strict)) - (helm-mklist it)))) - (cl-case method - (match (cond (defmatch-strict) - (defmatch - (append helm-mp-default-match-functions defmatch)) - (t helm-mp-default-match-functions))) - (search (cond (defsearch-strict) - (defsearch - (append searchers defsearch)) - (t searchers)))))) - - -;;; Modifiers -;; -(cl-defun helm-source-add-action-to-source-if (name fn source predicate - &optional (index 4)) - "Same as `helm-add-action-to-source-if' but for SOURCE defined as eieio object. -You can use this inside a `helm--setup-source' method for a SOURCE defined as -an eieio class." - (let* ((actions (slot-value source 'action)) - (action-transformers (slot-value source 'action-transformer)) - (new-action (list (cons name fn))) - (transformer `(lambda (actions candidate) - (cond ((funcall (quote ,predicate) candidate) - (helm-append-at-nth - actions (quote ,new-action) ,index)) - (t actions))))) - (when (symbolp actions) - (set-slot-value source 'action (list (cons "Default action" actions)))) - (when (symbolp action-transformers) - (setq action-transformers (list action-transformers))) - (set-slot-value - source - 'action-transformer - (delq nil (append (list transformer) action-transformers))))) - -;;; Methods to access types slots. -;; -;; -(defmethod helm-source-get-action-from-type ((object helm-type-file)) - (slot-value object 'action)) - -(defmethod helm-source-get-action-from-type ((object helm-type-buffer)) - (slot-value object 'action)) - -(defmethod helm-source-get-action-from-type ((object helm-type-bookmark)) - (slot-value object 'action)) - -(defmethod helm-source-get-action-from-type ((object helm-type-function)) - (slot-value object 'action)) - - -;;; Methods to build sources. -;; -;; -(defun helm-source--persistent-help-string (string source) - (substitute-command-keys - (concat "\\\\[helm-execute-persistent-action]: " - (or (format "%s (keeping session)" string) - (slot-value source 'header-line))))) - -(defun helm-source--header-line (source) - (substitute-command-keys - (concat "\\\\[helm-execute-persistent-action]: " - (helm-aif (or (slot-value source 'persistent-action) - (slot-value source 'action)) - (cond ((or (symbolp it) (functionp it)) - (helm-symbol-name it)) - ((listp it) - (let ((action (car it))) - ;; It comes from :action ("foo" . function). - (if (stringp (car action)) - (car action) - ;; It comes from :persistent-action - ;; (function . 'nosplit) Fix Issue #788. - (if (or (symbolp action) - (functionp action)) - (helm-symbol-name action))))) - (t "")) - "") - " (keeping session)"))) - -(defmethod helm--setup-source :primary ((_source helm-source))) - -(defmethod helm--setup-source :before ((source helm-source)) - (helm-aif (slot-value source 'keymap) - (and (symbolp it) (set-slot-value source 'keymap (symbol-value it)))) - (set-slot-value source 'header-line (helm-source--header-line source)) - (helm-aif (slot-value source 'persistent-help) - (set-slot-value source 'header-line (helm-source--persistent-help-string it source))) - (when (and (slot-value source 'fuzzy-match) helm-fuzzy-sort-fn) - (set-slot-value source 'filtered-candidate-transformer - (helm-aif (slot-value source 'filtered-candidate-transformer) - (append (helm-mklist it) - (list helm-fuzzy-sort-fn)) - (list helm-fuzzy-sort-fn)))) - (unless (slot-value source 'nohighlight) - (set-slot-value source 'filtered-candidate-transformer - (helm-aif (slot-value source 'filtered-candidate-transformer) - (append (helm-mklist it) - (list #'helm-fuzzy-highlight-matches)) - (list #'helm-fuzzy-highlight-matches))))) - -(defmethod helm-setup-user-source ((_source helm-source))) - -(defmethod helm--setup-source ((source helm-source-sync)) - (when (slot-value source 'fuzzy-match) - (helm-aif (slot-value source 'match) - (set-slot-value source 'match (append (helm-mklist it) - (list helm-fuzzy-match-fn))) - (set-slot-value source 'match helm-fuzzy-match-fn))) - (when (slot-value source 'matchplugin) - (set-slot-value source 'match - (helm-source-mp-get-search-or-match-fns source 'match)))) - -(defmethod helm--setup-source ((source helm-source-in-buffer)) - (let ((cur-init (slot-value source 'init))) - (helm-aif (slot-value source 'data) - (set-slot-value - source - 'init (delq - nil - (list - (and (null (eq 'helm-default-init-source-in-buffer-function - cur-init)) - cur-init) - (lambda () - (helm-init-candidates-in-buffer - 'global - (if (functionp it) (funcall it) it)))))))) - (when (slot-value source 'fuzzy-match) - (helm-aif (slot-value source 'search) - (set-slot-value source 'search (append (helm-mklist it) - (list helm-fuzzy-search-fn))) - (set-slot-value source 'search (list helm-fuzzy-search-fn)))) - (when (slot-value source 'matchplugin) - (set-slot-value source 'search (helm-source-mp-get-search-or-match-fns source 'search))) - (let ((mtc (slot-value source 'match))) - (cl-assert (or (equal '(identity) mtc) - (eq 'identity mtc)) - nil "Invalid slot value for `match'") - (cl-assert (eq (slot-value source 'volatile) t) - nil "Invalid slot value for `volatile'"))) - -(defmethod helm--setup-source ((source helm-source-async)) - (cl-assert (null (slot-value source 'candidates)) - nil "Incorrect use of `candidates' use `candidates-process' instead") - (cl-assert (null (slot-value source 'matchplugin)) - nil "`matchplugin' not allowed in async sources.")) - -(defmethod helm--setup-source ((source helm-source-dummy)) - (let ((mtc (slot-value source 'match))) - (cl-assert (or (equal '(identity) mtc) - (eq 'identity mtc)) - nil "Invalid slot value for `match'") - (cl-assert (eq (slot-value source 'volatile) t) - nil "Invalid slot value for `volatile'") - (cl-assert (equal (slot-value source 'candidates) '("dummy")) - nil "Invalid slot value for `candidates'") - (cl-assert (eq (slot-value source 'accept-empty) t) - nil "Invalid slot value for `accept-empty'"))) - - -;;; User functions -;; -;; Sources -(defmacro helm-build-sync-source (name &rest args) - "Build a synchronous helm source with name NAME. -Args ARGS are keywords provided by `helm-source-sync'." - (declare (indent 1)) - `(helm-make-source ,name 'helm-source-sync ,@args)) - -(defmacro helm-build-async-source (name &rest args) - "Build a asynchronous helm source with name NAME. -Args ARGS are keywords provided by `helm-source-async'." - (declare (indent 1)) - `(helm-make-source ,name 'helm-source-async ,@args)) - -(defmacro helm-build-in-buffer-source (name &rest args) - "Build a helm source with name NAME using `candidates-in-buffer' method. -Args ARGS are keywords provided by `helm-source-in-buffer'." - (declare (indent 1)) - `(helm-make-source ,name 'helm-source-in-buffer ,@args)) - -(defmacro helm-build-dummy-source (name &rest args) - "Build a helm source with name NAME using `dummy' method. -Args ARGS are keywords provided by `helm-source-dummy'." - (declare (indent 1)) - `(helm-make-source ,name 'helm-source-dummy ,@args)) - -(defmacro helm-build-in-file-source (name file &rest args) - "Build a helm source with NAME name using `candidates-in-files' method. -Arg FILE is a filename, the contents of this file will be -used as candidates in buffer. -Args ARGS are keywords provided by `helm-source-in-file'." - (declare (indent 1)) - `(helm-make-source ,name 'helm-source-in-file - :candidates-file ,file ,@args)) - -;; Types -(defun helm-actions-from-type-file () - (let ((source (make-instance 'helm-type-file))) - (helm--setup-source source) - (helm-source-get-action-from-type source))) - -(defun helm-build-type-file () - (helm-make-type 'helm-type-file)) - -(defun helm-actions-from-type-function () - (let ((source (make-instance 'helm-type-function))) - (helm--setup-source source) - (helm-source-get-action-from-type source))) - -(defun helm-build-type-function () - (helm-make-type 'helm-type-function)) - -(defun helm-actions-from-type-command () - (let ((source (make-instance 'helm-type-command))) - (helm--setup-source source) - (helm-source-get-action-from-type source))) - -(defun helm-build-type-command () - (helm-make-type 'helm-type-command)) - -(provide 'helm-source) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-source ends here diff --git a/elpa/helm-20150403.101/helm-sys.el b/elpa/helm-20150403.101/helm-sys.el deleted file mode 100644 index 2c3ce071..00000000 --- a/elpa/helm-20150403.101/helm-sys.el +++ /dev/null @@ -1,299 +0,0 @@ -;;; helm-sys.el --- System related functions for helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-utils) - - -(defgroup helm-sys nil - "System related helm library." - :group 'helm) - -(defface helm-top-columns - '((t :inherit helm-header)) - "Face for helm help string in minibuffer." - :group 'helm-sys) - - -(defun helm-top-command-set-fn (var _value) - (set var - (cl-case system-type - (darwin "env COLUMNS=%s ps -axo pid,user,pri,nice,ucomm,tty,start,vsz,%%cpu,%%mem,etime,command") - (t "env COLUMNS=%s top -b -n 1")))) - -(defcustom helm-top-command "env COLUMNS=%s top -b -n 1" - "Top command used to display output of top. -To use top command, a version supporting batch mode (-b option) is needed. -On Mac OSX top command doesn't support this, so ps command -is used by default instead. -If you modify this the number and order of elements displayed -should be the same as top command to have the sort commands -working properly, that is 12 elements with the 2 first being -PID and USER and the last 4 being %CPU, %MEM, TIME and COMMAND. -A format string where %s will be replaced with `frame-width'." - :group 'helm-sys - :type 'string - :set 'helm-top-command-set-fn) - - -;;; Top (process) -;; -;; -(defvar helm-top-sort-fn nil) -(defvar helm-top-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "C-c ?") 'helm-top-help) - (define-key map (kbd "M-P") 'helm-top-run-sort-by-cpu) - (define-key map (kbd "M-C") 'helm-top-run-sort-by-com) - (define-key map (kbd "M-M") 'helm-top-run-sort-by-mem) - (define-key map (kbd "M-U") 'helm-top-run-sort-by-user) - map)) - -(defvar helm-source-top - (helm-build-in-buffer-source "Top" - :header-name (lambda (name) (concat name " (Press C-c C-u to refresh)")) - :init #'helm-top-init - :nomark t - :display-to-real #'helm-top-display-to-real - :persistent-action #'helm-top-sh-persistent-action - :persistent-help "SIGTERM" - :mode-line helm-top-mode-line - :follow 'never - :keymap helm-top-map - :filtered-candidate-transformer #'helm-top-sort-transformer - :action-transformer #'helm-top-action-transformer)) - -(defun helm-top-transformer (candidates _source) - "Transformer for `helm-top'. -Return empty string for non--valid candidates." - (cl-loop for disp in candidates collect - (cond ((string-match "^ *[0-9]+" disp) disp) - ((string-match "^ *PID" disp) - (cons (propertize disp 'face 'helm-top-columns) "")) - (t (cons disp ""))))) - -(defun helm-top-action-transformer (actions _candidate) - "Action transformer for `top'. -Show actions only on line starting by a PID." - (let ((disp (helm-get-selection nil t))) - (cond ((string-match "^ *[0-9]+" disp) - (list '("kill (SIGTERM)" . (lambda (pid) (helm-top-sh "TERM" pid))) - '("kill (SIGKILL)" . (lambda (pid) (helm-top-sh "KILL" pid))) - '("kill (SIGINT)" . (lambda (pid) (helm-top-sh "INT" pid))) - '("kill (Choose signal)" - . (lambda (pid) - (helm-top-sh - (helm-comp-read (format "Kill [%s] with signal: " pid) - '("ALRM" "HUP" "INT" "KILL" "PIPE" "POLL" - "PROF" "TERM" "USR1" "USR2" "VTALRM" - "STKFLT" "PWR" "WINCH" "CHLD" "URG" - "TSTP" "TTIN" "TTOU" "STOP" "CONT" - "ABRT" "FPE" "ILL" "QUIT" "SEGV" - "TRAP" "SYS" "EMT" "BUS" "XCPU" "XFSZ") - :must-match t) - pid))))) - (t actions)))) - -(defun helm-top-sh (sig pid) - "Run kill shell command with signal SIG on PID for `helm-top'." - (let ((cmd (format "kill -%s %s" sig pid))) - (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))) - -(defun helm-top-sh-persistent-action (pid) - (delete-other-windows) - (helm-top-sh "TERM" pid) - (helm-force-update)) - -(defun helm-top-init () - "Insert output of top command in candidate buffer." - (unless helm-top-sort-fn (helm-top-set-mode-line "CPU")) - (with-current-buffer (helm-candidate-buffer 'global) - (call-process-shell-command - (format helm-top-command (frame-width)) - nil (current-buffer)))) - -(defun helm-top-display-to-real (line) - "Return pid only from LINE." - (car (split-string line))) - -;; Sort top command - -(defun helm-top-set-mode-line (str) - (if (string-match "Sort:\\[\\(.*\\)\\] " helm-top-mode-line) - (setq helm-top-mode-line (replace-match str nil nil helm-top-mode-line 1)) - (setq helm-top-mode-line (concat (format "Sort:[%s] " str) helm-top-mode-line)))) - -(defun helm-top-sort-transformer (candidates source) - (helm-top-transformer - (if helm-top-sort-fn - (cl-loop for c in candidates - if (string-match "^ *[0-9]+" c) - collect c into pid-cands - else collect c into header-cands - finally return (append - header-cands - (sort pid-cands helm-top-sort-fn))) - candidates) - source)) - -(defun helm-top-sort-by-com (s1 s2) - (let* ((split-1 (split-string s1)) - (split-2 (split-string s2)) - (com-1 (nth 11 split-1)) - (com-2 (nth 11 split-2))) - (string< com-1 com-2))) - -(defun helm-top-sort-by-mem (s1 s2) - (let* ((split-1 (split-string s1)) - (split-2 (split-string s2)) - (mem-1 (string-to-number (nth 9 split-1))) - (mem-2 (string-to-number (nth 9 split-2)))) - (> mem-1 mem-2))) - -(defun helm-top-sort-by-user (s1 s2) - (let* ((split-1 (split-string s1)) - (split-2 (split-string s2)) - (user-1 (nth 1 split-1)) - (user-2 (nth 1 split-2))) - (string< user-1 user-2))) - -(defun helm-top-run-sort-by-com () - (interactive) - (helm-top-set-mode-line "COM") - (setq helm-top-sort-fn 'helm-top-sort-by-com) - (helm-force-update)) - -(defun helm-top-run-sort-by-cpu () - (interactive) - (helm-top-set-mode-line "CPU") - (setq helm-top-sort-fn nil) - (helm-force-update)) - -(defun helm-top-run-sort-by-mem () - (interactive) - (helm-top-set-mode-line "MEM") - (setq helm-top-sort-fn 'helm-top-sort-by-mem) - (helm-force-update)) - -(defun helm-top-run-sort-by-user () - (interactive) - (helm-top-set-mode-line "USER") - (setq helm-top-sort-fn 'helm-top-sort-by-user) - (helm-force-update)) - - -;;; X RandR resolution change -;; -;; -;;; FIXME I do not care multi-display. - -(defun helm-xrandr-info () - "Return a pair with current X screen number and current X display name." - (with-temp-buffer - (call-process "xrandr" nil (current-buffer) nil - "--current") - (let (screen output) - (goto-char (point-min)) - (save-excursion - (when (re-search-forward "\\(^Screen \\)\\([0-9]\\):" nil t) - (setq screen (match-string 2)))) - (when (re-search-forward "^\\(.*\\) connected" nil t) - (setq output (match-string 1))) - (list screen output)))) - -(defun helm-xrandr-screen () - "Return current X screen number." - (car (helm-xrandr-info))) - -(defun helm-xrandr-output () - "Return current X display name." - (cadr (helm-xrandr-info))) - -(defvar helm-source-xrandr-change-resolution - '((name . "Change Resolution") - (candidates - . (lambda () - (with-temp-buffer - (call-process "xrandr" nil (current-buffer) nil - "--screen" (helm-xrandr-screen) "-q") - (goto-char 1) - (cl-loop with modes = nil - while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t) - for mode = (match-string 1) - unless (member mode modes) - collect mode into modes - finally return modes)))) - (action - ("Change Resolution" - . (lambda (mode) - (call-process "xrandr" nil nil nil - "--screen" (helm-xrandr-screen) - "--output" (helm-xrandr-output) - "--mode" mode)))))) - - -;;; Emacs process -;; -;; -(defvar helm-source-emacs-process - '((name . "Emacs Process") - (init . (lambda () (list-processes--refresh))) - (candidates . (lambda () (mapcar #'process-name (process-list)))) - (persistent-action . (lambda (elm) - (delete-process (get-process elm)) - (helm-delete-current-selection))) - (persistent-help . "Kill Process") - (action ("Kill Process" . (lambda (elm) - (delete-process (get-process elm))))))) - - -;;;###autoload -(defun helm-top () - "Preconfigured `helm' for top command." - (interactive) - (save-window-excursion - (unless helm-alive-p (delete-other-windows)) - (helm :sources 'helm-source-top - :buffer "*helm top*" :full-frame t - :candidate-number-limit 9999 - :preselect "^\\s-*[0-9]+"))) - -;;;###autoload -(defun helm-list-emacs-process () - "Preconfigured `helm' for emacs process." - (interactive) - (helm-other-buffer 'helm-source-emacs-process "*helm process*")) - -;;;###autoload -(defun helm-xrandr-set () - (interactive) - (helm :sources 'helm-source-xrandr-change-resolution - :buffer "*helm xrandr*")) - -(provide 'helm-sys) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-sys.el ends here diff --git a/elpa/helm-20150403.101/helm-tags.el b/elpa/helm-20150403.101/helm-tags.el deleted file mode 100644 index e6ba1792..00000000 --- a/elpa/helm-20150403.101/helm-tags.el +++ /dev/null @@ -1,360 +0,0 @@ -;;; helm-tags.el --- Helm for Etags and Ctags. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'helm-utils) - - -(defgroup helm-tags nil - "Tags related Applications and libraries for Helm." - :group 'helm) - -(defcustom helm-etags-tag-file-name "TAGS" - "Etags tag file name." - :type 'string - :group 'helm-tags) - -(defcustom helm-etags-tag-file-search-limit 10 - "The limit level of directory to search tag file. -Don't search tag file deeply if outside this value." - :type 'number - :group 'helm-tags) - -(defcustom helm-etags-match-part-only t - "Whether to match only the tag part of CANDIDATE in -helm-source-ctags-select." - :type 'boolean - :group 'helm-tags) - -(defcustom helm-etags-execute-action-at-once-if-one t - "Whether to jump straight to the selected tag if there's only -one match." - :type 'boolean - :group 'helm-tags) - - -(defgroup helm-tags-faces nil - "Customize the appearance of helm-tags faces." - :prefix "helm-" - :group 'helm-tags - :group 'helm-faces) - -(defface helm-etags-file - '((t (:foreground "Lightgoldenrod4" - :underline t))) - "Face used to highlight etags filenames." - :group 'helm-tags-faces) - - -(defun helm-etags-run-switch-other-window () - "Run switch to other window action from `helm-source-etags-select'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action - (lambda (c) - (helm-etags-action-goto 'find-file-other-window c))))) - -(defun helm-etags-run-switch-other-frame () - "Run switch to other frame action from `helm-source-etags-select'." - (interactive) - (with-helm-alive-p - (helm-quit-and-execute-action - (lambda (c) - (helm-etags-action-goto 'find-file-other-frame c))))) - -(defvar helm-etags-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map helm-map) - (define-key map (kbd "M-") 'helm-goto-next-file) - (define-key map (kbd "M-") 'helm-goto-precedent-file) - (define-key map (kbd "C-w") 'helm-yank-text-at-point) - (define-key map (kbd "C-c ?") 'helm-etags-help) - (define-key map (kbd "C-c o") 'helm-etags-run-switch-other-window) - (define-key map (kbd "C-c C-o") 'helm-etags-run-switch-other-frame) - map) - "Keymap used in Etags.") - - -;;; Ctags -;; -;; -(defvar helm-ctags-modes - '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode - makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode - scheme-mode sh-mode slang-mode sql-mode tcl-mode )) - -(defun helm-ctags-init () - (when (and buffer-file-name - (memq major-mode helm-ctags-modes) - (helm-current-buffer-is-modified)) - (with-current-buffer (helm-candidate-buffer 'local) - (call-process-shell-command - (if (string-match "\\.el\\.gz$" helm-buffer-file-name) - (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) " - helm-buffer-file-name) - (format "ctags -e -u -f- --fields=n %s " helm-buffer-file-name)) - nil (current-buffer)) - (goto-char (point-min)) - (forward-line 2) - (delete-region (point-min) (point)) - (cl-loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t)) - for lineno-start = (point) - for lineno = (buffer-substring - lineno-start - (1- (search-forward "," (point-at-eol) t))) - do - (forward-line 0) - (insert (format "%5s:" lineno)) - (search-forward "\177" (point-at-eol) t) - (delete-region (1- (point)) (point-at-eol)) - (forward-line 1))))) - -(defvar helm-source-ctags - '((name . "Exuberant ctags") - (init . helm-ctags-init) - (candidates-in-buffer) - (adjust) - (type . line)) - "Needs Exuberant Ctags. - -http://ctags.sourceforge.net/") - - -;;; Etags -;; -;; -(defvar helm-etags-mtime-alist nil - "Store the last modification time of etags files here.") -(defvar helm-etags-cache (make-hash-table :test 'equal) - "Cache content of etags files used here for faster access.") - -(defun helm-etags-get-tag-file (&optional directory) - "Return the path of etags file if found. -Lookes recursively in parents directorys for a -`helm-etags-tag-file-name' file." - ;; Get tag file from `default-directory' or upper directory. - (let ((current-dir (helm-etags-find-tag-file-directory - (or directory default-directory)))) - ;; Return nil if not find tag file. - (when current-dir - (expand-file-name helm-etags-tag-file-name current-dir)))) - -(defun helm-etags-all-tag-files () - "Return files from the following sources; - 1) An automatically located file in the parent directories, by `helm-etags-get-tag-file'. - 2) `tags-file-name', which is commonly set by `find-tag' command. - 3) `tags-table-list' which is commonly set by `visit-tags-table' command." - (helm-fast-remove-dups - (delq nil - (append (list (helm-etags-get-tag-file) - tags-file-name) - tags-table-list)) - :test 'equal)) - -(defun helm-etags-find-tag-file-directory (current-dir) - "Try to find the directory containing tag file. -If not found in CURRENT-DIR search in upper directory." - (let ((file-exists? #'(lambda (dir) - (let ((tag-path (expand-file-name - helm-etags-tag-file-name dir))) - (and (stringp tag-path) - (file-regular-p tag-path) - (file-readable-p tag-path)))))) - (cl-loop with count = 0 - until (funcall file-exists? current-dir) - ;; Return nil if outside the value of - ;; `helm-etags-tag-file-search-limit'. - if (= count helm-etags-tag-file-search-limit) - do (cl-return nil) - ;; Or search upper directories. - else - do (cl-incf count) - (setq current-dir (expand-file-name (concat current-dir "../"))) - finally return current-dir))) - -(defun helm-etags-get-header-name (_x) - "Create header name for this helm etags session." - (concat "Etags in " - (with-helm-current-buffer - (helm-etags-get-tag-file)))) - -(defun helm-etags-create-buffer (file) - "Create the `helm-buffer' based on contents of etags tag FILE." - (let* ((tag-fname file) - max - (split (with-current-buffer (find-file-noselect tag-fname) - (prog1 - (split-string (buffer-string) "\n" 'omit-nulls) - (setq max (line-number-at-pos (point-max))) - (kill-buffer)))) - (progress-reporter (make-progress-reporter "Loading tag file..." 0 max))) - (cl-loop - with fname - with cand - for i in split for count from 0 - for elm = (unless (string-match "^\x0c" i) - (helm-aif (string-match "\177" i) - (substring i 0 it) - i)) - do (cond ((and elm (string-match "^\\([^,]+\\),[0-9]+$" elm)) - (setq fname (propertize (match-string 1 elm) - 'face 'helm-etags-file))) - (elm (setq cand (concat fname ": " elm))) - (t (setq cand nil))) - when cand do (progn - (insert (concat cand "\n")) - (progress-reporter-update progress-reporter count))))) - -(defun helm-etags-init () - "Feed `helm-buffer' using `helm-etags-cache' or tag file. -If no entry in cache, create one." - (let ((tagfiles (helm-etags-all-tag-files))) - (when tagfiles - (with-current-buffer (helm-candidate-buffer 'global) - (dolist (f tagfiles) - (helm-aif (gethash f helm-etags-cache) - ;; An entry is present in cache, insert it. - (insert it) - ;; No entry, create a new buffer using content of tag file (slower). - (helm-etags-create-buffer f) - ;; Store content of buffer in cache. - (puthash f (buffer-string) helm-etags-cache) - ;; Store or set the last modification of tag file. - (helm-aif (assoc f helm-etags-mtime-alist) - ;; If an entry exists modify it. - (setcdr it (helm-etags-mtime f)) - ;; No entry create a new one. - (add-to-list 'helm-etags-mtime-alist - (cons f (helm-etags-mtime f)))))))))) - -(defun helm-etags-split-line (line) - (let ((regexp "\\`\\([[:lower:][:upper:]]?:?.*?\\): \\(.*\\)")) - (when (string-match regexp line) - (cl-loop for n from 1 to 2 collect (match-string n line))))) - -(defvar helm-source-etags-select nil - "Helm source for Etags.") - -(defun helm-etags-build-source () - (helm-build-in-buffer-source "Etags" - :header-name 'helm-etags-get-header-name - :init 'helm-etags-init - :get-line 'buffer-substring - :match-part (lambda (candidate) - ;; Match only the tag part of CANDIDATE - ;; and not the filename. - (if helm-etags-match-part-only - (cadr (helm-etags-split-line candidate)) - candidate)) - :mode-line helm-etags-mode-line-string - :keymap helm-etags-map - :action '(("Go to tag" . (lambda (c) - (helm-etags-action-goto 'find-file c))) - ("Go to tag in other window" . (lambda (c) - (helm-etags-action-goto - 'find-file-other-window - c))) - ("Go to tag in other frame" . (lambda (c) - (helm-etags-action-goto - 'find-file-other-frame - c)))) - :persistent-help "Go to line" - :persistent-action (lambda (candidate) - (helm-etags-action-goto 'find-file candidate) - (helm-highlight-current-line)))) - -(defvar find-tag-marker-ring) - -(defun helm-etags-action-goto (switcher candidate) - "Helm default action to jump to an etags entry in other window." - (require 'etags) - (helm-log-run-hook 'helm-goto-line-before-hook) - (let* ((split (helm-etags-split-line candidate)) - (fname (cl-loop for tagf being the hash-keys of helm-etags-cache - for f = (expand-file-name - (car split) (file-name-directory tagf)) - when (file-exists-p f) - return f)) - (elm (cadr split))) - (if (null fname) - (error "file %s not found" fname) - (ring-insert find-tag-marker-ring (point-marker)) - (funcall switcher fname) - (goto-char (point-min)) - (search-forward elm nil t) - (goto-char (match-beginning 0))))) - -(defun helm-etags-mtime (file) - "Last modification time of etags tag FILE." - (cadr (nth 5 (file-attributes file)))) - -(defun helm-etags-file-modified-p (file) - "Check if tag FILE have been modified in this session. -If FILE is nil return nil." - (let ((last-modif (and file - (assoc-default file helm-etags-mtime-alist)))) - (and last-modif - (/= last-modif (helm-etags-mtime file))))) - - -;;;###autoload -(defun helm-etags-select (arg) - "Preconfigured helm for etags. -If called with a prefix argument or if any of the tag files have -been modified, reinitialize cache. - -This function aggregates three sources of tag files: - - 1) An automatically located file in the parent directories, by `helm-etags-get-tag-file'. - 2) `tags-file-name', which is commonly set by `find-tag' command. - 3) `tags-table-list' which is commonly set by `visit-tags-table' command." - (interactive "P") - (let ((tag-files (helm-etags-all-tag-files)) - (helm-execute-action-at-once-if-one helm-etags-execute-action-at-once-if-one) - (str (if (region-active-p) (buffer-substring-no-properties (region-beginning) (region-end)) - (thing-at-point 'symbol)))) - (if (cl-notany 'file-exists-p tag-files) - (message "Error: No tag file found. Create with etags shell command, or visit with `find-tag' or `visit-tags-table'.") - (cl-loop for k being the hash-keys of helm-etags-cache - unless (member k tag-files) - do (remhash k helm-etags-cache)) - (mapc (lambda (f) - (when (or (equal arg '(4)) - (and helm-etags-mtime-alist - (helm-etags-file-modified-p f))) - (remhash f helm-etags-cache))) - tag-files) - (unless helm-source-etags-select - (setq helm-source-etags-select - (helm-etags-build-source))) - (helm :sources 'helm-source-etags-select - :keymap helm-etags-map - :default (list (concat "\\_<" str "\\_>") str) - :buffer "*helm etags*")))) - -(provide 'helm-tags) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm-tags.el ends here diff --git a/elpa/helm-20150403.101/helm-utils.el b/elpa/helm-20150403.101/helm-utils.el deleted file mode 100644 index e3f5b937..00000000 --- a/elpa/helm-20150403.101/helm-utils.el +++ /dev/null @@ -1,871 +0,0 @@ -;;; helm-utils.el --- Utilities Functions for helm. -*- lexical-binding: t -*- - -;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto - -;; 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 . - -;;; Code: - -(require 'cl-lib) -(require 'helm) -(require 'compile) ; Fixme: Is this needed? -(require 'dired) - -(declare-function helm-find-files-1 "helm-files.el" (fname &optional preselect)) -(defvar winner-boring-buffers) - - -(defgroup helm-utils nil - "Utilities routines for Helm." - :group 'helm) - -(defcustom helm-su-or-sudo "sudo" - "What command to use for root access." - :type 'string - :group 'helm-utils) - -(defcustom helm-yank-symbol-first nil - "`helm-yank-text-at-point' yanks symbol at point on first -invocation if this is non-nil." - :type 'boolean - :group 'helm-utils) - -(defcustom helm-default-kbsize 1024.0 - "Default Kbsize to use for showing files size. -It is a float, usually 1024.0 but could be 1000.0 on some systems." - :group 'helm-utils - :type 'float) - -(defcustom helm-highlight-number-lines-around-point 15 - "Number of lines around point where matched items are highlighted." - :group 'helm-utils - :type 'integer) - -(defcustom helm-buffers-to-resize-on-pa nil - "A list of helm buffers where the helm-window should be reduced on persistent actions." - :group 'helm-utils - :type '(repeat (choice string))) - -(defcustom helm-resize-on-pa-text-height 12 - "The size of the helm-window when resizing on persistent action." - :group 'helm-utils - :type 'integer) - - -(defvar helm-goto-line-before-hook '(helm-save-current-pos-to-mark-ring) - "Run before jumping to line. -This hook run when jumping from `helm-goto-line', `helm-etags-default-action', -and `helm-imenu-default-action'.") - -(defvar helm-save-pos-before-jump-register ?_ - "The register where `helm-save-pos-to-register-before-jump' save position.") - - -;;; Faces. -;; -(defface helm-selection-line - '((t (:inherit highlight :distant-foreground "black"))) - "Face used in the `helm-current-buffer' when jumping to candidate." - :group 'helm-faces) - -(defface helm-match-item - '((t (:inherit isearch))) - "Face used to highlight item matched in a selected line." - :group 'helm-faces) - - -;; CUA workaround -(defadvice cua-delete-region (around helm-avoid-cua activate) - (ignore-errors ad-do-it)) - -(defadvice copy-region-as-kill (around helm-avoid-cua activate) - (if cua-mode - (ignore-errors ad-do-it) - ad-do-it)) - - -;;; Utils functions -;; -;; -(defun helm-ff-find-printers () - "Return a list of available printers on Unix systems." - (when (executable-find "lpstat") - (let ((printer-list (with-temp-buffer - (call-process "lpstat" nil t nil "-a") - (split-string (buffer-string) "\n")))) - (cl-loop for p in printer-list - for printer = (car (split-string p)) - when printer - collect printer)))) - -(defun helm-switch-to-buffers (buffer-or-name &optional other-window) - "Switch to buffer BUFFER-OR-NAME. -If more than one buffer marked switch to these buffers in separate windows. -If OTHER-WINDOW is specified keep current-buffer and switch to others buffers -in separate windows." - (let* ((mkds (helm-marked-candidates)) - (size (/ (window-height) (length mkds)))) - (or (<= window-min-height size) - (error "Too many buffers to visit simultaneously.")) - (helm-aif (cdr mkds) - (progn - (if other-window - (switch-to-buffer-other-window (car mkds)) - (switch-to-buffer (car mkds))) - (save-selected-window - (cl-loop for b in it - do (progn - (select-window (split-window)) - (switch-to-buffer b))))) - (if other-window - (switch-to-buffer-other-window buffer-or-name) - (switch-to-buffer buffer-or-name))))) - -(defun helm-switch-to-buffers-other-window (buffer-or-name) - "switch to buffer BUFFER-OR-NAME in other window. -See `helm-switch-to-buffers' for switching to marked buffers." - (helm-switch-to-buffers buffer-or-name t)) - -(cl-defmacro helm-position (item seq &key (test 'eq) all) - "A simple and faster replacement of CL `position'. -Return position of first occurence of ITEM found in SEQ. -Argument SEQ can be a string, in this case ITEM have to be a char. -Argument ALL, if non--nil specify to return a list of positions of -all ITEM found in SEQ." - (let ((key (if (stringp seq) 'across 'in))) - `(cl-loop for c ,key ,seq - for index from 0 - when (funcall ,test c ,item) - if ,all collect index into ls - else return index - finally return ls))) - -(defun helm-substring (str width) - "Return the substring of string STR from 0 to WIDTH. -Handle multibyte characters by moving by columns." - (with-temp-buffer - (save-excursion - (insert str)) - (move-to-column width) - (buffer-substring (point-at-bol) (point)))) - -(cl-defun helm-substring-by-width (str width &optional (endstr "...")) - "Truncate string STR to end at column WIDTH. -Similar to `truncate-string-to-width'. -Add ENDSTR (default \"...\") at end of truncated STR. -Add spaces at end if needed to reach WIDTH when STR is shorter than WIDTH." - (cl-loop for ini-str = str - then (substring ini-str 0 (1- (length ini-str))) - for sw = (string-width ini-str) - when (<= sw width) return - (concat ini-str endstr (make-string (- width sw) ? )))) - -(defun helm-string-multibyte-p (str) - "Check if string STR contains multibyte characters." - (cl-loop for c across str - thereis (> (char-width c) 1))) - -(defun helm-get-pid-from-process-name (process-name) - "Get pid from running process PROCESS-NAME." - (cl-loop with process-list = (list-system-processes) - for pid in process-list - for process = (assoc-default 'comm (process-attributes pid)) - when (and process (string-match process-name process)) - return pid)) - -(cl-defun helm-current-buffer-narrowed-p (&optional - (buffer helm-current-buffer)) - "Check if BUFFER is narrowed. -Default is `helm-current-buffer'." - (with-current-buffer buffer - (let ((beg (point-min)) - (end (point-max)) - (total (buffer-size))) - (or (/= beg 1) (/= end (1+ total)))))) - -(defun helm-region-active-p () - (and transient-mark-mode mark-active (/= (mark) (point)))) - -(defun helm-goto-char (loc) - "Go to char, revealing if necessary." - (goto-char loc) - (when (or (eq major-mode 'org-mode) - (and (boundp 'outline-minor-mode) - outline-minor-mode)) - (require 'org) ; On some old Emacs versions org may not be loaded. - (org-reveal))) - -(defun helm-goto-line (lineno &optional noanim) - "Goto LINENO opening only outline headline if needed. -Animation is used unless NOANIM is non--nil." - (helm-log-run-hook 'helm-goto-line-before-hook) - (goto-char (point-min)) - (helm-goto-char (point-at-bol lineno)) - (unless noanim - (helm-highlight-current-line nil nil nil nil 'pulse))) - -(defun helm-save-pos-to-register-before-jump () - "Save current buffer position to `helm-save-pos-before-jump-register'. -To use this add it to `helm-goto-line-before-hook'." - (with-helm-current-buffer - (unless helm-in-persistent-action - (point-to-register helm-save-pos-before-jump-register)))) - -(defun helm-save-current-pos-to-mark-ring () - "Save current buffer position to mark ring. -To use this add it to `helm-goto-line-before-hook'." - (with-helm-current-buffer - (unless helm-in-persistent-action - (set-marker (mark-marker) (point)) - (push-mark (point) 'nomsg)))) - -;;;###autoload -(defun helm-show-all-in-this-source-only (arg) - "Show only current source of this helm session with all its candidates. -With a numeric prefix arg show only the ARG number of candidates." - (interactive "p") - (with-helm-window - (with-helm-default-directory helm-default-directory - (let ((helm-candidate-number-limit (and (> arg 1) arg))) - (helm-set-source-filter - (list (assoc-default 'name (helm-get-current-source)))))))) - -;;;###autoload -(defun helm-display-all-sources () - "Display all sources previously hidden by `helm-set-source-filter'." - (interactive) - (helm-set-source-filter nil)) - -(defun helm-displaying-source-names () - "Return the list of sources name for this helm session." - (with-current-buffer helm-buffer - (goto-char (point-min)) - (cl-loop with pos - while (setq pos (next-single-property-change (point) 'helm-header)) - do (goto-char pos) - collect (buffer-substring-no-properties (point-at-bol)(point-at-eol)) - do (forward-line 1)))) - -(defun helm-skip-entries (seq regexp-list) - "Remove entries which matches one of REGEXP-LIST from SEQ." - (cl-loop for i in seq - unless (cl-loop for regexp in regexp-list - thereis (and (stringp i) - (string-match regexp i))) - collect i)) - -(defun helm-shadow-entries (seq regexp-list) - "Put shadow property on entries in SEQ matching a regexp in REGEXP-LIST." - (let ((face 'italic)) - (cl-loop for i in seq - if (cl-loop for regexp in regexp-list - thereis (and (stringp i) - (string-match regexp i))) - collect (propertize i 'face face) - else collect i))) - -(defun helm-describe-function (func) - "FUNC is symbol or string." - (describe-function (helm-symbolify func)) - (message nil)) - -(defun helm-describe-variable (var) - "VAR is symbol or string." - (describe-variable (helm-symbolify var)) - (message nil)) - -(defun helm-find-function (func) - "FUNC is symbol or string." - (find-function (helm-symbolify func))) - -(defun helm-find-variable (var) - "VAR is symbol or string." - (find-variable (helm-symbolify var))) - -(defun helm-kill-new (candidate &optional replace) - "CANDIDATE is symbol or string. -See `kill-new' for argument REPLACE." - (kill-new (helm-stringify candidate) replace)) - -(cl-defun helm-fast-remove-dups (seq &key (test 'eq)) - "Remove duplicates elements in list SEQ. -This is same as `remove-duplicates' but with memoisation. -It is much faster, especially in large lists. -A test function can be provided with TEST argument key. -Default is `eq'." - (cl-loop with cont = (make-hash-table :test test) - for elm in seq - unless (gethash elm cont) - do (puthash elm elm cont) - finally return - (cl-loop for i being the hash-values in cont collect i))) - -(defun helm-remove-if-not-match (regexp seq) - "Remove all elements of SEQ that don't match REGEXP." - (cl-loop for s in seq - for str = (cond ((symbolp s) - (symbol-name s)) - ((consp s) - (car s)) - (t s)) - when (string-match-p regexp str) - collect s)) - -(defun helm-remove-if-match (regexp seq) - "Remove all elements of SEQ that match REGEXP." - (cl-loop for s in seq - for str = (cond ((symbolp s) - (symbol-name s)) - ((consp s) - (car s)) - (t s)) - unless (string-match-p regexp str) - collect s)) - -(defun helm-handle-winner-boring-buffers () - "Add `helm-buffer' to `winner-boring-buffers' when quitting/exiting helm. -Add this function to `helm-cleanup-hook' when you don't want to see helm buffers -after running winner-undo/redo." - (require 'winner) - (cl-pushnew helm-buffer winner-boring-buffers :test 'equal)) -(add-hook 'helm-cleanup-hook #'helm-handle-winner-boring-buffers) - -;;;###autoload -(defun helm-quit-and-find-file () - "Drop into `helm-find-files' from `helm'. -If current selection is a buffer or a file, `helm-find-files' -from its directory." - (interactive) - (require 'helm-grep) - (helm-run-after-quit - (lambda (f) - (if (file-exists-p f) - (helm-find-files-1 (file-name-directory f) - (concat - "^" - (regexp-quote - (if helm-ff-transformer-show-only-basename - (helm-basename f) f)))) - (helm-find-files-1 f))) - (let* ((sel (helm-get-selection)) - (grep-line (and (stringp sel) - (helm-grep-split-line sel))) - (bmk-name (and (stringp sel) - (not grep-line) - (replace-regexp-in-string "\\`\\*" "" sel))) - (bmk (and bmk-name (assoc bmk-name bookmark-alist))) - (buf (helm-aif (get-buffer sel) (buffer-name it))) - (default-preselection (or (buffer-file-name helm-current-buffer) - default-directory))) - (cond - ;; Buffer. - (buf (or (buffer-file-name sel) - (car (rassoc buf dired-buffers)) - (and (with-current-buffer buf - (eq major-mode 'org-agenda-mode)) - org-directory - (expand-file-name org-directory)) - (with-current-buffer buf default-directory))) - ;; Bookmark. - (bmk (helm-aif (bookmark-get-filename bmk) - (if (and ffap-url-regexp - (string-match ffap-url-regexp it)) - it (expand-file-name it)) - default-directory)) - ((or (file-remote-p sel) - (file-exists-p sel)) - (expand-file-name sel)) - ;; Grep. - ((and grep-line (file-exists-p (car grep-line))) - (expand-file-name (car grep-line))) - ;; Occur. - (grep-line - (with-current-buffer (get-buffer (car grep-line)) - (or (buffer-file-name) default-directory))) - ;; Url. - ((and ffap-url-regexp (string-match ffap-url-regexp sel)) sel) - ;; Default. - (t default-preselection))))) - -;; Same as `vc-directory-exclusion-list'. -(defvar helm-walk-ignore-directories - '("SCCS" "RCS" "CVS" "MCVS" ".svn" ".git" ".hg" ".bzr" - "_MTN" "_darcs" "{arch}" ".gvfs")) - -(cl-defun helm-walk-directory (directory &key (path 'basename) - (directories t) - match skip-subdirs) - "Walk through DIRECTORY tree. -Argument PATH can be one of basename, relative, full, or a function -called on file name, default to basename. -Argument DIRECTORIES when non--nil (default) return also directories names, -otherwise skip directories names. -Argument MATCH can be a predicate or a regexp. -Argument SKIP-SUBDIRS when non--nil will skip `helm-walk-ignore-directories' -unless it is given as a list of directories, in this case this list will be used -instead of `helm-walk-ignore-directories'." - (let* ((result '()) - (fn (cl-case path - (basename 'file-name-nondirectory) - (relative 'file-relative-name) - (full 'identity) - (t path)))) - (cl-labels ((ls-rec (dir) - (unless (and skip-subdirs - (member (helm-basename dir) - (if (listp skip-subdirs) - skip-subdirs - helm-walk-ignore-directories))) - (cl-loop with ls = (sort (file-name-all-completions "" dir) - 'string-lessp) - for f in ls - ;; Use `directory-file-name' to remove the final slash. - ;; Needed to avoid infloop on symlinks symlinking - ;; a directory inside it [1]. - for file = (directory-file-name - (expand-file-name f dir)) - unless (member f '("./" "../")) - ;; A directory. - if (char-equal (aref f (1- (length f))) ?/) - do (progn (when directories - (push (funcall fn file) result)) - ;; Don't recurse in symlinks. - ;; `file-symlink-p' have to be called - ;; on the directory with its final - ;; slash removed [1]. - (and (not (file-symlink-p file)) - (ls-rec file))) - else do - (if match - (and (if (functionp match) - (funcall match f) - (and (stringp match) - (string-match match f))) - (push (funcall fn file) result)) - (push (funcall fn file) result)))))) - (ls-rec directory) - (nreverse result)))) - -(defun helm-generic-sort-fn (s1 s2) - "Sort predicate function for helm candidates. -Args S1 and S2 can be single or \(display . real\) candidates, -that is sorting is done against real value of candidate." - (let* ((reg1 (concat "\\_<" helm-pattern "\\_>")) - (reg2 (concat "\\_<" helm-pattern)) - (split (split-string helm-pattern)) - (str1 (if (consp s1) (cdr s1) s1)) - (str2 (if (consp s2) (cdr s2) s2)) - (score #'(lambda (str r1 r2 lst) - (cond ((string-match r1 str) 4) - ((and (string-match " " helm-pattern) - (string-match (concat "\\_<" (car lst)) str) - (cl-loop for r in (cdr lst) - always (string-match r str))) 3) - ((and (string-match " " helm-pattern) - (cl-loop for r in lst always (string-match r str))) 2) - ((string-match r2 str) 1) - (t 0)))) - (sc1 (funcall score str1 reg1 reg2 split)) - (sc2 (funcall score str2 reg1 reg2 split))) - (cond ((or (zerop (string-width helm-pattern)) - (and (zerop sc1) (zerop sc2))) - (string-lessp str1 str2)) - ((= sc1 sc2) - (< (length str1) (length str2))) - (t (> sc1 sc2))))) - -(defun helm-basename (fname &optional ext) - "Print FNAME with any leading directory components removed. -If specified, also remove filename extension EXT." - (let ((non-essential t)) - (if (and ext (or (string= (file-name-extension fname) ext) - (string= (file-name-extension fname t) ext)) - (not (file-directory-p fname))) - (file-name-sans-extension (file-name-nondirectory fname)) - (file-name-nondirectory (directory-file-name fname))))) - -(defun helm-basedir (fname) - "Return the base directory of filename." - (helm-aif (and fname (file-name-directory fname)) - (file-name-as-directory it))) - -(defun helm-ff-get-host-from-tramp-invalid-fname (fname) - "Extract hostname from an incomplete tramp file name. -Return nil on valid file name remote or not." - (let* ((str (helm-basename fname)) - (split (split-string str ":")) - (meth (car (member (car split) (mapcar 'car tramp-methods))))) - (when (and meth (<= (length split) 2)) - (cadr split)))) - -(cl-defun helm-file-human-size (size &optional (kbsize helm-default-kbsize)) - "Return a string showing SIZE of a file in human readable form. -SIZE can be an integer or a float depending it's value. -`file-attributes' will take care of that to avoid overflow error. -KBSIZE if a floating point number, defaulting to `helm-default-kbsize'." - (let ((M (cons "M" (/ size (expt kbsize 2)))) - (G (cons "G" (/ size (expt kbsize 3)))) - (K (cons "K" (/ size kbsize))) - (B (cons "B" size))) - (cl-loop with result = B - for (a . b) in - (cl-loop for (x . y) in (list M G K B) - unless (< y 1) collect (cons x y)) - when (< b (cdr result)) do (setq result (cons a b)) - finally return (if (string= (car result) "B") - (format "%s" size) - (format "%.1f%s" (cdr result) (car result)))))) - -(cl-defun helm-file-attributes - (file &key type links uid gid access-time modif-time - status size mode gid-change inode device-num dired human-size - mode-type mode-owner mode-group mode-other (string t)) - "Return `file-attributes' elements of FILE separately according to key value. -Availables keys are: -- TYPE: Same as nth 0 `files-attributes' if STRING is nil - otherwise return either symlink, directory or file (default). -- LINKS: See nth 1 `files-attributes'. -- UID: See nth 2 `files-attributes'. -- GID: See nth 3 `files-attributes'. -- ACCESS-TIME: See nth 4 `files-attributes', however format time - when STRING is non--nil (the default). -- MODIF-TIME: See nth 5 `files-attributes', same as above. -- STATUS: See nth 6 `files-attributes', same as above. -- SIZE: See nth 7 `files-attributes'. -- MODE: See nth 8 `files-attributes'. -- GID-CHANGE: See nth 9 `files-attributes'. -- INODE: See nth 10 `files-attributes'. -- DEVICE-NUM: See nth 11 `files-attributes'. -- DIRED: A line similar to what 'ls -l' return. -- HUMAN-SIZE: The size in human form, see `helm-file-human-size'. -- MODE-TYPE, mode-owner,mode-group, mode-other: Split what - nth 7 `files-attributes' return in four categories. -- STRING: When non--nil (default) `helm-file-attributes' return - more friendly values. -If you want the same behavior as `files-attributes' , -\(but with return values in proplist\) use a nil value for STRING. -However when STRING is non--nil, time and type value are different from what -you have in `file-attributes'." - (let* ((all (cl-destructuring-bind - (type links uid gid access-time modif-time - status size mode gid-change inode device-num) - (file-attributes file string) - (list :type (if string - (cond ((stringp type) "symlink") ; fname - (type "directory") ; t - (t "file")) ; nil - type) - :links links - :uid uid - :gid gid - :access-time (if string - (format-time-string - "%Y-%m-%d %R" access-time) - access-time) - :modif-time (if string - (format-time-string - "%Y-%m-%d %R" modif-time) - modif-time) - :status (if string - (format-time-string - "%Y-%m-%d %R" status) - status) - :size size - :mode mode - :gid-change gid-change - :inode inode - :device-num device-num))) - (modes (helm-split-mode-file-attributes (cl-getf all :mode)))) - (cond (type (cl-getf all :type)) - (links (cl-getf all :links)) - (uid (cl-getf all :uid)) - (gid (cl-getf all :gid)) - (access-time (cl-getf all :access-time)) - (modif-time (cl-getf all :modif-time)) - (status (cl-getf all :status)) - (size (cl-getf all :size)) - (mode (cl-getf all :mode)) - (gid-change (cl-getf all :gid-change)) - (inode (cl-getf all :inode)) - (device-num (cl-getf all :device-num)) - (dired - (concat - (helm-split-mode-file-attributes (cl-getf all :mode) t) " " - (number-to-string (cl-getf all :links)) " " - (cl-getf all :uid) ":" - (cl-getf all :gid) " " - (if human-size - (helm-file-human-size (cl-getf all :size)) - (int-to-string (cl-getf all :size))) " " - (cl-getf all :modif-time))) - (human-size (helm-file-human-size (cl-getf all :size))) - (mode-type (cl-getf modes :mode-type)) - (mode-owner (cl-getf modes :user)) - (mode-group (cl-getf modes :group)) - (mode-other (cl-getf modes :other)) - (t (append all modes))))) - -(defun helm-split-mode-file-attributes (str &optional string) - "Split mode file attributes STR into a proplist. -If STRING is non--nil return instead a space separated string." - (cl-loop with type = (substring str 0 1) - with cdr = (substring str 1) - for i across cdr - for count from 1 - if (<= count 3) - concat (string i) into user - if (and (> count 3) (<= count 6)) - concat (string i) into group - if (and (> count 6) (<= count 9)) - concat (string i) into other - finally return - (if string - (mapconcat 'identity (list type user group other) " ") - (list :mode-type type :user user :group group :other other)))) - -(defun helm-current-directory () - "Return current-directory name at point. -Useful in dired buffers when there is inserted subdirs." - (if (eq major-mode 'dired-mode) - (dired-current-directory) - default-directory)) - -(defmacro with-helm-display-marked-candidates (buffer-or-name candidates &rest body) - (declare (indent 0) (debug t)) - (helm-with-gensyms (buffer window) - `(let* ((,buffer (temp-buffer-window-setup ,buffer-or-name)) - ,window) - (unwind-protect - (with-current-buffer ,buffer - (dired-format-columns-of-files ,candidates) - (select-window - (setq ,window (temp-buffer-window-show - ,buffer - '(display-buffer-below-selected - (window-height . fit-window-to-buffer))))) - (progn ,@body)) - (quit-window 'kill ,window))))) - -;;; Persistent Action Helpers -;; -;; -;; Internal -(defvar helm-match-line-overlay nil) -(defvar helm--match-item-overlays nil) - -(defun helm-highlight-current-line (&optional start end buf face pulse) - "Highlight and underline current position" - (let* ((start (or start (line-beginning-position))) - (end (or end (1+ (line-end-position)))) - (start-match (if (or (zerop helm-highlight-number-lines-around-point) - (null helm-highlight-number-lines-around-point)) - start - (save-excursion - (forward-line - (- helm-highlight-number-lines-around-point)) - (point-at-bol)))) - (end-match (if (or (zerop helm-highlight-number-lines-around-point) - (null helm-highlight-number-lines-around-point)) - end - (save-excursion - (forward-line - helm-highlight-number-lines-around-point) - (point-at-eol)))) - (args (list start end buf))) - (if (not helm-match-line-overlay) - (setq helm-match-line-overlay (apply 'make-overlay args)) - (apply 'move-overlay helm-match-line-overlay args)) - (overlay-put helm-match-line-overlay - 'face (or face 'helm-selection-line)) - (catch 'empty-line - (cl-loop with ov - for r in (helm-remove-if-match - "\\`!" (split-string helm-pattern)) - do (save-excursion - (goto-char start-match) - (while (condition-case _err - (re-search-forward r end-match t) - (invalid-regexp nil)) - (let ((s (match-beginning 0)) - (e (match-end 0))) - (if (= s e) - (throw 'empty-line nil) - (push (setq ov (make-overlay s e)) - helm--match-item-overlays) - (overlay-put ov 'face 'helm-match-item) - (overlay-put ov 'priority 1))))))) - (recenter) - (when pulse - (sit-for 0.3) - (helm-match-line-cleanup)))) - -(defun helm-match-line-cleanup () - (when helm-match-line-overlay - (delete-overlay helm-match-line-overlay) - (setq helm-match-line-overlay nil)) - (when helm--match-item-overlays - (mapc 'delete-overlay helm--match-item-overlays))) - -(defun helm-match-line-update () - (when helm-match-line-overlay - (delete-overlay helm-match-line-overlay) - (helm-highlight-current-line))) - -(defun helm-persistent-autoresize-hook () - (when (and helm-buffers-to-resize-on-pa - (member helm-buffer helm-buffers-to-resize-on-pa) - (eq helm-split-window-state 'vertical)) - (set-window-text-height (helm-window) helm-resize-on-pa-text-height))) - -(add-hook 'helm-after-persistent-action-hook 'helm-persistent-autoresize-hook) -(add-hook 'helm-cleanup-hook 'helm-match-line-cleanup) -(add-hook 'helm-after-persistent-action-hook 'helm-match-line-update) - -(defun helm-w32-prepare-filename (file) - "Convert filename FILE to something usable by external w32 executables." - (replace-regexp-in-string ; For UNC paths - "/" "\\" - (replace-regexp-in-string ; Strip cygdrive paths - "/cygdrive/\\(.\\)" "\\1:" - file nil nil) nil t)) - -;;;###autoload -(defun helm-w32-shell-execute-open-file (file) - (interactive "fOpen file:") - (with-no-warnings - (w32-shell-execute "open" (helm-w32-prepare-filename file)))) - -(defun helm-open-file-with-default-tool (file) - "Open FILE with the default tool on this platform." - (let (process-connection-type) - (if (eq system-type 'windows-nt) - (helm-w32-shell-execute-open-file file) - (start-process "helm-open-file-with-default-tool" - nil - (cond ((eq system-type 'gnu/linux) - "xdg-open") - ((or (eq system-type 'darwin) ;; Mac OS X - (eq system-type 'macos)) ;; Mac OS 9 - "open")) - file)))) - -(defun helm-open-dired (file) - "Opens a dired buffer in FILE's directory. If FILE is a -directory, open this directory." - (if (file-directory-p file) - (dired file) - (dired (file-name-directory file)) - (dired-goto-file file))) - -(defun helm-require-or-error (feature function) - (or (require feature nil t) - (error "Need %s to use `%s'." feature function))) - -(defun helm-find-file-as-root (candidate) - (let* ((buf (helm-basename candidate)) - (host (file-remote-p candidate 'host)) - (remote-path (format "/%s:%s:%s" - helm-su-or-sudo - (or host "") - (expand-file-name - (if host - (file-remote-p candidate 'localname) - candidate)))) - non-essential) - (if (buffer-live-p (get-buffer buf)) - (progn - (set-buffer buf) - (find-alternate-file remote-path)) - (find-file remote-path)))) - -(defun helm-find-many-files (_ignore) - (let ((helm--reading-passwd-or-string t)) - (mapc 'find-file (helm-marked-candidates)))) - -(defun helm-quit-and-execute-action (action) - "Quit current helm session and execute ACTION." - (setq helm-saved-action action) - (helm-exit-minibuffer)) - -;; Yank text at point. -;; -;; -;; Internal -(defvar helm-yank-point nil) - -;;;###autoload -(defun helm-yank-text-at-point () - "Yank text at point in `helm-current-buffer' into minibuffer. -If `helm-yank-symbol-first' is non--nil the first yank -grabs the entire symbol." - (interactive) - (with-helm-current-buffer - (let ((fwd-fn (if helm-yank-symbol-first - 'forward-symbol 'forward-word))) - ;; Start to initial point if C-w have never been hit. - (unless helm-yank-point (setq helm-yank-point (point))) - (save-excursion - (goto-char helm-yank-point) - (funcall fwd-fn 1) - (helm-set-pattern - (concat - helm-pattern (replace-regexp-in-string - "\\`\n" "" - (buffer-substring-no-properties - helm-yank-point (point))))) - (setq helm-yank-point (point)))))) - -(defun helm-reset-yank-point () - (setq helm-yank-point nil)) - -(defun helm-read-repeat-string (prompt &optional count) - "Prompt as many time PROMPT is not empty. -If COUNT is non--nil add a number after each prompt." - (cl-loop with elm - while (not (string= elm "")) - for n from 1 - do (when count - (setq prompt (concat prompt (int-to-string n) ": "))) - collect (setq elm (helm-read-string prompt)) into lis - finally return (remove "" lis))) - -(add-hook 'helm-cleanup-hook 'helm-reset-yank-point) -(add-hook 'helm-after-initialize-hook 'helm-reset-yank-point) - -(defun helm-html-bookmarks-to-alist (file url-regexp bmk-regexp) - "Parse html bookmark FILE and return an alist with (title . url) as elements." - (let (bookmarks-alist url title) - (with-temp-buffer - (insert-file-contents file) - (goto-char (point-min)) - (while (re-search-forward "href=\\|^ *

q\" '(foo bar baz) 2) - -Each time \" q\" is pressed the next function is executed, if you wait -More than 2 seconds, next hit will run again the first function and so on." - (define-key keymap key (helm-make-multi-command functions delay))) - -;;;###autoload -(defmacro helm-multi-key-defun (name docstring funs &optional delay) - "Define NAME as a multi-key command running FUNS. -After DELAY seconds the FUNS list is reinitialised. -See `helm-define-multi-key'." - (declare (indent 2)) - (setq docstring (if docstring (concat docstring "\n\n") - "This is a helmish multi-key command.")) - `(defalias (quote ,name) (helm-make-multi-command ,funs ,delay) ,docstring)) - -(defun helm-make-multi-command (functions &optional delay) - "Return an anonymous multi-key command running FUNCTIONS. -Run each function of FUNCTIONS list in turn when called within DELAY seconds." - (declare (indent 1)) - (let ((funs functions) - (iter (cl-gensym "helm-iter-key")) - (timeout delay)) - (eval (list 'defvar iter nil)) - #'(lambda () (interactive) (helm-run-multi-key-command funs iter timeout)))) - -(defun helm-run-multi-key-command (functions iterator delay) - (let ((fn #'(lambda () - (cl-loop for count from 1 to (length functions) - collect count))) - next) - (unless (and (symbol-value iterator) - ;; Reset iterator when another key is pressed. - (eq this-command real-last-command)) - (set iterator (helm-iter-list (funcall fn)))) - (setq next (helm-iter-next (symbol-value iterator))) - (unless next - (set iterator (helm-iter-list (funcall fn))) - (setq next (helm-iter-next (symbol-value iterator)))) - (and next (symbol-value iterator) (call-interactively (nth (1- next) functions))) - (when delay (run-with-idle-timer delay nil `(lambda () - (setq ,iterator nil)))))) - -(defun helm-iter-list (seq) - "Return an iterator object from SEQ." - (let ((lis seq)) - (lambda () - (let ((elm (car lis))) - (setq lis (cdr lis)) - elm)))) - -(defun helm-iter-next (iterator) - "Return next elm of ITERATOR." - (funcall iterator)) - -(helm-multi-key-defun helm-toggle-resplit-and-swap-windows - "Multi key command to resplit and swap helm window. -First call run `helm-toggle-resplit-window', -second call within 0.5s run `helm-swap-windows'." - '(helm-toggle-resplit-window helm-swap-windows) 1) - -;;;###autoload -(defun helm-define-key-with-subkeys (map key subkey command - &optional other-subkeys menu exit-fn) - "Allow defining in MAP a KEY and SUBKEY to COMMAND. - -This allow typing KEY to call COMMAND the first time and -type only SUBKEY on subsequent calls. - -Arg MAP is the keymap to use, SUBKEY is the initial short keybinding to -call COMMAND. - -Arg OTHER-SUBKEYS is an alist specifying other short keybindings -to use once started. -e.g: - -\(helm-define-key-with-subkeys global-map - \(kbd \"C-x v n\") ?n 'git-gutter:next-hunk '((?p . git-gutter:previous-hunk))\) - - -In this example, `C-x v n' will run `git-gutter:next-hunk' -subsequent hits on \"n\" will run this command again -and subsequent hits on \"p\" will run `git-gutter:previous-hunk'. - -Arg MENU is a string to display in minibuffer -to describe SUBKEY and OTHER-SUBKEYS. -Arg EXIT-FN specify a function to run on exit. - -Any other keys pressed run their assigned command defined in MAP -and exit the loop running EXIT-FN if specified. - -NOTE: SUBKEY and OTHER-SUBKEYS bindings support -only char syntax actually (e.g ?n) -so don't use strings, vectors or whatever to define them." - (declare (indent 1)) - (define-key map key - (lambda () - (interactive) - (unwind-protect - (progn - (call-interactively command) - (while (let ((input (read-key menu)) other kb com) - (setq last-command-event input) - (cond - ((eq input subkey) - (call-interactively command) - t) - ((setq other (assoc input other-subkeys)) - (call-interactively (cdr other)) - t) - (t - (setq kb (vector last-command-event)) - (setq com (lookup-key map kb)) - (if (commandp com) - (call-interactively com) - (setq unread-command-events - (nconc (mapcar 'identity kb) - unread-command-events))) - nil))))) - (and exit-fn (funcall exit-fn)))))) - - -;;; Keymap -;; -;; -(defvar helm-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-map) - (define-key map (kbd "") 'helm-next-line) - (define-key map (kbd "") 'helm-previous-line) - (define-key map (kbd "C-n") 'helm-next-line) - (define-key map (kbd "C-p") 'helm-previous-line) - (define-key map (kbd "") 'helm-follow-action-forward) - (define-key map (kbd "") 'helm-follow-action-backward) - (define-key map (kbd "") 'helm-previous-page) - (define-key map (kbd "") 'helm-next-page) - (define-key map (kbd "M-v") 'helm-previous-page) - (define-key map (kbd "C-v") 'helm-next-page) - (define-key map (kbd "M-<") 'helm-beginning-of-buffer) - (define-key map (kbd "M->") 'helm-end-of-buffer) - (define-key map (kbd "C-g") 'helm-keyboard-quit) - (define-key map (kbd "") 'helm-next-source) - (define-key map (kbd "") 'helm-previous-source) - (define-key map (kbd "") 'helm-maybe-exit-minibuffer) - (define-key map (kbd "C-i") 'helm-select-action) - (define-key map (kbd "C-z") 'helm-execute-persistent-action) - (define-key map (kbd "C-j") 'helm-execute-persistent-action) - (define-key map (kbd "C-o") 'helm-next-source) - (define-key map (kbd "C-l") 'helm-recenter-top-bottom-other-window) - (define-key map (kbd "M-C-l") 'helm-reposition-window-other-window) - (define-key map (kbd "C-M-v") 'helm-scroll-other-window) - (define-key map (kbd "M-") 'helm-scroll-other-window) - (define-key map (kbd "C-M-y") 'helm-scroll-other-window-down) - (define-key map (kbd "C-M-S-v") 'helm-scroll-other-window-down) - (define-key map (kbd "M-") 'helm-scroll-other-window-down) - (define-key map (kbd "") 'helm-scroll-other-window) - (define-key map (kbd "") 'helm-scroll-other-window-down) - (define-key map (kbd "C-@") 'helm-toggle-visible-mark) - (define-key map (kbd "C-SPC") 'helm-toggle-visible-mark) - (define-key map (kbd "M-SPC") 'helm-toggle-visible-mark) - (define-key map (kbd "M-[") nil) - (define-key map (kbd "M-(") 'helm-prev-visible-mark) - (define-key map (kbd "M-)") 'helm-next-visible-mark) - (define-key map (kbd "C-k") 'helm-delete-minibuffer-contents) - (define-key map (kbd "C-x C-f") 'helm-quit-and-find-file) - (define-key map (kbd "M-m") 'helm-toggle-all-marks) - (define-key map (kbd "M-a") 'helm-mark-all) - (define-key map (kbd "M-u") 'helm-unmark-all) - (define-key map (kbd "C-w") 'helm-yank-text-at-point) - (define-key map (kbd "C-M-a") 'helm-show-all-in-this-source-only) - (define-key map (kbd "C-M-e") 'helm-display-all-sources) - (define-key map (kbd "C-r") 'undefined) - (define-key map (kbd "C-s") 'undefined) - (define-key map (kbd "M-s") 'undefined) - (define-key map (kbd "C-}") 'helm-narrow-window) - (define-key map (kbd "C-{") 'helm-enlarge-window) - (define-key map (kbd "C-c -") 'helm-swap-windows) - (define-key map (kbd "C-c C-d") 'helm-delete-current-selection) - (define-key map (kbd "C-c C-y") 'helm-yank-selection) - (define-key map (kbd "C-c C-k") 'helm-kill-selection-and-quit) - (define-key map (kbd "C-c C-i") 'helm-copy-to-buffer) - (define-key map (kbd "C-c C-f") 'helm-follow-mode) - (define-key map (kbd "C-c C-u") 'helm-force-update) - (define-key map (kbd "M-p") 'previous-history-element) - (define-key map (kbd "M-n") 'next-history-element) - (define-key map (kbd "C-!") 'helm-toggle-suspend-update) - (define-key map (kbd "C-x b") 'helm-resume-previous-session-after-quit) - (define-key map (kbd "C-x C-b") 'helm-resume-list-buffers-after-quit) - ;; Disable `file-cache-minibuffer-complete'. - (define-key map (kbd "") 'undefined) - ;; Multi keys - (define-key map (kbd "C-t") 'helm-toggle-resplit-and-swap-windows) - ;; Debugging command - (define-key map (kbd "C-h C-d") 'undefined) - (define-key map (kbd "C-h C-d") 'helm-debug-output) - ;; Use `describe-mode' key in `global-map'. - (define-key map [f1] nil) ; Allow to eval keymap without errors. - (define-key map (kbd "C-h C-h") 'undefined) - (define-key map (kbd "C-h h") 'undefined) - (cl-dolist (k (where-is-internal 'describe-mode global-map)) - (define-key map k 'helm-help)) - ;; Bind all actions from 1 to 12 to their corresponding nth index+1. - (cl-loop for n from 0 to 12 do - (define-key map (kbd (format "" (1+ n))) - `(lambda () - (interactive) - (helm-select-nth-action ,n)))) - map) - "Keymap for helm.") - - -(defgroup helm nil - "Open helm." - :prefix "helm-" :group 'convenience) - -(defcustom helm-completion-window-scroll-margin 5 - " `scroll-margin' to use for helm completion window. -Which see. Set to 0 to disable. -NOTE: This have no effect when `helm-display-source-at-screen-top' -id non--nil." - :group 'helm - :type 'integer) - -(defcustom helm-display-source-at-screen-top t - "Display candidates at the top of screen. -This happen when using `helm-next-source' and `helm-previous-source'. -NOTE: When non--nil (default) disable `helm-completion-window-scroll-margin'." - :group 'helm - :type 'boolean) - -(defcustom helm-candidate-number-limit 100 - "Limit candidate number globally. -Do not show more candidates than this limit from individual sources. -It is usually pointless to show hundreds of matches -when the pattern is empty, because it is much simpler to type a -few characters to narrow down the list of potential candidates. - -Set it to nil if you don't want this limit." - :group 'helm - :type '(choice (const :tag "Disabled" nil) integer)) - -(defcustom helm-idle-delay 0.01 - "Be idle for this many seconds, before updating in delayed sources. -This is useful for sources involving heavy operations -\(like launching external programs\), so that candidates -from the source are not retrieved unnecessarily if the user keeps typing. - -It also can be used to declutter the results helm displays, -so that results from certain sources are not shown with every -character typed, only if the user hesitates a bit. -Be sure to know what you are doing when modifying this." - :group 'helm - :type 'float) - -(defcustom helm-input-idle-delay 0.01 - "Be idle for this many seconds, before updating. - -Unlike `helm-idle-delay', it is also effective for non-delayed sources. -If nil, candidates are collected immediately. - -Note: If this value is too low compared to `helm-idle-delay', -you may have duplicated sources when using multiples sources. -Safe value is always >= `helm-idle-delay'. -Default settings are equal value for both. -Be sure to know what you are doing when modifying this." - :group 'helm - :type 'float) - -(defcustom helm-exit-idle-delay 0 - "Be idle for this many seconds before exiting minibuffer while helm is updating. -Note that this does nothing when helm-buffer is up to date -\(i.e exit without delay in this condition\)." - :group 'helm - :type 'float) - -(defcustom helm-full-frame nil - "Use current window to show the candidates. -If t then Helm doesn't pop up a new window." - :group 'helm - :type 'boolean) - -(defvaralias 'helm-samewindow 'helm-full-frame) -(make-obsolete-variable 'helm-samewindow 'helm-full-frame "1.4.8.1") - -(defcustom helm-quick-update nil - "If non-nil, suppress displaying sources which are out of screen at first. -They are treated as delayed sources at this input. -This flag makes `helm' a bit faster with many sources." - :group 'helm - :type 'boolean) - -(defcustom helm-candidate-separator - "--------------------" - "Candidates separator of `multiline' source." - :group 'helm - :type 'string) - -(defcustom helm-save-configuration-functions - '(set-window-configuration . current-window-configuration) - "The functions used to restore/save window or frame configurations. -It is a pair where the car is the function to restore window or frame config, -and the cdr is the function to save the window or frame config. - -If you want to save and restore frame configuration, set this variable to - '\(set-frame-configuration . current-frame-configuration\) -NOTE: This may not work properly with own-frame minibuffer settings. -Older version saves/restores frame configuration, but the default is changed now -because flickering can occur in some environment." - :group 'helm - :type 'sexp) - -(defcustom helm-persistent-action-use-special-display nil - "If non-nil, use `special-display-function' in persistent action." - :group 'helm - :type 'boolean) - -(defcustom helm-scroll-amount nil - "Scroll amount when scrolling other window in a helm session. -It is used by `helm-scroll-other-window' -and `helm-scroll-other-window-down'. - -If you prefer scrolling line by line, set this value to 1." - :group 'helm - :type 'integer) - -(defcustom helm-display-function 'helm-default-display-buffer - "Function to display *helm* buffer. -It is `helm-default-display-buffer' by default, -which affects `helm-full-frame'." - :group 'helm - :type 'symbol) - -(defcustom helm-case-fold-search 'smart - "Add 'smart' option to `case-fold-search'. -When smart is enabled, ignore case in the search strings -if pattern contains no uppercase characters. -Otherwise, with a nil or t value, the behavior is same as -`case-fold-search'. -Default value is smart, other possible values are nil and t. -NOTE: This have no effect in asynchronous sources, you will -have to implement a similar feature directly in the process. -See in helm-grep.el how it is implemented." - :group 'helm - :type '(choice (const :tag "Ignore case" t) - (const :tag "Respect case" nil) - (other :tag "Smart" 'smart))) - -(defcustom helm-file-name-case-fold-search - (if (memq system-type - '(cygwin windows-nt ms-dos darwin)) - t - helm-case-fold-search) - "Local setting of `helm-case-fold-search' for reading filenames. - -See `helm-case-fold-search' for more info." - :group 'helm - :type 'symbol) - -(defcustom helm-reuse-last-window-split-state nil - "Reuse the last state of window split, vertical or horizontal. -That is when you use `helm-toggle-resplit-window' the next helm session -will reuse the same window scheme than the one of last session unless -`helm-split-window-default-side' is 'same or 'other." - :group 'helm - :type 'boolean) - -(defcustom helm-split-window-preferred-function 'helm-split-window-default-fn - "Default function used for splitting window." - :group 'helm - :type 'function) - -(defcustom helm-split-window-default-side 'below - "The default side to display `helm-buffer'. -Must be one acceptable arg for `split-window' SIDE, -that is 'below, 'above, 'left or 'right. - -Other acceptable values are 'same which always display `helm-buffer' -in current window and 'other that display `helm-buffer' below if only one -window or in `other-window-for-scrolling' if available. - -A nil value as same effect as 'below. -If `helm-full-frame' is non--nil, it take precedence on this. - -See also `helm-split-window-in-side-p' and `helm-always-two-windows' that -take precedence on this. - -NOTE: this have no effect if `helm-split-window-preferred-function' is not -`helm-split-window-default-fn' unless this new function handle this." - :group 'helm - :type 'symbol) - -(defcustom helm-split-window-in-side-p nil - "Force splitting inside selected window when non--nil. -See also `helm-split-window-default-side'. - -NOTE: this have no effect if `helm-split-window-preferred-function' is not -`helm-split-window-default-fn' unless this new function handle this." - :group 'helm - :type 'boolean) - -(defcustom helm-always-two-windows nil - "When non--nil helm will use two windows in this frame. -That is one window to display `helm-buffer' and one to display -`helm-current-buffer'. -Note: this have no effect when `helm-split-window-in-side-p' is non--nil, -or when `helm-split-window-default-side' is set to 'same. -When `helm-autoresize-mode' is enabled, setting this to nil -will have no effect until this mode will be disabled." - :group 'helm - :type 'boolean) - -(defcustom helm-sources-using-default-as-input '(helm-source-imenu - helm-source-info-elisp - helm-source-etags-select) - "List of helm sources that need to use `helm-maybe-use-default-as-input'. -When a source is member of this list, default `thing-at-point' -will be used as input." - :group 'helm - :type '(repeat (choice symbol))) - -(defcustom helm-delete-minibuffer-contents-from-point t - "When non--nil, `helm-delete-minibuffer-contents' delete region from `point'. -Otherwise delete `minibuffer-contents'. -See documentation of `helm-delete-minibuffer-contents'." - :group 'helm - :type 'boolean) - -(defcustom helm-follow-mode-persistent nil - "Retrieve last state of `helm-follow-mode' in next helm session when non--nil. -This will not make it persistent through emacs sessions though, -you will have to set explicitely the `follow' attribute in the source where -you want this mode enabled definitely." - :group 'helm - :type 'boolean) - -(defcustom helm-prevent-escaping-from-minibuffer t - "Prevent escaping from minibuffer during helm session." - :group 'helm - :type 'boolean) - -(defcustom helm-truncate-lines nil - "Truncate long lines when non--nil. -See `truncate-lines'." - :group 'helm - :type 'boolean) - -(defcustom helm-move-to-line-cycle-in-source nil - "Move to end or beginning of source when reaching top or bottom of source. -This happen when using `helm-next/previous-line'." - :group 'helm - :type 'boolean) - -(defcustom helm-fuzzy-match-fn 'helm-fuzzy-match - "The function for fuzzy matching in `helm-source-sync' based sources." - :group 'helm - :type 'function) - -(defcustom helm-fuzzy-search-fn 'helm-fuzzy-search - "The function for fuzzy matching in `helm-source-in-buffer' based sources." - :group 'helm - :type 'function) - -(defcustom helm-fuzzy-sort-fn 'helm-fuzzy-matching-default-sort-fn - "The sort transformer function used in fuzzy matching. -When nil no sorting will be done." - :group 'helm - :type 'function) - -(defcustom helm-fuzzy-matching-highlight-fn 'helm-fuzzy-default-highlight-match - "The function to highlight matches in fuzzy matching. -When nil no highlighting will be done." - :group 'helm - :type 'function) - -(defcustom helm-autoresize-max-height 40 - "Specifies a maximum height and defaults to the height of helm window's frame in percentage. - -See `fit-window-to-buffer' for more infos." - :group 'helm - :type 'integer) - -(defcustom helm-autoresize-min-height 10 - "Specifies a minimum height and defaults to the height of helm window's frame in percentage. - -If nil the default of `window-min-height' is used -See `fit-window-to-buffer' for more infos." - :group 'helm - :type 'integer) - -(defcustom helm-input-method-verbose-flag nil - "The default value of `input-method-verbose-flag' to use in helm minibuffer. -It is nil by default to allow helm updating and exiting without turning off -the input method when complex methods are in use, if you set it to any other -value allowed by `input-method-verbose-flag' you will have at each time you want -to exit or helm update to disable the `current-input-method' with `C-\\'." - :group 'helm - :type '(radio :tag "A flag to control extra guidance given by input methods in helm." - (const :tag "Never provide guidance" nil) - (const :tag "Always provide guidance" t) - (const :tag "Provide guidance only in complex methods" complex-only))) - -(defcustom helm-display-header-line t - "Display header-line when non nil." - :group 'helm - :type 'boolean) - -(defcustom helm-file-globstar t - "Same as globstar bash shopt option. -When non--nil a pattern beginning with two stars will expand recursively. -Directories expansion is not supported yet." - :group 'helm - :type 'boolean) - -(defcustom helm-inherit-input-method t - "Inherit `current-input-method' from `current-buffer' when non--nil. -The default is to enable this by default, the user can toggle the current -input method with `toggle-input-method'." - :group 'helm - :type 'boolean) - -;;; Faces -;; -;; -(defgroup helm-faces nil - "Customize the appearance of helm." - :prefix "helm-" - :group 'faces - :group 'helm) - -(defface helm-source-header - '((((background dark)) - :background "#22083397778B" - :foreground "white" - :weight bold :height 1.3 :family "Sans Serif") - (((background light)) - :background "#abd7f0" - :foreground "black" - :weight bold :height 1.3 :family "Sans Serif")) - "Face for source header in the helm buffer." - :group 'helm-faces) - -(defface helm-visible-mark - '((((min-colors 88) (background dark)) - (:background "green1" :foreground "black")) - (((background dark)) - (:background "green" :foreground "black")) - (((background light)) :background "#d1f5ea") - (((min-colors 88)) - (:background "green1")) - (t (:background "green"))) - "Face for visible mark." - :group 'helm-faces) - -(defface helm-header - '((t (:inherit header-line))) - "Face for header lines in the helm buffer." - :group 'helm-faces) - -(defface helm-candidate-number - '((((background dark)) :background "Yellow" :foreground "black") - (((background light)) :background "#faffb5" :foreground "black")) - "Face for candidate number in mode-line." :group 'helm-faces) - -(defface helm-selection - '((((background dark)) :background "ForestGreen" - :distant-foreground "black") - (((background light)) :background "#b5ffd1" - :distant-foreground "black")) - "Face for currently selected item in the helm buffer." - :group 'helm-faces) - -(defface helm-separator - '((((background dark)) :foreground "red") - (((background light)) :foreground "#ffbfb5")) - "Face for multiline source separator." - :group 'helm-faces) - -(defface helm-action - '((t (:underline t))) - "Face for action lines in the helm action buffer." - :group 'helm-faces) - -(defface helm-prefarg - '((((background dark)) :foreground "green") - (((background light)) :foreground "red")) - "Face for showing prefix arg in mode-line." - :group 'helm-faces) - -(defface helm-match - '((((background light)) :foreground "#b00000") - (((background dark)) :foreground "gold1")) - "Face used to highlight matches." - :group 'helm) - - -;;; Variables. -;; -;; -(defvar helm-type-attributes nil - "It's a list of \(TYPE ATTRIBUTES ...\). -ATTRIBUTES are the same as attributes for `helm-sources'. -TYPE connects the value to the appropriate sources. -Don't set this directly, use instead `define-helm-type-attribute'. - -This allows specifying common attributes for several sources. -For example, sources which provide files can specify -common attributes with a `file' type.") - -(defvar helm-source-filter nil - "A list of source names to be displayed. -Other sources won't appear in the search results. -If nil then there is no filtering. -See also `helm-set-source-filter'.") - -(defvar helm-action-buffer "*helm action*" - "Buffer showing actions.") - -(defvar helm-selection-overlay nil - "Overlay used to highlight the currently selected item.") - -(defvar helm-async-processes nil - "List of information about asynchronous processes managed by helm.") - -(defvar helm-before-initialize-hook nil - "Run before helm initialization. -This hook is run before init functions in `helm-sources', -that is before creation of `helm-buffer'. -Local variables for `helm-buffer' that need a value from `current-buffer' -can be set here with `helm-set-local-variable'.") - -(defvar helm-after-initialize-hook nil - "Run after helm initialization. -This hook run inside `helm-buffer' once created. -Variables are initialized and the `helm-buffer' is created. -But the `helm-buffer' has no contents.") - -(defvar helm-update-hook nil - "Run after the helm buffer was updated according the new input pattern. -This hook is run at the beginning of buffer. -The first candidate is selected after running this hook. -See also `helm-after-update-hook'.") - -(defvar helm-after-update-hook nil - "Run after the helm buffer was updated according the new input pattern. -This is very similar to `helm-update-hook' but selection is not moved. -It is useful to select a particular object instead of the first one.") - -(defvar helm-cleanup-hook nil - "Run after helm minibuffer is closed. -IOW this hook is executed BEFORE performing action.") - -(defvar helm-select-action-hook nil - "Run when opening the action buffer.") - -(defvar helm-before-action-hook nil - "Run before executing action. -Contrarily to `helm-cleanup-hook', -this hook run before helm minibuffer is closed -and before performing action.") - -(defvar helm-after-action-hook nil - "Run after executing action.") - -(defvar helm-exit-minibuffer-hook nil - "Run just before exiting minibuffer.") - -(defvar helm-after-persistent-action-hook nil - "Run after executing persistent action.") - -(defvar helm-move-selection-before-hook nil - "Run before moving selection in `helm-buffer'.") - -(defvar helm-move-selection-after-hook nil - "Run after moving selection in `helm-buffer'.") - -(defvar helm-window-configuration-hook nil - "Run when switching to and back from action buffer.") - -(defconst helm-restored-variables - '(helm-candidate-number-limit - helm-source-filter - helm-source-in-each-line-flag - helm-map - helm-sources) - "Variables which are restored after `helm' invocation.") - -(defvar helm-execute-action-at-once-if-one nil - "Execute default action and exit when only one candidate is remaining.") - -(defvar helm-quit-if-no-candidate nil - "Quit when there is no candidates when non--nil. -This variable accepts a function, which is executed if no candidate.") - -(defvar helm-maybe-use-default-as-input nil - "Use :default arg of `helm' as input to update display. -Note that if also :input is specified as `helm' arg, it will take -precedence on :default.") - -(defvar helm-source-in-each-line-flag nil - "Non-nil means add helm-source text-property in each candidate. -experimental feature.") - -(defvar helm-debug-variables nil - "A list of helm variables to show in `helm-debug-output'. -Otherwise all variables started with `helm-' are shown.") - -(defvar helm-debug-buffer "*Debug Helm Log*") - -(defvar helm-debug nil - "If non-nil, write log message into `helm-debug-buffer' buffer. -It is disabled by default because `helm-debug-buffer' grows quickly.") - -(defvar helm-compile-source-functions - '(helm-compile-source--type - helm-compile-source--dummy - helm-compile-source--candidates-in-buffer) - "Functions to compile elements of `helm-sources' (plug-in).") - -(defvar helm-mode-line-string "\ -\\\ -\\[helm-help]:Help \ -\\[helm-select-action]:Act \ -\\[helm-maybe-exit-minibuffer]/\ -f1/f2/f-n:NthAct" - "Help string displayed in mode-line in `helm'. -It can be a string or a list of two args, in this case, -first arg is a string that will be used as name for candidates number, -second arg any string to display in mode line. -If nil, use default `mode-line-format'.") - - -;;; Internal Variables -;; -;; -(defvar helm-current-prefix-arg nil - "Record `current-prefix-arg' when exiting minibuffer.") -(defvar helm-saved-action nil - "Saved value of the currently selected action by key.") -(defvar helm-saved-current-source nil - "Value of the current source when the action list is shown.") -(defvar helm-compiled-sources nil - "Compiled version of `helm-sources'.") -(defvar helm-in-persistent-action nil - "Flag whether in persistent-action or not.") -(defvar helm-last-buffer nil - "`helm-buffer' of previously `helm' session.") -(defvar helm-saved-selection nil - "Value of the currently selected object when the action list is shown.") -(defvar helm-sources nil - "[INTERNAL] Value of current sources in use, a list.") -(defvar helm-buffer "*helm*" - "Buffer showing completions.") -(defvar helm-current-buffer nil - "Current buffer when `helm' is invoked.") -(defvar helm-buffer-file-name nil - "Variable `buffer-file-name' when `helm' is invoked.") -(defvar helm-default-directory nil - "The value of `default-directory' when `helm' is initialized.") -(defvar helm-candidate-cache (make-hash-table :test 'equal) - "Holds the available candidate within a single helm invocation.") -(defvar helm-pattern "" - "The input pattern used to update the helm buffer.") -(defvar helm-input "" - "The input typed in the candidates panel.") -(defvar helm-input-local nil - "Internal, store locally `helm-pattern' value for later use in `helm-resume'.") -(defvar helm-source-name nil) -(defvar helm-current-source nil) -(defvar helm-candidate-buffer-alist nil) -(defvar helm-match-hash (make-hash-table :test 'equal)) -(defvar helm-cib-hash (make-hash-table :test 'equal)) -(defvar helm-tick-hash (make-hash-table :test 'equal)) -(defvar helm-issued-errors nil) -(defvar helm-debug-root-directory nil - "When non--nil, save helm log to `helm-last-log-file'. -Be aware that if you set that, you will end up with a huge directory -of log files, so use that only for debugging purpose. -See `helm-log-save-maybe' for more info.") -(defvar helm-last-log-file nil - "The name of the last helm session log file.") -(defvar helm-follow-mode nil) -(defvar helm--local-variables nil) -(defvar helm-split-window-state nil) -(defvar helm--window-side-state nil) -(defvar helm-selection-point nil) -(defvar helm-alive-p nil) -(defvar helm-visible-mark-overlays nil) -(defvar helm-update-blacklist-regexps '("^" "^ *" "$" "!" " " "\\b" - "\\<" "\\>" "\\_<" "\\_>" ".*")) -(defvar helm-suspend-update-flag nil) -(defvar helm-force-updating-p nil) -(defvar helm-exit-status 0 - "Flag to inform whether helm have exited or quitted. -Exit with 0 mean helm have exited executing an action. -Exit with 1 mean helm have quitted with \\[keyboard-quit] -It is useful for example to restore a window config if helm abort -in special cases. -See `helm-exit-minibuffer' and `helm-keyboard-quit'.") -(defvar helm-minibuffer-confirm-state nil) -(defvar helm-quit nil) -(defvar helm-attributes nil "List of all `helm' attributes.") -(defvar helm-buffers nil - "All of `helm-buffer' in most recently used order.") -(defvar helm-current-position nil - "Cons of \(point . window-start\) when `helm' is invoked. -It is needed to restore position in `helm-current-buffer' -when `helm' is keyboard-quitted.") -(defvar helm-last-frame-or-window-configuration nil - "Used to store window or frame configuration when helm start.") -(defvar helm-onewindow-p nil) -(defvar helm-types nil) -(defvar helm--mode-line-string-real nil) ; The string to display in mode-line. -(defvar helm-persistent-action-display-window nil) -(defvar helm-marked-candidates nil - "Marked candadates. List of \(source . real\) pair.") -(defvar helm--mode-line-display-prefarg nil) -(defvar helm--temp-follow-flag nil - "[INTERNAL] A simple flag to notify persistent action we are following.") -(defvar helm--reading-passwd-or-string nil) -(defvar helm--in-update nil) -(defvar helm--in-fuzzy nil) - -;; Utility: logging -(defun helm-log (format-string &rest args) - "Log message `helm-debug' is non-nil. -Messages are written to the `helm-debug-buffer' buffer. - -Argument FORMAT-STRING is a string to use with `format'. -Use optional arguments ARGS like in `format'." - (when helm-debug - (with-current-buffer (get-buffer-create helm-debug-buffer) - (outline-mode) - (buffer-disable-undo) - (set (make-local-variable 'inhibit-read-only) t) - (goto-char (point-max)) - (insert (let ((tm (current-time))) - (format (concat (if (string-match "Start session" format-string) - "* " "** ") - "%s.%06d (%s)\n %s\n") - (format-time-string "%H:%M:%S" tm) - (nth 2 tm) - (helm-log-get-current-function) - (apply #'format (cons format-string args)))))))) - -(defun helm-log-run-hook (hook) - "Run HOOK like `run-hooks' but write these actions to helm log buffer." - (helm-log "Executing %s with value = %S" hook (symbol-value hook)) - (helm-log "Executing %s with global value = %S" hook (default-value hook)) - (run-hooks hook) - (helm-log "executed %s" hook)) - -(defun helm-log-get-current-function () - "Get function name calling `helm-log'. -The original idea is from `tramp-debug-message'." - (cl-loop with exclude-func-re = "^helm-\\(?:interpret\\|log\\|.*funcall\\)" - for btn from 1 to 40 - for btf = (cl-second (backtrace-frame btn)) - for fn = (if (symbolp btf) (symbol-name btf) "") - if (and (string-match "^helm" fn) - (not (string-match exclude-func-re fn))) - return fn)) - -(defun helm-log-error (&rest args) - "Accumulate error messages into `helm-issued-errors'. -ARGS are args given to `format'. -e.g (helm-log-error \"Error %s: %s\" (car err) (cdr err))." - (apply 'helm-log (concat "ERROR: " (car args)) (cdr args)) - (let ((msg (apply 'format args))) - (unless (member msg helm-issued-errors) - (add-to-list 'helm-issued-errors msg)))) - -(defun helm-log-save-maybe () - "May be save log buffer to `helm-last-log-file'. -If `helm-debug-root-directory' is non--nil and a valid directory, -a directory named 'helm-debug-' -will be created there and the log recorded in a file named -at the date and time of today in this directory." - (when (and (stringp helm-debug-root-directory) - (file-directory-p helm-debug-root-directory) - helm-debug) - (let ((logdir (expand-file-name (concat "helm-debug-" - (format-time-string "%Y%m%d")) - helm-debug-root-directory))) - (make-directory logdir t) - (with-current-buffer (get-buffer-create helm-debug-buffer) - (write-region (point-min) (point-max) - (setq helm-last-log-file - (expand-file-name - (format-time-string "%Y%m%d-%H%M%S") - logdir)) - nil 'silent) - (kill-buffer))))) - -;;;###autoload -(defun helm-debug-open-last-log () - "Open helm log file of last helm session. -If `helm-last-log-file' is nil, switch to `helm-debug-buffer' ." - (interactive) - (if helm-last-log-file - (view-file helm-last-log-file) - (switch-to-buffer helm-debug-buffer) - (view-mode 1) (visual-line-mode 1))) - -(defun helm-print-error-messages () - "Print error messages in `helm-issued-errors'." - (and helm-issued-errors - (message "Helm issued errors: %s" - (mapconcat 'identity (reverse helm-issued-errors) "\n")))) - - -;; Programming Tools -(defmacro helm-aif (test-form then-form &rest else-forms) - "Like `if' but set the result of TEST-FORM in a temprary variable called `it'. -THEN-FORM and ELSE-FORMS are then excuted just like in `if'." - (declare (indent 2) (debug t)) - `(let ((it ,test-form)) - (if it ,then-form ,@else-forms))) - -(defun helm-mklist (obj) - "If OBJ is a list \(but not lambda\), return itself. -Otherwise make a list with one element." - (if (and (listp obj) (not (functionp obj))) - obj - (list obj))) - -(defun helm-this-command () - "Return the actual command in action. -Like `this-command' but return the real command, -not `exit-minibuffer' or unwanted functions." - (cl-loop with bl = '(helm-maybe-exit-minibuffer - helm-confirm-and-exit-minibuffer - helm-exit-minibuffer - exit-minibuffer) - for count from 1 to 50 - for btf = (backtrace-frame count) - for fn = (cl-second btf) - if (and - ;; In some case we may have in the way an - ;; advice compiled resulting in byte-code, - ;; ignore it (Issue #691). - (symbolp fn) - (commandp fn) - (not (memq fn bl))) - return fn - else - if (and (eq fn 'call-interactively) - (> (length btf) 2)) - return (cadr (cdr btf)))) - -(defun helm-flatten-list (seq &optional omit-nulls) - "Return a list of all single elements of sublists in SEQ." - (let (result) - (cl-labels ((flatten (seq) - (cl-loop - for elm in seq - if (and (or elm - (null omit-nulls)) - (or (atom elm) - (functionp elm) - (and (consp elm) - (cdr elm) - (atom (cdr elm))))) - do (push elm result) - else do (flatten elm)))) - (flatten seq)) - (nreverse result))) - - -;; Test tools -(defmacro with-helm-time-after-update (&rest body) - (helm-with-gensyms (start-time time-elapsed) - `(let ((,start-time (float-time)) ,time-elapsed) - (add-hook 'helm-after-update-hook - (lambda () - (setq ,time-elapsed (- (float-time) ,start-time)) - (keyboard-quit))) - (unwind-protect ,@body - (remove-hook 'helm-after-update-hook - (lambda () - (setq ,time-elapsed (- (float-time) ,start-time)) - (keyboard-quit)))) - ,time-elapsed))) - - -;; Helm API - -(defun helm-buffer-get () - "Return `helm-action-buffer' if shown otherwise `helm-buffer'." - (if (helm-action-window) - helm-action-buffer - helm-buffer)) - -(defun helm-window () - "Window of `helm-buffer'." - (get-buffer-window (helm-buffer-get) 0)) - -(defun helm-action-window () - "Window of `helm-action-buffer'." - (get-buffer-window helm-action-buffer 'visible)) - -(defmacro with-helm-window (&rest body) - "Be sure BODY is excuted in the helm window." - (declare (indent 0) (debug t)) - `(with-selected-window (helm-window) - ,@body)) - -(defmacro with-helm-current-buffer (&rest body) - "Eval BODY inside `helm-current-buffer'." - (declare (indent 0) (debug t)) - `(with-current-buffer (or (and (buffer-live-p helm-current-buffer) - helm-current-buffer) - (setq helm-current-buffer - (current-buffer))) - ,@body)) - -(defmacro with-helm-buffer (&rest body) - "Eval BODY inside `helm-buffer'." - (declare (indent 0) (debug t)) - `(with-current-buffer (helm-buffer-get) - ,@body)) - -(defmacro with-helm-restore-variables (&rest body) - "Restore `helm-restored-variables' after executing BODY." - (declare (indent 0) (debug t)) - (helm-with-gensyms (orig-vars) - `(let ((,orig-vars (mapcar (lambda (v) - (cons v (symbol-value v))) - helm-restored-variables))) - (unwind-protect (progn ,@body) - (cl-loop for (var . value) in ,orig-vars - do (set var value)) - (helm-log "restore variables"))))) - -(defmacro with-helm-default-directory (directory &rest body) - (declare (indent 2) (debug t)) - `(let ((default-directory (or (and ,directory - (file-name-as-directory ,directory)) - default-directory))) - ,@body)) - -(defun helm-default-directory () - "Return the value of `helm-default-directory'." - (buffer-local-value 'helm-default-directory (get-buffer helm-buffer))) - -(defmacro with-helm-temp-hook (hook &rest body) - "Execute temporarily BODY as a function for HOOK." - (declare (indent 1) (debug t)) - (helm-with-gensyms (fun) - `(progn - (defun ,fun () - (unwind-protect - (progn ,@body) - (remove-hook ,hook (quote ,fun)))) - (add-hook ,hook (quote ,fun))))) - -(defmacro with-helm-after-update-hook (&rest body) - "Execute BODY at end of `helm-update'." - (declare (indent 0) (debug t)) - `(with-helm-temp-hook 'helm-after-update-hook ,@body)) - -(defmacro with-helm-alive-p (&rest body) - "Return error when BODY run outside helm context." - (declare (indent 0) (debug t)) - `(progn - (if helm-alive-p - (progn ,@body) - (error "Running helm command outside of context")))) - -(cl-defun helm-attr (attribute-name - &optional (src (helm-get-current-source)) compute) - "Get the value of ATTRIBUTE-NAME of SRC. -If SRC is omitted, use current source. -If COMPUTE is non--nil compute value of ATTRIBUTE-NAME -with `helm-interpret-value'." - (helm-aif (or (assq attribute-name src) - (helm-get-attribute-from-source-type attribute-name src)) - (if compute (helm-interpret-value (cdr it)) (cdr it)))) - -(cl-defun helm-attr-defined (attribute-name - &optional (src (helm-get-current-source))) - "Return non-nil if ATTRIBUTE-NAME of SRC is defined. -if SRC is omitted, use current source." - (and (helm-attr attribute-name src) t)) - -(cl-defun helm-attrset (attribute-name value - &optional - (src (helm-get-current-source)) - alter-type) - "Set the value of ATTRIBUTE-NAME of source SRC to VALUE. -If ATTRIBUTE-NAME doesn't exists in source it is created with value VALUE. -If ALTER-TYPE is non--nil alter the value of ATTRIBUTE-NAME in `helm-attributes' -if it exists. -If SRC is omitted, use current source. -If operation succeed, return value, otherwise nil." - (let ((from-type (helm-get-attribute-from-source-type attribute-name src)) - done) - (helm-aif (or (assq attribute-name src) - (and alter-type from-type)) - (prog1 (setcdr it value) (setq done t)) - (unless from-type - (setcdr src (cons (cons attribute-name value) (cdr src))) - (setq done t))) - (and done value))) - -(defun helm-get-attribute-from-source-type (attribute source) - "Get ATTRIBUTE from type attribute of SOURCE." - (when (assq 'type source) - (assq attribute - (assq (cdr (assq 'type source)) - helm-type-attributes)))) - -(defun helm-get-attribute-from-type (attribute type) - "Get ATTRIBUTE from TYPE. -arg TYPE is an existing type defined in `helm-type-attributes'." - (assq attribute (assq type helm-type-attributes))) - -(defun helm-get-actions-from-type (source) - "Get actions list from type attribute of SOURCE." - (when (assq 'type source) - (helm-get-attribute-from-source-type 'action source))) - -(defun helm-inherit-attribute-from-source (attribute source) - "Get the ATTRIBUTE of SOURCE." - (helm-aif (assq attribute source) - it - (helm-get-attribute-from-source-type attribute source))) - -(defun helm-append-at-nth (seq elm index) - "Append ELM at INDEX in SEQ." - (let ((len (length seq))) - (when (> index len) (setq index len)) - (cl-loop for i in seq - for count from 1 collect i - when (= count index) - if (listp elm) append elm - else collect elm))) - -(defun helm-add-action-to-source (name fn source &optional index) - "Add new action NAME linked to function FN to SOURCE. -Function FN should be a valid function that take one arg i.e candidate, -argument NAME is a string that will appear in action menu -and SOURCE should be an existing helm source already loaded. -If INDEX is specified, action is added in action list at INDEX, -otherwise it is added at end. -This allow user to add a specific action to an existing source -without modifying source code." - (let ((actions (helm-attr 'action source)) - (new-action (list (cons name fn)))) - (when (symbolp actions) - (setq actions (list (cons "Default action" actions)))) - (helm-attrset 'action - (if index - (helm-append-at-nth actions new-action index) - (append actions new-action)) - source))) - -(defun helm-delete-action-from-source (action-or-name source) - "Delete ACTION-OR-NAME from SOURCE. -ACTION-OR-NAME can either be the name of action or the symbol function -associated to name." - (let* ((actions (helm-attr 'action source)) - (del-action (if (symbolp action-or-name) - (rassoc action-or-name actions) - (assoc action-or-name actions)))) - (helm-attrset 'action (delete del-action actions) source))) - -(cl-defun helm-add-action-to-source-if (name fn source predicate - &optional (index 4) test-only) - "Add new action NAME linked to function FN to SOURCE. -Action NAME will be available when the current candidate matches PREDICATE. -This function add an entry in the `action-transformer' attribute -of SOURCE (or create one if not found). -Function PREDICATE should take one arg candidate. -Function FN should be a valid function that take one arg i.e candidate, -argument NAME is a string that will appear in action menu -and SOURCE should be an existing helm source already loaded. -If INDEX is specified, action is added in action list at INDEX. -Value of INDEX should be always >=1, default to 4. -This allow user to add a specific `action-tranformer' -to an existing source without modifying source code. -E.g -Add the action \"Byte compile file async\" linked to -function 'async-byte-compile-file to source `helm-source-find-files' -only when predicate helm-ff-candidates-lisp-p return non--nil: - -\(helm-add-action-to-source-if \"Byte compile file async\" - 'async-byte-compile-file - helm-source-find-files - 'helm-ff-candidates-lisp-p\)." - (let* ((actions (helm-attr 'action source)) - (action-transformers (helm-attr 'action-transformer source)) - (new-action (list (cons name fn))) - (transformer `(lambda (actions candidate) - (cond ((funcall (quote ,predicate) candidate) - (helm-append-at-nth - actions (quote ,new-action) ,index)) - (t actions))))) - (when (symbolp actions) - (helm-attrset 'action (list (cons "Default action" actions)) source)) - (when (symbolp action-transformers) - (setq action-transformers (list action-transformers))) - (if test-only ; debug - (delq nil (append (list transformer) action-transformers)) - (helm-attrset 'action-transformer - (helm-fast-remove-dups - (delq nil (append (list transformer) action-transformers)) - :test 'equal) - source)))) - -(defun helm-set-source-filter (sources) - "Set the value of `helm-source-filter' to SOURCES and update. - -This function sets a filter for helm sources and it may be -called while helm is running. It can be used to toggle -displaying of sources dynamically. For example, additional keys -can be bound into `helm-map' to display only the file-related -results if there are too many matches from other sources and -you're after files only: - -Shift+F shows only file results from some sources: - -\(define-key helm-map \"F\" 'helm-my-show-files-only) - -\(defun helm-my-show-files-only () - (interactive) - (helm-set-source-filter '(\"File Name History\" - \"Files from Current Directory\"))) - -Shift+A shows all results: - -\(define-key helm-map \"A\" 'helm-my-show-all) - -\(defun helm-my-show-all () - (interactive) - (helm-set-source-filter nil)) - -The -my- part is added to avoid collisions with -existing Helm function names." - (let ((cur-disp-sel (with-current-buffer helm-buffer - (helm-get-selection nil t)))) - (setq helm-source-filter (helm--normalize-filter-sources sources)) - (helm-log "helm-source-filter = %S" helm-source-filter) - ;; Use force-update to run init/update functions. - (helm-force-update (and (stringp cur-disp-sel) - (regexp-quote cur-disp-sel))))) - -(defun helm--normalize-filter-sources (sources) - (cl-loop for s in sources collect - (cond ((symbolp s) - (assoc-default 'name (symbol-value s))) - ((listp s) - (assoc-default 'name s)) - ((stringp s) s)))) - -(defun helm-set-sources (sources &optional no-init no-update) - "Set SOURCES during `helm' invocation. -If NO-INIT is non-nil, skip executing init functions of SOURCES. -If NO-UPDATE is non-nil, skip executing `helm-update'." - (with-current-buffer helm-buffer - (setq helm-compiled-sources nil - helm-sources sources) - (helm-log "helm-compiled-sources = %S" helm-compiled-sources) - (helm-log "helm-sources = %S" helm-sources)) - (unless no-init (helm-funcall-foreach 'init)) - (unless no-update (helm-update))) - -(defun helm-get-sources () - "Return compiled `helm-sources', which is memoized. - -Attributes: - -- type - `helm-type-attributes' are merged in. -- candidates-buffer - candidates, volatile and match attribute are created." - (cond - ;; action - ((helm-action-window) - helm-sources) - ;; memoized - (helm-compiled-sources) - ;; first time - (t - (prog1 - (setq helm-compiled-sources - (helm-compile-sources - helm-sources helm-compile-source-functions)) - (helm-log "helm-compiled-sources = %S" helm-compiled-sources))))) - -(cl-defun helm-get-selection (&optional (buffer nil buffer-s) - force-display-part) - "Return the currently selected item or nil. -if BUFFER is nil or unspecified, use helm-buffer as default value. -If FORCE-DISPLAY-PART is non-nil, return the display string. -If FORCE-DISPLAY-PART value is 'withprop the display string is returned -with its properties." - (setq buffer (if (and buffer buffer-s) buffer helm-buffer)) - (unless (helm-empty-buffer-p buffer) - (with-current-buffer buffer - (let* ((disp-fn (if (eq force-display-part 'withprop) - 'buffer-substring - 'buffer-substring-no-properties)) - (selection - (or (and (not force-display-part) - (get-text-property (overlay-start - helm-selection-overlay) - 'helm-realvalue)) - ;; It is needed to return properties of DISP in some case, - ;; e.g for `helm-confirm-and-exit-minibuffer', - ;; so use `buffer-substring' here when 'withprop is specified. - (let ((disp (funcall - disp-fn - (overlay-start helm-selection-overlay) - (1- (overlay-end helm-selection-overlay)))) - (source (helm-get-current-source))) - (helm-aif (and (not force-display-part) - (assoc-default 'display-to-real source)) - (helm-funcall-with-source source it disp) - disp))))) - (unless (equal selection "") - (helm-log "selection = %S" selection) - selection))))) - -(defun helm-get-actions-from-current-source () - "Return the associated action for the selected candidate. -It is a function symbol \(sole action\) or list -of \(action-display . function\)." - (unless (helm-empty-buffer-p (helm-buffer-get)) - (helm-aif (helm-attr 'action-transformer) - (helm-composed-funcall-with-source - (helm-get-current-source) it - (helm-attr 'action) (helm-get-selection)) - (helm-attr 'action)))) - -(defun helm-get-current-source () - "Return the source for the current selection. -Allow also checking if helm-buffer contain candidates." - (or helm-current-source - (with-current-buffer (helm-buffer-get) - (or - ;; This happen only when `helm-source-in-each-line-flag' - ;; is non--nil and there is candidates in buffer. - (get-text-property (point) 'helm-source) - ;; Return nil when no--candidates. - (cl-block exit - ;; This goto-char shouldn't be necessary, but point is moved to - ;; point-min somewhere else which shouldn't happen. - (goto-char (overlay-start helm-selection-overlay)) - (let* ((header-pos (or (helm-get-previous-header-pos) - (helm-get-next-header-pos))) - (source-name - (save-excursion - (unless header-pos - (cl-return-from exit nil)) - (goto-char header-pos) - (helm-current-line-contents)))) - (cl-loop for source in (helm-get-sources) thereis - (and (equal (assoc-default 'name source) source-name) - source)))))))) - -(defun helm-buffer-is-modified (buffer) - "Return non-nil when BUFFER is modified since `helm' was invoked." - (let* ((b (get-buffer buffer)) - (key (concat (buffer-name b) "/" (helm-attr 'name))) - (source-tick (or (gethash key helm-tick-hash) 0)) - (buffer-tick (buffer-chars-modified-tick b)) - (modifiedp (/= source-tick buffer-tick))) - (puthash key buffer-tick helm-tick-hash) - (helm-log "buffer = %S" buffer) - (helm-log "modifiedp = %S" modifiedp) - modifiedp)) - -(defun helm-current-buffer-is-modified () - "Check if `helm-current-buffer' is modified since `helm' was invoked." - (helm-buffer-is-modified helm-current-buffer)) - -(defun helm-run-after-quit (function &rest args) - "Perform an action after quitting `helm'. -The action is to call FUNCTION with arguments ARGS." - (setq helm-quit t) - (helm-kill-async-processes) - (helm-log "function = %S" function) - (helm-log "args = %S" args) - (apply 'run-with-timer 0.1 nil function args) - (helm-exit-minibuffer)) - - -(defun define-helm-type-attribute (type definition &optional doc) - "Register type attribute of TYPE as DEFINITION with DOC. -DOC is displayed in `helm-type-attributes' docstring. - -Use this function is better than setting `helm-type-attributes' directly." - (cl-loop for i in definition do - ;; without `ignore-errors', error at emacs22 - (ignore-errors (setf i (delete nil i)))) - (helm-add-type-attribute type definition) - (and doc (helm-document-type-attribute type doc)) - nil) - -(defun helm-document-attribute (attribute short-doc &optional long-doc) - "Register ATTRIBUTE documentation introduced by plug-in. -SHORT-DOC is displayed beside attribute name. -LONG-DOC is displayed below attribute name and short documentation." - (if long-doc - (setq short-doc (concat "(" short-doc ")")) - (setq long-doc short-doc - short-doc "")) - (add-to-list 'helm-attributes attribute t) - (put attribute 'helm-attrdoc - (concat "- " (symbol-name attribute) - " " short-doc "\n\n" long-doc "\n"))) - -(put 'helm-document-attribute 'lisp-indent-function 2) - -(defun helm-interpret-value (value &optional source) - "Interpret VALUE as variable, function or literal and return it. -If VALUE is a function, call it with no arguments and return the value. -If SOURCE compute VALUE for this source. -If VALUE is a variable, return the value. -If VALUE is a symbol, but it is not a function or a variable, cause an error. -Otherwise, return VALUE itself." - (cond ((and source (functionp value)) - (helm-funcall-with-source source value)) - ((functionp value) - (funcall value)) - ((and (symbolp value) (boundp value)) - (symbol-value value)) - ((symbolp value) - (error - "helm-interpret-value: Symbol must be a function or a variable")) - (t - value))) - -(defun helm-set-local-variable (&rest args) - "Bind each pair in ARGS locally to `helm-buffer'. -Use this to set local vars before calling helm. -Usage: helm-set-local-variable ([VAR VALUE]...) -Just like `setq' except that the vars are not set sequentially. -IOW Don't use VALUE of previous VAR to eval the VALUE of next VAR. -When helm is alive use `make-local-variable' as usual on `helm-buffer'. - -\(fn VAR VALUE ...)" - (setq helm--local-variables - (append (cl-loop for i on args by #'cddr - collect (cons (car i) (cadr i))) - helm--local-variables))) - -(defun helm-make-actions (&rest args) - "Build an alist with (NAME . ACTION) elements with each pairs in ARGS. -Where NAME is a string or a function returning a string or nil and ACTION -a function. -If NAME returns nil the pair is skipped. - -\(fn NAME ACTION ...)" - (cl-loop for i on args by #'cddr - for name = (car i) - when (functionp name) - do (setq name (funcall name)) - when name - collect (cons name (cadr i)))) - -;; Core: API helper -(cl-defun helm-empty-buffer-p (&optional (buffer helm-buffer)) - "Check if BUFFER have candidates. -Default value for BUFFER is `helm-buffer'." - (zerop (buffer-size (and buffer (get-buffer buffer))))) - -(defun helm-empty-source-p () - "Check if current source contains candidates. -This happen only in certains cases when e.g the last element -of a source is deleted without updating the source." - (with-helm-window - (or (helm-empty-buffer-p) - (and (helm-end-of-source-p) - (eq (point-at-bol) (point-at-eol)) - (or - (save-excursion - (forward-line -1) - (helm-pos-header-line-p)) - (bobp)))))) - -(defun helm-symbol-name (obj) - (if (or (consp obj) (byte-code-function-p obj)) - "Anonymous" - (symbol-name obj))) - - -;; Core: tools -(defun helm-current-line-contents () - "Current line string without properties." - (buffer-substring-no-properties (point-at-bol) (point-at-eol))) - -(defun helm-funcall-with-source (source functions &rest args) - "Call from SOURCE FUNCTIONS list or single function FUNCTIONS with ARGS. -FUNCTIONS can be a symbol or a list of functions. -Return the result of last function call." - (let ((helm-source-name (assoc-default 'name source)) - (helm-current-source source) - (funs (if (functionp functions) (list functions) functions))) - (helm-log "helm-source-name = %S" helm-source-name) - (helm-log "functions = %S" functions) - (helm-log "args = %S" args) - (cl-loop with result for fn in funs - do (setq result (apply fn args)) finally return result))) - -(defun helm-funcall-foreach (sym &optional sources) - "Call the associated function to SYM for each source if any." - (let ((sources (or sources (helm-get-sources)))) - (cl-dolist (source sources) - (helm-aif (assoc-default sym source) - (helm-funcall-with-source source it))))) - -(defun helm-normalize-sources (sources) - "If SOURCES is only one source, make a list of one element." - (cond ((or (and sources - (symbolp sources)) - (and (listp sources) (assq 'name sources))) - (list sources)) - (sources) - (t helm-sources))) - -(defun helm-get-candidate-number (&optional in-current-source) - "Return candidates number in `helm-buffer'. -If IN-CURRENT-SOURCE is provided return number of candidates -in the source where point is." - (with-current-buffer (helm-buffer-get) - (if (or (helm-empty-buffer-p) - (helm-empty-source-p)) - 0 - (save-excursion - (if in-current-source - (goto-char (helm-get-previous-header-pos)) - (goto-char (point-min))) - (forward-line 1) - (if (helm-pos-multiline-p) - (save-excursion - (cl-loop with count-multi = 1 - while (and (not (if in-current-source - (save-excursion - (forward-line 2) - (or (helm-pos-header-line-p) (eobp))) - (eobp))) - (search-forward helm-candidate-separator nil t)) - do (cl-incf count-multi) - finally return count-multi)) - (save-excursion - (cl-loop with ln = 0 - while (not (if in-current-source - (or (helm-pos-header-line-p) (eobp)) - (eobp))) - unless (helm-pos-header-line-p) - do (cl-incf ln) - do (forward-line 1) finally return ln))))))) - -(defmacro with-helm-quittable (&rest body) - "If an error occur in execution of BODY, quit helm safely." - (declare (indent 0) (debug t)) - `(condition-case _v - (let (inhibit-quit) - ,@body) - (quit (setq quit-flag t) - (setq helm-quit t) - (exit-minibuffer) - (keyboard-quit) - ;; See comment about this in `with-local-quit'. - (eval '(ignore nil))))) - -(defun helm-compose (arg-lst func-lst) - "Apply arguments specified in ARG-LST with each function of FUNC-LST. -The result of each function will be the new `car' of ARG-LST. -Each function in FUNC-LST must accept (length ARG-LST) arguments -\(See examples below) . -This function allows easy sequencing of transformer functions. -Where generally, ARG-LST is '(candidates-list source) and FUNC-LST a -list of transformer functions that take one or two arguments depending -we are using 'filtered-candidate-transformer' or 'candidate-transformer'. -e.g -filtered-candidate-transformer: -\(helm-compose '((1 2 3 4 5 6 7) - '((name . \"A helm source\") (candidates . (a b c)))) - '((lambda (candidates _source) - (cl-loop for i in candidates - when (cl-oddp i) collect i)) - (lambda (candidates _source) - (cl-loop for i in candidates collect (1+ i))))) -=>(2 4 6 8) - -candidate-transformer: -\(helm-compose '((1 2 3 4 5 6 7)) - '((lambda (candidates) - (cl-loop for i in candidates - when (cl-oddp i) collect i)) - (lambda (candidates) - (cl-loop for i in candidates collect (1+ i))))) -=> (2 4 6 8)." - (cl-dolist (func func-lst) - (setcar arg-lst (apply func arg-lst))) - (car arg-lst)) - -(defun helm-composed-funcall-with-source (source funcs &rest args) - "With SOURCE apply `helm-funcall-with-source' with each FUNCS and ARGS. -This is used in transformers to modify candidates list." - (if (functionp funcs) - (apply 'helm-funcall-with-source source funcs args) - (apply 'helm-funcall-with-source source - (lambda (&rest oargs) (helm-compose oargs funcs)) - args))) - -(defun helm-stringify (str-or-sym) - "Get string of STR-OR-SYM." - (if (stringp str-or-sym) - str-or-sym - (symbol-name str-or-sym))) - -(defun helm-symbolify (str-or-sym) - "Get symbol of STR-OR-SYM." - (if (symbolp str-or-sym) - str-or-sym - (intern str-or-sym))) - - -;; Core: entry point -;; `:allow-nest' is not in this list because it is treated before. -(defconst helm-argument-keys - '(:sources :input :prompt :resume - :preselect :buffer :keymap :default :history)) - -;;;###autoload -(defun helm (&rest plist) - "Main function to execute helm sources. - -Keywords supported: -:sources :input :prompt :resume :preselect -:buffer :keymap :default :history :allow-nest - -Extra LOCAL-VARS keywords are supported, see below. - -PLIST is a list like \(:key1 val1 :key2 val2 ...\) or -\(&optional sources input prompt resume - preselect buffer keymap default history\). - -Basic keywords are the following: - -\:sources - -A list of sources used for this session. It also accepts a -symbol, interpreted as a variable of a helm source -i.e (a symbol can be passed instead of a list of sources). -It also accepts an alist representing a helm source, which is -detected by \(assq 'name ANY-SOURCES\). -NOTE: In this case the source is embedded in the helm command and -have no symbol name, so it is not reachable from outside. -It will be referenced in `helm-sources' as a whole alist. - -\:input - -Temporary value of `helm-pattern', ie. initial input of minibuffer. - -\:prompt - -Prompt other than \"pattern: \". - -\:resume - -If t, Resurrect previously instance of `helm'. Skip the initialization. -If 'noresume, this instance of `helm' cannot be resumed. - -\:preselect - -Initially selected candidate. Specified by exact candidate or a regexp. - -\:buffer - -`helm-buffer' instead of *helm*. - -\:keymap - -`helm-map' for current `helm' session. - -\:default - -A default argument that will be inserted in minibuffer \ -with \\\\[next-history-element]. -When nil or not present `thing-at-point' will be used instead. -If `helm-maybe-use-default-as-input' is non--nil display will be -updated using :default arg as input unless :input is specified, -which in this case will take precedence on :default -This is a string or a list, in this case the car of the list will -be used as initial default input, but you will be able to cycle in this -list with \\\\[next-history-element]. - -\:history - -By default all minibuffer input is pushed to `minibuffer-history', -if an argument HISTORY is provided, input will be pushed to HISTORY. -History element should be a symbol. - -\:allow-nest - -Allow running this helm command within a running helm session. - -Of course, conventional arguments are supported, the two are same. - -\(helm :sources sources :input input :prompt prompt :resume resume - :preselect preselect :buffer buffer :keymap keymap :default default - :history history\) - -and - -\(helm sources input prompt resume preselect buffer keymap default history\) - -are the same. - -However the use of non keyword args is deprecated and should not be used. - -Other keywords are interpreted as local variables of this helm session. -The `helm-' prefix can be omitted. For example, - -\(helm :sources 'helm-source-buffers-list - :buffer \"*buffers*\" :candidate-number-limit 10\) - -means starting helm session with `helm-source-buffers' -source in *buffers* buffer and set variable `helm-candidate-number-limit' -to 10 as session local variable. - -\(fn &key SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT HISTORY ALLOW-NEST OTHER-LOCAL-VARS)" - (let ((fn (cond ((or (and helm-alive-p (plist-get plist :allow-nest)) - (and helm-alive-p (memq 'allow-nest plist))) - #'helm-nest) - ((keywordp (car plist)) - #'helm) - (t #'helm-internal)))) - (if (and helm-alive-p (eq fn #'helm)) - (if (helm-alive-p) - ;; A helm session is normally running. - (error "Error: Trying to run helm within a running helm session") - ;; A helm session is already running and user jump somewhere else - ;; without desactivating it. - (with-helm-buffer - (prog1 - (message "Aborting an helm session running in background") - ;; `helm-alive-p' will be reset in unwind-protect forms. - (helm-keyboard-quit)))) - (if (keywordp (car plist)) - ;; Parse `plist' and move not regular `helm-argument-keys' - ;; to `helm--local-variables', then calling helm on itself - ;; with normal arguments (the non--arguments-keys removed) - ;; will end up in [1]. - (progn - (setq helm--local-variables - (append helm--local-variables - ;; Vars passed by keyword on helm call - ;; take precedence on same vars - ;; that may have been passed before helm call. - (helm-parse-keys plist))) - (apply fn (mapcar #'(lambda (key) (plist-get plist key)) - helm-argument-keys))) - (apply fn plist))))) ; [1] fn == helm-internal. - -(defun helm-alive-p () - "Check if `helm' is alive. -An `helm' session is considered alive if `helm-alive-p' is non--nil, -the `helm-buffer' is visible, and cursor is in minibuffer." - (and helm-alive-p - (get-buffer-window helm-buffer 'visible) - (minibuffer-window-active-p (minibuffer-window)) - (minibufferp (current-buffer)))) - -(defun helm-parse-keys (keys) - "Parse the KEYS arguments of `helm'. -Return only the keys that are not in `helm-argument-keys', -prefix them with \"helm\" and convert them to alist. -This allow to add arguments that are not part of `helm-argument-keys', -but are valid helm variables. -e.g :candidate-number-limit will be bound to `helm-candidate-number-limit' -in source. - - (helm-parse-keys '(:sources ((name . \"test\") - (candidates . (a b c))) - :buffer \"toto\" - :candidate-number-limit 4)) - ==> ((helm-candidate-number-limit . 4))." - - (cl-loop for (key value) on keys by #'cddr - for symname = (substring (symbol-name key) 1) - for sym = (intern (if (string-match "^helm-" symname) - symname - (concat "helm-" symname))) - unless (memq key helm-argument-keys) - collect (cons sym value))) - -;;; Core: entry point helper -(defun helm-internal (&optional - any-sources any-input - any-prompt any-resume - any-preselect any-buffer - any-keymap any-default any-history) - "The internal helm function called by `helm'. -For ANY-SOURCES ANY-INPUT ANY-PROMPT ANY-RESUME ANY-PRESELECT ANY-BUFFER and -ANY-KEYMAP ANY-DEFAULT ANY-HISTORY See `helm'." - ;; Activate the advice for `tramp-read-passwd'. - (if (fboundp 'advice-add) - (progn - (advice-add 'tramp-read-passwd :around #'helm--advice-tramp-read-passwd) - (advice-add 'ange-ftp-get-passwd :around #'helm--advice-ange-ftp-get-passwd)) - (ad-activate 'tramp-read-passwd) - (ad-activate 'ange-ftp-get-passwd)) - (helm-log (concat "[Start session] " (make-string 41 ?+))) - (helm-log "any-prompt = %S" any-prompt) - (helm-log "any-preselect = %S" any-preselect) - (helm-log "any-buffer = %S" any-buffer) - (helm-log "any-keymap = %S" any-keymap) - (helm-log "any-default = %S" any-default) - (helm-log "any-history = %S" any-history) - (let ((non-essential t) - (input-method-verbose-flag helm-input-method-verbose-flag) - (old--cua cua-mode) - (helm-maybe-use-default-as-input - (or helm-maybe-use-default-as-input ; it is let-bounded so use it. - (cl-loop for s in (helm-normalize-sources any-sources) - thereis (memq s helm-sources-using-default-as-input))))) - ;; cua-mode overhide local helm bindings. - ;; disable this stupid thing if enabled. - (and cua-mode (cua-mode -1)) - (unwind-protect - (condition-case-unless-debug _v - (let ( ;; `helm-source-name' is non-nil - ;; when `helm' is invoked by action, reset it. - helm-source-name - helm-current-source - helm-in-persistent-action - helm-quit - (helm-buffer (or any-buffer helm-buffer))) - (with-helm-restore-variables - (helm-initialize - any-resume any-input any-default any-sources) - (helm-display-buffer helm-buffer) - (when helm-prevent-escaping-from-minibuffer - (helm--remap-mouse-mode 1)) ; Disable mouse bindings. - (add-hook 'post-command-hook 'helm--maybe-update-keymap) - (helm-log "show prompt") - (unwind-protect - (helm-read-pattern-maybe - any-prompt any-input any-preselect - any-resume any-keymap any-default any-history) - (helm-cleanup))) - (prog1 - (unless helm-quit (helm-execute-selection-action)) - (helm-log (concat "[End session] " (make-string 41 ?-))))) - (quit - (helm-restore-position-on-quit) - (helm-log (concat "[End session (quit)] " (make-string 34 ?-))) - nil)) - (remove-hook 'post-command-hook 'helm--maybe-update-keymap) - (if (fboundp 'advice-add) - (progn - (advice-remove 'tramp-read-passwd - #'helm--advice-tramp-read-passwd) - (advice-remove 'ange-ftp-get-passwd - #'helm--advice-ange-ftp-get-passwd)) - (ad-deactivate 'tramp-read-passwd) - (ad-deactivate 'ange-ftp-get-passwd)) - (helm-log "helm-alive-p = %S" (setq helm-alive-p nil)) - (helm--remap-mouse-mode -1) ; Reenable mouse bindings. - (setq helm-alive-p nil) - ;; Reset helm-pattern so that lambda's using it - ;; before running helm will not start with its old value. - (setq helm-pattern "") - (and old--cua (cua-mode 1)) - (helm-log-save-maybe)))) - - -;;; Helm resume -;; -;; -(defun helm-resume (arg) - "Resurrect previously invoked `helm'. -Called with a prefix arg, allow choosing among all existing -helm buffers. i.e choose among various helm sessions. -Called from lisp, you can specify a buffer-name as a string with ARG." - (interactive "P") - (let (any-buffer helm-full-frame cur-dir) - (if arg - (if (and (stringp arg) (bufferp (get-buffer arg))) - (setq any-buffer arg) - (setq any-buffer (helm-resume-select-buffer))) - (setq any-buffer helm-last-buffer)) - (cl-assert any-buffer nil - "helm-resume: No helm buffers found to resume") - ;; Reset `cursor-type' to nil as it have been set to t - ;; when quitting previous session. - (with-current-buffer any-buffer (setq cursor-type nil)) - (setq helm-full-frame (buffer-local-value - 'helm-full-frame (get-buffer any-buffer))) - (setq helm-compiled-sources nil) - (setq cur-dir (buffer-local-value - 'helm-default-directory (get-buffer any-buffer))) - (unless (buffer-live-p helm-current-buffer) - ;; `helm-current-buffer' may have been killed. - (setq helm-current-buffer (current-buffer))) - ;; Restart with same `default-directory' value this session - ;; was initially started with. - (with-helm-default-directory cur-dir - (helm - :sources (buffer-local-value - 'helm-sources (get-buffer any-buffer)) - :input (buffer-local-value 'helm-input-local (get-buffer any-buffer)) - :resume t - :buffer any-buffer)))) - -(defun helm-resume-previous-session-after-quit (arg) - "Resume previous helm session within running helm." - (interactive "p") - (if (and helm-alive-p (> (length helm-buffers) arg)) - (helm-run-after-quit `(lambda () (helm-resume (nth ,arg helm-buffers)))) - (message "No previous helm sessions to resume yet!"))) - -(defun helm-resume-list-buffers-after-quit () - "List resumable helm buffers within running helm." - (interactive) - (if (and helm-alive-p (> (length helm-buffers) 0)) - (helm-run-after-quit #'(lambda () (helm-resume t))) - (message "No previous helm sessions to resume yet!"))) - -(defun helm-resume-p (any-resume) - "Whether current helm session is resumed or not." - (eq any-resume t)) - -(defun helm-resume-select-buffer () - "Select an `helm-buffer' in `helm-buffers' list to resume a helm session. -Return nil if no `helm-buffer' found." - (when helm-buffers - (or (helm :sources '(((name . "Resume helm buffer") - (candidates . helm-buffers) - (action . identity))) - :resume 'noresume - :buffer "*helm resume*") - (keyboard-quit)))) - - -;;;###autoload -(defun helm-other-buffer (any-sources any-buffer) - "Simplified interface of `helm' with other `helm-buffer'. -Call `helm' with only ANY-SOURCES and ANY-BUFFER as args." - (helm :sources any-sources :buffer any-buffer)) - -(defun helm-nest (&rest same-as-helm) - "Allow calling `helm' whithin a running helm session. -Arguments SAME-AS-HELM are the same as `helm', which see." - (with-helm-window - (let ((orig-helm-current-buffer helm-current-buffer) - (orig-helm-buffer helm-buffer) - (orig-helm--in-fuzzy helm--in-fuzzy) - (orig-helm-last-frame-or-window-configuration - helm-last-frame-or-window-configuration) - (orig-one-window-p helm-onewindow-p)) - (unwind-protect - (let (helm-current-position - helm-current-buffer - helm-pattern - (helm-buffer (or (cl-getf same-as-helm :buffer) - (nth 5 same-as-helm) - "*Helm*")) - helm-sources - helm-compiled-sources - (helm-full-frame t) - (enable-recursive-minibuffers t)) - (apply #'helm same-as-helm)) - (with-current-buffer orig-helm-buffer - (setq helm-alive-p t) ; Nested session set this to nil on exit. - (setq helm-buffer orig-helm-buffer) - (setq helm--in-fuzzy orig-helm--in-fuzzy) - (helm-initialize-overlays helm-buffer) - (unless (helm-empty-buffer-p) (helm-mark-current-line t)) - (setq helm-last-frame-or-window-configuration - orig-helm-last-frame-or-window-configuration) - (setq cursor-type nil) - (setq helm-current-buffer orig-helm-current-buffer) - (setq helm-onewindow-p orig-one-window-p)))))) - - -;;; Core: Accessors -;; -(defun helm-current-position (save-or-restore) - "Restore or save current position in `helm-current-buffer'. -Argument SAVE-OR-RESTORE is one of save or restore." - (cl-case save-or-restore - (save - (helm-log "Save position at %S" (cons (point) (window-start))) - (setq helm-current-position (cons (point) (window-start)))) - (restore - (helm-log "Restore position at %S in buffer %s" - helm-current-position - (buffer-name (current-buffer))) - (goto-char (car helm-current-position)) - ;; Fix this position with the NOFORCE arg of `set-window-start' - ;; otherwise, if there is some other buffer than `helm-current-buffer' - ;; one, position will be lost. - (set-window-start (selected-window) (cdr helm-current-position) t)))) - - -(defun helm-frame-or-window-configuration (save-or-restore) - "Save or restore last frame or window configuration. -Possible value of SAVE-OR-RESTORE are 'save and 'restore. -window or frame configuration is saved/restored according to values of -`helm-save-configuration-functions'." - (helm-log "helm-save-configuration-functions = %S" - helm-save-configuration-functions) - (let ((window-persistent-parameters (append '((no-other-window . t)) - window-persistent-parameters))) - (cl-case save-or-restore - (save (setq helm-last-frame-or-window-configuration - (funcall (cdr helm-save-configuration-functions)))) - (restore (funcall (car helm-save-configuration-functions) - helm-last-frame-or-window-configuration) - ;; Restore frame focus. - ;; This is needed for minibuffer own-frame config - ;; when recursive minibuffers are in use. - ;; e.g M-: + helm-minibuffer-history. - (let ((frame (if (minibufferp helm-current-buffer) - (selected-frame) - (last-nonminibuffer-frame)))) - (select-frame-set-input-focus frame)))))) - -(defun helm-split-window-default-fn (window) - (let (split-width-threshold) - (if (and (fboundp 'window-in-direction) - ;; Don't try to split when starting in a minibuffer - ;; e.g M-: and try to use helm-show-kill-ring. - (not (minibufferp helm-current-buffer))) - (if (or (one-window-p t) - helm-split-window-in-side-p) - (split-window - (selected-window) nil (if (eq helm-split-window-default-side 'other) - 'below helm-split-window-default-side)) - ;; If more than one window reuse one of them. - (cl-case helm-split-window-default-side - (left (or (helm-window-in-direction 'left) - (helm-window-in-direction 'above) - (selected-window))) - (above (or (helm-window-in-direction 'above) - (helm-window-in-direction 'left) - (selected-window))) - (right (or (helm-window-in-direction 'right) - (helm-window-in-direction 'below) - (selected-window))) - (below (or (helm-window-in-direction 'below) - (helm-window-in-direction 'right) - (selected-window))) - (same (selected-window)) - (other (other-window-for-scrolling)) - (t (or (window-next-sibling) (selected-window))))) - (split-window-sensibly window)))) - -(defun helm-window-in-direction (direction) - "Same as `window-in-direction' but check if window is dedicated." - (helm-aif (window-in-direction direction) - (and (not (window-dedicated-p it)) it))) - - -;;; Display helm buffer -;; -;; -(defun helm-display-buffer (buffer) - "Display BUFFER. -The function used to display `helm-buffer'." - (let (pop-up-frames - (split-window-preferred-function - helm-split-window-preferred-function) - (helm-split-window-default-side - (if (and (not helm-full-frame) - helm-reuse-last-window-split-state) - (cond ((eq helm-split-window-default-side 'same) 'same) - ((eq helm-split-window-default-side 'other) 'other) - (helm--window-side-state) - (t helm-split-window-default-side)) - helm-split-window-default-side))) - (prog1 - (funcall (with-current-buffer buffer helm-display-function) buffer) - (setq helm-onewindow-p (one-window-p t)) - ;; Don't allow other-window and friends switching out of minibuffer. - (when helm-prevent-escaping-from-minibuffer - (helm-prevent-switching-other-window))))) - -(cl-defun helm-prevent-switching-other-window (&key (enabled t)) - "Allow setting `no-other-window' window parameter in all windows. -Arg ENABLE will be the value of the `no-other-window' window property." - (walk-windows - #'(lambda (w) - (unless (window-dedicated-p w) - (set-window-parameter w 'no-other-window enabled))) - 0)) - -(defun helm-default-display-buffer (buffer) - "Default function to display `helm-buffer' BUFFER. -It uses `switch-to-buffer' or `pop-to-buffer' depending of value of -`helm-full-frame' and/or `helm-split-window-default-side'." - (if (or (buffer-local-value 'helm-full-frame (get-buffer buffer)) - (and (eq helm-split-window-default-side 'same) - (one-window-p t))) - (progn (delete-other-windows) (switch-to-buffer buffer)) - (when (and (or helm-always-two-windows helm-autoresize-mode) - (not (eq helm-split-window-default-side 'same)) - (not (minibufferp helm-current-buffer)) - (not helm-split-window-in-side-p)) - (delete-other-windows)) - (pop-to-buffer buffer))) - - -;;; Core: initialize -;; -(defun helm-initialize (any-resume any-input any-default any-sources) - "Start initialization of `helm' session. -For ANY-RESUME ANY-INPUT ANY-DEFAULT and ANY-SOURCES See `helm'." - (helm-log "start initialization: any-resume=%S any-input=%S" - any-resume any-input) - (helm-frame-or-window-configuration 'save) - (setq helm-sources (helm-normalize-sources any-sources)) - (setq helm--in-fuzzy - (cl-loop for s in helm-sources - for matchfns = (helm-match-functions - (if (symbolp s) (symbol-value s) s)) - for searchfns = (helm-search-functions - (if (symbolp s) (symbol-value s) s)) - when (or (member 'helm-fuzzy-match matchfns) - (member 'helm-fuzzy-search searchfns)) - return t)) - (helm-log "sources = %S" helm-sources) - (helm-current-position 'save) - (if (helm-resume-p any-resume) - (helm-initialize-overlays (helm-buffer-get)) - (helm-initial-setup any-default)) - (setq helm-alive-p t) - (unless (eq any-resume 'noresume) - (helm-recent-push helm-buffer 'helm-buffers) - (setq helm-last-buffer helm-buffer)) - (when any-input - (setq helm-input any-input - helm-pattern any-input) - (helm--fuzzy-match-maybe-set-pattern)) - ;; If a `resume' attribute is present `helm-funcall-foreach' - ;; will run its function. - (when (helm-resume-p any-resume) - (helm-funcall-foreach 'resume)) - (helm-log "end initialization")) - -(defun helm-initialize-overlays (buffer) - "Initialize helm overlays in BUFFER." - (helm-log "overlay setup") - (if helm-selection-overlay - ;; make sure the overlay belongs to the helm buffer if - ;; it's newly created - (move-overlay helm-selection-overlay (point-min) (point-min) - (get-buffer buffer)) - - (setq helm-selection-overlay - (make-overlay (point-min) (point-min) (get-buffer buffer))) - (overlay-put helm-selection-overlay 'face 'helm-selection) - (overlay-put helm-selection-overlay 'priority 1))) - -(defun helm-restore-position-on-quit () - "Restore position in `helm-current-buffer' when quitting." - (helm-current-position 'restore)) - -(defun helm-recent-push (elt list-var) - "Add ELT to the value of LIST-VAR as most recently used value." - (let ((m (member elt (symbol-value list-var)))) - (and m (set list-var (delq (car m) (symbol-value list-var)))) - (push elt (symbol-value list-var)))) - -(defun helm--current-buffer () - "[internal] Return `current-buffer' BEFORE `helm-buffer' is initialized. -Note that this will return the minibuffer in use after helm have started, -so to get the buffer where helm started while in a helm session, -use `helm-current-buffer'. -It is intended to use this only in `helm-initial-setup'." - (if (minibuffer-window-active-p (minibuffer-window)) - ;; If minibuffer is active be sure to use it's buffer - ;; as `helm-current-buffer', this allow to use helm - ;; from an already active minibuffer (M-: etc...) - (window-buffer (active-minibuffer-window)) - ;; Fix Issue #456 - ;; Use this instead of `current-buffer' to ensure - ;; helm session started in helm-mode from a completing-read - ;; Use really the buffer where we started and not the one - ;; where the completing-read is wrapped. i.e - ;; (with-current-buffer SOME-OTHER-BUFFER (completing-read [...]) - (window-buffer (with-selected-window (minibuffer-window) - (minibuffer-selected-window))))) - -(defun helm-initial-setup (any-default) - "Initialize helm settings and set up the helm buffer." - (helm-log-run-hook 'helm-before-initialize-hook) - (cl-loop for s in (helm-get-sources) - for hook = (assoc-default 'before-init-hook s) - when hook do (helm-log-run-hook hook)) - ;; For initialization of helm locals vars that need - ;; a value from current buffer, it is here. - (helm-set-local-variable 'current-input-method current-input-method) - (setq helm-current-prefix-arg nil) - (setq helm-suspend-update-flag nil) - (setq helm-current-buffer (helm--current-buffer)) - (setq helm-buffer-file-name buffer-file-name) - (setq helm-issued-errors nil) - (setq helm-compiled-sources nil) - (setq helm-saved-current-source nil) - (unless (and (or helm-split-window-state - helm--window-side-state) - helm-reuse-last-window-split-state) - (setq helm-split-window-state - (if (or (null split-width-threshold) - (and (integerp split-width-threshold) - (>= split-width-threshold (+ (frame-width) 4)))) - 'vertical 'horizontal)) - (setq helm--window-side-state - (or helm-split-window-default-side 'below))) - ;; Call the init function for sources where appropriate - (helm-funcall-foreach - 'init (and helm-source-filter - (cl-remove-if-not #'(lambda (s) - (member (assoc-default 'name s) - helm-source-filter)) - (helm-get-sources)))) - (setq helm-pattern (or (and helm-maybe-use-default-as-input - (or (if (listp any-default) - (car any-default) any-default) - (with-helm-current-buffer - (thing-at-point 'symbol)))) - "")) - (setq helm-input "") - (clrhash helm-candidate-cache) - (helm-create-helm-buffer) - (helm-clear-visible-mark) - (helm-log-run-hook 'helm-after-initialize-hook) - (cl-loop for s in (helm-get-sources) - for hook = (assoc-default 'after-init-hook s) - when hook do (helm-log-run-hook hook))) - -(defun helm-create-helm-buffer () - "Create and setup `helm-buffer'." - (let ((root-dir default-directory)) - (with-current-buffer (get-buffer-create helm-buffer) - (helm-log "kill local variables: %S" (buffer-local-variables)) - (kill-all-local-variables) - (set (make-local-variable 'inhibit-read-only) t) - (buffer-disable-undo) - (erase-buffer) - (set (make-local-variable 'helm-map) helm-map) - (make-local-variable 'helm-sources) - (set (make-local-variable 'helm-follow-mode) nil) - (set (make-local-variable 'helm-display-function) helm-display-function) - (set (make-local-variable 'helm-selection-point) nil) - (set (make-local-variable 'scroll-margin) - (if helm-display-source-at-screen-top - 0 helm-completion-window-scroll-margin)) - (set (make-local-variable 'helm-default-directory) root-dir) - (set (make-local-variable 'default-directory) root-dir) - (set (make-local-variable 'helm-marked-candidates) nil) - (helm-initialize-persistent-action) - (helm-log "helm-display-function = %S" helm-display-function) - (helm-log "helm--local-variables = %S" helm--local-variables) - (cl-loop for (var . val) in helm--local-variables - do (set (make-local-variable var) val) - finally (setq helm--local-variables nil)) - (setq truncate-lines helm-truncate-lines) ; already local. - (setq cursor-type nil) - (setq mode-name "Helm")) - (helm-initialize-overlays helm-buffer) - (get-buffer helm-buffer))) - -(define-minor-mode helm--minor-mode - "[INTERNAL] Enable keymap in helm minibuffer. -This mode have no effect when run outside of helm context. -Please don't use it. - -\\{helm-map}" - :group 'helm - :keymap (and helm-alive-p helm-map) - (unless helm-alive-p (setq helm--minor-mode nil))) - -(defun helm-read-pattern-maybe (any-prompt any-input - any-preselect any-resume any-keymap - any-default any-history) - "Read pattern with prompt ANY-PROMPT and initial input ANY-INPUT. -For ANY-PRESELECT ANY-RESUME ANY-KEYMAP ANY-DEFAULT ANY-HISTORY, See `helm'." - (if (and (helm-resume-p any-resume) - ;; When no source, helm-buffer is empty - ;; or contain non--candidate lines (e.g grep exit status) - (helm-get-current-source)) - (helm-mark-current-line t) - (helm-update any-preselect)) - (with-current-buffer (helm-buffer-get) - (let* ((src (helm-get-current-source)) - (src-keymap (assoc-default 'keymap src)) - (hist (or (and any-history (symbolp any-history) any-history) - ;; Needed for resuming. - (assoc-default 'history src))) - (timer nil) - blink-matching-paren - (first-src (car helm-sources)) - (source-delayed-p (or (assq 'delayed src) - (assq 'delayed (if (symbolp first-src) - (symbol-value first-src) - first-src))))) - ;; Startup with the first keymap found either in current source - ;; or helm arg, otherwise use global value of `helm-map'. - ;; This map will be used as a `minibuffer-local-map'. - ;; Maybe it will be overriden when changing source - ;; by `helm--maybe-update-keymap'. - ;; Note that helm-map have been made buffer-local - ;; in `helm-create-helm-buffer'. - (setq helm-map (or src-keymap any-keymap helm-map)) - (helm-log "helm-get-candidate-number => %S" - (helm-get-candidate-number)) - (helm-log "helm-execute-action-at-once-if-one = %S" - helm-execute-action-at-once-if-one) - (helm-log "helm-quit-if-no-candidate = %S" helm-quit-if-no-candidate) - ;; If source is delayed `helm-execute-action-at-once-if-one' - ;; and `helm-quit-if-no-candidate' are handled after update finish. - (when source-delayed-p - ;; Note that we quickly add the hook now when `helm-update' - ;; is already started, but because source is delayed the hook - ;; should have the time to be passed !!! - ;; the hook will remove itself once done. - (with-helm-after-update-hook (helm-exit-or-quit-maybe))) - ;; Reset `helm-pattern' for non--delayed sources and update - ;; display if no result found with precedent value of `helm-pattern' - ;; unless `helm-quit-if-no-candidate' is non--nil, in this case - ;; Don't force update with an empty pattern. - ;; Reset also `helm-maybe-use-default-as-input' as this checking - ;; happen only on startup. - (when (and helm-maybe-use-default-as-input (not source-delayed-p)) - (setq helm-pattern "") - (setq helm-maybe-use-default-as-input nil) - (and (helm-empty-buffer-p) - (null helm-quit-if-no-candidate) - (helm-force-update))) - ;; Handle `helm-execute-action-at-once-if-one' and - ;; `helm-quit-if-no-candidate' now only for not--delayed sources. - (cond ((and helm-execute-action-at-once-if-one - (not source-delayed-p) - (= (helm-get-candidate-number) 1)) - (ignore)) ; Don't enter the minibuffer loop. - ((and helm-quit-if-no-candidate - (not source-delayed-p) - (= (helm-get-candidate-number) 0)) - (setq helm-quit t) - (and (functionp helm-quit-if-no-candidate) - (funcall helm-quit-if-no-candidate))) - (t ; Enter now minibuffer and wait for input. - (let ((tap (or any-default - (with-helm-current-buffer - (thing-at-point 'symbol))))) - (unwind-protect - (minibuffer-with-setup-hook - #'(lambda () - ;; Start minor-mode with global value of helm-map. - (helm--minor-mode 1) - ;; Now overhide the global value of helm-map with - ;; the local one. - (setq minor-mode-overriding-map-alist - `((helm--minor-mode - . ,(with-helm-buffer helm-map)))) - (setq timer (run-with-idle-timer - (max helm-input-idle-delay 0.001) 'repeat - #'(lambda () - ;; Stop updating when in persistent action - ;; or when `helm-suspend-update-flag' is - ;; non--nil. - (unless (or helm-in-persistent-action - helm-suspend-update-flag) - (save-selected-window - (helm-check-minibuffer-input) - (helm-print-error-messages))))))) - (read-from-minibuffer (or any-prompt "pattern: ") - any-input helm-map - nil hist tap helm-inherit-input-method)) - (when timer (cancel-timer timer) (setq timer nil))))))))) - -(defun helm-exit-or-quit-maybe () - "Exit and run default action if only one candidate, quit if no candidates. -This function is handling `helm-execute-action-at-once-if-one' and -`helm-quit-if-no-candidate' in delayed sources." - (with-helm-window - (cond ((and helm-execute-action-at-once-if-one - (= (helm-get-candidate-number) 1)) - (helm-exit-minibuffer)) - ((and helm-quit-if-no-candidate - (= (helm-get-candidate-number) 0)) - (setq helm-quit t) - (and (functionp helm-quit-if-no-candidate) - (funcall helm-quit-if-no-candidate)) - (keyboard-quit))))) - -(defun helm-toggle-suspend-update () - "Enable or disable update of display in helm. -This can be useful for e.g writing quietly a complex regexp." - (interactive) - (when (setq helm-suspend-update-flag (not helm-suspend-update-flag)) - (helm-kill-async-processes) - (setq helm-pattern "")) - (message (if helm-suspend-update-flag - "Helm update suspended!" - "Helm update reenabled!"))) - -(defadvice tramp-read-passwd (around disable-helm-update) - ;; Suspend update when prompting for a tramp password. - (setq helm-suspend-update-flag t) - (setq overriding-terminal-local-map nil) - (setq helm--reading-passwd-or-string t) - (let (stimers) - (unwind-protect - (progn - (setq stimers (with-timeout-suspend)) - ad-do-it) - (with-timeout-unsuspend stimers) - (setq helm--reading-passwd-or-string nil) - (setq helm-suspend-update-flag nil)))) - -(defun helm--advice-tramp-read-passwd (old--fn &rest args) - ;; Suspend update when prompting for a tramp password. - (setq helm-suspend-update-flag t) - (setq overriding-terminal-local-map nil) - (setq helm--reading-passwd-or-string t) - (unwind-protect - ;; No need to suspend timer in emacs-24.4 - ;; it is fixed upstream. - (apply old--fn args) - (setq helm--reading-passwd-or-string nil) - (setq helm-suspend-update-flag nil))) - -(defun helm--advice-ange-ftp-get-passwd (old--fn &rest args) - ;; Suspend update when prompting for a ange password. - (setq helm-suspend-update-flag t) - (setq overriding-terminal-local-map nil) - (setq helm--reading-passwd-or-string t) - (unwind-protect - (apply old--fn args) - (setq helm--reading-passwd-or-string nil) - (setq helm-suspend-update-flag nil))) - -(defadvice ange-ftp-get-passwd (around disable-helm-update) - ;; Suspend update when prompting for a ange password. - (setq helm-suspend-update-flag t) - (setq overriding-terminal-local-map nil) - (setq helm--reading-passwd-or-string t) - (unwind-protect - ad-do-it - (setq helm--reading-passwd-or-string nil) - (setq helm-suspend-update-flag nil))) - -(defun helm--maybe-update-keymap () - "Handle differents keymaps in multiples sources. - -It will override `helm-map' with the local map of current source. -If no map is found in current source do nothing (keep previous map)." - (with-helm-buffer - (helm-aif (assoc-default 'keymap (helm-get-current-source)) - ;; We need the timer to leave enough time - ;; to helm to setup its buffer when changing source - ;; from a recursive minibuffer. - ;; e.g C-x C-f M-y C-g - ;; => *find-files have now the bindings of *kill-ring. - (run-with-idle-timer - 0.01 nil - (lambda () - (with-current-buffer (window-buffer (minibuffer-window)) - (setq minor-mode-overriding-map-alist `((helm--minor-mode . ,it))))))))) - -;;; Prevent loosing focus when using mouse. -;; -(defvar helm--remap-mouse-mode-map - (let ((map (make-sparse-keymap))) - (cl-loop for k in '([mouse-1] [mouse-2] [mouse-3] - [down-mouse-1] [down-mouse-2] [down-mouse-3] - [drag-mouse-1] [drag-mouse-2] [drag-mouse-3] - [double-mouse-1] [double-mouse-2] [double-mouse-3] - [triple-mouse-1] [triple-mouse-2] [triple-mouse-3]) - do (define-key map k 'undefined)) - map)) - -(define-minor-mode helm--remap-mouse-mode - "[INTERNAL] Prevent escaping helm minibuffer with mouse clicks. -Do nothing when used outside of helm context. - -WARNING: Do not use this mode yourself, it is internal to helm." - :group 'helm - :global t - :keymap helm--remap-mouse-mode-map - (unless helm-alive-p - (setq helm--remap-mouse-mode-map nil))) - -;; Core: clean up - -(defun helm-cleanup () - "Clean up the mess when helm exit or quit." - (helm-log "start cleanup") - (with-current-buffer helm-buffer - ;; bury-buffer from this window. - (bury-buffer) ;[1] - ;; Be sure we call this from helm-buffer. - (helm-funcall-foreach 'cleanup)) - (helm-kill-async-processes) - ;; When running helm from a dedicated frame - ;; with no minibuffer, helm will run in the main frame - ;; which have a minibuffer, so be sure to disable - ;; the `no-other-window' prop there. - (helm-prevent-switching-other-window :enabled nil) - (helm-log-run-hook 'helm-cleanup-hook) - (helm-frame-or-window-configuration 'restore) - ;; [1] now bury-buffer from underlying windows otherwise, - ;; if this window is killed the underlying buffer will - ;; be a helm buffer. - (replace-buffer-in-windows helm-buffer) - (setq helm-alive-p nil) - ;; This is needed in some cases where last input - ;; is yielded infinitely in minibuffer after helm session. - (helm-clean-up-minibuffer)) - -(defun helm-clean-up-minibuffer () - "Remove contents of minibuffer." - (let ((miniwin (minibuffer-window))) - ;; Clean only current minibuffer used by helm. - ;; i.e The precedent one is active. - (unless (minibuffer-window-active-p miniwin) - (with-current-buffer (window-buffer miniwin) - (delete-minibuffer-contents))))) - - -;;; Core: input handling -;; -;; -(defun helm-check-minibuffer-input () - "Check minibuffer content." - (with-helm-quittable - (with-selected-window (or (active-minibuffer-window) - (minibuffer-window)) - (helm-check-new-input (minibuffer-contents))))) - -(defun helm-check-new-input (input) - "Check INPUT string and update the helm buffer if necessary." - ;; First time minibuffer is entered - ;; we check value of `helm-pattern' that have been set - ;; in `helm-initial-setup' when `helm-maybe-use-default-as-input' - ;; is non--nil. After this initial check, reset - ;; `helm-maybe-use-default-as-input' and ignore this. - ;; This happen only when source is `delayed'. - (when helm-maybe-use-default-as-input ; nil when non--delayed. - (setq input helm-pattern) - (with-helm-after-update-hook (setq helm-pattern "")) - (setq helm-maybe-use-default-as-input nil)) - ;; In delayed sources `helm-pattern' have not been resat yet. - (unless (equal input helm-pattern) - (setq helm-pattern input) - (unless (helm-action-window) - (setq helm-input helm-pattern)) - (helm-log "helm-pattern = %S" helm-pattern) - (helm-log "helm-input = %S" helm-input) - (setq helm--in-update t) - (helm-update))) - -(defun helm--reset-update-flag () - (run-with-idle-timer - helm-exit-idle-delay nil - (lambda () (setq helm--in-update nil)))) - -(add-hook 'helm-after-update-hook #'helm--reset-update-flag) - - -;;; Core: source compiler -;; -;; -(defun helm-compile-sources (sources funcs) - "Compile SOURCES with FUNCS. -See `helm-compile-source-functions'. -Helm plug-ins are realized by this function." - (mapcar - (lambda (source) - (cl-loop with src = (if (listp source) source (symbol-value source)) - for noplug = (assoc 'dont-plug src) - for f in funcs - unless (and noplug (memq f (cdr noplug))) - do (setq src (funcall f src)) - finally (cl-return src))) - sources)) - - -;; Core: all candidates - -(defun helm-get-candidates (source) - "Retrieve and return the list of candidates from SOURCE." - (let* (inhibit-quit - (candidate-fn (assoc-default 'candidates source)) - (candidate-proc (assoc-default 'candidates-process source)) - (type-error (lambda () - (error - "`%s' must either be a function, a variable or a list" - (or candidate-fn candidate-proc)))) - (candidates (condition-case-unless-debug err - ;; Process candidates-(process) function - ;; It may return a process or a list of candidates. - (if candidate-proc - (helm-interpret-value candidate-proc source) - (helm-interpret-value candidate-fn source)) - (error (helm-log "Error: %S" err) nil)))) - (when (and (processp candidates) (not candidate-proc)) - (warn "Candidates function `%s' should be called in a `candidates-process' attribute" - candidate-fn)) - (cond ((processp candidates) - ;; Candidates will be filtered later in process filter. - candidates) - ((or (null candidates) - ;; Can happen when the output of a process - ;; is empty, and the candidates function call - ;; something like (split-string (buffer-string) "\n") - ;; which result in a list of one empty string (Issue #938). - ;; e.g (completing-read "test: " '("")) - (equal candidates '(""))) - nil) - ((listp candidates) - ;; Transform candidates with `candidate-transformer' functions if - ;; some, otherwise return candidates. - (helm-transform-candidates candidates source)) - (t (funcall type-error))))) - -(defmacro helm-while-no-input (&rest body) - "Same as `while-no-input' but without testing with `input-pending-p'." - (declare (debug t) (indent 0)) - (let ((catch-sym (make-symbol "input")) - inhibit-quit) - `(with-local-quit - (catch ',catch-sym - (let ((throw-on-input ',catch-sym)) - ,@body))))) - -(defun helm-get-cached-candidates (source) - "Return the cached value of candidates for SOURCE. -Cache the candidates if there is not yet a cached value." - (let* ((name (assoc-default 'name source)) - (candidate-cache (gethash name helm-candidate-cache))) - (helm-aif candidate-cache - (prog1 it (helm-log "Use cached candidates")) - (helm-log "No cached candidates, calculate candidates") - (let ((candidates (helm-get-candidates source))) - (cond ((processp candidates) - (push (cons candidates - (append source - (list (cons 'item-count 0) - (cons 'incomplete-line "")))) - helm-async-processes) - (set-process-filter candidates 'helm-output-filter) - (setq candidates nil)) - ((not (assoc 'volatile source)) - (puthash name candidates helm-candidate-cache))) - candidates)))) - - -;;; Core: candidate transformers -(defun helm-transform-mapcar (function args) - "`mapcar' for candidate-transformer. - -ARGS is (cand1 cand2 ...) or ((disp1 . real1) (disp2 . real2) ...) - -\(helm-transform-mapcar 'upcase '(\"foo\" \"bar\")) -=> (\"FOO\" \"BAR\") -\(helm-transform-mapcar 'upcase '((\"1st\" . \"foo\") (\"2nd\" . \"bar\"))) -=> ((\"1st\" . \"FOO\") (\"2nd\" . \"BAR\")) -" - (cl-loop for arg in args - if (consp arg) - collect (cons (car arg) (funcall function (cdr arg))) - else - collect (funcall function arg))) - -(defun helm-process-candidate-transformer (candidates source) - "Execute `candidate-transformer' function(s) on CANDIDATES in SOURCE." - (helm-aif (assoc-default 'candidate-transformer source) - (helm-composed-funcall-with-source source it candidates) - candidates)) - -(defun helm-process-filtered-candidate-transformer (candidates source) - "Execute `filtered-candidate-transformer' function(s) on CANDIDATES in SOURCE." - (helm-aif (assoc-default 'filtered-candidate-transformer source) - (helm-composed-funcall-with-source source it candidates source) - candidates)) - -(defmacro helm--maybe-process-filter-one-by-one-candidate (candidate source) - "Execute `filter-one-by-one' function(s) on CANDIDATE in SOURCE." - `(helm-aif (assoc-default 'filter-one-by-one ,source) - (if (and (listp it) - (not (functionp it))) ;; Don't treat lambda's as list. - (cl-loop for f in it - do (setq ,candidate (funcall f ,candidate))) - (setq ,candidate (funcall it ,candidate))))) - -(defun helm--initialize-one-by-one-candidates (candidates source) - "Process the CANDIDATES with the `filter-one-by-one' function in SOURCE. -Return CANDIDATES when pattern is empty." - (helm-aif (and (string= helm-pattern "") - (assoc-default 'filter-one-by-one source)) - (cl-loop for cand in candidates - do (helm--maybe-process-filter-one-by-one-candidate cand source) - collect cand) - candidates)) - -(defun helm-process-filtered-candidate-transformer-maybe - (candidates source process-p) - "Execute `filtered-candidate-transformer' function(s) on CANDIDATES in SOURCE. -When PROCESS-P is non-nil execute `filtered-candidate-transformer' -functions if some, otherwise return CANDIDATES." - (if process-p - ;; When no filter return CANDIDATES unmodified. - (helm-process-filtered-candidate-transformer candidates source) - candidates)) - -(defun helm-process-real-to-display (candidates source) - "Execute real-to-display function on all CANDIDATES of SOURCE." - (helm-aif (assoc-default 'real-to-display source) - (setq candidates (helm-funcall-with-source - source 'mapcar - (lambda (cand_) - (if (consp cand_) - ;; override DISPLAY from candidate-transformer - (cons (funcall it (cdr cand_)) (cdr cand_)) - (cons (funcall it cand_) cand_))) - candidates)) - candidates)) - -(defun helm-transform-candidates (candidates source &optional process-p) - "Transform CANDIDATES of SOURCE according to candidate transformers. -When PROCESS-P is non-nil execute the `filtered-candidate-transformer' functions -otherwise only the `candidate-transformer' functions are processed. -When attribute `real-to-display' is present, execute its function on all maybe -filtered CANDIDATES." - (helm-process-real-to-display - (helm-process-filtered-candidate-transformer-maybe - (helm-process-candidate-transformer - (helm--initialize-one-by-one-candidates candidates source) source) - source process-p) - source)) - - -;; Core: narrowing candidates -(defun helm-candidate-number-limit (source) - "Apply candidate-number-limit attribute value. -This overhide variable `helm-candidate-number-limit'. - -e.g: -If \(candidate-number-limit\) is in SOURCE, show all candidates in SOURCE. -If \(candidate-number-limit . 123\) is in SOURCE limit candidate to 123." - (helm-aif (assq 'candidate-number-limit source) - (or (cdr it) 99999999) - (or helm-candidate-number-limit 99999999))) - -(defun helm-candidate-get-display (candidate) - "Get searched display part from CANDIDATE. -CANDIDATE is a string, a symbol, or \(DISPLAY . REAL\) cons cell." - (cond ((car-safe candidate)) - ((symbolp candidate) - (symbol-name candidate)) - ((numberp candidate) - (number-to-string candidate)) - (t candidate))) - -(defun helm-process-pattern-transformer (pattern source) - "Execute pattern-transformer attribute PATTERN function in SOURCE." - (helm-aif (assoc-default 'pattern-transformer source) - (helm-composed-funcall-with-source source it pattern) - pattern)) - -(defun helm-default-match-function (candidate) - "Check if `helm-pattern' match CANDIDATE. -Default function to match candidates according to `helm-pattern'." - (string-match helm-pattern candidate)) - - -;;; Fuzzy matching -;; -;; -(defsubst helm--mapconcat-pattern (pattern) - "Transform string PATTERN in regexp for further fuzzy matching. -e.g helm.el$ - => \"[^h]*h[^e]*e[^l]*l[^m]*m[^.]*[.][^e]*e[^l]*l$\" - ^helm.el$ - => \"helm[.]el$\"." - (let ((ls (split-string-and-unquote pattern ""))) - (if (string= "^" (car ls)) - ;; Exact match. - (mapconcat (lambda (c) - (if (and (string= c "$") - (string-match "$\\'" pattern)) - c (regexp-quote c))) - (cdr ls) "") - ;; Fuzzy match. - (mapconcat (lambda (c) - (if (and (string= c "$") - (string-match "$\\'" pattern)) - c (format "[^%s]*%s" c (regexp-quote c)))) - ls "")))) - -(defvar helm--fuzzy-regexp-cache (make-hash-table :test 'eq)) -(defun helm--fuzzy-match-maybe-set-pattern () - ;; Computing helm-pattern with helm--mapconcat-pattern - ;; is costly, so cache it once time for all and reuse it - ;; until pattern change. - (when helm--in-fuzzy - (let ((fun (if (string-match "\\`\\^" helm-pattern) - #'identity - #'helm--mapconcat-pattern))) - (clrhash helm--fuzzy-regexp-cache) - ;; FIXME: Splitted part are not handled here, - ;; I must compute them in `helm-search-match-part' - ;; when negation and in-buffer are used. - (if (string-match "\\`!" helm-pattern) - (puthash 'helm-pattern - (if (> (length helm-pattern) 1) - (list (funcall fun (substring helm-pattern 1 2)) - (funcall fun (substring helm-pattern 1))) - '("" "")) - helm--fuzzy-regexp-cache) - (puthash 'helm-pattern - (if (> (length helm-pattern) 0) - (list (funcall fun (substring helm-pattern 0 1)) - (funcall fun helm-pattern)) - '("" "")) - helm--fuzzy-regexp-cache))))) - -(defun helm-fuzzy-match (candidate) - "Check if `helm-pattern' fuzzy match CANDIDATE. -This function is used with sources build with `helm-source-sync'." - (unless (string-match " " helm-pattern) - ;; When pattern have one or more spaces, let - ;; match-plugin doing the job with no fuzzy matching.[1] - (let ((regexp (cadr (gethash 'helm-pattern helm--fuzzy-regexp-cache)))) - (if (string-match "\\`!" helm-pattern) - (not (string-match regexp candidate)) - (string-match regexp candidate))))) - -(defun helm-fuzzy-search (pattern) - "Same as `helm-fuzzy-match' but for sources build with `helm-source-in-buffer'." - (unless (string-match " " helm-pattern) - ;; Same as in `helm-fuzzy-match' ref[1]. - (let* ((regexps (gethash 'helm-pattern helm--fuzzy-regexp-cache)) - (partial-regexp (car regexps)) - (regexp (cadr regexps))) - (if (string-match "\\`!" pattern) - ;; Don't try to search here, just return - ;; the position of line and go ahead, - ;; letting `helm-search-match-part' checking if - ;; pattern match against this line. - (prog1 (list (point-at-bol) (point-at-eol)) - (forward-line 1)) - ;; We could use here directly `re-search-forward' - ;; on the regexp produced by `helm--mapconcat-pattern', - ;; but it is very slow because emacs have to do an incredible - ;; amount of loops to match e.g "[^f]*o[^o]..." in the whole buffer, - ;; more the regexp is long more the amount of loops grow. - ;; (Probably leading to a max-lisp-eval-depth error if both - ;; regexp and buffer are too big) - ;; So just search the first bit of pattern e.g "[^f]*f", and - ;; then search the corresponding line with the whole regexp, - ;; which increase dramatically the speed of the search. - (cl-loop while (re-search-forward partial-regexp nil t) - for bol = (point-at-bol) - for eol = (point-at-eol) - if (progn (goto-char bol) - (re-search-forward regexp eol t)) - do (goto-char eol) and return t - else do (goto-char eol) - finally return nil))))) - -(defsubst helm--collect-pairs-in-string (string) - (cl-loop for str on (split-string string "" t) by 'cdr - when (cdr str) - collect (list (car str) (cadr str)))) - -(defun helm-score-candidate-for-pattern (candidate pattern) - "Give a score to CANDIDATE according to PATTERN. -Score is calculated against number of contiguous matches found with PATTERN. -If PATTERN is fully matched in CANDIDATE a maximal score (100) is given. -A bonus of one point is given when PATTERN prefix match CANDIDATE. -Contiguous matches have a coefficient of 2." - (let* ((pat-lookup (helm--collect-pairs-in-string pattern)) - (str-lookup (helm--collect-pairs-in-string candidate)) - (bonus (if (equal (car pat-lookup) (car str-lookup)) 1 0)) - (bonus1 (and (string-match (concat "\\<" (regexp-quote pattern) "\\>") - candidate) - 100))) - (+ bonus (or bonus1 - ;; Give a coefficient of 2 for contiguous matches. - ;; That's mean that "wiaaaki" will not take precedence - ;; on "aaawiki" when matching on "wiki" even if "wiaaaki" - ;; starts by "wi". - (* (length (cl-nintersection - pat-lookup str-lookup :test 'equal)) - 2))))) - -(defun helm-fuzzy-matching-default-sort-fn (candidates _source &optional use-real) - "The transformer for sorting candidates in fuzzy matching. -It is sorting on the display part of by default. - -Sort CANDIDATES according to their score calculated by -`helm-score-candidate-for-pattern'. When two candidates have the -same score sort is made by length. Set USE-REAL to non-nil to -sort on the real part." - (if (string= helm-pattern "") - candidates - (let ((table-scr (make-hash-table :test 'equal))) - (sort candidates - (lambda (s1 s2) - ;; Score and measure the length on real or display part of candidate - ;; according to `use-real'. - (let* ((real-or-disp-fn (if use-real #'cdr #'car)) - (cand1 (if (consp s1) - (funcall real-or-disp-fn s1) - s1)) - (cand2 (if (consp s2) - (funcall real-or-disp-fn s2) - s2)) - (data1 (or (gethash cand1 table-scr) - (puthash cand1 (list (helm-score-candidate-for-pattern - cand1 helm-pattern) - (length cand1)) - table-scr))) - (data2 (or (gethash cand2 table-scr) - (puthash cand2 (list (helm-score-candidate-for-pattern - cand2 helm-pattern) - (length cand2)) - table-scr))) - (len1 (cadr data1)) - (len2 (cadr data2)) - (scr1 (car data1)) - (scr2 (car data2))) - (cond ((= scr1 scr2) - (< len1 len2)) - ((> scr1 scr2))))))))) - -(defun helm-fuzzy-default-highlight-match (candidate) - "The default function to highlight matches in fuzzy matching. -It is meant to use with `filter-one-by-one' slot." - (let* ((pair (and (consp candidate) candidate)) - (display (helm-stringify (if pair (car pair) candidate))) - (real (cdr pair))) - (with-temp-buffer - (insert display) - (goto-char (point-min)) - (if (search-forward helm-pattern nil t) - (add-text-properties - (match-beginning 0) (match-end 0) '(face helm-match)) - (cl-loop with pattern = (if (string-match-p " " helm-pattern) - (split-string helm-pattern) - (split-string helm-pattern "" t)) - for p in pattern - do - (when (search-forward p nil t) - (add-text-properties - (match-beginning 0) (match-end 0) '(face helm-match))))) - (setq display (buffer-string))) - (if real (cons display real) display))) - -(defun helm-fuzzy-highlight-matches (candidates _source) - "The filtered-candidate-transformer function to highlight matches in fuzzy. -See helm-fuzzy-default-highlight-match." - (cl-loop for c in candidates - collect (helm-fuzzy-default-highlight-match c))) - -(defun helm-match-functions (source) - (let ((matchfns (or (assoc-default 'match source) - (assoc-default 'match-strict source) - #'helm-default-match-function))) - (if (and (listp matchfns) (not (functionp matchfns))) - matchfns (list matchfns)))) - -(defun helm-search-functions (source) - (let ((searchfns (assoc-default 'search source))) - (if (and (listp searchfns) (not (functionp searchfns))) - searchfns (list searchfns)))) - -(defmacro helm--accumulate-candidates (candidate newmatches - hash item-count limit source) - "Add CAND into NEWMATCHES and use HASH to uniq NEWMATCHES. -Argument ITEM-COUNT count the matches. -if ITEM-COUNT reaches LIMIT, exit from inner loop." - `(unless (gethash ,candidate ,hash) - (unless (assq 'allow-dups ,source) - (puthash ,candidate t ,hash)) - (helm--maybe-process-filter-one-by-one-candidate ,candidate ,source) - (push ,candidate ,newmatches) - (cl-incf ,item-count) - (when (= ,item-count ,limit) (cl-return)))) - -(defun helm-take-first-elements (seq n) - "Return the N first element of SEQ if SEQ is longer than N. -It is used to narrow down list of candidates to `helm-candidate-number-limit'." - (if (> (length seq) n) (cl-subseq seq 0 n) seq)) - -(cl-defun helm-set-case-fold-search (&optional (pattern helm-pattern)) - "Used to set the value of `case-fold-search' in helm. -Return t or nil depending of value of `helm-case-fold-search' -and `helm-pattern'." - (let ((helm-case-fold-search - (helm-aif (assq 'case-fold-search (helm-get-current-source)) - (cdr it) - helm-case-fold-search)) - ;; Only parse basename for filenames - ;; to avoid setting case sensitivity - ;; when expanded directories contains upcase - ;; characters. - (bn-or-pattern (if (string-match "[~/]*" pattern) - ;; `helm-basename' is not available yet. - (file-name-nondirectory - (directory-file-name pattern)) - pattern))) - (helm-set-case-fold-search-1 bn-or-pattern))) - -(defun helm-set-case-fold-search-1 (pattern) - (cl-case helm-case-fold-search - (smart (let ((case-fold-search nil)) - (if (string-match "[[:upper:]]" pattern) nil t))) - (t helm-case-fold-search))) - -(defun helm-match-from-candidates (cands matchfns match-part-fn limit source) - (let (matches) - (condition-case-unless-debug err - (let ((item-count 0) - (case-fold-search (helm-set-case-fold-search))) - (clrhash helm-match-hash) - (cl-dolist (match matchfns) - (let (newmatches) - (cl-dolist (candidate cands) - (unless (gethash candidate helm-match-hash) - (let ((target (helm-candidate-get-display candidate))) - (when (funcall match - (if match-part-fn - (funcall match-part-fn target) target)) - (helm--accumulate-candidates - candidate newmatches - helm-match-hash item-count limit source))))) - ;; filter-one-by-one may return nil candidates, so delq them if some. - (setq matches (nconc matches (nreverse (delq nil newmatches))))))) - (error (unless (eq (car err) 'invalid-regexp) ; Always ignore regexps errors. - (helm-log-error "helm-match-from-candidates in source `%s': %s %s" - (assoc-default 'name source) (car err) (cdr err))) - (setq matches nil))) - matches)) - -(defun helm-compute-matches (source) - "Start computing candidates in SOURCE." - (save-current-buffer - (let ((matchfns (helm-match-functions source)) - (matchpartfn (assoc-default 'match-part source)) - (helm-source-name (assoc-default 'name source)) - (helm-current-source source) - (limit (helm-candidate-number-limit source)) - (helm-pattern (helm-process-pattern-transformer - helm-pattern source))) - (helm--fuzzy-match-maybe-set-pattern) - ;; If source have a `filtered-candidate-transformer' attr - ;; Filter candidates with this func, otherwise just compute - ;; candidates. - (helm-process-filtered-candidate-transformer - (if (or (equal helm-pattern "") - (equal matchfns '(identity))) - ;; Compute all candidates up to LIMIT. - (helm-take-first-elements - (helm-get-cached-candidates source) limit) - ;; Compute candidates according to pattern with their match fns. - (helm-match-from-candidates - (helm-get-cached-candidates source) matchfns matchpartfn limit source)) - source)))) - -(defun helm-render-source (source matches) - "Display MATCHES from SOURCE according to its settings." - (helm-log "Source name = %S" (assoc-default 'name source)) - (when matches - (helm-insert-header-from-source source) - (if (not (assq 'multiline source)) - (cl-loop for m in matches - for count from 1 - do (helm-insert-match m 'insert source count)) - (let ((start (point)) - (count 0) - separate) - (cl-dolist (match matches) - (cl-incf count) - (if separate - (helm-insert-candidate-separator) - (setq separate t)) - (helm-insert-match match 'insert source count)) - (put-text-property start (point) 'helm-multiline t))))) - -(defmacro helm--maybe-use-while-no-input (&rest body) - "Wrap BODY in `helm-while-no-input' unless initializing a remote connection." - `(progn - (if (and (file-remote-p helm-pattern) - (not (file-remote-p helm-pattern nil t))) - ;; Tramp will ask for passwd, don't use `helm-while-no-input'. - ,@body - (helm-log "Using here `helm-while-no-input'") - (helm-while-no-input ,@body)))) - -(defun helm--compute-sources (src-list) - (cl-loop with matches = (helm--maybe-use-while-no-input - (cl-loop for src in src-list - collect (helm-compute-matches src))) - when (eq matches t) do (setq matches nil) - for src in src-list - for mtc in matches - do (helm-render-source src mtc))) - -(cl-defun helm-process-delayed-sources (delayed-sources &optional preselect source) - "Process helm DELAYED-SOURCES. -Move selection to string or regexp PRESELECT if non--nil. -This function is called in `helm-process-delayed-sources-timer' -when emacs is idle for `helm-idle-delay'." - (with-helm-quittable - (helm-log "Delayed sources = %S" - (mapcar (lambda (s) - (assoc-default 'name s)) - delayed-sources)) - (with-current-buffer (helm-buffer-get) - (save-excursion - (goto-char (point-max)) - (helm--compute-sources delayed-sources) - (when (and (not (helm-empty-buffer-p)) - ;; No selection yet. - (= (overlay-start helm-selection-overlay) - (overlay-end helm-selection-overlay))) - (helm-update-move-first-line 'without-hook))) - (save-excursion - (goto-char (point-min)) - (helm-log-run-hook 'helm-update-hook)) - (setq helm-force-updating-p nil) - (unless (assoc 'candidates-process source) - (helm-display-mode-line (helm-get-current-source)) - (helm-log-run-hook 'helm-after-update-hook)) - (when preselect (helm-preselect preselect source))))) - - -;;; Core: helm-update -;; -(defun helm-update (&optional preselect source) - "Update candidates list in `helm-buffer' according to `helm-pattern'. -Argument PRESELECT is a string or regexp used to move selection to a particular -place once updating is done. It should be used on single source because search -is done on whole `helm-buffer' and not on current source." - (helm-log "Start updating") - (helm-kill-async-processes) - ;; When persistent action have been called - ;; we have two windows even with `helm-full-frame'. - ;; So go back to one window when updating if `helm-full-frame' - ;; is non--nil. - (with-helm-window - (when helm-onewindow-p (delete-other-windows))) - (with-current-buffer (helm-buffer-get) - (set (make-local-variable 'helm-input-local) helm-pattern) - (let (normal-sources - delayed-sources) - (unwind-protect - (progn - ;; Iterate over all the sources - (cl-loop for source in (cl-remove-if-not - 'helm-update-source-p (helm-get-sources)) - if (helm-delayed-source-p source) - ;; Delayed sources just get collected for later - ;; processing - collect source into ds - else - ;; Collect the normal sources - collect source into ns - ;; Export the variables from cl-loop - finally (setq delayed-sources ds - normal-sources ns)) - (erase-buffer) - ;; Render all the sources into the helm buffer after - ;; calculating all candidates. - ;; Candidates must be computed AFTER erasing buffer - ;; even if it cause flickering; Doing so avoid - ;; unexpected results when executing actions. - (helm--compute-sources normal-sources)) - (helm-log "Delayed sources = %S" - (mapcar (lambda (s) (assoc-default 'name s)) - delayed-sources)) - (cond ((and preselect delayed-sources normal-sources) - ;; Preselection run here when there is - ;; normal AND delayed sources. - (helm-log "Update preselect candidate %s" preselect) - (helm-preselect preselect source)) - (delayed-sources ; Preselection and hooks will run later. - (helm-update-move-first-line 'without-hook)) - (t ; No delayed sources, run the hooks now. - (helm-update-move-first-line) - (unless (assoc 'candidates-process source) - (helm-display-mode-line (helm-get-current-source)) - (helm-log-run-hook 'helm-after-update-hook)) - (when preselect - (helm-log "Update preselect candidate %s" preselect) - (helm-preselect preselect source)) - (setq helm-force-updating-p nil))) - (when delayed-sources - ;; Allow giving a value to `delayed' attr from inside source. - ;; Retain the biggest value (the slower) found in DELAYED-SOURCES. - (let ((helm-idle-delay (cl-loop with delay = helm-idle-delay - for s in delayed-sources - for d = (assoc-default 'delayed s) - when d do (setq delay (max delay d)) - finally return delay))) - (run-with-idle-timer - ;; Be sure helm-idle-delay is > - ;; to helm-input-idle-delay - ;; otherwise use value of helm-input-idle-delay - ;; or 0.01 if == to 0. - (max helm-idle-delay helm-input-idle-delay 0.001) nil - 'helm-process-delayed-sources delayed-sources preselect source))) - (helm-log "end update"))))) - -;; Update keymap after updating. -;; Putting this in a hook allow users to disable it. -(add-hook 'helm-after-update-hook 'helm--maybe-update-keymap) - -(defun helm-update-source-p (source) - "Whether SOURCE need updating or not." - (let ((len (string-width - (if (or (assoc 'matchplugin source) - (null (assoc 'no-matchplugin source))) - ;; Don't count spaces entered when using - ;; match-plugin. - (replace-regexp-in-string " " "" helm-pattern) - helm-pattern)))) - (and (or (not helm-source-filter) - (member (assoc-default 'name source) helm-source-filter)) - (>= len - (helm-aif (assoc 'requires-pattern source) (or (cdr it) 1) 0)) - ;; These incomplete regexps hang helm forever - ;; so defer update. Maybe replace spaces quoted when using - ;; match-plugin-mode. - (not (member (replace-regexp-in-string "\\s\\ " " " helm-pattern) - helm-update-blacklist-regexps))))) - -(defun helm-delayed-source-p (source) - "Wheter SOURCE is a delayed source or not." - (or (assoc 'delayed source) - (and helm-quick-update - (> (length helm-sources) 1) - (< (window-height (get-buffer-window (current-buffer))) - (line-number-at-pos (point-max)))))) - -(defun helm-update-move-first-line (&optional without-hook) - "Goto first line of `helm-buffer'." - (goto-char (point-min)) - (unless without-hook - (save-excursion (helm-log-run-hook 'helm-update-hook))) - (helm-next-line)) - -(defun helm-force-update (&optional preselect) - "Force recalculation and update of candidates. -The difference with `helm-update' is this function is reevaling -the `init' and `update' attributes functions when present -before updating candidates according to pattern i.e calling `helm-update'. -Selection is preserved to current candidate or moved to PRESELECT -if specified." - (interactive) - (let ((source (helm-get-current-source)) - (selection (helm-get-selection nil t)) - ;; `helm-goto-source' need to have all sources displayed - ;; So disable `helm-quick-update'. - helm-quick-update) - (setq helm-force-updating-p t) - (when source - (mapc 'helm-force-update--reinit - (helm-get-sources))) - (helm-update (or preselect selection) source) - (with-helm-window (recenter)))) - -(defun helm-force-update--reinit (source) - "Reinit SOURCE by calling his update and/or init functions." - (helm-aif (helm-funcall-with-source - source 'helm-candidate-buffer) - (kill-buffer it)) - (cl-dolist (attr '(update init)) - (helm-aif (assoc-default attr source) - (helm-funcall-with-source source it))) - (helm-remove-candidate-cache source)) - -(defun helm-remove-candidate-cache (source) - "Remove SOURCE from `helm-candidate-cache'." - (remhash (assoc-default 'name source) helm-candidate-cache)) - -(defun helm-insert-match (match insert-function source &optional num) - "Insert MATCH into `helm-buffer' with INSERT-FUNCTION for SOURCE. -If MATCH is a list then insert the string intended to appear on the display -and store the real value in a text property." - (let ((start (point-at-bol (point))) - (dispvalue (helm-candidate-get-display match)) - (realvalue (cdr-safe match))) - (when (and (stringp dispvalue) - (not (zerop (length dispvalue)))) - (funcall insert-function dispvalue) - ;; Some sources with candidates-in-buffer have already added - ;; 'helm-realvalue property when creating candidate buffer. - (unless (get-text-property start 'helm-realvalue) - (and realvalue - (put-text-property start (point-at-eol) - 'helm-realvalue realvalue))) - (when num - (put-text-property start (point-at-eol) 'helm-cand-num num)) - (when helm-source-in-each-line-flag - (put-text-property start (point-at-eol) 'helm-source source)) - (funcall insert-function "\n")))) - -(defun helm-insert-header-from-source (source) - "Insert SOURCE name in `helm-buffer' header. -Maybe insert by overlay additional info after source name if SOURCE have -header-name attribute." - (let ((name (assoc-default 'name source))) - (helm-insert-header - name - (helm-aif (assoc-default 'header-name source) - (helm-funcall-with-source source it name))))) - -(defun helm-insert-header (name &optional display-string) - "Insert header of source NAME into the helm buffer. -If DISPLAY-STRING is non--nil and a string, display this additional info -after the source name by overlay." - (unless (bobp) - (let ((start (point))) - (insert "\n") - (put-text-property start (point) 'helm-header-separator t))) - (let ((start (point))) - (insert name) - (put-text-property (point-at-bol) - (point-at-eol) 'helm-header t) - (when display-string - (overlay-put (make-overlay (point-at-bol) (point-at-eol)) - 'display display-string)) - (insert "\n") - (put-text-property start (point) 'face 'helm-source-header))) - -(defun helm-insert-candidate-separator () - "Insert separator of candidates into the helm buffer." - (insert (propertize helm-candidate-separator 'face 'helm-separator)) - (put-text-property (point-at-bol) - (point-at-eol) 'helm-candidate-separator t) - (insert "\n")) - - -;;; Core: async process -;; -(defun helm-output-filter (process output-string) - "The `process-filter' function for helm async sources." - (with-helm-quittable - (helm-output-filter-1 (assoc process helm-async-processes) output-string))) - -(defun helm-output-filter-1 (process-assoc output-string) - (helm-log "output-string = %S" output-string) - (with-current-buffer helm-buffer - (let ((source (cdr process-assoc))) - (save-excursion - (helm-aif (assoc-default 'insertion-marker source) - (goto-char it) - (goto-char (point-max)) - (helm-insert-header-from-source source) - (setcdr process-assoc - (append source `((insertion-marker . ,(point-marker)))))) - (helm-output-filter--process-source - (car process-assoc) output-string source - (helm-candidate-number-limit source)))) - (helm-output-filter--post-process))) - -(defun helm-output-filter--process-source (process output-string source limit) - (cl-dolist (candidate (helm-transform-candidates - (helm-output-filter--collect-candidates - (split-string output-string "\n") - (assoc 'incomplete-line source) - source) - source t)) - (when candidate ; filter-one-by-one may return nil candidates. - (if (assq 'multiline source) - (let ((start (point))) - (helm-insert-candidate-separator) - (helm-insert-match candidate 'insert-before-markers source - (1+ (cdr (assoc 'item-count source)))) - (put-text-property start (point) 'helm-multiline t)) - (helm-insert-match candidate 'insert-before-markers source - (1+ (cdr (assoc 'item-count source))))) - (cl-incf (cdr (assoc 'item-count source))) - (when (>= (assoc-default 'item-count source) limit) - (helm-kill-async-process process) - (cl-return))))) - -(defun helm-output-filter--collect-candidates (lines incomplete-line-info source) - "Collect LINES maybe completing the truncated first and last lines." - ;; The output of process may come in chunks of any size, - ;; so the last line of LINES come truncated, this truncated line is - ;; stored in INCOMPLETE-LINE-INFO and will be concated with the first - ;; incomplete line of next chunk arriving. - ;; INCOMPLETE-LINE-INFO is an attribute of source which is created - ;; with an empty string when the source is computed => (incomplete-line . "") - (helm-log "incomplete-line-info = %S" (cdr incomplete-line-info)) - (butlast - (cl-loop for line in lines - ;; On start `incomplete-line-info' value is empty string. - for newline = (helm-aif (cdr incomplete-line-info) - (prog1 - (concat it line) - (setcdr incomplete-line-info nil)) - line) - do (helm--maybe-process-filter-one-by-one-candidate newline source) - collect newline - ;; Store last incomplete line (last chunk truncated) - ;; until new output arrives. - finally do (setcdr incomplete-line-info line)))) - -(defun helm-output-filter--post-process () - (let ((src (helm-get-current-source))) - (helm-log-run-hook 'helm-update-hook) - (helm-aif (get-buffer-window helm-buffer 'visible) - (with-selected-window it - (helm-skip-noncandidate-line 'next) - (helm-mark-current-line) - (helm-display-mode-line src) - (helm-log-run-hook 'helm-after-update-hook))))) - -(defun helm-process-deferred-sentinel-hook (process event file) - "Defer remote processes in sentinels. -Meant to be called at beginning of a sentinel process function." - (when (and (string= event "finished\n") - (or (file-remote-p file) - ;; `helm-suspend-update-flag' - ;; is non--nil here only during a - ;; running process, this will never be called - ;; when user set it explicitely with `C-!'. - helm-suspend-update-flag)) - (setq helm-suspend-update-flag t) - ;; Kill the process but don't delete entry in - ;; `helm-async-processes'. - (helm-kill-async-process process) - ;; When tramp tries to open the same connection twice in a - ;; short time frame (less than 5s) it throw 'suppress which - ;; call the real-handler on the main "Emacs", so we wait - ;; 5s before updating to avoid this [1], but allowing user to - ;; enter input during this delay. - ;; [1] On last Emacs versions, this is fixed and tramp return - ;; nil in this situation. - ;; Note: It is difficult to have a value < to 5 for - ;; `tramp-connection-min-time-diff', because the process die - ;; when calling too quickly same process. - (run-at-time (or (and (boundp 'tramp-connection-min-time-diff) - tramp-connection-min-time-diff) - 5) - nil #'(lambda () - (when helm-alive-p ; Don't run timer fn after quit. - (setq helm-suspend-update-flag nil) - (helm-check-minibuffer-input)))))) - -(defun helm-kill-async-processes () - "Kill all asynchronous processes registered in `helm-async-processes'." - (while helm-async-processes - (helm-kill-async-process (caar helm-async-processes)) - (setq helm-async-processes (cdr helm-async-processes)))) - -(defun helm-kill-async-process (process) - "Stop output from `helm-output-filter' and kill associated PROCESS." - (set-process-filter process nil) - (delete-process process)) - - -;;; Core: action -;; -(defun helm-execute-selection-action () - "Execute current action and kill the action buffer if present." - (helm-log-run-hook 'helm-before-action-hook) - ;; Position can be different when `helm-current-buffer' - ;; is splitted, so jump to this position before executing action. - (helm-current-position 'restore) - (unwind-protect - (helm-execute-selection-action-1) - (helm-aif (get-buffer helm-action-buffer) - (kill-buffer it)) - (helm-log-run-hook 'helm-after-action-hook))) - -(defun helm-execute-selection-action-1 (&optional - selection action - preserve-saved-action) - "Execute ACTION on current SELECTION. -If PRESERVE-SAVED-ACTION is non--nil save action." - (helm-log "executing action") - (setq action (helm-get-default-action - (or action - helm-saved-action - (if (get-buffer helm-action-buffer) - (helm-get-selection helm-action-buffer) - (helm-get-actions-from-current-source))))) - (let ((source (or helm-saved-current-source - (helm-get-current-source))) - non-essential) - (setq selection (or selection - (helm-get-selection) - (and (assoc 'accept-empty source) ""))) - (unless preserve-saved-action (setq helm-saved-action nil)) - (when (and selection action) - (helm-funcall-with-source - source action - (helm-coerce-selection selection source))))) - -(defun helm-coerce-selection (selection source) - "Apply coerce attribute function to SELECTION in SOURCE. -Coerce source with coerce function." - (helm-aif (assoc-default 'coerce source) - (helm-funcall-with-source source it selection) - selection)) - -(defun helm-get-default-action (action) - "Get the first ACTION value of action list in source." - (if (and (listp action) (not (functionp action))) - (cdar action) - action)) - -(defun helm-select-action () - "Select an action for the currently selected candidate. -If action buffer is selected, back to the helm buffer." - (interactive) - (helm-log-run-hook 'helm-select-action-hook) - (setq helm-saved-selection (helm-get-selection)) - (with-selected-frame (with-helm-window (selected-frame)) - (prog1 - (cond ((get-buffer-window helm-action-buffer 'visible) - (set-window-buffer (get-buffer-window helm-action-buffer) - helm-buffer) - (kill-buffer helm-action-buffer) - (helm-display-mode-line (helm-get-current-source)) - (helm-set-pattern helm-input 'noupdate)) - (helm-saved-selection - (setq helm-saved-current-source (helm-get-current-source)) - (let ((actions (helm-get-actions-from-current-source))) - (if (functionp actions) - (message "Sole action: %s" actions) - (helm-show-action-buffer actions) - ;; Be sure the minibuffer is entirely deleted (#907). - (helm--delete-minibuffer-contents-from "") - ;; Make `helm-pattern' differs from the previous value. - (setq helm-pattern 'dummy) - (helm-check-minibuffer-input)))) - (t (message "No Actions available"))) - (run-hooks 'helm-window-configuration-hook)))) - -(defun helm-show-action-buffer (actions) - (with-current-buffer (get-buffer-create helm-action-buffer) - (erase-buffer) - (buffer-disable-undo) - (set-window-buffer (get-buffer-window helm-buffer) helm-action-buffer) - (set (make-local-variable 'helm-sources) - `(((name . "Actions") - (volatile) - (nomark) - (candidates . ,actions) - (mode-line . ("Action(s)" "TAB:BackToCands RET/f1/f2/fn:NthAct")) - (candidate-transformer - . (lambda (candidates) - (cl-loop for (i . j) in candidates - for count from 1 - collect - (cons (concat (cond ((> count 12) - " ") - ((< count 10) - (format "[f%s] " count)) - (t (format "[f%s] " count))) - (propertize i 'face 'helm-action)) - j)))) - (candidate-number-limit)))) - (set (make-local-variable 'helm-source-filter) nil) - (set (make-local-variable 'helm-selection-overlay) nil) - (helm-initialize-overlays helm-action-buffer))) - - -;; Core: selection - -(defun helm-display-source-at-screen-top-maybe (unit) - "Display source at top of screen when UNIT value is 'source. -With any other value of UNIT return nil." - (when (and helm-display-source-at-screen-top (eq unit 'source)) - (set-window-start (selected-window) - (save-excursion (forward-line -1) (point))))) - -(defun helm-skip-noncandidate-line (direction) - "Skip source header or candidates separator when going in DIRECTION. -Possible value of DIRECTION are 'next or 'previous. -Same as `helm-skip-header-and-separator-line' but ensure -point is moved to the right place when at bop or eob." - (helm-skip-header-and-separator-line direction) - (and (bobp) (forward-line 1)) ; Skip first header. - (and (eobp) (forward-line -1))) ; Avoid last empty line. - -(defun helm-skip-header-and-separator-line (direction) - "Skip source header or candidate separator when going to next/previous line. -Possible value of DIRECTION are 'next or 'previous." - (let ((fn (cl-ecase direction - (next 'eobp) - (previous 'bobp)))) - (while (and (not (funcall fn)) - (or (helm-pos-header-line-p) - (helm-pos-candidate-separator-p))) - (forward-line (if (and (eq direction 'previous) - (not (eq (point-at-bol) (point-min)))) - -1 1))))) - -(defun helm-display-mode-line (source &optional force) - "Setup mode-line and header-line for `helm-buffer'." - (set (make-local-variable 'helm-mode-line-string) - (helm-interpret-value (or (and (listp source) ; Check if source is empty. - (assoc-default 'mode-line source)) - (default-value 'helm-mode-line-string)) - source)) - (let ((follow (and (eq (cdr (assq 'follow source)) 1) "(HF) "))) - ;; Setup mode-line. - (if helm-mode-line-string - (setq mode-line-format - `(" " mode-line-buffer-identification " " - (:eval (format "L%d" (helm-candidate-number-at-point))) - " " ,follow - (:eval (when ,helm--mode-line-display-prefarg - (let ((arg (prefix-numeric-value - (or prefix-arg current-prefix-arg)))) - (unless (= arg 1) - (propertize (format "[prefarg:%s] " arg) - 'face 'helm-prefarg))))) - (:eval (helm-show-candidate-number - (car-safe helm-mode-line-string))) - " " helm--mode-line-string-real " " mode-line-end-spaces) - helm--mode-line-string-real - (substitute-command-keys (if (listp helm-mode-line-string) - (cadr helm-mode-line-string) - helm-mode-line-string))) - (setq mode-line-format (default-value 'mode-line-format))) - ;; Setup header-line. - (when helm-display-header-line - (let* ((hlstr (helm-interpret-value - (and (listp source) - (assoc-default 'header-line source)) - source)) - (hlend (make-string (max 0 (- (window-width) (length hlstr))) ? ))) - (setq header-line-format - (propertize (concat " " hlstr hlend) 'face 'helm-header))))) - (when force (force-mode-line-update))) - -(defun helm-show-candidate-number (&optional name) - "Used to display candidate number in mode-line. -You can specify NAME of candidates e.g \"Buffers\" otherwise -it is \"Candidate\(s\)\" by default." - (when helm-alive-p - (unless (helm-empty-source-p) - (propertize - (format "[%s %s]" - (helm-get-candidate-number 'in-current-source) - (or name "Candidate(s)")) - 'face 'helm-candidate-number)))) - -(cl-defun helm-move-selection-common (&key where direction) - "Move the selection marker to a new position. -Position is determined by WHERE and DIRECTION. -Key arg WHERE can be one of: - - line - - page - - edge - - source -Key arg DIRECTION can be one of: - - previous - - next - - A source or a source name when used with :WHERE 'source." - (let ((move-func (cl-case where - (line (cl-ecase direction - (previous 'helm-move--previous-line-fn) - (next 'helm-move--next-line-fn))) - (page (cl-ecase direction - (previous 'helm-move--previous-page-fn) - (next 'helm-move--next-page-fn))) - (edge (cl-ecase direction - (previous 'helm-move--beginning-of-buffer-fn) - (next 'helm-move--end-of-buffer-fn))) - (source (cl-case direction - (previous 'helm-move--previous-source-fn) - (next 'helm-move--next-source-fn) - (t (lambda () ; A source is passed as DIRECTION arg. - (helm-move--goto-source-fn direction)))))))) - (unless (or (helm-empty-buffer-p (helm-buffer-get)) - (not (helm-window))) - (with-helm-window - (helm-log-run-hook 'helm-move-selection-before-hook) - (funcall move-func) - (and (memq direction '(next previous)) - (helm-skip-noncandidate-line direction)) - (when (helm-pos-multiline-p) - (helm-move--beginning-of-multiline-candidate)) - (helm-display-source-at-screen-top-maybe where) - (when (helm-get-previous-header-pos) - (helm-mark-current-line)) - (helm-display-mode-line (helm-get-current-source)) - (helm-log-run-hook 'helm-move-selection-after-hook))))) - -(defun helm-move--beginning-of-multiline-candidate () - (let ((header-pos (helm-get-previous-header-pos)) - (separator-pos (helm-get-previous-candidate-separator-pos))) - (when header-pos - (goto-char (if (or (null separator-pos) - (< separator-pos header-pos)) - header-pos - separator-pos)) - (forward-line 1)))) - -(defun helm-move--previous-multi-line-fn () - (forward-line -1) - (unless (helm-pos-header-line-p) - (helm-skip-header-and-separator-line 'previous) - (helm-move--beginning-of-multiline-candidate))) - -(defun helm-move--previous-line-fn () - (if (not (helm-pos-multiline-p)) - (forward-line -1) - (helm-move--previous-multi-line-fn)) - (when (and helm-move-to-line-cycle-in-source - (helm-pos-header-line-p)) - (forward-line 1) - (helm-move--end-of-source) - ;; We are at end of helm-buffer - ;; check if last candidate is a multiline candidate - ;; and jump to it - (when (and (eobp) - (save-excursion (forward-line -1) (helm-pos-multiline-p))) - (helm-move--previous-multi-line-fn)))) - -(defun helm-move--next-multi-line-fn () - (let ((header-pos (helm-get-next-header-pos)) - (separator-pos (helm-get-next-candidate-separator-pos))) - (cond ((and separator-pos - (or (null header-pos) (< separator-pos header-pos))) - (goto-char separator-pos)) - (header-pos - (goto-char header-pos))))) - -(defun helm-move--next-line-fn () - (if (not (helm-pos-multiline-p)) - (forward-line 1) - (helm-move--next-multi-line-fn)) - (when (and helm-move-to-line-cycle-in-source - (or (save-excursion (and (helm-pos-multiline-p) - (goto-char (overlay-end - helm-selection-overlay)) - (helm-end-of-source-p t))) - (helm-end-of-source-p t))) - (helm-move--beginning-of-source))) - -(defun helm-move--previous-page-fn () - (condition-case nil - (scroll-down) - (beginning-of-buffer (goto-char (point-min))))) - -(defun helm-move--next-page-fn () - (condition-case nil - (scroll-up) - (end-of-buffer (goto-char (point-max))))) - -(defun helm-move--beginning-of-buffer-fn () - (goto-char (point-min))) - -(defun helm-move--end-of-buffer-fn () - (goto-char (point-max))) - -(defun helm-move--end-of-source () - (goto-char (or (helm-get-next-header-pos) (point-max))) - (when (helm-pos-header-line-p) (forward-line -2))) - -(defun helm-move--beginning-of-source () - (goto-char (helm-get-previous-header-pos)) - (forward-line 1)) - -(defun helm-move--previous-source-fn () - (forward-line -1) - (if (bobp) - (goto-char (point-max)) - (helm-skip-header-and-separator-line 'previous)) - (goto-char (helm-get-previous-header-pos)) - (forward-line 1)) - -(defun helm-move--next-source-fn () - (goto-char (or (helm-get-next-header-pos) (point-min)))) - -(defun helm-move--goto-source-fn (source-or-name) - (goto-char (point-min)) - (let ((name (if (stringp source-or-name) source-or-name - (assoc-default 'name source-or-name)))) - (condition-case err - (while (not (string= name (helm-current-line-contents))) - (goto-char (helm-get-next-header-pos))) - (error (helm-log "%S" err))))) - -(defun helm-candidate-number-at-point () - (with-helm-buffer - (or (get-text-property (point) 'helm-cand-num) 1))) - -(defun helm--next-or-previous-line (direction &optional arg) - ;; Be sure to not use this in non--interactives calls. - (let ((helm-move-to-line-cycle-in-source - (and helm-move-to-line-cycle-in-source arg))) - (if (and arg (> arg 1)) - (cl-loop with pos = (helm-candidate-number-at-point) - with cand-num = (helm-get-candidate-number t) - with iter = (min arg (- cand-num pos)) - for count from 1 - while (<= count iter) - do - (helm-move-selection-common :where 'line :direction direction)) - (helm-move-selection-common :where 'line :direction direction)))) - -(defun helm-previous-line (&optional arg) - "Move selection to the ARG previous line(s). -Same behavior than `helm-next-line' when called with a numeric prefix arg." - (interactive "p") - (helm--next-or-previous-line 'previous arg)) - -(defun helm-next-line (&optional arg) - "Move selection to the next ARG line(s). -When a numeric prefix arg is given and this numeric arg -is > to the number of candidates, move to last candidate of -current source (i.e don't move to next source if some)." - (interactive "p") - (helm--next-or-previous-line 'next arg)) - -(defun helm-previous-page () - "Move selection back with a pageful." - (interactive) - (helm-move-selection-common :where 'page :direction 'previous)) - -(defun helm-next-page () - "Move selection forward with a pageful." - (interactive) - (helm-move-selection-common :where 'page :direction 'next)) - -(defun helm-beginning-of-buffer () - "Move selection at the top." - (interactive) - (helm-move-selection-common :where 'edge :direction 'previous)) - -(defun helm-end-of-buffer () - "Move selection at the bottom." - (interactive) - (helm-move-selection-common :where 'edge :direction 'next)) - -(defun helm-previous-source () - "Move selection to the previous source." - (interactive) - (helm-move-selection-common :where 'source :direction 'previous)) - -(defun helm-next-source () - "Move selection to the next source." - (interactive) - (helm-move-selection-common :where 'source :direction 'next)) - -(defun helm-goto-source (source-or-name) - "Move the selection to the source SOURCE-OR-NAME." - (helm-move-selection-common :where 'source :direction source-or-name)) - -(defun helm--follow-action (arg) - (let ((helm--temp-follow-flag t)) - (when (or (eq last-command 'helm-follow-action-forward) - (eq last-command 'helm-follow-action-backward) - (eq last-command 'helm-execute-persistent-action)) - (if (> arg 0) - (helm-next-line) - (helm-previous-line))) - (helm-execute-persistent-action))) - -(defun helm-follow-action-forward () - "Go to next line and execute persistent action." - (interactive) - (helm--follow-action 1)) - -(defun helm-follow-action-backward () - "Go to previous line and execute persistent action." - (interactive) - (helm--follow-action -1)) - -(defun helm-mark-current-line (&optional resumep) - "Move `helm-selection-overlay' to current line. -Note that this is not related with visibles marks, which are used -to mark candidates." - (with-helm-window - (when resumep - (goto-char helm-selection-point)) - (move-overlay - helm-selection-overlay (point-at-bol) - (if (helm-pos-multiline-p) - (let ((header-pos (helm-get-next-header-pos)) - (separator-pos (helm-get-next-candidate-separator-pos))) - (or (and (null header-pos) separator-pos) - (and header-pos separator-pos - (< separator-pos header-pos) - separator-pos) - header-pos - (point-max))) - (1+ (point-at-eol)))) - (setq helm-selection-point (overlay-start helm-selection-overlay))) - (helm-follow-execute-persistent-action-maybe)) - -(defun helm-confirm-and-exit-minibuffer () - "Maybe ask for confirmation when exiting helm. -It is similar to `minibuffer-complete-and-exit' adapted to helm. -If `minibuffer-completion-confirm' value is 'confirm, -send in minibuffer confirm message and exit on next hit. -If `minibuffer-completion-confirm' value is t, -don't exit and send message 'no match'." - (interactive) - (if (and (helm--updating-p) - (null helm--reading-passwd-or-string)) - (progn (message "[Display not ready]") - (sit-for 0.5) (message nil)) - (let* ((empty-buffer-p (with-current-buffer helm-buffer - (eq (point-min) (point-max)))) - (sel (helm-get-selection)) - (unknown (and (not empty-buffer-p) - (string= (get-text-property - 0 'display - (helm-get-selection nil 'withprop)) - "[?]")))) - (cond ((and (or empty-buffer-p unknown) - (eq minibuffer-completion-confirm 'confirm)) - (setq helm-minibuffer-confirm-state - 'confirm) - (setq minibuffer-completion-confirm nil) - (minibuffer-message " [confirm]")) - ((and (or empty-buffer-p - (unless (if minibuffer-completing-file-name - (and minibuffer-completion-predicate - (funcall minibuffer-completion-predicate sel)) - (and (stringp sel) - ;; SEL may be a cons cell when helm-comp-read - ;; is called directly with a collection composed - ;; of (display . real) and real is a cons cell. - (try-completion sel minibuffer-completion-table - minibuffer-completion-predicate))) - unknown)) - (eq minibuffer-completion-confirm t)) - (minibuffer-message " [No match]")) - (t - (setq helm-minibuffer-confirm-state nil) - (helm-exit-minibuffer)))))) -(add-hook 'helm-after-update-hook 'helm-confirm-and-exit-hook) - -(defun helm-confirm-and-exit-hook () - "Restore `minibuffer-completion-confirm' when helm update." - (unless (or (eq minibuffer-completion-confirm t) - (not helm-minibuffer-confirm-state)) - (setq minibuffer-completion-confirm - helm-minibuffer-confirm-state))) - -(defun helm-read-string (prompt &optional initial-input history - default-value inherit-input-method) - "Same as `read-string' but for reading string from a helm session." - (let ((helm--reading-passwd-or-string t)) - (read-string - prompt initial-input history default-value inherit-input-method))) - -(defun helm--updating-p () - ;; helm timer is between two cycles. - ;; IOW `helm-check-minibuffer-input' haven't yet compared input - ;; and `helm-pattern'. - (or (not (equal (minibuffer-contents) helm-pattern)) - ;; `helm-check-minibuffer-input' have launched `helm-update'. - helm--in-update)) - -(defun helm-maybe-exit-minibuffer () - (interactive) - (if (and (helm--updating-p) - (null helm--reading-passwd-or-string)) - (progn (message "[Display not ready]") - (sit-for 0.5) (message nil)) - (helm-exit-minibuffer))) - -(defun helm-exit-minibuffer () - "Select the current candidate by exiting the minibuffer." - (unless helm-current-prefix-arg - (setq helm-current-prefix-arg current-prefix-arg)) - (setq helm-exit-status 0) - (helm-log-run-hook 'helm-exit-minibuffer-hook) - (exit-minibuffer)) - -(defun helm-keyboard-quit () - "Quit minibuffer in helm. -If action buffer is displayed, kill it." - (interactive) - (when (get-buffer-window helm-action-buffer 'visible) - (kill-buffer helm-action-buffer)) - (setq helm-exit-status 1) - (abort-recursive-edit)) - -(defun helm-get-next-header-pos () - "Return the position of the next header from point." - (next-single-property-change (point) 'helm-header)) - -(defun helm-get-previous-header-pos () - "Return the position of the previous header from point." - (previous-single-property-change (point) 'helm-header)) - -(defun helm-pos-multiline-p () - "Return non-nil if the current position is in the multiline source region." - (get-text-property (point) 'helm-multiline)) - -(defun helm-get-next-candidate-separator-pos () - "Return the position of the next candidate separator from point." - (let ((hp (helm-get-next-header-pos))) - (helm-aif (next-single-property-change (point) 'helm-candidate-separator) - (or - ;; Be sure we don't catch - ;; the separator of next source. - (and hp (< it hp) it) - ;; The separator found is in next source - ;; we are at last cand, so use the header pos. - (and hp (< hp it) hp) - ;; A single source, just try next separator. - it)))) - -(defun helm-get-previous-candidate-separator-pos () - "Return the position of the previous candidate separator from point." - (previous-single-property-change (point) 'helm-candidate-separator)) - -(defun helm-pos-header-line-p () - "Return t if the current line is a header line." - (or (get-text-property (point-at-bol) 'helm-header) - (get-text-property (point-at-bol) 'helm-header-separator))) - -(defun helm-pos-candidate-separator-p () - "Return t if the current line is a candidate separator." - (get-text-property (point-at-bol) 'helm-candidate-separator)) - - -;;; Debugging -;; -;; -(defun helm-debug-output () - "Show all helm-related variables at this time." - (interactive) - (helm-help-internal " *Helm Debug*" 'helm-debug-output-function)) - -(defun helm-debug-output-function (&optional vars) - (message "Calculating all helm-related values...") - (insert "If you debug some variables or forms, set `helm-debug-variables' -to a list of forms.\n\n") - (cl-dolist (v (or vars - helm-debug-variables - (apropos-internal "^helm-" 'boundp))) - (insert "** " - (pp-to-string v) "\n" - (pp-to-string (with-current-buffer helm-buffer (eval v))) "\n")) - (message "Calculating all helm-related values...Done")) - - -;; Core: misc -(defun helm-kill-buffer-hook () - "Remove tick entry from `helm-tick-hash' and remove buffer from -`helm-buffers' when killing a buffer." - (cl-loop for key being the hash-keys in helm-tick-hash - if (string-match (format "^%s/" (regexp-quote (buffer-name))) key) - do (remhash key helm-tick-hash)) - (setq helm-buffers (remove (buffer-name) helm-buffers))) -(add-hook 'kill-buffer-hook 'helm-kill-buffer-hook) - -(defun helm-preselect (candidate-or-regexp &optional source) - "Move `helm-selection-overlay' to CANDIDATE-OR-REGEXP on startup. -Arg CANDIDATE-OR-REGEXP can be a string or a cons cell of two strings. -When it is a cons cell helm will try to jump first to first element of cons cell -and then to second, allowing a finer preselection when possible duplicates are -before the candidate we want to preselect." - (with-helm-window - (when candidate-or-regexp - (if (and helm-force-updating-p source) - (helm-goto-source source) - (goto-char (point-min)) - (forward-line 1)) - (let ((start (point))) - (or - (if (consp candidate-or-regexp) - (and (re-search-forward (car candidate-or-regexp) nil t) - (re-search-forward (cdr candidate-or-regexp) nil t)) - (re-search-forward candidate-or-regexp nil t)) - (goto-char start)))) - (forward-line 0) ; Avoid scrolling right on long lines. - (when (helm-pos-multiline-p) - (helm-move--beginning-of-multiline-candidate)) - (when (helm-pos-header-line-p) (forward-line 1)) - (helm-mark-current-line))) - -(defun helm-delete-current-selection () - "Delete the currently selected item." - (interactive) - (with-helm-window - (cond ((helm-pos-multiline-p) - (helm-aif (helm-get-next-candidate-separator-pos) - (delete-region (point-at-bol) - (1+ (progn (goto-char it) (point-at-eol)))) - ;; last candidate - (goto-char (helm-get-previous-candidate-separator-pos)) - (delete-region (point-at-bol) (point-max))) - (when (helm-end-of-source-p) - (goto-char (or (helm-get-previous-candidate-separator-pos) - (point-min))) - (forward-line 1))) - (t - (delete-region (point-at-bol) (1+ (point-at-eol))) - (when (helm-end-of-source-p t) - (let ((headp (save-excursion - (forward-line -1) - (not (helm-pos-header-line-p))))) - (and headp (forward-line -1)))))) - (unless (helm-end-of-source-p t) - (helm-mark-current-line)))) - -(defun helm-end-of-source-p (&optional at-point) - "Return non--nil if we are at eob or end of source." - (save-excursion - (if (and (helm-pos-multiline-p) (null at-point)) - (null (helm-get-next-candidate-separator-pos)) - (forward-line (if at-point 0 1)) - (or (eq (point-at-bol) (point-at-eol)) - (helm-pos-header-line-p) - (eobp))))) - -(defun helm-edit-current-selection-internal (func) - (with-helm-window - (forward-line 0) - (let ((realvalue (get-text-property (point) 'helm-realvalue)) - (multiline (get-text-property (point) 'helm-multiline))) - (funcall func) - (forward-line 0) - (and realvalue - (put-text-property (point) (point-at-eol) - 'helm-realvalue realvalue)) - (and multiline - (put-text-property (point) (point-at-eol) - 'helm-multiline multiline)) - (helm-mark-current-line)))) - -(defmacro helm-edit-current-selection (&rest forms) - "Evaluate FORMS at current selection in the helm buffer. -Used generally to modify current selection." - (declare (indent 0) (debug t)) - `(helm-edit-current-selection-internal - (lambda () ,@forms))) - -(defun helm-set-pattern (pattern &optional noupdate) - "Set minibuffer contents to PATTERN. -if optional NOUPDATE is non-nil, helm buffer is not changed." - (with-selected-window (or (active-minibuffer-window) (minibuffer-window)) - (delete-minibuffer-contents) - (insert pattern)) - (when noupdate - (setq helm-pattern pattern))) - -(defun helm-minibuffer-completion-contents () - "Return the user input in a minibuffer before point as a string. -That is what completion commands operate on." - (buffer-substring (field-beginning) (point))) - -(defun helm--delete-minibuffer-contents-from (from-str) - ;; Giving an empty string value to FROM-STR delete all. - (require 'helm-utils) - (let ((input (minibuffer-contents))) - (helm-reset-yank-point) - (if (> (length input) 0) - ;; minibuffer is not empty, delete contents from end - ;; of FROM-STR and update. - (helm-set-pattern from-str) - ;; minibuffer is already empty, force update. - (helm-force-update)))) - -(defun helm-delete-minibuffer-contents (&optional arg) - "Delete minibuffer contents. -When `helm-delete-minibuffer-contents-from-point' is non--nil, -delete minibuffer contents from point instead of deleting all. -Giving a prefix arg reverse this behavior. -When at end of minibuffer delete all." - (interactive "P") - (let ((str (if helm-delete-minibuffer-contents-from-point - (if (or arg (eobp)) - "" (helm-minibuffer-completion-contents)) - (if (and arg (not (eobp))) - (helm-minibuffer-completion-contents) "")))) - (helm--delete-minibuffer-contents-from str))) - - -;;; Plugins -;; -;; Built-in plug-in: type -(defun helm-compile-source--type (source) - (helm-aif (assoc-default 'type source) - (append source (assoc-default it helm-type-attributes) nil) - source)) - -;; `define-helm-type-attribute' is public API. - -(defun helm-add-type-attribute (type definition) - (helm-aif (assq type helm-type-attributes) - (setq helm-type-attributes (delete it helm-type-attributes))) - (push (cons type definition) helm-type-attributes)) - -(defun helm-document-type-attribute (type doc) - (add-to-list 'helm-types type t) - (put type 'helm-typeattrdoc - (concat "- " (symbol-name type) "\n\n" doc "\n"))) - -;; Built-in plug-in: dummy -(defun helm-dummy-candidate (_candidate _source) - "Use `helm-pattern' as CANDIDATE in SOURCE." - ;; `source' is defined in filtered-candidate-transformer - (list helm-pattern)) - -(defun helm-compile-source--dummy (source) - (if (assoc 'dummy source) - (progn - (unless (helm-attr-defined - 'filtered-candidate-transformer source) - (helm-attrset 'filtered-candidate-transformer - 'helm-dummy-candidate source)) - (append source - '((candidates "dummy") - (accept-empty) - (match identity) - (volatile)))) - source)) - -;; Built-in plug-in: candidates-in-buffer -(defun helm-candidates-in-buffer (&optional source) - "Get candidates from the candidates buffer according to `helm-pattern'. - -BUFFER is `helm-candidate-buffer' by default. Each -candidate must be placed in one line. This function is meant to -be used in candidates-in-buffer or candidates attribute of an -helm source. Especially fast for many (1000+) candidates. - -eg. - '((name . \"many files\") - (init . (lambda () (with-current-buffer (helm-candidate-buffer 'local) - (insert-many-filenames)))) - (search re-search-forward) ; optional - (candidates-in-buffer) - (type . file)) - -+===============================================================+ -| The new way of making and narrowing candidates: Using buffers | -+===============================================================+ - -By default, `helm' makes candidates by evaluating the -candidates function, then narrows them by `string-match' for each -candidate. - -But this way is very slow for many candidates. The new way is -storing all candidates in a buffer and narrowing them by -`re-search-forward'. Search function is customizable by search -attribute. The important point is that buffer processing is MUCH -FASTER than string list processing and is the Emacs way. - -The init function writes all candidates to a newly-created -candidate buffer. The candidates buffer is created or specified -by `helm-candidate-buffer'. Candidates are stored in a line. - -The candidates function narrows all candidates, IOW creates a -subset of candidates dynamically. It is the task of -`helm-candidates-in-buffer'. As long as -`helm-candidate-buffer' is used,`(candidates-in-buffer)' is -sufficient in most cases. - -Note that `(candidates-in-buffer)' is shortcut of three attributes: - (candidates . helm-candidates-in-buffer) - (volatile) - (match identity) -And `(candidates-in-buffer . func)' is shortcut of three attributes: - (candidates . func) - (volatile) - (match identity) -The expansion is performed in `helm-get-sources'. - -The candidates-in-buffer attribute implies the volatile attribute. -The volatile attribute is needed because `helm-candidates-in-buffer' -creates candidates dynamically and need to be called everytime -`helm-pattern' changes. - -Because `helm-candidates-in-buffer' plays the role of `match' attribute -function, specifying `(match identity)' makes the source slightly faster. - -However if source contain match-part attribute, match is computed only -on part of candidate returned by the call of function provided by this attribute. -The function should have one arg, candidate, and return only -a specific part of candidate. - -To customize `helm-candidates-in-buffer' behavior, use `search', -`get-line' and `match-part' attributes." - (let ((src (or source (helm-get-current-source)))) - (helm-candidates-in-buffer-1 - (helm-candidate-buffer) - helm-pattern - (or (assoc-default 'get-line src) - #'buffer-substring-no-properties) - (or (assoc-default 'search src) - '(helm-candidates-in-buffer-search-default-fn)) - (helm-candidate-number-limit src) - (helm-attr 'match-part) - src))) - -(defun helm-candidates-in-buffer-search-default-fn (pattern) - "Search PATTERN with `re-search-forward' with bound and noerror args." - (condition-case _err - (re-search-forward pattern nil t) - (invalid-regexp nil))) - -(defun helm-candidates-in-buffer-1 (buffer pattern get-line-fn - search-fns limit - match-part-fn source) - "Return the list of candidates inserted in BUFFER matching PATTERN." - ;; buffer == nil when candidates buffer does not exist. - (when buffer - (with-current-buffer buffer - (let ((inhibit-point-motion-hooks t) - (start-point (1- (point-min)))) - (goto-char start-point) - (if (string= pattern "") - (helm-initial-candidates-from-candidate-buffer - get-line-fn limit) - (helm-search-from-candidate-buffer - pattern get-line-fn search-fns limit - start-point match-part-fn source)))))) - -(defun helm-search-from-candidate-buffer (pattern get-line-fn search-fns - limit start-point match-part-fn source) - (let (buffer-read-only - matches - newmatches - (case-fold-search (helm-set-case-fold-search))) - (helm--search-from-candidate-buffer-1 - (lambda () - (clrhash helm-cib-hash) - (cl-dolist (searcher search-fns) - (goto-char start-point) - (setq newmatches nil) - (cl-loop with pos-lst - with item-count = 0 - while (and (setq pos-lst (funcall searcher pattern)) - (not (eobp))) - for cand = (apply get-line-fn - (if (and pos-lst (listp pos-lst)) - pos-lst - (list (point-at-bol) (point-at-eol)))) - when (and (not (gethash cand helm-cib-hash)) - (or - ;; Always collect when cand is matched by searcher funcs - ;; and match-part attr is not present. - (and (not match-part-fn) - (not (consp pos-lst))) - ;; If match-part attr is present, or if SEARCHER fn - ;; returns a cons cell, collect PATTERN only if it - ;; match the part of CAND specified by the match-part func. - (helm-search-match-part cand pattern (or match-part-fn #'identity)))) - do (helm--accumulate-candidates - cand newmatches helm-cib-hash item-count limit source)) - (setq matches (append matches (nreverse newmatches)))) - (delq nil matches))))) - -(defun helm-search-match-part (candidate pattern match-part-fn) - "Match PATTERN only on part of CANDIDATE returned by MATCH-PART-FN. -Because `helm-search-match-part' maybe called even if unspecified -in source (negation), MATCH-PART-FN default to `identity' to match whole candidate. -When using fuzzy matching and negation (i.e \"!\"), this function is always called." - (let ((part (funcall match-part-fn candidate)) - (fuzzy-regexp (cadr (gethash 'helm-pattern helm--fuzzy-regexp-cache)))) - (if (string-match " " pattern) - (cl-loop for i in (split-string pattern) always - (if (string-match "\\`!" i) - (not (string-match (substring i 1) part)) - (string-match i part))) - (if (string-match "\\`!" pattern) - (not (string-match (if helm--in-fuzzy - ;; Fuzzy regexp have already been - ;; computed with substring 1. - fuzzy-regexp - (substring 1 pattern)) - part)) - (string-match (if helm--in-fuzzy fuzzy-regexp pattern) - part))))) - -(defun helm-initial-candidates-from-candidate-buffer (get-line-fn limit) - (delq nil (cl-loop for i from 1 to limit - until (eobp) - collect (funcall get-line-fn - (point-at-bol) (point-at-eol)) - do (forward-line 1)))) - -(defun helm--search-from-candidate-buffer-1 (search-fn) - ;; Previously we were adding a newline at bob and at eol - ;; and removing these newlines afterward, it seems it is no more - ;; needed, thus when searching for empty line ("^$") - ;; it was adding the first line as a matched line - ;; which is wrong. - (unwind-protect - (funcall search-fn) - (set-buffer-modified-p nil))) - -(defun helm-candidate-buffer (&optional create-or-buffer) - "Register and return a buffer containing candidates of current source. -`helm-candidate-buffer' searches buffer-local candidates buffer first, -then global candidates buffer. - -Acceptable values of CREATE-OR-BUFFER: - -- nil (omit) - Only return the candidates buffer. -- a buffer - Register a buffer as a candidates buffer. -- 'global - Create a new global candidates buffer, - named \" *helm candidates:SOURCE*\". -- other non-nil value - Create a new local candidates buffer, - named \" *helm candidates:SOURCE*HELM-CURRENT-BUFFER\"." - (let* ((global-bname (format " *helm candidates:%s*" - helm-source-name)) - (local-bname (format " *helm candidates:%s*%s" - helm-source-name - (buffer-name helm-current-buffer))) - (register-func #'(lambda () - (setq helm-candidate-buffer-alist - (cons (cons helm-source-name create-or-buffer) - (delete (assoc helm-source-name - helm-candidate-buffer-alist) - helm-candidate-buffer-alist))))) - (kill-buffers-func #'(lambda () - (cl-loop for b in (buffer-list) - if (string-match (format "^%s" (regexp-quote global-bname)) - (buffer-name b)) - do (kill-buffer b)))) - (create-func #'(lambda () - (with-current-buffer - (get-buffer-create (if (eq create-or-buffer 'global) - global-bname - local-bname)) - (buffer-disable-undo) - (erase-buffer) - (font-lock-mode -1)))) - (return-func #'(lambda () - (or (get-buffer local-bname) - (get-buffer global-bname) - (helm-aif (assoc-default helm-source-name - helm-candidate-buffer-alist) - (and (buffer-live-p it) it)))))) - (when create-or-buffer - (funcall register-func) - (unless (bufferp create-or-buffer) - (and (eq create-or-buffer 'global) (funcall kill-buffers-func)) - (funcall create-func))) - (funcall return-func))) - -(defun helm-init-candidates-in-buffer (buffer data) - "Register BUFFER with DATA for a helm candidates-in-buffer session. -Arg BUFFER can be a string, a buffer object (bufferp), or a symbol, -either 'local or 'global which is passed to `helm-candidate-buffer'. -Arg DATA can be either a list or a plain string. -Returns the resulting buffer." - (declare (indent 1)) - (let ((buf (helm-candidate-buffer - (if (or (stringp buffer) - (bufferp buffer)) - (get-buffer-create buffer) - buffer)))) ; a symbol. - (with-current-buffer buf - (erase-buffer) - (if (listp data) - (insert (mapconcat (lambda (i) - (cond ((symbolp i) (symbol-name i)) - ((numberp i) (number-to-string i)) - (t i))) - data "\n")) - (and (stringp data) (insert data)))) - buf)) - -(defun helm-compile-source--candidates-in-buffer (source) - (helm-aif (assoc 'candidates-in-buffer source) - (append source - `((candidates . ,(or (cdr it) - (lambda () - (helm-candidates-in-buffer source)))) - (volatile) (match identity))) - source)) - - -;;; Resplit helm window -;; -;; -(defun helm-toggle-resplit-window () - "Toggle resplit helm window, vertically or horizontally." - (interactive) - (when helm-prevent-escaping-from-minibuffer - (helm-prevent-switching-other-window :enabled nil)) - (unwind-protect - (with-helm-window - (if (or helm-full-frame (one-window-p t)) - (message "Error: Attempt to resplit a single window") - (let ((before-height (window-height))) - (delete-window) - (set-window-buffer - (select-window - (if (= (window-height) before-height) ; initial split was horizontal. - ;; Split window vertically with `helm-buffer' placed - ;; on the good side according to actual value of - ;; `helm-split-window-default-side'. - (prog1 - (cond ((or (eq helm-split-window-default-side 'above) - (eq helm-split-window-default-side 'left)) - (split-window - (selected-window) nil 'above)) - (t (split-window-vertically))) - (setq helm-split-window-state 'vertical)) - ;; Split window vertically, same comment as above. - (setq helm-split-window-state 'horizontal) - (cond ((or (eq helm-split-window-default-side 'left) - (eq helm-split-window-default-side 'above)) - (split-window (selected-window) nil 'left)) - (t (split-window-horizontally))))) - helm-buffer))) - (setq helm--window-side-state (helm--get-window-side-state))) - (when helm-prevent-escaping-from-minibuffer - (helm-prevent-switching-other-window :enabled t)))) - -;; Utility: Resize helm window. -(defun helm-enlarge-window-1 (n) - "Enlarge or narrow helm window. -If N is positive enlarge, if negative narrow." - (unless helm-full-frame - (let ((horizontal-p (eq helm-split-window-state 'horizontal))) - (with-helm-window - (enlarge-window n horizontal-p))))) - -(defun helm-narrow-window () - "Narrow helm window." - (interactive) - (helm-enlarge-window-1 -1)) - -(defun helm-enlarge-window () - "Enlarge helm window." - (interactive) - (helm-enlarge-window-1 1)) - -(defun helm-swap-windows () - "Swap window holding `helm-buffer' with other window." - (interactive) - (if (and helm-full-frame (one-window-p t)) - (error "Error: Can't swap windows in a single window") - (let* ((w1 (helm-window)) - (split-state (eq helm-split-window-state 'horizontal)) - (w1size (window-total-size w1 split-state)) - (b1 (window-buffer w1)) ; helm-buffer - (s1 (window-start w1)) - (cur-frame (window-frame w1)) - (w2 (with-selected-window (helm-window) - ;; Don't try to display helm-buffer - ;; in a dedicated window. - (get-window-with-predicate - (lambda (w) (not (window-dedicated-p w))) - 1 cur-frame))) - (w2size (window-total-size w2 split-state)) - (b2 (window-buffer w2)) ; probably helm-current-buffer - (s2 (window-start w2)) - resize) - (with-selected-frame (window-frame w1) - (helm-replace-buffer-in-window w1 b1 b2) - (helm-replace-buffer-in-window w2 b2 b1) - (setq resize - (cond ( ;; helm-window is smaller than other window. - (< w1size w2size) - (- (- (max w2size w1size) - (min w2size w1size)))) - ( ;; helm-window is larger than other window. - (> w1size w2size) - (- (max w2size w1size) - (min w2size w1size))) - ( ;; windows have probably same size. - t nil))) - ;; Maybe resize the window holding helm-buffer. - (and resize (window-resize w2 resize split-state)) - (set-window-start w1 s2 t) - (set-window-start w2 s1 t)) - (setq helm--window-side-state (helm--get-window-side-state))))) - -(defun helm--get-window-side-state () - "Return the position of `helm-window' from `helm-current-buffer'. -Possible values are 'left 'right 'below or 'above." - (let ((side-list '(left right below above))) - (cl-loop for side in side-list - thereis (and (equal (helm-window) - (window-in-direction - side (get-buffer-window helm-current-buffer t) - t)) - side)))) - -(defun helm-replace-buffer-in-window (window buffer1 buffer2) - "Replace BUFFER1 by BUFFER2 in WINDOW registering BUFFER1." - (when (get-buffer-window buffer1) - (unrecord-window-buffer window buffer1) - (set-window-buffer window buffer2))) - -;; Utility: select another action by key -(defun helm-select-nth-action (n) - "Select the N nth action for the currently selected candidate." - (setq helm-saved-selection (helm-get-selection)) - (unless helm-saved-selection - (error "Nothing is selected")) - (setq helm-saved-action - (helm-get-nth-action - n - (if (get-buffer-window helm-action-buffer 'visible) - (assoc-default 'candidates (helm-get-current-source)) - (helm-get-actions-from-current-source)))) - (helm-maybe-exit-minibuffer)) - -(defun helm-get-nth-action (n action) - (cond ((and (zerop n) (functionp action)) - action) - ((listp action) - (or (cdr (elt action n)) - (error "No such action"))) - ((and (functionp action) (< 0 n)) - (error "Sole action")) - (t - (error "Error in `helm-select-nth-action'")))) - -;; Utility: Persistent Action -(defmacro with-helm-display-same-window (&rest body) - "Execute BODY in the window used for persistent action. -Make `pop-to-buffer' and `display-buffer' display in the same window." - (declare (indent 0) (debug t)) - `(let ((display-buffer-function 'helm-persistent-action-display-buffer)) - ,@body)) - -(defun helm-initialize-persistent-action () - (set (make-local-variable 'helm-persistent-action-display-window) nil)) - -(cl-defun helm-execute-persistent-action - (&optional (attr 'persistent-action) split-onewindow) - "Perform the associated action ATTR without quitting helm. -ATTR default is 'persistent-action', but it can be anything else. -In this case you have to add this new attribute to your source. - -When `helm-full-frame' or SPLIT-ONEWINDOW are non--nil, -and `helm-buffer' is displayed in only one window, -the helm window is splitted to display -`helm-select-persistent-action-window' in other window -and keep its visibility." - (interactive) - (helm-log "executing persistent-action") - (let* ((attr-val (assoc-default attr (helm-get-current-source))) - ;; If attr value is a cons, use its car as persistent function - ;; and its car to decide if helm window should be splitted. - (fn (if (and (consp attr-val) - ;; maybe a lambda. - (not (functionp attr-val))) - (car attr-val) attr-val)) - (no-split (and (consp attr-val) - (not (functionp attr-val)) - (cdr attr-val)))) - (with-helm-window - (save-selected-window - (if no-split - (helm-select-persistent-action-window) - (helm-select-persistent-action-window - (or split-onewindow helm-onewindow-p))) - (helm-log "current-buffer = %S" (current-buffer)) - (let ((helm-in-persistent-action t)) - (with-helm-display-same-window - (helm-execute-selection-action-1 - nil (or fn (helm-get-actions-from-current-source)) t) - (helm-log-run-hook 'helm-after-persistent-action-hook)) - ;; A typical case is when a persistent action delete - ;; the buffer already displayed in - ;; `helm-persistent-action-display-window' and `helm-full-frame' - ;; is enabled, we end up with the `helm-buffer' - ;; displayed in two windows. - (when (and helm-onewindow-p - (> (length (window-list)) 1) - (equal (buffer-name - (window-buffer - helm-persistent-action-display-window)) - (helm-buffer-get))) - (delete-other-windows))))))) - -(defun helm-persistent-action-display-window (&optional split-onewindow) - "Return the window that will be used for persistent action. -If SPLIT-ONEWINDOW is non--nil window will be splitted in persistent action." - (with-helm-window - (setq helm-persistent-action-display-window - (cond ((and (window-live-p helm-persistent-action-display-window) - (not (member helm-persistent-action-display-window - (get-buffer-window-list helm-buffer)))) - helm-persistent-action-display-window) - (split-onewindow (split-window)) - ((get-buffer-window helm-current-buffer)) - (t (next-window (selected-window) 1)))))) - -(defun helm-select-persistent-action-window (&optional split-onewindow) - "Select the window that will be used for persistent action. -See `helm-persistent-action-display-window' for how to use SPLIT-ONEWINDOW." - (select-window (get-buffer-window (helm-buffer-get))) - (select-window - (setq minibuffer-scroll-window - (helm-persistent-action-display-window split-onewindow)))) - -(defun helm-persistent-action-display-buffer (buf &optional action) - "Make `pop-to-buffer' and `display-buffer' display in the same window. -If `helm-persistent-action-use-special-display' is non-nil and -BUF is to be displayed by `special-display-function', use it. -Otherwise ignores `special-display-buffer-names' and `special-display-regexps'. -Argument ACTION if present will be used as second argument of `display-buffer'." - (let* ((name (buffer-name buf)) - display-buffer-function pop-up-windows pop-up-frames - ;; Disable `special-display-regexps' and `special-display-buffer-names' - ;; unless `helm-persistent-action-use-special-display' is non--nil. - (special-display-buffer-names - (and helm-persistent-action-use-special-display - special-display-buffer-names)) - (special-display-regexps - (and helm-persistent-action-use-special-display - special-display-regexps)) - (same-window-regexps - (unless (and helm-persistent-action-use-special-display - (or (member name - (mapcar (lambda (x) (or (car-safe x) x)) - special-display-buffer-names)) - (cl-loop for x in special-display-regexps - thereis (string-match (or (car-safe x) x) - name)))) - '(".")))) - ;; Don't loose minibuffer when displaying persistent window in - ;; another frame. - ;; This happen when the displayed persistent buffer-name is one of - ;; `special-display-buffer-names' or match `special-display-regexps' - ;; and `helm-persistent-action-use-special-display' is enabled. - (with-selected-window (if (or special-display-regexps - special-display-buffer-names) - (minibuffer-window) - (selected-window)) - ;; Be sure window of BUF is not dedicated. - (set-window-dedicated-p (get-buffer-window buf) nil) - (display-buffer buf action)))) - -;; scroll-other-window(-down)? for persistent-action -(defun helm-other-window-base (command &optional scroll-amount) - (setq scroll-amount (unless (eq scroll-amount 'noscroll) - helm-scroll-amount)) - (with-selected-window (helm-persistent-action-display-window) - (funcall command scroll-amount))) - -(defun helm-scroll-other-window () - "Scroll other window (not *Helm* window) upward." - (interactive) - (helm-other-window-base 'scroll-up)) - -(defun helm-scroll-other-window-down () - "Scroll other window (not *Helm* window) downward." - (interactive) - (helm-other-window-base 'scroll-down)) - -(defun helm-recenter-top-bottom-other-window () - "`recenter-top-bottom' in other window (not *Helm* window)." - (interactive) - (helm-other-window-base 'recenter-top-bottom 'noscroll)) - -(defun helm-reposition-window-other-window () - "`helm-reposition-window' in other window (not *Helm* window)." - (interactive) - (helm-other-window-base 'reposition-window 'noscroll)) - - - -;; Utility: Visible Mark - -(defun helm-clear-visible-mark () - (with-current-buffer (helm-buffer-get) - (mapc 'delete-overlay helm-visible-mark-overlays) - (set (make-local-variable 'helm-visible-mark-overlays) nil))) - -(defun helm-this-visible-mark () - (cl-loop for o in helm-visible-mark-overlays - when (equal (point-at-bol) (overlay-start o)) - return o)) - -(defun helm-delete-visible-mark (overlay) - (setq helm-marked-candidates - (remove - (cons (helm-get-current-source) (helm-get-selection)) - helm-marked-candidates)) - (delete-overlay overlay) - (setq helm-visible-mark-overlays - (delq overlay helm-visible-mark-overlays))) - -(defun helm-make-visible-mark () - (let ((o (make-overlay (point-at-bol) - (if (helm-pos-multiline-p) - (or (helm-get-next-candidate-separator-pos) - (point-max)) - (1+ (point-at-eol)))))) - (overlay-put o 'priority 0) - (overlay-put o 'face 'helm-visible-mark) - (overlay-put o 'source (assoc-default 'name (helm-get-current-source))) - (overlay-put o 'string (buffer-substring (overlay-start o) (overlay-end o))) - (overlay-put o 'real (helm-get-selection)) - (add-to-list 'helm-visible-mark-overlays o)) - (push (cons (helm-get-current-source) (helm-get-selection)) - helm-marked-candidates)) - -(defun helm-toggle-visible-mark () - "Toggle helm visible mark at point." - (interactive) - (with-helm-window - (let ((nomark (assq 'nomark (helm-get-current-source)))) - (if nomark - (message "Marking not allowed in this source") - (helm-aif (helm-this-visible-mark) - (helm-delete-visible-mark it) - (helm-make-visible-mark)) - (unless (helm-end-of-source-p) - (helm-next-line)))))) - -(defun helm-mark-all () - "Mark all visible unmarked candidates in current source." - (interactive) - (require 'helm-files) - (with-helm-window - (let ((nomark (assq 'nomark (helm-get-current-source))) - (follow (if helm-follow-mode 1 -1))) - (helm-follow-mode -1) - (unwind-protect - (if nomark - (message "Marking not allowed in this source") - (save-excursion - (goto-char (helm-get-previous-header-pos)) - (helm-next-line) - (let* ((next-head (helm-get-next-header-pos)) - (end (and next-head - (save-excursion - (goto-char next-head) - (forward-line -1) - (point)))) - (maxpoint (or end (point-max)))) - (while (< (point) maxpoint) - (helm-mark-current-line) - (let* ((prefix (get-text-property (point-at-bol) 'display)) - (cand (helm-get-selection)) - (bn (and (helm-file-completion-source-p) - (helm-basename cand))) - (src-name (assoc-default 'name - (helm-get-current-source)))) - (when (and (not (helm-this-visible-mark)) - (not (or (string= prefix "[?]") - (string= prefix "[@]")))) - ;; Don't mark possibles directories ending with . or .. - ;; autosave files/links and non--existent file. - (unless - (and (or (helm-file-completion-source-p) - (string= - src-name "Files from Current Directory")) - (or (string-match - "^[.]?#.*#?$\\|[^#]*[.]\\{1,2\\}$" bn) - ;; We need to test here when not using - ;; a transformer that tag prefix - ;; (i.e on tramp). - (not (file-exists-p cand)))) - (helm-make-visible-mark)))) - (if (helm-pos-multiline-p) - (progn - (goto-char - (or (helm-get-next-candidate-separator-pos) - (point-max))) - (forward-line 1)) - (forward-line 1)) - (end-of-line)))) - (helm-mark-current-line) - (message "%s candidates marked" (length helm-marked-candidates))) - (helm-follow-mode follow) (message nil))))) - -(defun helm-unmark-all () - "Unmark all candidates in all sources of current helm session." - (interactive) - (with-helm-window - (let ((len (length helm-marked-candidates))) - (save-excursion - (helm-clear-visible-mark)) - (setq helm-marked-candidates nil) - (helm-mark-current-line) - (message "%s candidates unmarked" len)))) - -(defun helm-toggle-all-marks () - "Toggle all marks. -Mark all visible candidates of current source or unmark all candidates -visible or invisible in all sources of current helm session" - (interactive) - (let ((marked (helm-marked-candidates))) - (if (and (>= (length marked) 1) - (with-helm-window helm-visible-mark-overlays)) - (helm-unmark-all) - (helm-mark-all)))) - -(cl-defun helm-marked-candidates (&key with-wildcard) - "Return marked candidates of current source if any. -Otherwise one element list of current selection. -When key WITH-WILDCARD is specified try to expand a wilcard if some." - (with-current-buffer helm-buffer - (cl-loop with current-src = (helm-get-current-source) - for (source . real) in - (or (reverse helm-marked-candidates) - (list (cons current-src (helm-get-selection)))) - when (equal (assoc 'name current-src) - (assoc 'name source)) - ;; When real is a normal filename without wildcard - ;; file-expand-wildcards returns a list of one file. - ;; When real is a non--existent file it return nil. - append (let* ((elm (helm-coerce-selection real source)) - (c (and with-wildcard - (condition-case nil - (helm-file-expand-wildcards elm t) - (error nil))))) - (or c (list elm))) - into cands - finally do (prog1 (cl-return cands) - (helm-log "Marked candidates = %S" cands))))) - -(defun helm-file-expand-wildcards (pattern &optional full) - "Same as `file-expand-wildcards' but allow recursion. -Recursion happen when PATTERN starts with two stars. -Directories expansion is not supported." - (require 'helm-utils) - (let ((bn (helm-basename pattern))) - (if (and helm-file-globstar - (string-match "\\`\\*\\{2\\}\\(.*\\)" bn)) - (helm-walk-directory (helm-basedir pattern) - :path (cl-case full - (full 'full) - (relative 'relative) - ((basename nil) 'basename) - (t 'full)) - :directories nil - :match (wildcard-to-regexp bn) - :skip-subdirs t) - (file-expand-wildcards pattern full)))) - -(defun helm-current-source-name= (name) - (save-excursion - (goto-char (helm-get-previous-header-pos)) - (equal name (helm-current-line-contents)))) - -(defun helm-revive-visible-mark () - "Restore marked candidates when helm update display." - (with-current-buffer helm-buffer - (cl-dolist (o helm-visible-mark-overlays) - (goto-char (point-min)) - (while (and (search-forward (overlay-get o 'string) nil t) - (helm-current-source-name= (overlay-get o 'source))) - ;; Calculate real value of candidate. - ;; It can be nil if candidate have only a display value. - (let ((real (get-text-property (point-at-bol 0) 'helm-realvalue))) - (if real - ;; Check if real value of current candidate is the same - ;; than the one stored in overlay. - ;; This is needed when some cands have same display names. - ;; Using equal allow testing any type of value for real cand. - ;; Issue (#706). - (and (equal (overlay-get o 'real) real) - (move-overlay o (point-at-bol 0) (1+ (point-at-eol 0)))) - (move-overlay o (point-at-bol 0) (1+ (point-at-eol 0))))))))) -(add-hook 'helm-update-hook 'helm-revive-visible-mark) - -(defun helm-next-point-in-list (curpos points &optional prev) - (cond - ;; rule out special cases. - ((null points) curpos) - ((and prev (<= curpos (car points))) - (nth (1- (length points)) points)) - ((< (car (last points)) curpos) - (if prev (car (last points)) (nth 0 points))) - ((and (not prev) (>= curpos (car (last points)))) - (nth 0 points)) - (t - (nth (if prev - (cl-loop for pt in points - for i from 0 - if (<= curpos pt) return (1- i)) - (cl-loop for pt in points - for i from 0 - if (< curpos pt) return i)) - points)))) - -(defun helm-next-visible-mark (&optional prev) - "Move next helm visible mark. -If PREV is non-nil move to precedent." - (interactive) - (with-helm-window - (ignore-errors - (goto-char (helm-next-point-in-list - (point) - (sort (mapcar 'overlay-start helm-visible-mark-overlays) '<) - prev))) - (helm-mark-current-line))) - -(defun helm-prev-visible-mark () - "Move previous helm visible mark." - (interactive) - (helm-next-visible-mark t)) - -;;; Utility: Selection Paste -;; -(defun helm-yank-selection (arg) - "Set minibuffer contents to current display selection. -With a prefix arg set to real value of current selection." - (interactive "P") - (let ((str (helm-get-selection nil (not arg)))) - (kill-new str) - (helm-set-pattern str))) - -(defun helm-kill-selection-and-quit (arg) - "Store display value of current selection to kill ring. -With a prefix arg set to real value of current selection. -Display value is what you see in `helm-buffer' and real value -is what is used to perform actions." - (interactive "P") - (helm-run-after-quit - (lambda (sel) - (kill-new sel) - (message "Killed: %s" sel)) - (helm-get-selection nil (not arg)))) - -(defun helm-copy-to-buffer () - "Copy selection or marked candidates to `helm-current-buffer'." - (interactive) - (with-helm-buffer - (cl-loop for cand in (helm-marked-candidates) - do (with-helm-current-buffer - (insert cand "\n"))))) - - -;;; Follow-mode: Automatical execution of persistent-action -;; -;; -(defun helm-follow-mode (&optional arg) - "Execute persistent action everytime the cursor is moved when enabled. -The mode is enabled for the current source only, you will have to turn it -on again when you go to next source if you want it there also. -This mode can be enabled or disabled interactively at anytime during -helm session or enabled specifically by source by adding the `follow' -attribute to this source. -Even when the attribute `follow' exists in source, it is still possible -to disable/enable this mode interactively. -Note that when you disable it interactively and `follow' attribute exists, -`helm-follow-mode' will be disabled on next helm session even if `follow' -attribute is specified in source. To avoid this set your `follow' attribute -in source in `helm-before-initialize-hook'. - -e.g: - -\(add-hook 'helm-before-initialize-hook - #'(lambda () (helm-attrset 'follow 1 helm-source-buffers-list))) - -This will enable `helm-follow-mode' automatically in `helm-source-buffers-list'." - (interactive "p") - (with-current-buffer helm-buffer - (let* ((src (helm-get-current-source)) - (name (assoc-default 'name src)) - (sym (cl-loop for s in helm-sources - for sname = (and (symbolp s) - (assoc-default - 'name (symbol-value s))) - thereis (and sname (string= sname name) s))) - (fol-attr (assq 'follow src)) - (enabled (or - ;; If `helm-follow-mode' is called with a negative - ;; ARG, assume follow is already enabled. - ;; i.e turn it off now. - (< arg 0) - (eq (cdr fol-attr) 1) - helm-follow-mode))) - (if src - (progn - (if (eq (cdr fol-attr) 'never) - (message "helm-follow-mode not allowed in this source") - ;; Make follow attr persistent for this emacs session. - (helm-attrset 'follow (if enabled -1 1) src) - (setq helm-follow-mode (not enabled)) - (message "helm-follow-mode is %s" - (if helm-follow-mode - "enabled" "disabled")) - (helm-display-mode-line src)) - (unless helm-follow-mode-persistent - (and sym (set sym (remove (assq 'follow src) src))))) - (message "Not enough candidates for helm-follow-mode"))))) - -(defvar helm-follow-input-idle-delay nil - "`helm-follow-mode' will execute its persistent action after this delay. -Note that if the `follow-delay' attr is present in source, -it will take precedence on this.") -(defun helm-follow-execute-persistent-action-maybe () - "Execute persistent action in mode `helm-follow-mode'. -This happen after `helm-input-idle-delay' secs." - (let ((src (helm-get-current-source))) - (and (not (get-buffer-window helm-action-buffer 'visible)) - (eq (assoc-default 'follow src) 1) - (sit-for (or (assoc-default 'follow-delay src) - helm-follow-input-idle-delay - (and helm-input-idle-delay - (max helm-input-idle-delay 0.01)))) - (helm-window) - (helm-get-selection) - (save-excursion - (helm-execute-persistent-action))))) - - -;;; Auto-resize mode -;; -(defun helm--autoresize-hook (&optional max-height min-height) - (with-helm-window - (fit-window-to-buffer nil - (/ (* (frame-height) - (or max-height helm-autoresize-max-height)) - 100) - (/ (* (frame-height) - (or min-height helm-autoresize-min-height)) - 100)))) - -(define-minor-mode helm-autoresize-mode - "Auto resize helm window when enabled. -Helm window is resized according to values of `helm-autoresize-max-height' -and `helm-autoresize-min-height'. -Note that when this mode is enabled, helm behave like when -`helm-always-two-windows' is enabled. - -See `fit-window-to-buffer' for more infos." - :group 'helm - :global t - (if helm-autoresize-mode - (progn (add-hook 'helm-after-update-hook 'helm--autoresize-hook) - (add-hook 'helm-window-configuration-hook 'helm--autoresize-hook)) - (remove-hook 'helm-after-update-hook 'helm--autoresize-hook) - (remove-hook 'helm-window-configuration-hook 'helm--autoresize-hook))) - - -(provide 'helm) - -;; Local Variables: -;; byte-compile-warnings: (not cl-functions obsolete) -;; coding: utf-8 -;; indent-tabs-mode: nil -;; End: - -;;; helm.el ends here diff --git a/elpa/helm-20150426.2119/emacs-helm.sh b/elpa/helm-20150426.2119/emacs-helm.sh new file mode 100755 index 00000000..d24128da --- /dev/null +++ b/elpa/helm-20150426.2119/emacs-helm.sh @@ -0,0 +1,96 @@ +#!/usr/bin/env bash + + +## Copyright (C) 2012 Thierry Volpiatto +## +## 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 . + +## Commentary: + +# Preconfigured Emacs with a basic helm configuration. +# Useful to start quickly an emacs -Q with helm. +# Run it from this directory. + +TMP="/tmp/helm-cfg.el" +EMACS=emacs + +case $1 in + -P) + shift 1 + declare EMACS=$1 + shift 1 + ;; + -h) + echo "Usage: ${0##*/} [-P} Emacs path [-h} help [--] EMACS ARGS" + exit 2 + ;; +esac + +cd $(dirname "$0") + +# Check if autoload file exists. +# It is maybe in a different directory if +# emacs-helm.sh is a symlink. +LS=$(ls -l $0 | awk '{print $11}') +if [ ! -z $LS ]; then + AUTO_FILE="$(dirname $LS)/helm-autoloads.el" +else + AUTO_FILE="helm-autoloads.el" +fi +if [ ! -e "$AUTO_FILE" ]; then + echo No autoloads found, please run make first to generate autoload file + exit 2 +fi + + +cat > $TMP <\`helm-find-files'\n\ +;; - \`occur'(M-s o) =>\`helm-occur'\n\ +;; - \`list-buffers'(C-x C-b) =>\`helm-buffers-list'\n\ +;; - \`completion-at-point'(M-tab) =>\`helm-lisp-completion-at-point'[1]\n\ +;; - \`dabbrev-expand'(M-/) =>\`helm-dabbrev'\n\n\ +;; Some others native emacs commands are \"helmized\" by \`helm-mode'.\n\ +;; [1] Coming with emacs-24.4 \`completion-at-point' is \"helmized\" by \`helm-mode'\n\ +;; which provide helm completion in many other places like \`shell-mode'.\n\ +;; You will find embeded help for most helm commands with \`C-c ?'.\n\ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n")) + +(setq default-frame-alist '((vertical-scroll-bars . nil) + (tool-bar-lines . 0) + (menu-bar-lines . 0) + (fullscreen . nil))) +(blink-cursor-mode -1) +(add-to-list 'load-path (file-name-directory (file-truename "$0"))) +(require 'helm-config) +(helm-mode 1) +(define-key global-map [remap find-file] 'helm-find-files) +(define-key global-map [remap occur] 'helm-occur) +(define-key global-map [remap list-buffers] 'helm-buffers-list) +(define-key global-map [remap dabbrev-expand] 'helm-dabbrev) +(global-set-key (kbd "M-x") 'helm-M-x) +(unless (boundp 'completion-in-region-function) + (define-key lisp-interaction-mode-map [remap completion-at-point] 'helm-lisp-completion-at-point) + (define-key emacs-lisp-mode-map [remap completion-at-point] 'helm-lisp-completion-at-point)) +(add-hook 'kill-emacs-hook #'(lambda () (and (file-exists-p "$TMP") (delete-file "$TMP")))) +EOF + +$EMACS -Q -l $TMP $@ + diff --git a/elpa/helm-20150426.2119/helm-adaptive.el b/elpa/helm-20150426.2119/helm-adaptive.el new file mode 100644 index 00000000..d7f05326 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-adaptive.el @@ -0,0 +1,243 @@ +;;; helm-adaptive.el --- Adaptive Sorting of Candidates. -*- lexical-binding: t -*- + +;; Original Author: Tamas Patrovics + +;; Copyright (C) 2007 Tamas Patrovics +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) + + +(defgroup helm-adapt nil + "Adaptative sorting of candidates for Helm." + :group 'helm) + +(defcustom helm-adaptive-history-file + "~/.emacs.d/helm-adaptive-history" + "Path of file where history information is stored." + :type 'string + :group 'helm-adapt) + +(defcustom helm-adaptive-history-length 50 + "Maximum number of candidates stored for a source." + :type 'number + :group 'helm-adapt) + + +;; Internal +(defvar helm-adaptive-done nil + "nil if history information is not yet stored for the current +selection.") + +(defvar helm-adaptive-history nil + "Contains the stored history information. +Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)") + +(defun helm-adaptive-done-reset () + (setq helm-adaptive-done nil)) + +(define-minor-mode helm-adaptive-mode + "Toggle adaptive sorting in all sources." + :group 'helm-adapt + :require 'helm-adaptive + :global t + (if helm-adaptive-mode + (progn + (unless helm-adaptive-history + (helm-adaptive-maybe-load-history)) + (add-hook 'kill-emacs-hook 'helm-adaptive-save-history) + ;; Should run at beginning of `helm-initial-setup'. + (add-hook 'helm-before-initialize-hook 'helm-adaptive-done-reset) + ;; Should run at beginning of `helm-exit-minibuffer'. + (add-hook 'helm-before-action-hook 'helm-adaptive-store-selection) + ;; Should run at beginning of `helm-select-action'. + (add-hook 'helm-select-action-hook 'helm-adaptive-store-selection)) + (helm-adaptive-save-history) + (setq helm-adaptive-history nil) + (remove-hook 'kill-emacs-hook 'helm-adaptive-save-history) + (remove-hook 'helm-before-initialize-hook 'helm-adaptive-done-reset) + (remove-hook 'helm-before-action-hook 'helm-adaptive-store-selection) + (remove-hook 'helm-select-action-hook 'helm-adaptive-store-selection))) + +(defun helm-adapt-use-adaptive-p (&optional source-name) + "Return current source only if it use adaptive history, nil otherwise." + (when helm-adaptive-mode + (let* ((source (or source-name (helm-get-current-source))) + (adapt-source (or (assoc-default 'filtered-candidate-transformer + (assoc (assoc-default 'type source) + helm-type-attributes)) + (assoc-default 'candidate-transformer + (assoc (assoc-default 'type source) + helm-type-attributes)) + (assoc-default 'filtered-candidate-transformer source) + (assoc-default 'candidate-transformer source)))) + (if (listp adapt-source) + (and (member 'helm-adaptive-sort adapt-source) source) + (and (eq adapt-source 'helm-adaptive-sort) source))))) + +(defun helm-adaptive-store-selection () + "Store history information for the selected candidate." + (unless helm-adaptive-done + (setq helm-adaptive-done t) + (let ((source (helm-adapt-use-adaptive-p))) + (when source + (let* ((source-name (or (assoc-default 'type source) + (assoc-default 'name source))) + (source-info (or (assoc source-name helm-adaptive-history) + (progn + (push (list source-name) helm-adaptive-history) + (car helm-adaptive-history)))) + (selection (helm-get-selection)) + (selection-info (progn + (setcdr source-info + (cons + (let ((found (assoc selection (cdr source-info)))) + (if (not found) + ;; new entry + (list selection) + ;; move entry to the beginning of the + ;; list, so that it doesn't get + ;; trimmed when the history is + ;; truncated + (setcdr source-info + (delete found (cdr source-info))) + found)) + (cdr source-info))) + (cadr source-info))) + (pattern-info (progn + (setcdr selection-info + (cons + (let ((found (assoc helm-pattern (cdr selection-info)))) + (if (not found) + ;; new entry + (cons helm-pattern 0) + + ;; move entry to the beginning of the + ;; list, so if two patterns used the + ;; same number of times then the one + ;; used last appears first in the list + (setcdr selection-info + (delete found (cdr selection-info))) + found)) + (cdr selection-info))) + (cadr selection-info)))) + + ;; increase usage count + (setcdr pattern-info (1+ (cdr pattern-info))) + + ;; truncate history if needed + (if (> (length (cdr selection-info)) helm-adaptive-history-length) + (setcdr selection-info + (cl-subseq (cdr selection-info) 0 helm-adaptive-history-length)))))))) + +(defun helm-adaptive-maybe-load-history () + "Load `helm-adaptive-history-file' which contain `helm-adaptive-history'. +Returns nil if `helm-adaptive-history-file' doesn't exist." + (when (file-readable-p helm-adaptive-history-file) + (load-file helm-adaptive-history-file))) + +(defun helm-adaptive-save-history (&optional arg) + "Save history information to file given by `helm-adaptive-history-file'." + (interactive "p") + (with-temp-buffer + (insert + ";; -*- mode: emacs-lisp -*-\n" + ";; History entries used for helm adaptive display.\n") + (prin1 `(setq helm-adaptive-history ',helm-adaptive-history) + (current-buffer)) + (insert ?\n) + (write-region (point-min) (point-max) helm-adaptive-history-file nil + (unless arg 'quiet)))) + +(defun helm-adaptive-sort (candidates source) + "Sort the CANDIDATES for SOURCE by usage frequency. +This is a filtered candidate transformer you can use with the +`filtered-candidate-transformer' attribute." + (let* ((source-name (or (assoc-default 'type source) + (assoc-default 'name source))) + (source-info (assoc source-name helm-adaptive-history))) + (if source-info + (let ((usage + ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT) + ;; pairs + (mapcar (lambda (candidate-info) + (let ((count 0)) + (cl-dolist (pattern-info (cdr candidate-info)) + (if (not (equal (car pattern-info) + helm-pattern)) + (cl-incf count (cdr pattern-info)) + + ;; if current pattern is equal to the previously + ;; used one then this candidate has priority + ;; (that's why its count is boosted by 10000) and + ;; it only has to compete with other candidates + ;; which were also selected with the same pattern + (setq count (+ 10000 (cdr pattern-info))) + (cl-return))) + (cons (car candidate-info) count))) + (cdr source-info)))) + (if (and usage (consp usage)) + ;; sort the list in descending order, so candidates with highest + ;; priorty come first + (progn + (setq usage (sort usage (lambda (first second) + (> (cdr first) (cdr second))))) + + ;; put those candidates first which have the highest usage count + (cl-loop for (info . _freq) in usage + for member = (cl-member info candidates + :test 'helm-adaptive-compare) + when member collect (car member) into sorted + and do + (setq candidates (cl-remove info candidates + :test 'helm-adaptive-compare)) + finally return (append sorted candidates))) + (message "Your `%s' is maybe corrupted or too old, \ +you should reinitialize it with `helm-reset-adaptive-history'" + helm-adaptive-history-file) + (sit-for 1) + candidates)) + ;; if there is no information stored for this source then do nothing + candidates))) + +;;;###autoload +(defun helm-reset-adaptive-history () + "Delete all `helm-adaptive-history' and his file. +Useful when you have a old or corrupted `helm-adaptive-history-file'." + (interactive) + (when (y-or-n-p "Really delete all your `helm-adaptive-history'? ") + (setq helm-adaptive-history nil) + (delete-file helm-adaptive-history-file))) + +(defun helm-adaptive-compare (x y) + "Compare candidates X and Y taking into account that the +candidate can be in (DISPLAY . REAL) format." + (equal (if (listp x) (cdr x) x) + (if (listp y) (cdr y) y))) + + +(provide 'helm-adaptive) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-adaptive.el ends here diff --git a/elpa/helm-20150426.2119/helm-aliases.el b/elpa/helm-20150426.2119/helm-aliases.el new file mode 100644 index 00000000..5427920a --- /dev/null +++ b/elpa/helm-20150426.2119/helm-aliases.el @@ -0,0 +1,778 @@ +;;; helm-aliases.el --- Helm aliases for helm obsoletes functions. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) + + +;;; Helper functions to create aliases with old helm definitions +;; prefixed with "helm-c-" +;; +(defun helm-alias-p (sym) + (cond ((boundp sym) + (not (eq (indirect-variable sym) sym))) + ((fboundp sym) + (symbolp (symbol-function sym))) + (t nil))) + +(defun helm-check-conflicting-prefixes () + (cl-loop for s in (all-completions "helm-c-" obarray) + for rep = (replace-regexp-in-string "helm-c-" "helm-" s) + when (or (and (not (helm-alias-p (intern s))) (fboundp (intern rep))) + (and (not (helm-alias-p (intern s))) (boundp (intern rep)))) + collect rep)) + +(defun helm-collect-functions-with-bad-prefix () + (cl-loop for s in (all-completions "helm-c-" obarray) + for sym = (intern s) + when (and (not (helm-alias-p sym)) (fboundp sym)) + collect s)) + +(defun helm-collect-vars-with-bad-prefix () + (cl-loop for s in (all-completions "helm-c-" obarray) + for sym = (intern s) + when (and (not (helm-alias-p sym)) (boundp sym)) + collect s)) + +(defun helm-insert-fn-aliases () + (cl-loop for s in (helm-collect-functions-with-bad-prefix) + for rep = (replace-regexp-in-string "helm-c-" "helm-" s) + do (insert (format "(defalias '%s '%s)\n(make-obsolete '%s '%s \"1.5.1\")\n" s rep s rep)))) + +(defun helm-insert-var-aliases () + (cl-loop for s in (helm-collect-vars-with-bad-prefix) + for rep = (replace-regexp-in-string "helm-c-" "helm-" s) + do (insert (format "(defvaralias '%s '%s)\n(make-obsolete-variable '%s '%s \"1.5.1\")\n" s rep s rep)))) + + +;;; Alias old functions prefixed with "helm-c-" +;; +;; +(defalias 'helm-c-etags-default-action 'helm-etags-default-action) +(make-obsolete 'helm-c-etags-default-action 'helm-etags-default-action "1.5.1") +(defalias 'helm-c-show-info-in-mode-line 'helm-show-info-in-mode-line) +(make-obsolete 'helm-c-show-info-in-mode-line 'helm-show-info-in-mode-line "1.5.1") +(defalias 'helm-c-grep-highlight-match 'helm-grep-highlight-match) +(make-obsolete 'helm-c-grep-highlight-match 'helm-grep-highlight-match "1.5.1") +(defalias 'helm-c-apropos 'helm-apropos) +(make-obsolete 'helm-c-apropos 'helm-apropos "1.5.1") +(defalias 'helm-c-grep-guess-extensions 'helm-grep-guess-extensions) +(make-obsolete 'helm-c-grep-guess-extensions 'helm-grep-guess-extensions "1.5.1") +(defalias 'helm-c-apt-reinstall 'helm-apt-reinstall) +(make-obsolete 'helm-c-apt-reinstall 'helm-apt-reinstall "1.5.1") +(defalias 'helm-c-reset-adaptive-history 'helm-reset-adaptive-history) +(make-obsolete 'helm-c-reset-adaptive-history 'helm-reset-adaptive-history "1.5.1") +(defalias 'helm-adaptative-mode 'helm-adaptive-mode) +(make-obsolete 'helm-adaptative-mode 'helm-adaptive-mode "1.6.2") +(defalias 'helm-c-highlight-bookmark 'helm-highlight-bookmark) +(make-obsolete 'helm-c-highlight-bookmark 'helm-highlight-bookmark "1.5.1") +(defalias 'helm-c-locate-init 'helm-locate-init) +(make-obsolete 'helm-c-locate-init 'helm-locate-init "1.5.1") +(defalias 'helm-c-delete-file 'helm-delete-file) +(make-obsolete 'helm-c-delete-file 'helm-delete-file "1.5.1") +(defalias 'helm-c-regexp-persistent-action 'helm-regexp-persistent-action) +(make-obsolete 'helm-c-regexp-persistent-action 'helm-regexp-persistent-action "1.5.1") +(defalias 'helm-c-grep-split-line 'helm-grep-split-line) +(make-obsolete 'helm-c-grep-split-line 'helm-grep-split-line "1.5.1") +(defalias 'helm-c-info-display-to-real 'helm-info-display-to-real) +(make-obsolete 'helm-c-info-display-to-real 'helm-info-display-to-real "1.5.1") +(defalias 'helm-c-symbolify 'helm-symbolify) +(make-obsolete 'helm-c-symbolify 'helm-symbolify "1.5.1") +(defalias 'helm-c-zgrep-buffers 'helm-zgrep-buffers) +(make-obsolete 'helm-c-zgrep-buffers 'helm-zgrep-buffers "1.5.1") +(defalias 'helm-c-apt-persistent-action 'helm-apt-persistent-action) +(make-obsolete 'helm-c-apt-persistent-action 'helm-apt-persistent-action "1.5.1") +(defalias 'helm-c-pdfgrep-init 'helm-pdfgrep-init) +(make-obsolete 'helm-c-pdfgrep-init 'helm-pdfgrep-init "1.5.1") +(defalias 'helm-c-walk-directory 'helm-walk-directory) +(make-obsolete 'helm-c-walk-directory 'helm-walk-directory "1.5.1") +(defalias 'helm-c-grep-init 'helm-grep-init) +(make-obsolete 'helm-c-grep-init 'helm-grep-init "1.5.1") +(defalias 'helm-c-ucs-forward-char 'helm-ucs-forward-char) +(make-obsolete 'helm-c-ucs-forward-char 'helm-ucs-forward-char "1.5.1") +(defalias 'helm-c-complete-file-name-at-point 'helm-complete-file-name-at-point) +(make-obsolete 'helm-c-complete-file-name-at-point 'helm-complete-file-name-at-point "1.5.1") +(defalias 'helm-c-timer-real-to-display 'helm-timer-real-to-display) +(make-obsolete 'helm-c-timer-real-to-display 'helm-timer-real-to-display "1.5.1") +(defalias 'helm-c-ucs-init 'helm-ucs-init) +(make-obsolete 'helm-c-ucs-init 'helm-ucs-init "1.5.1") +(defalias 'helm-c-bookmark-run-delete 'helm-bookmark-run-delete) +(make-obsolete 'helm-c-bookmark-run-delete 'helm-bookmark-run-delete "1.5.1") +(defalias 'helm-c-uniq-list 'helm-uniq-list) +(make-obsolete 'helm-c-uniq-list 'helm-uniq-list "1.5.1") +(defalias 'helm-c-pp-bookmarks 'helm-pp-bookmarks) +(make-obsolete 'helm-c-pp-bookmarks 'helm-pp-bookmarks "1.5.1") +(defalias 'helm-c-top-sh-persistent-action 'helm-top-sh-persistent-action) +(make-obsolete 'helm-c-top-sh-persistent-action 'helm-top-sh-persistent-action "1.5.1") +(defalias 'helm-c-grep-action 'helm-grep-action) +(make-obsolete 'helm-c-grep-action 'helm-grep-action "1.5.1") +(defalias 'helm-c-file-buffers 'helm-file-buffers) +(make-obsolete 'helm-c-file-buffers 'helm-file-buffers "1.5.1") +(defalias 'helm-c-google-suggest-fetch 'helm-google-suggest-fetch) +(make-obsolete 'helm-c-google-suggest-fetch 'helm-google-suggest-fetch "1.5.1") +(defalias 'helm-c-arrange-type-attribute 'helm-arrange-type-attribute) +(make-obsolete 'helm-c-arrange-type-attribute 'helm-arrange-type-attribute "1.5.1") +(defalias 'helm-c-yahoo-suggest-action 'helm-yahoo-suggest-action) +(make-obsolete 'helm-c-yahoo-suggest-action 'helm-yahoo-suggest-action "1.5.1") +(defalias 'helm-c-buffer-query-replace-1 'helm-buffer-query-replace-1) +(make-obsolete 'helm-c-buffer-query-replace-1 'helm-buffer-query-replace-1 "1.5.1") +(defalias 'helm-c-make-info-source 'helm-make-info-source) +(make-obsolete 'helm-c-make-info-source 'helm-make-info-source "1.5.1") +(defalias 'helm-c-open-dired 'helm-open-dired) +(make-obsolete 'helm-c-open-dired 'helm-open-dired "1.5.1") +(defalias 'helm-c-kill-ring-transformer 'helm-kill-ring-transformer) +(make-obsolete 'helm-c-kill-ring-transformer 'helm-kill-ring-transformer "1.5.1") +(defalias 'helm-c-etags-init 'helm-etags-init) +(make-obsolete 'helm-c-etags-init 'helm-etags-init "1.5.1") +(defalias 'helm-c-advice-update-current-display-string 'helm-advice-update-current-display-string) +(make-obsolete 'helm-c-advice-update-current-display-string 'helm-advice-update-current-display-string "1.5.1") +(defalias 'helm-c-regexp-get-line 'helm-regexp-get-line) +(make-obsolete 'helm-c-regexp-get-line 'helm-regexp-get-line "1.5.1") +(defalias 'helm-c-grep-run-other-window-action 'helm-grep-run-other-window-action) +(make-obsolete 'helm-c-grep-run-other-window-action 'helm-grep-run-other-window-action "1.5.1") +(defalias 'helm-c-regexp-kill-new 'helm-regexp-kill-new) +(make-obsolete 'helm-c-regexp-kill-new 'helm-regexp-kill-new "1.5.1") +(defalias 'helm-c-grep-run-default-action 'helm-grep-run-default-action) +(make-obsolete 'helm-c-grep-run-default-action 'helm-grep-run-default-action "1.5.1") +(defalias 'helm-c-define-info-index-sources 'helm-define-info-index-sources) +(make-obsolete 'helm-c-define-info-index-sources 'helm-define-info-index-sources "1.5.1") +(defalias 'helm-c-transform-file-browse-url 'helm-transform-file-browse-url) +(make-obsolete 'helm-c-transform-file-browse-url 'helm-transform-file-browse-url "1.5.1") +(defalias 'helm-c-shell-command-if-needed 'helm-shell-command-if-needed) +(make-obsolete 'helm-c-shell-command-if-needed 'helm-shell-command-if-needed "1.5.1") +(defalias 'helm-c-kill-regexp-as-sexp 'helm-kill-regexp-as-sexp) +(make-obsolete 'helm-c-kill-regexp-as-sexp 'helm-kill-regexp-as-sexp "1.5.1") +(defalias 'helm-c-goto-next-or-prec-file 'helm-goto-next-or-prec-file) +(make-obsolete 'helm-c-goto-next-or-prec-file 'helm-goto-next-or-prec-file "1.5.1") +(defalias 'helm-c-insert-file-name-completion-at-point 'helm-insert-file-name-completion-at-point) +(make-obsolete 'helm-c-insert-file-name-completion-at-point 'helm-insert-file-name-completion-at-point "1.5.1") +(defalias 'helm-c-point-file-in-dired 'helm-point-file-in-dired) +(make-obsolete 'helm-c-point-file-in-dired 'helm-point-file-in-dired "1.5.1") +(defalias 'helm-c-info-goto 'helm-info-goto) +(make-obsolete 'helm-c-info-goto 'helm-info-goto "1.5.1") +(defalias 'helm-c-apt-install 'helm-apt-install) +(make-obsolete 'helm-c-apt-install 'helm-apt-install "1.5.1") +(defalias 'helm-c-skip-boring-buffers 'helm-skip-boring-buffers) +(make-obsolete 'helm-c-skip-boring-buffers 'helm-skip-boring-buffers "1.5.1") +(defalias 'helm-c-register-candidates 'helm-register-candidates) +(make-obsolete 'helm-c-register-candidates 'helm-register-candidates "1.5.1") +(defalias 'helm-c-find-function 'helm-find-function) +(make-obsolete 'helm-c-find-function 'helm-find-function "1.5.1") +(defalias 'helm-c-apt-display-to-real 'helm-apt-display-to-real) +(make-obsolete 'helm-c-apt-display-to-real 'helm-apt-display-to-real "1.5.1") +(defalias 'helm-c-org-keywords-init 'helm-org-keywords-init) +(make-obsolete 'helm-c-org-keywords-init 'helm-org-keywords-init "1.5.1") +(defalias 'helm-c-xrandr-screen 'helm-xrandr-screen) +(make-obsolete 'helm-c-xrandr-screen 'helm-xrandr-screen "1.5.1") +(defalias 'helm-c-position 'helm-position) +(make-obsolete 'helm-c-position 'helm-position "1.5.1") +(defalias 'helm-c-imenu-candidates 'helm-imenu-candidates) +(make-obsolete 'helm-c-imenu-candidates 'helm-imenu-candidates "1.5.1") +(defalias 'helm-c-ucs-persistent-forward 'helm-ucs-persistent-forward) +(make-obsolete 'helm-c-ucs-persistent-forward 'helm-ucs-persistent-forward "1.5.1") +(defalias 'helm-c-basename 'helm-basename) +(make-obsolete 'helm-c-basename 'helm-basename "1.5.1") +(defalias 'helm-c-files-in-all-dired-candidates 'helm-files-in-all-dired-candidates) +(make-obsolete 'helm-c-files-in-all-dired-candidates 'helm-files-in-all-dired-candidates "1.5.1") +(defalias 'helm-c-grep-other-window 'helm-grep-other-window) +(make-obsolete 'helm-c-grep-other-window 'helm-grep-other-window "1.5.1") +(defalias 'helm-c-yahoo-suggest-fetch 'helm-yahoo-suggest-fetch) +(make-obsolete 'helm-c-yahoo-suggest-fetch 'helm-yahoo-suggest-fetch "1.5.1") +(defalias 'helm-c-external-commands-list-1 'helm-external-commands-list-1) +(make-obsolete 'helm-c-external-commands-list-1 'helm-external-commands-list-1 "1.5.1") +(defalias 'helm-c-buffers-list-persistent-action 'helm-buffers-list-persistent-action) +(make-obsolete 'helm-c-buffers-list-persistent-action 'helm-buffers-list-persistent-action "1.5.1") +(defalias 'helm-c-show-completion-init-overlay 'helm-show-completion-init-overlay) +(make-obsolete 'helm-c-show-completion-init-overlay 'helm-show-completion-init-overlay "1.5.1") +(defalias 'helm-c-shadow-boring-files 'helm-shadow-boring-files) +(make-obsolete 'helm-c-shadow-boring-files 'helm-shadow-boring-files "1.5.1") +(defalias 'helm-c-bookmark-local-files-setup-alist 'helm-bookmark-local-files-setup-alist) +(make-obsolete 'helm-c-bookmark-local-files-setup-alist 'helm-bookmark-local-files-setup-alist "1.5.1") +(defalias 'helm-c-highlight-local-use 'helm-highlight-local-use) +(make-obsolete 'helm-c-highlight-local-use 'helm-highlight-local-use "1.5.1") +(defalias 'helm-c-skip-current-file 'helm-skip-current-file) +(make-obsolete 'helm-c-skip-current-file 'helm-skip-current-file "1.5.1") +(defalias 'helm-c-goto-next-file 'helm-goto-next-file) +(make-obsolete 'helm-c-goto-next-file 'helm-goto-next-file "1.5.1") +(defalias 'helm-c-info-init 'helm-info-init) +(make-obsolete 'helm-c-info-init 'helm-info-init "1.5.1") +(defalias 'helm-c-query-replace-args 'helm-query-replace-args) +(make-obsolete 'helm-c-query-replace-args 'helm-query-replace-args "1.5.1") +(defalias 'helm-c-bookmark-info-setup-alist 'helm-bookmark-info-setup-alist) +(make-obsolete 'helm-c-bookmark-info-setup-alist 'helm-bookmark-info-setup-alist "1.5.1") +(defalias 'helm-c-ratpoison-commands-execute 'helm-ratpoison-commands-execute) +(make-obsolete 'helm-c-ratpoison-commands-execute 'helm-ratpoison-commands-execute "1.5.1") +(defalias 'helm-c-ucs-persistent-backward 'helm-ucs-persistent-backward) +(make-obsolete 'helm-c-ucs-persistent-backward 'helm-ucs-persistent-backward "1.5.1") +(defalias 'helm-c-info-pages-init 'helm-info-pages-init) +(make-obsolete 'helm-c-info-pages-init 'helm-info-pages-init "1.5.1") +(defalias 'helm-c-grep-save-results 'helm-grep-save-results) +(make-obsolete 'helm-c-grep-save-results 'helm-grep-save-results "1.5.1") +(defalias 'helm-c-read-file-name 'helm-read-file-name) +(make-obsolete 'helm-c-read-file-name 'helm-read-file-name "1.5.1") +(defalias 'helm-c-org-keywords-insert 'helm-org-keywords-insert) +(make-obsolete 'helm-c-org-keywords-insert 'helm-org-keywords-insert "1.5.1") +(defalias 'helm-c-call-interactively 'helm-call-interactively) +(make-obsolete 'helm-c-call-interactively 'helm-call-interactively "1.5.1") +(defalias 'helm-c-adaptative-compare 'helm-adaptive-compare) +(make-obsolete 'helm-c-adaptative-compare 'helm-adaptive-compare "1.5.1") +(defalias 'helm-c-buffer-list 'helm-buffer-list) +(make-obsolete 'helm-c-buffer-list 'helm-buffer-list "1.5.1") +(defalias 'helm-c-thing-before-point 'helm-thing-before-point) +(make-obsolete 'helm-c-thing-before-point 'helm-thing-before-point "1.5.1") +(defalias 'helm-c-ratpoison-commands-display-to-real 'helm-ratpoison-commands-display-to-real) +(make-obsolete 'helm-c-ratpoison-commands-display-to-real 'helm-ratpoison-commands-display-to-real "1.5.1") +(defalias 'helm-c-imenu-default-action 'helm-imenu-default-action) +(make-obsolete 'helm-c-imenu-default-action 'helm-imenu-default-action "1.5.1") +(defalias 'helm-c-describe-function 'helm-describe-function) +(make-obsolete 'helm-c-describe-function 'helm-describe-function "1.5.1") +(defalias 'helm-c-colors-get-name 'helm-colors-get-name) +(make-obsolete 'helm-c-colors-get-name 'helm-colors-get-name "1.5.1") +(defalias 'helm-c-bookmark-help 'helm-bookmark-help) +(make-obsolete 'helm-c-bookmark-help 'helm-bookmark-help "1.5.1") +(defalias 'helm-c-ucs-persistent-delete 'helm-ucs-persistent-delete) +(make-obsolete 'helm-c-ucs-persistent-delete 'helm-ucs-persistent-delete "1.5.1") +(defalias 'helm-c-set-variable 'helm-set-variable) +(make-obsolete 'helm-c-set-variable 'helm-set-variable "1.5.1") +(defalias 'helm-c-grep-save-results-1 'helm-grep-save-results-1) +(make-obsolete 'helm-c-grep-save-results-1 'helm-grep-save-results-1 "1.5.1") +(defalias 'helm-c-adaptative-maybe-load-history 'helm-adaptive-maybe-load-history) +(make-obsolete 'helm-c-adaptative-maybe-load-history 'helm-adaptive-maybe-load-history "1.5.1") +(defalias 'helm-c-w32-pathname-transformer 'helm-w32-pathname-transformer) +(make-obsolete 'helm-c-w32-pathname-transformer 'helm-w32-pathname-transformer "1.5.1") +(defalias 'helm-c-top-display-to-real 'helm-top-display-to-real) +(make-obsolete 'helm-c-top-display-to-real 'helm-top-display-to-real "1.5.1") +(defalias 'helm-c-open-file-externally 'helm-open-file-externally) +(make-obsolete 'helm-c-open-file-externally 'helm-open-file-externally "1.5.1") +(defalias 'helm-c-colors-get-rgb 'helm-colors-get-rgb) +(make-obsolete 'helm-c-colors-get-rgb 'helm-colors-get-rgb "1.5.1") +(defalias 'helm-c-stumpwm-commands-init 'helm-stumpwm-commands-init) +(make-obsolete 'helm-c-stumpwm-commands-init 'helm-stumpwm-commands-init "1.5.1") +(defalias 'helm-c-highlight-world 'helm-highlight-world) +(make-obsolete 'helm-c-highlight-world 'helm-highlight-world "1.5.1") +(defalias 'helm-c-top-sh 'helm-top-sh) +(make-obsolete 'helm-c-top-sh 'helm-top-sh "1.5.1") +(defalias 'helm-c-persistent-xfont-action 'helm-persistent-xfont-action) +(make-obsolete 'helm-c-persistent-xfont-action 'helm-persistent-xfont-action "1.5.1") +(defalias 'helm-c-latex-math-candidates 'helm-latex-math-candidates) +(make-obsolete 'helm-c-latex-math-candidates 'helm-latex-math-candidates "1.5.1") +(defalias 'helm-c-ucs-backward-char 'helm-ucs-backward-char) +(make-obsolete 'helm-c-ucs-backward-char 'helm-ucs-backward-char "1.5.1") +(defalias 'helm-c-calculate-ucs-max-len 'helm-calculate-ucs-max-len) +(make-obsolete 'helm-c-calculate-ucs-max-len 'helm-calculate-ucs-max-len "1.5.1") +(defalias 'helm-c-etags-mtime 'helm-etags-mtime) +(make-obsolete 'helm-c-etags-mtime 'helm-etags-mtime "1.5.1") +(defalias 'helm-c-google-suggest-action 'helm-google-suggest-action) +(make-obsolete 'helm-c-google-suggest-action 'helm-google-suggest-action "1.5.1") +(defalias 'helm-c-elisp-library-scan-init 'helm-elisp-library-scan-init) +(make-obsolete 'helm-c-elisp-library-scan-init 'helm-elisp-library-scan-init "1.5.1") +(defalias 'helm-c-apt-refresh 'helm-apt-refresh) +(make-obsolete 'helm-c-apt-refresh 'helm-apt-refresh "1.5.1") +(defalias 'helm-c-kill-regexp 'helm-kill-regexp) +(make-obsolete 'helm-c-kill-regexp 'helm-kill-regexp "1.5.1") +(defalias 'helm-c-grep-buffers-1 'helm-grep-buffers-1) +(make-obsolete 'helm-c-grep-buffers-1 'helm-grep-buffers-1 "1.5.1") +(defalias 'helm-c-adaptative-store-selection 'helm-adaptive-store-selection) +(make-obsolete 'helm-c-adaptative-store-selection 'helm-adaptive-store-selection "1.5.1") +(defalias 'helm-c-browse-url 'helm-browse-url) +(make-obsolete 'helm-c-browse-url 'helm-browse-url "1.5.1") +(defalias 'helm-c-google-suggest-emacs-lisp 'helm-google-suggest-emacs-lisp) +(make-obsolete 'helm-c-google-suggest-emacs-lisp 'helm-google-suggest-emacs-lisp "1.5.1") +(defalias 'helm-c-ucs-persistent-insert 'helm-ucs-persistent-insert) +(make-obsolete 'helm-c-ucs-persistent-insert 'helm-ucs-persistent-insert "1.5.1") +(defalias 'helm-c-xrandr-output 'helm-xrandr-output) +(make-obsolete 'helm-c-xrandr-output 'helm-xrandr-output "1.5.1") +(defalias 'helm-c-kill-ring-action 'helm-kill-ring-action) +(make-obsolete 'helm-c-kill-ring-action 'helm-kill-ring-action "1.5.1") +(defalias 'helm-c-org-keywords-candidates 'helm-org-keywords-candidates) +(make-obsolete 'helm-c-org-keywords-candidates 'helm-org-keywords-candidates "1.5.1") +(defalias 'helm-c-bookmark-jump 'helm-bookmark-jump) +(make-obsolete 'helm-c-bookmark-jump 'helm-bookmark-jump "1.5.1") +(defalias 'helm-c-shadow-boring-buffers 'helm-shadow-boring-buffers) +(make-obsolete 'helm-c-shadow-boring-buffers 'helm-shadow-boring-buffers "1.5.1") +(defalias 'helm-c-buffer-match-major-mode 'helm-buffer-match-major-mode) +(make-obsolete 'helm-c-buffer-match-major-mode 'helm-buffer-match-major-mode "1.5.1") +(defalias 'helm-c-highlight-bookmark-su 'helm-highlight-bookmark-su) +(make-obsolete 'helm-c-highlight-bookmark-su 'helm-highlight-bookmark-su "1.5.1") +(defalias 'helm-c-grep-other-frame 'helm-grep-other-frame) +(make-obsolete 'helm-c-grep-other-frame 'helm-grep-other-frame "1.5.1") +(defalias 'helm-c-jabber-online-contacts 'helm-jabber-online-contacts) +(make-obsolete 'helm-c-jabber-online-contacts 'helm-jabber-online-contacts "1.5.1") +(defalias 'helm-c-apt-purge 'helm-apt-purge) +(make-obsolete 'helm-c-apt-purge 'helm-apt-purge "1.5.1") +(defalias 'helm-c-adaptative-sort 'helm-adaptive-sort) +(make-obsolete 'helm-c-adaptative-sort 'helm-adaptive-sort "1.5.1") +(defalias 'helm-c-bmkext-addressbook-setup-alist 'helm-bmkext-addressbook-setup-alist) +(make-obsolete 'helm-c-bmkext-addressbook-setup-alist 'helm-bmkext-addressbook-setup-alist "1.5.1") +(defalias 'helm-c-bmkext-filter-setup-alist 'helm-bmkext-filter-setup-alist) +(make-obsolete 'helm-c-bmkext-filter-setup-alist 'helm-bmkext-filter-setup-alist "1.5.1") +(defalias 'helm-c-grep-buffers 'helm-grep-buffers) +(make-obsolete 'helm-c-grep-buffers 'helm-grep-buffers "1.5.1") +(defalias 'helm-c-apt-init 'helm-apt-init) +(make-obsolete 'helm-c-apt-init 'helm-apt-init "1.5.1") +(defalias 'helm-c-grep-run-save-buffer 'helm-grep-run-save-buffer) +(make-obsolete 'helm-c-grep-run-save-buffer 'helm-grep-run-save-buffer "1.5.1") +(defalias 'helm-c-ggs-set-number-result 'helm-ggs-set-number-result) +(make-obsolete 'helm-c-ggs-set-number-result 'helm-ggs-set-number-result "1.5.1") +(defalias 'helm-c-grep-prepare-candidates 'helm-grep-prepare-candidates) +(make-obsolete 'helm-c-grep-prepare-candidates 'helm-grep-prepare-candidates "1.5.1") +(defalias 'helm-c-grep-jump-elscreen 'helm-grep-jump-elscreen) +(make-obsolete 'helm-c-grep-jump-elscreen 'helm-grep-jump-elscreen "1.5.1") +(defalias 'helm-c-show-completion-display-function 'helm-show-completion-display-function) +(make-obsolete 'helm-c-show-completion-display-function 'helm-show-completion-display-function "1.5.1") +(defalias 'helm-c-find-variable 'helm-find-variable) +(make-obsolete 'helm-c-find-variable 'helm-find-variable "1.5.1") +(defalias 'helm-c-build-elvi-list 'helm-build-elvi-list) +(make-obsolete 'helm-c-build-elvi-list 'helm-build-elvi-list "1.5.1") +(defalias 'helm-c-advice-toggle 'helm-advice-toggle) +(make-obsolete 'helm-c-advice-toggle 'helm-advice-toggle "1.5.1") +(defalias 'helm-c-buffers-persistent-kill 'helm-buffers-persistent-kill) +(make-obsolete 'helm-c-buffers-persistent-kill 'helm-buffers-persistent-kill "1.5.1") +(defalias 'helm-c-register-action-transformer 'helm-register-action-transformer) +(make-obsolete 'helm-c-register-action-transformer 'helm-register-action-transformer "1.5.1") +(defalias 'helm-c-kill-ring-candidates 'helm-kill-ring-candidates) +(make-obsolete 'helm-c-kill-ring-candidates 'helm-kill-ring-candidates "1.5.1") +(defalias 'helm-c-generic-browser 'helm-generic-browser) +(make-obsolete 'helm-c-generic-browser 'helm-generic-browser "1.5.1") +(defalias 'helm-c-top-init 'helm-top-init) +(make-obsolete 'helm-c-top-init 'helm-top-init "1.5.1") +(defalias 'helm-c-ucs-delete-backward 'helm-ucs-delete-backward) +(make-obsolete 'helm-c-ucs-delete-backward 'helm-ucs-delete-backward "1.5.1") +(defalias 'helm-c-apt-generic-action 'helm-apt-generic-action) +(make-obsolete 'helm-c-apt-generic-action 'helm-apt-generic-action "1.5.1") +(defalias 'helm-c-pdfgrep-action-1 'helm-pdfgrep-action-1) +(make-obsolete 'helm-c-pdfgrep-action-1 'helm-pdfgrep-action-1 "1.5.1") +(defalias 'helm-c-buffer-query-replace-regexp 'helm-buffer-query-replace-regexp) +(make-obsolete 'helm-c-buffer-query-replace-regexp 'helm-buffer-query-replace-regexp "1.5.1") +(defalias 'helm-c-apropos-init 'helm-apropos-init) +(make-obsolete 'helm-c-apropos-init 'helm-apropos-init "1.5.1") +(defalias 'helm-c-kill-new 'helm-kill-new) +(make-obsolete 'helm-c-kill-new 'helm-kill-new "1.5.1") +(defalias 'helm-c-bookmark-gnus-setup-alist 'helm-bookmark-gnus-setup-alist) +(make-obsolete 'helm-c-bookmark-gnus-setup-alist 'helm-bookmark-gnus-setup-alist "1.5.1") +(defalias 'helm-c-quit-and-execute-action 'helm-quit-and-execute-action) +(make-obsolete 'helm-c-quit-and-execute-action 'helm-quit-and-execute-action "1.5.1") +(defalias 'helm-c-build-info-index-command 'helm-build-info-index-command) +(make-obsolete 'helm-c-build-info-index-command 'helm-build-info-index-command "1.5.1") +(defalias 'helm-c-ratpoison-commands-init 'helm-ratpoison-commands-init) +(make-obsolete 'helm-c-ratpoison-commands-init 'helm-ratpoison-commands-init "1.5.1") +(defalias 'helm-c-etags-select 'helm-etags-select) +(make-obsolete 'helm-c-etags-select 'helm-etags-select "1.5.1") +(defalias 'helm-c-etags-create-buffer 'helm-etags-create-buffer) +(make-obsolete 'helm-c-etags-create-buffer 'helm-etags-create-buffer "1.5.1") +(defalias 'helm-c-yahoo-suggest-set-candidates 'helm-yahoo-suggest-set-candidates) +(make-obsolete 'helm-c-yahoo-suggest-set-candidates 'helm-yahoo-suggest-set-candidates "1.5.1") +(defalias 'helm-c-org-keywords-show-help 'helm-org-keywords-show-help) +(make-obsolete 'helm-c-org-keywords-show-help 'helm-org-keywords-show-help "1.5.1") +(defalias 'helm-c-highlight-files 'helm-highlight-files) +(make-obsolete 'helm-c-highlight-files 'helm-highlight-files "1.5.1") +(defalias 'helm-c-get-pid-from-process-name 'helm-get-pid-from-process-name) +(make-obsolete 'helm-c-get-pid-from-process-name 'helm-get-pid-from-process-name "1.5.1") +(defalias 'helm-c-insert-latex-math 'helm-insert-latex-math) +(make-obsolete 'helm-c-insert-latex-math 'helm-insert-latex-math "1.5.1") +(defalias 'helm-c-buffer-query-replace 'helm-buffer-query-replace) +(make-obsolete 'helm-c-buffer-query-replace 'helm-buffer-query-replace "1.5.1") +(defalias 'helm-c-bmkext-run-edit 'helm-bmkext-run-edit) +(make-obsolete 'helm-c-bmkext-run-edit 'helm-bmkext-run-edit "1.5.1") +(defalias 'helm-c-skip-boring-files 'helm-skip-boring-files) +(make-obsolete 'helm-c-skip-boring-files 'helm-skip-boring-files "1.5.1") +(defalias 'helm-c-transform-file-load-el 'helm-transform-file-load-el) +(make-obsolete 'helm-c-transform-file-load-el 'helm-transform-file-load-el "1.5.1") +(defalias 'helm-c-ucs-insert-char 'helm-ucs-insert-char) +(make-obsolete 'helm-c-ucs-insert-char 'helm-ucs-insert-char "1.5.1") +(defalias 'helm-c-buffer-help 'helm-buffer-help) +(make-obsolete 'helm-c-buffer-help 'helm-buffer-help "1.5.1") +(defalias 'helm-c-current-directory 'helm-current-directory) +(make-obsolete 'helm-c-current-directory 'helm-current-directory "1.5.1") +(defalias 'helm-c-find-file-or-marked 'helm-find-file-or-marked) +(make-obsolete 'helm-c-find-file-or-marked 'helm-find-file-or-marked "1.5.1") +(defalias 'helm-c-query-replace-regexp 'helm-query-replace-regexp) +(make-obsolete 'helm-c-query-replace-regexp 'helm-query-replace-regexp "1.5.1") +(defalias 'helm-c-describe-variable 'helm-describe-variable) +(make-obsolete 'helm-c-describe-variable 'helm-describe-variable "1.5.1") +(defalias 'helm-c-advice-persistent-action 'helm-advice-persistent-action) +(make-obsolete 'helm-c-advice-persistent-action 'helm-advice-persistent-action "1.5.1") +(defalias 'helm-c-show-completion 'helm-show-completion) +(make-obsolete 'helm-c-show-completion 'helm-show-completion "1.5.1") +(defalias 'helm-c-google-suggest-set-candidates 'helm-google-suggest-set-candidates) +(make-obsolete 'helm-c-google-suggest-set-candidates 'helm-google-suggest-set-candidates "1.5.1") +(defalias 'helm-c-grep-persistent-action 'helm-grep-persistent-action) +(make-obsolete 'helm-c-grep-persistent-action 'helm-grep-persistent-action "1.5.1") +(defalias 'helm-c-open-file-with-default-tool 'helm-open-file-with-default-tool) +(make-obsolete 'helm-c-open-file-with-default-tool 'helm-open-file-with-default-tool "1.5.1") +(defalias 'helm-c-run-external-command 'helm-run-external-command) +(make-obsolete 'helm-c-run-external-command 'helm-run-external-command "1.5.1") +(defalias 'helm-c-bookmark-images-setup-alist 'helm-bookmark-images-setup-alist) +(make-obsolete 'helm-c-bookmark-images-setup-alist 'helm-bookmark-images-setup-alist "1.5.1") +(defalias 'helm-c-apt-candidate-transformer 'helm-apt-candidate-transformer) +(make-obsolete 'helm-c-apt-candidate-transformer 'helm-apt-candidate-transformer "1.5.1") +(defalias 'helm-c-grep-run-persistent-action 'helm-grep-run-persistent-action) +(make-obsolete 'helm-c-grep-run-persistent-action 'helm-grep-run-persistent-action "1.5.1") +(defalias 'helm-c-highlight-buffers 'helm-highlight-buffers) +(make-obsolete 'helm-c-highlight-buffers 'helm-highlight-buffers "1.5.1") +(defalias 'helm-c-man-default-action 'helm-man-default-action) +(make-obsolete 'helm-c-man-default-action 'helm-man-default-action "1.5.1") +(defalias 'helm-c-advice-candidates 'helm-advice-candidates) +(make-obsolete 'helm-c-advice-candidates 'helm-advice-candidates "1.5.1") +(defalias 'helm-c-stumpwm-commands-execute 'helm-stumpwm-commands-execute) +(make-obsolete 'helm-c-stumpwm-commands-execute 'helm-stumpwm-commands-execute "1.5.1") +(defalias 'helm-c-ucs-help 'helm-ucs-help) +(make-obsolete 'helm-c-ucs-help 'helm-ucs-help "1.5.1") +(defalias 'helm-c-apt-uninstall 'helm-apt-uninstall) +(make-obsolete 'helm-c-apt-uninstall 'helm-apt-uninstall "1.5.1") +(defalias 'helm-c-bookmark-run-jump-other-window 'helm-bookmark-run-jump-other-window) +(make-obsolete 'helm-c-bookmark-run-jump-other-window 'helm-bookmark-run-jump-other-window "1.5.1") +(defalias 'helm-c-elisp-library-scan-list 'helm-elisp-library-scan-list) +(make-obsolete 'helm-c-elisp-library-scan-list 'helm-elisp-library-scan-list "1.5.1") +(defalias 'helm-c-bookmark-man-setup-alist 'helm-bookmark-man-setup-alist) +(make-obsolete 'helm-c-bookmark-man-setup-alist 'helm-bookmark-man-setup-alist "1.5.1") +(defalias 'helm-c-etags-find-tag-file-directory 'helm-etags-find-tag-file-directory) +(make-obsolete 'helm-c-etags-find-tag-file-directory 'helm-etags-find-tag-file-directory "1.5.1") +(defalias 'helm-c-xrandr-info 'helm-xrandr-info) +(make-obsolete 'helm-c-xrandr-info 'helm-xrandr-info "1.5.1") +(defalias 'helm-c-stringify 'helm-stringify) +(make-obsolete 'helm-c-stringify 'helm-stringify "1.5.1") +(defalias 'helm-c-goto-precedent-file 'helm-goto-precedent-file) +(make-obsolete 'helm-c-goto-precedent-file 'helm-goto-precedent-file "1.5.1") +(defalias 'helm-c-apt-cache-show 'helm-apt-cache-show) +(make-obsolete 'helm-c-apt-cache-show 'helm-apt-cache-show "1.5.1") +(defalias 'helm-c-etags-file-modified-p 'helm-etags-file-modified-p) +(make-obsolete 'helm-c-etags-file-modified-p 'helm-etags-file-modified-p "1.5.1") +(defalias 'helm-c-etags-get-tag-file 'helm-etags-get-tag-file) +(make-obsolete 'helm-c-etags-get-tag-file 'helm-etags-get-tag-file "1.5.1") +(defalias 'helm-c-highlight-not-logged 'helm-highlight-not-logged) +(make-obsolete 'helm-c-highlight-not-logged 'helm-highlight-not-logged "1.5.1") +(defalias 'helm-c-pdfgrep-action 'helm-pdfgrep-action) +(make-obsolete 'helm-c-pdfgrep-action 'helm-pdfgrep-action "1.5.1") +(defalias 'helm-c-adaptative-save-history 'helm-adaptive-save-history) +(make-obsolete 'helm-c-adaptative-save-history 'helm-adaptive-save-history "1.5.1") +(defalias 'helm-c-get-first-line-documentation 'helm-get-first-line-documentation) +(make-obsolete 'helm-c-get-first-line-documentation 'helm-get-first-line-documentation "1.5.1") +(defalias 'helm-approximate-candidate-number 'helm-get-candidate-number) +(make-obsolete 'helm-approximate-candidate-number 'helm-get-candidate-number "1.5.5") +(defalias 'helm-org-headlines 'helm-org-in-buffer-headings) +(make-obsolete 'helm-org-headlines 'helm-org-in-buffer-headings "1.6.5") + + +;;; variables +;; +;; + + +(defvaralias 'helm-c-pdfgrep-default-command 'helm-pdfgrep-default-command) +(make-obsolete-variable 'helm-c-pdfgrep-default-command 'helm-pdfgrep-default-command "1.5.1") +(defvaralias 'helm-c-source-time-world 'helm-source-time-world) +(make-obsolete-variable 'helm-c-source-time-world 'helm-source-time-world "1.5.1") +(defvaralias 'helm-c-grep-default-command 'helm-grep-default-command) +(make-obsolete-variable 'helm-c-grep-default-command 'helm-grep-default-command "1.5.1") +(defvaralias 'helm-c-default-info-index-list 'helm-default-info-index-list) +(make-obsolete-variable 'helm-c-default-info-index-list 'helm-default-info-index-list "1.5.1") +(defvaralias 'helm-c-etags-tag-file-dir 'helm-etags-tag-file-dir) +(make-obsolete-variable 'helm-c-etags-tag-file-dir 'helm-etags-tag-file-dir "1.5.1") +(defvaralias 'helm-c-source-man-pages 'helm-source-man-pages) +(make-obsolete-variable 'helm-c-source-man-pages 'helm-source-man-pages "1.5.1") +(defvaralias 'helm-c-source-bookmark-info 'helm-source-bookmark-info) +(make-obsolete-variable 'helm-c-source-bookmark-info 'helm-source-bookmark-info "1.5.1") +(defvaralias 'helm-c-file-cache-files 'helm-file-cache-files) +(make-obsolete-variable 'helm-c-file-cache-files 'helm-file-cache-files "1.5.1") +(defvaralias 'helm-c-ucs-map 'helm-ucs-map) +(make-obsolete-variable 'helm-c-ucs-map 'helm-ucs-map "1.5.1") +(defvaralias 'helm-c-show-completion-min-window-height 'helm-show-completion-min-window-height) +(make-obsolete-variable 'helm-c-show-completion-min-window-height 'helm-show-completion-min-window-height "1.5.1") +(defvaralias 'helm-c-adaptative-history 'helm-adaptive-history) +(make-obsolete-variable 'helm-c-adaptative-history 'helm-adaptive-history "1.5.1") +(defvaralias 'helm-c-source-bookmarks-local 'helm-source-bookmarks-local) +(make-obsolete-variable 'helm-c-source-bookmarks-local 'helm-source-bookmarks-local "1.5.1") +(defvaralias 'helm-c-grep-map 'helm-grep-map) +(make-obsolete-variable 'helm-c-grep-map 'helm-grep-map "1.5.1") +(defvaralias 'helm-c-source-session 'helm-source-session) +(make-obsolete-variable 'helm-c-source-session 'helm-source-session "1.5.1") +(defvaralias 'helm-c-source-minibuffer-history 'helm-source-minibuffer-history) +(make-obsolete-variable 'helm-c-source-minibuffer-history 'helm-source-minibuffer-history "1.5.1") +(defvaralias 'helm-c-source-files-in-current-dir 'helm-source-files-in-current-dir) +(make-obsolete-variable 'helm-c-source-files-in-current-dir 'helm-source-files-in-current-dir "1.5.1") +(defvaralias 'helm-c-source-etags-select 'helm-source-etags-select) +(make-obsolete-variable 'helm-c-source-etags-select 'helm-source-etags-select "1.5.1") +(defvaralias 'helm-c-show-completion-overlay 'helm-show-completion-overlay) +(make-obsolete-variable 'helm-c-show-completion-overlay 'helm-show-completion-overlay "1.5.1") +(defvaralias 'helm-c-buffer-help-message 'helm-buffer-help-message) +(make-obsolete-variable 'helm-c-buffer-help-message 'helm-buffer-help-message "1.5.1") +(defvaralias 'helm-c-ucs-max-len 'helm-ucs-max-len) +(make-obsolete-variable 'helm-c-ucs-max-len 'helm-ucs-max-len "1.5.1") +(defvaralias 'helm-c-imenu-index-filter 'helm-imenu-index-filter) +(make-obsolete-variable 'helm-c-imenu-index-filter 'helm-imenu-index-filter "1.5.1") +(defvaralias 'helm-c-org-keywords-info-location 'helm-org-keywords-info-location) +(make-obsolete-variable 'helm-c-org-keywords-info-location 'helm-org-keywords-info-location "1.5.1") +(defvaralias 'helm-c-kill-ring-max-lines-number 'helm-kill-ring-max-lines-number) +(make-obsolete-variable 'helm-c-kill-ring-max-lines-number 'helm-kill-ring-max-lines-number "1.5.1") +(defvaralias 'helm-c-source-apt 'helm-source-apt) +(make-obsolete-variable 'helm-c-source-apt 'helm-source-apt "1.5.1") +(defvaralias 'helm-c-bookmark-map 'helm-bookmark-map) +(make-obsolete-variable 'helm-c-bookmark-map 'helm-bookmark-map "1.5.1") +(defvaralias 'helm-c-source-xfonts 'helm-source-xfonts) +(make-obsolete-variable 'helm-c-source-xfonts 'helm-source-xfonts "1.5.1") +(defvaralias 'helm-c-source-kill-ring 'helm-source-kill-ring) +(make-obsolete-variable 'helm-c-source-kill-ring 'helm-source-kill-ring "1.5.1") +(defvaralias 'helm-c-home-url 'helm-home-url) +(make-obsolete-variable 'helm-c-home-url 'helm-home-url "1.5.1") +(defvaralias 'helm-c-etags-cache 'helm-etags-cache) +(make-obsolete-variable 'helm-c-etags-cache 'helm-etags-cache "1.5.1") +(defvaralias 'helm-c-source-latex-math 'helm-source-latex-math) +(make-obsolete-variable 'helm-c-source-latex-math 'helm-source-latex-math "1.5.1") +(defvaralias 'helm-c-source-bookmark-files&dirs 'helm-source-bookmark-files&dirs) +(make-obsolete-variable 'helm-c-source-bookmark-files&dirs 'helm-source-bookmark-files&dirs "1.5.1") +(defvaralias 'helm-c-source-ratpoison-commands 'helm-source-ratpoison-commands) +(make-obsolete-variable 'helm-c-source-ratpoison-commands 'helm-source-ratpoison-commands "1.5.1") +(defvaralias 'helm-c-apt-show-command 'helm-apt-show-command) +(make-obsolete-variable 'helm-c-apt-show-command 'helm-apt-show-command "1.5.1") +(defvaralias 'helm-c-pdfgrep-default-function 'helm-pdfgrep-default-function) +(make-obsolete-variable 'helm-c-pdfgrep-default-function 'helm-pdfgrep-default-function "1.5.1") +(defvaralias 'helm-c-source-register 'helm-source-register) +(make-obsolete-variable 'helm-c-source-register 'helm-source-register "1.5.1") +(defvaralias 'helm-c-boring-buffer-regexp-list 'helm-boring-buffer-regexp-list) +(make-obsolete-variable 'helm-c-boring-buffer-regexp-list 'helm-boring-buffer-regexp-list "1.5.1") +(defvaralias 'helm-c-source-locate 'helm-source-locate) +(make-obsolete-variable 'helm-c-source-locate 'helm-source-locate "1.5.1") +(defvaralias 'helm-c-source-advice 'helm-source-advice) +(make-obsolete-variable 'helm-c-source-advice 'helm-source-advice "1.5.1") +(defvaralias 'helm-c-source-yaoddmuse-emacswiki-edit-or-view 'helm-source-yaoddmuse-emacswiki-edit-or-view) +(defvaralias 'helm-c-ucs-mode-line-string 'helm-ucs-mode-line-string) +(make-obsolete-variable 'helm-c-ucs-mode-line-string 'helm-ucs-mode-line-string "1.5.1") +(defvaralias 'helm-c-xfonts-cache 'helm-xfonts-cache) +(make-obsolete-variable 'helm-c-xfonts-cache 'helm-xfonts-cache "1.5.1") +(defvaralias 'helm-c-source-yahoo-suggest 'helm-source-yahoo-suggest) +(make-obsolete-variable 'helm-c-source-yahoo-suggest 'helm-source-yahoo-suggest "1.5.1") +(defvaralias 'helm-c-rzgrep-cache 'helm-rzgrep-cache) +(make-obsolete-variable 'helm-c-rzgrep-cache 'helm-rzgrep-cache "1.5.1") +(defvaralias 'helm-c-source-org-keywords 'helm-source-org-keywords) +(make-obsolete-variable 'helm-c-source-org-keywords 'helm-source-org-keywords "1.5.1") +(defvaralias 'helm-c-pdfgrep-map 'helm-pdfgrep-map) +(make-obsolete-variable 'helm-c-pdfgrep-map 'helm-pdfgrep-map "1.5.1") +(defvaralias 'helm-c-source-lacarte 'helm-source-lacarte) +(make-obsolete-variable 'helm-c-source-lacarte 'helm-source-lacarte "1.5.1") +(defvaralias 'helm-c-apt-search-command 'helm-apt-search-command) +(make-obsolete-variable 'helm-c-apt-search-command 'helm-apt-search-command "1.5.1") +(defvaralias 'helm-c-default-external-file-browser 'helm-default-external-file-browser) +(make-obsolete-variable 'helm-c-default-external-file-browser 'helm-default-external-file-browser "1.5.1") +(defvaralias 'helm-c-source-evaluation-result 'helm-source-evaluation-result) +(make-obsolete-variable 'helm-c-source-evaluation-result 'helm-source-evaluation-result "1.5.1") +(defvaralias 'helm-c-yahoo-suggest-search-url 'helm-yahoo-suggest-search-url) +(make-obsolete-variable 'helm-c-yahoo-suggest-search-url 'helm-yahoo-suggest-search-url "1.5.1") +(defvaralias 'helm-c-source-occur 'helm-source-occur) +(make-obsolete-variable 'helm-c-source-occur 'helm-source-occur "1.5.1") +(defvaralias 'helm-c-source-calculation-result 'helm-source-calculation-result) +(make-obsolete-variable 'helm-c-source-calculation-result 'helm-source-calculation-result "1.5.1") +(defvaralias 'helm-c-default-zgrep-command 'helm-default-zgrep-command) +(make-obsolete-variable 'helm-c-default-zgrep-command 'helm-default-zgrep-command "1.5.1") +(defvaralias 'helm-c-show-info-in-mode-line-delay 'helm-show-info-in-mode-line-delay) +(make-obsolete-variable 'helm-c-show-info-in-mode-line-delay 'helm-show-info-in-mode-line-delay "1.5.1") +(defvaralias 'helm-c-source-ido-virtual-buffers 'helm-source-ido-virtual-buffers) +(make-obsolete-variable 'helm-c-source-ido-virtual-buffers 'helm-source-ido-virtual-buffers "1.5.1") +(defvaralias 'helm-c-source-top 'helm-source-top) +(make-obsolete-variable 'helm-c-source-top 'helm-source-top "1.5.1") +(defvaralias 'helm-c-source-colors 'helm-source-colors) +(make-obsolete-variable 'helm-c-source-colors 'helm-source-colors "1.5.1") +(defvaralias 'helm-c-read-file-map 'helm-read-file-map) +(make-obsolete-variable 'helm-c-read-file-map 'helm-read-file-map "1.5.1") +(defvaralias 'helm-c-source-file-cache 'helm-source-file-cache) +(make-obsolete-variable 'helm-c-source-file-cache 'helm-source-file-cache "1.5.1") +(defvaralias 'helm-c-google-suggest-default-browser-function 'helm-google-suggest-default-browser-function) +(make-obsolete-variable 'helm-c-google-suggest-default-browser-function 'helm-google-suggest-default-browser-function "1.5.1") +(defvaralias 'helm-c-external-programs-associations 'helm-external-programs-associations) +(make-obsolete-variable 'helm-c-external-programs-associations 'helm-external-programs-associations "1.5.1") +(defvaralias 'helm-c-source-complex-command-history 'helm-source-complex-command-history) +(make-obsolete-variable 'helm-c-source-complex-command-history 'helm-source-complex-command-history "1.5.1") +(defvaralias 'helm-c-cached-imenu-candidates 'helm-cached-imenu-candidates) +(make-obsolete-variable 'helm-c-cached-imenu-candidates 'helm-cached-imenu-candidates "1.5.1") +(defvaralias 'helm-c-external-commands-list 'helm-external-commands-list) +(make-obsolete-variable 'helm-c-external-commands-list 'helm-external-commands-list "1.5.1") +(defvaralias 'helm-c-source-ucs 'helm-source-ucs) +(make-obsolete-variable 'helm-c-source-ucs 'helm-source-ucs "1.5.1") +(defvaralias 'helm-c-adaptative-history-length 'helm-adaptive-history-length) +(make-obsolete-variable 'helm-c-adaptative-history-length 'helm-adaptive-history-length "1.5.1") +(defvaralias 'helm-c-source-customize-face 'helm-source-customize-face) +(make-obsolete-variable 'helm-c-source-customize-face 'helm-source-customize-face "1.5.1") +(defvaralias 'helm-c-source-bookmarks-ssh 'helm-source-bookmarks-ssh) +(make-obsolete-variable 'helm-c-source-bookmarks-ssh 'helm-source-bookmarks-ssh "1.5.1") +(defvaralias 'helm-c-eldoc-in-minibuffer-show-fn 'helm-eldoc-in-minibuffer-show-fn) +(make-obsolete-variable 'helm-c-eldoc-in-minibuffer-show-fn 'helm-eldoc-in-minibuffer-show-fn "1.5.1") +(defvaralias 'helm-c-google-suggest-search-url 'helm-google-suggest-search-url) +(make-obsolete-variable 'helm-c-google-suggest-search-url 'helm-google-suggest-search-url "1.5.1") +(defvaralias 'helm-c-source-bmkext-addressbook 'helm-source-bmkext-addressbook) +(make-obsolete-variable 'helm-c-source-bmkext-addressbook 'helm-source-bmkext-addressbook "1.5.1") +(defvaralias 'helm-c-source-ctags 'helm-source-ctags) +(make-obsolete-variable 'helm-c-source-ctags 'helm-source-ctags "1.5.1") +(defvaralias 'helm-c-apt-installed-packages 'helm-apt-installed-packages) +(make-obsolete-variable 'helm-c-apt-installed-packages 'helm-apt-installed-packages "1.5.1") +(defvaralias 'helm-c-apt-all-packages 'helm-apt-all-packages) +(make-obsolete-variable 'helm-c-apt-all-packages 'helm-apt-all-packages "1.5.1") +(defvaralias 'helm-c-find-files-doc-header 'helm-find-files-doc-header) +(make-obsolete-variable 'helm-c-find-files-doc-header 'helm-find-files-doc-header "1.5.1") +(defvaralias 'helm-c-source-imenu 'helm-source-imenu) +(make-obsolete-variable 'helm-c-source-imenu 'helm-source-imenu "1.5.1") +(defvaralias 'helm-c-grep-default-function 'helm-grep-default-function) +(make-obsolete-variable 'helm-c-grep-default-function 'helm-grep-default-function "1.5.1") +(defvaralias 'helm-c-top-command 'helm-top-command) +(make-obsolete-variable 'helm-c-top-command 'helm-top-command "1.5.1") +(defvaralias 'helm-c-source-bookmark-man 'helm-source-bookmark-man) +(make-obsolete-variable 'helm-c-source-bookmark-man 'helm-source-bookmark-man "1.5.1") +(defvaralias 'helm-c-source-stumpwm-commands 'helm-source-stumpwm-commands) +(make-obsolete-variable 'helm-c-source-stumpwm-commands 'helm-source-stumpwm-commands "1.5.1") +(defvaralias 'helm-c-source-idle-time-timers 'helm-source-idle-time-timers) +(make-obsolete-variable 'helm-c-source-idle-time-timers 'helm-source-idle-time-timers "1.5.1") +(defvaralias 'helm-c-turn-on-show-completion 'helm-turn-on-show-completion) +(make-obsolete-variable 'helm-c-turn-on-show-completion 'helm-turn-on-show-completion "1.5.1") +(defvaralias 'helm-c-esh-help-message 'helm-esh-help-message) +(make-obsolete-variable 'helm-c-esh-help-message 'helm-esh-help-message "1.5.1") +(defvaralias 'helm-c-register-max-offset 'helm-register-max-offset) +(make-obsolete-variable 'helm-c-register-max-offset 'helm-register-max-offset "1.5.1") +(defvaralias 'helm-c-source-bookmark-set 'helm-source-bookmark-set) +(make-obsolete-variable 'helm-c-source-bookmark-set 'helm-source-bookmark-set "1.5.1") +(defvaralias 'helm-c-source-file-name-history 'helm-source-file-name-history) +(make-obsolete-variable 'helm-c-source-file-name-history 'helm-source-file-name-history "1.5.1") +(defvaralias 'helm-c-file-cache-initialized-p 'helm-file-cache-initialized-p) +(make-obsolete-variable 'helm-c-file-cache-initialized-p 'helm-file-cache-initialized-p "1.5.1") +(defvaralias 'helm-c-grep-max-length-history 'helm-grep-max-length-history) +(make-obsolete-variable 'helm-c-grep-max-length-history 'helm-grep-max-length-history "1.5.1") +(defvaralias 'helm-c-source-jabber-contacts 'helm-source-jabber-contacts) +(make-obsolete-variable 'helm-c-source-jabber-contacts 'helm-source-jabber-contacts "1.5.1") +(defvaralias 'helm-c-grep-use-ioccur-style-keys 'helm-grep-use-ioccur-style-keys) +(make-obsolete-variable 'helm-c-grep-use-ioccur-style-keys 'helm-grep-use-ioccur-style-keys "1.5.1") +(defvaralias 'helm-c-ctags-modes 'helm-ctags-modes) +(make-obsolete-variable 'helm-c-ctags-modes 'helm-ctags-modes "1.5.1") +(defvaralias 'helm-c-source-moccur 'helm-source-moccur) +(make-obsolete-variable 'helm-c-source-moccur 'helm-source-moccur "1.5.1") +(defvaralias 'helm-c-locate-command 'helm-locate-command) +(make-obsolete-variable 'helm-c-locate-command 'helm-locate-command "1.5.1") +(defvaralias 'helm-c-etags-tag-file-name 'helm-etags-tag-file-name) +(make-obsolete-variable 'helm-c-etags-tag-file-name 'helm-etags-tag-file-name "1.5.1") +(defvaralias 'helm-c-source-bookmarks-su 'helm-source-bookmarks-su) +(make-obsolete-variable 'helm-c-source-bookmarks-su 'helm-source-bookmarks-su "1.5.1") +(defvaralias 'helm-c-buffer-map 'helm-buffer-map) +(make-obsolete-variable 'helm-c-buffer-map 'helm-buffer-map "1.5.1") +(defvaralias 'helm-c-source-files-in-all-dired 'helm-source-files-in-all-dired) +(make-obsolete-variable 'helm-c-source-files-in-all-dired 'helm-source-files-in-all-dired "1.5.1") +(defvaralias 'helm-c-source-eshell-history 'helm-source-eshell-history) +(make-obsolete-variable 'helm-c-source-eshell-history 'helm-source-eshell-history "1.5.1") +(defvaralias 'helm-c-source-absolute-time-timers 'helm-source-absolute-time-timers) +(make-obsolete-variable 'helm-c-source-absolute-time-timers 'helm-source-absolute-time-timers "1.5.1") +(defvaralias 'helm-c-source-findutils 'helm-source-findutils) +(make-obsolete-variable 'helm-c-source-findutils 'helm-source-findutils "1.5.1") +(defvaralias 'helm-c-ucs-help-message 'helm-ucs-help-message) +(make-obsolete-variable 'helm-c-ucs-help-message 'helm-ucs-help-message "1.5.1") +(defvaralias 'helm-c-source-find-files 'helm-source-find-files) +(make-obsolete-variable 'helm-c-source-find-files 'helm-source-find-files "1.5.1") +(defvaralias 'helm-c-source-recentf 'helm-source-recentf) +(make-obsolete-variable 'helm-c-source-recentf 'helm-source-recentf "1.5.1") +(defvaralias 'helm-c-cache-world 'helm-cache-world) +(make-obsolete-variable 'helm-c-cache-world 'helm-cache-world "1.5.1") +(defvaralias 'helm-c-source-picklist 'helm-source-picklist) +(make-obsolete-variable 'helm-c-source-picklist 'helm-source-picklist "1.5.1") +(defvaralias 'helm-c-source-buffer-not-found 'helm-source-buffer-not-found) +(make-obsolete-variable 'helm-c-source-buffer-not-found 'helm-source-buffer-not-found "1.5.1") +(defvaralias 'helm-c-source-xrandr-change-resolution 'helm-source-xrandr-change-resolution) +(make-obsolete-variable 'helm-c-source-xrandr-change-resolution 'helm-source-xrandr-change-resolution "1.5.1") +(defvaralias 'helm-c-google-suggest-url 'helm-google-suggest-url) +(make-obsolete-variable 'helm-c-google-suggest-url 'helm-google-suggest-url "1.5.1") +(defvaralias 'helm-c-source-semantic 'helm-source-semantic) +(make-obsolete-variable 'helm-c-source-semantic 'helm-source-semantic "1.5.1") +(defvaralias 'helm-c-source-mark-ring 'helm-source-mark-ring) +(make-obsolete-variable 'helm-c-source-mark-ring 'helm-source-mark-ring "1.5.1") +(defvaralias 'helm-c-grep-preferred-ext 'helm-grep-preferred-ext) +(make-obsolete-variable 'helm-c-grep-preferred-ext 'helm-grep-preferred-ext "1.5.1") +(defvaralias 'helm-c-source-bookmarks 'helm-source-bookmarks) +(make-obsolete-variable 'helm-c-source-bookmarks 'helm-source-bookmarks "1.5.1") +(defvaralias 'helm-c-source-elisp-library-scan 'helm-source-elisp-library-scan) +(make-obsolete-variable 'helm-c-source-elisp-library-scan 'helm-source-elisp-library-scan "1.5.1") +(defvaralias 'helm-c-source-info-pages 'helm-source-info-pages) +(make-obsolete-variable 'helm-c-source-info-pages 'helm-source-info-pages "1.5.1") +(defvaralias 'helm-c-source-bookmark-gnus 'helm-source-bookmark-gnus) +(make-obsolete-variable 'helm-c-source-bookmark-gnus 'helm-source-bookmark-gnus "1.5.1") +(defvaralias 'helm-c-source-elscreen 'helm-source-elscreen) +(make-obsolete-variable 'helm-c-source-elscreen 'helm-source-elscreen "1.5.1") +(defvaralias 'helm-c-etags-mtime-alist 'helm-etags-mtime-alist) +(make-obsolete-variable 'helm-c-etags-mtime-alist 'helm-etags-mtime-alist "1.5.1") +(defvaralias 'helm-c-grep-default-recurse-command 'helm-grep-default-recurse-command) +(make-obsolete-variable 'helm-c-grep-default-recurse-command 'helm-grep-default-recurse-command "1.5.1") +(defvaralias 'helm-c-source-google-suggest 'helm-source-google-suggest) +(make-obsolete-variable 'helm-c-source-google-suggest 'helm-source-google-suggest "1.5.1") +(defvaralias 'helm-c-etags-tag-file-search-limit 'helm-etags-tag-file-search-limit) +(make-obsolete-variable 'helm-c-etags-tag-file-search-limit 'helm-etags-tag-file-search-limit "1.5.1") +(defvaralias 'helm-c-source-ff-file-name-history 'helm-source-ff-file-name-history) +(make-obsolete-variable 'helm-c-source-ff-file-name-history 'helm-source-ff-file-name-history "1.5.1") +(defvaralias 'helm-c-source-buffers-list 'helm-source-buffers-list) +(make-obsolete-variable 'helm-c-source-buffers-list 'helm-source-buffers-list "1.5.1") +(defvaralias 'helm-c-cached-imenu-alist 'helm-cached-imenu-alist) +(make-obsolete-variable 'helm-c-cached-imenu-alist 'helm-cached-imenu-alist "1.5.1") +(defvaralias 'helm-c-source-tracker-search 'helm-source-tracker-search) +(make-obsolete-variable 'helm-c-source-tracker-search 'helm-source-tracker-search "1.5.1") +(defvaralias 'helm-c-google-suggest-default-function 'helm-google-suggest-default-function) +(make-obsolete-variable 'helm-c-google-suggest-default-function 'helm-google-suggest-default-function "1.5.1") +(defvaralias 'helm-c-imenu-delimiter 'helm-imenu-delimiter) +(make-obsolete-variable 'helm-c-imenu-delimiter 'helm-imenu-delimiter "1.5.1") +(defvaralias 'helm-c-source-emacs-process 'helm-source-emacs-process) +(make-obsolete-variable 'helm-c-source-emacs-process 'helm-source-emacs-process "1.5.1") +(defvaralias 'helm-c-etags-map 'helm-etags-map) +(make-obsolete-variable 'helm-c-etags-map 'helm-etags-map "1.5.1") +(defvaralias 'helm-c-grep-history 'helm-grep-history) +(make-obsolete-variable 'helm-c-grep-history 'helm-grep-history "1.5.1") +(defvaralias 'helm-c-cached-imenu-tick 'helm-cached-imenu-tick) +(make-obsolete-variable 'helm-c-cached-imenu-tick 'helm-cached-imenu-tick "1.5.1") +(defvaralias 'helm-c-source-esh 'helm-source-esh) +(make-obsolete-variable 'helm-c-source-esh 'helm-source-esh "1.5.1") +(defvaralias 'helm-c-source-global-mark-ring 'helm-source-global-mark-ring) +(make-obsolete-variable 'helm-c-source-global-mark-ring 'helm-source-global-mark-ring "1.5.1") +(defvaralias 'helm-c-man-pages 'helm-man-pages) +(make-obsolete-variable 'helm-c-man-pages 'helm-man-pages "1.5.1") +(defvaralias 'helm-c-adaptative-done 'helm-adaptive-done) +(make-obsolete-variable 'helm-c-adaptative-done 'helm-adaptive-done "1.5.1") +(defvaralias 'helm-c-source-regexp 'helm-source-regexp) +(make-obsolete-variable 'helm-c-source-regexp 'helm-source-regexp "1.5.1") +(defvaralias 'helm-c-boring-file-regexp-list 'helm-boring-file-regexp-list) +(make-obsolete-variable 'helm-c-boring-file-regexp-list 'helm-boring-file-regexp-list "1.5.1") +(defvaralias 'helm-c-show-completion-use-special-display 'helm-show-completion-use-special-display) +(make-obsolete-variable 'helm-c-show-completion-use-special-display 'helm-show-completion-use-special-display "1.5.1") +(defvaralias 'helm-c-apt-query 'helm-apt-query) +(make-obsolete-variable 'helm-c-apt-query 'helm-apt-query "1.5.1") +(defvaralias 'helm-c-pdfgrep-default-read-command 'helm-pdfgrep-default-read-command) +(make-obsolete-variable 'helm-c-pdfgrep-default-read-command 'helm-pdfgrep-default-read-command "1.5.1") +(defvaralias 'helm-c-source-bookmark-images 'helm-source-bookmark-images) +(make-obsolete-variable 'helm-c-source-bookmark-images 'helm-source-bookmark-images "1.5.1") +(defvaralias 'helm-c-source-mac-spotlight 'helm-source-mac-spotlight) +(make-obsolete-variable 'helm-c-source-mac-spotlight 'helm-source-mac-spotlight "1.5.1") +(defvaralias 'helm-c-yahoo-suggest-url 'helm-yahoo-suggest-url) +(make-obsolete-variable 'helm-c-yahoo-suggest-url 'helm-yahoo-suggest-url "1.5.1") +(defvaralias 'helm-c-zgrep-recurse-flag 'helm-zgrep-recurse-flag) +(make-obsolete-variable 'helm-c-zgrep-recurse-flag 'helm-zgrep-recurse-flag "1.5.1") +(defvaralias 'helm-c-source-use-flags 'helm-source-use-flags) +(make-obsolete-variable 'helm-c-source-use-flags 'helm-source-use-flags "1.5.1") +(defvaralias 'helm-c-moccur-map 'helm-moccur-map) +(make-obsolete-variable 'helm-c-moccur-map 'helm-moccur-map "1.5.1") +(defvaralias 'helm-c-adaptative-history-file 'helm-adaptive-history-file) +(make-obsolete-variable 'helm-c-adaptative-history-file 'helm-adaptive-history-file "1.5.1") +(defvaralias 'helm-c-grep-default-directory-fn 'helm-grep-default-directory-fn) +(make-obsolete-variable 'helm-c-grep-default-directory-fn 'helm-grep-default-directory-fn "1.5.1") +(defvaralias 'helm-c-apt-input-history 'helm-apt-input-history) +(make-obsolete-variable 'helm-c-apt-input-history 'helm-apt-input-history "1.5.1") +(defvaralias 'helm-async-be-async 'dired-async-be-async) +(make-obsolete-variable 'helm-async-be-async 'dired-async-be-async "1.5.9") + + +(provide 'helm-aliases) + +;;; helm-aliases.el ends here diff --git a/elpa/helm-20150426.2119/helm-apt.el b/elpa/helm-20150426.2119/helm-apt.el new file mode 100644 index 00000000..b667c5b3 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-apt.el @@ -0,0 +1,292 @@ +;;; helm-apt.el --- Helm interface for Debian/Ubuntu packages (apt-*) -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-utils) +(require 'helm-external) + +(declare-function term-line-mode "term") +(declare-function term-char-mode "term") +(declare-function term-send-input "term") +(declare-function term-send-eof "term") + + +(defgroup helm-apt nil + "Apt related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-apt-cache-show-function 'helm-apt-cache-show-1 + "Function of one argument used to show apt package. +Default is `helm-apt-cache-show-1' but you can use `apt-utils-show-package-1' +from `apt-utils.el' to have something more enhanced. +If nil default `helm-apt-cache-show-1' will be used." + :type 'function + :group 'helm-apt) + +(defface helm-apt-installed + '((t (:foreground "green"))) + "Face used for apt installed candidates." + :group 'helm-apt) + +(defface helm-apt-deinstalled + '((t (:foreground "DimGray"))) + "Face used for apt deinstalled candidates." + :group 'helm-apt) + + +(defvar helm-apt-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c ?") 'helm-apt-help) + (define-key map (kbd "M-I") 'helm-apt-show-only-installed) + (define-key map (kbd "M-U") 'helm-apt-show-only-not-installed) + (define-key map (kbd "M-D") 'helm-apt-show-only-deinstalled) + (define-key map (kbd "M-A") 'helm-apt-show-all) + map)) + + +(defvar helm-source-apt + `((name . "APT") + (init . helm-apt-init) + (candidates-in-buffer) + (candidate-transformer . helm-apt-candidate-transformer) + (display-to-real . helm-apt-display-to-real) + (update . helm-apt-refresh) + (keymap . ,helm-apt-map) + (mode-line . helm-apt-mode-line) + (action + ("Show package description" . helm-apt-cache-show) + ("Install package" . helm-apt-install) + ("Reinstall package" . helm-apt-reinstall) + ("Remove package" . helm-apt-uninstall) + ("Purge package" . helm-apt-purge)) + (persistent-action . helm-apt-persistent-action) + (persistent-help . "Show package description"))) + +;;; Internals vars +(defvar helm-apt-search-command "apt-cache search '%s'") +(defvar helm-apt-show-command "apt-cache show '%s'") +(defvar helm-apt-installed-packages nil) +(defvar helm-apt-all-packages nil) +(defvar helm-apt-input-history nil) +(defvar helm-apt-show-only 'all) +(defvar helm-apt-term-buffer nil) +(defvar helm-apt-default-archs nil) + +(defun helm-apt-refresh () + "Refresh installed candidates list." + (setq helm-apt-installed-packages nil) + (setq helm-apt-all-packages nil)) + +(defun helm-apt-persistent-action (candidate) + "Persistent action for APT source." + (helm-apt-cache-show candidate)) + +(defun helm-apt--installed-package-name (name) + (cl-loop for arch in helm-apt-default-archs + thereis (or (assoc-default + name helm-apt-installed-packages) + (assoc-default + (format "%s:%s" name arch) + helm-apt-installed-packages)))) + +(defun helm-apt-candidate-transformer (candidates) + "Show installed CANDIDATES and the ones to deinstall in a different color." + (cl-loop for cand in candidates + for name = (helm-apt-display-to-real cand) + for deinstall = (string= + (helm-apt--installed-package-name name) + "deinstall") + for install = (string= + (helm-apt--installed-package-name name) + "install") + for show = (cond ((and deinstall + (memq helm-apt-show-only '(all deinstalled))) + (propertize cand 'face 'helm-apt-deinstalled)) + ((and install + (memq helm-apt-show-only '(all installed))) + (propertize cand 'face 'helm-apt-installed)) + ((and (eq helm-apt-show-only 'noinstalled) + (not install)) cand) + ((eq helm-apt-show-only 'all) cand)) + when show collect show)) + +(defun helm-apt-show-only-installed () + (interactive) + (when helm-alive-p + (setq helm-apt-show-only 'installed) + (helm-update))) + +(defun helm-apt-show-only-not-installed () + (interactive) + (when helm-alive-p + (setq helm-apt-show-only 'noinstalled) + (helm-update))) + +(defun helm-apt-show-only-deinstalled () + (interactive) + (when helm-alive-p + (setq helm-apt-show-only 'deinstalled) + (helm-update))) + +(defun helm-apt-show-all () + (interactive) + (when helm-alive-p + (setq helm-apt-show-only 'all) + (helm-update))) + +(defun helm-apt-init () + "Initialize list of debian packages." + (let ((query "")) + (unless (and helm-apt-installed-packages + helm-apt-all-packages) + (message "Loading package list...") + (setq helm-apt-installed-packages + (with-temp-buffer + (call-process-shell-command "dpkg --get-selections" + nil (current-buffer)) + (cl-loop for i in (split-string (buffer-string) "\n" t) + for p = (split-string i) + collect (cons (car p) (cadr p))))) + (helm-init-candidates-in-buffer + 'global + (setq helm-apt-all-packages + (with-temp-buffer + (call-process-shell-command + (format helm-apt-search-command query) + nil (current-buffer)) + (buffer-string)))) + (message "Loading package list done") + (sit-for 0.5)))) + +(defun helm-apt-display-to-real (line) + "Return only name of a debian package. +LINE is displayed like: +package name - description." + (car (split-string line " - "))) + +(defvar helm-apt-show-current-package nil) +(define-derived-mode helm-apt-show-mode + special-mode "helm-apt-show" + "Mode to display infos on apt packages.") + +(defun helm-apt-cache-show (package) + "Show information on apt package PACKAGE." + (if (and (functionp helm-apt-cache-show-function) + (not (eq helm-apt-cache-show-function + 'helm-apt-cache-show))) + ;; A function, call it. + (funcall helm-apt-cache-show-function package) + ;; nil or whatever use default. + (helm-apt-cache-show-1 package))) + +(defun helm-apt-cache-show-1 (package) + (let* ((command (format helm-apt-show-command package)) + (buf (get-buffer-create "*helm apt show*"))) + (switch-to-buffer buf) + (unless (string= package helm-apt-show-current-package) + (let ((inhibit-read-only t)) + (erase-buffer) + (save-excursion + (call-process-shell-command + command nil (current-buffer) t)))) + (helm-apt-show-mode) + (set (make-local-variable 'helm-apt-show-current-package) + package))) + +(defun helm-apt-install (_package) + "Run 'apt-get install' shell command on PACKAGE." + (helm-apt-generic-action :action 'install)) + +(defun helm-apt-reinstall (_package) + "Run 'apt-get install --reinstall' shell command on PACKAGE." + (helm-apt-generic-action :action 'reinstall)) + +(defun helm-apt-uninstall (_package) + "Run 'apt-get remove' shell command on PACKAGE." + (helm-apt-generic-action :action 'uninstall)) + +(defun helm-apt-purge (_package) + "Run 'apt-get purge' shell command on PACKAGE." + (helm-apt-generic-action :action 'purge)) + +(cl-defun helm-apt-generic-action (&key action) + "Run 'apt-get ACTION'. +Support install, remove and purge actions." + (if (and helm-apt-term-buffer + (buffer-live-p (get-buffer helm-apt-term-buffer))) + (switch-to-buffer helm-apt-term-buffer) + (ansi-term (getenv "SHELL") "term apt") + (setq helm-apt-term-buffer (buffer-name))) + (term-line-mode) + (let ((command (cl-case action + (install "sudo apt-get install ") + (reinstall "sudo apt-get install --reinstall ") + (uninstall "sudo apt-get remove ") + (purge "sudo apt-get purge ") + (t (error "Unknown action")))) + (beg (point)) + end + (cand-list (mapconcat #'(lambda (x) (format "'%s'" x)) + (helm-marked-candidates) " "))) + (goto-char (point-max)) + (insert (concat command cand-list)) + (setq end (point)) + (if (y-or-n-p (format "%s package(s)" (symbol-name action))) + (progn + (setq helm-external-commands-list nil) + (setq helm-apt-installed-packages nil) + (term-char-mode) (term-send-input)) + (delete-region beg end)))) + +;;;###autoload +(defun helm-apt (arg) + "Preconfigured `helm' : frontend of APT package manager. +With a prefix arg reload cache." + (interactive "P") + (setq helm-apt-show-only 'all) + (unless helm-apt-default-archs + (setq helm-apt-default-archs + (append (split-string + (shell-command-to-string + "dpkg --print-architecture") + "\n" t) + (split-string + (shell-command-to-string + "dpkg --print-foreign-architectures") + "\n" t)))) + (let ((query (read-string "Search Package: " nil 'helm-apt-input-history))) + (when arg (helm-apt-refresh)) + (helm :sources 'helm-source-apt + :prompt "Search Package: " + :input query + :buffer "*helm apt*" + :history 'helm-apt-input-history))) + + +(provide 'helm-apt) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-apt.el ends here diff --git a/elpa/helm-20150426.2119/helm-autoloads.el b/elpa/helm-20150426.2119/helm-autoloads.el new file mode 100644 index 00000000..55c4fb3c --- /dev/null +++ b/elpa/helm-20150426.2119/helm-autoloads.el @@ -0,0 +1,1224 @@ +;;; helm-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "helm" "helm.el" (21822 2333 0 0)) +;;; Generated autoloads from helm.el + +(autoload 'helm-define-multi-key "helm" "\ +In KEYMAP, define key sequence KEY for function list FUNCTIONS. +Each function run sequentially each time the key KEY is pressed. +If DELAY is specified switch back to initial function of FUNCTIONS list +after DELAY seconds. +The functions in FUNCTIONS list are functions with no args. +e.g + (defun foo () + (message \"Run foo\")) + (defun bar () + (message \"Run bar\")) + (defun baz () + (message \"Run baz\")) + +\(helm-define-multi-key global-map \" q\" '(foo bar baz) 2) + +Each time \" q\" is pressed the next function is executed, if you wait +More than 2 seconds, next hit will run again the first function and so on. + +\(fn KEYMAP KEY FUNCTIONS &optional DELAY)" nil nil) + +(autoload 'helm-multi-key-defun "helm" "\ +Define NAME as a multi-key command running FUNS. +After DELAY seconds the FUNS list is reinitialised. +See `helm-define-multi-key'. + +\(fn NAME DOCSTRING FUNS &optional DELAY)" nil t) + +(put 'helm-multi-key-defun 'lisp-indent-function '2) + +(autoload 'helm-define-key-with-subkeys "helm" "\ +Allow defining in MAP a KEY and SUBKEY to COMMAND. + +This allow typing KEY to call COMMAND the first time and +type only SUBKEY on subsequent calls. + +Arg MAP is the keymap to use, SUBKEY is the initial short keybinding to +call COMMAND. + +Arg OTHER-SUBKEYS is an alist specifying other short keybindings +to use once started. +e.g: + +\(helm-define-key-with-subkeys global-map + (kbd \"C-x v n\") ?n 'git-gutter:next-hunk '((?p . git-gutter:previous-hunk))) + + +In this example, `C-x v n' will run `git-gutter:next-hunk' +subsequent hits on \"n\" will run this command again +and subsequent hits on \"p\" will run `git-gutter:previous-hunk'. + +Arg MENU is a string to display in minibuffer +to describe SUBKEY and OTHER-SUBKEYS. +Arg EXIT-FN specify a function to run on exit. + +Any other keys pressed run their assigned command defined in MAP +and exit the loop running EXIT-FN if specified. + +NOTE: SUBKEY and OTHER-SUBKEYS bindings support +only char syntax actually (e.g ?n) +so don't use strings, vectors or whatever to define them. + +\(fn MAP KEY SUBKEY COMMAND &optional OTHER-SUBKEYS MENU EXIT-FN)" nil nil) + +(put 'helm-define-key-with-subkeys 'lisp-indent-function '1) + +(autoload 'helm-debug-open-last-log "helm" "\ +Open helm log file of last helm session. +If `helm-last-log-file' is nil, switch to `helm-debug-buffer' . + +\(fn)" t nil) + +(autoload 'helm "helm" "\ +Main function to execute helm sources. + +Keywords supported: +:sources :input :prompt :resume :preselect +:buffer :keymap :default :history :allow-nest + +Extra LOCAL-VARS keywords are supported, see below. + +PLIST is a list like (:key1 val1 :key2 val2 ...) or +\(&optional sources input prompt resume + preselect buffer keymap default history). + +Basic keywords are the following: + +:sources + +A list of sources used for this session. It also accepts a +symbol, interpreted as a variable of a helm source +i.e (a symbol can be passed instead of a list of sources). +It also accepts an alist representing a helm source, which is +detected by (assq 'name ANY-SOURCES). +NOTE: In this case the source is embedded in the helm command and +have no symbol name, so it is not reachable from outside. +It will be referenced in `helm-sources' as a whole alist. + +:input + +Temporary value of `helm-pattern', ie. initial input of minibuffer. + +:prompt + +Prompt other than \"pattern: \". + +:resume + +If t, Resurrect previously instance of `helm'. Skip the initialization. +If 'noresume, this instance of `helm' cannot be resumed. + +:preselect + +Initially selected candidate. Specified by exact candidate or a regexp. + +:buffer + +`helm-buffer' instead of *helm*. + +:keymap + +`helm-map' for current `helm' session. + +:default + +A default argument that will be inserted in minibuffer with \\\\[next-history-element]. +When nil or not present `thing-at-point' will be used instead. +If `helm-maybe-use-default-as-input' is non--nil display will be +updated using :default arg as input unless :input is specified, +which in this case will take precedence on :default +This is a string or a list, in this case the car of the list will +be used as initial default input, but you will be able to cycle in this +list with \\\\[next-history-element]. + +:history + +By default all minibuffer input is pushed to `minibuffer-history', +if an argument HISTORY is provided, input will be pushed to HISTORY. +History element should be a symbol. + +:allow-nest + +Allow running this helm command within a running helm session. + +Of course, conventional arguments are supported, the two are same. + +\(helm :sources sources :input input :prompt prompt :resume resume + :preselect preselect :buffer buffer :keymap keymap :default default + :history history) + +and + +\(helm sources input prompt resume preselect buffer keymap default history) + +are the same. + +However the use of non keyword args is deprecated and should not be used. + +Other keywords are interpreted as local variables of this helm session. +The `helm-' prefix can be omitted. For example, + +\(helm :sources 'helm-source-buffers-list + :buffer \"*buffers*\" :candidate-number-limit 10) + +means starting helm session with `helm-source-buffers' +source in *buffers* buffer and set variable `helm-candidate-number-limit' +to 10 as session local variable. + +\(fn &key SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT HISTORY ALLOW-NEST OTHER-LOCAL-VARS)" nil nil) + +(autoload 'helm-other-buffer "helm" "\ +Simplified interface of `helm' with other `helm-buffer'. +Call `helm' with only ANY-SOURCES and ANY-BUFFER as args. + +\(fn ANY-SOURCES ANY-BUFFER)" nil nil) + +;;;*** + +;;;### (autoloads nil "helm-adaptive" "helm-adaptive.el" (21822 2333 +;;;;;; 0 0)) +;;; Generated autoloads from helm-adaptive.el + +(autoload 'helm-reset-adaptive-history "helm-adaptive" "\ +Delete all `helm-adaptive-history' and his file. +Useful when you have a old or corrupted `helm-adaptive-history-file'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-apt" "helm-apt.el" (21822 2333 0 0)) +;;; Generated autoloads from helm-apt.el + +(autoload 'helm-apt "helm-apt" "\ +Preconfigured `helm' : frontend of APT package manager. +With a prefix arg reload cache. + +\(fn ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-bookmark" "helm-bookmark.el" (21822 2333 +;;;;;; 0 0)) +;;; Generated autoloads from helm-bookmark.el + +(autoload 'helm-bookmarks "helm-bookmark" "\ +Preconfigured `helm' for bookmarks. + +\(fn)" t nil) + +(autoload 'helm-pp-bookmarks "helm-bookmark" "\ +Preconfigured `helm' for bookmarks (pretty-printed). + +\(fn)" t nil) + +(autoload 'helm-filtered-bookmarks "helm-bookmark" "\ +Preconfigured helm for bookmarks (filtered by category). +Optional source `helm-source-bookmark-addressbook' is loaded +only if external library addressbook-bookmark.el is available. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-buffers" "helm-buffers.el" (21822 2333 +;;;;;; 0 0)) +;;; Generated autoloads from helm-buffers.el + +(autoload 'helm-buffers-list "helm-buffers" "\ +Preconfigured `helm' to list buffers. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-color" "helm-color.el" (21822 2333 0 +;;;;;; 0)) +;;; Generated autoloads from helm-color.el + +(autoload 'helm-colors "helm-color" "\ +Preconfigured `helm' for color. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-command" "helm-command.el" (21822 2333 +;;;;;; 0 0)) +;;; Generated autoloads from helm-command.el + +(autoload 'helm-M-x "helm-command" "\ +Preconfigured `helm' for Emacs commands. +It is `helm' replacement of regular `M-x' `execute-extended-command'. + +Unlike regular `M-x' emacs vanilla `execute-extended-command' command, +the prefix args if needed, are passed AFTER starting `helm-M-x'. + +You can get help on each command by persistent action. + +\(fn ARG &optional COMMAND-NAME)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-config" "helm-config.el" (21822 2333 +;;;;;; 0 0)) +;;; Generated autoloads from helm-config.el + +(autoload 'helm-configuration "helm-config" "\ +Customize `helm'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-dabbrev" "helm-dabbrev.el" (21822 2333 +;;;;;; 0 0)) +;;; Generated autoloads from helm-dabbrev.el + +(autoload 'helm-dabbrev "helm-dabbrev" "\ + + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-elisp" "helm-elisp.el" (21822 2333 0 +;;;;;; 0)) +;;; Generated autoloads from helm-elisp.el + +(autoload 'helm-lisp-completion-at-point "helm-elisp" "\ +Helm lisp symbol completion at point. + +\(fn)" t nil) + +(autoload 'helm-complete-file-name-at-point "helm-elisp" "\ +Complete file name at point. + +\(fn &optional FORCE)" t nil) + +(autoload 'helm-lisp-indent "helm-elisp" "\ + + +\(fn)" t nil) + +(autoload 'helm-lisp-completion-or-file-name-at-point "helm-elisp" "\ +Complete lisp symbol or filename at point. +Filename completion happen if string start after or between a double quote. + +\(fn)" t nil) + +(autoload 'helm-apropos "helm-elisp" "\ +Preconfigured helm to describe commands, functions, variables and faces. + +\(fn)" t nil) + +(autoload 'helm-manage-advice "helm-elisp" "\ +Preconfigured `helm' to disable/enable function advices. + +\(fn)" t nil) + +(autoload 'helm-locate-library "helm-elisp" "\ + + +\(fn)" t nil) + +(autoload 'helm-timers "helm-elisp" "\ +Preconfigured `helm' for timers. + +\(fn)" t nil) + +(autoload 'helm-complex-command-history "helm-elisp" "\ + + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-elisp-package" "helm-elisp-package.el" +;;;;;; (21822 2333 0 0)) +;;; Generated autoloads from helm-elisp-package.el + +(autoload 'helm-list-elisp-packages "helm-elisp-package" "\ + + +\(fn ARG)" t nil) + +(autoload 'helm-list-elisp-packages-no-fetch "helm-elisp-package" "\ + + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-elscreen" "helm-elscreen.el" (21822 2333 +;;;;;; 0 0)) +;;; Generated autoloads from helm-elscreen.el + +(autoload 'helm-elscreen "helm-elscreen" "\ +Preconfigured helm to list elscreen. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-eshell" "helm-eshell.el" (21822 2333 +;;;;;; 0 0)) +;;; Generated autoloads from helm-eshell.el + +(autoload 'helm-esh-pcomplete "helm-eshell" "\ +Preconfigured helm to provide helm completion in eshell. + +\(fn)" t nil) + +(autoload 'helm-eshell-history "helm-eshell" "\ +Preconfigured helm for eshell history. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-eval" "helm-eval.el" (21822 2333 0 0)) +;;; Generated autoloads from helm-eval.el + +(autoload 'helm-eval-expression "helm-eval" "\ +Preconfigured helm for `helm-source-evaluation-result'. + +\(fn ARG)" t nil) + +(autoload 'helm-eval-expression-with-eldoc "helm-eval" "\ +Preconfigured helm for `helm-source-evaluation-result' with `eldoc' support. + +\(fn)" t nil) + +(autoload 'helm-calcul-expression "helm-eval" "\ +Preconfigured helm for `helm-source-calculation-result'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-external" "helm-external.el" (21822 2333 +;;;;;; 0 0)) +;;; Generated autoloads from helm-external.el + +(autoload 'helm-run-external-command "helm-external" "\ +Preconfigured `helm' to run External PROGRAM asyncronously from Emacs. +If program is already running exit with error. +You can set your own list of commands with +`helm-external-commands-list'. + +\(fn PROGRAM)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-files" "helm-files.el" (21822 2333 0 +;;;;;; 0)) +;;; Generated autoloads from helm-files.el + +(autoload 'helm-browse-project "helm-files" "\ +Browse files and see status of project with its vcs. +Only HG and GIT are supported for now. +Fall back to `helm-find-files' or `helm-browse-project-find-files' +if current directory is not under control of one of those vcs. +With a prefix ARG browse files recursively, with two prefix ARG +rebuild the cache. +If the current directory is found in the cache, start +`helm-browse-project-find-files' even with no prefix ARG. +NOTE: The prefix ARG have no effect on the VCS controlled directories. + +Needed dependencies for VCS: + +and +. + +\(fn ARG)" t nil) + +(autoload 'helm-find "helm-files" "\ +Preconfigured `helm' for the find shell command. + +\(fn ARG)" t nil) + +(autoload 'helm-find-files "helm-files" "\ +Preconfigured `helm' for helm implementation of `find-file'. +Called with a prefix arg show history if some. +Don't call it from programs, use `helm-find-files-1' instead. +This is the starting point for nearly all actions you can do on files. + +\(fn ARG)" t nil) + +(autoload 'helm-for-files "helm-files" "\ +Preconfigured `helm' for opening files. +Run all sources defined in `helm-for-files-preferred-list'. + +\(fn)" t nil) + +(autoload 'helm-multi-files "helm-files" "\ +Same as `helm-for-files' but allow toggling from locate to others sources. + +\(fn)" t nil) + +(autoload 'helm-recentf "helm-files" "\ +Preconfigured `helm' for `recentf'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-font" "helm-font.el" (21822 2333 0 0)) +;;; Generated autoloads from helm-font.el + +(autoload 'helm-select-xfont "helm-font" "\ +Preconfigured `helm' to select Xfont. + +\(fn)" t nil) + +(autoload 'helm-ucs "helm-font" "\ +Preconfigured helm for `ucs-names' math symbols. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-grep" "helm-grep.el" (21822 2333 0 0)) +;;; Generated autoloads from helm-grep.el + +(autoload 'helm-goto-precedent-file "helm-grep" "\ +Go to precedent file in helm grep/etags buffers. + +\(fn)" t nil) + +(autoload 'helm-goto-next-file "helm-grep" "\ +Go to precedent file in helm grep/etags buffers. + +\(fn)" t nil) + +(autoload 'helm-grep-run-save-buffer "helm-grep" "\ +Run grep save results action from `helm-do-grep-1'. + +\(fn)" t nil) + +(autoload 'helm-grep-mode "helm-grep" "\ +Major mode to provide actions in helm grep saved buffer. + +Special commands: +\\{helm-grep-mode-map} + +\(fn)" t nil) + +(autoload 'helm-gm-next-file "helm-grep" "\ + + +\(fn)" t nil) + +(autoload 'helm-gm-precedent-file "helm-grep" "\ + + +\(fn)" t nil) + +(autoload 'helm-grep-mode-jump "helm-grep" "\ + + +\(fn)" t nil) + +(autoload 'helm-grep-mode-jump-other-window-forward "helm-grep" "\ + + +\(fn)" t nil) + +(autoload 'helm-grep-mode-jump-other-window-backward "helm-grep" "\ + + +\(fn)" t nil) + +(autoload 'helm-grep-mode-jump-other-window "helm-grep" "\ + + +\(fn)" t nil) + +(autoload 'helm-do-grep "helm-grep" "\ +Preconfigured helm for grep. +Contrarily to Emacs `grep', no default directory is given, but +the full path of candidates in ONLY. +That allow to grep different files not only in `default-directory' but anywhere +by marking them (C-). If one or more directory is selected +grep will search in all files of these directories. +You can also use wildcard in the base name of candidate. +If a prefix arg is given use the -r option of grep (recurse). +The prefix arg can be passed before or after start file selection. +See also `helm-do-grep-1'. + +\(fn)" t nil) + +(autoload 'helm-do-zgrep "helm-grep" "\ +Preconfigured helm for zgrep. + +\(fn)" t nil) + +(autoload 'helm-do-pdfgrep "helm-grep" "\ +Preconfigured helm for pdfgrep. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-help" "helm-help.el" (21822 2333 0 0)) +;;; Generated autoloads from helm-help.el + +(autoload 'helm-documentation "helm-help" "\ +Helm documentation. +With a prefix arg refresh the documentation. + +Find here the documentation of all sources actually documented. + +\(fn ARG)" t nil) + +(autoload 'helm-help "helm-help" "\ +Help of `helm'. + +\(fn)" t nil) + +(autoload 'helm-buffer-help "helm-help" "\ +Help command for helm buffers. + +\(fn)" t nil) + +(autoload 'helm-ff-help "helm-help" "\ +Help command for `helm-find-files'. + +\(fn)" t nil) + +(autoload 'helm-read-file-name-help "helm-help" "\ + + +\(fn)" t nil) + +(autoload 'helm-generic-file-help "helm-help" "\ + + +\(fn)" t nil) + +(autoload 'helm-grep-help "helm-help" "\ + + +\(fn)" t nil) + +(autoload 'helm-pdfgrep-help "helm-help" "\ + + +\(fn)" t nil) + +(autoload 'helm-etags-help "helm-help" "\ +The help function for etags. + +\(fn)" t nil) + +(autoload 'helm-ucs-help "helm-help" "\ +Help command for `helm-ucs'. + +\(fn)" t nil) + +(autoload 'helm-bookmark-help "helm-help" "\ +Help command for bookmarks. + +\(fn)" t nil) + +(autoload 'helm-esh-help "helm-help" "\ +Help command for `helm-find-files-eshell-command-on-file'. + +\(fn)" t nil) + +(autoload 'helm-buffers-ido-virtual-help "helm-help" "\ +Help command for ido virtual buffers. + +\(fn)" t nil) + +(autoload 'helm-moccur-help "helm-help" "\ + + +\(fn)" t nil) + +(autoload 'helm-top-help "helm-help" "\ + + +\(fn)" t nil) + +(autoload 'helm-apt-help "helm-help" "\ + + +\(fn)" t nil) + +(autoload 'helm-el-package-help "helm-help" "\ + + +\(fn)" t nil) + +(autoload 'helm-M-x-help "helm-help" "\ + + +\(fn)" t nil) + +(autoload 'helm-imenu-help "helm-help" "\ + + +\(fn)" t nil) + +(autoload 'helm-color-help "helm-help" "\ + + +\(fn)" t nil) + +(autoload 'helm-semantic-help "helm-help" "\ + + +\(fn)" t nil) + +(autoload 'helm-kmacro-help "helm-help" "\ + + +\(fn)" t nil) + +(defvar helm-buffer-mode-line-string '("Buffer(s)" "\\\\[helm-buffer-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct" "String displayed in mode-line in `helm-source-buffers-list'")) + +(defvar helm-color-mode-line-string '("Colors" "\\\\[helm-color-help]:Help/\\[helm-color-run-insert-name]:Insert name/\\[helm-color-run-insert-rgb]:Insert RGB/with shift: Kill")) + +(defvar helm-buffers-ido-virtual-mode-line-string '("Killed Buffer(s)" "\\\\[helm-buffers-ido-virtual-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct" "String displayed in mode-line in `helm-source-buffers-list'")) + +(defvar helm-ff-mode-line-string "\\\\[helm-ff-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct" "\ +String displayed in mode-line in `helm-source-find-files'") + +(defvar helm-read-file-name-mode-line-string "\\\\[helm-read-file-name-help]:Help C/\\[helm-cr-empty-string]:Empty \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct" "\ +String displayed in mode-line in `helm-source-find-files'.") + +(defvar helm-generic-file-mode-line-string "\\\\[helm-generic-file-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend" "\ +String displayed in mode-line in Locate.") + +(defvar helm-grep-mode-line-string "\\\\[helm-grep-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend" "\ +String displayed in mode-line in `helm-do-grep'.") + +(defvar helm-pdfgrep-mode-line-string "\\\\[helm-pdfgrep-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend" "\ +String displayed in mode-line in `helm-do-pdfgrep'.") + +(defvar helm-etags-mode-line-string "\\\\[helm-etags-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct" "\ +String displayed in mode-line in `helm-etags-select'.") + +(defvar helm-ucs-mode-line-string "\\\\[helm-ucs-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct" "\ +String displayed in mode-line in `helm-ucs'.") + +(defvar helm-bookmark-mode-line-string '("Bookmark(s)" "\\\\[helm-bookmark-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct") "\ +String displayed in mode-line in `helm-source-buffers-list'") + +(defvar helm-occur-mode-line "\\\\[helm-help]:Help \\\\[helm-occur-run-query-replace-regexp]:Query replace regexp \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") + +(defvar helm-moccur-mode-line "\\\\[helm-moccur-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") + +(defvar helm-comp-read-mode-line "\\C/\\[helm-cr-empty-string]:Empty \\\\[helm-help]:Help \\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct") + +(defvar helm-top-mode-line "\\\\[helm-top-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") + +(defvar helm-apt-mode-line "\\\\[helm-apt-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") + +(defvar helm-el-package-mode-line "\\\\[helm-el-package-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") + +(defvar helm-M-x-mode-line "\\\\[helm-M-x-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") + +(defvar helm-imenu-mode-line "\\\\[helm-imenu-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") + +(defvar helm-semantic-mode-line "\\\\[helm-semantic-help]:Help \\\\[helm-select-action]:Act \\[helm-maybe-exit-minibuffer]/f1/f2/f-n:NthAct \\[helm-toggle-suspend-update]:Tog.suspend") + +(autoload 'helm-describe-helm-attribute "helm-help" "\ +Display the full documentation of HELM-ATTRIBUTE. +HELM-ATTRIBUTE should be a symbol. + +\(fn HELM-ATTRIBUTE)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-imenu" "helm-imenu.el" (21822 2333 0 +;;;;;; 0)) +;;; Generated autoloads from helm-imenu.el + +(autoload 'helm-imenu "helm-imenu" "\ +Preconfigured `helm' for `imenu'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-info" "helm-info.el" (21822 2333 0 0)) +;;; Generated autoloads from helm-info.el + +(autoload 'helm-info-at-point "helm-info" "\ +Preconfigured `helm' for searching info at point. +With a prefix-arg insert symbol at point. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-locate" "helm-locate.el" (21822 2333 +;;;;;; 0 0)) +;;; Generated autoloads from helm-locate.el + +(autoload 'helm-locate-read-file-name "helm-locate" "\ + + +\(fn PROMPT)" nil nil) + +(autoload 'helm-locate "helm-locate" "\ +Preconfigured `helm' for Locate. +Note: you can add locate options after entering pattern. +See 'man locate' for valid options and also `helm-locate-command'. + +You can specify a local database with prefix argument ARG. +With two prefix arg, refresh the current local db or create it +if it doesn't exists. +Many databases can be used: navigate and mark them. +See also `helm-locate-with-db'. + +To create a user specific db, use +\"updatedb -l 0 -o db_path -U directory\". +Where db_path is a filename matched by +`helm-locate-db-file-regexp'. + +\(fn ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-man" "helm-man.el" (21822 2333 0 0)) +;;; Generated autoloads from helm-man.el + +(autoload 'helm-man-woman "helm-man" "\ +Preconfigured `helm' for Man and Woman pages. +With a prefix arg reinitialize the cache. + +\(fn ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-misc" "helm-misc.el" (21822 2333 0 0)) +;;; Generated autoloads from helm-misc.el + +(autoload 'helm-browse-menubar "helm-misc" "\ +Helm interface to the menubar using lacarte.el. + +\(fn)" t nil) + +(autoload 'helm-world-time "helm-misc" "\ +Preconfigured `helm' to show world time. + +\(fn)" t nil) + +(autoload 'helm-insert-latex-math "helm-misc" "\ +Preconfigured helm for latex math symbols completion. + +\(fn)" t nil) + +(autoload 'helm-ratpoison-commands "helm-misc" "\ +Preconfigured `helm' to execute ratpoison commands. + +\(fn)" t nil) + +(autoload 'helm-stumpwm-commands "helm-misc" "\ + + +\(fn)" t nil) + +(autoload 'helm-mini "helm-misc" "\ +Preconfigured `helm' lightweight version (buffer -> recentf). + +\(fn)" t nil) + +(autoload 'helm-minibuffer-history "helm-misc" "\ +Preconfigured `helm' for `minibuffer-history'. + +\(fn)" t nil) + +(autoload 'helm-comint-input-ring "helm-misc" "\ +Predefined `helm' that provide completion of `comint' history. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-mode" "helm-mode.el" (21822 2333 0 0)) +;;; Generated autoloads from helm-mode.el + +(autoload 'helm-comp-read "helm-mode" "\ +Read a string in the minibuffer, with helm completion. + +It is helm `completing-read' equivalent. + +- PROMPT is the prompt name to use. + +- COLLECTION can be a list, vector, obarray or hash-table. + It can be also a function that receives three arguments: + the values string, predicate and t. See `all-completions' for more details. + +Keys description: + +- TEST: A predicate called with one arg i.e candidate. + +- INITIAL-INPUT: Same as input arg in `helm'. + +- PRESELECT: See preselect arg of `helm'. + +- DEFAULT: This option is used only for compatibility with regular + Emacs `completing-read' (Same as DEFAULT arg of `completing-read'). + +- BUFFER: Name of helm-buffer. + +- MUST-MATCH: Candidate selected must be one of COLLECTION. + +- REVERSE-HISTORY: When non--nil display history source after current + source completion. + +- REQUIRES-PATTERN: Same as helm attribute, default is 0. + +- HISTORY: A list containing specific history, default is nil. + When it is non--nil, all elements of HISTORY are displayed in + a special source before COLLECTION. + +- INPUT-HISTORY: A symbol. the minibuffer input history will be + stored there, if nil or not provided, `minibuffer-history' + will be used instead. + +- CASE-FOLD: Same as `helm-case-fold-search'. + +- DEL-INPUT: Boolean, when non--nil (default) remove the partial + minibuffer input from HISTORY is present. + +- PERSISTENT-ACTION: A function called with one arg i.e candidate. + +- PERSISTENT-HELP: A string to document PERSISTENT-ACTION. + +- MODE-LINE: A string or list to display in mode line. + Default is `helm-comp-read-mode-line'. + +- KEYMAP: A keymap to use in this `helm-comp-read'. + (the keymap will be shared with history source) + +- NAME: The name related to this local source. + +- EXEC-WHEN-ONLY-ONE: Bound `helm-execute-action-at-once-if-one' + to non--nil. (possibles values are t or nil). + +- VOLATILE: Use volatile attribute (enabled by default). + +- SORT: A predicate to give to `sort' e.g `string-lessp'. + +- FC-TRANSFORMER: A `filtered-candidate-transformer' function. + +- HIST-FC-TRANSFORMER: A `filtered-candidate-transformer' + function for the history source. + +- MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list. + +- NOMARK: When non--nil don't allow marking candidates. + +- ALISTP: (default is non--nil) See `helm-comp-read-get-candidates'. + +- CANDIDATES-IN-BUFFER: when non--nil use a source build with + `helm-candidates-in-buffer' which is much faster. + Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil. + +Any prefix args passed during `helm-comp-read' invocation will be recorded +in `helm-current-prefix-arg', otherwise if prefix args were given before +`helm-comp-read' invocation, the value of `current-prefix-arg' will be used. +That's mean you can pass prefix args before or after calling a command +that use `helm-comp-read' See `helm-M-x' for example. + +\(fn PROMPT COLLECTION &key TEST INITIAL-INPUT DEFAULT PRESELECT (buffer \"*Helm Completions*\") MUST-MATCH FUZZY REVERSE-HISTORY (requires-pattern 0) HISTORY INPUT-HISTORY (case-fold helm-comp-read-case-fold-search) (del-input t) (persistent-action nil) (persistent-help \"DoNothing\") (mode-line helm-comp-read-mode-line) (keymap helm-comp-read-map) (name \"Helm Completions\") CANDIDATES-IN-BUFFER EXEC-WHEN-ONLY-ONE QUIT-WHEN-NO-CAND (volatile t) SORT (fc-transformer (quote helm-cr-default-transformer)) HIST-FC-TRANSFORMER MARKED-CANDIDATES NOMARK (alistp t))" nil nil) + +(defvar helm-mode nil "\ +Non-nil if Helm mode is enabled. +See the command `helm-mode' for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `helm-mode'.") + +(custom-autoload 'helm-mode "helm-mode" nil) + +(autoload 'helm-mode "helm-mode" "\ +Toggle generic helm completion. + +All functions in Emacs that use `completing-read' +or `read-file-name' and friends will use helm interface +when this mode is turned on. +However you can modify this behavior for functions of your choice +with `helm-completing-read-handlers-alist'. + +Called with a positive arg, turn on unconditionally, with a +negative arg turn off. +You can turn it on with `helm-mode'. + +Some crap emacs functions may not be supported, +e.g `ffap-alternate-file' and maybe others +You can add such functions to `helm-completing-read-handlers-alist' +with a nil value. + +Note: This mode is incompatible with Emacs23. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-net" "helm-net.el" (21822 2333 0 0)) +;;; Generated autoloads from helm-net.el + +(autoload 'helm-surfraw "helm-net" "\ +Preconfigured `helm' to search PATTERN with search ENGINE. + +\(fn PATTERN ENGINE)" t nil) + +(autoload 'helm-google-suggest "helm-net" "\ +Preconfigured `helm' for google search with google suggest. + +\(fn)" t nil) + +(autoload 'helm-yahoo-suggest "helm-net" "\ +Preconfigured `helm' for Yahoo searching with Yahoo suggest. + +\(fn)" t nil) + +(autoload 'helm-wikipedia-suggest "helm-net" "\ +Preconfigured `helm' for Wikipedia lookup with Wikipedia suggest. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-org" "helm-org.el" (21822 2333 0 0)) +;;; Generated autoloads from helm-org.el + +(autoload 'helm-org-agenda-files-headings "helm-org" "\ + + +\(fn)" t nil) + +(autoload 'helm-org-in-buffer-headings "helm-org" "\ + + +\(fn)" t nil) + +(autoload 'helm-org-capture-templates "helm-org" "\ + + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-regexp" "helm-regexp.el" (21822 2333 +;;;;;; 0 0)) +;;; Generated autoloads from helm-regexp.el + +(autoload 'helm-moccur-run-save-buffer "helm-regexp" "\ +Run grep save results action from `helm-do-grep-1'. + +\(fn)" t nil) + +(autoload 'helm-moccur-mode "helm-regexp" "\ +Major mode to provide actions in helm moccur saved buffer. + +Special commands: +\\{helm-moccur-mode-map} + +\(fn)" t nil) + +(autoload 'helm-regexp "helm-regexp" "\ +Preconfigured helm to build regexps. +`query-replace-regexp' can be run from there against found regexp. + +\(fn)" t nil) + +(autoload 'helm-occur "helm-regexp" "\ +Preconfigured helm for Occur. + +\(fn)" t nil) + +(autoload 'helm-occur-from-isearch "helm-regexp" "\ +Invoke `helm-occur' from isearch. + +\(fn)" t nil) + +(autoload 'helm-multi-occur "helm-regexp" "\ +Preconfigured helm for multi occur. + + BUFFERS is a list of buffers to search through. +With a prefix arg, reverse the behavior of +`helm-moccur-always-search-in-current'. +The prefix arg can be set before calling `helm-multi-occur' +or during the buffer selection. + +\(fn BUFFERS)" t nil) + +(autoload 'helm-multi-occur-from-isearch "helm-regexp" "\ +Invoke `helm-multi-occur' from isearch. + +With a prefix arg, reverse the behavior of +`helm-moccur-always-search-in-current'. +The prefix arg can be set before calling +`helm-multi-occur-from-isearch' or during the buffer selection. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-ring" "helm-ring.el" (21822 2333 0 0)) +;;; Generated autoloads from helm-ring.el + +(autoload 'helm-mark-ring "helm-ring" "\ +Preconfigured `helm' for `helm-source-mark-ring'. + +\(fn)" t nil) + +(autoload 'helm-global-mark-ring "helm-ring" "\ +Preconfigured `helm' for `helm-source-global-mark-ring'. + +\(fn)" t nil) + +(autoload 'helm-all-mark-rings "helm-ring" "\ +Preconfigured `helm' for `helm-source-global-mark-ring' and `helm-source-mark-ring'. + +\(fn)" t nil) + +(autoload 'helm-register "helm-ring" "\ +Preconfigured `helm' for Emacs registers. + +\(fn)" t nil) + +(autoload 'helm-show-kill-ring "helm-ring" "\ +Preconfigured `helm' for `kill-ring'. +It is drop-in replacement of `yank-pop'. + +First call open the kill-ring browser, next calls move to next line. + +\(fn)" t nil) + +(autoload 'helm-execute-kmacro "helm-ring" "\ +Keyboard macros with helm interface. +Define your macros with `f3' and `f4'. +See (info \"(emacs) Keyboard Macros\") for detailed infos. +This command is useful when used with persistent action. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-semantic" "helm-semantic.el" (21822 2333 +;;;;;; 0 0)) +;;; Generated autoloads from helm-semantic.el + +(autoload 'helm-semantic "helm-semantic" "\ +Preconfigured `helm' for `semantic'. +If ARG is supplied, pre-select symbol at point instead of current + +\(fn ARG)" t nil) + +(autoload 'helm-semantic-or-imenu "helm-semantic" "\ +Run `helm' with `semantic' or `imenu'. +If ARG is supplied, pre-select symbol at point instead of current +semantic tag in scope. + +If `semantic-mode' is active in the current buffer, then use +semantic for generating tags, otherwise fall back to `imenu'. +Fill in the symbol at point by default. + +\(fn ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-sys" "helm-sys.el" (21822 2333 0 0)) +;;; Generated autoloads from helm-sys.el + +(autoload 'helm-top "helm-sys" "\ +Preconfigured `helm' for top command. + +\(fn)" t nil) + +(autoload 'helm-list-emacs-process "helm-sys" "\ +Preconfigured `helm' for emacs process. + +\(fn)" t nil) + +(autoload 'helm-xrandr-set "helm-sys" "\ + + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-tags" "helm-tags.el" (21822 2333 0 0)) +;;; Generated autoloads from helm-tags.el + +(autoload 'helm-etags-select "helm-tags" "\ +Preconfigured helm for etags. +If called with a prefix argument or if any of the tag files have +been modified, reinitialize cache. + +This function aggregates three sources of tag files: + + 1) An automatically located file in the parent directories, by `helm-etags-get-tag-file'. + 2) `tags-file-name', which is commonly set by `find-tag' command. + 3) `tags-table-list' which is commonly set by `visit-tags-table' command. + +\(fn ARG)" t nil) + +;;;*** + +;;;### (autoloads nil "helm-utils" "helm-utils.el" (21822 2333 0 +;;;;;; 0)) +;;; Generated autoloads from helm-utils.el + +(autoload 'helm-show-all-in-this-source-only "helm-utils" "\ +Show only current source of this helm session with all its candidates. +With a numeric prefix arg show only the ARG number of candidates. + +\(fn ARG)" t nil) + +(autoload 'helm-display-all-sources "helm-utils" "\ +Display all sources previously hidden by `helm-set-source-filter'. + +\(fn)" t nil) + +(autoload 'helm-quit-and-find-file "helm-utils" "\ +Drop into `helm-find-files' from `helm'. +If current selection is a buffer or a file, `helm-find-files' +from its directory. + +\(fn)" t nil) + +(autoload 'helm-w32-shell-execute-open-file "helm-utils" "\ + + +\(fn FILE)" t nil) + +(autoload 'helm-yank-text-at-point "helm-utils" "\ +Yank text at point in `helm-current-buffer' into minibuffer. +If `helm-yank-symbol-first' is non--nil the first yank +grabs the entire symbol. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("helm-aliases.el" "helm-match-plugin.el" +;;;;;; "helm-pkg.el" "helm-plugin.el" "helm-source.el") (21822 3132 +;;;;;; 761426 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; helm-autoloads.el ends here diff --git a/elpa/helm-20150426.2119/helm-bookmark.el b/elpa/helm-20150426.2119/helm-bookmark.el new file mode 100644 index 00000000..5b5efe2b --- /dev/null +++ b/elpa/helm-20150426.2119/helm-bookmark.el @@ -0,0 +1,793 @@ +;;; helm-bookmark.el --- Helm for Emacs regular Bookmarks. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: +(require 'cl-lib) +(require 'bookmark) +(require 'helm) +(require 'helm-utils) +(require 'helm-info) +(require 'helm-adaptive) +(require 'helm-net) + +(declare-function addressbook-bookmark-edit "ext:addressbook-bookmark.el" (bookmark)) +(declare-function message-buffers "message.el") +(declare-function addressbook-set-mail-buffer-1 "ext:addressbook-bookmark.el" + (&optional bookmark-name append cc)) + + +(defgroup helm-bookmark nil + "Predefined configurations for `helm.el'." + :group 'helm) + +(defcustom helm-bookmark-show-location nil + "Show location of bookmark on display." + :group 'helm-bookmark + :type 'boolean) + +(defcustom helm-bookmark-default-filtered-sources + (append '(helm-source-bookmark-files&dirs + helm-source-bookmark-helm-find-files + helm-source-bookmark-info + helm-source-bookmark-gnus + helm-source-bookmark-man + helm-source-bookmark-images + helm-source-bookmark-w3m) + (and (locate-library "addressbook-bookmark") + (list 'helm-source-bookmark-addressbook)) + (list 'helm-source-bookmark-uncategorized + 'helm-source-bookmark-set)) + "List of sources to use in `helm-filtered-bookmarks'." + :group 'helm-bookmark + :type '(repeat (choice symbol))) + + +(defface helm-bookmark-info + '((t (:foreground "green"))) + "Face used for W3m Emacs bookmarks (not w3m bookmarks)." + :group 'helm-bookmark) + +(defface helm-bookmark-w3m + '((t (:foreground "yellow"))) + "Face used for W3m Emacs bookmarks (not w3m bookmarks)." + :group 'helm-bookmark) + +(defface helm-bookmark-gnus + '((t (:foreground "magenta"))) + "Face used for Gnus bookmarks." + :group 'helm-bookmark) + +(defface helm-bookmark-man + '((t (:foreground "Orange4"))) + "Face used for Woman/man bookmarks." + :group 'helm-bookmark) + +(defface helm-bookmark-file + '((t (:foreground "Deepskyblue2"))) + "Face used for file bookmarks." + :group 'helm-bookmark) + +(defface helm-bookmark-directory + '((t (:inherit helm-ff-directory))) + "Face used for file bookmarks." + :group 'helm-bookmark) + +(defface helm-bookmark-addressbook + '((t (:foreground "tomato"))) + "Face used for addressbook bookmarks." + :group 'helm-bookmark) + + +(defvar helm-bookmark-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c o") 'helm-bookmark-run-jump-other-window) + (define-key map (kbd "C-d") 'helm-bookmark-run-delete) + (define-key map (kbd "C-]") 'helm-bookmark-toggle-filename) + (define-key map (kbd "M-e") 'helm-bookmark-run-edit) + (define-key map (kbd "C-c ?") 'helm-bookmark-help) + map) + "Generic Keymap for emacs bookmark sources.") + +(defclass helm-source-basic-bookmarks (helm-source-in-buffer helm-type-bookmark) + ((init :initform (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global + (bookmark-all-names)))) + (filtered-candidate-transformer :initform 'helm-bookmark-transformer) + (search :initform 'helm-bookmark-search-fn))) + +(defvar helm-source-bookmarks + (helm-make-source "Bookmarks" 'helm-source-basic-bookmarks) + "See (info \"(emacs)Bookmarks\").") + +(defun helm-bookmark-transformer (candidates _source) + (cl-loop for i in candidates + for loc = (bookmark-location i) + for len = (string-width i) + for trunc = (if (> len bookmark-bmenu-file-column) + (helm-substring i bookmark-bmenu-file-column) + i) + for sep = (make-string (- (+ bookmark-bmenu-file-column 2) + (length trunc)) + ? ) + if helm-bookmark-show-location + collect (cons (concat trunc sep (if (listp loc) (car loc) loc)) i) + else collect i)) + +(defun helm-bookmark-match-fn (candidate) + "Match function for bookmark sources using `candidates'." + (if helm-bookmark-show-location + ;; match only location, match-plugin will match also name. + (string-match helm-pattern (bookmark-location candidate)) + (string-match helm-pattern candidate))) + +(defun helm-bookmark-toggle-filename-1 (_candidate) + (let* ((real (helm-get-selection helm-buffer)) + (trunc (if (> (string-width real) bookmark-bmenu-file-column) + (helm-substring real bookmark-bmenu-file-column) + real)) + (loc (bookmark-location real))) + (setq helm-bookmark-show-location (not helm-bookmark-show-location)) + (helm-force-update (if helm-bookmark-show-location + (concat (regexp-quote trunc) + " +" + (regexp-quote + (if (listp loc) (car loc) loc))) + real)))) + +(defun helm-bookmark-toggle-filename () + "Toggle bookmark location visibility." + (interactive) + (with-helm-alive-p + (helm-attrset 'toggle-filename + '(helm-bookmark-toggle-filename-1 . never-split)) + (helm-execute-persistent-action 'toggle-filename))) + +(defun helm-bookmark-jump (candidate) + "Jump to bookmark from keyboard." + (let ((current-prefix-arg helm-current-prefix-arg) + non-essential) + (bookmark-jump candidate))) + +(defun helm-bookmark-jump-other-window (candidate) + (let (non-essential) + (bookmark-jump-other-window candidate))) + + +;;; bookmark-set +;; +(defvar helm-source-bookmark-set + '((name . "Set Bookmark") + (dummy) + (action . bookmark-set)) + "See (info \"(emacs)Bookmarks\").") + + +;;; Colorize bookmarks by category +;; +(defvar helm-source-pp-bookmarks + '((name . "PP-Bookmarks") + (init . (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (cl-loop for b in (bookmark-all-names) collect + (propertize b 'location (bookmark-location b)))))) + (candidates-in-buffer) + (search helm-bookmark-search-fn) + (match-part . helm-pp-bookmark-match-fn) + (filtered-candidate-transformer + helm-adaptive-sort + helm-highlight-bookmark) + (type . bookmark)) + "See (info \"(emacs)Bookmarks\").") + +(defun helm-bookmark-search-fn (pattern) + "Search function for bookmark sources using `candidates-in-buffer'. +Should be used with `helm-pp-bookmark-match-fn' as `match-part' function." + (if helm-bookmark-show-location + (helm-aif (next-single-property-change (point) 'location) + (goto-char it)) + (re-search-forward pattern nil t))) + +(defun helm-pp-bookmark-match-fn (candidate) + "Search function for bookmark sources using `candidates-in-buffer'. +Should be used with `helm-bookmark-search-fn' as `search' function." + (helm-aif (and helm-bookmark-show-location + (bookmark-location candidate)) + ;; Match against bookmark-name and location. + (concat candidate " " it) + ;; Match against bookmark-name. + candidate)) + + +;;; Predicates +;; +(defconst helm-bookmark--non-file-filename " - no file -" + "Name to use for `filename' entry, for non-file bookmarks.") + +(defun helm-bookmark-gnus-bookmark-p (bookmark) + "Return non-nil if BOOKMARK is a Gnus bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-gnus) + (eq (bookmark-get-handler bookmark) 'gnus-summary-bookmark-jump) + (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-gnus))) + +(defun helm-bookmark-w3m-bookmark-p (bookmark) + "Return non-nil if BOOKMARK is a W3m bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-w3m) + (eq (bookmark-get-handler bookmark) 'bookmark-w3m-bookmark-jump) + (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-w3m))) + +(defun helm-bookmark-woman-bookmark-p (bookmark) + "Return non-nil if BOOKMARK is a Woman bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-woman) + (eq (bookmark-get-handler bookmark) 'woman-bookmark-jump) + (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-woman))) + +(defun helm-bookmark-man-bookmark-p (bookmark) + "Return non-nil if BOOKMARK is a Man bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (or (eq (bookmark-get-handler bookmark) 'bmkext-jump-man) + (eq (bookmark-get-handler bookmark) 'Man-bookmark-jump) + (eq (bookmark-get-handler bookmark) 'bookmarkp-jump-man))) + +(defun helm-bookmark-woman-man-bookmark-p (bookmark) + "Return non-nil if BOOKMARK is a Man or Woman bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (or (helm-bookmark-man-bookmark-p bookmark) + (helm-bookmark-woman-bookmark-p bookmark))) + +(defun helm-bookmark-info-bookmark-p (bookmark) + "Return non-nil if BOOKMARK is an Info bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (eq (bookmark-get-handler bookmark) 'Info-bookmark-jump)) + +(defun helm-bookmark-image-bookmark-p (bookmark) + "Return non-nil if BOOKMARK bookmarks an image file." + (if (stringp bookmark) + (assoc 'image-type (assoc bookmark bookmark-alist)) + (assoc 'image-type bookmark))) + +(defun helm-bookmark-file-p (bookmark) + "Return non-nil if BOOKMARK bookmarks a file or directory. +BOOKMARK is a bookmark name or a bookmark record. +This excludes bookmarks of a more specific kind (Info, Gnus, and W3m)." + (let* ((filename (bookmark-get-filename bookmark)) + (isnonfile (equal filename helm-bookmark--non-file-filename))) + (and filename (not isnonfile) (not (bookmark-get-handler bookmark))))) + +(defun helm-bookmark-helm-find-files-p (bookmark) + "Return non-nil if BOOKMARK bookmarks a `helm-find-files' session. +BOOKMARK is a bookmark name or a bookmark record." + (eq (bookmark-get-handler bookmark) 'helm-ff-bookmark-jump)) + +(defun helm-bookmark-addressbook-p (bookmark) + "Return non--nil if BOOKMARK is a contact recorded with addressbook-bookmark. +BOOKMARK is a bookmark name or a bookmark record." + (if (listp bookmark) + (string= (assoc-default 'type bookmark) "addressbook") + (string= (assoc-default + 'type (assoc bookmark bookmark-alist)) "addressbook"))) + +(defun helm-bookmark-uncategorized-bookmark-p (bookmark) + "Return non--nil if BOOKMARK match no known category." + (cl-loop for pred in '(helm-bookmark-addressbook-p + helm-bookmark-gnus-bookmark-p + helm-bookmark-w3m-bookmark-p + helm-bookmark-woman-man-bookmark-p + helm-bookmark-info-bookmark-p + helm-bookmark-image-bookmark-p + helm-bookmark-file-p + helm-bookmark-helm-find-files-p + helm-bookmark-addressbook-p) + never (funcall pred bookmark))) + +(defun helm-bookmark-filter-setup-alist (fn) + "Return a filtered `bookmark-alist' sorted alphabetically." + (cl-loop with alist = (cl-loop for b in bookmark-alist + when (funcall fn b) collect b) + for bmk in alist + for name = (car bmk) + collect (propertize name 'location (bookmark-location name)))) + + +;;; Bookmark handlers +;; +(defvar w3m-async-exec) +(defun helm-bookmark-jump-w3m (bookmark) + "Jump to W3m bookmark BOOKMARK, setting a new tab. +If `browse-url-browser-function' is set to something else +than `w3m-browse-url' use it." + (require 'helm-net) + (let ((file (or (bookmark-prop-get bookmark 'filename) + (bookmark-prop-get bookmark 'url))) + (buf (generate-new-buffer-name "*w3m*")) + (w3m-async-exec nil) + (really-use-w3m (equal browse-url-browser-function 'w3m-browse-url))) + (helm-browse-url file really-use-w3m) + (when really-use-w3m + (bookmark-default-handler + `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bookmark)))))) + +;; All bookmarks recorded with the handler provided with w3m +;; (`bookmark-w3m-bookmark-jump') will use our handler which open +;; the bookmark in a new tab or in an external browser depending +;; on `browse-url-browser-function'. +(defalias 'bookmark-w3m-bookmark-jump 'helm-bookmark-jump-w3m) + +;; Provide compatibility with old handlers provided in external +;; packages bookmark-extensions.el and bookmark+. +(defalias 'bmkext-jump-woman 'woman-bookmark-jump) +(defalias 'bmkext-jump-man 'Man-bookmark-jump) +(defalias 'bmkext-jump-w3m 'helm-bookmark-jump-w3m) +(defalias 'bmkext-jump-gnus 'gnus-summary-bookmark-jump) +(defalias 'bookmarkp-jump-gnus 'gnus-summary-bookmark-jump) +(defalias 'bookmarkp-jump-w3m 'helm-bookmark-jump-w3m) +(defalias 'bookmarkp-jump-woman 'woman-bookmark-jump) +(defalias 'bookmarkp-jump-man 'Man-bookmark-jump) + + +;;;; Filtered bookmark sources +;; +;; +(defclass helm-source-filtered-bookmarks (helm-source-in-buffer helm-type-bookmark) + ((search :initform #'helm-bookmark-search-fn) + (match-part :initform #'helm-pp-bookmark-match-fn) + (filtered-candidate-transformer + :initform '(helm-adaptive-sort + helm-highlight-bookmark)))) + +;;; W3m bookmarks. +;; +(defun helm-bookmark-w3m-setup-alist () + "Specialized filter function for bookmarks w3m." + (helm-bookmark-filter-setup-alist 'helm-bookmark-w3m-bookmark-p)) + +(defvar helm-source-bookmark-w3m + (helm-make-source "Bookmark W3m" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-w3m-setup-alist))))) + +;;; Images +;; +(defun helm-bookmark-images-setup-alist () + "Specialized filter function for images bookmarks." + (helm-bookmark-filter-setup-alist 'helm-bookmark-image-bookmark-p)) + +(defvar helm-source-bookmark-images + (helm-make-source "Bookmark Images" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-images-setup-alist))))) + +;;; Woman Man +;; +(defun helm-bookmark-man-setup-alist () + "Specialized filter function for bookmarks w3m." + (helm-bookmark-filter-setup-alist 'helm-bookmark-woman-man-bookmark-p)) + +(defvar helm-source-bookmark-man + (helm-make-source "Bookmark Woman&Man" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-man-setup-alist))))) + +;;; Gnus +;; +(defun helm-bookmark-gnus-setup-alist () + "Specialized filter function for bookmarks gnus." + (helm-bookmark-filter-setup-alist 'helm-bookmark-gnus-bookmark-p)) + +(defvar helm-source-bookmark-gnus + (helm-make-source "Bookmark Gnus" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-gnus-setup-alist))))) + +;;; Info +;; +(defun helm-bookmark-info-setup-alist () + "Specialized filter function for bookmarks info." + (helm-bookmark-filter-setup-alist 'helm-bookmark-info-bookmark-p)) + +(defvar helm-source-bookmark-info + (helm-make-source "Bookmark Info" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-info-setup-alist))))) + +;;; Files and directories +;; +(defun helm-bookmark-local-files-setup-alist () + "Specialized filter function for bookmarks locals files." + (helm-bookmark-filter-setup-alist 'helm-bookmark-file-p)) + +(defvar helm-source-bookmark-files&dirs + (helm-make-source "Bookmark Files&Directories" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-local-files-setup-alist))))) + +;;; Helm find files sessions. +;; +(defun helm-bookmark-helm-find-files-setup-alist () + "Specialized filter function for `helm-find-files' bookmarks." + (helm-bookmark-filter-setup-alist 'helm-bookmark-helm-find-files-p)) + +(defvar helm-source-bookmark-helm-find-files + (helm-make-source "Bookmark helm-find-files sessions" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-helm-find-files-setup-alist))))) + +;;; Uncategorized bookmarks +;; +(defun helm-bookmark-uncategorized-setup-alist () + "Specialized filter function for uncategorized bookmarks." + (helm-bookmark-filter-setup-alist 'helm-bookmark-uncategorized-bookmark-p)) + +(defvar helm-source-bookmark-uncategorized + (helm-make-source "Bookmark uncategorized" 'helm-source-filtered-bookmarks + :init (lambda () + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global (helm-bookmark-uncategorized-setup-alist))))) + +;;; Addressbook. +;; +;; +(defclass helm-bookmark-addressbook-class (helm-source-in-buffer) + ((init :initform (lambda () + (require 'addressbook-bookmark nil t) + (bookmark-maybe-load-default-file) + (helm-init-candidates-in-buffer + 'global + (helm-bookmark-addressbook-setup-alist)))) + (search :initform #'helm-bookmark-search-fn) + (match-part :initform #'helm-pp-bookmark-match-fn) + (persistent-action :initform + (lambda (candidate) + (let ((bmk (helm-bookmark-get-bookmark-from-name + candidate))) + (bookmark--jump-via bmk 'switch-to-buffer)))) + (persistent-help :initform "Show contact - Prefix with C-u to append") + (filtered-candidate-transformer :initform + '(helm-adaptive-sort + helm-highlight-bookmark)) + (action :initform (("Show Contact(s)" + . (lambda (candidate) + (let* ((contacts (helm-marked-candidates)) + (current-prefix-arg helm-current-prefix-arg)) + (bookmark-jump + (helm-bookmark-get-bookmark-from-name (car contacts))) + (helm-aif (cdr contacts) + (let ((current-prefix-arg '(4))) + (cl-loop for bmk in it do + (bookmark-jump + (helm-bookmark-get-bookmark-from-name bmk)))))))) + ("Mail To" . helm-bookmark-addressbook-send-mail-1) + ("Mail Cc" . (lambda (_candidate) + (helm-bookmark-addressbook-send-mail-1 nil 'cc))) + ("Mail Bcc" . (lambda (_candidate) + (helm-bookmark-addressbook-send-mail-1 nil 'bcc))) + ("Edit Bookmark" + . (lambda (candidate) + (let ((bmk (helm-bookmark-get-bookmark-from-name + candidate))) + (addressbook-bookmark-edit + (assoc bmk bookmark-alist))))) + ("Delete bookmark(s)" . helm-delete-marked-bookmarks) + ("Insert Email at point" + . (lambda (candidate) + (let* ((bmk (helm-bookmark-get-bookmark-from-name + candidate)) + (mlist (split-string + (assoc-default + 'email (assoc bmk bookmark-alist)) + ", "))) + (insert + (if (> (length mlist) 1) + (helm-comp-read + "Insert Mail Address: " mlist :must-match t) + (car mlist)))))) + ("Show annotation" + . (lambda (candidate) + (let ((bmk (helm-bookmark-get-bookmark-from-name + candidate))) + (bookmark-show-annotation bmk)))) + ("Edit annotation" + . (lambda (candidate) + (let ((bmk (helm-bookmark-get-bookmark-from-name + candidate))) + (bookmark-edit-annotation bmk)))) + ("Show Google map" + . (lambda (candidate) + (let* ((bmk (helm-bookmark-get-bookmark-from-name + candidate)) + (full-bmk (assoc bmk bookmark-alist))) + (addressbook-google-map full-bmk)))))))) + +(defun helm-bookmark-addressbook-send-mail-1 (_candidate &optional cc) + (let* ((contacts (helm-marked-candidates)) + (bookmark (helm-bookmark-get-bookmark-from-name + (car contacts))) + (append (message-buffers))) + (addressbook-set-mail-buffer-1 bookmark append) + (helm-aif (cdr contacts) + (progn + (when cc (addressbook-set-mail-buffer-1 (car it) nil cc)) + (cl-loop for bmk in (cdr it) do + (addressbook-set-mail-buffer-1 + (helm-bookmark-get-bookmark-from-name bmk) 'append cc)))))) + +(defun helm-bookmark-addressbook-setup-alist () + "Specialized filter function for addressbook bookmarks." + (helm-bookmark-filter-setup-alist 'helm-bookmark-addressbook-p)) + +(defvar helm-source-bookmark-addressbook + (helm-make-source "Bookmark Addressbook" 'helm-bookmark-addressbook-class)) + +;;; Transformer +;; + +(defun helm-highlight-bookmark (bookmarks _source) + "Used as `filtered-candidate-transformer' to colorize bookmarks. +Work both with standard Emacs bookmarks and bookmark-extensions.el." + (let ((non-essential t)) + (cl-loop for i in bookmarks + for isfile = (bookmark-get-filename i) + for hff = (helm-bookmark-helm-find-files-p i) + for handlerp = (and (fboundp 'bookmark-get-handler) + (bookmark-get-handler i)) + for isw3m = (and (fboundp 'helm-bookmark-w3m-bookmark-p) + (helm-bookmark-w3m-bookmark-p i)) + for isgnus = (and (fboundp 'helm-bookmark-gnus-bookmark-p) + (helm-bookmark-gnus-bookmark-p i)) + for isman = (and (fboundp 'helm-bookmark-man-bookmark-p) ; Man + (helm-bookmark-man-bookmark-p i)) + for iswoman = (and (fboundp 'helm-bookmark-woman-bookmark-p) ; Woman + (helm-bookmark-woman-bookmark-p i)) + for isannotation = (bookmark-get-annotation i) + for isabook = (string= (bookmark-prop-get i 'type) + "addressbook") + for isinfo = (eq handlerp 'Info-bookmark-jump) + for loc = (bookmark-location i) + for len = (string-width i) + for trunc = (if (and helm-bookmark-show-location + (> len bookmark-bmenu-file-column)) + (helm-substring + i bookmark-bmenu-file-column) + i) + ;; Add a * if bookmark have annotation + if (and isannotation (not (string-equal isannotation ""))) + do (setq trunc (concat "*" (if helm-bookmark-show-location trunc i))) + for sep = (and helm-bookmark-show-location + (make-string (- (+ bookmark-bmenu-file-column 2) + (string-width trunc)) + ? )) + for bmk = (cond ( ;; info buffers + isinfo + (propertize trunc 'face 'helm-bookmark-info + 'help-echo isfile)) + ( ;; w3m buffers + isw3m + (propertize trunc 'face 'helm-bookmark-w3m + 'help-echo isfile)) + ( ;; gnus buffers + isgnus + (propertize trunc 'face 'helm-bookmark-gnus + 'help-echo isfile)) + ( ;; Man Woman + (or iswoman isman) + (propertize trunc 'face 'helm-bookmark-man + 'help-echo isfile)) + ( ;; Addressbook + isabook + (propertize trunc 'face 'helm-bookmark-addressbook)) + ( ;; directories + (and isfile + (or hff + ;; This is needed because `non-essential' + ;; is not working on Emacs-24.2 and the behavior + ;; of tramp seems to have changed since previous + ;; versions (Need to reenter password even if a + ;; first connection have been established, + ;; probably when host is named differently + ;; i.e machine/localhost) + (and (not (file-remote-p isfile)) + (file-directory-p isfile)))) + (propertize trunc 'face 'helm-bookmark-directory + 'help-echo isfile)) + ( ;; regular files + t + (propertize trunc 'face 'helm-bookmark-file + 'help-echo isfile))) + collect (if helm-bookmark-show-location + (cons (concat bmk sep (if (listp loc) (car loc) loc)) + i) + (cons bmk i))))) + +(defun helm-bookmark-edit-bookmark (bookmark-name) + "Edit bookmark's name and file name, and maybe save them. +BOOKMARK-NAME is the current (old) name of the bookmark to be renamed." + (let ((bmk (helm-bookmark-get-bookmark-from-name bookmark-name)) + (handler (bookmark-prop-get bookmark-name 'handler))) + (if (eq handler 'addressbook-bookmark-jump) + (addressbook-bookmark-edit + (assoc bmk bookmark-alist)) + (helm-bookmark-edit-bookmark-1 bookmark-name handler)))) + +(defun helm-bookmark-edit-bookmark-1 (bookmark-name handler) + (let* ((helm--reading-passwd-or-string t) + (bookmark-fname (bookmark-get-filename bookmark-name)) + (bookmark-loc (bookmark-prop-get bookmark-name 'location)) + (new-name (read-from-minibuffer "Name: " bookmark-name)) + (new-loc (read-from-minibuffer "FileName or Location: " + (or bookmark-fname + (if (consp bookmark-loc) + (car bookmark-loc) + bookmark-loc)))) + (docid (and (eq handler 'mu4e-bookmark-jump) + (read-number "Docid: " (cdr bookmark-loc))))) + (when docid + (setq new-loc (cons new-loc docid))) + (when (and (not (equal new-name "")) (not (equal new-loc "")) + (y-or-n-p "Save changes? ")) + (if bookmark-fname + (progn + (helm-bookmark-rename bookmark-name new-name 'batch) + (bookmark-set-filename new-name new-loc)) + (bookmark-prop-set + (bookmark-get-bookmark bookmark-name) 'location new-loc) + (helm-bookmark-rename bookmark-name new-name 'batch)) + (helm-bookmark-maybe-save-bookmark) + (list new-name new-loc)))) + +(defun helm-bookmark-maybe-save-bookmark () + "Increment save counter and maybe save `bookmark-alist'." + (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)) + (when (bookmark-time-to-save-p) (bookmark-save))) + +(defun helm-bookmark-rename (old &optional new batch) + "Change bookmark's name from OLD to NEW. +Interactively: + If called from the keyboard, then prompt for OLD. + If called from the menubar, select OLD from a menu. +If NEW is nil, then prompt for its string value. + +If BATCH is non-nil, then do not rebuild the menu list. + +While the user enters the new name, repeated `C-w' inserts consecutive +words from the buffer into the new bookmark name." + (interactive (list (bookmark-completing-read "Old bookmark name"))) + (bookmark-maybe-historicize-string old) + (bookmark-maybe-load-default-file) + (save-excursion (skip-chars-forward " ") (setq bookmark-yank-point (point))) + (setq bookmark-current-buffer (current-buffer)) + (let ((newname (or new (read-from-minibuffer + "New name: " nil + (let ((now-map (copy-keymap minibuffer-local-map))) + (define-key now-map "\C-w" 'bookmark-yank-word) + now-map) + nil 'bookmark-history)))) + (bookmark-set-name old newname) + (setq bookmark-current-bookmark newname) + (unless batch (bookmark-bmenu-surreptitiously-rebuild-list)) + (helm-bookmark-maybe-save-bookmark) newname)) + +(defun helm-bookmark-run-edit () + "Run `helm-bookmark-edit-bookmark' from keyboard." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-bookmark-edit-bookmark))) + + +;;; Bookmarks attributes +;; +(define-helm-type-attribute 'bookmark + `((coerce . helm-bookmark-get-bookmark-from-name) + (action . ,(helm-make-actions + "Jump to bookmark" 'helm-bookmark-jump + "Jump to BM other window" 'helm-bookmark-jump-other-window + "Bookmark edit annotation" 'bookmark-edit-annotation + "Bookmark show annotation" 'bookmark-show-annotation + "Delete bookmark(s)" 'helm-delete-marked-bookmarks + "Edit Bookmark" 'helm-bookmark-edit-bookmark + "Rename bookmark" 'helm-bookmark-rename + "Relocate bookmark" 'bookmark-relocate)) + (keymap . ,helm-bookmark-map) + (mode-line . helm-bookmark-mode-line-string)) + "Bookmark name.") + + +(defun helm-bookmark-run-jump-other-window () + "Jump to bookmark from keyboard." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'bookmark-jump-other-window))) + +(defun helm-bookmark-run-delete () + "Delete bookmark from keyboard." + (interactive) + (with-helm-alive-p + (when (y-or-n-p "Delete bookmark(s)?") + (helm-quit-and-execute-action 'helm-delete-marked-bookmarks)))) + +(defun helm-bookmark-get-bookmark-from-name (bmk) + "Return bookmark name even if it is a bookmark with annotation. +e.g prepended with *." + (let ((bookmark (replace-regexp-in-string "\\`\\*" "" bmk))) + (if (assoc bookmark bookmark-alist) bookmark bmk))) + +(defun helm-delete-marked-bookmarks (_ignore) + "Delete this bookmark or all marked bookmarks." + (cl-dolist (i (helm-marked-candidates)) + (bookmark-delete (helm-bookmark-get-bookmark-from-name i) + 'batch))) + + +;;;###autoload +(defun helm-bookmarks () + "Preconfigured `helm' for bookmarks." + (interactive) + (helm :sources '(helm-source-bookmarks + helm-source-bookmark-set) + :buffer "*helm bookmarks*" + :default (buffer-name helm-current-buffer))) + +;;;###autoload +(defun helm-pp-bookmarks () + "Preconfigured `helm' for bookmarks (pretty-printed)." + (interactive) + (helm :sources '(helm-source-pp-bookmarks + helm-source-bookmark-set) + :buffer "*helm pp bookmarks*" + :default (buffer-name helm-current-buffer))) + +;;;###autoload +(defun helm-filtered-bookmarks () + "Preconfigured helm for bookmarks (filtered by category). +Optional source `helm-source-bookmark-addressbook' is loaded +only if external library addressbook-bookmark.el is available." + (interactive) + (helm :sources helm-bookmark-default-filtered-sources + :prompt "Search Bookmark: " + :buffer "*helm filtered bookmarks*" + :default (list (thing-at-point 'symbol) + (buffer-name helm-current-buffer)))) + +(provide 'helm-bookmark) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-bookmark.el ends here diff --git a/elpa/helm-20150426.2119/helm-buffers.el b/elpa/helm-20150426.2119/helm-buffers.el new file mode 100644 index 00000000..6775f329 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-buffers.el @@ -0,0 +1,854 @@ +;;; helm-buffers.el --- helm support for buffers. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-utils) +(require 'helm-elscreen) +(require 'helm-grep) +(require 'helm-plugin) +(require 'helm-regexp) +(require 'helm-help) + +(declare-function ido-make-buffer-list "ido" (default)) +(declare-function ido-add-virtual-buffers-to-list "ido") +(declare-function helm-comp-read "helm-mode") + + +(defgroup helm-buffers nil + "Buffers related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-boring-buffer-regexp-list + '("\\` " "\\*helm" "\\*helm-mode" "\\*Echo Area" "\\*Minibuf") + "The regexp list that match boring buffers. +Buffer candidates matching these regular expression will be +filtered from the list of candidates if the +`helm-skip-boring-buffers' candidate transformer is used." + :type '(repeat (choice regexp)) + :group 'helm-buffers) + +(defcustom helm-buffers-favorite-modes '(lisp-interaction-mode + emacs-lisp-mode + text-mode + org-mode) + "List of preferred mode to open new buffers with." + :type '(repeat (choice function)) + :group 'helm-buffers) + +(defcustom helm-buffer-max-length 20 + "Max length of buffer names before truncate. +When disabled (nil) use the longest buffer-name length found." + :group 'helm-buffers + :type '(choice (const :tag "Disabled" nil) + (integer :tag "Length before truncate"))) + +(defcustom helm-buffer-details-flag t + "Always show details in buffer list when non--nil." + :group 'helm-buffers + :type 'boolean) + +(defcustom helm-buffers-fuzzy-matching nil + "Fuzzy matching buffer names when non--nil. +Only buffer names are fuzzy matched when this is enabled, +`major-mode' matching is not affected by this." + :group 'helm-buffers + :type 'boolean) + +(defcustom helm-buffer-skip-remote-checking nil + "Ignore checking for `file-exists-p' on remote files." + :group 'helm-buffers + :type 'boolean) + +;;; Faces +;; +;; +(defgroup helm-buffers-faces nil + "Customize the appearance of helm-buffers." + :prefix "helm-" + :group 'helm-buffers + :group 'helm-faces) + +(defface helm-buffer-saved-out + '((t (:foreground "red" :background "black"))) + "Face used for buffer files modified outside of emacs." + :group 'helm-buffers-faces) + +(defface helm-buffer-not-saved + '((t (:foreground "Indianred2"))) + "Face used for buffer files not already saved on disk." + :group 'helm-buffers-faces) + +(defface helm-buffer-size + '((((background dark)) :foreground "RosyBrown") + (((background light)) :foreground "SlateGray")) + "Face used for buffer size." + :group 'helm-buffers-faces) + +(defface helm-buffer-process + '((t (:foreground "Sienna3"))) + "Face used for process status in buffer." + :group 'helm-buffers-faces) + +(defface helm-buffer-directory + '((t (:foreground "DarkRed" :background "LightGray"))) + "Face used for directories in `helm-buffers-list'." + :group 'helm-buffers-faces) + +(defface helm-buffer-file + '((t :inherit font-lock-builtin-face)) + "Face for buffer file names in `helm-buffers-list'." + :group 'helm-buffers-faces) + + +;;; Buffers keymap +;; +(defvar helm-buffer-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c ?") 'helm-buffer-help) + ;; No need to have separate command for grep and zgrep + ;; as we don't use recursivity for buffers. + ;; So use zgrep for both as it is capable to handle non--compressed files. + (define-key map (kbd "M-g s") 'helm-buffer-run-zgrep) + (define-key map (kbd "C-s") 'helm-buffers-run-multi-occur) + (define-key map (kbd "C-c o") 'helm-buffer-switch-other-window) + (define-key map (kbd "C-c C-o") 'helm-buffer-switch-other-frame) + (define-key map (kbd "C-c =") 'helm-buffer-run-ediff) + (define-key map (kbd "M-=") 'helm-buffer-run-ediff-merge) + (define-key map (kbd "C-=") 'helm-buffer-diff-persistent) + (define-key map (kbd "M-U") 'helm-buffer-revert-persistent) + (define-key map (kbd "C-c d") 'helm-buffer-run-kill-persistent) + (define-key map (kbd "M-D") 'helm-buffer-run-kill-buffers) + (define-key map (kbd "C-x C-s") 'helm-buffer-save-persistent) + (define-key map (kbd "C-M-%") 'helm-buffer-run-query-replace-regexp) + (define-key map (kbd "M-%") 'helm-buffer-run-query-replace) + (define-key map (kbd "M-m") 'helm-toggle-all-marks) + (define-key map (kbd "M-a") 'helm-mark-all) + (define-key map (kbd "C-]") 'helm-toggle-buffers-details) + (define-key map (kbd "C-c a") 'helm-buffers-toggle-show-hidden-buffers) + (define-key map (kbd "") 'helm-buffers-mark-similar-buffers) + map) + "Keymap for buffer sources in helm.") + +(defvar helm-buffers-ido-virtual-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c ?") 'helm-buffers-ido-virtual-help) + (define-key map (kbd "C-c o") 'helm-ff-run-switch-other-window) + (define-key map (kbd "C-c C-o") 'helm-ff-run-switch-other-frame) + (define-key map (kbd "M-g s") 'helm-ff-run-grep) + (define-key map (kbd "M-g z") 'helm-ff-run-zgrep) + (define-key map (kbd "M-D") 'helm-ff-run-delete-file) + (define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally) + map)) + + +(defvar helm-buffers-list-cache nil) +(defvar helm-buffer-max-len-mode nil) +(defclass helm-source-buffers (helm-source-sync helm-type-buffer) + ((buffer-list + :initarg :buffer-list + :initform #'helm-buffer-list + :custom function + :documentation + " A function with no arguments to create buffer list.") + (init :initform (lambda () + ;; Issue #51 Create the list before `helm-buffer' creation. + (setq helm-buffers-list-cache (funcall (helm-attr 'buffer-list))) + (let ((result (cl-loop for b in helm-buffers-list-cache + maximize (length b) into len-buf + maximize (length (with-current-buffer b + (symbol-name major-mode))) + into len-mode + finally return (cons len-buf len-mode)))) + (unless helm-buffer-max-length + (setq helm-buffer-max-length (car result))) + (unless helm-buffer-max-len-mode + ;; If a new buffer is longer that this value + ;; this value will be updated + (setq helm-buffer-max-len-mode (cdr result)))))) + (candidates :initform helm-buffers-list-cache) + (matchplugin :initform nil) + ;(nohighlight :initform t) + (match :initform 'helm-buffers-match-function) + (persistent-action :initform 'helm-buffers-list-persistent-action) + (resume :initform (lambda () + (run-with-idle-timer + 0.1 nil (lambda () + (with-helm-buffer + (helm-force-update)))))) + (keymap :initform helm-buffer-map) + (volatile :initform t) + (mode-line :initform helm-buffer-mode-line-string) + (persistent-help + :initform + "Show this buffer / C-u \\[helm-execute-persistent-action]: Kill this buffer"))) + +(defvar helm-source-buffers-list nil) + +(defvar helm-source-buffer-not-found + (helm-build-dummy-source + "Create buffer" + :action (helm-make-actions + "Create buffer (C-u choose mode)" + (lambda (candidate) + (let ((mjm (or (and helm-current-prefix-arg + (intern-soft (helm-comp-read + "Major-mode: " + helm-buffers-favorite-modes))) + (cl-loop for (r . m) in auto-mode-alist + when (string-match r candidate) + return m))) + (buffer (get-buffer-create candidate))) + (if mjm + (with-current-buffer buffer (funcall mjm)) + (set-buffer-major-mode buffer)) + (switch-to-buffer buffer)))))) + +(defvar ido-temp-list) +(defvar ido-ignored-list) +(defvar ido-process-ignore-lists) +(defvar ido-use-virtual-buffers) +(defvar ido-virtual-buffers) + +(defvar helm-source-ido-virtual-buffers + (helm-build-sync-source "Ido virtual buffers" + :candidates (lambda () + (let (ido-temp-list + ido-ignored-list + (ido-process-ignore-lists t)) + (when ido-use-virtual-buffers + (ido-add-virtual-buffers-to-list) + ido-virtual-buffers))) + :fuzzy-match helm-buffers-fuzzy-matching + :keymap helm-buffers-ido-virtual-map + :mode-line helm-buffers-ido-virtual-mode-line-string + :action '(("Find file" . helm-find-many-files) + ("Find file other window" . find-file-other-window) + ("Find file other frame" . find-file-other-frame) + ("Find file as root" . helm-find-file-as-root) + ("Grep File(s) `C-u recurse'" . helm-find-files-grep) + ("Zgrep File(s) `C-u Recurse'" . helm-ff-zgrep) + ("View file" . view-file) + ("Delete file(s)" . helm-delete-marked-files) + ("Open file externally (C-u to choose)" + . helm-open-file-externally)))) + + +(defvar ido-use-virtual-buffers) +(defun helm-buffer-list () + "Return the current list of buffers. +Currently visible buffers are put at the end of the list. +See `ido-make-buffer-list' for more infos." + (require 'ido) + (let ((ido-process-ignore-lists t) + ido-ignored-list + ido-use-virtual-buffers) + (ido-make-buffer-list nil))) + +(defun helm-buffer-size (buffer) + "Return size of BUFFER." + (with-current-buffer buffer + (save-restriction + (widen) + (helm-file-human-size + (- (position-bytes (point-max)) + (position-bytes (point-min))))))) + +(defun helm-buffer--show-details (buf-name prefix help-echo + size mode dir face1 face2 + proc details type) + (append + (list + (concat prefix + (propertize buf-name 'face face1 + 'help-echo help-echo + 'type type))) + (and details + (list size mode + (propertize + (if proc + (format "(%s %s in `%s')" + (process-name proc) + (process-status proc) dir) + (format "(in `%s')" dir)) + 'face face2))))) + +(defun helm-buffer--details (buffer &optional details) + (let* ((mode (with-current-buffer buffer (format-mode-line mode-name))) + (buf (get-buffer buffer)) + (size (propertize (helm-buffer-size buf) + 'face 'helm-buffer-size)) + (proc (get-buffer-process buf)) + (dir (with-current-buffer buffer (abbreviate-file-name default-directory))) + (file-name (helm-aif (buffer-file-name buf) (abbreviate-file-name it))) + (name (buffer-name buf)) + (name-prefix (when (file-remote-p dir) + (propertize "@ " 'face 'helm-ff-prefix)))) + ;; No fancy things on remote buffers. + (if (and name-prefix helm-buffer-skip-remote-checking) + (helm-buffer--show-details + name name-prefix file-name size mode dir + 'helm-buffer-file 'helm-buffer-process nil details 'filebuf) + (cond + ( ;; A dired buffer. + (rassoc buf dired-buffers) + (helm-buffer--show-details + name name-prefix dir size mode dir + 'helm-buffer-directory 'helm-buffer-process nil details 'dired)) + ;; A buffer file modified somewhere outside of emacs.=>red + ((and file-name + (file-exists-p file-name) + (not (verify-visited-file-modtime buf))) + (helm-buffer--show-details + name name-prefix file-name size mode dir + 'helm-buffer-saved-out 'helm-buffer-process nil details 'modout)) + ;; A new buffer file not already saved on disk.=>indianred2 + ((and file-name + (not (verify-visited-file-modtime buf))) + (helm-buffer--show-details + name name-prefix file-name size mode dir + 'helm-buffer-not-saved 'helm-buffer-process nil details 'notsaved)) + ;; A buffer file modified and not saved on disk.=>orange + ((and file-name (buffer-modified-p buf)) + (helm-buffer--show-details + name name-prefix file-name size mode dir + 'helm-ff-symlink 'helm-buffer-process nil details 'mod)) + ;; A buffer file not modified and saved on disk.=>green + (file-name + (helm-buffer--show-details + name name-prefix file-name size mode dir + 'helm-buffer-file 'helm-buffer-process nil details 'filebuf)) + ;; Any non--file buffer.=>grey italic + (t + (helm-buffer--show-details + name (and proc name-prefix) dir size mode dir + 'italic 'helm-buffer-process proc details 'nofile)))))) + +(defun helm-highlight-buffers (buffers _source) + "Transformer function to highlight BUFFERS list. +Should be called after others transformers i.e (boring buffers)." + (cl-loop for i in buffers + for (name size mode meta) = (if helm-buffer-details-flag + (helm-buffer--details i 'details) + (helm-buffer--details i)) + for truncbuf = (if (> (string-width name) helm-buffer-max-length) + (helm-substring-by-width + name helm-buffer-max-length) + (concat name (make-string + (- (+ helm-buffer-max-length 3) + (string-width name)) ? ))) + for len = (length mode) + when (> len helm-buffer-max-len-mode) + do (setq helm-buffer-max-len-mode len) + for fmode = (concat (make-string + (- (max helm-buffer-max-len-mode len) len) ? ) + mode) + ;; The max length of a number should be 1023.9X where X is the + ;; units, this is 7 characters. + for formatted-size = (and size (format "%7s" size)) + collect (cons (if helm-buffer-details-flag + (concat truncbuf "\t" formatted-size + " " fmode " " meta) + name) + (get-buffer i)))) + +(defun helm-buffer--get-preselection (buffer) + (let ((bufname (buffer-name buffer))) + (concat "^" + (if (and (null helm-buffer-details-flag) + (numberp helm-buffer-max-length) + (> (string-width bufname) + helm-buffer-max-length)) + (regexp-quote + (helm-substring-by-width + bufname helm-buffer-max-length)) + (concat (regexp-quote bufname) + (if helm-buffer-details-flag + "$" "[[:blank:]]+")))))) + +(defun helm-toggle-buffers-details () + (interactive) + (let ((preselect (helm-buffer--get-preselection + (helm-get-selection)))) + (when helm-alive-p + (setq helm-buffer-details-flag (not helm-buffer-details-flag)) + (helm-force-update preselect)))) + +(defun helm-buffers-sort-transformer (candidates _source) + (if (string= helm-pattern "") + candidates + (sort candidates + #'(lambda (s1 s2) + (< (string-width s1) (string-width s2)))))) + +(defun helm-buffers-mark-similar-buffers-1 () + (with-helm-window + (let ((type (get-text-property + 0 'type (helm-get-selection nil 'withprop)))) + (save-excursion + (goto-char (helm-get-previous-header-pos)) + (helm-next-line) + (let* ((next-head (helm-get-next-header-pos)) + (end (and next-head + (save-excursion + (goto-char next-head) + (forward-line -1) + (point)))) + (maxpoint (or end (point-max)))) + (while (< (point) maxpoint) + (helm-mark-current-line) + (let ((cand (helm-get-selection nil 'withprop))) + (when (and (not (helm-this-visible-mark)) + (eq (get-text-property 0 'type cand) type)) + (helm-make-visible-mark))) + (forward-line 1) (end-of-line)))) + (helm-mark-current-line) + (message "%s candidates marked" (length helm-marked-candidates))))) + +(defun helm-buffers-mark-similar-buffers () + "Mark All buffers that have same property `type' than current. +i.e same color." + (interactive) + (let ((marked (helm-marked-candidates))) + (if (and (>= (length marked) 1) + (with-helm-window helm-visible-mark-overlays)) + (helm-unmark-all) + (helm-buffers-mark-similar-buffers-1)))) + + +;;; match functions +;; +(defun helm-buffer--match-mjm (pattern mjm) + (when (string-match "\\`\\*" pattern) + (cl-loop with patterns = (split-string (substring pattern 1) ",") + for pat in patterns + if (string-match "\\`!" pat) + collect (string-match (substring pat 1) mjm) into neg + else collect (string-match pat mjm) into pos + finally return + (let ((neg-test (cl-loop for i in neg thereis (numberp i))) + (pos-test (cl-loop for i in pos thereis (numberp i)))) + (or + (and neg (not pos) (not neg-test)) + (and pos pos-test) + (and neg neg-test (not neg-test))))))) + +(defun helm-buffer--match-pattern (pattern candidate) + (let ((fun (if (and helm-buffers-fuzzy-matching + (not (string-match "\\`\\^" pattern))) + #'helm--mapconcat-pattern + #'identity))) + (if (string-match "\\`!" pattern) + (not (string-match (funcall fun (substring pattern 1)) + candidate)) + (string-match (funcall fun pattern) candidate)))) + +(defun helm-buffers--match-from-mjm (candidate) + (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate)) + (buf (get-buffer cand)) + (regexp (cl-loop with pattern = helm-pattern + for p in (split-string pattern) + when (string-match "\\`\\*" p) + return p))) + (if regexp + (when buf + (with-current-buffer buf + (let ((mjm (format-mode-line mode-name))) + (helm-buffer--match-mjm regexp mjm)))) + t))) + +(defun helm-buffers--match-from-pat (candidate) + (let ((regexp-list (cl-loop with pattern = helm-pattern + for p in (split-string pattern) + unless (string-match + "\\`\\(\\*\\)\\|\\(/\\)\\|\\(@\\)" p) + collect p))) + (if regexp-list + (cl-loop for re in regexp-list + always (helm-buffer--match-pattern re candidate)) + t))) + +(defun helm-buffers--match-from-inside (candidate) + (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate)) + (buf (get-buffer cand)) + (regexp (cl-loop with pattern = helm-pattern + for p in (split-string pattern) + when (string-match "\\`@\\(.*\\)" p) + return (match-string 1 p)))) + (if regexp + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (re-search-forward regexp nil t))) + t))) + +(defun helm-buffers--match-from-directory (candidate) + (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate)) + (buf (get-buffer cand)) + (buf-fname (buffer-file-name buf)) + (regexps (cl-loop with pattern = helm-pattern + for p in (split-string pattern) + when (string-match "\\`/" p) + collect p))) + (if regexps + (cl-loop for re in regexps + thereis + (and buf-fname + (string-match + (substring re 1) (helm-basedir buf-fname)))) + t))) + +(defun helm-buffers-match-function (candidate) + "Default function to match buffers." + (and (helm-buffers--match-from-pat candidate) + (helm-buffers--match-from-mjm candidate) + (helm-buffers--match-from-inside candidate) + (helm-buffers--match-from-directory candidate))) + + +(defun helm-buffer-query-replace-1 (&optional regexp-flag buffers) + "Query replace in marked buffers. +If REGEXP-FLAG is given use `query-replace-regexp'." + (let ((fn (if regexp-flag 'query-replace-regexp 'query-replace)) + (prompt (if regexp-flag "Query replace regexp" "Query replace")) + (bufs (or buffers (helm-marked-candidates))) + (helm--reading-passwd-or-string t)) + (cl-loop with replace = (query-replace-read-from prompt regexp-flag) + with tostring = (unless (consp replace) + (query-replace-read-to + replace prompt regexp-flag)) + for buf in bufs + do + (save-window-excursion + (switch-to-buffer buf) + (save-excursion + (let ((case-fold-search t)) + (goto-char (point-min)) + (if (consp replace) + (apply fn (list (car replace) (cdr replace))) + (apply fn (list replace tostring))))))))) + +(defun helm-buffer-query-replace-regexp (_candidate) + (helm-buffer-query-replace-1 'regexp)) + +(defun helm-buffer-query-replace (_candidate) + (helm-buffer-query-replace-1)) + +(defun helm-buffer-toggle-diff (candidate) + "Toggle diff buffer CANDIDATE with it's file." + (let (helm-persistent-action-use-special-display) + (helm-aif (get-buffer-window "*Diff*") + (progn (kill-buffer "*Diff*") + (set-window-buffer it helm-current-buffer)) + (diff-buffer-with-file (get-buffer candidate))))) + +(defun helm-buffer-diff-persistent () + "Toggle diff buffer without quitting helm." + (interactive) + (with-helm-alive-p + (helm-attrset 'diff-action 'helm-buffer-toggle-diff) + (helm-execute-persistent-action 'diff-action))) + +(defun helm-revert-buffer (candidate) + (with-current-buffer candidate + (helm-aif (buffer-file-name) + (and (file-exists-p it) (revert-buffer t t))))) + +(defun helm-revert-marked-buffers (_ignore) + (mapc 'helm-revert-buffer (helm-marked-candidates))) + +(defun helm-buffer-revert-and-update (_candidate) + (let ((marked (helm-marked-candidates)) + (preselect (helm-buffers--quote-truncated-buffer + (helm-get-selection)))) + (cl-loop for buf in marked do (helm-revert-buffer buf)) + (when (> (length marked) 1) (helm-unmark-all)) + (helm-force-update preselect))) + +(defun helm-buffer-revert-persistent () + "Revert buffer without quitting helm." + (interactive) + (with-helm-alive-p + (helm-attrset 'revert-action '(helm-buffer-revert-and-update . never-split)) + (helm-execute-persistent-action 'revert-action))) + +(defun helm-buffer-save-and-update (_candidate) + (let ((marked (helm-marked-candidates)) + (preselect (helm-get-selection nil t)) + (enable-recursive-minibuffers t)) + (cl-loop for buf in marked do + (with-current-buffer (get-buffer buf) + (when (buffer-file-name) (save-buffer)))) + (when (> (length marked) 1) (helm-unmark-all)) + (helm-force-update (regexp-quote preselect)))) + +(defun helm-buffer-save-persistent () + "Save buffer without quitting helm." + (interactive) + (with-helm-alive-p + (helm-attrset 'save-action '(helm-buffer-save-and-update . never-split)) + (helm-execute-persistent-action 'save-action))) + +(defun helm-buffer-run-kill-persistent () + "Kill buffer without quitting helm." + (interactive) + (with-helm-alive-p + (helm-attrset 'kill-action '(helm-buffers-persistent-kill . never-split)) + (helm-execute-persistent-action 'kill-action))) + +(defun helm-kill-marked-buffers (_ignore) + (mapc 'kill-buffer (helm-marked-candidates)) + (with-helm-buffer + (setq helm-marked-candidates nil + helm-visible-mark-overlays nil))) + +(defun helm-buffer-run-kill-buffers () + "Run kill buffer action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-kill-marked-buffers))) + +(defun helm-buffer-run-grep () + "Run Grep action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-grep-buffers))) + +(defun helm-buffer-run-zgrep () + "Run Grep action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-zgrep-buffers))) + +(defun helm-buffer-run-query-replace-regexp () + "Run Query replace regexp action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-buffer-query-replace-regexp))) + +(defun helm-buffer-run-query-replace () + "Run Query replace action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-buffer-query-replace))) + +(defun helm-buffer-switch-other-window () + "Run switch to other window action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-switch-to-buffers-other-window))) + +(defun helm-buffer-switch-other-frame () + "Run switch to other frame action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'switch-to-buffer-other-frame))) + +(defun helm-buffer-switch-to-elscreen () + "Run switch to elscreen action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-find-buffer-on-elscreen))) + +(defun helm-buffer-run-ediff () + "Run ediff action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-ediff-marked-buffers))) + +(defun helm-buffer-run-ediff-merge () + "Run ediff action from `helm-source-buffers-list'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-ediff-marked-buffers-merge))) + +(defun helm-buffers-persistent-kill-1 (buffer) + "Persistent action to kill buffer." + (with-current-buffer (get-buffer buffer) + (if (and (buffer-modified-p) + (buffer-file-name (current-buffer))) + (progn + (save-buffer) + (kill-buffer buffer)) + (kill-buffer buffer))) + (helm-delete-current-selection) + (with-helm-temp-hook 'helm-after-persistent-action-hook + (helm-force-update (regexp-quote (helm-get-selection nil t))))) + +(defun helm-buffers--quote-truncated-buffer (buffer) + (let ((bufname (and (bufferp buffer) + (buffer-name buffer)))) + (when bufname + (regexp-quote + (if helm-buffer-max-length + (helm-substring-by-width + bufname helm-buffer-max-length + "") + bufname))))) + +(defun helm-buffers-persistent-kill (_buffer) + (let ((marked (helm-marked-candidates))) + (unwind-protect + (cl-loop for b in marked + do (progn (helm-preselect + (format "^%s" + (helm-buffers--quote-truncated-buffer b))) + (when (y-or-n-p (format "kill buffer (%s)? " b)) + (helm-buffers-persistent-kill-1 b)) + (message nil))) + (with-helm-buffer + (setq helm-marked-candidates nil + helm-visible-mark-overlays nil)) + (helm-force-update (helm-buffers--quote-truncated-buffer + (helm-get-selection)))))) + +(defun helm-buffers-list-persistent-action (candidate) + (if current-prefix-arg + (helm-buffers-persistent-kill candidate) + (switch-to-buffer candidate))) + +(defun helm-ediff-marked-buffers (_candidate &optional merge) + "Ediff 2 marked buffers or CANDIDATE and `helm-current-buffer'. +With optional arg MERGE call `ediff-merge-buffers'." + (let ((lg-lst (length (helm-marked-candidates))) + buf1 buf2) + (cl-case lg-lst + (0 + (error "Error:You have to mark at least 1 buffer")) + (1 + (setq buf1 helm-current-buffer + buf2 (cl-first (helm-marked-candidates)))) + (2 + (setq buf1 (cl-first (helm-marked-candidates)) + buf2 (cl-second (helm-marked-candidates)))) + (t + (error "Error:To much buffers marked!"))) + (if merge + (ediff-merge-buffers buf1 buf2) + (ediff-buffers buf1 buf2)))) + +(defun helm-ediff-marked-buffers-merge (candidate) + "Ediff merge `helm-current-buffer' with CANDIDATE. +See `helm-ediff-marked-buffers'." + (helm-ediff-marked-buffers candidate t)) + +(defun helm-multi-occur-as-action (_candidate) + "Multi occur action for `helm-source-buffers-list'. +Can be used by any source that list buffers." + (let ((helm-moccur-always-search-in-current + (if helm-current-prefix-arg + (not helm-moccur-always-search-in-current) + helm-moccur-always-search-in-current)) + (buffers (helm-marked-candidates)) + (input (cl-loop for i in (split-string helm-pattern " " t) + thereis (and (string-match "\\`@\\(.*\\)" i) + (match-string 1 i))))) + (helm-multi-occur-1 buffers input))) + +(defun helm-buffers-run-multi-occur () + "Run `helm-multi-occur-as-action' by key." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-multi-occur-as-action))) + +(defun helm-buffers-toggle-show-hidden-buffers () + (interactive) + (with-helm-alive-p + (let ((filter-attrs (helm-attr 'filtered-candidate-transformer + helm-source-buffers-list))) + (if (memq 'helm-shadow-boring-buffers filter-attrs) + (helm-attrset 'filtered-candidate-transformer + (cons 'helm-skip-boring-buffers + (remove 'helm-shadow-boring-buffers + filter-attrs)) + helm-source-buffers-list t) + (helm-attrset 'filtered-candidate-transformer + (cons 'helm-shadow-boring-buffers + (remove 'helm-skip-boring-buffers + filter-attrs)) + helm-source-buffers-list t)) + (helm-force-update)))) + + +;;; Candidate Transformers +;; +;; +(defun helm-skip-boring-buffers (buffers _source) + (helm-skip-entries buffers helm-boring-buffer-regexp-list)) + +(defun helm-shadow-boring-buffers (buffers _source) + "Buffers matching `helm-boring-buffer-regexp' will be +displayed with the `file-name-shadow' face if available." + (helm-shadow-entries buffers helm-boring-buffer-regexp-list)) + + +(define-helm-type-attribute 'buffer + `((action + . ,(helm-make-actions + "Switch to buffer" 'switch-to-buffer + (lambda () (and (locate-library "popwin") "Switch to buffer in popup window")) + 'popwin:popup-buffer + "Switch to buffer other window `C-c o'" 'switch-to-buffer-other-window + "Switch to buffer other frame `C-c C-o'" 'switch-to-buffer-other-frame + (lambda () (and (locate-library "elscreen") "Display buffer in Elscreen")) + 'helm-find-buffer-on-elscreen + "Query replace regexp `C-M-%'" 'helm-buffer-query-replace-regexp + "Query replace `M-%'" 'helm-buffer-query-replace + "View buffer" 'view-buffer + "Display buffer" 'display-buffer + "Grep buffers `M-g s' (C-u grep all buffers)" 'helm-zgrep-buffers + "Multi occur buffer(s) `C-s'" 'helm-multi-occur-as-action + "Revert buffer(s) `M-U'" 'helm-revert-marked-buffers + "Insert buffer" 'insert-buffer + "Kill buffer(s) `M-D'" 'helm-kill-marked-buffers + "Diff with file" 'diff-buffer-with-file + "Ediff Marked buffers `C-c ='" 'helm-ediff-marked-buffers + "Ediff Merge marked buffers `M-='" (lambda (candidate) + (helm-ediff-marked-buffers candidate t)))) + (persistent-help . "Show this buffer") + (filtered-candidate-transformer helm-skip-boring-buffers + helm-buffers-sort-transformer + helm-highlight-buffers)) + "Buffer or buffer name.") + +;;;###autoload +(defun helm-buffers-list () + "Preconfigured `helm' to list buffers." + (interactive) + (unless helm-source-buffers-list + (setq helm-source-buffers-list + (helm-make-source "Buffers" 'helm-source-buffers))) + (helm :sources '(helm-source-buffers-list + helm-source-ido-virtual-buffers + helm-source-buffer-not-found) + :buffer "*helm buffers*" + :keymap helm-buffer-map + :truncate-lines t)) + +(provide 'helm-buffers) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-buffers.el ends here diff --git a/elpa/helm-20150426.2119/helm-color.el b/elpa/helm-20150426.2119/helm-color.el new file mode 100644 index 00000000..af4af763 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-color.el @@ -0,0 +1,163 @@ +;;; helm-color.el --- colors and faces -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: +(require 'cl-lib) +(require 'helm) + +;;; Customize Face +;; +;; +(defun helm-custom-faces-init () + "Initialize buffer for `helm-source-customize-face'." + (unless (helm-candidate-buffer) + (save-selected-window + (list-faces-display) + (message nil)) + (helm-init-candidates-in-buffer + 'global + (with-current-buffer (get-buffer "*Faces*") + (buffer-substring + (next-single-char-property-change (point-min) 'face) + (point-max)))) + (kill-buffer "*Faces*"))) + +(defvar helm-source-customize-face + '((name . "Customize Face") + (init . helm-custom-faces-init) + (candidates-in-buffer) + (get-line . buffer-substring) + (action . (("Customize" + . (lambda (line) + (customize-face (intern (car (split-string line)))))) + ("Copy name" + . (lambda (line) + (kill-new (car (split-string line " " t)))))))) + "See (info \"(emacs)Faces\")") + +;;; Colors browser +;; +;; +(defun helm-colors-init () + (unless (helm-candidate-buffer) + (save-selected-window + (list-colors-display) + (message nil)) + (helm-init-candidates-in-buffer + 'global + (with-current-buffer (get-buffer "*Colors*") + (buffer-string))) + (kill-buffer "*Colors*"))) + +(defun helm-color-insert-name (candidate) + (with-helm-current-buffer + (insert (helm-colors-get-name candidate)))) + +(defun helm-color-kill-name (candidate) + (kill-new (helm-colors-get-name candidate))) + +(defun helm-color-insert-rgb (candidate) + (with-helm-current-buffer + (insert (helm-colors-get-rgb candidate)))) + +(defun helm-color-kill-rgb (candidate) + (kill-new (helm-colors-get-rgb candidate))) + +(defun helm-color-run-insert-name () + "Insert name of color from `helm-source-colors'" + (interactive) + (with-helm-alive-p (helm-quit-and-execute-action 'helm-color-insert-name))) + +(defun helm-color-run-kill-name () + "Kill name of color from `helm-source-colors'" + (interactive) + (with-helm-alive-p (helm-quit-and-execute-action 'helm-color-kill-name))) + +(defun helm-color-run-insert-rgb () + "Insert RGB of color from `helm-source-colors'" + (interactive) + (with-helm-alive-p (helm-quit-and-execute-action 'helm-color-insert-rgb))) + +(defun helm-color-run-kill-rgb () + "Kill RGB of color from `helm-source-colors'" + (interactive) + (with-helm-alive-p (helm-quit-and-execute-action 'helm-color-kill-rgb))) + +(defvar helm-color-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c n") 'helm-color-run-insert-name) + (define-key map (kbd "C-c N") 'helm-color-run-kill-name) + (define-key map (kbd "C-c r") 'helm-color-run-insert-rgb) + (define-key map (kbd "C-c R") 'helm-color-run-kill-rgb) + (define-key map (kbd "C-c ?") 'helm-color-help) + map)) + +(defvar helm-source-colors + `((name . "Colors") + (init . helm-colors-init) + (candidates-in-buffer) + (get-line . buffer-substring) + (keymap . ,helm-color-map) + (persistent-help . "Kill entry in RGB format.") + (persistent-action . helm-color-kill-rgb) + (mode-line . helm-color-mode-line-string) + (action + ("Copy Name (C-c N)" . helm-color-kill-name) + ("Copy RGB (C-c R)" . helm-color-kill-rgb) + ("Insert Name (C-c n)" . helm-color-insert-name) + ("Insert RGB (C-c r)" . helm-color-insert-rgb)))) + +(defun helm-colors-get-name (candidate) + "Get color name." + (replace-regexp-in-string + " " "" + (with-temp-buffer + (insert (capitalize candidate)) + (goto-char (point-min)) + (search-forward-regexp "\\s-\\{2,\\}") + (delete-region (point) (point-max)) + (buffer-string)))) + +(defun helm-colors-get-rgb (candidate) + "Get color RGB." + (replace-regexp-in-string + " " "" + (with-temp-buffer + (insert (capitalize candidate)) + (goto-char (point-max)) + (search-backward-regexp "\\s-\\{2,\\}") + (delete-region (point) (point-min)) + (buffer-string)))) + +;;;###autoload +(defun helm-colors () + "Preconfigured `helm' for color." + (interactive) + (helm-other-buffer + '(helm-source-colors helm-source-customize-face) + "*helm colors*")) + +(provide 'helm-color) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-color.el ends here diff --git a/elpa/helm-20150426.2119/helm-command.el b/elpa/helm-20150426.2119/helm-command.el new file mode 100644 index 00000000..e17d2a0b --- /dev/null +++ b/elpa/helm-20150426.2119/helm-command.el @@ -0,0 +1,254 @@ +;;; helm-command.el --- Helm execute-exended-command. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-mode) +(require 'helm-elisp) + + +(defgroup helm-command nil + "Emacs command related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-M-x-requires-pattern 0 + "Value of requires-pattern for `helm-M-x'. +Show all candidates on startup when 0 (default)." + :group 'helm-command + :type 'boolean) + +(defcustom helm-M-x-always-save-history nil + "`helm-M-x' Save command in `extended-command-history' even when it fail." + :group 'helm-command + :type 'boolean) + +(defcustom helm-M-x-reverse-history nil + "The history source of `helm-M-x' appear in second position when non--nil." + :group 'helm-command + :type 'boolean) + +(defcustom helm-M-x-fuzzy-match nil + "Enable fuzzy matching in `helm-M-x' when non--nil.") + + +;;; Faces +;; +;; +(defgroup helm-command-faces nil + "Customize the appearance of helm-command." + :prefix "helm-" + :group 'helm-command + :group 'helm-faces) + +(defface helm-M-x-key '((t (:foreground "orange" :underline t))) + "Face used in helm-M-x to show keybinding." + :group 'helm-command-faces) + + +(defvar helm-M-x-input-history nil) + +(defvar helm-M-x-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c ?") 'helm-M-x-help) + map) + "Keymap for `helm-M-x'.") + + +(cl-defun helm-M-x-get-major-mode-command-alist (mode-map) + "Return alist of MODE-MAP." + (cl-loop for key being the key-seqs of mode-map using (key-bindings com) + for str-key = (key-description key) + for ismenu = (string-match "" str-key) + unless ismenu collect (cons str-key com))) + +(defun helm-get-mode-map-from-mode (mode) + "Guess the mode-map name according to MODE. +Some modes don't use conventional mode-map name +so we need to guess mode-map name. e.g python-mode ==> py-mode-map. +Return nil if no mode-map found." + (cl-loop ;; Start with a conventional mode-map name. + with mode-map = (intern-soft (format "%s-map" mode)) + with mode-string = (symbol-name mode) + with mode-name = (replace-regexp-in-string "-mode" "" mode-string) + while (not mode-map) + for count downfrom (length mode-name) + ;; Return when no result after parsing entire string. + when (eq count 0) return nil + for sub-name = (substring mode-name 0 count) + do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode")))) + finally return mode-map)) + +(defun helm-M-x-current-mode-map-alist () + "Return mode-map alist of current `major-mode'." + (let ((map (helm-get-mode-map-from-mode major-mode))) + (when (and map (boundp map)) + (helm-M-x-get-major-mode-command-alist (symbol-value map))))) + + +(defun helm-M-x-transformer-1 (candidates &optional sort) + "Transformer function to show bindings in emacs commands. +Show global bindings and local bindings according to current `major-mode'. +If SORT is non nil sort list with `helm-generic-sort-fn'. +Note that SORT should not be used when fuzzy matching because +fuzzy matching is running its own sort function with a different algorithm." + (with-helm-current-buffer + (cl-loop with local-map = (helm-M-x-current-mode-map-alist) + for cand in candidates + for local-key = (car (rassq cand local-map)) + for key = (substitute-command-keys (format "\\[%s]" cand)) + collect + (cons (cond ((and (string-match "^M-x" key) local-key) + (format "%s (%s)" + cand (propertize + local-key + 'face 'helm-M-x-key))) + ((string-match "^M-x" key) cand) + (t (format "%s (%s)" + cand (propertize + key + 'face 'helm-M-x-key)))) + cand) + into ls + finally return + (if sort (sort ls #'helm-generic-sort-fn) ls)))) + +(defun helm-M-x-transformer (candidates _source) + "Transformer function for `helm-M-x' candidates." + (helm-M-x-transformer-1 candidates (null helm--in-fuzzy))) + +(defun helm-M-x-transformer-hist (candidates _source) + "Transformer function for `helm-M-x' candidates." + (helm-M-x-transformer-1 candidates)) + +(defun helm-M-x--notify-prefix-arg () + ;; Notify a prefix-arg set AFTER calling M-x. + (when prefix-arg + (with-helm-window + (helm-display-mode-line (helm-get-current-source) 'force)))) + +(defun helm-M-x-read-extended-command () + "Read command name to invoke in `helm-M-x'. +Helm completion is not provided when executing or defining +kbd macros." + (if (or defining-kbd-macro executing-kbd-macro) + (if helm-mode + (unwind-protect + (progn + (helm-mode -1) + (read-extended-command)) + (helm-mode 1)) + (read-extended-command)) + (let* (in-help + help-cand + (orig-fuzzy-sort-fn helm-fuzzy-sort-fn) + (helm-fuzzy-sort-fn (lambda (candidates source) + (funcall orig-fuzzy-sort-fn + candidates source 'real))) + (helm--mode-line-display-prefarg t) + (pers-help + #'(lambda (candidate) + (let ((hbuf (get-buffer (help-buffer)))) + (if (and in-help (string= candidate help-cand) + (null helm-persistent-action-use-special-display)) + (progn + ;; When M-x is started from a help buffer, + ;; Don't kill it as it is helm-current-buffer. + (unless (equal hbuf helm-current-buffer) + (kill-buffer hbuf) + (set-window-buffer (get-buffer-window hbuf) + helm-current-buffer)) + (setq in-help nil)) + (helm-describe-function candidate) + (setq in-help t)) + (setq help-cand candidate)))) + (tm (run-at-time 1 0.1 'helm-M-x--notify-prefix-arg))) + (setq extended-command-history + (cl-loop for i in extended-command-history + when (commandp (intern i)) + do (set-text-properties 0 (length i) nil i) + and collect i)) + (unwind-protect + (let ((msg "Error: Specifying a prefix arg before calling `helm-M-x'")) + (when current-prefix-arg + (ding) + (message "%s" msg) + (while (not (sit-for 1)) + (discard-input)) + (user-error msg)) + (setq current-prefix-arg nil) + (helm-comp-read + "M-x " obarray + :test 'commandp + :requires-pattern helm-M-x-requires-pattern + :name "Emacs Commands" + :buffer "*helm M-x*" + :persistent-action pers-help + :persistent-help "Describe this command" + :history extended-command-history + :reverse-history helm-M-x-reverse-history + :del-input nil + :mode-line helm-M-x-mode-line + :must-match t + :fuzzy helm-M-x-fuzzy-match + :nomark t + :keymap helm-M-x-map + :candidates-in-buffer t + :fc-transformer 'helm-M-x-transformer + :hist-fc-transformer 'helm-M-x-transformer-hist)) + (cancel-timer tm) + (setq helm--mode-line-display-prefarg nil))))) + +;;;###autoload +(defun helm-M-x (arg &optional command-name) + "Preconfigured `helm' for Emacs commands. +It is `helm' replacement of regular `M-x' `execute-extended-command'. + +Unlike regular `M-x' emacs vanilla `execute-extended-command' command, +the prefix args if needed, are passed AFTER starting `helm-M-x'. + +You can get help on each command by persistent action." + (interactive (list current-prefix-arg (helm-M-x-read-extended-command))) + (let ((sym-com (and (stringp command-name) (intern-soft command-name)))) + ;; Avoid having `this-command' set to *exit-minibuffer. + (setq this-command sym-com + ;; Handle C-x z (repeat) Issue #322 + real-this-command sym-com) + ;; If helm-M-x is called with regular emacs completion (kmacro) + ;; use the value of arg otherwise use helm-current-prefix-arg. + (let ((prefix-arg (or helm-current-prefix-arg arg))) + ;; This ugly construct is to save history even on error. + (unless helm-M-x-always-save-history + (command-execute sym-com 'record)) + (setq extended-command-history + (cons command-name + (delete command-name extended-command-history))) + (when helm-M-x-always-save-history + (command-execute sym-com 'record))))) + + +(provide 'helm-command) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-command.el ends here diff --git a/elpa/helm-20150426.2119/helm-config.el b/elpa/helm-20150426.2119/helm-config.el new file mode 100644 index 00000000..2d4eb23e --- /dev/null +++ b/elpa/helm-20150426.2119/helm-config.el @@ -0,0 +1,228 @@ +;;; helm-config.el --- Applications library for `helm.el' -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + + +;;; Require +;; +;; +(require 'easymenu) +(require 'helm-aliases) +(require 'async-bytecomp nil t) + + +(defgroup helm-config nil + "Various configurations for Helm." + :group 'helm) + +(defcustom helm-command-prefix-key "C-x c" + "The key `helm-command-prefix' is bound to in the global map." + :type '(choice (string :tag "Key") (const :tag "no binding")) + :group 'helm-config + :set + (lambda (var key) + (when (and (boundp var) (symbol-value var)) + (define-key (current-global-map) + (read-kbd-macro (symbol-value var)) nil)) + (when key + (define-key (current-global-map) + (read-kbd-macro key) 'helm-command-prefix)) + (set var key))) + +(defcustom helm-minibuffer-history-key "C-r" + "The key `helm-minibuffer-history' is bound to in minibuffer local maps." + :type '(choice (string :tag "Key") (const :tag "no binding")) + :group 'helm-config + :set + (lambda (var key) + (cl-dolist (map '(minibuffer-local-completion-map + minibuffer-local-filename-completion-map + minibuffer-local-filename-must-match-map ; Emacs 23.1.+ + minibuffer-local-isearch-map + minibuffer-local-map + minibuffer-local-must-match-filename-map ; Older Emacsen + minibuffer-local-must-match-map + minibuffer-local-ns-map)) + (when (and (boundp map) (keymapp (symbol-value map))) + (when (and (boundp var) (symbol-value var)) + (define-key (symbol-value map) + (read-kbd-macro (symbol-value var)) nil)) + (when key + (define-key (symbol-value map) + (read-kbd-macro key) 'helm-minibuffer-history)))) + (set var key))) + +;;; Command Keymap +;; +;; +(defvar helm-command-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "a") 'helm-apropos) + (define-key map (kbd "e") 'helm-etags-select) + (define-key map (kbd "l") 'helm-locate) + (define-key map (kbd "s") 'helm-surfraw) + (define-key map (kbd "r") 'helm-regexp) + (define-key map (kbd "m") 'helm-man-woman) + (define-key map (kbd "t") 'helm-top) + (define-key map (kbd "/") 'helm-find) + (define-key map (kbd "i") 'helm-semantic-or-imenu) + (define-key map (kbd "") 'helm-lisp-completion-at-point) + (define-key map (kbd "p") 'helm-list-emacs-process) + (define-key map (kbd "C-x r b") 'helm-filtered-bookmarks) + (define-key map (kbd "M-y") 'helm-show-kill-ring) + (define-key map (kbd "C-c ") 'helm-all-mark-rings) + (define-key map (kbd "C-x C-f") 'helm-find-files) + (define-key map (kbd "f") 'helm-multi-files) + (define-key map (kbd "C-:") 'helm-eval-expression-with-eldoc) + (define-key map (kbd "C-,") 'helm-calcul-expression) + (define-key map (kbd "M-x") 'helm-M-x) + (define-key map (kbd "M-s o") 'helm-occur) + (define-key map (kbd "M-g s") 'helm-do-grep) + (define-key map (kbd "c") 'helm-colors) + (define-key map (kbd "F") 'helm-select-xfont) + (define-key map (kbd "8") 'helm-ucs) + (define-key map (kbd "C-c f") 'helm-recentf) + (define-key map (kbd "C-c g") 'helm-google-suggest) + (define-key map (kbd "h i") 'helm-info-at-point) + (define-key map (kbd "h r") 'helm-info-emacs) + (define-key map (kbd "h g") 'helm-info-gnus) + (define-key map (kbd "C-x C-b") 'helm-buffers-list) + (define-key map (kbd "C-x r i") 'helm-register) + (define-key map (kbd "C-c C-x") 'helm-run-external-command) + (define-key map (kbd "b") 'helm-resume) + map)) + +;; Don't override the keymap we just defined with an empty +;; keymap. This also protect bindings changed by the user. +(defvar helm-command-prefix) +(define-prefix-command 'helm-command-prefix) +(fset 'helm-command-prefix helm-command-map) +(setq helm-command-prefix helm-command-map) + + +;;; Menu +;; +;; +(easy-menu-add-item + nil '("Tools") + '("Helm" + ["Find any Files/Buffers" helm-multi-files t] + ["Helm Everywhere (Toggle)" helm-mode t] + ["Helm resume" helm-resume t] + "----" + ("Files" + ["Find files" helm-find-files t] + ["Recent Files" helm-recentf t] + ["Locate" helm-locate t] + ["Search Files with find" helm-find t] + ["Bookmarks" helm-filtered-bookmarks t]) + ("Buffers" + ["Find buffers" helm-buffers-list t]) + ("Commands" + ["Emacs Commands" helm-M-x t] + ["Externals Commands" helm-run-external-command t]) + ("Help" + ["Helm Apropos" helm-apropos t]) + ("Info" + ["Info at point" helm-info-at-point t] + ["Emacs Manual index" helm-info-emacs t] + ["Gnus Manual index" helm-info-gnus t]) + ("Org" + ["Org keywords" helm-org-keywords t] + ["Org headlines" helm-org-headlines t]) + ("Tools" + ["Occur" helm-occur t] + ["Grep" helm-do-grep t] + ["Etags" helm-etags-select t] + ["Lisp complete at point" helm-lisp-completion-at-point t] + ["Browse Kill ring" helm-show-kill-ring t] + ["Browse register" helm-register t] + ["Mark Ring" helm-all-mark-rings t] + ["Regexp handler" helm-regexp t] + ["Colors & Faces" helm-colors t] + ["Show xfonts" helm-select-xfont t] + ["Ucs Symbols" helm-ucs t] + ["Imenu" helm-imenu t] + ["Semantic or Imenu" helm-semantic-or-imenu t] + ["Google Suggest" helm-google-suggest t] + ["Eval expression" helm-eval-expression-with-eldoc t] + ["Calcul expression" helm-calcul-expression t] + ["Man pages" helm-man-woman t] + ["Top externals process" helm-top t] + ["Emacs internals process" helm-list-emacs-process t]) + "----" + ["Preferred Options" helm-configuration t]) + "Spell Checking") + +(easy-menu-add-item nil '("Tools") '("----") "Spell Checking") + + +;;;###autoload +(defun helm-configuration () + "Customize `helm'." + (interactive) + (customize-group "helm")) + + +;;; Fontlock +(cl-dolist (mode '(emacs-lisp-mode lisp-interaction-mode)) + (font-lock-add-keywords + mode + '(("(\\<\\(with-helm-after-update-hook\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-temp-hook\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-window\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-quittable\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-current-buffer\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-buffer\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-show-completion\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-default-directory\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-display-same-window\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(with-helm-restore-variables\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(define-helm-type-attribute\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(helm-multi-key-defun\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(helm-while-no-input\\)\\>" 1 font-lock-keyword-face) + ("(\\<\\(helm-aif\\)\\>" 1 font-lock-keyword-face)))) + + +;;; Compatibility emacs-24.4+ +;; Inlined from Emacs trunk. +(defalias 'function-put + ;; We don't want people to just use `put' because we can't conveniently + ;; hook into `put' to remap old properties to new ones. But for now, there's + ;; no such remapping, so we just call `put'. + #'(lambda (f prop value) (put f prop value)) + "Set function F's property PROP to VALUE. +The namespace for PROP is shared with symbols. +So far, F can only be a symbol, not a lambda expression.") + + +;;; Load the autoload file +;; It should have been generated either by +;; package.el or the make file. + +(load "helm-autoloads" nil t) + +(provide 'helm-config) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-config.el ends here diff --git a/elpa/helm-20150426.2119/helm-dabbrev.el b/elpa/helm-20150426.2119/helm-dabbrev.el new file mode 100644 index 00000000..d71f9a70 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-dabbrev.el @@ -0,0 +1,338 @@ +;;; helm-dabbrev.el --- Helm implementation of dabbrev. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'helm) +(require 'helm-elisp) ; For show-completion. + +(defgroup helm-dabbrev nil + "Dabbrev related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-dabbrev-always-search-all t + "Always search in all buffers when non--nil. +Note that even if nil, a search in all buffers +will occur if the length of candidates is <= than +`helm-dabbrev-max-length-result'." + :group 'helm-dabbrev + :type 'boolean) + +(defcustom helm-dabbrev-max-length-result 20 + "Max length of candidates before searching in all buffers. +If number of candidates found in current-buffer is <= to this, +search in all buffers. +Have no effect when `helm-dabbrev-always-search-all' is non--nil." + :group 'helm-dabbrev + :type 'integer) + +(defcustom helm-dabbrev-ignored-buffers-regexps + '("\\*helm" "\\*Messages" "\\*Echo Area" "\\*Buffer List") + "List of regexps matching names of buffers that helm-dabbrev should not check." + :group 'helm-dabbrev + :type '(repeat regexp)) + +(defcustom helm-dabbrev-related-buffer-fn #'helm-dabbrev--same-major-mode-p + "A function that decide if a buffer to search in is related to `current-buffer'. +This is actually determined by comparing `major-mode' of the buffer to search +and the `current-buffer'. +The function take one arg, the buffer which is current, look at +`helm-dabbrev--same-major-mode-p' for example. + +When nil all buffers are considered related to `current-buffer'." + :group 'helm-dabbrev + :type 'function) + +(defcustom helm-dabbrev-major-mode-assoc + '((emacs-lisp-mode . lisp-interaction-mode)) + "Major mode association alist. +This allow helm-dabbrev searching in buffers with the associated `major-mode'. +e.g \(emacs-lisp-mode . lisp-interaction-mode\) +will allow searching in the lisp-interaction-mode buffer when `current-buffer' +is an `emacs-lisp-mode' buffer and vice versa i.e +no need to provide \(lisp-interaction-mode . emacs-lisp-mode\) association. + +When nil check is the searched buffer have same `major-mode' +than the `current-buffer'. +This have no effect when `helm-dabbrev-related-buffer-fn' is nil or of course +bound to a function that doesn't handle this var." + :type '(alist :key-type symbol :value-type symbol) + :group 'helm-dabbrev) + +(defcustom helm-dabbrev-lineno-around 30 + "Search first in this number of lines before an after point." + :group 'helm-dabbrev + :type 'integer) + +(defcustom helm-dabbrev-cycle-threshold nil + "Number of time helm-dabbrev cycle before displaying helm completion. +When nil or 0 disable cycling." + :group 'helm-dabbrev + :type '(choice (const :tag "Cycling disabled" nil) integer)) + +(defcustom helm-dabbrev-case-fold-search 'smart + "Set `case-fold-search' in `helm-dabbrev'. +Same as `helm-case-fold-search' but for `helm-dabbrev'. +Note that this is not affecting searching in helm buffer, +but the initial search for all candidates in buffer(s)." + :group 'helm-dabbrev + :type '(choice (const :tag "Ignore case" t) + (const :tag "Respect case" nil) + (other :tag "Smart" 'smart))) + + +(defvar helm-dabbrev-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-/") 'helm-next-line) + (define-key map (kbd "M-:") 'helm-previous-line) + map)) + +;; Internal +(defvar helm-dabbrev--exclude-current-buffer-flag nil) +(defvar helm-dabbrev--cache nil) +(defvar helm-dabbrev--data nil) +(defvar helm-dabbrev--regexp "\\s-\\|\t\\|[(\[\{\"'`=<$;]\\|\\s\\\\|^\\|\\.") +(cl-defstruct helm-dabbrev-info dabbrev limits iterator) + + +(defun helm-dabbrev--buffer-list () + (cl-loop with lst = (buffer-list) + for buf in (if helm-dabbrev--exclude-current-buffer-flag + (cdr lst) lst) + unless (cl-loop for r in helm-dabbrev-ignored-buffers-regexps + thereis (string-match r (buffer-name buf))) + collect buf)) + +(defun helm-dabbrev--same-major-mode-p (start-buffer) + ;; START-BUFFER is the current-buffer where we start searching. + ;; Determine the major-mode of START-BUFFER as `cur-maj-mode'. + ;; Each time the loop go in another buffer we try to find if its + ;; `major-mode' is: + ;; - same as the `cur-maj-mode' + ;; - derived from `cur-maj-mode' + ;; - have an assoc entry (major-mode . cur-maj-mode) + ;; - have an rassoc entry (cur-maj-mode . major-mode) + ;; - check if one of these entries inherit from another one in + ;; `helm-dabbrev-major-mode-assoc'. + (let* ((cur-maj-mode (with-current-buffer start-buffer major-mode)) + (c-assoc-mode (assq cur-maj-mode helm-dabbrev-major-mode-assoc)) + (c-rassoc-mode (rassq cur-maj-mode helm-dabbrev-major-mode-assoc)) + (o-assoc-mode (assq major-mode helm-dabbrev-major-mode-assoc)) + (o-rassoc-mode (rassq major-mode helm-dabbrev-major-mode-assoc)) + (cdr-c-assoc-mode (cdr c-assoc-mode)) + (cdr-o-assoc-mode (cdr o-assoc-mode))) + (or (eq major-mode cur-maj-mode) + (derived-mode-p cur-maj-mode) + (or (eq cdr-c-assoc-mode major-mode) + (eq (car c-rassoc-mode) major-mode) + (eq (cdr (assq cdr-c-assoc-mode helm-dabbrev-major-mode-assoc)) + major-mode) + (eq (car (rassq cdr-c-assoc-mode helm-dabbrev-major-mode-assoc)) + major-mode)) + (or (eq cdr-o-assoc-mode cur-maj-mode) + (eq (car o-rassoc-mode) cur-maj-mode) + (eq (cdr (assq cdr-o-assoc-mode helm-dabbrev-major-mode-assoc)) + cur-maj-mode) + (eq (car (rassq cdr-o-assoc-mode helm-dabbrev-major-mode-assoc)) + cur-maj-mode))))) + +(defun helm-dabbrev--collect (str limit ignore-case all) + (let* ((case-fold-search ignore-case) + (buffer1 (current-buffer)) ; start buffer. + (minibuf (minibufferp buffer1)) + result pos-before pos-after + (search-and-store + #'(lambda (pattern direction) + (while (cl-case direction + (1 (search-forward pattern nil t)) + (-1 (search-backward pattern nil t)) + (2 (let ((pos + (save-excursion + (forward-line + helm-dabbrev-lineno-around) + (point)))) + (setq pos-after pos) + (search-forward pattern pos t))) + (-2 (let ((pos + (save-excursion + (forward-line + (- helm-dabbrev-lineno-around)) + (point)))) + (setq pos-before pos) + (search-backward pattern pos t)))) + (let* ((match-1 (helm-aif (thing-at-point 'symbol) + ;; `thing-at-point' returns + ;; the quote outside of e-lisp mode, + ;; e.g in message mode, + ;; `foo' => foo' + ;; but in e-lisp like modes: + ;; `foo' => foo + ;; so remove it [1]. + (replace-regexp-in-string + "[']\\'" "" (substring-no-properties it)))) + (match-2 (helm-aif (thing-at-point 'filename) + ;; Same as in [1]. + (replace-regexp-in-string + "[']\\'" "" (substring-no-properties it)))) + (lst (if (string= match-1 match-2) + (list match-1) + (list match-1 match-2)))) + (cl-loop for match in lst + unless (or (string= str match) + (member match result)) + do (push match result))))))) + (cl-loop for buf in (if all (helm-dabbrev--buffer-list) + (list (current-buffer))) + + do (with-current-buffer buf + (when (or minibuf ; check against all buffers when in minibuffer. + (if helm-dabbrev-related-buffer-fn + (funcall helm-dabbrev-related-buffer-fn buffer1) + t)) + (save-excursion + ;; Start searching before thing before point. + (goto-char (- (point) (length str))) + ;; Search the last 30 lines before point. + (funcall search-and-store str -2)) ; store pos [1] + (save-excursion + ;; Search the next 30 lines after point. + (funcall search-and-store str 2)) ; store pos [2] + (save-excursion + ;; Search all before point. + (goto-char pos-before) ; start from [1] + (funcall search-and-store str -1)) + (save-excursion + ;; Search all after point. + (goto-char pos-after) ; start from [2] + (funcall search-and-store str 1)))) + when (> (length result) limit) return (nreverse result) + finally return (nreverse result)))) + +(defun helm-dabbrev--get-candidates (abbrev) + (cl-assert abbrev nil "[No Match]") + (with-current-buffer (current-buffer) + (let* ((dabbrev-get #'(lambda (str all-bufs) + (helm-dabbrev--collect + str helm-candidate-number-limit + (cl-case helm-dabbrev-case-fold-search + (smart (helm-set-case-fold-search-1 abbrev)) + (t helm-dabbrev-case-fold-search)) + all-bufs))) + (lst (funcall dabbrev-get abbrev helm-dabbrev-always-search-all))) + (if (and (not helm-dabbrev-always-search-all) + (<= (length lst) helm-dabbrev-max-length-result)) + ;; Search all but don't recompute current-buffer. + (let ((helm-dabbrev--exclude-current-buffer-flag t)) + (append lst (funcall dabbrev-get abbrev 'all-bufs))) + lst)))) + +(defun helm-dabbrev-default-action (candidate) + (with-helm-current-buffer + (let* ((limits (helm-bounds-of-thing-before-point + helm-dabbrev--regexp)) + (beg (car limits)) + (end (point))) + (run-with-timer + 0.01 nil + 'helm-insert-completion-at-point + beg end candidate)))) + +;;;###autoload +(defun helm-dabbrev () + (interactive) + (let ((dabbrev (helm-thing-before-point nil helm-dabbrev--regexp)) + (limits (helm-bounds-of-thing-before-point helm-dabbrev--regexp)) + (enable-recursive-minibuffers t) + (cycling-disabled-p (or (null helm-dabbrev-cycle-threshold) + (zerop helm-dabbrev-cycle-threshold))) + (helm-execute-action-at-once-if-one t) + (helm-quit-if-no-candidate + #'(lambda () + (message "[Helm-dabbrev: No expansion found]")))) + (cl-assert (and (stringp dabbrev) (not (string= dabbrev ""))) + nil "[Helm-dabbrev: Nothing found before point]") + (when (and + ;; have been called at least once. + (helm-dabbrev-info-p helm-dabbrev--data) + ;; But user have moved with some other command + ;; in the meaning time. + (not (eq last-command 'helm-dabbrev))) + (setq helm-dabbrev--data nil)) + (when cycling-disabled-p + (setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev))) + (unless (or cycling-disabled-p + (helm-dabbrev-info-p helm-dabbrev--data)) + (setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev)) + (setq helm-dabbrev--data (make-helm-dabbrev-info + :dabbrev dabbrev + :limits limits + :iterator + (helm-iter-list + (cl-loop for i in helm-dabbrev--cache when + (and i (string-match + (concat "^" (regexp-quote dabbrev)) i)) + collect i into selection + when (and selection + (= (length selection) + helm-dabbrev-cycle-threshold)) + ;; When selection len reach + ;; `helm-dabbrev-cycle-threshold' + ;; return selection. + return selection + ;; selection len never reach + ;; `helm-dabbrev-cycle-threshold' + ;; return selection. + finally return selection))))) + (let ((iter (and (helm-dabbrev-info-p helm-dabbrev--data) + (helm-dabbrev-info-iterator helm-dabbrev--data))) + deactivate-mark) + (helm-aif (and iter (helm-iter-next iter)) + (progn + (helm-insert-completion-at-point + (car (helm-dabbrev-info-limits helm-dabbrev--data)) + (cdr limits) it) + ;; Move already tried candidates to end of list. + (setq helm-dabbrev--cache (append (remove it helm-dabbrev--cache) + (list it)))) + (unless cycling-disabled-p + (delete-region (car limits) (point)) + (setq dabbrev (helm-dabbrev-info-dabbrev helm-dabbrev--data) + limits (helm-dabbrev-info-limits helm-dabbrev--data)) + (setq helm-dabbrev--data nil) + (insert dabbrev)) + (with-helm-show-completion (car limits) (cdr limits) + (helm :sources (helm-build-in-buffer-source "Dabbrev Expand" + :data helm-dabbrev--cache + :persistent-action 'ignore + :persistent-help "DoNothing" + :keymap helm-dabbrev-map + :action 'helm-dabbrev-default-action) + :buffer "*helm dabbrev*" + :input (concat "^" dabbrev " ") + :resume 'noresume + :allow-nest t)))))) + +(provide 'helm-dabbrev) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-dabbrev.el ends here diff --git a/elpa/helm-20150426.2119/helm-elisp-package.el b/elpa/helm-20150426.2119/helm-elisp-package.el new file mode 100644 index 00000000..dfb33a30 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-elisp-package.el @@ -0,0 +1,315 @@ +;;; helm-elisp-package.el --- helm interface for package.el -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: +(require 'cl-lib) +(require 'helm) +(require 'package) + +(defgroup helm-el-package nil + "helm elisp packages." + :group 'helm) + +(defcustom helm-el-package-initial-filter 'all + "Show only installed, upgraded or all packages at startup." + :group 'helm-el-package + :type '(radio :tag "Initial filter for elisp packages" + (const :tag "Show all packages" all) + (const :tag "Show installed packages" installed) + (const :tag "Show upgradable packages" upgrade))) + +;; internals vars +(defvar helm-el-package--show-only 'all) +(defvar helm-el-package--initialized-p nil) +(defvar helm-el-package--tabulated-list nil) +(defvar helm-el-package--upgrades nil) +(defvar helm-el-package--removable-packages nil) + +(defun helm-el-package--init () + (when (null package-alist) + (setq helm-el-package--show-only 'all)) + (when (fboundp 'package--removable-packages) + (setq helm-el-package--removable-packages + (package--removable-packages))) + (save-selected-window + (list-packages helm-el-package--initialized-p) + (setq helm-el-package--initialized-p t) + (message nil)) + (helm-init-candidates-in-buffer + 'global + (with-current-buffer (get-buffer "*Packages*") + (setq helm-el-package--tabulated-list tabulated-list-entries) + (buffer-string))) + (setq helm-el-package--upgrades (helm-el-package-menu--find-upgrades)) + (if helm-force-updating-p + (message "Refreshing packages list done") + (setq helm-el-package--show-only helm-el-package-initial-filter)) + (kill-buffer "*Packages*")) + +(defun helm-el-package-describe (candidate) + (let ((id (get-text-property 0 'tabulated-list-id candidate))) + (describe-package (if (fboundp 'package-desc-name) + (package-desc-name id) + (car id))))) + +(defun helm-el-package-install-1 (pkg-list) + (cl-loop with mkd = pkg-list + for p in mkd + for id = (get-text-property 0 'tabulated-list-id p) + do (package-install + (if (fboundp 'package-desc-name) + (package-desc-name id) + (car id))) + collect (if (fboundp 'package-desc-full-name) + id + (car id)) + into installed-list + finally do (progn + (when (boundp 'package-selected-packages) + (customize-save-variable + 'package-selected-packages + (append (mapcar 'package-desc-name installed-list) + package-selected-packages))) + (if (fboundp 'package-desc-full-name) + (message (format "%d packages installed:\n(%s)" + (length installed-list) + (mapconcat #'package-desc-full-name + installed-list ", "))) + (message (format "%d packages installed:\n(%s)" + (length installed-list) + (mapconcat 'symbol-name installed-list ", "))))))) + +(defun helm-el-package-install (_candidate) + (helm-el-package-install-1 (helm-marked-candidates))) + +(defun helm-el-package-uninstall-1 (pkg-list) + (cl-loop with mkd = pkg-list + for p in mkd + for id = (get-text-property 0 'tabulated-list-id p) + do + (condition-case-unless-debug err + (with-no-warnings + (if (fboundp 'package-desc-full-name) + ;; emacs 24.4 + (package-delete id) + ;; emacs 24.3 + (package-delete (symbol-name (car id)) + (package-version-join (cdr id))))) + (error (message (cadr err)))) + unless (assoc (elt id 1) package-alist) + collect (if (fboundp 'package-desc-full-name) + id + (cons (symbol-name (car id)) + (package-version-join (cdr id)))) + into delete-list + finally do (if delete-list + (if (fboundp 'package-desc-full-name) + ;; emacs 24.4 + (message (format "%d packages deleted:\n(%s)" + (length delete-list) + (mapconcat #'package-desc-full-name + delete-list ", "))) + ;; emacs 24.3 + (message (format "%d packages deleted:\n(%s)" + (length delete-list) + (mapconcat (lambda (x) + (concat (car x) "-" (cdr x))) + delete-list ", "))) + ;; emacs 24.3 doesn't update + ;; its `package-alist' after deleting. + (cl-loop for p in package-alist + when (assq (symbol-name (car p)) delete-list) + do (setq package-alist (delete p package-alist)))) + "No package deleted"))) + +(defun helm-el-package-uninstall (_candidate) + (helm-el-package-uninstall-1 (helm-marked-candidates))) + +(defun helm-el-package-menu--find-upgrades () + (cl-loop for entry in helm-el-package--tabulated-list + for pkg-desc = (car entry) + for status = (package-desc-status pkg-desc) + when (member status '("installed" "unsigned" "dependency")) + collect pkg-desc + into installed + when (member status '("available" "new")) + collect (cons (package-desc-name pkg-desc) pkg-desc) + into available + finally return + (cl-loop for pkg in installed + for avail-pkg = (assq (package-desc-name pkg) available) + when (and avail-pkg + (version-list-< (package-desc-version pkg) + (package-desc-version + (cdr avail-pkg)))) + collect avail-pkg))) + +(defun helm-el-package-upgrade-1 (pkg-list) + (cl-loop for p in pkg-list + for pkg-desc = (car p) + for upgrade = (cdr (assq (package-desc-name pkg-desc) + helm-el-package--upgrades)) + do + (cond ((null upgrade) + (ignore)) + ((equal pkg-desc upgrade) + ;;Install. + (package-install pkg-desc)) + (t + ;; Delete. + (if (boundp 'package-selected-packages) + (with-no-warnings + (package-delete pkg-desc t t)) + (package-delete pkg-desc)))))) + +(defun helm-el-package-upgrade (_candidate) + (helm-el-package-upgrade-1 + (cl-loop with pkgs = (helm-marked-candidates) + for p in helm-el-package--tabulated-list + for pkg = (car p) + if (member (symbol-name (package-desc-name pkg)) pkgs) + collect p))) + +(defun helm-el-package-upgrade-all () + (if helm-el-package--upgrades + (with-helm-display-marked-candidates + helm-marked-buffer-name (mapcar (lambda (x) (symbol-name (car x))) + helm-el-package--upgrades) + (when (y-or-n-p "Upgrade all packages? ") + (helm-el-package-upgrade-1 helm-el-package--tabulated-list))) + (message "No packages to upgrade actually!"))) + +(defun helm-el-package-upgrade-all-action (_candidate) + (helm-el-package-upgrade-all)) + +(defun helm-el-package--transformer (candidates _source) + (cl-loop for c in candidates + for id = (get-text-property 0 'tabulated-list-id c) + for name = (if (fboundp 'package-desc-name) + (package-desc-name id) + (car id)) + for installed-p = (assq name package-alist) + for upgrade-p = (assq name helm-el-package--upgrades) + for user-installed-p = (and (boundp 'package-selected-packages) + (memq name package-selected-packages)) + do (when user-installed-p (put-text-property 0 2 'display "S " c)) + do (when (memq name helm-el-package--removable-packages) + (put-text-property 0 2 'display "U " c) + (put-text-property + 2 (+ (length (symbol-name name)) 2) + 'face 'font-lock-variable-name-face c)) + for cand = (cons c (car (split-string c))) + when (or (and upgrade-p + (eq helm-el-package--show-only 'upgrade)) + (and installed-p + (eq helm-el-package--show-only 'installed)) + (and (not installed-p) + (eq helm-el-package--show-only 'uninstalled)) + (eq helm-el-package--show-only 'all)) + collect cand)) + +(defun helm-el-package-show-upgrade () + (interactive) + (with-helm-alive-p + (setq helm-el-package--show-only 'upgrade) + (helm-update))) + +(defun helm-el-package-show-installed () + (interactive) + (with-helm-alive-p + (setq helm-el-package--show-only 'installed) + (helm-update))) + +(defun helm-el-package-show-all () + (interactive) + (with-helm-alive-p + (setq helm-el-package--show-only 'all) + (helm-update))) + +(defun helm-el-package-show-uninstalled () + (interactive) + (with-helm-alive-p + (setq helm-el-package--show-only 'uninstalled) + (helm-update))) + +(defvar helm-el-package-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-I") 'helm-el-package-show-installed) + (define-key map (kbd "M-U") 'helm-el-package-show-upgrade) + (define-key map (kbd "M-A") 'helm-el-package-show-all) + (define-key map (kbd "C-c ?") 'helm-el-package-help) + map)) + +(defvar helm-source-list-el-package nil) +(defclass helm-list-el-package-source (helm-source-in-buffer) + ((init :initform 'helm-el-package--init) + (get-line :initform 'buffer-substring) + (filtered-candidate-transformer :initform 'helm-el-package--transformer) + (action-transformer + :initform + (lambda (actions candidate) + (let ((pkg-desc (get-text-property + 0 'tabulated-list-id candidate)) + (acts (if helm-el-package--upgrades + (append actions '(("Upgrade all packages" + . helm-el-package-upgrade-all-action))) + actions))) + (cond ((cdr (assq (package-desc-name pkg-desc) + helm-el-package--upgrades)) + (append '(("Upgrade package" . helm-el-package-upgrade)) acts)) + ((package-installed-p (package-desc-name pkg-desc)) + (append acts '(("Reinstall package" . helm-el-package-reinstall) + ("Uninstall" . helm-el-package-uninstall)))) + (t (append acts '(("Install" . helm-el-package-install)))))))) + (mode-line :initform helm-el-package-mode-line) + (keymap :initform helm-el-package-map) + (update :initform 'helm-el-package--update) + (candidate-number-limit :initform 9999) + (action :initform '(("Describe" . helm-el-package-describe))))) + +(defun helm-el-package--update () + (setq helm-el-package--initialized-p nil)) + +(defun helm-el-package-reinstall (_pkg) + (cl-loop for p in (helm-marked-candidates) + for pkg-desc = (get-text-property 0 'tabulated-list-id p) + for name = (package-desc-name pkg-desc) + do (if (fboundp 'package-reinstall) + (package-reinstall name) + (package-delete pkg-desc) + (package-install name)))) + +;;;###autoload +(defun helm-list-elisp-packages (arg) + (interactive "P") + (when arg (setq helm-el-package--initialized-p nil)) + (unless helm-source-list-el-package + (setq helm-source-list-el-package + (helm-make-source "list packages" 'helm-list-el-package-source))) + (helm :sources 'helm-source-list-el-package + :buffer "*helm list packages*")) + +;;;###autoload +(defun helm-list-elisp-packages-no-fetch () + (interactive) + (let ((helm-el-package--initialized-p t)) + (helm-list-elisp-packages nil))) + +(provide 'helm-elisp-package) + +;;; helm-elisp-package.el ends here diff --git a/elpa/helm-20150426.2119/helm-elisp.el b/elpa/helm-20150426.2119/helm-elisp.el new file mode 100644 index 00000000..c7dc5813 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-elisp.el @@ -0,0 +1,829 @@ +;;; helm-elisp.el --- Elisp symbols completion for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: +(require 'cl-lib) +(require 'helm) +(require 'helm-utils) +(require 'helm-info) +(require 'helm-eval) +(require 'helm-files) +(require 'advice) + + +(defgroup helm-elisp nil + "Elisp related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-turn-on-show-completion t + "Display candidate in buffer while moving selection when non--nil." + :group 'helm-elisp + :type 'boolean) + +(defcustom helm-show-completion-use-special-display t + "A special display will be used in lisp completion if non--nil. +All functions that are wrapped in macro `with-helm-show-completion' +will be affected." + :group 'helm-elisp + :type 'boolean) + +(defcustom helm-show-completion-min-window-height 7 + "Minimum completion window height used in show completion. +This is used in macro `with-helm-show-completion'." + :group 'helm-elisp + :type 'integer) + +(defcustom helm-lisp-quoted-function-list + '(funcall apply mapc cl-mapc mapcar cl-mapcar + callf callf2 cl-callf cl-callf2 fset + fboundp fmakunbound symbol-function) + "List of function where quoted function completion happen. +e.g give only function names after \(funcall '." + :group 'helm-elisp + :type '(repeat (choice symbol))) + +(defcustom helm-lisp-unquoted-function-list + '(function defadvice) + "List of function where unquoted function completion happen. +e.g give only function names after \(function ." + :group 'helm-elisp + :type '(repeat (choice symbol))) + +(defcustom helm-apropos-fuzzy-match nil + "Enable fuzzy matching for `helm-apropos' when non-nil." + :group 'helm-elisp + :type 'boolean) + +(defcustom helm-lisp-fuzzy-completion nil + "Enable fuzzy matching in emacs-lisp completion when non-nil. +NOTE: This enable fuzzy matching in helm native implementation of +elisp completion, but not on helmized elisp completion, i.e +fuzzy completion is not available in `completion-at-point'." + :group 'helm-elisp + :type 'boolean) + +(defcustom helm-apropos-function-list '(helm-def-source--emacs-commands + helm-def-source--emacs-functions + helm-def-source--eieio-classes + helm-def-source--eieio-generic + helm-def-source--emacs-variables + helm-def-source--emacs-faces + helm-def-source--helm-attributes) + "A list of functions that build helm sources to use in `helm-apropos'." + :group 'helm-elisp + :type '(repeat (choice symbol))) + + +;;; Faces +;; +;; +(defgroup helm-elisp-faces nil + "Customize the appearance of helm-elisp." + :prefix "helm-" + :group 'helm-elisp + :group 'helm-faces) + +(defface helm-lisp-show-completion + '((t (:background "DarkSlateGray"))) + "Face used for showing candidates in `helm-lisp-completion'." + :group 'helm-elisp-faces) + +(defface helm-lisp-completion-info + '((t (:foreground "red"))) + "Face used for showing info in `helm-lisp-completion'." + :group 'helm-elisp-faces) + + +;;; Show completion. +;; +;; Provide show completion with macro `with-helm-show-completion'. + +(defvar helm-show-completion-overlay nil) + +;; Called each time cursor move in helm-buffer. +(defun helm-show-completion () + (with-helm-current-buffer + (overlay-put helm-show-completion-overlay + 'display (substring-no-properties + (helm-get-selection))))) + +(defun helm-show-completion-init-overlay (beg end) + (when (and helm-turn-on-show-completion beg end) + (setq helm-show-completion-overlay (make-overlay beg end)) + (overlay-put helm-show-completion-overlay + 'face 'helm-lisp-show-completion))) + +(defun helm-show-completion-display-function (buffer &rest _args) + "A special resized helm window is used depending on position in BUFFER." + (with-selected-window (selected-window) + (if (window-dedicated-p) + (helm-default-display-buffer buffer) + (let* ((screen-size (+ (count-screen-lines (window-start) (point) t) + 1 ; mode-line + (if header-line-format 1 0))) ; header-line + (def-size (- (window-height) + helm-show-completion-min-window-height)) + (upper-height (max window-min-height (min screen-size def-size))) + split-window-keep-point) + (recenter -1) + (set-window-buffer (if (active-minibuffer-window) + (minibuffer-selected-window) + (split-window nil upper-height)) + buffer))))) + +(defmacro with-helm-show-completion (beg end &rest body) + "Show helm candidate in an overlay at point. +BEG and END are the beginning and end position of the current completion +in `helm-current-buffer'. +BODY is an helm call where we want to enable show completion. +If `helm-turn-on-show-completion' is nil just do nothing." + (declare (indent 2) (debug t)) + `(let ((helm-move-selection-after-hook + (and helm-turn-on-show-completion + (append (list 'helm-show-completion) + helm-move-selection-after-hook)))) + (with-helm-temp-hook 'helm-after-initialize-hook + (with-helm-buffer + (set (make-local-variable 'helm-display-function) + (if helm-show-completion-use-special-display + 'helm-show-completion-display-function + 'helm-default-display-buffer)))) + (unwind-protect + (progn + (helm-show-completion-init-overlay ,beg ,end) + ,@body) + (when (and helm-turn-on-show-completion + helm-show-completion-overlay + (overlayp helm-show-completion-overlay)) + (delete-overlay helm-show-completion-overlay))))) + + +;;; Lisp symbol completion. +;; +;; +(defun helm-lisp-completion--predicate-at-point (beg) + ;; Return a predicate for `all-completions'. + (let ((fn-sym-p (lambda () + (or + (and (eq (char-before) ?\ ) + (save-excursion + (skip-syntax-backward " " (point-at-bol)) + (memq (symbol-at-point) + helm-lisp-unquoted-function-list))) + (and (eq (char-before) ?\') + (save-excursion + (forward-char -1) + (eq (char-before) ?\#))))))) + (save-excursion + (goto-char beg) + (if (or + ;; Complete on all symbols in non--lisp modes (logs mail etc..) + (not (memq major-mode '(emacs-lisp-mode + lisp-interaction-mode + inferior-emacs-lisp-mode))) + (not (or (funcall fn-sym-p) + (and (eq (char-before) ?\') + (save-excursion + (forward-char (if (funcall fn-sym-p) -2 -1)) + (skip-syntax-backward " " (point-at-bol)) + (memq (symbol-at-point) + helm-lisp-quoted-function-list))) + (eq (char-before) ?\())) ; no paren before str. + ;; Looks like we are in a let statement. + (condition-case nil + (progn (up-list -2) (forward-char 1) + (eq (char-after) ?\()) + (error nil))) + (lambda (sym) + (or (boundp sym) (fboundp sym) (symbol-plist sym))) + #'fboundp)))) + +(defun helm-thing-before-point (&optional limits regexp) + "Return symbol name before point. +If REGEXP is specified return what REGEXP find before point. +By default match the beginning of symbol before point. +With LIMITS arg specified return the beginning and end position +of symbol before point." + (save-excursion + (let (beg + (end (point)) + (boundary (field-beginning nil nil (point-at-bol)))) + (if (re-search-backward (or regexp "\\_<") boundary t) + (setq beg (match-end 0)) + (setq beg boundary)) + (unless (= beg end) + (if limits + (cons beg end) + (buffer-substring-no-properties beg end)))))) + +(defun helm-bounds-of-thing-before-point (&optional regexp) + "Get the beginning and end position of `helm-thing-before-point'. +Return a cons \(beg . end\)." + (helm-thing-before-point 'limits regexp)) + +(defun helm-insert-completion-at-point (beg end str) + ;; When there is no space after point + ;; we are completing inside a symbol or + ;; after a partial symbol with the next arg aside + ;; without space, in this case mark the region. + ;; deleting it would remove the + ;; next arg which is unwanted. + (delete-region beg end) + (insert str) + (let ((pos (cdr (or (bounds-of-thing-at-point 'symbol) + ;; needed for helm-dabbrev. + (bounds-of-thing-at-point 'filename))))) + (when (and pos (< (point) pos)) + (push-mark pos t t)))) + +(defvar helm-lisp-completion--cache nil) +(defvar helm-lgst-len nil) +;;;###autoload +(defun helm-lisp-completion-at-point () + "Helm lisp symbol completion at point." + (interactive) + (setq helm-lgst-len 0) + (let* ((target (helm-thing-before-point)) + (beg (car (helm-bounds-of-thing-before-point))) + (end (point)) + (pred (and beg (helm-lisp-completion--predicate-at-point beg))) + (loc-vars (and (fboundp 'elisp--local-variables) + (ignore-errors + (mapcar #'symbol-name (elisp--local-variables))))) + (glob-syms (and target pred (all-completions target obarray pred))) + (candidates (append loc-vars glob-syms)) + (helm-quit-if-no-candidate t) + (helm-execute-action-at-once-if-one t) + (enable-recursive-minibuffers t)) + (setq helm-lisp-completion--cache (cl-loop for sym in candidates + for len = (length sym) + when (> len helm-lgst-len) + do (setq helm-lgst-len len) + collect sym)) + (if candidates + (with-helm-show-completion beg end + ;; Overlay is initialized now in helm-current-buffer. + (helm + :sources (helm-build-in-buffer-source "Lisp completion" + :data helm-lisp-completion--cache + :persistent-action 'helm-lisp-completion-persistent-action + :nomark t + :fuzzy-match helm-lisp-fuzzy-completion + :persistent-help "Show brief doc in mode-line" + :filtered-candidate-transformer 'helm-lisp-completion-transformer + :action `(lambda (candidate) + (with-helm-current-buffer + (run-with-timer + 0.01 nil + 'helm-insert-completion-at-point + ,beg ,end candidate)))) + :input (if helm-lisp-fuzzy-completion + target (concat target " ")) + :resume 'noresume + :buffer "*helm lisp completion*" + :allow-nest t)) + (message "[No Match]")))) + +(defun helm-lisp-completion-persistent-action (candidate) + (let ((cursor-in-echo-area t) + mode-line-in-non-selected-windows) + (helm-show-info-in-mode-line + (propertize + (helm-get-first-line-documentation + (intern candidate)) + 'face 'helm-lisp-completion-info)))) + +(defun helm-lisp-completion-transformer (candidates _source) + "Helm candidates transformer for lisp completion." + (cl-loop for c in candidates + for sym = (intern c) + for annot = (cl-typecase sym + (command " (Com)") + (class " (Class)") + (generic " (Gen)") + (fbound " (Fun)") + (bound " (Var)") + (face " (Face)")) + for spaces = (make-string (- helm-lgst-len (length c)) ? ) + collect (cons (concat c spaces annot) c) into lst + finally return (sort lst #'helm-generic-sort-fn))) + +(defun helm-get-first-line-documentation (sym) + "Return first line documentation of symbol SYM. +If SYM is not documented, return \"Not documented\"." + (let ((doc (cond ((fboundp sym) + (documentation sym t)) + ((boundp sym) + (documentation-property sym 'variable-documentation t)) + ((facep sym) + (face-documentation sym)) + (t nil)))) + (if (and doc (not (string= doc "")) + ;; `documentation' return "\n\n(args...)" + ;; for CL-style functions. + (not (string-match-p "^\n\n" doc))) + (car (split-string doc "\n")) + "Not documented"))) + +;;; File completion. +;; +;; Complete file name at point. + +;;;###autoload +(defun helm-complete-file-name-at-point (&optional force) + "Complete file name at point." + (interactive) + (require 'helm-mode) + (let* ((tap (thing-at-point 'filename)) + beg + (init (and tap + (or force + (save-excursion + (end-of-line) + (search-backward tap (point-at-bol) t) + (setq beg (point)) + (looking-back "[^'`( ]" 1))) + (expand-file-name + (substring-no-properties tap)))) + (end (point)) + (helm-quit-if-no-candidate t) + (helm-execute-action-at-once-if-one t) + completion) + (with-helm-show-completion beg end + (setq completion (helm-read-file-name "FileName: " + :initial-input init))) + (when (and completion (not (string= completion ""))) + (delete-region beg end) (insert (if (string-match "^~" tap) + (abbreviate-file-name completion) + completion))))) + +;;;###autoload +(defun helm-lisp-indent () + ;; It is meant to use with `helm-define-multi-key' which + ;; does not support args for functions yet, so use `current-prefix-arg' + ;; for now instead of (interactive "P"). + (interactive) + (let ((tab-always-indent (or (eq tab-always-indent 'complete) + tab-always-indent))) + (indent-for-tab-command current-prefix-arg))) + +;;;###autoload +(defun helm-lisp-completion-or-file-name-at-point () + "Complete lisp symbol or filename at point. +Filename completion happen if string start after or between a double quote." + (interactive) + (let* ((tap (thing-at-point 'filename))) + (if (and tap (save-excursion + (end-of-line) + (search-backward tap (point-at-bol) t) + (looking-back "[^'`( ]" 1))) + (helm-complete-file-name-at-point) + (helm-lisp-completion-at-point)))) + + +;;; Apropos +;; +;; +(defun helm-apropos-init (test default) + "Init candidates buffer for `helm-apropos' sources." + (require 'helm-help) + (helm-init-candidates-in-buffer 'global + (let ((default-symbol (and (stringp default) + (intern-soft default))) + (symbols (all-completions "" obarray test))) + (if (and default-symbol (funcall test default-symbol)) + (cons default-symbol symbols) + symbols)))) + +(defun helm-apropos-init-faces (default) + "Init candidates buffer for faces for `helm-apropos'." + (require 'helm-help) + (with-current-buffer (helm-candidate-buffer 'global) + (goto-char (point-min)) + (let ((default-symbol (and (stringp default) + (intern-soft default))) + (faces (face-list))) + (when (and default-symbol (facep default-symbol)) + (insert (concat default "\n"))) + (insert + (mapconcat #'prin1-to-string + (if default + (cl-remove-if (lambda (sym) (string= sym default)) faces) + faces) + "\n"))))) + +(defun helm-apropos-default-sort-fn (candidates _source) + (if (string= helm-pattern "") + candidates + (sort candidates #'helm-generic-sort-fn))) + +(defun helm-def-source--emacs-variables (&optional default) + (helm-build-in-buffer-source "Variables" + :init `(lambda () + (helm-apropos-init + (lambda (x) (and (boundp x) (not (keywordp x)))) ,default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer (and (null helm-apropos-fuzzy-match) + 'helm-apropos-default-sort-fn) + :nomark t + :action '(("Describe Variable" . helm-describe-variable) + ("Find Variable" . helm-find-variable) + ("Info lookup" . helm-info-lookup-symbol) + ("Set variable" . helm-set-variable)))) + +(defun helm-def-source--emacs-faces (&optional default) + (helm-build-in-buffer-source "Faces" + :init (lambda () (helm-apropos-init-faces default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer + (append (and (null helm-apropos-fuzzy-match) + '(helm-apropos-default-sort-fn)) + (list + (lambda (candidates _source) + (cl-loop for c in candidates + collect (propertize c 'face (intern c)))))) + :nomark t + :action (lambda (candidate) + (describe-face (intern candidate))))) + +(defun helm-def-source--helm-attributes (&optional _default) + (helm-build-sync-source "Helm attributes" + :candidates (lambda () + (mapcar 'symbol-name helm-attributes)) + :fuzzy-match helm-apropos-fuzzy-match + :nomark t + :action (lambda (candidate) + (let (special-display-buffer-names + special-display-regexps + helm-persistent-action-use-special-display) + (with-output-to-temp-buffer "*Help*" + (princ (get (intern candidate) 'helm-attrdoc))))))) + +(defun helm-def-source--emacs-commands (&optional default) + (helm-build-in-buffer-source "Commands" + :init `(lambda () + (helm-apropos-init 'commandp ,default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer (and (null helm-apropos-fuzzy-match) + 'helm-apropos-default-sort-fn) + :nomark t + :action '(("Describe Function" . helm-describe-function) + ("Find Function" . helm-find-function) + ("Info lookup" . helm-info-lookup-symbol)))) + +(defun helm-def-source--emacs-functions (&optional default) + (helm-build-in-buffer-source "Functions" + :init `(lambda () + (helm-apropos-init #'(lambda (x) + (and (fboundp x) + (not (commandp x)) + (not (generic-p x)) + (not (class-p x)))) + ,default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer (and (null helm-apropos-fuzzy-match) + 'helm-apropos-default-sort-fn) + :nomark t + :action '(("Describe Function" . helm-describe-function) + ("Find Function" . helm-find-function) + ("Info lookup" . helm-info-lookup-symbol)))) + +(defun helm-def-source--eieio-classes (&optional default) + (helm-build-in-buffer-source "Classes" + :init `(lambda () + (helm-apropos-init #'(lambda (x) + (class-p x)) + ,default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer (and (null helm-apropos-fuzzy-match) + 'helm-apropos-default-sort-fn) + :nomark t + :action '(("Describe Function" . helm-describe-function) + ("Find Function" . helm-find-function) + ("Info lookup" . helm-info-lookup-symbol)))) + +(defun helm-def-source--eieio-generic (&optional default) + (helm-build-in-buffer-source "Generic functions" + :init `(lambda () + (helm-apropos-init #'(lambda (x) + (generic-p x)) + ,default)) + :fuzzy-match helm-apropos-fuzzy-match + :filtered-candidate-transformer (and (null helm-apropos-fuzzy-match) + 'helm-apropos-default-sort-fn) + :nomark t + :action '(("Describe Function" . helm-describe-function) + ("Find Function" . helm-find-function) + ("Info lookup" . helm-info-lookup-symbol)))) + +(defun helm-info-lookup-symbol (candidate) + (let ((helm-execute-action-at-once-if-one t) + (helm-quit-if-no-candidate + `(lambda () + (message "`%s' Not Documented as a symbol" ,candidate)))) + (helm :sources '(helm-source-info-elisp + helm-source-info-cl + helm-source-info-eieio) + :resume 'noresume + :buffer "*helm lookup*" + :input candidate))) + +;;;###autoload +(defun helm-apropos () + "Preconfigured helm to describe commands, functions, variables and faces." + (interactive) + (let ((default (thing-at-point 'symbol))) + (helm :sources + (mapcar (lambda (func) + (funcall func default)) + helm-apropos-function-list) + :buffer "*helm apropos*" + :preselect (and default (concat "\\_<" (regexp-quote default) "\\_>"))))) + + +;;; Advices +;; +;; +(defvar helm-source-advice + '((name . "Function Advice") + (candidates . helm-advice-candidates) + (action ("Toggle Enable/Disable" . helm-advice-toggle)) + (persistent-action . helm-advice-persistent-action) + (nomark) + (multiline) + (persistent-help . "Describe function / C-u C-j: Toggle advice"))) + +(defun helm-advice-candidates () + (cl-loop for (fname) in ad-advised-functions + for function = (intern fname) + append + (cl-loop for class in ad-advice-classes append + (cl-loop for advice in (ad-get-advice-info-field function class) + for enabled = (ad-advice-enabled advice) + collect + (cons (format + "%s %s %s" + (if enabled "Enabled " "Disabled") + (propertize fname 'face 'font-lock-function-name-face) + (ad-make-single-advice-docstring advice class nil)) + (list function class advice)))))) + +(defun helm-advice-persistent-action (func-class-advice) + (if current-prefix-arg + (helm-advice-toggle func-class-advice) + (describe-function (car func-class-advice)))) + +(defun helm-advice-toggle (func-class-advice) + (cl-destructuring-bind (function _class advice) func-class-advice + (cond ((ad-advice-enabled advice) + (ad-advice-set-enabled advice nil) + (message "Disabled")) + (t + (ad-advice-set-enabled advice t) + (message "Enabled"))) + (ad-activate function) + (and helm-in-persistent-action + (helm-advice-update-current-display-string)))) + +(defun helm-advice-update-current-display-string () + (helm-edit-current-selection + (let ((newword (cond ((looking-at "Disabled") "Enabled") + ((looking-at "Enabled") "Disabled")))) + (when newword + (delete-region (point) (progn (forward-word 1) (point))) + (insert newword))))) + +;;;###autoload +(defun helm-manage-advice () + "Preconfigured `helm' to disable/enable function advices." + (interactive) + (helm-other-buffer 'helm-source-advice "*helm advice*")) + + +;;; Locate elisp library +;; +;; +(defun helm-locate-library-scan-list () + (cl-loop for dir in load-path + when (file-directory-p dir) + append (directory-files dir t (concat (regexp-opt (get-load-suffixes)) + "\\'")) + into lst + finally return (helm-fast-remove-dups lst :test 'equal))) + +;;;###autoload +(defun helm-locate-library () + (interactive) + (helm :sources (helm-build-in-buffer-source "Elisp libraries (Scan)" + :data (lambda () (helm-locate-library-scan-list)) + :fuzzy-match t + :keymap helm-generic-files-map + :match-part (lambda (candidate) + (if helm-ff-transformer-show-only-basename + (helm-basename candidate) candidate)) + :filter-one-by-one (lambda (c) + (if helm-ff-transformer-show-only-basename + (cons (helm-basename c) c) c)) + :action (helm-actions-from-type-file)) + :buffer "*helm locate library*")) + +(defun helm-set-variable (var) + "Set value to VAR interactively." + (let* ((sym (helm-symbolify var)) + (val (default-value sym))) + (set-default sym (eval-minibuffer (format "Set `%s': " var) + (if (or (stringp val) (memq val '(nil t))) + (prin1-to-string val) + (format "'%s" (prin1-to-string val))))))) + + +;;; Type attributes +;; +;; +(let ((actions '(("Describe command" . describe-function) + ("Add command to kill ring" . helm-kill-new) + ("Go to command's definition" . find-function) + ("Debug on entry" . debug-on-entry) + ("Cancel debug on entry" . cancel-debug-on-entry) + ("Trace function" . trace-function) + ("Trace function (background)" . trace-function-background) + ("Untrace function" . untrace-function)))) + (define-helm-type-attribute 'command + `((action ("Call interactively" . helm-call-interactively) + ,@actions) + (coerce . helm-symbolify) + (persistent-action . describe-function)) + "Command. (string or symbol)") + + (define-helm-type-attribute 'function + `((action . ,actions) + (action-transformer helm-transform-function-call-interactively) + (candidate-transformer helm-mark-interactive-functions) + (coerce . helm-symbolify)) + "Function. (string or symbol)")) + +(define-helm-type-attribute 'variable + '((action + ("Describe variable" . describe-variable) + ("Add variable to kill ring" . helm-kill-new) + ("Go to variable's definition" . find-variable) + ("Set variable" . helm-set-variable)) + (coerce . helm-symbolify)) + "Variable.") + +(define-helm-type-attribute 'timer + '((action + ("Cancel Timer" . (lambda (_timer) + (let ((mkd (helm-marked-candidates))) + (cl-loop for timer in mkd + do (cancel-timer timer))))) + ("Describe Function" . (lambda (tm) (describe-function (timer--function tm)))) + ("Find Function" . (lambda (tm) (find-function (timer--function tm))))) + (persistent-action . (lambda (tm) (describe-function (timer--function tm)))) + (persistent-help . "Describe Function")) + "Timer.") + + +;;; Elisp Timers. +;; +;; +(defclass helm-absolute-time-timers-class (helm-source-sync helm-type-timers) + ((candidates :initform timer-list) + (filtered-candidate-transformer + :initform + (lambda (candidates _source) + (cl-loop for timer in candidates + collect (cons (helm-elisp--format-timer timer) timer)))) + (allow-dups :initform t) + (volatile :initform t))) + +(defvar helm-source-absolute-time-timers + (helm-make-source "Absolute Time Timers" 'helm-absolute-time-timers-class)) + +(defclass helm-idle-time-timers-class (helm-source-sync helm-type-timers) + ((candidates :initform timer-idle-list) + (allow-dups :initform t) + (volatile :initform t) + (filtered-candidate-transformer + :initform + (lambda (candidates _source) + (cl-loop for timer in candidates + collect (cons (helm-elisp--format-timer timer) timer)))))) + +(defvar helm-source-idle-time-timers + (helm-make-source "Idle Time Timers" 'helm-idle-time-timers-class)) + +(defun helm-elisp--format-timer (timer) + (format "%s repeat=%s %s(%s)" + (let ((time (timer--time timer))) + (if (timer--idle-delay timer) + (format-time-string "idle-for=%5s" time) + (format-time-string "%m/%d %T" time))) + (or (timer--repeat-delay timer) "nil") + (mapconcat 'identity (split-string + (prin1-to-string (timer--function timer)) + "\n") " ") + (mapconcat 'prin1-to-string (timer--args timer) " "))) + +;;;###autoload +(defun helm-timers () + "Preconfigured `helm' for timers." + (interactive) + (helm :sources '(helm-source-absolute-time-timers + helm-source-idle-time-timers) + :buffer "*helm timers*")) + + +;;; Complex command history +;; +;; +(defun helm-btf--usable-p () + "Return t if current version of `backtrace-frame' accept 2 arguments." + (condition-case nil + (and (backtrace-frame 1 'condition-case) t) + (wrong-number-of-arguments nil))) + +(if (helm-btf--usable-p) ; Check if BTF accept more than one arg. + ;; Emacs 24.4. + (dont-compile + (defvar helm-sexp--last-sexp nil) + ;; This wont work compiled. + (defun helm-sexp-eval-1 () + (interactive) + (unwind-protect + (progn + ;; Trick called-interactively-p into thinking that `cand' is + ;; an interactive call, See `repeat-complex-command'. + (add-hook 'called-interactively-p-functions + #'helm-complex-command-history--called-interactively-skip) + (eval (read helm-sexp--last-sexp))) + (remove-hook 'called-interactively-p-functions + #'helm-complex-command-history--called-interactively-skip))) + + (defun helm-complex-command-history--called-interactively-skip (i _frame1 frame2) + (and (eq 'eval (cadr frame2)) + (eq 'helm-sexp-eval-1 + (cadr (backtrace-frame (+ i 2) #'called-interactively-p))) + 1)) + + (defun helm-sexp-eval (_candidate) + (call-interactively #'helm-sexp-eval-1))) + ;; Emacs 24.3 + (defun helm-sexp-eval (cand) + (let ((sexp (read cand))) + (condition-case err + (if (> (length (remove nil sexp)) 1) + (eval sexp) + (apply 'call-interactively sexp)) + (error (message "Evaluating gave an error: %S" err) + nil))))) + +(defvar helm-source-complex-command-history + (helm-build-sync-source "Complex Command History" + :candidates (lambda () + ;; Use cdr to avoid adding + ;; `helm-complex-command-history' here. + (cl-loop for i in command-history + unless (equal i '(helm-complex-command-history)) + collect (prin1-to-string i))) + :action (helm-make-actions + "Eval" (lambda (candidate) + (and (boundp 'helm-sexp--last-sexp) + (setq helm-sexp--last-sexp candidate)) + (run-with-timer 0.1 nil #'helm-sexp-eval candidate)) + "Edit and eval" + (lambda (cand) + (minibuffer-with-setup-hook + (lambda () (insert cand)) + (call-interactively #'eval-expression)))) + :persistent-action #'helm-sexp-eval)) + +;;;###autoload +(defun helm-complex-command-history () + (interactive) + (helm :sources 'helm-source-complex-command-history + :buffer "*helm complex commands*")) + +(provide 'helm-elisp) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-elisp.el ends here diff --git a/elpa/helm-20150426.2119/helm-elscreen.el b/elpa/helm-20150426.2119/helm-elscreen.el new file mode 100644 index 00000000..178d37fe --- /dev/null +++ b/elpa/helm-20150426.2119/helm-elscreen.el @@ -0,0 +1,79 @@ +;;; helm-elscreen.el -- Elscreen support -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: +(require 'cl-lib) +(require 'helm) + +(declare-function elscreen-find-screen-by-buffer "ext:elscreen.el" (buffer &optional create)) +(declare-function elscreen-find-file "ext:elscreen.el" (filename)) +(declare-function elscreen-goto "ext:elscreen.el" (screen)) + +(defun helm-find-buffer-on-elscreen (candidate) + "Open buffer in new screen, if marked buffers open all in elscreens." + (helm-require-or-error 'elscreen 'helm-find-buffer-on-elscreen) + (helm-aif (helm-marked-candidates) + (cl-dolist (i it) + (let ((target-screen (elscreen-find-screen-by-buffer + (get-buffer i) 'create))) + (elscreen-goto target-screen))) + (let ((target-screen (elscreen-find-screen-by-buffer + (get-buffer candidate) 'create))) + (elscreen-goto target-screen)))) + +(defun helm-elscreen-find-file (file) + (helm-require-or-error 'elscreen 'helm-elscreen-find-file) + (elscreen-find-file file)) + +(defvar helm-source-elscreen + '((name . "Elscreen") + (candidates + . (lambda () + (if (cdr (elscreen-get-screen-to-name-alist)) + (sort + (cl-loop for sname in (elscreen-get-screen-to-name-alist) + append (list (format "[%d] %s" (car sname) (cdr sname)))) + #'(lambda (a b) (compare-strings a nil nil b nil nil)))))) + (action + . (("Change Screen" . + (lambda (candidate) + (elscreen-goto (- (aref candidate 1) (aref "0" 0))))) + ("Kill Screen(s)" . + (lambda (candidate) + (cl-dolist (i (helm-marked-candidates)) + (elscreen-goto (- (aref i 1) (aref "0" 0))) + (elscreen-kill)))) + ("Only Screen" . + (lambda (candidate) + (elscreen-goto (- (aref candidate 1) (aref "0" 0))) + (elscreen-kill-others))))))) + +;;;###autoload +(defun helm-elscreen () + "Preconfigured helm to list elscreen." + (interactive) + (helm-other-buffer 'helm-source-elscreen "*Helm Elscreen*")) + +(provide 'helm-elscreen) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-elscreen.el ends here diff --git a/elpa/helm-20150426.2119/helm-eshell.el b/elpa/helm-20150426.2119/helm-eshell.el new file mode 100644 index 00000000..7b164a0b --- /dev/null +++ b/elpa/helm-20150426.2119/helm-eshell.el @@ -0,0 +1,246 @@ +;;; helm-eshell.el --- pcomplete and eshell completion for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;; Enable like this in .emacs: +;; +;; (add-hook 'eshell-mode-hook +;; #'(lambda () +;; (define-key eshell-mode-map [remap pcomplete] 'helm-esh-pcomplete))) +;; + +;;; Code: +(require 'cl-lib) +(require 'helm) +(require 'helm-elisp) +(require 'helm-regexp) + +(declare-function eshell-read-aliases-list "em-alias") +(declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline)) +(declare-function eshell-bol "esh-mode") +(declare-function eshell-parse-arguments "esh-arg" (beg end)) +(declare-function eshell-backward-argument "esh-mode" (&optional arg)) + +(defvar helm-eshell-history-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-p") 'helm-next-line) + map) + "Keymap for `helm-eshell-history'.") + +(defvar helm-esh-completion-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "TAB") 'helm-next-line) + map) + "Keymap for `helm-esh-pcomplete'.") + +(defclass helm-esh-source (helm-source-sync) + ((init :initform (lambda () + (setq pcomplete-current-completions nil + pcomplete-last-completion-raw nil) + ;; Eshell-command add this hook in all minibuffers + ;; Remove it for the helm one. (Fixed in Emacs24) + (remove-hook 'minibuffer-setup-hook 'eshell-mode))) + (candidates :initform 'helm-esh-get-candidates) + (nomark :initform t) + (persistent-action :initform 'ignore) + (filtered-candidate-transformer + :initform + (lambda (candidates _sources) + (cl-loop + for i in candidates + collect + (cond ((string-match "\\`~/?" helm-ec-target) + (abbreviate-file-name i)) + ((string-match "\\`/" helm-ec-target) i) + (t + (file-relative-name i))) + into lst + finally return (sort lst 'helm-generic-sort-fn)))) + (action :initform 'helm-ec-insert)) + "Helm class to define source for Eshell completion.") + +;; Internal. +(defvar helm-ec-target "") +(defun helm-ec-insert (candidate) + "Replace text at point with CANDIDATE. +The function that call this should set `helm-ec-target' to thing at point." + (let ((pt (point))) + (when (and helm-ec-target + (search-backward helm-ec-target nil t) + (string= (buffer-substring (point) pt) helm-ec-target)) + (delete-region (point) pt))) + (when (string-match "\\`\\*" helm-ec-target) (insert "*")) + (cond ((string-match "\\`~/?" helm-ec-target) + (insert (helm-quote-whitespace (abbreviate-file-name candidate)))) + ((string-match "\\`/" helm-ec-target) + (insert (helm-quote-whitespace candidate))) + (t + (insert (concat (and (string-match "\\`[.]/" helm-ec-target) "./") + (helm-quote-whitespace + (file-relative-name candidate))))))) + +(defun helm-esh-get-candidates () + "Get candidates for eshell completion using `pcomplete'." + (catch 'pcompleted + (with-helm-current-buffer + (let* ((pcomplete-stub) + pcomplete-seen pcomplete-norm-func + pcomplete-args pcomplete-last pcomplete-index + (pcomplete-autolist pcomplete-autolist) + (pcomplete-suffix-list pcomplete-suffix-list) + (table (pcomplete-completions)) + (entry (or (try-completion helm-pattern + (pcomplete-entries)) + helm-pattern))) + (cl-loop ;; expand entry too to be able to compare it with file-cand. + with exp-entry = (and (stringp entry) + (not (string= entry "")) + (file-name-as-directory + (expand-file-name entry default-directory))) + for i in (all-completions pcomplete-stub table) + ;; Transform the related names to abs names. + for file-cand = (and exp-entry + (if (file-remote-p i) i + (expand-file-name + i (file-name-directory entry)))) + ;; Compare them to avoid dups. + for file-entry-p = (and (stringp exp-entry) + (stringp file-cand) + ;; Fix :/tmp/foo/ $ cd foo + (not (file-directory-p file-cand)) + (file-equal-p exp-entry file-cand)) + if (and file-cand (or (file-remote-p file-cand) + (file-exists-p file-cand)) + (not file-entry-p)) + collect file-cand into ls + else + ;; Avoid adding entry here. + unless file-entry-p collect i into ls + finally return + (if (and exp-entry + (file-directory-p exp-entry) + ;; If the car of completion list is + ;; an executable, probably we are in + ;; command completion, so don't add a + ;; possible file related entry here. + (and ls (not (executable-find (car ls)))) + ;; Don't add entry if already in prompt. + (not (file-equal-p exp-entry pcomplete-stub))) + (append (list exp-entry) + ;; Entry should not be here now but double check. + (remove entry ls)) + ls)))))) + +;;; Eshell history. +;; +;; +(defclass helm-eshell-history-source (helm-source-in-buffer) + ((init :initform (lambda () + (let (eshell-hist-ignoredups) + (eshell-write-history eshell-history-file-name t) + (with-current-buffer (helm-candidate-buffer 'global) + (insert-file-contents eshell-history-file-name))) + ;; Same comment as in `helm-source-esh' + (remove-hook 'minibuffer-setup-hook 'eshell-mode))) + (nomark :initform t) + (keymap :initform helm-eshell-history-map) + (filtered-candidate-transformer :initform (lambda (candidates sources) + (reverse candidates))) + (candidate-number-limit :initform 9999) + (action :initform (lambda (candidate) + (eshell-kill-input) + (insert candidate)))) + "Helm class to define source for Eshell history.") + +;;;###autoload +(defun helm-esh-pcomplete () + "Preconfigured helm to provide helm completion in eshell." + (interactive) + (let* ((helm-quit-if-no-candidate t) + (helm-execute-action-at-once-if-one t) + (end (point-marker)) + (beg (save-excursion (eshell-bol) (point))) + (args (catch 'eshell-incomplete + (eshell-parse-arguments beg end))) + (target + (or (and (looking-back " " 1) " ") + (buffer-substring-no-properties + (save-excursion + (eshell-backward-argument 1) (point)) + end))) + (first (car args)) ; Maybe lisp delimiter "(". + last) ; Will be the last but parsed by pcomplete. + (setq helm-ec-target (or target " ") + end (point) + ;; Reset beg for `with-helm-show-completion'. + beg (or (and target (not (string= target " ")) + (- end (length target))) + ;; Nothing at point. + (progn (insert " ") (point)))) + (cond ((eq first ?\() + (helm-lisp-completion-or-file-name-at-point)) + ;; In eshell `pcomplete-parse-arguments' is called + ;; with `pcomplete-parse-arguments-function' + ;; locally bound to `eshell-complete-parse-arguments' + ;; which is calling `lisp-complete-symbol', + ;; calling it before would popup the + ;; *completions* buffer. + (t (setq last (replace-regexp-in-string + "\\`\\*" "" + (car (last (ignore-errors + (pcomplete-parse-arguments)))))) + (with-helm-show-completion beg end + (helm :sources (helm-make-source "Eshell completions" 'helm-esh-source) + :buffer "*helm pcomplete*" + :keymap helm-esh-completion-map + :resume 'noresume + :input (and (stringp last) + (helm-ff-set-pattern last)))))))) + +;;;###autoload +(defun helm-eshell-history () + "Preconfigured helm for eshell history." + (interactive) + (let* ((end (point)) + (beg (save-excursion (eshell-bol) (point))) + (input (buffer-substring beg end)) + flag-empty) + (when (eq beg end) + (insert " ") + (setq flag-empty t) + (setq end (point))) + (unwind-protect + (with-helm-show-completion beg end + (helm :sources (helm-make-source "Eshell history" + 'helm-eshell-history-source) + :buffer "*helm eshell history*" + :resume 'noresume + :input input)) + (when (and flag-empty + (looking-back " " 1)) + (delete-char -1))))) + +(provide 'helm-eshell) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-eshell ends here diff --git a/elpa/helm-20150426.2119/helm-eval.el b/elpa/helm-20150426.2119/helm-eval.el new file mode 100644 index 00000000..183c570b --- /dev/null +++ b/elpa/helm-20150426.2119/helm-eval.el @@ -0,0 +1,193 @@ +;;; helm-eval.el --- eval expressions from helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: +(require 'cl-lib) +(require 'helm) +(require 'eldoc) + + +(defgroup helm-eval nil + "Eval related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-eldoc-in-minibuffer-show-fn + 'helm-show-info-in-mode-line + "A function to display eldoc info. +Should take one arg: the string to display." + :group 'helm-eval + :type 'symbol) + +(defcustom helm-show-info-in-mode-line-delay 12 + "Eldoc will show info in mode-line during this delay if user is idle." + :type 'integer + :group 'helm-eval) + + +;;; Eldoc compatibility between emacs-24 and emacs-25 +;; +(if (require 'elisp-mode nil t) ; emacs-25 + ;; Maybe the eldoc functions have been + ;; already aliased by eldoc-eval. + (cl-loop for (f . a) in '((eldoc-current-symbol . + elisp--current-symbol) + (eldoc-fnsym-in-current-sexp . + elisp--fnsym-in-current-sexp) + (eldoc-get-fnsym-args-string . + elisp--get-fnsym-args-string) + (eldoc-get-var-docstring . + elisp--get-var-docstring)) + unless (fboundp f) + do (defalias f a)) + ;; Emacs-24. + (declare-function eldoc-current-symbol "eldoc") + (declare-function eldoc-get-fnsym-args-string "eldoc" (sym &optional index)) + (declare-function eldoc-get-var-docstring "eldoc" (sym)) + (declare-function eldoc-fnsym-in-current-sexp "eldoc")) + +;;; Evaluation Result +;; +;; +;; Internal +(defvar helm-eldoc-active-minibuffers-list nil) + +(defvar helm-eval-expression-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "") 'helm-eval-new-line-and-indent) + (define-key map (kbd "") 'lisp-indent-line) + (define-key map (kbd "") 'helm-lisp-completion-at-point) + (define-key map (kbd "C-p") 'previous-line) + (define-key map (kbd "C-n") 'next-line) + (define-key map (kbd "") 'previous-line) + (define-key map (kbd "") 'next-line) + (define-key map (kbd "") 'forward-char) + (define-key map (kbd "") 'backward-char) + map)) + +(defvar helm-source-evaluation-result + '((name . "Evaluation Result") + (init . (lambda () (require 'edebug))) + (dummy) + (multiline) + (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.") + (filtered-candidate-transformer . (lambda (candidates _source) + (list + (condition-case nil + (with-helm-current-buffer + (pp-to-string + (if edebug-active + (edebug-eval-expression + (read helm-pattern)) + (eval (read helm-pattern))))) + (error "Error"))))) + (action . (("Copy result to kill-ring" . (lambda (candidate) + (kill-new + (replace-regexp-in-string + "\n" "" candidate)))) + ("copy sexp to kill-ring" . (lambda (candidate) + (kill-new helm-input))))))) + +(defun helm-eval-new-line-and-indent () + (interactive) + (newline) (lisp-indent-line)) + +(defun helm-eldoc-store-minibuffer () + "Store minibuffer buffer name in `helm-eldoc-active-minibuffers-list'." + (with-selected-window (minibuffer-window) + (push (current-buffer) helm-eldoc-active-minibuffers-list))) + +(defun helm-eldoc-show-in-eval () + "Return eldoc in mode-line for current minibuffer input." + (let ((buf (window-buffer (active-minibuffer-window)))) + (condition-case err + (when (member buf helm-eldoc-active-minibuffers-list) + (with-current-buffer buf + (let* ((sym (save-excursion + (unless (looking-back ")\\|\"" 1) + (forward-char -1)) + (eldoc-current-symbol))) + (info-fn (eldoc-fnsym-in-current-sexp)) + (doc (or (eldoc-get-var-docstring sym) + (eldoc-get-fnsym-args-string + (car info-fn) (cadr info-fn))))) + (when doc (funcall helm-eldoc-in-minibuffer-show-fn doc))))) + (error (message "Eldoc in minibuffer error: %S" err) nil)))) + +(defun helm-show-info-in-mode-line (str) + "Display string STR in mode-line." + (save-selected-window + (with-current-buffer helm-buffer + (let ((mode-line-format (concat " " str))) + (force-mode-line-update) + (sit-for helm-show-info-in-mode-line-delay)) + (force-mode-line-update)))) + +;;; Calculation Result +;; +;; +(defvar helm-source-calculation-result + '((name . "Calculation Result") + (dummy) + (filtered-candidate-transformer . (lambda (candidates _source) + (list + (condition-case nil + (calc-eval helm-pattern) + (error "error"))))) + (action ("Copy result to kill-ring" . kill-new)))) + +;;;###autoload +(defun helm-eval-expression (arg) + "Preconfigured helm for `helm-source-evaluation-result'." + (interactive "P") + (helm :sources 'helm-source-evaluation-result + :input (when arg (thing-at-point 'sexp)) + :buffer "*helm eval*" + :history 'read-expression-history + :keymap helm-eval-expression-map)) + +(defvar eldoc-idle-delay) +;;;###autoload +(defun helm-eval-expression-with-eldoc () + "Preconfigured helm for `helm-source-evaluation-result' with `eldoc' support. " + (interactive) + (let ((timer (run-with-idle-timer + eldoc-idle-delay 'repeat + 'helm-eldoc-show-in-eval))) + (unwind-protect + (minibuffer-with-setup-hook + 'helm-eldoc-store-minibuffer + (call-interactively 'helm-eval-expression)) + (and timer (cancel-timer timer)) + (setq helm-eldoc-active-minibuffers-list + (cdr helm-eldoc-active-minibuffers-list))))) + +;;;###autoload +(defun helm-calcul-expression () + "Preconfigured helm for `helm-source-calculation-result'." + (interactive) + (helm-other-buffer 'helm-source-calculation-result "*helm calcul*")) + +(provide 'helm-eval) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-eval.el ends here diff --git a/elpa/helm-20150426.2119/helm-external.el b/elpa/helm-20150426.2119/helm-external.el new file mode 100644 index 00000000..28298e3a --- /dev/null +++ b/elpa/helm-20150426.2119/helm-external.el @@ -0,0 +1,216 @@ +;;; helm-external.el --- Run Externals commands within Emacs with helm completion. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-net) + + +(defgroup helm-external nil + "External related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-raise-command nil + "A shell command to jump to a window running specific program. +Need external program wmctrl. +This will be use with `format', so use something like \"wmctrl -xa %s\"." + :type 'string + :group 'helm-external) + +(defcustom helm-external-programs-associations nil + "Alist to store externals programs associated with file extension. +This variable overhide setting in .mailcap file. +e.g : '\(\(\"jpg\" . \"gqview\"\) (\"pdf\" . \"xpdf\"\)\) " + :type '(alist :key-type string :value-type string) + :group 'helm-external) + +(defcustom helm-default-external-file-browser "nautilus" + "Default external file browser for your system. +Directories will be opened externally with it when +opening file externally in `helm-find-files'. +Set to nil if you do not have external file browser +or do not want to use it. +Windows users should set that to \"explorer.exe\"." + :group 'helm-external + :type 'string) + + +;;; Internals +(defvar helm-external-command-history nil) +(defvar helm-external-commands-list nil + "A list of all external commands the user can execute. +If this variable is not set by the user, it will be calculated +automatically.") + +(defun helm-external-commands-list-1 (&optional sort) + "Returns a list of all external commands the user can execute. +If `helm-external-commands-list' is non-nil it will +return its contents. Else it calculates all external commands +and sets `helm-external-commands-list'." + (helm-aif helm-external-commands-list + it + (setq helm-external-commands-list + (cl-loop + for dir in (split-string (getenv "PATH") path-separator) + when (and (file-exists-p dir) (file-accessible-directory-p dir)) + for lsdir = (cl-loop for i in (directory-files dir t) + for bn = (file-name-nondirectory i) + when (and (not (member bn completions)) + (not (file-directory-p i)) + (file-executable-p i)) + collect bn) + append lsdir into completions + finally return + (if sort (sort completions 'string-lessp) completions))))) + +(defun helm-run-or-raise (exe &optional file) + "Generic command that run asynchronously EXE. +If EXE is already running just jump to his window if `helm-raise-command' +is non--nil. +When FILE argument is provided run EXE with FILE. +In this case EXE must be provided as \"EXE %s\"." + (let* ((real-com (car (split-string (replace-regexp-in-string + "%s" "" exe)))) + (proc (if file (concat real-com " " file) real-com)) + process-connection-type) + (if (get-process proc) + (if helm-raise-command + (shell-command (format helm-raise-command real-com)) + (error "Error: %s is already running" real-com)) + (when (cl-loop for i in helm-external-commands-list thereis (string= real-com i)) + (message "Starting %s..." real-com) + (if file + (start-process-shell-command + proc nil (format exe (shell-quote-argument + (if (eq system-type 'windows-nt) + (helm-w32-prepare-filename file) + file)))) + (start-process-shell-command proc nil real-com)) + (set-process-sentinel + (get-process proc) + #'(lambda (process event) + (when (and (string= event "finished\n") + helm-raise-command + (not (helm-get-pid-from-process-name real-com))) + (shell-command (format helm-raise-command "emacs"))) + (message "%s process...Finished." process)))) + (setq helm-external-commands-list + (cons real-com + (delete real-com helm-external-commands-list)))))) + +(defun helm-get-mailcap-for-file (filename) + "Get the command to use for FILENAME from mailcap files. +The command is like and is meant to use with `format'." + (mailcap-parse-mailcaps) + (let* ((ext (file-name-extension filename)) + (mime (when ext (mailcap-extension-to-mime ext))) + (result (when mime (mailcap-mime-info mime)))) + ;; If elisp file have no associations in .mailcap + ;; `mailcap-maybe-eval' is returned, in this case just return nil. + (when (stringp result) result))) + +(defun helm-get-default-program-for-file (filename) + "Try to find a default program to open FILENAME. +Try first in `helm-external-programs-associations' and then in mailcap file +if nothing found return nil." + (let* ((ext (file-name-extension filename)) + (def-prog (assoc-default ext helm-external-programs-associations))) + (cond ((and def-prog (not (string= def-prog ""))) + (concat def-prog " %s")) + ((and helm-default-external-file-browser + (file-directory-p filename)) + (concat helm-default-external-file-browser " %s")) + (t (helm-get-mailcap-for-file filename))))) + +(defun helm-open-file-externally (file) + "Open FILE with an external program. +Try to guess which program to use with `helm-get-default-program-for-file'. +If not found or a prefix arg is given query the user which tool to use." + (let* ((fname (expand-file-name file)) + (collection (helm-external-commands-list-1 'sort)) + (def-prog (helm-get-default-program-for-file fname)) + (real-prog-name (if (or helm-current-prefix-arg (not def-prog)) + ;; Prefix arg or no default program. + (prog1 + (helm-comp-read + "Program: " collection + :must-match t + :name "Open file Externally" + :del-input nil + :history helm-external-command-history) + ;; Always prompt to set this program as default. + (setq def-prog nil)) + ;; No prefix arg or default program exists. + (replace-regexp-in-string " %s\\| '%s'" "" def-prog))) + (program (concat real-prog-name " %s"))) + (unless (or def-prog ; Association exists, no need to record it. + ;; Don't try to record non--filenames associations (e.g urls). + (not (file-exists-p fname))) + (when + (y-or-n-p + (format + "Do you want to make `%s' the default program for this kind of files? " + real-prog-name)) + (helm-aif (assoc (file-name-extension fname) + helm-external-programs-associations) + (setq helm-external-programs-associations + (delete it helm-external-programs-associations))) + (push (cons (file-name-extension fname) + (helm-read-string + "Program (Add args maybe and confirm): " real-prog-name)) + helm-external-programs-associations) + (customize-save-variable 'helm-external-programs-associations + helm-external-programs-associations))) + (helm-run-or-raise program file) + (setq helm-external-command-history + (cons real-prog-name + (delete real-prog-name + (cl-loop for i in helm-external-command-history + when (executable-find i) collect i)))))) + +;;;###autoload +(defun helm-run-external-command (program) + "Preconfigured `helm' to run External PROGRAM asyncronously from Emacs. +If program is already running exit with error. +You can set your own list of commands with +`helm-external-commands-list'." + (interactive (list + (helm-comp-read + "RunProgram: " + (helm-external-commands-list-1 'sort) + :must-match t + :del-input nil + :name "External Commands" + :history helm-external-command-history))) + (helm-run-or-raise program) + (setq helm-external-command-history + (cons program (delete program + (cl-loop for i in helm-external-command-history + when (executable-find i) collect i))))) + + +(provide 'helm-external) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-external ends here diff --git a/elpa/helm-20150426.2119/helm-files.el b/elpa/helm-20150426.2119/helm-files.el new file mode 100644 index 00000000..4a10a739 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-files.el @@ -0,0 +1,3214 @@ +;;; helm-files.el --- helm file browser and related. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-utils) +(require 'helm-external) +(require 'helm-grep) +(require 'helm-match-plugin) +(require 'helm-help) +(require 'helm-locate) +(require 'helm-bookmark) +(require 'helm-tags) +(require 'helm-buffers) +(require 'thingatpt) +(require 'ffap) +(require 'dired-aux) +(require 'dired-x) +(require 'tramp) +(require 'image-dired) + +(declare-function find-library-name "find-func.el" (library)) +(declare-function w32-shell-execute "ext:w32fns.c" (operation document &optional parameters show-flag)) +(declare-function gnus-dired-attach "ext:gnus-dired.el" (files-to-attach)) +(declare-function image-dired-display-image "image-dired.el" (file &optional original-size)) +(declare-function image-dired-update-property "image-dired.el" (prop value)) +(declare-function eshell-read-aliases-list "em-alias") +(declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline)) +(declare-function eshell-kill-input "esh-mode") +(declare-function eshell-bol "esh-mode") +(declare-function helm-ls-git-ls "ext:helm-ls-git") +(declare-function helm-hg-find-files-in-project "ext:helm-ls-hg") + +(defvar recentf-list) + + +;;; Type attributes +;; +;; +(define-helm-type-attribute 'file + (helm-build-type-file) + "File name.") + + + +(defgroup helm-files nil + "Files applications and libraries for Helm." + :group 'helm) + +(defcustom helm-boring-file-regexp-list + (mapcar (lambda (f) + (concat + (rx-to-string + (replace-regexp-in-string + "/$" "" f) t) "$")) + completion-ignored-extensions) + "The regexp list matching boring files." + :group 'helm-files + :type '(repeat (choice regexp))) + +(defcustom helm-for-files-preferred-list + '(helm-source-buffers-list + helm-source-recentf + helm-source-bookmarks + helm-source-file-cache + helm-source-files-in-current-dir + helm-source-locate) + "Your preferred sources to find files." + :type '(repeat (choice symbol)) + :group 'helm-files) + +(defcustom helm-tramp-verbose 0 + "Just like `tramp-verbose' but specific to helm. +When set to 0 don't show tramp messages in helm. +If you want to have the default tramp messages set it to 3." + :type 'integer + :group 'helm-files) + +(defcustom helm-ff-auto-update-initial-value nil + "Auto update when only one candidate directory is matched. +Default value when starting `helm-find-files' is nil because +it prevent using to delete char backward and by the way +confuse beginners. +For a better experience with `helm-find-files' set this to non--nil +and use C- to toggle it." + :group 'helm-files + :type 'boolean) + +(defcustom helm-ff-lynx-style-map t + "Use arrow keys to navigate with `helm-find-files'. +You will have to restart Emacs or reeval `helm-find-files-map' +and `helm-read-file-map' for this take effect." + :group 'helm-files + :type 'boolean) + +(defcustom helm-ff-history-max-length 100 + "Number of elements shown in `helm-find-files' history." + :group 'helm-files + :type 'integer) + +(defcustom helm-ff-smart-completion t + "Try to complete filenames smarter when non--nil. +See `helm-ff--transform-pattern-for-completion' for more info." + :group 'helm-files + :type 'boolean) + +(defcustom helm-ff-tramp-not-fancy t + "No colors when listing remote files when set to non--nil. +This make listing much faster, specially on slow machines." + :group 'helm-files + :type 'boolean) + +(defcustom helm-ff-exif-data-program "exiftran" + "Program used to extract exif data of an image file." + :group 'helm-files + :type 'string) + +(defcustom helm-ff-exif-data-program-args "-d" + "Arguments used for `helm-ff-exif-data-program'." + :group 'helm-files + :type 'string) + +(defcustom helm-ff-newfile-prompt-p t + "Whether Prompt or not when creating new file. +This set `ffap-newfile-prompt'." + :type 'boolean + :group 'helm-files) + +(defcustom helm-ff-avfs-directory "~/.avfs" + "The default avfs directory, usually '~/.avfs'. +When this is set you will be able to expand archive filenames with `C-j' +inside an avfs directory mounted with mountavfs. +See ." + :type 'string + :group 'helm-files) + +(defcustom helm-ff-file-compressed-list '("gz" "bz2" "zip" "7z") + "Minimal list of compressed files extension." + :type '(repeat (choice string)) + :group 'helm-files) + +(defcustom helm-ff-printer-list nil + "A list of available printers on your system. +When non--nil let you choose a printer to print file. +Otherwise when nil the variable `printer-name' will be used. +On Unix based systems (lpstat command needed) you don't need to set this, +`helm-ff-find-printers' will find a list of available printers for you." + :type '(repeat (choice string)) + :group 'helm-files) + +(defcustom helm-ff-transformer-show-only-basename t + "Show only basename of candidates in `helm-find-files'. +This can be toggled at anytime from `helm-find-files' with \ +\\\\[helm-ff-run-toggle-basename]." + :type 'boolean + :group 'helm-files) + +(defcustom helm-ff-signal-error-on-dot-files t + "Signal error when file is `.' or `..' on file deletion when non--nil. +Default is non--nil. +WARNING: Setting this to nil is unsafe and can cause deletion of a whole tree." + :group 'helm-files + :type 'boolean) + +(defcustom helm-ff-search-library-in-sexp nil + "Search for library in `require' and `declare-function' sexp." + :group 'helm-files + :type 'boolean) + +(defcustom helm-tooltip-hide-delay 25 + "Hide tooltips automatically after this many seconds." + :group 'helm-files + :type 'integer) + +(defcustom helm-ff-file-name-history-use-recentf nil + "Use `recentf-list' instead of `file-name-history' in `helm-find-files'." + :group 'helm-files + :type 'boolean) + +(defcustom helm-ff-skip-boring-files nil + "Non--nil to skip files matching regexps in `helm-boring-file-regexp-list'. +This take effect in `helm-find-files' and file completion used by `helm-mode' +i.e `helm-read-file-name'." + :group 'helm-files + :type 'boolean) + +(defcustom helm-findutils-skip-boring-files t + "Ignore files matching regexps in `completion-ignored-extensions'." + :group 'helm-files + :type 'boolean) + +(defcustom helm-findutils-search-full-path nil + "Search in full path with shell command find when non--nil. +I.e use the -path/ipath arguments of find instead of -name/iname." + :group 'helm-files + :type 'boolean) + +(defcustom helm-files-save-history-extra-sources '("Find" "Locate") + "Extras source that save candidate to `file-name-history'." + :group 'helm-files + :type '(repeat (choice string))) + +(defcustom helm-find-files-before-init-hook nil + "Hook that run before initialization of `helm-find-files'." + :group 'helm-files + :type 'hook) + +(defcustom helm-find-files-after-init-hook nil + "Hook that run after initialization of `helm-find-files'." + :group 'helm-files + :type 'hook) + +(defcustom helm-multi-files-toggle-locate-binding "C-c p" + "Default binding to switch back and forth locate in `helm-multi-files'." + :group 'helm-files + :type 'string) + +(defcustom helm-find-files-bookmark-prefix "Helm-find-files: " + "bookmark name prefix of `helm-find-files' sessions." + :group 'helm-files + :type 'string) + +;;; Faces +;; +;; +(defgroup helm-files-faces nil + "Customize the appearance of helm-files." + :prefix "helm-" + :group 'helm-files + :group 'helm-faces) + +(defface helm-ff-prefix + '((t (:background "yellow" :foreground "black"))) + "Face used to prefix new file or url paths in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-executable + '((t (:foreground "green"))) + "Face used for executable files in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-directory + '((t (:foreground "DarkRed" :background "LightGray"))) + "Face used for directories in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-dotted-directory + '((t (:foreground "black" :background "DimGray"))) + "Face used for dotted directories in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-symlink + '((t (:foreground "DarkOrange"))) + "Face used for symlinks in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-invalid-symlink + '((t (:foreground "black" :background "red"))) + "Face used for invalid symlinks in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-ff-file + '((t (:inherit font-lock-builtin-face))) + "Face used for file names in `helm-find-files'." + :group 'helm-files-faces) + +(defface helm-history-deleted + '((t (:inherit helm-ff-invalid-symlink))) + "Face used for deleted files in `file-name-history'." + :group 'helm-files-faces) + +(defface helm-history-remote + '((t (:foreground "Indianred1"))) + "Face used for remote files in `file-name-history'." + :group 'helm-files-faces) + + +;;; Helm-find-files - The helm file browser. +;; +;; Keymaps +(defvar helm-find-files-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-]") 'helm-ff-run-toggle-basename) + (define-key map (kbd "C-x C-f") 'helm-ff-run-locate) + (define-key map (kbd "C-x C-d") 'helm-ff-run-browse-project) + (define-key map (kbd "C-x r m") 'helm-ff-bookmark-set) + (define-key map (kbd "C-s") 'helm-ff-run-grep) + (define-key map (kbd "M-g s") 'helm-ff-run-grep) + (define-key map (kbd "M-g p") 'helm-ff-run-pdfgrep) + (define-key map (kbd "M-g z") 'helm-ff-run-zgrep) + (define-key map (kbd "M-.") 'helm-ff-run-etags) + (define-key map (kbd "M-R") 'helm-ff-run-rename-file) + (define-key map (kbd "M-C") 'helm-ff-run-copy-file) + (define-key map (kbd "M-B") 'helm-ff-run-byte-compile-file) + (define-key map (kbd "M-L") 'helm-ff-run-load-file) + (define-key map (kbd "M-S") 'helm-ff-run-symlink-file) + (define-key map (kbd "M-H") 'helm-ff-run-hardlink-file) + (define-key map (kbd "M-D") 'helm-ff-run-delete-file) + (define-key map (kbd "M-K") 'helm-ff-run-kill-buffer-persistent) + (define-key map (kbd "C-c d") 'helm-ff-persistent-delete) + (define-key map (kbd "M-e") 'helm-ff-run-switch-to-eshell) + (define-key map (kbd "C-c i") 'helm-ff-run-complete-fn-at-point) + (define-key map (kbd "C-c o") 'helm-ff-run-switch-other-window) + (define-key map (kbd "C-c C-o") 'helm-ff-run-switch-other-frame) + (define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally) + (define-key map (kbd "C-c X") 'helm-ff-run-open-file-with-default-tool) + (define-key map (kbd "M-!") 'helm-ff-run-eshell-command-on-file) + (define-key map (kbd "M-%") 'helm-ff-run-query-replace-on-marked) + (define-key map (kbd "C-c =") 'helm-ff-run-ediff-file) + (define-key map (kbd "M-=") 'helm-ff-run-ediff-merge-file) + (define-key map (kbd "M-p") 'helm-ff-run-switch-to-history) + (define-key map (kbd "C-c h") 'helm-ff-file-name-history) + (define-key map (kbd "M-i") 'helm-ff-properties-persistent) + (define-key map (kbd "C-c ?") 'helm-ff-help) + (define-key map (kbd "C-}") 'helm-narrow-window) + (define-key map (kbd "C-{") 'helm-enlarge-window) + (define-key map (kbd "C-") 'helm-ff-run-toggle-auto-update) + (define-key map (kbd "C-c ") 'helm-ff-run-toggle-auto-update) + (define-key map (kbd "C-c C-a") 'helm-ff-run-gnus-attach-files) + (define-key map (kbd "C-c p") 'helm-ff-run-print-file) + (define-key map (kbd "C-c /") 'helm-ff-run-find-sh-command) + ;; Next 2 have no effect if candidate is not an image file. + (define-key map (kbd "M-l") 'helm-ff-rotate-left-persistent) + (define-key map (kbd "M-r") 'helm-ff-rotate-right-persistent) + (define-key map (kbd "C-.") 'helm-find-files-up-one-level) + (define-key map (kbd "C-l") 'helm-find-files-up-one-level) + (define-key map (kbd "C-h C-b") 'helm-send-bug-report-from-helm) + (define-key map (kbd "C-c r") 'helm-ff-run-find-file-as-root) + (define-key map (kbd "C-c @") 'helm-ff-run-insert-org-link) + (helm-define-key-with-subkeys map (kbd "DEL") ?\d 'helm-ff-delete-char-backward + nil nil 'helm-ff-delete-char-backward--exit-fn) + (when helm-ff-lynx-style-map + (define-key map (kbd "") 'helm-find-files-up-one-level) + (define-key map (kbd "") 'helm-execute-persistent-action)) + (delq nil map)) + "Keymap for `helm-find-files'.") + +(defvar helm-read-file-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "") 'helm-cr-empty-string) + (define-key map (kbd "") 'helm-cr-empty-string) + (define-key map (kbd "C-]") 'helm-ff-run-toggle-basename) + (define-key map (kbd "C-.") 'helm-find-files-up-one-level) + (define-key map (kbd "C-l") 'helm-find-files-up-one-level) + (define-key map (kbd "C-c h") 'helm-ff-file-name-history) + (define-key map (kbd "C-") 'helm-ff-run-toggle-auto-update) + (define-key map (kbd "C-c ") 'helm-ff-run-toggle-auto-update) + (define-key map (kbd "C-c ?") 'helm-read-file-name-help) + (helm-define-key-with-subkeys map (kbd "DEL") ?\d 'helm-ff-delete-char-backward + nil nil 'helm-ff-delete-char-backward--exit-fn) + (when helm-ff-lynx-style-map + (define-key map (kbd "") 'helm-find-files-up-one-level) + (define-key map (kbd "") 'helm-execute-persistent-action) + (define-key map (kbd "") 'helm-previous-source) + (define-key map (kbd "") 'helm-next-source)) + (delq nil map)) + "Keymap for `helm-read-file-name'.") + +(defvar helm-esh-on-file-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c ?") 'helm-esh-help) + map) + "Keymap for `helm-find-files-eshell-command-on-file'.") + + +;; Internal. +(defvar helm-find-files-doc-header " (`C-l': Go up one level)" + "*The doc that is inserted in the Name header of a find-files or dired source.") +(defvar helm-ff-auto-update-flag nil + "Internal, flag to turn on/off auto-update in `helm-find-files'. +Don't set it directly, use instead `helm-ff-auto-update-initial-value'.") +(defvar helm-ff-last-expanded nil + "Store last expanded directory or file.") +(defvar helm-ff-default-directory nil) +(defvar helm-ff-history nil) +(defvar helm-ff-cand-to-mark nil) +(defvar helm-ff-url-regexp + "\\`\\(news\\(post\\)?:\\|nntp:\\|mailto:\\|file:\\|\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\):/?/?\\).*" + "Same as `ffap-url-regexp' but match earlier possible url.") +(defvar helm-tramp-file-name-regexp "\\`/\\([^[/:]+\\|[^/]+]\\):") +(defvar helm-marked-buffer-name "*helm marked*") +(defvar helm-ff--auto-update-state nil) +(defvar helm-ff--deleting-char-backward nil) +(defvar helm-multi-files--toggle-locate nil) +(defvar helm-ff--move-to-first-real-candidate t) + + +;;; Helm-find-files +;; +;; +(defvar helm-source-find-files nil + "The main source to browse files. +Should not be used among other sources.") + +(defclass helm-source-ffiles (helm-source-sync) + ((header-name + :initform (lambda (name) + (concat name helm-find-files-doc-header))) + (init + :initform (lambda () + (setq helm-ff-auto-update-flag + helm-ff-auto-update-initial-value) + (setq helm-ff--auto-update-state + helm-ff-auto-update-flag) + (helm-set-local-variable 'bookmark-make-record-function + #'helm-ff-make-bookmark-record))) + (candidates :initform 'helm-find-files-get-candidates) + (filtered-candidate-transformer :initform 'helm-ff-sort-candidates) + (filter-one-by-one :initform 'helm-ff-filter-candidate-one-by-one) + (persistent-action :initform 'helm-find-files-persistent-action) + (persistent-help :initform "Hit1 Expand Candidate, Hit2 or (C-u) Find file") + (mode-line :initform helm-ff-mode-line-string) + (volatile :initform t) + (nohighlight :initform t) + (candidate-number-limit + :initform 9999) + (action-transformer + :initform 'helm-find-files-action-transformer) + (action + :initform + (helm-make-actions + "Find File" 'helm-find-file-or-marked + "Find file in Dired" 'helm-point-file-in-dired + (lambda () (and (locate-library "elscreen") "Find file in Elscreen")) + 'helm-elscreen-find-file + "View file" 'view-file + "Checksum File" 'helm-ff-checksum + "Query replace fnames on marked" 'helm-ff-query-replace-on-marked + "Query replace contents on marked" 'helm-ff-query-replace + "Query replace regexp contents on marked" 'helm-ff-query-replace-regexp + "Serial rename files" 'helm-ff-serial-rename + "Serial rename by symlinking files" 'helm-ff-serial-rename-by-symlink + "Serial rename by copying files" 'helm-ff-serial-rename-by-copying + "Open file with default tool" 'helm-open-file-with-default-tool + "Find file in hex dump" 'hexl-find-file + "Browse project" 'helm-ff-browse-project + "Complete at point `C-c i'" 'helm-insert-file-name-completion-at-point + "Insert as org link `C-c @'" 'helm-files-insert-as-org-link + "Find shell command `C-c /'" 'helm-ff-find-sh-command + "Add marked files to file-cache" 'helm-ff-cache-add-file + "Open file externally `C-c C-x, C-u to choose'" 'helm-open-file-externally + "Grep File(s) `C-s, C-u Recurse'" 'helm-find-files-grep + "Zgrep File(s) `M-g z, C-u Recurse'" 'helm-ff-zgrep + "Switch to Eshell `M-e'" 'helm-ff-switch-to-eshell + "Etags `M-., C-u reload tag file'" 'helm-ff-etags-select + "Eshell command on file(s) `M-!, C-u take all marked as arguments.'" + 'helm-find-files-eshell-command-on-file + "Find file as root `C-c r'" 'helm-find-file-as-root + "Ediff File `C-='" 'helm-find-files-ediff-files + "Ediff Merge File `C-c ='" 'helm-find-files-ediff-merge-files + "Delete File(s) `M-D'" 'helm-delete-marked-files + "Copy file(s) `M-C, C-u to follow'" 'helm-find-files-copy + "Rename file(s) `M-R, C-u to follow'" 'helm-find-files-rename + "Symlink files(s) `M-S, C-u to follow'" 'helm-find-files-symlink + "Relsymlink file(s) `C-u to follow'" 'helm-find-files-relsymlink + "Hardlink file(s) `M-H, C-u to follow'" 'helm-find-files-hardlink + "Find file other window `C-c o'" 'find-file-other-window + "Switch to history `M-p'" 'helm-find-files-switch-to-hist + "Find file other frame `C-c C-o'" 'find-file-other-frame + "Print File `C-c p, C-u to refresh'" 'helm-ff-print + "Locate `C-x C-f, C-u to specify locate db'" 'helm-ff-locate)) + (before-init-hook :initform 'helm-find-files-before-init-hook) + (after-init-hook :initform 'helm-find-files-after-init-hook))) + +;; Bookmark handlers. +;; +(defun helm-ff-make-bookmark-record () + "The `bookmark-make-record-function' for `helm-find-files'." + (with-helm-buffer + `((filename . ,helm-ff-default-directory) + (presel . ,(helm-get-selection)) + (handler . helm-ff-bookmark-jump)))) + +(defun helm-ff-bookmark-jump (bookmark) + "bookmark handler for `helm-find-files'." + (let ((fname (bookmark-prop-get bookmark 'filename)) + (presel (bookmark-prop-get bookmark 'presel))) + (helm-find-files-1 fname (if helm-ff-transformer-show-only-basename + (helm-basename presel) + presel)))) + +(defun helm-ff-bookmark-set () + "Record `helm-find-files' session in bookmarks." + (interactive) + (with-helm-buffer + (bookmark-set + (concat helm-find-files-bookmark-prefix + (abbreviate-file-name helm-ff-default-directory)))) + (message "Helm find files session bookmarked! ")) + +(defun helm-dwim-target-directory () + "Return value of `default-directory' of buffer in other window. +If there is only one window return the value ot `default-directory' +for current buffer." + (with-helm-current-buffer + (let ((num-windows (length (remove (get-buffer-window helm-marked-buffer-name) + (window-list))))) + (expand-file-name + (if (> num-windows 1) + (save-selected-window + (other-window 1) + default-directory) + (or (car-safe helm-ff-history) default-directory)))))) + +(defun helm-find-files-do-action (action) + "Generic function for creating actions from `helm-source-find-files'. +ACTION must be an action supported by `helm-dired-action'." + (let* ((ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo' + (helm-marked-candidates :with-wildcard t))) + (cand (helm-get-selection)) ; Target + (prompt (format "%s %s file(s) to: " + (capitalize (symbol-name action)) + (length ifiles))) + helm-ff--move-to-first-real-candidate + (helm-always-two-windows t) + (helm-reuse-last-window-split-state t) + (helm-split-window-default-side + (eq helm-split-window-default-side 'same)) + helm-split-window-in-side-p + (parg helm-current-prefix-arg) + helm-display-source-at-screen-top ; prevent setting window-start. + helm-ff-auto-update-initial-value + (dest (with-helm-display-marked-candidates + helm-marked-buffer-name + (mapcar #'(lambda (f) + (if (file-directory-p f) + (concat (helm-basename f) "/") + (helm-basename f))) + ifiles) + (with-helm-current-buffer + (helm-read-file-name + prompt + :preselect (if helm-ff-transformer-show-only-basename + (helm-basename cand) cand) + :initial-input (helm-dwim-target-directory) + :history (helm-find-files-history :comp-read nil)))))) + (helm-dired-action + dest :files ifiles :action action :follow parg))) + +(defun helm-find-files-copy (_candidate) + "Copy files from `helm-find-files'." + (helm-find-files-do-action 'copy)) + +(defun helm-find-files-rename (_candidate) + "Rename files from `helm-find-files'." + (helm-find-files-do-action 'rename)) + +(defun helm-find-files-symlink (_candidate) + "Symlink files from `helm-find-files'." + (helm-find-files-do-action 'symlink)) + +(defun helm-find-files-relsymlink (_candidate) + "Relsymlink files from `helm-find-files'." + (helm-find-files-do-action 'relsymlink)) + +(defun helm-find-files-hardlink (_candidate) + "Hardlink files from `helm-find-files'." + (helm-find-files-do-action 'hardlink)) + +(defun helm-find-files-byte-compile (_candidate) + "Byte compile elisp files from `helm-find-files'." + (let ((files (helm-marked-candidates :with-wildcard t)) + (parg helm-current-prefix-arg)) + (cl-loop for fname in files + do (byte-compile-file fname parg)))) + +(defun helm-find-files-load-files (_candidate) + "Load elisp files from `helm-find-files'." + (let ((files (helm-marked-candidates :with-wildcard t))) + (cl-loop for fname in files + do (load fname)))) + +(defun helm-find-files-ediff-files-1 (candidate &optional merge) + "Generic function to ediff/merge files in `helm-find-files'." + (let* ((bname (helm-basename candidate)) + (marked (helm-marked-candidates :with-wildcard t)) + (prompt (if merge "Ediff Merge `%s' With File: " + "Ediff `%s' With File: ")) + (fun (if merge 'ediff-merge-files 'ediff-files)) + (input (helm-dwim-target-directory)) + (presel (if helm-ff-transformer-show-only-basename + (helm-basename candidate) + (expand-file-name + (helm-basename candidate) + input)))) + (if (= (length marked) 2) + (funcall fun (car marked) (cadr marked)) + (funcall fun candidate (helm-read-file-name + (format prompt bname) + :initial-input input + :preselect presel))))) + +(defun helm-find-files-ediff-files (candidate) + (helm-find-files-ediff-files-1 candidate)) + +(defun helm-find-files-ediff-merge-files (candidate) + (helm-find-files-ediff-files-1 candidate 'merge)) + +(defun helm-find-files-grep (_candidate) + "Default action to grep files from `helm-find-files'." + (apply 'run-with-timer 0.01 nil + #'helm-do-grep-1 + (helm-marked-candidates :with-wildcard t) + helm-current-prefix-arg)) + +(defun helm-ff-zgrep (_candidate) + "Default action to zgrep files from `helm-find-files'." + (helm-ff-zgrep-1 (helm-marked-candidates :with-wildcard t) helm-current-prefix-arg)) + +(defun helm-ff-pdfgrep (_candidate) + "Default action to pdfgrep files from `helm-find-files'." + (let ((cands (cl-loop for file in (helm-marked-candidates :with-wildcard t) + if (or (string= (file-name-extension file) "pdf") + (string= (file-name-extension file) "PDF")) + collect file)) + (helm-pdfgrep-default-function 'helm-pdfgrep-init)) + (when cands + (helm-do-pdfgrep-1 cands)))) + +(defun helm-ff-etags-select (candidate) + "Default action to jump to etags from `helm-find-files'." + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + (let* ((source-name (assoc-default 'name (helm-get-current-source))) + (default-directory (if (string= source-name "Find Files") + helm-ff-default-directory + (file-name-directory candidate)))) + (helm-etags-select helm-current-prefix-arg))) + +(defun helm-find-files-switch-to-hist (_candidate) + "Switch to helm-find-files history." + (helm-find-files t)) + +(defvar eshell-command-aliases-list nil) +(defvar helm-eshell-command-on-file-input-history nil) +(defun helm-find-files-eshell-command-on-file-1 (&optional map) + "Run `eshell-command' on CANDIDATE or marked candidates. +This is done possibly with an eshell alias, if no alias found, you can type in +an eshell command. + +Basename of CANDIDATE can be a wild-card. +e.g you can do \"eshell-command command *.el\" +Where \"*.el\" is the CANDIDATE. + +It is possible to do eshell-command command +like this: \"command %s some more args\". + +If MAP is given run `eshell-command' on all marked files at once, +Otherwise, run `eshell-command' on each marked files. +In other terms, with a prefix arg do on the three marked files +\"foo\" \"bar\" \"baz\": + +\"eshell-command command foo bar baz\" + +otherwise do + +\"eshell-command command foo\" +\"eshell-command command bar\" +\"eshell-command command baz\" + +Note: +If `eshell' or `eshell-command' have not been run once, +or if you have no eshell aliases `eshell-command-aliases-list' +will not be loaded first time you use this." + (when (or eshell-command-aliases-list + (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? ")) + (and eshell-command-aliases-list (eshell-read-aliases-list)) + (let* ((cand-list (helm-marked-candidates :with-wildcard t)) + (default-directory (or helm-ff-default-directory + ;; If candidate is an url *-ff-default-directory is nil + ;; so keep value of default-directory. + default-directory)) + (command (helm-comp-read + "Command: " + (cl-loop for (a . c) in eshell-command-aliases-list + when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c)) + collect (propertize a 'help-echo (car c)) into ls + finally return (sort ls 'string<)) + :buffer "*helm eshell on file*" + :name "Eshell command" + :keymap helm-esh-on-file-map + :mode-line + '("Eshell alias" + "C-c ?: Help, \\[universal-argument]: Insert output at point") + :input-history + 'helm-eshell-command-on-file-input-history)) + (alias-value (car (assoc-default command eshell-command-aliases-list)))) + (if (or (equal helm-current-prefix-arg '(16)) + (equal map '(16))) + ;; Two time C-u from `helm-comp-read' mean print to current-buffer. + ;; i.e `eshell-command' will use this value. + (setq current-prefix-arg '(16)) + ;; Else reset the value of `current-prefix-arg' + ;; to avoid printing in current-buffer. + (setq current-prefix-arg nil)) + (if (and (or + ;; One prefix-arg have been passed before `helm-comp-read'. + ;; If map have been set with C-u C-u (value == '(16)) + ;; ignore it. + (and map (equal map '(4))) + ;; One C-u from `helm-comp-read'. + (equal helm-current-prefix-arg '(4)) + ;; An alias that finish with $* + (and alias-value + ;; If command is an alias be sure it accept + ;; more than one arg i.e $*. + (string-match "\\$\\*$" alias-value))) + (cdr cand-list)) + + ;; Run eshell-command with ALL marked files as arguments. + ;; This wont work on remote files, because tramp handlers depends + ;; on `default-directory' (limitation). + (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " "))) + (if (string-match "'%s'\\|\"%s\"\\|%s" command) + (eshell-command (format command mapfiles)) ; See [1] + (eshell-command (format "%s %s" command mapfiles)))) + + ;; Run eshell-command on EACH marked files. + ;; To work with tramp handler we have to call + ;; COMMAND on basename of each file, using + ;; its basedir as `default-directory'. + (cl-loop for f in cand-list + for dir = (and (not (string-match ffap-url-regexp f)) + (helm-basedir f)) + for file = (format "'%s'" (if (and dir (file-remote-p dir)) + (helm-basename f) f)) + for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command) + ;; [1] This allow to enter other args AFTER filename + ;; i.e + (format command file) + (format "%s %s" command file)) + do (let ((default-directory (or dir default-directory))) + (eshell-command com))))))) + +(defun helm-find-files-eshell-command-on-file (_candidate) + "Run `eshell-command' on CANDIDATE or marked candidates. +See `helm-find-files-eshell-command-on-file-1' for more info." + (helm-find-files-eshell-command-on-file-1 helm-current-prefix-arg)) + +(defun helm-ff-switch-to-eshell (_candidate) + "Switch to eshell and cd to `helm-ff-default-directory'." + (let ((cd-eshell #'(lambda () + (eshell-kill-input) + (goto-char (point-max)) + (insert + (format "cd '%s'" helm-ff-default-directory)) + (eshell-send-input)))) + (if (get-buffer "*eshell*") + (switch-to-buffer "*eshell*") + (call-interactively 'eshell)) + (unless (get-buffer-process (current-buffer)) + (funcall cd-eshell)))) + +(defun helm-ff-serial-rename-action (method) + "Rename all marked files in `helm-ff-default-directory' with METHOD. +See `helm-ff-serial-rename-1'." + (let* ((helm--reading-passwd-or-string t) + (cands (helm-marked-candidates :with-wildcard t)) + (def-name (car cands)) + (name (helm-read-string "NewName: " + (replace-regexp-in-string + "[0-9]+$" "" + (helm-basename + def-name + (file-name-extension def-name))))) + (start (read-number "StartAtNumber: ")) + (extension (helm-read-string "Extension: " + (file-name-extension (car cands)))) + (dir (expand-file-name + (helm-read-file-name + "Serial Rename to directory: " + :initial-input + (expand-file-name helm-ff-default-directory) + :test 'file-directory-p + :must-match t))) + done) + (with-helm-display-marked-candidates + helm-marked-buffer-name (mapcar 'helm-basename cands) + (if (y-or-n-p + (format "Rename %s file(s) to <%s> like this ?\n%s " + (length cands) dir (format "%s <-> %s%s.%s" + (helm-basename (car cands)) + name start extension))) + (progn + (helm-ff-serial-rename-1 + dir cands name start extension :method method) + (setq done t) + (message nil)))) + (if done + (with-helm-current-buffer (helm-find-files-1 dir)) + (message "Operation aborted")))) + +(defun helm-ff-member-directory-p (file directory) + (let ((dir-file (expand-file-name + (file-name-as-directory (file-name-directory file)))) + (cur-dir (expand-file-name (file-name-as-directory directory)))) + (string= dir-file cur-dir))) + +(cl-defun helm-ff-serial-rename-1 + (directory collection new-name start-at-num extension &key (method 'rename)) + "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME. +Rename start at number START-AT-NUM - ex: prefixname-01.jpg. +EXTENSION is the file extension to use, in empty prompt, +reuse the original extension of file. +METHOD can be one of rename, copy or symlink. +Files will be renamed if they are files of current directory, otherwise they +will be treated with METHOD. +Default METHOD is rename." + ;; Maybe remove directories selected by error in collection. + (setq collection (cl-remove-if 'file-directory-p collection)) + (let* ((tmp-dir (file-name-as-directory + (concat (file-name-as-directory directory) + (symbol-name (cl-gensym "tmp"))))) + (fn (cl-case method + (copy 'copy-file) + (symlink 'make-symbolic-link) + (rename 'rename-file) + (t (error "Error: Unknown method %s" method))))) + (make-directory tmp-dir) + (unwind-protect + (progn + ;; Rename all files to tmp-dir with new-name. + ;; If files are not from start directory, use method + ;; to move files to tmp-dir. + (cl-loop for i in collection + for count from start-at-num + for fnum = (if (< count 10) "0%s" "%s") + for nname = (concat tmp-dir new-name (format fnum count) + (if (not (string= extension "")) + (format ".%s" (replace-regexp-in-string + "[.]" "" extension)) + (file-name-extension i 'dot))) + do (if (helm-ff-member-directory-p i directory) + (rename-file i nname) + (funcall fn i nname))) + ;; Now move all from tmp-dir to destination. + (cl-loop with dirlist = (directory-files + tmp-dir t directory-files-no-dot-files-regexp) + for f in dirlist do + (if (file-symlink-p f) + (make-symbolic-link (file-truename f) + (concat (file-name-as-directory directory) + (helm-basename f))) + (rename-file f directory)))) + (delete-directory tmp-dir t)))) + +(defun helm-ff-serial-rename (_candidate) + "Serial rename all marked files to `helm-ff-default-directory'. +Rename only file of current directory, and symlink files coming from +other directories. +See `helm-ff-serial-rename-1'." + (helm-ff-serial-rename-action 'rename)) + +(defun helm-ff-serial-rename-by-symlink (_candidate) + "Serial rename all marked files to `helm-ff-default-directory'. +Rename only file of current directory, and symlink files coming from +other directories. +See `helm-ff-serial-rename-1'." + (helm-ff-serial-rename-action 'symlink)) + +(defun helm-ff-serial-rename-by-copying (_candidate) + "Serial rename all marked files to `helm-ff-default-directory'. +Rename only file of current directory, and copy files coming from +other directories. +See `helm-ff-serial-rename-1'." + (helm-ff-serial-rename-action 'copy)) + +(defun helm-ff-query-replace-on-marked-1 (candidates) + (with-helm-display-marked-candidates + helm-marked-buffer-name + (mapcar 'helm-basename candidates) + (let* ((regexp (read-string "Replace regexp on filename(s): ")) + (str (read-string (format "Replace regexp `%s' with: " regexp)))) + (cl-loop with query = "y" + with count = 0 + for old in candidates + for new = (concat (helm-basedir old) + (replace-regexp-in-string + regexp str + (helm-basename old))) + ;; If `regexp' is not matched in `old' + ;; `replace-regexp-in-string' will + ;; return `old' unmodified. + unless (string= old new) + do (progn + (unless (string= query "!") + (while (not (member + (setq query + (string + (read-key + (propertize + (format + "Replace `%s' by `%s' [!,y,n,q]" + old new) + 'face 'minibuffer-prompt)))) + '("y" "!" "n" "q"))) + (message "Please answer by y,n,! or q") (sit-for 1))) + (when (string= query "q") + (cl-return (message "Operation aborted"))) + (unless (string= query "n") + (rename-file old new) + (cl-incf count))) + finally (message "%d Files renamed" count)))) + ;; This fix the emacs bug where "Emacs-Lisp:" is sent + ;; in minibuffer (not the echo area). + (sit-for 0.1) + (with-current-buffer (window-buffer (minibuffer-window)) + (delete-minibuffer-contents))) + +;; The action. +(defun helm-ff-query-replace-on-marked (_candidate) + (let ((marked (helm-marked-candidates))) + (helm-run-after-quit #'helm-ff-query-replace-on-marked-1 marked))) + +;; The command for `helm-find-files-map'. +(defun helm-ff-run-query-replace-on-marked () + (interactive) + (helm-ff-query-replace-on-marked nil)) + +(defun helm-ff-query-replace (_candidate) + (let ((bufs (cl-loop for f in (helm-marked-candidates) + collect (buffer-name (find-file-noselect f))))) + (helm-run-after-quit #'helm-buffer-query-replace-1 nil bufs))) + +(defun helm-ff-query-replace-regexp (_candidate) + (let ((bufs (cl-loop for f in (helm-marked-candidates) + collect (buffer-name (find-file-noselect f))))) + (helm-run-after-quit #'helm-buffer-query-replace-1 'regexp bufs))) + +(defun helm-ff-run-query-replace () + (interactive) + (helm-ff-query-replace nil)) + +(defun helm-ff-run-query-replace-regexp () + (interactive) + (helm-ff-query-replace-regexp nil)) + +(defun helm-ff-toggle-auto-update (_candidate) + (setq helm-ff-auto-update-flag (not helm-ff-auto-update-flag)) + (setq helm-ff--auto-update-state helm-ff-auto-update-flag) + (message "[Auto expansion %s]" + (if helm-ff-auto-update-flag "enabled" "disabled"))) + +(defun helm-ff-run-toggle-auto-update () + (interactive) + (with-helm-alive-p + (helm-attrset 'toggle-auto-update '(helm-ff-toggle-auto-update . never-split)) + (helm-execute-persistent-action 'toggle-auto-update))) + +(defun helm-ff-delete-char-backward () + "Disable helm find files auto update and delete char backward." + (interactive) + (setq helm-ff-auto-update-flag nil) + (setq helm-ff--deleting-char-backward t) + (call-interactively + (lookup-key (current-global-map) + (read-kbd-macro "DEL")))) + +(defun helm-ff-delete-char-backward--exit-fn () + (setq helm-ff-auto-update-flag helm-ff--auto-update-state) + (setq helm-ff--deleting-char-backward nil)) + +(defun helm-ff-run-switch-to-history () + "Run Switch to history action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (when (helm-file-completion-source-p) + (helm-quit-and-execute-action 'helm-find-files-switch-to-hist)))) + +(defun helm-ff-run-grep () + "Run Grep action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-find-files-grep))) + +(defun helm-ff-run-pdfgrep () + "Run Pdfgrep action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-ff-pdfgrep))) + +(defun helm-ff-run-zgrep () + "Run Grep action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-ff-zgrep))) + +(defun helm-ff-run-copy-file () + "Run Copy file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-find-files-copy))) + +(defun helm-ff-run-rename-file () + "Run Rename file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-find-files-rename))) + +(defun helm-ff-run-byte-compile-file () + "Run Byte compile file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-find-files-byte-compile))) + +(defun helm-ff-run-load-file () + "Run Load file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-find-files-load-files))) + +(defun helm-ff-run-eshell-command-on-file () + "Run eshell command on file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action + 'helm-find-files-eshell-command-on-file))) + +(defun helm-ff-run-ediff-file () + "Run Ediff file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-find-files-ediff-files))) + +(defun helm-ff-run-ediff-merge-file () + "Run Ediff merge file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action + 'helm-find-files-ediff-merge-files))) + +(defun helm-ff-run-symlink-file () + "Run Symlink file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-find-files-symlink))) + +(defun helm-ff-run-hardlink-file () + "Run Hardlink file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-find-files-hardlink))) + +(defun helm-ff-run-delete-file () + "Run Delete file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-delete-marked-files))) + +(defun helm-ff-run-complete-fn-at-point () + "Run complete file name action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action + 'helm-insert-file-name-completion-at-point))) + +(defun helm-ff-run-switch-to-eshell () + "Run switch to eshell action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-ff-switch-to-eshell))) + +(defun helm-ff-run-switch-other-window () + "Run switch to other window action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'find-file-other-window))) + +(defun helm-ff-run-switch-other-frame () + "Run switch to other frame action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'find-file-other-frame))) + +(defun helm-ff-run-open-file-externally () + "Run open file externally command action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-open-file-externally))) + +(defun helm-ff-run-open-file-with-default-tool () + "Run open file externally command action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-open-file-with-default-tool))) + +(defun helm-ff-locate (candidate) + "Locate action function for `helm-find-files'." + (helm-locate-set-command) + (let ((input (concat (helm-basename + (expand-file-name + candidate + helm-ff-default-directory)) + ;; The locate '-b' option doesn't exists + ;; in everything (es). + (unless (and (eq system-type 'windows-nt) + (string-match "^es" helm-locate-command)) + " -b")))) + (helm-locate-1 helm-current-prefix-arg nil 'from-ff input))) + +(defun helm-ff-run-locate () + "Run locate action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-ff-locate))) + +(defun helm-files-insert-as-org-link (candidate) + (insert (format "[[%s][]]" candidate)) + (goto-char (- (point) 2))) + +(defun helm-ff-run-insert-org-link () + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-files-insert-as-org-link))) + +(defun helm-ff-run-find-file-as-root () + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-find-file-as-root))) + +(defun helm-ff-run-gnus-attach-files () + "Run gnus attach files command action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-ff-gnus-attach-files))) + +(defun helm-ff-run-etags () + "Run Etags command action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-ff-etags-select))) + +(defvar lpr-printer-switch) +(defun helm-ff-print (_candidate) + "Print marked files. + +You may to set in order +variables `lpr-command',`lpr-switches' and/or `printer-name', +but with no settings helm should detect your printer(s) and +print with the default `lpr' settings. + +NOTE: DO NOT set the \"-P\" flag in `lpr-switches', if you really +have to modify this, do it in `lpr-printer-switch'. + +Same as `dired-do-print' but for helm." + (require 'lpr) + (when (or helm-current-prefix-arg + (not helm-ff-printer-list)) + (setq helm-ff-printer-list + (helm-ff-find-printers))) + (let* ((file-list (helm-marked-candidates :with-wildcard t)) + (len (length file-list)) + (printer-name (if helm-ff-printer-list + (helm-comp-read + "Printer: " helm-ff-printer-list) + printer-name)) + (lpr-switches + (if (and (stringp printer-name) + (string< "" printer-name)) + (cons (concat lpr-printer-switch printer-name) + lpr-switches) + lpr-switches)) + (command (helm-read-string + (format "Print *%s File(s):\n%s with: " + len + (mapconcat + (lambda (f) (format "- %s\n" f)) + file-list "")) + (when (and lpr-command lpr-switches) + (mapconcat 'identity + (cons lpr-command + (if (stringp lpr-switches) + (list lpr-switches) + lpr-switches)) + " ")))) + (file-args (mapconcat #'(lambda (x) + (format "'%s'" x)) + file-list " ")) + (cmd-line (concat command " " file-args))) + (if command + (start-process-shell-command "helm-print" nil cmd-line) + (error "Error: Please verify your printer settings in Emacs.")))) + +(defun helm-ff-run-print-file () + "Run Print file action from `helm-source-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-ff-print))) + +(defun helm-ff-checksum (file) + "Calculate the checksum of FILE. +The checksum is copied to kill-ring." + (let ((algo (intern (helm-comp-read + "Algorithm: " + '(md5 sha1 sha224 sha256 sha384 sha512))))) + (kill-new (with-temp-buffer + (insert-file-contents-literally file) + (secure-hash algo (current-buffer)))) + (message "Checksum copied to kill-ring."))) + +(defun helm-ff-toggle-basename (_candidate) + (setq helm-ff-transformer-show-only-basename + (not helm-ff-transformer-show-only-basename)) + (let* ((cand (helm-get-selection nil t)) + (target (if helm-ff-transformer-show-only-basename + (helm-basename cand) cand))) + (helm-force-update (regexp-quote target)))) + +(defun helm-ff-run-toggle-basename () + (interactive) + (with-helm-alive-p + (unless (helm-empty-source-p) + (helm-attrset 'toggle-basename '(helm-ff-toggle-basename . never-split)) + (helm-execute-persistent-action 'toggle-basename)))) + +(cl-defun helm-reduce-file-name (fname level &key unix-close expand) + "Reduce FNAME by LEVEL from end or beginning depending LEVEL value. +If LEVEL is positive reduce from end else from beginning. +If UNIX-CLOSE is non--nil close filename with /. +If EXPAND is non--nil expand-file-name." + (let* ((exp-fname (expand-file-name fname)) + (fname-list (split-string (if (or (string= fname "~/") expand) + exp-fname fname) "/" t)) + (len (length fname-list)) + (pop-list (if (< level 0) + (cl-subseq fname-list (* level -1)) + (cl-subseq fname-list 0 (- len level)))) + (result (mapconcat 'identity pop-list "/")) + (empty (string= result ""))) + (when unix-close (setq result (concat result "/"))) + (if (string-match "^~" result) + (if (string= result "~/") "~/" result) + (if (< level 0) + (if empty "../" (concat "../" result)) + (cond ((eq system-type 'windows-nt) + (if empty (expand-file-name "/") ; Expand to "/" or "c:/". + result)) + (empty "/") + (t + (concat "/" result))))))) + +;; Internal +(defvar helm--file-completion-sources + '("Find Files" "Read File Name" "Read File Name History") + "Sources that use the *find-files mechanism can be added here. +Sources generated by `helm-mode' don't need to be added here, it will +be done automatically. +You should not modify this yourself unless you know what you do.") + +(defun helm-file-completion-source-p () + "Return non--nil if current source is a file completion source." + (or minibuffer-completing-file-name + (let ((cur-source (cdr (assoc 'name (helm-get-current-source))))) + (cl-loop for i in helm--file-completion-sources + thereis (string= cur-source i))))) + +(defun helm-find-files-up-one-level (arg) + "Go up one level like unix command `cd ..'. +If prefix numeric arg is given go ARG level up." + (interactive "p") + (with-helm-alive-p + (when (and (helm-file-completion-source-p) + (not (helm-ff-invalid-tramp-name-p))) + (with-helm-window + (when helm-follow-mode + (helm-follow-mode -1) (message nil))) + ;; When going up one level we want to be at the line + ;; corresponding to actual directory, so store this info + ;; in `helm-ff-last-expanded'. + (let ((cur-cand (helm-get-selection)) + (new-pattern (helm-reduce-file-name + helm-pattern arg :unix-close t :expand t))) + (cond ((file-directory-p helm-pattern) + (setq helm-ff-last-expanded helm-ff-default-directory)) + ((file-exists-p helm-pattern) + (setq helm-ff-last-expanded helm-pattern)) + ((and cur-cand (file-exists-p cur-cand)) + (setq helm-ff-last-expanded cur-cand))) + (helm-set-pattern new-pattern helm-suspend-update-flag) + (with-helm-after-update-hook (helm-ff-retrieve-last-expanded)))))) + +(defun helm-ff-retrieve-last-expanded () + "Move overlay to last visited directory `helm-ff-last-expanded'. +This happen after using `helm-find-files-up-one-level', +or hitting C-j on \"..\"." + (when helm-ff-last-expanded + (let ((presel (if helm-ff-transformer-show-only-basename + (helm-basename + (directory-file-name helm-ff-last-expanded)) + (directory-file-name helm-ff-last-expanded)))) + (with-helm-window + (when (re-search-forward (concat "^" (regexp-quote presel) "$") nil t) + (forward-line 0) + (helm-mark-current-line))) + (setq helm-ff-last-expanded nil)))) + +(defun helm-ff-move-to-first-real-candidate () + "When candidate is an incomplete file name move to first real candidate." + (helm-aif (and (helm-file-completion-source-p) + (not (helm-empty-source-p)) + (not (string-match + "\\`[Dd]ired" + (assoc-default 'name (helm-get-current-source)))) + helm-ff--move-to-first-real-candidate + (helm-get-selection)) + (unless (or (not (stringp it)) + (and (string-match helm-tramp-file-name-regexp it) + (not (file-remote-p it nil t))) + (file-exists-p it)) + (helm-next-line)))) +(add-hook 'helm-after-update-hook 'helm-ff-move-to-first-real-candidate) + +;;; Auto-update - helm-find-files auto expansion of directories. +;; +;; +(defun helm-ff-update-when-only-one-matched () + "Expand to directory when sole completion. +When only one candidate is remaining and it is a directory, +expand to this directory. +This happen only when `helm-ff-auto-update-flag' is non--nil +or when `helm-pattern' is equal to \"~/\"." + (when (or (and helm-ff-auto-update-flag + (null helm-ff--deleting-char-backward) + (helm-file-completion-source-p) + ;; Issue #295 + ;; File predicates are returning t + ;; with paths like //home/foo. + ;; So check it is not the case by regexp + ;; to allow user to do C-a / to start e.g + ;; entering a tramp method e.g /sudo::. + (not (string-match "\\`//" helm-pattern)) + (not (helm-ff-invalid-tramp-name-p)) + (not (eq last-command 'helm-yank-text-at-point))) + ;; Fix issue #542. + (string= helm-pattern "~/")) + (let* ((history-p (string= (assoc-default + 'name (helm-get-current-source)) + "Read File Name History")) + (pat (if (string-match helm-tramp-file-name-regexp + helm-pattern) + (helm-create-tramp-name helm-pattern) + helm-pattern)) + (completed-p (string= (file-name-as-directory + (expand-file-name pat)) + helm-ff-default-directory)) + (candnum (helm-get-candidate-number))) + (when (and (or + ;; Only one candidate remaining + ;; and at least 2 char in basename. + (and (<= candnum 2) + (>= (string-width (helm-basename helm-pattern)) 2)) + ;; Already completed. + completed-p) + (not history-p)) ; Don't try to auto complete in history. + (with-helm-window + (let ((cur-cand (prog2 + (unless (or completed-p (file-exists-p pat)) + ;; Only one non--existing candidate + ;; and one directory candidate, move to it. + (helm-next-line)) + (helm-get-selection)))) + (when (and (stringp cur-cand) + (file-accessible-directory-p cur-cand)) + (if (and (not (helm-dir-is-dot cur-cand)) ; [1] + ;; Maybe we are here because completed-p is true + ;; but check this again to be sure. (Windows fix) + (<= candnum 2)) ; [2] + ;; If after going to next line the candidate + ;; is not one of "." or ".." [1] + ;; and only one candidate is remaining [2], + ;; assume candidate is a new directory to expand, and do it. + (helm-set-pattern (file-name-as-directory cur-cand)) + ;; The candidate is one of "." or ".." + ;; that mean we have entered the last letter of the directory name + ;; in prompt, so expansion is already done, just add the "/" at end + ;; of name unless helm-pattern ends with "." + ;; (i.e we are writing something starting with ".") + (unless (string-match "\\`.*[.]\\{1\\}\\'" helm-pattern) + (helm-set-pattern + ;; Need to expand-file-name to avoid e.g /ssh:host:./ in prompt. + (expand-file-name (file-name-as-directory helm-pattern))))) + (helm-check-minibuffer-input)))))))) + +(defun helm-ff-auto-expand-to-home-or-root () + "Allow expanding to home/user directory or root or text yanked after pattern." + (when (and (helm-file-completion-source-p) + (string-match + "/\\$.*/\\|/\\./\\|/\\.\\./\\|/~.*/\\|//\\|\\(/[[:alpha:]]:/\\|\\s\\+\\)" + helm-pattern) + (with-current-buffer (window-buffer (minibuffer-window)) (eolp)) + (not (string-match helm-ff-url-regexp helm-pattern))) + (let* ((match (match-string 0 helm-pattern)) + (input (cond ((string= match "/./") + (expand-file-name default-directory)) + ((string= helm-pattern "/../") "/") + ((string-match-p "\\`/\\$" match) + (let ((sub (substitute-in-file-name match))) + (if (file-directory-p sub) + sub (replace-regexp-in-string "/\\'" "" sub)))) + (t (expand-file-name + (helm-substitute-in-filename helm-pattern) + ;; [Windows] On UNC paths "/" expand to current machine, + ;; so use the root of current Drive. (i.e "C:/") + (and (memq system-type '(windows-nt ms-dos)) + (getenv "SystemDrive")) ; nil on Unix. + ))))) + (if (file-directory-p input) + (setq helm-ff-default-directory + (setq input (file-name-as-directory input))) + (setq helm-ff-default-directory (file-name-as-directory + (file-name-directory input)))) + (with-helm-window + (helm-set-pattern input) + (helm-check-minibuffer-input))))) + +(defun helm-substitute-in-filename (fname) + "Substitute all parts of FNAME from start up to \"~/\" or \"/\". +On windows system substitute from start up to \"/[[:lower:]]:/\". +This function is needed for `helm-ff-auto-expand-to-home-or-root' +and should be used carefully elsewhere, or not at all, using +`substitute-in-file-name' instead." + (if (and ffap-url-regexp + (string-match-p ffap-url-regexp fname)) + fname + (with-temp-buffer + (insert fname) + (goto-char (point-min)) + (skip-chars-forward "/") ;; Avoid infloop in UNC paths Issue #424 + (if (re-search-forward "~.*/?\\|//\\|/[[:alpha:]]:/" nil t) + (let ((match (match-string 0))) + (goto-char (if (or (string= match "//") + (string-match-p "/[[:alpha:]]:/" match)) + (1+ (match-beginning 0)) + (match-beginning 0))) + (buffer-substring-no-properties (point) (point-at-eol))) + fname)))) + +(add-hook 'helm-after-update-hook 'helm-ff-update-when-only-one-matched) +(add-hook 'helm-after-update-hook 'helm-ff-auto-expand-to-home-or-root) + +(defun helm-point-file-in-dired (file) + "Put point on filename FILE in dired buffer." + (unless (and ffap-url-regexp + (string-match-p ffap-url-regexp file)) + (let ((target (expand-file-name (helm-substitute-in-filename file)))) + (dired (file-name-directory target)) + (dired-goto-file target)))) + +(defun helm-create-tramp-name (fname) + "Build filename for `helm-pattern' like /su:: or /sudo::." + (apply #'tramp-make-tramp-file-name + (cl-loop with v = (tramp-dissect-file-name fname) + for i across v collect i))) + +(cl-defun helm-ff-tramp-hostnames (&optional (pattern helm-pattern)) + "Get a list of hosts for tramp method found in `helm-pattern'. +Argument PATTERN default to `helm-pattern', it is here only for debugging +purpose." + (when (string-match helm-tramp-file-name-regexp pattern) + (let ((method (match-string 1 pattern)) + (tn (match-string 0 pattern)) + (all-methods (mapcar 'car tramp-methods))) + (helm-fast-remove-dups + (cl-loop for (f . h) in (tramp-get-completion-function method) + append (cl-loop for e in (funcall f (car h)) + for host = (and (consp e) (cadr e)) + when (and host (not (member host all-methods))) + collect (concat tn host))) + :test 'equal)))) + +(defun helm-ff-before-action-hook-fn () + "Exit helm when user try to execute action on an invalid tramp fname." + (let ((cand (helm-get-selection))) + (when (and (helm-file-completion-source-p) + (stringp cand) + (helm-ff-invalid-tramp-name-p cand) ; Check candidate. + (helm-ff-invalid-tramp-name-p)) ; check helm-pattern. + (error "Error: Unknown file or directory `%s'" cand)))) +(add-hook 'helm-before-action-hook 'helm-ff-before-action-hook-fn) + +(cl-defun helm-ff-invalid-tramp-name-p (&optional (pattern helm-pattern)) + "Return non--nil when PATTERN is an invalid tramp filename." + (string= (helm-ff-set-pattern pattern) + "Invalid tramp file name")) + +(defun helm-ff-set-pattern (pattern) + "Handle tramp filenames in `helm-pattern'." + (let ((methods (mapcar 'car tramp-methods)) + (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:") + cur-method tramp-name) + ;; In some rare cases tramp can return a nil input, + ;; so be sure pattern is a string for safety (Issue #476). + (unless pattern (setq pattern "")) + (cond ((string-match "\\`\\$" pattern) + (substitute-in-file-name pattern)) + ((string= pattern "") "") + ((string-match "\\`[.]\\{1,2\\}/\\'" pattern) + (expand-file-name pattern)) + ((string-match ".*\\(~?/?[.]\\{1\\}/\\)\\'" pattern) + (expand-file-name default-directory)) + ((and (string-match ".*\\(~//\\|//\\)\\'" pattern) + (not (string-match helm-ff-url-regexp helm-pattern))) + (expand-file-name "/")) ; Expand to "/" or "c:/" + ((string-match "\\`\\(~/\\|.*/~/\\)\\'" pattern) + (expand-file-name "~/")) + ;; Match "/method:maybe_hostname:~" + ((and (string-match (concat reg "~") pattern) + (setq cur-method (match-string 1 pattern)) + (member cur-method methods)) + (setq tramp-name (expand-file-name + (helm-create-tramp-name + (match-string 0 pattern)))) + (replace-match tramp-name nil t pattern)) + ;; Match "/method:maybe_hostname:" + ((and (string-match reg pattern) + (setq cur-method (match-string 1 pattern)) + (member cur-method methods)) + (setq tramp-name (helm-create-tramp-name + (match-string 0 pattern))) + (replace-match tramp-name nil t pattern)) + ;; Match "/hostname:" + ((and (string-match helm-tramp-file-name-regexp pattern) + (setq cur-method (match-string 1 pattern)) + (and cur-method (not (member cur-method methods)))) + (setq tramp-name (helm-create-tramp-name + (match-string 0 pattern))) + (replace-match tramp-name nil t pattern)) + ;; Match "/method:" in this case don't try to connect. + ((and (not (string-match reg pattern)) + (string-match helm-tramp-file-name-regexp pattern) + (member (match-string 1 pattern) methods)) + "Invalid tramp file name") ; Write in helm-buffer. + ;; PATTERN is a directory, end it with "/". + ;; This will make PATTERN not ending yet with "/" + ;; candidate for `helm-ff-default-directory', + ;; allowing `helm-ff-retrieve-last-expanded' to retrieve it + ;; when descending level. + ;; However, we don't add automatically the "/" when + ;; `helm-ff-auto-update-flag' is enabled to avoid quick expansion. + ((and (file-accessible-directory-p pattern) + helm-ff-auto-update-flag) + (file-name-as-directory (expand-file-name pattern))) + ;; Return PATTERN unchanged. + (t pattern)))) + +(defun helm-find-files-get-candidates (&optional require-match) + "Create candidate list for `helm-source-find-files'." + (let* ((path (helm-ff-set-pattern helm-pattern)) + (dir-p (file-accessible-directory-p path)) + basedir + invalid-basedir + non-essential + (tramp-verbose helm-tramp-verbose)) ; No tramp message when 0. + (set-text-properties 0 (length path) nil path) + ;; Issue #118 allow creation of newdir+newfile. + (unless (or + ;; A tramp file name not completed. + (string= path "Invalid tramp file name") + ;; An empty pattern + (string= path "") + ;; Check if base directory of PATH is valid. + (helm-aif (file-name-directory path) + ;; If PATH is a valid directory IT=PATH, + ;; else IT=basedir of PATH. + (file-directory-p it))) + ;; BASEDIR is invalid, that's mean user is starting + ;; to write a non--existing path in minibuffer + ;; probably to create a 'new_dir' or a 'new_dir+new_file'. + (setq invalid-basedir t)) + ;; Don't set now `helm-pattern' if `path' == "Invalid tramp file name" + ;; like that the actual value (e.g /ssh:) is passed to + ;; `helm-ff-tramp-hostnames'. + (unless (or (string= path "Invalid tramp file name") + invalid-basedir) ; Leave helm-pattern unchanged. + (setq helm-ff-auto-update-flag ; [1] + ;; Unless auto update is disabled at startup or + ;; interactively, start auto updating only at third char. + (unless (or (null helm-ff-auto-update-initial-value) + (null helm-ff--auto-update-state) + ;; But don't enable auto update when + ;; deleting backward. + helm-ff--deleting-char-backward) + (or (>= (length (helm-basename path)) 3) dir-p))) + (setq helm-pattern (helm-ff--transform-pattern-for-completion path)) + ;; This have to be set after [1] to allow deleting char backward. + (setq basedir (expand-file-name + (if (and dir-p helm-ff-auto-update-flag) + ;; Add the final "/" to path + ;; when `helm-ff-auto-update-flag' is enabled. + (file-name-as-directory path) + (file-name-directory path)))) + (setq helm-ff-default-directory + (if (string= helm-pattern "") + (expand-file-name "/") ; Expand to "/" or "c:/" + ;; If path is an url *default-directory have to be nil. + (unless (or (string-match helm-ff-url-regexp path) + (and ffap-url-regexp + (string-match ffap-url-regexp path))) + basedir)))) + (cond ((string= path "Invalid tramp file name") + (or (helm-ff-tramp-hostnames) ; Hostnames completion. + (prog2 + ;; `helm-pattern' have not been modified yet. + ;; Set it here to the value of `path' that should be now + ;; "Invalid tramp file name" and set the candidates list + ;; to ("Invalid tramp file name") to make `helm-pattern' + ;; match single candidate "Invalid tramp file name". + (setq helm-pattern path) + ;; "Invalid tramp file name" is now printed + ;; in `helm-buffer'. + (list path)))) + ((or (and (file-regular-p path) + (eq last-repeatable-command 'helm-execute-persistent-action)) + ;; `ffap-url-regexp' don't match until url is complete. + (string-match helm-ff-url-regexp path) + invalid-basedir + (and (not (file-exists-p path)) (string-match "/$" path)) + (and ffap-url-regexp (string-match ffap-url-regexp path))) + (list path)) + ((string= path "") (helm-ff-directory-files "/" t)) + ((and (file-directory-p path) (not (file-readable-p path))) + (list (format "Opening directory: access denied, `%s'" path))) + ;; A fast expansion of PATH is made only if `helm-ff-auto-update-flag' + ;; is enabled. + ((and dir-p helm-ff-auto-update-flag) + (helm-ff-directory-files path t)) + (t (append (unless (or require-match + ;; When `helm-ff-auto-update-flag' has been + ;; disabled, whe don't want PATH to be added on top + ;; if it is a directory. + dir-p) + (list path)) + (helm-ff-directory-files basedir t)))))) + +(defsubst helm-ff-directory-files (directory &optional full) + "List contents of DIRECTORY. +Argument FULL mean absolute path. +It is same as `directory-files' but always returns the +dotted filename '.' and '..' even on root directories in Windows +systems." + (setq directory (file-name-as-directory + (expand-file-name directory))) + (let ((ls (directory-files + directory full directory-files-no-dot-files-regexp)) + (dot (concat directory ".")) + (dot2 (concat directory ".."))) + (append (list dot dot2) ls))) + +(defun helm-ff-handle-backslash (fname) + ;; Allow creation of filenames containing a backslash. + (cl-loop with bad = '((92 . "")) + for i across fname + for isbad = (assq i bad) + if isbad concat (cdr isbad) + else concat (string i))) + +(defun helm-ff-smart-completion-p () + (and helm-ff-smart-completion + (not (memq helm-mp-matching-method '(multi1 multi3p))))) + +(defun helm-ff--transform-pattern-for-completion (pattern) + "Maybe return PATTERN with it's basename modified as a regexp. +This happen only when `helm-ff-smart-completion' is enabled. +This provide a similar behavior as `ido-enable-flex-matching'. +See also `helm--mapconcat-pattern'. +If PATTERN is an url returns it unmodified. +When PATTERN contain a space fallback to match-plugin. +If basename contain one or more space fallback to match-plugin. +If PATTERN is a valid directory name,return PATTERN unchanged." + ;; handle bad filenames containing a backslash. + (setq pattern (helm-ff-handle-backslash pattern)) + (let ((bn (helm-basename pattern)) + (bd (or (helm-basedir pattern) "")) + (dir-p (file-directory-p pattern)) + (tramp-p (cl-loop for (m . f) in tramp-methods + thereis (string-match m pattern)))) + ;; Always regexp-quote base directory name to handle + ;; crap dirnames such e.g bookmark+ + (cond + ((or (and dir-p tramp-p (string-match ":\\'" pattern)) + (string= pattern "") + (and dir-p (<= (length bn) 2)) + ;; Fix Issue #541 when BD have a subdir similar + ;; to BN, don't switch to match plugin + ;; which will match both. + (and dir-p (string-match (regexp-quote bn) bd))) + ;; Use full PATTERN on e.g "/ssh:host:". + (regexp-quote pattern)) + ;; Prefixing BN with a space call match-plugin completion. + ;; This allow showing all files/dirs matching BN (Issue #518). + ;; FIXME: some match-plugin methods may not work here. + (dir-p (concat (regexp-quote bd) " " (regexp-quote bn))) + ((or (not (helm-ff-smart-completion-p)) + (string-match "\\s-" bn)) ; Fall back to match-plugin. + (concat (regexp-quote bd) bn)) + ((or (string-match "[*][.]?.*" bn) ; Allow entering wilcard. + (string-match "/$" pattern) ; Allow mkdir. + (string-match helm-ff-url-regexp pattern) + (and (string= helm-ff-default-directory "/") tramp-p)) + ;; Don't treat wildcards ("*") as regexp char. + ;; (e.g ./foo/*.el => ./foo/[*].el) + (concat (regexp-quote bd) + (replace-regexp-in-string "[*]" "[*]" bn))) + (t + (setq bn (if (>= (length bn) 2) ; wait 2nd char before concating. + (helm--mapconcat-pattern bn) + (concat ".*" (regexp-quote bn)))) + (concat (regexp-quote bd) bn))))) + +(defun helm-dir-is-dot (dir) + (string-match "\\(?:/\\|\\`\\)\\.\\{1,2\\}\\'" dir)) + +(defun helm-ff-save-history () + "Store the last value of `helm-ff-default-directory' in `helm-ff-history'. +Note that only existing directories are saved here." + (when (and helm-ff-default-directory + (helm-file-completion-source-p) + (file-directory-p helm-ff-default-directory)) + (set-text-properties 0 (length helm-ff-default-directory) + nil helm-ff-default-directory) + (push helm-ff-default-directory helm-ff-history))) +(add-hook 'helm-cleanup-hook 'helm-ff-save-history) + +(defun helm-files-save-file-name-history (&optional force) + "Save selected file to `file-name-history'." + (let ((src-name (assoc-default 'name (helm-get-current-source)))) + (when (or force (helm-file-completion-source-p) + (member src-name helm-files-save-history-extra-sources)) + (let ((mkd (helm-marked-candidates)) + (history-delete-duplicates t)) + (cl-loop for sel in mkd + when (and sel + (stringp sel) + (file-exists-p sel) + (not (file-directory-p sel))) + do + ;; we use `abbreviate-file-name' here because + ;; other parts of Emacs seems to, + ;; and we don't want to introduce duplicates. + (add-to-history 'file-name-history + (abbreviate-file-name sel))))))) +(add-hook 'helm-exit-minibuffer-hook 'helm-files-save-file-name-history) + +(defun helm-ff-valid-symlink-p (file) + (helm-aif (condition-case-unless-debug nil + ;; `file-truename' send error + ;; on cyclic symlinks (Issue #692). + (file-truename file) + (error nil)) + (file-exists-p it))) + +(defun helm-get-default-mode-for-file (filename) + "Return the default mode to open FILENAME." + (let ((mode (cl-loop for (r . m) in auto-mode-alist + thereis (and (string-match r filename) m)))) + (or (and (symbolp mode) mode) "Fundamental"))) + +(defun helm-ff-properties (candidate) + "Show file properties of CANDIDATE in a tooltip or message." + (let* ((all (helm-file-attributes candidate)) + (dired-line (helm-file-attributes + candidate :dired t :human-size t)) + (type (cl-getf all :type)) + (mode-type (cl-getf all :mode-type)) + (owner (cl-getf all :uid)) + (owner-right (cl-getf all :user t)) + (group (cl-getf all :gid)) + (group-right (cl-getf all :group)) + (other-right (cl-getf all :other)) + (size (helm-file-human-size (cl-getf all :size))) + (modif (cl-getf all :modif-time)) + (access (cl-getf all :access-time)) + (ext (helm-get-default-program-for-file candidate)) + (tooltip-hide-delay (or helm-tooltip-hide-delay tooltip-hide-delay))) + (if (and (window-system) tooltip-mode) + (tooltip-show + (concat + (helm-basename candidate) "\n" + dired-line "\n" + (format "Mode: %s\n" (helm-get-default-mode-for-file candidate)) + (format "Ext prog: %s\n" (or (and ext (replace-regexp-in-string + " %s" "" ext)) + "Not defined")) + (format "Type: %s: %s\n" type mode-type) + (when (string= type "symlink") + (format "True name: '%s'\n" + (cond ((string-match "^\.#" (helm-basename candidate)) + "Autosave symlink") + ((helm-ff-valid-symlink-p candidate) + (file-truename candidate)) + (t "Invalid Symlink")))) + (format "Owner: %s: %s\n" owner owner-right) + (format "Group: %s: %s\n" group group-right) + (format "Others: %s\n" other-right) + (format "Size: %s\n" size) + (format "Modified: %s\n" modif) + (format "Accessed: %s\n" access))) + (message dired-line) (sit-for 5)))) + +(defun helm-ff-properties-persistent () + "Show properties without quitting helm." + (interactive) + (with-helm-alive-p + (helm-attrset 'properties-action '(helm-ff-properties . never-split)) + (helm-execute-persistent-action 'properties-action))) + +(defun helm-ff-persistent-delete () + "Delete current candidate without quitting." + (interactive) + (with-helm-alive-p + (helm-attrset 'quick-delete '(helm-ff-quick-delete . never-split)) + (helm-execute-persistent-action 'quick-delete))) + +(defun helm-ff-dot-file-p (file) + "Check if FILE is `.' or `..'." + (member (helm-basename file) '("." ".."))) + +(defun helm-ff-quick-delete (_candidate) + "Delete file CANDIDATE without quitting." + (let ((marked (helm-marked-candidates))) + (unwind-protect + (save-selected-window + (cl-loop for c in marked do + (progn (helm-preselect (if (and helm-ff-transformer-show-only-basename + (not (helm-ff-dot-file-p c))) + (helm-basename c) c)) + (when (y-or-n-p (format "Really Delete file `%s'? " c)) + (helm-delete-file c helm-ff-signal-error-on-dot-files + 'synchro) + (helm-delete-current-selection) + (message nil))))) + (with-helm-buffer + (setq helm-marked-candidates nil + helm-visible-mark-overlays nil)) + (helm-force-update)))) + +(defun helm-ff-kill-buffer-fname (candidate) + (let ((buf (get-file-buffer candidate))) + (if buf + (progn + (kill-buffer buf) (message "Buffer `%s' killed" buf)) + (message "No buffer to kill")))) + +(defun helm-ff-kill-or-find-buffer-fname (candidate) + "Find file CANDIDATE or kill it's buffer if it is visible. +Never kill `helm-current-buffer'. +Never kill buffer modified. +This is called normally on third hit of \ +\\\\[helm-execute-persistent-action] +in `helm-find-files-persistent-action'." + (let* ((buf (get-file-buffer candidate)) + (buf-name (buffer-name buf)) + (win (get-buffer-window buf)) + (helm--reading-passwd-or-string t)) + (if (and buf win + (not (eq buf (get-buffer helm-current-buffer))) + (not (buffer-modified-p buf))) + (progn + (kill-buffer buf) + (set-window-buffer win helm-current-buffer) + (message "Buffer `%s' killed" buf-name)) + (find-file candidate)))) + +(defun helm-ff-run-kill-buffer-persistent () + "Execute `helm-ff-kill-buffer-fname' whitout quitting." + (interactive) + (with-helm-alive-p + (helm-attrset 'kill-buffer-fname 'helm-ff-kill-buffer-fname) + (helm-execute-persistent-action 'kill-buffer-fname))) + +(defun helm-ff-prefix-filename (fname &optional file-or-symlinkp new-file) + "Return filename FNAME maybe prefixed with [?] or [@]. +If FILE-OR-SYMLINKP is non--nil this mean we assume FNAME is an +existing filename or valid symlink and there is no need to test it. +NEW-FILE when non--nil mean FNAME is a non existing file and +return FNAME prefixed with [?]." + (let* ((prefix-new (propertize + " " 'display + (propertize "[?]" 'face 'helm-ff-prefix))) + (prefix-url (propertize + " " 'display + (propertize "[@]" 'face 'helm-ff-prefix)))) + (cond ((or file-or-symlinkp (file-exists-p fname)) fname) + ((or (string-match helm-ff-url-regexp fname) + (and ffap-url-regexp (string-match ffap-url-regexp fname))) + (concat prefix-url " " fname)) + ((or new-file (not (file-exists-p fname))) + (concat prefix-new " " fname))))) + +(defun helm-ff-score-candidate-for-pattern (str pattern) + (if (member str '("." "..")) + 200 + (helm-score-candidate-for-pattern str pattern))) + +(defun helm-ff-sort-candidates (candidates _source) + "Sort function for `helm-source-find-files'. +Return candidates prefixed with basename of `helm-input' first." + (if (or (and (file-directory-p helm-input) + (string-match "/\\'" helm-input)) + (string-match "\\`\\$" helm-input) + (null candidates)) + candidates + (let* ((c1 (car candidates)) + (cand1real (if (consp c1) (cdr c1) c1)) + (cand1 (unless (file-exists-p cand1real) c1)) + (rest-cand (if cand1 (cdr candidates) candidates)) + (memo-src (make-hash-table :test 'equal)) + (all (sort rest-cand + #'(lambda (s1 s2) + (let* ((score (lambda (str) + (helm-ff-score-candidate-for-pattern + str (helm-basename helm-input)))) + (bn1 (helm-basename (if (consp s1) (cdr s1) s1))) + (bn2 (helm-basename (if (consp s2) (cdr s2) s2))) + (sc1 (or (gethash bn1 memo-src) + (puthash bn1 (funcall score bn1) memo-src))) + (sc2 (or (gethash bn2 memo-src) + (puthash bn2 (funcall score bn2) memo-src)))) + (cond ((= sc1 sc2) + (< (string-width bn1) + (string-width bn2))) + ((> sc1 sc2)))))))) + (if cand1 (cons cand1 all) all)))) + +(defun helm-ff-filter-candidate-one-by-one (file) + "`filter-one-by-one' Transformer function for `helm-source-find-files'." + ;; Handle boring files + (unless (and helm-ff-skip-boring-files + (cl-loop for r in helm-boring-file-regexp-list + ;; Prevent user doing silly thing like + ;; adding the dotted files to boring regexps (#924). + thereis (and (not (string-match "\\.$" file)) + (string-match r file)))) + ;; Handle tramp files. + (if (and (string-match helm-tramp-file-name-regexp helm-pattern) + helm-ff-tramp-not-fancy) + (if helm-ff-transformer-show-only-basename + (if (helm-dir-is-dot file) + file + (cons (or (helm-ff-get-host-from-tramp-invalid-fname file) + (helm-basename file)) + file)) + file) + ;; Now highlight. + (let* ((disp (if (and helm-ff-transformer-show-only-basename + (not (helm-dir-is-dot file)) + (not (and ffap-url-regexp + (string-match ffap-url-regexp file))) + (not (string-match helm-ff-url-regexp file))) + (or (helm-ff-get-host-from-tramp-invalid-fname file) + (helm-basename file)) file)) + (attr (file-attributes file)) + (type (car attr))) + + (cond ((string-match "access denied" file) file) + ( ;; A not already saved file. + (and (stringp type) + (not (helm-ff-valid-symlink-p file)) + (not (string-match "^\.#" (helm-basename file)))) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-invalid-symlink) t) + file)) + ;; A symlink. + ((stringp type) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-symlink) t) + file)) + ;; A dotted directory. + ((and (eq t type) (helm-ff-dot-file-p file)) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-dotted-directory) t) + file)) + ;; A directory. + ((eq t type) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-directory) t) + file)) + ;; An executable file. + ((and attr (string-match "x" (nth 8 attr))) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-executable) t) + file)) + ;; A file. + ((and attr (null type)) + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-file) t) + file)) + ;; A non--existing file. + (t + (cons (helm-ff-prefix-filename + (propertize disp 'face 'helm-ff-file) nil 'new-file) + file))))))) + +(defun helm-find-files-action-transformer (actions candidate) + "Action transformer for `helm-source-find-files'." + (cond ((with-helm-current-buffer + (eq major-mode 'message-mode)) + (append actions + '(("Gnus attach file(s)" . helm-ff-gnus-attach-files)))) + ((string-match (image-file-name-regexp) candidate) + (append actions + '(("Rotate image right `M-r'" . helm-ff-rotate-image-right) + ("Rotate image left `M-l'" . helm-ff-rotate-image-left)))) + ((string-match "\.el$" (helm-aif (helm-marked-candidates) + (car it) candidate)) + (append actions + '(("Byte compile lisp file(s) `M-B, C-u to load'" + . helm-find-files-byte-compile) + ("Load File(s) `M-L'" . helm-find-files-load-files)))) + ((and (string-match "\.html?$" candidate) + (file-exists-p candidate)) + (append actions + '(("Browse url file" . browse-url-of-file)))) + ((or (string= (file-name-extension candidate) "pdf") + (string= (file-name-extension candidate) "PDF")) + (append actions + '(("Pdfgrep File(s)" . helm-ff-pdfgrep)))) + (t actions))) + +(defun helm-ff-gnus-attach-files (_candidate) + "Run `gnus-dired-attach' on `helm-marked-candidates' or CANDIDATE." + (require 'gnus-dired) + (let ((flist (helm-marked-candidates :with-wildcard t))) + (gnus-dired-attach flist))) + +(defvar image-dired-display-image-buffer) +(defun helm-ff-rotate-current-image-1 (file &optional num-arg) + "Rotate current image at NUM-ARG degrees. +This is a destructive operation on FILE made by external tool mogrify." + (setq file (file-truename file)) ; For symlinked images. + ;; When FILE is not an image-file, do nothing. + (when (string-match (image-file-name-regexp) file) + (if (executable-find "mogrify") + (progn + (shell-command (format "mogrify -rotate %s %s" + (or num-arg 90) + (shell-quote-argument file))) + (when (buffer-live-p image-dired-display-image-buffer) + (kill-buffer image-dired-display-image-buffer)) + (image-dired-display-image file) + (message nil) + (display-buffer (get-buffer image-dired-display-image-buffer))) + (error "mogrify not found")))) + +(defun helm-ff-rotate-image-left (candidate) + "Rotate image file CANDIDATE left. +This affect directly file CANDIDATE." + (helm-ff-rotate-current-image-1 candidate -90)) + +(defun helm-ff-rotate-image-right (candidate) + "Rotate image file CANDIDATE right. +This affect directly file CANDIDATE." + (helm-ff-rotate-current-image-1 candidate)) + +(defun helm-ff-rotate-left-persistent () + "Rotate image left without quitting helm." + (interactive) + (with-helm-alive-p + (helm-attrset 'image-action1 'helm-ff-rotate-image-left) + (helm-execute-persistent-action 'image-action1))) + +(defun helm-ff-rotate-right-persistent () + "Rotate image right without quitting helm." + (interactive) + (with-helm-alive-p + (helm-attrset 'image-action2 'helm-ff-rotate-image-right) + (helm-execute-persistent-action 'image-action2))) + +(defun helm-ff-exif-data (candidate) + "Extract exif data from file CANDIDATE using `helm-ff-exif-data-program'." + (if (and helm-ff-exif-data-program + (executable-find helm-ff-exif-data-program)) + (shell-command-to-string (format "%s %s %s" + helm-ff-exif-data-program + helm-ff-exif-data-program-args + candidate)) + (format "No program %s found to extract exif" + helm-ff-exif-data-program))) + +(defun helm-find-files-persistent-action (candidate) + "Open subtree CANDIDATE without quitting helm. +If CANDIDATE is not a directory expand CANDIDATE filename. +If CANDIDATE is alone, open file CANDIDATE filename. +That's mean: +First hit on C-j expand CANDIDATE second hit open file. +If a prefix arg is given or `helm-follow-mode' is on open file." + (let* ((follow (or (buffer-local-value + 'helm-follow-mode + (get-buffer-create helm-buffer)) + helm--temp-follow-flag)) + (new-pattern (helm-get-selection)) + (num-lines-buf (with-current-buffer helm-buffer + (count-lines (point-min) (point-max)))) + (insert-in-minibuffer #'(lambda (fname) + (with-selected-window (minibuffer-window) + (unless follow + (delete-minibuffer-contents) + (set-text-properties 0 (length fname) + nil fname) + (insert fname)))))) + (cond ((and (helm-ff-invalid-tramp-name-p) + (string-match helm-tramp-file-name-regexp candidate)) + ;; First hit insert hostname and + ;; second hit insert ":" and expand. + (if (string= candidate helm-pattern) + (funcall insert-in-minibuffer (concat candidate ":")) + (funcall insert-in-minibuffer candidate))) + ( ;; A symlink directory, expand it's truename. + (and (file-directory-p candidate) (file-symlink-p candidate)) + (funcall insert-in-minibuffer (file-name-as-directory + (file-truename + (expand-file-name candidate))))) + ;; A directory, open it. + ((file-directory-p candidate) + (when (string= (helm-basename candidate) "..") + (setq helm-ff-last-expanded helm-ff-default-directory)) + (funcall insert-in-minibuffer (file-name-as-directory + (expand-file-name candidate)))) + ;; A symlink file, expand to it's true name. (first hit) + ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow)) + (funcall insert-in-minibuffer (file-truename candidate))) + ;; A regular file, expand it, (first hit) + ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow)) + (setq helm-pattern "") ; Force update. + (funcall insert-in-minibuffer new-pattern)) + ;; An image file and it is the second hit on C-j, + ;; show the file in `image-dired'. + ((string-match (image-file-name-regexp) candidate) + (when (buffer-live-p (get-buffer image-dired-display-image-buffer)) + (kill-buffer image-dired-display-image-buffer)) + ;; Fix emacs bug never fixed upstream. + (unless (file-directory-p image-dired-dir) + (make-directory image-dired-dir)) + (image-dired-display-image candidate) + (message nil) + (switch-to-buffer image-dired-display-image-buffer) + (with-current-buffer image-dired-display-image-buffer + (let ((exif-data (helm-ff-exif-data candidate))) + (setq default-directory helm-ff-default-directory) + (image-dired-update-property 'help-echo exif-data)))) + ;; Allow browsing archive on avfs fs. + ;; Assume volume is already mounted with mountavfs. + ((and helm-ff-avfs-directory + (string-match + (regexp-quote (expand-file-name helm-ff-avfs-directory)) + (file-name-directory candidate)) + (helm-ff-file-compressed-p candidate)) + (funcall insert-in-minibuffer (concat candidate "#"))) + ;; On second hit we open file. + ;; On Third hit we kill it's buffer maybe. + (t + (helm-ff-kill-or-find-buffer-fname candidate))))) + +(defun helm-ff-file-compressed-p (candidate) + "Whether CANDIDATE is a compressed file or not." + (member (file-name-extension candidate) + helm-ff-file-compressed-list)) + +(defun helm-insert-file-name-completion-at-point (candidate) + "Insert file name completion at point." + (with-helm-current-buffer + (if buffer-read-only + (error "Error: Buffer `%s' is read-only" (buffer-name)) + (let* ((end (point)) + (tap (thing-at-point 'filename)) + (guess (and (stringp tap) (substring-no-properties tap))) + (beg (- (point) (length guess))) + (full-path-p (and (stringp guess) + (or (string-match-p + (concat "^" (getenv "HOME")) + guess) + (string-match-p + "\\`\\(/\\|[[:lower:][:upper:]]:/\\)" + guess))))) + (set-text-properties 0 (length candidate) nil candidate) + (if (and guess (not (string= guess "")) + (or (string-match "^\\(~/\\|/\\|[[:lower:][:upper:]]:/\\)" + guess) + (file-exists-p candidate))) + (progn + (delete-region beg end) + (insert (cond (full-path-p + (expand-file-name candidate)) + ((string= (match-string 1 guess) "~/") + (abbreviate-file-name candidate)) + (t (file-relative-name candidate))))) + (insert (cond ((equal helm-current-prefix-arg '(4)) + (abbreviate-file-name candidate)) + ((equal helm-current-prefix-arg '(16)) + (file-relative-name candidate)) + (t candidate)))))))) + +(cl-defun helm-find-files-history (&key (comp-read t)) + "The `helm-find-files' history. +Show the first `helm-ff-history-max-length' elements of +`helm-ff-history' in an `helm-comp-read'." + (let ((history (when helm-ff-history + (helm-fast-remove-dups helm-ff-history + :test 'equal)))) + (when history + (setq helm-ff-history + (if (>= (length history) helm-ff-history-max-length) + (cl-subseq history 0 helm-ff-history-max-length) + history)) + (if comp-read + (helm-comp-read + "Switch to Directory: " + helm-ff-history + :name "Helm Find Files History" + :must-match t) + helm-ff-history)))) + +(defun helm-find-files-1 (fname &optional preselect) + "Find FNAME with `helm' completion. +Like `find-file' but with `helm' support. +Use it for non--interactive calls of `helm-find-files'." + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + (let* ( ;; Be sure we don't erase the precedent minibuffer if some. + (helm-ff-auto-update-initial-value + (and helm-ff-auto-update-initial-value + (not (minibuffer-window-active-p (minibuffer-window))))) + (tap (thing-at-point 'filename)) + (def (and tap (or (file-remote-p tap) + (expand-file-name tap))))) + (unless helm-source-find-files + (setq helm-source-find-files (helm-make-source + "Find Files" 'helm-source-ffiles))) + (helm :sources 'helm-source-find-files + :input fname + :case-fold-search helm-file-name-case-fold-search + :keymap helm-find-files-map + :preselect preselect + :default def + :prompt "Find Files or Url: " + :buffer "*Helm Find Files*"))) + + +(defun helm-find-files-initial-input (&optional input) + "Return INPUT if present, otherwise try to guess it." + (let ((ffap-machine-p-known 'reject)) + (unless (eq major-mode 'image-mode) + (or (and input (or (and (file-remote-p input) input) + (expand-file-name input))) + (helm-find-files-input + (ffap-guesser) + (thing-at-point 'filename)))))) + +(defun helm-find-files-input (file-at-pt thing-at-pt) + "Try to guess a default input for `helm-find-files'." + (let* ((non-essential t) + (remp (or (and file-at-pt (file-remote-p file-at-pt)) + (and thing-at-pt (file-remote-p thing-at-pt)))) + (def-dir (helm-current-directory)) + (urlp (and file-at-pt ffap-url-regexp + (string-match ffap-url-regexp file-at-pt))) + (lib (when helm-ff-search-library-in-sexp + (helm-find-library-at-point))) + (hlink (helm-ff-find-url-at-point)) + (file-p (and file-at-pt + (not (string= file-at-pt "")) + (not remp) + (file-exists-p file-at-pt) + thing-at-pt + (not (string= thing-at-pt "")) + (file-exists-p + (file-name-directory + (expand-file-name thing-at-pt def-dir)))))) + (cond (lib) ; e.g we are inside a require sexp. + (hlink) ; String at point is an hyperlink. + (file-p ; a regular file + (helm-aif (ffap-file-at-point) (expand-file-name it))) + (urlp file-at-pt) ; possibly an url or email. + ((and file-at-pt + (not remp) + (file-exists-p file-at-pt)) + file-at-pt)))) + +(defun helm-ff-find-url-at-point () + "Try to find link to an url in text-property at point." + (let* ((he (get-text-property (point) 'help-echo)) + (ov (overlays-at (point))) + (ov-he (and ov (overlay-get + (car (overlays-at (point))) 'help-echo))) + (w3m-l (get-text-property (point) 'w3m-href-anchor)) + (nt-prop (get-text-property (point) 'nt-link))) + ;; Org link. + (when (and (stringp he) (string-match "^LINK: " he)) + (setq he (replace-match "" t t he))) + (cl-loop for i in (list he ov-he w3m-l nt-prop) + thereis (and (stringp i) ffap-url-regexp (string-match ffap-url-regexp i) i)))) + +(defun helm-find-library-at-point () + "Try to find library path at point. +Find inside `require' and `declare-function' sexp." + (require 'find-func) + (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t))) + (end-sexp (save-excursion (search-forward ")" (point-at-eol) t))) + (sexp (and beg-sexp end-sexp + (buffer-substring-no-properties + (1+ beg-sexp) (1- end-sexp))))) + (ignore-errors + (cond ((and sexp (string-match "require \'.+[^)]" sexp)) + (find-library-name + (replace-regexp-in-string + "'\\|\)\\|\(" "" + ;; If require use third arg, ignore it, + ;; always use library path found in `load-path'. + (cl-second (split-string (match-string 0 sexp)))))) + ((and sexp (string-match-p "^declare-function" sexp)) + (find-library-name + (replace-regexp-in-string + "\"\\|ext:" "" + (cl-third (split-string sexp))))) + (t nil))))) + + +;;; Handle copy, rename, symlink, relsymlink and hardlink from helm. +;; +;; +(defvar dired-async-be-async) +(cl-defun helm-dired-action (candidate + &key action follow (files (dired-get-marked-files))) + "Execute ACTION on FILES to CANDIDATE. +Where ACTION is a symbol that can be one of: +'copy, 'rename, 'symlink,'relsymlink, 'hardlink. +Argument FOLLOW when non--nil specify to follow FILES to destination for the actions +copy and rename." + (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer)) + (let ((fn (cl-case action + (copy 'dired-copy-file) + (rename 'dired-rename-file) + (symlink 'make-symbolic-link) + (relsymlink 'dired-make-relative-symlink) + (hardlink 'dired-hardlink))) + (marker (cl-case action + ((copy rename) dired-keep-marker-copy) + (symlink dired-keep-marker-symlink) + (relsymlink dired-keep-marker-relsymlink) + (hardlink dired-keep-marker-hardlink))) + (dirflag (and (= (length files) 1) + (file-directory-p (car files)) + (not (file-directory-p candidate)))) + ;; When FOLLOW is enabled, disable helm-async. + ;; If it is globally disabled use this nil value. + (dired-async-be-async (and (boundp 'dired-async-be-async) + dired-async-be-async + (not follow)))) + (dired-create-files + fn (symbol-name action) files + ;; CANDIDATE is the destination. + (if (file-directory-p candidate) + ;; When CANDIDATE is a directory, build file-name in this directory. + ;; Else we use CANDIDATE. + #'(lambda (from) + (expand-file-name (file-name-nondirectory from) candidate)) + #'(lambda (_from) candidate)) + marker) + (push (file-name-as-directory + (if (file-directory-p candidate) + (expand-file-name candidate) + (file-name-directory candidate))) + helm-ff-history) + ;; If follow is non--nil we should not be in async mode. + (when (and follow + (not (memq action '(symlink relsymlink hardlink))) + (not (get-buffer dired-log-buffer))) + (let ((target (directory-file-name candidate))) + (unwind-protect + (progn + (setq helm-ff-cand-to-mark + (helm-get-dest-fnames-from-list files candidate dirflag)) + (with-helm-after-update-hook (helm-ff-maybe-mark-candidates)) + (if (and dirflag (eq action 'rename)) + (helm-find-files-1 (file-name-directory target) + (if helm-ff-transformer-show-only-basename + (helm-basename target) target)) + (helm-find-files-1 (file-name-as-directory + (expand-file-name candidate))))) + (setq helm-ff-cand-to-mark nil)))))) + +(defun helm-get-dest-fnames-from-list (flist dest-cand rename-dir-flag) + "Transform filenames of FLIST to abs of DEST-CAND. +If RENAME-DIR-FLAG is non--nil collect the `directory-file-name' of transformed +members of FLIST." + ;; At this point files have been renamed/copied at destination. + ;; That's mean DEST-CAND exists. + (cl-loop + with dest = (expand-file-name dest-cand) + for src in flist + for basename-src = (helm-basename src) + for fname = (cond (rename-dir-flag (directory-file-name dest)) + ((file-directory-p dest) + (concat (file-name-as-directory dest) basename-src)) + (t dest)) + when (file-exists-p fname) + collect fname into tmp-list + finally return (sort tmp-list 'string<))) + +(defun helm-ff-maybe-mark-candidates () + "Mark all candidates of list `helm-ff-cand-to-mark'. +This is used when copying/renaming/symlinking etc... and +following files to destination." + (when (and (string= (assoc-default 'name (helm-get-current-source)) + (assoc-default 'name helm-source-find-files)) + helm-ff-cand-to-mark) + (with-helm-window + (while helm-ff-cand-to-mark + (if (string= (car helm-ff-cand-to-mark) (helm-get-selection)) + (progn + (helm-make-visible-mark) + (helm-next-line) + (setq helm-ff-cand-to-mark (cdr helm-ff-cand-to-mark))) + (helm-next-line))) + (unless (helm-this-visible-mark) + (helm-prev-visible-mark))))) + + +;;; Routines for files +;; +;; +(defun helm-file-buffers (filename) + "Returns a list of buffer names corresponding to FILENAME." + (cl-loop with name = (expand-file-name filename) + for buf in (buffer-list) + for bfn = (buffer-file-name buf) + when (and bfn (string= name bfn)) + collect (buffer-name buf))) + +(defun helm-delete-file (file &optional error-if-dot-file-p synchro) + "Delete the given file after querying the user. +Ask to kill buffers associated with that file, too." + (when (and error-if-dot-file-p + (helm-ff-dot-file-p file)) + (error "Error: Cannot operate on `.' or `..'")) + (let ((buffers (helm-file-buffers file)) + (helm--reading-passwd-or-string t)) + (if (or (< emacs-major-version 24) synchro) + ;; `dired-delete-file' in Emacs versions < 24 + ;; doesn't support delete-by-moving-to-trash + ;; so use `delete-directory' and `delete-file' + ;; that handle it. + (cond ((and (not (file-symlink-p file)) + (file-directory-p file) + (directory-files file t dired-re-no-dot)) + (when (y-or-n-p (format "Recursive delete of `%s'? " file)) + (delete-directory file 'recursive))) + ((and (not (file-symlink-p file)) + (file-directory-p file)) + (delete-directory file)) + (t (delete-file file))) + (dired-delete-file + file dired-recursive-deletes delete-by-moving-to-trash)) + (when buffers + (cl-dolist (buf buffers) + (when (y-or-n-p (format "Kill buffer %s, too? " buf)) + (kill-buffer buf)))))) + +(defun helm-delete-marked-files (_ignore) + (let* ((files (helm-marked-candidates :with-wildcard t)) + (len (length files))) + (with-helm-display-marked-candidates + helm-marked-buffer-name + (mapcar #'(lambda (f) + (if (file-directory-p f) + (concat (helm-basename f) "/") + (helm-basename f))) + files) + (if (not (y-or-n-p (format "Delete *%s File(s)" len))) + (message "(No deletions performed)") + (cl-dolist (i files) + (set-text-properties 0 (length i) nil i) + (helm-delete-file i helm-ff-signal-error-on-dot-files)) + (message "%s File(s) deleted" len))))) + +(defun helm-find-file-or-marked (candidate) + "Open file CANDIDATE or open helm marked files in separate windows. +Called with a prefix arg open files in background without selecting them." + (let ((marked (helm-marked-candidates :with-wildcard t)) + (url-p (and ffap-url-regexp ; we should have only one candidate. + (string-match ffap-url-regexp candidate))) + (ffap-newfile-prompt helm-ff-newfile-prompt-p) + (find-file-wildcards nil) + (make-dir-fn + #'(lambda (dir &optional helm-ff) + (when (y-or-n-p (format "Create directory `%s'? " dir)) + (let ((dirfname (directory-file-name dir))) + (if (file-exists-p dirfname) + (error + "Mkdir: Unable to create directory `%s': file exists." + (helm-basename dirfname)) + (make-directory dir 'parent))) + (when helm-ff + ;; Allow having this new dir in history + ;; to be able to retrieve it immediately + ;; if we want to e.g copy a file from somewhere in it. + (setq helm-ff-default-directory + (file-name-as-directory dir)) + (push helm-ff-default-directory helm-ff-history)) + (or (and helm-ff (helm-find-files-1 dir)) t)))) + (helm--reading-passwd-or-string t)) + (if (cdr marked) + (if helm-current-prefix-arg + (dired-simultaneous-find-file marked nil) + (mapc 'find-file-noselect (cdr marked)) + (find-file (car marked))) + (if (and (not (file-exists-p candidate)) + (not url-p) + (string-match "/$" candidate)) + ;; A a non--existing filename ending with / + ;; Create a directory and jump to it. + (funcall make-dir-fn candidate 'helm-ff) + ;; A non--existing filename NOT ending with / or + ;; an existing filename, create or jump to it. + ;; If the basedir of candidate doesn't exists, + ;; ask for creating it. + (let ((dir (file-name-directory candidate))) + (find-file-at-point + (cond ((and dir (file-directory-p dir)) + (substitute-in-file-name (car marked))) + ;; FIXME Why do we use this on urls ? + (url-p (helm-substitute-in-filename (car marked))) + ((funcall make-dir-fn dir) candidate)))))))) + +(defun helm-shadow-boring-files (files) + "Files matching `helm-boring-file-regexp' will be +displayed with the `file-name-shadow' face if available." + (helm-shadow-entries files helm-boring-file-regexp-list)) + +(defun helm-skip-boring-files (files) + "Files matching `helm-boring-file-regexp' will be skipped." + (helm-skip-entries files helm-boring-file-regexp-list)) + +(defun helm-skip-current-file (files) + "Current file will be skipped." + (remove (buffer-file-name helm-current-buffer) files)) + +(defun helm-w32-pathname-transformer (args) + "Change undesirable features of windows pathnames to ones more acceptable to +other candidate transformers." + (if (eq system-type 'windows-nt) + (helm-transform-mapcar + (lambda (x) + (replace-regexp-in-string + "/cygdrive/\\(.\\)" "\\1:" + (replace-regexp-in-string "\\\\" "/" x))) + args) + args)) + +(defun helm-transform-file-load-el (actions candidate) + "Add action to load the file CANDIDATE if it is an emacs lisp +file. Else return ACTIONS unmodified." + (if (member (file-name-extension candidate) '("el" "elc")) + (append actions '(("Load Emacs Lisp File" . load-file))) + actions)) + +(defun helm-transform-file-browse-url (actions candidate) + "Add an action to browse the file CANDIDATE if it is a html file or URL. +Else return ACTIONS unmodified." + (let ((browse-action '("Browse with Browser" . browse-url))) + (cond ((string-match "^http\\|^ftp" candidate) + (cons browse-action actions)) + ((string-match "\\.html?$" candidate) + (append actions (list browse-action))) + (t actions)))) + +(defun helm-multi-files-toggle-to-locate () + (interactive) + (with-helm-buffer + (if (setq helm-multi-files--toggle-locate + (not helm-multi-files--toggle-locate)) + (progn + (helm-set-sources (unless (memq 'helm-source-locate + helm-sources) + (cons 'helm-source-locate helm-sources))) + (helm-set-source-filter '(helm-source-locate))) + (helm-kill-async-processes) + (helm-set-sources (remove 'helm-source-locate + helm-for-files-preferred-list)) + (helm-set-source-filter nil)))) + + +;;; List of files gleaned from every dired buffer +;; +;; +(defun helm-files-in-all-dired-candidates () + (save-excursion + (cl-loop for (f . b) in dired-buffers + when (buffer-live-p b) + append (let ((dir (with-current-buffer b dired-directory))) + (if (listp dir) (cdr dir) + (directory-files f t dired-re-no-dot)))))) + +;; (dired '("~/" "~/.emacs.d/.emacs-custom.el" "~/.emacs.d/.emacs.bmk")) + +(defvar helm-source-files-in-all-dired + '((name . "Files in all dired buffer.") + (candidates . helm-files-in-all-dired-candidates) + (type . file))) + + +;;; File Cache +;; +;; +(defvar file-cache-alist) + +(defclass helm-file-cache (helm-source-in-buffer helm-type-file) + ((init :initform (lambda () (require 'filecache))) + (keymap :initform helm-generic-files-map) + (help-message :initform helm-generic-file-help-message) + (mode-line :initform helm-generic-file-mode-line-string))) + +(defun helm-file-cache-get-candidates () + (cl-loop for item in file-cache-alist append + (cl-destructuring-bind (base &rest dirs) item + (cl-loop for dir in dirs collect + (concat dir base))))) + +(defvar helm-source-file-cache nil) + +(defcustom helm-file-cache-fuzzy-match nil + "Enable fuzzy matching in `helm-source-file-cache' when non--nil." + :group 'helm-files + :type 'boolean + :set (lambda (var val) + (set var val) + (setq helm-source-file-cache + (helm-make-source "File Cache" 'helm-file-cache + :fuzzy-match helm-file-cache-fuzzy-match + :data 'helm-file-cache-get-candidates)))) + +(cl-defun helm-file-cache-add-directory-recursively + (dir &optional match (ignore-dirs t)) + (require 'filecache) + (cl-loop for f in (helm-walk-directory + dir + :path 'full + :directories nil + :match match + :skip-subdirs ignore-dirs) + do (file-cache-add-file f))) + +(defun helm-ff-cache-add-file (_candidate) + (require 'filecache) + (let ((mkd (helm-marked-candidates :with-wildcard t))) + (mapc 'file-cache-add-file mkd))) + +(defun helm-ff-file-cache-remove-file-1 (file) + "Remove FILE from `file-cache-alist'." + (let ((entry (assoc (helm-basename file) file-cache-alist)) + (dir (helm-basedir file)) + new-entry) + (setq new-entry (remove dir entry)) + (when (= (length entry) 1) + (setq new-entry nil)) + (setq file-cache-alist + (cons new-entry (remove entry file-cache-alist))))) + +(defun helm-ff-file-cache-remove-file (_file) + "Remove marked files from `file-cache-alist.'" + (let ((mkd (helm-marked-candidates))) + (mapc 'helm-ff-file-cache-remove-file-1 mkd))) + +(defun helm-transform-file-cache (actions _candidate) + (let ((source (helm-get-current-source))) + (if (string= (assoc-default 'name source) "File Cache") + (append actions + '(("Remove marked files from file-cache" + . helm-ff-file-cache-remove-file))) + actions))) + + +;;; File name history +;; +;; +(defvar helm-source-file-name-history + `((name . "File Name History") + (candidates . file-name-history) + (persistent-action . ignore) + (filtered-candidate-transformer . helm-file-name-history-transformer) + (action . ,(helm-actions-from-type-file)))) + +(defvar helm-source--ff-file-name-history nil + "[Internal] This source is build to be used with `helm-find-files'. +Don't use it in your own code unless you know what you are doing.") + +(defun helm-file-name-history-transformer (candidates _source) + (cl-loop for c in candidates collect + (cond ((file-remote-p c) + (cons (propertize c 'face 'helm-history-remote) c)) + ((file-exists-p c) + (cons (propertize c 'face 'helm-ff-file) c)) + (t (cons (propertize c 'face 'helm-history-deleted) c))))) + +(defun helm-ff-file-name-history () + "Switch to `file-name-history' without quitting `helm-find-files'." + (interactive) + (unless helm-source--ff-file-name-history + (setq helm-source--ff-file-name-history + (helm-build-sync-source "File name history" + :init (lambda () + (with-helm-alive-p + (when helm-ff-file-name-history-use-recentf + (require 'recentf) + (or recentf-mode (recentf-mode 1))))) + :candidates (lambda () + (if helm-ff-file-name-history-use-recentf + recentf-list + file-name-history)) + :fuzzy-match t + :persistent-action 'ignore + :filtered-candidate-transformer 'helm-file-name-history-transformer + :action (helm-make-actions + "Find file" (lambda (candidate) + (helm-set-pattern + (expand-file-name candidate)) + (with-helm-after-update-hook (helm-exit-minibuffer))) + "Find file in helm" (lambda (candidate) + (helm-set-pattern + (expand-file-name candidate))))))) + (with-helm-alive-p + (helm :sources 'helm-source--ff-file-name-history + :buffer "*helm-file-name-history*" + :allow-nest t + :resume 'noresume))) + +;;; Recentf files +;; +;; +(defvar helm-recentf--basename-flag nil) + +(defun helm-recentf-pattern-transformer (pattern) + (let ((pattern-no-flag (replace-regexp-in-string " -b" "" pattern))) + (cond ((and (string-match " " pattern-no-flag) + (string-match " -b\\'" pattern)) + (setq helm-recentf--basename-flag t) + pattern-no-flag) + ((string-match "\\([^ ]*\\) -b\\'" pattern) + (prog1 (match-string 1 pattern) + (setq helm-recentf--basename-flag t))) + (t (setq helm-recentf--basename-flag nil) + pattern)))) + +(defclass helm-recentf-source (helm-source-sync) + ((init :initform (lambda () + (require 'recentf) + (recentf-mode 1))) + (candidates :initform (lambda () recentf-list)) + (pattern-transformer :initform 'helm-recentf-pattern-transformer) + (match-part :initform (lambda (candidate) + (if (or helm-ff-transformer-show-only-basename + helm-recentf--basename-flag) + (helm-basename candidate) candidate))) + (filter-one-by-one :initform (lambda (c) + (if (and helm-ff-transformer-show-only-basename + (not (consp c))) + (cons (helm-basename c) c) + c))) + (keymap :initform helm-generic-files-map) + (help-message :initform helm-generic-file-help-message) + (mode-line :initform helm-generic-file-mode-line-string) + (action :initform (helm-actions-from-type-file)))) + +(defvar helm-source-recentf nil + "See (info \"(emacs)File Conveniences\"). +Set `recentf-max-saved-items' to a bigger value if default is too small.") + +(defcustom helm-recentf-fuzzy-match nil + "Enable fuzzy matching in `helm-source-recentf' when non--nil." + :group 'helm-files + :type 'boolean + :set (lambda (var val) + (set var val) + (setq helm-source-recentf + (helm-make-source "Recentf" 'helm-recentf-source + :fuzzy-match helm-recentf-fuzzy-match)))) + +;;; Browse project +;; Need dependencies: +;; +;; +;; Only hg and git are supported for now. +(defvar helm--browse-project-cache (make-hash-table :test 'equal)) + +(defun helm-browse-project-get-buffers (root-directory) + (cl-loop for b in (helm-buffer-list) + for bf = (buffer-file-name (get-buffer b)) + when (and bf (file-in-directory-p bf root-directory)) + collect b)) + +(defun helm-browse-project-build-buffers-source (directory) + (helm-make-source "Buffers in project" 'helm-source-buffers + :header-name (lambda (name) + (format + "%s (%s)" + name (abbreviate-file-name directory))) + :buffer-list (lambda () (helm-browse-project-get-buffers directory)))) + +(defun helm-browse-project-find-files (directory &optional refresh) + (when refresh (remhash directory helm--browse-project-cache)) + (unless (gethash directory helm--browse-project-cache) + (puthash directory (helm-walk-directory + directory + :directories nil :path 'full :skip-subdirs t) + helm--browse-project-cache)) + (helm :sources `(,(helm-browse-project-build-buffers-source directory) + ,(helm-build-in-buffer-source "Browse project" + :data (gethash directory helm--browse-project-cache) + :header-name (lambda (name) + (format + "%s (%s)" + name (abbreviate-file-name directory))) + :match-part (lambda (c) + (if helm-ff-transformer-show-only-basename + (helm-basename c) c)) + :filter-one-by-one + (lambda (c) + (if helm-ff-transformer-show-only-basename + (cons (propertize (helm-basename c) + 'face 'helm-ff-file) + c) + (propertize c 'face 'helm-ff-file))) + :mode-line helm-generic-file-mode-line-string + :keymap helm-generic-files-map + :action (helm-actions-from-type-file))) + :buffer "*helm browse project*")) + +;;;###autoload +(defun helm-browse-project (arg) + "Browse files and see status of project with its vcs. +Only HG and GIT are supported for now. +Fall back to `helm-find-files' or `helm-browse-project-find-files' +if current directory is not under control of one of those vcs. +With a prefix ARG browse files recursively, with two prefix ARG +rebuild the cache. +If the current directory is found in the cache, start +`helm-browse-project-find-files' even with no prefix ARG. +NOTE: The prefix ARG have no effect on the VCS controlled directories. + +Needed dependencies for VCS: + +and +." + (interactive "P") + (cond ((and (require 'helm-ls-git nil t) + (fboundp 'helm-ls-git-root-dir) + (helm-ls-git-root-dir)) + (helm-ls-git-ls)) + ((and (require 'helm-ls-hg nil t) + (fboundp 'helm-hg-root) + (helm-hg-root)) + (helm-hg-find-files-in-project)) + (t (let ((cur-dir (helm-current-directory))) + (if (or arg (gethash cur-dir helm--browse-project-cache)) + (helm-browse-project-find-files cur-dir (equal arg '(16))) + (helm :sources (helm-browse-project-build-buffers-source cur-dir) + :buffer "*helm browse project*")))))) + +(defun helm-ff-browse-project (_candidate) + "Browse project in current directory. +See `helm-browse-project'." + (with-helm-default-directory helm-ff-default-directory + (helm-browse-project helm-current-prefix-arg))) + +(defun helm-ff-run-browse-project () + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-ff-browse-project))) + +;;; session.el files +;; +;; session (http://emacs-session.sourceforge.net/) is an alternative to +;; recentf that saves recent file history and much more. +(defvar helm-source-session + `((name . "Session") + (candidates . (lambda () + (cl-delete-if-not #'(lambda (f) + (or (string-match helm-tramp-file-name-regexp f) + (file-exists-p f))) + (mapcar 'car session-file-alist)))) + (keymap . ,helm-generic-files-map) + (help-message . helm-generic-file-help-message) + (mode-line . helm-generic-file-mode-line-string) + (action . ,(helm-actions-from-type-file))) + "File list from emacs-session.") + + +;;; Files in current dir +;; +;; +(defun helm-highlight-files (files) + "A basic transformer for helm files sources. +Colorize only symlinks, directories and files." + (cl-loop for i in files + for disp = (if (and helm-ff-transformer-show-only-basename + (not (helm-dir-is-dot i)) + (not (and ffap-url-regexp + (string-match ffap-url-regexp i))) + (not (string-match helm-ff-url-regexp i))) + (helm-basename i) i) + for type = (car (file-attributes i)) + collect + (cond ((and helm-ff-tramp-not-fancy + (string-match helm-tramp-file-name-regexp i)) + (cons disp i)) + ((stringp type) + (cons (propertize disp + 'face 'helm-ff-symlink + 'help-echo (expand-file-name i)) + i)) + ((eq type t) + (cons (propertize disp + 'face 'helm-ff-directory + 'help-echo (expand-file-name i)) + i)) + (t (cons (propertize disp + 'face 'helm-ff-file + 'help-echo (expand-file-name i)) + i))))) + +(defclass helm-files-in-current-dir-source (helm-source-sync helm-type-file) + ((candidates :initform (lambda () + (with-helm-current-buffer + (let ((dir (helm-current-directory))) + (when (file-accessible-directory-p dir) + (directory-files dir t)))))) + (pattern-transformer :initform 'helm-recentf-pattern-transformer) + (match-part :initform (lambda (candidate) + (if (or helm-ff-transformer-show-only-basename + helm-recentf--basename-flag) + (helm-basename candidate) candidate))) + (fuzzy-match :initform t) + (keymap :initform helm-generic-files-map) + (help-message :initform helm-generic-file-help-message) + (mode-line :initform helm-generic-file-mode-line-string))) + +(defvar helm-source-files-in-current-dir + (helm-make-source "Files from Current Directory" + helm-files-in-current-dir-source)) + + +;;; External searching file tools. +;; +;; Tracker desktop search +(defvar helm-source-tracker-cand-incomplete nil "Contains incomplete candidate") +(defun helm-source-tracker-transformer (candidates _source) + (helm-log "received: %S" candidates) + (cl-loop for cand in candidates + for path = (when (stringp helm-source-tracker-cand-incomplete) + (caar (helm-highlight-files + (list helm-source-tracker-cand-incomplete)))) + for built = (if (not (stringp cand)) cand + (let ((snippet cand)) + (unless (or (null path) + (string= "" path) + (not (string-match-p + "\\`[[:space:]]*\\.\\.\\." + snippet))) + (let ((complete-candidate + (cons (concat path "\n" snippet) path))) + (setq helm-source-tracker-cand-incomplete nil) + (helm-log "built: %S" complete-candidate) + complete-candidate)))) + when (and (stringp cand) + (string-match "\\`[[:space:]]*file://" cand)) + do (setq helm-source-tracker-cand-incomplete ; save path + (replace-match "" t t cand)) end + collect built)) + +(defvar helm-source-tracker-search + `((name . "Tracker Search") + (candidates-process + . (lambda () + (start-process "tracker-search-process" nil + "tracker-search" + "--disable-color" + "--limit=512" + helm-pattern))) + (filtered-candidate-transformer . helm-source-tracker-transformer) + ;;(multiline) ; https://github.com/emacs-helm/helm/issues/529 + (keymap . ,helm-generic-files-map) + (action . ,(cdr (helm-get-attribute-from-type 'action 'file))) + (action-transformer + helm-transform-file-load-el + helm-transform-file-browse-url) + (requires-pattern . 3)) + "Source for retrieving files matching the current input pattern +with the tracker desktop search.") + +;; Spotlight (MacOS X desktop search) +(defvar helm-source-mac-spotlight + '((name . "mdfind") + (candidates-process + . (lambda () (start-process "mdfind-process" nil "mdfind" helm-pattern))) + (type . file) + (requires-pattern . 3)) + "Source for retrieving files via Spotlight's command line +utility mdfind.") + + +;;; Findutils +;; +;; +(defvar helm-source-findutils + (helm-build-async-source "Find" + :header-name (lambda (name) + (concat name " in [" (helm-default-directory) "]")) + :candidates-process 'helm-find-shell-command-fn + :filtered-candidate-transformer 'helm-findutils-transformer + :action-transformer 'helm-transform-file-load-el + :action (helm-actions-from-type-file) + :mode-line helm-generic-file-mode-line-string + :keymap helm-generic-files-map + :candidate-number-limit 9999 + :requires-pattern 3)) + +(defun helm-findutils-transformer (candidates _source) + (cl-loop for i in candidates + for type = (car (file-attributes i)) + for abs = (expand-file-name i (helm-default-directory)) + for disp = (if (and helm-ff-transformer-show-only-basename + (not (string-match "[.]\\{1,2\\}$" i))) + (helm-basename i) abs) + collect (cond ((eq t type) + (cons (propertize disp 'face 'helm-ff-directory) abs)) + ((stringp type) + (cons (propertize disp 'face 'helm-ff-symlink) abs)) + (t (cons (propertize disp 'face 'helm-ff-file) abs))))) + +(defun helm-find-shell-command-fn () + "Asynchronously fetch candidates for `helm-find'. +Additional find options can be sepcified after a \"*\" +separator." + (require 'find-cmd) + (with-helm-default-directory (helm-default-directory) + (let* (process-connection-type + (patterns+options (split-string helm-pattern "\\(\\`\\| +\\)\\* +")) + (fold-case (helm-set-case-fold-search (car patterns+options))) + (patterns (split-string (car patterns+options))) + (additional-options (and (cdr patterns+options) + (list (concat (cadr patterns+options) " ")))) + (ignored-dirs ()) + (ignored-files (when helm-findutils-skip-boring-files + (cl-loop for f in completion-ignored-extensions + if (string-match "/$" f) + do (push (replace-match "" nil t f) + ignored-dirs) + else collect (concat "*" f)))) + (path-or-name (if helm-findutils-search-full-path + '(ipath path) '(iname name))) + (name-or-iname (if fold-case + (car path-or-name) (cadr path-or-name))) + (cmd (find-cmd (and ignored-dirs + `(prune (name ,@ignored-dirs))) + (and ignored-files + `(not (name ,@ignored-files))) + `(and ,@(mapcar + (lambda (pattern) + `(,name-or-iname ,(concat "*" pattern "*"))) + patterns) + ,@additional-options))) + (proc (start-file-process-shell-command "hfind" helm-buffer cmd))) + (helm-log "Find command:\n%s" cmd) + (prog1 proc + (set-process-sentinel + proc + #'(lambda (process event) + (helm-process-deferred-sentinel-hook + process event (helm-default-directory)) + (if (string= event "finished\n") + (with-helm-window + (setq mode-line-format + '(" " mode-line-buffer-identification " " + (:eval (format "L%s" (helm-candidate-number-at-point))) " " + (:eval (propertize + (format "[Find process finished - (%s results)]" + (max (1- (count-lines + (point-min) (point-max))) + 0)) + 'face 'helm-locate-finish)))) + (force-mode-line-update)) + (helm-log "Error: Find %s" + (replace-regexp-in-string "\n" "" event))))))))) + +(defun helm-find-1 (dir) + (helm :sources 'helm-source-findutils + :buffer "*helm find*" + ;; Make these vars local for further resuming. + :default-directory dir ; reset it when called from elsewhere. + :ff-transformer-show-only-basename nil + :case-fold-search helm-file-name-case-fold-search)) + +;; helm-find-files integration. +(defun helm-ff-find-sh-command (_candidate) + "Run `helm-find' from `helm-find-files'." + (helm-find-1 helm-ff-default-directory)) + +(defun helm-ff-run-find-sh-command () + "Run find shell command action with key from `helm-find-files'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-ff-find-sh-command))) + + +;;; Preconfigured commands +;; +;; +;;;###autoload +(defun helm-find (arg) + "Preconfigured `helm' for the find shell command." + (interactive "P") + (let ((directory + (if arg + (file-name-as-directory + (read-directory-name "DefaultDirectory: ")) + default-directory))) + (helm-find-1 directory))) + +(defvar org-directory) +;;;###autoload +(defun helm-find-files (arg) + "Preconfigured `helm' for helm implementation of `find-file'. +Called with a prefix arg show history if some. +Don't call it from programs, use `helm-find-files-1' instead. +This is the starting point for nearly all actions you can do on files." + (interactive "P") + (let* ((hist (and arg helm-ff-history (helm-find-files-history))) + (default-input (or hist (helm-find-files-initial-input))) + (input (cond ((and (eq major-mode 'org-agenda-mode) + org-directory + (not default-input)) + (expand-file-name org-directory)) + ((and (eq major-mode 'dired-mode) default-input) + (file-name-directory default-input)) + ((and (not (string= default-input "")) + default-input)) + (t (expand-file-name (helm-current-directory))))) + (presel (helm-aif (or hist + (buffer-file-name (current-buffer)) + (and (eq major-mode 'dired-mode) + default-input)) + (if helm-ff-transformer-show-only-basename + (helm-basename it) it)))) + (set-text-properties 0 (length input) nil input) + (helm-find-files-1 input (and presel (concat "^" (regexp-quote presel)))))) + +;;;###autoload +(defun helm-for-files () + "Preconfigured `helm' for opening files. +Run all sources defined in `helm-for-files-preferred-list'." + (interactive) + (unless helm-source-buffers-list + (setq helm-source-buffers-list + (helm-make-source "Buffers" 'helm-source-buffers))) + (let ((helm-ff-transformer-show-only-basename nil)) + (helm :sources helm-for-files-preferred-list :buffer "*helm for files*"))) + +;;;###autoload +(defun helm-multi-files () + "Same as `helm-for-files' but allow toggling from locate to others sources." + (interactive) + (unless helm-source-buffers-list + (setq helm-source-buffers-list + (helm-make-source "Buffers" 'helm-source-buffers))) + (setq helm-multi-files--toggle-locate nil) + (let ((sources (remove 'helm-source-locate helm-for-files-preferred-list)) + (helm-ff-transformer-show-only-basename nil) + (old-key (lookup-key + helm-map + (read-kbd-macro helm-multi-files-toggle-locate-binding)))) + (with-helm-temp-hook 'helm-after-initialize-hook + (define-key helm-map (kbd helm-multi-files-toggle-locate-binding) + 'helm-multi-files-toggle-to-locate)) + (unwind-protect + (helm :sources sources + :buffer "*helm multi files*") + (define-key helm-map (kbd helm-multi-files-toggle-locate-binding) + old-key)))) + +;;;###autoload +(defun helm-recentf () + "Preconfigured `helm' for `recentf'." + (interactive) + (let ((helm-ff-transformer-show-only-basename nil)) + (helm-other-buffer 'helm-source-recentf "*helm recentf*"))) + +(provide 'helm-files) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-files.el ends here diff --git a/elpa/helm-20150426.2119/helm-font.el b/elpa/helm-20150426.2119/helm-font.el new file mode 100644 index 00000000..e7a7d240 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-font.el @@ -0,0 +1,187 @@ +;;; helm-font --- Font and ucs selection for Helm -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) + +(defvar helm-ucs-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "") 'helm-ucs-persistent-delete) + (define-key map (kbd "") 'helm-ucs-persistent-backward) + (define-key map (kbd "") 'helm-ucs-persistent-forward) + (define-key map (kbd "") 'helm-ucs-persistent-insert) + (define-key map (kbd "C-c ?") 'helm-ucs-help) + map) + "Keymap for `helm-ucs'.") + + +;;; Xfont selection +;; +;; +(defun helm-persistent-xfont-action (elm) + "Show current font temporarily" + (let ((current-font (cdr (assoc 'font (frame-parameters)))) + (default-font elm)) + (unwind-protect + (progn (set-frame-font default-font 'keep-size) (sit-for 2)) + (set-frame-font current-font)))) + +(defvar helm-xfonts-cache nil) +(defvar helm-source-xfonts + '((name . "X Fonts") + (init . (lambda () + (unless helm-xfonts-cache + (setq helm-xfonts-cache + (x-list-fonts "*"))))) + (candidates . helm-xfonts-cache) + (action . (("Copy to kill ring" . (lambda (elm) + (kill-new elm))) + ("Set Font" . (lambda (elm) + (kill-new elm) + (set-frame-font elm 'keep-size) + (message "New font have been copied to kill ring"))))) + (persistent-action . helm-persistent-xfont-action) + (persistent-help . "Switch to this font temporarily"))) + +;;; 𝕌𝕔𝕤 𝕊𝕪𝕞𝕓𝕠𝕝 𝕔𝕠𝕞𝕡𝕝𝕖𝕥𝕚𝕠𝕟 +;; +;; +(defvar helm-ucs-max-len 0) +(defun helm-calculate-ucs-max-len () + "Calculate the length of longest `ucs-names' candidate." + (cl-loop with count = 0 + for (n . v) in (ucs-names) + for len = (length n) + if (> len count) + do (setq count len) + finally return count)) + +(defun helm-ucs-init () + "Initialize an helm buffer with ucs symbols. +Only math* symbols are collected." + (unless (> helm-ucs-max-len 0) + (setq helm-ucs-max-len + (helm-calculate-ucs-max-len))) + (with-current-buffer (helm-candidate-buffer + (get-buffer-create "*helm ucs*")) + ;; `ucs-names' fn will not run again, data is cached in + ;; var `ucs-names'. + (cl-loop for (n . v) in (ucs-names) + for len = (length n) + for diff = (+ (- helm-ucs-max-len len) 2) + unless (string= "" n) + do (progn (insert (concat + n ":" + (make-string + diff ? ))) + (if (fboundp 'ucs-insert) + (ucs-insert v) + ;; call `insert-char' with nil nil + ;; to shutup byte compiler in 24.1. + (insert-char v nil nil)) + (insert (format " #x%x" v)) + (insert "\n"))))) + +(defun helm-ucs-forward-char (_candidate) + (with-helm-current-buffer + (forward-char 1))) + +(defun helm-ucs-backward-char (_candidate) + (with-helm-current-buffer + (forward-char -1))) + +(defun helm-ucs-delete-backward (_candidate) + (with-helm-current-buffer + (delete-char -1))) + +(defun helm-ucs-insert (candidate n) + (with-helm-current-buffer + (string-match "^\\([^:]+\\): +\\(.\\) #x\\([a-f0-9]+\\)$" candidate) + (insert (match-string n candidate)))) + +(defun helm-ucs-insert-name (candidate) + (helm-ucs-insert candidate 1)) + +(defun helm-ucs-insert-char (candidate) + (helm-ucs-insert candidate 2)) + +(defun helm-ucs-insert-code (candidate) + (helm-ucs-insert candidate 3)) + +(defun helm-ucs-persistent-insert () + (interactive) + (with-helm-alive-p + (helm-attrset 'action-insert 'helm-ucs-insert-char) + (helm-execute-persistent-action 'action-insert))) + +(defun helm-ucs-persistent-forward () + (interactive) + (with-helm-alive-p + (helm-attrset 'action-forward 'helm-ucs-forward-char) + (helm-execute-persistent-action 'action-forward))) + +(defun helm-ucs-persistent-backward () + (interactive) + (with-helm-alive-p + (helm-attrset 'action-back 'helm-ucs-backward-char) + (helm-execute-persistent-action 'action-back))) + +(defun helm-ucs-persistent-delete () + (interactive) + (with-helm-alive-p + (helm-attrset 'action-delete 'helm-ucs-delete-backward) + (helm-execute-persistent-action 'action-delete))) + +(defvar helm-source-ucs + '((name . "Ucs names") + (init . helm-ucs-init) + (candidate-number-limit . 9999) + (candidates-in-buffer) + (mode-line . helm-ucs-mode-line-string) + (action . (("Insert character" . helm-ucs-insert-char) + ("Insert character name" . helm-ucs-insert-name) + ("Insert character code in hex" . helm-ucs-insert-code) + ("Forward char" . helm-ucs-forward-char) + ("Backward char" . helm-ucs-backward-char) + ("Delete char backward" . helm-ucs-delete-backward)))) + "Source for collecting `ucs-names' math symbols.") + +;;;###autoload +(defun helm-select-xfont () + "Preconfigured `helm' to select Xfont." + (interactive) + (helm-other-buffer 'helm-source-xfonts "*helm select* xfont")) + +;;;###autoload +(defun helm-ucs () + "Preconfigured helm for `ucs-names' math symbols." + (interactive) + (helm :sources 'helm-source-ucs + :keymap helm-ucs-map)) + +(provide 'helm-font) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-font.el ends here diff --git a/elpa/helm-20150426.2119/helm-grep.el b/elpa/helm-20150426.2119/helm-grep.el new file mode 100644 index 00000000..0bf22647 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-grep.el @@ -0,0 +1,1229 @@ +;;; helm-grep.el --- Helm Incremental Grep. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: +(require 'cl-lib) +(require 'helm) +(require 'grep) +(require 'helm-regexp) + +;;; load wgrep proxy if it's available +(require 'wgrep-helm nil t) + +(declare-function helm-buffer-list "helm-buffers") +(declare-function helm-elscreen-find-file "helm-elscreen" (file)) +(declare-function View-quit "view") +(declare-function doc-view-goto-page "doc-view" (page)) + + +(defgroup helm-grep nil + "Grep related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-grep-default-command + "grep --color=never -a -d skip %e -n%cH -e %p %f" + "Default grep format command for `helm-do-grep-1'. +Where: +'%e' format spec is for --exclude or --include grep options or + ack-grep --type option. (Not mandatory) + +'%c' format spec is for case-fold-search, + whether to use the -i option of grep. (Not mandatory) + When you specify this spec, helm grep will use smartcase + that is when a upcase character is found in pattern case will + be respected and no '-i' option will be used, otherwise, when + no upcase character is found in pattern always use '-i'. + If you don't want this behavior, don't use this spec and + specify or not the '-i' option. + Note that with ack-grep this is not needed, just specify + the '--smart-case' option. + +'%p' format spec is for pattern. (Mandatory) + +'%f' format spec is for filenames. (Mandatory) + +If your grep version doesn't support the --exclude/include args +don't specify the '%e' format spec. + +Helm also support ack-grep and git-grep , +here a default command example for ack-grep: + +\(setq helm-grep-default-command \"ack-grep -Hn --no-group --no-color %e %p %f\" + helm-grep-default-recurse-command \"ack-grep -H --no-group --no-color %e %p %f\") + +You can ommit the %e spec if you don't want to be prompted for types. + +NOTE: Helm for ack-grep support ANSI sequences, so you can remove +the \"--no-color\" option safely (recommended). + +To enable ANSI in grep it is a little more difficult: + 1) Modify env var + \(setenv \"GREP_COLORS\" \"ms=01;31:mc=01;31:sl=01;37:cx=:fn=35:ln=32:bn=32:se=36\") + 2) Add the option \"--color=always\". + +To enable ANSI color in git-grep just add \"--color=always\". +To customize the ANSI color in git-grep, GREP_COLORS have no effect, +you will have to setup this in your .gitconfig: + + [color \"grep\"] + match = black yellow + +where \"black\" is the foreground and \"yellow\" the background. +See the git documentation for more infos. + +`helm-grep-default-command' and `helm-grep-default-recurse-command'are +independents, so you can enable `helm-grep-default-command' with ack-grep +and `helm-grep-default-recurse-command' with grep if you want to be faster +on recursive grep. + +NOTE: Remote grepping is not available with ack-grep, + and badly supported with grep because tramp handle badly + repeated remote processes in a short delay (< to 5s)." + :group 'helm-grep + :type 'string) + +(defcustom helm-grep-default-recurse-command + "grep --color=never -a -d recurse %e -n%cH -e %p %f" + "Default recursive grep format command for `helm-do-grep-1'. +See `helm-grep-default-command' for format specs and infos about ack-grep." + :group 'helm-grep + :type 'string) + +(defcustom helm-default-zgrep-command + "zgrep -a -n%cH -e %p %f" + "Default command for Zgrep. +See `helm-grep-default-command' for infos on format specs. +Option --color=always is supported and can be used safely +to replace the helm internal match highlighting, +see `helm-grep-default-command' for more infos." + :group 'helm-grep + :type 'string) + +(defcustom helm-pdfgrep-default-command + "pdfgrep --color never -niH %s %s" + "Default command for pdfgrep. +Option --color always is not supported, expect +errors when executing actions." + :group 'helm-grep + :type 'string) + +(defcustom helm-grep-use-ioccur-style-keys t + "Use Arrow keys to jump to occurences." + :group 'helm-grep + :type 'boolean) + +(defcustom helm-pdfgrep-default-read-command nil + "Default command to read pdf files from pdfgrep. +Where '%f' format spec is filename and '%p' is page number. +e.g In Ubuntu you can set it to: + + \"evince --page-label=%p '%f'\" + +If set to nil `doc-view-mode' will be used instead of an external command." + :group 'helm-grep + :type 'string) + +(defcustom helm-grep-max-length-history 100 + "Max number of elements to save in `helm-grep-history'." + :group 'helm-grep + :type 'integer) + +(defcustom helm-zgrep-file-extension-regexp + ".*\\(\\.gz\\|\\.bz\\|\\.xz\\|\\.lzma\\)$" + "Default file extensions zgrep will search in." + :group 'helm-grep + :type 'string) + +(defcustom helm-do-grep-preselect-candidate nil + "When non--nil the file name of current buffer will be selected." + :group 'helm-grep + :type 'boolean) + +(defcustom helm-grep-preferred-ext nil + "This file extension will be preselected for grep." + :group 'helm-grep + :type 'string) + + +;;; Faces +;; +;; +(defgroup helm-grep-faces nil + "Customize the appearance of helm-grep." + :prefix "helm-" + :group 'helm-grep + :group 'helm-faces) + +(defface helm-grep-match + '((((background light)) :foreground "#b00000") + (((background dark)) :foreground "gold1")) + "Face used to highlight grep matches." + :group 'helm-grep-faces) + +(defface helm-grep-file + '((t (:foreground "BlueViolet" + :underline t))) + "Face used to highlight grep results filenames." + :group 'helm-grep-faces) + +(defface helm-grep-lineno + '((t (:foreground "Darkorange1"))) + "Face used to highlight grep number lines." + :group 'helm-grep-faces) + +(defface helm-grep-running + '((t (:foreground "Red"))) + "Face used in mode line when grep is running." + :group 'helm-grep-faces) + +(defface helm-grep-finish + '((t (:foreground "Green"))) + "Face used in mode line when grep is finish." + :group 'helm-grep-faces) + +(defface helm-grep-cmd-line + '((t (:inherit diff-added))) + "Face used to highlight grep command line when no results." + :group 'helm-grep-faces) + + +;;; Keymaps +;; +;; +(defvar helm-grep-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-") 'helm-goto-next-file) + (define-key map (kbd "M-") 'helm-goto-precedent-file) + (define-key map (kbd "C-c o") 'helm-grep-run-other-window-action) + (define-key map (kbd "C-c C-o") 'helm-grep-run-other-frame-action) + (define-key map (kbd "C-w") 'helm-yank-text-at-point) + (define-key map (kbd "C-x C-s") 'helm-grep-run-save-buffer) + (when helm-grep-use-ioccur-style-keys + (define-key map (kbd "") 'helm-execute-persistent-action) + (define-key map (kbd "") 'helm-grep-run-default-action)) + (define-key map (kbd "C-c ?") 'helm-grep-help) + (delq nil map)) + "Keymap used in Grep sources.") + +(defvar helm-pdfgrep-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-") 'helm-goto-next-file) + (define-key map (kbd "M-") 'helm-goto-precedent-file) + (define-key map (kbd "C-w") 'helm-yank-text-at-point) + (define-key map (kbd "C-c ?") 'helm-pdfgrep-help) + map) + "Keymap used in pdfgrep.") + +(defvar helm-grep-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'helm-grep-mode-jump) + (define-key map (kbd "C-o") 'helm-grep-mode-jump-other-window) + (define-key map (kbd "") 'helm-grep-mode-jump-other-window-forward) + (define-key map (kbd "") 'helm-grep-mode-jump-other-window-backward) + (define-key map (kbd "") 'helm-gm-next-file) + (define-key map (kbd "") 'helm-gm-precedent-file) + (define-key map (kbd "M-n") 'helm-grep-mode-jump-other-window-forward) + (define-key map (kbd "M-p") 'helm-grep-mode-jump-other-window-backward) + (define-key map (kbd "M-N") 'helm-gm-next-file) + (define-key map (kbd "M-P") 'helm-gm-precedent-file) + map)) + + +;;; Internals vars +;; +;; +(defvar helm-rzgrep-cache (make-hash-table :test 'equal)) +(defvar helm-grep-default-function 'helm-grep-init) +(defvar helm-zgrep-recurse-flag nil) +(defvar helm-grep-history nil) +(defvar helm-grep-last-targets nil) +(defvar helm-grep-include-files nil) +(defvar helm-grep-in-recurse nil) +(defvar helm-grep-use-zgrep nil) +(defvar helm-grep-default-directory-fn nil + "A function that should return a directory to expand candidate to. +It is intended to use as a let-bound variable, DON'T set this globaly.") +(defvar helm-pdfgrep-targets nil) +(defvar helm-grep-last-cmd-line nil) +(defvar helm-grep-split-line-regexp "^\\([[:lower:][:upper:]]?:?.*?\\):\\([0-9]+\\):\\(.*\\)") + + +;;; Init +;; +;; +(defun helm-grep-prepare-candidates (candidates in-directory) + "Prepare filenames and directories CANDIDATES for grep command line." + ;; If one or more candidate is a directory, search in all files + ;; of this candidate (e.g /home/user/directory/*). + ;; If r option is enabled search also in subdidrectories. + ;; We need here to expand wildcards to support crap windows filenames + ;; as grep doesn't accept quoted wildcards (e.g "dir/*.el"). + (if helm-zgrep-recurse-flag + (mapconcat 'shell-quote-argument candidates " ") + ;; When candidate is a directory, search in all its files. + ;; NOTE that `file-expand-wildcards' will return also + ;; directories, they will be ignored by grep but not + ;; by ack-grep that will grep all files of this directory + ;; without recursing in their subdirs though, see that as a one + ;; level recursion with ack-grep. + ;; So I leave it as it is, considering it is a feature. [1] + (cl-loop for i in candidates append + (cond ((string-match "^git" helm-grep-default-command) + (list i)) + ;; Candidate is a directory and we use recursion or ack. + ((and (file-directory-p i) + (or helm-grep-in-recurse + ;; ack-grep accept directory [1]. + (helm-grep-use-ack-p))) + (list (expand-file-name i))) + ;; Grep doesn't support directory only when not in recurse. + ((file-directory-p i) + (file-expand-wildcards + (concat (file-name-as-directory (expand-file-name i)) "*") t)) + ;; Candidate is a file or wildcard and we use recursion, use the + ;; current directory instead of candidate. + ((and (or (file-exists-p i) (string-match "[*]" i)) + helm-grep-in-recurse) + (list (expand-file-name + (directory-file-name ; Needed for windoze. + (file-name-directory (directory-file-name i)))))) + ;; Else should be one or more file/directory + ;; possibly marked. + ;; When real is a normal filename without wildcard + ;; file-expand-wildcards returns a list of one file. + ;; wildcards should have been already handled by + ;; helm-read-file-name or helm-find-files but do it from + ;; here too in case we are called from elsewhere. + (t (file-expand-wildcards i t))) into all-files ; [1] + finally return + (let ((files (if (file-remote-p in-directory) + ;; Grep don't understand tramp filenames + ;; use the local name. + (mapcar #'(lambda (x) + (file-remote-p x 'localname)) + all-files) + all-files))) + (if (string-match "^git" helm-grep-default-command) + (mapconcat 'identity files " ") + (mapconcat 'shell-quote-argument files " ")))))) + +(defun helm-grep-command (&optional recursive) + (let* ((com (if recursive + helm-grep-default-recurse-command + helm-grep-default-command)) + (exe (and com (car (split-string com " "))))) + (if (and exe (string= exe "git")) "git-grep" exe))) + +(cl-defun helm-grep-use-ack-p (&key where) + (let* ((rec-com (helm-grep-command t)) + (norm-com (helm-grep-command)) + (norm-com-ack-p (string-match "\\`ack" norm-com)) + (rec-com-ack-p (and rec-com (string-match "\\`ack" rec-com)))) + (cl-case where + (default (and norm-com norm-com-ack-p)) + (recursive (and rec-com rec-com-ack-p)) + (strict (and norm-com rec-com rec-com-ack-p norm-com-ack-p)) + (t (and (not (and norm-com (string= norm-com "git-grep"))) + (or (and norm-com norm-com-ack-p) + (and rec-com rec-com-ack-p))))))) + +(defun helm-grep--prepare-cmd-line (only-files &optional include zgrep) + (let* ((default-directory (or (helm-default-directory) + (expand-file-name helm-ff-default-directory))) + (fnargs (helm-grep-prepare-candidates + only-files default-directory)) + (ignored-files (unless (helm-grep-use-ack-p) + (mapconcat + #'(lambda (x) + (concat "--exclude=" + (shell-quote-argument x))) + grep-find-ignored-files " "))) + (ignored-dirs (unless (helm-grep-use-ack-p) + (mapconcat + ;; Need grep version >=2.5.4 + ;; of Gnuwin32 on windoze. + #'(lambda (x) + (concat "--exclude-dir=" + (shell-quote-argument x))) + grep-find-ignored-directories " "))) + (exclude (unless (helm-grep-use-ack-p) + (if helm-grep-in-recurse + (concat (or include ignored-files) + " " ignored-dirs) + ignored-files))) + (types (and (helm-grep-use-ack-p) + ;; When %e format spec is not specified + ;; in `helm-grep-default-command' + ;; we need to pass an empty string + ;; to types to avoid error. + (or include ""))) + (smartcase (if (helm-grep-use-ack-p) "" + (unless (let ((case-fold-search nil)) + (string-match-p + "[[:upper:]]" helm-pattern)) "i")))) + (format-spec + helm-grep-default-command + (delq nil + (list (unless zgrep + (if types + (cons ?e types) + (cons ?e exclude))) + (cons ?c (or smartcase "")) + (cons ?p (shell-quote-argument helm-pattern)) + (cons ?f fnargs)))))) + +(defun helm-grep-init (cmd-line) + "Start an asynchronous grep process with CMD-LINE using ZGREP if non--nil." + (let* ((default-directory (or (expand-file-name helm-ff-default-directory) + (helm-default-directory))) + (zgrep (string-match "\\`zgrep" cmd-line)) + ;; Use pipe only with grep, zgrep or git-grep. + (process-connection-type (and (not zgrep) (helm-grep-use-ack-p))) + (tramp-verbose helm-tramp-verbose) + non-essential) + ;; Start grep process. + (helm-log "Starting Grep process in directory `%s'" default-directory) + (helm-log "Command line used was:\n\n%s" + (concat ">>> " (propertize cmd-line 'face 'helm-grep-cmd-line) "\n\n")) + (prog1 ; This function should return the process first. + (start-file-process-shell-command + "grep" helm-buffer cmd-line) + ;; Init sentinel. + (set-process-sentinel + (get-buffer-process helm-buffer) + #'(lambda (process event) + (let ((noresult (= (process-exit-status process) 1))) + (unless noresult + (helm-process-deferred-sentinel-hook + process event helm-ff-default-directory)) + (cond ((and noresult + ;; [FIXME] This is a workaround for zgrep + ;; that exit with code 1 + ;; after a certain amount of results. + (not (with-helm-buffer helm-grep-use-zgrep))) + (with-current-buffer helm-buffer + (insert (concat "* Exit with code 1, no result found," + " Command line was:\n\n " + (propertize helm-grep-last-cmd-line + 'face 'helm-grep-cmd-line))) + (setq mode-line-format + '(" " mode-line-buffer-identification " " + (:eval (format "L%s" (helm-candidate-number-at-point))) " " + (:eval (propertize + (format + "[%s process finished - (no results)] " + (if helm-grep-use-zgrep + "Zgrep" + (capitalize + (if helm-grep-in-recurse + (helm-grep-command t) + (helm-grep-command))))) + 'face 'helm-grep-finish)))))) + ((string= event "finished\n") + (with-helm-window + (setq mode-line-format + '(" " mode-line-buffer-identification " " + (:eval (format "L%s" (helm-candidate-number-at-point))) " " + (:eval (propertize + (format + "[%s process finished - (%s results)] " + (if helm-grep-use-zgrep + "Zgrep" + (capitalize + (if helm-grep-in-recurse + (helm-grep-command t) + (helm-grep-command)))) + (max (1- (count-lines + (point-min) + (point-max))) + 0)) + 'face 'helm-grep-finish)))) + (force-mode-line-update))) + ;; Catch error output in log. + (t (helm-log + "Error: %s %s" + (if helm-grep-use-zgrep "Zgrep" "Grep") + (replace-regexp-in-string "\n" "" event)))))))))) + +(defun helm-grep-collect-candidates () + (let ((cmd-line (helm-grep--prepare-cmd-line + helm-grep-last-targets + helm-grep-include-files + helm-grep-use-zgrep))) + (set (make-local-variable 'helm-grep-last-cmd-line) cmd-line) + (funcall helm-grep-default-function cmd-line))) + + +;;; Actions +;; +;; +(defun helm-grep-action (candidate &optional where mark) + "Define a default action for `helm-do-grep' on CANDIDATE. +WHERE can be one of other-window, elscreen, other-frame." + (let* ((split (helm-grep-split-line candidate)) + (lineno (string-to-number (nth 1 split))) + (loc-fname (or (with-current-buffer + (if (eq major-mode 'helm-grep-mode) + (current-buffer) + helm-buffer) + (get-text-property (point-at-bol) 'help-echo)) + (car split))) + (tramp-method (file-remote-p (or helm-ff-default-directory + default-directory) 'method)) + (tramp-host (file-remote-p (or helm-ff-default-directory + default-directory) 'host)) + (tramp-prefix (concat "/" tramp-method ":" tramp-host ":")) + (fname (if tramp-host + (concat tramp-prefix loc-fname) loc-fname))) + (cl-case where + (other-window (find-file-other-window fname)) + (elscreen (helm-elscreen-find-file fname)) + (other-frame (find-file-other-frame fname)) + (grep (helm-grep-save-results-1)) + (pdf (if helm-pdfgrep-default-read-command + (helm-pdfgrep-action-1 split lineno (car split)) + (find-file (car split)) (doc-view-goto-page lineno))) + (t (find-file fname))) + (unless (or (eq where 'grep) (eq where 'pdf)) + (helm-goto-line lineno)) + (when mark + (set-marker (mark-marker) (point)) + (push-mark (point) 'nomsg)) + ;; Save history + (unless (or helm-in-persistent-action + (eq major-mode 'helm-grep-mode) + (string= helm-pattern "")) + (setq helm-grep-history + (cons helm-pattern + (delete helm-pattern helm-grep-history))) + (when (> (length helm-grep-history) + helm-grep-max-length-history) + (setq helm-grep-history + (delete (car (last helm-grep-history)) + helm-grep-history)))))) + +(defun helm-grep-persistent-action (candidate) + "Persistent action for `helm-do-grep'. +With a prefix arg record CANDIDATE in `mark-ring'." + (if current-prefix-arg + (helm-grep-action candidate nil 'mark) + (helm-grep-action candidate)) + (helm-highlight-current-line)) + +(defun helm-grep-other-window (candidate) + "Jump to result in other window from helm grep." + (helm-grep-action candidate 'other-window)) + +(defun helm-grep-other-frame (candidate) + "Jump to result in other frame from helm grep." + (helm-grep-action candidate 'other-frame)) + +(defun helm-grep-jump-elscreen (candidate) + "Jump to result in elscreen from helm grep." + (helm-grep-action candidate 'elscreen)) + +(defun helm-goto-next-or-prec-file (n &optional type) + "Go to next or precedent candidate file in helm grep/etags buffers. +If N is positive go forward otherwise go backward." + (let* ((allow-mode (or (eq major-mode 'helm-grep-mode) + (eq major-mode 'helm-moccur-mode))) + (sel (if allow-mode + (buffer-substring (point-at-bol) (point-at-eol)) + (helm-get-selection nil t))) + (current-line-list (if (eq type 'etags) + (split-string sel ": +" t) + (helm-grep-split-line sel))) + (current-fname (nth 0 current-line-list)) + (bob-or-eof (if (eq n 1) 'eobp 'bobp)) + (mark-maybe #'(lambda () + (if allow-mode + (ignore) + (helm-mark-current-line))))) + (catch 'break + (while (not (funcall bob-or-eof)) + (forward-line n) ; Go forward or backward depending of n value. + ;; Exit when current-fname is not matched or in `helm-grep-mode' + ;; the line is not a grep line i.e 'fname:num:tag'. + (setq sel (buffer-substring (point-at-bol) (point-at-eol))) + (unless (or (string= current-fname + (car (if (eq type 'etags) + (split-string sel ": +" t) + (helm-grep-split-line sel)))) + (and (eq major-mode 'helm-grep-mode) + (not (get-text-property (point-at-bol) 'help-echo)))) + (funcall mark-maybe) + (throw 'break nil)))) + (cond ((and (> n 0) (eobp)) + (re-search-backward ".") + (forward-line 0) + (funcall mark-maybe)) + ((and (< n 0) (bobp)) + (helm-aif (next-single-property-change (point-at-bol) 'help-echo) + (goto-char it) + (forward-line 1)) + (funcall mark-maybe))))) + +;;;###autoload +(defun helm-goto-precedent-file () + "Go to precedent file in helm grep/etags buffers." + (interactive) + (let ((etagp (when (string= (assoc-default + 'name (helm-get-current-source)) "Etags") + 'etags))) + (with-helm-window + (helm-goto-next-or-prec-file -1 etagp)))) + +;;;###autoload +(defun helm-goto-next-file () + "Go to precedent file in helm grep/etags buffers." + (interactive) + (let ((etagp (when (string= (assoc-default + 'name (helm-get-current-source)) "Etags") + 'etags))) + (with-helm-window + (helm-goto-next-or-prec-file 1 etagp)))) + +(defun helm-grep-run-default-action () + "Run grep default action from `helm-do-grep-1'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-grep-action))) + +(defun helm-grep-run-other-window-action () + "Run grep goto other window action from `helm-do-grep-1'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-grep-other-window))) + +(defun helm-grep-run-other-frame-action () + "Run grep goto other frame action from `helm-do-grep-1'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-grep-other-frame))) + +;;;###autoload +(defun helm-grep-run-save-buffer () + "Run grep save results action from `helm-do-grep-1'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-grep-save-results))) + + +;;; helm-grep-mode +;; +;; +(defun helm-grep-save-results (candidate) + (helm-grep-action candidate 'grep)) + +(defun helm-grep-save-results-1 () + "Save helm grep result in a `helm-grep-mode' buffer." + (let ((buf "*hgrep*") + new-buf) + (when (get-buffer buf) + (setq new-buf (helm-read-string "GrepBufferName: " buf)) + (cl-loop for b in (helm-buffer-list) + when (and (string= new-buf b) + (not (y-or-n-p + (format "Buffer `%s' already exists overwrite? " + new-buf)))) + do (setq new-buf (helm-read-string "GrepBufferName: " "*hgrep "))) + (setq buf new-buf)) + (with-current-buffer (get-buffer-create buf) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert "-*- mode: helm-grep -*-\n\n" + (format "Grep Results for `%s':\n\n" helm-pattern)) + (save-excursion + (insert (with-current-buffer helm-buffer + (goto-char (point-min)) (forward-line 1) + (buffer-substring (point) (point-max)))))) + (helm-grep-mode) (pop-to-buffer buf)) + (message "Helm Grep Results saved in `%s' buffer" buf))) + +;;;###autoload +(define-derived-mode helm-grep-mode + special-mode "helm-grep" + "Major mode to provide actions in helm grep saved buffer. + +Special commands: +\\{helm-grep-mode-map}" + (set (make-local-variable 'helm-grep-last-cmd-line) + (with-helm-buffer helm-grep-last-cmd-line)) + (set (make-local-variable 'revert-buffer-function) + #'helm-grep-mode--revert-buffer-function)) + +(defun helm-grep-mode--revert-buffer-function (&optional _ignore-auto _noconfirm) + (goto-char (point-min)) + (re-search-forward "^Grep Results for" nil t) + (forward-line 0) + (when (re-search-forward "^$" nil t) + (forward-line 1)) + (let ((inhibit-read-only t)) + (delete-region (point) (point-max))) + (message "Reverting buffer...") + (set-process-sentinel + (start-file-process-shell-command + "hgrep" (generate-new-buffer "*hgrep revert*") helm-grep-last-cmd-line) + (lambda (process event) + (when (string= event "finished\n") + (with-current-buffer (current-buffer) + (let ((inhibit-read-only t)) + (save-excursion + (cl-loop for line in (with-current-buffer (process-buffer process) + (prog1 (split-string (buffer-string) "\n") + (kill-buffer))) + when (string-match helm-grep-split-line-regexp line) + do (insert (propertize + (car (helm-grep-filter-one-by-one line)) + ;; needed for wgrep. + 'helm-realvalue line) + "\n")))) + (message "Reverting buffer done")))))) + +;;;###autoload +(defun helm-gm-next-file () + (interactive) + (helm-goto-next-or-prec-file 1)) + +;;;###autoload +(defun helm-gm-precedent-file () + (interactive) + (helm-goto-next-or-prec-file -1)) + +;;;###autoload +(defun helm-grep-mode-jump () + (interactive) + (helm-grep-action + (buffer-substring (point-at-bol) (point-at-eol)))) + +(defun helm-grep-mode-jump-other-window-1 (arg) + (let ((candidate (buffer-substring (point-at-bol) (point-at-eol)))) + (condition-case nil + (progn + (save-selected-window + (helm-grep-action candidate 'other-window) + (recenter)) + (forward-line arg)) + (error nil)))) + +;;;###autoload +(defun helm-grep-mode-jump-other-window-forward () + (interactive) + (helm-grep-mode-jump-other-window-1 1)) + +;;;###autoload +(defun helm-grep-mode-jump-other-window-backward () + (interactive) + (helm-grep-mode-jump-other-window-1 -1)) + +;;;###autoload +(defun helm-grep-mode-jump-other-window () + (interactive) + (let ((candidate (buffer-substring (point-at-bol) (point-at-eol)))) + (condition-case nil + (helm-grep-action candidate 'other-window) + (error nil)))) + + +;;; ack-grep types +;; +;; +(defun helm-grep-hack-types () + "Return a list of known ack-grep types." + (with-temp-buffer + ;; "--help-types" works with both 1.96 and 2.1+, while + ;; "--help types" works only with 1.96 Issue #422. + ;; `helm-grep-command' should return the ack executable + ;; when this function is used in the right context + ;; i.e After checking is we are using ack-grep with + ;; `helm-grep-use-ack-p'. + (call-process (helm-grep-command t) nil t nil "--help-types") + (goto-char (point-min)) + (cl-loop while (re-search-forward + "^ *--\\(\\[no\\]\\)\\([^. ]+\\) *\\(.*\\)" nil t) + collect (cons (concat (match-string 2) + " [" (match-string 3) "]") + (match-string 2)) + collect (cons (concat "no" (match-string 2) + " [" (match-string 3) "]") + (concat "no" (match-string 2)))))) + +(defun helm-grep-ack-types-transformer (candidates _source) + (cl-loop for i in candidates + if (stringp i) + collect (rassoc i helm-grep-ack-types-cache) + else + collect i)) + +(defvar helm-grep-ack-types-cache nil) +(defun helm-grep-read-ack-type () + "Select types for the '--type' argument of ack-grep." + (require 'helm-mode) + (require 'helm-adaptive) + (setq helm-grep-ack-types-cache (helm-grep-hack-types)) + (let ((types (helm-comp-read + "Types: " helm-grep-ack-types-cache + :name "*Ack-grep types*" + :marked-candidates t + :must-match t + :fc-transformer '(helm-adaptive-sort + helm-grep-ack-types-transformer) + :buffer "*helm ack-types*"))) + (mapconcat #'(lambda (type) (concat "--type=" type)) types " "))) + + +;;; grep extensions +;; +;; +(defun helm-grep-guess-extensions (files) + "Try to guess file extensions in FILES list when using grep recurse. +These extensions will be added to command line with --include arg of grep." + (cl-loop with ext-list = (list helm-grep-preferred-ext "*") + with lst = (if (file-directory-p (car files)) + (directory-files + (car files) nil + directory-files-no-dot-files-regexp) + files) + for i in lst + for ext = (file-name-extension i 'dot) + for glob = (and ext (not (string= ext "")) + (concat "*" ext)) + unless (or (not glob) + (and glob-list (member glob glob-list)) + (and glob-list (member glob ext-list)) + (and glob-list (member glob grep-find-ignored-files))) + collect glob into glob-list + finally return (delq nil (append ext-list glob-list)))) + +(defun helm-grep-get-file-extensions (files) + "Try to return a list of file extensions to pass to '--include' arg of grep." + (let* ((all-exts (helm-grep-guess-extensions + (mapcar 'expand-file-name files))) + (extensions (helm-comp-read "Search Only in: " all-exts + :marked-candidates t + :fc-transformer 'helm-adaptive-sort + :buffer "*helm grep exts*" + :name "*helm grep extensions*"))) + (when (listp extensions) ; Otherwise it is empty string returned by C-RET. + ;; If extensions is a list of one string containing spaces, + ;; assume user entered more than one glob separated by space(s) and + ;; split this string to pass it later to mapconcat. + ;; e.g '("*.el *.py") + (cl-loop for i in extensions + append (split-string-and-unquote i " "))))) + + +;;; Set up source +;; +;; +(defvar helm-source-grep nil) +(defun helm-do-grep-1 (targets &optional recurse zgrep exts default-input) + "Launch grep on a list of TARGETS files. +When RECURSE is given use -r option of grep and prompt user +to set the --include args of grep. +You can give more than one arg separated by space. +e.g *.el *.py *.tex. +If you are using ack-grep, you will be prompted for --type +instead. +If prompt is empty '--exclude `grep-find-ignored-files' is used instead. +ZGREP when non--nil use zgrep instead, without prompting for a choice +in recurse, search being made on `helm-zgrep-file-extension-regexp'." + (when (and (helm-grep-use-ack-p) + helm-ff-default-directory + (file-remote-p helm-ff-default-directory)) + (error "Error: Remote operation not supported with ack-grep.")) + (let* (non-essential + (exts (and recurse + ;; [FIXME] I could handle this from helm-walk-directory. + (not zgrep) ; zgrep doesn't handle -r opt. + (not (helm-grep-use-ack-p :where 'recursive)) + (or exts (helm-grep-get-file-extensions targets)))) + (include-files (and exts + (mapconcat #'(lambda (x) + (concat "--include=" + (shell-quote-argument x))) + (if (> (length exts) 1) + (remove "*" exts) + exts) " "))) + (types (and (not include-files) + (not zgrep) + recurse + (helm-grep-use-ack-p :where 'recursive) + ;; When %e format spec is not specified + ;; ignore types and do not prompt for choice. + (string-match "%e" helm-grep-default-command) + (helm-grep-read-ack-type))) + (follow (and helm-follow-mode-persistent + (assoc-default 'follow helm-source-grep)))) + ;; When called as action from an other source e.g *-find-files + ;; we have to kill action buffer. + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + ;; If `helm-find-files' haven't already started, + ;; give a default value to `helm-ff-default-directory'. + (unless helm-ff-default-directory + (setq helm-ff-default-directory default-directory)) + ;; We need to store these vars locally + ;; to pass infos later to `helm-resume'. + (helm-set-local-variable 'helm-zgrep-recurse-flag (and recurse zgrep) + 'helm-grep-last-targets targets + 'helm-grep-include-files (or include-files types) + 'helm-grep-in-recurse recurse + 'helm-grep-use-zgrep zgrep + 'helm-grep-default-command + (cond (zgrep helm-default-zgrep-command) + (recurse helm-grep-default-recurse-command) + ;; When resuming the local value of + ;; `helm-grep-default-command' is used, only git-grep + ;; should need this. + (t helm-grep-default-command))) + ;; Setup the source. + (setq helm-source-grep + (helm-build-async-source + (if zgrep "Zgrep" (capitalize (if recurse + (helm-grep-command t) + (helm-grep-command)))) + :header-name (lambda (name) + (concat name "(C-c ? Help)")) + :candidates-process 'helm-grep-collect-candidates + :filter-one-by-one 'helm-grep-filter-one-by-one + :nohighlight t + :candidate-number-limit 9999 + :mode-line helm-grep-mode-line-string + :history 'helm-grep-history + :action (helm-make-actions + "Find File" 'helm-grep-action + "Find file other frame" 'helm-grep-other-frame + (lambda () (and (locate-library "elscreen") + "Find file in Elscreen")) + 'helm-grep-jump-elscreen + "Save results in grep buffer" 'helm-grep-save-results + "Find file other window" 'helm-grep-other-window) + :persistent-action 'helm-grep-persistent-action + :persistent-help "Jump to line (`C-u' Record in mark ring)" + :requires-pattern 2 + :follow follow)) + (helm + :sources 'helm-source-grep + :buffer (format "*helm %s*" (if zgrep "zgrep" (helm-grep-command recurse))) + :default default-input + :keymap helm-grep-map + :history 'helm-grep-history + :truncate-lines t))) + + + +;;; zgrep +;; +;; +(defun helm-ff-zgrep-1 (flist recursive) + (unwind-protect + (let* ((def-dir (or helm-ff-default-directory + default-directory)) + (only (if recursive + (or (gethash def-dir helm-rzgrep-cache) + (puthash + def-dir + (helm-walk-directory + def-dir + :directories nil + :path 'full + :match helm-zgrep-file-extension-regexp) + helm-rzgrep-cache)) + flist))) + (helm-do-grep-1 only recursive 'zgrep)) + (setq helm-zgrep-recurse-flag nil))) + + +;;; transformers +;; +;; +(defun helm-grep-split-line (line) + "Split a grep output line." + ;; The output of grep may send a truncated line in this chunk, + ;; so don't split until grep line is valid, that is + ;; once the second part of the line comes with next chunk + ;; send by process. + (when (string-match helm-grep-split-line-regexp line) + ;; Don't use split-string because buffer/file name or string + ;; may contain a ":". + (cl-loop for n from 1 to 3 collect (match-string n line)))) + +(defun helm-grep--filter-candidate-1 (candidate &optional dir) + (let* ((root (or dir (and helm-grep-default-directory-fn + (funcall helm-grep-default-directory-fn)))) + ansi-color-context ; seems this avoid non--translated fname entries. + (ansi-p (string-match-p ansi-color-regexp candidate)) + (line (if ansi-p (ansi-color-apply candidate) candidate)) + (split (helm-grep-split-line line)) + (fname (if (and root split) + (expand-file-name (car split) root) + (car-safe split))) + (lineno (nth 1 split)) + (str (nth 2 split))) + (when (and fname lineno str) + (cons (concat (propertize (file-name-nondirectory fname) + 'face 'helm-grep-file + 'help-echo fname) + ":" + (propertize lineno 'face 'helm-grep-lineno) + ":" + (if ansi-p str (helm-grep-highlight-match str))) + line)))) + +(defun helm-grep-filter-one-by-one (candidate) + "`filter-one-by-one' transformer function for `helm-do-grep'." + (let ((helm-grep-default-directory-fn + (or helm-grep-default-directory-fn + (lambda () (or helm-ff-default-directory + (helm-default-directory) + default-directory))))) + (helm-grep--filter-candidate-1 candidate))) + +(defun helm-grep-highlight-match (str &optional multi-match) + "Highlight in string STR all occurences matching `helm-pattern'." + (require 'helm-match-plugin) + (let (beg end) + (condition-case nil + (with-temp-buffer + (insert str) + (goto-char (point-min)) + (cl-loop for reg in (if multi-match + (cl-loop for r in (helm-mp-split-pattern + helm-pattern) + unless (string-match "\\`!" r) + collect r) + (list helm-pattern)) + do + (while (and (re-search-forward reg nil t) + (> (- (setq end (match-end 0)) + (setq beg (match-beginning 0))) 0)) + (add-text-properties beg end '(face helm-grep-match))) + do (goto-char (point-min))) + (buffer-string)) + (error nil)))) + + +;;; Grep from buffer list +;; +;; +(defun helm-grep-buffers-1 (candidate &optional zgrep) + "Run grep on all file--buffers or CANDIDATE if it is a file--buffer. +If one of selected buffers is not a file--buffer, +it is ignored and grep will run on all others file--buffers. +If only one candidate is selected and it is not a file--buffer, +switch to this buffer and run `helm-occur'. +If a prefix arg is given run grep on all buffers ignoring non--file-buffers." + (let* ((prefarg (or current-prefix-arg helm-current-prefix-arg)) + (helm-ff-default-directory + (if (and helm-ff-default-directory + (file-remote-p helm-ff-default-directory)) + default-directory + helm-ff-default-directory)) + (cands (if prefarg + (buffer-list) + (helm-marked-candidates))) + (win-conf (current-window-configuration)) + ;; Non--fname and remote buffers are ignored. + (bufs (cl-loop for buf in cands + for fname = (buffer-file-name (get-buffer buf)) + when (and fname (not (file-remote-p fname))) + collect (expand-file-name fname)))) + (if bufs + (if zgrep + (helm-do-grep-1 bufs nil 'zgrep) + (helm-do-grep-1 bufs)) + ;; bufs is empty, thats mean we have only CANDIDATE + ;; and it is not a buffer-filename, fallback to occur. + (switch-to-buffer candidate) + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + (helm-occur) + (when (eq helm-exit-status 1) + (set-window-configuration win-conf))))) + +(defun helm-grep-buffers (candidate) + "Action to grep buffers." + (helm-grep-buffers-1 candidate)) + +(defun helm-zgrep-buffers (candidate) + "Action to zgrep buffers." + (helm-grep-buffers-1 candidate 'zgrep)) + + +;;; Helm interface for pdfgrep +;; pdfgrep program +;; and a pdf-reader (e.g xpdf) are needed. +;; +(defvar helm-pdfgrep-default-function 'helm-pdfgrep-init) +(defun helm-pdfgrep-init (only-files) + "Start an asynchronous pdfgrep process in ONLY-FILES list." + (let* ((default-directory (or helm-ff-default-directory + default-directory)) + (fnargs (helm-grep-prepare-candidates + (if (file-remote-p default-directory) + (mapcar #'(lambda (x) + (file-remote-p x 'localname)) + only-files) + only-files) + default-directory)) + (cmd-line (format helm-pdfgrep-default-command + helm-pattern + fnargs)) + process-connection-type) + ;; Start pdf grep process. + (helm-log "Starting Pdf Grep process in directory `%s'" default-directory) + (helm-log "Command line used was:\n\n%s" + (concat ">>> " (propertize cmd-line 'face 'helm-grep-cmd-line) "\n\n")) + (prog1 + (start-file-process-shell-command + "pdfgrep" helm-buffer cmd-line) + (message nil) + (set-process-sentinel + (get-buffer-process helm-buffer) + #'(lambda (_process event) + (if (string= event "finished\n") + (with-helm-window + (setq mode-line-format + '(" " mode-line-buffer-identification " " + (:eval (format "L%s" (helm-candidate-number-at-point))) " " + (:eval (propertize + (format "[Pdfgrep Process Finish - %s result(s)] " + (max (1- (count-lines + (point-min) (point-max))) 0)) + 'face 'helm-grep-finish)))) + (force-mode-line-update)) + (helm-log "Error: Pdf grep %s" + (replace-regexp-in-string "\n" "" event)))))))) + +(defun helm-do-pdfgrep-1 (only) + "Launch pdfgrep with a list of ONLY files." + (unless (executable-find "pdfgrep") + (error "Error: No such program `pdfgrep'.")) + (let* (helm-grep-in-recurse) ; recursion is never used in pdfgrep. + ;; When called as action from an other source e.g *-find-files + ;; we have to kill action buffer. + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + (setq helm-pdfgrep-targets only) + (helm + :sources (helm-build-async-source "PdfGrep" + :init (lambda () + ;; If `helm-find-files' haven't already started, + ;; give a default value to `helm-ff-default-directory'. + (setq helm-ff-default-directory (or helm-ff-default-directory + default-directory))) + :candidates-process (lambda () + (funcall helm-pdfgrep-default-function helm-pdfgrep-targets)) + :filter-one-by-one #'helm-grep-filter-one-by-one + :candidate-number-limit 9999 + :history 'helm-grep-history + :keymap helm-pdfgrep-map + :mode-line helm-pdfgrep-mode-line-string + :action #'helm-pdfgrep-action + :persistent-help "Jump to PDF Page" + :requires-pattern 2) + :buffer "*helm pdfgrep*" + :history 'helm-grep-history))) + +(defun helm-pdfgrep-action (candidate) + (helm-grep-action candidate 'pdf)) + +(defun helm-pdfgrep-action-1 (_split pageno fname) + (save-selected-window + (start-file-process-shell-command + "pdf-reader" nil + (format-spec helm-pdfgrep-default-read-command + (list (cons ?f fname) (cons ?p pageno)))))) + +;;;###autoload +(defun helm-do-grep () + "Preconfigured helm for grep. +Contrarily to Emacs `grep', no default directory is given, but +the full path of candidates in ONLY. +That allow to grep different files not only in `default-directory' but anywhere +by marking them (C-). If one or more directory is selected +grep will search in all files of these directories. +You can also use wildcard in the base name of candidate. +If a prefix arg is given use the -r option of grep (recurse). +The prefix arg can be passed before or after start file selection. +See also `helm-do-grep-1'." + (interactive) + (require 'helm-mode) + (let* ((preselection (or (dired-get-filename nil t) + (buffer-file-name (current-buffer)))) + (only (helm-read-file-name + "Search in file(s): " + :marked-candidates t + :preselect (and helm-do-grep-preselect-candidate + (if helm-ff-transformer-show-only-basename + (helm-basename preselection) + preselection)))) + (prefarg (or current-prefix-arg helm-current-prefix-arg))) + (helm-do-grep-1 only prefarg))) + +;;;###autoload +(defun helm-do-zgrep () + "Preconfigured helm for zgrep." + (interactive) + (require 'helm-mode) + (let* ((prefarg (or current-prefix-arg helm-current-prefix-arg)) + (preselection (or (dired-get-filename nil t) + (buffer-file-name (current-buffer)))) + (ls (helm-read-file-name + "Search in file(s): " + :marked-candidates t + :preselect (and helm-do-grep-preselect-candidate + (if helm-ff-transformer-show-only-basename + (helm-basename preselection) + preselection))))) + (helm-ff-zgrep-1 ls prefarg))) + +;;;###autoload +(defun helm-do-pdfgrep () + "Preconfigured helm for pdfgrep." + (interactive) + (require 'helm-mode) + (let* ((preselection (or (dired-get-filename nil t) + (buffer-file-name (current-buffer)))) + (only (helm-read-file-name + "Search in file(s): " + :marked-candidates t + :test #'(lambda (file) + (or (string= (file-name-extension file) "pdf") + (string= (file-name-extension file) "PDF") + (file-directory-p file))) + :preselect (and helm-do-grep-preselect-candidate + (if helm-ff-transformer-show-only-basename + (helm-basename preselection) + preselection)))) + (helm-grep-default-function 'helm-pdfgrep-init)) + (helm-do-pdfgrep-1 only))) + + +(provide 'helm-grep) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-grep.el ends here diff --git a/elpa/helm-20150426.2119/helm-help.el b/elpa/helm-20150426.2119/helm-help.el new file mode 100644 index 00000000..bfef7768 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-help.el @@ -0,0 +1,1717 @@ +;;; helm-help.el --- Help messages for Helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: +(require 'helm) +(require 'helm-org) + + +(defgroup helm-help nil + "Embedded help for `helm'." + :group 'helm) + +(defface helm-helper + '((t :inherit helm-header)) + "Face for helm help string in minibuffer." + :group 'helm-help) + +(defcustom helm-documentation-file "~/.emacs.d/helm-doc.org" + "The file where you want to save helm documentation." + :group 'helm-help + :type 'string) + +(defvar helm-help--string-list '(helm-help-message + helm-buffer-help-message + helm-ff-help-message + helm-read-file-name-help-message + helm-generic-file-help-message + helm-grep-help-message + helm-pdfgrep-help-message + helm-etags-help-message + helm-ucs-help-message + helm-bookmark-help-message + helm-esh-help-message + helm-buffers-ido-virtual-help-message + helm-moccur-help-message + helm-top-help-message + helm-apt-help-message + helm-el-package-help-message + helm-M-x-help-message + helm-imenu-help-message + helm-colors-help-message + helm-semantic-help-message + helm-kmacro-help-message)) + + +;;;###autoload +(defun helm-documentation (arg) + "Helm documentation. +With a prefix arg refresh the documentation. + +Find here the documentation of all sources actually documented." + (interactive "P") + (when arg (delete-file helm-documentation-file) + (helm-aif (get-file-buffer helm-documentation-file) + (kill-buffer it))) + (unless (file-exists-p helm-documentation-file) + (with-temp-file helm-documentation-file + (erase-buffer) + (cl-loop for elm in helm-help--string-list + for str = (symbol-value elm) + do (if (functionp str) + (insert (funcall str)) + (insert str))))) + (let ((helm-org-headings--nofilename t)) + (helm :sources (helm-source-org-headings-for-files + (list helm-documentation-file)) + :candidate-number-limit 99999 + :buffer "*helm documentation*"))) + +;;; Global help message - Used by `helm-help' +;; +;; +(defvar helm-help-message + (lambda () + (concat + "\n* Helm generic help\n" + "\\" + "\n`helm' is an Emacs incremental completion and selection narrowing framework. + +Narrow the list by typing some pattern, +Multiple patterns are allowed by splitting by space. +Select with natural Emacs operations, choose with RET. + +** Help + +C-h m : Run this generic help for helm. +C-c ? : Run specific helm help for current source. + +** Basic Operations + +C-p, Up: Previous Line +C-n, Down : Next Line +M-v, PageUp : Previous Page +C-v, PageDown : Next Page +Enter : Execute first (default) action / Select +M-< : First Line +M-> : Last Line +M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window) +M-PageDown, C-M-v : Next Page (other-window) + +Tab, C-i : Show action list +Left : Previous Source +Right, C-o : Next Source +C-k : Delete pattern (with prefix arg delete from point to end) +C-j or C-z: Persistent Action (Execute action with helm session kept) + +** Shortcuts For nth Action + +f1-12: Execute nth 1 to 12 Action(s). + +** Visible Marks + +Visible marks store candidate. Some actions uses marked candidates. + +\\[helm-toggle-visible-mark] : Toggle Visible Mark +\\[helm-prev-visible-mark] : Previous Mark +\\[helm-next-visible-mark] : Next Mark + +** Miscellaneous Commands + +\\[helm-toggle-resplit-window] : Toggle vertical/horizontal split helm window. +\\[helm-quit-and-find-file] : Drop into `find-file'. +\\[helm-delete-current-selection] : Delete selected item (visually). +\\[helm-kill-selection-and-quit] : Kill display value of candidate and quit (with prefix arg kill the real value). +\\[helm-yank-selection] : Yank selection into pattern. +\\[helm-follow-mode] : Toggle automatical execution of persistent action. +\\[helm-follow-action-forward] : Run persistent action and goto next line. +\\[helm-follow-action-backward] : Run persistent action and goto previous line. +\\[helm-force-update] : Recalculate and redisplay candidates. + +** Global Commands + +\\\\[helm-resume] revives last `helm' session. +It is very useful, so you should bind any key.")) + "Detailed help message string for `helm'. +It also accepts function or variable symbol.") + +(defun helm-help-internal (bufname insert-content-fn) + "Show long message during `helm' session in BUFNAME. +INSERT-CONTENT-FN is the function that insert +text to be displayed in BUFNAME." + (let ((winconf (current-frame-configuration))) + (unwind-protect + (progn + (setq helm-suspend-update-flag t) + (set-buffer (get-buffer-create bufname)) + (switch-to-buffer bufname) + (delete-other-windows) + (delete-region (point-min) (point-max)) + (outline-mode) + (save-excursion + (funcall insert-content-fn)) + (setq cursor-type nil) + (buffer-disable-undo) + (helm-help-event-loop)) + (setq helm-suspend-update-flag nil) + (set-frame-configuration winconf)))) + +(defun helm-help-scroll-up (amount) + (condition-case _err + (scroll-up-command amount) + (beginning-of-buffer nil) + (end-of-buffer nil))) + +(defun helm-help-scroll-down (amount) + (condition-case _err + (scroll-down-command amount) + (beginning-of-buffer nil) + (end-of-buffer nil))) + +(defun helm-help-event-loop () + (let ((prompt (propertize + "[SPC,C-v,down,next:NextPage b,M-v,up,prior:PrevPage C-s/r:Isearch q:Quit]" + 'face 'helm-helper)) + scroll-error-top-bottom) + (cl-loop for event = (read-key prompt) do + (cl-case event + ((?\C-v ? down next) (helm-help-scroll-up helm-scroll-amount)) + ((?\M-v ?b up prior) (helm-help-scroll-down helm-scroll-amount)) + (?\C-s (isearch-forward)) + (?\C-r (isearch-backward)) + (?q (cl-return)) + (t (ignore)))))) + +;;;###autoload +(defun helm-help () + "Help of `helm'." + (interactive) + (with-helm-alive-p + (save-selected-window + (helm-help-internal + "*Helm Help*" + (lambda () + (insert (substitute-command-keys + (helm-interpret-value (or (assoc-default + 'help-message + (helm-get-current-source)) + helm-help-message))))))))) + +;;; `helm-buffer-list' help +;; +;; +(defvar helm-buffer-help-message + "\n* Helm Buffer\n + +** Helm buffers tips: + +*** Completion: + +**** Major-mode: + +You can enter a partial name of major-mode (e.g lisp, sh) to narrow down buffers. +To specify the major-mode, prefix it with \"*\" e.g \"*lisp\". +If you want to match all buffers but the ones with a specific major-mode (negation), +prefix the major-mode with \"!\" e.g \"*!lisp\". +If you want to specify more than one major-mode, separate them with \",\", +e.g \"*!lisp,!sh,!fun\" will list all buffers but the ones in lisp-mode, sh-mode and +fundamental-mode. + +Enter then a space and a pattern to narrow down to buffers matching this pattern. + +**** Search inside buffers: + +If you enter a space and a pattern prefixed by \"@\" helm will search for text matching +this pattern INSIDE the buffer (i.e not in the name of buffer). +NOTE that if you enter your pattern prefixed with \"@\" but escaped, helm will search a buffer +matching \"@pattern\" but will not search inside. + +**** Search by directory name: + +If you prefix the beginning of pattern with \"/\" the match will occur on directory name +of buffer, it is interesting to narrow down to one directory for example, subsequent string +entered after a space will match on buffer-name only. +Note that negation is not supported for matching on buffer-file-name. +You can specify more than one directory starting from helm v1.6.8 + +**** Fuzzy matching: + +Note that if `helm-buffers-fuzzy-matching' is non--nil you will have +fuzzy matching on buffer names (not on directory name matching and major-mode though). +A pattern starting with \"^\" will disable fuzzy matching and will match by exact regexp. + +**** Examples: + +if I enter in pattern prompt: +\"*lisp ^helm @moc\" +helm will narrow down the list by selecting only buffers that are in lisp mode, start by helm +and match \"moc\" in their contents. + +if I enter in pattern prompt: +\"*lisp ^helm moc\" +Notice there is no \"@\" this time +helm will look for lisp mode buffers starting by \"helm\" and have \"moc\" in their name. + +if I enter in pattern prompt: +\"*!lisp !helm\" +helm will narrow down to buffers that are not in \"lisp\" mode and that do not match \"helm\" + +if I enter in pattern prompt: +/helm/ w3 +helm will narrow down to buffers that are in any \"helm\" subdirectory and matching w3. + + +*** Creating buffers + +When creating a new buffer use \\[universal-argument] to choose a mode for your buffer in a list. +This list is customizable, see `helm-buffers-favorite-modes'. + +*** Killing buffers + +You have a command to kill buffer(s) and quit emacs and a command to kill buffers one by one +\(no marked\) without quitting helm. +You can run this persistent kill buffer command either with the regular +`helm-execute-persistent-action' called with a prefix arg (C-u C-j) or with its specific command +`helm-buffer-run-kill-persistent' see binding below. + +*** Meaning of colors and prefixes for buffers: + +Remote buffers are prefixed with '@'. +Red => Buffer have its file modified on disk by an external process. +Indianred2 => Buffer exists but its file have been deleted. +Orange => Buffer is modified and its file not saved to disk. +Italic => A non--file buffer. + +\n** Specific commands for `helm-buffers-list': +\\ +\\[helm-buffer-run-zgrep]\t\t->Grep Buffer(s) works as zgrep too (C-u grep all buffers but non--file buffers). +\\[helm-buffers-run-multi-occur]\t\t->Multi Occur buffer or marked buffers. (C-u toggle force searching current-buffer). +\\[helm-buffer-switch-other-window]\t\t->Switch other window. +\\[helm-buffer-switch-other-frame]\t\t->Switch other frame. +\\[helm-buffer-run-query-replace-regexp]\t\t->Query replace regexp in marked buffers. +\\[helm-buffer-run-query-replace]\t\t->Query replace in marked buffers. +\\[helm-buffer-run-ediff]\t\t->Ediff current buffer with candidate. If two marked buffers ediff those buffers. +\\[helm-buffer-run-ediff-merge]\t\t->Ediff merge current buffer with candidate. If two marked buffers ediff merge those buffers. +\\[helm-buffer-diff-persistent]\t\t->Toggle Diff buffer with saved file without quitting. +\\[helm-buffer-revert-persistent]\t\t->Revert buffer without quitting. +\\[helm-buffer-save-persistent]\t\t->Save buffer without quitting. +\\[helm-buffer-run-kill-buffers]\t\t->Delete marked buffers and quit. +\\[helm-buffer-run-kill-persistent]\t\t->Delete buffer without quitting helm. +\\[helm-toggle-all-marks]\t\t->Toggle all marks. +\\[helm-mark-all]\t\t->Mark all. +\\[helm-toggle-buffers-details]\t\t->Toggle details. +\\[helm-buffers-toggle-show-hidden-buffers]\t\t->Show hidden buffers. +\\[helm-buffers-mark-similar-buffers]\t\t->Mark all buffers with same type (color) than current. +\\[helm-buffer-help]\t\t->Display this help. +\n** Helm Map +\\{helm-map}") + +;;;###autoload +(defun helm-buffer-help () + "Help command for helm buffers." + (interactive) + (let ((helm-help-message helm-buffer-help-message)) + (helm-help))) + +;;; Find files help (`helm-find-files') +;; +;; +(defvar helm-ff-help-message + "\n* Helm Find Files\n + +** Helm find files tips: +\n*** Enter `~/' at end of pattern to quickly reach home directory. + +*** Enter `/' at end of pattern to quickly reach root of your file system. + +*** Enter `./' at end of pattern to quickly reach `default-directory' (initial start of session). + If you are already in `default-directory' this will move cursor on top. + +*** Enter `../' at end of pattern will reach upper directory, moving cursor on top. + NOTE: This different to using `C-l' in that `C-l' don't move cursor on top but stay on previous + subdir name. + +*** You can complete with partial basename (start on third char entered) + + e.g \"fob\" or \"fbr\" will complete \"foobar\" + but \"fb\" will wait for a third char for completing. + +*** Use `C-u C-j' to watch an image. + +*** `C-j' on a filename will expand in helm-buffer to this filename. + Second hit on `C-j' will display buffer filename. + Third hit on `C-j' will kill buffer filename. + NOTE: `C-u C-j' will display buffer directly. + +*** To browse images directories turn on `helm-follow-mode' and navigate with arrow keys. + You can also use `helm-follow-action-forward' and `helm-follow-action-backward' + (`C-'). + +*** You can turn off/on (toggle) autoupdate completion at any moment with `C-DEL'. + NOTE: On a terminal C- may not work, use in this case C-c . + +*** You can create a new directory and a new file at the same time. + just write the path in prompt and press `'. + e.g You can create \"~/new/newnew/newnewnew/my_newfile.txt\". + +*** To create a new directory, add a \"/\" at end of new name and press . + +*** To create a new file just write the filename not ending with \"/\". + +*** Recursive search from helm find files + +**** You can use helm browse project (see binding below). + +- With no prefix arg + If your current directory is under version control + with one of git or hg and you have installed helm-ls-git and/or helm-ls-hg + https://github.com/emacs-helm/helm-ls-git.git + https://github.com/emacs-helm/helm-ls-hg + you will see all your files under version control, otherwise + you will be back to helm-find-files. +- With one prefix arg + You will see all the files under this directory + and other subdirectories (recursion) and this list of files will be cached. +- With two prefix args + same but the cache will be refreshed. + +**** You can start a recursive search with Locate of Find (See commands below). + With Locate you can use a local db with a prefix arg; If the localdb doesn't already + exists, you will be prompted for its creation, if it exists and you want to refresh it, + give two prefix args. + +*** Insert filename at point or complete filename at point + +On insertion (no completion, i.e nothing at point): + +- `C-c i' => insert absolute file name. +- `C-u C-c i' => insert abbreviate file name. +- `C-u C-u C-c i' => insert relative file name. + +On completion: + +- target starts by ~/ => insert abbreviate file name. +- target starts by / or [a-z]:/ => insert full path. +- otherwise => insert relative file name. + +*** Using wildcard to select multiple files + +Use of wilcard is supported to give a set of files to an action: + +e.g +You can copy all the files with \".el\" extension by using \"*.el\" +and then run your copy action. + +You can do the same but with \"**.el\" (note the two stars), +this will select recursively all \".el\" files under current directory. + +NOTE: When using an action that involve an external backend (e.g grep), using \"**\" +is not advised (even if it works fine) because it will be slower to select all your files, +you have better time letting the backend doing it, it will be faster. +However, if you know you have not many files it is reasonable to use this, +also using not recursive wilcard (e.g \"*.el\") is perfectly fine for this. + +This feature (\"**\") is activated by default with the option `helm-file-globstar'. +The directory selection with \"**foo/\" like bash shopt globstar option is not supported yet. + +*** Bookmark your `helm-find-files' session + +You can bookmark your `helm-find-files' session with `C-x r m'. +You can retrieve later these bookmarks easily by using M-x helm-filtered-bookmarks. + +\n** Specific commands for `helm-find-files':\n +\\ +\\[helm-ff-run-locate]\t\t->Run Locate (C-u to specify locate db, M-n insert basename of candidate) +\\[helm-ff-run-browse-project]\t\t->Browse project (`C-u' recurse, `C-u C-u' recurse and refresh db) +\\[helm-ff-run-find-sh-command]\t\t->Run Find shell command from this directory. +\\[helm-ff-run-grep]\t\t->Run Grep (C-u Recursive). +\\[helm-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files. +\\[helm-ff-run-zgrep]\t\t->Run zgrep (C-u Recursive). +\\[helm-ff-run-etags]\t\t->Run Etags (C-u use thing-at-point `C-u C-u' reload cache) +\\[helm-ff-run-rename-file]\t\t->Rename File (C-u Follow). +\\[helm-ff-run-query-replace-on-marked]\t\t->Query replace on marked files. +\\[helm-ff-run-copy-file]\t\t->Copy File (C-u Follow). +\\[helm-ff-run-byte-compile-file]\t\t->Byte Compile File (C-u Load). +\\[helm-ff-run-load-file]\t\t->Load File. +\\[helm-ff-run-symlink-file]\t\t->Symlink File. +\\[helm-ff-run-hardlink-file]\t\t->Hardlink file. +\\[helm-ff-run-delete-file]\t\t->Delete File. +\\[helm-ff-run-kill-buffer-persistent]\t\t->Kill buffer candidate without quitting. +\\[helm-ff-persistent-delete]\t\t->Delete file without quitting. +\\[helm-ff-run-switch-to-eshell]\t\t->Switch to Eshell. +\\[helm-ff-run-eshell-command-on-file]\t\t->Eshell command on file (C-u Apply on marked files, otherwise treat them sequentially). +\\[helm-ff-run-ediff-file]\t\t->Ediff file. +\\[helm-ff-run-ediff-merge-file]\t\t->Ediff merge file. +\\[helm-ff-run-complete-fn-at-point]\t\t->Complete file name at point. +\\[helm-ff-run-switch-other-window]\t\t->Switch other window. +\\[helm-ff-run-switch-other-frame]\t\t->Switch other frame. +\\[helm-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose). +\\[helm-ff-run-open-file-with-default-tool]\t\t->Open file externally with default tool. +\\[helm-ff-rotate-left-persistent]\t\t->Rotate Image Left. +\\[helm-ff-rotate-right-persistent]\t\t->Rotate Image Right. +\\[helm-find-files-up-one-level]\t\t->Go down precedent directory. +\\[helm-ff-run-switch-to-history]\t\t->Switch to last visited directories history. +\\[helm-ff-file-name-history]\t\t->Switch to file name history. +\\[helm-ff-properties-persistent]\t\t->Show file properties in a tooltip. +\\[helm-mark-all]\t\t->Mark all visibles candidates. +\\[helm-ff-run-toggle-auto-update]\t\t->Toggle auto expansion of directories. +\\[helm-unmark-all]\t\t->Unmark all candidates, visibles and invisibles. +\\[helm-ff-run-gnus-attach-files]\t\t->Gnus attach files to message buffer. +\\[helm-ff-run-print-file]\t\t->Print file, (C-u to refresh printers list). +\\[helm-enlarge-window]\t\t->Enlarge helm window. +\\[helm-narrow-window]\t\t->Narrow helm window. +\\[helm-ff-run-toggle-basename]\t\t->Toggle basename/fullpath. +\\[helm-ff-run-find-file-as-root]\t\t->Find file as root. +\\[helm-ff-run-insert-org-link]\t\t->Insert org link. +\\[helm-ff-help]\t\t->Display this help info. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-ff-help () + "Help command for `helm-find-files'." + (interactive) + (let ((helm-help-message helm-ff-help-message)) + (helm-help))) + +;;; Help for `helm-read-file-name' +;; +;; +(defvar helm-read-file-name-help-message + "\n* Helm read file name\n + +** Helm read file name tips: + +\n*** Enter `~/' at end of pattern to quickly reach home directory. + +*** Enter `/' at end of pattern to quickly reach root of your file system. + +*** Enter `./' at end of pattern to quickly reach `default-directory' (initial start of session). + If you are in `default-directory' move cursor on top. + +*** Enter `../' at end of pattern will reach upper directory, moving cursor on top. + NOTE: This different to using `C-l' in that `C-l' don't move cursor on top but stay on previous + subdir name. + +*** You can complete with partial basename (start on third char entered) + + e.g \"fob\" or \"fbr\" will complete \"foobar\" + but \"fb\" will wait for a third char for completing. + +*** Persistent actions: + +By default `helm-read-file-name' use the persistent actions of `helm-find-files'. + +**** Use `C-u C-j' to watch an image. + +**** `C-j' on a filename will expand in helm-buffer to this filename. + Second hit on `C-j' will display buffer filename. + Third hit on `C-j' will kill buffer filename. + NOTE: `C-u C-j' will display buffer directly. + +**** To browse images directories turn on `helm-follow-mode' and navigate with arrow keys. + +**** When you want to delete backward characters to e.g creating a new file or directory, + autoupdate may keep updating to an existent directory + preventing you to do so, in this case just hit C- and then . + This should not needed when copying/renaming files because autoupdate is disabled + by default in this case. + NOTE: On a terminal C- may not work, use in this case C-c . + +**** You can create a new directory and a new file at the same time, just write the path in prompt + and press . + e.g You can create \"~/new/newnew/newnewnew/my_newfile.txt\". + +**** To create a new directory, add a \"/\" at end of new name and press . + +**** To create a new file just write the filename not ending with \"/\". + +\n** Specific commands for helm-read-file-name:\n +\\ +\\[helm-find-files-up-one-level]\t\t->Go down precedent directory. +\\[helm-ff-run-toggle-auto-update]\t\t->Toggle auto expansion of directories. +\\[helm-ff-run-toggle-basename]\t\t->Toggle basename. +\\[helm-ff-file-name-history]\t\t->File name history. +C/\\[helm-cr-empty-string]\t\t->Maybe return empty string (unless `must-match'). +\\[helm-next-source]\t\t->Goto next source. +\\[helm-previous-source]\t->Goto previous source. +\\[helm-read-file-name-help]\t\t->Display this help info. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-read-file-name-help () + (interactive) + (let ((helm-help-message helm-read-file-name-help-message)) + (helm-help))) + +;;; Generic file help - Used by locate. +;; +;; +(defvar helm-generic-file-help-message + "\n* Helm Generic files\n + +** Helm generic file tips:\n + +*** Locate +You can add after writing search pattern any of the locate command line options. +e.g -b, -e, -n ...etc. +See Man locate for more infos. + +Some other sources (at the moment recentf and file in current directory sources) +support the -b flag for compatibility with locate when they are used with it. + +*** Browse project + +When your directory is not under version control, +don't forget to refresh your cache when files have been added/removed in your directory. + +*** Find command + +Recursively search files using \"find\" shell command. + +Candidates are all filenames that match all given globbing patterns. +This respects the options `helm-case-fold-search' and +`helm-findutils-search-full-path'. + +You can pass arbitrary options directly to find after a \"*\" separator. +For example, this would find all files matching \"book\" that are larger +than 1 megabyte: + +book * -size +1M + +\n** Specific commands for helm locate and others files sources: + +\\ +\\[helm-ff-run-toggle-basename]\t\t->Toggle basename. +\\[helm-ff-run-grep]\t\t->Run grep (C-u recurse). +\\[helm-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files. +\\[helm-ff-run-delete-file]\t\t->Delete file. +\\[helm-ff-run-ediff-file]\t\t->Ediff file. +\\[helm-ff-run-ediff-merge-file]\t\t->Ediff merge file. +\\[helm-ff-run-switch-other-window]\t\t->Switch other window. +\\[helm-ff-properties-persistent]\t\t->Show file properties. +\\[helm-ff-run-etags]\t\t->Run etags (C-u use tap, C-u C-u reload DB). +\\[helm-yank-text-at-point]\t\t->Yank text at point. +\\[helm-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose). +\\[helm-ff-run-open-file-with-default-tool]\t\t->Open file externally with default tool. +\\[helm-ff-run-insert-org-link]\t\t->Insert org link. +\\[helm-generic-file-help]\t\t->Show this help. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-generic-file-help () + (interactive) + (let ((helm-help-message helm-generic-file-help-message)) + (helm-help))) + +;;; Grep help +;; +;; +(defvar helm-grep-help-message + "\n* Helm Grep\n +** Helm grep tips:\n +*** You can start grep with a prefix arg to recurse in subdirectories. +*** You can use wild card when selecting files (e.g *.el) +*** You can grep in many differents directories by marking files or wild cards. +*** You can save your results in a grep-mode buffer, see commands below. + +*** Important:\n +Grepping on remote file will work only with grep, not ack-grep, but it is +anyway bad supported as tramp doesn't support multiple process running in a +short delay (less than 5s actually) among other things, +so I strongly advice hitting `C-!' (i.e suspend process) +before entering anything in pattern, and hit again `C-!' when +your regexp is ready to send to remote process, even if helm is handling +this by delaying each process at 5s. +Or even better don't use tramp at all and mount your remote file system on SSHFS. + +\n** Specific commands for Helm Grep:\n +\\ +\\[helm-goto-next-file]\t->Next File. +\\[helm-goto-precedent-file]\t\t->Precedent File. +\\[helm-yank-text-at-point]\t\t->Yank Text at point in minibuffer. +\\[helm-grep-run-other-window-action]\t\t->Jump other window. +\\[helm-grep-run-other-frame-action]\t\t->Jump other frame. +\\[helm-grep-run-persistent-action]\t\t->Run persistent action (Same as `C-j'). +\\[helm-grep-run-default-action]\t\t->Run default action (Same as RET). +\\[helm-grep-run-save-buffer]\t\t->Save to a `grep-mode' enabled buffer. +\\[helm-grep-help]\t\t->Show this help. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-grep-help () + (interactive) + (let ((helm-help-message helm-grep-help-message)) + (helm-help))) + +;;; Pdf grep help +;; +;; +(defvar helm-pdfgrep-help-message + "\n* Helm PdfGrep Map\n +\n** Specific commands for Pdf Grep:\n +\\ +\\[helm-goto-next-file]\t->Next File. +\\[helm-goto-precedent-file]\t\t->Precedent File. +\\[helm-yank-text-at-point]\t\t->Yank Text at point in minibuffer. +\\[helm-pdfgrep-help]\t\t->Show this help. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-pdfgrep-help () + (interactive) + (let ((helm-help-message helm-pdfgrep-help-message)) + (helm-help))) + +;;; Etags help +;; +;; +(defvar helm-etags-help-message + "\n* Helm Etags Map\n +\n** Specific commands for Etags:\n +\\ +\\[helm-goto-next-file]\t->Next File. +\\[helm-goto-precedent-file]\t\t->Precedent File. +\\[helm-yank-text-at-point]\t\t->Yank Text at point in minibuffer. +\\[helm-etags-help]\t\t->Show this help. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-etags-help () + "The help function for etags." + (interactive) + (let ((helm-help-message helm-etags-help-message)) + (helm-help))) + +;;; Ucs help +;; +;; +(defvar helm-ucs-help-message + "\n* Helm Ucs\n +\n** Specific commands for `helm-ucs':\n +\\ +\\[helm-ucs-persistent-insert]\t->Insert char. +\\[helm-ucs-persistent-forward]\t->Forward char. +\\[helm-ucs-persistent-backward]\t->Backward char. +\\[helm-ucs-persistent-delete]\t->Delete char backward. +\\[helm-ucs-help]\t\t->Show this help. + +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-ucs-help () + "Help command for `helm-ucs'." + (interactive) + (let ((helm-help-message helm-ucs-help-message)) + (helm-help))) + +;;; Bookmark help +;; +;; +(defvar helm-bookmark-help-message + "\n* Helm bookmark name\n +\n** Specific commands for bookmarks:\n +\\ +\\[helm-bookmark-run-jump-other-window]\t\t->Jump other window. +\\[helm-bookmark-run-delete]\t\t->Delete bookmark. +\\[helm-bookmark-run-edit]\t\t->Edit bookmark. +\\[helm-bookmark-toggle-filename]\t\t->Toggle bookmark location visibility. +\\[helm-bookmark-help]\t\t->Run this help. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-bookmark-help () + "Help command for bookmarks." + (interactive) + (let ((helm-help-message helm-bookmark-help-message)) + (helm-help))) + +;;; Eshell command on file help +;; +;; +(defvar helm-esh-help-message + "\n* Helm eshell on file\n +** Helm eshell on file tips: + +*** Passing extra args after filename: + +Normally your command or alias will be called with file as argument. + +e.g 'candidate_file' + +But you can also pass an argument or more after 'candidate_file' like this: + + %s [extra_args]\n + +'candidate_file' will be added at '%s' and your command will look at this: + + 'candidate_file' [extra_args] + +*** Specify many files as args (marked files): + +e.g file1 file2 ... + +Call `helm-find-files-eshell-command-on-file' with one prefix-arg +Otherwise you can pass one prefix-arg from the command selection buffer. +NOTE: This is not working on remote files. + +With two prefix-arg before starting or from the command selection buffer +the output is printed to your `current-buffer'. + +Note that with no prefix-arg or a prefix-arg value of '(16) (C-u C-u) +the command is called once for each file like this: + + file1 file2 etc... + +\n** Specific commands for `helm-find-files-eshell-command-on-file':\n +\\ +\\[helm-esh-help]\t\t->Display this help. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-esh-help () + "Help command for `helm-find-files-eshell-command-on-file'." + (interactive) + (let ((helm-help-message helm-esh-help-message)) + (helm-help))) + +;;; Ido virtual buffer help +;; +;; +(defvar helm-buffers-ido-virtual-help-message + "\n* Helm ido virtual buffers\n +\n** Specific commands for ido virtuals buffers:\n +\\ +\\[helm-ff-run-switch-other-window]\t\t->Switch other window. +\\[helm-ff-run-switch-other-frame]\t\t->Switch other frame. +\\[helm-ff-run-grep]\t\t->Grep file. +\\[helm-ff-run-zgrep]\t\t->Zgrep file. +\\[helm-ff-run-delete-file]\t\t->Delete file. +\\[helm-ff-run-open-file-externally]\t\t->Open file externally. +\\[helm-buffers-ido-virtual-help]\t\t->Display this help. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-buffers-ido-virtual-help () + "Help command for ido virtual buffers." + (interactive) + (let ((helm-help-message helm-buffers-ido-virtual-help-message)) + (helm-help))) + +;;; Moccur help +;; +;; +(defvar helm-moccur-help-message + "\n* Helm Moccur\n +** Helm Moccur tips: + +*** Matching +Multiple regexp matching is allowed, just enter a space to separate your regexps. + +Matching empty lines is supported with the regexp \"^$\", you will get the results +with only the buffer-name and the line number, you can of course save and edit these +results. + +*** Jump to the corresponding line in the searched buffer +You can do this with `C-j' (persistent-action), to do it repetitively +you can use `C-' and `C-' or enable `helm-follow-mode' with `C-c C-f'. + +*** Saving results +Same as with helm-grep, you can save the results with `C-x C-s'. +Of course if you don't save your results, you can get back your session +with `helm-resume'. + +*** Refreshing the resumed session. +When the buffer(s) where you ran helm-(m)occur have been modified, you will be +warned of this with the buffer flashing to red, you can refresh the buffer by running +`C-c C-u'. +This can be done automatically by customizing `helm-moccur-auto-update-on-resume'. + +*** Refreshing a saved buffer +Just hit `g' to update your buffer. + +*** Edit a saved buffer + +To do so you have to install wgrep +https://github.com/mhayashi1120/Emacs-wgrep +and then: + +1) C-c C-p to edit the buffer(s). +2) C-x C-s to save your changes. + +Tip: Use the excellent iedit https://github.com/tsdh/iedit +to modify occurences in your buffer. + +\n** Specific commands for Helm Moccur:\n +\\ +\\[helm-goto-next-file]\t->Next Buffer. +\\[helm-goto-precedent-file]\t\t->Precedent Buffer. +\\[helm-yank-text-at-point]\t\t->Yank Text at point in minibuffer. +\\[helm-moccur-run-goto-line-ow]\t\t->Goto line in other window. +\\[helm-moccur-run-goto-line-of]\t\t->Goto line in new frame. +\\[helm-moccur-help]\t\t->Show this help. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-moccur-help () + (interactive) + (let ((helm-help-message helm-moccur-help-message)) + (helm-help))) + +;;; Helm Top +;; +;; +(defvar helm-top-help-message + "\n* Helm Top\n +\n** Helm Top tips: + +\n** Specific commands for Helm Top:\n +\\ +\\[helm-top-run-sort-by-com]\t->Sort by commands. +\\[helm-top-run-sort-by-cpu]\t->Sort by cpu usage. +\\[helm-top-run-sort-by-user]\t->Sort alphabetically by user. +\\[helm-top-run-sort-by-mem]\t->Sort by memory. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-top-help () + (interactive) + (let ((helm-help-message helm-top-help-message)) + (helm-help))) + +;;; Helm Apt +;; +;; +(defvar helm-apt-help-message + "\n* Helm Apt\n +\n** Helm Apt tips: + +\n** Specific commands for Helm Apt:\n +\\ +\\[helm-apt-show-all]\t->Show all packages. +\\[helm-apt-show-only-installed]\t->Show installed packages only. +\\[helm-apt-show-only-not-installed]\t->Show not installed packages only. +\\[helm-apt-show-only-deinstalled]\t-Show deinstalled (not purged yet) packages only.> +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-apt-help () + (interactive) + (let ((helm-help-message helm-apt-help-message)) + (helm-help))) + +;;; Helm elisp package +;; +;; +(defvar helm-el-package-help-message + "\n* Helm elisp package\n +\n** Helm elisp package tips: +*** Upgrade elisp packages + +To see upgradables packages hit . + +Then you can install all upgradables packages with the upgrade all action, +or upgrade only the specific packages by marking them (the new ones) and running +the upgrade action (visible only when there is upgradables packages). +Of course you can upgrade a single package by just running the upgrade action +without marking it. + +*** Meaning of flags prefixing packages (Emacs-25) + +- The flag \"S\" that prefix package names mean that this package is one of `package-selected-packages'. +This feature is only available with emacs-25. + +- The flag \"U\" that prefix package names mean that this package is no more needed. +This feature is only available with emacs-25. + +\n** Specific commands for Helm elisp package:\n +\\ +\\[helm-el-package-show-all]\t->Show all packages. +\\[helm-el-package-show-installed]\t->Show installed packages only. +\\[helm-el-package-show-uninstalled]\t->Show not installed packages only. +\\[helm-el-package-help]\t->Show this help. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-el-package-help () + (interactive) + (let ((helm-help-message helm-el-package-help-message)) + (helm-help))) + +;;; Helm M-x +;; +;; +(defvar helm-M-x-help-message + "\n* Helm M-x\n +\n** Helm M-x tips: + +*** You can get help on any command with persistent action (C-j). + +*** All the prefix args passed BEFORE running `helm-M-x' are ignored, +you should have an error message if you do so. +When you want to pass prefix args, pass them AFTER starting `helm-M-x', +you will have a prefix arg counter appearing in mode-line notifying you +the amount of prefix args entered. + +\n** Specific commands for Helm M-x:\n +\\ +\\[helm-M-x-help]\t\t->Show this help. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-M-x-help () + (interactive) + (let ((helm-help-message helm-M-x-help-message)) + (helm-help))) + +;;; helm-imenu +;; +;; +(defvar helm-imenu-help-message + "\n* Helm imenu\n +\n** Helm imenu tips: + +\n** Specific commands for Helm imenu:\n +\\ +\\[helm-imenu-help]\t->Show this help. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-imenu-help () + (interactive) + (let ((helm-help-message helm-imenu-help-message)) + (helm-help))) + +;;; helm-colors +;; +;; +(defvar helm-colors-help-message + "\n* Helm colors\n +\n** Specific commands for Helm colors:\n +\\ +\\[helm-color-run-insert-name]\t\tInsert the entry'name. +\\[helm-color-run-kill-name]\t\tKill the entry's name. +\\[helm-color-run-insert-rgb]\t\tInsert entry in RGB format. +\\[helm-color-run-kill-rgb]\t\tKill entry in RGB format. +\\[helm-color-help]\t\tShow this help. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-color-help () + (interactive) + (let ((helm-help-message helm-colors-help-message)) + (helm-help))) + +;;; helm semantic +;; +;; +(defvar helm-semantic-help-message + "\n* Helm semantic\n +\n** Helm semantic tips: + +\n** Specific commands for Helm semantic:\n +\\ +\\[helm-semantic-help]\t->Show this help. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-semantic-help () + (interactive) + (let ((helm-help-message helm-semantic-help-message)) + (helm-help))) + +;;; helm kmacro +;; +;; +(defvar helm-kmacro-help-message + "\n* Helm kmacro\n +\n** Helm kmacro tips: +- Start recording some keys with `f3' +- Record new kmacro with `f4' +- Start `helm-execute-kmacro' to list all your macros. + +Use persistent action to run your kmacro as many time as needed, +you can change of kmacro with `helm-next-line' `helm-previous-line'. + +NOTE: You can't record keys running helm commands except `helm-M-x' unless +you don't choose from there a command using helm completion. + +\n** Specific commands for Helm kmacro:\n +\\ +\\[helm-kmacro-help]\t->Show this help. +\n** Helm Map\n +\\{helm-map}") + +;;;###autoload +(defun helm-kmacro-help () + (interactive) + (let ((helm-help-message helm-kmacro-help-message)) + (helm-help))) + + +;;; Mode line strings +;; +;; +;;;###autoload +(defvar helm-buffer-mode-line-string + '("Buffer(s)" "\ +\\\ +\\[helm-buffer-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct" + "String displayed in mode-line in `helm-source-buffers-list'")) + +;;;###autoload +(defvar helm-color-mode-line-string + '("Colors" "\ +\\\ +\\[helm-color-help]:Help/\ +\\[helm-color-run-insert-name]:Insert name/\ +\\[helm-color-run-insert-rgb]:Insert RGB/\ +with shift: Kill")) + +;;;###autoload +(defvar helm-buffers-ido-virtual-mode-line-string + '("Killed Buffer(s)" "\ +\\\ +\\[helm-buffers-ido-virtual-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct" + "String displayed in mode-line in `helm-source-buffers-list'")) + +;;;###autoload +(defvar helm-ff-mode-line-string "\ +\\\ +\\[helm-ff-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct" + "String displayed in mode-line in `helm-source-find-files'") + +;;;###autoload +(defvar helm-read-file-name-mode-line-string "\ +\\\ +\\[helm-read-file-name-help]:Help \ +C/\\[helm-cr-empty-string]:Empty \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct" + "String displayed in mode-line in `helm-source-find-files'.") + +;;;###autoload +(defvar helm-generic-file-mode-line-string "\ +\\\ +\\[helm-generic-file-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend" + "String displayed in mode-line in Locate.") + +;;;###autoload +(defvar helm-grep-mode-line-string"\ +\\\ +\\[helm-grep-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend" + "String displayed in mode-line in `helm-do-grep'.") + +;;;###autoload +(defvar helm-pdfgrep-mode-line-string "\ +\\\ +\\[helm-pdfgrep-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend" + "String displayed in mode-line in `helm-do-pdfgrep'.") + +;;;###autoload +(defvar helm-etags-mode-line-string "\ +\\\ +\\[helm-etags-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct" + "String displayed in mode-line in `helm-etags-select'.") + +;;;###autoload +(defvar helm-ucs-mode-line-string "\ +\\\ +\\[helm-ucs-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct" + "String displayed in mode-line in `helm-ucs'.") + +;;;###autoload +(defvar helm-bookmark-mode-line-string + '("Bookmark(s)" "\ +\\\ +\\[helm-bookmark-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct") + "String displayed in mode-line in `helm-source-buffers-list'") + +;;;###autoload +(defvar helm-occur-mode-line "\ +\\\ +\\[helm-help]:Help \ +\\\ +\\[helm-occur-run-query-replace-regexp]:Query replace regexp \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend") + +;;;###autoload +(defvar helm-moccur-mode-line "\ +\\\ +\\[helm-moccur-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend") + +;;;###autoload +(defvar helm-comp-read-mode-line "\ +\\\ +C/\\[helm-cr-empty-string]:Empty \ +\\\ +\\[helm-help]:Help \ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct") + +;;;###autoload +(defvar helm-top-mode-line "\ +\\\ +\\[helm-top-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend") + +;;;###autoload +(defvar helm-apt-mode-line "\ +\\\ +\\[helm-apt-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend") + +;;;###autoload +(defvar helm-el-package-mode-line "\ +\\\ +\\[helm-el-package-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend") + +;;;###autoload +(defvar helm-M-x-mode-line "\ +\\\ +\\[helm-M-x-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend") + +;;;###autoload +(defvar helm-imenu-mode-line "\ +\\\ +\\[helm-imenu-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend") + +;;;###autoload +(defvar helm-semantic-mode-line "\ +\\\ +\\[helm-semantic-help]:Help \ +\\\ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct \ +\\[helm-toggle-suspend-update]:Tog.suspend") + + +;;; Attribute Documentation +;; +;; +;;;###autoload +(defun helm-describe-helm-attribute (helm-attribute) + "Display the full documentation of HELM-ATTRIBUTE. +HELM-ATTRIBUTE should be a symbol." + (interactive (list (intern + (completing-read + "Describe helm attribute: " + (mapcar 'symbol-name helm-attributes) + nil t)))) + (with-output-to-temp-buffer "*Help*" + (princ (get helm-attribute 'helm-attrdoc)))) + +(helm-document-attribute 'name "mandatory" + " The name of the source. It is also the heading which appears + above the list of matches from the source. Must be unique.") + +(helm-document-attribute 'header-name "optional" + " A function returning the display string of the header. Its + argument is the name of the source. This attribute is useful to + add an additional information with the source name.") + +(helm-document-attribute 'candidates "mandatory if candidates-in-buffer attribute is not provided" + " Specifies how to retrieve candidates from the source. It can + either be a variable name, a function called with no parameters + or the actual list of candidates. + + The list must be a list whose members are strings, symbols + or (DISPLAY . REAL) pairs. + + In case of (DISPLAY . REAL) pairs, the DISPLAY string is shown + in the Helm buffer, but the REAL one is used as action + argument when the candidate is selected. This allows a more + readable presentation for candidates which would otherwise be, + for example, too long or have a common part shared with other + candidates which can be safely replaced with an abbreviated + string for display purposes. + + Note that if the (DISPLAY . REAL) form is used then pattern + matching is done on the displayed string, not on the real + value. + + If the candidates have to be retrieved asynchronously (for + example, by an external command which takes a while to run) + then the function should start the external command + asynchronously and return the associated process object. + Helm will take care of managing the process (receiving the + output from it, killing it if necessary, etc.). The process + should return candidates matching the current pattern (see + variable `helm-pattern'.) + You should use instead `candidates-process' attribute for + async processes, a warning will popup when using async process + in a `candidates' attribute. + + Note that currently results from asynchronous sources appear + last in the helm buffer regardless of their position in + `helm-sources'.") + +(helm-document-attribute 'candidates-process + "Same as `candidates' attributes but for process function." + " You should use this attribute when using a function involving + an async process instead of `candidates'.") + +(helm-document-attribute 'action "mandatory if type attribute is not provided" + " It is a list of (DISPLAY . FUNCTION) pairs or FUNCTION. + FUNCTION is called with one parameter: the selected candidate. + + An action other than the default can be chosen from this list + of actions for the currently selected candidate (by default + with TAB). The DISPLAY string is shown in the completions + buffer and the FUNCTION is invoked when an action is + selected. The first action of the list is the default.") + +(helm-document-attribute 'coerce "optional" + " It's a function called with one argument: the selected + candidate. + + This function is intended for type convertion. In normal case, + the selected candidate (string) is passed to action + function. If coerce function is specified, it is called just + before action function. + + Example: converting string to symbol + (coerce . intern)") + +(helm-document-attribute 'type "optional if action attribute is provided" + " Indicates the type of the items the source returns. + + Merge attributes not specified in the source itself from + `helm-type-attributes'. + + This attribute is implemented by plug-in.") + +(helm-document-attribute 'init "optional" + " Function called with no parameters when helm is started. It + is useful for collecting current state information which can be + used to create the list of candidates later. + + For example, if a source needs to work with the current + directory then it can store its value here, because later + helm does its job in the minibuffer and in the + `helm-buffer' and the current directory can be different + there.") + +(helm-document-attribute 'match "optional" + " List of functions called with one parameter: a candidate. The + function should return non-nil if the candidate matches the + current pattern (see variable `helm-pattern'). + + This attribute allows the source to override the default + pattern matching based on `string-match'. It can be used, for + example, to implement a source for file names and do the + pattern matching on the basename of files, since it's more + likely one is typing part of the basename when searching for a + file, instead of some string anywhere else in its path. + + If the list contains more than one function then the list of + matching candidates from the source is constructed by appending + the results after invoking the first function on all the + potential candidates, then the next function, and so on. The + matching candidates supplied by the first function appear first + in the list of results and then results from the other + functions, respectively. + + This attribute has no effect for asynchronous sources (see + attribute `candidates'), since they perform pattern matching + themselves.") + +(helm-document-attribute 'candidate-transformer "optional" + " It's a function or a list of functions called with one argument + when the completion list from the source is built. The argument + is the list of candidates retrieved from the source. The + function should return a transformed list of candidates which + will be used for the actual completion. If it is a list of + functions, it calls each function sequentially. + + This can be used to transform or remove items from the list of + candidates. + + Note that `candidates' is run already, so the given transformer + function should also be able to handle candidates with (DISPLAY + . REAL) format.") + +(helm-document-attribute 'filtered-candidate-transformer "optional" + " It has the same format as `candidate-transformer', except the + function is called with two parameters: the candidate list and + the source. + + This transformer is run on the candidate list which is already + filtered by the current pattern. While `candidate-transformer' + is run only once, it is run every time the input pattern is + changed. + + It can be used to transform the candidate list dynamically, for + example, based on the current pattern. + + In some cases it may also be more efficent to perform candidate + transformation here, instead of with `candidate-transformer' + even if this transformation is done every time the pattern is + changed. For example, if a candidate set is very large then + `candidate-transformer' transforms every candidate while only + some of them will actually be dislpayed due to the limit + imposed by `helm-candidate-number-limit'. + + Note that `candidates' and `candidate-transformer' is run + already, so the given transformer function should also be able + to handle candidates with (DISPLAY . REAL) format. + + This option has no effect for asynchronous sources. (Not yet, + at least.") + +(helm-document-attribute 'action-transformer "optional" + " It's a function or a list of functions called with two + arguments when the action list from the source is + assembled. The first argument is the list of actions, the + second is the current selection. If it is a list of functions, + it calls each function sequentially. + + The function should return a transformed action list. + + This can be used to customize the list of actions based on the + currently selected candidate.") + +(helm-document-attribute 'pattern-transformer "optional" + " It's a function or a list of functions called with one argument + before computing matches. Its argument is `helm-pattern'. + Functions should return transformed `helm-pattern'. + + It is useful to change interpretation of `helm-pattern'.") + +(helm-document-attribute 'delayed "optional" + " Candidates from the source are shown only if the user stops + typing and is idle for `helm-idle-delay' seconds. + If a value is given to delayed attr, this value is used instead only + if it is > to `helm-idle-delay'.") + +(helm-document-attribute 'volatile "optional" + " Indicates the source assembles the candidate list dynamically, + so it shouldn't be cached within a single Helm + invocation. It is only applicable to synchronous sources, + because asynchronous sources are not cached.") + +(helm-document-attribute 'requires-pattern "optional" + " If present matches from the source are shown only if the + pattern is not empty. Optionally, it can have an integer + parameter specifying the required length of input which is + useful in case of sources with lots of candidates.") + +(helm-document-attribute 'persistent-action "optional" + " Can be a either a Function called with one parameter (the + selected candidate) or a cons cell where first element is this + same function and second element a symbol (e.g never-split) + that inform `helm-execute-persistent-action'to not split his + window to execute this persistent action.") + +(helm-document-attribute 'candidates-in-buffer "optional" + " Shortcut attribute for making and narrowing candidates using + buffers. This newly-introduced attribute prevents us from + forgetting to add volatile and match attributes. + + See docstring of `helm-candidates-in-buffer'. + + (candidates-in-buffer) is equivalent of three attributes: + (candidates . helm-candidates-in-buffer) + (volatile) + (match identity) + + (candidates-in-buffer . candidates-function) is equivalent of: + (candidates . candidates-function) + (volatile) + (match identity) + + This attribute is implemented by plug-in.") + +(helm-document-attribute 'search "optional" + " List of functions like `re-search-forward' or `search-forward'. + Buffer search function used by `helm-candidates-in-buffer'. + By default, `helm-candidates-in-buffer' uses + `re-search-forward'. This attribute is meant to be used with + (candidates . helm-candidates-in-buffer) or + (candidates-in-buffer) in short.") + +(helm-document-attribute 'get-line "optional" + " A function like `buffer-substring-no-properties' or `buffer-substring'. + This function converts point of line-beginning and point of line-end, + which represents a candidate computed by `helm-candidates-in-buffer'. + By default, `helm-candidates-in-buffer' uses + `buffer-substring-no-properties'.") + +(helm-document-attribute 'display-to-real "optional" + " Function called with one parameter; the selected candidate. + + The function transforms the selected candidate, and the result + is passed to the action function. The display-to-real + attribute provides another way to pass other string than one + shown in Helm buffer. + + Traditionally, it is possible to make candidates, + candidate-transformer or filtered-candidate-transformer + function return a list with (DISPLAY . REAL) pairs. But if REAL + can be generated from DISPLAY, display-to-real is more + convenient and faster.") + +(helm-document-attribute 'real-to-display "optional" + " Function called with one parameter; the selected candidate. + + The inverse of display-to-real attribute. + + The function transforms the selected candidate, which is passed + to the action function, for display. The real-to-display + attribute provides the other way to pass other string than one + shown in Helm buffer. + + Traditionally, it is possible to make candidates, + candidate-transformer or filtered-candidate-transformer + function return a list with (DISPLAY . REAL) pairs. But if + DISPLAY can be generated from REAL, real-to-display is more + convenient. + + Note that DISPLAY parts returned from candidates / + candidate-transformer are IGNORED as the name `display-to-real' + says.") + +(helm-document-attribute 'cleanup "optional" + " Function called with no parameters when *helm* buffer is + closed. It is useful for killing unneeded candidates buffer. + + Note that the function is executed BEFORE performing action.") + +(helm-document-attribute 'candidate-number-limit "optional" + " Override `helm-candidate-number-limit' only for this source.") + +(helm-document-attribute 'accept-empty "optional" + " Pass empty string \"\" to action function.") + +(helm-document-attribute 'dummy "optional" + " Set `helm-pattern' to candidate. If this attribute is + specified, The candidates attribute is ignored. + + This attribute is implemented by plug-in.") + +(helm-document-attribute 'multiline "optional" + " Enable to selection multiline candidates.") + +(helm-document-attribute 'update "optional" + (substitute-command-keys + " Function called with no parameters at before \"init\" function when \ +\\\\[helm-force-update] is pressed.")) + +(helm-document-attribute 'mode-line "optional" + " Source local `helm-mode-line-string' (included in + `mode-line-format'). It accepts also variable/function name.") + +(helm-document-attribute 'header-line "optional" + " Source local `header-line-format'. + It accepts also variable/function name. ") + +(helm-document-attribute + 'resume "optional" + " Function called with no parameters at end of initialization + when `helm-resume' is started. + If this function try to do something against `helm-buffer', \(e.g updating, + searching etc...\) probably you should run it in a timer to ensure + `helm-buffer' is ready.") + +(helm-document-attribute 'keymap "optional" + " Specific keymap for this source. + It is useful to have a keymap per source when using more than + one source. Otherwise, a keymap can be set per command with + `helm' argument KEYMAP. NOTE: when a source have `helm-map' as + keymap attr, the global value of `helm-map' will override the + actual local one.") + +(helm-document-attribute 'help-message "optional" + " Help message for this source. + If not present, `helm-help-message' value will be used.") + +(helm-document-attribute 'match-part "optional" + " Allow matching candidate in the line with `candidates-in-buffer'. + In candidates-in-buffer sources, match is done with + `re-search-forward' which allow matching only a regexp on the + `helm-buffer'; when this search is done, match-part allow + matching only a specific part of the current line e.g with a + line like this: + + filename:candidate-containing-the-word-filename + + What you want is to ignore \"filename\" part and match only + \"candidate-containing-the-word-filename\" + + So give a function matching only the part of candidate after \":\" + + If source contain match-part attribute, match is computed only + on part of candidate returned by the call of function provided + by this attribute. The function should have one arg, candidate, + and return only a specific part of candidate. + + NOTE: This have effect only on sources using + `candidates-in-buffer'.") + +(helm-document-attribute 'match-strict "optional" + " When specifying a match function within a source and + helm-match-plugin is enabled, the result of all matching + functions will be concatened, which in some cases is not what + is wanted. When using `match-strict' only this or these + functions will be used. You can specify those functions as a + list of functions or a single symbol function. For anonymous + function don't add the dot, e.g: + + \(match-strict (lambda () (foo))).") + +(helm-document-attribute 'nohighlight "optional" + " Disable highlight match in this source.") + +(helm-document-attribute 'no-matchplugin "optional" + " Disable matchplugin for this source.") + +(helm-document-attribute 'history "optional" + " Allow passing history variable to helm from source. + It should be a quoted symbol evaluated from source, i.e: + (history . ,'history-var)") + +(helm-document-attribute 'follow "optional" + " Enable `helm-follow-mode' for this source only. + You must give it a value of 1 or -1, though giving a -1 value + is surely not what you want, e.g: (follow . 1) + + See `helm-follow-mode' for more infos") + +(helm-document-attribute 'follow-delay "optional" + " `helm-follow-mode' will execute persistent-action after this delay. +Otherwise value of `helm-follow-input-idle-delay' is used if non--nil, +If none of these are found fallback to `helm-input-idle-delay'.") + +(helm-document-attribute 'allow-dups "optional" + " Allow helm collecting duplicates candidates.") + +(helm-document-attribute 'filter-one-by-one "optional" + " A transformer function that treat candidates one by one. + It is called with one arg the candidate. + It is faster than `filtered-candidate-transformer' or `candidates-transformer', + but should be used only in sources that recompute constantly their candidates, + e.g `helm-source-find-files'. + Filtering happen early and candidates are treated + one by one instead of re-looping on the whole list. + If used with `filtered-candidate-transformer' or `candidates-transformer' + these functions should treat the candidates transformed by the `filter-one-by-one' + function in consequence.") + +(helm-document-attribute 'nomark "optional" + " Don't allow marking candidates when this attribute is present.") + +(provide 'helm-help) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-help.el ends here diff --git a/elpa/helm-20150426.2119/helm-imenu.el b/elpa/helm-20150426.2119/helm-imenu.el new file mode 100644 index 00000000..2bf44c42 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-imenu.el @@ -0,0 +1,183 @@ +;;; helm-imenu.el --- Helm interface for Imenu -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'imenu) +(require 'helm-utils) +(require 'helm-help) + + +(defgroup helm-imenu nil + "Imenu related libraries and applications for helm." + :group 'helm) + +(defcustom helm-imenu-delimiter " / " + "Delimit types of candidates and his value in `helm-buffer'." + :group 'helm-imenu + :type 'string) + +(defcustom helm-imenu-execute-action-at-once-if-one t + "Goto the candidate when only one is remaining." + :group 'helm-imenu + :type 'boolean) + +(defcustom helm-imenu-lynx-style-map t + "Use Arrow keys to jump to occurences." + :group 'helm-imenu + :type 'boolean) + + +;;; keymap +(defvar helm-imenu-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c ?") 'helm-imenu-help) + (when helm-imenu-lynx-style-map + (define-key map (kbd "") 'helm-maybe-exit-minibuffer) + (define-key map (kbd "") 'helm-execute-persistent-action)) + (delq nil map))) + + +;;; Internals +(defvar helm-cached-imenu-alist nil) +(make-variable-buffer-local 'helm-cached-imenu-alist) + +(defvar helm-cached-imenu-candidates nil) +(make-variable-buffer-local 'helm-cached-imenu-candidates) + +(defvar helm-cached-imenu-tick nil) +(make-variable-buffer-local 'helm-cached-imenu-tick) + + +(defvar helm-source-imenu nil "See (info \"(emacs)Imenu\")") + +(defclass helm-imenu-source (helm-source-sync) + ((candidates :initform 'helm-imenu-candidates) + (candidate-transformer :initform 'helm-imenu-transformer) + (persistent-action :initform 'helm-imenu-persistent-action) + (persistent-help :initform "Show this entry") + (keymap :initform helm-imenu-map) + (mode-line :initform helm-imenu-mode-line) + (action :initform 'helm-imenu-action))) + +(defcustom helm-imenu-fuzzy-match nil + "Enable fuzzy matching in `helm-source-imenu'." + :group 'helm-imenu + :type 'boolean + :set (lambda (var val) + (set var val) + (setq helm-source-imenu + (helm-make-source "Imenu" 'helm-imenu-source + :fuzzy-match helm-imenu-fuzzy-match)))) + +(defun helm-imenu-action (candidate) + "Default action for `helm-source-imenu'." + (imenu candidate) + ;; If semantic is supported in this buffer + ;; imenu used `semantic-imenu-goto-function' + ;; and position have been highlighted, + ;; no need to highlight again. + (unless (eq imenu-default-goto-function + 'semantic-imenu-goto-function) + (helm-highlight-current-line nil nil nil nil 'pulse))) + +(defun helm-imenu-persistent-action (candidate) + "Default persistent action for `helm-source-imenu'." + (imenu candidate) + (helm-highlight-current-line)) + +(defun helm-imenu-candidates () + (with-helm-current-buffer + (let ((tick (buffer-modified-tick))) + (if (eq helm-cached-imenu-tick tick) + helm-cached-imenu-candidates + (setq imenu--index-alist nil) + (prog1 (setq helm-cached-imenu-candidates + (let ((index (imenu--make-index-alist))) + (helm-imenu--candidates-1 + (delete (assoc "*Rescan*" index) index)))) + (setq helm-cached-imenu-tick tick)))))) + +(defun helm-imenu--candidates-1 (alist) + (cl-loop for elm in alist + append (if (imenu--subalist-p elm) + (helm-imenu--candidates-1 + (cl-loop for (e . v) in (cdr elm) collect + (cons (propertize + e 'helm-imenu-type (car elm)) + v))) + (and (cdr elm) ; bug in imenu, should not be needed. + (list elm))))) + +(defun helm-imenu--get-prop (item) + ;; property value of ITEM can have itself + ;; a property value which have itself a property value + ;; ...and so on; Return a list of all these + ;; properties values starting at ITEM. + (let* ((prop (get-text-property 0 'helm-imenu-type item)) + (lst (list prop item))) + (when prop + (while prop + (setq prop (get-text-property 0 'helm-imenu-type prop)) + (and prop (push prop lst))) + lst))) + +(defun helm-imenu-transformer (candidates) + (cl-loop for (k . v) in candidates + for types = (or (helm-imenu--get-prop k) + (list "Function" k)) + collect + (cons (mapconcat (lambda (x) + (propertize + x 'face (cond ((string= x "Variables") + 'font-lock-variable-name-face) + ((string= x "Function") + 'font-lock-function-name-face) + ((string= x "Types") + 'font-lock-type-face)))) + types helm-imenu-delimiter) + (cons k v)))) + +;;;###autoload +(defun helm-imenu () + "Preconfigured `helm' for `imenu'." + (interactive) + (unless helm-source-imenu + (setq helm-source-imenu + (helm-make-source "Imenu" 'helm-imenu-source + :fuzzy-match helm-imenu-fuzzy-match))) + (let ((imenu-auto-rescan t) + (str (thing-at-point 'symbol)) + (helm-execute-action-at-once-if-one + helm-imenu-execute-action-at-once-if-one)) + (helm :sources 'helm-source-imenu + :default (list (concat "\\_<" str "\\_>") str) + :candidate-number-limit 9999 + :buffer "*helm imenu*"))) + +(provide 'helm-imenu) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-imenu.el ends here diff --git a/elpa/helm-20150426.2119/helm-info.el b/elpa/helm-20150426.2119/helm-info.el new file mode 100644 index 00000000..e38e64d3 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-info.el @@ -0,0 +1,183 @@ +;;; helm-info.el --- Browse info index with helm -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-plugin) + +(declare-function Info-index-nodes "info" (&optional file)) +(declare-function Info-goto-node "info" (&optional fork)) +(declare-function Info-find-node "info.el" (filename nodename &optional no-going-back)) +(defvar Info-history) + + +(defgroup helm-info nil + "Info related Applications and libraries for Helm." + :group 'helm) + +;;; Build info-index sources with `helm-info-source' class. +;; +;; +(cl-defun helm-info-init (&optional (file (helm-attr 'info-file))) + ;; Allow reinit candidate buffer when using edebug. + (helm-aif (and debug-on-error + (helm-candidate-buffer)) + (kill-buffer it)) + (unless (helm-candidate-buffer) + (save-window-excursion + (info file) + (let ((tobuf (helm-candidate-buffer 'global)) + (infobuf (current-buffer)) + Info-history + start end) + (cl-dolist (node (Info-index-nodes)) + (Info-goto-node node) + (goto-char (point-min)) + (while (search-forward "\n* " nil t) + (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t) + (setq start (point-at-bol) + end (point-at-eol)) + (with-current-buffer tobuf + (insert-buffer-substring infobuf start end) + (insert "\n"))))))))) + +(defun helm-info-goto (node-line) + (Info-goto-node (car node-line)) + (helm-goto-line (cdr node-line))) + +(defun helm-info-display-to-real (line) + (and (string-match + ;; This regexp is stolen from Info-apropos-matches + "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line) + (cons (format "(%s)%s" (helm-attr 'info-file) (match-string 2 line)) + (string-to-number (or (match-string 3 line) "1"))))) + +(defclass helm-info-source (helm-source-in-buffer) + ((info-file :initarg :info-file + :initform nil + :custom 'string) + (init :initform #'helm-info-init) + (display-to-real :initform #'helm-info-display-to-real) + (get-line :initform #'buffer-substring) + (action :initform '(("Goto node" . helm-info-goto))))) + +(defmacro helm-build-info-source (fname &rest args) + `(helm-make-source (concat "Info Index: " ,fname) 'helm-info-source + :info-file ,fname ,@args)) + +(defun helm-build-info-index-command (name doc source buffer) + "Define an helm command NAME with documentation DOC. +Arg SOURCE will be an existing helm source named +`helm-source-info-' and BUFFER a string buffer name." + (defalias (intern (concat "helm-info-" name)) + (lambda () + (interactive) + (helm :sources source + :buffer buffer + :candidate-number-limit 1000)) + doc)) + +(defun helm-define-info-index-sources (var-value &optional commands) + "Define helm sources named helm-source-info-. +Sources are generated for all entries of `helm-default-info-index-list'. +If COMMANDS arg is non--nil build also commands named `helm-info'. +Where NAME is one of `helm-default-info-index-list'." + (cl-loop for str in var-value + for sym = (intern (concat "helm-source-info-" str)) + do (set sym (helm-build-info-source str)) + when commands + do (helm-build-info-index-command + str (format "Predefined helm for %s info." str) + sym (format "*helm info %s*" str)))) + +(defun helm-info-index-set (var value) + (set var value) + (helm-define-info-index-sources value t)) + +(defcustom helm-default-info-index-list + '("elisp" "cl" "org" "gnus" "tramp" "ratpoison" + "zsh" "bash" "coreutils" "fileutils" + "find" "sh-utils" "textutils" "libc" + "make" "automake" "autoconf" "eintr" + "emacs" "elib" "eieio" "gauche-refe" "guile" + "guile-tut" "goops" "screen" "latex" "gawk" + "sed" "m4" "wget" "binutils" "as" "bfd" "gprof" + "ld" "diff" "flex" "grep" "gzip" "libtool" + "texinfo" "info" "gdb" "stabs" "cvsbook" "cvs" + "bison" "id-utils" "global") + "Info Manual entries to use for building helm info index commands." + :group 'helm-info + :type '(repeat (choice string)) + :set 'helm-info-index-set) + +(defcustom helm-info-default-sources + '(helm-source-info-elisp + helm-source-info-cl + helm-source-info-eieio + helm-source-info-pages) + "The default sources to use in `helm-info-at-point'." + :group 'helm-info + :type '(repeat (choice symbol))) + + +;;; Info pages +(defvar helm-info--pages-cache nil + "Cache for all info pages on system.") + +(defun helm-info-pages-init () + "Collect candidates for initial Info node Top." + (if helm-info--pages-cache + helm-info--pages-cache + (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.") + topics) + (require 'info) + (with-temp-buffer + (Info-find-node "dir" "top") + (goto-char (point-min)) + (while (re-search-forward info-topic-regexp nil t) + (push (match-string-no-properties 1) topics)) + (kill-buffer)) + (setq helm-info--pages-cache topics)))) + +(defvar helm-source-info-pages + (helm-build-sync-source "Info Pages" + :init #'helm-info-pages-init + :candidates (lambda () helm-info--pages-cache) + :action '(("Show with Info" .(lambda (node-str) + (info (replace-regexp-in-string + "^[^:]+: " "" node-str))))) + :requires-pattern 2)) + +;;;###autoload +(defun helm-info-at-point () + "Preconfigured `helm' for searching info at point. +With a prefix-arg insert symbol at point." + (interactive) + (helm :sources helm-info-default-sources + :buffer "*helm info*")) + +(provide 'helm-info) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-info.el ends here diff --git a/elpa/helm-20150426.2119/helm-locate.el b/elpa/helm-20150426.2119/helm-locate.el new file mode 100644 index 00000000..2c50ea64 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-locate.el @@ -0,0 +1,345 @@ +;;; helm-locate.el --- helm interface for locate. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;; NOTE for WINDOZE users: +;; You have to install Everything with his command line interface here: +;; http://www.voidtools.com/download.php + +;;; Code: + +(require 'cl-lib) +(require 'helm) + + +(defgroup helm-locate nil + "Locate related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-locate-db-file-regexp "m?locate\.db$" + "Default regexp to match locate database. +If nil Search in all files." + :type 'string + :group 'helm-locate) + +(defcustom helm-ff-locate-db-filename "locate.db" + "The basename of the locatedb file you use locally in your directories. +When this is set and `helm' find such a file in the directory from +where you launch locate, it will use this file and will not prompt you +for a db file. +Note that this happen only when locate is launched with a prefix arg." + :group 'helm-locate + :type 'string) + +(defcustom helm-locate-command nil + "A list of arguments for locate program. +Normally you should not have to modify this yourself. + +If nil it will be calculated when `helm-locate' startup +with these default values for different systems: + +Gnu/linux: \"locate %s -e -A %s\" +berkeley-unix: \"locate %s %s\" +windows-nt: \"es %s %s\" +Others: \"locate %s %s\" + +This string will be passed to format so it should end with `%s'. +The first format spec is used for the \"-i\" value of locate/es, +So don't set it directly but use `helm-locate-case-fold-search' +for this. +The \"-r\" option must be the last option, however if not specified you will +be able to specify it during helm invocation by prefixing the pattern +you enter with \"-r\"." + :type 'string + :group 'helm-locate) + +(defcustom helm-locate-create-db-command + "updatedb -l 0 -o %s -U %s" + "Command used to create a locale locate db file." + :type 'string + :group 'helm-locate) + +(defcustom helm-locate-case-fold-search helm-case-fold-search + "It have the same meaning as `helm-case-fold-search'. +The -i option of locate will be used depending of value of +`helm-pattern' when this is set to 'smart. +When nil \"-i\" will not be used at all. +and when non--nil it will always be used. +NOTE: the -i option of the \"es\" command used on windows does +the opposite of \"locate\" command." + :group 'helm-locate + :type 'symbol) + +(defcustom helm-locate-fuzzy-match nil + "Enable fuzzy matching in `helm-locate'." + :group 'helm-locate + :type 'boolean) + + +(defvar helm-generic-files-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-]") 'helm-ff-run-toggle-basename) + (define-key map (kbd "C-s") 'helm-ff-run-grep) + (define-key map (kbd "M-g s") 'helm-ff-run-grep) + (define-key map (kbd "M-g z") 'helm-ff-run-zgrep) + (define-key map (kbd "M-g p") 'helm-ff-run-pdfgrep) + (define-key map (kbd "M-D") 'helm-ff-run-delete-file) + (define-key map (kbd "C-=") 'helm-ff-run-ediff-file) + (define-key map (kbd "C-c =") 'helm-ff-run-ediff-merge-file) + (define-key map (kbd "C-c o") 'helm-ff-run-switch-other-window) + (define-key map (kbd "C-c C-o") 'helm-ff-run-switch-other-frame) + (define-key map (kbd "M-i") 'helm-ff-properties-persistent) + (define-key map (kbd "C-c C-x") 'helm-ff-run-open-file-externally) + (define-key map (kbd "C-c X") 'helm-ff-run-open-file-with-default-tool) + (define-key map (kbd "M-.") 'helm-ff-run-etags) + (define-key map (kbd "C-w") 'helm-yank-text-at-point) + (define-key map (kbd "C-c @") 'helm-ff-run-insert-org-link) + (define-key map (kbd "C-c ?") 'helm-generic-file-help) + map) + "Generic Keymap for files.") + + +(defface helm-locate-finish + '((t (:foreground "Green"))) + "Face used in mode line when locate process is finish." + :group 'helm-locate) + + +(defun helm-ff-find-locatedb (&optional from-ff) + "Try to find if a local locatedb file is available. +The search is done in `helm-ff-default-directory' or +fall back to `default-directory' if FROM-FF is nil." + (when helm-ff-locate-db-filename + (cond ((and helm-ff-default-directory + from-ff + (file-exists-p (expand-file-name + helm-ff-locate-db-filename + helm-ff-default-directory)) + (expand-file-name + helm-ff-locate-db-filename + helm-ff-default-directory))) + ((and (not from-ff) + (file-exists-p (expand-file-name + helm-ff-locate-db-filename + default-directory)) + (expand-file-name + helm-ff-locate-db-filename + default-directory)))))) + +(defun helm-locate-1 (&optional localdb init from-ff default) + "Generic function to run Locate. +Prefix arg LOCALDB when (4) search and use a local locate db file when it +exists or create it, when (16) force update of existing db file +even if exists. +It have no effect when locate command is 'es'. +INIT is a string to use as initial input in prompt. +See `helm-locate-with-db' and `helm-locate'." + (require 'helm-mode) + (helm-locate-set-command) + (let ((pfn #'(lambda (candidate) + (if (file-directory-p candidate) + (message "Error: The locate Db should be a file") + (if (= (shell-command + (format helm-locate-create-db-command + candidate + helm-ff-default-directory)) + 0) + (message "New locatedb file `%s' created" candidate) + (error "Failed to create locatedb file `%s'" candidate))))) + (locdb (and localdb + (not (string-match "^es" helm-locate-command)) + (or (and (equal '(4) localdb) + (helm-ff-find-locatedb from-ff)) + (helm-read-file-name + "Create Locate Db file: " + :initial-input (expand-file-name "locate.db" + (or helm-ff-default-directory + default-directory)) + :preselect helm-locate-db-file-regexp + :test #'(lambda (x) + (if helm-locate-db-file-regexp + ;; Select only locate db files and directories + ;; to allow navigation. + (or (string-match + helm-locate-db-file-regexp x) + (file-directory-p x)) + x))))))) + (when (and locdb (or (equal localdb '(16)) + (not (file-exists-p locdb)))) + (funcall pfn locdb)) + (helm-locate-with-db (and localdb locdb) init default))) + +(defun helm-locate-set-command () + "Setup `helm-locate-command' if not already defined." + (unless helm-locate-command + (setq helm-locate-command + (cl-case system-type + (gnu/linux "locate %s -e -r %s") + (berkeley-unix "locate %s %s") + (windows-nt "es %s %s") + (t "locate %s %s"))))) + +(defvar helm-file-name-history nil) +(defun helm-locate-with-db (&optional db initial-input default) + "Run locate -d DB. +If DB is not given or nil use locate without -d option. +Argument DB can be given as a string or list of db files. +Argument INITIAL-INPUT is a string to use as initial-input. +See also `helm-locate'." + (when (and db (stringp db)) (setq db (list db))) + (helm-locate-set-command) + (let ((helm-ff-transformer-show-only-basename nil) + (helm-locate-command + (if db + (replace-regexp-in-string + "locate" + (format "locate -d %s" + (mapconcat 'identity + ;; Remove eventually + ;; marked directories by error. + (cl-loop for i in db + unless (file-directory-p i) + collect i) ":")) + helm-locate-command) + helm-locate-command))) + (setq helm-file-name-history (mapcar 'helm-basename file-name-history)) + (helm :sources 'helm-source-locate + :buffer "*helm locate*" + :input initial-input + :default default + :history 'helm-file-name-history))) + +(defun helm-locate-init () + "Initialize async locate process for `helm-source-locate'." + (let* ((locate-is-es (string-match "\\`es" helm-locate-command)) + (real-locate (string-match "\\`locate" helm-locate-command)) + (case-sensitive-flag (if locate-is-es "-i" "")) + (ignore-case-flag (if (or locate-is-es + (not real-locate)) "" "-i")) + (args (split-string helm-pattern " ")) + (cmd (format helm-locate-command + (cl-case helm-locate-case-fold-search + (smart (let ((case-fold-search nil)) + (if (string-match "[[:upper:]]" helm-pattern) + case-sensitive-flag + ignore-case-flag))) + (t (if helm-locate-case-fold-search + ignore-case-flag + case-sensitive-flag))) + (concat + ;; The pattern itself. + (shell-quote-argument (car args)) " " + ;; Possible locate args added + ;; after pattern, don't quote them. + (mapconcat 'identity (cdr args) " "))))) + (helm-log "Starting helm-locate process") + (helm-log "Command line used was:\n\n%s" + (concat ">>> " (propertize cmd 'face 'font-lock-comment-face) "\n\n")) + (prog1 + (start-process-shell-command + "locate-process" helm-buffer + cmd) + (set-process-sentinel + (get-buffer-process helm-buffer) + #'(lambda (_process event) + (if (string= event "finished\n") + (with-helm-window + (setq mode-line-format + '(" " mode-line-buffer-identification " " + (:eval (format "L%s" (helm-candidate-number-at-point))) " " + (:eval (propertize + (format "[Locate process finished - (%s results)]" + (max (1- (count-lines + (point-min) (point-max))) + 0)) + 'face 'helm-locate-finish)))) + (force-mode-line-update)) + (helm-log "Error: Locate %s" + (replace-regexp-in-string "\n" "" event)))))))) + +(defclass helm-locate-source (helm-source-async helm-type-file) + ((init :initform 'helm-locate-set-command) + (candidates-process :initform 'helm-locate-init) + (requires-pattern :initform 3) + (history :initform 'helm-file-name-history) + (keymap :initform helm-generic-files-map) + (help-message :initform helm-generic-file-help-message) + (candidate-number-limit :initform 9999) + (mode-line :initform helm-generic-file-mode-line-string))) + +(defvar helm-source-locate + (helm-make-source "Locate" 'helm-locate-source + :pattern-transformer 'helm-locate-pattern-transformer)) + +(defun helm-locate-pattern-transformer (pattern) + (if helm-locate-fuzzy-match + (cond ((string-match + " " (replace-regexp-in-string " -b" "" pattern)) pattern) + ((string-match "\\([^ ]*\\) -b" pattern) + (concat (helm--mapconcat-pattern + (match-string 1 pattern)) " -b")) + (t (helm--mapconcat-pattern pattern))) + pattern)) + +;;;###autoload +(defun helm-locate-read-file-name (prompt) + (let* (helm-ff-transformer-show-only-basename + (src `((name . "Locate read fname") + (init . helm-locate-set-command) + (candidates-process . helm-locate-init) + (action . identity) + (requires-pattern . 3) + (history . ,'helm-file-name-history) + (candidate-transformer . (helm-skip-boring-files + helm-highlight-files)) + (candidate-number-limit . 9999) + (no-matchplugin)))) + (or (helm :sources src + :prompt prompt + :buffer "*helm locate read fname*" + :resume 'noresume) + (keyboard-quit)))) + +;;;###autoload +(defun helm-locate (arg) + "Preconfigured `helm' for Locate. +Note: you can add locate options after entering pattern. +See 'man locate' for valid options and also `helm-locate-command'. + +You can specify a local database with prefix argument ARG. +With two prefix arg, refresh the current local db or create it +if it doesn't exists. +Many databases can be used: navigate and mark them. +See also `helm-locate-with-db'. + +To create a user specific db, use +\"updatedb -l 0 -o db_path -U directory\". +Where db_path is a filename matched by +`helm-locate-db-file-regexp'." + (interactive "P") + (setq helm-ff-default-directory default-directory) + (helm-locate-1 arg)) + +(provide 'helm-locate) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-locate.el ends here diff --git a/elpa/helm-20150426.2119/helm-man.el b/elpa/helm-20150426.2119/helm-man.el new file mode 100644 index 00000000..cdf7c2aa --- /dev/null +++ b/elpa/helm-20150426.2119/helm-man.el @@ -0,0 +1,102 @@ +;;; helm-man.el --- Man and woman UI -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) + +(declare-function woman-file-name-all-completions "woman.el" (topic)) +(declare-function Man-getpage-in-background "man.el" (topic)) +(declare-function helm-generic-sort-fn "helm-utils.el" (S1 S2)) + +(defgroup helm-man nil + "Man and Woman applications for helm." + :group 'helm) + +(defcustom helm-man-or-woman-function 'Man-getpage-in-background + "Default command to display a man page." + :group 'helm-man + :type '(radio :tag "Preferred command to display a man page" + (const :tag "Man" Man-getpage-in-background) + (const :tag "Woman" woman))) + +;; Internal +(defvar helm-man-pages nil + "All man pages on system. +Will be calculated the first time you invoke helm with this +source.") + +(defun helm-man-default-action (candidate) + "Default action for jumping to a woman or man page from helm." + (let ((wfiles (mapcar + 'car (woman-file-name-all-completions candidate)))) + (condition-case nil + (if (> (length wfiles) 1) + (let ((file (helm-comp-read + "ManFile: " wfiles :must-match t))) + (if (eq helm-man-or-woman-function 'Man-getpage-in-background) + (manual-entry (format "-l %s" file)) + (woman-find-file file))) + (funcall helm-man-or-woman-function candidate)) + ;; If woman is unable to format correctly + ;; use man instead. + (error (kill-buffer) ; Kill woman buffer. + (Man-getpage-in-background candidate))))) + +(defvar helm-source-man-pages + '((name . "Manual Pages") + (init . (lambda () + (require 'woman) + (require 'helm-utils) + (unless helm-man-pages + (setq helm-man-pages + (ignore-errors + (woman-file-name "" t) + (sort (mapcar 'car woman-topic-all-completions) + 'string-lessp)))) + (helm-init-candidates-in-buffer 'global helm-man-pages))) + (candidates-in-buffer) + (persistent-action . ignore) + (filtered-candidate-transformer + . (lambda (candidates _source) + (sort candidates #'helm-generic-sort-fn))) + (action . (("Display Man page" . helm-man-default-action))) + ;; Woman does not work OS X + ;; http://xahlee.org/emacs/modernization_man_page.html + (action-transformer . (lambda (actions candidate) + (if (eq system-type 'darwin) + '(("Display Man page" . man)) + actions))))) + +;;;###autoload +(defun helm-man-woman (arg) + "Preconfigured `helm' for Man and Woman pages. +With a prefix arg reinitialize the cache." + (interactive "P") + (when arg (setq helm-man-pages nil)) + (helm-other-buffer 'helm-source-man-pages "*Helm man woman*")) + +(provide 'helm-man) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-man.el ends here diff --git a/elpa/helm-20150426.2119/helm-match-plugin.el b/elpa/helm-20150426.2119/helm-match-plugin.el new file mode 100644 index 00000000..c95bfb50 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-match-plugin.el @@ -0,0 +1,331 @@ +;;; helm-match-plugin.el --- Multiple regexp matching methods for helm -*- lexical-binding: t -*- + +;; Original Author: rubikitch + +;; Copyright (C) 2008 ~ 2011 rubikitch +;; Copyright (C) 2011 ~ 2015 Thierry Volpiatto + +;; Author: Thierry Volpiatto +;; URL: http://github.com/emacs-helm/helm + +;; 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 . + +;;; Code: + +(require 'helm) +(require 'cl-lib) + + +(defgroup helm-match-plugin nil + "Helm match plugin." + :group 'helm) + +(defcustom helm-mp-matching-method 'multi3 + "Matching method for helm match plugin. +You can set here different methods to match candidates in helm. +Here are the possible value of this symbol and their meaning: +- multi1: Respect order, prefix of pattern must match. +- multi2: Same but with partial match. +- multi3: The best, multiple regexp match, allow negation. +- multi3p: Same but prefix must match. +Default is multi3." + :type '(radio :tag "Matching methods for helm" + (const :tag "Multiple regexp 1 ordered with prefix match" multi1) + (const :tag "Multiple regexp 2 ordered with partial match" multi2) + (const :tag "Multiple regexp 3 matching no order, partial, best." multi3) + (const :tag "Multiple regexp 3p matching with prefix match" multi3p)) + :group 'helm-match-plugin) + + +;; Internal +(defconst helm-mp-default-match-functions + '(helm-mp-exact-match helm-mp-match)) +(defconst helm-mp-default-search-functions + '(helm-mp-exact-search helm-mp-search)) + + +;;; Build regexps +;; +;; +(defvar helm-mp-space-regexp "[\\ ] " + "Regexp to represent space itself in multiple regexp match.") + +(defun helm-mp-split-pattern (pattern) + "Split PATTERN if it contain spaces and return resulting list. +If spaces in PATTERN are escaped, don't split at this place. +i.e \"foo bar\"=> (\"foo\" \"bar\") +but \"foo\ bar\"=> (\"foobar\")." + (if (string= pattern "") + '("") + (cl-loop for s in (split-string + (replace-regexp-in-string helm-mp-space-regexp + "\000\000" pattern) + " " t) + collect (replace-regexp-in-string "\000\000" " " s)))) + +(defun helm-mp-1-make-regexp (pattern) + "Replace spaces in PATTERN with \"\.*\"." + (mapconcat 'identity (helm-mp-split-pattern pattern) ".*")) + + +;;; Exact match. +;; +;; +;; Internal. +(defvar helm-mp-exact-pattern-str nil) +(defvar helm-mp-exact-pattern-real nil) + +(defun helm-mp-exact-get-pattern (pattern) + (unless (equal pattern helm-mp-exact-pattern-str) + (setq helm-mp-exact-pattern-str pattern + helm-mp-exact-pattern-real (concat "\n" pattern "\n"))) + helm-mp-exact-pattern-real) + + +(defun helm-mp-exact-match (str &optional pattern) + (string= str (or pattern helm-pattern))) + +(defun helm-mp-exact-search (pattern &rest _ignore) + (and (search-forward (helm-mp-exact-get-pattern pattern) nil t) + (forward-line -1))) + + +;;; Prefix match +;; +;; +;; Internal +(defvar helm-mp-prefix-pattern-str nil) +(defvar helm-mp-prefix-pattern-real nil) + +(defun helm-mp-prefix-get-pattern (pattern) + (unless (equal pattern helm-mp-prefix-pattern-str) + (setq helm-mp-prefix-pattern-str pattern + helm-mp-prefix-pattern-real (concat "\n" pattern))) + helm-mp-prefix-pattern-real) + +(defun helm-mp-prefix-match (str &optional pattern) + (setq pattern (or pattern helm-pattern)) + (let ((len (length pattern))) + (and (<= len (length str)) + (string= (substring str 0 len) pattern )))) + +(defun helm-mp-prefix-search (pattern &rest _ignore) + (search-forward (helm-mp-prefix-get-pattern pattern) nil t)) + + +;;; Multiple regexp patterns 1 (order is preserved / prefix). +;; +;; +;; Internal +(defvar helm-mp-1-pattern-str nil) +(defvar helm-mp-1-pattern-real nil) + +(defun helm-mp-1-get-pattern (pattern) + (unless (equal pattern helm-mp-1-pattern-str) + (setq helm-mp-1-pattern-str pattern + helm-mp-1-pattern-real + (concat "^" (helm-mp-1-make-regexp pattern)))) + helm-mp-1-pattern-real) + +(cl-defun helm-mp-1-match (str &optional (pattern helm-pattern)) + (string-match (helm-mp-1-get-pattern pattern) str)) + +(defun helm-mp-1-search (pattern &rest _ignore) + (re-search-forward (helm-mp-1-get-pattern pattern) nil t)) + + +;;; Multiple regexp patterns 2 (order is preserved / partial). +;; +;; +;; Internal +(defvar helm-mp-2-pattern-str nil) +(defvar helm-mp-2-pattern-real nil) + +(defun helm-mp-2-get-pattern (pattern) + (unless (equal pattern helm-mp-2-pattern-str) + (setq helm-mp-2-pattern-str pattern + helm-mp-2-pattern-real + (concat "^.*" (helm-mp-1-make-regexp pattern)))) + helm-mp-2-pattern-real) + +(cl-defun helm-mp-2-match (str &optional (pattern helm-pattern)) + (string-match (helm-mp-2-get-pattern pattern) str)) + +(defun helm-mp-2-search (pattern &rest _ignore) + (re-search-forward (helm-mp-2-get-pattern pattern) nil t)) + + +;;; Multiple regexp patterns 3 (permutation). +;; +;; +;; Internal +(defvar helm-mp-3-pattern-str nil) +(defvar helm-mp-3-pattern-list nil) + +(defun helm-mp-3-get-patterns (pattern) + "Return `helm-mp-3-pattern-list', a list of predicate/regexp cons cells. +e.g ((identity . \"foo\") (identity . \"bar\")). +This is done only if `helm-mp-3-pattern-str' is same as PATTERN." + (unless (equal pattern helm-mp-3-pattern-str) + (setq helm-mp-3-pattern-str pattern + helm-mp-3-pattern-list + (helm-mp-3-get-patterns-internal pattern))) + helm-mp-3-pattern-list) + +(defun helm-mp-3-get-patterns-internal (pattern) + "Return a list of predicate/regexp cons cells. +e.g ((identity . \"foo\") (identity . \"bar\"))." + (unless (string= pattern "") + (cl-loop for pat in (helm-mp-split-pattern pattern) + collect (if (string= "!" (substring pat 0 1)) + (cons 'not (substring pat 1)) + (cons 'identity pat))))) + +(cl-defun helm-mp-3-match (str &optional (pattern helm-pattern)) + "Check if PATTERN match STR. +When PATTERN contain a space, it is splitted and matching is done +with the several resulting regexps against STR. +e.g \"bar foo\" will match \"foobar\" and \"barfoo\". +Argument PATTERN, a string, is transformed in a list of +cons cell with `helm-mp-3-get-patterns' if it contain a space. +e.g \"foo bar\"=>((identity . \"foo\") (identity . \"bar\")). +Then each predicate of cons cell(s) is called with regexp of same +cons cell against STR (a candidate). +i.e (identity (string-match \"foo\" \"foo bar\")) => t." + (let ((pat (helm-mp-3-get-patterns pattern))) + (cl-loop for (predicate . regexp) in pat + always (funcall predicate + (condition-case _err + ;; FIXME: Probably do nothing when + ;; using fuzzy leaving the job + ;; to the fuzzy fn. + (string-match regexp str) + (invalid-regexp nil)))))) + +(defun helm-mp-3-search-base (pattern searchfn1 searchfn2) + "Try to find PATTERN in `helm-buffer' with SEARCHFN1 and SEARCHFN2. +This is the search function for `candidates-in-buffer' enabled sources. +Use the same method as `helm-mp-3-match' except it search in buffer +instead of matching on a string. +i.e (identity (re-search-forward \"foo\" (point-at-eol) t)) => t." + (cl-loop with pat = (if (stringp pattern) + (helm-mp-3-get-patterns pattern) + pattern) + when (eq (caar pat) 'not) return + ;; Pass the job to `helm-search-match-part'. + (prog1 (list (point-at-bol) (point-at-eol)) + (forward-line 1)) + while (condition-case _err + (funcall searchfn1 (or (cdar pat) "") nil t) + (invalid-regexp nil)) + for bol = (point-at-bol) + for eol = (point-at-eol) + if (cl-loop for (pred . str) in (cdr pat) always + (progn (goto-char bol) + (funcall pred (condition-case _err + (funcall searchfn2 str eol t) + (invalid-regexp nil))))) + do (goto-char eol) and return t + else do (goto-char eol) + finally return nil)) + +(defun helm-mp-3-search (pattern &rest _ignore) + (when (stringp pattern) + (setq pattern (helm-mp-3-get-patterns pattern))) + (helm-mp-3-search-base + pattern 're-search-forward 're-search-forward)) + + +;;; mp-3p- (multiple regexp pattern 3 with prefix search) +;; +;; +(defun helm-mp-3p-match (str &optional pattern) + "Check if PATTERN match STR. +Same as `helm-mp-3-match' but more strict, matching against prefix also. +e.g \"bar foo\" will match \"barfoo\" but not \"foobar\" contrarily to +`helm-mp-3-match'." + (let* ((pat (helm-mp-3-get-patterns (or pattern helm-pattern))) + (first (car pat))) + (and (funcall (car first) (helm-mp-prefix-match str (cdr first))) + (cl-loop for (predicate . regexp) in (cdr pat) + always (funcall predicate (string-match regexp str)))))) + +(defun helm-mp-3p-search (pattern &rest _ignore) + (when (stringp pattern) + (setq pattern (helm-mp-3-get-patterns pattern))) + (helm-mp-3-search-base + pattern 'helm-mp-prefix-search 're-search-forward)) + + +;;; Generic multi-match/search functions +;; +;; +(cl-defun helm-mp-match (str &optional (pattern helm-pattern)) + (let ((fun (cl-ecase helm-mp-matching-method + (multi1 #'helm-mp-1-match) + (multi2 #'helm-mp-2-match) + (multi3 #'helm-mp-3-match) + (multi3p #'helm-mp-3p-match)))) + (funcall fun str pattern))) + +(defun helm-mp-search (pattern &rest _ignore) + (let ((fun (cl-ecase helm-mp-matching-method + (multi1 #'helm-mp-1-search) + (multi2 #'helm-mp-2-search) + (multi3 #'helm-mp-3-search) + (multi3p #'helm-mp-3p-search)))) + (funcall fun pattern))) + + +;;; source compiler +;; This is used only in old sources defined without helm-source. +;; +(defun helm-compile-source--match-plugin (source) + (if (assoc 'no-matchplugin source) + source + (let* ((searchers helm-mp-default-search-functions) + (defmatch (helm-aif (assoc-default 'match source) + (helm-mklist it))) + (defmatch-strict (helm-aif (assoc-default 'match-strict source) + (helm-mklist it))) + (defsearch (helm-aif (assoc-default 'search source) + (helm-mklist it))) + (defsearch-strict (helm-aif (assoc-default 'search-strict source) + (helm-mklist it))) + (matchfns (cond (defmatch-strict) + (defmatch + (append helm-mp-default-match-functions defmatch)) + (t helm-mp-default-match-functions))) + (searchfns (cond (defsearch-strict) + (defsearch + (append searchers defsearch)) + (t searchers)))) + `(,(if (assoc 'candidates-in-buffer source) + `(search ,@searchfns) `(match ,@matchfns)) + ,@source)))) + + +;; Enable match-plugin by default in old sources. +(add-to-list 'helm-compile-source-functions 'helm-compile-source--match-plugin) + +(provide 'helm-match-plugin) + + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-match-plugin.el ends here diff --git a/elpa/helm-20150426.2119/helm-misc.el b/elpa/helm-20150426.2119/helm-misc.el new file mode 100644 index 00000000..88fee5f3 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-misc.el @@ -0,0 +1,330 @@ +;;; helm-misc.el --- Various functions for helm -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: +(require 'cl-lib) +(require 'helm) + + +(defgroup helm-misc nil + "Various Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-time-zone-home-location "Paris" + "The time zone of your home" + :group 'helm-misc + :type 'string) + +(defcustom helm-mini-default-sources '(helm-source-buffers-list + helm-source-recentf + helm-source-buffer-not-found) + "Default sources list used in `helm-mini'." + :group 'helm-misc + :type '(repeat (choice symbol))) + +(defface helm-time-zone-current + '((t (:foreground "green"))) + "Face used to colorize current time in `helm-world-time'." + :group 'helm-misc) + +(defface helm-time-zone-home + '((t (:foreground "red"))) + "Face used to colorize home time in `helm-world-time'." + :group 'helm-misc) + + +;;; Latex completion +(defvar LaTeX-math-menu) +(defun helm-latex-math-candidates () + "Collect candidates for latex math completion." + (cl-loop for i in (cddr LaTeX-math-menu) + for elm = (cl-loop for s in i when (vectorp s) + collect (cons (aref s 0) (aref s 1))) + append elm)) + +(defvar helm-source-latex-math + '((name . "Latex Math Menu") + (init . (lambda () + (with-helm-current-buffer + (LaTeX-math-mode 1)))) + (candidate-number-limit . 9999) + (candidates . helm-latex-math-candidates) + (action . (lambda (candidate) + (call-interactively candidate))))) + + +;;; Jabber Contacts (jabber.el) +(defun helm-jabber-online-contacts () + "List online Jabber contacts." + (with-no-warnings + (cl-loop for item in (jabber-concat-rosters) + when (get item 'connected) + collect + (if (get item 'name) + (cons (get item 'name) item) + (cons (symbol-name item) item))))) + +(defvar helm-source-jabber-contacts + '((name . "Jabber Contacts") + (init . (lambda () (require 'jabber))) + (candidates . (lambda () (mapcar 'car (helm-jabber-online-contacts)))) + (action . (lambda (x) + (jabber-chat-with + (jabber-read-account) + (symbol-name + (cdr (assoc x (helm-jabber-online-contacts))))))))) + +;;; World time +;; +(defun helm-time-zone-transformer (candidates _source) + (cl-loop for i in candidates + collect + (cond ((string-match (format-time-string "%H:%M" (current-time)) i) + (propertize i 'face 'helm-time-zone-current)) + ((string-match helm-time-zone-home-location i) + (propertize i 'face 'helm-time-zone-home)) + (t i)))) + +(defvar helm-source-time-world + '((name . "Time World List") + (init . (lambda () + (require 'time) + (let ((helm-buffer (helm-candidate-buffer 'global))) + (with-current-buffer helm-buffer + (display-time-world-display display-time-world-list))))) + (candidates-in-buffer) + (filtered-candidate-transformer . helm-time-zone-transformer))) + +;;; LaCarte +;; +;; +(declare-function lacarte-get-overall-menu-item-alist "ext:lacarte.el" (&optional MAPS)) + +(defun helm-lacarte-candidate-transformer (cands) + (mapcar (lambda (cand) + (let* ((item (car cand)) + (match (string-match "[^>] \\((.*)\\)$" item))) + (when match + (put-text-property (match-beginning 1) (match-end 1) + 'face 'helm-M-x-key item)) + cand)) + cands)) + +(defclass helm-lacarte (helm-source-sync helm-type-command) + ((init :initform (lambda () (require 'lacarte))) + (candidates :initform 'helm-lacarte-get-candidates) + (candidate-transformer :initform 'helm-lacarte-candidate-transformer) + (candidate-number-limit :initform 9999))) + +(defun helm-lacarte-get-candidates (&optional maps) + "Extract candidates for menubar using lacarte.el. +See http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el. +Optional argument MAPS is a list specifying which keymaps to use: it +can contain the symbols `local', `global', and `minor', mean the +current local map, current global map, and all current minor maps." + (with-helm-current-buffer + ;; FIXME: do we still need to remove possible '(nil) candidates. + (lacarte-get-overall-menu-item-alist maps))) + +;;;###autoload +(defun helm-browse-menubar () + "Helm interface to the menubar using lacarte.el." + (interactive) + (require 'lacarte) + (helm :sources (mapcar + (lambda (spec) (helm-make-source (car spec) 'helm-lacarte + :candidates (lambda () (helm-lacarte-get-candidates (cdr spec))))) + '(("Major Mode" . (local)) + ("Minor Modes" . (minor)) + ("Global Map" . (global)))) + :buffer "*helm lacarte*")) + +(defun helm-call-interactively (cmd-or-name) + "Execute CMD-OR-NAME as Emacs command. +It is added to `extended-command-history'. +`helm-current-prefix-arg' is used as the command's prefix argument." + (setq extended-command-history + (cons (helm-stringify cmd-or-name) + (delete (helm-stringify cmd-or-name) extended-command-history))) + (let ((current-prefix-arg helm-current-prefix-arg) + (cmd (helm-symbolify cmd-or-name))) + (if (stringp (symbol-function cmd)) + (execute-kbd-macro (symbol-function cmd)) + (setq this-command cmd) + (call-interactively cmd)))) + +;;; Minibuffer History +;; +;; +(defvar helm-source-minibuffer-history + (helm-build-sync-source "Minibuffer History" + :header-name (lambda (name) + (format "%s (%s)" name minibuffer-history-variable)) + :candidates + (lambda () + (let ((history (cl-loop for i in + (symbol-value minibuffer-history-variable) + unless (string= "" i) collect i))) + (if (consp (car history)) + (mapcar 'prin1-to-string history) + history))) + :migemo t + :multiline t + :action (lambda (candidate) + (delete-minibuffer-contents) + (insert candidate)))) + +;;; Shell history +;; +;; +(defun helm-comint-input-ring-action (candidate) + "Default action for comint history." + (with-helm-current-buffer + (delete-region (comint-line-beginning-position) (point-max)) + (insert candidate))) + +(defvar helm-source-comint-input-ring + '((name . "Comint history") + (candidates . (lambda () + (with-helm-current-buffer + (ring-elements comint-input-ring)))) + (action . helm-comint-input-ring-action)) + "Source that provide helm completion against `comint-input-ring'.") + + +;;; Helm ratpoison UI +;; +;; +(defvar helm-source-ratpoison-commands + '((name . "Ratpoison Commands") + (init . helm-ratpoison-commands-init) + (candidates-in-buffer) + (action ("Execute the command" . helm-ratpoison-commands-execute)) + (display-to-real . helm-ratpoison-commands-display-to-real) + (candidate-number-limit))) + +(defun helm-ratpoison-commands-init () + (unless (helm-candidate-buffer) + (with-current-buffer (helm-candidate-buffer 'global) + ;; with ratpoison prefix key + (save-excursion + (call-process "ratpoison" nil (current-buffer) nil "-c" "help")) + (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t) + (replace-match " \\1: \\2")) + (goto-char (point-max)) + ;; direct binding + (save-excursion + (call-process "ratpoison" nil (current-buffer) nil "-c" "help top")) + (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t) + (replace-match "\\1: \\2"))))) + +(defun helm-ratpoison-commands-display-to-real (display) + (and (string-match ": " display) + (substring display (match-end 0)))) + +(defun helm-ratpoison-commands-execute (candidate) + (call-process "ratpoison" nil nil nil "-ic" candidate)) + +;;; Helm stumpwm UI +;; +;; +(defvar helm-source-stumpwm-commands + '((name . "Stumpwm Commands") + (init . helm-stumpwm-commands-init) + (candidates-in-buffer) + (action ("Execute the command" . helm-stumpwm-commands-execute)) + (candidate-number-limit))) + +(defun helm-stumpwm-commands-init () + (with-current-buffer (helm-candidate-buffer 'global) + (save-excursion + (call-process "stumpish" nil (current-buffer) nil "commands")) + (while (re-search-forward "[ ]*\\([^ ]+\\)[ ]*\n?" nil t) + (replace-match "\n\\1\n")) + (delete-blank-lines) + (sort-lines nil (point-min) (point-max)) + (goto-char (point-max)))) + +(defun helm-stumpwm-commands-execute (candidate) + (call-process "stumpish" nil nil nil candidate)) + +;;;###autoload +(defun helm-world-time () + "Preconfigured `helm' to show world time." + (interactive) + (helm-other-buffer 'helm-source-time-world "*helm world time*")) + +;;;###autoload +(defun helm-insert-latex-math () + "Preconfigured helm for latex math symbols completion." + (interactive) + (helm-other-buffer 'helm-source-latex-math "*helm latex*")) + +;;;###autoload +(defun helm-ratpoison-commands () + "Preconfigured `helm' to execute ratpoison commands." + (interactive) + (helm-other-buffer 'helm-source-ratpoison-commands + "*helm ratpoison commands*")) + +;;;###autoload +(defun helm-stumpwm-commands() + (interactive) + (helm-other-buffer 'helm-source-stumpwm-commands + "*helm stumpwm commands*")) + +;;;###autoload +(defun helm-mini () + "Preconfigured `helm' lightweight version \(buffer -> recentf\)." + (interactive) + (require 'helm-files) + (unless helm-source-buffers-list + (setq helm-source-buffers-list + (helm-make-source "Buffers" 'helm-source-buffers))) + (let ((helm-ff-transformer-show-only-basename nil)) + (helm :sources helm-mini-default-sources + :buffer "*helm mini*" + :truncate-lines t))) + +;;;###autoload +(defun helm-minibuffer-history () + "Preconfigured `helm' for `minibuffer-history'." + (interactive) + (let ((enable-recursive-minibuffers t)) + (helm :sources 'helm-source-minibuffer-history + :buffer "*helm minibuffer-history*"))) + +;;;###autoload +(defun helm-comint-input-ring () + "Predefined `helm' that provide completion of `comint' history." + (interactive) + (when (derived-mode-p 'comint-mode) + (helm :sources 'helm-source-comint-input-ring + :input (buffer-substring-no-properties (comint-line-beginning-position) + (point-at-eol)) + :buffer "*helm comint history*"))) + + +(provide 'helm-misc) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-misc.el ends here diff --git a/elpa/helm-20150426.2119/helm-mode.el b/elpa/helm-20150426.2119/helm-mode.el new file mode 100644 index 00000000..d49b30c5 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-mode.el @@ -0,0 +1,1129 @@ +;;; helm-mode.el --- Enable helm completion everywhere. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-files) + + +(defgroup helm-mode nil + "Enable helm completion." + :group 'helm) + +(defcustom helm-completing-read-handlers-alist + '((describe-function . helm-completing-read-symbols) + (describe-variable . helm-completing-read-symbols) + (debug-on-entry . helm-completing-read-symbols) + (find-function . helm-completing-read-symbols) + (trace-function . helm-completing-read-symbols) + (trace-function-foreground . helm-completing-read-symbols) + (trace-function-background . helm-completing-read-symbols) + (find-tag . helm-completing-read-with-cands-in-buffer) + (ffap-alternate-file . nil) + (tmm-menubar . nil)) + "Alist of handlers to replace `completing-read', `read-file-name' in `helm-mode'. +Each entry is a cons cell like \(emacs_command . completing-read_handler\) +where key and value are symbols. + +Each key is an Emacs command that use originaly `completing-read'. + +Each value maybe an helm function that take same arguments as +`completing-read' plus NAME and BUFFER, where NAME is the name of the new +helm source and BUFFER the name of the buffer we will use. +This function prefix name must start by \"helm\". + +See `helm-completing-read-symbols' for example. + +Note that this function will be reused for ALL the `completing-read' +of this command, so it should handle all cases, e.g +If first `completing-read' complete against symbols and +second `completing-read' should handle only buffer, +your specialized function should handle the both. + +If the value of an entry is nil completion will fall back to +emacs vanilla behavior. +e.g If you want to disable helm completion for `describe-function': +\(describe-function . nil\). + +Ido is also supported, you can use `ido-completing-read' and +`ido-read-file-name' as value of an entry or just 'ido. +e.g ido completion for `find-file': +\(find-file . ido\) +same as +\(find-file . ido-read-file-name\) +Note that you don't need to enable `ido-mode' for this to work." + :group 'helm-mode + :type '(alist :key-type symbol :value-type symbol)) + +(defcustom helm-comp-read-case-fold-search helm-case-fold-search + "Default Local setting of `helm-case-fold-search' for `helm-comp-read'. +See `helm-case-fold-search' for more info." + :group 'helm-mode + :type 'symbol) + +(defcustom helm-mode-handle-completion-in-region t + "Whether to replace or not `completion-in-region-function'. +This enable support for `completing-read-multiple' and `completion-at-point' +when non--nil." + :group 'helm-mode + :type 'boolean) + +(defcustom helm-mode-reverse-history t + "Display history source after current source in `helm-mode' handled commands." + :group 'helm-mode + :type 'boolean) + +(defcustom helm-mode-no-completion-in-region-in-modes nil + "A list of modes that do not want helm for `completion-in-region'." + :group 'helm-mode + :type 'boolean) + +(defcustom helm-completion-in-region-fuzzy-match nil + "Whether `helm-completion-in-region' use fuzzy matching or not. +Affect among others `completion-at-point', `completing-read-multiple'." + :group 'helm-mode + :type 'boolean) + + +(defvar helm-comp-read-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "") 'helm-cr-empty-string) + (define-key map (kbd "") 'helm-cr-empty-string) + map) + "Keymap for `helm-comp-read'.") + + +;;; Internal +;; +;; +;; Flag to know if `helm-pattern' have been added +;; to candidate list in `helm-comp-read'. +(defvar helm-cr-unknown-pattern-flag nil) + + +;;; Helm `completing-read' replacement +;; +;; +(defun helm-cr-empty-string () + "Return empty string." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action + #'(lambda (_candidate) + (identity ""))))) + +(defun helm-mode--keyboard-quit () + ;; Use this instead of `keyboard-quit' + ;; to avoid deactivating mark in current-buffer. + (let ((debug-on-quit nil)) + (signal 'quit nil))) + +(defun helm-comp-read-get-candidates (collection &optional test sort-fn alistp) + "Convert COLLECTION to list removing elements that don't match TEST. +See `helm-comp-read' about supported COLLECTION arguments. + +SORT-FN is a predicate to sort COLLECTION. + +ALISTP when non--nil will not use `all-completions' to collect +candidates because it doesn't handle alists correctly for helm. +i.e In `all-completions' the car of each pair is used as value. +In helm we want to use the cdr instead like \(display . real\), +so we return the alist as it is with no transformation by all-completions. + +e.g + +\(setq A '((a . 1) (b . 2) (c . 3))) +==>((a . 1) (b . 2) (c . 3)) +\(helm-comp-read \"test: \" A :alistp nil + :exec-when-only-one t + :initial-input \"a\") +==>\"a\" Which is not what we expect. + +\(helm-comp-read \"test: \" A :alistp t + :exec-when-only-one t + :initial-input \"1\") +==>\"1\" + +See docstring of `all-completions' for more info. + +If COLLECTION is an `obarray', a TEST should be needed. See `obarray'." + + (let ((cands + (cond ((vectorp collection) + (all-completions "" collection test)) + ((and (symbolp collection) (boundp collection) + ;; Issue #324 history is let-bounded and given + ;; quoted as hist argument of completing-read. + ;; See example in `rcirc-browse-url'. + (symbolp (symbol-value collection))) + nil) + ;; When collection is a symbol, most of the time + ;; it should be a symbol used as a minibuffer-history. + ;; The value of this symbol in this case return a list + ;; of string which maybe are converted later as symbol + ;; in special cases. + ;; we treat here commandp as a special case as it return t + ;; also with a string unless its last arg is provided. + ;; Also, the history collections generally collect their + ;; elements as string, so intern them to call predicate. + ((and (symbolp collection) (boundp collection) test) + (let ((predicate `(lambda (elm) + (condition-case err + (if (eq (quote ,test) 'commandp) + (funcall (quote ,test) (intern elm)) + (funcall (quote ,test) elm)) + (wrong-type-argument + (funcall (quote ,test) (intern elm))))))) + (all-completions "" (symbol-value collection) predicate))) + ((and (symbolp collection) (boundp collection)) + (all-completions "" (symbol-value collection))) + ;; Normally file completion should not be handled here, + ;; but special cases like `find-file-at-point' do it. + ;; Handle here specially such cases. + ((and (functionp collection) minibuffer-completing-file-name) + (cl-loop for f in (funcall collection helm-pattern test t) + unless (member f '("./" "../")) + collect (concat (file-name-as-directory + (helm-basedir helm-pattern)) f))) + ((functionp collection) + (funcall collection "" test t)) + ((and alistp test) + (cl-loop for i in collection when (funcall test i) collect i)) + (alistp collection) + (t (all-completions "" collection test))))) + (if sort-fn (sort cands sort-fn) cands))) + +(defun helm-cr-default-transformer (candidates _source) + "Default filter candidate function for `helm-comp-read'." + (cl-loop for c in candidates + for cand = (if (stringp c) (replace-regexp-in-string "\\s\\" "" c) c) + for pat = (replace-regexp-in-string "\\s\\" "" helm-pattern) + if (and (equal cand pat) helm-cr-unknown-pattern-flag) + collect + (cons (concat (propertize + " " 'display + (propertize "[?]" 'face 'helm-ff-prefix)) + c) + c) + into lst + else collect (if (and (stringp c) + (string-match "\n" c)) + (cons (replace-regexp-in-string "\n" "->" c) c) + c) + into lst + finally return (helm-fast-remove-dups lst :test 'equal))) + +(defun helm-comp-read--move-to-first-real-candidate () + (helm-aif (helm-get-selection nil 'withprop) + (when (string= (get-text-property 0 'display it) "[?]") + (helm-next-line)))) + +;;;###autoload +(cl-defun helm-comp-read (prompt collection + &key + test + initial-input + default + preselect + (buffer "*Helm Completions*") + must-match + fuzzy + reverse-history + (requires-pattern 0) + history + input-history + (case-fold helm-comp-read-case-fold-search) + (del-input t) + (persistent-action nil) + (persistent-help "DoNothing") + (mode-line helm-comp-read-mode-line) + (keymap helm-comp-read-map) + (name "Helm Completions") + candidates-in-buffer + exec-when-only-one + quit-when-no-cand + (volatile t) + sort + (fc-transformer 'helm-cr-default-transformer) + hist-fc-transformer + marked-candidates + nomark + (alistp t)) + "Read a string in the minibuffer, with helm completion. + +It is helm `completing-read' equivalent. + +- PROMPT is the prompt name to use. + +- COLLECTION can be a list, vector, obarray or hash-table. + It can be also a function that receives three arguments: + the values string, predicate and t. See `all-completions' for more details. + +Keys description: + +- TEST: A predicate called with one arg i.e candidate. + +- INITIAL-INPUT: Same as input arg in `helm'. + +- PRESELECT: See preselect arg of `helm'. + +- DEFAULT: This option is used only for compatibility with regular + Emacs `completing-read' (Same as DEFAULT arg of `completing-read'). + +- BUFFER: Name of helm-buffer. + +- MUST-MATCH: Candidate selected must be one of COLLECTION. + +- REVERSE-HISTORY: When non--nil display history source after current + source completion. + +- REQUIRES-PATTERN: Same as helm attribute, default is 0. + +- HISTORY: A list containing specific history, default is nil. + When it is non--nil, all elements of HISTORY are displayed in + a special source before COLLECTION. + +- INPUT-HISTORY: A symbol. the minibuffer input history will be + stored there, if nil or not provided, `minibuffer-history' + will be used instead. + +- CASE-FOLD: Same as `helm-case-fold-search'. + +- DEL-INPUT: Boolean, when non--nil (default) remove the partial + minibuffer input from HISTORY is present. + +- PERSISTENT-ACTION: A function called with one arg i.e candidate. + +- PERSISTENT-HELP: A string to document PERSISTENT-ACTION. + +- MODE-LINE: A string or list to display in mode line. + Default is `helm-comp-read-mode-line'. + +- KEYMAP: A keymap to use in this `helm-comp-read'. + (the keymap will be shared with history source) + +- NAME: The name related to this local source. + +- EXEC-WHEN-ONLY-ONE: Bound `helm-execute-action-at-once-if-one' + to non--nil. (possibles values are t or nil). + +- VOLATILE: Use volatile attribute \(enabled by default\). + +- SORT: A predicate to give to `sort' e.g `string-lessp'. + +- FC-TRANSFORMER: A `filtered-candidate-transformer' function. + +- HIST-FC-TRANSFORMER: A `filtered-candidate-transformer' + function for the history source. + +- MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list. + +- NOMARK: When non--nil don't allow marking candidates. + +- ALISTP: \(default is non--nil\) See `helm-comp-read-get-candidates'. + +- CANDIDATES-IN-BUFFER: when non--nil use a source build with + `helm-candidates-in-buffer' which is much faster. + Argument VOLATILE have no effect when CANDIDATES-IN-BUFFER is non--nil. + +Any prefix args passed during `helm-comp-read' invocation will be recorded +in `helm-current-prefix-arg', otherwise if prefix args were given before +`helm-comp-read' invocation, the value of `current-prefix-arg' will be used. +That's mean you can pass prefix args before or after calling a command +that use `helm-comp-read' See `helm-M-x' for example." + + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + (let ((action-fn `(("Sole action (Identity)" + . (lambda (candidate) + (if ,marked-candidates + (helm-marked-candidates) + (identity candidate))))))) + ;; Assume completion have been already required, + ;; so always use 'confirm. + (when (eq must-match 'confirm-after-completion) + (setq must-match 'confirm)) + (let* ((minibuffer-completion-confirm must-match) + (must-match-map (when must-match + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") + 'helm-confirm-and-exit-minibuffer) + map))) + (loc-map (if must-match-map + (make-composed-keymap + must-match-map (or keymap helm-map)) + (or keymap helm-map))) + (minibuffer-completion-predicate test) + (minibuffer-completion-table collection) + (helm-read-file-name-mode-line-string + (replace-regexp-in-string "helm-maybe-exit-minibuffer" + "helm-confirm-and-exit-minibuffer" + helm-read-file-name-mode-line-string)) + (get-candidates (lambda () + (let ((cands (helm-comp-read-get-candidates + collection test sort alistp))) + (setq helm-cr-unknown-pattern-flag nil) + (unless (or (eq must-match t) + (string= helm-pattern "") + (assoc helm-pattern cands) + (assoc (intern helm-pattern) cands) + (member helm-pattern cands)) + (setq cands (append (list + ;; Unquote helm-pattern + ;; when it is added + ;; as candidate. + (replace-regexp-in-string + "\\s\\" "" helm-pattern)) + cands)) + (setq helm-cr-unknown-pattern-flag t)) + (if (and default (not (string= default ""))) + (delq nil (cons default (delete default cands))) + cands)))) + (history-get-candidates (lambda () + (let ((all (helm-comp-read-get-candidates + history test nil alistp))) + (when all + (delete + "" + (helm-fast-remove-dups + (if (and default (not (string= default ""))) + (delq nil (cons default + (delete default all))) + all) + :test 'equal)))))) + (src-hist (helm-build-sync-source (format "%s History" name) + :candidates history-get-candidates + :fuzzy-match fuzzy + :filtered-candidate-transformer + (append '((lambda (candidates sources) + (cl-loop for i in candidates + ;; Input is added to history in completing-read's + ;; and may be regexp-quoted, so unquote it. + for cand = (replace-regexp-in-string "\\s\\" "" i) + collect cand))) + (and hist-fc-transformer (helm-mklist hist-fc-transformer))) + :persistent-action persistent-action + :persistent-help persistent-help + :mode-line mode-line + :action action-fn)) + (src (helm-build-sync-source name + :candidates get-candidates + :filtered-candidate-transformer fc-transformer + :requires-pattern requires-pattern + :persistent-action persistent-action + :persistent-help persistent-help + :fuzzy-match fuzzy + :mode-line mode-line + :action action-fn)) + (src-1 (helm-build-in-buffer-source name + :data get-candidates + :filtered-candidate-transformer fc-transformer + :requires-pattern requires-pattern + :persistent-action persistent-action + :fuzzy-match fuzzy + :persistent-help persistent-help + :mode-line mode-line + :action action-fn)) + (src-list (list src-hist + (if candidates-in-buffer + src-1 + (if volatile + (append src '((volatile))) + src)))) + (helm-execute-action-at-once-if-one exec-when-only-one) + (helm-quit-if-no-candidate quit-when-no-cand) + result) + (when nomark + (setq src-list (cl-loop for src in src-list + collect (cons '(nomark) src)))) + (when reverse-history (setq src-list (nreverse src-list))) + (add-hook 'helm-after-update-hook 'helm-comp-read--move-to-first-real-candidate) + (unwind-protect + (setq result (helm + :sources src-list + :input initial-input + :default default + :preselect preselect + :prompt prompt + :resume 'noresume + :case-fold-search case-fold + :keymap loc-map + :history (and (symbolp input-history) input-history) + :buffer buffer)) + (remove-hook 'helm-after-update-hook 'helm-comp-read--move-to-first-real-candidate)) + ;; Avoid adding an incomplete input to history. + (when (and result history del-input) + (cond ((and (symbolp history) ; History is a symbol. + (not (symbolp (symbol-value history)))) ; Fix Issue #324. + ;; Be sure history is not a symbol with a nil value. + (helm-aif (symbol-value history) (setcar it result))) + ((consp history) ; A list with a non--nil value. + (setcar history result)) + (t ; Possibly a symbol with a nil value. + (set history (list result))))) + (or + result + (when (and (eq helm-exit-status 0) + (eq must-match 'confirm)) + ;; Return empty string only if it is the DEFAULT + ;; value and helm-pattern is empty. + ;; otherwise return helm-pattern + (if (and (string= helm-pattern "") default) + default (identity helm-pattern))) + (unless (or (eq helm-exit-status 1) + must-match) ; FIXME this should not be needed now. + default) + (helm-mode--keyboard-quit))))) + +;; Generic completing-read +;; +;; Support also function as collection. +;; e.g M-x man is supported. +;; Support hash-table and vectors as collection. +;; NOTE: +;; Some crap emacs functions may not be supported +;; like ffap-alternate-file (bad use of completing-read) +;; and maybe others. +;; Provide a mode `helm-mode' which turn on +;; helm in all `completing-read' and `read-file-name' in Emacs. +;; +(defvar helm-completion-mode-string " Helm") + +(defvar helm-completion-mode-quit-message + "Helm completion disabled") + +(defvar helm-completion-mode-start-message + "Helm completion enabled") + +;;; Specialized handlers +;; +;; +(defun helm-completing-read-symbols + (prompt _collection test _require-match init + hist default _inherit-input-method name buffer) + "Specialized function for fast symbols completion in `helm-mode'." + (or + (helm + :sources (helm-build-in-buffer-source name + :init (lambda () + (require 'helm-elisp) + (helm-apropos-init (lambda (x) + (and (funcall test x) + (not (keywordp x)))) + (or (car-safe default) default))) + :filtered-candidate-transformer 'helm-apropos-default-sort-fn + :persistent-action 'helm-lisp-completion-persistent-action + :persistent-help "Show brief doc in mode-line") + :prompt prompt + :buffer buffer + :input init + :history hist + :resume 'noresume + :default (or default "")) + (helm-mode--keyboard-quit))) + + +;;; Generic completing read +;; +;; +(defun helm-completing-read-default-1 + (prompt collection test require-match + init hist default _inherit-input-method + name buffer &optional cands-in-buffer exec-when-only-one) + "Call `helm-comp-read' with same args as `completing-read'. +Extra optional arg CANDS-IN-BUFFER mean use `candidates-in-buffer' +method which is faster. +It should be used when candidate list don't need to rebuild dynamically." + (let ((history (or (car-safe hist) hist)) + (alistp cands-in-buffer)) + (when (and default (listp default)) + ;; When DEFAULT is a list move the list on head of COLLECTION + ;; and set it to its car. #bugfix `grep-read-files'. + (setq collection (if (listp collection) + (append default collection) + ;; Else COLLECTION is maybe a function or a table. + (prog1 + (append default (all-completions "" collection)) + ;; Ensure `all-completions' will not be used + ;; a second time to recompute COLLECTION [1]. + (setq alistp t)))) + (setq default (car default))) + (helm-comp-read + prompt collection + :test test + :history history + :reverse-history helm-mode-reverse-history + :input-history history + :must-match require-match + :alistp alistp ; Ensure `all-completions' is used when non-nil [1]. + :name name + :requires-pattern (if (and (string= default "") + (or (eq require-match 'confirm) + (eq require-match + 'confirm-after-completion))) + 1 0) + :candidates-in-buffer cands-in-buffer + :exec-when-only-one exec-when-only-one + :buffer buffer + ;; If DEF is not provided, fallback to empty string + ;; to avoid `thing-at-point' to be appended on top of list + :default (or default "") + ;; Fail with special characters (e.g in gnus "nnimap+gmail:") + ;; if regexp-quote is not used. + ;; when init is added to history, it will be unquoted by + ;; helm-comp-read. + :initial-input (helm-aif (pcase init + ((pred (stringp)) init) + ;; INIT is a cons cell. + (`(,l . ,_ll) l)) + (if minibuffer-completing-file-name it + (regexp-quote it)))))) + +(defun helm-completing-read-with-cands-in-buffer + (prompt collection test require-match + init hist default inherit-input-method + name buffer) + "Same as `helm-completing-read-default-1' but use candidates-in-buffer." + ;; Some commands like find-tag may use `read-file-name' from inside + ;; the calculation of collection. in this case it clash with + ;; candidates-in-buffer that reuse precedent data (files) which is wrong. + ;; So (re)calculate collection outside of main helm-session. + (let ((cands (all-completions "" collection))) + (helm-completing-read-default-1 prompt cands test require-match + init hist default inherit-input-method + name buffer t))) + +(cl-defun helm--completing-read-default + (prompt collection &optional + predicate require-match + initial-input hist def + inherit-input-method) + "An helm replacement of `completing-read'. +This function should be used only as a `completing-read-function'. + +Don't use it directly, use instead `helm-comp-read' in your programs. + +See documentation of `completing-read' and `all-completions' for details." + (let* ((current-command (or (helm-this-command) this-command)) + (str-command (helm-symbol-name current-command)) + (buf-name (format "*helm-mode-%s*" str-command)) + (entry (assq current-command + helm-completing-read-handlers-alist)) + (def-com (cdr-safe entry)) + (str-defcom (and def-com (symbol-name def-com))) + (def-args (list prompt collection predicate require-match + initial-input hist def inherit-input-method)) + ;; Append the two extra args needed to set the buffer and source name + ;; in helm specialized functions. + (any-args (append def-args (list str-command buf-name))) + helm-completion-mode-start-message ; Be quiet + helm-completion-mode-quit-message + ;; Be sure this pesty *completion* buffer doesn't popup. + ;; Note: `minibuffer-with-setup-hook' may setup a lambda + ;; calling `minibuffer-completion-help' or other minibuffer + ;; functions we DONT WANT here, in these cases removing the hook + ;; (a symbol) have no effect. Issue #448. + ;; But because `minibuffer-completion-table' and + ;; `minibuffer-completion-predicate' are not bound + ;; anymore here, these functions should have no effect now. + (minibuffer-setup-hook (remove 'minibuffer-completion-help + minibuffer-setup-hook)) + ;; Disable hack that could be used before `completing-read'. + ;; i.e (push ?\t unread-command-events). + unread-command-events) + (when (eq def-com 'ido) (setq def-com 'ido-completing-read)) + (unless (or (not entry) def-com) + ;; An entry in *read-handlers-alist exists but have + ;; a nil value, so we exit from here, disable `helm-mode' + ;; and run the command again with it original behavior. + ;; `helm-mode' will be restored on exit. + (cl-return-from helm--completing-read-default + (unwind-protect + (progn + (helm-mode -1) + (apply completing-read-function def-args)) + (helm-mode 1)))) + ;; If we use now `completing-read' we MUST turn off `helm-mode' + ;; to avoid infinite recursion and CRASH. It will be reenabled on exit. + (when (or (eq def-com 'completing-read) + ;; All specialized functions are prefixed by "helm" + (and (stringp str-defcom) + (not (string-match "^helm" str-defcom)))) + (helm-mode -1)) + (unwind-protect + (cond (;; An helm specialized function exists, run it. + (and def-com helm-mode) + (apply def-com any-args)) + (;; Try to handle `ido-completing-read' everywhere. + (and def-com (eq def-com 'ido-completing-read)) + (setcar (memq collection def-args) + (all-completions "" collection predicate)) + (apply def-com def-args)) + (;; User set explicitely `completing-read' or something similar + ;; in *read-handlers-alist, use this with exactly the same + ;; args as in `completing-read'. + ;; If we are here `helm-mode' is now disabled. + def-com + (apply def-com def-args)) + (t ; Fall back to classic `helm-comp-read'. + (helm-completing-read-default-1 + prompt collection predicate require-match + initial-input hist def inherit-input-method + str-command buf-name))) + (helm-mode 1) + ;; When exiting minibuffer, `this-command' is set to + ;; `helm-exit-minibuffer', which is unwanted when starting + ;; on another `completing-read', so restore `this-command' to + ;; initial value when exiting. + (setq this-command current-command)))) + +;;; Generic read-file-name +;; +;; +(cl-defun helm-read-file-name + (prompt + &key + (name "Read File Name") + (initial-input (expand-file-name default-directory)) + (buffer "*Helm file completions*") + test + (case-fold helm-file-name-case-fold-search) + preselect + history + must-match + default + marked-candidates + nomark + (alistp t) + (persistent-action 'helm-find-files-persistent-action) + (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file") + (mode-line helm-read-file-name-mode-line-string)) + "Read a file name with helm completion. +It is helm `read-file-name' emulation. + +Argument PROMPT is the default prompt to use. + +Keys description: + +- NAME: Source name, default to \"Read File Name\". + +- INITIAL-INPUT: Where to start read file name, default to `default-directory'. + +- BUFFER: `helm-buffer' name default to \"*Helm Completions*\". + +- TEST: A predicate called with one arg 'candidate'. + +- CASE-FOLD: Same as `helm-case-fold-search'. + +- PRESELECT: helm preselection. + +- HISTORY: Display HISTORY in a special source. + +- MUST-MATCH: Can be 'confirm, nil, or t. + +- MARKED-CANDIDATES: When non--nil return a list of marked candidates. + +- NOMARK: When non--nil don't allow marking candidates. + +- ALISTP: Don't use `all-completions' in history (take effect only on history). + +- PERSISTENT-ACTION: a persistent action function. + +- PERSISTENT-HELP: persistent help message. + +- MODE-LINE: A mode line message, default is `helm-read-file-name-mode-line-string'." + + (when (get-buffer helm-action-buffer) + (kill-buffer helm-action-buffer)) + ;; Assume completion have been already required, + ;; so always use 'confirm. + (when (eq must-match 'confirm-after-completion) + (setq must-match 'confirm)) + (let* ((action-fn `(("Sole action (Identity)" + . (lambda (candidate) + (if ,marked-candidates + (helm-marked-candidates :with-wildcard t) + (identity candidate)))))) + ;; Be sure we don't erase the underlying minibuffer if some. + (helm-ff-auto-update-initial-value + (and helm-ff-auto-update-initial-value + (not (minibuffer-window-active-p (minibuffer-window))))) + helm-full-frame + (hist (and history (helm-comp-read-get-candidates + history nil nil alistp))) + (minibuffer-completion-confirm must-match) + (must-match-map (when must-match + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") + 'helm-confirm-and-exit-minibuffer) + map))) + (cmap (if must-match-map + (make-composed-keymap + must-match-map helm-read-file-map) + helm-read-file-map)) + (minibuffer-completion-predicate test) + (minibuffer-completing-file-name t) + (helm-read-file-name-mode-line-string + (replace-regexp-in-string "helm-maybe-exit-minibuffer" + "helm-confirm-and-exit-minibuffer" + helm-read-file-name-mode-line-string)) + (src-list + (list + ;; History source. + (helm-build-sync-source (format "%s History" name) + :header-name (lambda (hname) + (concat hname helm-find-files-doc-header)) + :mode-line mode-line + :candidates hist + :nohighlight t + :persistent-action persistent-action + :persistent-help persistent-help + :nomark nomark + :action action-fn) + ;; Other source. + (helm-build-sync-source name + :header-name (lambda (hname) + (concat hname helm-find-files-doc-header)) + :init (lambda () + (setq helm-ff-auto-update-flag + helm-ff-auto-update-initial-value) + (setq helm-ff--auto-update-state + helm-ff-auto-update-flag)) + :mode-line mode-line + :nohighlight t + :candidates + (lambda () + (append (and (not (file-exists-p helm-pattern)) + (list helm-pattern)) + (if test + (cl-loop with hn = (helm-ff-tramp-hostnames) + for i in (helm-find-files-get-candidates + must-match) + when (or (member i hn) ; A tramp host + (funcall test i)) ; Test ok + collect i) + (helm-find-files-get-candidates must-match)))) + :filtered-candidate-transformer 'helm-ff-sort-candidates + :filter-one-by-one 'helm-ff-filter-candidate-one-by-one + :persistent-action persistent-action + :candidate-number-limit 9999 + :persistent-help persistent-help + :volatile t + :nomark nomark + :action action-fn))) + ;; Helm result. + (result (helm + :sources src-list + :input initial-input + :prompt prompt + :keymap cmap + :resume 'noresume + :case-fold-search case-fold + :default default + :buffer buffer + :preselect preselect))) + (or + (cond ((and result (stringp result) + (string= result "") "")) + ((and result + (stringp result) + (file-equal-p result initial-input) + default) + (if (listp default) (car default) default)) + ((and result (stringp result)) + (expand-file-name result)) + ((and result (listp result)) + (mapcar #'expand-file-name result)) + (t result)) + (when (and (not (string= helm-pattern "")) + (eq helm-exit-status 0) + (eq must-match 'confirm)) + (identity helm-pattern)) + (helm-mode--keyboard-quit)))) + +(defun helm-mode--default-filename (fname dir initial) + (unless dir (setq dir default-directory)) + (unless (file-name-absolute-p dir) + (setq dir (expand-file-name dir))) + (unless (or fname (consp fname)) + (setq fname (expand-file-name + (or initial buffer-file-name dir) + dir))) + (if (and fname (consp fname)) + (setq fname (cl-loop for f in fname + collect (expand-file-name f dir))) + (if (file-name-absolute-p fname) + fname (expand-file-name fname dir)))) + +(cl-defun helm--generic-read-file-name + (prompt &optional dir default-filename mustmatch initial predicate) + "Generic helm replacement of `read-file-name'. +Don't use it directly, use instead `helm-read-file-name' in your programs." + (let* ((init (or initial dir default-directory)) + (current-command (or (helm-this-command) this-command)) + (str-command (helm-symbol-name current-command)) + (helm--file-completion-sources + (cons str-command + (remove str-command helm--file-completion-sources))) + (buf-name (format "*helm-mode-%s*" str-command)) + (entry (assq current-command + helm-completing-read-handlers-alist)) + (def-com (cdr-safe entry)) + (str-defcom (and def-com (symbol-name def-com))) + (def-args (list prompt dir default-filename mustmatch initial predicate)) + ;; Append the two extra args needed to set the buffer and source name + ;; in helm specialized functions. + (any-args (append def-args (list str-command buf-name))) + (ido-state ido-mode) + helm-completion-mode-start-message ; Be quiet + helm-completion-mode-quit-message ; Same here + fname) + (setq default-filename (helm-mode--default-filename + default-filename dir initial)) + ;; Some functions that normally call `completing-read' can switch + ;; brutally to `read-file-name' (e.g find-tag), in this case + ;; the helm specialized function will fail because it is build + ;; for `completing-read', so set it to 'incompatible to be sure + ;; we switch to `helm-read-file-name' and don't try to call it + ;; with wrong number of args. + (when (eq def-com 'ido) + (setq def-com 'ido-read-file-name) (ido-mode 1)) + (when (and def-com (> (length (help-function-arglist def-com)) 8)) + (setq def-com 'incompatible)) + (unless (or (not entry) def-com) + (cl-return-from helm--generic-read-file-name + (unwind-protect + (progn + (helm-mode -1) + (apply read-file-name-function def-args)) + (helm-mode 1)))) + ;; If we use now `read-file-name' we MUST turn off `helm-mode' + ;; to avoid infinite recursion and CRASH. It will be reenabled on exit. + (when (or (eq def-com 'read-file-name) + (eq def-com 'ido-read-file-name) + (and (stringp str-defcom) + (not (string-match "^helm" str-defcom)))) + (helm-mode -1)) + (unwind-protect + (setq fname + (cond (;; A specialized function exists, run it + ;; with the two extra args specific to helm.. + (and def-com helm-mode + (not (eq def-com 'ido-read-file-name)) + (not (eq def-com 'incompatible))) + (apply def-com any-args)) + (;; Def-com value is `ido-read-file-name' + ;; run it with default args. + (and def-com (eq def-com 'ido-read-file-name)) + (ido-mode 1) + (apply def-com def-args)) + (;; Def-com value is `read-file-name' + ;; run it with default args. + (eq def-com 'read-file-name) + (apply def-com def-args)) + (t ; Fall back to classic `helm-read-file-name'. + (helm-read-file-name + prompt + :name str-command + :buffer buf-name + :default default-filename + :initial-input (expand-file-name init dir) + :alistp nil + :must-match mustmatch + :test predicate)))) + (helm-mode 1) + (ido-mode (if ido-state 1 -1)) + ;; Same comment as in `helm--completing-read-default'. + (setq this-command current-command)) + fname)) + +(defun helm-mode--advice-lisp--local-variables (old--fn &rest args) + (ignore-errors + (apply old--fn args))) + +(defun helm--completion-in-region (start end collection &optional predicate) + "[EXPERIMENTAL] Helm replacement of `completion--in-region'. +Can be used as value for `completion-in-region-function'." + (cl-declare (special require-match prompt)) + (if (memq major-mode helm-mode-no-completion-in-region-in-modes) + (funcall helm--old-completion-in-region-function + start end collection predicate) + (advice-add + 'lisp--local-variables + :around #'helm-mode--advice-lisp--local-variables) + (unwind-protect + (let* ((enable-recursive-minibuffers t) + (input (buffer-substring-no-properties start end)) + (current-command (or (helm-this-command) this-command)) + (str-command (symbol-name current-command)) + (buf-name (format "*helm-mode-%s*" str-command)) + (require-match (or (and (boundp 'require-match) require-match) + minibuffer-completion-confirm + ;; If prompt have not been propagated here, that's + ;; probably mean we have no prompt and we are in + ;; completion-at-point or friend, so use a non--nil + ;; value for require-match. + (not (boundp 'prompt)))) + ;; `completion-extra-properties' is let-bounded in `completion-at-point'. + ;; `afun' is a closure to call against each string in `data'. + ;; it provide the annotation info for each string. + ;; e.g "foo" => "foo " where foo is a function. + ;; See Issue #407. + (afun (plist-get completion-extra-properties :annotation-function)) + (data (all-completions input collection predicate)) + (init-space-suffix (unless helm-completion-in-region-fuzzy-match " ")) + ;; Assume that when `afun' and `predicate' are null + ;; we are in filename completion. + (file-comp-p (or (helm-mode--in-file-completion-p) + (and (null afun) (null predicate)))) + ;; Completion-at-point and friends have no prompt. + (result (if (stringp data) + data + (helm-comp-read + (or (and (boundp 'prompt) prompt) "Pattern: ") + (if file-comp-p + (cl-loop for f in data unless + (string-match "\\`\\.\\{1,2\\}/\\'" f) + collect f) + (if afun + (mapcar (lambda (s) + (let ((ann (funcall afun s))) + (if ann + (cons + (concat + s + (propertize + " " 'display + (propertize + ann + 'face 'completions-annotations))) + s) + s))) + data) + data)) + :name str-command + :fuzzy helm-completion-in-region-fuzzy-match + :nomark t + :initial-input + (cond ((and file-comp-p + (not (string-match "/\\'" input))) + (concat (helm-basename input) + (unless (string= input "") + init-space-suffix))) + ((string-match "/\\'" input) nil) + ((or (null require-match) + (stringp require-match)) + input) + (t (concat input init-space-suffix))) + :buffer buf-name + :fc-transformer (append (list 'helm-cr-default-transformer) + (list (lambda (candidates _source) + (sort candidates 'helm-generic-sort-fn)))) + :exec-when-only-one t + :quit-when-no-cand + #'(lambda () + ;; Delay message to overwrite "Quit". + (run-with-timer + 0.01 nil + #'(lambda () + (message "[No matches]"))) + t) ; exit minibuffer immediately. + :must-match require-match)))) + (when result + (delete-region (if (and file-comp-p + (save-excursion + (re-search-backward "~?/" start t))) + (match-end 0) start) + end) + (insert result))) + (advice-remove 'lisp--local-variables + #'helm-mode--advice-lisp--local-variables)))) + +(defun helm-mode--in-file-completion-p () + (with-helm-current-buffer + (run-hook-with-args-until-success 'file-name-at-point-functions))) + +(when (boundp 'completion-in-region-function) + (defconst helm--old-completion-in-region-function completion-in-region-function)) + +;;;###autoload +(define-minor-mode helm-mode + "Toggle generic helm completion. + +All functions in Emacs that use `completing-read' +or `read-file-name' and friends will use helm interface +when this mode is turned on. +However you can modify this behavior for functions of your choice +with `helm-completing-read-handlers-alist'. + +Called with a positive arg, turn on unconditionally, with a +negative arg turn off. +You can turn it on with `helm-mode'. + +Some crap emacs functions may not be supported, +e.g `ffap-alternate-file' and maybe others +You can add such functions to `helm-completing-read-handlers-alist' +with a nil value. + +Note: This mode is incompatible with Emacs23." + :group 'helm-mode + :global t + :lighter helm-completion-mode-string + (cl-assert (boundp 'completing-read-function) nil + "`helm-mode' not available, upgrade to Emacs-24") + (if helm-mode + (if (fboundp 'add-function) + (progn + (add-function :override completing-read-function + #'helm--completing-read-default) + (add-function :override read-file-name-function + #'helm--generic-read-file-name) + (when helm-mode-handle-completion-in-region + (add-function :override completion-in-region-function + #'helm--completion-in-region))) + (setq completing-read-function 'helm--completing-read-default + read-file-name-function 'helm--generic-read-file-name) + (when (and (boundp 'completion-in-region-function) + helm-mode-handle-completion-in-region) + (setq completion-in-region-function #'helm--completion-in-region)) + (message helm-completion-mode-start-message)) + (if (fboundp 'remove-function) + (progn + (remove-function completing-read-function #'helm--completing-read-default) + (remove-function read-file-name-function #'helm--generic-read-file-name) + (remove-function completion-in-region-function #'helm--completion-in-region)) + (setq completing-read-function (and (fboundp 'completing-read-default) + 'completing-read-default) + read-file-name-function (and (fboundp 'read-file-name-default) + 'read-file-name-default)) + (when (and (boundp 'completion-in-region-function) + (boundp 'helm--old-completion-in-region-function)) + (setq completion-in-region-function helm--old-completion-in-region-function)) + (message helm-completion-mode-quit-message)))) + +(provide 'helm-mode) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-mode.el ends here diff --git a/elpa/helm-20150426.2119/helm-net.el b/elpa/helm-20150426.2119/helm-net.el new file mode 100644 index 00000000..702a3aa6 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-net.el @@ -0,0 +1,607 @@ +;;; helm-net.el --- helm browse url and search web. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'url) +(require 'xml) +(require 'browse-url) + + +(defgroup helm-net nil + "Net related applications and libraries for Helm." + :group 'helm) + +(defcustom helm-google-suggest-default-browser-function nil + "The browse url function you prefer to use with google suggest. +When nil, use the first browser function available +See `helm-browse-url-default-browser-alist'." + :group 'helm-net + :type 'symbol) + +(defcustom helm-home-url "http://www.google.fr" + "Default url to use as home url." + :group 'helm-net + :type 'string) + +(defcustom helm-surfraw-default-browser-function nil + "The browse url function you prefer to use with surfraw. +When nil, fallback to `browse-url-browser-function'." + :group 'helm-net + :type 'symbol) + +(defcustom helm-google-suggest-url + "http://google.com/complete/search?output=toolbar&q=" + "URL used for looking up Google suggestions." + :type 'string + :group 'helm-net) + +(defcustom helm-google-suggest-search-url + "http://www.google.com/search?ie=utf-8&oe=utf-8&q=%s" + "URL used for Google searching." + :type 'string + :group 'helm-net) + +(defcustom helm-google-suggest-use-curl-p nil + "When non--nil use CURL to get info from `helm-google-suggest-url'. +Otherwise `url-retrieve-synchronously' is used." + :type 'boolean + :group 'helm-net) + +(defcustom helm-yahoo-suggest-url + "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=Generic&query=" + "Url used for looking up Yahoo suggestions." + :type 'string + :group 'helm-net) + +(defcustom helm-yahoo-suggest-search-url + "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p=%s" + "Url used for Yahoo searching." + :type 'string + :group 'helm-net) + +(defcustom helm-surfraw-duckduckgo-url + "https://duckduckgo.com/lite/?q=%s&kp=1" + "The duckduckgo url. +This is a format string, don't forget the `%s'. +If you have personal settings saved on duckduckgo you should have +a personal url, see your settings on duckduckgo." + :type 'string + :group 'helm-net) + +(defcustom helm-wikipedia-suggest-url + "http://en.wikipedia.org/w/api.php?action=opensearch&search=" + "Url used for looking up Wikipedia suggestions." + :type 'string + :group 'helm-net) + +(defcustom helm-search-suggest-action-wikipedia-url + "https://en.wikipedia.org/wiki/Special:Search?search=%s" + "The Wikipedia search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-wikipedia-summary-url + "http://en.wikipedia.org/w/api.php?action=parse&format=json&prop=text§ion=0&page=" + "URL for getting the summary of a Wikipedia topic." + :type 'string + :group 'helm-net) + +(defcustom helm-wikipedia-follow-delay 2 + "Delay before wikipedia summary popup." + :type 'number + :group 'helm-net) + +(defcustom helm-search-suggest-action-youtube-url + "http://www.youtube.com/results?aq=f&search_query=%s" + "The Youtube search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-search-suggest-action-imdb-url + "http://www.imdb.com/find?s=all&q=%s" + "The IMDb search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-search-suggest-action-google-maps-url + "http://maps.google.com/maps?f=q&source=s_q&q=%s" + "The Google Maps search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + +(defcustom helm-search-suggest-action-google-news-url + "http://www.google.com/search?safe=off&prmd=nvlifd&source=lnms&tbs=nws:1&q=%s" + "The Google News search url. +This is a format string, don't forget the `%s'." + :type 'string + :group 'helm-net) + + +;;; Additional actions for search suggestions +;; +;; +;; Internal + +(defun helm-search-suggest-perform-additional-action (url query) + "Perform the search via URL using QUERY as input." + (browse-url (format url (url-hexify-string query)))) + +(defvar helm-search-suggest-additional-actions + '(("Wikipedia" . (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-wikipedia-url + candidate))) + ("Youtube" . (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-youtube-url + candidate))) + ("IMDb" . (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-imdb-url + candidate))) + ("Google Maps" . (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-google-maps-url + candidate))) + ("Google News" . (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-google-news-url + candidate)))) + "List of additional actions for suggest sources.") + + +;;; Google Suggestions +;; +;; +;; Internal +(defvar helm-ggs-max-length-real-flag 0) +(defvar helm-ggs-max-length-num-flag 0) + +(defun helm-google-suggest-fetch (input) + "Fetch suggestions for INPUT from XML buffer. +Return an alist with elements like (data . number_results)." + (setq helm-ggs-max-length-real-flag 0 + helm-ggs-max-length-num-flag 0) + (let ((request (concat helm-google-suggest-url + (url-hexify-string input))) + (fetch #'(lambda () + (cl-loop + with result-alist = (xml-get-children + (car (xml-parse-region + (point-min) (point-max))) + 'CompleteSuggestion) + for i in result-alist + for data = (cdr (cl-caadr (assoc 'suggestion i))) + for nqueries = (cdr (cl-caadr (assoc 'num_queries i))) + for lqueries = (length (helm-ggs-set-number-result + nqueries)) + for ldata = (length data) + do + (progn + (when (> ldata helm-ggs-max-length-real-flag) + (setq helm-ggs-max-length-real-flag ldata)) + (when (> lqueries helm-ggs-max-length-num-flag) + (setq helm-ggs-max-length-num-flag lqueries))) + collect (cons data nqueries) into cont + finally return cont)))) + (if helm-google-suggest-use-curl-p + (with-temp-buffer + (call-process "curl" nil t nil request) + (funcall fetch)) + (with-current-buffer + (url-retrieve-synchronously request) + (funcall fetch))))) + +(defun helm-google-suggest-set-candidates (&optional request-prefix) + "Set candidates with result and number of google results found." + (let ((suggestions + (cl-loop with suggested-results = (helm-google-suggest-fetch + (or (and request-prefix + (concat request-prefix + " " helm-pattern)) + helm-pattern)) + for (real . numresult) in suggested-results + ;; Prepare number of results with "," + for fnumresult = (helm-ggs-set-number-result numresult) + ;; Calculate number of spaces to add before fnumresult + ;; if it is smaller than longest result + ;; `helm-ggs-max-length-num-flag'. + ;; e.g 1,234,567 + ;; 345,678 + ;; To be sure it is aligned properly. + for nspaces = (if (< (length fnumresult) + helm-ggs-max-length-num-flag) + (- helm-ggs-max-length-num-flag + (length fnumresult)) + 0) + ;; Add now the spaces before fnumresult. + for align-fnumresult = (concat (make-string nspaces ? ) + fnumresult) + for interval = (- helm-ggs-max-length-real-flag + (length real)) + for spaces = (make-string (+ 2 interval) ? ) + for display = (format "%s%s(%s results)" + real spaces align-fnumresult) + collect (cons display real)))) + (if (cl-loop for (_disp . dat) in suggestions + thereis (equal dat helm-pattern)) + suggestions + ;; if there is no suggestion exactly matching the input then + ;; prepend a Search on Google item to the list + (append + suggestions + (list (cons (concat "Search for " "'" helm-input "'" " on Google") + helm-input)))))) + +(defun helm-ggs-set-number-result (num) + (if num + (progn + (and (numberp num) (setq num (number-to-string num))) + (cl-loop for i in (reverse (split-string num "" t)) + for count from 1 + append (list i) into C + when (= count 3) + append (list ",") into C + and do (setq count 0) + finally return + (replace-regexp-in-string + "^," "" (mapconcat 'identity (reverse C) "")))) + "?")) + +(defun helm-google-suggest-action (candidate) + "Default action to jump to a google suggested candidate." + (let ((arg (format helm-google-suggest-search-url + (url-hexify-string candidate)))) + (helm-aif helm-google-suggest-default-browser-function + (funcall it arg) + (helm-browse-url arg)))) + +(defvar helm-google-suggest-default-function + 'helm-google-suggest-set-candidates + "Default function to use in helm google suggest.") + +(defvar helm-source-google-suggest + `((name . "Google Suggest") + (candidates . (lambda () + (funcall helm-google-suggest-default-function))) + (action . ,(cons '("Google Search" . helm-google-suggest-action) + helm-search-suggest-additional-actions)) + (volatile) + (keymap . ,helm-map) + (requires-pattern . 3))) + +(defun helm-google-suggest-emacs-lisp () + "Try to emacs lisp complete with google suggestions." + (helm-google-suggest-set-candidates "emacs lisp")) + + +;;; Yahoo suggestions +;; +;; +(defun helm-yahoo-suggest-fetch (input) + "Fetch Yahoo suggestions for INPUT from XML buffer. +Return an alist with elements like (data . number_results)." + (let ((request (concat helm-yahoo-suggest-url + (url-hexify-string input)))) + (with-current-buffer + (url-retrieve-synchronously request) + (cl-loop with result-alist = + (xml-get-children + (car (xml-parse-region + (point-min) (point-max))) + 'Result) + for i in result-alist + collect (cl-caddr i))))) + +(defun helm-yahoo-suggest-set-candidates () + "Set candidates with Yahoo results found." + (let ((suggestions (helm-yahoo-suggest-fetch helm-input))) + (or suggestions + (append + suggestions + (list (cons (concat "Search for " "'" helm-input "'" " on Yahoo") + helm-input)))))) + +(defun helm-yahoo-suggest-action (candidate) + "Default action to jump to a Yahoo suggested candidate." + (helm-browse-url (format helm-yahoo-suggest-search-url + (url-hexify-string candidate)))) + +(defvar helm-source-yahoo-suggest + `((name . "Yahoo Suggest") + (candidates . helm-yahoo-suggest-set-candidates) + (action . (("Yahoo Search" . helm-yahoo-suggest-action))) + (volatile) + (keymap . ,helm-map) + (requires-pattern . 3))) + +;;; Wikipedia suggestions +;; +;; +(declare-function json-read-from-string "json" (string)) +(defun helm-wikipedia-suggest-fetch () + "Fetch Wikipedia suggestions and return them as a list." + (require 'json) + (let ((request (concat helm-wikipedia-suggest-url + (url-hexify-string helm-pattern)))) + (if helm-google-suggest-use-curl-p + (with-temp-buffer + (call-process "curl" nil t nil request) + (helm-wikipedia--parse-buffer)) + (with-current-buffer + (url-retrieve-synchronously request) + (helm-wikipedia--parse-buffer))))) + +(defun helm-wikipedia--parse-buffer () + (goto-char (point-min)) + (when (re-search-forward "^\\[.+\\[\\(.*\\)\\]\\]" nil t) + (cl-loop for i across (aref (json-read-from-string (match-string 0)) 1) + collect i into result + finally return (or result + (append + result + (list (cons (format "Search for '%s' on wikipedia" + helm-pattern) + helm-pattern))))))) + +(defvar helm-wikipedia--summary-cache (make-hash-table :test 'equal)) +(defun helm-wikipedia-persistent-action (candidate) + (unless (string= (format "Search for '%s' on wikipedia" + helm-pattern) + (helm-get-selection nil t)) + (message "Fetching summary from Wikipedia...") + (let ((buf (get-buffer-create "*helm wikipedia summary*")) + result mess) + (while (progn + (setq result (or (gethash candidate helm-wikipedia--summary-cache) + (puthash candidate + (prog1 + (helm-wikipedia-fetch-summary candidate) + (setq mess "Done")) + helm-wikipedia--summary-cache))) + (when (and result + (listp result)) + (setq candidate (cdr result)) + (message "Redirected to %s" candidate) + t))) + (if (not result) + (message "Error when getting summary.") + (with-current-buffer buf + (erase-buffer) + (setq cursor-type nil) + (insert result) + (fill-region (point-min) (point-max)) + (goto-char (point-min))) + (display-buffer buf) + (message mess))))) + + +(defun helm-wikipedia-fetch-summary (input) + (let* ((request (concat helm-wikipedia-summary-url (url-hexify-string input)))) + (if helm-google-suggest-use-curl-p + (with-temp-buffer + (call-process "curl" nil t nil request) + (helm-wikipedia--parse-summary)) + (with-current-buffer + (url-retrieve-synchronously request) + (helm-wikipedia--parse-summary))))) + + +(defun helm-wikipedia--parse-summary () + (goto-char (point-min)) + (when (search-forward "{" nil t) + (let ((result (cdr (assoc '* + (assoc 'text + (assoc 'parse + (json-read-from-string + (buffer-substring-no-properties + (1- (point)) (point-max))))))))) + (when result + (if (string-match "]+>\\([^<]+\\)" result) + (cons 'redirect (match-string 1 result)) + + ;; find the beginning of the summary text in the result + + ;; check if there is a table before the summary and skip that + (when (or (string-match "\\(\n\\)?\n

" result) + ;; otherwise just find the first paragraph + (string-match "

" result)) + ;; remove cruft and do a simple formatting + (replace-regexp-in-string + "Cite error: .*" "" + (replace-regexp-in-string + " " "" + (replace-regexp-in-string + "\\[[^\]]+\\]" "" + (replace-regexp-in-string + "<[^>]*>" "" + (replace-regexp-in-string + "

\n

" "\n\n" + (substring result (match-end 0))))))))))))) + + +(defvar helm-source-wikipedia-suggest + `((name . "Wikipedia Suggest") + (candidates . helm-wikipedia-suggest-fetch) + (action . (("Wikipedia" . (lambda (candidate) + (helm-search-suggest-perform-additional-action + helm-search-suggest-action-wikipedia-url + candidate))))) + (persistent-action . helm-wikipedia-persistent-action) + (volatile) + (keymap . ,helm-map) + (follow . 1) + (follow-delay . ,helm-wikipedia-follow-delay) + (requires-pattern . 3))) + + +;;; Web browser functions. +;; +;; +;; If default setting of `w3m-command' is not +;; what you want and you modify it, you will have to reeval +;; also `helm-browse-url-default-browser-alist'. + +(defvar helm-browse-url-chromium-program "chromium-browser") +(defvar helm-browse-url-uzbl-program "uzbl-browser") +(defvar helm-browse-url-conkeror-program "conkeror") +(defvar helm-browse-url-default-browser-alist + `((,(or (and (boundp 'w3m-command) w3m-command) + "/usr/bin/w3m") . w3m-browse-url) + (,browse-url-firefox-program . browse-url-firefox) + (,helm-browse-url-chromium-program . helm-browse-url-chromium) + (,helm-browse-url-conkeror-program . helm-browse-url-conkeror) + (,helm-browse-url-uzbl-program . helm-browse-url-uzbl) + (,browse-url-kde-program . browse-url-kde) + (,browse-url-gnome-moz-program . browse-url-gnome-moz) + (,browse-url-mozilla-program . browse-url-mozilla) + (,browse-url-galeon-program . browse-url-galeon) + (,browse-url-netscape-program . browse-url-netscape) + (,browse-url-mosaic-program . browse-url-mosaic) + (,browse-url-xterm-program . browse-url-text-xterm) + ("emacs" . eww-browse-url)) + "*Alist of \(executable . function\) to try to find a suitable url browser.") + +(cl-defun helm-generic-browser (url cmd-name &rest args) + "Browse URL with NAME browser." + (let ((proc (concat cmd-name " " url))) + (message "Starting %s..." cmd-name) + (apply 'start-process proc nil cmd-name + (append args (list url))) + (set-process-sentinel + (get-process proc) + #'(lambda (process event) + (when (string= event "finished\n") + (message "%s process %s" process event)))))) + +(defun helm-browse-url-chromium (url &optional _ignore) + "Browse URL with google chrome browser." + (interactive "sURL: ") + (helm-generic-browser + url helm-browse-url-chromium-program)) + +(defun helm-browse-url-uzbl (url &optional _ignore) + "Browse URL with uzbl browser." + (interactive "sURL: ") + (helm-generic-browser url helm-browse-url-uzbl-program "-u")) + +(defun helm-browse-url-conkeror (url &optional _ignore) + "Browse URL with conkeror browser." + (interactive "sURL: ") + (helm-generic-browser url helm-browse-url-conkeror-program)) + +(defun helm-browse-url-default-browser (url &rest args) + "Find the first available browser and ask it to load URL." + (let ((default-browser-fn + (cl-loop for (exe . fn) in helm-browse-url-default-browser-alist + thereis (and exe (executable-find exe) (fboundp fn) fn)))) + (if default-browser-fn + (apply default-browser-fn url args) + (error "No usable browser found")))) + +(defun helm-browse-url (url &rest args) + "Default command to browse URL." + (if browse-url-browser-function + (browse-url url args) + (helm-browse-url-default-browser url args))) + + +;;; Surfraw +;; +;; Need external program surfraw. +;; + +;; Internal +(defvar helm-surfraw-engines-history nil) +(defvar helm-surfraw-input-history nil) +(defvar helm-surfraw--elvi-cache nil) + +(defun helm-build-elvi-list () + "Return list of all engines and descriptions handled by surfraw." + (or helm-surfraw--elvi-cache + (setq helm-surfraw--elvi-cache + (cdr (with-temp-buffer + (call-process "surfraw" nil t nil "-elvi") + (split-string (buffer-string) "\n")))))) + +;;;###autoload +(defun helm-surfraw (pattern engine) + "Preconfigured `helm' to search PATTERN with search ENGINE." + (interactive (list (read-string "SearchFor: " + nil 'helm-surfraw-input-history + (thing-at-point 'symbol)) + (helm-comp-read + "Engine: " + (helm-build-elvi-list) + :must-match t + :name "Surfraw Search Engines" + :del-input nil + :history helm-surfraw-engines-history))) + (let* ((engine-nodesc (car (split-string engine))) + (url (if (string= engine-nodesc "duckduckgo") + ;; "sr duckduckgo -p foo" is broken, workaround. + (format helm-surfraw-duckduckgo-url + (url-hexify-string pattern)) + (with-temp-buffer + (apply 'call-process "surfraw" nil t nil + (append (list engine-nodesc "-p") (split-string pattern))) + (replace-regexp-in-string + "\n" "" (buffer-string))))) + (browse-url-browser-function (or helm-surfraw-default-browser-function + browse-url-browser-function))) + (if (string= engine-nodesc "W") + (helm-browse-url helm-home-url) + (helm-browse-url url) + (setq helm-surfraw-engines-history + (cons engine (delete engine helm-surfraw-engines-history)))))) + +;;;###autoload +(defun helm-google-suggest () + "Preconfigured `helm' for google search with google suggest." + (interactive) + (helm-other-buffer 'helm-source-google-suggest "*helm google*")) + +;;;###autoload +(defun helm-yahoo-suggest () + "Preconfigured `helm' for Yahoo searching with Yahoo suggest." + (interactive) + (helm-other-buffer 'helm-source-yahoo-suggest "*helm yahoo*")) + +;;;###autoload +(defun helm-wikipedia-suggest () + "Preconfigured `helm' for Wikipedia lookup with Wikipedia suggest." + (interactive) + (helm :sources 'helm-source-wikipedia-suggest + :buffer "*helm wikipedia*")) + + +(provide 'helm-net) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-net.el ends here diff --git a/elpa/helm-20150426.2119/helm-org.el b/elpa/helm-20150426.2119/helm-org.el new file mode 100644 index 00000000..6570016a --- /dev/null +++ b/elpa/helm-20150426.2119/helm-org.el @@ -0,0 +1,148 @@ +;;; helm-org.el --- Helm for org headlines and keywords completion -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: +(require 'cl-lib) +(require 'helm) +(require 'org) + +(defgroup helm-org nil + "Org related functions for helm." + :group 'helm) + +(defcustom helm-org-headings-fontify nil + "Fontify org buffers before parsing them. +This reflect fontification in helm-buffer when non--nil. +NOTE: This will be slow on large org buffers." + :group 'helm-org + :type 'boolean) + +;; Internal +(defvar helm-org-headings--nofilename nil) + +;;; Org capture templates +;; +;; +(defvar org-capture-templates) +(defun helm-source-org-capture-templates () + (helm-build-sync-source "Org Capture Templates:" + :candidates (cl-loop for template in org-capture-templates + collect `(,(nth 1 template) . ,(nth 0 template))) + :action '(("Do capture" . (lambda (template-shortcut) + (org-capture nil template-shortcut)))))) + +;;; Org headings +;; +;; +(defun helm-org-goto-marker (marker) + (switch-to-buffer (marker-buffer marker)) + (goto-char (marker-position marker)) + (org-show-context) + (org-show-entry)) + +(cl-defun helm-source-org-headings-for-files (filenames + &optional (min-depth 1) (max-depth 8)) + (helm-build-sync-source "Org Headings" + :candidates (helm-org-get-candidates filenames min-depth max-depth) + :action '(("Go to line" . helm-org-goto-marker) + ("Refile to this heading" . helm-org-heading-refile) + ("Insert link to this heading" + . helm-org-insert-link-to-heading-at-marker)))) + +(defun helm-org-insert-link-to-heading-at-marker (marker) + (with-current-buffer (marker-buffer marker) + (let ((heading-name (save-excursion (goto-char (marker-position marker)) + (nth 4 (org-heading-components)))) + (file-name (buffer-file-name))) + (with-helm-current-buffer + (org-insert-link + file-name (concat "file:" file-name "::*" heading-name)))))) + +(defun helm-org-heading-refile (marker) + (with-helm-current-buffer + (org-cut-subtree)) + (let ((target-level (with-current-buffer (marker-buffer marker) + (goto-char (marker-position marker)) + (org-current-level)))) + (helm-org-goto-marker marker) + (org-end-of-subtree t t) + (org-paste-subtree (+ target-level 1)))) + +(defun helm-org-get-candidates (filenames min-depth max-depth) + (apply #'append + (mapcar (lambda (filename) + (helm-get-org-candidates-in-file + filename min-depth max-depth + helm-org-headings-fontify + helm-org-headings--nofilename)) + filenames))) + +(defun helm-get-org-candidates-in-file (filename min-depth max-depth + &optional fontify nofname) + (with-current-buffer (pcase filename + ((pred bufferp) filename) + ((pred stringp) (find-file-noselect filename))) + (and fontify (jit-lock-fontify-now)) + (let ((match-fn (if fontify 'match-string 'match-string-no-properties))) + (save-excursion + (goto-char (point-min)) + (cl-loop with width = (window-width) + while (re-search-forward org-complex-heading-regexp nil t) + if (let ((num-stars (length (match-string-no-properties 1)))) + (and (>= num-stars min-depth) (<= num-stars max-depth))) + collect `(,(let ((heading (funcall match-fn 4)) + (file (unless nofname + (concat (helm-basename filename) ":"))) + (level (length (match-string-no-properties 1)))) + (org-format-outline-path + (append (org-get-outline-path t level heading) + (list heading)) width file)) + . ,(point-marker))))))) + +;;;###autoload +(defun helm-org-agenda-files-headings () + (interactive) + (helm :sources (helm-source-org-headings-for-files (org-agenda-files)) + :candidate-number-limit 99999 + :buffer "*helm org headings*")) + +;;;###autoload +(defun helm-org-in-buffer-headings () + (interactive) + (let ((helm-org-headings--nofilename t)) + (helm :sources (helm-source-org-headings-for-files + (list (current-buffer))) + :candidate-number-limit 99999 + :buffer "*helm org inbuffer*"))) + +;;;###autoload +(defun helm-org-capture-templates () + (interactive) + (helm :sources (helm-source-org-capture-templates) + :candidate-number-limit 99999 + :buffer "*helm org capture templates*")) + + +(provide 'helm-org) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-org.el ends here diff --git a/elpa/helm-20150426.2119/helm-pkg.el b/elpa/helm-20150426.2119/helm-pkg.el new file mode 100644 index 00000000..071b8bf9 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-pkg.el @@ -0,0 +1,8 @@ +(define-package "helm" "20150426.2119" "Helm is an Emacs incremental and narrowing framework" + '((emacs "24") + (cl-lib "0.5") + (async "1.2")) + :url "https://emacs-helm.github.io/helm/") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/helm-20150426.2119/helm-plugin.el b/elpa/helm-20150426.2119/helm-plugin.el new file mode 100644 index 00000000..976a7349 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-plugin.el @@ -0,0 +1,137 @@ +;;; helm-plugin.el --- Helm plugins -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-utils) + + +;;; Plug-in: `info-index' +;; +;; +(defun helm-make-info-source (source file) + `(,@source + (name . ,(concat "Info Index: " file)) + (info-file . ,file) + (init . helm-info-init) + (display-to-real . helm-info-display-to-real) + (get-line . buffer-substring) + (candidates-in-buffer) + (action ("Goto node" . helm-info-goto)))) + +(defun helm-compile-source--info-index (source) + (helm-aif (helm-interpret-value (assoc-default 'info-index source)) + (helm-make-info-source source it) + source)) + +(add-to-list 'helm-compile-source-functions 'helm-compile-source--info-index) + +(helm-document-attribute 'info-index "info-index plugin" + " Create a source of info index very easily. + + Example: + + (defvar helm-source-info-wget '((info-index . \"wget\"))") + + +;;; Plug-in: `candidates-file' +;; +;; List all lines in a file. +(defun helm-compile-source--candidates-file (source) + (if (assoc-default 'candidates-file source) + `((init helm-p-candidates-file-init + ,@(let ((orig-init (assoc-default 'init source))) + (cond ((null orig-init) nil) + ((functionp orig-init) (list orig-init)) + (t orig-init)))) + (candidates-in-buffer) + ,@source) + source)) +(add-to-list 'helm-compile-source-functions 'helm-compile-source--candidates-file) + +(defun helm-p-candidates-file-init () + (cl-destructuring-bind (file &optional updating) + (helm-mklist (helm-attr 'candidates-file)) + (setq file (helm-interpret-value file)) + (with-current-buffer (helm-candidate-buffer 'global) + (insert-file-contents file) + (when updating + (buffer-disable-undo) + (font-lock-mode -1) + (auto-revert-mode 1))))) + +(helm-document-attribute 'candidates-file "candidates-file plugin" + " Use a file as the candidates buffer. + + 1st argument is a filename, string or function name or variable + name. If optional 2nd argument is non-nil, the file is opened with + `auto-revert-mode' enabled. + + Example: + + \(defvar helm-source-test-file + '((name . \"test1\") + (candidates-file \"~/.emacs.el\" t))) + + Will list all lines in .emacs.el.") + + +;;; Plug-in: `persistent-help' +;; +;; Add help about persistent action in `helm-buffer' header. +(defun helm-compile-source--persistent-help (source) + (if (assoc 'header-line source) + source + (append source '((header-line . helm-persistent-help-string))))) +(add-to-list 'helm-compile-source-functions 'helm-compile-source--persistent-help) + +(defun helm-persistent-help-string () + (substitute-command-keys + (concat "\\\\[helm-execute-persistent-action]: " + (or (helm-interpret-value (helm-attr 'persistent-help)) + (helm-aif (or (assoc-default + 'persistent-action + (helm-get-current-source)) + (assoc-default + 'action (helm-get-current-source))) + (cond ((symbolp it) + (symbol-name it)) + ((listp it) + (or (ignore-errors (caar it)) "")))) + "") + " (keeping session)"))) + + +;;; Document new attributes +;; +;; +(helm-document-attribute 'persistent-help "persistent-help plug-in" + " A string to explain persistent-action of this source. It also + accepts a function or a variable name.") + + +(provide 'helm-plugin) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-plugin ends here diff --git a/elpa/helm-20150426.2119/helm-regexp.el b/elpa/helm-20150426.2119/helm-regexp.el new file mode 100644 index 00000000..5b2b2fc7 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-regexp.el @@ -0,0 +1,643 @@ +;;; helm-regexp.el --- In buffer regexp searching and replacement for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-utils) +(require 'helm-plugin) + + +(defgroup helm-regexp nil + "Regexp related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-moccur-always-search-in-current nil + "Helm multi occur always search in current buffer when non--nil." + :group 'helm-regexp + :type 'boolean) + +(defcustom helm-moccur-use-ioccur-style-keys t + "Similar to `helm-grep-use-ioccur-style-keys' but for multi occur." + :group 'helm-regexp + :type 'boolean) + +(defcustom helm-moccur-auto-update-on-resume nil + "Allow auto updating helm-(m)occur buffer when outdated. +noask => Always update without asking +nil => Don't update but signal buffer needs update +never => Never update and do not signal buffer needs update +Any other non--nil value update after confirmation." + :group 'helm-regexp + :type '(radio :tag "Allow auto updating helm-(m)occur buffer when outdated." + (const :tag "Always update without asking" noask) + (const :tag "Never update and do not signal buffer needs update" never) + (const :tag "Don't update but signal buffer needs update" nil) + (const :tag "Update after confirmation" t))) + + +(defface helm-moccur-buffer + '((t (:foreground "DarkTurquoise" :underline t))) + "Face used to highlight moccur buffer names." + :group 'helm-regexp) + +(defface helm-resume-need-update + '((t (:background "red"))) + "Face used to flash moccur buffer when it needs update." + :group 'helm-regexp) + + +(defvar helm-moccur-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-") 'helm-goto-next-file) + (define-key map (kbd "M-") 'helm-goto-precedent-file) + (define-key map (kbd "C-w") 'helm-yank-text-at-point) + (define-key map (kbd "C-c ?") 'helm-moccur-help) + (define-key map (kbd "C-c o") 'helm-moccur-run-goto-line-ow) + (define-key map (kbd "C-c C-o") 'helm-moccur-run-goto-line-of) + (define-key map (kbd "C-x C-s") 'helm-moccur-run-save-buffer) + (when helm-moccur-use-ioccur-style-keys + (define-key map (kbd "") 'helm-execute-persistent-action) + (define-key map (kbd "") 'helm-moccur-run-default-action)) + (delq nil map)) + "Keymap used in Moccur source.") + + +(defvar helm-build-regexp-history nil) +(defun helm-query-replace-regexp (_candidate) + "Query replace regexp from `helm-regexp'. +With a prefix arg replace only matches surrounded by word boundaries, +i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b." + (let ((regexp helm-input)) + (apply 'query-replace-regexp + (helm-query-replace-args regexp)))) + +(defun helm-kill-regexp-as-sexp (_candidate) + "Kill regexp in a format usable in lisp code." + (helm-regexp-kill-new + (prin1-to-string helm-input))) + +(defun helm-kill-regexp (_candidate) + "Kill regexp as it is in `helm-pattern'." + (helm-regexp-kill-new helm-input)) + +(defun helm-query-replace-args (regexp) + "create arguments of `query-replace-regexp' action in `helm-regexp'." + (let ((region-only (helm-region-active-p))) + (list + regexp + (query-replace-read-to regexp + (format "Query replace %sregexp %s" + (if helm-current-prefix-arg "word " "") + (if region-only "in region " "")) + t) + helm-current-prefix-arg + (when region-only (region-beginning)) + (when region-only (region-end))))) + +(defvar helm-source-regexp + (helm-build-in-buffer-source "Regexp Builder" + :init (lambda () + (helm-init-candidates-in-buffer + 'global (with-temp-buffer + (insert-buffer-substring helm-current-buffer) + (buffer-string)))) + :get-line #'helm-regexp-get-line + :persistent-action #'helm-regexp-persistent-action + :persistent-help "Show this line" + :multiline t + :matchplugin nil + :requires-pattern 2 + :mode-line "Press TAB to select action." + :action '(("Kill Regexp as sexp" . helm-kill-regexp-as-sexp) + ("Query Replace Regexp (C-u Not inside word.)" + . helm-query-replace-regexp) + ("Kill Regexp" . helm-kill-regexp)))) + +(defun helm-regexp-get-line (s e) + (let ((matches (match-data)) + (line (buffer-substring s e))) + (propertize + (cl-loop with ln = (format "%5d: %s" (line-number-at-pos s) line) + for i from 0 to (1- (/ (length matches) 2)) + concat (format "\n %s'%s'" (format "Group %d: " i) + (match-string i)) + into ln1 + finally return (concat ln ln1)) + 'helm-realvalue s))) + +(defun helm-regexp-persistent-action (pt) + (helm-goto-char pt) + (helm-highlight-current-line)) + +(defun helm-regexp-kill-new (input) + (kill-new input) + (message "Killed: %s" input)) + +(defun helm-quote-whitespace (candidate) + "Quote whitespace, if some, in string CANDIDATE." + (replace-regexp-in-string " " "\\\\ " candidate)) + + +;;; Occur +;; +;; +(defvar helm-source-occur nil) +(defun helm-occur-init-source () + (unless helm-source-occur + (setq helm-source-occur + (helm-make-source "Occur" 'helm-source-multi-occur)))) + + +;;; Multi occur +;; +;; + +;; Internal +(defvar helm-multi-occur-buffer-list nil) +(defvar helm-multi-occur-buffer-tick nil) +(defun helm-moccur-init () + "Create the initial helm multi occur buffer." + (helm-init-candidates-in-buffer + 'global + (cl-loop with buffers = (helm-attr 'moccur-buffers) + for buf in buffers + for bufstr = (with-current-buffer buf (buffer-string)) + do (add-text-properties + 0 (length bufstr) + `(buffer-name ,(buffer-name (get-buffer buf))) + bufstr) + concat bufstr))) + +(defun helm-moccur--next-or-previous-char () + (save-excursion + (or (re-search-forward "^." nil t) + (re-search-backward "^." nil t)))) + +(defun helm-moccur-get-line (beg end) + "Format line for `helm-source-moccur'." + (prog1 + (format "%s:%d:%s" + (get-text-property (if (= beg end) + (helm-moccur--next-or-previous-char) + beg) + 'buffer-name) + (save-restriction + (narrow-to-region (or (previous-single-property-change + (point) 'buffer-name) 1) + (or (next-single-property-change + (if (= beg end) + (helm-moccur--next-or-previous-char) + (point)) + 'buffer-name) + (point-max))) + (line-number-at-pos beg)) + ;; When matching empty line, use empty string + ;; to allow saving and modifying with wgrep. + (if (= beg end) "" (buffer-substring beg end))) + ;; When matching empty line, forward char ("\n") + ;; to not be blocked forever here. + (when (= beg end) (forward-char 1)))) + +(cl-defun helm-moccur-action (candidate + &optional (method (quote buffer)) mark) + "Jump to CANDIDATE with METHOD. +arg METHOD can be one of buffer, buffer-other-window, buffer-other-frame." + (require 'helm-grep) + (let* ((split (helm-grep-split-line candidate)) + (buf (car split)) + (lineno (string-to-number (nth 1 split))) + (split-pat (helm-mp-split-pattern helm-pattern))) + (cl-case method + (buffer (switch-to-buffer buf)) + (buffer-other-window (switch-to-buffer-other-window buf)) + (buffer-other-frame (switch-to-buffer-other-frame buf))) + (helm-goto-line lineno) + ;; Move point to the nearest matching regexp from bol. + (cl-loop for reg in split-pat + when (save-excursion + (condition-case _err + (re-search-forward reg (point-at-eol) t) + (invalid-regexp nil))) + collect (match-beginning 0) into pos-ls + finally (when pos-ls (goto-char (apply #'min pos-ls)))) + (when mark + (set-marker (mark-marker) (point)) + (push-mark (point) 'nomsg)))) + +(defun helm-moccur-persistent-action (candidate) + (helm-moccur-goto-line candidate) + (helm-highlight-current-line)) + +(defun helm-moccur-goto-line (candidate) + "From multi occur, switch to buffer and go to nth 1 CANDIDATE line." + (helm-moccur-action + candidate 'buffer (or current-prefix-arg ; persistent. + helm-current-prefix-arg))) ; exit. + +(defun helm-moccur-goto-line-ow (candidate) + "Go to CANDIDATE line in other window. +Same as `helm-moccur-goto-line' but go in other window." + (helm-moccur-action + candidate 'buffer-other-window + (or current-prefix-arg ; persistent. + helm-current-prefix-arg))) ; exit. + +(defun helm-moccur-goto-line-of (candidate) + "Go to CANDIDATE line in new frame. +Same as `helm-moccur-goto-line' but go in new frame." + (helm-moccur-action + candidate 'buffer-other-frame + (or current-prefix-arg ; persistent. + helm-current-prefix-arg))) ; exit. + +(defun helm-moccur-run-goto-line-ow () + "Run goto line other window action from `helm-source-moccur'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-moccur-goto-line-ow))) + +(defun helm-moccur-run-goto-line-of () + "Run goto line new frame action from `helm-source-moccur'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-moccur-goto-line-of))) + +(defun helm-moccur-run-default-action () + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-moccur-goto-line))) + +(defvar helm-source-moccur nil) +(defclass helm-source-multi-occur (helm-source-in-buffer) + ((init :initform (lambda () + (require 'helm-grep) + (helm-moccur-init))) + (filter-one-by-one :initform 'helm-moccur-filter-one-by-one) + (get-line :initform helm-moccur-get-line) + (nohighlight :initform t) + (migemo :initform t) + (action :initform '(("Go to Line" . helm-moccur-goto-line) + ("Goto line other window" . helm-moccur-goto-line-ow) + ("Goto line new frame" . helm-moccur-goto-line-of))) + (persistent-action :initform 'helm-moccur-persistent-action) + (persistent-help :initform "Go to line") + (recenter :initform t) + (resume :initform 'helm-moccur-resume-fn) + (candidate-number-limit :initform 9999) + (mode-line :initform helm-moccur-mode-line) + (keymap :initform helm-moccur-map) + (history :initform 'helm-grep-history) + (requires-pattern :initform 2))) + +(defun helm-moccur-resume-fn () + (with-helm-buffer + (let (new-tick-ls buffer-is-modified) + (set (make-local-variable 'helm-multi-occur-buffer-list) + (cl-loop for b in helm-multi-occur-buffer-list + when (buffer-live-p (get-buffer b)) + collect b)) + (setq buffer-is-modified (/= (length helm-multi-occur-buffer-list) + (length (helm-attr 'moccur-buffers)))) + (helm-attrset 'moccur-buffers helm-multi-occur-buffer-list) + (setq new-tick-ls (cl-loop for b in helm-multi-occur-buffer-list + collect (buffer-chars-modified-tick (get-buffer b)))) + (when buffer-is-modified + (setq helm-multi-occur-buffer-tick new-tick-ls)) + (cl-assert (> (length helm-multi-occur-buffer-list) 0) nil + "helm-resume error: helm-(m)occur buffer list is empty") + (unless (eq helm-moccur-auto-update-on-resume 'never) + (when (or buffer-is-modified + (cl-loop for b in helm-multi-occur-buffer-list + for new-tick = (buffer-chars-modified-tick (get-buffer b)) + for tick in helm-multi-occur-buffer-tick + thereis (/= tick new-tick))) + (helm-aif helm-moccur-auto-update-on-resume + (when (or (eq it 'noask) + (y-or-n-p "Helm (m)occur Buffer outdated, update? ")) + (run-with-idle-timer 0.1 nil (lambda () + (with-helm-buffer + (helm-force-update) + (message "Helm (m)occur Buffer have been udated") + (sit-for 1) (message nil)))) + (unless buffer-is-modified (setq helm-multi-occur-buffer-tick new-tick-ls))) + (run-with-idle-timer 0.1 nil (lambda () + (with-helm-buffer + (let ((ov (make-overlay (save-excursion + (goto-char (point-min)) + (forward-line 1) + (point)) + (point-max)))) + (overlay-put ov 'face 'helm-resume-need-update) + (sit-for 0.3) (delete-overlay ov) + (message "[Helm occur Buffer outdated (C-c C-u to update)]"))))) + (unless buffer-is-modified + (with-helm-after-update-hook + (setq helm-multi-occur-buffer-tick new-tick-ls) + (message "Helm (m)occur Buffer have been udated"))))))))) + +(defun helm-moccur-filter-one-by-one (candidate) + "`filter-one-by-one' function for `helm-source-moccur'." + (require 'helm-grep) + (let* ((split (helm-grep-split-line candidate)) + (buf (car split)) + (lineno (nth 1 split)) + (str (nth 2 split))) + (cons (concat (propertize + buf + 'face 'helm-moccur-buffer + 'help-echo (buffer-file-name + (get-buffer buf)) + 'buffer-name buf) + ":" + (propertize lineno 'face 'helm-grep-lineno) + ":" + (helm-grep-highlight-match str t)) + candidate))) + +(defun helm-multi-occur-1 (buffers &optional input) + "Main function to call `helm-source-moccur' with BUFFERS list." + (let ((bufs (if helm-moccur-always-search-in-current + (cons + ;; will become helm-current-buffer later. + (buffer-name (current-buffer)) + (remove helm-current-buffer buffers)) + buffers))) + (unless helm-source-moccur + (setq helm-source-moccur + (helm-make-source "Moccur" 'helm-source-multi-occur))) + (helm-attrset 'moccur-buffers bufs helm-source-moccur) + (helm-set-local-variable 'helm-multi-occur-buffer-list bufs) + (helm-set-local-variable + 'helm-multi-occur-buffer-tick + (cl-loop for b in bufs + collect (buffer-chars-modified-tick (get-buffer b))))) + (helm :sources 'helm-source-moccur + :buffer "*helm multi occur*" + :history 'helm-grep-history + :input input + :truncate-lines t)) + +;;;###autoload +(defun helm-moccur-run-save-buffer () + "Run grep save results action from `helm-do-grep-1'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action 'helm-moccur-save-results))) + + +;;; helm-moccur-mode +;; +;; +(defvar helm-moccur-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "RET") 'helm-moccur-mode-goto-line) + (define-key map (kbd "C-o") 'helm-moccur-mode-goto-line-ow) + (define-key map (kbd "") 'helm-moccur-mode-goto-line-ow-forward) + (define-key map (kbd "") 'helm-moccur-mode-goto-line-ow-backward) + (define-key map (kbd "") 'helm-gm-next-file) + (define-key map (kbd "") 'helm-gm-precedent-file) + (define-key map (kbd "M-n") 'helm-moccur-mode-goto-line-ow-forward) + (define-key map (kbd "M-p") 'helm-moccur-mode-goto-line-ow-backward) + (define-key map (kbd "M-N") 'helm-gm-next-file) + (define-key map (kbd "M-P") 'helm-gm-precedent-file) + map)) + +(defun helm-moccur-mode-goto-line () + (interactive) + (helm-aif (get-text-property (point) 'helm-realvalue) + (helm-moccur-goto-line it))) + +(defun helm-moccur-mode-goto-line-ow () + (interactive) + (helm-aif (get-text-property (point) 'helm-realvalue) + (helm-moccur-goto-line-ow it))) + +(defun helm-moccur-mode-goto-line-ow-forward-1 (arg) + (condition-case nil + (progn + (save-selected-window + (helm-moccur-mode-goto-line-ow) + (recenter)) + (forward-line arg)) + (error nil))) + +(defun helm-moccur-mode-goto-line-ow-forward () + (interactive) + (helm-moccur-mode-goto-line-ow-forward-1 1)) + +(defun helm-moccur-mode-goto-line-ow-backward () + (interactive) + (helm-moccur-mode-goto-line-ow-forward-1 -1)) + +(defun helm-moccur-save-results (_candidate) + "Save helm moccur results in a `helm-moccur-mode' buffer." + (let ((buf "*hmoccur*") + new-buf) + (when (get-buffer buf) + (setq new-buf (helm-read-string "OccurBufferName: " buf)) + (cl-loop for b in (helm-buffer-list) + when (and (string= new-buf b) + (not (y-or-n-p + (format "Buffer `%s' already exists overwrite? " + new-buf)))) + do (setq new-buf (helm-read-string "OccurBufferName: " "*hmoccur "))) + (setq buf new-buf)) + (with-current-buffer (get-buffer-create buf) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert "-*- mode: helm-moccur -*-\n\n" + (format "Moccur Results for `%s':\n\n" helm-pattern)) + (save-excursion + (insert (with-current-buffer helm-buffer + (goto-char (point-min)) (forward-line 1) + (buffer-substring (point) (point-max)))))) + (helm-moccur-mode) (pop-to-buffer buf)) + (message "Helm Moccur Results saved in `%s' buffer" buf))) + +;;;###autoload +(define-derived-mode helm-moccur-mode + special-mode "helm-moccur" + "Major mode to provide actions in helm moccur saved buffer. + +Special commands: +\\{helm-moccur-mode-map}" + (set (make-local-variable 'helm-multi-occur-buffer-list) + (with-helm-buffer helm-multi-occur-buffer-list)) + (set (make-local-variable 'revert-buffer-function) + #'helm-moccur-mode--revert-buffer-function)) + +(defun helm-moccur-mode--revert-buffer-function (&optional _ignore-auto _noconfirm) + (goto-char (point-min)) + (let (pattern) + (when (re-search-forward "^Moccur Results for `\\(.*\\)'" nil t) + (setq pattern (match-string 1)) + (forward-line 0) + (when (re-search-forward "^$" nil t) + (forward-line 1)) + (let ((inhibit-read-only t) + (buffer (current-buffer)) + (buflst helm-multi-occur-buffer-list)) + (delete-region (point) (point-max)) + (message "Reverting buffer...") + (save-excursion + (with-temp-buffer + (insert + "\n" + (cl-loop for buf in buflst + for bufstr = (or (and (buffer-live-p (get-buffer buf)) + (with-current-buffer buf + (buffer-string))) + "") + unless (string= bufstr "") + do (add-text-properties + 0 (length bufstr) + `(buffer-name ,(buffer-name (get-buffer buf))) + bufstr) + concat bufstr) + "\n") + (goto-char (point-min)) + (cl-loop while (re-search-forward pattern nil t) + for line = (helm-moccur-get-line (point-at-bol) (point-at-eol)) + when line + do (with-current-buffer buffer + (insert + (propertize + (car (helm-moccur-filter-one-by-one line)) + 'helm-real-value line) + "\n"))))) + (message "Reverting buffer done"))))) + + +;;; Predefined commands +;; +;; + +;;;###autoload +(defun helm-regexp () + "Preconfigured helm to build regexps. +`query-replace-regexp' can be run from there against found regexp." + (interactive) + (save-restriction + (when (and (helm-region-active-p) + ;; Don't narrow to region if buffer is already narrowed. + (not (helm-current-buffer-narrowed-p (current-buffer)))) + (narrow-to-region (region-beginning) (region-end))) + (helm :sources helm-source-regexp + :buffer "*helm regexp*" + :prompt "Regexp: " + :history 'helm-build-regexp-history))) + +;;;###autoload +(defun helm-occur () + "Preconfigured helm for Occur." + (interactive) + (helm-occur-init-source) + (let ((bufs (list (buffer-name (current-buffer))))) + (helm-attrset 'moccur-buffers bufs helm-source-occur) + (helm-set-local-variable 'helm-multi-occur-buffer-list bufs) + (helm-set-local-variable + 'helm-multi-occur-buffer-tick + (cl-loop for b in bufs + collect (buffer-chars-modified-tick (get-buffer b))))) + (helm :sources 'helm-source-occur + :buffer "*helm occur*" + :history 'helm-grep-history + :preselect (and (memq 'helm-source-occur helm-sources-using-default-as-input) + (format "%s:%d:" (buffer-name) (line-number-at-pos (point)))) + :truncate-lines t)) + +;;;###autoload +(defun helm-occur-from-isearch () + "Invoke `helm-occur' from isearch." + (interactive) + (let ((input (if isearch-regexp + isearch-string + (regexp-quote isearch-string))) + (bufs (list (buffer-name (current-buffer))))) + (isearch-exit) + (helm-occur-init-source) + (helm-attrset 'moccur-buffers bufs helm-source-occur) + (helm-set-local-variable 'helm-multi-occur-buffer-list bufs) + (helm-set-local-variable + 'helm-multi-occur-buffer-tick + (cl-loop for b in bufs + collect (buffer-chars-modified-tick (get-buffer b)))) + (helm :sources 'helm-source-occur + :buffer "*helm occur*" + :history 'helm-grep-history + :input input + :truncate-lines t))) + +;;;###autoload +(defun helm-multi-occur (buffers) + "Preconfigured helm for multi occur. + + BUFFERS is a list of buffers to search through. +With a prefix arg, reverse the behavior of +`helm-moccur-always-search-in-current'. +The prefix arg can be set before calling `helm-multi-occur' +or during the buffer selection." + (interactive (list (helm-comp-read + "Buffers: " (helm-buffer-list) + :marked-candidates t))) + (let ((helm-moccur-always-search-in-current + (if (or current-prefix-arg + helm-current-prefix-arg) + (not helm-moccur-always-search-in-current) + helm-moccur-always-search-in-current))) + (helm-multi-occur-1 buffers))) + +;;;###autoload +(defun helm-multi-occur-from-isearch (&optional _arg) + "Invoke `helm-multi-occur' from isearch. + +With a prefix arg, reverse the behavior of +`helm-moccur-always-search-in-current'. +The prefix arg can be set before calling +`helm-multi-occur-from-isearch' or during the buffer selection." + (interactive "p") + (let (buf-list + helm-moccur-always-search-in-current + (input (if isearch-regexp + isearch-string + (regexp-quote isearch-string)))) + (isearch-exit) + (setq buf-list (helm-comp-read "Buffers: " + (helm-buffer-list) + :name "Occur in buffer(s)" + :marked-candidates t)) + (setq helm-moccur-always-search-in-current + (if (or current-prefix-arg + helm-current-prefix-arg) + (not helm-moccur-always-search-in-current) + helm-moccur-always-search-in-current)) + (helm-multi-occur-1 buf-list input))) + + +(provide 'helm-regexp) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-regexp.el ends here diff --git a/elpa/helm-20150426.2119/helm-ring.el b/elpa/helm-20150426.2119/helm-ring.el new file mode 100644 index 00000000..a43895c6 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-ring.el @@ -0,0 +1,416 @@ +;;; helm-ring.el --- kill-ring, mark-ring, and register browsers for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-utils) +(require 'helm-elisp) + +(declare-function undo-tree-restore-state-from-register "ext:undo-tree.el" (register)) + + +(defgroup helm-ring nil + "Ring related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-kill-ring-threshold 3 + "Minimum length of a candidate to be listed by `helm-source-kill-ring'." + :type 'integer + :group 'helm-ring) + +(defcustom helm-kill-ring-max-lines-number 5 + "Max number of lines displayed per candidate in kill-ring browser. +If nil or zero (disabled), don't truncate candidate, show all." + :type '(choice (const :tag "Disabled" nil) + (integer :tag "Max number of lines")) + :group 'helm-ring) + +(defcustom helm-register-max-offset 160 + "Max size of string register entries before truncating." + :group 'helm-ring + :type 'integer) + + +;;; Kill ring +;; +;; +(defvar helm-kill-ring-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-y") 'helm-next-line) + (define-key map (kbd "M-u") 'helm-previous-line) + map) + "Keymap for `helm-show-kill-ring'.") + +(defvar helm-source-kill-ring + (helm-build-sync-source "Kill Ring" + :init (lambda () (helm-attrset 'last-command last-command)) + :candidates #'helm-kill-ring-candidates + :filtered-candidate-transformer #'helm-kill-ring-transformer + :action '(("Yank" . helm-kill-ring-action) + ("Delete" . (lambda (candidate) + (cl-loop for cand in (helm-marked-candidates) + do (setq kill-ring + (delete cand kill-ring)))))) + :persistent-action (lambda (_candidate) (ignore)) + :persistent-help "DoNothing" + :keymap helm-kill-ring-map + :migemo t + :multiline t) + "Source for browse and insert contents of kill-ring.") + +(defun helm-kill-ring-candidates () + (cl-loop for kill in (helm-fast-remove-dups kill-ring :test 'equal) + unless (or (< (length kill) helm-kill-ring-threshold) + (string-match "\\`[\n[:blank:]]+\\'" kill)) + collect kill)) + +(defun helm-kill-ring-transformer (candidates _source) + "Display only the `helm-kill-ring-max-lines-number' lines of candidate." + (cl-loop for i in candidates + when (get-text-property 0 'read-only i) + do (set-text-properties 0 (length i) '(read-only nil) i) + for nlines = (with-temp-buffer (insert i) (count-lines (point-min) (point-max))) + if (and helm-kill-ring-max-lines-number + (> nlines helm-kill-ring-max-lines-number)) + collect (cons + (with-temp-buffer + (insert i) + (goto-char (point-min)) + (concat + (buffer-substring + (point-min) + (save-excursion + (forward-line helm-kill-ring-max-lines-number) + (point))) + "[...]")) i) + else collect i)) + +(defun helm-kill-ring-action (str) + "Insert STR in `kill-ring' and set STR to the head. +If this action is executed just after `yank', +replace with STR as yanked string." + (with-helm-current-buffer + (setq kill-ring (delete str kill-ring)) + (if (not (eq (helm-attr 'last-command helm-source-kill-ring) 'yank)) + (run-with-timer 0.01 nil `(lambda () (insert-for-yank ,str))) + ;; from `yank-pop' + (let ((inhibit-read-only t) + (before (< (point) (mark t)))) + (if before + (funcall (or yank-undo-function 'delete-region) (point) (mark t)) + (funcall (or yank-undo-function 'delete-region) (mark t) (point))) + (setq yank-undo-function nil) + (set-marker (mark-marker) (point) helm-current-buffer) + (run-with-timer 0.01 nil `(lambda () (insert-for-yank ,str))) + ;; Set the window start back where it was in the yank command, + ;; if possible. + (set-window-start (selected-window) yank-window-start t) + (when before + ;; This is like exchange-point-and-mark, but doesn't activate the mark. + ;; It is cleaner to avoid activation, even though the command + ;; loop would deactivate the mark because we inserted text. + (goto-char (prog1 (mark t) + (set-marker (mark-marker) (point) helm-current-buffer)))))) + (kill-new str))) + + + + +;;;; +;; DO NOT use these sources with other sources use +;; the commands `helm-mark-ring', `helm-global-mark-ring' or +;; `helm-all-mark-rings' instead. + +(defun helm-mark-ring-get-marks (pos) + (save-excursion + (goto-char pos) + (forward-line 0) + (let ((line (car (split-string (thing-at-point 'line) "[\n\r]")))) + (when (string= "" line) + (setq line "")) + (format "%7d: %s" (line-number-at-pos) line)))) + +(defun helm-mark-ring-get-candidates () + (with-helm-current-buffer + (cl-loop with marks = (if (mark t) (cons (mark-marker) mark-ring) mark-ring) + for i in marks + for m = (helm-mark-ring-get-marks i) + unless (and recip (member m recip)) + collect m into recip + finally return recip))) + +(defvar helm-source-mark-ring + (helm-build-sync-source "mark-ring" + :candidates #'helm-mark-ring-get-candidates + :action '(("Goto line" + . (lambda (candidate) + (helm-goto-line (string-to-number candidate))))) + :persistent-action (lambda (candidate) + (helm-goto-line (string-to-number candidate)) + (helm-highlight-current-line)) + :persistent-help "Show this line")) + + +;;; Global-mark-ring +(defvar helm-source-global-mark-ring + (helm-build-sync-source "global-mark-ring" + :candidates #'helm-global-mark-ring-get-candidates + :action '(("Goto line" + . (lambda (candidate) + (let ((items (split-string candidate ":"))) + (switch-to-buffer (cl-second items)) + (helm-goto-line (string-to-number (car items))))))) + :persistent-action (lambda (candidate) + (let ((items (split-string candidate ":"))) + (switch-to-buffer (cl-second items)) + (helm-goto-line (string-to-number (car items))) + (helm-highlight-current-line))) + :persistent-help "Show this line")) + +(defun helm-global-mark-ring-format-buffer (marker) + (with-current-buffer (marker-buffer marker) + (goto-char marker) + (forward-line 0) + (let (line) + (if (string= "" line) + (setq line "") + (setq line (car (split-string (thing-at-point 'line) + "[\n\r]")))) + (format "%7d:%s: %s" + (line-number-at-pos) (marker-buffer marker) line)))) + +(defun helm-global-mark-ring-get-candidates () + (let ((marks global-mark-ring)) + (when marks + (cl-loop for i in marks + for gm = (unless (or (string-match + "^ " (format "%s" (marker-buffer i))) + (null (marker-buffer i))) + (helm-global-mark-ring-format-buffer i)) + when (and gm (not (member gm recip))) + collect gm into recip + finally return recip)))) + + +;;;; +;;; Insert from register +(defvar helm-source-register + (helm-build-sync-source "Registers" + :candidates #'helm-register-candidates + :action-transformer #'helm-register-action-transformer + :multiline t + :action nil) + "See (info \"(emacs)Registers\")") + +(defun helm-register-candidates () + "Collecting register contents and appropriate commands." + (cl-loop for (char . val) in register-alist + for key = (single-key-description char) + for string-actions = + (cond + ((numberp val) + (list (int-to-string val) + 'insert-register + 'increment-register)) + ((markerp val) + (let ((buf (marker-buffer val))) + (if (null buf) + (list "a marker in no buffer") + (list (concat + "a buffer position:" + (buffer-name buf) + ", position " + (int-to-string (marker-position val))) + 'jump-to-register + 'insert-register)))) + ((and (consp val) (window-configuration-p (car val))) + (list "window configuration." + 'jump-to-register)) + ((and (vectorp val) + (fboundp 'undo-tree-register-data-p) + (undo-tree-register-data-p (elt val 1))) + (list + "Undo-tree entry." + 'undo-tree-restore-state-from-register)) + ((or (and (vectorp val) (eq 'registerv (aref val 0))) + (and (consp val) (frame-configuration-p (car val)))) + (list "frame configuration." + 'jump-to-register)) + ((and (consp val) (eq (car val) 'file)) + (list (concat "file:" + (prin1-to-string (cdr val)) + ".") + 'jump-to-register)) + ((and (consp val) (eq (car val) 'file-query)) + (list (concat "file:a file-query reference: file " + (car (cdr val)) + ", position " + (int-to-string (car (cdr (cdr val)))) + ".") + 'jump-to-register)) + ((consp val) + (let ((lines (format "%4d" (length val)))) + (list (format "%s: %s\n" lines + (truncate-string-to-width + (mapconcat 'identity (list (car val)) + "^J") (- (window-width) 15))) + 'insert-register))) + ((stringp val) + (list + ;; without properties + (concat (substring-no-properties + val 0 (min (length val) helm-register-max-offset)) + (if (> (length val) helm-register-max-offset) + "[...]" "")) + 'insert-register + 'append-to-register + 'prepend-to-register)) + (t + "GARBAGE!")) + collect (cons (format "Register %3s:\n %s" key (car string-actions)) + (cons char (cdr string-actions))))) + +(defun helm-register-action-transformer (_actions register-and-functions) + "Decide actions by the contents of register." + (cl-loop with func-actions = + '((insert-register + "Insert Register" . + (lambda (c) (insert-register (car c)))) + (jump-to-register + "Jump to Register" . + (lambda (c) (jump-to-register (car c)))) + (append-to-register + "Append Region to Register" . + (lambda (c) (append-to-register + (car c) (region-beginning) (region-end)))) + (prepend-to-register + "Prepend Region to Register" . + (lambda (c) (prepend-to-register + (car c) (region-beginning) (region-end)))) + (increment-register + "Increment Prefix Arg to Register" . + (lambda (c) (increment-register + helm-current-prefix-arg (car c)))) + (undo-tree-restore-state-from-register + "Restore Undo-tree register" + (lambda (c) (and (fboundp 'undo-tree-restore-state-from-register) + (undo-tree-restore-state-from-register (car c)))))) + for func in (cdr register-and-functions) + for cell = (assq func func-actions) + when cell + collect (cdr cell))) + +;;;###autoload +(defun helm-mark-ring () + "Preconfigured `helm' for `helm-source-mark-ring'." + (interactive) + (helm :sources 'helm-source-mark-ring + :resume 'noresume + :buffer "*helm mark*")) + +;;;###autoload +(defun helm-global-mark-ring () + "Preconfigured `helm' for `helm-source-global-mark-ring'." + (interactive) + (helm :sources 'helm-source-global-mark-ring + :resume 'noresume + :buffer "*helm global mark*")) + +;;;###autoload +(defun helm-all-mark-rings () + "Preconfigured `helm' for `helm-source-global-mark-ring' and \ +`helm-source-mark-ring'." + (interactive) + (helm :sources '(helm-source-mark-ring + helm-source-global-mark-ring) + :resume 'noresume + :buffer "*helm mark ring*")) + +;;;###autoload +(defun helm-register () + "Preconfigured `helm' for Emacs registers." + (interactive) + (helm :sources 'helm-source-register + :resume 'noresume + :buffer "*helm register*")) + +;;;###autoload +(defun helm-show-kill-ring () + "Preconfigured `helm' for `kill-ring'. +It is drop-in replacement of `yank-pop'. + +First call open the kill-ring browser, next calls move to next line." + (interactive) + (let ((enable-recursive-minibuffers t)) + (helm :sources helm-source-kill-ring + :buffer "*helm kill ring*" + :resume 'noresume + :allow-nest t))) + +(defvar helm-kmacro-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c ?") 'helm-kmacro-help) + map)) + +;;;###autoload +(defun helm-execute-kmacro () + "Keyboard macros with helm interface. +Define your macros with `f3' and `f4'. +See (info \"(emacs) Keyboard Macros\") for detailed infos. +This command is useful when used with persistent action." + (interactive) + (helm :sources + (helm-build-sync-source "Kmacro" + :candidates (lambda () + (helm-fast-remove-dups + (cons (kmacro-ring-head) + kmacro-ring) + :test 'equal)) + :multiline t + :keymap helm-kmacro-map + :candidate-transformer + (lambda (candidates) + (cl-loop for c in candidates collect + (propertize (help-key-description (car c) nil) + 'helm-realvalue c))) + :persistent-help "Execute kmacro" + :action + (helm-make-actions + "Execute kmacro (`C-u ' to execute times)" + (lambda (candidate) + (interactive) + ;; Move candidate on top of list for next use. + (setq kmacro-ring (delete candidate kmacro-ring)) + (kmacro-push-ring) + (kmacro-split-ring-element candidate) + (kmacro-exec-ring-item + candidate helm-current-prefix-arg)))) + :buffer "*helm kmacro*")) + +(provide 'helm-ring) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-ring.el ends here diff --git a/elpa/helm-20150426.2119/helm-semantic.el b/elpa/helm-20150426.2119/helm-semantic.el new file mode 100644 index 00000000..72ab49c5 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-semantic.el @@ -0,0 +1,209 @@ +;;; helm-semantic.el --- Helm interface for Semantic -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Daniel Hackney +;; Author: Daniel Hackney + +;; 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 . + +;;; Commentary: + +;; Uses `candidates-in-buffer' for speed. + +;;; Code: + +(require 'cl-lib) +(require 'semantic) +(require 'helm-imenu) + +(declare-function pulse-momentary-highlight-one-line "pulse.el" (point &optional face)) + +(defgroup helm-semantic nil + "Semantic tags related libraries and applications for helm." + :group 'helm) + +(defcustom helm-semantic-lynx-style-map t + "Use Arrow keys to jump to occurences." + :group 'helm-semantic + :type 'boolean) + +(defcustom helm-semantic-display-style 'semantic-format-tag-summarize + "Function to present a semantic tag." + :group 'helm-semantic + :type '(radio + (const :tag "Default" semantic-format-tag-summarize) + (const :tag "Prototype" semantic-format-tag-prototype))) + +;;; keymap +(defvar helm-semantic-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c ?") 'helm-semantic-help) + (when helm-semantic-lynx-style-map + (define-key map (kbd "") 'helm-maybe-exit-minibuffer) + (define-key map (kbd "") 'helm-execute-persistent-action)) + (delq nil map))) + +;; Internals vars +(defvar helm-semantic--tags-cache nil) + +(defun helm-semantic--fetch-candidates (tags depth &optional class) + "Write the contents of TAGS to the current buffer." + (let ((class class) cur-type) + (cl-dolist (tag tags) + (when (listp tag) + (cl-case (setq cur-type (semantic-tag-class tag)) + ((function variable type) + (let ((spaces (make-string (* depth 2) ?\s)) + (type-p (eq cur-type 'type))) + (unless (and (> depth 0) (not type-p)) + (setq class nil)) + (insert + (if (and class (not type-p)) + (format "%s%s(%s) " + spaces (if (< depth 2) "" "├►") class) + spaces) + ;; Save the tag for later + (propertize (funcall helm-semantic-display-style tag nil t) + 'semantic-tag tag) + "\n") + (and type-p (setq class (car tag))) + ;; Recurse to children + (unless (eq cur-type 'function) + (helm-semantic--fetch-candidates + (semantic-tag-components tag) (1+ depth) class)))) + + ;; Don't do anything with packages or includes for now + ((package include) + (insert + (propertize (funcall helm-semantic-display-style tag nil t) + 'semantic-tag tag) + "\n") + ) + ;; Catch-all + (t)))))) + +(defun helm-semantic-default-action (_candidate &optional persistent) + ;; By default, helm doesn't pass on the text properties of the selection. + ;; Fix this. + (helm-log-run-hook 'helm-goto-line-before-hook) + (with-current-buffer helm-buffer + (when (looking-at " ") + (goto-char (next-single-property-change + (point-at-bol) 'semantic-tag nil (point-at-eol)))) + (let ((tag (get-text-property (point) 'semantic-tag))) + (semantic-go-to-tag tag) + (unless persistent + (pulse-momentary-highlight-one-line (point)))))) + +(defun helm-semantic--maybe-set-needs-update () + (with-helm-current-buffer + (let ((tick (buffer-modified-tick))) + (unless (eq helm-cached-imenu-tick tick) + (setq helm-cached-imenu-tick tick) + (semantic-parse-tree-set-needs-update))))) + +(defvar helm-source-semantic nil) + +(defclass helm-semantic-source (helm-source-in-buffer) + ((init :initform (lambda () + (helm-semantic--maybe-set-needs-update) + (setq helm-semantic--tags-cache (semantic-fetch-tags)) + (with-current-buffer (helm-candidate-buffer 'global) + (let ((major-mode (with-helm-current-buffer major-mode))) + (helm-semantic--fetch-candidates helm-semantic--tags-cache 0))))) + (get-line :initform 'buffer-substring) + (persistent-help :initform "Show this entry") + (keymap :initform 'helm-semantic-map) + (mode-line :initform helm-semantic-mode-line) + (persistent-action :initform (lambda (elm) + (helm-semantic-default-action elm t) + (helm-highlight-current-line))) + (action :initform 'helm-semantic-default-action))) + +(defcustom helm-semantic-fuzzy-match nil + "Enable fuzzy matching in `helm-source-semantic'." + :group 'helm-semantic + :type 'boolean + :set (lambda (var val) + (set var val) + (setq helm-source-semantic + (helm-make-source "Semantic Tags" 'helm-semantic-source + :fuzzy-match helm-semantic-fuzzy-match)))) + +;;;###autoload +(defun helm-semantic (arg) + "Preconfigured `helm' for `semantic'. +If ARG is supplied, pre-select symbol at point instead of current" + (interactive "P") + (let ((tag (helm-aif (semantic-current-tag-parent) + (cons (format "\\_<%s\\_>" (car it)) + (format "\\_<%s\\_>" (car (semantic-current-tag)))) + (format "\\_<%s\\_>" (car (semantic-current-tag)))))) + (unless helm-source-semantic + (setq helm-source-semantic + (helm-make-source "Semantic Tags" 'helm-semantic-source + :fuzzy-match helm-semantic-fuzzy-match))) + (helm :sources 'helm-source-semantic + :candidate-number-limit 9999 + :preselect (if arg + (thing-at-point 'symbol) + tag) + :buffer "*helm semantic*"))) + +;;;###autoload +(defun helm-semantic-or-imenu (arg) + "Run `helm' with `semantic' or `imenu'. +If ARG is supplied, pre-select symbol at point instead of current +semantic tag in scope. + +If `semantic-mode' is active in the current buffer, then use +semantic for generating tags, otherwise fall back to `imenu'. +Fill in the symbol at point by default." + (interactive "P") + (unless helm-source-semantic + (setq helm-source-semantic + (helm-make-source "Semantic Tags" 'helm-semantic-source + :fuzzy-match helm-semantic-fuzzy-match))) + (unless helm-source-imenu + (setq helm-source-imenu + (helm-make-source "Imenu" 'helm-imenu-source + :fuzzy-match helm-imenu-fuzzy-match))) + (let* ((source (if (semantic-active-p) + 'helm-source-semantic + 'helm-source-imenu)) + (imenu-p (eq source 'helm-source-imenu)) + (imenu-auto-rescan imenu-p) + (helm-execute-action-at-once-if-one + (and imenu-p + helm-imenu-execute-action-at-once-if-one)) + (tag (helm-aif (semantic-current-tag-parent) + (cons (format "\\_<%s\\_>" (car it)) + (format "\\_<%s\\_>" (car (semantic-current-tag)))) + (format "\\_<%s\\_>" (car (semantic-current-tag)))))) + (helm :sources source + :candidate-number-limit 9999 + :preselect (if (or arg imenu-p) + (thing-at-point 'symbol) + tag) + :buffer "*helm semantic/imenu*"))) + +(provide 'helm-semantic) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-semantic.el ends here diff --git a/elpa/helm-20150426.2119/helm-source.el b/elpa/helm-20150426.2119/helm-source.el new file mode 100644 index 00000000..2a2e65c4 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-source.el @@ -0,0 +1,1148 @@ +;;; helm-source.el --- Helm source creation. -*- lexical-binding: t -*- + +;; Copyright (C) 2015 Thierry Volpiatto + +;; Author: Thierry Volpiatto +;; URL: http://github.com/emacs-helm/helm + +;; 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 . + +;;; Commentary: + +;; Interface to create helm sources easily. +;; Actually the eieo objects are transformed in alist for compatibility. +;; In the future this package should allow creating source as eieo objects +;; without conversion to alist, teaching helm to read such a structure. +;; The compatibility with alists would be kept. + +;;; Code: + +(require 'cl-lib) +(require 'eieio) + + +(defgeneric helm--setup-source (source) + "Prepare slots and handle slot errors before creating a helm source.") + +(defgeneric helm-setup-user-source (source) + "Allow users modifying slots in SOURCE just before creation.") + + +;;; Classes for sources +;; +;; +(defclass helm-source () + ((name + :initarg :name + :initform nil + :custom string + :documentation + " The name of the source. + A string which is also the heading which appears + above the list of matches from the source. Must be unique.") + + (header-name + :initarg :header-name + :initform nil + :custom function + :documentation + " A function returning the display string of the header. + Its argument is the name of the source. This attribute is useful to + add an additional information with the source name. + It doesn't modify the name of the source.") + + (init + :initarg :init + :initform nil + :custom function + :documentation + " Function called with no parameters when helm is started. + It is useful for collecting current state information which can be + used to create the list of candidates later. + Initialization of `candidates-in-buffer' is done here + with `helm-init-candidates-in-buffer'.") + + (candidates + :initarg :candidates + :initform nil + :custom (choice function list) + :documentation + " Specifies how to retrieve candidates from the source. + It can either be a variable name, a function called with no parameters + or the actual list of candidates. + + The list must be a list whose members are strings, symbols + or (DISPLAY . REAL) pairs. + + In case of (DISPLAY . REAL) pairs, the DISPLAY string is shown + in the Helm buffer, but the REAL one is used as action + argument when the candidate is selected. This allows a more + readable presentation for candidates which would otherwise be, + for example, too long or have a common part shared with other + candidates which can be safely replaced with an abbreviated + string for display purposes. + + Note that if the (DISPLAY . REAL) form is used then pattern + matching is done on the displayed string, not on the real + value.") + + (update + :initarg :update + :initform nil + :custom function + :documentation + " Function called with no parameters at before \"init\" function + when `helm-force-update' is called.") + + (cleanup + :initarg :cleanup + :initform nil + :custom function + :documentation + " Function called with no parameters when *helm* buffer is + closed. It is useful for killing unneeded candidates buffer. + + Note that the function is executed BEFORE performing action.") + + (delayed + :initarg :delayed + :initform nil + :custom (choice null integer) + :documentation + " Candidates from the source are shown only if the user stops + typing and is idle for `helm-idle-delay' seconds. + If a value is given to delayed attr, this value is used instead only + if it is > to `helm-idle-delay'.") + + (keymap + :initarg :keymap + :initform nil + :custom sexp + :documentation + " Specific keymap for this source. + It is useful to have a keymap per source when using more than + one source. Otherwise, a keymap can be set per command with + `helm' argument KEYMAP. NOTE: when a source have `helm-map' as + keymap attr, the global value of `helm-map' will override the + actual local one.") + + (action + :initarg :action + :initform 'identity + :custom (alist :key-type string + :value-type function) + :documentation + " It is a list of (DISPLAY . FUNCTION) pairs or FUNCTION. + FUNCTION is called with one parameter: the selected candidate. + + An action other than the default can be chosen from this list + of actions for the currently selected candidate (by default + with TAB). The DISPLAY string is shown in the completions + buffer and the FUNCTION is invoked when an action is + selected. The first action of the list is the default. + + You should use `helm-make-actions' to build this alist easily.") + + (persistent-action + :initarg :persistent-action + :initform nil + :custom function + :documentation + " Can be a either a Function called with one parameter (the + selected candidate) or a cons cell where first element is this + same function and second element a symbol (e.g never-split) + that inform `helm-execute-persistent-action'to not split his + window to execute this persistent action.") + + (persistent-help + :initarg :persistent-help + :initform nil + :custom string + :documentation + " A string to explain persistent-action of this source. It also + accepts a function or a variable name. + It will be displayed in source header.") + + (help-message + :initarg :help-message + :initform nil + :custom (choice string function) + :documentation + " Help message for this source. + If not present, `helm-help-message' value will be used.") + + (multiline + :initarg :multiline + :initform nil + :custom boolean + :documentation + " Enable to selection multiline candidates.") + + (requires-pattern + :initarg :requires-pattern + :initform nil + :custom integer + :documentation + " If present matches from the source are shown only if the + pattern is not empty. Optionally, it can have an integer + parameter specifying the required length of input which is + useful in case of sources with lots of candidates.") + + (candidate-transformer + :initarg :candidate-transformer + :initform nil + :custom (choice function list) + :documentation + " It's a function or a list of functions called with one argument + when the completion list from the source is built. The argument + is the list of candidates retrieved from the source. The + function should return a transformed list of candidates which + will be used for the actual completion. If it is a list of + functions, it calls each function sequentially. + + This can be used to transform or remove items from the list of + candidates. + + Note that `candidates' is run already, so the given transformer + function should also be able to handle candidates with (DISPLAY + . REAL) format.") + + (filtered-candidate-transformer + :initarg :filtered-candidate-transformer + :initform nil + :custom (choice function list) + :documentation + " It has the same format as `candidate-transformer', except the + function is called with two parameters: the candidate list and + the source. + + This transformer is run on the candidate list which is already + filtered by the current pattern. While `candidate-transformer' + is run only once, it is run every time the input pattern is + changed. + + It can be used to transform the candidate list dynamically, for + example, based on the current pattern. + + In some cases it may also be more efficent to perform candidate + transformation here, instead of with `candidate-transformer' + even if this transformation is done every time the pattern is + changed. For example, if a candidate set is very large then + `candidate-transformer' transforms every candidate while only + some of them will actually be displayed due to the limit + imposed by `helm-candidate-number-limit'. + + Note that `candidates' and `candidate-transformer' is run + already, so the given transformer function should also be able + to handle candidates with (DISPLAY . REAL) format.") + + (filter-one-by-one + :initarg :filter-one-by-one + :initform nil + :custom (choice function list) + :documentation + " A transformer function that treat candidates one by one. + It is called with one arg the candidate. + It is faster than `filtered-candidate-transformer' or + `candidates-transformer', but should be used only in sources + that recompute constantly their candidates, e.g `helm-source-find-files'. + Filtering happen early and candidates are treated + one by one instead of re-looping on the whole list. + If used with `filtered-candidate-transformer' or `candidates-transformer' + these functions should treat the candidates transformed by the + `filter-one-by-one' function in consequence.") + + (display-to-real + :initarg :display-to-real + :initform nil + :custom function + :documentation + " Function called with one parameter; the selected candidate. + + The function transforms the selected candidate, and the result + is passed to the action function. The display-to-real + attribute provides another way to pass to action other string than + the one shown in Helm buffer. + + Traditionally, it is possible to make candidates, + candidate-transformer or filtered-candidate-transformer + function return a list with (DISPLAY . REAL) pairs. But if REAL + can be generated from DISPLAY, display-to-real is more + convenient and faster. + + NOTE: This is deprecated and you have better time using `filter-one-by-one'.") + + (real-to-display + :initarg :real-to-display + :initform nil + :custom function + :documentation + " Function called with one parameter; the selected candidate. + The real value of candidates will be shown in display. + See `display-to-real'.") + + (action-transformer + :initarg :action-transformer + :initform nil + :custom (choice function list) + :documentation + " It's a function or a list of functions called with two + arguments when the action list from the source is + assembled. The first argument is the list of actions, the + second is the current selection. If it is a list of functions, + it calls each function sequentially. + + The function should return a transformed action list. + + This can be used to customize the list of actions based on the + currently selected candidate.") + + (pattern-transformer + :initarg :pattern-transformer + :initform nil + :custom (choice function list) + :documentation + " It's a function or a list of functions called with one argument + before computing matches. Its argument is `helm-pattern'. + Functions should return transformed `helm-pattern'. + + It is useful to change interpretation of `helm-pattern'.") + + (candidate-number-limit + :initarg :candidate-number-limit + :initform nil + :custom integer + :documentation + " Override `helm-candidate-number-limit' only for this source.") + + (volatile + :initarg :volatile + :initform nil + :custom boolean + :documentation + " Indicates the source assembles the candidate list dynamically, + so it shouldn't be cached within a single Helm + invocation. It is only applicable to synchronous sources, + because asynchronous sources are not cached.") + + (match + :initarg :match + :initform nil + :custom (choice function list) + :documentation + " List of functions called with one parameter: a candidate. The + function should return non-nil if the candidate matches the + current pattern (see variable `helm-pattern'). + + When using `candidates-in-buffer' its default value is `identity' and + don't have to be changed, use the `search' slot instead. + + This attribute allows the source to override the default + pattern matching based on `string-match'. It can be used, for + example, to implement a source for file names and do the + pattern matching on the basename of files, since it's more + likely one is typing part of the basename when searching for a + file, instead of some string anywhere else in its path. + + If the list contains more than one function then the list of + matching candidates from the source is constructed by appending + the results after invoking the first function on all the + potential candidates, then the next function, and so on. The + matching candidates supplied by the first function appear first + in the list of results and then results from the other + functions, respectively. + + This attribute has no effect for asynchronous sources (see + attribute `candidates'), since they perform pattern matching + themselves. + + Note that FUZZY-MATCH slot will overhide value of this slot.") + + (fuzzy-match + :initarg :fuzzy-match + :initform nil + :custom boolean + :documentation + " Enable fuzzy matching in this source. + This will overwrite settings in MATCH slot, and for + sources built with child class `helm-source-in-buffer' the SEARCH slot. + This is an easy way of enabling fuzzy matching, but you can use the MATCH + or SEARCH slots yourself if you want something more elaborated, mixing + different type of match (See `helm-source-buffers' class for example).") + + (nomark + :initarg :nomark + :initform nil + :custom boolean + :documentation + " Don't allow marking candidates when this attribute is present.") + + (nohighlight + :initarg :nohighlight + :initform nil + :custom boolean + :documentation + " Disable highlighting matches in this source. + This will disable generic highlighting of matches, + but some specialized highlighting can be done from elsewhere, + i.e from `filtered-candidate-transformer' or `filter-one-by-one' slots. + So use this to either disable completely highlighting in your source, + or to disable highlighting and use a specialized highlighting matches + function for this source. + Remember that this function should run AFTER all filter functions if those + filter functions are modifying face properties, though it is possible to + avoid this by using new `add-face-text-property' in your filter functions.") + + (allow-dups + :initarg :allow-dups + :initform nil + :custom boolean + :documentation + " Allow helm collecting duplicates candidates.") + + (recenter + :initarg :recenter + :initform nil + :custom boolean + :documentation + " `recenter' after jumping to candidate.") + + (history + :initarg :history + :initform nil + :custom symbol + :documentation + " Allow passing history variable to helm from source. + It should be a quoted symbol.") + + (coerce + :initarg :coerce + :initform nil + :custom function + :documentation + " It's a function called with one argument: the selected candidate. + This function is intended for type convertion. In normal case, + the selected candidate (string) is passed to action + function. If coerce function is specified, it is called just + before action function. + + Example: converting string to symbol + (coerce . intern)") + + (mode-line + :initarg :mode-line + :initform nil + :custom (choice string sexp) + :documentation + " Source local `helm-mode-line-string' (included in + `mode-line-format'). It accepts also variable/function name.") + + (header-line + :initarg :header-line + :initform nil + :custom (choice string function) + :documentation + " Source local `header-line-format'. + It accepts also variable/function name.") + + (resume + :initarg :resume + :initform nil + :custom function + :documentation + " Function called with no parameters at end of initialization + when `helm-resume' is started. + If this function try to do something against `helm-buffer', \(e.g updating, + searching etc...\) probably you should run it in a timer to ensure + `helm-buffer' is ready.") + + (follow + :initarg :follow + :initform nil + :custom integer + :documentation + " Enable `helm-follow-mode' for this source only. + You must give it a value of 1 or -1, though giving a -1 value + is surely not what you want, e.g: (follow . 1) + + See `helm-follow-mode' for more infos.") + + (follow-delay + :initarg :follow-delay + :initform nil + :custom integer + :documentation + " `helm-follow-mode' will execute persistent-action after this delay. + Otherwise value of `helm-follow-input-idle-delay' is used if non--nil, + If none of these are found fallback to `helm-input-idle-delay'.") + + (dont-plug + :initarg :dont-plug + :initform '(helm-compile-source--persistent-help) + :custom list + :documentation + " A list of compile functions plugin to ignore.") + + (migemo + :initarg :migemo + :initform nil + :custom boolean + :documentation + " Needed for Japanese input with helm-migemo.el. + If you are not Japanese, ignore this.") + + (matchplugin + :initarg :matchplugin + :initform t + :custom boolean) + + (match-part + :initarg :match-part + :initform nil + :custom function + :documentation + " Allow matching only one part of candidate. + If source contain match-part attribute, match is computed only + on part of candidate returned by the call of function provided + by this attribute. The function should have one arg, candidate, + and return only a specific part of candidate.") + + (before-init-hook + :initarg :before-init-hook + :initform nil + :custom symbol + :documentation + " A local hook that run at beginning of initilization of this source. + i.e Before the creation of `helm-buffer'.") + + (after-init-hook + :initarg :after-init-hook + :initform nil + :custom symbol + :documentation + " A local hook that run at end of initilization of this source. + i.e After the creation of `helm-buffer'.")) + + "Main interface to define helm sources." + :abstract t) + +(defclass helm-source-sync (helm-source) + ((candidates + :initform '("ERROR: You must specify the `candidates' slot, either with a list or a function")) + + (dont-plug + :initform '(helm-compile-source--match-plugin + helm-compile-source--persistent-help)) + + (match-strict + :initarg :match-strict + :initform nil + :custom function + :documentation + " When specifying a match function within a source and + helm-match-plugin is enabled, the result of all matching + functions will be concatened, which in some cases is not what + is wanted. When using `match-strict' only this or these + functions will be used. You can specify those functions as a + list of functions or a single symbol function. + + NOTE: This have the same effect as using :MATCHPLUGIN nil.")) + + "Use this class to make helm sources using a list of candidates. +This list should be given as a normal list, a variable handling a list +or a function returning a list. +Matching is done basically with `string-match' against each candidate.") + +(defclass helm-source-async (helm-source) + ((candidates-process + :initarg :candidates-process + :initform nil + :custom function + :documentation + " You should use this attribute when using a function involving + an async process instead of `candidates'. + The function must return a process.") + + (matchplugin :initform nil) + (dont-plug :initform '(helm-compile-source--match-plugin + helm-compile-source--persistent-help))) + + "Use this class to define a helm source calling an external process. +The :candidates slot is not allowed even if described because this class +inherit from `helm-source'.") + +(defclass helm-source-in-buffer (helm-source) + ((init + :initform 'helm-default-init-source-in-buffer-function) + + (data + :initarg :data + :initform nil + :custom (choice list string) + :documentation + " A string or a list that will be used to feed the `helm-candidates-buffer'. + This data will be passed in a function added to the init slot and + the buffer will be build with `helm-init-candidates-in-buffer'. + This is an easy and fast method to build a `candidates-in-buffer' source.") + + (dont-plug + :initform '(helm-compile-source--candidates-in-buffer + helm-compile-source--match-plugin + helm-compile-source--persistent-help)) + + (candidates + :initform 'helm-candidates-in-buffer) + + (volatile + :initform t) + + (match + :initform '(identity)) + + (get-line + :initarg :get-line + :initform 'buffer-substring-no-properties + :custom function + :documentation + " A function like `buffer-substring-no-properties' or `buffer-substring'. + This function converts point of line-beginning and point of line-end, + which represents a candidate computed by `helm-candidates-in-buffer'. + By default, `helm-candidates-in-buffer' uses + `buffer-substring-no-properties'.") + + (search + :initarg :search + :initform '(helm-candidates-in-buffer-search-default-fn) + :custom (choice function list) + :documentation + " List of functions like `re-search-forward' or `search-forward'. + Buffer search function used by `helm-candidates-in-buffer'. + By default, `helm-candidates-in-buffer' uses `re-search-forward'. + The function should take one arg PATTERN. + If your search function needs to handle negation like matchplugin, + this function should returns in such case a cons cell of two integers defining + the beg and end positions to match in the line previously matched by + `re-search-forward' or similar, and move point to next line + (See how the `helm-mp-3-search-base' and `helm-fuzzy-search' functions are working). + + NOTE: FUZZY-MATCH slot will overhide value of this slot.") + + (search-strict + :initarg :search-strict + :initform nil + :custom function + :documentation + " When specifying a search function within a source and + helm-match-plugin is enabled, the result of all searching + functions will be concatened, which in some cases is not what + is wanted. When using `search-strict' only this or these + functions will be used. You can specify those functions as a + list of functions or a single symbol function. + + NOTE: This have the same effect as using a nil value for + :MATCHPLUGIN slot.")) + + "Use this source to make helm sources storing candidates inside a buffer. +Contrarily to `helm-source-sync' candidates are matched using a function +like `re-search-forward', see below documentation of :search slot.") + +(defclass helm-source-dummy (helm-source) + ((candidates + :initform '("dummy")) + + (filtered-candidate-transformer + :initform 'helm-dummy-candidate) + + (matchplugin + :initform nil) + + (accept-empty + :initarg :accept-empty + :initform t + :custom boolean + :documentation + " Allow exiting with an empty string. + You should keep the default value.") + + (match + :initform 'identity) + + (volatile + :initform t))) + +(defclass helm-source-in-file (helm-source-in-buffer) + ((init :initform (lambda () + (let ((file (helm-attr 'candidates-file))) + (with-current-buffer (helm-candidate-buffer 'global) + (insert-file-contents file))))) + (candidates-file + :initarg :candidates-file + :initform nil + :custom string + :documentation "A filename.")) + + "The contents of the file will be used as candidates in buffer.") + + +;;; Classes for types. +;; +;; Files +(defclass helm-type-file (helm-source) () + "A class to define helm type file.") + +(defmethod helm--setup-source :primary ((_source helm-type-file))) + +(defmethod helm--setup-source :before ((source helm-type-file)) + (set-slot-value + source 'action + (helm-make-actions + "Find file" 'helm-find-many-files + "Find file as root" 'helm-find-file-as-root + "Find file other window" 'find-file-other-window + "Find file other frame" 'find-file-other-frame + "Open dired in file's directory" 'helm-open-dired + "Grep File(s) `C-u recurse'" 'helm-find-files-grep + "Zgrep File(s) `C-u Recurse'" 'helm-ff-zgrep + "Pdfgrep File(s)" 'helm-ff-pdfgrep + "Insert as org link" 'helm-files-insert-as-org-link + "Checksum File" 'helm-ff-checksum + "Ediff File" 'helm-find-files-ediff-files + "Ediff Merge File" 'helm-find-files-ediff-merge-files + "Etags `M-., C-u tap, C-u C-u reload tag file'" + 'helm-ff-etags-select + "View file" 'view-file + "Insert file" 'insert-file + "Add marked files to file-cache" 'helm-ff-cache-add-file + "Delete file(s)" 'helm-delete-marked-files + "Open file externally (C-u to choose)" 'helm-open-file-externally + "Open file with default tool" 'helm-open-file-with-default-tool + "Find file in hex dump" 'hexl-find-file)) + (set-slot-value source 'persistent-help "Show this file") + (set-slot-value source 'action-transformer '(helm-transform-file-load-el + helm-transform-file-browse-url + helm-transform-file-cache)) + (set-slot-value source 'candidate-transformer '(helm-skip-boring-files + helm-highlight-files + helm-w32-pathname-transformer))) + +;; Bookmarks +(defclass helm-type-bookmark (helm-source) () + "A class to define type bookmarks.") + +(defmethod helm--setup-source :primary ((_source helm-type-bookmark))) + +(defmethod helm--setup-source :before ((source helm-type-bookmark)) + (set-slot-value + source 'action (helm-make-actions + "Jump to bookmark" 'helm-bookmark-jump + "Jump to BM other window" 'helm-bookmark-jump-other-window + "Bookmark edit annotation" 'bookmark-edit-annotation + "Bookmark show annotation" 'bookmark-show-annotation + "Delete bookmark(s)" 'helm-delete-marked-bookmarks + "Edit Bookmark" 'helm-bookmark-edit-bookmark + "Rename bookmark" 'helm-bookmark-rename + "Relocate bookmark" 'bookmark-relocate)) + (set-slot-value source 'keymap helm-bookmark-map) + (set-slot-value source 'mode-line helm-bookmark-mode-line-string)) + +;; Buffers +(defclass helm-type-buffer (helm-source) () + "A class to define type buffer.") + +(defmethod helm--setup-source :primary ((_source helm-type-buffer))) + +(defmethod helm--setup-source :before ((source helm-type-buffer)) + (set-slot-value + source 'action (helm-make-actions + "Switch to buffer(s)" 'helm-switch-to-buffers + (lambda () (and (locate-library "popwin") + "Switch to buffer in popup window")) + 'popwin:popup-buffer + "Switch to buffer(s) other window `C-c o'" + 'helm-switch-to-buffers-other-window + "Switch to buffer other frame `C-c C-o'" + 'switch-to-buffer-other-frame + (lambda () (and (locate-library "elscreen") + "Display buffer in Elscreen")) + 'helm-find-buffer-on-elscreen + "Query replace regexp `C-M-%'" + 'helm-buffer-query-replace-regexp + "Query replace `M-%'" 'helm-buffer-query-replace + "View buffer" 'view-buffer + "Display buffer" 'display-buffer + "Grep buffers `M-g s' (C-u grep all buffers)" + 'helm-zgrep-buffers + "Multi occur buffer(s) `C-s'" 'helm-multi-occur-as-action + "Revert buffer(s) `M-U'" 'helm-revert-marked-buffers + "Insert buffer" 'insert-buffer + "Kill buffer(s) `M-D'" 'helm-kill-marked-buffers + "Diff with file `C-='" 'diff-buffer-with-file + "Ediff Marked buffers `C-c ='" 'helm-ediff-marked-buffers + "Ediff Merge marked buffers `M-='" + (lambda (candidate) + (helm-ediff-marked-buffers candidate t)))) + (set-slot-value source 'persistent-help "Show this buffer") + (set-slot-value + source 'filtered-candidate-transformer + '(helm-skip-boring-buffers + helm-buffers-sort-transformer + helm-highlight-buffers))) + +;; Functions +(defclass helm-type-function (helm-source) () + "A class to define helm type function.") + +(defmethod helm--setup-source :primary ((_source helm-type-function))) + +(defmethod helm--setup-source :before ((source helm-type-function)) + (set-slot-value + source 'action (helm-make-actions + "Describe command" 'describe-function + "Add command to kill ring" 'helm-kill-new + "Go to command's definition" 'find-function + "Debug on entry" 'debug-on-entry + "Cancel debug on entry" 'cancel-debug-on-entry + "Trace function" 'trace-function + "Trace function (background)" 'trace-function-background + "Untrace function" 'untrace-function)) + (set-slot-value source 'action-transformer + 'helm-transform-function-call-interactively) + (set-slot-value source 'candidate-transformer + 'helm-mark-interactive-functions) + (set-slot-value source 'coerce 'helm-symbolify)) + +;; Commands +(defclass helm-type-command (helm-source) () + "A class to define helm type command.") + +(defmethod helm--setup-source :primary ((_source helm-type-command))) + +(defmethod helm--setup-source :before ((source helm-type-command)) + (set-slot-value + source 'action (append (helm-make-actions + "Call interactively" 'helm-call-interactively) + (helm-actions-from-type-function))) + (set-slot-value source 'coerce 'helm-symbolify) + (set-slot-value source 'persistent-action 'describe-function)) + +;; Timers +(defclass helm-type-timers (helm-source) () + "A class to define helm type timers.") + +(defmethod helm--setup-source :primary ((_source helm-type-timers))) + +(defmethod helm--setup-source :before ((source helm-type-timers)) + (set-slot-value + source 'action + '(("Cancel Timer" . (lambda (_timer) + (let ((mkd (helm-marked-candidates))) + (cl-loop for timer in mkd + do (cancel-timer timer))))) + ("Describe Function" . (lambda (tm) + (describe-function (timer--function tm)))) + ("Find Function" . (lambda (tm) + (find-function (timer--function tm)))))) + (set-slot-value source 'persistent-action + (lambda (tm) + (describe-function (timer--function tm)))) + (set-slot-value source 'persistent-help "Describe Function")) + + +;;; Error functions +;; +;; +(defun helm-default-init-source-in-buffer-function () + (helm-init-candidates-in-buffer 'global + '("ERROR: No buffer handling your data, use either the `init' slot or the `data' slot."))) + + +;;; Internal Builder functions. +;; +;; +(defun helm--create-source (object) + "[INTERNAL] Build a helm source from OBJECT. +Where OBJECT is an instance of an eieio class." + (cl-loop for s in (object-slots object) + for slot-val = (slot-value object s) + when slot-val + collect (cons s (unless (eq t slot-val) slot-val)))) + +(defun helm-make-source (name class &rest args) + "Build a `helm' source named NAME with ARGS for CLASS. +Argument NAME is a string which define the source name, so no need to use +the keyword :name in your source, NAME will be used instead. +Argument CLASS is an eieio class object. +Arguments ARGS are keyword value pairs as defined in CLASS." + (declare (indent 2)) + (let ((source (apply #'make-instance class name args))) + (set-slot-value source 'name name) + (helm--setup-source source) + (helm-setup-user-source source) + (helm--create-source source))) + +(defun helm-make-type (class &rest args) + (let ((source (apply #'make-instance class args))) + (set-slot-value source 'name nil) + (helm--setup-source source) + (helm--create-source source))) + +(defun helm-source-mp-get-search-or-match-fns (source method) + (require 'helm-match-plugin) + (let ((searchers (and (eq method 'search) + helm-mp-default-search-functions)) + (defmatch (helm-aif (slot-value source 'match) + (helm-mklist it))) + (defmatch-strict (helm-aif (and (eq method 'match) + (slot-value source 'match-strict)) + (helm-mklist it))) + (defsearch (helm-aif (and (eq method 'search) + (slot-value source 'search)) + (helm-mklist it))) + (defsearch-strict (helm-aif (and (eq method 'search-strict) + (slot-value source 'search-strict)) + (helm-mklist it)))) + (cl-case method + (match (cond (defmatch-strict) + (defmatch + (append helm-mp-default-match-functions defmatch)) + (t helm-mp-default-match-functions))) + (search (cond (defsearch-strict) + (defsearch + (append searchers defsearch)) + (t searchers)))))) + + +;;; Modifiers +;; +(cl-defun helm-source-add-action-to-source-if (name fn source predicate + &optional (index 4)) + "Same as `helm-add-action-to-source-if' but for SOURCE defined as eieio object. +You can use this inside a `helm--setup-source' method for a SOURCE defined as +an eieio class." + (let* ((actions (slot-value source 'action)) + (action-transformers (slot-value source 'action-transformer)) + (new-action (list (cons name fn))) + (transformer `(lambda (actions candidate) + (cond ((funcall (quote ,predicate) candidate) + (helm-append-at-nth + actions (quote ,new-action) ,index)) + (t actions))))) + (when (symbolp actions) + (set-slot-value source 'action (list (cons "Default action" actions)))) + (when (symbolp action-transformers) + (setq action-transformers (list action-transformers))) + (set-slot-value + source + 'action-transformer + (delq nil (append (list transformer) action-transformers))))) + +;;; Methods to access types slots. +;; +;; +(defmethod helm-source-get-action-from-type ((object helm-type-file)) + (slot-value object 'action)) + +(defmethod helm-source-get-action-from-type ((object helm-type-buffer)) + (slot-value object 'action)) + +(defmethod helm-source-get-action-from-type ((object helm-type-bookmark)) + (slot-value object 'action)) + +(defmethod helm-source-get-action-from-type ((object helm-type-function)) + (slot-value object 'action)) + + +;;; Methods to build sources. +;; +;; +(defun helm-source--persistent-help-string (string source) + (substitute-command-keys + (concat "\\\\[helm-execute-persistent-action]: " + (or (format "%s (keeping session)" string) + (slot-value source 'header-line))))) + +(defun helm-source--header-line (source) + (substitute-command-keys + (concat "\\\\[helm-execute-persistent-action]: " + (helm-aif (or (slot-value source 'persistent-action) + (slot-value source 'action)) + (cond ((or (symbolp it) (functionp it)) + (helm-symbol-name it)) + ((listp it) + (let ((action (car it))) + ;; It comes from :action ("foo" . function). + (if (stringp (car action)) + (car action) + ;; It comes from :persistent-action + ;; (function . 'nosplit) Fix Issue #788. + (if (or (symbolp action) + (functionp action)) + (helm-symbol-name action))))) + (t "")) + "") + " (keeping session)"))) + +(defmethod helm--setup-source :primary ((_source helm-source))) + +(defmethod helm--setup-source :before ((source helm-source)) + (helm-aif (slot-value source 'keymap) + (and (symbolp it) (set-slot-value source 'keymap (symbol-value it)))) + (set-slot-value source 'header-line (helm-source--header-line source)) + (helm-aif (slot-value source 'persistent-help) + (set-slot-value source 'header-line + (helm-source--persistent-help-string it source))) + (when (and (slot-value source 'fuzzy-match) helm-fuzzy-sort-fn) + (set-slot-value source 'filtered-candidate-transformer + (helm-aif (slot-value source 'filtered-candidate-transformer) + (append (helm-mklist it) + (list helm-fuzzy-sort-fn)) + (list helm-fuzzy-sort-fn)))) + (unless (slot-value source 'nohighlight) + (set-slot-value source 'filtered-candidate-transformer + (helm-aif (slot-value source 'filtered-candidate-transformer) + (append (helm-mklist it) + (list #'helm-fuzzy-highlight-matches)) + (list #'helm-fuzzy-highlight-matches))))) + +(defmethod helm-setup-user-source ((_source helm-source))) + +(defmethod helm--setup-source ((source helm-source-sync)) + (when (slot-value source 'fuzzy-match) + (helm-aif (slot-value source 'match) + (set-slot-value source 'match (append (helm-mklist it) + (list helm-fuzzy-match-fn))) + (set-slot-value source 'match helm-fuzzy-match-fn))) + (when (slot-value source 'matchplugin) + (set-slot-value source 'match + (helm-source-mp-get-search-or-match-fns source 'match)))) + +(defmethod helm--setup-source ((source helm-source-in-buffer)) + (let ((cur-init (slot-value source 'init))) + (helm-aif (slot-value source 'data) + (set-slot-value + source + 'init (delq + nil + (list + (and (null (eq 'helm-default-init-source-in-buffer-function + cur-init)) + cur-init) + (lambda () + (helm-init-candidates-in-buffer + 'global + (if (functionp it) (funcall it) it)))))))) + (when (slot-value source 'fuzzy-match) + (helm-aif (slot-value source 'search) + (set-slot-value source 'search (append (helm-mklist it) + (list helm-fuzzy-search-fn))) + (set-slot-value source 'search (list helm-fuzzy-search-fn)))) + (when (slot-value source 'matchplugin) + (set-slot-value + source 'search (helm-source-mp-get-search-or-match-fns source 'search))) + (let ((mtc (slot-value source 'match))) + (cl-assert (or (equal '(identity) mtc) + (eq 'identity mtc)) + nil "Invalid slot value for `match'") + (cl-assert (eq (slot-value source 'volatile) t) + nil "Invalid slot value for `volatile'"))) + +(defmethod helm--setup-source ((source helm-source-async)) + (cl-assert (null (slot-value source 'candidates)) + nil "Incorrect use of `candidates' use `candidates-process' instead") + (cl-assert (null (slot-value source 'matchplugin)) + nil "`matchplugin' not allowed in async sources.")) + +(defmethod helm--setup-source ((source helm-source-dummy)) + (let ((mtc (slot-value source 'match))) + (cl-assert (or (equal '(identity) mtc) + (eq 'identity mtc)) + nil "Invalid slot value for `match'") + (cl-assert (eq (slot-value source 'volatile) t) + nil "Invalid slot value for `volatile'") + (cl-assert (equal (slot-value source 'candidates) '("dummy")) + nil "Invalid slot value for `candidates'") + (cl-assert (eq (slot-value source 'accept-empty) t) + nil "Invalid slot value for `accept-empty'"))) + + +;;; User functions +;; +;; Sources +(defmacro helm-build-sync-source (name &rest args) + "Build a synchronous helm source with name NAME. +Args ARGS are keywords provided by `helm-source-sync'." + (declare (indent 1)) + `(helm-make-source ,name 'helm-source-sync ,@args)) + +(defmacro helm-build-async-source (name &rest args) + "Build a asynchronous helm source with name NAME. +Args ARGS are keywords provided by `helm-source-async'." + (declare (indent 1)) + `(helm-make-source ,name 'helm-source-async ,@args)) + +(defmacro helm-build-in-buffer-source (name &rest args) + "Build a helm source with name NAME using `candidates-in-buffer' method. +Args ARGS are keywords provided by `helm-source-in-buffer'." + (declare (indent 1)) + `(helm-make-source ,name 'helm-source-in-buffer ,@args)) + +(defmacro helm-build-dummy-source (name &rest args) + "Build a helm source with name NAME using `dummy' method. +Args ARGS are keywords provided by `helm-source-dummy'." + (declare (indent 1)) + `(helm-make-source ,name 'helm-source-dummy ,@args)) + +(defmacro helm-build-in-file-source (name file &rest args) + "Build a helm source with NAME name using `candidates-in-files' method. +Arg FILE is a filename, the contents of this file will be +used as candidates in buffer. +Args ARGS are keywords provided by `helm-source-in-file'." + (declare (indent 1)) + `(helm-make-source ,name 'helm-source-in-file + :candidates-file ,file ,@args)) + +;; Types +(defun helm-actions-from-type-file () + (let ((source (make-instance 'helm-type-file))) + (helm--setup-source source) + (helm-source-get-action-from-type source))) + +(defun helm-build-type-file () + (helm-make-type 'helm-type-file)) + +(defun helm-actions-from-type-function () + (let ((source (make-instance 'helm-type-function))) + (helm--setup-source source) + (helm-source-get-action-from-type source))) + +(defun helm-build-type-function () + (helm-make-type 'helm-type-function)) + +(defun helm-actions-from-type-command () + (let ((source (make-instance 'helm-type-command))) + (helm--setup-source source) + (helm-source-get-action-from-type source))) + +(defun helm-build-type-command () + (helm-make-type 'helm-type-command)) + +(provide 'helm-source) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-source ends here diff --git a/elpa/helm-20150426.2119/helm-sys.el b/elpa/helm-20150426.2119/helm-sys.el new file mode 100644 index 00000000..2c3ce071 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-sys.el @@ -0,0 +1,299 @@ +;;; helm-sys.el --- System related functions for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-utils) + + +(defgroup helm-sys nil + "System related helm library." + :group 'helm) + +(defface helm-top-columns + '((t :inherit helm-header)) + "Face for helm help string in minibuffer." + :group 'helm-sys) + + +(defun helm-top-command-set-fn (var _value) + (set var + (cl-case system-type + (darwin "env COLUMNS=%s ps -axo pid,user,pri,nice,ucomm,tty,start,vsz,%%cpu,%%mem,etime,command") + (t "env COLUMNS=%s top -b -n 1")))) + +(defcustom helm-top-command "env COLUMNS=%s top -b -n 1" + "Top command used to display output of top. +To use top command, a version supporting batch mode (-b option) is needed. +On Mac OSX top command doesn't support this, so ps command +is used by default instead. +If you modify this the number and order of elements displayed +should be the same as top command to have the sort commands +working properly, that is 12 elements with the 2 first being +PID and USER and the last 4 being %CPU, %MEM, TIME and COMMAND. +A format string where %s will be replaced with `frame-width'." + :group 'helm-sys + :type 'string + :set 'helm-top-command-set-fn) + + +;;; Top (process) +;; +;; +(defvar helm-top-sort-fn nil) +(defvar helm-top-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "C-c ?") 'helm-top-help) + (define-key map (kbd "M-P") 'helm-top-run-sort-by-cpu) + (define-key map (kbd "M-C") 'helm-top-run-sort-by-com) + (define-key map (kbd "M-M") 'helm-top-run-sort-by-mem) + (define-key map (kbd "M-U") 'helm-top-run-sort-by-user) + map)) + +(defvar helm-source-top + (helm-build-in-buffer-source "Top" + :header-name (lambda (name) (concat name " (Press C-c C-u to refresh)")) + :init #'helm-top-init + :nomark t + :display-to-real #'helm-top-display-to-real + :persistent-action #'helm-top-sh-persistent-action + :persistent-help "SIGTERM" + :mode-line helm-top-mode-line + :follow 'never + :keymap helm-top-map + :filtered-candidate-transformer #'helm-top-sort-transformer + :action-transformer #'helm-top-action-transformer)) + +(defun helm-top-transformer (candidates _source) + "Transformer for `helm-top'. +Return empty string for non--valid candidates." + (cl-loop for disp in candidates collect + (cond ((string-match "^ *[0-9]+" disp) disp) + ((string-match "^ *PID" disp) + (cons (propertize disp 'face 'helm-top-columns) "")) + (t (cons disp ""))))) + +(defun helm-top-action-transformer (actions _candidate) + "Action transformer for `top'. +Show actions only on line starting by a PID." + (let ((disp (helm-get-selection nil t))) + (cond ((string-match "^ *[0-9]+" disp) + (list '("kill (SIGTERM)" . (lambda (pid) (helm-top-sh "TERM" pid))) + '("kill (SIGKILL)" . (lambda (pid) (helm-top-sh "KILL" pid))) + '("kill (SIGINT)" . (lambda (pid) (helm-top-sh "INT" pid))) + '("kill (Choose signal)" + . (lambda (pid) + (helm-top-sh + (helm-comp-read (format "Kill [%s] with signal: " pid) + '("ALRM" "HUP" "INT" "KILL" "PIPE" "POLL" + "PROF" "TERM" "USR1" "USR2" "VTALRM" + "STKFLT" "PWR" "WINCH" "CHLD" "URG" + "TSTP" "TTIN" "TTOU" "STOP" "CONT" + "ABRT" "FPE" "ILL" "QUIT" "SEGV" + "TRAP" "SYS" "EMT" "BUS" "XCPU" "XFSZ") + :must-match t) + pid))))) + (t actions)))) + +(defun helm-top-sh (sig pid) + "Run kill shell command with signal SIG on PID for `helm-top'." + (let ((cmd (format "kill -%s %s" sig pid))) + (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))) + +(defun helm-top-sh-persistent-action (pid) + (delete-other-windows) + (helm-top-sh "TERM" pid) + (helm-force-update)) + +(defun helm-top-init () + "Insert output of top command in candidate buffer." + (unless helm-top-sort-fn (helm-top-set-mode-line "CPU")) + (with-current-buffer (helm-candidate-buffer 'global) + (call-process-shell-command + (format helm-top-command (frame-width)) + nil (current-buffer)))) + +(defun helm-top-display-to-real (line) + "Return pid only from LINE." + (car (split-string line))) + +;; Sort top command + +(defun helm-top-set-mode-line (str) + (if (string-match "Sort:\\[\\(.*\\)\\] " helm-top-mode-line) + (setq helm-top-mode-line (replace-match str nil nil helm-top-mode-line 1)) + (setq helm-top-mode-line (concat (format "Sort:[%s] " str) helm-top-mode-line)))) + +(defun helm-top-sort-transformer (candidates source) + (helm-top-transformer + (if helm-top-sort-fn + (cl-loop for c in candidates + if (string-match "^ *[0-9]+" c) + collect c into pid-cands + else collect c into header-cands + finally return (append + header-cands + (sort pid-cands helm-top-sort-fn))) + candidates) + source)) + +(defun helm-top-sort-by-com (s1 s2) + (let* ((split-1 (split-string s1)) + (split-2 (split-string s2)) + (com-1 (nth 11 split-1)) + (com-2 (nth 11 split-2))) + (string< com-1 com-2))) + +(defun helm-top-sort-by-mem (s1 s2) + (let* ((split-1 (split-string s1)) + (split-2 (split-string s2)) + (mem-1 (string-to-number (nth 9 split-1))) + (mem-2 (string-to-number (nth 9 split-2)))) + (> mem-1 mem-2))) + +(defun helm-top-sort-by-user (s1 s2) + (let* ((split-1 (split-string s1)) + (split-2 (split-string s2)) + (user-1 (nth 1 split-1)) + (user-2 (nth 1 split-2))) + (string< user-1 user-2))) + +(defun helm-top-run-sort-by-com () + (interactive) + (helm-top-set-mode-line "COM") + (setq helm-top-sort-fn 'helm-top-sort-by-com) + (helm-force-update)) + +(defun helm-top-run-sort-by-cpu () + (interactive) + (helm-top-set-mode-line "CPU") + (setq helm-top-sort-fn nil) + (helm-force-update)) + +(defun helm-top-run-sort-by-mem () + (interactive) + (helm-top-set-mode-line "MEM") + (setq helm-top-sort-fn 'helm-top-sort-by-mem) + (helm-force-update)) + +(defun helm-top-run-sort-by-user () + (interactive) + (helm-top-set-mode-line "USER") + (setq helm-top-sort-fn 'helm-top-sort-by-user) + (helm-force-update)) + + +;;; X RandR resolution change +;; +;; +;;; FIXME I do not care multi-display. + +(defun helm-xrandr-info () + "Return a pair with current X screen number and current X display name." + (with-temp-buffer + (call-process "xrandr" nil (current-buffer) nil + "--current") + (let (screen output) + (goto-char (point-min)) + (save-excursion + (when (re-search-forward "\\(^Screen \\)\\([0-9]\\):" nil t) + (setq screen (match-string 2)))) + (when (re-search-forward "^\\(.*\\) connected" nil t) + (setq output (match-string 1))) + (list screen output)))) + +(defun helm-xrandr-screen () + "Return current X screen number." + (car (helm-xrandr-info))) + +(defun helm-xrandr-output () + "Return current X display name." + (cadr (helm-xrandr-info))) + +(defvar helm-source-xrandr-change-resolution + '((name . "Change Resolution") + (candidates + . (lambda () + (with-temp-buffer + (call-process "xrandr" nil (current-buffer) nil + "--screen" (helm-xrandr-screen) "-q") + (goto-char 1) + (cl-loop with modes = nil + while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t) + for mode = (match-string 1) + unless (member mode modes) + collect mode into modes + finally return modes)))) + (action + ("Change Resolution" + . (lambda (mode) + (call-process "xrandr" nil nil nil + "--screen" (helm-xrandr-screen) + "--output" (helm-xrandr-output) + "--mode" mode)))))) + + +;;; Emacs process +;; +;; +(defvar helm-source-emacs-process + '((name . "Emacs Process") + (init . (lambda () (list-processes--refresh))) + (candidates . (lambda () (mapcar #'process-name (process-list)))) + (persistent-action . (lambda (elm) + (delete-process (get-process elm)) + (helm-delete-current-selection))) + (persistent-help . "Kill Process") + (action ("Kill Process" . (lambda (elm) + (delete-process (get-process elm))))))) + + +;;;###autoload +(defun helm-top () + "Preconfigured `helm' for top command." + (interactive) + (save-window-excursion + (unless helm-alive-p (delete-other-windows)) + (helm :sources 'helm-source-top + :buffer "*helm top*" :full-frame t + :candidate-number-limit 9999 + :preselect "^\\s-*[0-9]+"))) + +;;;###autoload +(defun helm-list-emacs-process () + "Preconfigured `helm' for emacs process." + (interactive) + (helm-other-buffer 'helm-source-emacs-process "*helm process*")) + +;;;###autoload +(defun helm-xrandr-set () + (interactive) + (helm :sources 'helm-source-xrandr-change-resolution + :buffer "*helm xrandr*")) + +(provide 'helm-sys) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-sys.el ends here diff --git a/elpa/helm-20150426.2119/helm-tags.el b/elpa/helm-20150426.2119/helm-tags.el new file mode 100644 index 00000000..2df5c4ea --- /dev/null +++ b/elpa/helm-20150426.2119/helm-tags.el @@ -0,0 +1,314 @@ +;;; helm-tags.el --- Helm for Etags. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'helm-utils) + + +(defgroup helm-tags nil + "Tags related Applications and libraries for Helm." + :group 'helm) + +(defcustom helm-etags-tag-file-name "TAGS" + "Etags tag file name." + :type 'string + :group 'helm-tags) + +(defcustom helm-etags-tag-file-search-limit 10 + "The limit level of directory to search tag file. +Don't search tag file deeply if outside this value." + :type 'number + :group 'helm-tags) + +(defcustom helm-etags-match-part-only t + "Whether to match only the tag part of CANDIDATE in +helm-source-etags-select." + :type 'boolean + :group 'helm-tags) + +(defcustom helm-etags-execute-action-at-once-if-one t + "Whether to jump straight to the selected tag if there's only +one match." + :type 'boolean + :group 'helm-tags) + + +(defgroup helm-tags-faces nil + "Customize the appearance of helm-tags faces." + :prefix "helm-" + :group 'helm-tags + :group 'helm-faces) + +(defface helm-etags-file + '((t (:foreground "Lightgoldenrod4" + :underline t))) + "Face used to highlight etags filenames." + :group 'helm-tags-faces) + + +;;; Etags +;; +;; +(defun helm-etags-run-switch-other-window () + "Run switch to other window action from `helm-source-etags-select'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action + (lambda (c) + (helm-etags-action-goto 'find-file-other-window c))))) + +(defun helm-etags-run-switch-other-frame () + "Run switch to other frame action from `helm-source-etags-select'." + (interactive) + (with-helm-alive-p + (helm-quit-and-execute-action + (lambda (c) + (helm-etags-action-goto 'find-file-other-frame c))))) + +(defvar helm-etags-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map helm-map) + (define-key map (kbd "M-") 'helm-goto-next-file) + (define-key map (kbd "M-") 'helm-goto-precedent-file) + (define-key map (kbd "C-w") 'helm-yank-text-at-point) + (define-key map (kbd "C-c ?") 'helm-etags-help) + (define-key map (kbd "C-c o") 'helm-etags-run-switch-other-window) + (define-key map (kbd "C-c C-o") 'helm-etags-run-switch-other-frame) + map) + "Keymap used in Etags.") + +(defvar helm-etags-mtime-alist nil + "Store the last modification time of etags files here.") +(defvar helm-etags-cache (make-hash-table :test 'equal) + "Cache content of etags files used here for faster access.") + +(defun helm-etags-get-tag-file (&optional directory) + "Return the path of etags file if found. +Lookes recursively in parents directorys for a +`helm-etags-tag-file-name' file." + ;; Get tag file from `default-directory' or upper directory. + (let ((current-dir (helm-etags-find-tag-file-directory + (or directory default-directory)))) + ;; Return nil if not find tag file. + (when current-dir + (expand-file-name helm-etags-tag-file-name current-dir)))) + +(defun helm-etags-all-tag-files () + "Return files from the following sources; + 1) An automatically located file in the parent directories, by `helm-etags-get-tag-file'. + 2) `tags-file-name', which is commonly set by `find-tag' command. + 3) `tags-table-list' which is commonly set by `visit-tags-table' command." + (helm-fast-remove-dups + (delq nil + (append (list (helm-etags-get-tag-file) + tags-file-name) + tags-table-list)) + :test 'equal)) + +(defun helm-etags-find-tag-file-directory (current-dir) + "Try to find the directory containing tag file. +If not found in CURRENT-DIR search in upper directory." + (let ((file-exists? #'(lambda (dir) + (let ((tag-path (expand-file-name + helm-etags-tag-file-name dir))) + (and (stringp tag-path) + (file-regular-p tag-path) + (file-readable-p tag-path)))))) + (cl-loop with count = 0 + until (funcall file-exists? current-dir) + ;; Return nil if outside the value of + ;; `helm-etags-tag-file-search-limit'. + if (= count helm-etags-tag-file-search-limit) + do (cl-return nil) + ;; Or search upper directories. + else + do (cl-incf count) + (setq current-dir (expand-file-name (concat current-dir "../"))) + finally return current-dir))) + +(defun helm-etags-get-header-name (_x) + "Create header name for this helm etags session." + (concat "Etags in " + (with-helm-current-buffer + (helm-etags-get-tag-file)))) + +(defun helm-etags-create-buffer (file) + "Create the `helm-buffer' based on contents of etags tag FILE." + (let* ((tag-fname file) + max + (split (with-current-buffer (find-file-noselect tag-fname) + (prog1 + (split-string (buffer-string) "\n" 'omit-nulls) + (setq max (line-number-at-pos (point-max))) + (kill-buffer)))) + (progress-reporter (make-progress-reporter "Loading tag file..." 0 max))) + (cl-loop + with fname + with cand + for i in split for count from 0 + for elm = (unless (string-match "^\x0c" i) + (helm-aif (string-match "\177" i) + (substring i 0 it) + i)) + do (cond ((and elm (string-match "^\\([^,]+\\),[0-9]+$" elm)) + (setq fname (propertize (match-string 1 elm) + 'face 'helm-etags-file))) + (elm (setq cand (concat fname ": " elm))) + (t (setq cand nil))) + when cand do (progn + (insert (concat cand "\n")) + (progress-reporter-update progress-reporter count))))) + +(defun helm-etags-init () + "Feed `helm-buffer' using `helm-etags-cache' or tag file. +If no entry in cache, create one." + (let ((tagfiles (helm-etags-all-tag-files))) + (when tagfiles + (with-current-buffer (helm-candidate-buffer 'global) + (dolist (f tagfiles) + (helm-aif (gethash f helm-etags-cache) + ;; An entry is present in cache, insert it. + (insert it) + ;; No entry, create a new buffer using content of tag file (slower). + (helm-etags-create-buffer f) + ;; Store content of buffer in cache. + (puthash f (buffer-string) helm-etags-cache) + ;; Store or set the last modification of tag file. + (helm-aif (assoc f helm-etags-mtime-alist) + ;; If an entry exists modify it. + (setcdr it (helm-etags-mtime f)) + ;; No entry create a new one. + (add-to-list 'helm-etags-mtime-alist + (cons f (helm-etags-mtime f)))))))))) + +(defun helm-etags-split-line (line) + (let ((regexp "\\`\\([[:lower:][:upper:]]?:?.*?\\): \\(.*\\)")) + (when (string-match regexp line) + (cl-loop for n from 1 to 2 collect (match-string n line))))) + +(defvar helm-source-etags-select nil + "Helm source for Etags.") + +(defun helm-etags-build-source () + (helm-build-in-buffer-source "Etags" + :header-name 'helm-etags-get-header-name + :init 'helm-etags-init + :get-line 'buffer-substring + :match-part (lambda (candidate) + ;; Match only the tag part of CANDIDATE + ;; and not the filename. + (if helm-etags-match-part-only + (cadr (helm-etags-split-line candidate)) + candidate)) + :mode-line helm-etags-mode-line-string + :keymap helm-etags-map + :action '(("Go to tag" . (lambda (c) + (helm-etags-action-goto 'find-file c))) + ("Go to tag in other window" . (lambda (c) + (helm-etags-action-goto + 'find-file-other-window + c))) + ("Go to tag in other frame" . (lambda (c) + (helm-etags-action-goto + 'find-file-other-frame + c)))) + :persistent-help "Go to line" + :persistent-action (lambda (candidate) + (helm-etags-action-goto 'find-file candidate) + (helm-highlight-current-line)))) + +(defvar find-tag-marker-ring) + +(defun helm-etags-action-goto (switcher candidate) + "Helm default action to jump to an etags entry in other window." + (require 'etags) + (helm-log-run-hook 'helm-goto-line-before-hook) + (let* ((split (helm-etags-split-line candidate)) + (fname (cl-loop for tagf being the hash-keys of helm-etags-cache + for f = (expand-file-name + (car split) (file-name-directory tagf)) + when (file-exists-p f) + return f)) + (elm (cadr split))) + (if (null fname) + (error "file %s not found" fname) + (ring-insert find-tag-marker-ring (point-marker)) + (funcall switcher fname) + (goto-char (point-min)) + (search-forward elm nil t) + (goto-char (match-beginning 0))))) + +(defun helm-etags-mtime (file) + "Last modification time of etags tag FILE." + (cadr (nth 5 (file-attributes file)))) + +(defun helm-etags-file-modified-p (file) + "Check if tag FILE have been modified in this session. +If FILE is nil return nil." + (let ((last-modif (and file + (assoc-default file helm-etags-mtime-alist)))) + (and last-modif + (/= last-modif (helm-etags-mtime file))))) + + +;;;###autoload +(defun helm-etags-select (arg) + "Preconfigured helm for etags. +If called with a prefix argument or if any of the tag files have +been modified, reinitialize cache. + +This function aggregates three sources of tag files: + + 1) An automatically located file in the parent directories, by `helm-etags-get-tag-file'. + 2) `tags-file-name', which is commonly set by `find-tag' command. + 3) `tags-table-list' which is commonly set by `visit-tags-table' command." + (interactive "P") + (let ((tag-files (helm-etags-all-tag-files)) + (helm-execute-action-at-once-if-one helm-etags-execute-action-at-once-if-one) + (str (if (region-active-p) (buffer-substring-no-properties (region-beginning) (region-end)) + (thing-at-point 'symbol)))) + (if (cl-notany 'file-exists-p tag-files) + (message "Error: No tag file found. Create with etags shell command, or visit with `find-tag' or `visit-tags-table'.") + (cl-loop for k being the hash-keys of helm-etags-cache + unless (member k tag-files) + do (remhash k helm-etags-cache)) + (mapc (lambda (f) + (when (or (equal arg '(4)) + (and helm-etags-mtime-alist + (helm-etags-file-modified-p f))) + (remhash f helm-etags-cache))) + tag-files) + (unless helm-source-etags-select + (setq helm-source-etags-select + (helm-etags-build-source))) + (helm :sources 'helm-source-etags-select + :keymap helm-etags-map + :default (list (concat "\\_<" str "\\_>") str) + :buffer "*helm etags*")))) + +(provide 'helm-tags) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm-tags.el ends here diff --git a/elpa/helm-20150426.2119/helm-utils.el b/elpa/helm-20150426.2119/helm-utils.el new file mode 100644 index 00000000..6e5853a6 --- /dev/null +++ b/elpa/helm-20150426.2119/helm-utils.el @@ -0,0 +1,871 @@ +;;; helm-utils.el --- Utilities Functions for helm. -*- lexical-binding: t -*- + +;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto + +;; 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 . + +;;; Code: + +(require 'cl-lib) +(require 'helm) +(require 'compile) ; Fixme: Is this needed? +(require 'dired) + +(declare-function helm-find-files-1 "helm-files.el" (fname &optional preselect)) +(defvar winner-boring-buffers) + + +(defgroup helm-utils nil + "Utilities routines for Helm." + :group 'helm) + +(defcustom helm-su-or-sudo "sudo" + "What command to use for root access." + :type 'string + :group 'helm-utils) + +(defcustom helm-yank-symbol-first nil + "`helm-yank-text-at-point' yanks symbol at point on first +invocation if this is non-nil." + :type 'boolean + :group 'helm-utils) + +(defcustom helm-default-kbsize 1024.0 + "Default Kbsize to use for showing files size. +It is a float, usually 1024.0 but could be 1000.0 on some systems." + :group 'helm-utils + :type 'float) + +(defcustom helm-highlight-number-lines-around-point 15 + "Number of lines around point where matched items are highlighted." + :group 'helm-utils + :type 'integer) + +(defcustom helm-buffers-to-resize-on-pa nil + "A list of helm buffers where the helm-window should be reduced on persistent actions." + :group 'helm-utils + :type '(repeat (choice string))) + +(defcustom helm-resize-on-pa-text-height 12 + "The size of the helm-window when resizing on persistent action." + :group 'helm-utils + :type 'integer) + + +(defvar helm-goto-line-before-hook '(helm-save-current-pos-to-mark-ring) + "Run before jumping to line. +This hook run when jumping from `helm-goto-line', `helm-etags-default-action', +and `helm-imenu-default-action'.") + +(defvar helm-save-pos-before-jump-register ?_ + "The register where `helm-save-pos-to-register-before-jump' save position.") + + +;;; Faces. +;; +(defface helm-selection-line + '((t (:inherit highlight :distant-foreground "black"))) + "Face used in the `helm-current-buffer' when jumping to candidate." + :group 'helm-faces) + +(defface helm-match-item + '((t (:inherit isearch))) + "Face used to highlight item matched in a selected line." + :group 'helm-faces) + + +;; CUA workaround +(defadvice cua-delete-region (around helm-avoid-cua activate) + (ignore-errors ad-do-it)) + +(defadvice copy-region-as-kill (around helm-avoid-cua activate) + (if cua-mode + (ignore-errors ad-do-it) + ad-do-it)) + + +;;; Utils functions +;; +;; +(defun helm-ff-find-printers () + "Return a list of available printers on Unix systems." + (when (executable-find "lpstat") + (let ((printer-list (with-temp-buffer + (call-process "lpstat" nil t nil "-a") + (split-string (buffer-string) "\n")))) + (cl-loop for p in printer-list + for printer = (car (split-string p)) + when printer + collect printer)))) + +(defun helm-switch-to-buffers (buffer-or-name &optional other-window) + "Switch to buffer BUFFER-OR-NAME. +If more than one buffer marked switch to these buffers in separate windows. +If OTHER-WINDOW is specified keep current-buffer and switch to others buffers +in separate windows." + (let* ((mkds (helm-marked-candidates)) + (size (/ (window-height) (length mkds)))) + (or (<= window-min-height size) + (error "Too many buffers to visit simultaneously.")) + (helm-aif (cdr mkds) + (progn + (if other-window + (switch-to-buffer-other-window (car mkds)) + (switch-to-buffer (car mkds))) + (save-selected-window + (cl-loop for b in it + do (progn + (select-window (split-window)) + (switch-to-buffer b))))) + (if other-window + (switch-to-buffer-other-window buffer-or-name) + (switch-to-buffer buffer-or-name))))) + +(defun helm-switch-to-buffers-other-window (buffer-or-name) + "switch to buffer BUFFER-OR-NAME in other window. +See `helm-switch-to-buffers' for switching to marked buffers." + (helm-switch-to-buffers buffer-or-name t)) + +(cl-defmacro helm-position (item seq &key (test 'eq) all) + "A simple and faster replacement of CL `position'. +Return position of first occurence of ITEM found in SEQ. +Argument SEQ can be a string, in this case ITEM have to be a char. +Argument ALL, if non--nil specify to return a list of positions of +all ITEM found in SEQ." + (let ((key (if (stringp seq) 'across 'in))) + `(cl-loop for c ,key ,seq + for index from 0 + when (funcall ,test c ,item) + if ,all collect index into ls + else return index + finally return ls))) + +(defun helm-substring (str width) + "Return the substring of string STR from 0 to WIDTH. +Handle multibyte characters by moving by columns." + (with-temp-buffer + (save-excursion + (insert str)) + (move-to-column width) + (buffer-substring (point-at-bol) (point)))) + +(cl-defun helm-substring-by-width (str width &optional (endstr "...")) + "Truncate string STR to end at column WIDTH. +Similar to `truncate-string-to-width'. +Add ENDSTR (default \"...\") at end of truncated STR. +Add spaces at end if needed to reach WIDTH when STR is shorter than WIDTH." + (cl-loop for ini-str = str + then (substring ini-str 0 (1- (length ini-str))) + for sw = (string-width ini-str) + when (<= sw width) return + (concat ini-str endstr (make-string (- width sw) ? )))) + +(defun helm-string-multibyte-p (str) + "Check if string STR contains multibyte characters." + (cl-loop for c across str + thereis (> (char-width c) 1))) + +(defun helm-get-pid-from-process-name (process-name) + "Get pid from running process PROCESS-NAME." + (cl-loop with process-list = (list-system-processes) + for pid in process-list + for process = (assoc-default 'comm (process-attributes pid)) + when (and process (string-match process-name process)) + return pid)) + +(cl-defun helm-current-buffer-narrowed-p (&optional + (buffer helm-current-buffer)) + "Check if BUFFER is narrowed. +Default is `helm-current-buffer'." + (with-current-buffer buffer + (let ((beg (point-min)) + (end (point-max)) + (total (buffer-size))) + (or (/= beg 1) (/= end (1+ total)))))) + +(defun helm-region-active-p () + (and transient-mark-mode mark-active (/= (mark) (point)))) + +(defun helm-goto-char (loc) + "Go to char, revealing if necessary." + (goto-char loc) + (when (or (eq major-mode 'org-mode) + (and (boundp 'outline-minor-mode) + outline-minor-mode)) + (require 'org) ; On some old Emacs versions org may not be loaded. + (org-reveal))) + +(defun helm-goto-line (lineno &optional noanim) + "Goto LINENO opening only outline headline if needed. +Animation is used unless NOANIM is non--nil." + (helm-log-run-hook 'helm-goto-line-before-hook) + (goto-char (point-min)) + (helm-goto-char (point-at-bol lineno)) + (unless noanim + (helm-highlight-current-line nil nil nil nil 'pulse))) + +(defun helm-save-pos-to-register-before-jump () + "Save current buffer position to `helm-save-pos-before-jump-register'. +To use this add it to `helm-goto-line-before-hook'." + (with-helm-current-buffer + (unless helm-in-persistent-action + (point-to-register helm-save-pos-before-jump-register)))) + +(defun helm-save-current-pos-to-mark-ring () + "Save current buffer position to mark ring. +To use this add it to `helm-goto-line-before-hook'." + (with-helm-current-buffer + (unless helm-in-persistent-action + (set-marker (mark-marker) (point)) + (push-mark (point) 'nomsg)))) + +;;;###autoload +(defun helm-show-all-in-this-source-only (arg) + "Show only current source of this helm session with all its candidates. +With a numeric prefix arg show only the ARG number of candidates." + (interactive "p") + (with-helm-window + (with-helm-default-directory (helm-default-directory) + (let ((helm-candidate-number-limit (and (> arg 1) arg))) + (helm-set-source-filter + (list (assoc-default 'name (helm-get-current-source)))))))) + +;;;###autoload +(defun helm-display-all-sources () + "Display all sources previously hidden by `helm-set-source-filter'." + (interactive) + (helm-set-source-filter nil)) + +(defun helm-displaying-source-names () + "Return the list of sources name for this helm session." + (with-current-buffer helm-buffer + (goto-char (point-min)) + (cl-loop with pos + while (setq pos (next-single-property-change (point) 'helm-header)) + do (goto-char pos) + collect (buffer-substring-no-properties (point-at-bol)(point-at-eol)) + do (forward-line 1)))) + +(defun helm-skip-entries (seq regexp-list) + "Remove entries which matches one of REGEXP-LIST from SEQ." + (cl-loop for i in seq + unless (cl-loop for regexp in regexp-list + thereis (and (stringp i) + (string-match regexp i))) + collect i)) + +(defun helm-shadow-entries (seq regexp-list) + "Put shadow property on entries in SEQ matching a regexp in REGEXP-LIST." + (let ((face 'italic)) + (cl-loop for i in seq + if (cl-loop for regexp in regexp-list + thereis (and (stringp i) + (string-match regexp i))) + collect (propertize i 'face face) + else collect i))) + +(defun helm-describe-function (func) + "FUNC is symbol or string." + (describe-function (helm-symbolify func)) + (message nil)) + +(defun helm-describe-variable (var) + "VAR is symbol or string." + (describe-variable (helm-symbolify var)) + (message nil)) + +(defun helm-find-function (func) + "FUNC is symbol or string." + (find-function (helm-symbolify func))) + +(defun helm-find-variable (var) + "VAR is symbol or string." + (find-variable (helm-symbolify var))) + +(defun helm-kill-new (candidate &optional replace) + "CANDIDATE is symbol or string. +See `kill-new' for argument REPLACE." + (kill-new (helm-stringify candidate) replace)) + +(cl-defun helm-fast-remove-dups (seq &key (test 'eq)) + "Remove duplicates elements in list SEQ. +This is same as `remove-duplicates' but with memoisation. +It is much faster, especially in large lists. +A test function can be provided with TEST argument key. +Default is `eq'." + (cl-loop with cont = (make-hash-table :test test) + for elm in seq + unless (gethash elm cont) + do (puthash elm elm cont) + finally return + (cl-loop for i being the hash-values in cont collect i))) + +(defun helm-remove-if-not-match (regexp seq) + "Remove all elements of SEQ that don't match REGEXP." + (cl-loop for s in seq + for str = (cond ((symbolp s) + (symbol-name s)) + ((consp s) + (car s)) + (t s)) + when (string-match-p regexp str) + collect s)) + +(defun helm-remove-if-match (regexp seq) + "Remove all elements of SEQ that match REGEXP." + (cl-loop for s in seq + for str = (cond ((symbolp s) + (symbol-name s)) + ((consp s) + (car s)) + (t s)) + unless (string-match-p regexp str) + collect s)) + +(defun helm-handle-winner-boring-buffers () + "Add `helm-buffer' to `winner-boring-buffers' when quitting/exiting helm. +Add this function to `helm-cleanup-hook' when you don't want to see helm buffers +after running winner-undo/redo." + (require 'winner) + (cl-pushnew helm-buffer winner-boring-buffers :test 'equal)) +(add-hook 'helm-cleanup-hook #'helm-handle-winner-boring-buffers) + +;;;###autoload +(defun helm-quit-and-find-file () + "Drop into `helm-find-files' from `helm'. +If current selection is a buffer or a file, `helm-find-files' +from its directory." + (interactive) + (require 'helm-grep) + (helm-run-after-quit + (lambda (f) + (if (file-exists-p f) + (helm-find-files-1 (file-name-directory f) + (concat + "^" + (regexp-quote + (if helm-ff-transformer-show-only-basename + (helm-basename f) f)))) + (helm-find-files-1 f))) + (let* ((sel (helm-get-selection)) + (grep-line (and (stringp sel) + (helm-grep-split-line sel))) + (bmk-name (and (stringp sel) + (not grep-line) + (replace-regexp-in-string "\\`\\*" "" sel))) + (bmk (and bmk-name (assoc bmk-name bookmark-alist))) + (buf (helm-aif (get-buffer sel) (buffer-name it))) + (default-preselection (or (buffer-file-name helm-current-buffer) + default-directory))) + (cond + ;; Buffer. + (buf (or (buffer-file-name sel) + (car (rassoc buf dired-buffers)) + (and (with-current-buffer buf + (eq major-mode 'org-agenda-mode)) + org-directory + (expand-file-name org-directory)) + (with-current-buffer buf default-directory))) + ;; Bookmark. + (bmk (helm-aif (bookmark-get-filename bmk) + (if (and ffap-url-regexp + (string-match ffap-url-regexp it)) + it (expand-file-name it)) + default-directory)) + ((or (file-remote-p sel) + (file-exists-p sel)) + (expand-file-name sel)) + ;; Grep. + ((and grep-line (file-exists-p (car grep-line))) + (expand-file-name (car grep-line))) + ;; Occur. + (grep-line + (with-current-buffer (get-buffer (car grep-line)) + (or (buffer-file-name) default-directory))) + ;; Url. + ((and ffap-url-regexp (string-match ffap-url-regexp sel)) sel) + ;; Default. + (t default-preselection))))) + +;; Same as `vc-directory-exclusion-list'. +(defvar helm-walk-ignore-directories + '("SCCS" "RCS" "CVS" "MCVS" ".svn" ".git" ".hg" ".bzr" + "_MTN" "_darcs" "{arch}" ".gvfs")) + +(cl-defun helm-walk-directory (directory &key (path 'basename) + (directories t) + match skip-subdirs) + "Walk through DIRECTORY tree. +Argument PATH can be one of basename, relative, full, or a function +called on file name, default to basename. +Argument DIRECTORIES when non--nil (default) return also directories names, +otherwise skip directories names. +Argument MATCH can be a predicate or a regexp. +Argument SKIP-SUBDIRS when non--nil will skip `helm-walk-ignore-directories' +unless it is given as a list of directories, in this case this list will be used +instead of `helm-walk-ignore-directories'." + (let* ((result '()) + (fn (cl-case path + (basename 'file-name-nondirectory) + (relative 'file-relative-name) + (full 'identity) + (t path)))) + (cl-labels ((ls-rec (dir) + (unless (and skip-subdirs + (member (helm-basename dir) + (if (listp skip-subdirs) + skip-subdirs + helm-walk-ignore-directories))) + (cl-loop with ls = (sort (file-name-all-completions "" dir) + 'string-lessp) + for f in ls + ;; Use `directory-file-name' to remove the final slash. + ;; Needed to avoid infloop on symlinks symlinking + ;; a directory inside it [1]. + for file = (directory-file-name + (expand-file-name f dir)) + unless (member f '("./" "../")) + ;; A directory. + if (char-equal (aref f (1- (length f))) ?/) + do (progn (when directories + (push (funcall fn file) result)) + ;; Don't recurse in symlinks. + ;; `file-symlink-p' have to be called + ;; on the directory with its final + ;; slash removed [1]. + (and (not (file-symlink-p file)) + (ls-rec file))) + else do + (if match + (and (if (functionp match) + (funcall match f) + (and (stringp match) + (string-match match f))) + (push (funcall fn file) result)) + (push (funcall fn file) result)))))) + (ls-rec directory) + (nreverse result)))) + +(defun helm-generic-sort-fn (s1 s2) + "Sort predicate function for helm candidates. +Args S1 and S2 can be single or \(display . real\) candidates, +that is sorting is done against real value of candidate." + (let* ((reg1 (concat "\\_<" helm-pattern "\\_>")) + (reg2 (concat "\\_<" helm-pattern)) + (split (split-string helm-pattern)) + (str1 (if (consp s1) (cdr s1) s1)) + (str2 (if (consp s2) (cdr s2) s2)) + (score #'(lambda (str r1 r2 lst) + (cond ((string-match r1 str) 4) + ((and (string-match " " helm-pattern) + (string-match (concat "\\_<" (car lst)) str) + (cl-loop for r in (cdr lst) + always (string-match r str))) 3) + ((and (string-match " " helm-pattern) + (cl-loop for r in lst always (string-match r str))) 2) + ((string-match r2 str) 1) + (t 0)))) + (sc1 (funcall score str1 reg1 reg2 split)) + (sc2 (funcall score str2 reg1 reg2 split))) + (cond ((or (zerop (string-width helm-pattern)) + (and (zerop sc1) (zerop sc2))) + (string-lessp str1 str2)) + ((= sc1 sc2) + (< (length str1) (length str2))) + (t (> sc1 sc2))))) + +(defun helm-basename (fname &optional ext) + "Print FNAME with any leading directory components removed. +If specified, also remove filename extension EXT." + (let ((non-essential t)) + (if (and ext (or (string= (file-name-extension fname) ext) + (string= (file-name-extension fname t) ext)) + (not (file-directory-p fname))) + (file-name-sans-extension (file-name-nondirectory fname)) + (file-name-nondirectory (directory-file-name fname))))) + +(defun helm-basedir (fname) + "Return the base directory of filename." + (helm-aif (and fname (file-name-directory fname)) + (file-name-as-directory it))) + +(defun helm-ff-get-host-from-tramp-invalid-fname (fname) + "Extract hostname from an incomplete tramp file name. +Return nil on valid file name remote or not." + (let* ((str (helm-basename fname)) + (split (split-string str ":")) + (meth (car (member (car split) (mapcar 'car tramp-methods))))) + (when (and meth (<= (length split) 2)) + (cadr split)))) + +(cl-defun helm-file-human-size (size &optional (kbsize helm-default-kbsize)) + "Return a string showing SIZE of a file in human readable form. +SIZE can be an integer or a float depending it's value. +`file-attributes' will take care of that to avoid overflow error. +KBSIZE if a floating point number, defaulting to `helm-default-kbsize'." + (let ((M (cons "M" (/ size (expt kbsize 2)))) + (G (cons "G" (/ size (expt kbsize 3)))) + (K (cons "K" (/ size kbsize))) + (B (cons "B" size))) + (cl-loop with result = B + for (a . b) in + (cl-loop for (x . y) in (list M G K B) + unless (< y 1) collect (cons x y)) + when (< b (cdr result)) do (setq result (cons a b)) + finally return (if (string= (car result) "B") + (format "%s" size) + (format "%.1f%s" (cdr result) (car result)))))) + +(cl-defun helm-file-attributes + (file &key type links uid gid access-time modif-time + status size mode gid-change inode device-num dired human-size + mode-type mode-owner mode-group mode-other (string t)) + "Return `file-attributes' elements of FILE separately according to key value. +Availables keys are: +- TYPE: Same as nth 0 `files-attributes' if STRING is nil + otherwise return either symlink, directory or file (default). +- LINKS: See nth 1 `files-attributes'. +- UID: See nth 2 `files-attributes'. +- GID: See nth 3 `files-attributes'. +- ACCESS-TIME: See nth 4 `files-attributes', however format time + when STRING is non--nil (the default). +- MODIF-TIME: See nth 5 `files-attributes', same as above. +- STATUS: See nth 6 `files-attributes', same as above. +- SIZE: See nth 7 `files-attributes'. +- MODE: See nth 8 `files-attributes'. +- GID-CHANGE: See nth 9 `files-attributes'. +- INODE: See nth 10 `files-attributes'. +- DEVICE-NUM: See nth 11 `files-attributes'. +- DIRED: A line similar to what 'ls -l' return. +- HUMAN-SIZE: The size in human form, see `helm-file-human-size'. +- MODE-TYPE, mode-owner,mode-group, mode-other: Split what + nth 7 `files-attributes' return in four categories. +- STRING: When non--nil (default) `helm-file-attributes' return + more friendly values. +If you want the same behavior as `files-attributes' , +\(but with return values in proplist\) use a nil value for STRING. +However when STRING is non--nil, time and type value are different from what +you have in `file-attributes'." + (let* ((all (cl-destructuring-bind + (type links uid gid access-time modif-time + status size mode gid-change inode device-num) + (file-attributes file string) + (list :type (if string + (cond ((stringp type) "symlink") ; fname + (type "directory") ; t + (t "file")) ; nil + type) + :links links + :uid uid + :gid gid + :access-time (if string + (format-time-string + "%Y-%m-%d %R" access-time) + access-time) + :modif-time (if string + (format-time-string + "%Y-%m-%d %R" modif-time) + modif-time) + :status (if string + (format-time-string + "%Y-%m-%d %R" status) + status) + :size size + :mode mode + :gid-change gid-change + :inode inode + :device-num device-num))) + (modes (helm-split-mode-file-attributes (cl-getf all :mode)))) + (cond (type (cl-getf all :type)) + (links (cl-getf all :links)) + (uid (cl-getf all :uid)) + (gid (cl-getf all :gid)) + (access-time (cl-getf all :access-time)) + (modif-time (cl-getf all :modif-time)) + (status (cl-getf all :status)) + (size (cl-getf all :size)) + (mode (cl-getf all :mode)) + (gid-change (cl-getf all :gid-change)) + (inode (cl-getf all :inode)) + (device-num (cl-getf all :device-num)) + (dired + (concat + (helm-split-mode-file-attributes (cl-getf all :mode) t) " " + (number-to-string (cl-getf all :links)) " " + (cl-getf all :uid) ":" + (cl-getf all :gid) " " + (if human-size + (helm-file-human-size (cl-getf all :size)) + (int-to-string (cl-getf all :size))) " " + (cl-getf all :modif-time))) + (human-size (helm-file-human-size (cl-getf all :size))) + (mode-type (cl-getf modes :mode-type)) + (mode-owner (cl-getf modes :user)) + (mode-group (cl-getf modes :group)) + (mode-other (cl-getf modes :other)) + (t (append all modes))))) + +(defun helm-split-mode-file-attributes (str &optional string) + "Split mode file attributes STR into a proplist. +If STRING is non--nil return instead a space separated string." + (cl-loop with type = (substring str 0 1) + with cdr = (substring str 1) + for i across cdr + for count from 1 + if (<= count 3) + concat (string i) into user + if (and (> count 3) (<= count 6)) + concat (string i) into group + if (and (> count 6) (<= count 9)) + concat (string i) into other + finally return + (if string + (mapconcat 'identity (list type user group other) " ") + (list :mode-type type :user user :group group :other other)))) + +(defun helm-current-directory () + "Return current-directory name at point. +Useful in dired buffers when there is inserted subdirs." + (if (eq major-mode 'dired-mode) + (dired-current-directory) + default-directory)) + +(defmacro with-helm-display-marked-candidates (buffer-or-name candidates &rest body) + (declare (indent 0) (debug t)) + (helm-with-gensyms (buffer window) + `(let* ((,buffer (temp-buffer-window-setup ,buffer-or-name)) + ,window) + (unwind-protect + (with-current-buffer ,buffer + (dired-format-columns-of-files ,candidates) + (select-window + (setq ,window (temp-buffer-window-show + ,buffer + '(display-buffer-below-selected + (window-height . fit-window-to-buffer))))) + (progn ,@body)) + (quit-window 'kill ,window))))) + +;;; Persistent Action Helpers +;; +;; +;; Internal +(defvar helm-match-line-overlay nil) +(defvar helm--match-item-overlays nil) + +(defun helm-highlight-current-line (&optional start end buf face pulse) + "Highlight and underline current position" + (let* ((start (or start (line-beginning-position))) + (end (or end (1+ (line-end-position)))) + (start-match (if (or (zerop helm-highlight-number-lines-around-point) + (null helm-highlight-number-lines-around-point)) + start + (save-excursion + (forward-line + (- helm-highlight-number-lines-around-point)) + (point-at-bol)))) + (end-match (if (or (zerop helm-highlight-number-lines-around-point) + (null helm-highlight-number-lines-around-point)) + end + (save-excursion + (forward-line + helm-highlight-number-lines-around-point) + (point-at-eol)))) + (args (list start end buf))) + (if (not helm-match-line-overlay) + (setq helm-match-line-overlay (apply 'make-overlay args)) + (apply 'move-overlay helm-match-line-overlay args)) + (overlay-put helm-match-line-overlay + 'face (or face 'helm-selection-line)) + (catch 'empty-line + (cl-loop with ov + for r in (helm-remove-if-match + "\\`!" (split-string helm-pattern)) + do (save-excursion + (goto-char start-match) + (while (condition-case _err + (re-search-forward r end-match t) + (invalid-regexp nil)) + (let ((s (match-beginning 0)) + (e (match-end 0))) + (if (= s e) + (throw 'empty-line nil) + (push (setq ov (make-overlay s e)) + helm--match-item-overlays) + (overlay-put ov 'face 'helm-match-item) + (overlay-put ov 'priority 1))))))) + (recenter) + (when pulse + (sit-for 0.3) + (helm-match-line-cleanup)))) + +(defun helm-match-line-cleanup () + (when helm-match-line-overlay + (delete-overlay helm-match-line-overlay) + (setq helm-match-line-overlay nil)) + (when helm--match-item-overlays + (mapc 'delete-overlay helm--match-item-overlays))) + +(defun helm-match-line-update () + (when helm-match-line-overlay + (delete-overlay helm-match-line-overlay) + (helm-highlight-current-line))) + +(defun helm-persistent-autoresize-hook () + (when (and helm-buffers-to-resize-on-pa + (member helm-buffer helm-buffers-to-resize-on-pa) + (eq helm-split-window-state 'vertical)) + (set-window-text-height (helm-window) helm-resize-on-pa-text-height))) + +(add-hook 'helm-after-persistent-action-hook 'helm-persistent-autoresize-hook) +(add-hook 'helm-cleanup-hook 'helm-match-line-cleanup) +(add-hook 'helm-after-persistent-action-hook 'helm-match-line-update) + +(defun helm-w32-prepare-filename (file) + "Convert filename FILE to something usable by external w32 executables." + (replace-regexp-in-string ; For UNC paths + "/" "\\" + (replace-regexp-in-string ; Strip cygdrive paths + "/cygdrive/\\(.\\)" "\\1:" + file nil nil) nil t)) + +;;;###autoload +(defun helm-w32-shell-execute-open-file (file) + (interactive "fOpen file:") + (with-no-warnings + (w32-shell-execute "open" (helm-w32-prepare-filename file)))) + +(defun helm-open-file-with-default-tool (file) + "Open FILE with the default tool on this platform." + (let (process-connection-type) + (if (eq system-type 'windows-nt) + (helm-w32-shell-execute-open-file file) + (start-process "helm-open-file-with-default-tool" + nil + (cond ((eq system-type 'gnu/linux) + "xdg-open") + ((or (eq system-type 'darwin) ;; Mac OS X + (eq system-type 'macos)) ;; Mac OS 9 + "open")) + file)))) + +(defun helm-open-dired (file) + "Opens a dired buffer in FILE's directory. If FILE is a +directory, open this directory." + (if (file-directory-p file) + (dired file) + (dired (file-name-directory file)) + (dired-goto-file file))) + +(defun helm-require-or-error (feature function) + (or (require feature nil t) + (error "Need %s to use `%s'." feature function))) + +(defun helm-find-file-as-root (candidate) + (let* ((buf (helm-basename candidate)) + (host (file-remote-p candidate 'host)) + (remote-path (format "/%s:%s:%s" + helm-su-or-sudo + (or host "") + (expand-file-name + (if host + (file-remote-p candidate 'localname) + candidate)))) + non-essential) + (if (buffer-live-p (get-buffer buf)) + (progn + (set-buffer buf) + (find-alternate-file remote-path)) + (find-file remote-path)))) + +(defun helm-find-many-files (_ignore) + (let ((helm--reading-passwd-or-string t)) + (mapc 'find-file (helm-marked-candidates)))) + +(defun helm-quit-and-execute-action (action) + "Quit current helm session and execute ACTION." + (setq helm-saved-action action) + (helm-exit-minibuffer)) + +;; Yank text at point. +;; +;; +;; Internal +(defvar helm-yank-point nil) + +;;;###autoload +(defun helm-yank-text-at-point () + "Yank text at point in `helm-current-buffer' into minibuffer. +If `helm-yank-symbol-first' is non--nil the first yank +grabs the entire symbol." + (interactive) + (with-helm-current-buffer + (let ((fwd-fn (if helm-yank-symbol-first + 'forward-symbol 'forward-word))) + ;; Start to initial point if C-w have never been hit. + (unless helm-yank-point (setq helm-yank-point (point))) + (save-excursion + (goto-char helm-yank-point) + (funcall fwd-fn 1) + (helm-set-pattern + (concat + helm-pattern (replace-regexp-in-string + "\\`\n" "" + (buffer-substring-no-properties + helm-yank-point (point))))) + (setq helm-yank-point (point)))))) + +(defun helm-reset-yank-point () + (setq helm-yank-point nil)) + +(defun helm-read-repeat-string (prompt &optional count) + "Prompt as many time PROMPT is not empty. +If COUNT is non--nil add a number after each prompt." + (cl-loop with elm + while (not (string= elm "")) + for n from 1 + do (when count + (setq prompt (concat prompt (int-to-string n) ": "))) + collect (setq elm (helm-read-string prompt)) into lis + finally return (remove "" lis))) + +(add-hook 'helm-cleanup-hook 'helm-reset-yank-point) +(add-hook 'helm-after-initialize-hook 'helm-reset-yank-point) + +(defun helm-html-bookmarks-to-alist (file url-regexp bmk-regexp) + "Parse html bookmark FILE and return an alist with (title . url) as elements." + (let (bookmarks-alist url title) + (with-temp-buffer + (insert-file-contents file) + (goto-char (point-min)) + (while (re-search-forward "href=\\|^ *

q\" '(foo bar baz) 2) + +Each time \" q\" is pressed the next function is executed, if you wait +More than 2 seconds, next hit will run again the first function and so on." + (define-key keymap key (helm-make-multi-command functions delay))) + +;;;###autoload +(defmacro helm-multi-key-defun (name docstring funs &optional delay) + "Define NAME as a multi-key command running FUNS. +After DELAY seconds the FUNS list is reinitialised. +See `helm-define-multi-key'." + (declare (indent 2)) + (setq docstring (if docstring (concat docstring "\n\n") + "This is a helmish multi-key command.")) + `(defalias (quote ,name) (helm-make-multi-command ,funs ,delay) ,docstring)) + +(defun helm-make-multi-command (functions &optional delay) + "Return an anonymous multi-key command running FUNCTIONS. +Run each function of FUNCTIONS list in turn when called within DELAY seconds." + (declare (indent 1)) + (let ((funs functions) + (iter (cl-gensym "helm-iter-key")) + (timeout delay)) + (eval (list 'defvar iter nil)) + #'(lambda () (interactive) (helm-run-multi-key-command funs iter timeout)))) + +(defun helm-run-multi-key-command (functions iterator delay) + (let ((fn #'(lambda () + (cl-loop for count from 1 to (length functions) + collect count))) + next) + (unless (and (symbol-value iterator) + ;; Reset iterator when another key is pressed. + (eq this-command real-last-command)) + (set iterator (helm-iter-list (funcall fn)))) + (setq next (helm-iter-next (symbol-value iterator))) + (unless next + (set iterator (helm-iter-list (funcall fn))) + (setq next (helm-iter-next (symbol-value iterator)))) + (and next (symbol-value iterator) (call-interactively (nth (1- next) functions))) + (when delay (run-with-idle-timer delay nil `(lambda () + (setq ,iterator nil)))))) + +(defun helm-iter-list (seq) + "Return an iterator object from SEQ." + (let ((lis seq)) + (lambda () + (let ((elm (car lis))) + (setq lis (cdr lis)) + elm)))) + +(defun helm-iter-next (iterator) + "Return next elm of ITERATOR." + (funcall iterator)) + +(helm-multi-key-defun helm-toggle-resplit-and-swap-windows + "Multi key command to resplit and swap helm window. +First call run `helm-toggle-resplit-window', +second call within 0.5s run `helm-swap-windows'." + '(helm-toggle-resplit-window helm-swap-windows) 1) + +;;;###autoload +(defun helm-define-key-with-subkeys (map key subkey command + &optional other-subkeys menu exit-fn) + "Allow defining in MAP a KEY and SUBKEY to COMMAND. + +This allow typing KEY to call COMMAND the first time and +type only SUBKEY on subsequent calls. + +Arg MAP is the keymap to use, SUBKEY is the initial short keybinding to +call COMMAND. + +Arg OTHER-SUBKEYS is an alist specifying other short keybindings +to use once started. +e.g: + +\(helm-define-key-with-subkeys global-map + \(kbd \"C-x v n\") ?n 'git-gutter:next-hunk '((?p . git-gutter:previous-hunk))\) + + +In this example, `C-x v n' will run `git-gutter:next-hunk' +subsequent hits on \"n\" will run this command again +and subsequent hits on \"p\" will run `git-gutter:previous-hunk'. + +Arg MENU is a string to display in minibuffer +to describe SUBKEY and OTHER-SUBKEYS. +Arg EXIT-FN specify a function to run on exit. + +Any other keys pressed run their assigned command defined in MAP +and exit the loop running EXIT-FN if specified. + +NOTE: SUBKEY and OTHER-SUBKEYS bindings support +only char syntax actually (e.g ?n) +so don't use strings, vectors or whatever to define them." + (declare (indent 1)) + (define-key map key + (lambda () + (interactive) + (unwind-protect + (progn + (call-interactively command) + (while (let ((input (read-key menu)) other kb com) + (setq last-command-event input) + (cond + ((eq input subkey) + (call-interactively command) + t) + ((setq other (assoc input other-subkeys)) + (call-interactively (cdr other)) + t) + (t + (setq kb (vector last-command-event)) + (setq com (lookup-key map kb)) + (if (commandp com) + (call-interactively com) + (setq unread-command-events + (nconc (mapcar 'identity kb) + unread-command-events))) + nil))))) + (and exit-fn (funcall exit-fn)))))) + + +;;; Keymap +;; +;; +(defvar helm-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (define-key map (kbd "") 'helm-next-line) + (define-key map (kbd "") 'helm-previous-line) + (define-key map (kbd "C-n") 'helm-next-line) + (define-key map (kbd "C-p") 'helm-previous-line) + (define-key map (kbd "") 'helm-follow-action-forward) + (define-key map (kbd "") 'helm-follow-action-backward) + (define-key map (kbd "") 'helm-previous-page) + (define-key map (kbd "") 'helm-next-page) + (define-key map (kbd "M-v") 'helm-previous-page) + (define-key map (kbd "C-v") 'helm-next-page) + (define-key map (kbd "M-<") 'helm-beginning-of-buffer) + (define-key map (kbd "M->") 'helm-end-of-buffer) + (define-key map (kbd "C-g") 'helm-keyboard-quit) + (define-key map (kbd "") 'helm-next-source) + (define-key map (kbd "") 'helm-previous-source) + (define-key map (kbd "") 'helm-maybe-exit-minibuffer) + (define-key map (kbd "C-i") 'helm-select-action) + (define-key map (kbd "C-z") 'helm-execute-persistent-action) + (define-key map (kbd "C-j") 'helm-execute-persistent-action) + (define-key map (kbd "C-o") 'helm-next-source) + (define-key map (kbd "C-l") 'helm-recenter-top-bottom-other-window) + (define-key map (kbd "M-C-l") 'helm-reposition-window-other-window) + (define-key map (kbd "C-M-v") 'helm-scroll-other-window) + (define-key map (kbd "M-") 'helm-scroll-other-window) + (define-key map (kbd "C-M-y") 'helm-scroll-other-window-down) + (define-key map (kbd "C-M-S-v") 'helm-scroll-other-window-down) + (define-key map (kbd "M-") 'helm-scroll-other-window-down) + (define-key map (kbd "") 'helm-scroll-other-window) + (define-key map (kbd "") 'helm-scroll-other-window-down) + (define-key map (kbd "C-@") 'helm-toggle-visible-mark) + (define-key map (kbd "C-SPC") 'helm-toggle-visible-mark) + (define-key map (kbd "M-SPC") 'helm-toggle-visible-mark) + (define-key map (kbd "M-[") nil) + (define-key map (kbd "M-(") 'helm-prev-visible-mark) + (define-key map (kbd "M-)") 'helm-next-visible-mark) + (define-key map (kbd "C-k") 'helm-delete-minibuffer-contents) + (define-key map (kbd "C-x C-f") 'helm-quit-and-find-file) + (define-key map (kbd "M-m") 'helm-toggle-all-marks) + (define-key map (kbd "M-a") 'helm-mark-all) + (define-key map (kbd "M-u") 'helm-unmark-all) + (define-key map (kbd "C-w") 'helm-yank-text-at-point) + (define-key map (kbd "C-M-a") 'helm-show-all-in-this-source-only) + (define-key map (kbd "C-M-e") 'helm-display-all-sources) + (define-key map (kbd "C-r") 'undefined) + (define-key map (kbd "C-s") 'undefined) + (define-key map (kbd "M-s") 'undefined) + (define-key map (kbd "C-}") 'helm-narrow-window) + (define-key map (kbd "C-{") 'helm-enlarge-window) + (define-key map (kbd "C-c -") 'helm-swap-windows) + (define-key map (kbd "C-c C-d") 'helm-delete-current-selection) + (define-key map (kbd "C-c C-y") 'helm-yank-selection) + (define-key map (kbd "C-c C-k") 'helm-kill-selection-and-quit) + (define-key map (kbd "C-c C-i") 'helm-copy-to-buffer) + (define-key map (kbd "C-c C-f") 'helm-follow-mode) + (define-key map (kbd "C-c C-u") 'helm-force-update) + (define-key map (kbd "M-p") 'previous-history-element) + (define-key map (kbd "M-n") 'next-history-element) + (define-key map (kbd "C-!") 'helm-toggle-suspend-update) + (define-key map (kbd "C-x b") 'helm-resume-previous-session-after-quit) + (define-key map (kbd "C-x C-b") 'helm-resume-list-buffers-after-quit) + ;; Disable `file-cache-minibuffer-complete'. + (define-key map (kbd "") 'undefined) + ;; Multi keys + (define-key map (kbd "C-t") 'helm-toggle-resplit-and-swap-windows) + ;; Debugging command + (define-key map (kbd "C-h C-d") 'undefined) + (define-key map (kbd "C-h C-d") 'helm-debug-output) + ;; Use `describe-mode' key in `global-map'. + (define-key map [f1] nil) ; Allow to eval keymap without errors. + (define-key map (kbd "C-h C-h") 'undefined) + (define-key map (kbd "C-h h") 'undefined) + (cl-dolist (k (where-is-internal 'describe-mode global-map)) + (define-key map k 'helm-help)) + ;; Bind all actions from 1 to 12 to their corresponding nth index+1. + (cl-loop for n from 0 to 12 do + (define-key map (kbd (format "" (1+ n))) + `(lambda () + (interactive) + (helm-select-nth-action ,n)))) + map) + "Keymap for helm.") + + +(defgroup helm nil + "Open helm." + :prefix "helm-" :group 'convenience) + +(defcustom helm-completion-window-scroll-margin 5 + " `scroll-margin' to use for helm completion window. +Which see. Set to 0 to disable. +NOTE: This have no effect when `helm-display-source-at-screen-top' +id non--nil." + :group 'helm + :type 'integer) + +(defcustom helm-display-source-at-screen-top t + "Display candidates at the top of screen. +This happen when using `helm-next-source' and `helm-previous-source'. +NOTE: When non--nil (default) disable `helm-completion-window-scroll-margin'." + :group 'helm + :type 'boolean) + +(defcustom helm-candidate-number-limit 100 + "Limit candidate number globally. +Do not show more candidates than this limit from individual sources. +It is usually pointless to show hundreds of matches +when the pattern is empty, because it is much simpler to type a +few characters to narrow down the list of potential candidates. + +Set it to nil if you don't want this limit." + :group 'helm + :type '(choice (const :tag "Disabled" nil) integer)) + +(defcustom helm-idle-delay 0.01 + "Be idle for this many seconds, before updating in delayed sources. +This is useful for sources involving heavy operations +\(like launching external programs\), so that candidates +from the source are not retrieved unnecessarily if the user keeps typing. + +It also can be used to declutter the results helm displays, +so that results from certain sources are not shown with every +character typed, only if the user hesitates a bit. +Be sure to know what you are doing when modifying this." + :group 'helm + :type 'float) + +(defcustom helm-input-idle-delay 0.01 + "Be idle for this many seconds, before updating. + +Unlike `helm-idle-delay', it is also effective for non-delayed sources. +If nil, candidates are collected immediately. + +Note: If this value is too low compared to `helm-idle-delay', +you may have duplicated sources when using multiples sources. +Safe value is always >= `helm-idle-delay'. +Default settings are equal value for both. +Be sure to know what you are doing when modifying this." + :group 'helm + :type 'float) + +(defcustom helm-exit-idle-delay 0 + "Be idle for this many seconds before exiting minibuffer while helm is updating. +Note that this does nothing when helm-buffer is up to date +\(i.e exit without delay in this condition\)." + :group 'helm + :type 'float) + +(defcustom helm-full-frame nil + "Use current window to show the candidates. +If t then Helm doesn't pop up a new window." + :group 'helm + :type 'boolean) + +(defvaralias 'helm-samewindow 'helm-full-frame) +(make-obsolete-variable 'helm-samewindow 'helm-full-frame "1.4.8.1") + +(defcustom helm-quick-update nil + "If non-nil, suppress displaying sources which are out of screen at first. +They are treated as delayed sources at this input. +This flag makes `helm' a bit faster with many sources." + :group 'helm + :type 'boolean) + +(defcustom helm-candidate-separator + "--------------------" + "Candidates separator of `multiline' source." + :group 'helm + :type 'string) + +(defcustom helm-save-configuration-functions + '(set-window-configuration . current-window-configuration) + "The functions used to restore/save window or frame configurations. +It is a pair where the car is the function to restore window or frame config, +and the cdr is the function to save the window or frame config. + +If you want to save and restore frame configuration, set this variable to + '\(set-frame-configuration . current-frame-configuration\) +NOTE: This may not work properly with own-frame minibuffer settings. +Older version saves/restores frame configuration, but the default is changed now +because flickering can occur in some environment." + :group 'helm + :type 'sexp) + +(defcustom helm-persistent-action-use-special-display nil + "If non-nil, use `special-display-function' in persistent action." + :group 'helm + :type 'boolean) + +(defcustom helm-scroll-amount nil + "Scroll amount when scrolling other window in a helm session. +It is used by `helm-scroll-other-window' +and `helm-scroll-other-window-down'. + +If you prefer scrolling line by line, set this value to 1." + :group 'helm + :type 'integer) + +(defcustom helm-display-function 'helm-default-display-buffer + "Function to display *helm* buffer. +It is `helm-default-display-buffer' by default, +which affects `helm-full-frame'." + :group 'helm + :type 'symbol) + +(defcustom helm-case-fold-search 'smart + "Add 'smart' option to `case-fold-search'. +When smart is enabled, ignore case in the search strings +if pattern contains no uppercase characters. +Otherwise, with a nil or t value, the behavior is same as +`case-fold-search'. +Default value is smart, other possible values are nil and t. +NOTE: This have no effect in asynchronous sources, you will +have to implement a similar feature directly in the process. +See in helm-grep.el how it is implemented." + :group 'helm + :type '(choice (const :tag "Ignore case" t) + (const :tag "Respect case" nil) + (other :tag "Smart" 'smart))) + +(defcustom helm-file-name-case-fold-search + (if (memq system-type + '(cygwin windows-nt ms-dos darwin)) + t + helm-case-fold-search) + "Local setting of `helm-case-fold-search' for reading filenames. + +See `helm-case-fold-search' for more info." + :group 'helm + :type 'symbol) + +(defcustom helm-reuse-last-window-split-state nil + "Reuse the last state of window split, vertical or horizontal. +That is when you use `helm-toggle-resplit-window' the next helm session +will reuse the same window scheme than the one of last session unless +`helm-split-window-default-side' is 'same or 'other." + :group 'helm + :type 'boolean) + +(defcustom helm-split-window-preferred-function 'helm-split-window-default-fn + "Default function used for splitting window." + :group 'helm + :type 'function) + +(defcustom helm-split-window-default-side 'below + "The default side to display `helm-buffer'. +Must be one acceptable arg for `split-window' SIDE, +that is 'below, 'above, 'left or 'right. + +Other acceptable values are 'same which always display `helm-buffer' +in current window and 'other that display `helm-buffer' below if only one +window or in `other-window-for-scrolling' if available. + +A nil value as same effect as 'below. +If `helm-full-frame' is non--nil, it take precedence on this. + +See also `helm-split-window-in-side-p' and `helm-always-two-windows' that +take precedence on this. + +NOTE: this have no effect if `helm-split-window-preferred-function' is not +`helm-split-window-default-fn' unless this new function handle this." + :group 'helm + :type 'symbol) + +(defcustom helm-split-window-in-side-p nil + "Force splitting inside selected window when non--nil. +See also `helm-split-window-default-side'. + +NOTE: this have no effect if `helm-split-window-preferred-function' is not +`helm-split-window-default-fn' unless this new function handle this." + :group 'helm + :type 'boolean) + +(defcustom helm-always-two-windows nil + "When non--nil helm will use two windows in this frame. +That is one window to display `helm-buffer' and one to display +`helm-current-buffer'. +Note: this have no effect when `helm-split-window-in-side-p' is non--nil, +or when `helm-split-window-default-side' is set to 'same. +When `helm-autoresize-mode' is enabled, setting this to nil +will have no effect until this mode will be disabled." + :group 'helm + :type 'boolean) + +(defcustom helm-sources-using-default-as-input '(helm-source-imenu + helm-source-info-elisp + helm-source-etags-select) + "List of helm sources that need to use `helm-maybe-use-default-as-input'. +When a source is member of this list, default `thing-at-point' +will be used as input." + :group 'helm + :type '(repeat (choice symbol))) + +(defcustom helm-delete-minibuffer-contents-from-point t + "When non--nil, `helm-delete-minibuffer-contents' delete region from `point'. +Otherwise delete `minibuffer-contents'. +See documentation of `helm-delete-minibuffer-contents'." + :group 'helm + :type 'boolean) + +(defcustom helm-follow-mode-persistent nil + "Retrieve last state of `helm-follow-mode' in next helm session when non--nil. +This will not make it persistent through emacs sessions though, +you will have to set explicitely the `follow' attribute in the source where +you want this mode enabled definitely." + :group 'helm + :type 'boolean) + +(defcustom helm-prevent-escaping-from-minibuffer t + "Prevent escaping from minibuffer during helm session." + :group 'helm + :type 'boolean) + +(defcustom helm-truncate-lines nil + "Truncate long lines when non--nil. +See `truncate-lines'." + :group 'helm + :type 'boolean) + +(defcustom helm-move-to-line-cycle-in-source nil + "Move to end or beginning of source when reaching top or bottom of source. +This happen when using `helm-next/previous-line'." + :group 'helm + :type 'boolean) + +(defcustom helm-fuzzy-match-fn 'helm-fuzzy-match + "The function for fuzzy matching in `helm-source-sync' based sources." + :group 'helm + :type 'function) + +(defcustom helm-fuzzy-search-fn 'helm-fuzzy-search + "The function for fuzzy matching in `helm-source-in-buffer' based sources." + :group 'helm + :type 'function) + +(defcustom helm-fuzzy-sort-fn 'helm-fuzzy-matching-default-sort-fn + "The sort transformer function used in fuzzy matching. +When nil no sorting will be done." + :group 'helm + :type 'function) + +(defcustom helm-fuzzy-matching-highlight-fn 'helm-fuzzy-default-highlight-match + "The function to highlight matches in fuzzy matching. +When nil no highlighting will be done." + :group 'helm + :type 'function) + +(defcustom helm-autoresize-max-height 40 + "Specifies a maximum height and defaults to the height of helm window's frame in percentage. + +See `fit-window-to-buffer' for more infos." + :group 'helm + :type 'integer) + +(defcustom helm-autoresize-min-height 10 + "Specifies a minimum height and defaults to the height of helm window's frame in percentage. + +If nil the default of `window-min-height' is used +See `fit-window-to-buffer' for more infos." + :group 'helm + :type 'integer) + +(defcustom helm-input-method-verbose-flag nil + "The default value of `input-method-verbose-flag' to use in helm minibuffer. +It is nil by default to allow helm updating and exiting without turning off +the input method when complex methods are in use, if you set it to any other +value allowed by `input-method-verbose-flag' you will have at each time you want +to exit or helm update to disable the `current-input-method' with `C-\\'." + :group 'helm + :type '(radio :tag "A flag to control extra guidance given by input methods in helm." + (const :tag "Never provide guidance" nil) + (const :tag "Always provide guidance" t) + (const :tag "Provide guidance only in complex methods" complex-only))) + +(defcustom helm-display-header-line t + "Display header-line when non nil." + :group 'helm + :type 'boolean) + +(defcustom helm-file-globstar t + "Same as globstar bash shopt option. +When non--nil a pattern beginning with two stars will expand recursively. +Directories expansion is not supported yet." + :group 'helm + :type 'boolean) + +(defcustom helm-inherit-input-method t + "Inherit `current-input-method' from `current-buffer' when non--nil. +The default is to enable this by default, the user can toggle the current +input method with `toggle-input-method'." + :group 'helm + :type 'boolean) + +;;; Faces +;; +;; +(defgroup helm-faces nil + "Customize the appearance of helm." + :prefix "helm-" + :group 'faces + :group 'helm) + +(defface helm-source-header + '((((background dark)) + :background "#22083397778B" + :foreground "white" + :weight bold :height 1.3 :family "Sans Serif") + (((background light)) + :background "#abd7f0" + :foreground "black" + :weight bold :height 1.3 :family "Sans Serif")) + "Face for source header in the helm buffer." + :group 'helm-faces) + +(defface helm-visible-mark + '((((min-colors 88) (background dark)) + (:background "green1" :foreground "black")) + (((background dark)) + (:background "green" :foreground "black")) + (((background light)) :background "#d1f5ea") + (((min-colors 88)) + (:background "green1")) + (t (:background "green"))) + "Face for visible mark." + :group 'helm-faces) + +(defface helm-header + '((t (:inherit header-line))) + "Face for header lines in the helm buffer." + :group 'helm-faces) + +(defface helm-candidate-number + '((((background dark)) :background "Yellow" :foreground "black") + (((background light)) :background "#faffb5" :foreground "black")) + "Face for candidate number in mode-line." :group 'helm-faces) + +(defface helm-selection + '((((background dark)) :background "ForestGreen" + :distant-foreground "black") + (((background light)) :background "#b5ffd1" + :distant-foreground "black")) + "Face for currently selected item in the helm buffer." + :group 'helm-faces) + +(defface helm-separator + '((((background dark)) :foreground "red") + (((background light)) :foreground "#ffbfb5")) + "Face for multiline source separator." + :group 'helm-faces) + +(defface helm-action + '((t (:underline t))) + "Face for action lines in the helm action buffer." + :group 'helm-faces) + +(defface helm-prefarg + '((((background dark)) :foreground "green") + (((background light)) :foreground "red")) + "Face for showing prefix arg in mode-line." + :group 'helm-faces) + +(defface helm-match + '((((background light)) :foreground "#b00000") + (((background dark)) :foreground "gold1")) + "Face used to highlight matches." + :group 'helm) + + +;;; Variables. +;; +;; +(defvar helm-type-attributes nil + "It's a list of \(TYPE ATTRIBUTES ...\). +ATTRIBUTES are the same as attributes for `helm-sources'. +TYPE connects the value to the appropriate sources. +Don't set this directly, use instead `define-helm-type-attribute'. + +This allows specifying common attributes for several sources. +For example, sources which provide files can specify +common attributes with a `file' type.") + +(defvar helm-source-filter nil + "A list of source names to be displayed. +Other sources won't appear in the search results. +If nil then there is no filtering. +See also `helm-set-source-filter'.") + +(defvar helm-action-buffer "*helm action*" + "Buffer showing actions.") + +(defvar helm-selection-overlay nil + "Overlay used to highlight the currently selected item.") + +(defvar helm-async-processes nil + "List of information about asynchronous processes managed by helm.") + +(defvar helm-before-initialize-hook nil + "Run before helm initialization. +This hook is run before init functions in `helm-sources', +that is before creation of `helm-buffer'. +Local variables for `helm-buffer' that need a value from `current-buffer' +can be set here with `helm-set-local-variable'.") + +(defvar helm-after-initialize-hook nil + "Run after helm initialization. +This hook run inside `helm-buffer' once created. +Variables are initialized and the `helm-buffer' is created. +But the `helm-buffer' has no contents.") + +(defvar helm-update-hook nil + "Run after the helm buffer was updated according the new input pattern. +This hook is run at the beginning of buffer. +The first candidate is selected after running this hook. +See also `helm-after-update-hook'.") + +(defvar helm-after-update-hook nil + "Run after the helm buffer was updated according the new input pattern. +This is very similar to `helm-update-hook' but selection is not moved. +It is useful to select a particular object instead of the first one.") + +(defvar helm-cleanup-hook nil + "Run after helm minibuffer is closed. +IOW this hook is executed BEFORE performing action.") + +(defvar helm-select-action-hook nil + "Run when opening the action buffer.") + +(defvar helm-before-action-hook nil + "Run before executing action. +Contrarily to `helm-cleanup-hook', +this hook run before helm minibuffer is closed +and before performing action.") + +(defvar helm-after-action-hook nil + "Run after executing action.") + +(defvar helm-exit-minibuffer-hook nil + "Run just before exiting minibuffer.") + +(defvar helm-after-persistent-action-hook nil + "Run after executing persistent action.") + +(defvar helm-move-selection-before-hook nil + "Run before moving selection in `helm-buffer'.") + +(defvar helm-move-selection-after-hook nil + "Run after moving selection in `helm-buffer'.") + +(defvar helm-window-configuration-hook nil + "Run when switching to and back from action buffer.") + +(defconst helm-restored-variables + '(helm-candidate-number-limit + helm-source-filter + helm-source-in-each-line-flag + helm-map + helm-sources) + "Variables which are restored after `helm' invocation.") + +(defvar helm-execute-action-at-once-if-one nil + "Execute default action and exit when only one candidate is remaining.") + +(defvar helm-quit-if-no-candidate nil + "Quit when there is no candidates when non--nil. +This variable accepts a function, which is executed if no candidate.") + +(defvar helm-maybe-use-default-as-input nil + "Use :default arg of `helm' as input to update display. +Note that if also :input is specified as `helm' arg, it will take +precedence on :default.") + +(defvar helm-source-in-each-line-flag nil + "Non-nil means add helm-source text-property in each candidate. +experimental feature.") + +(defvar helm-debug-variables nil + "A list of helm variables to show in `helm-debug-output'. +Otherwise all variables started with `helm-' are shown.") + +(defvar helm-debug-buffer "*Debug Helm Log*") + +(defvar helm-debug nil + "If non-nil, write log message into `helm-debug-buffer' buffer. +It is disabled by default because `helm-debug-buffer' grows quickly.") + +(defvar helm-compile-source-functions + '(helm-compile-source--type + helm-compile-source--dummy + helm-compile-source--candidates-in-buffer) + "Functions to compile elements of `helm-sources' (plug-in).") + +(defvar helm-mode-line-string "\ +\\\ +\\[helm-help]:Help \ +\\[helm-select-action]:Act \ +\\[helm-maybe-exit-minibuffer]/\ +f1/f2/f-n:NthAct" + "Help string displayed in mode-line in `helm'. +It can be a string or a list of two args, in this case, +first arg is a string that will be used as name for candidates number, +second arg any string to display in mode line. +If nil, use default `mode-line-format'.") + + +;;; Internal Variables +;; +;; +(defvar helm-current-prefix-arg nil + "Record `current-prefix-arg' when exiting minibuffer.") +(defvar helm-saved-action nil + "Saved value of the currently selected action by key.") +(defvar helm-saved-current-source nil + "Value of the current source when the action list is shown.") +(defvar helm-compiled-sources nil + "Compiled version of `helm-sources'.") +(defvar helm-in-persistent-action nil + "Flag whether in persistent-action or not.") +(defvar helm-last-buffer nil + "`helm-buffer' of previously `helm' session.") +(defvar helm-saved-selection nil + "Value of the currently selected object when the action list is shown.") +(defvar helm-sources nil + "[INTERNAL] Value of current sources in use, a list.") +(defvar helm-buffer "*helm*" + "Buffer showing completions.") +(defvar helm-current-buffer nil + "Current buffer when `helm' is invoked.") +(defvar helm-buffer-file-name nil + "Variable `buffer-file-name' when `helm' is invoked.") +(defvar helm-candidate-cache (make-hash-table :test 'equal) + "Holds the available candidate within a single helm invocation.") +(defvar helm-pattern "" + "The input pattern used to update the helm buffer.") +(defvar helm-input "" + "The input typed in the candidates panel.") +(defvar helm-input-local nil + "Internal, store locally `helm-pattern' value for later use in `helm-resume'.") +(defvar helm-source-name nil) +(defvar helm-current-source nil) +(defvar helm-candidate-buffer-alist nil) +(defvar helm-match-hash (make-hash-table :test 'equal)) +(defvar helm-cib-hash (make-hash-table :test 'equal)) +(defvar helm-tick-hash (make-hash-table :test 'equal)) +(defvar helm-issued-errors nil) +(defvar helm-debug-root-directory nil + "When non--nil, save helm log to `helm-last-log-file'. +Be aware that if you set that, you will end up with a huge directory +of log files, so use that only for debugging purpose. +See `helm-log-save-maybe' for more info.") +(defvar helm-last-log-file nil + "The name of the last helm session log file.") +(defvar helm-follow-mode nil) +(defvar helm--local-variables nil) +(defvar helm-split-window-state nil) +(defvar helm--window-side-state nil) +(defvar helm-selection-point nil) +(defvar helm-alive-p nil) +(defvar helm-visible-mark-overlays nil) +(defvar helm-update-blacklist-regexps '("^" "^ *" "$" "!" " " "\\b" + "\\<" "\\>" "\\_<" "\\_>" ".*")) +(defvar helm-suspend-update-flag nil) +(defvar helm-force-updating-p nil) +(defvar helm-exit-status 0 + "Flag to inform whether helm have exited or quitted. +Exit with 0 mean helm have exited executing an action. +Exit with 1 mean helm have quitted with \\[keyboard-quit] +It is useful for example to restore a window config if helm abort +in special cases. +See `helm-exit-minibuffer' and `helm-keyboard-quit'.") +(defvar helm-minibuffer-confirm-state nil) +(defvar helm-quit nil) +(defvar helm-attributes nil "List of all `helm' attributes.") +(defvar helm-buffers nil + "All of `helm-buffer' in most recently used order.") +(defvar helm-current-position nil + "Cons of \(point . window-start\) when `helm' is invoked. +It is needed to restore position in `helm-current-buffer' +when `helm' is keyboard-quitted.") +(defvar helm-last-frame-or-window-configuration nil + "Used to store window or frame configuration when helm start.") +(defvar helm-onewindow-p nil) +(defvar helm-types nil) +(defvar helm--mode-line-string-real nil) ; The string to display in mode-line. +(defvar helm-persistent-action-display-window nil) +(defvar helm-marked-candidates nil + "Marked candadates. List of \(source . real\) pair.") +(defvar helm--mode-line-display-prefarg nil) +(defvar helm--temp-follow-flag nil + "[INTERNAL] A simple flag to notify persistent action we are following.") +(defvar helm--reading-passwd-or-string nil) +(defvar helm--in-update nil) +(defvar helm--in-fuzzy nil) + +;; Utility: logging +(defun helm-log (format-string &rest args) + "Log message `helm-debug' is non-nil. +Messages are written to the `helm-debug-buffer' buffer. + +Argument FORMAT-STRING is a string to use with `format'. +Use optional arguments ARGS like in `format'." + (when helm-debug + (with-current-buffer (get-buffer-create helm-debug-buffer) + (outline-mode) + (buffer-disable-undo) + (set (make-local-variable 'inhibit-read-only) t) + (goto-char (point-max)) + (insert (let ((tm (current-time))) + (format (concat (if (string-match "Start session" format-string) + "* " "** ") + "%s.%06d (%s)\n %s\n") + (format-time-string "%H:%M:%S" tm) + (nth 2 tm) + (helm-log-get-current-function) + (apply #'format (cons format-string args)))))))) + +(defun helm-log-run-hook (hook) + "Run HOOK like `run-hooks' but write these actions to helm log buffer." + (helm-log "Executing %s with value = %S" hook (symbol-value hook)) + (helm-log "Executing %s with global value = %S" hook (default-value hook)) + (run-hooks hook) + (helm-log "executed %s" hook)) + +(defun helm-log-get-current-function () + "Get function name calling `helm-log'. +The original idea is from `tramp-debug-message'." + (cl-loop with exclude-func-re = "^helm-\\(?:interpret\\|log\\|.*funcall\\)" + for btn from 1 to 40 + for btf = (cl-second (backtrace-frame btn)) + for fn = (if (symbolp btf) (symbol-name btf) "") + if (and (string-match "^helm" fn) + (not (string-match exclude-func-re fn))) + return fn)) + +(defun helm-log-error (&rest args) + "Accumulate error messages into `helm-issued-errors'. +ARGS are args given to `format'. +e.g (helm-log-error \"Error %s: %s\" (car err) (cdr err))." + (apply 'helm-log (concat "ERROR: " (car args)) (cdr args)) + (let ((msg (apply 'format args))) + (unless (member msg helm-issued-errors) + (add-to-list 'helm-issued-errors msg)))) + +(defun helm-log-save-maybe () + "May be save log buffer to `helm-last-log-file'. +If `helm-debug-root-directory' is non--nil and a valid directory, +a directory named 'helm-debug-' +will be created there and the log recorded in a file named +at the date and time of today in this directory." + (when (and (stringp helm-debug-root-directory) + (file-directory-p helm-debug-root-directory) + helm-debug) + (let ((logdir (expand-file-name (concat "helm-debug-" + (format-time-string "%Y%m%d")) + helm-debug-root-directory))) + (make-directory logdir t) + (with-current-buffer (get-buffer-create helm-debug-buffer) + (write-region (point-min) (point-max) + (setq helm-last-log-file + (expand-file-name + (format-time-string "%Y%m%d-%H%M%S") + logdir)) + nil 'silent) + (kill-buffer))))) + +;;;###autoload +(defun helm-debug-open-last-log () + "Open helm log file of last helm session. +If `helm-last-log-file' is nil, switch to `helm-debug-buffer' ." + (interactive) + (if helm-last-log-file + (view-file helm-last-log-file) + (switch-to-buffer helm-debug-buffer) + (view-mode 1) (visual-line-mode 1))) + +(defun helm-print-error-messages () + "Print error messages in `helm-issued-errors'." + (and helm-issued-errors + (message "Helm issued errors: %s" + (mapconcat 'identity (reverse helm-issued-errors) "\n")))) + + +;; Programming Tools +(defmacro helm-aif (test-form then-form &rest else-forms) + "Like `if' but set the result of TEST-FORM in a temprary variable called `it'. +THEN-FORM and ELSE-FORMS are then excuted just like in `if'." + (declare (indent 2) (debug t)) + `(let ((it ,test-form)) + (if it ,then-form ,@else-forms))) + +(defun helm-mklist (obj) + "If OBJ is a list \(but not lambda\), return itself. +Otherwise make a list with one element." + (if (and (listp obj) (not (functionp obj))) + obj + (list obj))) + +(defun helm-this-command () + "Return the actual command in action. +Like `this-command' but return the real command, +not `exit-minibuffer' or unwanted functions." + (cl-loop with bl = '(helm-maybe-exit-minibuffer + helm-confirm-and-exit-minibuffer + helm-exit-minibuffer + exit-minibuffer) + for count from 1 to 50 + for btf = (backtrace-frame count) + for fn = (cl-second btf) + if (and + ;; In some case we may have in the way an + ;; advice compiled resulting in byte-code, + ;; ignore it (Issue #691). + (symbolp fn) + (commandp fn) + (not (memq fn bl))) + return fn + else + if (and (eq fn 'call-interactively) + (> (length btf) 2)) + return (cadr (cdr btf)))) + +(defun helm-flatten-list (seq &optional omit-nulls) + "Return a list of all single elements of sublists in SEQ." + (let (result) + (cl-labels ((flatten (seq) + (cl-loop + for elm in seq + if (and (or elm + (null omit-nulls)) + (or (atom elm) + (functionp elm) + (and (consp elm) + (cdr elm) + (atom (cdr elm))))) + do (push elm result) + else do (flatten elm)))) + (flatten seq)) + (nreverse result))) + + +;; Test tools +(defmacro with-helm-time-after-update (&rest body) + (helm-with-gensyms (start-time time-elapsed) + `(let ((,start-time (float-time)) ,time-elapsed) + (add-hook 'helm-after-update-hook + (lambda () + (setq ,time-elapsed (- (float-time) ,start-time)) + (keyboard-quit))) + (unwind-protect ,@body + (remove-hook 'helm-after-update-hook + (lambda () + (setq ,time-elapsed (- (float-time) ,start-time)) + (keyboard-quit)))) + ,time-elapsed))) + + +;; Helm API + +(defun helm-buffer-get () + "Return `helm-action-buffer' if shown otherwise `helm-buffer'." + (if (helm-action-window) + helm-action-buffer + helm-buffer)) + +(defun helm-window () + "Window of `helm-buffer'." + (get-buffer-window (helm-buffer-get) 0)) + +(defun helm-action-window () + "Window of `helm-action-buffer'." + (get-buffer-window helm-action-buffer 'visible)) + +(defmacro with-helm-window (&rest body) + "Be sure BODY is excuted in the helm window." + (declare (indent 0) (debug t)) + `(with-selected-window (helm-window) + ,@body)) + +(defmacro with-helm-current-buffer (&rest body) + "Eval BODY inside `helm-current-buffer'." + (declare (indent 0) (debug t)) + `(with-current-buffer (or (and (buffer-live-p helm-current-buffer) + helm-current-buffer) + (setq helm-current-buffer + (current-buffer))) + ,@body)) + +(defmacro with-helm-buffer (&rest body) + "Eval BODY inside `helm-buffer'." + (declare (indent 0) (debug t)) + `(with-current-buffer (helm-buffer-get) + ,@body)) + +(defmacro with-helm-restore-variables (&rest body) + "Restore `helm-restored-variables' after executing BODY." + (declare (indent 0) (debug t)) + (helm-with-gensyms (orig-vars) + `(let ((,orig-vars (mapcar (lambda (v) + (cons v (symbol-value v))) + helm-restored-variables))) + (unwind-protect (progn ,@body) + (cl-loop for (var . value) in ,orig-vars + do (set var value)) + (helm-log "restore variables"))))) + +(defmacro with-helm-default-directory (directory &rest body) + (declare (indent 2) (debug t)) + `(let ((default-directory (or (and ,directory + (file-name-as-directory ,directory)) + default-directory))) + ,@body)) + +(defun helm-default-directory () + "Return the local value of `default-directory' in `helm-buffer'." + (buffer-local-value 'default-directory (get-buffer helm-buffer))) + +(defmacro with-helm-temp-hook (hook &rest body) + "Execute temporarily BODY as a function for HOOK." + (declare (indent 1) (debug t)) + (helm-with-gensyms (fun) + `(progn + (defun ,fun () + (unwind-protect + (progn ,@body) + (remove-hook ,hook (quote ,fun)))) + (add-hook ,hook (quote ,fun))))) + +(defmacro with-helm-after-update-hook (&rest body) + "Execute BODY at end of `helm-update'." + (declare (indent 0) (debug t)) + `(with-helm-temp-hook 'helm-after-update-hook ,@body)) + +(defmacro with-helm-alive-p (&rest body) + "Return error when BODY run outside helm context." + (declare (indent 0) (debug t)) + `(progn + (if helm-alive-p + (progn ,@body) + (error "Running helm command outside of context")))) + +(cl-defun helm-attr (attribute-name + &optional (src (helm-get-current-source)) compute) + "Get the value of ATTRIBUTE-NAME of SRC. +If SRC is omitted, use current source. +If COMPUTE is non--nil compute value of ATTRIBUTE-NAME +with `helm-interpret-value'." + (helm-aif (or (assq attribute-name src) + (helm-get-attribute-from-source-type attribute-name src)) + (if compute (helm-interpret-value (cdr it)) (cdr it)))) + +(cl-defun helm-attr-defined (attribute-name + &optional (src (helm-get-current-source))) + "Return non-nil if ATTRIBUTE-NAME of SRC is defined. +if SRC is omitted, use current source." + (and (helm-attr attribute-name src) t)) + +(cl-defun helm-attrset (attribute-name value + &optional + (src (helm-get-current-source)) + alter-type) + "Set the value of ATTRIBUTE-NAME of source SRC to VALUE. +If ATTRIBUTE-NAME doesn't exists in source it is created with value VALUE. +If ALTER-TYPE is non--nil alter the value of ATTRIBUTE-NAME in `helm-attributes' +if it exists. +If SRC is omitted, use current source. +If operation succeed, return value, otherwise nil." + (let ((from-type (helm-get-attribute-from-source-type attribute-name src)) + done) + (helm-aif (or (assq attribute-name src) + (and alter-type from-type)) + (prog1 (setcdr it value) (setq done t)) + (unless from-type + (setcdr src (cons (cons attribute-name value) (cdr src))) + (setq done t))) + (and done value))) + +(defun helm-get-attribute-from-source-type (attribute source) + "Get ATTRIBUTE from type attribute of SOURCE." + (when (assq 'type source) + (assq attribute + (assq (cdr (assq 'type source)) + helm-type-attributes)))) + +(defun helm-get-attribute-from-type (attribute type) + "Get ATTRIBUTE from TYPE. +arg TYPE is an existing type defined in `helm-type-attributes'." + (assq attribute (assq type helm-type-attributes))) + +(defun helm-get-actions-from-type (source) + "Get actions list from type attribute of SOURCE." + (when (assq 'type source) + (helm-get-attribute-from-source-type 'action source))) + +(defun helm-inherit-attribute-from-source (attribute source) + "Get the ATTRIBUTE of SOURCE." + (helm-aif (assq attribute source) + it + (helm-get-attribute-from-source-type attribute source))) + +(defun helm-append-at-nth (seq elm index) + "Append ELM at INDEX in SEQ." + (let ((len (length seq))) + (when (> index len) (setq index len)) + (cl-loop for i in seq + for count from 1 collect i + when (= count index) + if (listp elm) append elm + else collect elm))) + +(defun helm-add-action-to-source (name fn source &optional index) + "Add new action NAME linked to function FN to SOURCE. +Function FN should be a valid function that take one arg i.e candidate, +argument NAME is a string that will appear in action menu +and SOURCE should be an existing helm source already loaded. +If INDEX is specified, action is added in action list at INDEX, +otherwise it is added at end. +This allow user to add a specific action to an existing source +without modifying source code." + (let ((actions (helm-attr 'action source)) + (new-action (list (cons name fn)))) + (when (symbolp actions) + (setq actions (list (cons "Default action" actions)))) + (helm-attrset 'action + (if index + (helm-append-at-nth actions new-action index) + (append actions new-action)) + source))) + +(defun helm-delete-action-from-source (action-or-name source) + "Delete ACTION-OR-NAME from SOURCE. +ACTION-OR-NAME can either be the name of action or the symbol function +associated to name." + (let* ((actions (helm-attr 'action source)) + (del-action (if (symbolp action-or-name) + (rassoc action-or-name actions) + (assoc action-or-name actions)))) + (helm-attrset 'action (delete del-action actions) source))) + +(cl-defun helm-add-action-to-source-if (name fn source predicate + &optional (index 4) test-only) + "Add new action NAME linked to function FN to SOURCE. +Action NAME will be available when the current candidate matches PREDICATE. +This function add an entry in the `action-transformer' attribute +of SOURCE (or create one if not found). +Function PREDICATE should take one arg candidate. +Function FN should be a valid function that take one arg i.e candidate, +argument NAME is a string that will appear in action menu +and SOURCE should be an existing helm source already loaded. +If INDEX is specified, action is added in action list at INDEX. +Value of INDEX should be always >=1, default to 4. +This allow user to add a specific `action-tranformer' +to an existing source without modifying source code. +E.g +Add the action \"Byte compile file async\" linked to +function 'async-byte-compile-file to source `helm-source-find-files' +only when predicate helm-ff-candidates-lisp-p return non--nil: + +\(helm-add-action-to-source-if \"Byte compile file async\" + 'async-byte-compile-file + helm-source-find-files + 'helm-ff-candidates-lisp-p\)." + (let* ((actions (helm-attr 'action source)) + (action-transformers (helm-attr 'action-transformer source)) + (new-action (list (cons name fn))) + (transformer `(lambda (actions candidate) + (cond ((funcall (quote ,predicate) candidate) + (helm-append-at-nth + actions (quote ,new-action) ,index)) + (t actions))))) + (when (symbolp actions) + (helm-attrset 'action (list (cons "Default action" actions)) source)) + (when (symbolp action-transformers) + (setq action-transformers (list action-transformers))) + (if test-only ; debug + (delq nil (append (list transformer) action-transformers)) + (helm-attrset 'action-transformer + (helm-fast-remove-dups + (delq nil (append (list transformer) action-transformers)) + :test 'equal) + source)))) + +(defun helm-set-source-filter (sources) + "Set the value of `helm-source-filter' to SOURCES and update. + +This function sets a filter for helm sources and it may be +called while helm is running. It can be used to toggle +displaying of sources dynamically. For example, additional keys +can be bound into `helm-map' to display only the file-related +results if there are too many matches from other sources and +you're after files only: + +Shift+F shows only file results from some sources: + +\(define-key helm-map \"F\" 'helm-my-show-files-only) + +\(defun helm-my-show-files-only () + (interactive) + (helm-set-source-filter '(\"File Name History\" + \"Files from Current Directory\"))) + +Shift+A shows all results: + +\(define-key helm-map \"A\" 'helm-my-show-all) + +\(defun helm-my-show-all () + (interactive) + (helm-set-source-filter nil)) + +The -my- part is added to avoid collisions with +existing Helm function names." + (let ((cur-disp-sel (with-current-buffer helm-buffer + (helm-get-selection nil t)))) + (setq helm-source-filter (helm--normalize-filter-sources sources)) + (helm-log "helm-source-filter = %S" helm-source-filter) + ;; Use force-update to run init/update functions. + (helm-force-update (and (stringp cur-disp-sel) + (regexp-quote cur-disp-sel))))) + +(defun helm--normalize-filter-sources (sources) + (cl-loop for s in sources collect + (cond ((symbolp s) + (assoc-default 'name (symbol-value s))) + ((listp s) + (assoc-default 'name s)) + ((stringp s) s)))) + +(defun helm-set-sources (sources &optional no-init no-update) + "Set SOURCES during `helm' invocation. +If NO-INIT is non-nil, skip executing init functions of SOURCES. +If NO-UPDATE is non-nil, skip executing `helm-update'." + (with-current-buffer helm-buffer + (setq helm-compiled-sources nil + helm-sources sources) + (helm-log "helm-compiled-sources = %S" helm-compiled-sources) + (helm-log "helm-sources = %S" helm-sources)) + (unless no-init (helm-funcall-foreach 'init)) + (unless no-update (helm-update))) + +(defun helm-get-sources () + "Return compiled `helm-sources', which is memoized. + +Attributes: + +- type + `helm-type-attributes' are merged in. +- candidates-buffer + candidates, volatile and match attribute are created." + (cond + ;; action + ((helm-action-window) + helm-sources) + ;; memoized + (helm-compiled-sources) + ;; first time + (t + (prog1 + (setq helm-compiled-sources + (helm-compile-sources + helm-sources helm-compile-source-functions)) + (helm-log "helm-compiled-sources = %S" helm-compiled-sources))))) + +(cl-defun helm-get-selection (&optional (buffer nil buffer-s) + force-display-part) + "Return the currently selected item or nil. +if BUFFER is nil or unspecified, use helm-buffer as default value. +If FORCE-DISPLAY-PART is non-nil, return the display string. +If FORCE-DISPLAY-PART value is 'withprop the display string is returned +with its properties." + (setq buffer (if (and buffer buffer-s) buffer helm-buffer)) + (unless (helm-empty-buffer-p buffer) + (with-current-buffer buffer + (let* ((disp-fn (if (eq force-display-part 'withprop) + 'buffer-substring + 'buffer-substring-no-properties)) + (selection + (or (and (not force-display-part) + (get-text-property (overlay-start + helm-selection-overlay) + 'helm-realvalue)) + ;; It is needed to return properties of DISP in some case, + ;; e.g for `helm-confirm-and-exit-minibuffer', + ;; so use `buffer-substring' here when 'withprop is specified. + (let ((disp (funcall + disp-fn + (overlay-start helm-selection-overlay) + (1- (overlay-end helm-selection-overlay)))) + (source (helm-get-current-source))) + (helm-aif (and (not force-display-part) + (assoc-default 'display-to-real source)) + (helm-funcall-with-source source it disp) + disp))))) + (unless (equal selection "") + (helm-log "selection = %S" selection) + selection))))) + +(defun helm-get-actions-from-current-source () + "Return the associated action for the selected candidate. +It is a function symbol \(sole action\) or list +of \(action-display . function\)." + (unless (helm-empty-buffer-p (helm-buffer-get)) + (helm-aif (helm-attr 'action-transformer) + (helm-composed-funcall-with-source + (helm-get-current-source) it + (helm-attr 'action) (helm-get-selection)) + (helm-attr 'action)))) + +(defun helm-get-current-source () + "Return the source for the current selection. +Allow also checking if helm-buffer contain candidates." + (or helm-current-source + (with-current-buffer (helm-buffer-get) + (or + ;; This happen only when `helm-source-in-each-line-flag' + ;; is non--nil and there is candidates in buffer. + (get-text-property (point) 'helm-source) + ;; Return nil when no--candidates. + (cl-block exit + ;; This goto-char shouldn't be necessary, but point is moved to + ;; point-min somewhere else which shouldn't happen. + (goto-char (overlay-start helm-selection-overlay)) + (let* ((header-pos (or (helm-get-previous-header-pos) + (helm-get-next-header-pos))) + (source-name + (save-excursion + (unless header-pos + (cl-return-from exit nil)) + (goto-char header-pos) + (helm-current-line-contents)))) + (cl-loop for source in (helm-get-sources) thereis + (and (equal (assoc-default 'name source) source-name) + source)))))))) + +(defun helm-buffer-is-modified (buffer) + "Return non-nil when BUFFER is modified since `helm' was invoked." + (let* ((b (get-buffer buffer)) + (key (concat (buffer-name b) "/" (helm-attr 'name))) + (source-tick (or (gethash key helm-tick-hash) 0)) + (buffer-tick (buffer-chars-modified-tick b)) + (modifiedp (/= source-tick buffer-tick))) + (puthash key buffer-tick helm-tick-hash) + (helm-log "buffer = %S" buffer) + (helm-log "modifiedp = %S" modifiedp) + modifiedp)) + +(defun helm-current-buffer-is-modified () + "Check if `helm-current-buffer' is modified since `helm' was invoked." + (helm-buffer-is-modified helm-current-buffer)) + +(defun helm-run-after-quit (function &rest args) + "Perform an action after quitting `helm'. +The action is to call FUNCTION with arguments ARGS." + (setq helm-quit t) + (helm-kill-async-processes) + (helm-log "function = %S" function) + (helm-log "args = %S" args) + (apply 'run-with-timer 0.1 nil function args) + (helm-exit-minibuffer)) + + +(defun define-helm-type-attribute (type definition &optional doc) + "Register type attribute of TYPE as DEFINITION with DOC. +DOC is displayed in `helm-type-attributes' docstring. + +Use this function is better than setting `helm-type-attributes' directly." + (cl-loop for i in definition do + ;; without `ignore-errors', error at emacs22 + (ignore-errors (setf i (delete nil i)))) + (helm-add-type-attribute type definition) + (and doc (helm-document-type-attribute type doc)) + nil) + +(defun helm-document-attribute (attribute short-doc &optional long-doc) + "Register ATTRIBUTE documentation introduced by plug-in. +SHORT-DOC is displayed beside attribute name. +LONG-DOC is displayed below attribute name and short documentation." + (if long-doc + (setq short-doc (concat "(" short-doc ")")) + (setq long-doc short-doc + short-doc "")) + (add-to-list 'helm-attributes attribute t) + (put attribute 'helm-attrdoc + (concat "- " (symbol-name attribute) + " " short-doc "\n\n" long-doc "\n"))) + +(put 'helm-document-attribute 'lisp-indent-function 2) + +(defun helm-interpret-value (value &optional source) + "Interpret VALUE as variable, function or literal and return it. +If VALUE is a function, call it with no arguments and return the value. +If SOURCE compute VALUE for this source. +If VALUE is a variable, return the value. +If VALUE is a symbol, but it is not a function or a variable, cause an error. +Otherwise, return VALUE itself." + (cond ((and source (functionp value)) + (helm-funcall-with-source source value)) + ((functionp value) + (funcall value)) + ((and (symbolp value) (boundp value)) + (symbol-value value)) + ((symbolp value) + (error + "helm-interpret-value: Symbol must be a function or a variable")) + (t + value))) + +(defun helm-set-local-variable (&rest args) + "Bind each pair in ARGS locally to `helm-buffer'. +Use this to set local vars before calling helm. +Usage: helm-set-local-variable ([VAR VALUE]...) +Just like `setq' except that the vars are not set sequentially. +IOW Don't use VALUE of previous VAR to eval the VALUE of next VAR. +When helm is alive use `make-local-variable' as usual on `helm-buffer'. + +\(fn VAR VALUE ...)" + (setq helm--local-variables + (append (cl-loop for i on args by #'cddr + collect (cons (car i) (cadr i))) + helm--local-variables))) + +(defun helm-make-actions (&rest args) + "Build an alist with (NAME . ACTION) elements with each pairs in ARGS. +Where NAME is a string or a function returning a string or nil and ACTION +a function. +If NAME returns nil the pair is skipped. + +\(fn NAME ACTION ...)" + (cl-loop for i on args by #'cddr + for name = (car i) + when (functionp name) + do (setq name (funcall name)) + when name + collect (cons name (cadr i)))) + +;; Core: API helper +(cl-defun helm-empty-buffer-p (&optional (buffer helm-buffer)) + "Check if BUFFER have candidates. +Default value for BUFFER is `helm-buffer'." + (zerop (buffer-size (and buffer (get-buffer buffer))))) + +(defun helm-empty-source-p () + "Check if current source contains candidates. +This happen only in certains cases when e.g the last element +of a source is deleted without updating the source." + (with-helm-window + (or (helm-empty-buffer-p) + (and (helm-end-of-source-p) + (eq (point-at-bol) (point-at-eol)) + (or + (save-excursion + (forward-line -1) + (helm-pos-header-line-p)) + (bobp)))))) + +(defun helm-symbol-name (obj) + (if (or (consp obj) (byte-code-function-p obj)) + "Anonymous" + (symbol-name obj))) + + +;; Core: tools +(defun helm-current-line-contents () + "Current line string without properties." + (buffer-substring-no-properties (point-at-bol) (point-at-eol))) + +(defun helm-funcall-with-source (source functions &rest args) + "Call from SOURCE FUNCTIONS list or single function FUNCTIONS with ARGS. +FUNCTIONS can be a symbol or a list of functions. +Return the result of last function call." + (let ((helm-source-name (assoc-default 'name source)) + (helm-current-source source) + (funs (if (functionp functions) (list functions) functions))) + (helm-log "helm-source-name = %S" helm-source-name) + (helm-log "functions = %S" functions) + (helm-log "args = %S" args) + (cl-loop with result for fn in funs + do (setq result (apply fn args)) + finally return result))) + +(defun helm-funcall-foreach (sym &optional sources) + "Call the associated function to SYM for each source if any." + (let ((sources (or sources (helm-get-sources)))) + (cl-dolist (source sources) + (helm-aif (assoc-default sym source) + (helm-funcall-with-source source it))))) + +(defun helm-normalize-sources (sources) + "If SOURCES is only one source, make a list of one element." + (cond ((or (and sources + (symbolp sources)) + (and (listp sources) (assq 'name sources))) + (list sources)) + (sources) + (t helm-sources))) + +(defun helm-get-candidate-number (&optional in-current-source) + "Return candidates number in `helm-buffer'. +If IN-CURRENT-SOURCE is provided return number of candidates +in the source where point is." + (with-current-buffer (helm-buffer-get) + (if (or (helm-empty-buffer-p) + (helm-empty-source-p)) + 0 + (save-excursion + (if in-current-source + (goto-char (helm-get-previous-header-pos)) + (goto-char (point-min))) + (forward-line 1) + (if (helm-pos-multiline-p) + (save-excursion + (cl-loop with count-multi = 1 + while (and (not (if in-current-source + (save-excursion + (forward-line 2) + (or (helm-pos-header-line-p) (eobp))) + (eobp))) + (search-forward helm-candidate-separator nil t)) + do (cl-incf count-multi) + finally return count-multi)) + (save-excursion + (cl-loop with ln = 0 + while (not (if in-current-source + (or (helm-pos-header-line-p) (eobp)) + (eobp))) + unless (helm-pos-header-line-p) + do (cl-incf ln) + do (forward-line 1) finally return ln))))))) + +(defmacro with-helm-quittable (&rest body) + "If an error occur in execution of BODY, quit helm safely." + (declare (indent 0) (debug t)) + `(condition-case _v + (let (inhibit-quit) + ,@body) + (quit (setq quit-flag t) + (setq helm-quit t) + (exit-minibuffer) + (keyboard-quit) + ;; See comment about this in `with-local-quit'. + (eval '(ignore nil))))) + +(defun helm-compose (arg-lst func-lst) + "Apply arguments specified in ARG-LST with each function of FUNC-LST. +The result of each function will be the new `car' of ARG-LST. +Each function in FUNC-LST must accept (length ARG-LST) arguments +\(See examples below) . +This function allows easy sequencing of transformer functions. +Where generally, ARG-LST is '(candidates-list source) and FUNC-LST a +list of transformer functions that take one or two arguments depending +we are using 'filtered-candidate-transformer' or 'candidate-transformer'. +e.g +filtered-candidate-transformer: +\(helm-compose '((1 2 3 4 5 6 7) + '((name . \"A helm source\") (candidates . (a b c)))) + '((lambda (candidates _source) + (cl-loop for i in candidates + when (cl-oddp i) collect i)) + (lambda (candidates _source) + (cl-loop for i in candidates collect (1+ i))))) +=>(2 4 6 8) + +candidate-transformer: +\(helm-compose '((1 2 3 4 5 6 7)) + '((lambda (candidates) + (cl-loop for i in candidates + when (cl-oddp i) collect i)) + (lambda (candidates) + (cl-loop for i in candidates collect (1+ i))))) +=> (2 4 6 8)." + (cl-dolist (func func-lst) + (setcar arg-lst (apply func arg-lst))) + (car arg-lst)) + +(defun helm-composed-funcall-with-source (source funcs &rest args) + "With SOURCE apply `helm-funcall-with-source' with each FUNCS and ARGS. +This is used in transformers to modify candidates list." + (if (functionp funcs) + (apply 'helm-funcall-with-source source funcs args) + (apply 'helm-funcall-with-source source + (lambda (&rest oargs) (helm-compose oargs funcs)) + args))) + +(defun helm-stringify (str-or-sym) + "Get string of STR-OR-SYM." + (if (stringp str-or-sym) + str-or-sym + (symbol-name str-or-sym))) + +(defun helm-symbolify (str-or-sym) + "Get symbol of STR-OR-SYM." + (if (symbolp str-or-sym) + str-or-sym + (intern str-or-sym))) + + +;; Core: entry point +;; `:allow-nest' is not in this list because it is treated before. +(defconst helm-argument-keys + '(:sources :input :prompt :resume + :preselect :buffer :keymap :default :history)) + +;;;###autoload +(defun helm (&rest plist) + "Main function to execute helm sources. + +Keywords supported: +:sources :input :prompt :resume :preselect +:buffer :keymap :default :history :allow-nest + +Extra LOCAL-VARS keywords are supported, see below. + +PLIST is a list like \(:key1 val1 :key2 val2 ...\) or +\(&optional sources input prompt resume + preselect buffer keymap default history\). + +Basic keywords are the following: + +\:sources + +A list of sources used for this session. It also accepts a +symbol, interpreted as a variable of a helm source +i.e (a symbol can be passed instead of a list of sources). +It also accepts an alist representing a helm source, which is +detected by \(assq 'name ANY-SOURCES\). +NOTE: In this case the source is embedded in the helm command and +have no symbol name, so it is not reachable from outside. +It will be referenced in `helm-sources' as a whole alist. + +\:input + +Temporary value of `helm-pattern', ie. initial input of minibuffer. + +\:prompt + +Prompt other than \"pattern: \". + +\:resume + +If t, Resurrect previously instance of `helm'. Skip the initialization. +If 'noresume, this instance of `helm' cannot be resumed. + +\:preselect + +Initially selected candidate. Specified by exact candidate or a regexp. + +\:buffer + +`helm-buffer' instead of *helm*. + +\:keymap + +`helm-map' for current `helm' session. + +\:default + +A default argument that will be inserted in minibuffer \ +with \\\\[next-history-element]. +When nil or not present `thing-at-point' will be used instead. +If `helm-maybe-use-default-as-input' is non--nil display will be +updated using :default arg as input unless :input is specified, +which in this case will take precedence on :default +This is a string or a list, in this case the car of the list will +be used as initial default input, but you will be able to cycle in this +list with \\\\[next-history-element]. + +\:history + +By default all minibuffer input is pushed to `minibuffer-history', +if an argument HISTORY is provided, input will be pushed to HISTORY. +History element should be a symbol. + +\:allow-nest + +Allow running this helm command within a running helm session. + +Of course, conventional arguments are supported, the two are same. + +\(helm :sources sources :input input :prompt prompt :resume resume + :preselect preselect :buffer buffer :keymap keymap :default default + :history history\) + +and + +\(helm sources input prompt resume preselect buffer keymap default history\) + +are the same. + +However the use of non keyword args is deprecated and should not be used. + +Other keywords are interpreted as local variables of this helm session. +The `helm-' prefix can be omitted. For example, + +\(helm :sources 'helm-source-buffers-list + :buffer \"*buffers*\" :candidate-number-limit 10\) + +means starting helm session with `helm-source-buffers' +source in *buffers* buffer and set variable `helm-candidate-number-limit' +to 10 as session local variable. + +\(fn &key SOURCES INPUT PROMPT RESUME PRESELECT BUFFER KEYMAP DEFAULT HISTORY ALLOW-NEST OTHER-LOCAL-VARS)" + (let ((fn (cond ((or (and helm-alive-p (plist-get plist :allow-nest)) + (and helm-alive-p (memq 'allow-nest plist))) + #'helm-nest) + ((keywordp (car plist)) + #'helm) + (t #'helm-internal)))) + (if (and helm-alive-p (eq fn #'helm)) + (if (helm-alive-p) + ;; A helm session is normally running. + (error "Error: Trying to run helm within a running helm session") + ;; A helm session is already running and user jump somewhere else + ;; without desactivating it. + (with-helm-buffer + (prog1 + (message "Aborting an helm session running in background") + ;; `helm-alive-p' will be reset in unwind-protect forms. + (helm-keyboard-quit)))) + (if (keywordp (car plist)) + ;; Parse `plist' and move not regular `helm-argument-keys' + ;; to `helm--local-variables', then calling helm on itself + ;; with normal arguments (the non--arguments-keys removed) + ;; will end up in [1]. + (progn + (setq helm--local-variables + (append helm--local-variables + ;; Vars passed by keyword on helm call + ;; take precedence on same vars + ;; that may have been passed before helm call. + (helm-parse-keys plist))) + (apply fn (mapcar #'(lambda (key) (plist-get plist key)) + helm-argument-keys))) + (apply fn plist))))) ; [1] fn == helm-internal. + +(defun helm-alive-p () + "Check if `helm' is alive. +An `helm' session is considered alive if `helm-alive-p' is non--nil, +the `helm-buffer' is visible, and cursor is in minibuffer." + (and helm-alive-p + (get-buffer-window helm-buffer 'visible) + (minibuffer-window-active-p (minibuffer-window)) + (minibufferp (current-buffer)))) + +(defun helm-parse-keys (keys) + "Parse the KEYS arguments of `helm'. +Return only the keys that are not in `helm-argument-keys', +prefix them with \"helm\" and convert them to alist. +This allow to add arguments that are not part of `helm-argument-keys', +but are valid helm variables. +e.g :candidate-number-limit will be bound to `helm-candidate-number-limit' +in source. + + (helm-parse-keys '(:sources ((name . \"test\") + (candidates . (a b c))) + :buffer \"toto\" + :candidate-number-limit 4)) + ==> ((helm-candidate-number-limit . 4))." + + (cl-loop for (key value) on keys by #'cddr + for symname = (substring (symbol-name key) 1) + for sym = (intern (if (string-match "^helm-" symname) + symname + (concat "helm-" symname))) + unless (memq key helm-argument-keys) + collect (cons sym value))) + +;;; Core: entry point helper +(defun helm-internal (&optional + any-sources any-input + any-prompt any-resume + any-preselect any-buffer + any-keymap any-default any-history) + "The internal helm function called by `helm'. +For ANY-SOURCES ANY-INPUT ANY-PROMPT ANY-RESUME ANY-PRESELECT ANY-BUFFER and +ANY-KEYMAP ANY-DEFAULT ANY-HISTORY See `helm'." + ;; Activate the advice for `tramp-read-passwd'. + (if (fboundp 'advice-add) + (progn + (advice-add 'tramp-read-passwd :around #'helm--advice-tramp-read-passwd) + (advice-add 'ange-ftp-get-passwd :around #'helm--advice-ange-ftp-get-passwd)) + (ad-activate 'tramp-read-passwd) + (ad-activate 'ange-ftp-get-passwd)) + (helm-log (concat "[Start session] " (make-string 41 ?+))) + (helm-log "any-prompt = %S" any-prompt) + (helm-log "any-preselect = %S" any-preselect) + (helm-log "any-buffer = %S" any-buffer) + (helm-log "any-keymap = %S" any-keymap) + (helm-log "any-default = %S" any-default) + (helm-log "any-history = %S" any-history) + (let ((non-essential t) + (input-method-verbose-flag helm-input-method-verbose-flag) + (old--cua cua-mode) + (helm-maybe-use-default-as-input + (or helm-maybe-use-default-as-input ; it is let-bounded so use it. + (cl-loop for s in (helm-normalize-sources any-sources) + thereis (memq s helm-sources-using-default-as-input))))) + ;; cua-mode overhide local helm bindings. + ;; disable this stupid thing if enabled. + (and cua-mode (cua-mode -1)) + (unwind-protect + (condition-case-unless-debug _v + (let ( ;; `helm-source-name' is non-nil + ;; when `helm' is invoked by action, reset it. + helm-source-name + helm-current-source + helm-in-persistent-action + helm-quit + (helm-buffer (or any-buffer helm-buffer))) + (with-helm-restore-variables + (helm-initialize + any-resume any-input any-default any-sources) + (helm-display-buffer helm-buffer) + (when helm-prevent-escaping-from-minibuffer + (helm--remap-mouse-mode 1)) ; Disable mouse bindings. + (add-hook 'post-command-hook 'helm--maybe-update-keymap) + (helm-log "show prompt") + (unwind-protect + (helm-read-pattern-maybe + any-prompt any-input any-preselect + any-resume any-keymap any-default any-history) + (helm-cleanup))) + (prog1 + (unless helm-quit (helm-execute-selection-action)) + (helm-log (concat "[End session] " (make-string 41 ?-))))) + (quit + (helm-restore-position-on-quit) + (helm-log (concat "[End session (quit)] " (make-string 34 ?-))) + nil)) + (remove-hook 'post-command-hook 'helm--maybe-update-keymap) + (if (fboundp 'advice-add) + (progn + (advice-remove 'tramp-read-passwd + #'helm--advice-tramp-read-passwd) + (advice-remove 'ange-ftp-get-passwd + #'helm--advice-ange-ftp-get-passwd)) + (ad-deactivate 'tramp-read-passwd) + (ad-deactivate 'ange-ftp-get-passwd)) + (helm-log "helm-alive-p = %S" (setq helm-alive-p nil)) + (helm--remap-mouse-mode -1) ; Reenable mouse bindings. + (setq helm-alive-p nil) + ;; Reset helm-pattern so that lambda's using it + ;; before running helm will not start with its old value. + (setq helm-pattern "") + (and old--cua (cua-mode 1)) + (helm-log-save-maybe)))) + + +;;; Helm resume +;; +;; +(defun helm-resume (arg) + "Resurrect previously invoked `helm'. +Called with a prefix arg, allow choosing among all existing +helm buffers. i.e choose among various helm sessions. +Called from lisp, you can specify a buffer-name as a string with ARG." + (interactive "P") + (let (any-buffer helm-full-frame cur-dir) + (if arg + (if (and (stringp arg) (bufferp (get-buffer arg))) + (setq any-buffer arg) + (setq any-buffer (helm-resume-select-buffer))) + (setq any-buffer helm-last-buffer)) + (cl-assert any-buffer nil + "helm-resume: No helm buffers found to resume") + ;; Reset `cursor-type' to nil as it have been set to t + ;; when quitting previous session. + (with-current-buffer any-buffer (setq cursor-type nil)) + (setq helm-full-frame (buffer-local-value + 'helm-full-frame (get-buffer any-buffer))) + (setq helm-compiled-sources nil) + (setq cur-dir (buffer-local-value + 'default-directory (get-buffer any-buffer))) + (unless (buffer-live-p helm-current-buffer) + ;; `helm-current-buffer' may have been killed. + (setq helm-current-buffer (current-buffer))) + ;; Restart with same `default-directory' value this session + ;; was initially started with. + (with-helm-default-directory cur-dir + (helm + :sources (buffer-local-value + 'helm-sources (get-buffer any-buffer)) + :input (buffer-local-value 'helm-input-local (get-buffer any-buffer)) + :resume t + :buffer any-buffer)))) + +(defun helm-resume-previous-session-after-quit (arg) + "Resume previous helm session within running helm." + (interactive "p") + (if (and helm-alive-p (> (length helm-buffers) arg)) + (helm-run-after-quit `(lambda () (helm-resume (nth ,arg helm-buffers)))) + (message "No previous helm sessions to resume yet!"))) + +(defun helm-resume-list-buffers-after-quit () + "List resumable helm buffers within running helm." + (interactive) + (if (and helm-alive-p (> (length helm-buffers) 0)) + (helm-run-after-quit #'(lambda () (helm-resume t))) + (message "No previous helm sessions to resume yet!"))) + +(defun helm-resume-p (any-resume) + "Whether current helm session is resumed or not." + (eq any-resume t)) + +(defun helm-resume-select-buffer () + "Select an `helm-buffer' in `helm-buffers' list to resume a helm session. +Return nil if no `helm-buffer' found." + (when helm-buffers + (or (helm :sources '(((name . "Resume helm buffer") + (candidates . helm-buffers) + (action . identity))) + :resume 'noresume + :buffer "*helm resume*") + (keyboard-quit)))) + + +;;;###autoload +(defun helm-other-buffer (any-sources any-buffer) + "Simplified interface of `helm' with other `helm-buffer'. +Call `helm' with only ANY-SOURCES and ANY-BUFFER as args." + (helm :sources any-sources :buffer any-buffer)) + +(defun helm-nest (&rest same-as-helm) + "Allow calling `helm' whithin a running helm session. +Arguments SAME-AS-HELM are the same as `helm', which see." + (with-helm-window + (let ((orig-helm-current-buffer helm-current-buffer) + (orig-helm-buffer helm-buffer) + (orig-helm--in-fuzzy helm--in-fuzzy) + (orig-helm-last-frame-or-window-configuration + helm-last-frame-or-window-configuration) + (orig-one-window-p helm-onewindow-p)) + (unwind-protect + (let (helm-current-position + helm-current-buffer + helm-pattern + (helm-buffer (or (cl-getf same-as-helm :buffer) + (nth 5 same-as-helm) + "*Helm*")) + helm-sources + helm-compiled-sources + (helm-full-frame t) + (enable-recursive-minibuffers t)) + (apply #'helm same-as-helm)) + (with-current-buffer orig-helm-buffer + (setq helm-alive-p t) ; Nested session set this to nil on exit. + (setq helm-buffer orig-helm-buffer) + (setq helm--in-fuzzy orig-helm--in-fuzzy) + (helm-initialize-overlays helm-buffer) + (unless (helm-empty-buffer-p) (helm-mark-current-line t)) + (setq helm-last-frame-or-window-configuration + orig-helm-last-frame-or-window-configuration) + (setq cursor-type nil) + (setq helm-current-buffer orig-helm-current-buffer) + (setq helm-onewindow-p orig-one-window-p)))))) + + +;;; Core: Accessors +;; +(defun helm-current-position (save-or-restore) + "Restore or save current position in `helm-current-buffer'. +Argument SAVE-OR-RESTORE is one of save or restore." + (cl-case save-or-restore + (save + (helm-log "Save position at %S" (cons (point) (window-start))) + (setq helm-current-position (cons (point) (window-start)))) + (restore + (helm-log "Restore position at %S in buffer %s" + helm-current-position + (buffer-name (current-buffer))) + (goto-char (car helm-current-position)) + ;; Fix this position with the NOFORCE arg of `set-window-start' + ;; otherwise, if there is some other buffer than `helm-current-buffer' + ;; one, position will be lost. + (set-window-start (selected-window) (cdr helm-current-position) t)))) + + +(defun helm-frame-or-window-configuration (save-or-restore) + "Save or restore last frame or window configuration. +Possible value of SAVE-OR-RESTORE are 'save and 'restore. +window or frame configuration is saved/restored according to values of +`helm-save-configuration-functions'." + (helm-log "helm-save-configuration-functions = %S" + helm-save-configuration-functions) + (let ((window-persistent-parameters (append '((no-other-window . t)) + window-persistent-parameters))) + (cl-case save-or-restore + (save (setq helm-last-frame-or-window-configuration + (funcall (cdr helm-save-configuration-functions)))) + (restore (funcall (car helm-save-configuration-functions) + helm-last-frame-or-window-configuration) + ;; Restore frame focus. + ;; This is needed for minibuffer own-frame config + ;; when recursive minibuffers are in use. + ;; e.g M-: + helm-minibuffer-history. + (let ((frame (if (minibufferp helm-current-buffer) + (selected-frame) + (last-nonminibuffer-frame)))) + (select-frame-set-input-focus frame)))))) + +(defun helm-split-window-default-fn (window) + (let (split-width-threshold) + (if (and (fboundp 'window-in-direction) + ;; Don't try to split when starting in a minibuffer + ;; e.g M-: and try to use helm-show-kill-ring. + (not (minibufferp helm-current-buffer))) + (if (or (one-window-p t) + helm-split-window-in-side-p) + (split-window + (selected-window) nil (if (eq helm-split-window-default-side 'other) + 'below helm-split-window-default-side)) + ;; If more than one window reuse one of them. + (cl-case helm-split-window-default-side + (left (or (helm-window-in-direction 'left) + (helm-window-in-direction 'above) + (selected-window))) + (above (or (helm-window-in-direction 'above) + (helm-window-in-direction 'left) + (selected-window))) + (right (or (helm-window-in-direction 'right) + (helm-window-in-direction 'below) + (selected-window))) + (below (or (helm-window-in-direction 'below) + (helm-window-in-direction 'right) + (selected-window))) + (same (selected-window)) + (other (other-window-for-scrolling)) + (t (or (window-next-sibling) (selected-window))))) + (split-window-sensibly window)))) + +(defun helm-window-in-direction (direction) + "Same as `window-in-direction' but check if window is dedicated." + (helm-aif (window-in-direction direction) + (and (not (window-dedicated-p it)) it))) + + +;;; Display helm buffer +;; +;; +(defun helm-display-buffer (buffer) + "Display BUFFER. +The function used to display `helm-buffer'." + (let (pop-up-frames + (split-window-preferred-function + helm-split-window-preferred-function) + (helm-split-window-default-side + (if (and (not helm-full-frame) + helm-reuse-last-window-split-state) + (cond ((eq helm-split-window-default-side 'same) 'same) + ((eq helm-split-window-default-side 'other) 'other) + (helm--window-side-state) + (t helm-split-window-default-side)) + helm-split-window-default-side))) + (prog1 + (funcall (with-current-buffer buffer helm-display-function) buffer) + (setq helm-onewindow-p (one-window-p t)) + ;; Don't allow other-window and friends switching out of minibuffer. + (when helm-prevent-escaping-from-minibuffer + (helm-prevent-switching-other-window))))) + +(cl-defun helm-prevent-switching-other-window (&key (enabled t)) + "Allow setting `no-other-window' window parameter in all windows. +Arg ENABLE will be the value of the `no-other-window' window property." + (walk-windows + #'(lambda (w) + (unless (window-dedicated-p w) + (set-window-parameter w 'no-other-window enabled))) + 0)) + +(defun helm-default-display-buffer (buffer) + "Default function to display `helm-buffer' BUFFER. +It uses `switch-to-buffer' or `pop-to-buffer' depending of value of +`helm-full-frame' and/or `helm-split-window-default-side'." + (if (or (buffer-local-value 'helm-full-frame (get-buffer buffer)) + (and (eq helm-split-window-default-side 'same) + (one-window-p t))) + (progn (delete-other-windows) (switch-to-buffer buffer)) + (when (and (or helm-always-two-windows helm-autoresize-mode) + (not (eq helm-split-window-default-side 'same)) + (not (minibufferp helm-current-buffer)) + (not helm-split-window-in-side-p)) + (delete-other-windows)) + (pop-to-buffer buffer))) + + +;;; Core: initialize +;; +(defun helm-initialize (any-resume any-input any-default any-sources) + "Start initialization of `helm' session. +For ANY-RESUME ANY-INPUT ANY-DEFAULT and ANY-SOURCES See `helm'." + (helm-log "start initialization: any-resume=%S any-input=%S" + any-resume any-input) + (helm-frame-or-window-configuration 'save) + (setq helm-sources (helm-normalize-sources any-sources)) + (setq helm--in-fuzzy + (cl-loop for s in helm-sources + for matchfns = (helm-match-functions + (if (symbolp s) (symbol-value s) s)) + for searchfns = (helm-search-functions + (if (symbolp s) (symbol-value s) s)) + when (or (member 'helm-fuzzy-match matchfns) + (member 'helm-fuzzy-search searchfns)) + return t)) + (helm-log "sources = %S" helm-sources) + (helm-current-position 'save) + (if (helm-resume-p any-resume) + (helm-initialize-overlays (helm-buffer-get)) + (helm-initial-setup any-default)) + (setq helm-alive-p t) + (unless (eq any-resume 'noresume) + (helm-recent-push helm-buffer 'helm-buffers) + (setq helm-last-buffer helm-buffer)) + (when any-input + (setq helm-input any-input + helm-pattern any-input) + (helm--fuzzy-match-maybe-set-pattern)) + ;; If a `resume' attribute is present `helm-funcall-foreach' + ;; will run its function. + (when (helm-resume-p any-resume) + (helm-funcall-foreach 'resume)) + (helm-log "end initialization")) + +(defun helm-initialize-overlays (buffer) + "Initialize helm overlays in BUFFER." + (helm-log "overlay setup") + (if helm-selection-overlay + ;; make sure the overlay belongs to the helm buffer if + ;; it's newly created + (move-overlay helm-selection-overlay (point-min) (point-min) + (get-buffer buffer)) + + (setq helm-selection-overlay + (make-overlay (point-min) (point-min) (get-buffer buffer))) + (overlay-put helm-selection-overlay 'face 'helm-selection) + (overlay-put helm-selection-overlay 'priority 1))) + +(defun helm-restore-position-on-quit () + "Restore position in `helm-current-buffer' when quitting." + (helm-current-position 'restore)) + +(defun helm-recent-push (elt list-var) + "Add ELT to the value of LIST-VAR as most recently used value." + (let ((m (member elt (symbol-value list-var)))) + (and m (set list-var (delq (car m) (symbol-value list-var)))) + (push elt (symbol-value list-var)))) + +(defun helm--current-buffer () + "[internal] Return `current-buffer' BEFORE `helm-buffer' is initialized. +Note that this will return the minibuffer in use after helm have started, +so to get the buffer where helm started while in a helm session, +use `helm-current-buffer'. +It is intended to use this only in `helm-initial-setup'." + (if (minibuffer-window-active-p (minibuffer-window)) + ;; If minibuffer is active be sure to use it's buffer + ;; as `helm-current-buffer', this allow to use helm + ;; from an already active minibuffer (M-: etc...) + (window-buffer (active-minibuffer-window)) + ;; Fix Issue #456 + ;; Use this instead of `current-buffer' to ensure + ;; helm session started in helm-mode from a completing-read + ;; Use really the buffer where we started and not the one + ;; where the completing-read is wrapped. i.e + ;; (with-current-buffer SOME-OTHER-BUFFER (completing-read [...]) + (window-buffer (with-selected-window (minibuffer-window) + (minibuffer-selected-window))))) + +(defun helm-initial-setup (any-default) + "Initialize helm settings and set up the helm buffer." + (helm-log-run-hook 'helm-before-initialize-hook) + (cl-loop for s in (helm-get-sources) + for hook = (assoc-default 'before-init-hook s) + when hook do (helm-log-run-hook hook)) + ;; For initialization of helm locals vars that need + ;; a value from current buffer, it is here. + (helm-set-local-variable 'current-input-method current-input-method) + (setq helm-current-prefix-arg nil) + (setq helm-suspend-update-flag nil) + (setq helm-current-buffer (helm--current-buffer)) + (setq helm-buffer-file-name buffer-file-name) + (setq helm-issued-errors nil) + (setq helm-compiled-sources nil) + (setq helm-saved-current-source nil) + (unless (and (or helm-split-window-state + helm--window-side-state) + helm-reuse-last-window-split-state) + (setq helm-split-window-state + (if (or (null split-width-threshold) + (and (integerp split-width-threshold) + (>= split-width-threshold (+ (frame-width) 4)))) + 'vertical 'horizontal)) + (setq helm--window-side-state + (or helm-split-window-default-side 'below))) + ;; Call the init function for sources where appropriate + (helm-funcall-foreach + 'init (and helm-source-filter + (cl-remove-if-not #'(lambda (s) + (member (assoc-default 'name s) + helm-source-filter)) + (helm-get-sources)))) + (setq helm-pattern (or (and helm-maybe-use-default-as-input + (or (if (listp any-default) + (car any-default) any-default) + (with-helm-current-buffer + (thing-at-point 'symbol)))) + "")) + (setq helm-input "") + (clrhash helm-candidate-cache) + (helm-create-helm-buffer) + (helm-clear-visible-mark) + (helm-log-run-hook 'helm-after-initialize-hook) + (cl-loop for s in (helm-get-sources) + for hook = (assoc-default 'after-init-hook s) + when hook do (helm-log-run-hook hook))) + +(defun helm-create-helm-buffer () + "Create and setup `helm-buffer'." + (let ((root-dir default-directory)) + (with-current-buffer (get-buffer-create helm-buffer) + (helm-log "kill local variables: %S" (buffer-local-variables)) + (kill-all-local-variables) + (set (make-local-variable 'inhibit-read-only) t) + (buffer-disable-undo) + (erase-buffer) + (set (make-local-variable 'helm-map) helm-map) + (make-local-variable 'helm-sources) + (set (make-local-variable 'helm-follow-mode) nil) + (set (make-local-variable 'helm-display-function) helm-display-function) + (set (make-local-variable 'helm-selection-point) nil) + (set (make-local-variable 'scroll-margin) + (if helm-display-source-at-screen-top + 0 helm-completion-window-scroll-margin)) + (set (make-local-variable 'default-directory) root-dir) + (set (make-local-variable 'helm-marked-candidates) nil) + (helm-initialize-persistent-action) + (helm-log "helm-display-function = %S" helm-display-function) + (helm-log "helm--local-variables = %S" helm--local-variables) + (cl-loop for (var . val) in helm--local-variables + do (set (make-local-variable var) val) + finally (setq helm--local-variables nil)) + (setq truncate-lines helm-truncate-lines) ; already local. + (setq cursor-type nil) + (setq mode-name "Helm")) + (helm-initialize-overlays helm-buffer) + (get-buffer helm-buffer))) + +(define-minor-mode helm--minor-mode + "[INTERNAL] Enable keymap in helm minibuffer. +This mode have no effect when run outside of helm context. +Please don't use it. + +\\{helm-map}" + :group 'helm + :keymap (and helm-alive-p helm-map) + (unless helm-alive-p (setq helm--minor-mode nil))) + +(defun helm-read-pattern-maybe (any-prompt any-input + any-preselect any-resume any-keymap + any-default any-history) + "Read pattern with prompt ANY-PROMPT and initial input ANY-INPUT. +For ANY-PRESELECT ANY-RESUME ANY-KEYMAP ANY-DEFAULT ANY-HISTORY, See `helm'." + (if (and (helm-resume-p any-resume) + ;; When no source, helm-buffer is empty + ;; or contain non--candidate lines (e.g grep exit status) + (helm-get-current-source)) + (helm-mark-current-line t) + (helm-update any-preselect)) + (with-current-buffer (helm-buffer-get) + (let* ((src (helm-get-current-source)) + (src-keymap (assoc-default 'keymap src)) + (hist (or (and any-history (symbolp any-history) any-history) + ;; Needed for resuming. + (assoc-default 'history src))) + (timer nil) + blink-matching-paren + (first-src (car helm-sources)) + (source-delayed-p (or (assq 'delayed src) + (assq 'delayed (if (symbolp first-src) + (symbol-value first-src) + first-src))))) + ;; Startup with the first keymap found either in current source + ;; or helm arg, otherwise use global value of `helm-map'. + ;; This map will be used as a `minibuffer-local-map'. + ;; Maybe it will be overriden when changing source + ;; by `helm--maybe-update-keymap'. + ;; Note that helm-map have been made buffer-local + ;; in `helm-create-helm-buffer'. + (setq helm-map (or src-keymap any-keymap helm-map)) + (helm-log "helm-get-candidate-number => %S" + (helm-get-candidate-number)) + (helm-log "helm-execute-action-at-once-if-one = %S" + helm-execute-action-at-once-if-one) + (helm-log "helm-quit-if-no-candidate = %S" helm-quit-if-no-candidate) + ;; If source is delayed `helm-execute-action-at-once-if-one' + ;; and `helm-quit-if-no-candidate' are handled after update finish. + (when source-delayed-p + ;; Note that we quickly add the hook now when `helm-update' + ;; is already started, but because source is delayed the hook + ;; should have the time to be passed !!! + ;; the hook will remove itself once done. + (with-helm-after-update-hook (helm-exit-or-quit-maybe))) + ;; Reset `helm-pattern' for non--delayed sources and update + ;; display if no result found with precedent value of `helm-pattern' + ;; unless `helm-quit-if-no-candidate' is non--nil, in this case + ;; Don't force update with an empty pattern. + ;; Reset also `helm-maybe-use-default-as-input' as this checking + ;; happen only on startup. + (when (and helm-maybe-use-default-as-input (not source-delayed-p)) + (setq helm-pattern "") + (setq helm-maybe-use-default-as-input nil) + (and (helm-empty-buffer-p) + (null helm-quit-if-no-candidate) + (helm-force-update))) + ;; Handle `helm-execute-action-at-once-if-one' and + ;; `helm-quit-if-no-candidate' now only for not--delayed sources. + (cond ((and helm-execute-action-at-once-if-one + (not source-delayed-p) + (= (helm-get-candidate-number) 1)) + (ignore)) ; Don't enter the minibuffer loop. + ((and helm-quit-if-no-candidate + (not source-delayed-p) + (= (helm-get-candidate-number) 0)) + (setq helm-quit t) + (and (functionp helm-quit-if-no-candidate) + (funcall helm-quit-if-no-candidate))) + (t ; Enter now minibuffer and wait for input. + (let ((tap (or any-default + (with-helm-current-buffer + (thing-at-point 'symbol))))) + (unwind-protect + (minibuffer-with-setup-hook + #'(lambda () + ;; Start minor-mode with global value of helm-map. + (helm--minor-mode 1) + ;; Now overhide the global value of helm-map with + ;; the local one. + (setq minor-mode-overriding-map-alist + `((helm--minor-mode + . ,(with-helm-buffer helm-map)))) + (setq timer (run-with-idle-timer + (max helm-input-idle-delay 0.001) 'repeat + #'(lambda () + ;; Stop updating when in persistent action + ;; or when `helm-suspend-update-flag' is + ;; non--nil. + (unless (or helm-in-persistent-action + helm-suspend-update-flag) + (save-selected-window + (helm-check-minibuffer-input) + (helm-print-error-messages))))))) + (read-from-minibuffer (or any-prompt "pattern: ") + any-input helm-map + nil hist tap helm-inherit-input-method)) + (when timer (cancel-timer timer) (setq timer nil))))))))) + +(defun helm-exit-or-quit-maybe () + "Exit and run default action if only one candidate, quit if no candidates. +This function is handling `helm-execute-action-at-once-if-one' and +`helm-quit-if-no-candidate' in delayed sources." + (with-helm-window + (cond ((and helm-execute-action-at-once-if-one + (= (helm-get-candidate-number) 1)) + (helm-exit-minibuffer)) + ((and helm-quit-if-no-candidate + (= (helm-get-candidate-number) 0)) + (setq helm-quit t) + (and (functionp helm-quit-if-no-candidate) + (funcall helm-quit-if-no-candidate)) + (keyboard-quit))))) + +(defun helm-toggle-suspend-update () + "Enable or disable update of display in helm. +This can be useful for e.g writing quietly a complex regexp." + (interactive) + (when (setq helm-suspend-update-flag (not helm-suspend-update-flag)) + (helm-kill-async-processes) + (setq helm-pattern "")) + (message (if helm-suspend-update-flag + "Helm update suspended!" + "Helm update reenabled!"))) + +(defadvice tramp-read-passwd (around disable-helm-update) + ;; Suspend update when prompting for a tramp password. + (setq helm-suspend-update-flag t) + (setq overriding-terminal-local-map nil) + (setq helm--reading-passwd-or-string t) + (let (stimers) + (unwind-protect + (progn + (setq stimers (with-timeout-suspend)) + ad-do-it) + (with-timeout-unsuspend stimers) + (setq helm--reading-passwd-or-string nil) + (setq helm-suspend-update-flag nil)))) + +(defun helm--advice-tramp-read-passwd (old--fn &rest args) + ;; Suspend update when prompting for a tramp password. + (setq helm-suspend-update-flag t) + (setq overriding-terminal-local-map nil) + (setq helm--reading-passwd-or-string t) + (unwind-protect + ;; No need to suspend timer in emacs-24.4 + ;; it is fixed upstream. + (apply old--fn args) + (setq helm--reading-passwd-or-string nil) + (setq helm-suspend-update-flag nil))) + +(defun helm--advice-ange-ftp-get-passwd (old--fn &rest args) + ;; Suspend update when prompting for a ange password. + (setq helm-suspend-update-flag t) + (setq overriding-terminal-local-map nil) + (setq helm--reading-passwd-or-string t) + (unwind-protect + (apply old--fn args) + (setq helm--reading-passwd-or-string nil) + (setq helm-suspend-update-flag nil))) + +(defadvice ange-ftp-get-passwd (around disable-helm-update) + ;; Suspend update when prompting for a ange password. + (setq helm-suspend-update-flag t) + (setq overriding-terminal-local-map nil) + (setq helm--reading-passwd-or-string t) + (unwind-protect + ad-do-it + (setq helm--reading-passwd-or-string nil) + (setq helm-suspend-update-flag nil))) + +(defun helm--maybe-update-keymap () + "Handle differents keymaps in multiples sources. + +It will override `helm-map' with the local map of current source. +If no map is found in current source do nothing (keep previous map)." + (with-helm-buffer + (helm-aif (assoc-default 'keymap (helm-get-current-source)) + ;; We need the timer to leave enough time + ;; to helm to setup its buffer when changing source + ;; from a recursive minibuffer. + ;; e.g C-x C-f M-y C-g + ;; => *find-files have now the bindings of *kill-ring. + (run-with-idle-timer + 0.01 nil + (lambda () + (with-current-buffer (window-buffer (minibuffer-window)) + (setq minor-mode-overriding-map-alist `((helm--minor-mode . ,it))))))))) + +;;; Prevent loosing focus when using mouse. +;; +(defvar helm--remap-mouse-mode-map + (let ((map (make-sparse-keymap))) + (cl-loop for k in '([mouse-1] [mouse-2] [mouse-3] + [down-mouse-1] [down-mouse-2] [down-mouse-3] + [drag-mouse-1] [drag-mouse-2] [drag-mouse-3] + [double-mouse-1] [double-mouse-2] [double-mouse-3] + [triple-mouse-1] [triple-mouse-2] [triple-mouse-3]) + do (define-key map k 'undefined)) + map)) + +(define-minor-mode helm--remap-mouse-mode + "[INTERNAL] Prevent escaping helm minibuffer with mouse clicks. +Do nothing when used outside of helm context. + +WARNING: Do not use this mode yourself, it is internal to helm." + :group 'helm + :global t + :keymap helm--remap-mouse-mode-map + (unless helm-alive-p + (setq helm--remap-mouse-mode-map nil))) + +;; Core: clean up + +(defun helm-cleanup () + "Clean up the mess when helm exit or quit." + (helm-log "start cleanup") + (with-current-buffer helm-buffer + ;; bury-buffer from this window. + (bury-buffer) ;[1] + ;; Be sure we call this from helm-buffer. + (helm-funcall-foreach 'cleanup)) + (helm-kill-async-processes) + ;; When running helm from a dedicated frame + ;; with no minibuffer, helm will run in the main frame + ;; which have a minibuffer, so be sure to disable + ;; the `no-other-window' prop there. + (helm-prevent-switching-other-window :enabled nil) + (helm-log-run-hook 'helm-cleanup-hook) + (helm-frame-or-window-configuration 'restore) + ;; [1] now bury-buffer from underlying windows otherwise, + ;; if this window is killed the underlying buffer will + ;; be a helm buffer. + (replace-buffer-in-windows helm-buffer) + (setq helm-alive-p nil) + ;; This is needed in some cases where last input + ;; is yielded infinitely in minibuffer after helm session. + (helm-clean-up-minibuffer)) + +(defun helm-clean-up-minibuffer () + "Remove contents of minibuffer." + (let ((miniwin (minibuffer-window))) + ;; Clean only current minibuffer used by helm. + ;; i.e The precedent one is active. + (unless (minibuffer-window-active-p miniwin) + (with-current-buffer (window-buffer miniwin) + (delete-minibuffer-contents))))) + + +;;; Core: input handling +;; +;; +(defun helm-check-minibuffer-input () + "Check minibuffer content." + (with-helm-quittable + (with-selected-window (or (active-minibuffer-window) + (minibuffer-window)) + (helm-check-new-input (minibuffer-contents))))) + +(defun helm-check-new-input (input) + "Check INPUT string and update the helm buffer if necessary." + ;; First time minibuffer is entered + ;; we check value of `helm-pattern' that have been set + ;; in `helm-initial-setup' when `helm-maybe-use-default-as-input' + ;; is non--nil. After this initial check, reset + ;; `helm-maybe-use-default-as-input' and ignore this. + ;; This happen only when source is `delayed'. + (when helm-maybe-use-default-as-input ; nil when non--delayed. + (setq input helm-pattern) + (with-helm-after-update-hook (setq helm-pattern "")) + (setq helm-maybe-use-default-as-input nil)) + ;; In delayed sources `helm-pattern' have not been resat yet. + (unless (equal input helm-pattern) + (setq helm-pattern input) + (unless (helm-action-window) + (setq helm-input helm-pattern)) + (helm-log "helm-pattern = %S" helm-pattern) + (helm-log "helm-input = %S" helm-input) + (setq helm--in-update t) + (helm-update))) + +(defun helm--reset-update-flag () + (run-with-idle-timer + helm-exit-idle-delay nil + (lambda () (setq helm--in-update nil)))) + +(add-hook 'helm-after-update-hook #'helm--reset-update-flag) + + +;;; Core: source compiler +;; +;; +(defun helm-compile-sources (sources funcs) + "Compile SOURCES with FUNCS. +See `helm-compile-source-functions'. +Helm plug-ins are realized by this function." + (mapcar + (lambda (source) + (cl-loop with src = (if (listp source) source (symbol-value source)) + for noplug = (assoc 'dont-plug src) + for f in funcs + unless (and noplug (memq f (cdr noplug))) + do (setq src (funcall f src)) + finally (cl-return src))) + sources)) + + +;; Core: all candidates + +(defun helm-get-candidates (source) + "Retrieve and return the list of candidates from SOURCE." + (let* (inhibit-quit + (candidate-fn (assoc-default 'candidates source)) + (candidate-proc (assoc-default 'candidates-process source)) + (type-error (lambda () + (error + "`%s' must either be a function, a variable or a list" + (or candidate-fn candidate-proc)))) + (candidates (condition-case-unless-debug err + ;; Process candidates-(process) function + ;; It may return a process or a list of candidates. + (if candidate-proc + (helm-interpret-value candidate-proc source) + (helm-interpret-value candidate-fn source)) + (error (helm-log "Error: %S" err) nil)))) + (when (and (processp candidates) (not candidate-proc)) + (warn "Candidates function `%s' should be called in a `candidates-process' attribute" + candidate-fn)) + (cond ((processp candidates) + ;; Candidates will be filtered later in process filter. + candidates) + ((or (null candidates) + ;; Can happen when the output of a process + ;; is empty, and the candidates function call + ;; something like (split-string (buffer-string) "\n") + ;; which result in a list of one empty string (Issue #938). + ;; e.g (completing-read "test: " '("")) + (equal candidates '(""))) + nil) + ((listp candidates) + ;; Transform candidates with `candidate-transformer' functions if + ;; some, otherwise return candidates. + (helm-transform-candidates candidates source)) + (t (funcall type-error))))) + +(defmacro helm-while-no-input (&rest body) + "Same as `while-no-input' but without testing with `input-pending-p'." + (declare (debug t) (indent 0)) + (let ((catch-sym (make-symbol "input")) + inhibit-quit) + `(with-local-quit + (catch ',catch-sym + (let ((throw-on-input ',catch-sym)) + ,@body))))) + +(defun helm-get-cached-candidates (source) + "Return the cached value of candidates for SOURCE. +Cache the candidates if there is not yet a cached value." + (let* ((name (assoc-default 'name source)) + (candidate-cache (gethash name helm-candidate-cache))) + (helm-aif candidate-cache + (prog1 it (helm-log "Use cached candidates")) + (helm-log "No cached candidates, calculate candidates") + (let ((candidates (helm-get-candidates source))) + (cond ((processp candidates) + (push (cons candidates + (append source + (list (cons 'item-count 0) + (cons 'incomplete-line "")))) + helm-async-processes) + (set-process-filter candidates 'helm-output-filter) + (setq candidates nil)) + ((not (assoc 'volatile source)) + (puthash name candidates helm-candidate-cache))) + candidates)))) + + +;;; Core: candidate transformers +(defun helm-transform-mapcar (function args) + "`mapcar' for candidate-transformer. + +ARGS is (cand1 cand2 ...) or ((disp1 . real1) (disp2 . real2) ...) + +\(helm-transform-mapcar 'upcase '(\"foo\" \"bar\")) +=> (\"FOO\" \"BAR\") +\(helm-transform-mapcar 'upcase '((\"1st\" . \"foo\") (\"2nd\" . \"bar\"))) +=> ((\"1st\" . \"FOO\") (\"2nd\" . \"BAR\")) +" + (cl-loop for arg in args + if (consp arg) + collect (cons (car arg) (funcall function (cdr arg))) + else + collect (funcall function arg))) + +(defun helm-process-candidate-transformer (candidates source) + "Execute `candidate-transformer' function(s) on CANDIDATES in SOURCE." + (helm-aif (assoc-default 'candidate-transformer source) + (helm-composed-funcall-with-source source it candidates) + candidates)) + +(defun helm-process-filtered-candidate-transformer (candidates source) + "Execute `filtered-candidate-transformer' function(s) on CANDIDATES in SOURCE." + (helm-aif (assoc-default 'filtered-candidate-transformer source) + (helm-composed-funcall-with-source source it candidates source) + candidates)) + +(defmacro helm--maybe-process-filter-one-by-one-candidate (candidate source) + "Execute `filter-one-by-one' function(s) on CANDIDATE in SOURCE." + `(helm-aif (assoc-default 'filter-one-by-one ,source) + (if (and (listp it) + (not (functionp it))) ;; Don't treat lambda's as list. + (cl-loop for f in it + do (setq ,candidate (funcall f ,candidate))) + (setq ,candidate (funcall it ,candidate))))) + +(defun helm--initialize-one-by-one-candidates (candidates source) + "Process the CANDIDATES with the `filter-one-by-one' function in SOURCE. +Return CANDIDATES when pattern is empty." + (helm-aif (and (string= helm-pattern "") + (assoc-default 'filter-one-by-one source)) + (cl-loop for cand in candidates + do (helm--maybe-process-filter-one-by-one-candidate cand source) + collect cand) + candidates)) + +(defun helm-process-filtered-candidate-transformer-maybe + (candidates source process-p) + "Execute `filtered-candidate-transformer' function(s) on CANDIDATES in SOURCE. +When PROCESS-P is non-nil execute `filtered-candidate-transformer' +functions if some, otherwise return CANDIDATES." + (if process-p + ;; When no filter return CANDIDATES unmodified. + (helm-process-filtered-candidate-transformer candidates source) + candidates)) + +(defun helm-process-real-to-display (candidates source) + "Execute real-to-display function on all CANDIDATES of SOURCE." + (helm-aif (assoc-default 'real-to-display source) + (setq candidates (helm-funcall-with-source + source 'mapcar + (lambda (cand_) + (if (consp cand_) + ;; override DISPLAY from candidate-transformer + (cons (funcall it (cdr cand_)) (cdr cand_)) + (cons (funcall it cand_) cand_))) + candidates)) + candidates)) + +(defun helm-transform-candidates (candidates source &optional process-p) + "Transform CANDIDATES of SOURCE according to candidate transformers. +When PROCESS-P is non-nil execute the `filtered-candidate-transformer' functions +otherwise only the `candidate-transformer' functions are processed. +When attribute `real-to-display' is present, execute its function on all maybe +filtered CANDIDATES." + (helm-process-real-to-display + (helm-process-filtered-candidate-transformer-maybe + (helm-process-candidate-transformer + (helm--initialize-one-by-one-candidates candidates source) source) + source process-p) + source)) + + +;; Core: narrowing candidates +(defun helm-candidate-number-limit (source) + "Apply candidate-number-limit attribute value. +This overhide variable `helm-candidate-number-limit'. + +e.g: +If \(candidate-number-limit\) is in SOURCE, show all candidates in SOURCE. +If \(candidate-number-limit . 123\) is in SOURCE limit candidate to 123." + (helm-aif (assq 'candidate-number-limit source) + (or (cdr it) 99999999) + (or helm-candidate-number-limit 99999999))) + +(defun helm-candidate-get-display (candidate) + "Get searched display part from CANDIDATE. +CANDIDATE is a string, a symbol, or \(DISPLAY . REAL\) cons cell." + (cond ((car-safe candidate)) + ((symbolp candidate) + (symbol-name candidate)) + ((numberp candidate) + (number-to-string candidate)) + (t candidate))) + +(defun helm-process-pattern-transformer (pattern source) + "Execute pattern-transformer attribute PATTERN function in SOURCE." + (helm-aif (assoc-default 'pattern-transformer source) + (helm-composed-funcall-with-source source it pattern) + pattern)) + +(defun helm-default-match-function (candidate) + "Check if `helm-pattern' match CANDIDATE. +Default function to match candidates according to `helm-pattern'." + (string-match helm-pattern candidate)) + + +;;; Fuzzy matching +;; +;; +(defsubst helm--mapconcat-pattern (pattern) + "Transform string PATTERN in regexp for further fuzzy matching. +e.g helm.el$ + => \"[^h]*h[^e]*e[^l]*l[^m]*m[^.]*[.][^e]*e[^l]*l$\" + ^helm.el$ + => \"helm[.]el$\"." + (let ((ls (split-string-and-unquote pattern ""))) + (if (string= "^" (car ls)) + ;; Exact match. + (mapconcat (lambda (c) + (if (and (string= c "$") + (string-match "$\\'" pattern)) + c (regexp-quote c))) + (cdr ls) "") + ;; Fuzzy match. + (mapconcat (lambda (c) + (if (and (string= c "$") + (string-match "$\\'" pattern)) + c (format "[^%s]*%s" c (regexp-quote c)))) + ls "")))) + +(defvar helm--fuzzy-regexp-cache (make-hash-table :test 'eq)) +(defun helm--fuzzy-match-maybe-set-pattern () + ;; Computing helm-pattern with helm--mapconcat-pattern + ;; is costly, so cache it once time for all and reuse it + ;; until pattern change. + (when helm--in-fuzzy + (let ((fun (if (string-match "\\`\\^" helm-pattern) + #'identity + #'helm--mapconcat-pattern))) + (clrhash helm--fuzzy-regexp-cache) + ;; FIXME: Splitted part are not handled here, + ;; I must compute them in `helm-search-match-part' + ;; when negation and in-buffer are used. + (if (string-match "\\`!" helm-pattern) + (puthash 'helm-pattern + (if (> (length helm-pattern) 1) + (list (funcall fun (substring helm-pattern 1 2)) + (funcall fun (substring helm-pattern 1))) + '("" "")) + helm--fuzzy-regexp-cache) + (puthash 'helm-pattern + (if (> (length helm-pattern) 0) + (list (funcall fun (substring helm-pattern 0 1)) + (funcall fun helm-pattern)) + '("" "")) + helm--fuzzy-regexp-cache))))) + +(defun helm-fuzzy-match (candidate) + "Check if `helm-pattern' fuzzy match CANDIDATE. +This function is used with sources build with `helm-source-sync'." + (unless (string-match " " helm-pattern) + ;; When pattern have one or more spaces, let + ;; match-plugin doing the job with no fuzzy matching.[1] + (let ((regexp (cadr (gethash 'helm-pattern helm--fuzzy-regexp-cache)))) + (if (string-match "\\`!" helm-pattern) + (not (string-match regexp candidate)) + (string-match regexp candidate))))) + +(defun helm-fuzzy-search (pattern) + "Same as `helm-fuzzy-match' but for sources build with `helm-source-in-buffer'." + (unless (string-match " " helm-pattern) + ;; Same as in `helm-fuzzy-match' ref[1]. + (let* ((regexps (gethash 'helm-pattern helm--fuzzy-regexp-cache)) + (partial-regexp (car regexps)) + (regexp (cadr regexps))) + (if (string-match "\\`!" pattern) + ;; Don't try to search here, just return + ;; the position of line and go ahead, + ;; letting `helm-search-match-part' checking if + ;; pattern match against this line. + (prog1 (list (point-at-bol) (point-at-eol)) + (forward-line 1)) + ;; We could use here directly `re-search-forward' + ;; on the regexp produced by `helm--mapconcat-pattern', + ;; but it is very slow because emacs have to do an incredible + ;; amount of loops to match e.g "[^f]*o[^o]..." in the whole buffer, + ;; more the regexp is long more the amount of loops grow. + ;; (Probably leading to a max-lisp-eval-depth error if both + ;; regexp and buffer are too big) + ;; So just search the first bit of pattern e.g "[^f]*f", and + ;; then search the corresponding line with the whole regexp, + ;; which increase dramatically the speed of the search. + (cl-loop while (re-search-forward partial-regexp nil t) + for bol = (point-at-bol) + for eol = (point-at-eol) + if (progn (goto-char bol) + (re-search-forward regexp eol t)) + do (goto-char eol) and return t + else do (goto-char eol) + finally return nil))))) + +(defsubst helm--collect-pairs-in-string (string) + (cl-loop for str on (split-string string "" t) by 'cdr + when (cdr str) + collect (list (car str) (cadr str)))) + +(defun helm-score-candidate-for-pattern (candidate pattern) + "Give a score to CANDIDATE according to PATTERN. +Score is calculated against number of contiguous matches found with PATTERN. +If PATTERN is fully matched in CANDIDATE a maximal score (100) is given. +A bonus of one point is given when PATTERN prefix match CANDIDATE. +Contiguous matches have a coefficient of 2." + (let* ((pat-lookup (helm--collect-pairs-in-string pattern)) + (str-lookup (helm--collect-pairs-in-string candidate)) + (bonus (if (equal (car pat-lookup) (car str-lookup)) 1 0)) + (bonus1 (and (string-match (concat "\\<" (regexp-quote pattern) "\\>") + candidate) + 100))) + (+ bonus (or bonus1 + ;; Give a coefficient of 2 for contiguous matches. + ;; That's mean that "wiaaaki" will not take precedence + ;; on "aaawiki" when matching on "wiki" even if "wiaaaki" + ;; starts by "wi". + (* (length (cl-nintersection + pat-lookup str-lookup :test 'equal)) + 2))))) + +(defun helm-fuzzy-matching-default-sort-fn (candidates _source &optional use-real) + "The transformer for sorting candidates in fuzzy matching. +It is sorting on the display part of by default. + +Sort CANDIDATES according to their score calculated by +`helm-score-candidate-for-pattern'. When two candidates have the +same score sort is made by length. Set USE-REAL to non-nil to +sort on the real part." + (if (string= helm-pattern "") + candidates + (let ((table-scr (make-hash-table :test 'equal))) + (sort candidates + (lambda (s1 s2) + ;; Score and measure the length on real or display part of candidate + ;; according to `use-real'. + (let* ((real-or-disp-fn (if use-real #'cdr #'car)) + (cand1 (if (consp s1) + (funcall real-or-disp-fn s1) + s1)) + (cand2 (if (consp s2) + (funcall real-or-disp-fn s2) + s2)) + (data1 (or (gethash cand1 table-scr) + (puthash cand1 (list (helm-score-candidate-for-pattern + cand1 helm-pattern) + (length cand1)) + table-scr))) + (data2 (or (gethash cand2 table-scr) + (puthash cand2 (list (helm-score-candidate-for-pattern + cand2 helm-pattern) + (length cand2)) + table-scr))) + (len1 (cadr data1)) + (len2 (cadr data2)) + (scr1 (car data1)) + (scr2 (car data2))) + (cond ((= scr1 scr2) + (< len1 len2)) + ((> scr1 scr2))))))))) + +(defun helm-fuzzy-default-highlight-match (candidate) + "The default function to highlight matches in fuzzy matching. +It is meant to use with `filter-one-by-one' slot." + (let* ((pair (and (consp candidate) candidate)) + (display (helm-stringify (if pair (car pair) candidate))) + (real (cdr pair))) + (with-temp-buffer + (insert display) + (goto-char (point-min)) + (if (search-forward helm-pattern nil t) + (add-text-properties + (match-beginning 0) (match-end 0) '(face helm-match)) + (cl-loop with pattern = (if (string-match-p " " helm-pattern) + (split-string helm-pattern) + (split-string helm-pattern "" t)) + for p in pattern + do + (when (search-forward p nil t) + (add-text-properties + (match-beginning 0) (match-end 0) '(face helm-match))))) + (setq display (buffer-string))) + (if real (cons display real) display))) + +(defun helm-fuzzy-highlight-matches (candidates _source) + "The filtered-candidate-transformer function to highlight matches in fuzzy. +See helm-fuzzy-default-highlight-match." + (cl-loop for c in candidates + collect (helm-fuzzy-default-highlight-match c))) + +(defun helm-match-functions (source) + (let ((matchfns (or (assoc-default 'match source) + (assoc-default 'match-strict source) + #'helm-default-match-function))) + (if (and (listp matchfns) (not (functionp matchfns))) + matchfns (list matchfns)))) + +(defun helm-search-functions (source) + (let ((searchfns (assoc-default 'search source))) + (if (and (listp searchfns) (not (functionp searchfns))) + searchfns (list searchfns)))) + +(defmacro helm--accumulate-candidates (candidate newmatches + hash item-count limit source) + "Add CAND into NEWMATCHES and use HASH to uniq NEWMATCHES. +Argument ITEM-COUNT count the matches. +if ITEM-COUNT reaches LIMIT, exit from inner loop." + `(unless (gethash ,candidate ,hash) + (unless (assq 'allow-dups ,source) + (puthash ,candidate t ,hash)) + (helm--maybe-process-filter-one-by-one-candidate ,candidate ,source) + (push ,candidate ,newmatches) + (cl-incf ,item-count) + (when (= ,item-count ,limit) (cl-return)))) + +(defun helm-take-first-elements (seq n) + "Return the N first element of SEQ if SEQ is longer than N. +It is used to narrow down list of candidates to `helm-candidate-number-limit'." + (if (> (length seq) n) (cl-subseq seq 0 n) seq)) + +(cl-defun helm-set-case-fold-search (&optional (pattern helm-pattern)) + "Used to set the value of `case-fold-search' in helm. +Return t or nil depending of value of `helm-case-fold-search' +and `helm-pattern'." + (let ((helm-case-fold-search + (helm-aif (assq 'case-fold-search (helm-get-current-source)) + (cdr it) + helm-case-fold-search)) + ;; Only parse basename for filenames + ;; to avoid setting case sensitivity + ;; when expanded directories contains upcase + ;; characters. + (bn-or-pattern (if (string-match "[~/]*" pattern) + ;; `helm-basename' is not available yet. + (file-name-nondirectory + (directory-file-name pattern)) + pattern))) + (helm-set-case-fold-search-1 bn-or-pattern))) + +(defun helm-set-case-fold-search-1 (pattern) + (cl-case helm-case-fold-search + (smart (let ((case-fold-search nil)) + (if (string-match "[[:upper:]]" pattern) nil t))) + (t helm-case-fold-search))) + +(defun helm-match-from-candidates (cands matchfns match-part-fn limit source) + (let (matches) + (condition-case-unless-debug err + (let ((item-count 0) + (case-fold-search (helm-set-case-fold-search))) + (clrhash helm-match-hash) + (cl-dolist (match matchfns) + (let (newmatches) + (cl-dolist (candidate cands) + (unless (gethash candidate helm-match-hash) + (let ((target (helm-candidate-get-display candidate))) + (when (funcall match + (if match-part-fn + (funcall match-part-fn target) target)) + (helm--accumulate-candidates + candidate newmatches + helm-match-hash item-count limit source))))) + ;; filter-one-by-one may return nil candidates, so delq them if some. + (setq matches (nconc matches (nreverse (delq nil newmatches))))))) + (error (unless (eq (car err) 'invalid-regexp) ; Always ignore regexps errors. + (helm-log-error "helm-match-from-candidates in source `%s': %s %s" + (assoc-default 'name source) (car err) (cdr err))) + (setq matches nil))) + matches)) + +(defun helm-compute-matches (source) + "Start computing candidates in SOURCE." + (save-current-buffer + (let ((matchfns (helm-match-functions source)) + (matchpartfn (assoc-default 'match-part source)) + (helm-source-name (assoc-default 'name source)) + (helm-current-source source) + (limit (helm-candidate-number-limit source)) + (helm-pattern (helm-process-pattern-transformer + helm-pattern source))) + (helm--fuzzy-match-maybe-set-pattern) + ;; If source have a `filtered-candidate-transformer' attr + ;; Filter candidates with this func, otherwise just compute + ;; candidates. + (helm-process-filtered-candidate-transformer + (if (or (equal helm-pattern "") + (equal matchfns '(identity))) + ;; Compute all candidates up to LIMIT. + (helm-take-first-elements + (helm-get-cached-candidates source) limit) + ;; Compute candidates according to pattern with their match fns. + (helm-match-from-candidates + (helm-get-cached-candidates source) matchfns matchpartfn limit source)) + source)))) + +(defun helm-render-source (source matches) + "Display MATCHES from SOURCE according to its settings." + (helm-log "Source name = %S" (assoc-default 'name source)) + (when matches + (helm-insert-header-from-source source) + (if (not (assq 'multiline source)) + (cl-loop for m in matches + for count from 1 + do (helm-insert-match m 'insert source count)) + (let ((start (point)) + (count 0) + separate) + (cl-dolist (match matches) + (cl-incf count) + (if separate + (helm-insert-candidate-separator) + (setq separate t)) + (helm-insert-match match 'insert source count)) + (put-text-property start (point) 'helm-multiline t))))) + +(defmacro helm--maybe-use-while-no-input (&rest body) + "Wrap BODY in `helm-while-no-input' unless initializing a remote connection." + `(progn + (if (and (file-remote-p helm-pattern) + (not (file-remote-p helm-pattern nil t))) + ;; Tramp will ask for passwd, don't use `helm-while-no-input'. + ,@body + (helm-log "Using here `helm-while-no-input'") + (helm-while-no-input ,@body)))) + +(defun helm--compute-sources (src-list) + (cl-loop with matches = (helm--maybe-use-while-no-input + (cl-loop for src in src-list + collect (helm-compute-matches src))) + when (eq matches t) do (setq matches nil) + for src in src-list + for mtc in matches + do (helm-render-source src mtc))) + +(cl-defun helm-process-delayed-sources (delayed-sources &optional preselect source) + "Process helm DELAYED-SOURCES. +Move selection to string or regexp PRESELECT if non--nil. +This function is called in `helm-process-delayed-sources-timer' +when emacs is idle for `helm-idle-delay'." + (with-helm-quittable + (helm-log "Delayed sources = %S" + (mapcar (lambda (s) + (assoc-default 'name s)) + delayed-sources)) + (with-current-buffer (helm-buffer-get) + (save-excursion + (goto-char (point-max)) + (helm--compute-sources delayed-sources) + (when (and (not (helm-empty-buffer-p)) + ;; No selection yet. + (= (overlay-start helm-selection-overlay) + (overlay-end helm-selection-overlay))) + (helm-update-move-first-line 'without-hook))) + (save-excursion + (goto-char (point-min)) + (helm-log-run-hook 'helm-update-hook)) + (setq helm-force-updating-p nil) + (unless (assoc 'candidates-process source) + (helm-display-mode-line (helm-get-current-source)) + (helm-log-run-hook 'helm-after-update-hook)) + (when preselect (helm-preselect preselect source))))) + + +;;; Core: helm-update +;; +(defun helm-update (&optional preselect source) + "Update candidates list in `helm-buffer' according to `helm-pattern'. +Argument PRESELECT is a string or regexp used to move selection to a particular +place once updating is done. It should be used on single source because search +is done on whole `helm-buffer' and not on current source." + (helm-log "Start updating") + (helm-kill-async-processes) + ;; When persistent action have been called + ;; we have two windows even with `helm-full-frame'. + ;; So go back to one window when updating if `helm-full-frame' + ;; is non--nil. + (with-helm-window + (when helm-onewindow-p (delete-other-windows))) + (with-current-buffer (helm-buffer-get) + (set (make-local-variable 'helm-input-local) helm-pattern) + (let (normal-sources + delayed-sources) + (unwind-protect + (progn + ;; Iterate over all the sources + (cl-loop for source in (cl-remove-if-not + 'helm-update-source-p (helm-get-sources)) + if (helm-delayed-source-p source) + ;; Delayed sources just get collected for later + ;; processing + collect source into ds + else + ;; Collect the normal sources + collect source into ns + ;; Export the variables from cl-loop + finally (setq delayed-sources ds + normal-sources ns)) + (erase-buffer) + ;; Render all the sources into the helm buffer after + ;; calculating all candidates. + ;; Candidates must be computed AFTER erasing buffer + ;; even if it cause flickering; Doing so avoid + ;; unexpected results when executing actions. + (helm--compute-sources normal-sources)) + (helm-log "Delayed sources = %S" + (mapcar (lambda (s) (assoc-default 'name s)) + delayed-sources)) + (cond ((and preselect delayed-sources normal-sources) + ;; Preselection run here when there is + ;; normal AND delayed sources. + (helm-log "Update preselect candidate %s" preselect) + (helm-preselect preselect source)) + (delayed-sources ; Preselection and hooks will run later. + (helm-update-move-first-line 'without-hook)) + (t ; No delayed sources, run the hooks now. + (helm-update-move-first-line) + (unless (assoc 'candidates-process source) + (helm-display-mode-line (helm-get-current-source)) + (helm-log-run-hook 'helm-after-update-hook)) + (when preselect + (helm-log "Update preselect candidate %s" preselect) + (helm-preselect preselect source)) + (setq helm-force-updating-p nil))) + (when delayed-sources + ;; Allow giving a value to `delayed' attr from inside source. + ;; Retain the biggest value (the slower) found in DELAYED-SOURCES. + (let ((helm-idle-delay (cl-loop with delay = helm-idle-delay + for s in delayed-sources + for d = (assoc-default 'delayed s) + when d do (setq delay (max delay d)) + finally return delay))) + (run-with-idle-timer + ;; Be sure helm-idle-delay is > + ;; to helm-input-idle-delay + ;; otherwise use value of helm-input-idle-delay + ;; or 0.01 if == to 0. + (max helm-idle-delay helm-input-idle-delay 0.001) nil + 'helm-process-delayed-sources delayed-sources preselect source))) + (helm-log "end update"))))) + +;; Update keymap after updating. +;; Putting this in a hook allow users to disable it. +(add-hook 'helm-after-update-hook 'helm--maybe-update-keymap) + +(defun helm-update-source-p (source) + "Whether SOURCE need updating or not." + (let ((len (string-width + (if (or (assoc 'matchplugin source) + (null (assoc 'no-matchplugin source))) + ;; Don't count spaces entered when using + ;; match-plugin. + (replace-regexp-in-string " " "" helm-pattern) + helm-pattern)))) + (and (or (not helm-source-filter) + (member (assoc-default 'name source) helm-source-filter)) + (>= len + (helm-aif (assoc 'requires-pattern source) (or (cdr it) 1) 0)) + ;; These incomplete regexps hang helm forever + ;; so defer update. Maybe replace spaces quoted when using + ;; match-plugin-mode. + (not (member (replace-regexp-in-string "\\s\\ " " " helm-pattern) + helm-update-blacklist-regexps))))) + +(defun helm-delayed-source-p (source) + "Wheter SOURCE is a delayed source or not." + (or (assoc 'delayed source) + (and helm-quick-update + (> (length helm-sources) 1) + (< (window-height (get-buffer-window (current-buffer))) + (line-number-at-pos (point-max)))))) + +(defun helm-update-move-first-line (&optional without-hook) + "Goto first line of `helm-buffer'." + (goto-char (point-min)) + (unless without-hook + (save-excursion (helm-log-run-hook 'helm-update-hook))) + (helm-next-line)) + +(defun helm-force-update (&optional preselect) + "Force recalculation and update of candidates. +The difference with `helm-update' is this function is reevaling +the `init' and `update' attributes functions when present +before updating candidates according to pattern i.e calling `helm-update'. +Selection is preserved to current candidate or moved to PRESELECT +if specified." + (interactive) + (let ((source (helm-get-current-source)) + (selection (helm-get-selection nil t)) + ;; `helm-goto-source' need to have all sources displayed + ;; So disable `helm-quick-update'. + helm-quick-update) + (setq helm-force-updating-p t) + (when source + (mapc 'helm-force-update--reinit + (helm-get-sources))) + (helm-update (or preselect selection) source) + (with-helm-window (recenter)))) + +(defun helm-force-update--reinit (source) + "Reinit SOURCE by calling his update and/or init functions." + (helm-aif (helm-funcall-with-source + source 'helm-candidate-buffer) + (kill-buffer it)) + (cl-dolist (attr '(update init)) + (helm-aif (assoc-default attr source) + (helm-funcall-with-source source it))) + (helm-remove-candidate-cache source)) + +(defun helm-remove-candidate-cache (source) + "Remove SOURCE from `helm-candidate-cache'." + (remhash (assoc-default 'name source) helm-candidate-cache)) + +(defun helm-insert-match (match insert-function source &optional num) + "Insert MATCH into `helm-buffer' with INSERT-FUNCTION for SOURCE. +If MATCH is a list then insert the string intended to appear on the display +and store the real value in a text property." + (let ((start (point-at-bol (point))) + (dispvalue (helm-candidate-get-display match)) + (realvalue (cdr-safe match))) + (when (and (stringp dispvalue) + (not (zerop (length dispvalue)))) + (funcall insert-function dispvalue) + ;; Some sources with candidates-in-buffer have already added + ;; 'helm-realvalue property when creating candidate buffer. + (unless (get-text-property start 'helm-realvalue) + (and realvalue + (put-text-property start (point-at-eol) + 'helm-realvalue realvalue))) + (when num + (put-text-property start (point-at-eol) 'helm-cand-num num)) + (when helm-source-in-each-line-flag + (put-text-property start (point-at-eol) 'helm-source source)) + (funcall insert-function "\n")))) + +(defun helm-insert-header-from-source (source) + "Insert SOURCE name in `helm-buffer' header. +Maybe insert by overlay additional info after source name if SOURCE have +header-name attribute." + (let ((name (assoc-default 'name source))) + (helm-insert-header + name + (helm-aif (assoc-default 'header-name source) + (helm-funcall-with-source source it name))))) + +(defun helm-insert-header (name &optional display-string) + "Insert header of source NAME into the helm buffer. +If DISPLAY-STRING is non--nil and a string, display this additional info +after the source name by overlay." + (unless (bobp) + (let ((start (point))) + (insert "\n") + (put-text-property start (point) 'helm-header-separator t))) + (let ((start (point))) + (insert name) + (put-text-property (point-at-bol) + (point-at-eol) 'helm-header t) + (when display-string + (overlay-put (make-overlay (point-at-bol) (point-at-eol)) + 'display display-string)) + (insert "\n") + (put-text-property start (point) 'face 'helm-source-header))) + +(defun helm-insert-candidate-separator () + "Insert separator of candidates into the helm buffer." + (insert (propertize helm-candidate-separator 'face 'helm-separator)) + (put-text-property (point-at-bol) + (point-at-eol) 'helm-candidate-separator t) + (insert "\n")) + + +;;; Core: async process +;; +(defun helm-output-filter (process output-string) + "The `process-filter' function for helm async sources." + (with-helm-quittable + (helm-output-filter-1 (assoc process helm-async-processes) output-string))) + +(defun helm-output-filter-1 (process-assoc output-string) + (helm-log "output-string = %S" output-string) + (with-current-buffer helm-buffer + (let ((source (cdr process-assoc))) + (save-excursion + (helm-aif (assoc-default 'insertion-marker source) + (goto-char it) + (goto-char (point-max)) + (helm-insert-header-from-source source) + (setcdr process-assoc + (append source `((insertion-marker . ,(point-marker)))))) + (helm-output-filter--process-source + (car process-assoc) output-string source + (helm-candidate-number-limit source)))) + (helm-output-filter--post-process))) + +(defun helm-output-filter--process-source (process output-string source limit) + (cl-dolist (candidate (helm-transform-candidates + (helm-output-filter--collect-candidates + (split-string output-string "\n") + (assoc 'incomplete-line source) + source) + source t)) + (when candidate ; filter-one-by-one may return nil candidates. + (if (assq 'multiline source) + (let ((start (point))) + (helm-insert-candidate-separator) + (helm-insert-match candidate 'insert-before-markers source + (1+ (cdr (assoc 'item-count source)))) + (put-text-property start (point) 'helm-multiline t)) + (helm-insert-match candidate 'insert-before-markers source + (1+ (cdr (assoc 'item-count source))))) + (cl-incf (cdr (assoc 'item-count source))) + (when (>= (assoc-default 'item-count source) limit) + (helm-kill-async-process process) + (cl-return))))) + +(defun helm-output-filter--collect-candidates (lines incomplete-line-info source) + "Collect LINES maybe completing the truncated first and last lines." + ;; The output of process may come in chunks of any size, + ;; so the last line of LINES come truncated, this truncated line is + ;; stored in INCOMPLETE-LINE-INFO and will be concated with the first + ;; incomplete line of next chunk arriving. + ;; INCOMPLETE-LINE-INFO is an attribute of source which is created + ;; with an empty string when the source is computed => (incomplete-line . "") + (helm-log "incomplete-line-info = %S" (cdr incomplete-line-info)) + (butlast + (cl-loop for line in lines + ;; On start `incomplete-line-info' value is empty string. + for newline = (helm-aif (cdr incomplete-line-info) + (prog1 + (concat it line) + (setcdr incomplete-line-info nil)) + line) + do (helm--maybe-process-filter-one-by-one-candidate newline source) + collect newline + ;; Store last incomplete line (last chunk truncated) + ;; until new output arrives. + finally do (setcdr incomplete-line-info line)))) + +(defun helm-output-filter--post-process () + (let ((src (helm-get-current-source))) + (helm-log-run-hook 'helm-update-hook) + (helm-aif (get-buffer-window helm-buffer 'visible) + (with-selected-window it + (helm-skip-noncandidate-line 'next) + (helm-mark-current-line) + (helm-display-mode-line src) + (helm-log-run-hook 'helm-after-update-hook))))) + +(defun helm-process-deferred-sentinel-hook (process event file) + "Defer remote processes in sentinels. +Meant to be called at beginning of a sentinel process function." + (when (and (string= event "finished\n") + (or (file-remote-p file) + ;; `helm-suspend-update-flag' + ;; is non--nil here only during a + ;; running process, this will never be called + ;; when user set it explicitely with `C-!'. + helm-suspend-update-flag)) + (setq helm-suspend-update-flag t) + ;; Kill the process but don't delete entry in + ;; `helm-async-processes'. + (helm-kill-async-process process) + ;; When tramp tries to open the same connection twice in a + ;; short time frame (less than 5s) it throw 'suppress which + ;; call the real-handler on the main "Emacs", so we wait + ;; 5s before updating to avoid this [1], but allowing user to + ;; enter input during this delay. + ;; [1] On last Emacs versions, this is fixed and tramp return + ;; nil in this situation. + ;; Note: It is difficult to have a value < to 5 for + ;; `tramp-connection-min-time-diff', because the process die + ;; when calling too quickly same process. + (run-at-time (or (and (boundp 'tramp-connection-min-time-diff) + tramp-connection-min-time-diff) + 5) + nil #'(lambda () + (when helm-alive-p ; Don't run timer fn after quit. + (setq helm-suspend-update-flag nil) + (helm-check-minibuffer-input)))))) + +(defun helm-kill-async-processes () + "Kill all asynchronous processes registered in `helm-async-processes'." + (while helm-async-processes + (helm-kill-async-process (caar helm-async-processes)) + (setq helm-async-processes (cdr helm-async-processes)))) + +(defun helm-kill-async-process (process) + "Stop output from `helm-output-filter' and kill associated PROCESS." + (set-process-filter process nil) + (delete-process process)) + + +;;; Core: action +;; +(defun helm-execute-selection-action () + "Execute current action and kill the action buffer if present." + (helm-log-run-hook 'helm-before-action-hook) + ;; Position can be different when `helm-current-buffer' + ;; is splitted, so jump to this position before executing action. + (helm-current-position 'restore) + (unwind-protect + (helm-execute-selection-action-1) + (helm-aif (get-buffer helm-action-buffer) + (kill-buffer it)) + (helm-log-run-hook 'helm-after-action-hook))) + +(defun helm-execute-selection-action-1 (&optional + selection action + preserve-saved-action) + "Execute ACTION on current SELECTION. +If PRESERVE-SAVED-ACTION is non--nil save action." + (helm-log "executing action") + (setq action (helm-get-default-action + (or action + helm-saved-action + (if (get-buffer helm-action-buffer) + (helm-get-selection helm-action-buffer) + (helm-get-actions-from-current-source))))) + (let ((source (or helm-saved-current-source + (helm-get-current-source))) + non-essential) + (setq selection (or selection + (helm-get-selection) + (and (assoc 'accept-empty source) ""))) + (unless preserve-saved-action (setq helm-saved-action nil)) + (when (and selection action) + (helm-funcall-with-source + source action + (helm-coerce-selection selection source))))) + +(defun helm-coerce-selection (selection source) + "Apply coerce attribute function to SELECTION in SOURCE. +Coerce source with coerce function." + (helm-aif (assoc-default 'coerce source) + (helm-funcall-with-source source it selection) + selection)) + +(defun helm-get-default-action (action) + "Get the first ACTION value of action list in source." + (if (and (listp action) (not (functionp action))) + (cdar action) + action)) + +(defun helm-select-action () + "Select an action for the currently selected candidate. +If action buffer is selected, back to the helm buffer." + (interactive) + (helm-log-run-hook 'helm-select-action-hook) + (setq helm-saved-selection (helm-get-selection)) + (with-selected-frame (with-helm-window (selected-frame)) + (prog1 + (cond ((get-buffer-window helm-action-buffer 'visible) + (set-window-buffer (get-buffer-window helm-action-buffer) + helm-buffer) + (kill-buffer helm-action-buffer) + (helm-display-mode-line (helm-get-current-source)) + (helm-set-pattern helm-input 'noupdate)) + (helm-saved-selection + (setq helm-saved-current-source (helm-get-current-source)) + (let ((actions (helm-get-actions-from-current-source))) + (if (functionp actions) + (message "Sole action: %s" actions) + (helm-show-action-buffer actions) + ;; Be sure the minibuffer is entirely deleted (#907). + (helm--delete-minibuffer-contents-from "") + ;; Make `helm-pattern' differs from the previous value. + (setq helm-pattern 'dummy) + (helm-check-minibuffer-input)))) + (t (message "No Actions available"))) + (run-hooks 'helm-window-configuration-hook)))) + +(defun helm-show-action-buffer (actions) + (with-current-buffer (get-buffer-create helm-action-buffer) + (erase-buffer) + (buffer-disable-undo) + (set-window-buffer (get-buffer-window helm-buffer) helm-action-buffer) + (set (make-local-variable 'helm-sources) + `(((name . "Actions") + (volatile) + (nomark) + (candidates . ,actions) + (mode-line . ("Action(s)" "TAB:BackToCands RET/f1/f2/fn:NthAct")) + (candidate-transformer + . (lambda (candidates) + (cl-loop for (i . j) in candidates + for count from 1 + collect + (cons (concat (cond ((> count 12) + " ") + ((< count 10) + (format "[f%s] " count)) + (t (format "[f%s] " count))) + (propertize i 'face 'helm-action)) + j)))) + (candidate-number-limit)))) + (set (make-local-variable 'helm-source-filter) nil) + (set (make-local-variable 'helm-selection-overlay) nil) + (helm-initialize-overlays helm-action-buffer))) + + +;; Core: selection + +(defun helm-display-source-at-screen-top-maybe (unit) + "Display source at top of screen when UNIT value is 'source. +With any other value of UNIT return nil." + (when (and helm-display-source-at-screen-top (eq unit 'source)) + (set-window-start (selected-window) + (save-excursion (forward-line -1) (point))))) + +(defun helm-skip-noncandidate-line (direction) + "Skip source header or candidates separator when going in DIRECTION. +Possible value of DIRECTION are 'next or 'previous. +Same as `helm-skip-header-and-separator-line' but ensure +point is moved to the right place when at bop or eob." + (helm-skip-header-and-separator-line direction) + (and (bobp) (forward-line 1)) ; Skip first header. + (and (eobp) (forward-line -1))) ; Avoid last empty line. + +(defun helm-skip-header-and-separator-line (direction) + "Skip source header or candidate separator when going to next/previous line. +Possible value of DIRECTION are 'next or 'previous." + (let ((fn (cl-ecase direction + (next 'eobp) + (previous 'bobp)))) + (while (and (not (funcall fn)) + (or (helm-pos-header-line-p) + (helm-pos-candidate-separator-p))) + (forward-line (if (and (eq direction 'previous) + (not (eq (point-at-bol) (point-min)))) + -1 1))))) + +(defun helm-display-mode-line (source &optional force) + "Setup mode-line and header-line for `helm-buffer'." + (set (make-local-variable 'helm-mode-line-string) + (helm-interpret-value (or (and (listp source) ; Check if source is empty. + (assoc-default 'mode-line source)) + (default-value 'helm-mode-line-string)) + source)) + (let ((follow (and (eq (cdr (assq 'follow source)) 1) "(HF) "))) + ;; Setup mode-line. + (if helm-mode-line-string + (setq mode-line-format + `(" " mode-line-buffer-identification " " + (:eval (format "L%d" (helm-candidate-number-at-point))) + " " ,follow + (:eval (when ,helm--mode-line-display-prefarg + (let ((arg (prefix-numeric-value + (or prefix-arg current-prefix-arg)))) + (unless (= arg 1) + (propertize (format "[prefarg:%s] " arg) + 'face 'helm-prefarg))))) + (:eval (helm-show-candidate-number + (car-safe helm-mode-line-string))) + " " helm--mode-line-string-real " " mode-line-end-spaces) + helm--mode-line-string-real + (substitute-command-keys (if (listp helm-mode-line-string) + (cadr helm-mode-line-string) + helm-mode-line-string))) + (setq mode-line-format (default-value 'mode-line-format))) + ;; Setup header-line. + (when helm-display-header-line + (let* ((hlstr (helm-interpret-value + (and (listp source) + (assoc-default 'header-line source)) + source)) + (hlend (make-string (max 0 (- (window-width) (length hlstr))) ? ))) + (setq header-line-format + (propertize (concat " " hlstr hlend) 'face 'helm-header))))) + (when force (force-mode-line-update))) + +(defun helm-show-candidate-number (&optional name) + "Used to display candidate number in mode-line. +You can specify NAME of candidates e.g \"Buffers\" otherwise +it is \"Candidate\(s\)\" by default." + (when helm-alive-p + (unless (helm-empty-source-p) + (propertize + (format "[%s %s]" + (helm-get-candidate-number 'in-current-source) + (or name "Candidate(s)")) + 'face 'helm-candidate-number)))) + +(cl-defun helm-move-selection-common (&key where direction) + "Move the selection marker to a new position. +Position is determined by WHERE and DIRECTION. +Key arg WHERE can be one of: + - line + - page + - edge + - source +Key arg DIRECTION can be one of: + - previous + - next + - A source or a source name when used with :WHERE 'source." + (let ((move-func (cl-case where + (line (cl-ecase direction + (previous 'helm-move--previous-line-fn) + (next 'helm-move--next-line-fn))) + (page (cl-ecase direction + (previous 'helm-move--previous-page-fn) + (next 'helm-move--next-page-fn))) + (edge (cl-ecase direction + (previous 'helm-move--beginning-of-buffer-fn) + (next 'helm-move--end-of-buffer-fn))) + (source (cl-case direction + (previous 'helm-move--previous-source-fn) + (next 'helm-move--next-source-fn) + (t (lambda () ; A source is passed as DIRECTION arg. + (helm-move--goto-source-fn direction)))))))) + (unless (or (helm-empty-buffer-p (helm-buffer-get)) + (not (helm-window))) + (with-helm-window + (helm-log-run-hook 'helm-move-selection-before-hook) + (funcall move-func) + (and (memq direction '(next previous)) + (helm-skip-noncandidate-line direction)) + (when (helm-pos-multiline-p) + (helm-move--beginning-of-multiline-candidate)) + (helm-display-source-at-screen-top-maybe where) + (when (helm-get-previous-header-pos) + (helm-mark-current-line)) + (helm-display-mode-line (helm-get-current-source)) + (helm-log-run-hook 'helm-move-selection-after-hook))))) + +(defun helm-move--beginning-of-multiline-candidate () + (let ((header-pos (helm-get-previous-header-pos)) + (separator-pos (helm-get-previous-candidate-separator-pos))) + (when header-pos + (goto-char (if (or (null separator-pos) + (< separator-pos header-pos)) + header-pos + separator-pos)) + (forward-line 1)))) + +(defun helm-move--previous-multi-line-fn () + (forward-line -1) + (unless (helm-pos-header-line-p) + (helm-skip-header-and-separator-line 'previous) + (helm-move--beginning-of-multiline-candidate))) + +(defun helm-move--previous-line-fn () + (if (not (helm-pos-multiline-p)) + (forward-line -1) + (helm-move--previous-multi-line-fn)) + (when (and helm-move-to-line-cycle-in-source + (helm-pos-header-line-p)) + (forward-line 1) + (helm-move--end-of-source) + ;; We are at end of helm-buffer + ;; check if last candidate is a multiline candidate + ;; and jump to it + (when (and (eobp) + (save-excursion (forward-line -1) (helm-pos-multiline-p))) + (helm-move--previous-multi-line-fn)))) + +(defun helm-move--next-multi-line-fn () + (let ((header-pos (helm-get-next-header-pos)) + (separator-pos (helm-get-next-candidate-separator-pos))) + (cond ((and separator-pos + (or (null header-pos) (< separator-pos header-pos))) + (goto-char separator-pos)) + (header-pos + (goto-char header-pos))))) + +(defun helm-move--next-line-fn () + (if (not (helm-pos-multiline-p)) + (forward-line 1) + (helm-move--next-multi-line-fn)) + (when (and helm-move-to-line-cycle-in-source + (or (save-excursion (and (helm-pos-multiline-p) + (goto-char (overlay-end + helm-selection-overlay)) + (helm-end-of-source-p t))) + (helm-end-of-source-p t))) + (helm-move--beginning-of-source))) + +(defun helm-move--previous-page-fn () + (condition-case nil + (scroll-down) + (beginning-of-buffer (goto-char (point-min))))) + +(defun helm-move--next-page-fn () + (condition-case nil + (scroll-up) + (end-of-buffer (goto-char (point-max))))) + +(defun helm-move--beginning-of-buffer-fn () + (goto-char (point-min))) + +(defun helm-move--end-of-buffer-fn () + (goto-char (point-max))) + +(defun helm-move--end-of-source () + (goto-char (or (helm-get-next-header-pos) (point-max))) + (when (helm-pos-header-line-p) (forward-line -2))) + +(defun helm-move--beginning-of-source () + (goto-char (helm-get-previous-header-pos)) + (forward-line 1)) + +(defun helm-move--previous-source-fn () + (forward-line -1) + (if (bobp) + (goto-char (point-max)) + (helm-skip-header-and-separator-line 'previous)) + (goto-char (helm-get-previous-header-pos)) + (forward-line 1)) + +(defun helm-move--next-source-fn () + (goto-char (or (helm-get-next-header-pos) (point-min)))) + +(defun helm-move--goto-source-fn (source-or-name) + (goto-char (point-min)) + (let ((name (if (stringp source-or-name) source-or-name + (assoc-default 'name source-or-name)))) + (condition-case err + (while (not (string= name (helm-current-line-contents))) + (goto-char (helm-get-next-header-pos))) + (error (helm-log "%S" err))))) + +(defun helm-candidate-number-at-point () + (with-helm-buffer + (or (get-text-property (point) 'helm-cand-num) 1))) + +(defun helm--next-or-previous-line (direction &optional arg) + ;; Be sure to not use this in non--interactives calls. + (let ((helm-move-to-line-cycle-in-source + (and helm-move-to-line-cycle-in-source arg))) + (if (and arg (> arg 1)) + (cl-loop with pos = (helm-candidate-number-at-point) + with cand-num = (helm-get-candidate-number t) + with iter = (min arg (- cand-num pos)) + for count from 1 + while (<= count iter) + do + (helm-move-selection-common :where 'line :direction direction)) + (helm-move-selection-common :where 'line :direction direction)))) + +(defun helm-previous-line (&optional arg) + "Move selection to the ARG previous line(s). +Same behavior than `helm-next-line' when called with a numeric prefix arg." + (interactive "p") + (helm--next-or-previous-line 'previous arg)) + +(defun helm-next-line (&optional arg) + "Move selection to the next ARG line(s). +When a numeric prefix arg is given and this numeric arg +is > to the number of candidates, move to last candidate of +current source (i.e don't move to next source if some)." + (interactive "p") + (helm--next-or-previous-line 'next arg)) + +(defun helm-previous-page () + "Move selection back with a pageful." + (interactive) + (helm-move-selection-common :where 'page :direction 'previous)) + +(defun helm-next-page () + "Move selection forward with a pageful." + (interactive) + (helm-move-selection-common :where 'page :direction 'next)) + +(defun helm-beginning-of-buffer () + "Move selection at the top." + (interactive) + (helm-move-selection-common :where 'edge :direction 'previous)) + +(defun helm-end-of-buffer () + "Move selection at the bottom." + (interactive) + (helm-move-selection-common :where 'edge :direction 'next)) + +(defun helm-previous-source () + "Move selection to the previous source." + (interactive) + (helm-move-selection-common :where 'source :direction 'previous)) + +(defun helm-next-source () + "Move selection to the next source." + (interactive) + (helm-move-selection-common :where 'source :direction 'next)) + +(defun helm-goto-source (source-or-name) + "Move the selection to the source SOURCE-OR-NAME." + (helm-move-selection-common :where 'source :direction source-or-name)) + +(defun helm--follow-action (arg) + (let ((helm--temp-follow-flag t)) + (when (or (eq last-command 'helm-follow-action-forward) + (eq last-command 'helm-follow-action-backward) + (eq last-command 'helm-execute-persistent-action)) + (if (> arg 0) + (helm-next-line) + (helm-previous-line))) + (helm-execute-persistent-action))) + +(defun helm-follow-action-forward () + "Go to next line and execute persistent action." + (interactive) + (helm--follow-action 1)) + +(defun helm-follow-action-backward () + "Go to previous line and execute persistent action." + (interactive) + (helm--follow-action -1)) + +(defun helm-mark-current-line (&optional resumep) + "Move `helm-selection-overlay' to current line. +Note that this is not related with visibles marks, which are used +to mark candidates." + (with-helm-window + (when resumep + (goto-char helm-selection-point)) + (move-overlay + helm-selection-overlay (point-at-bol) + (if (helm-pos-multiline-p) + (let ((header-pos (helm-get-next-header-pos)) + (separator-pos (helm-get-next-candidate-separator-pos))) + (or (and (null header-pos) separator-pos) + (and header-pos separator-pos + (< separator-pos header-pos) + separator-pos) + header-pos + (point-max))) + (1+ (point-at-eol)))) + (setq helm-selection-point (overlay-start helm-selection-overlay))) + (helm-follow-execute-persistent-action-maybe)) + +(defun helm-confirm-and-exit-minibuffer () + "Maybe ask for confirmation when exiting helm. +It is similar to `minibuffer-complete-and-exit' adapted to helm. +If `minibuffer-completion-confirm' value is 'confirm, +send in minibuffer confirm message and exit on next hit. +If `minibuffer-completion-confirm' value is t, +don't exit and send message 'no match'." + (interactive) + (if (and (helm--updating-p) + (null helm--reading-passwd-or-string)) + (progn (message "[Display not ready]") + (sit-for 0.5) (message nil)) + (let* ((empty-buffer-p (with-current-buffer helm-buffer + (eq (point-min) (point-max)))) + (sel (helm-get-selection)) + (unknown (and (not empty-buffer-p) + (string= (get-text-property + 0 'display + (helm-get-selection nil 'withprop)) + "[?]")))) + (cond ((and (or empty-buffer-p unknown) + (eq minibuffer-completion-confirm 'confirm)) + (setq helm-minibuffer-confirm-state + 'confirm) + (setq minibuffer-completion-confirm nil) + (minibuffer-message " [confirm]")) + ((and (or empty-buffer-p + (unless (if minibuffer-completing-file-name + (and minibuffer-completion-predicate + (funcall minibuffer-completion-predicate sel)) + (and (stringp sel) + ;; SEL may be a cons cell when helm-comp-read + ;; is called directly with a collection composed + ;; of (display . real) and real is a cons cell. + (try-completion sel minibuffer-completion-table + minibuffer-completion-predicate))) + unknown)) + (eq minibuffer-completion-confirm t)) + (minibuffer-message " [No match]")) + (t + (setq helm-minibuffer-confirm-state nil) + (helm-exit-minibuffer)))))) +(add-hook 'helm-after-update-hook 'helm-confirm-and-exit-hook) + +(defun helm-confirm-and-exit-hook () + "Restore `minibuffer-completion-confirm' when helm update." + (unless (or (eq minibuffer-completion-confirm t) + (not helm-minibuffer-confirm-state)) + (setq minibuffer-completion-confirm + helm-minibuffer-confirm-state))) + +(defun helm-read-string (prompt &optional initial-input history + default-value inherit-input-method) + "Same as `read-string' but for reading string from a helm session." + (let ((helm--reading-passwd-or-string t)) + (read-string + prompt initial-input history default-value inherit-input-method))) + +(defun helm--updating-p () + ;; helm timer is between two cycles. + ;; IOW `helm-check-minibuffer-input' haven't yet compared input + ;; and `helm-pattern'. + (or (not (equal (minibuffer-contents) helm-pattern)) + ;; `helm-check-minibuffer-input' have launched `helm-update'. + helm--in-update)) + +(defun helm-maybe-exit-minibuffer () + (interactive) + (if (and (helm--updating-p) + (null helm--reading-passwd-or-string)) + (progn (message "[Display not ready]") + (sit-for 0.5) (message nil)) + (helm-exit-minibuffer))) + +(defun helm-exit-minibuffer () + "Select the current candidate by exiting the minibuffer." + (unless helm-current-prefix-arg + (setq helm-current-prefix-arg current-prefix-arg)) + (setq helm-exit-status 0) + (helm-log-run-hook 'helm-exit-minibuffer-hook) + (exit-minibuffer)) + +(defun helm-keyboard-quit () + "Quit minibuffer in helm. +If action buffer is displayed, kill it." + (interactive) + (when (get-buffer-window helm-action-buffer 'visible) + (kill-buffer helm-action-buffer)) + (setq helm-exit-status 1) + (abort-recursive-edit)) + +(defun helm-get-next-header-pos () + "Return the position of the next header from point." + (next-single-property-change (point) 'helm-header)) + +(defun helm-get-previous-header-pos () + "Return the position of the previous header from point." + (previous-single-property-change (point) 'helm-header)) + +(defun helm-pos-multiline-p () + "Return non-nil if the current position is in the multiline source region." + (get-text-property (point) 'helm-multiline)) + +(defun helm-get-next-candidate-separator-pos () + "Return the position of the next candidate separator from point." + (let ((hp (helm-get-next-header-pos))) + (helm-aif (next-single-property-change (point) 'helm-candidate-separator) + (or + ;; Be sure we don't catch + ;; the separator of next source. + (and hp (< it hp) it) + ;; The separator found is in next source + ;; we are at last cand, so use the header pos. + (and hp (< hp it) hp) + ;; A single source, just try next separator. + it)))) + +(defun helm-get-previous-candidate-separator-pos () + "Return the position of the previous candidate separator from point." + (previous-single-property-change (point) 'helm-candidate-separator)) + +(defun helm-pos-header-line-p () + "Return t if the current line is a header line." + (or (get-text-property (point-at-bol) 'helm-header) + (get-text-property (point-at-bol) 'helm-header-separator))) + +(defun helm-pos-candidate-separator-p () + "Return t if the current line is a candidate separator." + (get-text-property (point-at-bol) 'helm-candidate-separator)) + + +;;; Debugging +;; +;; +(defun helm-debug-output () + "Show all helm-related variables at this time." + (interactive) + (helm-help-internal " *Helm Debug*" 'helm-debug-output-function)) + +(defun helm-debug-output-function (&optional vars) + (message "Calculating all helm-related values...") + (insert "If you debug some variables or forms, set `helm-debug-variables' +to a list of forms.\n\n") + (cl-dolist (v (or vars + helm-debug-variables + (apropos-internal "^helm-" 'boundp))) + (insert "** " + (pp-to-string v) "\n" + (pp-to-string (with-current-buffer helm-buffer (eval v))) "\n")) + (message "Calculating all helm-related values...Done")) + + +;; Core: misc +(defun helm-kill-buffer-hook () + "Remove tick entry from `helm-tick-hash' and remove buffer from +`helm-buffers' when killing a buffer." + (cl-loop for key being the hash-keys in helm-tick-hash + if (string-match (format "^%s/" (regexp-quote (buffer-name))) key) + do (remhash key helm-tick-hash)) + (setq helm-buffers (remove (buffer-name) helm-buffers))) +(add-hook 'kill-buffer-hook 'helm-kill-buffer-hook) + +(defun helm-preselect (candidate-or-regexp &optional source) + "Move `helm-selection-overlay' to CANDIDATE-OR-REGEXP on startup. +Arg CANDIDATE-OR-REGEXP can be a string or a cons cell of two strings. +When it is a cons cell helm will try to jump first to first element of cons cell +and then to second, allowing a finer preselection when possible duplicates are +before the candidate we want to preselect." + (with-helm-window + (when candidate-or-regexp + (if (and helm-force-updating-p source) + (helm-goto-source source) + (goto-char (point-min)) + (forward-line 1)) + (let ((start (point))) + (or + (if (consp candidate-or-regexp) + (and (re-search-forward (car candidate-or-regexp) nil t) + (re-search-forward (cdr candidate-or-regexp) nil t)) + (re-search-forward candidate-or-regexp nil t)) + (goto-char start)))) + (forward-line 0) ; Avoid scrolling right on long lines. + (when (helm-pos-multiline-p) + (helm-move--beginning-of-multiline-candidate)) + (when (helm-pos-header-line-p) (forward-line 1)) + (helm-mark-current-line))) + +(defun helm-delete-current-selection () + "Delete the currently selected item." + (interactive) + (with-helm-window + (cond ((helm-pos-multiline-p) + (helm-aif (helm-get-next-candidate-separator-pos) + (delete-region (point-at-bol) + (1+ (progn (goto-char it) (point-at-eol)))) + ;; last candidate + (goto-char (helm-get-previous-candidate-separator-pos)) + (delete-region (point-at-bol) (point-max))) + (when (helm-end-of-source-p) + (goto-char (or (helm-get-previous-candidate-separator-pos) + (point-min))) + (forward-line 1))) + (t + (delete-region (point-at-bol) (1+ (point-at-eol))) + (when (helm-end-of-source-p t) + (let ((headp (save-excursion + (forward-line -1) + (not (helm-pos-header-line-p))))) + (and headp (forward-line -1)))))) + (unless (helm-end-of-source-p t) + (helm-mark-current-line)))) + +(defun helm-end-of-source-p (&optional at-point) + "Return non--nil if we are at eob or end of source." + (save-excursion + (if (and (helm-pos-multiline-p) (null at-point)) + (null (helm-get-next-candidate-separator-pos)) + (forward-line (if at-point 0 1)) + (or (eq (point-at-bol) (point-at-eol)) + (helm-pos-header-line-p) + (eobp))))) + +(defun helm-edit-current-selection-internal (func) + (with-helm-window + (forward-line 0) + (let ((realvalue (get-text-property (point) 'helm-realvalue)) + (multiline (get-text-property (point) 'helm-multiline))) + (funcall func) + (forward-line 0) + (and realvalue + (put-text-property (point) (point-at-eol) + 'helm-realvalue realvalue)) + (and multiline + (put-text-property (point) (point-at-eol) + 'helm-multiline multiline)) + (helm-mark-current-line)))) + +(defmacro helm-edit-current-selection (&rest forms) + "Evaluate FORMS at current selection in the helm buffer. +Used generally to modify current selection." + (declare (indent 0) (debug t)) + `(helm-edit-current-selection-internal + (lambda () ,@forms))) + +(defun helm-set-pattern (pattern &optional noupdate) + "Set minibuffer contents to PATTERN. +if optional NOUPDATE is non-nil, helm buffer is not changed." + (with-selected-window (or (active-minibuffer-window) (minibuffer-window)) + (delete-minibuffer-contents) + (insert pattern)) + (when noupdate + (setq helm-pattern pattern))) + +(defun helm-minibuffer-completion-contents () + "Return the user input in a minibuffer before point as a string. +That is what completion commands operate on." + (buffer-substring (field-beginning) (point))) + +(defun helm--delete-minibuffer-contents-from (from-str) + ;; Giving an empty string value to FROM-STR delete all. + (require 'helm-utils) + (let ((input (minibuffer-contents))) + (helm-reset-yank-point) + (if (> (length input) 0) + ;; minibuffer is not empty, delete contents from end + ;; of FROM-STR and update. + (helm-set-pattern from-str) + ;; minibuffer is already empty, force update. + (helm-force-update)))) + +(defun helm-delete-minibuffer-contents (&optional arg) + "Delete minibuffer contents. +When `helm-delete-minibuffer-contents-from-point' is non--nil, +delete minibuffer contents from point instead of deleting all. +Giving a prefix arg reverse this behavior. +When at end of minibuffer delete all." + (interactive "P") + (let ((str (if helm-delete-minibuffer-contents-from-point + (if (or arg (eobp)) + "" (helm-minibuffer-completion-contents)) + (if (and arg (not (eobp))) + (helm-minibuffer-completion-contents) "")))) + (helm--delete-minibuffer-contents-from str))) + + +;;; Plugins +;; +;; Built-in plug-in: type +(defun helm-compile-source--type (source) + (helm-aif (assoc-default 'type source) + (append source (assoc-default it helm-type-attributes) nil) + source)) + +;; `define-helm-type-attribute' is public API. + +(defun helm-add-type-attribute (type definition) + (helm-aif (assq type helm-type-attributes) + (setq helm-type-attributes (delete it helm-type-attributes))) + (push (cons type definition) helm-type-attributes)) + +(defun helm-document-type-attribute (type doc) + (add-to-list 'helm-types type t) + (put type 'helm-typeattrdoc + (concat "- " (symbol-name type) "\n\n" doc "\n"))) + +;; Built-in plug-in: dummy +(defun helm-dummy-candidate (_candidate _source) + "Use `helm-pattern' as CANDIDATE in SOURCE." + ;; `source' is defined in filtered-candidate-transformer + (list helm-pattern)) + +(defun helm-compile-source--dummy (source) + (if (assoc 'dummy source) + (progn + (unless (helm-attr-defined + 'filtered-candidate-transformer source) + (helm-attrset 'filtered-candidate-transformer + 'helm-dummy-candidate source)) + (append source + '((candidates "dummy") + (accept-empty) + (match identity) + (volatile)))) + source)) + +;; Built-in plug-in: candidates-in-buffer +(defun helm-candidates-in-buffer (&optional source) + "Get candidates from the candidates buffer according to `helm-pattern'. + +BUFFER is `helm-candidate-buffer' by default. Each +candidate must be placed in one line. This function is meant to +be used in candidates-in-buffer or candidates attribute of an +helm source. Especially fast for many (1000+) candidates. + +eg. + '((name . \"many files\") + (init . (lambda () (with-current-buffer (helm-candidate-buffer 'local) + (insert-many-filenames)))) + (search re-search-forward) ; optional + (candidates-in-buffer) + (type . file)) + ++===============================================================+ +| The new way of making and narrowing candidates: Using buffers | ++===============================================================+ + +By default, `helm' makes candidates by evaluating the +candidates function, then narrows them by `string-match' for each +candidate. + +But this way is very slow for many candidates. The new way is +storing all candidates in a buffer and narrowing them by +`re-search-forward'. Search function is customizable by search +attribute. The important point is that buffer processing is MUCH +FASTER than string list processing and is the Emacs way. + +The init function writes all candidates to a newly-created +candidate buffer. The candidates buffer is created or specified +by `helm-candidate-buffer'. Candidates are stored in a line. + +The candidates function narrows all candidates, IOW creates a +subset of candidates dynamically. It is the task of +`helm-candidates-in-buffer'. As long as +`helm-candidate-buffer' is used,`(candidates-in-buffer)' is +sufficient in most cases. + +Note that `(candidates-in-buffer)' is shortcut of three attributes: + (candidates . helm-candidates-in-buffer) + (volatile) + (match identity) +And `(candidates-in-buffer . func)' is shortcut of three attributes: + (candidates . func) + (volatile) + (match identity) +The expansion is performed in `helm-get-sources'. + +The candidates-in-buffer attribute implies the volatile attribute. +The volatile attribute is needed because `helm-candidates-in-buffer' +creates candidates dynamically and need to be called everytime +`helm-pattern' changes. + +Because `helm-candidates-in-buffer' plays the role of `match' attribute +function, specifying `(match identity)' makes the source slightly faster. + +However if source contain match-part attribute, match is computed only +on part of candidate returned by the call of function provided by this attribute. +The function should have one arg, candidate, and return only +a specific part of candidate. + +To customize `helm-candidates-in-buffer' behavior, use `search', +`get-line' and `match-part' attributes." + (let ((src (or source (helm-get-current-source)))) + (helm-candidates-in-buffer-1 + (helm-candidate-buffer) + helm-pattern + (or (assoc-default 'get-line src) + #'buffer-substring-no-properties) + (or (assoc-default 'search src) + '(helm-candidates-in-buffer-search-default-fn)) + (helm-candidate-number-limit src) + (helm-attr 'match-part) + src))) + +(defun helm-candidates-in-buffer-search-default-fn (pattern) + "Search PATTERN with `re-search-forward' with bound and noerror args." + (condition-case _err + (re-search-forward pattern nil t) + (invalid-regexp nil))) + +(defun helm-candidates-in-buffer-1 (buffer pattern get-line-fn + search-fns limit + match-part-fn source) + "Return the list of candidates inserted in BUFFER matching PATTERN." + ;; buffer == nil when candidates buffer does not exist. + (when buffer + (with-current-buffer buffer + (let ((inhibit-point-motion-hooks t) + (start-point (1- (point-min)))) + (goto-char start-point) + (if (string= pattern "") + (helm-initial-candidates-from-candidate-buffer + get-line-fn limit) + (helm-search-from-candidate-buffer + pattern get-line-fn search-fns limit + start-point match-part-fn source)))))) + +(defun helm-search-from-candidate-buffer (pattern get-line-fn search-fns + limit start-point match-part-fn source) + (let (buffer-read-only + matches + newmatches + (case-fold-search (helm-set-case-fold-search))) + (helm--search-from-candidate-buffer-1 + (lambda () + (clrhash helm-cib-hash) + (cl-dolist (searcher search-fns) + (goto-char start-point) + (setq newmatches nil) + (cl-loop with pos-lst + with item-count = 0 + while (and (setq pos-lst (funcall searcher pattern)) + (not (eobp))) + for cand = (apply get-line-fn + (if (and pos-lst (listp pos-lst)) + pos-lst + (list (point-at-bol) (point-at-eol)))) + when (and (not (gethash cand helm-cib-hash)) + (or + ;; Always collect when cand is matched by searcher funcs + ;; and match-part attr is not present. + (and (not match-part-fn) + (not (consp pos-lst))) + ;; If match-part attr is present, or if SEARCHER fn + ;; returns a cons cell, collect PATTERN only if it + ;; match the part of CAND specified by the match-part func. + (helm-search-match-part cand pattern (or match-part-fn #'identity)))) + do (helm--accumulate-candidates + cand newmatches helm-cib-hash item-count limit source)) + (setq matches (append matches (nreverse newmatches)))) + (delq nil matches))))) + +(defun helm-search-match-part (candidate pattern match-part-fn) + "Match PATTERN only on part of CANDIDATE returned by MATCH-PART-FN. +Because `helm-search-match-part' maybe called even if unspecified +in source (negation), MATCH-PART-FN default to `identity' to match whole candidate. +When using fuzzy matching and negation (i.e \"!\"), this function is always called." + (let ((part (funcall match-part-fn candidate)) + (fuzzy-regexp (cadr (gethash 'helm-pattern helm--fuzzy-regexp-cache)))) + (if (string-match " " pattern) + (cl-loop for i in (split-string pattern) always + (if (string-match "\\`!" i) + (not (string-match (substring i 1) part)) + (string-match i part))) + (if (string-match "\\`!" pattern) + (not (string-match (if helm--in-fuzzy + ;; Fuzzy regexp have already been + ;; computed with substring 1. + fuzzy-regexp + (substring 1 pattern)) + part)) + (string-match (if helm--in-fuzzy fuzzy-regexp pattern) + part))))) + +(defun helm-initial-candidates-from-candidate-buffer (get-line-fn limit) + (delq nil (cl-loop for i from 1 to limit + until (eobp) + collect (funcall get-line-fn + (point-at-bol) (point-at-eol)) + do (forward-line 1)))) + +(defun helm--search-from-candidate-buffer-1 (search-fn) + ;; Previously we were adding a newline at bob and at eol + ;; and removing these newlines afterward, it seems it is no more + ;; needed, thus when searching for empty line ("^$") + ;; it was adding the first line as a matched line + ;; which is wrong. + (unwind-protect + (funcall search-fn) + (set-buffer-modified-p nil))) + +(defun helm-candidate-buffer (&optional create-or-buffer) + "Register and return a buffer containing candidates of current source. +`helm-candidate-buffer' searches buffer-local candidates buffer first, +then global candidates buffer. + +Acceptable values of CREATE-OR-BUFFER: + +- nil (omit) + Only return the candidates buffer. +- a buffer + Register a buffer as a candidates buffer. +- 'global + Create a new global candidates buffer, + named \" *helm candidates:SOURCE*\". +- other non-nil value + Create a new local candidates buffer, + named \" *helm candidates:SOURCE*HELM-CURRENT-BUFFER\"." + (let* ((global-bname (format " *helm candidates:%s*" + helm-source-name)) + (local-bname (format " *helm candidates:%s*%s" + helm-source-name + (buffer-name helm-current-buffer))) + (register-func #'(lambda () + (setq helm-candidate-buffer-alist + (cons (cons helm-source-name create-or-buffer) + (delete (assoc helm-source-name + helm-candidate-buffer-alist) + helm-candidate-buffer-alist))))) + (kill-buffers-func #'(lambda () + (cl-loop for b in (buffer-list) + if (string-match (format "^%s" (regexp-quote global-bname)) + (buffer-name b)) + do (kill-buffer b)))) + (create-func #'(lambda () + (with-current-buffer + (get-buffer-create (if (eq create-or-buffer 'global) + global-bname + local-bname)) + (buffer-disable-undo) + (erase-buffer) + (font-lock-mode -1)))) + (return-func #'(lambda () + (or (get-buffer local-bname) + (get-buffer global-bname) + (helm-aif (assoc-default helm-source-name + helm-candidate-buffer-alist) + (and (buffer-live-p it) it)))))) + (when create-or-buffer + (funcall register-func) + (unless (bufferp create-or-buffer) + (and (eq create-or-buffer 'global) (funcall kill-buffers-func)) + (funcall create-func))) + (funcall return-func))) + +(defun helm-init-candidates-in-buffer (buffer data) + "Register BUFFER with DATA for a helm candidates-in-buffer session. +Arg BUFFER can be a string, a buffer object (bufferp), or a symbol, +either 'local or 'global which is passed to `helm-candidate-buffer'. +Arg DATA can be either a list or a plain string. +Returns the resulting buffer." + (declare (indent 1)) + (let ((buf (helm-candidate-buffer + (if (or (stringp buffer) + (bufferp buffer)) + (get-buffer-create buffer) + buffer)))) ; a symbol. + (with-current-buffer buf + (erase-buffer) + (if (listp data) + (insert (mapconcat (lambda (i) + (cond ((symbolp i) (symbol-name i)) + ((numberp i) (number-to-string i)) + (t i))) + data "\n")) + (and (stringp data) (insert data)))) + buf)) + +(defun helm-compile-source--candidates-in-buffer (source) + (helm-aif (assoc 'candidates-in-buffer source) + (append source + `((candidates . ,(or (cdr it) + (lambda () + (helm-candidates-in-buffer source)))) + (volatile) (match identity))) + source)) + + +;;; Resplit helm window +;; +;; +(defun helm-toggle-resplit-window () + "Toggle resplit helm window, vertically or horizontally." + (interactive) + (when helm-prevent-escaping-from-minibuffer + (helm-prevent-switching-other-window :enabled nil)) + (unwind-protect + (with-helm-window + (if (or helm-full-frame (one-window-p t)) + (message "Error: Attempt to resplit a single window") + (let ((before-height (window-height))) + (delete-window) + (set-window-buffer + (select-window + (if (= (window-height) before-height) ; initial split was horizontal. + ;; Split window vertically with `helm-buffer' placed + ;; on the good side according to actual value of + ;; `helm-split-window-default-side'. + (prog1 + (cond ((or (eq helm-split-window-default-side 'above) + (eq helm-split-window-default-side 'left)) + (split-window + (selected-window) nil 'above)) + (t (split-window-vertically))) + (setq helm-split-window-state 'vertical)) + ;; Split window vertically, same comment as above. + (setq helm-split-window-state 'horizontal) + (cond ((or (eq helm-split-window-default-side 'left) + (eq helm-split-window-default-side 'above)) + (split-window (selected-window) nil 'left)) + (t (split-window-horizontally))))) + helm-buffer))) + (setq helm--window-side-state (helm--get-window-side-state))) + (when helm-prevent-escaping-from-minibuffer + (helm-prevent-switching-other-window :enabled t)))) + +;; Utility: Resize helm window. +(defun helm-enlarge-window-1 (n) + "Enlarge or narrow helm window. +If N is positive enlarge, if negative narrow." + (unless helm-full-frame + (let ((horizontal-p (eq helm-split-window-state 'horizontal))) + (with-helm-window + (enlarge-window n horizontal-p))))) + +(defun helm-narrow-window () + "Narrow helm window." + (interactive) + (helm-enlarge-window-1 -1)) + +(defun helm-enlarge-window () + "Enlarge helm window." + (interactive) + (helm-enlarge-window-1 1)) + +(defun helm-swap-windows () + "Swap window holding `helm-buffer' with other window." + (interactive) + (if (and helm-full-frame (one-window-p t)) + (error "Error: Can't swap windows in a single window") + (let* ((w1 (helm-window)) + (split-state (eq helm-split-window-state 'horizontal)) + (w1size (window-total-size w1 split-state)) + (b1 (window-buffer w1)) ; helm-buffer + (s1 (window-start w1)) + (cur-frame (window-frame w1)) + (w2 (with-selected-window (helm-window) + ;; Don't try to display helm-buffer + ;; in a dedicated window. + (get-window-with-predicate + (lambda (w) (not (window-dedicated-p w))) + 1 cur-frame))) + (w2size (window-total-size w2 split-state)) + (b2 (window-buffer w2)) ; probably helm-current-buffer + (s2 (window-start w2)) + resize) + (with-selected-frame (window-frame w1) + (helm-replace-buffer-in-window w1 b1 b2) + (helm-replace-buffer-in-window w2 b2 b1) + (setq resize + (cond ( ;; helm-window is smaller than other window. + (< w1size w2size) + (- (- (max w2size w1size) + (min w2size w1size)))) + ( ;; helm-window is larger than other window. + (> w1size w2size) + (- (max w2size w1size) + (min w2size w1size))) + ( ;; windows have probably same size. + t nil))) + ;; Maybe resize the window holding helm-buffer. + (and resize (window-resize w2 resize split-state)) + (set-window-start w1 s2 t) + (set-window-start w2 s1 t)) + (setq helm--window-side-state (helm--get-window-side-state))))) + +(defun helm--get-window-side-state () + "Return the position of `helm-window' from `helm-current-buffer'. +Possible values are 'left 'right 'below or 'above." + (let ((side-list '(left right below above))) + (cl-loop for side in side-list + thereis (and (equal (helm-window) + (window-in-direction + side (get-buffer-window helm-current-buffer t) + t)) + side)))) + +(defun helm-replace-buffer-in-window (window buffer1 buffer2) + "Replace BUFFER1 by BUFFER2 in WINDOW registering BUFFER1." + (when (get-buffer-window buffer1) + (unrecord-window-buffer window buffer1) + (set-window-buffer window buffer2))) + +;; Utility: select another action by key +(defun helm-select-nth-action (n) + "Select the N nth action for the currently selected candidate." + (setq helm-saved-selection (helm-get-selection)) + (unless helm-saved-selection + (error "Nothing is selected")) + (setq helm-saved-action + (helm-get-nth-action + n + (if (get-buffer-window helm-action-buffer 'visible) + (assoc-default 'candidates (helm-get-current-source)) + (helm-get-actions-from-current-source)))) + (helm-maybe-exit-minibuffer)) + +(defun helm-get-nth-action (n action) + (cond ((and (zerop n) (functionp action)) + action) + ((listp action) + (or (cdr (elt action n)) + (error "No such action"))) + ((and (functionp action) (< 0 n)) + (error "Sole action")) + (t + (error "Error in `helm-select-nth-action'")))) + +;; Utility: Persistent Action +(defmacro with-helm-display-same-window (&rest body) + "Execute BODY in the window used for persistent action. +Make `pop-to-buffer' and `display-buffer' display in the same window." + (declare (indent 0) (debug t)) + `(let ((display-buffer-function 'helm-persistent-action-display-buffer)) + ,@body)) + +(defun helm-initialize-persistent-action () + (set (make-local-variable 'helm-persistent-action-display-window) nil)) + +(cl-defun helm-execute-persistent-action + (&optional (attr 'persistent-action) split-onewindow) + "Perform the associated action ATTR without quitting helm. +ATTR default is 'persistent-action', but it can be anything else. +In this case you have to add this new attribute to your source. + +When `helm-full-frame' or SPLIT-ONEWINDOW are non--nil, +and `helm-buffer' is displayed in only one window, +the helm window is splitted to display +`helm-select-persistent-action-window' in other window +and keep its visibility." + (interactive) + (helm-log "executing persistent-action") + (let* ((attr-val (assoc-default attr (helm-get-current-source))) + ;; If attr value is a cons, use its car as persistent function + ;; and its car to decide if helm window should be splitted. + (fn (if (and (consp attr-val) + ;; maybe a lambda. + (not (functionp attr-val))) + (car attr-val) attr-val)) + (no-split (and (consp attr-val) + (not (functionp attr-val)) + (cdr attr-val)))) + (with-helm-window + (save-selected-window + (if no-split + (helm-select-persistent-action-window) + (helm-select-persistent-action-window + (or split-onewindow helm-onewindow-p))) + (helm-log "current-buffer = %S" (current-buffer)) + (let ((helm-in-persistent-action t)) + (with-helm-display-same-window + (helm-execute-selection-action-1 + nil (or fn (helm-get-actions-from-current-source)) t) + (helm-log-run-hook 'helm-after-persistent-action-hook)) + ;; A typical case is when a persistent action delete + ;; the buffer already displayed in + ;; `helm-persistent-action-display-window' and `helm-full-frame' + ;; is enabled, we end up with the `helm-buffer' + ;; displayed in two windows. + (when (and helm-onewindow-p + (> (length (window-list)) 1) + (equal (buffer-name + (window-buffer + helm-persistent-action-display-window)) + (helm-buffer-get))) + (delete-other-windows))))))) + +(defun helm-persistent-action-display-window (&optional split-onewindow) + "Return the window that will be used for persistent action. +If SPLIT-ONEWINDOW is non--nil window will be splitted in persistent action." + (with-helm-window + (setq helm-persistent-action-display-window + (cond ((and (window-live-p helm-persistent-action-display-window) + (not (member helm-persistent-action-display-window + (get-buffer-window-list helm-buffer)))) + helm-persistent-action-display-window) + (split-onewindow (split-window)) + ((get-buffer-window helm-current-buffer)) + (t (next-window (selected-window) 1)))))) + +(defun helm-select-persistent-action-window (&optional split-onewindow) + "Select the window that will be used for persistent action. +See `helm-persistent-action-display-window' for how to use SPLIT-ONEWINDOW." + (select-window (get-buffer-window (helm-buffer-get))) + (select-window + (setq minibuffer-scroll-window + (helm-persistent-action-display-window split-onewindow)))) + +(defun helm-persistent-action-display-buffer (buf &optional action) + "Make `pop-to-buffer' and `display-buffer' display in the same window. +If `helm-persistent-action-use-special-display' is non-nil and +BUF is to be displayed by `special-display-function', use it. +Otherwise ignores `special-display-buffer-names' and `special-display-regexps'. +Argument ACTION if present will be used as second argument of `display-buffer'." + (let* ((name (buffer-name buf)) + display-buffer-function pop-up-windows pop-up-frames + ;; Disable `special-display-regexps' and `special-display-buffer-names' + ;; unless `helm-persistent-action-use-special-display' is non--nil. + (special-display-buffer-names + (and helm-persistent-action-use-special-display + special-display-buffer-names)) + (special-display-regexps + (and helm-persistent-action-use-special-display + special-display-regexps)) + (same-window-regexps + (unless (and helm-persistent-action-use-special-display + (or (member name + (mapcar (lambda (x) (or (car-safe x) x)) + special-display-buffer-names)) + (cl-loop for x in special-display-regexps + thereis (string-match (or (car-safe x) x) + name)))) + '(".")))) + ;; Don't loose minibuffer when displaying persistent window in + ;; another frame. + ;; This happen when the displayed persistent buffer-name is one of + ;; `special-display-buffer-names' or match `special-display-regexps' + ;; and `helm-persistent-action-use-special-display' is enabled. + (with-selected-window (if (or special-display-regexps + special-display-buffer-names) + (minibuffer-window) + (selected-window)) + ;; Be sure window of BUF is not dedicated. + (set-window-dedicated-p (get-buffer-window buf) nil) + (display-buffer buf action)))) + +;; scroll-other-window(-down)? for persistent-action +(defun helm-other-window-base (command &optional scroll-amount) + (setq scroll-amount (unless (eq scroll-amount 'noscroll) + helm-scroll-amount)) + (with-selected-window (helm-persistent-action-display-window) + (funcall command scroll-amount))) + +(defun helm-scroll-other-window () + "Scroll other window (not *Helm* window) upward." + (interactive) + (helm-other-window-base 'scroll-up)) + +(defun helm-scroll-other-window-down () + "Scroll other window (not *Helm* window) downward." + (interactive) + (helm-other-window-base 'scroll-down)) + +(defun helm-recenter-top-bottom-other-window () + "`recenter-top-bottom' in other window (not *Helm* window)." + (interactive) + (helm-other-window-base 'recenter-top-bottom 'noscroll)) + +(defun helm-reposition-window-other-window () + "`helm-reposition-window' in other window (not *Helm* window)." + (interactive) + (helm-other-window-base 'reposition-window 'noscroll)) + + + +;; Utility: Visible Mark + +(defun helm-clear-visible-mark () + (with-current-buffer (helm-buffer-get) + (mapc 'delete-overlay helm-visible-mark-overlays) + (set (make-local-variable 'helm-visible-mark-overlays) nil))) + +(defun helm-this-visible-mark () + (cl-loop for o in helm-visible-mark-overlays + when (equal (point-at-bol) (overlay-start o)) + return o)) + +(defun helm-delete-visible-mark (overlay) + (setq helm-marked-candidates + (remove + (cons (helm-get-current-source) (helm-get-selection)) + helm-marked-candidates)) + (delete-overlay overlay) + (setq helm-visible-mark-overlays + (delq overlay helm-visible-mark-overlays))) + +(defun helm-make-visible-mark () + (let ((o (make-overlay (point-at-bol) + (if (helm-pos-multiline-p) + (or (helm-get-next-candidate-separator-pos) + (point-max)) + (1+ (point-at-eol)))))) + (overlay-put o 'priority 0) + (overlay-put o 'face 'helm-visible-mark) + (overlay-put o 'source (assoc-default 'name (helm-get-current-source))) + (overlay-put o 'string (buffer-substring (overlay-start o) (overlay-end o))) + (overlay-put o 'real (helm-get-selection)) + (add-to-list 'helm-visible-mark-overlays o)) + (push (cons (helm-get-current-source) (helm-get-selection)) + helm-marked-candidates)) + +(defun helm-toggle-visible-mark () + "Toggle helm visible mark at point." + (interactive) + (with-helm-window + (let ((nomark (assq 'nomark (helm-get-current-source)))) + (if nomark + (message "Marking not allowed in this source") + (helm-aif (helm-this-visible-mark) + (helm-delete-visible-mark it) + (helm-make-visible-mark)) + (unless (helm-end-of-source-p) + (helm-next-line)))))) + +(defun helm-mark-all () + "Mark all visible unmarked candidates in current source." + (interactive) + (require 'helm-files) + (with-helm-window + (let ((nomark (assq 'nomark (helm-get-current-source))) + (follow (if helm-follow-mode 1 -1))) + (helm-follow-mode -1) + (unwind-protect + (if nomark + (message "Marking not allowed in this source") + (save-excursion + (goto-char (helm-get-previous-header-pos)) + (helm-next-line) + (let* ((next-head (helm-get-next-header-pos)) + (end (and next-head + (save-excursion + (goto-char next-head) + (forward-line -1) + (point)))) + (maxpoint (or end (point-max)))) + (while (< (point) maxpoint) + (helm-mark-current-line) + (let* ((prefix (get-text-property (point-at-bol) 'display)) + (cand (helm-get-selection)) + (bn (and (helm-file-completion-source-p) + (helm-basename cand))) + (src-name (assoc-default 'name + (helm-get-current-source)))) + (when (and (not (helm-this-visible-mark)) + (not (or (string= prefix "[?]") + (string= prefix "[@]")))) + ;; Don't mark possibles directories ending with . or .. + ;; autosave files/links and non--existent file. + (unless + (and (or (helm-file-completion-source-p) + (string= + src-name "Files from Current Directory")) + (or (string-match + "^[.]?#.*#?$\\|[^#]*[.]\\{1,2\\}$" bn) + ;; We need to test here when not using + ;; a transformer that tag prefix + ;; (i.e on tramp). + (not (file-exists-p cand)))) + (helm-make-visible-mark)))) + (if (helm-pos-multiline-p) + (progn + (goto-char + (or (helm-get-next-candidate-separator-pos) + (point-max))) + (forward-line 1)) + (forward-line 1)) + (end-of-line)))) + (helm-mark-current-line) + (message "%s candidates marked" (length helm-marked-candidates))) + (helm-follow-mode follow) (message nil))))) + +(defun helm-unmark-all () + "Unmark all candidates in all sources of current helm session." + (interactive) + (with-helm-window + (let ((len (length helm-marked-candidates))) + (save-excursion + (helm-clear-visible-mark)) + (setq helm-marked-candidates nil) + (helm-mark-current-line) + (message "%s candidates unmarked" len)))) + +(defun helm-toggle-all-marks () + "Toggle all marks. +Mark all visible candidates of current source or unmark all candidates +visible or invisible in all sources of current helm session" + (interactive) + (let ((marked (helm-marked-candidates))) + (if (and (>= (length marked) 1) + (with-helm-window helm-visible-mark-overlays)) + (helm-unmark-all) + (helm-mark-all)))) + +(cl-defun helm-marked-candidates (&key with-wildcard) + "Return marked candidates of current source if any. +Otherwise one element list of current selection. +When key WITH-WILDCARD is specified try to expand a wilcard if some." + (with-current-buffer helm-buffer + (cl-loop with current-src = (helm-get-current-source) + for (source . real) in + (or (reverse helm-marked-candidates) + (list (cons current-src (helm-get-selection)))) + when (equal (assoc 'name current-src) + (assoc 'name source)) + ;; When real is a normal filename without wildcard + ;; file-expand-wildcards returns a list of one file. + ;; When real is a non--existent file it return nil. + append (let* ((elm (helm-coerce-selection real source)) + (c (and with-wildcard + (condition-case nil + (helm-file-expand-wildcards elm t) + (error nil))))) + (or c (list elm))) + into cands + finally do (prog1 (cl-return cands) + (helm-log "Marked candidates = %S" cands))))) + +(defun helm-file-expand-wildcards (pattern &optional full) + "Same as `file-expand-wildcards' but allow recursion. +Recursion happen when PATTERN starts with two stars. +Directories expansion is not supported." + (require 'helm-utils) + (let ((bn (helm-basename pattern))) + (if (and helm-file-globstar + (string-match "\\`\\*\\{2\\}\\(.*\\)" bn)) + (helm-walk-directory (helm-basedir pattern) + :path (cl-case full + (full 'full) + (relative 'relative) + ((basename nil) 'basename) + (t 'full)) + :directories nil + :match (wildcard-to-regexp bn) + :skip-subdirs t) + (file-expand-wildcards pattern full)))) + +(defun helm-current-source-name= (name) + (save-excursion + (goto-char (helm-get-previous-header-pos)) + (equal name (helm-current-line-contents)))) + +(defun helm-revive-visible-mark () + "Restore marked candidates when helm update display." + (with-current-buffer helm-buffer + (cl-dolist (o helm-visible-mark-overlays) + (goto-char (point-min)) + (while (and (search-forward (overlay-get o 'string) nil t) + (helm-current-source-name= (overlay-get o 'source))) + ;; Calculate real value of candidate. + ;; It can be nil if candidate have only a display value. + (let ((real (get-text-property (point-at-bol 0) 'helm-realvalue))) + (if real + ;; Check if real value of current candidate is the same + ;; than the one stored in overlay. + ;; This is needed when some cands have same display names. + ;; Using equal allow testing any type of value for real cand. + ;; Issue (#706). + (and (equal (overlay-get o 'real) real) + (move-overlay o (point-at-bol 0) (1+ (point-at-eol 0)))) + (move-overlay o (point-at-bol 0) (1+ (point-at-eol 0))))))))) +(add-hook 'helm-update-hook 'helm-revive-visible-mark) + +(defun helm-next-point-in-list (curpos points &optional prev) + (cond + ;; rule out special cases. + ((null points) curpos) + ((and prev (<= curpos (car points))) + (nth (1- (length points)) points)) + ((< (car (last points)) curpos) + (if prev (car (last points)) (nth 0 points))) + ((and (not prev) (>= curpos (car (last points)))) + (nth 0 points)) + (t + (nth (if prev + (cl-loop for pt in points + for i from 0 + if (<= curpos pt) return (1- i)) + (cl-loop for pt in points + for i from 0 + if (< curpos pt) return i)) + points)))) + +(defun helm-next-visible-mark (&optional prev) + "Move next helm visible mark. +If PREV is non-nil move to precedent." + (interactive) + (with-helm-window + (ignore-errors + (goto-char (helm-next-point-in-list + (point) + (sort (mapcar 'overlay-start helm-visible-mark-overlays) '<) + prev))) + (helm-mark-current-line))) + +(defun helm-prev-visible-mark () + "Move previous helm visible mark." + (interactive) + (helm-next-visible-mark t)) + +;;; Utility: Selection Paste +;; +(defun helm-yank-selection (arg) + "Set minibuffer contents to current display selection. +With a prefix arg set to real value of current selection." + (interactive "P") + (let ((str (helm-get-selection nil (not arg)))) + (kill-new str) + (helm-set-pattern str))) + +(defun helm-kill-selection-and-quit (arg) + "Store display value of current selection to kill ring. +With a prefix arg set to real value of current selection. +Display value is what you see in `helm-buffer' and real value +is what is used to perform actions." + (interactive "P") + (helm-run-after-quit + (lambda (sel) + (kill-new sel) + (message "Killed: %s" sel)) + (helm-get-selection nil (not arg)))) + +(defun helm-copy-to-buffer () + "Copy selection or marked candidates to `helm-current-buffer'." + (interactive) + (with-helm-buffer + (cl-loop for cand in (helm-marked-candidates) + do (with-helm-current-buffer + (insert cand "\n"))))) + + +;;; Follow-mode: Automatical execution of persistent-action +;; +;; +(defun helm-follow-mode (&optional arg) + "Execute persistent action everytime the cursor is moved when enabled. +The mode is enabled for the current source only, you will have to turn it +on again when you go to next source if you want it there also. +This mode can be enabled or disabled interactively at anytime during +helm session or enabled specifically by source by adding the `follow' +attribute to this source. +Even when the attribute `follow' exists in source, it is still possible +to disable/enable this mode interactively. +Note that when you disable it interactively and `follow' attribute exists, +`helm-follow-mode' will be disabled on next helm session even if `follow' +attribute is specified in source. To avoid this set your `follow' attribute +in source in `helm-before-initialize-hook'. + +e.g: + +\(add-hook 'helm-before-initialize-hook + #'(lambda () (helm-attrset 'follow 1 helm-source-buffers-list))) + +This will enable `helm-follow-mode' automatically in `helm-source-buffers-list'." + (interactive "p") + (with-current-buffer helm-buffer + (let* ((src (helm-get-current-source)) + (name (assoc-default 'name src)) + (sym (cl-loop for s in helm-sources + for sname = (and (symbolp s) + (assoc-default + 'name (symbol-value s))) + thereis (and sname (string= sname name) s))) + (fol-attr (assq 'follow src)) + (enabled (or + ;; If `helm-follow-mode' is called with a negative + ;; ARG, assume follow is already enabled. + ;; i.e turn it off now. + (< arg 0) + (eq (cdr fol-attr) 1) + helm-follow-mode))) + (if src + (progn + (if (eq (cdr fol-attr) 'never) + (message "helm-follow-mode not allowed in this source") + ;; Make follow attr persistent for this emacs session. + (helm-attrset 'follow (if enabled -1 1) src) + (setq helm-follow-mode (not enabled)) + (message "helm-follow-mode is %s" + (if helm-follow-mode + "enabled" "disabled")) + (helm-display-mode-line src)) + (unless helm-follow-mode-persistent + (and sym (set sym (remove (assq 'follow src) src))))) + (message "Not enough candidates for helm-follow-mode"))))) + +(defvar helm-follow-input-idle-delay nil + "`helm-follow-mode' will execute its persistent action after this delay. +Note that if the `follow-delay' attr is present in source, +it will take precedence on this.") +(defun helm-follow-execute-persistent-action-maybe () + "Execute persistent action in mode `helm-follow-mode'. +This happen after `helm-input-idle-delay' secs." + (let ((src (helm-get-current-source))) + (and (not (get-buffer-window helm-action-buffer 'visible)) + (eq (assoc-default 'follow src) 1) + (sit-for (or (assoc-default 'follow-delay src) + helm-follow-input-idle-delay + (and helm-input-idle-delay + (max helm-input-idle-delay 0.01)))) + (helm-window) + (helm-get-selection) + (save-excursion + (helm-execute-persistent-action))))) + + +;;; Auto-resize mode +;; +(defun helm--autoresize-hook (&optional max-height min-height) + (with-helm-window + (fit-window-to-buffer nil + (/ (* (frame-height) + (or max-height helm-autoresize-max-height)) + 100) + (/ (* (frame-height) + (or min-height helm-autoresize-min-height)) + 100)))) + +(define-minor-mode helm-autoresize-mode + "Auto resize helm window when enabled. +Helm window is resized according to values of `helm-autoresize-max-height' +and `helm-autoresize-min-height'. +Note that when this mode is enabled, helm behave like when +`helm-always-two-windows' is enabled. + +See `fit-window-to-buffer' for more infos." + :group 'helm + :global t + (if helm-autoresize-mode + (progn (add-hook 'helm-after-update-hook 'helm--autoresize-hook) + (add-hook 'helm-window-configuration-hook 'helm--autoresize-hook)) + (remove-hook 'helm-after-update-hook 'helm--autoresize-hook) + (remove-hook 'helm-window-configuration-hook 'helm--autoresize-hook))) + + +(provide 'helm) + +;; Local Variables: +;; byte-compile-warnings: (not cl-functions obsolete) +;; coding: utf-8 +;; indent-tabs-mode: nil +;; End: + +;;; helm.el ends here diff --git a/elpa/org-20150427.signed b/elpa/org-20150427.signed new file mode 100644 index 00000000..fe07a322 --- /dev/null +++ b/elpa/org-20150427.signed @@ -0,0 +1 @@ +Good signature from 474F05837FBDEF9B GNU ELPA Signing Agent (trust undefined) created at 2015-04-27T11:05:03+0200 using DSA \ No newline at end of file diff --git a/elpa/org-20150427/COPYING b/elpa/org-20150427/COPYING new file mode 100644 index 00000000..94a9ed02 --- /dev/null +++ b/elpa/org-20150427/COPYING @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + 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 . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. diff --git a/elpa/org-20150427/README_ELPA b/elpa/org-20150427/README_ELPA new file mode 100644 index 00000000..be893243 --- /dev/null +++ b/elpa/org-20150427/README_ELPA @@ -0,0 +1,41 @@ +This is the Emacs Org project, an Emacs library for organizing your life. + +The homepage of Org is at: + http://orgmode.org + +Installations instructions are at: + http://orgmode.org/org.html#Installation + +This distribution contains an ELPA packaged version of Org. +"ELPA" stands for the "Emacs Lisp Package Archive". + +The GNU ELPA is at: + http://elpa.gnu.org + +It contains the org-*.tar package, containing only the org files +that are also part of GNU Emacs. + +There are other ELPA online, offering more packages. + +Some contain the org-plus-contrib-*.tar ELPA package, which bundles +the core Org files plus many additional contributed libraries. + +All ELPA packages of Org contain: + +README_ELPA + This file. + +*.el + Elisp files. + +org + The Org info manual. + +orgcard.pdf + The Org reference card. + +etc/ + Libraries for the ODT exporter. + +org-*-pkg.el + The name of the package, requested GNU Emacs packaging system. diff --git a/elpa/org-20150427/dir b/elpa/org-20150427/dir new file mode 100644 index 00000000..9610c404 --- /dev/null +++ b/elpa/org-20150427/dir @@ -0,0 +1,18 @@ +This is the file .../info/dir, which contains the +topmost node of the Info hierarchy, called (dir)Top. +The first time you invoke Info you start off looking at this node. + +File: dir, Node: Top This is the top of the INFO tree + + This (the Directory node) gives a menu of major topics. + Typing "q" exits, "?" lists all Info commands, "d" returns here, + "h" gives a primer for first-timers, + "mEmacs" visits the Emacs manual, etc. + + In Emacs, you can click mouse button 2 on a menu item or cross reference + to select it. + +* Menu: + +Emacs +* Org Mode: (org). Outline-based notes management and organizer diff --git a/elpa/org-20150427/etc/styles/OrgOdtContentTemplate.xml b/elpa/org-20150427/etc/styles/OrgOdtContentTemplate.xml new file mode 100644 index 00000000..d0c98a3e --- /dev/null +++ b/elpa/org-20150427/etc/styles/OrgOdtContentTemplate.xml @@ -0,0 +1,275 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/elpa/org-20150427/etc/styles/OrgOdtStyles.xml b/elpa/org-20150427/etc/styles/OrgOdtStyles.xml new file mode 100644 index 00000000..f41d9840 --- /dev/null +++ b/elpa/org-20150427/etc/styles/OrgOdtStyles.xml @@ -0,0 +1,841 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + / + + / + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/elpa/org-20150427/etc/styles/README b/elpa/org-20150427/etc/styles/README new file mode 100644 index 00000000..d04f4349 --- /dev/null +++ b/elpa/org-20150427/etc/styles/README @@ -0,0 +1,36 @@ +The files OrgOdtContentTemplate.xml and OrgOdtStyles.xml have the +following copyright information: + +Copyright (C) 2010-2014 Free Software Foundation, Inc. + +These files are 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 . + + +Author: Jambunathan K +Keywords: outlines, hypermedia, calendar, wp +Homepage: http://orgmode.org + +Commentary: + +These files are part of Org-mode's OpenDocument export module. + +OrgOdtContentTemplate.xml provides a template within which the content +of an exported document is enclosed. This file contributes to +"content.xml" file within an exported document and acts as a +repository of automatic styles. + +OrgOdtStyles.xml contributes to "styles.xml" file within an exported +document and acts as a repository of custom styles. diff --git a/elpa/org-20150427/ob-C.el b/elpa/org-20150427/ob-C.el new file mode 100644 index 00000000..c460be32 --- /dev/null +++ b/elpa/org-20150427/ob-C.el @@ -0,0 +1,243 @@ +;;; ob-C.el --- org-babel functions for C and similar languages + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating C code. +;; +;; very limited implementation: +;; - currently only support :results output +;; - not much in the way of error feedback + +;;; Code: +(require 'ob) +(require 'cc-mode) + +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) + + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("C++" . "cpp")) + +(defvar org-babel-default-header-args:C '()) + +(defvar org-babel-C-compiler "gcc" + "Command used to compile a C source code file into an +executable.") + +(defvar org-babel-C++-compiler "g++" + "Command used to compile a C++ source code file into an +executable.") + +(defvar org-babel-c-variant nil + "Internal variable used to hold which type of C (e.g. C or C++) +is currently being evaluated.") + +(defun org-babel-execute:cpp (body params) + "Execute BODY according to PARAMS. +This function calls `org-babel-execute:C++'." + (org-babel-execute:C++ body params)) + +(defun org-babel-execute:C++ (body params) + "Execute a block of C++ code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params))) + +(defun org-babel-expand-body:C++ (body params) + "Expand a block of C++ code with org-babel according to it's +header arguments (calls `org-babel-C-expand')." + (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params))) + +(defun org-babel-execute:C (body params) + "Execute a block of C code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let ((org-babel-c-variant 'c)) (org-babel-C-execute body params))) + +(defun org-babel-expand-body:c (body params) + "Expand a block of C code with org-babel according to it's +header arguments (calls `org-babel-C-expand')." + (let ((org-babel-c-variant 'c)) (org-babel-C-expand body params))) + +(defun org-babel-C-execute (body params) + "This function should only be called by `org-babel-execute:C' +or `org-babel-execute:C++'." + (let* ((tmp-src-file (org-babel-temp-file + "C-src-" + (cond + ((equal org-babel-c-variant 'c) ".c") + ((equal org-babel-c-variant 'cpp) ".cpp")))) + (tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext)) + (cmdline (cdr (assoc :cmdline params))) + (flags (cdr (assoc :flags params))) + (full-body (org-babel-C-expand body params)) + (compile + (progn + (with-temp-file tmp-src-file (insert full-body)) + (org-babel-eval + (format "%s -o %s %s %s" + (cond + ((equal org-babel-c-variant 'c) org-babel-C-compiler) + ((equal org-babel-c-variant 'cpp) org-babel-C++-compiler)) + (org-babel-process-file-name tmp-bin-file) + (mapconcat 'identity + (if (listp flags) flags (list flags)) " ") + (org-babel-process-file-name tmp-src-file)) "")))) + (let ((results + (org-babel-trim + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))) + (org-babel-reassemble-table + (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-read results) + (let ((tmp-file (org-babel-temp-file "c-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) + )) + +(defun org-babel-C-expand (body params) + "Expand a block of C or C++ code with org-babel according to +it's header arguments." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (main-p (not (string= (cdr (assoc :main params)) "no"))) + (includes (or (cdr (assoc :includes params)) + (org-babel-read (org-entry-get nil "includes" t)))) + (defines (org-babel-read + (or (cdr (assoc :defines params)) + (org-babel-read (org-entry-get nil "defines" t)))))) + (mapconcat 'identity + (list + ;; includes + (mapconcat + (lambda (inc) (format "#include %s" inc)) + (if (listp includes) includes (list includes)) "\n") + ;; defines + (mapconcat + (lambda (inc) (format "#define %s" inc)) + (if (listp defines) defines (list defines)) "\n") + ;; variables + (mapconcat 'org-babel-C-var-to-C vars "\n") + ;; body + (if main-p + (org-babel-C-ensure-main-wrap body) + body) "\n") "\n"))) + +(defun org-babel-C-ensure-main-wrap (body) + "Wrap BODY in a \"main\" function call if none exists." + (if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body) + body + (format "int main() {\n%s\nreturn 0;\n}\n" body))) + +(defun org-babel-prep-session:C (session params) + "This function does nothing as C is a compiled language with no +support for sessions" + (error "C is a compiled languages -- no support for sessions")) + +(defun org-babel-load-session:C (session body params) + "This function does nothing as C is a compiled language with no +support for sessions" + (error "C is a compiled languages -- no support for sessions")) + +;; helper functions + +(defun org-babel-C-format-val (type val) + "Handle the FORMAT part of TYPE with the data from VAL." + (let ((format-data (cadr type))) + (if (stringp format-data) + (cons "" (format format-data val)) + (funcall format-data val)))) + +(defun org-babel-C-val-to-C-type (val) + "Determine the type of VAL. +Return a list (TYPE-NAME FORMAT). TYPE-NAME should be the name of the type. +FORMAT can be either a format string or a function which is called with VAL." + (cond + ((integerp val) '("int" "%d")) + ((floatp val) '("double" "%f")) + ((or (listp val) (vectorp val)) + (lexical-let ((type (org-babel-C-val-to-C-list-type val))) + (list (car type) + (lambda (val) + (cons + (format "[%d]%s" + (length val) + (car (org-babel-C-format-val type (elt val 0)))) + (concat "{ " + (mapconcat (lambda (v) + (cdr (org-babel-C-format-val type v))) + val + ", ") + " }")))))) + (t ;; treat unknown types as string + '("char" (lambda (val) + (let ((s (format "%s" val))) ;; convert to string for unknown types + (cons (format "[%d]" (1+ (length s))) + (concat "\"" s "\"")))))))) + +(defun org-babel-C-val-to-C-list-type (val) + "Determine the C array type of a VAL." + (let (type) + (mapc + #'(lambda (i) + (let* ((tmp-type (org-babel-C-val-to-C-type i)) + (type-name (car type)) + (tmp-type-name (car tmp-type))) + (when (and type (not (string= type-name tmp-type-name))) + (if (and (member type-name '("int" "double" "int32_t")) + (member tmp-type-name '("int" "double" "int32_t"))) + (setq tmp-type '("double" "" "%f")) + (error "Only homogeneous lists are supported by C. You can not mix %s and %s" + type-name + tmp-type-name))) + (setq type tmp-type))) + val) + type)) + +(defun org-babel-C-var-to-C (pair) + "Convert an elisp val into a string of C code specifying a var +of the same value." + ;; TODO list support + (let ((var (car pair)) + (val (cdr pair))) + (when (symbolp val) + (setq val (symbol-name val)) + (when (= (length val) 1) + (setq val (string-to-char val)))) + (let* ((type-data (org-babel-C-val-to-C-type val)) + (type (car type-data)) + (formated (org-babel-C-format-val type-data val)) + (suffix (car formated)) + (data (cdr formated))) + (format "%s %s%s = %s;" + type + var + suffix + data)))) + +(provide 'ob-C) + +;;; ob-C.el ends here diff --git a/elpa/org-20150427/ob-R.el b/elpa/org-20150427/ob-R.el new file mode 100644 index 00000000..b97fd912 --- /dev/null +++ b/elpa/org-20150427/ob-R.el @@ -0,0 +1,389 @@ +;;; ob-R.el --- org-babel functions for R code evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Dan Davison +;; Keywords: literate programming, reproducible research, R, statistics +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating R code + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function orgtbl-to-tsv "org-table" (table params)) +(declare-function R "ext:essd-r" (&optional start-args)) +(declare-function inferior-ess-send-input "ext:ess-inf" ()) +(declare-function ess-make-buffer-current "ext:ess-inf" ()) +(declare-function ess-eval-buffer "ext:ess-inf" (vis)) +(declare-function org-number-sequence "org-compat" (from &optional to inc)) +(declare-function org-remove-if-not "org" (predicate seq)) + +(defconst org-babel-header-args:R + '((width . :any) + (height . :any) + (bg . :any) + (units . :any) + (pointsize . :any) + (antialias . :any) + (quality . :any) + (compression . :any) + (res . :any) + (type . :any) + (family . :any) + (title . :any) + (fonts . :any) + (version . :any) + (paper . :any) + (encoding . :any) + (pagecentre . :any) + (colormodel . :any) + (useDingbats . :any) + (horizontal . :any) + (results . ((file list vector table scalar verbatim) + (raw org html latex code pp wrap) + (replace silent append prepend) + (output value graphics)))) + "R-specific header arguments.") + +(defvar org-babel-default-header-args:R '()) + +(defcustom org-babel-R-command "R --slave --no-save" + "Name of command to use for executing R code." + :group 'org-babel + :version "24.1" + :type 'string) + +(defvar ess-local-process-name) ; dynamically scoped +(defun org-babel-edit-prep:R (info) + (let ((session (cdr (assoc :session (nth 2 info))))) + (when (and session (string-match "^\\*\\(.+?\\)\\*$" session)) + (save-match-data (org-babel-R-initiate-session session nil))))) + +(defun org-babel-expand-body:R (body params &optional graphics-file) + "Expand BODY according to PARAMS, return the expanded body." + (let ((graphics-file + (or graphics-file (org-babel-R-graphical-output-file params)))) + (mapconcat + #'identity + (let ((inside + (append + (when (cdr (assoc :prologue params)) + (list (cdr (assoc :prologue params)))) + (org-babel-variable-assignments:R params) + (list body) + (when (cdr (assoc :epilogue params)) + (list (cdr (assoc :epilogue params))))))) + (if graphics-file + (append + (list (org-babel-R-construct-graphics-device-call + graphics-file params)) + inside + (list "dev.off()")) + inside)) + "\n"))) + +(defun org-babel-execute:R (body params) + "Execute a block of R code. +This function is called by `org-babel-execute-src-block'." + (save-excursion + (let* ((result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) + (session (org-babel-R-initiate-session + (cdr (assoc :session params)) params)) + (colnames-p (cdr (assoc :colnames params))) + (rownames-p (cdr (assoc :rownames params))) + (graphics-file (org-babel-R-graphical-output-file params)) + (full-body (org-babel-expand-body:R body params graphics-file)) + (result + (org-babel-R-evaluate + session full-body result-type result-params + (or (equal "yes" colnames-p) + (org-babel-pick-name + (cdr (assoc :colname-names params)) colnames-p)) + (or (equal "yes" rownames-p) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) rownames-p))))) + (if graphics-file nil result)))) + +(defun org-babel-prep-session:R (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-R-initiate-session session params)) + (var-lines (org-babel-variable-assignments:R params))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (end-of-line 1) (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:R (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:R session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-variable-assignments:R (params) + "Return list of R statements assigning the block's variables." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (mapcar + (lambda (pair) + (org-babel-R-assign-elisp + (car pair) (cdr pair) + (equal "yes" (cdr (assoc :colnames params))) + (equal "yes" (cdr (assoc :rownames params))))) + (mapcar + (lambda (i) + (cons (car (nth i vars)) + (org-babel-reassemble-table + (cdr (nth i vars)) + (cdr (nth i (cdr (assoc :colname-names params)))) + (cdr (nth i (cdr (assoc :rowname-names params))))))) + (org-number-sequence 0 (1- (length vars))))))) + +(defun org-babel-R-quote-tsv-field (s) + "Quote field S for export to R." + (if (stringp s) + (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") + (format "%S" s))) + +(defun org-babel-R-assign-elisp (name value colnames-p rownames-p) + "Construct R code assigning the elisp VALUE to a variable named NAME." + (if (listp value) + (let* ((lengths (mapcar 'length (org-remove-if-not 'sequencep value))) + (max (if lengths (apply 'max lengths) 0)) + (min (if lengths (apply 'min lengths) 0)) + (transition-file (org-babel-temp-file "R-import-"))) + ;; Ensure VALUE has an orgtbl structure (depth of at least 2). + (unless (listp (car value)) (setq value (list value))) + (with-temp-file transition-file + (insert + (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)) + "\n")) + (let ((file (org-babel-process-file-name transition-file 'noquote)) + (header (if (or (eq (nth 1 value) 'hline) colnames-p) + "TRUE" "FALSE")) + (row-names (if rownames-p "1" "NULL"))) + (if (= max min) + (format "%s <- read.table(\"%s\", + header=%s, + row.names=%s, + sep=\"\\t\", + as.is=TRUE)" name file header row-names) + (format "%s <- read.table(\"%s\", + header=%s, + row.names=%s, + sep=\"\\t\", + as.is=TRUE, + fill=TRUE, + col.names = paste(\"V\", seq_len(%d), sep =\"\"))" + name file header row-names max)))) + (format "%s <- %s" name (org-babel-R-quote-tsv-field value)))) + +(defvar ess-ask-for-ess-directory) ; dynamically scoped +(defun org-babel-R-initiate-session (session params) + "If there is not a current R process then create one." + (unless (string= session "none") + (let ((session (or session "*R*")) + (ess-ask-for-ess-directory + (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory) + (not (cdr (assoc :dir params)))))) + (if (org-babel-comint-buffer-livep session) + session + (save-window-excursion + (when (get-buffer session) + ;; Session buffer exists, but with dead process + (set-buffer session)) + (require 'ess) (R) + (rename-buffer + (if (bufferp session) + (buffer-name session) + (if (stringp session) + session + (buffer-name)))) + (current-buffer)))))) + +(defun org-babel-R-associate-session (session) + "Associate R code buffer with an R session. +Make SESSION be the inferior ESS process associated with the +current code buffer." + (setq ess-local-process-name + (process-name (get-buffer-process session))) + (ess-make-buffer-current)) + +(defun org-babel-R-graphical-output-file (params) + "Name of file to which R should send graphical output." + (and (member "graphics" (cdr (assq :result-params params))) + (cdr (assq :file params)))) + +(defvar org-babel-R-graphics-devices + '((:bmp "bmp" "filename") + (:jpg "jpeg" "filename") + (:jpeg "jpeg" "filename") + (:tikz "tikz" "file") + (:tiff "tiff" "filename") + (:png "png" "filename") + (:svg "svg" "file") + (:pdf "pdf" "file") + (:ps "postscript" "file") + (:postscript "postscript" "file")) + "An alist mapping graphics file types to R functions. + +Each member of this list is a list with three members: +1. the file extension of the graphics file, as an elisp :keyword +2. the R graphics device function to call to generate such a file +3. the name of the argument to this function which specifies the + file to write to (typically \"file\" or \"filename\")") + +(defun org-babel-R-construct-graphics-device-call (out-file params) + "Construct the call to the graphics device." + (let* ((allowed-args '(:width :height :bg :units :pointsize + :antialias :quality :compression :res + :type :family :title :fonts :version + :paper :encoding :pagecentre :colormodel + :useDingbats :horizontal)) + (device (and (string-match ".+\\.\\([^.]+\\)" out-file) + (match-string 1 out-file))) + (device-info (or (assq (intern (concat ":" device)) + org-babel-R-graphics-devices) + (assq :png org-babel-R-graphics-devices))) + (extra-args (cdr (assq :R-dev-args params))) filearg args) + (setq device (nth 1 device-info)) + (setq filearg (nth 2 device-info)) + (setq args (mapconcat + (lambda (pair) + (if (member (car pair) allowed-args) + (format ",%s=%S" + (substring (symbol-name (car pair)) 1) + (cdr pair)) "")) + params "")) + (format "%s(%s=\"%s\"%s%s%s)" + device filearg out-file args + (if extra-args "," "") (or extra-args "")))) + +(defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'") +(defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"") + +(defvar org-babel-R-write-object-command "{function(object,transfer.file){object;invisible(if(inherits(try({tfile<-tempfile();write.table(object,file=tfile,sep=\"\\t\",na=\"nil\",row.names=%s,col.names=%s,quote=FALSE);file.rename(tfile,transfer.file)},silent=TRUE),\"try-error\")){if(!file.exists(transfer.file))file.create(transfer.file)})}}(object=%s,transfer.file=\"%s\")") + +(defun org-babel-R-evaluate + (session body result-type result-params column-names-p row-names-p) + "Evaluate R code in BODY." + (if session + (org-babel-R-evaluate-session + session body result-type result-params column-names-p row-names-p) + (org-babel-R-evaluate-external-process + body result-type result-params column-names-p row-names-p))) + +(defun org-babel-R-evaluate-external-process + (body result-type result-params column-names-p row-names-p) + "Evaluate BODY in external R process. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (case result-type + (value + (let ((tmp-file (org-babel-temp-file "R-"))) + (org-babel-eval org-babel-R-command + (format org-babel-R-write-object-command + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE") + (format "{function ()\n{\n%s\n}}()" body) + (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-R-process-value-result + (org-babel-result-cond result-params + (with-temp-buffer + (insert-file-contents tmp-file) + (buffer-string)) + (org-babel-import-elisp-from-file tmp-file '(16))) + column-names-p))) + (output (org-babel-eval org-babel-R-command body)))) + +(defvar ess-eval-visibly-p) + +(defun org-babel-R-evaluate-session + (session body result-type result-params column-names-p row-names-p) + "Evaluate BODY in SESSION. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (case result-type + (value + (with-temp-buffer + (insert (org-babel-chomp body)) + (let ((ess-local-process-name + (process-name (get-buffer-process session))) + (ess-eval-visibly-p nil)) + (ess-eval-buffer nil))) + (let ((tmp-file (org-babel-temp-file "R-"))) + (org-babel-comint-eval-invisibly-and-wait-for-file + session tmp-file + (format org-babel-R-write-object-command + (if row-names-p "TRUE" "FALSE") + (if column-names-p + (if row-names-p "NA" "TRUE") + "FALSE") + ".Last.value" (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-R-process-value-result + (org-babel-result-cond result-params + (with-temp-buffer + (insert-file-contents tmp-file) + (buffer-string)) + (org-babel-import-elisp-from-file tmp-file '(16))) + column-names-p))) + (output + (mapconcat + #'org-babel-chomp + (butlast + (delq nil + (mapcar + (lambda (line) (when (> (length line) 0) line)) + (mapcar + (lambda (line) ;; cleanup extra prompts left in output + (if (string-match + "^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line) + (substring line (match-end 1)) + line)) + (org-babel-comint-with-output (session org-babel-R-eoe-output) + (insert (mapconcat #'org-babel-chomp + (list body org-babel-R-eoe-indicator) + "\n")) + (inferior-ess-send-input)))))) "\n")))) + +(defun org-babel-R-process-value-result (result column-names-p) + "R-specific processing of return value. +Insert hline if column names in output have been requested." + (if column-names-p + (cons (car result) (cons 'hline (cdr result))) + result)) + +(provide 'ob-R) + + + +;;; ob-R.el ends here diff --git a/elpa/org-20150427/ob-asymptote.el b/elpa/org-20150427/ob-asymptote.el new file mode 100644 index 00000000..21c0a170 --- /dev/null +++ b/elpa/org-20150427/ob-asymptote.el @@ -0,0 +1,150 @@ +;;; ob-asymptote.el --- org-babel functions for asymptote evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating asymptote source code. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in asymptote +;; +;; 2) we are generally only going to return results of type "file" +;; +;; 3) we are adding the "file" and "cmdline" header arguments, if file +;; is omitted then the -V option is passed to the asy command for +;; interactive viewing + +;;; Requirements: + +;; - The asymptote program :: http://asymptote.sourceforge.net/ +;; +;; - asy-mode :: Major mode for editing asymptote files + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function org-combine-plists "org" (&rest plists)) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy")) + +(defvar org-babel-default-header-args:asymptote + '((:results . "file") (:exports . "results")) + "Default arguments when evaluating an Asymptote source block.") + +(defun org-babel-execute:asymptote (body params) + "Execute a block of Asymptote code. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (cdr (assoc :file params))) + (format (or (and out-file + (string-match ".+\\.\\(.+\\)" out-file) + (match-string 1 out-file)) + "pdf")) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "asymptote-")) + (cmd + (concat "asy " + (if out-file + (concat + "-globalwrite -f " format + " -o " (org-babel-process-file-name out-file)) + "-V") + " " cmdline + " " (org-babel-process-file-name in-file)))) + (with-temp-file in-file + (insert (org-babel-expand-body:generic + body params + (org-babel-variable-assignments:asymptote params)))) + (message cmd) (shell-command cmd) + nil)) ;; signal that output has already been written to file + +(defun org-babel-prep-session:asymptote (session params) + "Return an error if the :session header argument is set. +Asymptote does not support sessions" + (error "Asymptote does not support sessions")) + +(defun org-babel-variable-assignments:asymptote (params) + "Return list of asymptote statements assigning the block's variables." + (mapcar #'org-babel-asymptote-var-to-asymptote + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-asymptote-var-to-asymptote (pair) + "Convert an elisp value into an Asymptote variable. +The elisp value PAIR is converted into Asymptote code specifying +a variable of the same value." + (let ((var (car pair)) + (val (let ((v (cdr pair))) + (if (symbolp v) (symbol-name v) v)))) + (cond + ((integerp val) + (format "int %S=%S;" var val)) + ((floatp val) + (format "real %S=%S;" var val)) + ((stringp val) + (format "string %S=\"%s\";" var val)) + ((and (listp val) (not (listp (car val)))) + (let* ((type (org-babel-asymptote-define-type val)) + (fmt (if (eq 'string type) "\"%s\"" "%s")) + (vect (mapconcat (lambda (e) (format fmt e)) val ", "))) + (format "%s[] %S={%s};" type var vect))) + ((listp val) + (let* ((type (org-babel-asymptote-define-type val)) + (fmt (if (eq 'string type) "\"%s\"" "%s")) + (array (mapconcat (lambda (row) + (concat "{" + (mapconcat (lambda (e) (format fmt e)) + row ", ") + "}")) + val ","))) + (format "%S[][] %S={%s};" type var array)))))) + +(defun org-babel-asymptote-define-type (data) + "Determine type of DATA. + +DATA is a list. Return type as a symbol. + +The type is `string' if any element in DATA is +a string. Otherwise, it is either `real', if some elements are +floats, or `int'." + (let* ((type 'int) + find-type ; for byte-compiler + (find-type + (function + (lambda (row) + (catch 'exit + (mapc (lambda (el) + (cond ((listp el) (funcall find-type el)) + ((stringp el) (throw 'exit (setq type 'string))) + ((floatp el) (setq type 'real)))) + row)))))) + (funcall find-type data) type)) + +(provide 'ob-asymptote) + + + +;;; ob-asymptote.el ends here diff --git a/elpa/org-20150427/ob-awk.el b/elpa/org-20150427/ob-awk.el new file mode 100644 index 00000000..ed98afdf --- /dev/null +++ b/elpa/org-20150427/ob-awk.el @@ -0,0 +1,113 @@ +;;; ob-awk.el --- org-babel functions for awk evaluation + +;; Copyright (C) 2011-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Babel's awk can use special header argument: +;; +;; - :in-file takes a path to a file of data to be processed by awk +;; +;; - :stdin takes an Org-mode data or code block reference, the value +;; of which will be passed to the awk process through STDIN + +;;; Code: +(require 'ob) +(require 'org-compat) +(eval-when-compile (require 'cl)) + +(declare-function org-babel-ref-resolve "ob-ref" (ref)) +(declare-function orgtbl-to-generic "org-table" (table params)) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("awk" . "awk")) + +(defvar org-babel-awk-command "awk" + "Name of the awk executable command.") + +(defun org-babel-expand-body:awk (body params) + "Expand BODY according to PARAMS, return the expanded body." + (dolist (pair (mapcar #'cdr (org-babel-get-header params :var))) + (setf body (replace-regexp-in-string + (regexp-quote (format "$%s" (car pair))) (cdr pair) body))) + body) + +(defun org-babel-execute:awk (body params) + "Execute a block of Awk code with org-babel. This function is +called by `org-babel-execute-src-block'" + (message "executing Awk source code block") + (let* ((result-params (cdr (assoc :result-params params))) + (cmd-line (cdr (assoc :cmd-line params))) + (in-file (cdr (assoc :in-file params))) + (full-body (org-babel-expand-body:awk body params)) + (code-file (let ((file (org-babel-temp-file "awk-"))) + (with-temp-file file (insert full-body)) file)) + (stdin (let ((stdin (cdr (assoc :stdin params)))) + (when stdin + (let ((tmp (org-babel-temp-file "awk-stdin-")) + (res (org-babel-ref-resolve stdin))) + (with-temp-file tmp + (insert (org-babel-awk-var-to-awk res))) + tmp)))) + (cmd (mapconcat #'identity (remove nil (list org-babel-awk-command + "-f" code-file + cmd-line + in-file)) + " "))) + (org-babel-reassemble-table + (let ((results + (cond + (stdin (with-temp-buffer + (call-process-shell-command cmd stdin (current-buffer)) + (buffer-string))) + (t (org-babel-eval cmd ""))))) + (when results + (org-babel-result-cond result-params + results + (let ((tmp (org-babel-temp-file "awk-results-"))) + (with-temp-file tmp (insert results)) + (org-babel-import-elisp-from-file tmp))))) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + +(defun org-babel-awk-var-to-awk (var &optional sep) + "Return a printed value of VAR suitable for parsing with awk." + (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v))))) + (cond + ((and (listp var) (listp (car var))) + (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var))) + ((listp var) + (mapconcat echo-var var "\n")) + (t (funcall echo-var var))))) + +(defun org-babel-awk-table-or-string (results) + "If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape results)) + +(provide 'ob-awk) + + + +;;; ob-awk.el ends here diff --git a/elpa/org-20150427/ob-calc.el b/elpa/org-20150427/ob-calc.el new file mode 100644 index 00000000..cdb528a5 --- /dev/null +++ b/elpa/org-20150427/ob-calc.el @@ -0,0 +1,108 @@ +;;; ob-calc.el --- org-babel functions for calc code evaluation + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating calc code + +;;; Code: +(require 'ob) +(require 'calc) +(unless (featurep 'xemacs) + (require 'calc-trail) + (require 'calc-store)) + +(declare-function calc-store-into "calc-store" (&optional var)) +(declare-function calc-recall "calc-store" (&optional var)) +(declare-function math-evaluate-expr "calc-ext" (x)) + +(defvar org-babel-default-header-args:calc nil + "Default arguments for evaluating an calc source block.") + +(defun org-babel-expand-body:calc (body params) + "Expand BODY according to PARAMS, return the expanded body." body) + +(defvar org--var-syms) ; Dynamically scoped from org-babel-execute:calc + +(defun org-babel-execute:calc (body params) + "Execute a block of calc code with Babel." + (unless (get-buffer "*Calculator*") + (save-window-excursion (calc) (calc-quit))) + (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (org--var-syms (mapcar #'car vars)) + (var-names (mapcar #'symbol-name org--var-syms))) + (mapc + (lambda (pair) + (calc-push-list (list (cdr pair))) + (calc-store-into (car pair))) + vars) + (mapc + (lambda (line) + (when (> (length line) 0) + (cond + ;; simple variable name + ((member line var-names) (calc-recall (intern line))) + ;; stack operation + ((string= "'" (substring line 0 1)) + (funcall (lookup-key calc-mode-map (substring line 1)) nil)) + ;; complex expression + (t + (calc-push-list + (list (let ((res (calc-eval line))) + (cond + ((numberp res) res) + ((math-read-number res) (math-read-number res)) + ((listp res) (error "Calc error \"%s\" on input \"%s\"" + (cadr res) line)) + (t (replace-regexp-in-string + "'" "" + (calc-eval + (math-evaluate-expr + ;; resolve user variables, calc built in + ;; variables are handled automatically + ;; upstream by calc + (mapcar #'org-babel-calc-maybe-resolve-var + ;; parse line into calc objects + (car (math-read-exprs line))))))))) + )))))) + (mapcar #'org-babel-trim + (split-string (org-babel-expand-body:calc body params) "[\n\r]")))) + (save-excursion + (with-current-buffer (get-buffer "*Calculator*") + (calc-eval (calc-top 1))))) + +(defun org-babel-calc-maybe-resolve-var (el) + (if (consp el) + (if (and (equal 'var (car el)) (member (cadr el) org--var-syms)) + (progn + (calc-recall (cadr el)) + (prog1 (calc-top 1) + (calc-pop 1))) + (mapcar #'org-babel-calc-maybe-resolve-var el)) + el)) + +(provide 'ob-calc) + + + +;;; ob-calc.el ends here diff --git a/elpa/org-20150427/ob-clojure.el b/elpa/org-20150427/ob-clojure.el new file mode 100644 index 00000000..78f3c6d3 --- /dev/null +++ b/elpa/org-20150427/ob-clojure.el @@ -0,0 +1,95 @@ +;;; ob-clojure.el --- org-babel functions for clojure evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Joel Boehland +;; Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Support for evaluating clojure code, relies on slime for all eval. + +;;; Requirements: + +;; - clojure (at least 1.2.0) +;; - clojure-mode +;; - slime + +;; By far, the best way to install these components is by following +;; the directions as set out by Phil Hagelberg (Technomancy) on the +;; web page: http://technomancy.us/126 + +;;; Code: +(require 'ob) + +(declare-function slime-eval "ext:slime" (sexp &optional package)) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) + +(defvar org-babel-default-header-args:clojure '()) +(defvar org-babel-header-args:clojure '((package . :any))) + +(defun org-babel-expand-body:clojure (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (result-params (cdr (assoc :result-params params))) + (print-level nil) (print-length nil) + (body (org-babel-trim + (if (> (length vars) 0) + (concat "(let [" + (mapconcat + (lambda (var) + (format "%S (quote %S)" (car var) (cdr var))) + vars "\n ") + "]\n" body ")") + body)))) + (cond ((or (member "code" result-params) (member "pp" result-params)) + (format (concat "(let [org-mode-print-catcher (java.io.StringWriter.)] " + "(clojure.pprint/with-pprint-dispatch clojure.pprint/%s-dispatch " + "(clojure.pprint/pprint (do %s) org-mode-print-catcher) " + "(str org-mode-print-catcher)))") + (if (member "code" result-params) "code" "simple") body)) + ;; if (:results output), collect printed output + ((member "output" result-params) + (format "(clojure.core/with-out-str %s)" body)) + (t body)))) + +(defun org-babel-execute:clojure (body params) + "Execute a block of Clojure code with Babel." + (require 'slime) + (with-temp-buffer + (insert (org-babel-expand-body:clojure body params)) + (let ((result + (slime-eval + `(swank:eval-and-grab-output + ,(buffer-substring-no-properties (point-min) (point-max))) + (cdr (assoc :package params))))) + (let ((result-params (cdr (assoc :result-params params)))) + (org-babel-result-cond result-params + result + (condition-case nil (org-babel-script-escape result) + (error result))))))) + +(provide 'ob-clojure) + + + +;;; ob-clojure.el ends here diff --git a/elpa/org-20150427/ob-comint.el b/elpa/org-20150427/ob-comint.el new file mode 100644 index 00000000..40bfaf7c --- /dev/null +++ b/elpa/org-20150427/ob-comint.el @@ -0,0 +1,166 @@ +;;; ob-comint.el --- org-babel functions for interaction with comint buffers + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, comint +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; These functions build on comint to ease the sending and receiving +;; of commands and results from comint buffers. + +;; Note that the buffers in this file are analogous to sessions in +;; org-babel at large. + +;;; Code: +(require 'ob-core) +(require 'org-compat) +(require 'comint) +(eval-when-compile (require 'cl)) +(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) +(declare-function tramp-flush-directory-property "tramp" (vec directory)) + +(defun org-babel-comint-buffer-livep (buffer) + "Check if BUFFER is a comint buffer with a live process." + (let ((buffer (if buffer (get-buffer buffer)))) + (and buffer (buffer-live-p buffer) (get-buffer-process buffer) buffer))) + +(defmacro org-babel-comint-in-buffer (buffer &rest body) + "Check BUFFER and execute BODY. +BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is +executed inside the protection of `save-excursion' and +`save-match-data'." + (declare (indent 1)) + `(save-excursion + (save-match-data + (unless (org-babel-comint-buffer-livep ,buffer) + (error "Buffer %s does not exist or has no process" ,buffer)) + (set-buffer ,buffer) + ,@body))) +(def-edebug-spec org-babel-comint-in-buffer (form body)) + +(defmacro org-babel-comint-with-output (meta &rest body) + "Evaluate BODY in BUFFER and return process output. +Will wait until EOE-INDICATOR appears in the output, then return +all process output. If REMOVE-ECHO and FULL-BODY are present and +non-nil, then strip echo'd body from the returned output. META +should be a list containing the following where the last two +elements are optional. + + (BUFFER EOE-INDICATOR REMOVE-ECHO FULL-BODY) + +This macro ensures that the filter is removed in case of an error +or user `keyboard-quit' during execution of body." + (declare (indent 1)) + (let ((buffer (car meta)) + (eoe-indicator (cadr meta)) + (remove-echo (cadr (cdr meta))) + (full-body (cadr (cdr (cdr meta))))) + `(org-babel-comint-in-buffer ,buffer + (let ((string-buffer "") dangling-text raw) + ;; setup filter + (setq comint-output-filter-functions + (cons (lambda (text) (setq string-buffer (concat string-buffer text))) + comint-output-filter-functions)) + (unwind-protect + (progn + ;; got located, and save dangling text + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (let ((start (point)) + (end (point-max))) + (setq dangling-text (buffer-substring start end)) + (delete-region start end)) + ;; pass FULL-BODY to process + ,@body + ;; wait for end-of-evaluation indicator + (while (progn + (goto-char comint-last-input-end) + (not (save-excursion + (and (re-search-forward + (regexp-quote ,eoe-indicator) nil t) + (re-search-forward + comint-prompt-regexp nil t))))) + (accept-process-output (get-buffer-process (current-buffer))) + ;; thought the following this would allow async + ;; background running, but I was wrong... + ;; (run-with-timer .5 .5 'accept-process-output + ;; (get-buffer-process (current-buffer))) + ) + ;; replace cut dangling text + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert dangling-text)) + ;; remove filter + (setq comint-output-filter-functions + (cdr comint-output-filter-functions))) + ;; remove echo'd FULL-BODY from input + (if (and ,remove-echo ,full-body + (string-match + (replace-regexp-in-string + "\n" "[\r\n]+" (regexp-quote (or ,full-body ""))) + string-buffer)) + (setq raw (substring string-buffer (match-end 0)))) + (split-string string-buffer comint-prompt-regexp))))) +(def-edebug-spec org-babel-comint-with-output (sexp body)) + +(defun org-babel-comint-input-command (buffer cmd) + "Pass CMD to BUFFER. +The input will not be echoed." + (org-babel-comint-in-buffer buffer + (goto-char (process-mark (get-buffer-process buffer))) + (insert cmd) + (comint-send-input) + (org-babel-comint-wait-for-output buffer))) + +(defun org-babel-comint-wait-for-output (buffer) + "Wait until output arrives from BUFFER. +Note: this is only safe when waiting for the result of a single +statement (not large blocks of code)." + (org-babel-comint-in-buffer buffer + (while (progn + (goto-char comint-last-input-end) + (not (and (re-search-forward comint-prompt-regexp nil t) + (goto-char (match-beginning 0)) + (string= (face-name (face-at-point)) + "comint-highlight-prompt")))) + (accept-process-output (get-buffer-process buffer))))) + +(defun org-babel-comint-eval-invisibly-and-wait-for-file + (buffer file string &optional period) + "Evaluate STRING in BUFFER invisibly. +Don't return until FILE exists. Code in STRING must ensure that +FILE exists at end of evaluation." + (unless (org-babel-comint-buffer-livep buffer) + (error "Buffer %s does not exist or has no process" buffer)) + (if (file-exists-p file) (delete-file file)) + (process-send-string + (get-buffer-process buffer) + (if (string-match "\n$" string) string (concat string "\n"))) + ;; From Tramp 2.1.19 the following cache flush is not necessary + (if (file-remote-p default-directory) + (let (v) + (with-parsed-tramp-file-name default-directory nil + (tramp-flush-directory-property v "")))) + (while (not (file-exists-p file)) (sit-for (or period 0.25)))) + +(provide 'ob-comint) + + + +;;; ob-comint.el ends here diff --git a/elpa/org-20150427/ob-core.el b/elpa/org-20150427/ob-core.el new file mode 100644 index 00000000..a6ffcc48 --- /dev/null +++ b/elpa/org-20150427/ob-core.el @@ -0,0 +1,2778 @@ +;;; ob-core.el --- working with code blocks in org-mode + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Authors: Eric Schulte +;; Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Code: +(eval-when-compile + (require 'cl)) +(require 'ob-eval) +(require 'org-macs) +(require 'org-compat) + +(defconst org-babel-exeext + (if (memq system-type '(windows-nt cygwin)) + ".exe" + nil)) +;; dynamically scoped for tramp +(defvar org-babel-call-process-region-original nil) +(defvar org-src-lang-modes) +(defvar org-babel-library-of-babel) +(declare-function show-all "outline" ()) +(declare-function org-every "org" (pred seq)) +(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS)) +(declare-function org-mark-ring-push "org" (&optional pos buffer)) +(declare-function tramp-compat-make-temp-file "tramp-compat" + (filename &optional dir-flag)) +(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) +(declare-function tramp-file-name-user "tramp" (vec)) +(declare-function tramp-file-name-host "tramp" (vec)) +(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) +(declare-function org-icompleting-read "org" (&rest args)) +(declare-function org-edit-src-code "org-src" + (&optional context code edit-buffer-name quietp)) +(declare-function org-edit-src-exit "org-src" (&optional context)) +(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) +(declare-function org-save-outline-visibility "org-macs" (use-markers &rest body)) +(declare-function org-outline-overlay-data "org" (&optional use-markers)) +(declare-function org-set-outline-overlay-data "org" (data)) +(declare-function org-narrow-to-subtree "org" ()) +(declare-function org-split-string "org" (string &optional separators)) +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) +(declare-function org-make-options-regexp "org" (kwds &optional extra)) +(declare-function org-do-remove-indentation "org" (&optional n)) +(declare-function org-next-block "org" (arg &optional backward block-regexp)) +(declare-function org-previous-block "org" (arg &optional block-regexp)) +(declare-function org-show-context "org" (&optional key)) +(declare-function org-at-table-p "org" (&optional table-type)) +(declare-function org-cycle "org" (&optional arg)) +(declare-function org-uniquify "org" (list)) +(declare-function org-current-level "org" ()) +(declare-function org-table-import "org-table" (file arg)) +(declare-function org-add-hook "org-compat" + (hook function &optional append local)) +(declare-function org-table-align "org-table" ()) +(declare-function org-table-end "org-table" (&optional table-type)) +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function orgtbl-to-orgtbl "org-table" (table params)) +(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info)) +(declare-function org-babel-lob-get-info "ob-lob" nil) +(declare-function org-babel-ref-split-args "ob-ref" (arg-string)) +(declare-function org-babel-ref-parse "ob-ref" (assignment)) +(declare-function org-babel-ref-resolve "ob-ref" (ref)) +(declare-function org-babel-ref-goto-headline-id "ob-ref" (id)) +(declare-function org-babel-ref-headline-body "ob-ref" ()) +(declare-function org-babel-lob-execute-maybe "ob-lob" ()) +(declare-function org-number-sequence "org-compat" (from &optional to inc)) +(declare-function org-at-item-p "org-list" ()) +(declare-function org-list-parse-list "org-list" (&optional delete)) +(declare-function org-list-to-generic "org-list" (LIST PARAMS)) +(declare-function org-list-struct "org-list" ()) +(declare-function org-list-prevs-alist "org-list" (struct)) +(declare-function org-list-get-list-end "org-list" (item struct prevs)) +(declare-function org-remove-if "org" (predicate seq)) +(declare-function org-completing-read "org" (&rest args)) +(declare-function org-escape-code-in-region "org-src" (beg end)) +(declare-function org-unescape-code-in-string "org-src" (s)) +(declare-function org-table-to-lisp "org-table" (&optional txt)) +(declare-function org-reverse-string "org" (string)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-type "org-element" (element)) + +(defgroup org-babel nil + "Code block evaluation and management in `org-mode' documents." + :tag "Babel" + :group 'org) + +(defcustom org-confirm-babel-evaluate t + "Confirm before evaluation. +Require confirmation before interactively evaluating code +blocks in Org-mode buffers. The default value of this variable +is t, meaning confirmation is required for any code block +evaluation. This variable can be set to nil to inhibit any +future confirmation requests. This variable can also be set to a +function which takes two arguments the language of the code block +and the body of the code block. Such a function should then +return a non-nil value if the user should be prompted for +execution or nil if no prompt is required. + +Warning: Disabling confirmation may result in accidental +evaluation of potentially harmful code. It may be advisable +remove code block execution from C-c C-c as further protection +against accidental code block evaluation. The +`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to +remove code block execution from the C-c C-c keybinding." + :group 'org-babel + :version "24.1" + :type '(choice boolean function)) +;; don't allow this variable to be changed through file settings +(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t))) + +(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil + "Remove code block evaluation from the C-c C-c key binding." + :group 'org-babel + :version "24.1" + :type 'boolean) + +(defcustom org-babel-results-keyword "RESULTS" + "Keyword used to name results generated by code blocks. +Should be either RESULTS or NAME however any capitalization may +be used." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-babel-noweb-wrap-start "<<" + "String used to begin a noweb reference in a code block. +See also `org-babel-noweb-wrap-end'." + :group 'org-babel + :type 'string) + +(defcustom org-babel-noweb-wrap-end ">>" + "String used to end a noweb reference in a code block. +See also `org-babel-noweb-wrap-start'." + :group 'org-babel + :type 'string) + +(defcustom org-babel-inline-result-wrap "=%s=" + "Format string used to wrap inline results. +This string must include a \"%s\" which will be replaced by the results." + :group 'org-babel + :type 'string) + +(defun org-babel-noweb-wrap (&optional regexp) + (concat org-babel-noweb-wrap-start + (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)") + org-babel-noweb-wrap-end)) + +(defvar org-babel-src-name-regexp + "^[ \t]*#\\+name:[ \t]*" + "Regular expression used to match a source name line.") + +(defvar org-babel-multi-line-header-regexp + "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$" + "Regular expression used to match multi-line header arguments.") + +(defvar org-babel-src-name-w-name-regexp + (concat org-babel-src-name-regexp + "\\(" + org-babel-multi-line-header-regexp + "\\)*" + "\\([^ ()\f\t\n\r\v]+\\)") + "Regular expression matching source name lines with a name.") + +(defvar org-babel-src-block-regexp + (concat + ;; (1) indentation (2) lang + "^\\([ \t]*\\)#\\+begin_src[ \t]+\\([^ \f\t\n\r\v]+\\)[ \t]*" + ;; (3) switches + "\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)" + ;; (4) header arguments + "\\([^\n]*\\)\n" + ;; (5) body + "\\([^\000]*?\n\\)??[ \t]*#\\+end_src") + "Regexp used to identify code blocks.") + +(defvar org-babel-inline-src-block-regexp + (concat + ;; (1) replacement target (2) lang + "\\(?:^\\|[^-[:alnum:]]\\)\\(src_\\([^ \f\t\n\r\v]+\\)" + ;; (3,4) (unused, headers) + "\\(\\|\\[\\(.*?\\)\\]\\)" + ;; (5) body + "{\\([^\f\n\r\v]+?\\)}\\)") + "Regexp used to identify inline src-blocks.") + +(defun org-babel-get-header (params key &optional others) + "Select only header argument of type KEY from a list. +Optional argument OTHERS indicates that only the header that do +not match KEY should be returned." + (delq nil + (mapcar + (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p)) + params))) + +(defun org-babel-get-inline-src-block-matches() + "Set match data if within body of an inline source block. +Returns non-nil if match-data set" + (let ((src-at-0-p (save-excursion + (beginning-of-line 1) + (string= "src" (thing-at-point 'word)))) + (first-line-p (= (line-beginning-position) (point-min))) + (orig (point))) + (let ((search-for (cond ((and src-at-0-p first-line-p "src_")) + (first-line-p "[[:punct:] \t]src_") + (t "[[:punct:] \f\t\n\r\v]src_"))) + (lower-limit (if first-line-p + nil + (- (point-at-bol) 1)))) + (save-excursion + (when (or (and src-at-0-p (bobp)) + (and (re-search-forward "}" (point-at-eol) t) + (re-search-backward search-for lower-limit t) + (> orig (point)))) + (when (looking-at org-babel-inline-src-block-regexp) + t )))))) + +(defvar org-babel-inline-lob-one-liner-regexp) +(defun org-babel-get-lob-one-liner-matches() + "Set match data if on line of an lob one liner. +Returns non-nil if match-data set" + (save-excursion + (unless (= (point) (point-at-bol)) ;; move before inline block + (re-search-backward "[ \f\t\n\r\v]" nil t)) + (if (looking-at org-babel-inline-lob-one-liner-regexp) + t + nil))) + +(defun org-babel-get-src-block-info (&optional light) + "Get information on the current source block. + +Optional argument LIGHT does not resolve remote variable +references; a process which could likely result in the execution +of other code blocks. + +Returns a list + (language body header-arguments-alist switches name indent block-head)." + (let ((case-fold-search t) head info name indent) + ;; full code block + (if (setq head (org-babel-where-is-src-block-head)) + (save-excursion + (goto-char head) + (setq info (org-babel-parse-src-block-match)) + (setq indent (car (last info))) + (setq info (butlast info)) + (while (and (forward-line -1) + (looking-at org-babel-multi-line-header-regexp)) + (setf (nth 2 info) + (org-babel-merge-params + (nth 2 info) + (org-babel-parse-header-arguments (match-string 1))))) + (when (looking-at org-babel-src-name-w-name-regexp) + (setq name (org-no-properties (match-string 3))))) + ;; inline source block + (when (org-babel-get-inline-src-block-matches) + (setq info (org-babel-parse-inline-src-block-match)))) + ;; resolve variable references and add summary parameters + (when (and info (not light)) + (setf (nth 2 info) (org-babel-process-params (nth 2 info)))) + (when info (append info (list name indent head))))) + +(defvar org-current-export-file) ; dynamically bound +(defmacro org-babel-check-confirm-evaluate (info &rest body) + "Evaluate BODY with special execution confirmation variables set. + +Specifically; NOEVAL will indicate if evaluation is allowed, +QUERY will indicate if a user query is required, CODE-BLOCK will +hold the language of the code block, and BLOCK-NAME will hold the +name of the code block." + (declare (indent defun)) + (org-with-gensyms + (lang block-body headers name eval eval-no export eval-no-export) + `(let* ((,lang (nth 0 ,info)) + (,block-body (nth 1 ,info)) + (,headers (nth 2 ,info)) + (,name (nth 4 ,info)) + (,eval (or (cdr (assoc :eval ,headers)) + (when (assoc :noeval ,headers) "no"))) + (,eval-no (or (equal ,eval "no") + (equal ,eval "never"))) + (,export (org-bound-and-true-p org-current-export-file)) + (,eval-no-export (and ,export (or (equal ,eval "no-export") + (equal ,eval "never-export")))) + (noeval (or ,eval-no ,eval-no-export)) + (query (or (equal ,eval "query") + (and ,export (equal ,eval "query-export")) + (if (functionp org-confirm-babel-evaluate) + (funcall org-confirm-babel-evaluate + ,lang ,block-body) + org-confirm-babel-evaluate))) + (code-block (if ,info (format " %s " ,lang) " ")) + (block-name (if ,name (format " (%s) " ,name) " "))) + ,@body))) + +(defsubst org-babel-check-evaluate (info) + "Check if code block INFO should be evaluated. +Do not query the user." + (org-babel-check-confirm-evaluate info + (not (when noeval + (message (format "Evaluation of this%scode-block%sis disabled." + code-block block-name)))))) + + ;; dynamically scoped for asynchronous export +(defvar org-babel-confirm-evaluate-answer-no) + +(defsubst org-babel-confirm-evaluate (info) + "Confirm evaluation of the code block INFO. + +If the variable `org-babel-confirm-evaluate-answer-no' is bound +to a non-nil value, auto-answer with \"no\". + +This query can also be suppressed by setting the value of +`org-confirm-babel-evaluate' to nil, in which case all future +interactive code block evaluations will proceed without any +confirmation from the user. + +Note disabling confirmation may result in accidental evaluation +of potentially harmful code." + (org-babel-check-confirm-evaluate info + (not (when query + (unless + (and (not (org-bound-and-true-p + org-babel-confirm-evaluate-answer-no)) + (yes-or-no-p + (format "Evaluate this%scode block%son your system? " + code-block block-name))) + (message (format "Evaluation of this%scode-block%sis aborted." + code-block block-name))))))) + +;;;###autoload +(defun org-babel-execute-safely-maybe () + (unless org-babel-no-eval-on-ctrl-c-ctrl-c + (org-babel-execute-maybe))) + +(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-safely-maybe) + +;;;###autoload +(defun org-babel-execute-maybe () + (interactive) + (or (org-babel-execute-src-block-maybe) + (org-babel-lob-execute-maybe))) + +(defmacro org-babel-when-in-src-block (&rest body) + "Execute BODY if point is in a source block and return t. + +Otherwise do nothing and return nil." + `(if (or (org-babel-where-is-src-block-head) + (org-babel-get-inline-src-block-matches)) + (progn + ,@body + t) + nil)) + +(defun org-babel-execute-src-block-maybe () + "Conditionally execute a source block. +Detect if this is context for a Babel src-block and if so +then run `org-babel-execute-src-block'." + (interactive) + (org-babel-when-in-src-block + (org-babel-eval-wipe-error-buffer) + (org-babel-execute-src-block current-prefix-arg))) + +;;;###autoload +(defun org-babel-view-src-block-info () + "Display information on the current source block. +This includes header arguments, language and name, and is largely +a window into the `org-babel-get-src-block-info' function." + (interactive) + (let ((info (org-babel-get-src-block-info 'light)) + (full (lambda (it) (> (length it) 0))) + (printf (lambda (fmt &rest args) (princ (apply #'format fmt args))))) + (when info + (with-help-window (help-buffer) + (let ((name (nth 4 info)) + (lang (nth 0 info)) + (switches (nth 3 info)) + (header-args (nth 2 info))) + (when name (funcall printf "Name: %s\n" name)) + (when lang (funcall printf "Lang: %s\n" lang)) + (when (funcall full switches) (funcall printf "Switches: %s\n" switches)) + (funcall printf "Header Arguments:\n") + (dolist (pair (sort header-args + (lambda (a b) (string< (symbol-name (car a)) + (symbol-name (car b)))))) + (when (funcall full (cdr pair)) + (funcall printf "\t%S%s\t%s\n" + (car pair) + (if (> (length (format "%S" (car pair))) 7) "" "\t") + (cdr pair))))))))) + +;;;###autoload +(defun org-babel-expand-src-block-maybe () + "Conditionally expand a source block. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-expand-src-block'." + (interactive) + (org-babel-when-in-src-block + (org-babel-expand-src-block current-prefix-arg))) + +;;;###autoload +(defun org-babel-load-in-session-maybe () + "Conditionally load a source block in a session. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-load-in-session'." + (interactive) + (org-babel-when-in-src-block + (org-babel-load-in-session current-prefix-arg))) + +(add-hook 'org-metaup-hook 'org-babel-load-in-session-maybe) + +;;;###autoload +(defun org-babel-pop-to-session-maybe () + "Conditionally pop to a session. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-switch-to-session'." + (interactive) + (org-babel-when-in-src-block + (org-babel-switch-to-session current-prefix-arg))) + +(add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe) + +(defconst org-babel-common-header-args-w-values + '((cache . ((no yes))) + (cmdline . :any) + (colnames . ((nil no yes))) + (comments . ((no link yes org both noweb))) + (dir . :any) + (eval . ((never query))) + (exports . ((code results both none))) + (epilogue . :any) + (file . :any) + (file-desc . :any) + (hlines . ((no yes))) + (mkdirp . ((yes no))) + (no-expand) + (noeval) + (noweb . ((yes no tangle no-export strip-export))) + (noweb-ref . :any) + (noweb-sep . :any) + (padline . ((yes no))) + (post . :any) + (prologue . :any) + (results . ((file list vector table scalar verbatim) + (raw html latex org code pp drawer) + (replace silent none append prepend) + (output value))) + (rownames . ((no yes))) + (sep . :any) + (session . :any) + (shebang . :any) + (tangle . ((tangle yes no :any))) + (tangle-mode . ((#o755 #o555 #o444 :any))) + (var . :any) + (wrap . :any))) + +(defconst org-babel-header-arg-names + (mapcar #'car org-babel-common-header-args-w-values) + "Common header arguments used by org-babel. +Note that individual languages may define their own language +specific header arguments as well.") + +(defvar org-babel-default-header-args + '((:session . "none") (:results . "replace") (:exports . "code") + (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")) + "Default arguments to use when evaluating a source block.") + +(defvar org-babel-default-inline-header-args + '((:session . "none") (:results . "replace") (:exports . "results")) + "Default arguments to use when evaluating an inline source block.") + +(defvar org-babel-data-names '("tblname" "results" "name")) + +(defvar org-babel-result-regexp + (concat "^[ \t]*#\\+" + (regexp-opt org-babel-data-names t) + "\\(\\[\\(" + ;; FIXME The string below is `org-ts-regexp' + "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>" + " \\)?\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*") + "Regular expression used to match result lines. +If the results are associated with a hash key then the hash will +be saved in the second match data.") + +(defvar org-babel-result-w-name-regexp + (concat org-babel-result-regexp + "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")) + +(defvar org-babel-min-lines-for-block-output 10 + "The minimum number of lines for block output. +If number of lines of output is equal to or exceeds this +value, the output is placed in a #+begin_example...#+end_example +block. Otherwise the output is marked as literal by inserting +colons at the starts of the lines. This variable only takes +effect if the :results output option is in effect.") + +(defvar org-babel-noweb-error-langs nil + "Languages for which Babel will raise literate programming errors. +List of languages for which errors should be raised when the +source code block satisfying a noweb reference in this language +can not be resolved.") + +(defvar org-babel-hash-show 4 + "Number of initial characters to show of a hidden results hash.") + +(defvar org-babel-hash-show-time nil + "Non-nil means show the time the code block was evaluated in the result hash.") + +(defvar org-babel-after-execute-hook nil + "Hook for functions to be called after `org-babel-execute-src-block'") + +(defun org-babel-named-src-block-regexp-for-name (name) + "This generates a regexp used to match a src block named NAME." + (concat org-babel-src-name-regexp (regexp-quote name) + "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*" + (substring org-babel-src-block-regexp 1))) + +(defun org-babel-named-data-regexp-for-name (name) + "This generates a regexp used to match data named NAME." + (concat org-babel-result-regexp (regexp-quote name) "\\([ \t]\\|$\\)")) + +;;; functions +(defvar call-process-region) +(defvar org-babel-current-src-block-location nil + "Marker pointing to the src block currently being executed. +This may also point to a call line or an inline code block. If +multiple blocks are being executed (e.g., in chained execution +through use of the :var header argument) this marker points to +the outer-most code block.") + +;;;###autoload +(defun org-babel-execute-src-block (&optional arg info params) + "Execute the current source code block. +Insert the results of execution into the buffer. Source code +execution and the collection and formatting of results can be +controlled through a variety of header arguments. + +With prefix argument ARG, force re-execution even if an existing +result cached in the buffer would otherwise have been returned. + +Optionally supply a value for INFO in the form returned by +`org-babel-get-src-block-info'. + +Optionally supply a value for PARAMS which will be merged with +the header arguments specified at the front of the source code +block." + (interactive) + (let* ((org-babel-current-src-block-location + (or org-babel-current-src-block-location + (nth 6 info) + (org-babel-where-is-src-block-head))) + (info (if info + (copy-tree info) + (org-babel-get-src-block-info))) + (merged-params (org-babel-merge-params (nth 2 info) params))) + (when (org-babel-check-evaluate + (let ((i info)) (setf (nth 2 i) merged-params) i)) + (let* ((params (if params + (org-babel-process-params merged-params) + (nth 2 info))) + (cachep (and (not arg) (cdr (assoc :cache params)) + (string= "yes" (cdr (assoc :cache params))))) + (new-hash (when cachep (org-babel-sha1-hash info))) + (old-hash (when cachep (org-babel-current-result-hash))) + (cache-current-p (and (not arg) new-hash + (equal new-hash old-hash)))) + (cond + (cache-current-p + (save-excursion ;; return cached result + (goto-char (org-babel-where-is-src-block-result nil info)) + (end-of-line 1) (forward-char 1) + (let ((result (org-babel-read-result))) + (message (replace-regexp-in-string + "%" "%%" (format "%S" result))) result))) + ((org-babel-confirm-evaluate + (let ((i info)) (setf (nth 2 i) merged-params) i)) + (let* ((lang (nth 0 info)) + (result-params (cdr (assoc :result-params params))) + (body (setf (nth 1 info) + (if (org-babel-noweb-p params :eval) + (org-babel-expand-noweb-references info) + (nth 1 info)))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory (expand-file-name dir))) + default-directory)) + (org-babel-call-process-region-original ;; for tramp handler + (or (org-bound-and-true-p + org-babel-call-process-region-original) + (symbol-function 'call-process-region))) + (indent (nth 5 info)) + result cmd) + (unwind-protect + (let ((call-process-region + (lambda (&rest args) + (apply 'org-babel-tramp-handle-call-process-region + args)))) + (let ((lang-check + (lambda (f) + (let ((f (intern (concat "org-babel-execute:" f)))) + (when (fboundp f) f))))) + (setq cmd + (or (funcall lang-check lang) + (funcall lang-check + (symbol-name + (cdr (assoc lang org-src-lang-modes)))) + (error "No org-babel-execute function for %s!" + lang)))) + (message "executing %s code block%s..." + (capitalize lang) + (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) + (if (member "none" result-params) + (progn + (funcall cmd body params) + (message "result silenced") + (setq result nil)) + (setq result + (let ((result (funcall cmd body params))) + (if (and (eq (cdr (assoc :result-type params)) + 'value) + (or (member "vector" result-params) + (member "table" result-params)) + (not (listp result))) + (list (list result)) result))) + ;; If non-empty result and :file then write to :file. + (when (cdr (assoc :file params)) + (when result + (with-temp-file (cdr (assoc :file params)) + (insert + (org-babel-format-result + result (cdr (assoc :sep (nth 2 info))))))) + (setq result (cdr (assoc :file params)))) + ;; Possibly perform post process provided its appropriate. + (when (cdr (assoc :post params)) + (let ((*this* (if (cdr (assoc :file params)) + (org-babel-result-to-file + (cdr (assoc :file params)) + (when (assoc :file-desc params) + (or (cdr (assoc :file-desc params)) + result))) + result))) + (setq result (org-babel-ref-resolve + (cdr (assoc :post params)))) + (when (cdr (assoc :file params)) + (setq result-params + (remove "file" result-params))))) + (org-babel-insert-result + result result-params info new-hash indent lang)) + (run-hooks 'org-babel-after-execute-hook) + result) + (setq call-process-region + 'org-babel-call-process-region-original))))))))) + +(defun org-babel-expand-body:generic (body params &optional var-lines) + "Expand BODY with PARAMS. +Expand a block of code with org-babel according to its header +arguments. This generic implementation of body expansion is +called for languages which have not defined their own specific +org-babel-expand-body:lang function." + (let ((pro (cdr (assoc :prologue params))) + (epi (cdr (assoc :epilogue params)))) + (mapconcat #'identity + (append (when pro (list pro)) + var-lines + (list body) + (when epi (list epi))) + "\n"))) + +;;;###autoload +(defun org-babel-expand-src-block (&optional arg info params) + "Expand the current source code block. +Expand according to the source code block's header +arguments and pop open the results in a preview buffer." + (interactive) + (let* ((info (or info (org-babel-get-src-block-info))) + (lang (nth 0 info)) + (params (setf (nth 2 info) + (sort (org-babel-merge-params (nth 2 info) params) + (lambda (el1 el2) (string< (symbol-name (car el1)) + (symbol-name (car el2))))))) + (body (setf (nth 1 info) + (if (org-babel-noweb-p params :eval) + (org-babel-expand-noweb-references info) (nth 1 info)))) + (expand-cmd (intern (concat "org-babel-expand-body:" lang))) + (assignments-cmd (intern (concat "org-babel-variable-assignments:" + lang))) + (expanded + (if (fboundp expand-cmd) (funcall expand-cmd body params) + (org-babel-expand-body:generic + body params (and (fboundp assignments-cmd) + (funcall assignments-cmd params)))))) + (if (org-called-interactively-p 'any) + (org-edit-src-code + nil expanded + (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*")) + expanded))) + +(defun org-babel-edit-distance (s1 s2) + "Return the edit (levenshtein) distance between strings S1 S2." + (let* ((l1 (length s1)) + (l2 (length s2)) + (dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil)) + (number-sequence 1 (1+ l1))))) + (in (lambda (i j) (aref (aref dist i) j)))) + (setf (aref (aref dist 0) 0) 0) + (dolist (j (number-sequence 1 l2)) + (setf (aref (aref dist 0) j) j)) + (dolist (i (number-sequence 1 l1)) + (setf (aref (aref dist i) 0) i) + (dolist (j (number-sequence 1 l2)) + (setf (aref (aref dist i) j) + (min + (1+ (funcall in (1- i) j)) + (1+ (funcall in i (1- j))) + (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1) + (funcall in (1- i) (1- j))))))) + (funcall in l1 l2))) + +(defun org-babel-combine-header-arg-lists (original &rest others) + "Combine a number of lists of header argument names and arguments." + (let ((results (copy-sequence original))) + (dolist (new-list others) + (dolist (arg-pair new-list) + (let ((header (car arg-pair)) + (args (cdr arg-pair))) + (setq results + (cons arg-pair (org-remove-if + (lambda (pair) (equal header (car pair))) + results)))))) + results)) + +;;;###autoload +(defun org-babel-check-src-block () + "Check for misspelled header arguments in the current code block." + (interactive) + ;; TODO: report malformed code block + ;; TODO: report incompatible combinations of header arguments + ;; TODO: report uninitialized variables + (let ((too-close 2) ;; <- control closeness to report potential match + (names (mapcar #'symbol-name org-babel-header-arg-names))) + (dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1)) + (and (org-babel-where-is-src-block-head) + (org-babel-parse-header-arguments + (org-no-properties + (match-string 4)))))) + (dolist (name names) + (when (and (not (string= header name)) + (<= (org-babel-edit-distance header name) too-close) + (not (member header names))) + (error "Supplied header \"%S\" is suspiciously close to \"%S\"" + header name)))) + (message "No suspicious header arguments found."))) + +;;;###autoload +(defun org-babel-insert-header-arg () + "Insert a header argument selecting from lists of common args and values." + (interactive) + (let* ((lang (car (org-babel-get-src-block-info 'light))) + (lang-headers (intern (concat "org-babel-header-args:" lang))) + (headers (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values + (when (boundp lang-headers) (eval lang-headers)))) + (arg (org-icompleting-read + "Header Arg: " + (mapcar + (lambda (header-spec) (symbol-name (car header-spec))) + headers)))) + (insert ":" arg) + (let ((vals (cdr (assoc (intern arg) headers)))) + (when vals + (insert + " " + (cond + ((eq vals :any) + (read-from-minibuffer "value: ")) + ((listp vals) + (mapconcat + (lambda (group) + (let ((arg (org-icompleting-read + "value: " + (cons "default" (mapcar #'symbol-name group))))) + (if (and arg (not (string= "default" arg))) + (concat arg " ") + ""))) + vals "")))))))) + +;; Add support for completing-read insertion of header arguments after ":" +(defun org-babel-header-arg-expand () + "Call `org-babel-enter-header-arg-w-completion' in appropriate contexts." + (when (and (equal (char-before) ?\:) (org-babel-where-is-src-block-head)) + (org-babel-enter-header-arg-w-completion (match-string 2)))) + +(defun org-babel-enter-header-arg-w-completion (&optional lang) + "Insert header argument appropriate for LANG with completion." + (let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang))) + (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var))) + (headers-w-values (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values lang-headers)) + (headers (mapcar #'symbol-name (mapcar #'car headers-w-values))) + (header (org-completing-read "Header Arg: " headers)) + (args (cdr (assoc (intern header) headers-w-values))) + (arg (when (and args (listp args)) + (org-completing-read + (format "%s: " header) + (mapcar #'symbol-name (apply #'append args)))))) + (insert (concat header " " (or arg ""))) + (cons header arg))) + +(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand) + +;;;###autoload +(defun org-babel-load-in-session (&optional arg info) + "Load the body of the current source-code block. +Evaluate the header arguments for the source block before +entering the session. After loading the body this pops open the +session." + (interactive) + (let* ((info (or info (org-babel-get-src-block-info))) + (lang (nth 0 info)) + (params (nth 2 info)) + (body (if (not info) + (user-error "No src code block at point") + (setf (nth 1 info) + (if (org-babel-noweb-p params :eval) + (org-babel-expand-noweb-references info) + (nth 1 info))))) + (session (cdr (assoc :session params))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory dir)) default-directory)) + (cmd (intern (concat "org-babel-load-session:" lang)))) + (unless (fboundp cmd) + (error "No org-babel-load-session function for %s!" lang)) + (pop-to-buffer (funcall cmd session body params)) + (end-of-line 1))) + +;;;###autoload +(defun org-babel-initiate-session (&optional arg info) + "Initiate session for current code block. +If called with a prefix argument then resolve any variable +references in the header arguments and assign these variables in +the session. Copy the body of the code block to the kill ring." + (interactive "P") + (let* ((info (or info (org-babel-get-src-block-info (not arg)))) + (lang (nth 0 info)) + (body (nth 1 info)) + (params (nth 2 info)) + (session (cdr (assoc :session params))) + (dir (cdr (assoc :dir params))) + (default-directory + (or (and dir (file-name-as-directory dir)) default-directory)) + (init-cmd (intern (format "org-babel-%s-initiate-session" lang))) + (prep-cmd (intern (concat "org-babel-prep-session:" lang)))) + (if (and (stringp session) (string= session "none")) + (error "This block is not using a session!")) + (unless (fboundp init-cmd) + (error "No org-babel-initiate-session function for %s!" lang)) + (with-temp-buffer (insert (org-babel-trim body)) + (copy-region-as-kill (point-min) (point-max))) + (when arg + (unless (fboundp prep-cmd) + (error "No org-babel-prep-session function for %s!" lang)) + (funcall prep-cmd session params)) + (funcall init-cmd session params))) + +;;;###autoload +(defun org-babel-switch-to-session (&optional arg info) + "Switch to the session of the current code block. +Uses `org-babel-initiate-session' to start the session. If called +with a prefix argument then this is passed on to +`org-babel-initiate-session'." + (interactive "P") + (pop-to-buffer (org-babel-initiate-session arg info)) + (end-of-line 1)) + +(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session) + +(defvar org-src-window-setup) + +;;;###autoload +(defun org-babel-switch-to-session-with-code (&optional arg info) + "Switch to code buffer and display session." + (interactive "P") + (let ((swap-windows + (lambda () + (let ((other-window-buffer (window-buffer (next-window)))) + (set-window-buffer (next-window) (current-buffer)) + (set-window-buffer (selected-window) other-window-buffer)) + (other-window 1))) + (info (org-babel-get-src-block-info)) + (org-src-window-setup 'reorganize-frame)) + (save-excursion + (org-babel-switch-to-session arg info)) + (org-edit-src-code) + (funcall swap-windows))) + +(defmacro org-babel-do-in-edit-buffer (&rest body) + "Evaluate BODY in edit buffer if there is a code block at point. +Return t if a code block was found at point, nil otherwise." + `(let ((org-src-window-setup 'switch-invisibly)) + (when (and (org-babel-where-is-src-block-head) + (org-edit-src-code nil nil nil)) + (unwind-protect (progn ,@body) + (if (org-bound-and-true-p org-edit-src-from-org-mode) + (org-edit-src-exit))) + t))) +(def-edebug-spec org-babel-do-in-edit-buffer (body)) + +(defun org-babel-do-key-sequence-in-edit-buffer (key) + "Read key sequence and execute the command in edit buffer. +Enter a key sequence to be executed in the language major-mode +edit buffer. For example, TAB will alter the contents of the +Org-mode code block according to the effect of TAB in the +language major-mode buffer. For languages that support +interactive sessions, this can be used to send code from the Org +buffer to the session for evaluation using the native major-mode +evaluation mechanisms." + (interactive "kEnter key-sequence to execute in edit buffer: ") + (org-babel-do-in-edit-buffer + (call-interactively + (key-binding (or key (read-key-sequence nil)))))) + +(defvar org-bracket-link-regexp) + +(defun org-babel-active-location-p () + (memq (org-element-type (save-match-data (org-element-context))) + '(babel-call inline-babel-call inline-src-block src-block))) + +;;;###autoload +(defun org-babel-open-src-block-result (&optional re-run) + "If `point' is on a src block then open the results of the +source code block, otherwise return nil. With optional prefix +argument RE-RUN the source-code block is evaluated even if +results already exist." + (interactive "P") + (let ((info (org-babel-get-src-block-info 'light))) + (when info + (save-excursion + ;; go to the results, if there aren't any then run the block + (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result)) + (progn (org-babel-execute-src-block) + (org-babel-where-is-src-block-result)))) + (end-of-line 1) + (while (looking-at "[\n\r\t\f ]") (forward-char 1)) + ;; open the results + (if (looking-at org-bracket-link-regexp) + ;; file results + (org-open-at-point) + (let ((r (org-babel-format-result + (org-babel-read-result) (cdr (assoc :sep (nth 2 info)))))) + (pop-to-buffer (get-buffer-create "*Org-Babel Results*")) + (delete-region (point-min) (point-max)) + (insert r))) + t)))) + +;;;###autoload +(defmacro org-babel-map-src-blocks (file &rest body) + "Evaluate BODY forms on each source-block in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer. During evaluation of BODY the following local variables +are set relative to the currently matched code block. + +full-block ------- string holding the entirety of the code block +beg-block -------- point at the beginning of the code block +end-block -------- point at the end of the matched code block +lang ------------- string holding the language of the code block +beg-lang --------- point at the beginning of the lang +end-lang --------- point at the end of the lang +switches --------- string holding the switches +beg-switches ----- point at the beginning of the switches +end-switches ----- point at the end of the switches +header-args ------ string holding the header-args +beg-header-args -- point at the beginning of the header-args +end-header-args -- point at the end of the header-args +body ------------- string holding the body of the code block +beg-body --------- point at the beginning of the body +end-body --------- point at the end of the body" + (declare (indent 1)) + (let ((tempvar (make-symbol "file"))) + `(let* ((case-fold-search t) + (,tempvar ,file) + (visited-p (or (null ,tempvar) + (get-file-buffer (expand-file-name ,tempvar)))) + (point (point)) to-be-removed) + (save-window-excursion + (when ,tempvar (find-file ,tempvar)) + (setq to-be-removed (current-buffer)) + (goto-char (point-min)) + (while (re-search-forward org-babel-src-block-regexp nil t) + (when (org-babel-active-location-p) + (goto-char (match-beginning 0)) + (let ((full-block (match-string 0)) + (beg-block (match-beginning 0)) + (end-block (match-end 0)) + (lang (match-string 2)) + (beg-lang (match-beginning 2)) + (end-lang (match-end 2)) + (switches (match-string 3)) + (beg-switches (match-beginning 3)) + (end-switches (match-end 3)) + (header-args (match-string 4)) + (beg-header-args (match-beginning 4)) + (end-header-args (match-end 4)) + (body (match-string 5)) + (beg-body (match-beginning 5)) + (end-body (match-end 5))) + ,@body + (goto-char end-block))))) + (unless visited-p (kill-buffer to-be-removed)) + (goto-char point)))) +(def-edebug-spec org-babel-map-src-blocks (form body)) + +;;;###autoload +(defmacro org-babel-map-inline-src-blocks (file &rest body) + "Evaluate BODY forms on each inline source-block in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer." + (declare (indent 1)) + (let ((tempvar (make-symbol "file"))) + `(let* ((case-fold-search t) + (,tempvar ,file) + (visited-p (or (null ,tempvar) + (get-file-buffer (expand-file-name ,tempvar)))) + (point (point)) to-be-removed) + (save-window-excursion + (when ,tempvar (find-file ,tempvar)) + (setq to-be-removed (current-buffer)) + (goto-char (point-min)) + (while (re-search-forward org-babel-inline-src-block-regexp nil t) + (when (org-babel-active-location-p) + (goto-char (match-beginning 1)) + (save-match-data ,@body)) + (goto-char (match-end 0)))) + (unless visited-p (kill-buffer to-be-removed)) + (goto-char point)))) +(def-edebug-spec org-babel-map-inline-src-blocks (form body)) + +(defvar org-babel-lob-one-liner-regexp) + +;;;###autoload +(defmacro org-babel-map-call-lines (file &rest body) + "Evaluate BODY forms on each call line in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer." + (declare (indent 1)) + (let ((tempvar (make-symbol "file"))) + `(let* ((,tempvar ,file) + (visited-p (or (null ,tempvar) + (get-file-buffer (expand-file-name ,tempvar)))) + (point (point)) to-be-removed) + (save-window-excursion + (when ,tempvar (find-file ,tempvar)) + (setq to-be-removed (current-buffer)) + (goto-char (point-min)) + (while (re-search-forward org-babel-lob-one-liner-regexp nil t) + (when (org-babel-active-location-p) + (goto-char (match-beginning 1)) + (save-match-data ,@body)) + (goto-char (match-end 0)))) + (unless visited-p (kill-buffer to-be-removed)) + (goto-char point)))) +(def-edebug-spec org-babel-map-call-lines (form body)) + +;;;###autoload +(defmacro org-babel-map-executables (file &rest body) + (declare (indent 1)) + (let ((tempvar (make-symbol "file")) + (rx (make-symbol "rx"))) + `(let* ((,tempvar ,file) + (,rx (concat "\\(" org-babel-src-block-regexp + "\\|" org-babel-inline-src-block-regexp + "\\|" org-babel-lob-one-liner-regexp "\\)")) + (visited-p (or (null ,tempvar) + (get-file-buffer (expand-file-name ,tempvar)))) + (point (point)) to-be-removed) + (save-window-excursion + (when ,tempvar (find-file ,tempvar)) + (setq to-be-removed (current-buffer)) + (goto-char (point-min)) + (while (re-search-forward ,rx nil t) + (when (org-babel-active-location-p) + (goto-char (match-beginning 1)) + (when (looking-at org-babel-inline-src-block-regexp) + (forward-char 1)) + (save-match-data ,@body)) + (goto-char (match-end 0)))) + (unless visited-p (kill-buffer to-be-removed)) + (goto-char point)))) +(def-edebug-spec org-babel-map-executables (form body)) + +;;;###autoload +(defun org-babel-execute-buffer (&optional arg) + "Execute source code blocks in a buffer. +Call `org-babel-execute-src-block' on every source block in +the current buffer." + (interactive "P") + (org-babel-eval-wipe-error-buffer) + (org-save-outline-visibility t + (org-babel-map-executables nil + (if (looking-at org-babel-lob-one-liner-regexp) + (org-babel-lob-execute-maybe) + (org-babel-execute-src-block arg))))) + +;;;###autoload +(defun org-babel-execute-subtree (&optional arg) + "Execute source code blocks in a subtree. +Call `org-babel-execute-src-block' on every source block in +the current subtree." + (interactive "P") + (save-restriction + (save-excursion + (org-narrow-to-subtree) + (org-babel-execute-buffer arg) + (widen)))) + +;;;###autoload +(defun org-babel-sha1-hash (&optional info) + "Generate an sha1 hash based on the value of info." + (interactive) + (let ((print-level nil) + (info (or info (org-babel-get-src-block-info)))) + (setf (nth 2 info) + (sort (copy-sequence (nth 2 info)) + (lambda (a b) (string< (car a) (car b))))) + (let* ((rm (lambda (lst) + (dolist (p '("replace" "silent" "none" + "append" "prepend")) + (setq lst (remove p lst))) + lst)) + (norm (lambda (arg) + (let ((v (if (and (listp (cdr arg)) (null (cddr arg))) + (copy-sequence (cdr arg)) + (cdr arg)))) + (when (and v (not (and (sequencep v) + (not (consp v)) + (= (length v) 0)))) + (cond + ((and (listp v) ; lists are sorted + (member (car arg) '(:result-params))) + (sort (funcall rm v) #'string<)) + ((and (stringp v) ; strings are sorted + (member (car arg) '(:results :exports))) + (mapconcat #'identity (sort (funcall rm (split-string v)) + #'string<) " ")) + (t v))))))) + (let* ((it (format "%s-%s" + (mapconcat + #'identity + (delq nil (mapcar (lambda (arg) + (let ((normalized (funcall norm arg))) + (when normalized + (format "%S" normalized)))) + (nth 2 info))) ":") + (nth 1 info))) + (hash (sha1 it))) + (when (org-called-interactively-p 'interactive) (message hash)) + hash)))) + +(defun org-babel-current-result-hash () + "Return the current in-buffer hash." + (org-babel-where-is-src-block-result) + (org-no-properties (match-string 5))) + +(defun org-babel-set-current-result-hash (hash) + "Set the current in-buffer hash to HASH." + (org-babel-where-is-src-block-result) + (save-excursion (goto-char (match-beginning 5)) + (mapc #'delete-overlay (overlays-at (point))) + (forward-char org-babel-hash-show) + (mapc #'delete-overlay (overlays-at (point))) + (replace-match hash nil nil nil 5) + (goto-char (point-at-bol)) + (org-babel-hide-hash))) + +(defun org-babel-hide-hash () + "Hide the hash in the current results line. +Only the initial `org-babel-hash-show' characters of the hash +will remain visible." + (add-to-invisibility-spec '(org-babel-hide-hash . t)) + (save-excursion + (when (and (re-search-forward org-babel-result-regexp nil t) + (match-string 5)) + (let* ((start (match-beginning 5)) + (hide-start (+ org-babel-hash-show start)) + (end (match-end 5)) + (hash (match-string 5)) + ov1 ov2) + (setq ov1 (make-overlay start hide-start)) + (setq ov2 (make-overlay hide-start end)) + (overlay-put ov2 'invisible 'org-babel-hide-hash) + (overlay-put ov1 'babel-hash hash))))) + +(defun org-babel-hide-all-hashes () + "Hide the hash in the current buffer. +Only the initial `org-babel-hash-show' characters of each hash +will remain visible. This function should be called as part of +the `org-mode-hook'." + (save-excursion + (while (and (not org-babel-hash-show-time) + (re-search-forward org-babel-result-regexp nil t)) + (goto-char (match-beginning 0)) + (org-babel-hide-hash) + (goto-char (match-end 0))))) +(add-hook 'org-mode-hook 'org-babel-hide-all-hashes) + +(defun org-babel-hash-at-point (&optional point) + "Return the value of the hash at POINT. +The hash is also added as the last element of the kill ring. +This can be called with C-c C-c." + (interactive) + (let ((hash (car (delq nil (mapcar + (lambda (ol) (overlay-get ol 'babel-hash)) + (overlays-at (or point (point)))))))) + (when hash (kill-new hash) (message hash)))) +(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point) + +(defun org-babel-result-hide-spec () + "Hide portions of results lines. +Add `org-babel-hide-result' as an invisibility spec for hiding +portions of results lines." + (add-to-invisibility-spec '(org-babel-hide-result . t))) +(add-hook 'org-mode-hook 'org-babel-result-hide-spec) + +(defvar org-babel-hide-result-overlays nil + "Overlays hiding results.") + +(defun org-babel-result-hide-all () + "Fold all results in the current buffer." + (interactive) + (org-babel-show-result-all) + (save-excursion + (while (re-search-forward org-babel-result-regexp nil t) + (save-excursion (goto-char (match-beginning 0)) + (org-babel-hide-result-toggle-maybe))))) + +(defun org-babel-show-result-all () + "Unfold all results in the current buffer." + (mapc 'delete-overlay org-babel-hide-result-overlays) + (setq org-babel-hide-result-overlays nil)) + +;;;###autoload +(defun org-babel-hide-result-toggle-maybe () + "Toggle visibility of result at point." + (interactive) + (let ((case-fold-search t)) + (if (save-excursion + (beginning-of-line 1) + (looking-at org-babel-result-regexp)) + (progn (org-babel-hide-result-toggle) + t) ;; to signal that we took action + nil))) ;; to signal that we did not + +(defun org-babel-hide-result-toggle (&optional force) + "Toggle the visibility of the current result." + (interactive) + (save-excursion + (beginning-of-line) + (if (re-search-forward org-babel-result-regexp nil t) + (let ((start (progn (beginning-of-line 2) (- (point) 1))) + (end (progn + (while (looking-at org-babel-multi-line-header-regexp) + (forward-line 1)) + (goto-char (- (org-babel-result-end) 1)) (point))) + ov) + (if (memq t (mapcar (lambda (overlay) + (eq (overlay-get overlay 'invisible) + 'org-babel-hide-result)) + (overlays-at start))) + (if (or (not force) (eq force 'off)) + (mapc (lambda (ov) + (when (member ov org-babel-hide-result-overlays) + (setq org-babel-hide-result-overlays + (delq ov org-babel-hide-result-overlays))) + (when (eq (overlay-get ov 'invisible) + 'org-babel-hide-result) + (delete-overlay ov))) + (overlays-at start))) + (setq ov (make-overlay start end)) + (overlay-put ov 'invisible 'org-babel-hide-result) + ;; make the block accessible to isearch + (overlay-put + ov 'isearch-open-invisible + (lambda (ov) + (when (member ov org-babel-hide-result-overlays) + (setq org-babel-hide-result-overlays + (delq ov org-babel-hide-result-overlays))) + (when (eq (overlay-get ov 'invisible) + 'org-babel-hide-result) + (delete-overlay ov)))) + (push ov org-babel-hide-result-overlays))) + (error "Not looking at a result line")))) + +;; org-tab-after-check-for-cycling-hook +(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe) +;; Remove overlays when changing major mode +(add-hook 'org-mode-hook + (lambda () (org-add-hook 'change-major-mode-hook + 'org-babel-show-result-all 'append 'local))) + +(defvar org-file-properties) +(defun org-babel-params-from-properties (&optional lang) + "Retrieve parameters specified as properties. +Return a list of association lists of source block params +specified in the properties of the current outline entry." + (save-match-data + (list + ;; DEPRECATED header arguments specified as separate property at + ;; point of definition + (let (val sym) + (org-babel-parse-multiple-vars + (delq nil + (mapcar + (lambda (header-arg) + (and (setq val (org-entry-get (point) header-arg t)) + (cons (intern (concat ":" header-arg)) + (org-babel-read val)))) + (mapcar + #'symbol-name + (mapcar + #'car + (org-babel-combine-header-arg-lists + org-babel-common-header-args-w-values + (progn + (setq sym (intern (concat "org-babel-header-args:" lang))) + (and (boundp sym) (eval sym)))))))))) + ;; header arguments specified with the header-args property at + ;; point of call + (org-babel-parse-header-arguments + (org-entry-get org-babel-current-src-block-location + "header-args" 'inherit)) + (when lang ;; language-specific header arguments at point of call + (org-babel-parse-header-arguments + (org-entry-get org-babel-current-src-block-location + (concat "header-args:" lang) 'inherit)))))) + +(defvar org-src-preserve-indentation) ;; declare defcustom from org-src +(defun org-babel-parse-src-block-match () + "Parse the results from a match of the `org-babel-src-block-regexp'." + (let* ((block-indentation (length (match-string 1))) + (lang (org-no-properties (match-string 2))) + (lang-headers (intern (concat "org-babel-default-header-args:" lang))) + (switches (match-string 3)) + (body (org-no-properties + (let* ((body (match-string 5)) + (sub-length (- (length body) 1))) + (if (and (> sub-length 0) + (string= "\n" (substring body sub-length))) + (substring body 0 sub-length) + (or body ""))))) + (preserve-indentation (or org-src-preserve-indentation + (save-match-data + (string-match "-i\\>" switches))))) + (list lang + ;; get block body less properties, protective commas, and indentation + (with-temp-buffer + (save-match-data + (insert (org-unescape-code-in-string body)) + (unless preserve-indentation (org-do-remove-indentation)) + (buffer-string))) + (apply #'org-babel-merge-params + org-babel-default-header-args + (when (boundp lang-headers) (eval lang-headers)) + (append + (org-babel-params-from-properties lang) + (list (org-babel-parse-header-arguments + (org-no-properties (or (match-string 4) "")))))) + switches + block-indentation))) + +(defun org-babel-parse-inline-src-block-match () + "Parse the results from a match of the `org-babel-inline-src-block-regexp'." + (let* ((lang (org-no-properties (match-string 2))) + (lang-headers (intern (concat "org-babel-default-header-args:" lang)))) + (list lang + (org-unescape-code-in-string (org-no-properties (match-string 5))) + (apply #'org-babel-merge-params + org-babel-default-inline-header-args + (if (boundp lang-headers) (eval lang-headers) nil) + (append + (org-babel-params-from-properties lang) + (list (org-babel-parse-header-arguments + (org-no-properties (or (match-string 4) ""))))))))) + +(defun org-babel-balanced-split (string alts) + "Split STRING on instances of ALTS. +ALTS is a cons of two character options where each option may be +either the numeric code of a single character or a list of +character alternatives. For example to split on balanced +instances of \"[ \t]:\" set ALTS to '((32 9) . 58)." + (let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch)))) + (matched (lambda (ch last) + (if (consp alts) + (and (funcall matches ch (cdr alts)) + (funcall matches last (car alts))) + (funcall matches ch alts)))) + (balance 0) (last 0) + quote partial lst) + (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]: + (setq balance (+ balance + (cond ((or (equal 91 ch) (equal 40 ch)) 1) + ((or (equal 93 ch) (equal 41 ch)) -1) + (t 0)))) + (when (and (equal 34 ch) (not (equal 92 last))) + (setq quote (not quote))) + (setq partial (cons ch partial)) + (when (and (= balance 0) (not quote) (funcall matched ch last)) + (setq lst (cons (apply #'string (nreverse + (if (consp alts) + (cddr partial) + (cdr partial)))) + lst)) + (setq partial nil)) + (setq last ch)) + (string-to-list string)) + (nreverse (cons (apply #'string (nreverse partial)) lst)))) + +(defun org-babel-join-splits-near-ch (ch list) + "Join splits where \"=\" is on either end of the split." + (let ((last= (lambda (str) (= ch (aref str (1- (length str)))))) + (first= (lambda (str) (= ch (aref str 0))))) + (reverse + (org-reduce (lambda (acc el) + (let ((head (car acc))) + (if (and head (or (funcall last= head) (funcall first= el))) + (cons (concat head el) (cdr acc)) + (cons el acc)))) + list :initial-value nil)))) + +(defun org-babel-parse-header-arguments (arg-string) + "Parse a string of header arguments returning an alist." + (when (> (length arg-string) 0) + (org-babel-parse-multiple-vars + (delq nil + (mapcar + (lambda (arg) + (if (string-match + "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" + arg) + (cons (intern (match-string 1 arg)) + (org-babel-read (org-babel-chomp (match-string 2 arg)))) + (cons (intern (org-babel-chomp arg)) nil))) + (let ((raw (org-babel-balanced-split arg-string '((32 9) . 58)))) + (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw))))))))) + +(defun org-babel-parse-multiple-vars (header-arguments) + "Expand multiple variable assignments behind a single :var keyword. + +This allows expression of multiple variables with one :var as +shown below. + +#+PROPERTY: var foo=1, bar=2" + (let (results) + (mapc (lambda (pair) + (if (eq (car pair) :var) + (mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results)) + (org-babel-join-splits-near-ch + 61 (org-babel-balanced-split (cdr pair) 32))) + (push pair results))) + header-arguments) + (nreverse results))) + +(defun org-babel-process-params (params) + "Expand variables in PARAMS and add summary parameters." + (let* ((processed-vars (mapcar (lambda (el) + (if (consp (cdr el)) + (cdr el) + (org-babel-ref-parse (cdr el)))) + (org-babel-get-header params :var))) + (vars-and-names (if (and (assoc :colname-names params) + (assoc :rowname-names params)) + (list processed-vars) + (org-babel-disassemble-tables + processed-vars + (cdr (assoc :hlines params)) + (cdr (assoc :colnames params)) + (cdr (assoc :rownames params))))) + (raw-result (or (cdr (assoc :results params)) "")) + (result-params (append + (split-string (if (stringp raw-result) + raw-result + (eval raw-result))) + (cdr (assoc :result-params params))))) + (append + (mapcar (lambda (var) (cons :var var)) (car vars-and-names)) + (list + (cons :colname-names (or (cdr (assoc :colname-names params)) + (cadr vars-and-names))) + (cons :rowname-names (or (cdr (assoc :rowname-names params)) + (caddr vars-and-names))) + (cons :result-params result-params) + (cons :result-type (cond ((member "output" result-params) 'output) + ((member "value" result-params) 'value) + (t 'value)))) + (org-babel-get-header params :var 'other)))) + +;; row and column names +(defun org-babel-del-hlines (table) + "Remove all 'hlines from TABLE." + (remove 'hline table)) + +(defun org-babel-get-colnames (table) + "Return the column names of TABLE. +Return a cons cell, the `car' of which contains the TABLE less +colnames, and the `cdr' of which contains a list of the column +names." + (if (equal 'hline (nth 1 table)) + (cons (cddr table) (car table)) + (cons (cdr table) (car table)))) + +(defun org-babel-get-rownames (table) + "Return the row names of TABLE. +Return a cons cell, the `car' of which contains the TABLE less +rownames, and the `cdr' of which contains a list of the rownames. +Note: this function removes any hlines in TABLE." + (let* ((table (org-babel-del-hlines table)) + (rownames (funcall (lambda () + (let ((tp table)) + (mapcar + (lambda (row) + (prog1 + (pop (car tp)) + (setq tp (cdr tp)))) + table)))))) + (cons table rownames))) + +(defun org-babel-put-colnames (table colnames) + "Add COLNAMES to TABLE if they exist." + (if colnames (apply 'list colnames 'hline table) table)) + +(defun org-babel-put-rownames (table rownames) + "Add ROWNAMES to TABLE if they exist." + (if rownames + (mapcar (lambda (row) + (if (listp row) + (cons (or (pop rownames) "") row) + row)) table) + table)) + +(defun org-babel-pick-name (names selector) + "Select one out of an alist of row or column names. +SELECTOR can be either a list of names in which case those names +will be returned directly, or an index into the list NAMES in +which case the indexed names will be return." + (if (listp selector) + selector + (when names + (if (and selector (symbolp selector) (not (equal t selector))) + (cdr (assoc selector names)) + (if (integerp selector) + (nth (- selector 1) names) + (cdr (car (last names)))))))) + +(defun org-babel-disassemble-tables (vars hlines colnames rownames) + "Parse tables for further processing. +Process the variables in VARS according to the HLINES, +ROWNAMES and COLNAMES header arguments. Return a list consisting +of the vars, cnames and rnames." + (let (cnames rnames) + (list + (mapcar + (lambda (var) + (when (listp (cdr var)) + (when (and (not (equal colnames "no")) + (or colnames (and (equal (nth 1 (cdr var)) 'hline) + (not (member 'hline (cddr (cdr var))))))) + (let ((both (org-babel-get-colnames (cdr var)))) + (setq cnames (cons (cons (car var) (cdr both)) + cnames)) + (setq var (cons (car var) (car both))))) + (when (and rownames (not (equal rownames "no"))) + (let ((both (org-babel-get-rownames (cdr var)))) + (setq rnames (cons (cons (car var) (cdr both)) + rnames)) + (setq var (cons (car var) (car both))))) + (when (and hlines (not (equal hlines "yes"))) + (setq var (cons (car var) (org-babel-del-hlines (cdr var)))))) + var) + vars) + (reverse cnames) (reverse rnames)))) + +(defun org-babel-reassemble-table (table colnames rownames) + "Add column and row names to a table. +Given a TABLE and set of COLNAMES and ROWNAMES add the names +to the table for reinsertion to org-mode." + (if (listp table) + (let ((table (if (and rownames (= (length table) (length rownames))) + (org-babel-put-rownames table rownames) table))) + (if (and colnames (listp (car table)) (= (length (car table)) + (length colnames))) + (org-babel-put-colnames table colnames) table)) + table)) + +(defun org-babel-where-is-src-block-head () + "Find where the current source block begins. +Return the point at the beginning of the current source +block. Specifically at the beginning of the #+BEGIN_SRC line. +If the point is not on a source block then return nil." + (let ((initial (point)) (case-fold-search t) top bottom) + (or + (save-excursion ;; on a source name line or a #+header line + (beginning-of-line 1) + (and (or (looking-at org-babel-src-name-regexp) + (looking-at org-babel-multi-line-header-regexp)) + (progn + (while (and (forward-line 1) + (or (looking-at org-babel-src-name-regexp) + (looking-at org-babel-multi-line-header-regexp)))) + (looking-at org-babel-src-block-regexp)) + (point))) + (save-excursion ;; on a #+begin_src line + (beginning-of-line 1) + (and (looking-at org-babel-src-block-regexp) + (point))) + (save-excursion ;; inside a src block + (and + (re-search-backward "^[ \t]*#\\+begin_src" nil t) (setq top (point)) + (re-search-forward "^[ \t]*#\\+end_src" nil t) (setq bottom (point)) + (< top initial) (< initial bottom) + (progn (goto-char top) (beginning-of-line 1) + (looking-at org-babel-src-block-regexp)) + (point-marker)))))) + +;;;###autoload +(defun org-babel-goto-src-block-head () + "Go to the beginning of the current code block." + (interactive) + (let ((head (org-babel-where-is-src-block-head))) + (if head (goto-char head) (error "Not currently in a code block")))) + +;;;###autoload +(defun org-babel-goto-named-src-block (name) + "Go to a named source-code block." + (interactive + (let ((completion-ignore-case t) + (case-fold-search t) + (under-point (thing-at-point 'line))) + (list (org-icompleting-read + "source-block name: " (org-babel-src-block-names) nil t + (cond + ;; noweb + ((string-match (org-babel-noweb-wrap) under-point) + (let ((block-name (match-string 1 under-point))) + (string-match "[^(]*" block-name) + (match-string 0 block-name))) + ;; #+call: + ((string-match org-babel-lob-one-liner-regexp under-point) + (let ((source-info (car (org-babel-lob-get-info)))) + (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info) + (let ((source-name (match-string 1 source-info))) + source-name)))) + ;; #+results: + ((string-match (concat "#\\+" org-babel-results-keyword + "\\:\s+\\([^\\(]*\\)") under-point) + (match-string 1 under-point)) + ;; symbol-at-point + ((and (thing-at-point 'symbol)) + (org-babel-find-named-block (thing-at-point 'symbol)) + (thing-at-point 'symbol)) + ("")))))) + (let ((point (org-babel-find-named-block name))) + (if point + ;; taken from `org-open-at-point' + (progn (org-mark-ring-push) (goto-char point) (org-show-context)) + (message "source-code block '%s' not found in this buffer" name)))) + +(defun org-babel-find-named-block (name) + "Find a named source-code block. +Return the location of the source block identified by source +NAME, or nil if no such block exists. Set match data according to +org-babel-named-src-block-regexp." + (save-excursion + (let ((case-fold-search t) + (regexp (org-babel-named-src-block-regexp-for-name name)) msg) + (goto-char (point-min)) + (when (or (re-search-forward regexp nil t) + (re-search-backward regexp nil t)) + (match-beginning 0))))) + +(defun org-babel-src-block-names (&optional file) + "Returns the names of source blocks in FILE or the current buffer." + (save-excursion + (when file (find-file file)) (goto-char (point-min)) + (let ((case-fold-search t) names) + (while (re-search-forward org-babel-src-name-w-name-regexp nil t) + (setq names (cons (match-string 3) names))) + names))) + +;;;###autoload +(defun org-babel-goto-named-result (name) + "Go to a named result." + (interactive + (let ((completion-ignore-case t)) + (list (org-icompleting-read "source-block name: " + (org-babel-result-names) nil t)))) + (let ((point (org-babel-find-named-result name))) + (if point + ;; taken from `org-open-at-point' + (progn (goto-char point) (org-show-context)) + (message "result '%s' not found in this buffer" name)))) + +(defun org-babel-find-named-result (name &optional point) + "Find a named result. +Return the location of the result named NAME in the current +buffer or nil if no such result exists." + (save-excursion + (let ((case-fold-search t)) + (goto-char (or point (point-min))) + (catch 'is-a-code-block + (when (re-search-forward + (concat org-babel-result-regexp + "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t) + (when (and (string= "name" (downcase (match-string 1))) + (or (beginning-of-line 1) + (looking-at org-babel-src-block-regexp) + (looking-at org-babel-multi-line-header-regexp) + (looking-at org-babel-lob-one-liner-regexp))) + (throw 'is-a-code-block (org-babel-find-named-result name (point)))) + (beginning-of-line 0) (point)))))) + +(defun org-babel-result-names (&optional file) + "Returns the names of results in FILE or the current buffer." + (save-excursion + (when file (find-file file)) (goto-char (point-min)) + (let ((case-fold-search t) names) + (while (re-search-forward org-babel-result-w-name-regexp nil t) + (setq names (cons (match-string 4) names))) + names))) + +;;;###autoload +(defun org-babel-next-src-block (&optional arg) + "Jump to the next source block. +With optional prefix argument ARG, jump forward ARG many source blocks." + (interactive "p") + (org-next-block arg nil org-babel-src-block-regexp)) + +;;;###autoload +(defun org-babel-previous-src-block (&optional arg) + "Jump to the previous source block. +With optional prefix argument ARG, jump backward ARG many source blocks." + (interactive "p") + (org-previous-block arg org-babel-src-block-regexp)) + +(defvar org-babel-load-languages) + +;;;###autoload +(defun org-babel-mark-block () + "Mark current src block." + (interactive) + (let ((head (org-babel-where-is-src-block-head))) + (when head + (save-excursion + (goto-char head) + (looking-at org-babel-src-block-regexp)) + (push-mark (match-end 5) nil t) + (goto-char (match-beginning 5))))) + +(defun org-babel-demarcate-block (&optional arg) + "Wrap or split the code in the region or on the point. +When called from inside of a code block the current block is +split. When called from outside of a code block a new code block +is created. In both cases if the region is demarcated and if the +region is not active then the point is demarcated." + (interactive "P") + (let ((info (org-babel-get-src-block-info 'light)) + (headers (progn (org-babel-where-is-src-block-head) + (match-string 4))) + (stars (concat (make-string (or (org-current-level) 1) ?*) " "))) + (if info + (mapc + (lambda (place) + (save-excursion + (goto-char place) + (let ((lang (nth 0 info)) + (indent (make-string (nth 5 info) ? ))) + (when (string-match "^[[:space:]]*$" + (buffer-substring (point-at-bol) + (point-at-eol))) + (delete-region (point-at-bol) (point-at-eol))) + (insert (concat + (if (looking-at "^") "" "\n") + indent "#+end_src\n" + (if arg stars indent) "\n" + indent "#+begin_src " lang + (if (> (length headers) 1) + (concat " " headers) headers) + (if (looking-at "[\n\r]") + "" + (concat "\n" (make-string (current-column) ? ))))))) + (move-end-of-line 2)) + (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>)) + (let ((start (point)) + (lang (org-icompleting-read + "Lang: " + (mapcar #'symbol-name + (delete-dups + (append (mapcar #'car org-babel-load-languages) + (mapcar (lambda (el) (intern (car el))) + org-src-lang-modes)))))) + (body (delete-and-extract-region + (if (org-region-active-p) (mark) (point)) (point)))) + (insert (concat (if (looking-at "^") "" "\n") + (if arg (concat stars "\n") "") + "#+begin_src " lang "\n" + body + (if (or (= (length body) 0) + (string-match "[\r\n]$" body)) "" "\n") + "#+end_src\n")) + (goto-char start) (move-end-of-line 1))))) + +(defvar org-babel-lob-one-liner-regexp) +(defun org-babel-where-is-src-block-result (&optional insert info hash indent) + "Find where the current source block results begin. +Return the point at the beginning of the result of the current +source block. Specifically at the beginning of the results line. +If no result exists for this block then create a results line +following the source block." + (save-excursion + (let* ((case-fold-search t) + (on-lob-line (save-excursion + (beginning-of-line 1) + (looking-at org-babel-lob-one-liner-regexp))) + (inlinep (when (org-babel-get-inline-src-block-matches) + (match-end 0))) + (name (nth 4 (or info (org-babel-get-src-block-info 'light)))) + (head (unless on-lob-line (org-babel-where-is-src-block-head))) + found beg end) + (when head (goto-char head)) + (org-with-wide-buffer + (setq + found ;; was there a result (before we potentially insert one) + (or + inlinep + (and + ;; named results: + ;; - return t if it is found, else return nil + ;; - if it does not need to be rebuilt, then don't set end + ;; - if it does need to be rebuilt then do set end + name (setq beg (org-babel-find-named-result name)) + (prog1 beg + (when (and hash (not (string= hash (match-string 5)))) + (goto-char beg) (setq end beg) ;; beginning of result + (forward-line 1) + (delete-region end (org-babel-result-end)) nil))) + (and + ;; unnamed results: + ;; - return t if it is found, else return nil + ;; - if it is found, and the hash doesn't match, delete and set end + (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t)) + (progn (end-of-line 1) + (if (eobp) (insert "\n") (forward-char 1)) + (setq end (point)) + (or (and + (not name) + (progn ;; unnamed results line already exists + (catch 'non-comment + (while (re-search-forward "[^ \f\t\n\r\v]" nil t) + (beginning-of-line 1) + (cond + ((looking-at (concat org-babel-result-regexp "\n")) + (throw 'non-comment t)) + ((looking-at "^[ \t]*#") (end-of-line 1)) + (t (throw 'non-comment nil)))))) + (let ((this-hash (match-string 5))) + (prog1 (point) + ;; must remove and rebuild if hash!=old-hash + (if (and hash (not (string= hash this-hash))) + (prog1 nil + (forward-line 1) + (delete-region + end (org-babel-result-end))) + (setq end nil))))))))))) + (if (not (and insert end)) found + (goto-char end) + (unless beg + (if (looking-at "[\n\r]") (forward-char 1) (insert "\n"))) + (insert (concat + (when (wholenump indent) (make-string indent ? )) + "#+" org-babel-results-keyword + (when hash + (if org-babel-hash-show-time + (concat + "["(format-time-string "<%Y-%m-%d %H:%M:%S>")" "hash"]") + (concat "["hash"]"))) + ":" + (when name (concat " " name)) "\n")) + (unless beg (insert "\n") (backward-char)) + (beginning-of-line 0) + (if hash (org-babel-hide-hash)) + (point))))) + +(defvar org-block-regexp) +(defun org-babel-read-result () + "Read the result at `point' into emacs-lisp." + (let ((case-fold-search t) result-string) + (cond + ((org-at-table-p) (org-babel-read-table)) + ((org-at-item-p) (org-babel-read-list)) + ((looking-at org-bracket-link-regexp) (org-babel-read-link)) + ((looking-at org-block-regexp) (org-babel-trim (match-string 4))) + ((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$")) + (setq result-string + (org-babel-trim + (mapconcat (lambda (line) + (or (and (> (length line) 1) + (string-match "^[ \t]*: ?\\(.+\\)" line) + (match-string 1 line)) + "")) + (split-string + (buffer-substring + (point) (org-babel-result-end)) "[\r\n]+") + "\n"))) + (or (org-babel-number-p result-string) result-string)) + ((looking-at org-babel-result-regexp) + (save-excursion (forward-line 1) (org-babel-read-result)))))) + +(defun org-babel-read-table () + "Read the table at `point' into emacs-lisp." + (mapcar (lambda (row) + (if (and (symbolp row) (equal row 'hline)) row + (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) row))) + (org-table-to-lisp))) + +(defun org-babel-read-list () + "Read the list at `point' into emacs-lisp." + (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) + (mapcar #'cadr (cdr (org-list-parse-list))))) + +(defvar org-link-types-re) +(defun org-babel-read-link () + "Read the link at `point' into emacs-lisp. +If the path of the link is a file path it is expanded using +`expand-file-name'." + (let* ((case-fold-search t) + (raw (and (looking-at org-bracket-link-regexp) + (org-no-properties (match-string 1)))) + (type (and (string-match org-link-types-re raw) + (match-string 1 raw)))) + (cond + ((not type) (expand-file-name raw)) + ((string= type "file") + (and (string-match "file\\(.*\\):\\(.+\\)" raw) + (expand-file-name (match-string 2 raw)))) + (t raw)))) + +(defun org-babel-format-result (result &optional sep) + "Format RESULT for writing to file." + (let ((echo-res (lambda (r) (if (stringp r) r (format "%S" r))))) + (if (listp result) + ;; table result + (orgtbl-to-generic + result (list :sep (or sep "\t") :fmt echo-res)) + ;; scalar result + (funcall echo-res result)))) + +(defun org-babel-insert-result + (result &optional result-params info hash indent lang) + "Insert RESULT into the current buffer. +By default RESULT is inserted after the end of the +current source block. With optional argument RESULT-PARAMS +controls insertion of results in the org-mode file. +RESULT-PARAMS can take the following values: + +replace - (default option) insert results after the source block + replacing any previously inserted results + +silent -- no results are inserted into the Org-mode buffer but + the results are echoed to the minibuffer and are + ingested by Emacs (a potentially time consuming + process) + +file ---- the results are interpreted as a file path, and are + inserted into the buffer using the Org-mode file syntax + +list ---- the results are interpreted as an Org-mode list. + +raw ----- results are added directly to the Org-mode file. This + is a good option if you code block will output org-mode + formatted text. + +drawer -- results are added directly to the Org-mode file as with + \"raw\", but are wrapped in a RESULTS drawer, allowing + them to later be replaced or removed automatically. + +org ----- results are added inside of a \"#+BEGIN_SRC org\" block. + They are not comma-escaped when inserted, but Org syntax + here will be discarded when exporting the file. + +html ---- results are added inside of a #+BEGIN_HTML block. This + is a good option if you code block will output html + formatted text. + +latex --- results are added inside of a #+BEGIN_LATEX block. + This is a good option if you code block will output + latex formatted text. + +code ---- the results are extracted in the syntax of the source + code of the language being evaluated and are added + inside of a #+BEGIN_SRC block with the source-code + language set appropriately. Note this relies on the + optional LANG argument." + (if (stringp result) + (progn + (setq result (org-no-properties result)) + (when (member "file" result-params) + (setq result (org-babel-result-to-file + result (when (assoc :file-desc (nth 2 info)) + (or (cdr (assoc :file-desc (nth 2 info))) + result)))))) + (unless (listp result) (setq result (format "%S" result)))) + (if (and result-params (member "silent" result-params)) + (progn + (message (replace-regexp-in-string "%" "%%" (format "%S" result))) + result) + (save-excursion + (let* ((inlinep + (save-excursion + (when (or (org-babel-get-inline-src-block-matches) + (org-babel-get-lob-one-liner-matches)) + (goto-char (match-end 0)) + (insert (if (listp result) "\n" " ")) + (point)))) + (existing-result (unless inlinep + (org-babel-where-is-src-block-result + t info hash indent))) + (results-switches + (cdr (assoc :results_switches (nth 2 info)))) + (visible-beg (copy-marker (point-min))) + (visible-end (copy-marker (point-max))) + ;; When results exist outside of the current visible + ;; region of the buffer, be sure to widen buffer to + ;; update them. + (outside-scope-p (and existing-result + (or (> visible-beg existing-result) + (<= visible-end existing-result)))) + beg end) + (when (and (stringp result) ; ensure results end in a newline + (not inlinep) + (> (length result) 0) + (not (or (string-equal (substring result -1) "\n") + (string-equal (substring result -1) "\r")))) + (setq result (concat result "\n"))) + (unwind-protect + (progn + (when outside-scope-p (widen)) + (if (not existing-result) + (setq beg (or inlinep (point))) + (goto-char existing-result) + (save-excursion + (re-search-forward "#" nil t) + (setq indent (- (current-column) 1))) + (forward-line 1) + (setq beg (point)) + (cond + ((member "replace" result-params) + (delete-region (point) (org-babel-result-end))) + ((member "append" result-params) + (goto-char (org-babel-result-end)) (setq beg (point-marker))) + ((member "prepend" result-params)))) ; already there + (setq results-switches + (if results-switches (concat " " results-switches) "")) + (let ((wrap (lambda (start finish &optional no-escape) + (goto-char end) (insert (concat finish "\n")) + (goto-char beg) (insert (concat start "\n")) + (unless no-escape + (org-escape-code-in-region (min (point) end) end)) + (goto-char end) (goto-char (point-at-eol)) + (setq end (point-marker)))) + (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it))))))) + ;; insert results based on type + (cond + ;; do nothing for an empty result + ((null result)) + ;; insert a list if preferred + ((member "list" result-params) + (insert + (org-babel-trim + (org-list-to-generic + (cons 'unordered + (mapcar + (lambda (el) (list nil (if (stringp el) el (format "%S" el)))) + (if (listp result) result (split-string result "\n" t)))) + '(:splicep nil :istart "- " :iend "\n"))) + "\n")) + ;; assume the result is a table if it's not a string + ((funcall proper-list-p result) + (goto-char beg) + (insert (concat (orgtbl-to-orgtbl + (if (org-every + (lambda (el) (or (listp el) (eq el 'hline))) + result) + result (list result)) + '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) + (goto-char beg) (when (org-at-table-p) (org-table-align))) + ((and (listp result) (not (funcall proper-list-p result))) + (insert (format "%s\n" result))) + ((member "file" result-params) + (when inlinep (goto-char inlinep)) + (insert result)) + (t (goto-char beg) (insert result))) + (when (funcall proper-list-p result) (goto-char (org-table-end))) + (setq end (point-marker)) + ;; possibly wrap result + (cond + ((assoc :wrap (nth 2 info)) + (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS"))) + (funcall wrap (concat "#+BEGIN_" name) + (concat "#+END_" (car (org-split-string name)))))) + ((member "html" result-params) + (funcall wrap "#+BEGIN_HTML" "#+END_HTML")) + ((member "latex" result-params) + (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX")) + ((member "org" result-params) + (goto-char beg) (if (org-at-table-p) (org-cycle)) + (funcall wrap "#+BEGIN_SRC org" "#+END_SRC")) + ((member "code" result-params) + (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches) + "#+END_SRC")) + ((member "raw" result-params) + (goto-char beg) (if (org-at-table-p) (org-cycle))) + ((or (member "drawer" result-params) + ;; Stay backward compatible with <7.9.2 + (member "wrap" result-params)) + (goto-char beg) (if (org-at-table-p) (org-cycle)) + (funcall wrap ":RESULTS:" ":END:" 'no-escape)) + ((and (not (funcall proper-list-p result)) + (not (member "file" result-params))) + (org-babel-examplize-region beg end results-switches) + (setq end (point))))) + ;; possibly indent the results to match the #+results line + (when (and (not inlinep) (numberp indent) indent (> indent 0) + ;; in this case `table-align' does the work for us + (not (and (listp result) + (member "append" result-params)))) + (indent-rigidly beg end indent)) + (if (null result) + (if (member "value" result-params) + (message "Code block returned no value.") + (message "Code block produced no output.")) + (message "Code block evaluation complete."))) + (when outside-scope-p (narrow-to-region visible-beg visible-end)) + (set-marker visible-beg nil) + (set-marker visible-end nil)))))) + +(defun org-babel-remove-result (&optional info) + "Remove the result of the current source block." + (interactive) + (let ((location (org-babel-where-is-src-block-result nil info)) start) + (when location + (setq start (- location 1)) + (save-excursion + (goto-char location) (forward-line 1) + (delete-region start (org-babel-result-end)))))) + +(defun org-babel-result-end () + "Return the point at the end of the current set of results." + (save-excursion + (cond + ((org-at-table-p) (progn (goto-char (org-table-end)) (point))) + ((org-at-item-p) (let* ((struct (org-list-struct)) + (prvs (org-list-prevs-alist struct))) + (org-list-get-list-end (point-at-bol) struct prvs))) + ((let ((case-fold-search t)) (looking-at "^\\([ \t]*\\):results:")) + (progn (re-search-forward (concat "^" (match-string 1) ":END:")) + (forward-char 1) (point))) + (t + (let ((case-fold-search t)) + (if (looking-at (concat "[ \t]*#\\+begin_\\([^ \t\n\r]+\\)")) + (progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1)) + nil t) + (forward-char 1)) + (while (looking-at "[ \t]*\\(: \\|:$\\|\\[\\[\\)") + (forward-line 1)))) + (point))))) + +(defun org-babel-result-to-file (result &optional description) + "Convert RESULT into an `org-mode' link with optional DESCRIPTION. +If the `default-directory' is different from the containing +file's directory then expand relative links." + (when (stringp result) + (format "[[file:%s]%s]" + (if (and default-directory + buffer-file-name + (not (string= (expand-file-name default-directory) + (expand-file-name + (file-name-directory buffer-file-name))))) + (expand-file-name result default-directory) + result) + (if description (concat "[" description "]") "")))) + +(defvar org-babel-capitalize-examplize-region-markers nil + "Make true to capitalize begin/end example markers inserted by code blocks.") + +(defun org-babel-examplize-region (beg end &optional results-switches) + "Comment out region using the inline '==' or ': ' org example quote." + (interactive "*r") + (let ((chars-between (lambda (b e) + (not (string-match "^[\\s]*$" (buffer-substring b e))))) + (maybe-cap (lambda (str) (if org-babel-capitalize-examplize-region-markers + (upcase str) str)))) + (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg) + (funcall chars-between end (save-excursion (goto-char end) (point-at-eol)))) + (save-excursion + (goto-char beg) + (insert (format org-babel-inline-result-wrap + (prog1 (buffer-substring beg end) + (delete-region beg end))))) + (let ((size (count-lines beg end))) + (save-excursion + (cond ((= size 0)) ; do nothing for an empty result + ((< size org-babel-min-lines-for-block-output) + (goto-char beg) + (dotimes (n size) + (beginning-of-line 1) (insert ": ") (forward-line 1))) + (t + (goto-char beg) + (insert (if results-switches + (format "%s%s\n" + (funcall maybe-cap "#+begin_example") + results-switches) + (funcall maybe-cap "#+begin_example\n"))) + (if (markerp end) (goto-char end) (forward-char (- end beg))) + (insert (funcall maybe-cap "#+end_example\n"))))))))) + +(defun org-babel-update-block-body (new-body) + "Update the body of the current code block to NEW-BODY." + (if (not (org-babel-where-is-src-block-head)) + (error "Not in a source block") + (save-match-data + (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5)) + (indent-rigidly (match-beginning 5) (match-end 5) 2))) + +(defun org-babel-merge-params (&rest plists) + "Combine all parameter association lists in PLISTS. +Later elements of PLISTS override the values of previous elements. +This takes into account some special considerations for certain +parameters when merging lists." + (let* ((results-exclusive-groups + (mapcar (lambda (group) (mapcar #'symbol-name group)) + (cdr (assoc 'results org-babel-common-header-args-w-values)))) + (exports-exclusive-groups + (mapcar (lambda (group) (mapcar #'symbol-name group)) + (cdr (assoc 'exports org-babel-common-header-args-w-values)))) + (variable-index 0) + (e-merge (lambda (exclusive-groups &rest result-params) + ;; maintain exclusivity of mutually exclusive parameters + (let (output) + (mapc (lambda (new-params) + (mapc (lambda (new-param) + (mapc (lambda (exclusive-group) + (when (member new-param exclusive-group) + (mapcar (lambda (excluded-param) + (setq output + (delete + excluded-param + output))) + exclusive-group))) + exclusive-groups) + (setq output (org-uniquify + (cons new-param output)))) + new-params)) + result-params) + output))) + params results exports tangle noweb cache vars shebang comments padline + clearnames) + + (mapc + (lambda (plist) + (mapc + (lambda (pair) + (case (car pair) + (:var + (let ((name (if (listp (cdr pair)) + (cadr pair) + (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" + (cdr pair)) + (intern (match-string 1 (cdr pair))))))) + (if name + (setq vars + (append + (if (member name (mapcar #'car vars)) + (progn + (push name clearnames) + (delq nil + (mapcar + (lambda (p) + (unless (equal (car p) name) p)) + vars))) + vars) + (list (cons name pair)))) + ;; if no name is given and we already have named variables + ;; then assign to named variables in order + (if (and vars (nth variable-index vars)) + (let ((name (car (nth variable-index vars)))) + (push name clearnames) ; clear out colnames + ; and rownames + ; for replace vars + (prog1 (setf (cddr (nth variable-index vars)) + (concat (symbol-name name) "=" (cdr pair))) + (incf variable-index))) + (error "Variable \"%s\" must be assigned a default value" + (cdr pair)))))) + (:results + (setq results (funcall e-merge results-exclusive-groups + results + (split-string + (let ((r (cdr pair))) + (if (stringp r) r (eval r))))))) + (:file + (when (cdr pair) + (setq results (funcall e-merge results-exclusive-groups + results '("file"))) + (unless (or (member "both" exports) + (member "none" exports) + (member "code" exports)) + (setq exports (funcall e-merge exports-exclusive-groups + exports '("results")))) + (setq params (cons pair (assq-delete-all (car pair) params))))) + (:exports + (setq exports (funcall e-merge exports-exclusive-groups + exports (split-string (cdr pair))))) + (:tangle ;; take the latest -- always overwrite + (setq tangle (or (list (cdr pair)) tangle))) + (:noweb + (setq noweb (funcall e-merge + '(("yes" "no" "tangle" "no-export" + "strip-export" "eval")) + noweb + (split-string (or (cdr pair) ""))))) + (:cache + (setq cache (funcall e-merge '(("yes" "no")) cache + (split-string (or (cdr pair) ""))))) + (:padline + (setq padline (funcall e-merge '(("yes" "no")) padline + (split-string (or (cdr pair) ""))))) + (:shebang ;; take the latest -- always overwrite + (setq shebang (or (list (cdr pair)) shebang))) + (:comments + (setq comments (funcall e-merge '(("yes" "no")) comments + (split-string (or (cdr pair) ""))))) + (t ;; replace: this covers e.g. :session + (setq params (cons pair (assq-delete-all (car pair) params)))))) + plist)) + plists) + (setq vars (reverse vars)) + (while vars (setq params (cons (cons :var (cddr (pop vars))) params))) + ;; clear out col-names and row-names for replaced variables + (mapc + (lambda (name) + (mapc + (lambda (param) + (when (assoc param params) + (setf (cdr (assoc param params)) + (org-remove-if (lambda (pair) (equal (car pair) name)) + (cdr (assoc param params)))) + (setf params (org-remove-if (lambda (pair) (and (equal (car pair) param) + (null (cdr pair)))) + params)))) + (list :colname-names :rowname-names))) + clearnames) + (mapc + (lambda (hd) + (let ((key (intern (concat ":" (symbol-name hd)))) + (val (eval hd))) + (setf params (cons (cons key (mapconcat 'identity val " ")) params)))) + '(results exports tangle noweb padline cache shebang comments)) + params)) + +(defvar org-babel-use-quick-and-dirty-noweb-expansion nil + "Set to true to use regular expressions to expand noweb references. +This results in much faster noweb reference expansion but does +not properly allow code blocks to inherit the \":noweb-ref\" +header argument from buffer or subtree wide properties.") + +(defun org-babel-noweb-p (params context) + "Check if PARAMS require expansion in CONTEXT. +CONTEXT may be one of :tangle, :export or :eval." + (let* (intersect + (intersect (lambda (as bs) + (when as + (if (member (car as) bs) + (car as) + (funcall intersect (cdr as) bs)))))) + (funcall intersect (case context + (:tangle '("yes" "tangle" "no-export" "strip-export")) + (:eval '("yes" "no-export" "strip-export" "eval")) + (:export '("yes"))) + (split-string (or (cdr (assoc :noweb params)) ""))))) + +(defun org-babel-expand-noweb-references (&optional info parent-buffer) + "Expand Noweb references in the body of the current source code block. + +For example the following reference would be replaced with the +body of the source-code block named 'example-block'. + +<> + +Note that any text preceding the <> construct on a line will +be interposed between the lines of the replacement text. So for +example if <> is placed behind a comment, then the entire +replacement text will also be commented. + +This function must be called from inside of the buffer containing +the source-code block which holds BODY. + +In addition the following syntax can be used to insert the +results of evaluating the source-code block named 'example-block'. + +<> + +Any optional arguments can be passed to example-block by placing +the arguments inside the parenthesis following the convention +defined by `org-babel-lob'. For example + +<> + +would set the value of argument \"a\" equal to \"9\". Note that +these arguments are not evaluated in the current source-code +block but are passed literally to the \"example-block\"." + (let* ((parent-buffer (or parent-buffer (current-buffer))) + (info (or info (org-babel-get-src-block-info 'light))) + (lang (nth 0 info)) + (body (nth 1 info)) + (ob-nww-start org-babel-noweb-wrap-start) + (ob-nww-end org-babel-noweb-wrap-end) + (comment (string= "noweb" (cdr (assoc :comments (nth 2 info))))) + (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|" + ":noweb-ref[ \t]+" "\\)")) + (new-body "") + (nb-add (lambda (text) (setq new-body (concat new-body text)))) + (c-wrap (lambda (text) + (with-temp-buffer + (funcall (intern (concat lang "-mode"))) + (comment-region (point) (progn (insert text) (point))) + (org-babel-trim (buffer-string))))) + index source-name evaluate prefix) + (with-temp-buffer + (org-set-local 'org-babel-noweb-wrap-start ob-nww-start) + (org-set-local 'org-babel-noweb-wrap-end ob-nww-end) + (insert body) (goto-char (point-min)) + (setq index (point)) + (while (and (re-search-forward (org-babel-noweb-wrap) nil t)) + (save-match-data (setf source-name (match-string 1))) + (save-match-data (setq evaluate (string-match "\(.*\)" source-name))) + (save-match-data + (setq prefix + (buffer-substring (match-beginning 0) + (save-excursion + (beginning-of-line 1) (point))))) + ;; add interval to new-body (removing noweb reference) + (goto-char (match-beginning 0)) + (funcall nb-add (buffer-substring index (point))) + (goto-char (match-end 0)) + (setq index (point)) + (funcall + nb-add + (with-current-buffer parent-buffer + (save-restriction + (widen) + (mapconcat ;; Interpose PREFIX between every line. + #'identity + (split-string + (if evaluate + (let ((raw (org-babel-ref-resolve source-name))) + (if (stringp raw) raw (format "%S" raw))) + (or + ;; Retrieve from the library of babel. + (nth 2 (assoc (intern source-name) + org-babel-library-of-babel)) + ;; Return the contents of headlines literally. + (save-excursion + (when (org-babel-ref-goto-headline-id source-name) + (org-babel-ref-headline-body))) + ;; Find the expansion of reference in this buffer. + (let ((rx (concat rx-prefix source-name "[ \t\n]")) + expansion) + (save-excursion + (goto-char (point-min)) + (if org-babel-use-quick-and-dirty-noweb-expansion + (while (re-search-forward rx nil t) + (let* ((i (org-babel-get-src-block-info 'light)) + (body (org-babel-expand-noweb-references i)) + (sep (or (cdr (assoc :noweb-sep (nth 2 i))) + "\n")) + (full (if comment + (let ((cs (org-babel-tangle-comment-links i))) + (concat (funcall c-wrap (car cs)) "\n" + body "\n" + (funcall c-wrap (cadr cs)))) + body))) + (setq expansion (cons sep (cons full expansion))))) + (org-babel-map-src-blocks nil + (let ((i (org-babel-get-src-block-info 'light))) + (when (equal (or (cdr (assoc :noweb-ref (nth 2 i))) + (nth 4 i)) + source-name) + (let* ((body (org-babel-expand-noweb-references i)) + (sep (or (cdr (assoc :noweb-sep (nth 2 i))) + "\n")) + (full (if comment + (let ((cs (org-babel-tangle-comment-links i))) + (concat (funcall c-wrap (car cs)) "\n" + body "\n" + (funcall c-wrap (cadr cs)))) + body))) + (setq expansion + (cons sep (cons full expansion))))))))) + (and expansion + (mapconcat #'identity (nreverse (cdr expansion)) ""))) + ;; Possibly raise an error if named block doesn't exist. + (if (member lang org-babel-noweb-error-langs) + (error "%s" (concat + (org-babel-noweb-wrap source-name) + "could not be resolved (see " + "`org-babel-noweb-error-langs')")) + ""))) + "[\n\r]") (concat "\n" prefix)))))) + (funcall nb-add (buffer-substring index (point-max)))) + new-body)) + +(defun org-babel-script-escape (str &optional force) + "Safely convert tables into elisp lists." + (let ((escaped + (if (or force + (and (stringp str) + (> (length str) 2) + (or (and (string-equal "[" (substring str 0 1)) + (string-equal "]" (substring str -1))) + (and (string-equal "{" (substring str 0 1)) + (string-equal "}" (substring str -1))) + (and (string-equal "(" (substring str 0 1)) + (string-equal ")" (substring str -1)))))) + (org-babel-read + (concat + "'" + (let (in-single in-double out) + (mapc + (lambda (ch) + (setq + out + (case ch + (91 (if (or in-double in-single) ; [ + (cons 91 out) + (cons 40 out))) + (93 (if (or in-double in-single) ; ] + (cons 93 out) + (cons 41 out))) + (123 (if (or in-double in-single) ; { + (cons 123 out) + (cons 40 out))) + (125 (if (or in-double in-single) ; } + (cons 125 out) + (cons 41 out))) + (44 (if (or in-double in-single) ; , + (cons 44 out) (cons 32 out))) + (39 (if in-double ; ' + (cons 39 out) + (setq in-single (not in-single)) (cons 34 out))) + (34 (if in-single ; " + (append (list 34 32) out) + (setq in-double (not in-double)) (cons 34 out))) + (t (cons ch out))))) + (string-to-list str)) + (apply #'string (reverse out))))) + str))) + (condition-case nil (org-babel-read escaped) (error escaped)))) + +(defun org-babel-read (cell &optional inhibit-lisp-eval) + "Convert the string value of CELL to a number if appropriate. +Otherwise if cell looks like lisp (meaning it starts with a +\"(\", \"'\", \"`\" or a \"[\") then read it as lisp, +otherwise return it unmodified as a string. Optional argument +NO-LISP-EVAL inhibits lisp evaluation for situations in which is +it not appropriate." + (if (and (stringp cell) (not (equal cell ""))) + (or (org-babel-number-p cell) + (if (and (not inhibit-lisp-eval) + (or (member (substring cell 0 1) '("(" "'" "`" "[")) + (string= cell "*this*"))) + (eval (read cell)) + (if (string= (substring cell 0 1) "\"") + (read cell) + (progn (set-text-properties 0 (length cell) nil cell) cell)))) + cell)) + +(defun org-babel-number-p (string) + "If STRING represents a number return its value." + (if (and (string-match "[0-9]+" string) + (string-match "^-?[0-9]*\\.?[0-9]*$" string) + (= (length (substring string (match-beginning 0) + (match-end 0))) + (length string))) + (string-to-number string))) + +(defun org-babel-import-elisp-from-file (file-name &optional separator) + "Read the results located at FILE-NAME into an elisp table. +If the table is trivial, then return it as a scalar." + (let (result) + (save-window-excursion + (with-temp-buffer + (condition-case err + (progn + (org-table-import file-name separator) + (delete-file file-name) + (setq result (mapcar (lambda (row) + (mapcar #'org-babel-string-read row)) + (org-table-to-lisp)))) + (error (message "Error reading results: %s" err) nil))) + (if (null (cdr result)) ;; if result is trivial vector, then scalarize it + (if (consp (car result)) + (if (null (cdr (car result))) + (caar result) + result) + (car result)) + result)))) + +(defun org-babel-string-read (cell) + "Strip nested \"s from around strings." + (org-babel-read (or (and (stringp cell) + (string-match "\\\"\\(.+\\)\\\"" cell) + (match-string 1 cell)) + cell) t)) + +(defun org-babel-chomp (string &optional regexp) + "Strip trailing spaces and carriage returns from STRING. +Default regexp used is \"[ \f\t\n\r\v]\" but can be +overwritten by specifying a regexp as a second argument." + (let ((regexp (or regexp "[ \f\t\n\r\v]"))) + (while (and (> (length string) 0) + (string-match regexp (substring string -1))) + (setq string (substring string 0 -1))) + string)) + +(defun org-babel-trim (string &optional regexp) + "Strip leading and trailing spaces and carriage returns from STRING. +Like `org-babel-chomp' only it runs on both the front and back +of the string." + (org-babel-chomp (org-reverse-string + (org-babel-chomp (org-reverse-string string) regexp)) + regexp)) + +(defun org-babel-tramp-handle-call-process-region + (start end program &optional delete buffer display &rest args) + "Use Tramp to handle `call-process-region'. +Fixes a bug in `tramp-handle-call-process-region'." + (if (and (featurep 'tramp) (file-remote-p default-directory)) + (let ((tmpfile (tramp-compat-make-temp-file ""))) + (write-region start end tmpfile) + (when delete (delete-region start end)) + (unwind-protect + ;; (apply 'call-process program tmpfile buffer display args) + ;; bug in tramp + (apply 'process-file program tmpfile buffer display args) + (delete-file tmpfile))) + ;; org-babel-call-process-region-original is the original emacs + ;; definition. It is in scope from the let binding in + ;; org-babel-execute-src-block + (apply org-babel-call-process-region-original + start end program delete buffer display args))) + +(defun org-babel-local-file-name (file) + "Return the local name component of FILE." + (if (file-remote-p file) + (let (localname) + (with-parsed-tramp-file-name file nil + localname)) + file)) + +(defun org-babel-process-file-name (name &optional no-quote-p) + "Prepare NAME to be used in an external process. +If NAME specifies a remote location, the remote portion of the +name is removed, since in that case the process will be executing +remotely. The file name is then processed by `expand-file-name'. +Unless second argument NO-QUOTE-P is non-nil, the file name is +additionally processed by `shell-quote-argument'" + (let ((f (expand-file-name (org-babel-local-file-name name)))) + (if no-quote-p f (shell-quote-argument f)))) + +(defvar org-babel-temporary-directory) +(unless (or noninteractive (boundp 'org-babel-temporary-directory)) + (defvar org-babel-temporary-directory + (or (and (boundp 'org-babel-temporary-directory) + (file-exists-p org-babel-temporary-directory) + org-babel-temporary-directory) + (make-temp-file "babel-" t)) + "Directory to hold temporary files created to execute code blocks. +Used by `org-babel-temp-file'. This directory will be removed on +Emacs shutdown.")) + +(defmacro org-babel-result-cond (result-params scalar-form &rest table-forms) + "Call the code to parse raw string results according to RESULT-PARAMS." + (declare (indent 1) + (debug (form form &rest form))) + (org-with-gensyms (params) + `(let ((,params ,result-params)) + (unless (member "none" ,params) + (if (or (member "scalar" ,params) + (member "verbatim" ,params) + (member "html" ,params) + (member "code" ,params) + (member "pp" ,params) + (and (or (member "output" ,params) + (member "raw" ,params) + (member "org" ,params) + (member "drawer" ,params)) + (not (member "table" ,params)))) + ,scalar-form + ,@table-forms))))) +(def-edebug-spec org-babel-result-cond (form form body)) + +(defun org-babel-temp-file (prefix &optional suffix) + "Create a temporary file in the `org-babel-temporary-directory'. +Passes PREFIX and SUFFIX directly to `make-temp-file' with the +value of `temporary-file-directory' temporarily set to the value +of `org-babel-temporary-directory'." + (if (file-remote-p default-directory) + (let ((prefix + (concat (file-remote-p default-directory) + (expand-file-name prefix temporary-file-directory)))) + (make-temp-file prefix nil suffix)) + (let ((temporary-file-directory + (or (and (boundp 'org-babel-temporary-directory) + (file-exists-p org-babel-temporary-directory) + org-babel-temporary-directory) + temporary-file-directory))) + (make-temp-file prefix nil suffix)))) + +(defun org-babel-remove-temporary-directory () + "Remove `org-babel-temporary-directory' on Emacs shutdown." + (when (and (boundp 'org-babel-temporary-directory) + (file-exists-p org-babel-temporary-directory)) + ;; taken from `delete-directory' in files.el + (condition-case nil + (progn + (mapc (lambda (file) + ;; This test is equivalent to + ;; (and (file-directory-p fn) (not (file-symlink-p fn))) + ;; but more efficient + (if (eq t (car (file-attributes file))) + (delete-directory file) + (delete-file file))) + ;; We do not want to delete "." and "..". + (directory-files org-babel-temporary-directory 'full + "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) + (delete-directory org-babel-temporary-directory)) + (error + (message "Failed to remove temporary Org-babel directory %s" + (if (boundp 'org-babel-temporary-directory) + org-babel-temporary-directory + "[directory not defined]")))))) + +(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) + +(provide 'ob-core) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ob-core.el ends here diff --git a/elpa/org-20150427/ob-css.el b/elpa/org-20150427/ob-css.el new file mode 100644 index 00000000..2fedb354 --- /dev/null +++ b/elpa/org-20150427/ob-css.el @@ -0,0 +1,48 @@ +;;; ob-css.el --- org-babel functions for css evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Since CSS can't be executed, this file exists solely for tangling +;; CSS from org-mode files. + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:css '()) + +(defun org-babel-execute:css (body params) + "Execute a block of CSS code. +This function is called by `org-babel-execute-src-block'." + body) + +(defun org-babel-prep-session:css (session params) + "Return an error if the :session header argument is set. +CSS does not support sessions." + (error "CSS sessions are nonsensical")) + +(provide 'ob-css) + + + +;;; ob-css.el ends here diff --git a/elpa/org-20150427/ob-ditaa.el b/elpa/org-20150427/ob-ditaa.el new file mode 100644 index 00000000..26f0e4f4 --- /dev/null +++ b/elpa/org-20150427/ob-ditaa.el @@ -0,0 +1,122 @@ +;;; ob-ditaa.el --- org-babel functions for ditaa evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating ditaa source code. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in ditaa +;; +;; 2) we are generally only going to return results of type "file" +;; +;; 3) we are adding the "file" and "cmdline" header arguments +;; +;; 4) there are no variables (at least for now) + +;;; Code: +(require 'ob) +(require 'org-compat) + +(defvar org-babel-default-header-args:ditaa + '((:results . "file") + (:exports . "results") + (:java . "-Dfile.encoding=UTF-8")) + "Default arguments for evaluating a ditaa source block.") + +(defcustom org-ditaa-jar-path (expand-file-name + "ditaa.jar" + (file-name-as-directory + (expand-file-name + "scripts" + (file-name-as-directory + (expand-file-name + "../contrib" + (file-name-directory (org-find-library-dir "org"))))))) + "Path to the ditaa jar executable." + :group 'org-babel + :type 'string) + +(defcustom org-babel-ditaa-java-cmd "java" + "Java executable to use when evaluating ditaa blocks." + :group 'org-babel + :type 'string) + +(defcustom org-ditaa-eps-jar-path + (expand-file-name "DitaaEps.jar" (file-name-directory org-ditaa-jar-path)) + "Path to the DitaaEps.jar executable." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-ditaa-jar-option "-jar" + "Option for the ditaa jar file. +Do not leave leading or trailing spaces in this string." + :group 'org-babel + :version "24.1" + :type 'string) + +(defun org-babel-execute:ditaa (body params) + "Execute a block of Ditaa code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (let ((el (cdr (assoc :file params)))) + (or el + (error + "ditaa code block requires :file header argument")))) + (cmdline (cdr (assoc :cmdline params))) + (java (cdr (assoc :java params))) + (in-file (org-babel-temp-file "ditaa-")) + (eps (cdr (assoc :eps params))) + (cmd (concat org-babel-ditaa-java-cmd + " " java " " org-ditaa-jar-option " " + (shell-quote-argument + (expand-file-name + (if eps org-ditaa-eps-jar-path org-ditaa-jar-path))) + " " cmdline + " " (org-babel-process-file-name in-file) + " " (org-babel-process-file-name out-file))) + (pdf-cmd (when (and (or (string= (file-name-extension out-file) "pdf") + (cdr (assoc :pdf params)))) + (concat + "epstopdf" + " " (org-babel-process-file-name (concat in-file ".eps")) + " -o=" (org-babel-process-file-name out-file))))) + (unless (file-exists-p org-ditaa-jar-path) + (error "Could not find ditaa.jar at %s" org-ditaa-jar-path)) + (with-temp-file in-file (insert body)) + (message cmd) (shell-command cmd) + (when pdf-cmd (message pdf-cmd) (shell-command pdf-cmd)) + nil)) ;; signal that output has already been written to file + +(defun org-babel-prep-session:ditaa (session params) + "Return an error because ditaa does not support sessions." + (error "Ditaa does not support sessions")) + +(provide 'ob-ditaa) + + + +;;; ob-ditaa.el ends here diff --git a/elpa/org-20150427/ob-dot.el b/elpa/org-20150427/ob-dot.el new file mode 100644 index 00000000..b35d7bbc --- /dev/null +++ b/elpa/org-20150427/ob-dot.el @@ -0,0 +1,89 @@ +;;; ob-dot.el --- org-babel functions for dot evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating dot source code. +;; +;; For information on dot see http://www.graphviz.org/ +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in dot +;; +;; 2) we are generally only going to return results of type "file" +;; +;; 3) we are adding the "file" and "cmdline" header arguments +;; +;; 4) there are no variables (at least for now) + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:dot + '((:results . "file") (:exports . "results")) + "Default arguments to use when evaluating a dot source block.") + +(defun org-babel-expand-body:dot (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (mapc + (lambda (pair) + (let ((name (symbol-name (car pair))) + (value (cdr pair))) + (setq body + (replace-regexp-in-string + (concat "\$" (regexp-quote name)) + (if (stringp value) value (format "%S" value)) + body)))) + vars) + body)) + +(defun org-babel-execute:dot (body params) + "Execute a block of Dot code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (cdr (assoc :result-params params))) + (out-file (cdr (or (assoc :file params) + (error "You need to specify a :file parameter")))) + (cmdline (or (cdr (assoc :cmdline params)) + (format "-T%s" (file-name-extension out-file)))) + (cmd (or (cdr (assoc :cmd params)) "dot")) + (in-file (org-babel-temp-file "dot-"))) + (with-temp-file in-file + (insert (org-babel-expand-body:dot body params))) + (org-babel-eval + (concat cmd + " " (org-babel-process-file-name in-file) + " " cmdline + " -o " (org-babel-process-file-name out-file)) "") + nil)) ;; signal that output has already been written to file + +(defun org-babel-prep-session:dot (session params) + "Return an error because Dot does not support sessions." + (error "Dot does not support sessions")) + +(provide 'ob-dot) + + + +;;; ob-dot.el ends here diff --git a/elpa/org-20150427/ob-emacs-lisp.el b/elpa/org-20150427/ob-emacs-lisp.el new file mode 100644 index 00000000..3219344d --- /dev/null +++ b/elpa/org-20150427/ob-emacs-lisp.el @@ -0,0 +1,82 @@ +;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating emacs-lisp code + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:emacs-lisp + '((:hlines . "yes") (:colnames . "no")) + "Default arguments for evaluating an emacs-lisp source block.") + +(declare-function orgtbl-to-generic "org-table" (table params)) + +(defun org-babel-expand-body:emacs-lisp (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (result-params (cdr (assoc :result-params params))) + (print-level nil) (print-length nil) + (body (if (> (length vars) 0) + (concat "(let (" + (mapconcat + (lambda (var) + (format "%S" (print `(,(car var) ',(cdr var))))) + vars "\n ") + ")\n" body "\n)") + (concat body "\n")))) + (if (or (member "code" result-params) + (member "pp" result-params)) + (concat "(pp " body ")") body))) + +(defun org-babel-execute:emacs-lisp (body params) + "Execute a block of emacs-lisp code with Babel." + (save-window-excursion + (let ((result + (eval (read (format (if (member "output" + (cdr (assoc :result-params params))) + "(with-output-to-string %s)" + "(progn %s)") + (org-babel-expand-body:emacs-lisp + body params)))))) + (org-babel-result-cond (cdr (assoc :result-params params)) + (let ((print-level nil) + (print-length nil)) + (if (or (member "scalar" (cdr (assoc :result-params params))) + (member "verbatim" (cdr (assoc :result-params params)))) + (format "%S" result) + (format "%s" result))) + (org-babel-reassemble-table + result + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params)))))))) + +(provide 'ob-emacs-lisp) + + + +;;; ob-emacs-lisp.el ends here diff --git a/elpa/org-20150427/ob-eval.el b/elpa/org-20150427/ob-eval.el new file mode 100644 index 00000000..057590f0 --- /dev/null +++ b/elpa/org-20150427/ob-eval.el @@ -0,0 +1,143 @@ +;;; ob-eval.el --- org-babel functions for external code evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, comint +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; These functions build existing Emacs support for executing external +;; shell commands. + +;;; Code: +(require 'org-macs) +(eval-when-compile (require 'cl)) + +(defvar org-babel-error-buffer-name "*Org-Babel Error Output*") +(declare-function org-babel-temp-file "ob-core" (prefix &optional suffix)) + +(defun org-babel-eval-error-notify (exit-code stderr) + "Open a buffer to display STDERR and a message with the value of EXIT-CODE." + (let ((buf (get-buffer-create org-babel-error-buffer-name))) + (with-current-buffer buf + (goto-char (point-max)) + (save-excursion (insert stderr))) + (display-buffer buf)) + (message "Babel evaluation exited with code %S" exit-code)) + +(defun org-babel-eval (cmd body) + "Run CMD on BODY. +If CMD succeeds then return its results, otherwise display +STDERR with `org-babel-eval-error-notify'." + (let ((err-buff (get-buffer-create " *Org-Babel Error*")) exit-code) + (with-current-buffer err-buff (erase-buffer)) + (with-temp-buffer + (insert body) + (setq exit-code + (org-babel--shell-command-on-region + (point-min) (point-max) cmd err-buff)) + (if (or (not (numberp exit-code)) (> exit-code 0)) + (progn + (with-current-buffer err-buff + (org-babel-eval-error-notify exit-code (buffer-string))) + nil) + (buffer-string))))) + +(defun org-babel-eval-read-file (file) + "Return the contents of FILE as a string." + (with-temp-buffer (insert-file-contents file) + (buffer-string))) + +(defun org-babel--shell-command-on-region (start end command error-buffer) + "Execute COMMAND in an inferior shell with region as input. + +Stripped down version of shell-command-on-region for internal use +in Babel only. This lets us work around errors in the original +function in various versions of Emacs. +" + (let ((input-file (org-babel-temp-file "ob-input-")) + (error-file (if error-buffer (org-babel-temp-file "ob-error-") nil)) + ;; Unfortunately, `executable-find' does not support file name + ;; handlers. Therefore, we could use it in the local case + ;; only. + (shell-file-name + (cond ((and (not (file-remote-p default-directory)) + (executable-find shell-file-name)) + shell-file-name) + ((file-executable-p + (concat (file-remote-p default-directory) shell-file-name)) + shell-file-name) + ("/bin/sh"))) + exit-status) + ;; There is an error in `process-file' when `error-file' exists. + ;; This is fixed in Emacs trunk as of 2012-12-21; let's use this + ;; workaround for now. + (unless (file-remote-p default-directory) + (delete-file error-file)) + ;; we always call this with 'replace, remove conditional + ;; Replace specified region with output from command. + (let ((swap (< start end))) + (goto-char start) + (push-mark (point) 'nomsg) + (write-region start end input-file) + (delete-region start end) + (setq exit-status + (process-file shell-file-name input-file + (if error-file + (list t error-file) + t) + nil shell-command-switch command)) + (when swap (exchange-point-and-mark))) + + (when (and input-file (file-exists-p input-file) + ;; bind org-babel--debug-input around the call to keep + ;; the temporary input files available for inspection + (not (when (boundp 'org-babel--debug-input) + org-babel--debug-input))) + (delete-file input-file)) + + (when (and error-file (file-exists-p error-file)) + (if (< 0 (nth 7 (file-attributes error-file))) + (with-current-buffer (get-buffer-create error-buffer) + (let ((pos-from-end (- (point-max) (point)))) + (or (bobp) + (insert "\f\n")) + ;; Do no formatting while reading error file, + ;; because that can run a shell command, and we + ;; don't want that to cause an infinite recursion. + (format-insert-file error-file nil) + ;; Put point after the inserted errors. + (goto-char (- (point-max) pos-from-end))) + (current-buffer))) + (delete-file error-file)) + exit-status)) + +(defun org-babel-eval-wipe-error-buffer () + "Delete the contents of the Org code block error buffer. +This buffer is named by `org-babel-error-buffer-name'." + (when (get-buffer org-babel-error-buffer-name) + (with-current-buffer org-babel-error-buffer-name + (delete-region (point-min) (point-max))))) + +(provide 'ob-eval) + + + +;;; ob-eval.el ends here diff --git a/elpa/org-20150427/ob-exp.el b/elpa/org-20150427/ob-exp.el new file mode 100644 index 00000000..761c9f17 --- /dev/null +++ b/elpa/org-20150427/ob-exp.el @@ -0,0 +1,406 @@ +;;; ob-exp.el --- Exportation of org-babel source blocks + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Authors: Eric Schulte +;; Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Code: +(require 'ob-core) +(require 'org-src) +(eval-when-compile + (require 'cl)) + +(defvar org-current-export-file) +(defvar org-babel-lob-one-liner-regexp) +(defvar org-babel-ref-split-regexp) +(defvar org-list-forbidden-blocks) + +(declare-function org-babel-lob-get-info "ob-lob" ()) +(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ()) +(declare-function org-between-regexps-p "org" + (start-re end-re &optional lim-up lim-down)) +(declare-function org-get-indentation "org" (&optional line)) +(declare-function org-heading-components "org" ()) +(declare-function org-in-block-p "org" (names)) +(declare-function org-in-verbatim-emphasis "org" ()) +(declare-function org-link-search "org" (s &optional type avoid-pos stealth)) +(declare-function org-fill-template "org" (template alist)) +(declare-function org-split-string "org" (string &optional separators)) +(declare-function org-element-at-point "org-element" (&optional keep-trail)) +(declare-function org-element-context "org-element" ()) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-escape-code-in-string "org-src" (s)) + +(defcustom org-export-babel-evaluate t + "Switch controlling code evaluation during export. +When set to nil no code will be evaluated as part of the export +process. When set to 'inline-only, only inline code blocks will +be executed." + :group 'org-babel + :version "24.1" + :type '(choice (const :tag "Never" nil) + (const :tag "Only inline code" inline-only) + (const :tag "Always" t))) +(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil))) + +(defun org-babel-exp-get-export-buffer () + "Return the current export buffer if possible." + (cond + ((bufferp org-current-export-file) org-current-export-file) + (org-current-export-file (get-file-buffer org-current-export-file)) + ('otherwise + (error "Requested export buffer when `org-current-export-file' is nil")))) + +(defvar org-link-search-inhibit-query) + +(defmacro org-babel-exp-in-export-file (lang &rest body) + (declare (indent 1)) + `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang))) + (heading (nth 4 (ignore-errors (org-heading-components)))) + (export-buffer (current-buffer)) + (original-buffer (org-babel-exp-get-export-buffer)) results) + (when original-buffer + ;; resolve parameters in the original file so that + ;; headline and file-wide parameters are included, attempt + ;; to go to the same heading in the original file + (set-buffer original-buffer) + (save-restriction + (when heading + (condition-case nil + (let ((org-link-search-inhibit-query t)) + (org-link-search heading)) + (error (when heading + (goto-char (point-min)) + (re-search-forward (regexp-quote heading) nil t))))) + (setq results ,@body)) + (set-buffer export-buffer) + results))) +(def-edebug-spec org-babel-exp-in-export-file (form body)) + +(defun org-babel-exp-src-block (&rest headers) + "Process source block for export. +Depending on the 'export' headers argument, replace the source +code block like this: + +both ---- display the code and the results + +code ---- the default, display the code inside the block but do + not process + +results - just like none only the block is run on export ensuring + that it's results are present in the org-mode buffer + +none ---- do not display either code or results upon export + +Assume point is at the beginning of block's starting line." + (interactive) + (unless noninteractive (message "org-babel-exp processing...")) + (save-excursion + (let* ((info (org-babel-get-src-block-info 'light)) + (lang (nth 0 info)) + (raw-params (nth 2 info)) hash) + ;; bail if we couldn't get any info from the block + (when info + ;; if we're actually going to need the parameters + (when (member (cdr (assoc :exports (nth 2 info))) '("both" "results")) + (org-babel-exp-in-export-file lang + (setf (nth 2 info) + (org-babel-process-params + (apply #'org-babel-merge-params + org-babel-default-header-args + (if (boundp lang-headers) (eval lang-headers) nil) + (append (org-babel-params-from-properties lang) + (list raw-params)))))) + (setf hash (org-babel-sha1-hash info))) + (org-babel-exp-do-export info 'block hash))))) + +(defcustom org-babel-exp-call-line-template + "" + "Template used to export call lines. +This template may be customized to include the call line name +with any export markup. The template is filled out using +`org-fill-template', and the following %keys may be used. + + line --- call line + +An example value would be \"\\n: call: %line\" to export the call line +wrapped in a verbatim environment. + +Note: the results are inserted separately after the contents of +this template." + :group 'org-babel + :type 'string) + +(defvar org-babel-default-lob-header-args) +(defun org-babel-exp-process-buffer () + "Execute all Babel blocks in current buffer." + (interactive) + (save-window-excursion + (save-excursion + (let ((case-fold-search t) + (regexp (concat org-babel-inline-src-block-regexp "\\|" + org-babel-lob-one-liner-regexp "\\|" + "^[ \t]*#\\+BEGIN_SRC"))) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (let* ((element (save-excursion + ;; If match is inline, point is at its + ;; end. Move backward so + ;; `org-element-context' can get the + ;; object, not the following one. + (backward-char) + (save-match-data (org-element-context)))) + (type (org-element-type element)) + (begin (copy-marker (org-element-property :begin element))) + (end (copy-marker + (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (point))))) + (case type + (inline-src-block + (let* ((info (org-babel-parse-inline-src-block-match)) + (params (nth 2 info))) + (setf (nth 1 info) + (if (and (cdr (assoc :noweb params)) + (string= "yes" (cdr (assoc :noweb params)))) + (org-babel-expand-noweb-references + info (org-babel-exp-get-export-buffer)) + (nth 1 info))) + (goto-char begin) + (let ((replacement (org-babel-exp-do-export info 'inline))) + (if (equal replacement "") + ;; Replacement code is empty: remove inline src + ;; block, including extra white space that + ;; might have been created when inserting + ;; results. + (delete-region begin + (progn (goto-char end) + (skip-chars-forward " \t") + (point))) + ;; Otherwise: remove inline src block but + ;; preserve following white spaces. Then insert + ;; value. + (delete-region begin end) + (insert replacement))))) + ((babel-call inline-babel-call) + (let* ((lob-info (org-babel-lob-get-info)) + (results + (org-babel-exp-do-export + (list "emacs-lisp" "results" + (apply #'org-babel-merge-params + org-babel-default-header-args + org-babel-default-lob-header-args + (append + (org-babel-params-from-properties) + (list + (org-babel-parse-header-arguments + (org-no-properties + (concat + ":var results=" + (mapconcat 'identity + (butlast lob-info 2) + " "))))))) + "" (nth 3 lob-info) (nth 2 lob-info)) + 'lob)) + (rep (org-fill-template + org-babel-exp-call-line-template + `(("line" . ,(nth 0 lob-info)))))) + ;; If replacement is empty, completely remove the + ;; object/element, including any extra white space + ;; that might have been created when including + ;; results. + (if (equal rep "") + (delete-region + begin + (progn (goto-char end) + (if (not (eq type 'babel-call)) + (progn (skip-chars-forward " \t") (point)) + (skip-chars-forward " \r\t\n") + (line-beginning-position)))) + ;; Otherwise, preserve following white + ;; spaces/newlines and then, insert replacement + ;; string. + (goto-char begin) + (delete-region begin end) + (insert rep)))) + (src-block + (let* ((match-start (copy-marker (match-beginning 0))) + (ind (org-get-indentation)) + (headers + (cons + (org-element-property :language element) + (let ((params (org-element-property :parameters + element))) + (and params (org-split-string params "[ \t]+")))))) + ;; Take care of matched block: compute replacement + ;; string. In particular, a nil REPLACEMENT means + ;; the block should be left as-is while an empty + ;; string should remove the block. + (let ((replacement (progn (goto-char match-start) + (org-babel-exp-src-block headers)))) + (cond ((not replacement) (goto-char end)) + ((equal replacement "") + (goto-char end) + (skip-chars-forward " \r\t\n") + (beginning-of-line) + (delete-region begin (point))) + (t + (goto-char match-start) + (delete-region (point) + (save-excursion (goto-char end) + (line-end-position))) + (insert replacement) + (if (or org-src-preserve-indentation + (org-element-property :preserve-indent + element)) + ;; Indent only the code block markers. + (save-excursion (skip-chars-backward " \r\t\n") + (indent-line-to ind) + (goto-char match-start) + (indent-line-to ind)) + ;; Indent everything. + (indent-rigidly match-start (point) ind))))) + (set-marker match-start nil)))) + (set-marker begin nil) + (set-marker end nil))))))) + +(defun org-babel-in-example-or-verbatim () + "Return true if point is in example or verbatim code. +Example and verbatim code include escaped portions of +an org-mode buffer code that should be treated as normal +org-mode text." + (or (save-match-data + (save-excursion + (goto-char (point-at-bol)) + (looking-at "[ \t]*:[ \t]"))) + (org-in-verbatim-emphasis) + (org-in-block-p org-list-forbidden-blocks) + (org-between-regexps-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src"))) + +(defun org-babel-exp-do-export (info type &optional hash) + "Return a string with the exported content of a code block. +The function respects the value of the :exports header argument." + (let ((silently (lambda () (let ((session (cdr (assoc :session (nth 2 info))))) + (when (not (and session (equal "none" session))) + (org-babel-exp-results info type 'silent))))) + (clean (lambda () (unless (eq type 'inline) (org-babel-remove-result info))))) + (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) + ('none (funcall silently) (funcall clean) "") + ('code (funcall silently) (funcall clean) (org-babel-exp-code info)) + ('results (org-babel-exp-results info type nil hash) "") + ('both (org-babel-exp-results info type nil hash) + (org-babel-exp-code info))))) + +(defcustom org-babel-exp-code-template + "#+BEGIN_SRC %lang%switches%flags\n%body\n#+END_SRC" + "Template used to export the body of code blocks. +This template may be customized to include additional information +such as the code block name, or the values of particular header +arguments. The template is filled out using `org-fill-template', +and the following %keys may be used. + + lang ------ the language of the code block + name ------ the name of the code block + body ------ the body of the code block + switches -- the switches associated to the code block + flags ----- the flags passed to the code block + +In addition to the keys mentioned above, every header argument +defined for the code block may be used as a key and will be +replaced with its value." + :group 'org-babel + :type 'string) + +(defun org-babel-exp-code (info) + "Return the original code block formatted for export." + (setf (nth 1 info) + (if (string= "strip-export" (cdr (assoc :noweb (nth 2 info)))) + (replace-regexp-in-string + (org-babel-noweb-wrap) "" (nth 1 info)) + (if (org-babel-noweb-p (nth 2 info) :export) + (org-babel-expand-noweb-references + info (org-babel-exp-get-export-buffer)) + (nth 1 info)))) + (org-fill-template + org-babel-exp-code-template + `(("lang" . ,(nth 0 info)) + ("body" . ,(org-escape-code-in-string (nth 1 info))) + ("switches" . ,(let ((f (nth 3 info))) + (and (org-string-nw-p f) (concat " " f)))) + ("flags" . ,(let ((f (assq :flags (nth 2 info)))) + (and f (concat " " (cdr f))))) + ,@(mapcar (lambda (pair) + (cons (substring (symbol-name (car pair)) 1) + (format "%S" (cdr pair)))) + (nth 2 info)) + ("name" . ,(or (nth 4 info) ""))))) + +(defun org-babel-exp-results (info type &optional silent hash) + "Evaluate and return the results of the current code block for export. +Results are prepared in a manner suitable for export by org-mode. +This function is called by `org-babel-exp-do-export'. The code +block will be evaluated. Optional argument SILENT can be used to +inhibit insertion of results into the buffer." + (when (and (or (eq org-export-babel-evaluate t) + (and (eq type 'inline) + (eq org-export-babel-evaluate 'inline-only))) + (not (and hash (equal hash (org-babel-current-result-hash))))) + (let ((lang (nth 0 info)) + (body (if (org-babel-noweb-p (nth 2 info) :eval) + (org-babel-expand-noweb-references + info (org-babel-exp-get-export-buffer)) + (nth 1 info))) + (info (copy-sequence info)) + (org-babel-current-src-block-location (point-marker))) + ;; skip code blocks which we can't evaluate + (when (fboundp (intern (concat "org-babel-execute:" lang))) + (org-babel-eval-wipe-error-buffer) + (prog1 nil + (setf (nth 1 info) body) + (setf (nth 2 info) + (org-babel-exp-in-export-file lang + (org-babel-process-params + (org-babel-merge-params + (nth 2 info) + `((:results . ,(if silent "silent" "replace"))))))) + (cond + ((equal type 'block) + (org-babel-execute-src-block nil info)) + ((equal type 'inline) + ;; position the point on the inline source block allowing + ;; `org-babel-insert-result' to check that the block is + ;; inline + (re-search-backward "[ \f\t\n\r\v]" nil t) + (re-search-forward org-babel-inline-src-block-regexp nil t) + (re-search-backward "src_" nil t) + (org-babel-execute-src-block nil info)) + ((equal type 'lob) + (save-excursion + (re-search-backward org-babel-lob-one-liner-regexp nil t) + (let (org-confirm-babel-evaluate) + (org-babel-execute-src-block nil info)))))))))) + + +(provide 'ob-exp) + +;;; ob-exp.el ends here diff --git a/elpa/org-20150427/ob-fortran.el b/elpa/org-20150427/ob-fortran.el new file mode 100644 index 00000000..0211fda5 --- /dev/null +++ b/elpa/org-20150427/ob-fortran.el @@ -0,0 +1,168 @@ +;;; ob-fortran.el --- org-babel functions for fortran + +;; Copyright (C) 2011-2014 Free Software Foundation, Inc. + +;; Authors: Sergey Litvinov +;; Eric Schulte +;; Keywords: literate programming, reproducible research, fortran +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating fortran code. + +;;; Code: +(require 'ob) +(require 'cc-mode) + +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) +(declare-function org-every "org" (pred seq)) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90")) + +(defvar org-babel-default-header-args:fortran '()) + +(defvar org-babel-fortran-compiler "gfortran" + "fortran command used to compile a fortran source code file into an + executable.") + +(defun org-babel-execute:fortran (body params) + "This function should only be called by `org-babel-execute:fortran'" + (let* ((tmp-src-file (org-babel-temp-file "fortran-src-" ".F90")) + (tmp-bin-file (org-babel-temp-file "fortran-bin-" org-babel-exeext)) + (cmdline (cdr (assoc :cmdline params))) + (flags (cdr (assoc :flags params))) + (full-body (org-babel-expand-body:fortran body params)) + (compile + (progn + (with-temp-file tmp-src-file (insert full-body)) + (org-babel-eval + (format "%s -o %s %s %s" + org-babel-fortran-compiler + (org-babel-process-file-name tmp-bin-file) + (mapconcat 'identity + (if (listp flags) flags (list flags)) " ") + (org-babel-process-file-name tmp-src-file)) "")))) + (let ((results + (org-babel-trim + (org-babel-eval + (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))) + (org-babel-reassemble-table + (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-read results) + (let ((tmp-file (org-babel-temp-file "f-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) + +(defun org-babel-expand-body:fortran (body params) + "Expand a block of fortran or fortran code with org-babel according to +it's header arguments." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (main-p (not (string= (cdr (assoc :main params)) "no"))) + (includes (or (cdr (assoc :includes params)) + (org-babel-read (org-entry-get nil "includes" t)))) + (defines (org-babel-read + (or (cdr (assoc :defines params)) + (org-babel-read (org-entry-get nil "defines" t)))))) + (mapconcat 'identity + (list + ;; includes + (mapconcat + (lambda (inc) (format "#include %s" inc)) + (if (listp includes) includes (list includes)) "\n") + ;; defines + (mapconcat + (lambda (inc) (format "#define %s" inc)) + (if (listp defines) defines (list defines)) "\n") + ;; body + (if main-p + (org-babel-fortran-ensure-main-wrap + (concat + ;; variables + (mapconcat 'org-babel-fortran-var-to-fortran vars "\n") + body) params) + body) "\n") "\n"))) + +(defun org-babel-fortran-ensure-main-wrap (body params) + "Wrap body in a \"program ... end program\" block if none exists." + (if (string-match "^[ \t]*program[ \t]*.*" (capitalize body)) + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (if vars (error "Cannot use :vars if 'program' statement is present")) + body) + (format "program main\n%s\nend program main\n" body))) + +(defun org-babel-prep-session:fortran (session params) + "This function does nothing as fortran is a compiled language with no +support for sessions" + (error "Fortran is a compiled languages -- no support for sessions")) + +(defun org-babel-load-session:fortran (session body params) + "This function does nothing as fortran is a compiled language with no +support for sessions" + (error "Fortran is a compiled languages -- no support for sessions")) + +;; helper functions + +(defun org-babel-fortran-var-to-fortran (pair) + "Convert an elisp val into a string of fortran code specifying a var +of the same value." + ;; TODO list support + (let ((var (car pair)) + (val (cdr pair))) + (when (symbolp val) + (setq val (symbol-name val)) + (when (= (length val) 1) + (setq val (string-to-char val)))) + (cond + ((integerp val) + (format "integer, parameter :: %S = %S\n" var val)) + ((floatp val) + (format "real, parameter :: %S = %S\n" var val)) + ((or (integerp val)) + (format "character, parameter :: %S = '%S'\n" var val)) + ((stringp val) + (format "character(len=%d), parameter :: %S = '%s'\n" + (length val) var val)) + ;; val is a matrix + ((and (listp val) (org-every #'listp val)) + (format "real, parameter :: %S(%d,%d) = transpose( reshape( %s , (/ %d, %d /) ) )\n" + var (length val) (length (car val)) + (org-babel-fortran-transform-list val) + (length (car val)) (length val))) + ((listp val) + (format "real, parameter :: %S(%d) = %s\n" + var (length val) (org-babel-fortran-transform-list val))) + (t + (error (format "the type of parameter %s is not supported by ob-fortran" + var)))))) + +(defun org-babel-fortran-transform-list (val) + "Return a fortran representation of enclose syntactic lists." + (if (listp val) + (concat "(/" (mapconcat #'org-babel-fortran-transform-list val ", ") "/)") + (format "%S" val))) + +(provide 'ob-fortran) + +;;; ob-fortran.el ends here diff --git a/elpa/org-20150427/ob-gnuplot.el b/elpa/org-20150427/ob-gnuplot.el new file mode 100644 index 00000000..ffe5dcf5 --- /dev/null +++ b/elpa/org-20150427/ob-gnuplot.el @@ -0,0 +1,285 @@ +;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating gnuplot source code. +;; +;; This differs from most standard languages in that +;; +;; 1) we are generally only going to return results of type "file" +;; +;; 2) we are adding the "file" and "cmdline" header arguments + +;;; Requirements: + +;; - gnuplot :: http://www.gnuplot.info/ +;; +;; - gnuplot-mode :: http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function org-time-string-to-time "org" (s)) +(declare-function org-combine-plists "org" (&rest plists)) +(declare-function orgtbl-to-generic "org-table" (table params)) +(declare-function gnuplot-mode "ext:gnuplot-mode" ()) +(declare-function gnuplot-send-string-to-gnuplot "ext:gnuplot-mode" (str txt)) +(declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot-mode" ()) + +(defvar org-babel-default-header-args:gnuplot + '((:results . "file") (:exports . "results") (:session . nil)) + "Default arguments to use when evaluating a gnuplot source block.") + +(defvar org-babel-header-args:gnuplot + '((title . :any) + (lines . :any) + (sets . :any) + (x-labels . :any) + (y-labels . :any) + (timefmt . :any) + (time-ind . :any) + (missing . :any) + (term . :any)) + "Gnuplot specific header args.") + +(defvar org-babel-gnuplot-timestamp-fmt nil) + +(defvar *org-babel-gnuplot-missing* nil) + +(defcustom *org-babel-gnuplot-terms* + '((eps . "postscript eps")) + "List of file extensions and the associated gnuplot terminal." + :group 'org-babel + :type '(repeat (cons (symbol :tag "File extension") + (string :tag "Gnuplot terminal")))) + +(defun org-babel-gnuplot-process-vars (params) + "Extract variables from PARAMS and process the variables. +Dumps all vectors into files and returns an association list +of variable names and the related value to be used in the gnuplot +code." + (let ((*org-babel-gnuplot-missing* (cdr (assoc :missing params)))) + (mapcar + (lambda (pair) + (cons + (car pair) ;; variable name + (let* ((val (cdr pair)) ;; variable value + (lp (listp val))) + (if lp + (org-babel-gnuplot-table-to-data + (let* ((first (car val)) + (tablep (or (listp first) (symbolp first)))) + (if tablep val (mapcar 'list val))) + (org-babel-temp-file "gnuplot-") params) + val)))) + (mapcar #'cdr (org-babel-get-header params :var))))) + +(defun org-babel-expand-body:gnuplot (body params) + "Expand BODY according to PARAMS, return the expanded body." + (save-window-excursion + (let* ((vars (org-babel-gnuplot-process-vars params)) + (out-file (cdr (assoc :file params))) + (prologue (cdr (assoc :prologue params))) + (epilogue (cdr (assoc :epilogue params))) + (term (or (cdr (assoc :term params)) + (when out-file + (let ((ext (file-name-extension out-file))) + (or (cdr (assoc (intern (downcase ext)) + *org-babel-gnuplot-terms*)) + ext))))) + (cmdline (cdr (assoc :cmdline params))) + (title (cdr (assoc :title params))) + (lines (cdr (assoc :line params))) + (sets (cdr (assoc :set params))) + (x-labels (cdr (assoc :xlabels params))) + (y-labels (cdr (assoc :ylabels params))) + (timefmt (cdr (assoc :timefmt params))) + (time-ind (or (cdr (assoc :timeind params)) + (when timefmt 1))) + (missing (cdr (assoc :missing params))) + (add-to-body (lambda (text) (setq body (concat text "\n" body)))) + output) + ;; append header argument settings to body + (when title (funcall add-to-body (format "set title '%s'" title))) + (when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) + (when missing + (funcall add-to-body (format "set datafile missing '%s'" missing))) + (when sets + (mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets)) + (when x-labels + (funcall add-to-body + (format "set xtics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" + (cdr pair) (car pair))) + x-labels ", ")))) + (when y-labels + (funcall add-to-body + (format "set ytics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" + (cdr pair) (car pair))) + y-labels ", ")))) + (when time-ind + (funcall add-to-body "set xdata time") + (funcall add-to-body (concat "set timefmt \"" + (or timefmt + "%Y-%m-%d-%H:%M:%S") "\""))) + (when out-file + ;; set the terminal at the top of the block + (funcall add-to-body (format "set output \"%s\"" out-file)) + ;; and close the terminal at the bottom of the block + (setq body (concat body "\nset output\n"))) + (when term (funcall add-to-body (format "set term %s" term))) + ;; insert variables into code body: this should happen last + ;; placing the variables at the *top* of the code in case their + ;; values are used later + (funcall add-to-body + (mapconcat #'identity + (org-babel-variable-assignments:gnuplot params) + "\n")) + ;; replace any variable names preceded by '$' with the actual + ;; value of the variable + (mapc (lambda (pair) + (setq body (replace-regexp-in-string + (format "\\$%s" (car pair)) (cdr pair) body))) + vars) + (when prologue (funcall add-to-body prologue)) + (when epilogue (setq body (concat body "\n" epilogue)))) + body)) + +(defun org-babel-execute:gnuplot (body params) + "Execute a block of Gnuplot code. +This function is called by `org-babel-execute-src-block'." + (require 'gnuplot) + (let ((session (cdr (assoc :session params))) + (result-type (cdr (assoc :results params))) + (out-file (cdr (assoc :file params))) + (body (org-babel-expand-body:gnuplot body params)) + output) + (save-window-excursion + ;; evaluate the code body with gnuplot + (if (string= session "none") + (let ((script-file (org-babel-temp-file "gnuplot-script-"))) + (with-temp-file script-file + (insert (concat body "\n"))) + (message "gnuplot \"%s\"" script-file) + (setq output + (shell-command-to-string + (format + "gnuplot \"%s\"" + (org-babel-process-file-name + script-file + (if (member system-type '(cygwin windows-nt ms-dos)) + t nil))))) + (message output)) + (with-temp-buffer + (insert (concat body "\n")) + (gnuplot-mode) + (gnuplot-send-buffer-to-gnuplot))) + (if (member "output" (split-string result-type)) + output + nil)))) ;; signal that output has already been written to file + +(defun org-babel-prep-session:gnuplot (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (let* ((session (org-babel-gnuplot-initiate-session session)) + (var-lines (org-babel-variable-assignments:gnuplot params))) + (message "%S" session) + (org-babel-comint-in-buffer session + (mapc (lambda (var-line) + (insert var-line) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines)) + session)) + +(defun org-babel-load-session:gnuplot (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:gnuplot session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +(defun org-babel-variable-assignments:gnuplot (params) + "Return list of gnuplot statements assigning the block's variables." + (mapcar + (lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair))) + (org-babel-gnuplot-process-vars params))) + +(defvar gnuplot-buffer) +(defun org-babel-gnuplot-initiate-session (&optional session params) + "Initiate a gnuplot session. +If there is not a current inferior-process-buffer in SESSION +then create one. Return the initialized session. The current +`gnuplot-mode' doesn't provide support for multiple sessions." + (require 'gnuplot) + (unless (string= session "none") + (save-window-excursion + (gnuplot-send-string-to-gnuplot "" "line") + gnuplot-buffer))) + +(defun org-babel-gnuplot-quote-timestamp-field (s) + "Convert S from timestamp to Unix time and export to gnuplot." + (format-time-string org-babel-gnuplot-timestamp-fmt + (org-time-string-to-time s))) + +(defvar org-table-number-regexp) +(defvar org-ts-regexp3) +(defun org-babel-gnuplot-quote-tsv-field (s) + "Quote S for export to gnuplot." + (unless (stringp s) + (setq s (format "%s" s))) + (if (string-match org-table-number-regexp s) s + (if (string-match org-ts-regexp3 s) + (org-babel-gnuplot-quote-timestamp-field s) + (if (zerop (length s)) + (or *org-babel-gnuplot-missing* s) + (if (string-match "[ \"]" s) + (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") + "\"") + s))))) + +(defun org-babel-gnuplot-table-to-data (table data-file params) + "Export TABLE to DATA-FILE in a format readable by gnuplot. +Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." + (with-temp-file data-file + (make-local-variable 'org-babel-gnuplot-timestamp-fmt) + (setq org-babel-gnuplot-timestamp-fmt (or + (plist-get params :timefmt) + "%Y-%m-%d-%H:%M:%S")) + (insert (orgtbl-to-generic + table + (org-combine-plists + '(:sep "\t" :fmt org-babel-gnuplot-quote-tsv-field) + params)))) + data-file) + +(provide 'ob-gnuplot) + + + +;;; ob-gnuplot.el ends here diff --git a/elpa/org-20150427/ob-haskell.el b/elpa/org-20150427/ob-haskell.el new file mode 100644 index 00000000..00066702 --- /dev/null +++ b/elpa/org-20150427/ob-haskell.el @@ -0,0 +1,225 @@ +;;; ob-haskell.el --- org-babel functions for haskell evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating haskell source code. This one will +;; be sort of tricky because haskell programs must be compiled before +;; they can be run, but haskell code can also be run through an +;; interactive interpreter. +;; +;; For now lets only allow evaluation using the haskell interpreter. + +;;; Requirements: + +;; - haskell-mode :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode +;; +;; - inf-haskell :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode +;; +;; - (optionally) lhs2tex :: http://people.cs.uu.nl/andres/lhs2tex/ + +;;; Code: +(require 'ob) +(require 'comint) +(eval-when-compile (require 'cl)) + +(declare-function org-remove-indentation "org" (code &optional n)) +(declare-function haskell-mode "ext:haskell-mode" ()) +(declare-function run-haskell "ext:inf-haskell" (&optional arg)) +(declare-function inferior-haskell-load-file + "ext:inf-haskell" (&optional reload)) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs")) + +(defvar org-babel-default-header-args:haskell + '((:padlines . "no"))) + +(defvar org-babel-haskell-lhs2tex-command "lhs2tex") + +(defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"") + +(defun org-babel-execute:haskell (body params) + "Execute a block of Haskell code." + (let* ((session (cdr (assoc :session params))) + (vars (mapcar #'cdr (org-babel-get-header params :var))) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params + (org-babel-variable-assignments:haskell params))) + (session (org-babel-haskell-initiate-session session params)) + (raw (org-babel-comint-with-output + (session org-babel-haskell-eoe t full-body) + (insert (org-babel-trim full-body)) + (comint-send-input nil t) + (insert org-babel-haskell-eoe) + (comint-send-input nil t))) + (results (mapcar + #'org-babel-haskell-read-string + (cdr (member org-babel-haskell-eoe + (reverse (mapcar #'org-babel-trim raw))))))) + (org-babel-reassemble-table + (let ((result + (case result-type + (output (mapconcat #'identity (reverse (cdr results)) "\n")) + (value (car results))))) + (org-babel-result-cond (cdr (assoc :result-params params)) + result (org-babel-haskell-table-or-string result))) + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colname-names params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rowname-names params)))))) + +(defun org-babel-haskell-read-string (string) + "Strip \\\"s from around a haskell string." + (if (string-match "^\"\\([^\000]+\\)\"$" string) + (match-string 1 string) + string)) + +(defun org-babel-haskell-initiate-session (&optional session params) + "Initiate a haskell session. +If there is not a current inferior-process-buffer in SESSION +then create one. Return the initialized session." + (require 'inf-haskell) + (or (get-buffer "*haskell*") + (save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer)))) + +(defun org-babel-load-session:haskell (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let* ((buffer (org-babel-prep-session:haskell session params)) + (load-file (concat (org-babel-temp-file "haskell-load-") ".hs"))) + (with-temp-buffer + (insert body) (write-file load-file) + (haskell-mode) (inferior-haskell-load-file)) + buffer))) + +(defun org-babel-prep-session:haskell (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (save-window-excursion + (let ((buffer (org-babel-haskell-initiate-session session))) + (org-babel-comint-in-buffer buffer + (mapc (lambda (line) + (insert line) + (comint-send-input nil t)) + (org-babel-variable-assignments:haskell params))) + (current-buffer)))) + +(defun org-babel-variable-assignments:haskell (params) + "Return list of haskell statements assigning the block's variables." + (mapcar (lambda (pair) + (format "let %s = %s" + (car pair) + (org-babel-haskell-var-to-haskell (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-haskell-table-or-string (results) + "Convert RESULTS to an Emacs-lisp table or string. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape results)) + +(defun org-babel-haskell-var-to-haskell (var) + "Convert an elisp value VAR into a haskell variable. +The elisp VAR is converted to a string of haskell source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-haskell-var-to-haskell var ", ") "]") + (format "%S" var))) + +(defvar org-export-copy-to-kill-ring) +(declare-function org-export-to-file "ox" + (backend file + &optional async subtreep visible-only body-only ext-plist)) +(defun org-babel-haskell-export-to-lhs (&optional arg) + "Export to a .lhs file with all haskell code blocks escaped. +When called with a prefix argument the resulting +.lhs file will be exported to a .tex file. This function will +create two new files, base-name.lhs and base-name.tex where +base-name is the name of the current org-mode file. + +Note that all standard Babel literate programming +constructs (header arguments, no-web syntax etc...) are ignored." + (interactive "P") + (let* ((contents (buffer-string)) + (haskell-regexp + (concat "^\\([ \t]*\\)#\\+begin_src[ \t]haskell*\\(.*\\)?[\r\n]" + "\\([^\000]*?\\)[\r\n][ \t]*#\\+end_src.*")) + (base-name (file-name-sans-extension (buffer-file-name))) + (tmp-file (org-babel-temp-file "haskell-")) + (tmp-org-file (concat tmp-file ".org")) + (tmp-tex-file (concat tmp-file ".tex")) + (lhs-file (concat base-name ".lhs")) + (tex-file (concat base-name ".tex")) + (command (concat org-babel-haskell-lhs2tex-command + " " (org-babel-process-file-name lhs-file) + " > " (org-babel-process-file-name tex-file))) + (preserve-indentp org-src-preserve-indentation) + indentation) + ;; escape haskell source-code blocks + (with-temp-file tmp-org-file + (insert contents) + (goto-char (point-min)) + (while (re-search-forward haskell-regexp nil t) + (save-match-data (setq indentation (length (match-string 1)))) + (replace-match (save-match-data + (concat + "#+begin_latex\n\\begin{code}\n" + (if (or preserve-indentp + (string-match "-i" (match-string 2))) + (match-string 3) + (org-remove-indentation (match-string 3))) + "\n\\end{code}\n#+end_latex\n")) + t t) + (indent-code-rigidly (match-beginning 0) (match-end 0) indentation))) + (save-excursion + ;; export to latex w/org and save as .lhs + (require 'ox-latex) + (find-file tmp-org-file) + ;; Ensure we do not clutter kill ring with incomplete results. + (let (org-export-copy-to-kill-ring) + (org-export-to-file 'latex tmp-tex-file)) + (kill-buffer nil) + (delete-file tmp-org-file) + (find-file tmp-tex-file) + (goto-char (point-min)) (forward-line 2) + (insert "%include polycode.fmt\n") + ;; ensure all \begin/end{code} statements start at the first column + (while (re-search-forward "^[ \t]+\\\\begin{code}[^\000]+\\\\end{code}" nil t) + (replace-match (save-match-data (org-remove-indentation (match-string 0))) + t t)) + (setq contents (buffer-string)) + (save-buffer) (kill-buffer nil)) + (delete-file tmp-tex-file) + ;; save org exported latex to a .lhs file + (with-temp-file lhs-file (insert contents)) + (if (not arg) + (find-file lhs-file) + ;; process .lhs file with lhs2tex + (message "running %s" command) (shell-command command) (find-file tex-file)))) + +(provide 'ob-haskell) + + + +;;; ob-haskell.el ends here diff --git a/elpa/org-20150427/ob-io.el b/elpa/org-20150427/ob-io.el new file mode 100644 index 00000000..971b37fc --- /dev/null +++ b/elpa/org-20150427/ob-io.el @@ -0,0 +1,118 @@ +;;; ob-io.el --- org-babel functions for Io evaluation + +;; Copyright (C) 2012-2014 Free Software Foundation, Inc. + +;; Author: Andrzej Lichnerowicz +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: +;; Currently only supports the external execution. No session support yet. +;; :results output -- runs in scripting mode +;; :results output repl -- runs in repl mode + +;;; Requirements: +;; - Io language :: http://iolanguage.org/ +;; - Io major mode :: Can be installed from Io sources +;; https://github.com/stevedekorte/io/blob/master/extras/SyntaxHighlighters/Emacs/io-mode.el + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(defvar org-babel-tangle-lang-exts) ;; Autoloaded +(add-to-list 'org-babel-tangle-lang-exts '("io" . "io")) +(defvar org-babel-default-header-args:io '()) +(defvar org-babel-io-command "io" + "Name of the command to use for executing Io code.") + +(defun org-babel-execute:io (body params) + "Execute a block of Io code with org-babel. This function is +called by `org-babel-execute-src-block'" + (message "executing Io source code block") + (let* ((processed-params (org-babel-process-params params)) + (session (org-babel-io-initiate-session (nth 0 processed-params))) + (vars (nth 1 processed-params)) + (result-params (nth 2 processed-params)) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params)) + (result (org-babel-io-evaluate + session full-body result-type result-params))) + + (org-babel-reassemble-table + result + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + + +(defun org-babel-io-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape results)) + + +(defvar org-babel-io-wrapper-method + "( +%s +) asString print +") + + +(defun org-babel-io-evaluate (session body &optional result-type result-params) + "Evaluate BODY in external Io process. +If RESULT-TYPE equals 'output then return standard output as a string. +If RESULT-TYPE equals 'value then return the value of the last statement +in BODY as elisp." + (when session (error "Sessions are not (yet) supported for Io")) + (case result-type + (output + (if (member "repl" result-params) + (org-babel-eval org-babel-io-command body) + (let ((src-file (org-babel-temp-file "io-"))) + (progn (with-temp-file src-file (insert body)) + (org-babel-eval + (concat org-babel-io-command " " src-file) ""))))) + (value (let* ((src-file (org-babel-temp-file "io-")) + (wrapper (format org-babel-io-wrapper-method body))) + (with-temp-file src-file (insert wrapper)) + (let ((raw (org-babel-eval + (concat org-babel-io-command " " src-file) ""))) + (org-babel-result-cond result-params + raw + (org-babel-io-table-or-string raw))))))) + + +(defun org-babel-prep-session:io (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (error "Sessions are not (yet) supported for Io")) + +(defun org-babel-io-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session. Sessions are not +supported in Io." + nil) + +(provide 'ob-io) + + + +;;; ob-io.el ends here diff --git a/elpa/org-20150427/ob-java.el b/elpa/org-20150427/ob-java.el new file mode 100644 index 00000000..22f8785f --- /dev/null +++ b/elpa/org-20150427/ob-java.el @@ -0,0 +1,75 @@ +;;; ob-java.el --- org-babel functions for java evaluation + +;; Copyright (C) 2011-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Currently this only supports the external compilation and execution +;; of java code blocks (i.e., no session support). + +;;; Code: +(require 'ob) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("java" . "java")) + +(defvar org-babel-java-command "java" + "Name of the java command.") + +(defvar org-babel-java-compiler "javac" + "Name of the java compiler.") + +(defun org-babel-execute:java (body params) + (let* ((classname (or (cdr (assoc :classname params)) + (error + "Can't compile a java block without a classname"))) + (packagename (file-name-directory classname)) + (src-file (concat classname ".java")) + (cmpflag (or (cdr (assoc :cmpflag params)) "")) + (cmdline (or (cdr (assoc :cmdline params)) "")) + (full-body (org-babel-expand-body:generic body params)) + (compile + (progn (with-temp-file src-file (insert full-body)) + (org-babel-eval + (concat org-babel-java-compiler + " " cmpflag " " src-file) "")))) + ;; created package-name directories if missing + (unless (or (not packagename) (file-exists-p packagename)) + (make-directory packagename 'parents)) + (let ((results (org-babel-eval (concat org-babel-java-command + " " cmdline " " classname) ""))) + (org-babel-reassemble-table + (org-babel-result-cond (cdr (assoc :result-params params)) + (org-babel-read results) + (let ((tmp-file (org-babel-temp-file "c-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) + +(provide 'ob-java) + + + +;;; ob-java.el ends here diff --git a/elpa/org-20150427/ob-js.el b/elpa/org-20150427/ob-js.el new file mode 100644 index 00000000..ea51ed98 --- /dev/null +++ b/elpa/org-20150427/ob-js.el @@ -0,0 +1,162 @@ +;;; ob-js.el --- org-babel functions for Javascript + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, js +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Now working with SBCL for both session and external evaluation. +;; +;; This certainly isn't optimally robust, but it seems to be working +;; for the basic use cases. + +;;; Requirements: + +;; - a non-browser javascript engine such as node.js http://nodejs.org/ +;; or mozrepl http://wiki.github.com/bard/mozrepl/ +;; +;; - for session based evaluation mozrepl and moz.el are required see +;; http://wiki.github.com/bard/mozrepl/emacs-integration for +;; configuration instructions + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function run-mozilla "ext:moz" (arg)) + +(defvar org-babel-default-header-args:js '() + "Default header arguments for js code blocks.") + +(defvar org-babel-js-eoe "org-babel-js-eoe" + "String to indicate that evaluation has completed.") + +(defcustom org-babel-js-cmd "node" + "Name of command used to evaluate js blocks." + :group 'org-babel + :version "24.1" + :type 'string) + +(defvar org-babel-js-function-wrapper + "require('sys').print(require('sys').inspect(function(){%s}()));" + "Javascript code to print value of body.") + +(defun org-babel-execute:js (body params) + "Execute a block of Javascript code with org-babel. +This function is called by `org-babel-execute-src-block'" + (let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd)) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params (org-babel-variable-assignments:js params))) + (result (if (not (string= (cdr (assoc :session params)) "none")) + ;; session evaluation + (let ((session (org-babel-prep-session:js + (cdr (assoc :session params)) params))) + (nth 1 + (org-babel-comint-with-output + (session (format "%S" org-babel-js-eoe) t body) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) + (comint-send-input nil t)) + (list body (format "%S" org-babel-js-eoe)))))) + ;; external evaluation + (let ((script-file (org-babel-temp-file "js-script-"))) + (with-temp-file script-file + (insert + ;; return the value or the output + (if (string= result-type "value") + (format org-babel-js-function-wrapper full-body) + full-body))) + (org-babel-eval + (format "%s %s" org-babel-js-cmd + (org-babel-process-file-name script-file)) ""))))) + (org-babel-result-cond (cdr (assoc :result-params params)) + result (org-babel-js-read result)))) + +(defun org-babel-js-read (results) + "Convert RESULTS into an appropriate elisp value. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-read + (if (and (stringp results) (string-match "^\\[.+\\]$" results)) + (org-babel-read + (concat "'" + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string + "\\]" ")" (replace-regexp-in-string + ", " " " (replace-regexp-in-string + "'" "\"" results)))))) + results))) + +(defun org-babel-js-var-to-js (var) + "Convert VAR into a js variable. +Convert an elisp value into a string of js source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-js-var-to-js var ", ") "]") + (replace-regexp-in-string "\n" "\\\\n" (format "%S" var)))) + +(defun org-babel-prep-session:js (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-js-initiate-session session)) + (var-lines (org-babel-variable-assignments:js params))) + (when session + (org-babel-comint-in-buffer session + (sit-for .5) (goto-char (point-max)) + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines))) + session)) + +(defun org-babel-variable-assignments:js (params) + "Return list of Javascript statements assigning the block's variables." + (mapcar + (lambda (pair) (format "var %s=%s;" + (car pair) (org-babel-js-var-to-js (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-js-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (unless (string= session "none") + (cond + ((string= "mozrepl" org-babel-js-cmd) + (require 'moz) + (let ((session-buffer (save-window-excursion + (run-mozilla nil) + (rename-buffer session) + (current-buffer)))) + (if (org-babel-comint-buffer-livep session-buffer) + (progn (sit-for .25) session-buffer) + (sit-for .5) + (org-babel-js-initiate-session session)))) + ((string= "node" org-babel-js-cmd ) + (error "Session evaluation with node.js is not supported")) + (t + (error "Sessions are only supported with mozrepl add \":cmd mozrepl\""))))) + +(provide 'ob-js) + + + +;;; ob-js.el ends here diff --git a/elpa/org-20150427/ob-keys.el b/elpa/org-20150427/ob-keys.el new file mode 100644 index 00000000..90b5196c --- /dev/null +++ b/elpa/org-20150427/ob-keys.el @@ -0,0 +1,105 @@ +;;; ob-keys.el --- key bindings for org-babel + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Add org-babel keybindings to the org-mode keymap for exposing +;; org-babel functions. These will all share a common prefix. See +;; the value of `org-babel-key-bindings' for a list of interactive +;; functions and their associated keys. + +;;; Code: +(require 'ob-core) + +(defvar org-babel-key-prefix "\C-c\C-v" + "The key prefix for Babel interactive key-bindings. +See `org-babel-key-bindings' for the list of interactive babel +functions which are assigned key bindings, and see +`org-babel-map' for the actual babel keymap.") + +(defvar org-babel-map (make-sparse-keymap) + "The keymap for interactive Babel functions.") + +;;;###autoload +(defun org-babel-describe-bindings () + "Describe all keybindings behind `org-babel-key-prefix'." + (interactive) + (describe-bindings org-babel-key-prefix)) + +(defvar org-babel-key-bindings + '(("p" . org-babel-previous-src-block) + ("\C-p" . org-babel-previous-src-block) + ("n" . org-babel-next-src-block) + ("\C-n" . org-babel-next-src-block) + ("e" . org-babel-execute-maybe) + ("\C-e" . org-babel-execute-maybe) + ("o" . org-babel-open-src-block-result) + ("\C-o" . org-babel-open-src-block-result) + ("\C-v" . org-babel-expand-src-block) + ("v" . org-babel-expand-src-block) + ("u" . org-babel-goto-src-block-head) + ("\C-u" . org-babel-goto-src-block-head) + ("g" . org-babel-goto-named-src-block) + ("r" . org-babel-goto-named-result) + ("\C-r" . org-babel-goto-named-result) + ("\C-b" . org-babel-execute-buffer) + ("b" . org-babel-execute-buffer) + ("\C-s" . org-babel-execute-subtree) + ("s" . org-babel-execute-subtree) + ("\C-d" . org-babel-demarcate-block) + ("d" . org-babel-demarcate-block) + ("\C-t" . org-babel-tangle) + ("t" . org-babel-tangle) + ("\C-f" . org-babel-tangle-file) + ("f" . org-babel-tangle-file) + ("\C-c" . org-babel-check-src-block) + ("c" . org-babel-check-src-block) + ("\C-j" . org-babel-insert-header-arg) + ("j" . org-babel-insert-header-arg) + ("\C-l" . org-babel-load-in-session) + ("l" . org-babel-load-in-session) + ("\C-i" . org-babel-lob-ingest) + ("i" . org-babel-lob-ingest) + ("\C-I" . org-babel-view-src-block-info) + ("I" . org-babel-view-src-block-info) + ("\C-z" . org-babel-switch-to-session) + ("z" . org-babel-switch-to-session-with-code) + ("\C-a" . org-babel-sha1-hash) + ("a" . org-babel-sha1-hash) + ("h" . org-babel-describe-bindings) + ("\C-x" . org-babel-do-key-sequence-in-edit-buffer) + ("x" . org-babel-do-key-sequence-in-edit-buffer) + ("\C-\M-h" . org-babel-mark-block)) + "Alist of key bindings and interactive Babel functions. +This list associates interactive Babel functions +with keys. Each element of this list will add an entry to the +`org-babel-map' using the letter key which is the `car' of the +a-list placed behind the generic `org-babel-key-prefix'.") + +(provide 'ob-keys) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ob-keys.el ends here diff --git a/elpa/org-20150427/ob-latex.el b/elpa/org-20150427/ob-latex.el new file mode 100644 index 00000000..35b66507 --- /dev/null +++ b/elpa/org-20150427/ob-latex.el @@ -0,0 +1,200 @@ +;;; ob-latex.el --- org-babel functions for latex "evaluation" + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating LaTeX source code. +;; +;; Currently on evaluation this returns raw LaTeX code, unless a :file +;; header argument is given in which case small png or pdf files will +;; be created directly form the latex source code. + +;;; Code: +(require 'ob) + +(declare-function org-create-formula-image "org" (string tofile options buffer)) +(declare-function org-splice-latex-header "org" + (tpl def-pkg pkg snippets-p &optional extra)) +(declare-function org-latex-guess-inputenc "ox-latex" (header)) +(declare-function org-latex-compile "ox-latex" (file)) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) + +(defvar org-format-latex-header) ; From org.el +(defvar org-format-latex-options) ; From org.el +(defvar org-latex-default-packages-alist) ; From org.el +(defvar org-latex-packages-alist) ; From org.el + +(defvar org-babel-default-header-args:latex + '((:results . "latex") (:exports . "results")) + "Default arguments to use when evaluating a LaTeX source block.") + +(defcustom org-babel-latex-htlatex "" + "The htlatex command to enable conversion of latex to SVG or HTML." + :group 'org-babel + :type 'string) + +(defcustom org-babel-latex-htlatex-packages + '("[usenames]{color}" "{tikz}" "{color}" "{listings}" "{amsmath}") + "Packages to use for htlatex export." + :group 'org-babel + :type '(repeat (string))) + +(defun org-babel-expand-body:latex (body params) + "Expand BODY according to PARAMS, return the expanded body." + (mapc (lambda (pair) ;; replace variables + (setq body + (replace-regexp-in-string + (regexp-quote (format "%S" (car pair))) + (if (stringp (cdr pair)) + (cdr pair) (format "%S" (cdr pair))) + body))) (mapcar #'cdr (org-babel-get-header params :var))) + (org-babel-trim body)) + +(defun org-babel-execute:latex (body params) + "Execute a block of Latex code with Babel. +This function is called by `org-babel-execute-src-block'." + (setq body (org-babel-expand-body:latex body params)) + (if (cdr (assoc :file params)) + (let* ((out-file (cdr (assoc :file params))) + (tex-file (org-babel-temp-file "latex-" ".tex")) + (border (cdr (assoc :border params))) + (imagemagick (cdr (assoc :imagemagick params))) + (im-in-options (cdr (assoc :iminoptions params))) + (im-out-options (cdr (assoc :imoutoptions params))) + (pdfpng (cdr (assoc :pdfpng params))) + (fit (or (cdr (assoc :fit params)) border)) + (height (and fit (cdr (assoc :pdfheight params)))) + (width (and fit (cdr (assoc :pdfwidth params)))) + (headers (cdr (assoc :headers params))) + (in-buffer (not (string= "no" (cdr (assoc :buffer params))))) + (org-latex-packages-alist + (append (cdr (assoc :packages params)) org-latex-packages-alist))) + (cond + ((and (string-match "\\.png$" out-file) (not imagemagick)) + (org-create-formula-image + body out-file org-format-latex-options in-buffer)) + ((string-match "\\.tikz$" out-file) + (when (file-exists-p out-file) (delete-file out-file)) + (with-temp-file out-file + (insert body))) + ((or (string-match "\\.pdf$" out-file) imagemagick) + (with-temp-file tex-file + (require 'ox-latex) + (insert + (org-latex-guess-inputenc + (org-splice-latex-header + org-format-latex-header + (delq + nil + (mapcar + (lambda (el) + (unless (and (listp el) (string= "hyperref" (cadr el))) + el)) + org-latex-default-packages-alist)) + org-latex-packages-alist + nil)) + (if fit "\n\\usepackage[active, tightpage]{preview}\n" "") + (if border (format "\\setlength{\\PreviewBorder}{%s}" border) "") + (if height (concat "\n" (format "\\pdfpageheight %s" height)) "") + (if width (concat "\n" (format "\\pdfpagewidth %s" width)) "") + (if headers + (concat "\n" + (if (listp headers) + (mapconcat #'identity headers "\n") + headers) "\n") + "") + (if fit + (concat "\n\\begin{document}\n\\begin{preview}\n" body + "\n\\end{preview}\n\\end{document}\n") + (concat "\n\\begin{document}\n" body "\n\\end{document}\n")))) + (when (file-exists-p out-file) (delete-file out-file)) + (let ((transient-pdf-file (org-babel-latex-tex-to-pdf tex-file))) + (cond + ((string-match "\\.pdf$" out-file) + (rename-file transient-pdf-file out-file)) + (imagemagick + (convert-pdf + transient-pdf-file out-file im-in-options im-out-options) + (when (file-exists-p transient-pdf-file) + (delete-file transient-pdf-file)))))) + ((and (or (string-match "\\.svg$" out-file) + (string-match "\\.html$" out-file)) + (not (string= "" org-babel-latex-htlatex))) + (with-temp-file tex-file + (insert (concat + "\\documentclass[preview]{standalone} +\\def\\pgfsysdriver{pgfsys-tex4ht.def} +" + (mapconcat (lambda (pkg) + (concat "\\usepackage" pkg)) + org-babel-latex-htlatex-packages + "\n") + "\\begin{document}" + body + "\\end{document}"))) + (when (file-exists-p out-file) (delete-file out-file)) + (let ((default-directory (file-name-directory tex-file))) + (shell-command (format "%s %s" org-babel-latex-htlatex tex-file))) + (cond + ((file-exists-p (concat (file-name-sans-extension tex-file) "-1.svg")) + (if (string-match "\\.svg$" out-file) + (progn + (shell-command "pwd") + (shell-command (format "mv %s %s" + (concat (file-name-sans-extension tex-file) "-1.svg") + out-file))) + (error "SVG file produced but HTML file requested."))) + ((file-exists-p (concat (file-name-sans-extension tex-file) ".html")) + (if (string-match "\\.html$" out-file) + (shell-command "mv %s %s" + (concat (file-name-sans-extension tex-file) + ".html") + out-file) + (error "HTML file produced but SVG file requested."))))) + ((string-match "\\.\\([^\\.]+\\)$" out-file) + (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument" + (match-string 1 out-file)))) + nil) ;; signal that output has already been written to file + body)) + +(defun convert-pdf (pdffile out-file im-in-options im-out-options) + "Generate a file from a pdf file using imagemagick." + (let ((cmd (concat "convert " im-in-options " " pdffile " " + im-out-options " " out-file))) + (message (concat "Converting pdffile file " cmd "...")) + (shell-command cmd))) + +(defun org-babel-latex-tex-to-pdf (file) + "Generate a pdf file according to the contents FILE." + (require 'ox-latex) + (org-latex-compile file)) + +(defun org-babel-prep-session:latex (session params) + "Return an error because LaTeX doesn't support sessions." + (error "LaTeX does not support sessions")) + + +(provide 'ob-latex) +;;; ob-latex.el ends here diff --git a/elpa/org-20150427/ob-ledger.el b/elpa/org-20150427/ob-ledger.el new file mode 100644 index 00000000..806fec61 --- /dev/null +++ b/elpa/org-20150427/ob-ledger.el @@ -0,0 +1,71 @@ +;;; ob-ledger.el --- org-babel functions for ledger evaluation + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Eric S Fraga +;; Keywords: literate programming, reproducible research, accounting +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating ledger entries. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in ledger +;; +;; 2) we are generally only going to return output from the ledger program +;; +;; 3) we are adding the "cmdline" header argument +;; +;; 4) there are no variables + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:ledger + '((:results . "output") (:cmdline . "bal")) + "Default arguments to use when evaluating a ledger source block.") + +(defun org-babel-execute:ledger (body params) + "Execute a block of Ledger entries with org-babel. This function is +called by `org-babel-execute-src-block'." + (message "executing Ledger source code block") + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "ledger-")) + (out-file (org-babel-temp-file "ledger-output-"))) + (with-temp-file in-file (insert body)) + (message "%s" (concat "ledger" + " -f " (org-babel-process-file-name in-file) + " " cmdline)) + (with-output-to-string + (shell-command (concat "ledger" + " -f " (org-babel-process-file-name in-file) + " " cmdline + " > " (org-babel-process-file-name out-file)))) + (with-temp-buffer (insert-file-contents out-file) (buffer-string)))) + +(defun org-babel-prep-session:ledger (session params) + (error "Ledger does not support sessions")) + +(provide 'ob-ledger) + + + +;;; ob-ledger.el ends here diff --git a/elpa/org-20150427/ob-lilypond.el b/elpa/org-20150427/ob-lilypond.el new file mode 100644 index 00000000..00a951d3 --- /dev/null +++ b/elpa/org-20150427/ob-lilypond.el @@ -0,0 +1,436 @@ +;;; ob-lilypond.el --- org-babel functions for lilypond evaluation + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Martyn Jago +;; Keywords: babel language, literate programming +;; Homepage: http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.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 . + +;;; Commentary: + +;; Installation, ob-lilypond documentation, and examples are available at +;; http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html +;; +;; Lilypond documentation can be found at +;; http://lilypond.org/manuals.html + +;;; Code: +(require 'ob) +(require 'outline) +(defalias 'lilypond-mode 'LilyPond-mode) + +(add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly")) + +(defvar org-babel-default-header-args:lilypond '() + "Default header arguments for lilypond code blocks. +NOTE: The arguments are determined at lilypond compile time. +See (org-babel-lilypond-set-header-args)") + +(defvar org-babel-lilypond-compile-post-tangle t + "Following the org-babel-tangle (C-c C-v t) command, +org-babel-lilypond-compile-post-tangle determines whether ob-lilypond should +automatically attempt to compile the resultant tangled file. +If the value is nil, no automated compilation takes place. +Default value is t") + +(defvar org-babel-lilypond-display-pdf-post-tangle t + "Following a successful LilyPond compilation +org-babel-lilypond-display-pdf-post-tangle determines whether to automate the +drawing / redrawing of the resultant pdf. If the value is nil, +the pdf is not automatically redrawn. Default value is t") + +(defvar org-babel-lilypond-play-midi-post-tangle t + "Following a successful LilyPond compilation +org-babel-lilypond-play-midi-post-tangle determines whether to automate the +playing of the resultant midi file. If the value is nil, +the midi file is not automatically played. Default value is t") + +(defvar org-babel-lilypond-OSX-ly-path + "/Applications/lilypond.app/Contents/Resources/bin/lilypond") +(defvar org-babel-lilypond-OSX-pdf-path "open") +(defvar org-babel-lilypond-OSX-midi-path "open") + +(defvar org-babel-lilypond-nix-ly-path "/usr/bin/lilypond") +(defvar org-babel-lilypond-nix-pdf-path "evince") +(defvar org-babel-lilypond-nix-midi-path "timidity") + +(defvar org-babel-lilypond-w32-ly-path "lilypond") +(defvar org-babel-lilypond-w32-pdf-path "") +(defvar org-babel-lilypond-w32-midi-path "") + +(defvar org-babel-lilypond-gen-png nil + "Image generation (png) can be turned on by default by setting +ORG-BABEL-LILYPOND-GEN-PNG to t") + +(defvar org-babel-lilypond-gen-svg nil + "Image generation (SVG) can be turned on by default by setting +ORG-BABEL-LILYPOND-GEN-SVG to t") + +(defvar org-babel-lilypond-gen-html nil + "HTML generation can be turned on by default by setting +ORG-BABEL-LILYPOND-GEN-HTML to t") + +(defvar org-babel-lilypond-gen-pdf nil + "PDF generation can be turned on by default by setting +ORG-BABEL-LILYPOND-GEN-PDF to t") + +(defvar org-babel-lilypond-use-eps nil + "You can force the compiler to use the EPS backend by setting +ORG-BABEL-LILYPOND-USE-EPS to t") + +(defvar org-babel-lilypond-arrange-mode nil + "Arrange mode is turned on by setting ORG-BABEL-LILYPOND-ARRANGE-MODE +to t. In Arrange mode the following settings are altered +from default... +:tangle yes, :noweb yes +:results silent :comments yes. +In addition lilypond block execution causes tangling of all lilypond +blocks") + +(defun org-babel-expand-body:lilypond (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (mapc + (lambda (pair) + (let ((name (symbol-name (car pair))) + (value (cdr pair))) + (setq body + (replace-regexp-in-string + (concat "\$" (regexp-quote name)) + (if (stringp value) value (format "%S" value)) + body)))) + vars) + body)) + +(defun org-babel-execute:lilypond (body params) + "This function is called by `org-babel-execute-src-block'. +Depending on whether we are in arrange mode either: +1. Attempt to execute lilypond block according to header settings + (This is the default basic mode) +2. Tangle all lilypond blocks and process the result (arrange mode)" + (org-babel-lilypond-set-header-args org-babel-lilypond-arrange-mode) + (if org-babel-lilypond-arrange-mode + (org-babel-lilypond-tangle) + (org-babel-lilypond-process-basic body params))) + +(defun org-babel-lilypond-tangle () + "ob-lilypond specific tangle, attempts to invoke +=ly-execute-tangled-ly= if tangle is successful. Also passes +specific arguments to =org-babel-tangle=" + (interactive) + (if (org-babel-tangle nil "yes" "lilypond") + (org-babel-lilypond-execute-tangled-ly) nil)) + +(defun org-babel-lilypond-process-basic (body params) + "Execute a lilypond block in basic mode." + (let* ((result-params (cdr (assoc :result-params params))) + (out-file (cdr (assoc :file params))) + (cmdline (or (cdr (assoc :cmdline params)) + "")) + (in-file (org-babel-temp-file "lilypond-"))) + + (with-temp-file in-file + (insert (org-babel-expand-body:generic body params))) + (org-babel-eval + (concat + (org-babel-lilypond-determine-ly-path) + " -dbackend=eps " + "-dno-gs-load-fonts " + "-dinclude-eps-fonts " + (or (cdr (assoc (file-name-extension out-file) + '(("pdf" . "--pdf ") + ("ps" . "--ps ") + ("png" . "--png ")))) + "--png ") + "--output=" + (file-name-sans-extension out-file) + " " + cmdline + in-file) "")) nil) + +(defun org-babel-prep-session:lilypond (session params) + "Return an error because LilyPond exporter does not support sessions." + (error "Sorry, LilyPond does not currently support sessions!")) + +(defun org-babel-lilypond-execute-tangled-ly () + "Compile result of block tangle with lilypond. +If error in compilation, attempt to mark the error in lilypond org file" + (when org-babel-lilypond-compile-post-tangle + (let ((org-babel-lilypond-tangled-file (org-babel-lilypond-switch-extension + (buffer-file-name) ".lilypond")) + (org-babel-lilypond-temp-file (org-babel-lilypond-switch-extension + (buffer-file-name) ".ly"))) + (if (file-exists-p org-babel-lilypond-tangled-file) + (progn + (when (file-exists-p org-babel-lilypond-temp-file) + (delete-file org-babel-lilypond-temp-file)) + (rename-file org-babel-lilypond-tangled-file + org-babel-lilypond-temp-file)) + (error "Error: Tangle Failed!") t) + (switch-to-buffer-other-window "*lilypond*") + (erase-buffer) + (org-babel-lilypond-compile-lilyfile org-babel-lilypond-temp-file) + (goto-char (point-min)) + (if (not (org-babel-lilypond-check-for-compile-error org-babel-lilypond-temp-file)) + (progn + (other-window -1) + (org-babel-lilypond-attempt-to-open-pdf org-babel-lilypond-temp-file) + (org-babel-lilypond-attempt-to-play-midi org-babel-lilypond-temp-file)) + (error "Error in Compilation!")))) nil) + +(defun org-babel-lilypond-compile-lilyfile (file-name &optional test) + "Compile lilypond file and check for compile errors +FILE-NAME is full path to lilypond (.ly) file" + (message "Compiling LilyPond...") + (let ((arg-1 (org-babel-lilypond-determine-ly-path)) ;program + (arg-2 nil) ;infile + (arg-3 "*lilypond*") ;buffer + (arg-4 t) ;display + (arg-5 (if org-babel-lilypond-gen-png "--png" "")) ;&rest... + (arg-6 (if org-babel-lilypond-gen-html "--html" "")) + (arg-7 (if org-babel-lilypond-gen-pdf "--pdf" "")) + (arg-8 (if org-babel-lilypond-use-eps "-dbackend=eps" "")) + (arg-9 (if org-babel-lilypond-gen-svg "-dbackend=svg" "")) + (arg-10 (concat "--output=" (file-name-sans-extension file-name))) + (arg-11 file-name)) + (if test + `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 ,arg-6 + ,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11) + (call-process + arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 + arg-7 arg-8 arg-9 arg-10 arg-11)))) + +(defun org-babel-lilypond-check-for-compile-error (file-name &optional test) + "Check for compile error. +This is performed by parsing the *lilypond* buffer +containing the output message from the compilation. +FILE-NAME is full path to lilypond file. +If TEST is t just return nil if no error found, and pass +nil as file-name since it is unused in this context" + (let ((is-error (search-forward "error:" nil t))) + (if (not test) + (if (not is-error) + nil + (org-babel-lilypond-process-compile-error file-name)) + is-error))) + +(defun org-babel-lilypond-process-compile-error (file-name) + "Process the compilation error that has occurred. +FILE-NAME is full path to lilypond file" + (let ((line-num (org-babel-lilypond-parse-line-num))) + (let ((error-lines (org-babel-lilypond-parse-error-line file-name line-num))) + (org-babel-lilypond-mark-error-line file-name error-lines) + (error "Error: Compilation Failed!")))) + +(defun org-babel-lilypond-mark-error-line (file-name line) + "Mark the erroneous lines in the lilypond org buffer. +FILE-NAME is full path to lilypond file. +LINE is the erroneous line" + (switch-to-buffer-other-window + (concat (file-name-nondirectory + (org-babel-lilypond-switch-extension file-name ".org")))) + (let ((temp (point))) + (goto-char (point-min)) + (setq case-fold-search nil) + (if (search-forward line nil t) + (progn + (show-all) + (set-mark (point)) + (goto-char (- (point) (length line)))) + (goto-char temp)))) + +(defun org-babel-lilypond-parse-line-num (&optional buffer) + "Extract error line number." + (when buffer + (set-buffer buffer)) + (let ((start + (and (search-backward ":" nil t) + (search-backward ":" nil t) + (search-backward ":" nil t) + (search-backward ":" nil t))) + (num nil)) + (if start + (progn + (forward-char) + (let ((num (buffer-substring + (+ 1 start) + (- (search-forward ":" nil t) 1)))) + (setq num (string-to-number num)) + (if (numberp num) + num + nil))) + nil))) + +(defun org-babel-lilypond-parse-error-line (file-name lineNo) + "Extract the erroneous line from the tangled .ly file +FILE-NAME is full path to lilypond file. +LINENO is the number of the erroneous line" + (with-temp-buffer + (insert-file-contents (org-babel-lilypond-switch-extension file-name ".ly") + nil nil nil t) + (if (> lineNo 0) + (progn + (goto-char (point-min)) + (forward-line (- lineNo 1)) + (buffer-substring (point) (point-at-eol))) + nil))) + +(defun org-babel-lilypond-attempt-to-open-pdf (file-name &optional test) + "Attempt to display the generated pdf file +FILE-NAME is full path to lilypond file +If TEST is non-nil, the shell command is returned and is not run" + (when org-babel-lilypond-display-pdf-post-tangle + (let ((pdf-file (org-babel-lilypond-switch-extension file-name ".pdf"))) + (if (file-exists-p pdf-file) + (let ((cmd-string + (concat (org-babel-lilypond-determine-pdf-path) " " pdf-file))) + (if test + cmd-string + (start-process + "\"Audition pdf\"" + "*lilypond*" + (org-babel-lilypond-determine-pdf-path) + pdf-file))) + (message "No pdf file generated so can't display!"))))) + +(defun org-babel-lilypond-attempt-to-play-midi (file-name &optional test) + "Attempt to play the generated MIDI file +FILE-NAME is full path to lilypond file +If TEST is non-nil, the shell command is returned and is not run" + (when org-babel-lilypond-play-midi-post-tangle + (let ((midi-file (org-babel-lilypond-switch-extension file-name ".midi"))) + (if (file-exists-p midi-file) + (let ((cmd-string + (concat (org-babel-lilypond-determine-midi-path) " " midi-file))) + (if test + cmd-string + (start-process + "\"Audition midi\"" + "*lilypond*" + (org-babel-lilypond-determine-midi-path) + midi-file))) + (message "No midi file generated so can't play!"))))) + +(defun org-babel-lilypond-determine-ly-path (&optional test) + "Return correct path to ly binary depending on OS +If TEST is non-nil, it contains a simulation of the OS for test purposes" + (let ((sys-type + (or test system-type))) + (cond ((string= sys-type "darwin") + org-babel-lilypond-OSX-ly-path) + ((string= sys-type "windows-nt") + org-babel-lilypond-w32-ly-path) + (t org-babel-lilypond-nix-ly-path)))) + +(defun org-babel-lilypond-determine-pdf-path (&optional test) + "Return correct path to pdf viewer depending on OS +If TEST is non-nil, it contains a simulation of the OS for test purposes" + (let ((sys-type + (or test system-type))) + (cond ((string= sys-type "darwin") + org-babel-lilypond-OSX-pdf-path) + ((string= sys-type "windows-nt") + org-babel-lilypond-w32-pdf-path) + (t org-babel-lilypond-nix-pdf-path)))) + +(defun org-babel-lilypond-determine-midi-path (&optional test) + "Return correct path to midi player depending on OS +If TEST is non-nil, it contains a simulation of the OS for test purposes" + (let ((sys-type + (or test test system-type))) + (cond ((string= sys-type "darwin") + org-babel-lilypond-OSX-midi-path) + ((string= sys-type "windows-nt") + org-babel-lilypond-w32-midi-path) + (t org-babel-lilypond-nix-midi-path)))) + +(defun org-babel-lilypond-toggle-midi-play () + "Toggle whether midi will be played following a successful compilation." + (interactive) + (setq org-babel-lilypond-play-midi-post-tangle + (not org-babel-lilypond-play-midi-post-tangle)) + (message (concat "Post-Tangle MIDI play has been " + (if org-babel-lilypond-play-midi-post-tangle + "ENABLED." "DISABLED.")))) + +(defun org-babel-lilypond-toggle-pdf-display () + "Toggle whether pdf will be displayed following a successful compilation." + (interactive) + (setq org-babel-lilypond-display-pdf-post-tangle + (not org-babel-lilypond-display-pdf-post-tangle)) + (message (concat "Post-Tangle PDF display has been " + (if org-babel-lilypond-display-pdf-post-tangle + "ENABLED." "DISABLED.")))) + +(defun org-babel-lilypond-toggle-png-generation () + "Toggle whether png image will be generated by compilation." + (interactive) + (setq org-babel-lilypond-gen-png (not org-babel-lilypond-gen-png)) + (message (concat "PNG image generation has been " + (if org-babel-lilypond-gen-png "ENABLED." "DISABLED.")))) + +(defun org-babel-lilypond-toggle-html-generation () + "Toggle whether html will be generated by compilation." + (interactive) + (setq org-babel-lilypond-gen-html (not org-babel-lilypond-gen-html)) + (message (concat "HTML generation has been " + (if org-babel-lilypond-gen-html "ENABLED." "DISABLED.")))) + +(defun org-babel-lilypond-toggle-pdf-generation () + "Toggle whether pdf will be generated by compilation." + (interactive) + (setq org-babel-lilypond-gen-pdf (not org-babel-lilypond-gen-pdf)) + (message (concat "PDF generation has been " + (if org-babel-lilypond-gen-pdf "ENABLED." "DISABLED.")))) + +(defun org-babel-lilypond-toggle-arrange-mode () + "Toggle whether in Arrange mode or Basic mode." + (interactive) + (setq org-babel-lilypond-arrange-mode + (not org-babel-lilypond-arrange-mode)) + (message (concat "Arrange mode has been " + (if org-babel-lilypond-arrange-mode "ENABLED." "DISABLED.")))) + +(defun org-babel-lilypond-switch-extension (file-name ext) + "Utility command to swap current FILE-NAME extension with EXT" + (concat (file-name-sans-extension + file-name) ext)) + +(defun org-babel-lilypond-get-header-args (mode) + "Default arguments to use when evaluating a lilypond +source block. These depend upon whether we are in arrange +mode i.e. ARRANGE-MODE is t" + (cond (mode + '((:tangle . "yes") + (:noweb . "yes") + (:results . "silent") + (:cache . "yes") + (:comments . "yes"))) + (t + '((:results . "file") + (:exports . "results"))))) + +(defun org-babel-lilypond-set-header-args (mode) + "Set org-babel-default-header-args:lilypond +dependent on ORG-BABEL-LILYPOND-ARRANGE-MODE" + (setq org-babel-default-header-args:lilypond + (org-babel-lilypond-get-header-args mode))) + +(provide 'ob-lilypond) + +;;; ob-lilypond.el ends here diff --git a/elpa/org-20150427/ob-lisp.el b/elpa/org-20150427/ob-lisp.el new file mode 100644 index 00000000..6bddd614 --- /dev/null +++ b/elpa/org-20150427/ob-lisp.el @@ -0,0 +1,109 @@ +;;; ob-lisp.el --- org-babel functions for common lisp evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Authors: Joel Boehland +;; Eric Schulte +;; David T. O'Toole +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;;; support for evaluating common lisp code, relies on slime for all eval + +;;; Requirements: + +;; Requires SLIME (Superior Lisp Interaction Mode for Emacs.) +;; See http://common-lisp.net/project/slime/ + +;;; Code: +(require 'ob) + +(declare-function slime-eval "ext:slime" (sexp &optional package)) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp")) + +(defvar org-babel-default-header-args:lisp '()) +(defvar org-babel-header-args:lisp '((package . :any))) + +(defcustom org-babel-lisp-dir-fmt + "(let ((*default-pathname-defaults* #P%S)) %%s)" + "Format string used to wrap code bodies to set the current directory. +For example a value of \"(progn ;; %s\\n %%s)\" would ignore the +current directory string." + :group 'org-babel + :version "24.1" + :type 'string) + +(defun org-babel-expand-body:lisp (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (result-params (cdr (assoc :result-params params))) + (print-level nil) (print-length nil) + (body (org-babel-trim + (if (> (length vars) 0) + (concat "(let (" + (mapconcat + (lambda (var) + (format "(%S (quote %S))" (car var) (cdr var))) + vars "\n ") + ")\n" body ")") + body)))) + (if (or (member "code" result-params) + (member "pp" result-params)) + (format "(pprint %s)" body) + body))) + +(defun org-babel-execute:lisp (body params) + "Execute a block of Common Lisp code with Babel." + (require 'slime) + (org-babel-reassemble-table + (let ((result + (with-temp-buffer + (insert (org-babel-expand-body:lisp body params)) + (slime-eval `(swank:eval-and-grab-output + ,(let ((dir (if (assoc :dir params) + (cdr (assoc :dir params)) + default-directory))) + (format + (if dir (format org-babel-lisp-dir-fmt dir) + "(progn %s)") + (buffer-substring-no-properties + (point-min) (point-max))))) + (cdr (assoc :package params)))))) + (org-babel-result-cond (cdr (assoc :result-params params)) + (car result) + (condition-case nil + (read (org-babel-lisp-vector-to-list (cadr result))) + (error (cadr result))))) + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params))))) + +(defun org-babel-lisp-vector-to-list (results) + ;; TODO: better would be to replace #(...) with [...] + (replace-regexp-in-string "#(" "(" results)) + +(provide 'ob-lisp) + + + +;;; ob-lisp.el ends here diff --git a/elpa/org-20150427/ob-lob.el b/elpa/org-20150427/ob-lob.el new file mode 100644 index 00000000..4e635da1 --- /dev/null +++ b/elpa/org-20150427/ob-lob.el @@ -0,0 +1,164 @@ +;;; ob-lob.el --- functions supporting the Library of Babel + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Authors: Eric Schulte +;; Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Code: +(eval-when-compile + (require 'cl)) +(require 'ob-core) +(require 'ob-table) + +(declare-function org-babel-in-example-or-verbatim "ob-exp" nil) + +(defvar org-babel-library-of-babel nil + "Library of source-code blocks. +This is an association list. Populate the library by adding +files to `org-babel-lob-files'.") + +(defcustom org-babel-lob-files nil + "Files used to populate the `org-babel-library-of-babel'. +To add files to this list use the `org-babel-lob-ingest' command." + :group 'org-babel + :version "24.1" + :type '(repeat file)) + +(defvar org-babel-default-lob-header-args '((:exports . "results")) + "Default header arguments to use when exporting #+lob/call lines.") + +(defun org-babel-lob-ingest (&optional file) + "Add all named source blocks defined in FILE to `org-babel-library-of-babel'." + (interactive "fFile: ") + (let ((lob-ingest-count 0)) + (org-babel-map-src-blocks file + (let* ((info (org-babel-get-src-block-info 'light)) + (source-name (nth 4 info))) + (when source-name + (setq source-name (intern source-name) + org-babel-library-of-babel + (cons (cons source-name info) + (assq-delete-all source-name org-babel-library-of-babel)) + lob-ingest-count (1+ lob-ingest-count))))) + (message "%d src block%s added to Library of Babel" + lob-ingest-count (if (> lob-ingest-count 1) "s" "")) + lob-ingest-count)) + +(defconst org-babel-block-lob-one-liner-regexp + (concat + "^\\([ \t]*?\\)#\\+call:[ \t]+\\([^\(\)\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)" + "\(\\([^\n]*?\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\(\\([^\n]*\\)\\)?") + "Regexp to match non-inline calls to predefined source block functions.") + +(defconst org-babel-inline-lob-one-liner-regexp + (concat + "\\([^\n]*?\\)call_\\([^\(\)\n]+?\\)\\(\\[\\(.*?\\)\\]\\|\\(\\)\\)" + "\(\\([^\n]*?\\)\)\\(\\[\\(.*?\\)\\]\\)?") + "Regexp to match inline calls to predefined source block functions.") + +(defconst org-babel-lob-one-liner-regexp + (concat "\\(" org-babel-block-lob-one-liner-regexp + "\\|" org-babel-inline-lob-one-liner-regexp "\\)") + "Regexp to match calls to predefined source block functions.") + +;; functions for executing lob one-liners + +;;;###autoload +(defun org-babel-lob-execute-maybe () + "Execute a Library of Babel source block, if appropriate. +Detect if this is context for a Library Of Babel source block and +if so then run the appropriate source block from the Library." + (interactive) + (let ((info (org-babel-lob-get-info))) + (if (and (nth 0 info) (not (org-babel-in-example-or-verbatim))) + (progn (org-babel-lob-execute info) t) + nil))) + +;;;###autoload +(defun org-babel-lob-get-info () + "Return a Library of Babel function call as a string." + (let ((case-fold-search t) + (nonempty (lambda (a b) + (let ((it (match-string a))) + (if (= (length it) 0) (match-string b) it))))) + (save-excursion + (beginning-of-line 1) + (when (looking-at org-babel-lob-one-liner-regexp) + (append + (mapcar #'org-no-properties + (list + (format "%s%s(%s)%s" + (funcall nonempty 3 12) + (if (not (= 0 (length (funcall nonempty 5 14)))) + (concat "[" (funcall nonempty 5 14) "]") "") + (or (funcall nonempty 7 16) "") + (or (funcall nonempty 8 19) "")) + (funcall nonempty 9 18))) + (list (length (if (= (length (match-string 12)) 0) + (match-string 2) (match-string 11))) + (save-excursion + (forward-line -1) + (and (looking-at (concat org-babel-src-name-regexp + "\\([^\n]*\\)$")) + (org-no-properties (match-string 1)))))))))) + +(defvar org-babel-default-header-args:emacs-lisp) ; Defined in ob-emacs-lisp.el +(defun org-babel-lob-execute (info) + "Execute the lob call specified by INFO." + (let* ((mkinfo (lambda (p) + (list "emacs-lisp" "results" p nil + (nth 3 info) ;; name + (nth 2 info)))) + (pre-params (apply #'org-babel-merge-params + org-babel-default-header-args + org-babel-default-header-args:emacs-lisp + (append + (org-babel-params-from-properties) + (list + (org-babel-parse-header-arguments + (org-no-properties + (concat + ":var results=" + (mapconcat #'identity (butlast info 2) + " ")))))))) + (pre-info (funcall mkinfo pre-params)) + (cache-p (and (cdr (assoc :cache pre-params)) + (string= "yes" (cdr (assoc :cache pre-params))))) + (new-hash (when cache-p (org-babel-sha1-hash pre-info))) + (old-hash (when cache-p (org-babel-current-result-hash))) + (org-babel-current-src-block-location (point-marker))) + (if (and cache-p (equal new-hash old-hash)) + (save-excursion (goto-char (org-babel-where-is-src-block-result)) + (forward-line 1) + (message "%S" (org-babel-read-result))) + (prog1 (let* ((proc-params (org-babel-process-params pre-params)) + org-confirm-babel-evaluate) + (org-babel-execute-src-block nil (funcall mkinfo proc-params))) + ;; update the hash + (when new-hash (org-babel-set-current-result-hash new-hash)))))) + +(provide 'ob-lob) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ob-lob.el ends here diff --git a/elpa/org-20150427/ob-makefile.el b/elpa/org-20150427/ob-makefile.el new file mode 100644 index 00000000..af7e66e5 --- /dev/null +++ b/elpa/org-20150427/ob-makefile.el @@ -0,0 +1,48 @@ +;;; ob-makefile.el --- org-babel functions for makefile evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Thomas S. Dye +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; This file exists solely for tangling a Makefile from org-mode files. + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:makefile '()) + +(defun org-babel-execute:makefile (body params) + "Execute a block of makefile code. +This function is called by `org-babel-execute-src-block'." + body) + +(defun org-babel-prep-session:makefile (session params) + "Return an error if the :session header argument is set. Make +does not support sessions." + (error "Makefile sessions are nonsensical")) + +(provide 'ob-makefile) + + + +;;; ob-makefile.el ends here diff --git a/elpa/org-20150427/ob-matlab.el b/elpa/org-20150427/ob-matlab.el new file mode 100644 index 00000000..ef77de30 --- /dev/null +++ b/elpa/org-20150427/ob-matlab.el @@ -0,0 +1,47 @@ +;;; ob-matlab.el --- org-babel support for matlab evaluation + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Functions that are common to org-babel support for matlab and +;; octave are in org-babel-octave.el + +;;; Requirements: + +;; Matlab + +;; matlab.el required for interactive emacs sessions and matlab-mode +;; major mode for source code editing buffer +;; http://matlab-emacs.sourceforge.net/ + +;;; Code: +(require 'ob) +(require 'ob-octave) + +;; see ob-octave for matlab implementation + +(provide 'ob-matlab) + + + +;;; ob-matlab.el ends here diff --git a/elpa/org-20150427/ob-maxima.el b/elpa/org-20150427/ob-maxima.el new file mode 100644 index 00000000..7435f1d3 --- /dev/null +++ b/elpa/org-20150427/ob-maxima.el @@ -0,0 +1,132 @@ +;;; ob-maxima.el --- org-babel functions for maxima evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric S Fraga +;; Eric Schulte +;; Keywords: literate programming, reproducible research, maxima +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating maxima entries. +;; +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in maxima +;; +;; 2) we are adding the "cmdline" header argument + +;;; Code: +(require 'ob) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("maxima" . "max")) + +(defvar org-babel-default-header-args:maxima '()) + +(defcustom org-babel-maxima-command + (if (boundp 'maxima-command) maxima-command "maxima") + "Command used to call maxima on the shell." + :group 'org-babel + :type 'string) + +(defun org-babel-maxima-expand (body params) + "Expand a block of Maxima code according to its header arguments." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (mapconcat 'identity + (list + ;; graphic output + (let ((graphic-file (org-babel-maxima-graphical-output-file params))) + (if graphic-file + (format + "set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);" + graphic-file) + "")) + ;; variables + (mapconcat 'org-babel-maxima-var-to-maxima vars "\n") + ;; body + body + "gnuplot_close ()$") + "\n"))) + +(defun org-babel-execute:maxima (body params) + "Execute a block of Maxima entries with org-babel. +This function is called by `org-babel-execute-src-block'." + (message "executing Maxima source code block") + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (result + (let* ((cmdline (or (cdr (assoc :cmdline params)) "")) + (in-file (org-babel-temp-file "maxima-" ".max")) + (cmd (format "%s --very-quiet -r 'batchload(%S)$' %s" + org-babel-maxima-command in-file cmdline))) + (with-temp-file in-file (insert (org-babel-maxima-expand body params))) + (message cmd) + ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' " + (let ((raw (org-babel-eval cmd ""))) + (mapconcat + #'identity + (delq nil + (mapcar (lambda (line) + (unless (or (string-match "batch" line) + (string-match "^rat: replaced .*$" line) + (string-match "^;;; Loading #P" line) + (= 0 (length line))) + line)) + (split-string raw "[\r\n]"))) "\n"))))) + (if (org-babel-maxima-graphical-output-file params) + nil + (org-babel-result-cond result-params + result + (let ((tmp-file (org-babel-temp-file "maxima-res-"))) + (with-temp-file tmp-file (insert result)) + (org-babel-import-elisp-from-file tmp-file)))))) + + +(defun org-babel-prep-session:maxima (session params) + (error "Maxima does not support sessions")) + +(defun org-babel-maxima-var-to-maxima (pair) + "Convert an elisp val into a string of maxima code specifying a var +of the same value." + (let ((var (car pair)) + (val (cdr pair))) + (when (symbolp val) + (setq val (symbol-name val)) + (when (= (length val) 1) + (setq val (string-to-char val)))) + (format "%S: %s$" var + (org-babel-maxima-elisp-to-maxima val)))) + +(defun org-babel-maxima-graphical-output-file (params) + "Name of file to which maxima should send graphical output." + (and (member "graphics" (cdr (assq :result-params params))) + (cdr (assq :file params)))) + +(defun org-babel-maxima-elisp-to-maxima (val) + "Return a string of maxima code which evaluates to VAL." + (if (listp val) + (concat "[" (mapconcat #'org-babel-maxima-elisp-to-maxima val ", ") "]") + (format "%s" val))) + + +(provide 'ob-maxima) + + + +;;; ob-maxima.el ends here diff --git a/elpa/org-20150427/ob-mscgen.el b/elpa/org-20150427/ob-mscgen.el new file mode 100644 index 00000000..4a4dc052 --- /dev/null +++ b/elpa/org-20150427/ob-mscgen.el @@ -0,0 +1,84 @@ +;;; ob-msc.el --- org-babel functions for mscgen evaluation + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Juan Pechiar +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: +;; +;; This software provides EMACS org-babel export support for message +;; sequence charts. The mscgen utility is used for processing the +;; sequence definition, and must therefore be installed in the system. +;; +;; Mscgen is available and documented at +;; http://www.mcternan.me.uk/mscgen/index.html +;; +;; This code is directly inspired by Eric Schulte's ob-dot.el +;; +;; Example: +;; +;; #+begin_src mscgen :file example.png +;; msc { +;; A,B; +;; A -> B [ label = "send message" ]; +;; A <- B [ label = "get answer" ]; +;; } +;; #+end_src +;; +;; Header for alternative file type: +;; +;; #+begin_src mscgen :file ex2.svg :filetype svg + +;; This differs from most standard languages in that +;; +;; 1) there is no such thing as a "session" in mscgen +;; 2) we are generally only going to return results of type "file" +;; 3) we are adding the "file" and "filetype" header arguments +;; 4) there are no variables + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:mscgen + '((:results . "file") (:exports . "results")) + "Default arguments to use when evaluating a mscgen source block.") + +(defun org-babel-execute:mscgen (body params) + "Execute a block of Mscgen code with Babel. +This function is called by `org-babel-execute-src-block'. +Default filetype is png. Modify by setting :filetype parameter to +mscgen supported formats." + (let* ((out-file (or (cdr (assoc :file params)) "output.png" )) + (filetype (or (cdr (assoc :filetype params)) "png" ))) + (unless (cdr (assoc :file params)) + (error " +ERROR: no output file specified. Add \":file name.png\" to the src header")) + (org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body) + nil)) ;; signal that output has already been written to file + +(defun org-babel-prep-session:mscgen (session params) + "Raise an error because Mscgen doesn't support sessions." + (error "Mscgen does not support sessions")) + +(provide 'ob-mscgen) + + + +;;; ob-msc.el ends here diff --git a/elpa/org-20150427/ob-ocaml.el b/elpa/org-20150427/ob-ocaml.el new file mode 100644 index 00000000..1f29a25c --- /dev/null +++ b/elpa/org-20150427/ob-ocaml.el @@ -0,0 +1,160 @@ +;;; ob-ocaml.el --- org-babel functions for ocaml evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating ocaml source code. This one will +;; be sort of tricky because ocaml programs must be compiled before +;; they can be run, but ocaml code can also be run through an +;; interactive interpreter. +;; +;; For now lets only allow evaluation using the ocaml interpreter. + +;;; Requirements: + +;; - tuareg-mode :: http://www-rocq.inria.fr/~acohen/tuareg/ + +;;; Code: +(require 'ob) +(require 'comint) +(eval-when-compile (require 'cl)) + +(declare-function tuareg-run-caml "ext:tuareg" ()) +(declare-function tuareg-run-ocaml "ext:tuareg" ()) +(declare-function tuareg-interactive-send-input "ext:tuareg" ()) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml")) + +(defvar org-babel-default-header-args:ocaml '()) + +(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;") +(defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe") + +(defcustom org-babel-ocaml-command "ocaml" + "Name of the command for executing Ocaml code." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-babel + :type 'string) + +(defun org-babel-execute:ocaml (body params) + "Execute a block of Ocaml code with Babel." + (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (full-body (org-babel-expand-body:generic + body params + (org-babel-variable-assignments:ocaml params))) + (session (org-babel-prep-session:ocaml + (cdr (assoc :session params)) params)) + (raw (org-babel-comint-with-output + (session org-babel-ocaml-eoe-output t full-body) + (insert + (concat + (org-babel-chomp full-body)";;\n"org-babel-ocaml-eoe-indicator)) + (tuareg-interactive-send-input))) + (clean + (car (let ((re (regexp-quote org-babel-ocaml-eoe-output)) out) + (delq nil (mapcar (lambda (line) + (if out + (progn (setq out nil) line) + (when (string-match re line) + (progn (setq out t) nil)))) + (mapcar #'org-babel-trim (reverse raw)))))))) + (org-babel-reassemble-table + (let ((raw (org-babel-trim clean)) + (result-params (cdr (assoc :result-params params)))) + (org-babel-result-cond result-params + ;; strip type information from output unless verbatim is specified + (if (and (not (member "verbatim" result-params)) + (string-match "= \\(.+\\)$" raw)) + (match-string 1 raw) raw) + (org-babel-ocaml-parse-output raw))) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + +(defvar tuareg-interactive-buffer-name) +(defun org-babel-prep-session:ocaml (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (require 'tuareg) + (let ((tuareg-interactive-buffer-name (if (and (not (string= session "none")) + (not (string= session "default")) + (stringp session)) + session + tuareg-interactive-buffer-name))) + (save-window-excursion (if (fboundp 'tuareg-run-process-if-needed) + (tuareg-run-process-if-needed org-babel-ocaml-command) + (tuareg-run-caml))) + (get-buffer tuareg-interactive-buffer-name))) + +(defun org-babel-variable-assignments:ocaml (params) + "Return list of ocaml statements assigning the block's variables." + (mapcar + (lambda (pair) (format "let %s = %s;;" (car pair) + (org-babel-ocaml-elisp-to-ocaml (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-ocaml-elisp-to-ocaml (val) + "Return a string of ocaml code which evaluates to VAL." + (if (listp val) + (concat "[|" (mapconcat #'org-babel-ocaml-elisp-to-ocaml val "; ") "|]") + (format "%S" val))) + +(defun org-babel-ocaml-parse-output (output) + "Parse OUTPUT. +OUTPUT is string output from an ocaml process." + (let ((regexp "[^:]+ : %s = \\(.+\\)$")) + (cond + ((string-match (format regexp "string") output) + (org-babel-read (match-string 1 output))) + ((or (string-match (format regexp "int") output) + (string-match (format regexp "float") output)) + (string-to-number (match-string 1 output))) + ((string-match (format regexp "list") output) + (org-babel-ocaml-read-list (match-string 1 output))) + ((string-match (format regexp "array") output) + (org-babel-ocaml-read-array (match-string 1 output))) + (t (message "don't recognize type of %s" output) output)))) + +(defun org-babel-ocaml-read-list (results) + "Convert RESULTS into an elisp table or string. +If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape (replace-regexp-in-string ";" "," results))) + +(defun org-babel-ocaml-read-array (results) + "Convert RESULTS into an elisp table or string. +If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape + (replace-regexp-in-string + "\\[|" "[" (replace-regexp-in-string + "|\\]" "]" (replace-regexp-in-string + "; " "," results))))) + +(provide 'ob-ocaml) + + + +;;; ob-ocaml.el ends here diff --git a/elpa/org-20150427/ob-octave.el b/elpa/org-20150427/ob-octave.el new file mode 100644 index 00000000..8cc66b6f --- /dev/null +++ b/elpa/org-20150427/ob-octave.el @@ -0,0 +1,280 @@ +;;; ob-octave.el --- org-babel functions for octave and matlab evaluation + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;;; Requirements: + +;; octave +;; octave-mode.el and octave-inf.el come with GNU emacs + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function matlab-shell "ext:matlab-mode") +(declare-function matlab-shell-run-region "ext:matlab-mode") + +(defvar org-babel-default-header-args:matlab '()) +(defvar org-babel-default-header-args:octave '()) + +(defvar org-babel-matlab-shell-command "matlab -nosplash" + "Shell command to run matlab as an external process.") +(defvar org-babel-octave-shell-command "octave -q" + "Shell command to run octave as an external process.") + +(defvar org-babel-matlab-with-emacs-link nil + "If non-nil use matlab-shell-run-region for session evaluation. + This will use EmacsLink if (matlab-with-emacs-link) evaluates + to a non-nil value.") + +(defvar org-babel-matlab-emacs-link-wrapper-method + "%s +if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); +else, save -ascii %s ans +end +delete('%s') +") +(defvar org-babel-octave-wrapper-method + "%s +if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); +else, dlmwrite('%s', ans, '\\t') +end") + +(defvar org-babel-octave-eoe-indicator "\'org_babel_eoe\'") + +(defvar org-babel-octave-eoe-output "ans = org_babel_eoe") + +(defun org-babel-execute:matlab (body params) + "Execute a block of matlab code with Babel." + (org-babel-execute:octave body params 'matlab)) + +(defun org-babel-execute:octave (body params &optional matlabp) + "Execute a block of octave code with Babel." + (let* ((session + (funcall (intern (format "org-babel-%s-initiate-session" + (if matlabp "matlab" "octave"))) + (cdr (assoc :session params)) params)) + (vars (mapcar #'cdr (org-babel-get-header params :var))) + (result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) + (out-file (cdr (assoc :file params))) + (full-body + (org-babel-expand-body:generic + body params (org-babel-variable-assignments:octave params))) + (result (org-babel-octave-evaluate + session + (if (org-babel-octave-graphical-output-file params) + (mapconcat 'identity + (list + "set (0, \"defaultfigurevisible\", \"off\");" + full-body + (format "print -dpng %s" (org-babel-octave-graphical-output-file params))) + "\n") + full-body) + result-type matlabp))) + (if (org-babel-octave-graphical-output-file params) + nil + (org-babel-reassemble-table + result + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) + +(defun org-babel-prep-session:matlab (session params) + "Prepare SESSION according to PARAMS." + (org-babel-prep-session:octave session params 'matlab)) + +(defun org-babel-variable-assignments:octave (params) + "Return list of octave statements assigning the block's variables." + (mapcar + (lambda (pair) + (format "%s=%s;" + (car pair) + (org-babel-octave-var-to-octave (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defalias 'org-babel-variable-assignments:matlab + 'org-babel-variable-assignments:octave) + +(defun org-babel-octave-var-to-octave (var) + "Convert an emacs-lisp value into an octave variable. +Converts an emacs-lisp variable into a string of octave code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-octave-var-to-octave var + (if (listp (car var)) "; " ",")) "]") + (cond + ((stringp var) + (format "\'%s\'" var)) + (t + (format "%s" var))))) + +(defun org-babel-prep-session:octave (session params &optional matlabp) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-octave-initiate-session session params matlabp)) + (var-lines (org-babel-variable-assignments:octave params))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (end-of-line 1) (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-matlab-initiate-session (&optional session params) + "Create a matlab inferior process buffer. +If there is not a current inferior-process-buffer in SESSION then +create. Return the initialized session." + (org-babel-octave-initiate-session session params 'matlab)) + +(defun org-babel-octave-initiate-session (&optional session params matlabp) + "Create an octave inferior process buffer. +If there is not a current inferior-process-buffer in SESSION then +create. Return the initialized session." + (if matlabp (require 'matlab) (or (require 'octave-inf nil 'noerror) + (require 'octave))) + (unless (string= session "none") + (let ((session (or session + (if matlabp "*Inferior Matlab*" "*Inferior Octave*")))) + (if (org-babel-comint-buffer-livep session) session + (save-window-excursion + (if matlabp (unless org-babel-matlab-with-emacs-link (matlab-shell)) + (run-octave)) + (rename-buffer (if (bufferp session) (buffer-name session) + (if (stringp session) session (buffer-name)))) + (current-buffer)))))) + +(defun org-babel-octave-evaluate + (session body result-type &optional matlabp) + "Pass BODY to the octave process in SESSION. +If RESULT-TYPE equals 'output then return the outputs of the +statements in BODY, if RESULT-TYPE equals 'value then return the +value of the last statement in BODY, as elisp." + (if session + (org-babel-octave-evaluate-session session body result-type matlabp) + (org-babel-octave-evaluate-external-process body result-type matlabp))) + +(defun org-babel-octave-evaluate-external-process (body result-type matlabp) + "Evaluate BODY in an external octave process." + (let ((cmd (if matlabp + org-babel-matlab-shell-command + org-babel-octave-shell-command))) + (case result-type + (output (org-babel-eval cmd body)) + (value (let ((tmp-file (org-babel-temp-file "octave-"))) + (org-babel-eval + cmd + (format org-babel-octave-wrapper-method body + (org-babel-process-file-name tmp-file 'noquote) + (org-babel-process-file-name tmp-file 'noquote))) + (org-babel-octave-import-elisp-from-file tmp-file)))))) + +(defun org-babel-octave-evaluate-session + (session body result-type &optional matlabp) + "Evaluate BODY in SESSION." + (let* ((tmp-file (org-babel-temp-file (if matlabp "matlab-" "octave-"))) + (wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-")) + (full-body + (case result-type + (output + (mapconcat + #'org-babel-chomp + (list body org-babel-octave-eoe-indicator) "\n")) + (value + (if (and matlabp org-babel-matlab-with-emacs-link) + (concat + (format org-babel-matlab-emacs-link-wrapper-method + body + (org-babel-process-file-name tmp-file 'noquote) + (org-babel-process-file-name tmp-file 'noquote) wait-file) "\n") + (mapconcat + #'org-babel-chomp + (list (format org-babel-octave-wrapper-method + body + (org-babel-process-file-name tmp-file 'noquote) + (org-babel-process-file-name tmp-file 'noquote)) + org-babel-octave-eoe-indicator) "\n"))))) + (raw (if (and matlabp org-babel-matlab-with-emacs-link) + (save-window-excursion + (with-temp-buffer + (insert full-body) + (write-region "" 'ignored wait-file nil nil nil 'excl) + (matlab-shell-run-region (point-min) (point-max)) + (message "Waiting for Matlab Emacs Link") + (while (file-exists-p wait-file) (sit-for 0.01)) + "")) ;; matlab-shell-run-region doesn't seem to + ;; make *matlab* buffer contents easily + ;; available, so :results output currently + ;; won't work + (org-babel-comint-with-output + (session + (if matlabp + org-babel-octave-eoe-indicator + org-babel-octave-eoe-output) + t full-body) + (insert full-body) (comint-send-input nil t)))) results) + (case result-type + (value + (org-babel-octave-import-elisp-from-file tmp-file)) + (output + (progn + (setq results + (if matlabp + (cdr (reverse (delq "" (mapcar + #'org-babel-octave-read-string + (mapcar #'org-babel-trim raw))))) + (cdr (member org-babel-octave-eoe-output + (reverse (mapcar + #'org-babel-octave-read-string + (mapcar #'org-babel-trim raw))))))) + (mapconcat #'identity (reverse results) "\n")))))) + +(defun org-babel-octave-import-elisp-from-file (file-name) + "Import data from FILE-NAME. +This removes initial blank and comment lines and then calls +`org-babel-import-elisp-from-file'." + (let ((temp-file (org-babel-temp-file "octave-matlab-")) beg end) + (with-temp-file temp-file + (insert-file-contents file-name) + (re-search-forward "^[ \t]*[^# \t]" nil t) + (if (< (setq beg (point-min)) + (setq end (point-at-bol))) + (delete-region beg end))) + (org-babel-import-elisp-from-file temp-file '(16)))) + +(defun org-babel-octave-read-string (string) + "Strip \\\"s from around octave string." + (if (string-match "^\"\\([^\000]+\\)\"$" string) + (match-string 1 string) + string)) + +(defun org-babel-octave-graphical-output-file (params) + "Name of file to which maxima should send graphical output." + (and (member "graphics" (cdr (assq :result-params params))) + (cdr (assq :file params)))) + +(provide 'ob-octave) + + + +;;; ob-octave.el ends here diff --git a/elpa/org-20150427/ob-org.el b/elpa/org-20150427/ob-org.el new file mode 100644 index 00000000..bc02f23f --- /dev/null +++ b/elpa/org-20150427/ob-org.el @@ -0,0 +1,72 @@ +;;; ob-org.el --- org-babel functions for org code block evaluation + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; This is the simplest of code blocks, where upon evaluation the +;; contents of the code block are returned in a raw result. + +;;; Code: +(require 'ob) + +(declare-function org-export-string-as "ox" + (string backend &optional body-only ext-plist)) + +(defvar org-babel-default-header-args:org + '((:results . "raw silent") (:exports . "code")) + "Default arguments for evaluating a org source block.") + +(defvar org-babel-org-default-header + "#+TITLE: default empty header\n" + "Default header inserted during export of org blocks.") + +(defun org-babel-expand-body:org (body params) + (dolist (var (mapcar #'cdr (org-babel-get-header params :var))) + (setq body (replace-regexp-in-string + (regexp-quote (format "$%s" (car var))) + (format "%s" (cdr var)) + body nil 'literal))) + body) + +(defun org-babel-execute:org (body params) + "Execute a block of Org code with. +This function is called by `org-babel-execute-src-block'." + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (body (org-babel-expand-body:org + (replace-regexp-in-string "^," "" body) params))) + (cond + ((member "latex" result-params) + (org-export-string-as (concat "#+Title: \n" body) 'latex t)) + ((member "html" result-params) (org-export-string-as body 'html t)) + ((member "ascii" result-params) (org-export-string-as body 'ascii t)) + (t body)))) + +(defun org-babel-prep-session:org (session params) + "Return an error because org does not support sessions." + (error "Org does not support sessions")) + +(provide 'ob-org) + + + +;;; ob-org.el ends here diff --git a/elpa/org-20150427/ob-perl.el b/elpa/org-20150427/ob-perl.el new file mode 100644 index 00000000..ff4cbea9 --- /dev/null +++ b/elpa/org-20150427/ob-perl.el @@ -0,0 +1,158 @@ +;;; ob-perl.el --- org-babel functions for perl evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Authors: Dan Davison +;; Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating perl source code. + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl")) + +(defvar org-babel-default-header-args:perl '()) + +(defvar org-babel-perl-command "perl" + "Name of command to use for executing perl code.") + +(defun org-babel-execute:perl (body params) + "Execute a block of Perl code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((session (cdr (assoc :session params))) + (result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params (org-babel-variable-assignments:perl params))) + (session (org-babel-perl-initiate-session session))) + (org-babel-reassemble-table + (org-babel-perl-evaluate session full-body result-type result-params) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + +(defun org-babel-prep-session:perl (session params) + "Prepare SESSION according to the header arguments in PARAMS." + (error "Sessions are not supported for Perl")) + +(defun org-babel-variable-assignments:perl (params) + "Return list of perl statements assigning the block's variables." + (mapcar + (lambda (pair) + (org-babel-perl--var-to-perl (cdr pair) (car pair))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +;; helper functions + +(defvar org-babel-perl-var-wrap "q(%s)" + "Wrapper for variables inserted into Perl code.") + +(defvar org-babel-perl--lvl) +(defun org-babel-perl--var-to-perl (var &optional varn) + "Convert an elisp value to a perl variable. +The elisp value, VAR, is converted to a string of perl source code +specifying a var of the same value." + (if varn + (let ((org-babel-perl--lvl 0) (lvar (listp var)) prefix) + (concat "my $" (symbol-name varn) "=" (when lvar "\n") + (org-babel-perl--var-to-perl var) + ";\n")) + (let ((prefix (make-string (* 2 org-babel-perl--lvl) ?\ ))) + (concat prefix + (if (listp var) + (let ((org-babel-perl--lvl (1+ org-babel-perl--lvl))) + (concat "[\n" + (mapconcat #'org-babel-perl--var-to-perl var "") + prefix "]")) + (format "q(%s)" var)) + (unless (zerop org-babel-perl--lvl) ",\n"))))) + +(defvar org-babel-perl-buffers '(:default . nil)) + +(defun org-babel-perl-initiate-session (&optional session params) + "Return nil because sessions are not supported by perl." + nil) + +(defvar org-babel-perl-wrapper-method "{ + my $babel_sub = sub { + %s + }; + open my $BOH, qq(>%s) or die qq(Perl: Could not open output file.$/); + my $rv = &$babel_sub(); + my $rt = ref $rv; + select $BOH; + if (qq(ARRAY) eq $rt) { + local $\\=$/; + local $,=qq(\t); + foreach my $rv ( @$rv ) { + my $rt = ref $rv; + if (qq(ARRAY) eq $rt) { + print @$rv; + } else { + print $rv; + } + } + } else { + print $rv; + } +}") + +(defvar org-babel-perl-preface nil) + +(defvar org-babel-perl-pp-wrapper-method + nil) + +(defun org-babel-perl-evaluate (session ibody &optional result-type result-params) + "Pass BODY to the Perl process in SESSION. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY, as elisp." + (when session (error "Sessions are not supported for Perl")) + (let* ((body (concat org-babel-perl-preface ibody)) + (tmp-file (org-babel-temp-file "perl-")) + (tmp-babel-file (org-babel-process-file-name + tmp-file 'noquote))) + (let ((results + (case result-type + (output + (with-temp-file tmp-file + (insert + (org-babel-eval org-babel-perl-command body)) + (buffer-string))) + (value + (org-babel-eval org-babel-perl-command + (format org-babel-perl-wrapper-method + body tmp-babel-file)))))) + (when results + (org-babel-result-cond result-params + (org-babel-eval-read-file tmp-file) + (org-babel-import-elisp-from-file tmp-file '(16))))))) + +(provide 'ob-perl) + + + +;;; ob-perl.el ends here diff --git a/elpa/org-20150427/ob-picolisp.el b/elpa/org-20150427/ob-picolisp.el new file mode 100644 index 00000000..b240138f --- /dev/null +++ b/elpa/org-20150427/ob-picolisp.el @@ -0,0 +1,189 @@ +;;; ob-picolisp.el --- org-babel functions for picolisp evaluation + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Authors: Thorsten Jolitz +;; Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; This library enables the use of PicoLisp in the multi-language +;; programming framework Org-Babel. PicoLisp is a minimal yet +;; fascinating lisp dialect and a highly productive application +;; framework for web-based client-server applications on top of +;; object-oriented databases. A good way to learn PicoLisp is to first +;; read Paul Grahams essay "The hundred year language" +;; (http://www.paulgraham.com/hundred.html) and then study the various +;; documents and essays published in the PicoLisp wiki +;; (http://picolisp.com/5000/-2.html). PicoLisp is included in some +;; GNU/Linux Distributions, and can be downloaded here: +;; http://software-lab.de/down.html. It ships with a picolisp-mode and +;; a inferior-picolisp-mode for Emacs (to be found in the /lib/el/ +;; directory). + +;; Although it might seem more natural to use Emacs Lisp for most +;; Lisp-based programming tasks inside Org-Mode, an Emacs library +;; written in Emacs Lisp, PicoLisp has at least two outstanding +;; features that make it a valuable addition to Org-Babel: + +;; PicoLisp _is_ an object-oriented database with a Prolog-based query +;; language implemented in PicoLisp (Pilog). Database objects are +;; first-class members of the language. + +;; PicoLisp is an extremely productive framework for the development +;; of interactive web-applications (on top of a database). + +;;; Requirements: + +;;; Code: +(require 'ob) +(require 'comint) +(eval-when-compile (require 'cl)) + +(declare-function run-picolisp "ext:inferior-picolisp" (cmd)) +(defvar org-babel-tangle-lang-exts) ;; Autoloaded + +;; optionally define a file extension for this language +(add-to-list 'org-babel-tangle-lang-exts '("picolisp" . "l")) + +;;; interferes with settings in org-babel buffer? +;; optionally declare default header arguments for this language +;; (defvar org-babel-default-header-args:picolisp +;; '((:colnames . "no")) +;; "Default arguments for evaluating a picolisp source block.") + +(defvar org-babel-picolisp-eoe "org-babel-picolisp-eoe" + "String to indicate that evaluation has completed.") + +(defcustom org-babel-picolisp-cmd "pil" + "Name of command used to evaluate picolisp blocks." + :group 'org-babel + :version "24.1" + :type 'string) + +(defun org-babel-expand-body:picolisp (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) + (result-params (cdr (assoc :result-params params))) + (print-level nil) (print-length nil)) + (if (> (length vars) 0) + (concat "(prog (let (" + (mapconcat + (lambda (var) + (format "%S '%S)" + (print (car var)) + (print (cdr var)))) + vars "\n ") + " \n" body ") )") + body))) + +(defun org-babel-execute:picolisp (body params) + "Execute a block of Picolisp code with org-babel. This function is + called by `org-babel-execute-src-block'" + (message "executing Picolisp source code block") + (let* ( + ;; Name of the session or "none". + (session-name (cdr (assoc :session params))) + ;; Set the session if the session variable is non-nil. + (session (org-babel-picolisp-initiate-session session-name)) + ;; Either OUTPUT or VALUE which should behave as described above. + (result-type (cdr (assoc :result-type params))) + (result-params (cdr (assoc :result-params params))) + ;; Expand the body with `org-babel-expand-body:picolisp'. + (full-body (org-babel-expand-body:picolisp body params)) + ;; Wrap body appropriately for the type of evaluation and results. + (wrapped-body + (cond + ((or (member "code" result-params) + (member "pp" result-params)) + (format "(pretty (out \"/dev/null\" %s))" full-body)) + ((and (member "value" result-params) (not session)) + (format "(print (out \"/dev/null\" %s))" full-body)) + ((member "value" result-params) + (format "(out \"/dev/null\" %s)" full-body)) + (t full-body))) + (result + (if (not (string= session-name "none")) + ;; Session based evaluation. + (mapconcat ;; <- joins the list back into a single string + #'identity + (butlast ;; <- remove the org-babel-picolisp-eoe line + (delq nil + (mapcar + (lambda (line) + (org-babel-chomp ;; Remove trailing newlines. + (when (> (length line) 0) ;; Remove empty lines. + (cond + ;; Remove leading "-> " from return values. + ((and (>= (length line) 3) + (string= "-> " (substring line 0 3))) + (substring line 3)) + ;; Remove trailing "-> <>" on the + ;; last line of output. + ((and (member "output" result-params) + (string-match-p "->" line)) + (substring line 0 (string-match "->" line))) + (t line) + ) + ;;(if (and (>= (length line) 3);Remove leading "<-" + ;; (string= "-> " (substring line 0 3))) + ;; (substring line 3) + ;; line) + ))) + ;; Returns a list of the output of each evaluated exp. + (org-babel-comint-with-output + (session org-babel-picolisp-eoe) + (insert wrapped-body) (comint-send-input) + (insert "'" org-babel-picolisp-eoe) + (comint-send-input))))) + "\n") + ;; external evaluation + (let ((script-file (org-babel-temp-file "picolisp-script-"))) + (with-temp-file script-file + (insert (concat wrapped-body "(bye)"))) + (org-babel-eval + (format "%s %s" + org-babel-picolisp-cmd + (org-babel-process-file-name script-file)) + ""))))) + (org-babel-result-cond result-params + result + (read result)))) + +(defun org-babel-picolisp-initiate-session (&optional session-name) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (unless (string= session-name "none") + (require 'inferior-picolisp) + ;; provide a reasonable default session name + (let ((session (or session-name "*inferior-picolisp*"))) + ;; check if we already have a live session by this name + (if (org-babel-comint-buffer-livep session) + (get-buffer session) + (save-window-excursion + (run-picolisp org-babel-picolisp-cmd) + (rename-buffer session-name) + (current-buffer)))))) + +(provide 'ob-picolisp) + + + +;;; ob-picolisp.el ends here diff --git a/elpa/org-20150427/ob-plantuml.el b/elpa/org-20150427/ob-plantuml.el new file mode 100644 index 00000000..ebc5a10e --- /dev/null +++ b/elpa/org-20150427/ob-plantuml.el @@ -0,0 +1,85 @@ +;;; ob-plantuml.el --- org-babel functions for plantuml evaluation + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Zhang Weize +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating plantuml script. +;; +;; Inspired by Ian Yang's org-export-blocks-format-plantuml +;; http://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el + +;;; Requirements: + +;; plantuml | http://plantuml.sourceforge.net/ +;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:plantuml + '((:results . "file") (:exports . "results")) + "Default arguments for evaluating a plantuml source block.") + +(defcustom org-plantuml-jar-path "" + "Path to the plantuml.jar file." + :group 'org-babel + :version "24.1" + :type 'string) + +(defun org-babel-execute:plantuml (body params) + "Execute a block of plantuml code with org-babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (out-file (or (cdr (assoc :file params)) + (error "PlantUML requires a \":file\" header argument"))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "plantuml-")) + (java (or (cdr (assoc :java params)) "")) + (cmd (if (string= "" org-plantuml-jar-path) + (error "`org-plantuml-jar-path' is not set") + (concat "java " java " -jar " + (shell-quote-argument + (expand-file-name org-plantuml-jar-path)) + (if (string= (file-name-extension out-file) "svg") + " -tsvg" "") + (if (string= (file-name-extension out-file) "eps") + " -teps" "") + " -p " cmdline " < " + (org-babel-process-file-name in-file) + " > " + (org-babel-process-file-name out-file))))) + (unless (file-exists-p org-plantuml-jar-path) + (error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) + (with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml"))) + (message "%s" cmd) (org-babel-eval cmd "") + nil)) ;; signal that output has already been written to file + +(defun org-babel-prep-session:plantuml (session params) + "Return an error because plantuml does not support sessions." + (error "Plantuml does not support sessions")) + +(provide 'ob-plantuml) + + + +;;; ob-plantuml.el ends here diff --git a/elpa/org-20150427/ob-python.el b/elpa/org-20150427/ob-python.el new file mode 100644 index 00000000..7cee1046 --- /dev/null +++ b/elpa/org-20150427/ob-python.el @@ -0,0 +1,344 @@ +;;; ob-python.el --- org-babel functions for python evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Authors: Eric Schulte +;; Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating python source code. + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function org-remove-indentation "org" ) +(declare-function py-shell "ext:python-mode" (&optional argprompt)) +(declare-function py-toggle-shells "ext:python-mode" (arg)) +(declare-function run-python "ext:python" (cmd &optional dedicated show)) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("python" . "py")) + +(defvar org-babel-default-header-args:python '()) + +(defcustom org-babel-python-command "python" + "Name of the command for executing Python code." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-babel + :type 'string) + +(defcustom org-babel-python-mode + (if (or (featurep 'xemacs) (featurep 'python-mode)) 'python-mode 'python) + "Preferred python mode for use in running python interactively. +This will typically be either 'python or 'python-mode." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'symbol) + +(defcustom org-babel-python-hline-to "None" + "Replace hlines in incoming tables with this when translating to python." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-babel-python-None-to 'hline + "Replace 'None' in python tables with this before returning." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'symbol) + +(defun org-babel-execute:python (body params) + "Execute a block of Python code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((session (org-babel-python-initiate-session + (cdr (assoc :session params)))) + (result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) + (return-val (when (and (eq result-type 'value) (not session)) + (cdr (assoc :return params)))) + (preamble (cdr (assoc :preamble params))) + (full-body + (org-babel-expand-body:generic + (concat body (if return-val (format "\nreturn %s" return-val) "")) + params (org-babel-variable-assignments:python params))) + (result (org-babel-python-evaluate + session full-body result-type result-params preamble))) + (org-babel-reassemble-table + result + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params)))))) + +(defun org-babel-prep-session:python (session params) + "Prepare SESSION according to the header arguments in PARAMS. +VARS contains resolved variable references" + (let* ((session (org-babel-python-initiate-session session)) + (var-lines + (org-babel-variable-assignments:python params))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (end-of-line 1) (insert var) (comint-send-input) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:python (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:python session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-variable-assignments:python (params) + "Return a list of Python statements assigning the block's variables." + (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-python-var-to-python (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-python-var-to-python (var) + "Convert an elisp value to a python variable. +Convert an elisp value, VAR, into a string of python source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-python-var-to-python var ", ") "]") + (if (equal var 'hline) + org-babel-python-hline-to + (format + (if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S") + (if (stringp var) (substring-no-properties var) var))))) + +(defun org-babel-python-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If the results look like a list or tuple, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (let ((res (org-babel-script-escape results))) + (if (listp res) + (mapcar (lambda (el) (if (equal el 'None) + org-babel-python-None-to el)) + res) + res))) + +(defvar org-babel-python-buffers '((:default . "*Python*"))) + +(defun org-babel-python-session-buffer (session) + "Return the buffer associated with SESSION." + (cdr (assoc session org-babel-python-buffers))) + +(defun org-babel-python-with-earmuffs (session) + (let ((name (if (stringp session) session (format "%s" session)))) + (if (and (string= "*" (substring name 0 1)) + (string= "*" (substring name (- (length name) 1)))) + name + (format "*%s*" name)))) + +(defun org-babel-python-without-earmuffs (session) + (let ((name (if (stringp session) session (format "%s" session)))) + (if (and (string= "*" (substring name 0 1)) + (string= "*" (substring name (- (length name) 1)))) + (substring name 1 (- (length name) 1)) + name))) + +(defvar py-default-interpreter) +(defvar py-which-bufname) +(defvar python-shell-buffer-name) +(defun org-babel-python-initiate-session-by-key (&optional session) + "Initiate a python session. +If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session." + (require org-babel-python-mode) + (save-window-excursion + (let* ((session (if session (intern session) :default)) + (python-buffer (org-babel-python-session-buffer session)) + (cmd (if (member system-type '(cygwin windows-nt ms-dos)) + (concat org-babel-python-command " -i") + org-babel-python-command))) + (cond + ((and (eq 'python org-babel-python-mode) + (fboundp 'run-python)) ; python.el + (if (not (version< "24.1" emacs-version)) + (run-python cmd) + (unless python-buffer + (setq python-buffer (org-babel-python-with-earmuffs session))) + (let ((python-shell-buffer-name + (org-babel-python-without-earmuffs python-buffer))) + (run-python cmd)))) + ((and (eq 'python-mode org-babel-python-mode) + (fboundp 'py-shell)) ; python-mode.el + ;; Make sure that py-which-bufname is initialized, as otherwise + ;; it will be overwritten the first time a Python buffer is + ;; created. + (py-toggle-shells py-default-interpreter) + ;; `py-shell' creates a buffer whose name is the value of + ;; `py-which-bufname' with '*'s at the beginning and end + (let* ((bufname (if (and python-buffer (buffer-live-p python-buffer)) + (replace-regexp-in-string ;; zap surrounding * + "^\\*\\([^*]+\\)\\*$" "\\1" python-buffer) + (concat "Python-" (symbol-name session)))) + (py-which-bufname bufname)) + (py-shell) + (setq python-buffer (org-babel-python-with-earmuffs bufname)))) + (t + (error "No function available for running an inferior Python"))) + (setq org-babel-python-buffers + (cons (cons session python-buffer) + (assq-delete-all session org-babel-python-buffers))) + session))) + +(defun org-babel-python-initiate-session (&optional session params) + "Create a session named SESSION according to PARAMS." + (unless (string= session "none") + (org-babel-python-session-buffer + (org-babel-python-initiate-session-by-key session)))) + +(defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'" + "A string to indicate that evaluation has completed.") +(defvar org-babel-python-wrapper-method + " +def main(): +%s + +open('%s', 'w').write( str(main()) )") +(defvar org-babel-python-pp-wrapper-method + " +import pprint +def main(): +%s + +open('%s', 'w').write( pprint.pformat(main()) )") + +(defun org-babel-python-evaluate + (session body &optional result-type result-params preamble) + "Evaluate BODY as Python code." + (if session + (org-babel-python-evaluate-session + session body result-type result-params) + (org-babel-python-evaluate-external-process + body result-type result-params preamble))) + +(defun org-babel-python-evaluate-external-process + (body &optional result-type result-params preamble) + "Evaluate BODY in external python process. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (let ((raw + (case result-type + (output (org-babel-eval org-babel-python-command + (concat (if preamble (concat preamble "\n")) + body))) + (value (let ((tmp-file (org-babel-temp-file "python-"))) + (org-babel-eval + org-babel-python-command + (concat + (if preamble (concat preamble "\n") "") + (format + (if (member "pp" result-params) + org-babel-python-pp-wrapper-method + org-babel-python-wrapper-method) + (mapconcat + (lambda (line) (format "\t%s" line)) + (split-string + (org-remove-indentation + (org-babel-trim body)) + "[\r\n]") "\n") + (org-babel-process-file-name tmp-file 'noquote)))) + (org-babel-eval-read-file tmp-file)))))) + (org-babel-result-cond result-params + raw + (org-babel-python-table-or-string (org-babel-trim raw))))) + +(defun org-babel-python-evaluate-session + (session body &optional result-type result-params) + "Pass BODY to the Python process in SESSION. +If RESULT-TYPE equals 'output then return standard output as a +string. If RESULT-TYPE equals 'value then return the value of the +last statement in BODY, as elisp." + (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5))) + (dump-last-value + (lambda + (tmp-file pp) + (mapc + (lambda (statement) (insert statement) (funcall send-wait)) + (if pp + (list + "import pprint" + (format "open('%s', 'w').write(pprint.pformat(_))" + (org-babel-process-file-name tmp-file 'noquote))) + (list (format "open('%s', 'w').write(str(_))" + (org-babel-process-file-name tmp-file + 'noquote))))))) + (input-body (lambda (body) + (mapc (lambda (line) (insert line) (funcall send-wait)) + (split-string body "[\r\n]")) + (funcall send-wait))) + (results + (case result-type + (output + (mapconcat + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (session org-babel-python-eoe-indicator t body) + (funcall input-body body) + (funcall send-wait) (funcall send-wait) + (insert org-babel-python-eoe-indicator) + (funcall send-wait)) + 2) "\n")) + (value + (let ((tmp-file (org-babel-temp-file "python-"))) + (org-babel-comint-with-output + (session org-babel-python-eoe-indicator nil body) + (let ((comint-process-echoes nil)) + (funcall input-body body) + (funcall dump-last-value tmp-file + (member "pp" result-params)) + (funcall send-wait) (funcall send-wait) + (insert org-babel-python-eoe-indicator) + (funcall send-wait))) + (org-babel-eval-read-file tmp-file)))))) + (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results) + (org-babel-result-cond result-params + results + (org-babel-python-table-or-string results))))) + +(defun org-babel-python-read-string (string) + "Strip 's from around Python string." + (if (string-match "^'\\([^\000]+\\)'$" string) + (match-string 1 string) + string)) + +(provide 'ob-python) + + + +;;; ob-python.el ends here diff --git a/elpa/org-20150427/ob-ref.el b/elpa/org-20150427/ob-ref.el new file mode 100644 index 00000000..152af86a --- /dev/null +++ b/elpa/org-20150427/ob-ref.el @@ -0,0 +1,271 @@ +;;; ob-ref.el --- org-babel functions for referencing external data + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Authors: Eric Schulte +;; Dan Davison +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Functions for referencing data from the header arguments of a +;; org-babel block. The syntax of such a reference should be + +;; #+VAR: variable-name=file:resource-id + +;; - variable-name :: the name of the variable to which the value +;; will be assigned + +;; - file :: path to the file containing the resource, or omitted if +;; resource is in the current file + +;; - resource-id :: the id or name of the resource + +;; So an example of a simple src block referencing table data in the +;; same file would be + +;; #+NAME: sandbox +;; | 1 | 2 | 3 | +;; | 4 | org-babel | 6 | +;; +;; #+begin_src emacs-lisp :var table=sandbox +;; (message table) +;; #+end_src + +;;; Code: +(require 'ob-core) +(eval-when-compile + (require 'cl)) + +(declare-function org-remove-if-not "org" (predicate seq)) +(declare-function org-at-table-p "org" (&optional table-type)) +(declare-function org-count "org" (CL-ITEM CL-SEQ)) +(declare-function org-at-item-p "org-list" ()) +(declare-function org-narrow-to-subtree "org" ()) +(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp)) +(declare-function org-id-find-id-file "org-id" (id)) +(declare-function org-show-context "org" (&optional key)) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) + +(defvar org-babel-ref-split-regexp + "[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*") + +(defvar org-babel-update-intermediate nil + "Update the in-buffer results of code blocks executed to resolve references.") + +(defun org-babel-ref-parse (assignment) + "Parse a variable ASSIGNMENT in a header argument. +If the right hand side of the assignment has a literal value +return that value, otherwise interpret as a reference to an +external resource and find its value using +`org-babel-ref-resolve'. Return a list with two elements. The +first element of the list will be the name of the variable, and +the second will be an emacs-lisp representation of the value of +the variable." + (when (string-match org-babel-ref-split-regexp assignment) + (let ((var (match-string 1 assignment)) + (ref (match-string 2 assignment))) + (cons (intern var) + (let ((out (save-excursion + (when org-babel-current-src-block-location + (goto-char (if (markerp org-babel-current-src-block-location) + (marker-position org-babel-current-src-block-location) + org-babel-current-src-block-location))) + (org-babel-read ref)))) + (if (equal out ref) + (if (string-match "^\".*\"$" ref) + (read ref) + (org-babel-ref-resolve ref)) + out)))))) + +(defun org-babel-ref-goto-headline-id (id) + (goto-char (point-min)) + (let ((rx (regexp-quote id))) + (or (re-search-forward + (concat "^[ \t]*:CUSTOM_ID:[ \t]+" rx "[ \t]*$") nil t) + (let* ((file (org-id-find-id-file id)) + (m (when file (org-id-find-id-in-file id file 'marker)))) + (when (and file m) + (message "file:%S" file) + (org-pop-to-buffer-same-window (marker-buffer m)) + (goto-char m) + (move-marker m nil) + (org-show-context) + t))))) + +(defun org-babel-ref-headline-body () + (save-restriction + (org-narrow-to-subtree) + (buffer-substring + (save-excursion (goto-char (point-min)) + (forward-line 1) + (when (looking-at "[ \t]*:PROPERTIES:") + (re-search-forward ":END:" nil) + (forward-char)) + (point)) + (point-max)))) + +(defvar org-babel-library-of-babel) +(defun org-babel-ref-resolve (ref) + "Resolve the reference REF and return its value." + (save-window-excursion + (save-excursion + (let ((case-fold-search t) + type args new-refere new-header-args new-referent result + lob-info split-file split-ref index index-row index-col id) + ;; if ref is indexed grab the indices -- beware nested indices + (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) + (let ((str (substring ref 0 (match-beginning 0)))) + (= (org-count ?( str) (org-count ?) str)))) + (setq index (match-string 1 ref)) + (setq ref (substring ref 0 (match-beginning 0)))) + ;; assign any arguments to pass to source block + (when (string-match + "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref) + (setq new-refere (match-string 1 ref)) + (setq new-header-args (match-string 3 ref)) + (setq new-referent (match-string 5 ref)) + (when (> (length new-refere) 0) + (when (> (length new-referent) 0) + (setq args (mapcar (lambda (ref) (cons :var ref)) + (org-babel-ref-split-args new-referent)))) + (when (> (length new-header-args) 0) + (setq args (append (org-babel-parse-header-arguments + new-header-args) args))) + (setq ref new-refere))) + (when (string-match "^\\(.+\\):\\(.+\\)$" ref) + (setq split-file (match-string 1 ref)) + (setq split-ref (match-string 2 ref)) + (find-file split-file) (setq ref split-ref)) + (save-restriction + (widen) + (goto-char (point-min)) + (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref)) + (res-rx (org-babel-named-data-regexp-for-name ref))) + ;; goto ref in the current buffer + (or + ;; check for code blocks + (re-search-forward src-rx nil t) + ;; check for named data + (re-search-forward res-rx nil t) + ;; check for local or global headlines by id + (setq id (org-babel-ref-goto-headline-id ref)) + ;; check the Library of Babel + (setq lob-info (cdr (assoc (intern ref) + org-babel-library-of-babel))))) + (unless (or lob-info id) (goto-char (match-beginning 0))) + ;; ;; TODO: allow searching for names in other buffers + ;; (setq id-loc (org-id-find ref 'marker) + ;; buffer (marker-buffer id-loc) + ;; loc (marker-position id-loc)) + ;; (move-marker id-loc nil) + (error "Reference '%s' not found in this buffer" ref)) + (cond + (lob-info (setq type 'lob)) + (id (setq type 'id)) + ((and (looking-at org-babel-src-name-regexp) + (save-excursion + (forward-line 1) + (or (looking-at org-babel-src-block-regexp) + (looking-at org-babel-multi-line-header-regexp)))) + (setq type 'source-block)) + (t (while (not (setq type (org-babel-ref-at-ref-p))) + (forward-line 1) + (beginning-of-line) + (if (or (= (point) (point-min)) (= (point) (point-max))) + (error "Reference not found"))))) + (let ((params (append args '((:results . "silent"))))) + (setq result + (case type + (results-line (org-babel-read-result)) + (table (org-babel-read-table)) + (list (org-babel-read-list)) + (file (org-babel-read-link)) + (source-block (org-babel-execute-src-block + nil nil (if org-babel-update-intermediate + nil params))) + (lob (org-babel-execute-src-block + nil lob-info params)) + (id (org-babel-ref-headline-body))))) + (if (symbolp result) + (format "%S" result) + (if (and index (listp result)) + (org-babel-ref-index-list index result) + result))))))) + +(defun org-babel-ref-index-list (index lis) + "Return the subset of LIS indexed by INDEX. + +Indices are 0 based and negative indices count from the end of +LIS, so 0 references the first element of LIS and -1 references +the last. If INDEX is separated by \",\"s then each \"portion\" +is assumed to index into the next deepest nesting or dimension. + +A valid \"portion\" can consist of either an integer index, two +integers separated by a \":\" in which case the entire range is +returned, or an empty string or \"*\" both of which are +interpreted to mean the entire range and as such are equivalent +to \"0:-1\"." + (if (and (> (length index) 0) (string-match "^\\([^,]*\\),?" index)) + (let* ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)") + (lgth (length lis)) + (portion (match-string 1 index)) + (remainder (substring index (match-end 0))) + (wrap (lambda (num) (if (< num 0) (+ lgth num) num))) + (open (lambda (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls)))) + (funcall + open + (mapcar + (lambda (sub-lis) + (if (listp sub-lis) + (org-babel-ref-index-list remainder sub-lis) + sub-lis)) + (if (or (= 0 (length portion)) (string-match ind-re portion)) + (mapcar + (lambda (n) (nth n lis)) + (apply 'org-number-sequence + (if (and (> (length portion) 0) (match-string 2 portion)) + (list + (funcall wrap (string-to-number (match-string 2 portion))) + (funcall wrap (string-to-number (match-string 3 portion)))) + (list (funcall wrap 0) (funcall wrap -1))))) + (list (nth (funcall wrap (string-to-number portion)) lis)))))) + lis)) + +(defun org-babel-ref-split-args (arg-string) + "Split ARG-STRING into top-level arguments of balanced parenthesis." + (mapcar #'org-babel-trim (org-babel-balanced-split arg-string 44))) + +(defvar org-bracket-link-regexp) +(defun org-babel-ref-at-ref-p () + "Return the type of reference located at point. +Return nil if none of the supported reference types are found. +Supported reference types are tables and source blocks." + (cond ((org-at-table-p) 'table) + ((org-at-item-p) 'list) + ((looking-at "^[ \t]*#\\+BEGIN_SRC") 'source-block) + ((looking-at org-bracket-link-regexp) 'file) + ((looking-at org-babel-result-regexp) 'results-line))) + +(provide 'ob-ref) + + + +;;; ob-ref.el ends here diff --git a/elpa/org-20150427/ob-ruby.el b/elpa/org-20150427/ob-ruby.el new file mode 100644 index 00000000..5b31247b --- /dev/null +++ b/elpa/org-20150427/ob-ruby.el @@ -0,0 +1,260 @@ +;;; ob-ruby.el --- org-babel functions for ruby evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating ruby source code. + +;;; Requirements: + +;; - ruby and irb executables :: http://www.ruby-lang.org/ +;; +;; - ruby-mode :: Can be installed through ELPA, or from +;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el +;; +;; - inf-ruby mode :: Can be installed through ELPA, or from +;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function run-ruby "ext:inf-ruby" (&optional command name)) +(declare-function xmp "ext:rcodetools" (&optional option)) + +(defvar org-babel-tangle-lang-exts) +(add-to-list 'org-babel-tangle-lang-exts '("ruby" . "rb")) + +(defvar org-babel-default-header-args:ruby '()) + +(defvar org-babel-ruby-command "ruby" + "Name of command to use for executing ruby code.") + +(defcustom org-babel-ruby-hline-to "nil" + "Replace hlines in incoming tables with this when translating to ruby." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-babel-ruby-nil-to 'hline + "Replace 'nil' in ruby tables with this before returning." + :group 'org-babel + :version "24.4" + :package-version '(Org . "8.0") + :type 'symbol) + +(defun org-babel-execute:ruby (body params) + "Execute a block of Ruby code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((session (org-babel-ruby-initiate-session + (cdr (assoc :session params)))) + (result-params (cdr (assoc :result-params params))) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params (org-babel-variable-assignments:ruby params))) + (result (if (member "xmp" result-params) + (with-temp-buffer + (require 'rcodetools) + (insert full-body) + (xmp (cdr (assoc :xmp-option params))) + (buffer-string)) + (org-babel-ruby-evaluate + session full-body result-type result-params)))) + (org-babel-reassemble-table + (org-babel-result-cond result-params + result + (org-babel-ruby-table-or-string result)) + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params)))))) + +(defun org-babel-prep-session:ruby (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + ;; (message "params=%S" params) ;; debugging + (let* ((session (org-babel-ruby-initiate-session session)) + (var-lines (org-babel-variable-assignments:ruby params))) + (org-babel-comint-in-buffer session + (sit-for .5) (goto-char (point-max)) + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session) + (sit-for .1) (goto-char (point-max))) var-lines)) + session)) + +(defun org-babel-load-session:ruby (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:ruby session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-variable-assignments:ruby (params) + "Return list of ruby statements assigning the block's variables." + (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-ruby-var-to-ruby (cdr pair)))) + (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun org-babel-ruby-var-to-ruby (var) + "Convert VAR into a ruby variable. +Convert an elisp value into a string of ruby source code +specifying a variable of the same value." + (if (listp var) + (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]") + (if (equal var 'hline) + org-babel-ruby-hline-to + (format "%S" var)))) + +(defun org-babel-ruby-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (let ((res (org-babel-script-escape results))) + (if (listp res) + (mapcar (lambda (el) (if (equal el 'nil) + org-babel-ruby-nil-to el)) + res) + res))) + +(defun org-babel-ruby-initiate-session (&optional session params) + "Initiate a ruby session. +If there is not a current inferior-process-buffer in SESSION +then create one. Return the initialized session." + (unless (string= session "none") + (require 'inf-ruby) + (let ((session-buffer (save-window-excursion + (run-ruby nil session) (current-buffer)))) + (if (org-babel-comint-buffer-livep session-buffer) + (progn (sit-for .25) session-buffer) + (sit-for .5) + (org-babel-ruby-initiate-session session))))) + +(defvar org-babel-ruby-eoe-indicator ":org_babel_ruby_eoe" + "String to indicate that evaluation has completed.") +(defvar org-babel-ruby-f-write + "File.open('%s','w'){|f| f.write((_.class == String) ? _ : _.inspect)}") +(defvar org-babel-ruby-pp-f-write + "File.open('%s','w'){|f| $stdout = f; pp(results); $stdout = orig_out}") +(defvar org-babel-ruby-wrapper-method + " +def main() +%s +end +results = main() +File.open('%s', 'w'){ |f| f.write((results.class == String) ? results : results.inspect) } +") +(defvar org-babel-ruby-pp-wrapper-method + " +require 'pp' +def main() +%s +end +results = main() +File.open('%s', 'w') do |f| + $stdout = f + pp results +end +") + +(defun org-babel-ruby-evaluate + (buffer body &optional result-type result-params) + "Pass BODY to the Ruby process in BUFFER. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY, as elisp." + (if (not buffer) + ;; external process evaluation + (case result-type + (output (org-babel-eval org-babel-ruby-command body)) + (value (let ((tmp-file (org-babel-temp-file "ruby-"))) + (org-babel-eval + org-babel-ruby-command + (format (if (member "pp" result-params) + org-babel-ruby-pp-wrapper-method + org-babel-ruby-wrapper-method) + body (org-babel-process-file-name tmp-file 'noquote))) + (let ((raw (org-babel-eval-read-file tmp-file))) + (if (or (member "code" result-params) + (member "pp" result-params)) + raw + (org-babel-ruby-table-or-string raw)))))) + ;; comint session evaluation + (case result-type + (output + (mapconcat + #'identity + (butlast + (split-string + (mapconcat + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (buffer org-babel-ruby-eoe-indicator t body) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (list body org-babel-ruby-eoe-indicator)) + (comint-send-input nil t)) 2) + "\n") "[\r\n]")) "\n")) + (value + (let* ((tmp-file (org-babel-temp-file "ruby-")) + (ppp (or (member "code" result-params) + (member "pp" result-params)))) + (org-babel-comint-with-output + (buffer org-babel-ruby-eoe-indicator t body) + (when ppp (insert "require 'pp';") (comint-send-input nil t)) + (mapc + (lambda (line) + (insert (org-babel-chomp line)) (comint-send-input nil t)) + (append + (list body) + (if (not ppp) + (list (format org-babel-ruby-f-write + (org-babel-process-file-name tmp-file 'noquote))) + (list + "results=_" "require 'pp'" "orig_out = $stdout" + (format org-babel-ruby-pp-f-write + (org-babel-process-file-name tmp-file 'noquote)))) + (list org-babel-ruby-eoe-indicator))) + (comint-send-input nil t)) + (org-babel-eval-read-file tmp-file)))))) + +(defun org-babel-ruby-read-string (string) + "Strip \\\"s from around a ruby string." + (if (string-match "^\"\\([^\000]+\\)\"$" string) + (match-string 1 string) + string)) + +(provide 'ob-ruby) + + + +;;; ob-ruby.el ends here diff --git a/elpa/org-20150427/ob-sass.el b/elpa/org-20150427/ob-sass.el new file mode 100644 index 00000000..78c0c958 --- /dev/null +++ b/elpa/org-20150427/ob-sass.el @@ -0,0 +1,71 @@ +;;; ob-sass.el --- org-babel functions for the sass css generation language + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; For more information on sass see http://sass-lang.com/ +;; +;; This accepts a 'file' header argument which is the target of the +;; compiled sass. The default output type for sass evaluation is +;; either file (if a 'file' header argument was given) or scalar if no +;; such header argument was supplied. +;; +;; A 'cmdline' header argument can be supplied to pass arguments to +;; the sass command line. + +;;; Requirements: + +;; - sass-mode :: http://github.com/nex3/haml/blob/master/extra/sass-mode.el + +;;; Code: +(require 'ob) + +(defvar org-babel-default-header-args:sass '()) + +(defun org-babel-execute:sass (body params) + "Execute a block of Sass code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (file (cdr (assoc :file params))) + (out-file (or file (org-babel-temp-file "sass-out-"))) + (cmdline (cdr (assoc :cmdline params))) + (in-file (org-babel-temp-file "sass-in-")) + (cmd (concat "sass " (or cmdline "") + " " (org-babel-process-file-name in-file) + " " (org-babel-process-file-name out-file)))) + (with-temp-file in-file + (insert (org-babel-expand-body:generic body params))) + (org-babel-eval cmd "") + (if file + nil ;; signal that output has already been written to file + (with-temp-buffer (insert-file-contents out-file) (buffer-string))))) + +(defun org-babel-prep-session:sass (session params) + "Raise an error because sass does not support sessions." + (error "Sass does not support sessions")) + +(provide 'ob-sass) + + + +;;; ob-sass.el ends here diff --git a/elpa/org-20150427/ob-scala.el b/elpa/org-20150427/ob-scala.el new file mode 100644 index 00000000..0584342f --- /dev/null +++ b/elpa/org-20150427/ob-scala.el @@ -0,0 +1,124 @@ +;;; ob-scala.el --- org-babel functions for Scala evaluation + +;; Copyright (C) 2012-2014 Free Software Foundation, Inc. + +;; Author: Andrzej Lichnerowicz +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: +;; Currently only supports the external execution. No session support yet. + +;;; Requirements: +;; - Scala language :: http://www.scala-lang.org/ +;; - Scala major mode :: Can be installed from Scala sources +;; https://github.com/scala/scala-dist/blob/master/tool-support/src/emacs/scala-mode.el + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(defvar org-babel-tangle-lang-exts) ;; Autoloaded +(add-to-list 'org-babel-tangle-lang-exts '("scala" . "scala")) +(defvar org-babel-default-header-args:scala '()) +(defvar org-babel-scala-command "scala" + "Name of the command to use for executing Scala code.") + +(defun org-babel-execute:scala (body params) + "Execute a block of Scala code with org-babel. This function is +called by `org-babel-execute-src-block'" + (message "executing Scala source code block") + (let* ((processed-params (org-babel-process-params params)) + (session (org-babel-scala-initiate-session (nth 0 processed-params))) + (vars (nth 1 processed-params)) + (result-params (nth 2 processed-params)) + (result-type (cdr (assoc :result-type params))) + (full-body (org-babel-expand-body:generic + body params)) + (result (org-babel-scala-evaluate + session full-body result-type result-params))) + + (org-babel-reassemble-table + result + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + + +(defun org-babel-scala-table-or-string (results) + "Convert RESULTS into an appropriate elisp value. +If RESULTS look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape results)) + + +(defvar org-babel-scala-wrapper-method + +"var str_result :String = null; + +Console.withOut(new java.io.OutputStream() {def write(b: Int){ +}}) { + str_result = { +%s + }.toString +} + +print(str_result) +") + + +(defun org-babel-scala-evaluate + (session body &optional result-type result-params) + "Evaluate BODY in external Scala process. +If RESULT-TYPE equals 'output then return standard output as a string. +If RESULT-TYPE equals 'value then return the value of the last statement +in BODY as elisp." + (when session (error "Sessions are not (yet) supported for Scala")) + (case result-type + (output + (let ((src-file (org-babel-temp-file "scala-"))) + (progn (with-temp-file src-file (insert body)) + (org-babel-eval + (concat org-babel-scala-command " " src-file) "")))) + (value + (let* ((src-file (org-babel-temp-file "scala-")) + (wrapper (format org-babel-scala-wrapper-method body))) + (with-temp-file src-file (insert wrapper)) + (let ((raw (org-babel-eval + (concat org-babel-scala-command " " src-file) ""))) + (org-babel-result-cond result-params + raw + (org-babel-scala-table-or-string raw))))))) + + +(defun org-babel-prep-session:scala (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (error "Sessions are not (yet) supported for Scala")) + +(defun org-babel-scala-initiate-session (&optional session) + "If there is not a current inferior-process-buffer in SESSION +then create. Return the initialized session. Sessions are not +supported in Scala." + nil) + +(provide 'ob-scala) + + + +;;; ob-scala.el ends here diff --git a/elpa/org-20150427/ob-scheme.el b/elpa/org-20150427/ob-scheme.el new file mode 100644 index 00000000..b7117e9a --- /dev/null +++ b/elpa/org-20150427/ob-scheme.el @@ -0,0 +1,190 @@ +;;; ob-scheme.el --- org-babel functions for Scheme + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Authors: Eric Schulte +;; Michael Gauland +;; Keywords: literate programming, reproducible research, scheme +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Now working with SBCL for both session and external evaluation. +;; +;; This certainly isn't optimally robust, but it seems to be working +;; for the basic use cases. + +;;; Requirements: + +;; - a working scheme implementation +;; (e.g. guile http://www.gnu.org/software/guile/guile.html) +;; +;; - for session based evaluation geiser is required, which is available from +;; ELPA. + +;;; Code: +(require 'ob) +(require 'geiser nil t) +(defvar geiser-repl--repl) ; Defined in geiser-repl.el +(defvar geiser-impl--implementation) ; Defined in geiser-impl.el +(defvar geiser-default-implementation) ; Defined in geiser-impl.el +(defvar geiser-active-implementations) ; Defined in geiser-impl.el + +(declare-function run-geiser "geiser-repl" (impl)) +(declare-function geiser-mode "geiser-mode" ()) +(declare-function geiser-eval-region "geiser-mode" (start end &optional and-go raw nomsg)) +(declare-function geiser-repl-exit "geiser-repl" (&optional arg)) + +(defvar org-babel-default-header-args:scheme '() + "Default header arguments for scheme code blocks.") + +(defun org-babel-expand-body:scheme (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (if (> (length vars) 0) + (concat "(let (" + (mapconcat + (lambda (var) (format "%S" (print `(,(car var) ',(cdr var))))) + vars "\n ") + ")\n" body ")") + body))) + + +(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal) + "Map of scheme sessions to session names.") + +(defun org-babel-scheme-cleanse-repl-map () + "Remove dead buffers from the REPL map." + (maphash + (lambda (x y) + (when (not (buffer-name y)) + (remhash x org-babel-scheme-repl-map))) + org-babel-scheme-repl-map)) + +(defun org-babel-scheme-get-session-buffer (session-name) + "Look up the scheme buffer for a session; return nil if it doesn't exist." + (org-babel-scheme-cleanse-repl-map) ; Prune dead sessions + (gethash session-name org-babel-scheme-repl-map)) + +(defun org-babel-scheme-set-session-buffer (session-name buffer) + "Record the scheme buffer used for a given session." + (puthash session-name buffer org-babel-scheme-repl-map)) + +(defun org-babel-scheme-get-buffer-impl (buffer) + "Returns the scheme implementation geiser associates with the buffer." + (with-current-buffer (set-buffer buffer) + geiser-impl--implementation)) + +(defun org-babel-scheme-get-repl (impl name) + "Switch to a scheme REPL, creating it if it doesn't exist:" + (let ((buffer (org-babel-scheme-get-session-buffer name))) + (or buffer + (progn + (run-geiser impl) + (if name + (progn + (rename-buffer name t) + (org-babel-scheme-set-session-buffer name (current-buffer)))) + (current-buffer))))) + +(defun org-babel-scheme-make-session-name (buffer name impl) + "Generate a name for the session buffer. + +For a named session, the buffer name will be the session name. + +If the session is unnamed (nil), generate a name. + +If the session is 'none', use nil for the session name, and +org-babel-scheme-execute-with-geiser will use a temporary session." + (let ((result + (cond ((not name) + (concat buffer " " (symbol-name impl) " REPL")) + ((string= name "none") nil) + (name)))) + result)) + +(defun org-babel-scheme-execute-with-geiser (code output impl repl) + "Execute code in specified REPL. If the REPL doesn't exist, create it +using the given scheme implementation. + +Returns the output of executing the code if the output parameter +is true; otherwise returns the last value." + (let ((result nil)) + (with-temp-buffer + (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl)) + (newline) + (insert (if output + (format "(with-output-to-string (lambda () %s))" code) + code)) + (geiser-mode) + (let ((repl-buffer (save-current-buffer + (org-babel-scheme-get-repl impl repl)))) + (when (not (eq impl (org-babel-scheme-get-buffer-impl + (current-buffer)))) + (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl) + (org-babel-scheme-get-buffer-impl (current-buffer)) + (symbolp (org-babel-scheme-get-buffer-impl + (current-buffer))))) + (setq geiser-repl--repl repl-buffer) + (setq geiser-impl--implementation nil) + (geiser-eval-region (point-min) (point-max)) + (setq result + (if (equal (substring (current-message) 0 3) "=> ") + (replace-regexp-in-string "^=> " "" (current-message)) + "\"An error occurred.\"")) + (when (not repl) + (save-current-buffer (set-buffer repl-buffer) + (geiser-repl-exit)) + (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil) + (kill-buffer repl-buffer)) + (setq result (if (or (string= result "#") + (string= result "#")) + nil + (read result))))) + result)) + +(defun org-babel-execute:scheme (body params) + "Execute a block of Scheme code with org-babel. +This function is called by `org-babel-execute-src-block'" + (let* ((source-buffer (current-buffer)) + (source-buffer-name (replace-regexp-in-string ;; zap surrounding * + "^ ?\\*\\([^*]+\\)\\*" "\\1" + (buffer-name source-buffer)))) + (save-excursion + (org-babel-reassemble-table + (let* ((result-type (cdr (assoc :result-type params))) + (impl (or (when (cdr (assoc :scheme params)) + (intern (cdr (assoc :scheme params)))) + geiser-default-implementation + (car geiser-active-implementations))) + (session (org-babel-scheme-make-session-name + source-buffer-name (cdr (assoc :session params)) impl)) + (full-body (org-babel-expand-body:scheme body params))) + (org-babel-scheme-execute-with-geiser + full-body ; code + (string= result-type "output") ; output? + impl ; implementation + (and (not (string= session "none")) session))) ; session + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params))))))) + +(provide 'ob-scheme) + +;;; ob-scheme.el ends here diff --git a/elpa/org-20150427/ob-screen.el b/elpa/org-20150427/ob-screen.el new file mode 100644 index 00000000..1d4ccddd --- /dev/null +++ b/elpa/org-20150427/ob-screen.el @@ -0,0 +1,145 @@ +;;; ob-screen.el --- org-babel support for interactive terminal + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Benjamin Andresen +;; Keywords: literate programming, interactive shell +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for interactive terminals. Mostly shell scripts. +;; Heavily inspired by 'eev' from Eduardo Ochs +;; +;; Adding :cmd and :terminal as header arguments +;; :terminal must support the -T (title) and -e (command) parameter +;; +;; You can test the default setup. (xterm + sh) with +;; M-x org-babel-screen-test RET + +;;; Code: +(require 'ob) + +(defvar org-babel-screen-location "screen" + "The command location for screen. +In case you want to use a different screen than one selected by your $PATH") + +(defvar org-babel-default-header-args:screen + '((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm")) + "Default arguments to use when running screen source blocks.") + +(defun org-babel-execute:screen (body params) + "Send a block of code via screen to a terminal using Babel. +\"default\" session is used when none is specified." + (message "Sending source code block to interactive terminal session...") + (save-window-excursion + (let* ((session (cdr (assoc :session params))) + (socket (org-babel-screen-session-socketname session))) + (unless socket (org-babel-prep-session:screen session params)) + (org-babel-screen-session-execute-string + session (org-babel-expand-body:generic body params))))) + +(defun org-babel-prep-session:screen (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (cdr (assoc :session params))) + (socket (org-babel-screen-session-socketname session)) + (cmd (cdr (assoc :cmd params))) + (terminal (cdr (assoc :terminal params))) + (process-name (concat "org-babel: terminal (" session ")"))) + (apply 'start-process process-name "*Messages*" + terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location + "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session) + ,cmd)) + ;; XXX: Is there a better way than the following? + (while (not (org-babel-screen-session-socketname session)) + ;; wait until screen session is available before returning + ))) + +;; helper functions + +(defun org-babel-screen-session-execute-string (session body) + "If SESSION exists, send BODY to it." + (let ((socket (org-babel-screen-session-socketname session))) + (when socket + (let ((tmpfile (org-babel-screen-session-write-temp-file session body))) + (apply 'start-process (concat "org-babel: screen (" session ")") "*Messages*" + org-babel-screen-location + `("-S" ,socket "-X" "eval" "msgwait 0" + ,(concat "readreg z " tmpfile) + "paste z")))))) + +(defun org-babel-screen-session-socketname (session) + "Check if SESSION exists by parsing output of \"screen -ls\"." + (let* ((screen-ls (shell-command-to-string "screen -ls")) + (sockets (delq + nil + (mapcar + (lambda (x) + (when (string-match (rx (or "(Attached)" "(Detached)")) x) + x)) + (split-string screen-ls "\n")))) + (match-socket (car + (delq + nil + (mapcar + (lambda (x) + (when (string-match + (concat "org-babel-session-" session) x) + x)) + sockets))))) + (when match-socket (car (split-string match-socket))))) + +(defun org-babel-screen-session-write-temp-file (session body) + "Save BODY in a temp file that is named after SESSION." + (let ((tmpfile (org-babel-temp-file "screen-"))) + (with-temp-file tmpfile + (insert body) + + ;; org-babel has superfluous spaces + (goto-char (point-min)) + (delete-matching-lines "^ +$")) + tmpfile)) + +(defun org-babel-screen-test () + "Test if the default setup works. +The terminal should shortly flicker." + (interactive) + (let* ((session "org-babel-testing") + (random-string (format "%s" (random 99999))) + (tmpfile (org-babel-temp-file "ob-screen-test-")) + (body (concat "echo '" random-string "' > " tmpfile "\nexit\n")) + process tmp-string) + (org-babel-execute:screen body org-babel-default-header-args:screen) + ;; XXX: need to find a better way to do the following + (while (not (file-readable-p tmpfile)) + ;; do something, otherwise this will be optimized away + (format "org-babel-screen: File not readable yet.")) + (setq tmp-string (with-temp-buffer + (insert-file-contents-literally tmpfile) + (buffer-substring (point-min) (point-max)))) + (delete-file tmpfile) + (message (concat "org-babel-screen: Setup " + (if (string-match random-string tmp-string) + "WORKS." + "DOESN'T work."))))) + +(provide 'ob-screen) + + + +;;; ob-screen.el ends here diff --git a/elpa/org-20150427/ob-sh.el b/elpa/org-20150427/ob-sh.el new file mode 100644 index 00000000..856c7a01 --- /dev/null +++ b/elpa/org-20150427/ob-sh.el @@ -0,0 +1,218 @@ +;;; ob-sh.el --- org-babel functions for shell evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating shell source code. + +;;; Code: +(require 'ob) +(require 'shell) +(eval-when-compile (require 'cl)) + +(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)) +(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer)) +(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) +(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body)) +(declare-function orgtbl-to-generic "org-table" (table params)) + +(defvar org-babel-default-header-args:sh '()) + +(defvar org-babel-sh-command "sh" + "Command used to invoke a shell. +This will be passed to `shell-command-on-region'") + +(defcustom org-babel-sh-var-quote-fmt + "$(cat <<'BABEL_TABLE'\n%s\nBABEL_TABLE\n)" + "Format string used to escape variables when passed to shell scripts." + :group 'org-babel + :type 'string) + +(defun org-babel-execute:sh (body params) + "Execute a block of Shell commands with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((session (org-babel-sh-initiate-session + (cdr (assoc :session params)))) + (stdin (let ((stdin (cdr (assoc :stdin params)))) + (when stdin (org-babel-sh-var-to-string + (org-babel-ref-resolve stdin))))) + (full-body (org-babel-expand-body:generic + body params (org-babel-variable-assignments:sh params)))) + (org-babel-reassemble-table + (org-babel-sh-evaluate session full-body params stdin) + (org-babel-pick-name + (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) + (org-babel-pick-name + (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) + +(defun org-babel-prep-session:sh (session params) + "Prepare SESSION according to the header arguments specified in PARAMS." + (let* ((session (org-babel-sh-initiate-session session)) + (var-lines (org-babel-variable-assignments:sh params))) + (org-babel-comint-in-buffer session + (mapc (lambda (var) + (insert var) (comint-send-input nil t) + (org-babel-comint-wait-for-output session)) var-lines)) + session)) + +(defun org-babel-load-session:sh (session body params) + "Load BODY into SESSION." + (save-window-excursion + (let ((buffer (org-babel-prep-session:sh session params))) + (with-current-buffer buffer + (goto-char (process-mark (get-buffer-process (current-buffer)))) + (insert (org-babel-chomp body))) + buffer))) + +;; helper functions + +(defun org-babel-variable-assignments:sh (params) + "Return list of shell statements assigning the block's variables." + (let ((sep (cdr (assoc :separator params)))) + (mapcar + (lambda (pair) + (format "%s=%s" + (car pair) + (org-babel-sh-var-to-sh (cdr pair) sep))) + (mapcar #'cdr (org-babel-get-header params :var))))) + +(defun org-babel-sh-var-to-sh (var &optional sep) + "Convert an elisp value to a shell variable. +Convert an elisp var into a string of shell commands specifying a +var of the same value." + (format org-babel-sh-var-quote-fmt (org-babel-sh-var-to-string var sep))) + +(defun org-babel-sh-var-to-string (var &optional sep) + "Convert an elisp value to a string." + (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v))))) + (cond + ((and (listp var) (or (listp (car var)) (equal (car var) 'hline))) + (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var))) + ((listp var) + (mapconcat echo-var var "\n")) + (t (funcall echo-var var))))) + +(defun org-babel-sh-table-or-results (results) + "Convert RESULTS to an appropriate elisp value. +If the results look like a table, then convert them into an +Emacs-lisp table, otherwise return the results as a string." + (org-babel-script-escape results)) + +(defun org-babel-sh-initiate-session (&optional session params) + "Initiate a session named SESSION according to PARAMS." + (when (and session (not (string= session "none"))) + (save-window-excursion + (or (org-babel-comint-buffer-livep session) + (progn + (shell session) + ;; Needed for Emacs 23 since the marker is initially + ;; undefined and the filter functions try to use it without + ;; checking. + (set-marker comint-last-output-start (point)) + (get-buffer (current-buffer))))))) + +(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'" + "String to indicate that evaluation has completed.") +(defvar org-babel-sh-eoe-output "org_babel_sh_eoe" + "String to indicate that evaluation has completed.") + +(defun org-babel-sh-evaluate (session body &optional params stdin) + "Pass BODY to the Shell process in BUFFER. +If RESULT-TYPE equals 'output then return a list of the outputs +of the statements in BODY, if RESULT-TYPE equals 'value then +return the value of the last statement in BODY." + (let ((results + (cond + (stdin ; external shell script w/STDIN + (let ((script-file (org-babel-temp-file "sh-script-")) + (stdin-file (org-babel-temp-file "sh-stdin-")) + (shebang (cdr (assoc :shebang params))) + (padline (not (string= "no" (cdr (assoc :padline params)))))) + (with-temp-file script-file + (when shebang (insert (concat shebang "\n"))) + (when padline (insert "\n")) + (insert body)) + (set-file-modes script-file #o755) + (with-temp-file stdin-file (insert stdin)) + (with-temp-buffer + (call-process-shell-command + (if shebang + script-file + (format "%s %s" org-babel-sh-command script-file)) + stdin-file + (current-buffer)) + (buffer-string)))) + (session ; session evaluation + (mapconcat + #'org-babel-sh-strip-weird-long-prompt + (mapcar + #'org-babel-trim + (butlast + (org-babel-comint-with-output + (session org-babel-sh-eoe-output t body) + (mapc + (lambda (line) + (insert line) + (comint-send-input nil t) + (while (save-excursion + (goto-char comint-last-input-end) + (not (re-search-forward + comint-prompt-regexp nil t))) + (accept-process-output + (get-buffer-process (current-buffer))))) + (append + (split-string (org-babel-trim body) "\n") + (list org-babel-sh-eoe-indicator)))) + 2)) "\n")) + ('otherwise ; external shell script + (if (and (cdr (assoc :shebang params)) + (> (length (cdr (assoc :shebang params))) 0)) + (let ((script-file (org-babel-temp-file "sh-script-")) + (shebang (cdr (assoc :shebang params))) + (padline (not (equal "no" (cdr (assoc :padline params)))))) + (with-temp-file script-file + (when shebang (insert (concat shebang "\n"))) + (when padline (insert "\n")) + (insert body)) + (set-file-modes script-file #o755) + (org-babel-eval script-file "")) + (org-babel-eval org-babel-sh-command (org-babel-trim body))))))) + (when results + (let ((result-params (cdr (assoc :result-params params)))) + (org-babel-result-cond result-params + results + (let ((tmp-file (org-babel-temp-file "sh-"))) + (with-temp-file tmp-file (insert results)) + (org-babel-import-elisp-from-file tmp-file))))))) + +(defun org-babel-sh-strip-weird-long-prompt (string) + "Remove prompt cruft from a string of shell output." + (while (string-match "^% +[\r\n$]+ *" string) + (setq string (substring string (match-end 0)))) + string) + +(provide 'ob-sh) + + + +;;; ob-sh.el ends here diff --git a/elpa/org-20150427/ob-shen.el b/elpa/org-20150427/ob-shen.el new file mode 100644 index 00000000..e40e45cc --- /dev/null +++ b/elpa/org-20150427/ob-shen.el @@ -0,0 +1,79 @@ +;;; ob-shen.el --- org-babel functions for Shen + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research, shen +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Currently this only works using session evaluation as there is no +;; defined method for executing shen code outside of a session. + +;;; Requirements: + +;; - shen-mode and inf-shen will soon be available through the GNU +;; elpa, however in the interim they are available at +;; https://github.com/eschulte/shen-mode + +;;; Code: +(require 'ob) + +(declare-function shen-eval-defun "ext:inf-shen" (&optional and-go)) +(declare-function org-babel-ruby-var-to-ruby "ob-ruby" (var)) + +(defvar org-babel-default-header-args:shen '() + "Default header arguments for shen code blocks.") + +(defun org-babel-expand-body:shen (body params) + "Expand BODY according to PARAMS, return the expanded body." + (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) + (if (> (length vars) 0) + (concat "(let " + (mapconcat (lambda (var) + (format "%s %s" (car var) + (org-babel-shen-var-to-shen (cdr var)))) + vars " ") + body ")") + body))) + +(defun org-babel-shen-var-to-shen (var) + "Convert VAR into a shen variable." + (if (listp var) + (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var " ") "]") + (format "%S" var))) + +(defun org-babel-execute:shen (body params) + "Execute a block of Shen code with org-babel. +This function is called by `org-babel-execute-src-block'" + (require 'inf-shen) + (let* ((result-type (cdr (assoc :result-type params))) + (result-params (cdr (assoc :result-params params))) + (full-body (org-babel-expand-body:shen body params))) + (let ((results + (with-temp-buffer + (insert full-body) + (call-interactively #'shen-eval-defun)))) + (org-babel-result-cond result-params + results + (condition-case nil (org-babel-script-escape results) + (error results)))))) + +(provide 'ob-shen) +;;; ob-shen.el ends here diff --git a/elpa/org-20150427/ob-sql.el b/elpa/org-20150427/ob-sql.el new file mode 100644 index 00000000..08d44191 --- /dev/null +++ b/elpa/org-20150427/ob-sql.el @@ -0,0 +1,212 @@ +;;; ob-sql.el --- org-babel functions for sql evaluation + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating sql source code. +;; (see also ob-sqlite.el) +;; +;; SQL is somewhat unique in that there are many different engines for +;; the evaluation of sql (Mysql, PostgreSQL, etc...), so much of this +;; file will have to be implemented engine by engine. +;; +;; Also SQL evaluation generally takes place inside of a database. +;; +;; Header args used: +;; - engine +;; - cmdline +;; - dbhost +;; - dbuser +;; - dbpassword +;; - database +;; - colnames (default, nil, means "yes") +;; - result-params +;; - out-file +;; The following are used but not really implemented for SQL: +;; - colname-names +;; - rownames +;; - rowname-names +;; +;; TODO: +;; +;; - support for sessions +;; - support for more engines (currently only supports mysql) +;; - what's a reasonable way to drop table data into SQL? +;; + +;;; Code: +(require 'ob) +(eval-when-compile (require 'cl)) + +(declare-function org-table-import "org-table" (file arg)) +(declare-function orgtbl-to-csv "org-table" (table params)) +(declare-function org-table-to-lisp "org-table" (&optional txt)) + +(defvar org-babel-default-header-args:sql '()) + +(defconst org-babel-header-args:sql + '((engine . :any) + (out-file . :any) + (dbhost . :any) + (dbuser . :any) + (dbpassword . :any) + (database . :any)) + "SQL-specific header arguments.") + +(defun org-babel-expand-body:sql (body params) + "Expand BODY according to the values of PARAMS." + (org-babel-sql-expand-vars + body (mapcar #'cdr (org-babel-get-header params :var)))) + +(defun dbstring-mysql (host user password database) + "Make MySQL cmd line args for database connection. Pass nil to omit that arg." + (combine-and-quote-strings + (remq nil + (list (when host (concat "-h" host)) + (when user (concat "-u" user)) + (when password (concat "-p" password)) + (when database (concat "-D" database)))))) + +(defun org-babel-execute:sql (body params) + "Execute a block of Sql code with Babel. +This function is called by `org-babel-execute-src-block'." + (let* ((result-params (cdr (assoc :result-params params))) + (cmdline (cdr (assoc :cmdline params))) + (dbhost (cdr (assoc :dbhost params))) + (dbuser (cdr (assoc :dbuser params))) + (dbpassword (cdr (assoc :dbpassword params))) + (database (cdr (assoc :database params))) + (engine (cdr (assoc :engine params))) + (colnames-p (not (equal "no" (cdr (assoc :colnames params))))) + (in-file (org-babel-temp-file "sql-in-")) + (out-file (or (cdr (assoc :out-file params)) + (org-babel-temp-file "sql-out-"))) + (header-delim "") + (command (case (intern engine) + ('dbi (format "dbish --batch %s < %s | sed '%s' > %s" + (or cmdline "") + (org-babel-process-file-name in-file) + "/^+/d;s/^\|//;s/(NULL)/ /g;$d" + (org-babel-process-file-name out-file))) + ('monetdb (format "mclient -f tab %s < %s > %s" + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + ('msosql (format "osql %s -s \"\t\" -i %s -o %s" + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + ('mysql (format "mysql %s %s %s < %s > %s" + (dbstring-mysql dbhost dbuser dbpassword database) + (if colnames-p "" "-N") + (or cmdline "") + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file))) + ('postgresql (format + "psql -A -P footer=off -F \"\t\" -f %s -o %s %s" + (org-babel-process-file-name in-file) + (org-babel-process-file-name out-file) + (or cmdline ""))) + (t (error "No support for the %s SQL engine" engine))))) + (with-temp-file in-file + (insert + (case (intern engine) + ('dbi "/format partbox\n") + (t "")) + (org-babel-expand-body:sql body params))) + (message command) + (org-babel-eval command "") + (org-babel-result-cond result-params + (with-temp-buffer + (progn (insert-file-contents-literally out-file) (buffer-string))) + (with-temp-buffer + (cond + ((or (eq (intern engine) 'mysql) + (eq (intern engine) 'dbi) + (eq (intern engine) 'postgresql)) + ;; Add header row delimiter after column-names header in first line + (cond + (colnames-p + (with-temp-buffer + (insert-file-contents out-file) + (goto-char (point-min)) + (forward-line 1) + (insert "-\n") + (setq header-delim "-") + (write-file out-file))))) + (t + ;; Need to figure out the delimiter for the header row + (with-temp-buffer + (insert-file-contents out-file) + (goto-char (point-min)) + (when (re-search-forward "^\\(-+\\)[^-]" nil t) + (setq header-delim (match-string-no-properties 1))) + (goto-char (point-max)) + (forward-char -1) + (while (looking-at "\n") + (delete-char 1) + (goto-char (point-max)) + (forward-char -1)) + (write-file out-file)))) + (org-table-import out-file '(16)) + (org-babel-reassemble-table + (mapcar (lambda (x) + (if (string= (car x) header-delim) + 'hline + x)) + (org-table-to-lisp)) + (org-babel-pick-name (cdr (assoc :colname-names params)) + (cdr (assoc :colnames params))) + (org-babel-pick-name (cdr (assoc :rowname-names params)) + (cdr (assoc :rownames params)))))))) + +(defun org-babel-sql-expand-vars (body vars) + "Expand the variables held in VARS in BODY." + (mapc + (lambda (pair) + (setq body + (replace-regexp-in-string + (format "\$%s" (car pair)) ;FIXME: "\$" == "$"! + (let ((val (cdr pair))) + (if (listp val) + (let ((data-file (org-babel-temp-file "sql-data-"))) + (with-temp-file data-file + (insert (orgtbl-to-csv + val '(:fmt (lambda (el) (if (stringp el) + el + (format "%S" el))))))) + data-file) + (if (stringp val) val (format "%S" val)))) + body))) + vars) + body) + +(defun org-babel-prep-session:sql (session params) + "Raise an error because Sql sessions aren't implemented." + (error "SQL sessions not yet implemented")) + +(provide 'ob-sql) + + + +;;; ob-sql.el ends here diff --git a/elpa/org-20150427/ob-sqlite.el b/elpa/org-20150427/ob-sqlite.el new file mode 100644 index 00000000..098626fe --- /dev/null +++ b/elpa/org-20150427/ob-sqlite.el @@ -0,0 +1,162 @@ +;;; ob-sqlite.el --- org-babel functions for sqlite database interaction + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Org-Babel support for evaluating sqlite source code. + +;;; Code: +(require 'ob) + +(declare-function org-fill-template "org" (template alist)) +(declare-function org-table-convert-region "org-table" + (beg0 end0 &optional separator)) +(declare-function orgtbl-to-csv "org-table" (table params)) +(declare-function org-table-to-lisp "org-table" (&optional txt)) + +(defvar org-babel-default-header-args:sqlite '()) + +(defvar org-babel-header-args:sqlite + '((db . :any) + (header . :any) + (echo . :any) + (bail . :any) + (csv . :any) + (column . :any) + (html . :any) + (line . :any) + (list . :any) + (separator . :any) + (nullvalue . :any)) + "Sqlite specific header args.") + +(defun org-babel-expand-body:sqlite (body params) + "Expand BODY according to the values of PARAMS." + (org-babel-sqlite-expand-vars + body (mapcar #'cdr (org-babel-get-header params :var)))) + +(defvar org-babel-sqlite3-command "sqlite3") + +(defun org-babel-execute:sqlite (body params) + "Execute a block of Sqlite code with Babel. +This function is called by `org-babel-execute-src-block'." + (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) + (db (cdr (assoc :db params))) + (separator (cdr (assoc :separator params))) + (nullvalue (cdr (assoc :nullvalue params))) + (headers-p (equal "yes" (cdr (assoc :colnames params)))) + (others (delq nil (mapcar + (lambda (arg) (car (assoc arg params))) + (list :header :echo :bail :column + :csv :html :line :list)))) + exit-code) + (unless db (error "ob-sqlite: can't evaluate without a database")) + (with-temp-buffer + (insert + (org-babel-eval + (org-fill-template + "%cmd %header %separator %nullvalue %others %csv %db " + (list + (cons "cmd" org-babel-sqlite3-command) + (cons "header" (if headers-p "-header" "-noheader")) + (cons "separator" + (if separator (format "-separator %s" separator) "")) + (cons "nullvalue" + (if nullvalue (format "-nullvalue %s" nullvalue) "")) + (cons "others" + (mapconcat + (lambda (arg) (format "-%s" (substring (symbol-name arg) 1))) + others " ")) + ;; for easy table parsing, default header type should be -csv + (cons "csv" (if (or (member :csv others) (member :column others) + (member :line others) (member :list others) + (member :html others) separator) + "" + "-csv")) + (cons "db " db))) + ;; body of the code block + (org-babel-expand-body:sqlite body params))) + (org-babel-result-cond result-params + (buffer-string) + (if (equal (point-min) (point-max)) + "" + (org-table-convert-region (point-min) (point-max) + (if (or (member :csv others) + (member :column others) + (member :line others) + (member :list others) + (member :html others) separator) + nil + '(4))) + (org-babel-sqlite-table-or-scalar + (org-babel-sqlite-offset-colnames + (org-table-to-lisp) headers-p))))))) + +(defun org-babel-sqlite-expand-vars (body vars) + "Expand the variables held in VARS in BODY." + ;; FIXME: Redundancy with org-babel-sql-expand-vars! + (mapc + (lambda (pair) + (setq body + (replace-regexp-in-string + (format "\$%s" (car pair)) ;FIXME: "\$" == "$"! + (let ((val (cdr pair))) + (if (listp val) + (let ((data-file (org-babel-temp-file "sqlite-data-"))) + (with-temp-file data-file + (insert (orgtbl-to-csv + val '(:fmt (lambda (el) (if (stringp el) + el + (format "%S" el))))))) + data-file) + (if (stringp val) val (format "%S" val)))) + body))) + vars) + body) + +(defun org-babel-sqlite-table-or-scalar (result) + "If RESULT looks like a trivial table, then unwrap it." + (if (and (equal 1 (length result)) + (equal 1 (length (car result)))) + (org-babel-read (caar result)) + (mapcar (lambda (row) + (if (equal 'hline row) + 'hline + (mapcar #'org-babel-string-read row))) result))) + +(defun org-babel-sqlite-offset-colnames (table headers-p) + "If HEADERS-P is non-nil then offset the first row as column names." + (if headers-p + (cons (car table) (cons 'hline (cdr table))) + table)) + +(defun org-babel-prep-session:sqlite (session params) + "Raise an error because support for SQLite sessions isn't implemented. +Prepare SESSION according to the header arguments specified in PARAMS." + (error "SQLite sessions not yet implemented")) + +(provide 'ob-sqlite) + + + +;;; ob-sqlite.el ends here diff --git a/elpa/org-20150427/ob-table.el b/elpa/org-20150427/ob-table.el new file mode 100644 index 00000000..831e3521 --- /dev/null +++ b/elpa/org-20150427/ob-table.el @@ -0,0 +1,141 @@ +;;; ob-table.el --- support for calling org-babel functions from tables + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Should allow calling functions from org-mode tables using the +;; function `org-sbe' as so... + +;; #+begin_src emacs-lisp :results silent +;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2))))) +;; #+end_src + +;; #+name: fibbd +;; #+begin_src emacs-lisp :var n=2 :results silent +;; (fibbd n) +;; #+end_src + +;; | original | fibbd | +;; |----------+--------| +;; | 0 | | +;; | 1 | | +;; | 2 | | +;; | 3 | | +;; | 4 | | +;; | 5 | | +;; | 6 | | +;; | 7 | | +;; | 8 | | +;; | 9 | | +;; #+TBLFM: $2='(org-sbe 'fibbd (n $1)) + +;;; Code: +(require 'ob-core) + +(defun org-babel-table-truncate-at-newline (string) + "Replace newline character with ellipses. +If STRING ends in a newline character, then remove the newline +character and replace it with ellipses." + (if (and (stringp string) (string-match "[\n\r]\\(.\\)?" string)) + (concat (substring string 0 (match-beginning 0)) + (if (match-string 1 string) "...")) string)) + +(defmacro org-sbe (source-block &rest variables) + "Return the results of calling SOURCE-BLOCK with VARIABLES. +Each element of VARIABLES should be a two +element list, whose first element is the name of the variable and +second element is a string of its value. The following call to +`org-sbe' would be equivalent to the following source code block. + + (org-sbe 'source-block (n $2) (m 3)) + +#+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent +results +#+end_src + +NOTE: by default string variable names are interpreted as +references to source-code blocks, to force interpretation of a +cell's value as a string, prefix the identifier a \"$\" (e.g., +\"$$2\" instead of \"$2\" or \"$@2$2\" instead of \"@2$2\"). + +NOTE: it is also possible to pass header arguments to the code +block. In this case a table cell should hold the string value of +the header argument which can then be passed before all variables +as shown in the example below. + +| 1 | 2 | :file nothing.png | nothing.png | +#+TBLFM: @1$4='(org-sbe test-sbe $3 (x $1) (y $2))" + (declare (debug (form form))) + (let* ((header-args (if (stringp (car variables)) (car variables) "")) + (variables (if (stringp (car variables)) (cdr variables) variables))) + (let* (quote + (variables + (mapcar + (lambda (var) + ;; ensure that all cells prefixed with $'s are strings + (cons (car var) + (delq nil (mapcar + (lambda (el) + (if (eq '$ el) + (prog1 nil (setq quote t)) + (prog1 + (cond + (quote (format "\"%s\"" el)) + ((stringp el) (org-no-properties el)) + (t el)) + (setq quote nil)))) + (cdr var))))) + variables))) + (unless (stringp source-block) + (setq source-block (symbol-name source-block))) + (let ((result + (if (and source-block (> (length source-block) 0)) + (let ((params + ;; FIXME: Why `eval'?!?!? + (eval `(org-babel-parse-header-arguments + (concat + ":var results=" + ,source-block + "[" ,header-args "]" + "(" + (mapconcat + (lambda (var-spec) + (if (> (length (cdr var-spec)) 1) + (format "%S='%S" + (car var-spec) + (mapcar #'read (cdr var-spec))) + (format "%S=%s" + (car var-spec) (cadr var-spec)))) + ',variables ", ") + ")"))))) + (org-babel-execute-src-block + nil (list "emacs-lisp" "results" params) + '((:results . "silent")))) + ""))) + (org-babel-trim (if (stringp result) result (format "%S" result))))))) + +(provide 'ob-table) + + + +;;; ob-table.el ends here diff --git a/elpa/org-20150427/ob-tangle.el b/elpa/org-20150427/ob-tangle.el new file mode 100644 index 00000000..3a43b42e --- /dev/null +++ b/elpa/org-20150427/ob-tangle.el @@ -0,0 +1,560 @@ +;;; ob-tangle.el --- extract source code from org-mode files + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;; Extract the code from source blocks out into raw source-code files. + +;;; Code: +(require 'org-src) +(eval-when-compile + (require 'cl)) + +(declare-function org-edit-special "org" (&optional arg)) +(declare-function org-link-escape "org" (text &optional table)) +(declare-function org-store-link "org" (arg)) +(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer)) +(declare-function org-heading-components "org" ()) +(declare-function org-back-to-heading "org" (invisible-ok)) +(declare-function org-fill-template "org" (template alist)) +(declare-function org-babel-update-block-body "org" (new-body)) +(declare-function make-directory "files" (dir &optional parents)) + +(defcustom org-babel-tangle-lang-exts + '(("emacs-lisp" . "el")) + "Alist mapping languages to their file extensions. +The key is the language name, the value is the string that should +be inserted as the extension commonly used to identify files +written in this language. If no entry is found in this list, +then the name of the language is used." + :group 'org-babel-tangle + :version "24.1" + :type '(repeat + (cons + (string "Language name") + (string "File Extension")))) + +(defcustom org-babel-post-tangle-hook nil + "Hook run in code files tangled by `org-babel-tangle'." + :group 'org-babel + :version "24.1" + :type 'hook) + +(defcustom org-babel-pre-tangle-hook '(save-buffer) + "Hook run at the beginning of `org-babel-tangle'." + :group 'org-babel + :version "24.1" + :type 'hook) + +(defcustom org-babel-tangle-body-hook nil + "Hook run over the contents of each code block body." + :group 'org-babel + :version "24.1" + :type 'hook) + +(defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]" + "Format of inserted comments in tangled code files. +The following format strings can be used to insert special +information into the output using `org-fill-template'. +%start-line --- the line number at the start of the code block +%file --------- the file from which the code block was tangled +%link --------- Org-mode style link to the code block +%source-name -- name of the code block + +Whether or not comments are inserted during tangling is +controlled by the :comments header argument." + :group 'org-babel + :version "24.1" + :type 'string) + +(defcustom org-babel-tangle-comment-format-end "%source-name ends here" + "Format of inserted comments in tangled code files. +The following format strings can be used to insert special +information into the output using `org-fill-template'. +%start-line --- the line number at the start of the code block +%file --------- the file from which the code block was tangled +%link --------- Org-mode style link to the code block +%source-name -- name of the code block + +Whether or not comments are inserted during tangling is +controlled by the :comments header argument." + :group 'org-babel + :version "24.1" + :type 'string) + +(defcustom org-babel-process-comment-text #'org-babel-trim + "Function called to process raw Org-mode text collected to be +inserted as comments in tangled source-code files. The function +should take a single string argument and return a string +result. The default value is `org-babel-trim'." + :group 'org-babel + :version "24.1" + :type 'function) + +(defun org-babel-find-file-noselect-refresh (file) + "Find file ensuring that the latest changes on disk are +represented in the file." + (find-file-noselect file 'nowarn) + (with-current-buffer (get-file-buffer file) + (revert-buffer t t t))) + +(defmacro org-babel-with-temp-filebuffer (file &rest body) + "Open FILE into a temporary buffer execute BODY there like +`progn', then kill the FILE buffer returning the result of +evaluating BODY." + (declare (indent 1)) + (let ((temp-path (make-symbol "temp-path")) + (temp-result (make-symbol "temp-result")) + (temp-file (make-symbol "temp-file")) + (visited-p (make-symbol "visited-p"))) + `(let* ((,temp-path ,file) + (,visited-p (get-file-buffer ,temp-path)) + ,temp-result ,temp-file) + (org-babel-find-file-noselect-refresh ,temp-path) + (setf ,temp-file (get-file-buffer ,temp-path)) + (with-current-buffer ,temp-file + (setf ,temp-result (progn ,@body))) + (unless ,visited-p (kill-buffer ,temp-file)) + ,temp-result))) +(def-edebug-spec org-babel-with-temp-filebuffer (form body)) + +;;;###autoload +(defun org-babel-tangle-file (file &optional target-file lang) + "Extract the bodies of source code blocks in FILE. +Source code blocks are extracted with `org-babel-tangle'. +Optional argument TARGET-FILE can be used to specify a default +export file for all source blocks. Optional argument LANG can be +used to limit the exported source code blocks by language. +Return a list whose CAR is the tangled file name." + (interactive "fFile to tangle: \nP") + (let ((visited-p (get-file-buffer (expand-file-name file))) + to-be-removed) + (prog1 + (save-window-excursion + (find-file file) + (setq to-be-removed (current-buffer)) + (org-babel-tangle nil target-file lang)) + (unless visited-p + (kill-buffer to-be-removed))))) + +(defun org-babel-tangle-publish (_ filename pub-dir) + "Tangle FILENAME and place the results in PUB-DIR." + (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename))) + +;;;###autoload +(defun org-babel-tangle (&optional arg target-file lang) + "Write code blocks to source-specific files. +Extract the bodies of all source code blocks from the current +file into their own source-specific files. +With one universal prefix argument, only tangle the block at point. +When two universal prefix arguments, only tangle blocks for the +tangle file of the block at point. +Optional argument TARGET-FILE can be used to specify a default +export file for all source blocks. Optional argument LANG can be +used to limit the exported source code blocks by language." + (interactive "P") + (run-hooks 'org-babel-pre-tangle-hook) + ;; Possibly Restrict the buffer to the current code block + (save-restriction + (when (equal arg '(4)) + (let ((head (org-babel-where-is-src-block-head))) + (if head + (goto-char head) + (user-error "Point is not in a source code block")))) + (save-excursion + (let ((block-counter 0) + (org-babel-default-header-args + (if target-file + (org-babel-merge-params org-babel-default-header-args + (list (cons :tangle target-file))) + org-babel-default-header-args)) + (tangle-file + (when (equal arg '(16)) + (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info 'light)))) + (user-error "Point is not in a source code block")))) + path-collector) + (mapc ;; map over all languages + (lambda (by-lang) + (let* ((lang (car by-lang)) + (specs (cdr by-lang)) + (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang)) + (lang-f (intern + (concat + (or (and (cdr (assoc lang org-src-lang-modes)) + (symbol-name + (cdr (assoc lang org-src-lang-modes)))) + lang) + "-mode"))) + she-banged) + (mapc + (lambda (spec) + (let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec)))))) + (let* ((tangle (funcall get-spec :tangle)) + (she-bang (let ((sheb (funcall get-spec :shebang))) + (when (> (length sheb) 0) sheb))) + (tangle-mode (funcall get-spec :tangle-mode)) + (base-name (cond + ((string= "yes" tangle) + (file-name-sans-extension + (buffer-file-name))) + ((string= "no" tangle) nil) + ((> (length tangle) 0) tangle))) + (file-name (when base-name + ;; decide if we want to add ext to base-name + (if (and ext (string= "yes" tangle)) + (concat base-name "." ext) base-name)))) + (when file-name + ;; Possibly create the parent directories for file. + (let ((m (funcall get-spec :mkdirp)) + (fnd (file-name-directory file-name))) + (and m fnd (not (string= m "no")) + (make-directory fnd 'parents))) + ;; delete any old versions of file + (and (file-exists-p file-name) + (not (member file-name (mapcar #'car path-collector))) + (delete-file file-name)) + ;; drop source-block to file + (with-temp-buffer + (when (fboundp lang-f) (ignore-errors (funcall lang-f))) + (when (and she-bang (not (member file-name she-banged))) + (insert (concat she-bang "\n")) + (setq she-banged (cons file-name she-banged))) + (org-babel-spec-to-string spec) + ;; We avoid append-to-file as it does not work with tramp. + (let ((content (buffer-string))) + (with-temp-buffer + (if (file-exists-p file-name) + (insert-file-contents file-name)) + (goto-char (point-max)) + (insert content) + (write-region nil nil file-name)))) + ;; if files contain she-bangs, then make the executable + (when she-bang + (unless tangle-mode (setq tangle-mode #o755))) + ;; update counter + (setq block-counter (+ 1 block-counter)) + (add-to-list 'path-collector + (cons file-name tangle-mode) + nil + (lambda (a b) (equal (car a) (car b)))))))) + specs))) + (if (equal arg '(4)) + (org-babel-tangle-single-block 1 t) + (org-babel-tangle-collect-blocks lang tangle-file))) + (message "Tangled %d code block%s from %s" block-counter + (if (= block-counter 1) "" "s") + (file-name-nondirectory + (buffer-file-name + (or (buffer-base-buffer) (current-buffer))))) + ;; run `org-babel-post-tangle-hook' in all tangled files + (when org-babel-post-tangle-hook + (mapc + (lambda (file) + (org-babel-with-temp-filebuffer file + (run-hooks 'org-babel-post-tangle-hook))) + (mapcar #'car path-collector))) + ;; set permissions on tangled files + (mapc (lambda (pair) + (when (cdr pair) (set-file-modes (car pair) (cdr pair)))) + path-collector) + (mapcar #'car path-collector))))) + +(defun org-babel-tangle-clean () + "Remove comments inserted by `org-babel-tangle'. +Call this function inside of a source-code file generated by +`org-babel-tangle' to remove all comments inserted automatically +by `org-babel-tangle'. Warning, this comment removes any lines +containing constructs which resemble org-mode file links or noweb +references." + (interactive) + (goto-char (point-min)) + (while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t) + (re-search-forward (org-babel-noweb-wrap) nil t)) + (delete-region (save-excursion (beginning-of-line 1) (point)) + (save-excursion (end-of-line 1) (forward-char 1) (point))))) + +(defvar org-stored-links) +(defvar org-bracket-link-regexp) +(defun org-babel-spec-to-string (spec) + "Insert SPEC into the current file. + +Insert the source-code specified by SPEC into the current source +code file. This function uses `comment-region' which assumes +that the appropriate major-mode is set. SPEC has the form: + + \(start-line file link source-name params body comment)" + (let* ((start-line (nth 0 spec)) + (file (nth 1 spec)) + (link (nth 2 spec)) + (source-name (nth 3 spec)) + (body (nth 5 spec)) + (comment (nth 6 spec)) + (comments (cdr (assoc :comments (nth 4 spec)))) + (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec)))))) + (link-p (or (string= comments "both") (string= comments "link") + (string= comments "yes") (string= comments "noweb"))) + (link-data (mapcar (lambda (el) + (cons (symbol-name el) + (let ((le (eval el))) + (if (stringp le) le (format "%S" le))))) + '(start-line file link source-name))) + (insert-comment (lambda (text) + (when (and comments (not (string= comments "no")) + (> (length text) 0)) + (when padline (insert "\n")) + (comment-region (point) (progn (insert text) (point))) + (end-of-line nil) (insert "\n"))))) + (when comment (funcall insert-comment comment)) + (when link-p + (funcall + insert-comment + (org-fill-template org-babel-tangle-comment-format-beg link-data))) + (when padline (insert "\n")) + (insert + (format + "%s\n" + (org-unescape-code-in-string + (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]"))))) + (when link-p + (funcall + insert-comment + (org-fill-template org-babel-tangle-comment-format-end link-data))))) + +(defvar org-comment-string) ;; Defined in org.el +(defun org-babel-tangle-collect-blocks (&optional language tangle-file) + "Collect source blocks in the current Org-mode file. +Return an association list of source-code block specifications of +the form used by `org-babel-spec-to-string' grouped by language. +Optional argument LANGUAGE can be used to limit the collected +source code blocks by language. Optional argument TANGLE-FILE +can be used to limit the collected code blocks by target file." + (let ((block-counter 1) (current-heading "") blocks by-lang) + (org-babel-map-src-blocks (buffer-file-name) + (lambda (new-heading) + (if (not (string= new-heading current-heading)) + (progn + (setq block-counter 1) + (setq current-heading new-heading)) + (setq block-counter (+ 1 block-counter)))) + (replace-regexp-in-string "[ \t]" "-" + (condition-case nil + (or (nth 4 (org-heading-components)) + "(dummy for heading without text)") + (error (buffer-file-name)))) + (let* ((info (org-babel-get-src-block-info 'light)) + (src-lang (nth 0 info)) + (src-tfile (cdr (assoc :tangle (nth 2 info))))) + (unless (or (string-match (concat "^" org-comment-string) current-heading) + (string= (cdr (assoc :tangle (nth 2 info))) "no") + (and tangle-file (not (equal tangle-file src-tfile)))) + (unless (and language (not (string= language src-lang))) + ;; Add the spec for this block to blocks under it's language + (setq by-lang (cdr (assoc src-lang blocks))) + (setq blocks (delq (assoc src-lang blocks) blocks)) + (setq blocks (cons + (cons src-lang + (cons + (org-babel-tangle-single-block + block-counter) + by-lang)) blocks)))))) + ;; Ensure blocks are in the correct order + (setq blocks + (mapcar + (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang)))) + blocks)) + blocks)) + +(defun org-babel-tangle-single-block + (block-counter &optional only-this-block) + "Collect the tangled source for current block. +Return the list of block attributes needed by +`org-babel-tangle-collect-blocks'. +When ONLY-THIS-BLOCK is non-nil, return the full association +list to be used by `org-babel-tangle' directly." + (let* ((info (org-babel-get-src-block-info)) + (start-line + (save-restriction (widen) + (+ 1 (line-number-at-pos (point))))) + (file (buffer-file-name)) + (src-lang (nth 0 info)) + (params (nth 2 info)) + (extra (nth 3 info)) + (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra) + (match-string 1 extra)) + org-coderef-label-format)) + (link (let ((link (org-no-properties + (org-store-link nil)))) + (and (string-match org-bracket-link-regexp link) + (match-string 1 link)))) + (source-name + (intern (or (nth 4 info) + (format "%s:%d" + (or (ignore-errors (nth 4 (org-heading-components))) + "No heading") + block-counter)))) + (expand-cmd + (intern (concat "org-babel-expand-body:" src-lang))) + (assignments-cmd + (intern (concat "org-babel-variable-assignments:" src-lang))) + (body + ;; Run the tangle-body-hook. + (let* ((body ;; Expand the body in language specific manner. + (if (org-babel-noweb-p params :tangle) + (org-babel-expand-noweb-references info) + (nth 1 info))) + (body + (if (assoc :no-expand params) + body + (if (fboundp expand-cmd) + (funcall expand-cmd body params) + (org-babel-expand-body:generic + body params + (and (fboundp assignments-cmd) + (funcall assignments-cmd params))))))) + (with-temp-buffer + (insert body) + (when (string-match "-r" extra) + (goto-char (point-min)) + (while (re-search-forward + (replace-regexp-in-string "%s" ".+" cref-fmt) nil t) + (replace-match ""))) + (run-hooks 'org-babel-tangle-body-hook) + (buffer-string)))) + (comment + (when (or (string= "both" (cdr (assoc :comments params))) + (string= "org" (cdr (assoc :comments params)))) + ;; From the previous heading or code-block end + (funcall + org-babel-process-comment-text + (buffer-substring + (max (condition-case nil + (save-excursion + (org-back-to-heading t) ; Sets match data + (match-end 0)) + (error (point-min))) + (save-excursion + (if (re-search-backward + org-babel-src-block-regexp nil t) + (match-end 0) + (point-min)))) + (point))))) + (result + (list start-line file link source-name params body comment))) + (if only-this-block + (list (cons src-lang (list result))) + result))) + +(defun org-babel-tangle-comment-links ( &optional info) + "Return a list of begin and end link comments for the code block at point." + (let* ((start-line (org-babel-where-is-src-block-head)) + (file (buffer-file-name)) + (link (org-link-escape (progn (call-interactively 'org-store-link) + (org-no-properties + (car (pop org-stored-links)))))) + (source-name (nth 4 (or info (org-babel-get-src-block-info 'light)))) + (link-data (mapcar (lambda (el) + (cons (symbol-name el) + (let ((le (eval el))) + (if (stringp le) le (format "%S" le))))) + '(start-line file link source-name)))) + (list (org-fill-template org-babel-tangle-comment-format-beg link-data) + (org-fill-template org-babel-tangle-comment-format-end link-data)))) + +;; de-tangling functions +(defvar org-bracket-link-analytic-regexp) +(defun org-babel-detangle (&optional source-code-file) + "Propagate changes in source file back original to Org-mode file. +This requires that code blocks were tangled with link comments +which enable the original code blocks to be found." + (interactive) + (save-excursion + (when source-code-file (find-file source-code-file)) + (goto-char (point-min)) + (let ((counter 0) new-body end) + (while (re-search-forward org-bracket-link-analytic-regexp nil t) + (when (re-search-forward + (concat " " (regexp-quote (match-string 5)) " ends here")) + (setq end (match-end 0)) + (forward-line -1) + (save-excursion + (when (setq new-body (org-babel-tangle-jump-to-org)) + (org-babel-update-block-body new-body))) + (setq counter (+ 1 counter))) + (goto-char end)) + (prog1 counter (message "Detangled %d code blocks" counter))))) + +(defun org-babel-tangle-jump-to-org () + "Jump from a tangled code file to the related Org-mode file." + (interactive) + (let ((mid (point)) + start body-start end done + target-buffer target-char link path block-name body) + (save-window-excursion + (save-excursion + (while (and (re-search-backward org-bracket-link-analytic-regexp nil t) + (not ; ever wider searches until matching block comments + (and (setq start (point-at-eol)) + (setq body-start (save-excursion + (forward-line 2) (point-at-bol))) + (setq link (match-string 0)) + (setq path (match-string 3)) + (setq block-name (match-string 5)) + (save-excursion + (save-match-data + (re-search-forward + (concat " " (regexp-quote block-name) + " ends here") nil t) + (setq end (point-at-bol)))))))) + (unless (and start (< start mid) (< mid end)) + (error "Not in tangled code")) + (setq body (org-babel-trim (buffer-substring start end)))) + (when (string-match "::" path) + (setq path (substring path 0 (match-beginning 0)))) + (find-file path) (setq target-buffer (current-buffer)) + (goto-char start) (org-open-link-from-string link) + (if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name) + (org-babel-next-src-block + (string-to-number (match-string 1 block-name))) + (org-babel-goto-named-src-block block-name)) + ;; position at the beginning of the code block body + (goto-char (org-babel-where-is-src-block-head)) + (forward-line 1) + ;; Use org-edit-special to isolate the code. + (org-edit-special) + ;; Then move forward the correct number of characters in the + ;; code buffer. + (forward-char (- mid body-start)) + ;; And return to the Org-mode buffer with the point in the right + ;; place. + (org-edit-src-exit) + (setq target-char (point))) + (org-src-switch-to-buffer target-buffer t) + (prog1 body (goto-char target-char)))) + +(provide 'ob-tangle) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ob-tangle.el ends here diff --git a/elpa/org-20150427/ob.el b/elpa/org-20150427/ob.el new file mode 100644 index 00000000..87657fef --- /dev/null +++ b/elpa/org-20150427/ob.el @@ -0,0 +1,43 @@ +;;; ob.el --- working with code blocks in org-mode + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Authors: Eric Schulte +;; Keywords: literate programming, reproducible research +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Code: +(require 'org-macs) +(require 'org-compat) +(require 'ob-eval) +(require 'ob-core) +(require 'ob-comint) +(require 'ob-exp) +(require 'ob-keys) +(require 'ob-table) +(require 'ob-lob) +(require 'ob-ref) +(require 'ob-tangle) + +(provide 'ob) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ob.el ends here diff --git a/elpa/org-20150427/org b/elpa/org-20150427/org new file mode 100644 index 00000000..038c98f9 --- /dev/null +++ b/elpa/org-20150427/org @@ -0,0 +1,21283 @@ +This is org, produced by makeinfo version 4.13 from org.texi. + +This manual is for Org version 8.2.10 (release_8.2.10-37-gc000e8). + + Copyright (C) 2004-2014 Free Software Foundation, Inc. + + Permission is granted to copy, distribute and/or modify this + document under the terms of the GNU Free Documentation License, + Version 1.3 or any later version published by the Free Software + Foundation; with no Invariant Sections, with the Front-Cover Texts + being "A GNU Manual," and with the Back-Cover Texts as in (a) + below. A copy of the license is included in the section entitled + "GNU Free Documentation License." + + (a) The FSF's Back-Cover Text is: "You have the freedom to copy and + modify this GNU manual." + +INFO-DIR-SECTION Emacs editing modes +START-INFO-DIR-ENTRY +* Org Mode: (org). Outline-based notes management and organizer +END-INFO-DIR-ENTRY + + +File: org, Node: Top, Next: Introduction, Prev: (dir), Up: (dir) + +Org Mode Manual +*************** + +This manual is for Org version 8.2.10 (release_8.2.10-37-gc000e8). + + Copyright (C) 2004-2014 Free Software Foundation, Inc. + + Permission is granted to copy, distribute and/or modify this + document under the terms of the GNU Free Documentation License, + Version 1.3 or any later version published by the Free Software + Foundation; with no Invariant Sections, with the Front-Cover Texts + being "A GNU Manual," and with the Back-Cover Texts as in (a) + below. A copy of the license is included in the section entitled + "GNU Free Documentation License." + + (a) The FSF's Back-Cover Text is: "You have the freedom to copy and + modify this GNU manual." + +* Menu: + +* Introduction:: Getting started +* Document Structure:: A tree works like your brain +* Tables:: Pure magic for quick formatting +* Hyperlinks:: Notes in context +* TODO Items:: Every tree branch can be a TODO item +* Tags:: Tagging headlines and matching sets of tags +* Properties and Columns:: Storing information about an entry +* Dates and Times:: Making items useful for planning +* Capture - Refile - Archive:: The ins and outs for projects +* Agenda Views:: Collecting information into views +* Markup:: Prepare text for rich export +* Exporting:: Sharing and publishing notes +* Publishing:: Create a web site of linked Org files +* Working With Source Code:: Export, evaluate, and tangle code blocks +* Miscellaneous:: All the rest which did not fit elsewhere +* Hacking:: How to hack your way around +* MobileOrg:: Viewing and capture on a mobile device +* History and Acknowledgments:: How Org came into being +* GNU Free Documentation License:: The license for this documentation. +* Main Index:: An index of Org's concepts and features +* Key Index:: Key bindings and where they are described +* Command and Function Index:: Command names and some internal functions +* Variable Index:: Variables mentioned in the manual + + --- The Detailed Node Listing --- + +Introduction + +* Summary:: Brief summary of what Org does +* Installation:: Installing Org +* Activation:: How to activate Org for certain buffers +* Feedback:: Bug reports, ideas, patches etc. +* Conventions:: Typesetting conventions in the manual + +Document structure + +* Outlines:: Org is based on Outline mode +* Headlines:: How to typeset Org tree headlines +* Visibility cycling:: Show and hide, much simplified +* Motion:: Jumping to other headlines +* Structure editing:: Changing sequence and level of headlines +* Sparse trees:: Matches embedded in context +* Plain lists:: Additional structure within an entry +* Drawers:: Tucking stuff away +* Blocks:: Folding blocks +* Footnotes:: How footnotes are defined in Org's syntax +* Orgstruct mode:: Structure editing outside Org +* Org syntax:: Formal description of Org's syntax + +Visibility cycling + +* Global and local cycling:: Cycling through various visibility states +* Initial visibility:: Setting the initial visibility state +* Catching invisible edits:: Preventing mistakes when editing invisible parts + +Global and local cycling + +* Initial visibility:: Setting the initial visibility state +* Catching invisible edits:: Preventing mistakes when editing invisible parts + +Tables + +* Built-in table editor:: Simple tables +* Column width and alignment:: Overrule the automatic settings +* Column groups:: Grouping to trigger vertical lines +* Orgtbl mode:: The table editor as minor mode +* The spreadsheet:: The table editor has spreadsheet capabilities +* Org-Plot:: Plotting from org tables + +The spreadsheet + +* References:: How to refer to another field or range +* Formula syntax for Calc:: Using Calc to compute stuff +* Formula syntax for Lisp:: Writing formulas in Emacs Lisp +* Durations and time values:: How to compute durations and time values +* Field and range formulas:: Formula for specific (ranges of) fields +* Column formulas:: Formulas valid for an entire column +* Lookup functions:: Lookup functions for searching tables +* Editing and debugging formulas:: Fixing formulas +* Updating the table:: Recomputing all dependent fields +* Advanced features:: Field and column names, parameters and automatic recalc + +Hyperlinks + +* Link format:: How links in Org are formatted +* Internal links:: Links to other places in the current file +* External links:: URL-like links to the world +* Handling links:: Creating, inserting and following +* Using links outside Org:: Linking from my C source code? +* Link abbreviations:: Shortcuts for writing complex links +* Search options:: Linking to a specific location +* Custom searches:: When the default search is not enough + +Internal links + +* Radio targets:: Make targets trigger links in plain text + +TODO items + +* TODO basics:: Marking and displaying TODO entries +* TODO extensions:: Workflow and assignments +* Progress logging:: Dates and notes for progress +* Priorities:: Some things are more important than others +* Breaking down tasks:: Splitting a task into manageable pieces +* Checkboxes:: Tick-off lists + +Extended use of TODO keywords + +* Workflow states:: From TODO to DONE in steps +* TODO types:: I do this, Fred does the rest +* Multiple sets in one file:: Mixing it all, and still finding your way +* Fast access to TODO states:: Single letter selection of a state +* Per-file keywords:: Different files, different requirements +* Faces for TODO keywords:: Highlighting states +* TODO dependencies:: When one task needs to wait for others + +Progress logging + +* Closing items:: When was this entry marked DONE? +* Tracking TODO state changes:: When did the status change? +* Tracking your habits:: How consistent have you been? + +Tags + +* Tag inheritance:: Tags use the tree structure of the outline +* Setting tags:: How to assign tags to a headline +* Tag groups:: Use one tag to search for several tags +* Tag searches:: Searching for combinations of tags + +Properties and columns + +* Property syntax:: How properties are spelled out +* Special properties:: Access to other Org mode features +* Property searches:: Matching property values +* Property inheritance:: Passing values down the tree +* Column view:: Tabular viewing and editing +* Property API:: Properties for Lisp programmers + +Column view + +* Defining columns:: The COLUMNS format property +* Using column view:: How to create and use column view +* Capturing column view:: A dynamic block for column view + +Defining columns + +* Scope of column definitions:: Where defined, where valid? +* Column attributes:: Appearance and content of a column + +Dates and times + +* Timestamps:: Assigning a time to a tree entry +* Creating timestamps:: Commands which insert timestamps +* Deadlines and scheduling:: Planning your work +* Clocking work time:: Tracking how long you spend on a task +* Effort estimates:: Planning work effort in advance +* Relative timer:: Notes with a running timer +* Countdown timer:: Starting a countdown timer for a task + +Creating timestamps + +* The date/time prompt:: How Org mode helps you entering date and time +* Custom time format:: Making dates look different + +Deadlines and scheduling + +* Inserting deadline/schedule:: Planning items +* Repeated tasks:: Items that show up again and again + +Clocking work time + +* Clocking commands:: Starting and stopping a clock +* The clock table:: Detailed reports +* Resolving idle time:: Resolving time when you've been idle + +Capture - Refile - Archive + +* Capture:: Capturing new stuff +* Attachments:: Add files to tasks +* RSS Feeds:: Getting input from RSS feeds +* Protocols:: External (e.g., Browser) access to Emacs and Org +* Refile and copy:: Moving/copying a tree from one place to another +* Archiving:: What to do with finished projects + +Capture + +* Setting up capture:: Where notes will be stored +* Using capture:: Commands to invoke and terminate capture +* Capture templates:: Define the outline of different note types + +Capture templates + +* Template elements:: What is needed for a complete template entry +* Template expansion:: Filling in information about time and context +* Templates in contexts:: Only show a template in a specific context + +Archiving + +* Moving subtrees:: Moving a tree to an archive file +* Internal archiving:: Switch off a tree but keep it in the file + +Agenda views + +* Agenda files:: Files being searched for agenda information +* Agenda dispatcher:: Keyboard access to agenda views +* Built-in agenda views:: What is available out of the box? +* Presentation and sorting:: How agenda items are prepared for display +* Agenda commands:: Remote editing of Org trees +* Custom agenda views:: Defining special searches and views +* Exporting Agenda Views:: Writing a view to a file +* Agenda column view:: Using column view for collected entries + +The built-in agenda views + +* Weekly/daily agenda:: The calendar page with current tasks +* Global TODO list:: All unfinished action items +* Matching tags and properties:: Structured information with fine-tuned search +* Timeline:: Time-sorted view for single file +* Search view:: Find entries by searching for text +* Stuck projects:: Find projects you need to review + +Presentation and sorting + +* Categories:: Not all tasks are equal +* Time-of-day specifications:: How the agenda knows the time +* Sorting agenda items:: The order of things +* Filtering/limiting agenda items:: Dynamically narrow the agenda + +Custom agenda views + +* Storing searches:: Type once, use often +* Block agenda:: All the stuff you need in a single buffer +* Setting Options:: Changing the rules + +Markup for rich export + +* Structural markup elements:: The basic structure as seen by the exporter +* Images and tables:: Images, tables and caption mechanism +* Literal examples:: Source code examples with special formatting +* Include files:: Include additional files into a document +* Index entries:: Making an index +* Macro replacement:: Use macros to create templates +* Embedded LaTeX:: LaTeX can be freely used inside Org documents +* Special blocks:: Containers targeted at export back-ends + +Structural markup elements + +* Document title:: Where the title is taken from +* Headings and sections:: The document structure as seen by the exporter +* Table of contents:: The if and where of the table of contents +* Lists:: Lists +* Paragraphs:: Paragraphs +* Footnote markup:: Footnotes +* Emphasis and monospace:: Bold, italic, etc. +* Horizontal rules:: Make a line +* Comment lines:: What will *not* be exported + +Embedded LaTeX + +* Special symbols:: Greek letters and other symbols +* Subscripts and superscripts:: Simple syntax for raising/lowering text +* LaTeX fragments:: Complex formulas made easy +* Previewing LaTeX fragments:: What will this snippet look like? +* CDLaTeX mode:: Speed up entering of formulas + +Exporting + +* The Export Dispatcher:: The main exporter interface +* Export back-ends:: Built-in export formats +* Export settings:: Generic export settings +* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding +* Beamer export:: Exporting as a Beamer presentation +* HTML export:: Exporting to HTML +* LaTeX and PDF export:: Exporting to LaTeX, and processing to PDF +* Markdown export:: Exporting to Markdown +* OpenDocument Text export:: Exporting to OpenDocument Text +* Org export:: Exporting to Org +* Texinfo export:: Exporting to Texinfo +* iCalendar export:: Exporting to iCalendar +* Other built-in back-ends:: Exporting to a man page +* Export in foreign buffers:: Author tables and lists in Org syntax +* Advanced configuration:: Fine-tuning the export output + +HTML export + +* HTML Export commands:: How to invoke HTML export +* HTML doctypes:: Org can export to various (X)HTML flavors +* HTML preamble and postamble:: How to insert a preamble and a postamble +* Quoting HTML tags:: Using direct HTML in Org mode +* Links in HTML export:: How links will be interpreted and formatted +* Tables in HTML export:: How to modify the formatting of tables +* Images in HTML export:: How to insert figures into HTML output +* Math formatting in HTML export:: Beautiful math also on the web +* Text areas in HTML export:: An alternative way to show an example +* CSS support:: Changing the appearance of the output +* JavaScript support:: Info and Folding in a web browser + +LaTeX and PDF export + +* LaTeX export commands:: How to export to LaTeX and PDF +* Header and sectioning:: Setting up the export file structure +* Quoting LaTeX code:: Incorporating literal LaTeX code +* LaTeX specific attributes:: Controlling LaTeX output + +OpenDocument Text export + +* Pre-requisites for ODT export:: What packages ODT exporter relies on +* ODT export commands:: How to invoke ODT export +* Extending ODT export:: How to produce `doc', `pdf' files +* Applying custom styles:: How to apply custom styles to the output +* Links in ODT export:: How links will be interpreted and formatted +* Tables in ODT export:: How Tables are exported +* Images in ODT export:: How to insert images +* Math formatting in ODT export:: How LaTeX fragments are formatted +* Labels and captions in ODT export:: How captions are rendered +* Literal examples in ODT export:: How source and example blocks are formatted +* Advanced topics in ODT export:: Read this if you are a power user + +Math formatting in ODT export + +* Working with LaTeX math snippets:: How to embed LaTeX math fragments +* Working with MathML or OpenDocument formula files:: How to embed equations in native format + +Advanced topics in ODT export + +* Configuring a document converter:: How to register a document converter +* Working with OpenDocument style files:: Explore the internals +* Creating one-off styles:: How to produce custom highlighting etc +* Customizing tables in ODT export:: How to define and use Table templates +* Validating OpenDocument XML:: How to debug corrupt OpenDocument files + +Texinfo export + +* Texinfo export commands:: How to invoke Texinfo export +* Document preamble:: File header, title and copyright page +* Headings and sectioning structure:: Building document structure +* Indices:: Creating indices +* Quoting Texinfo code:: Incorporating literal Texinfo code +* Texinfo specific attributes:: Controlling Texinfo output +* An example:: + +Publishing + +* Configuration:: Defining projects +* Uploading files:: How to get files up on the server +* Sample configuration:: Example projects +* Triggering publication:: Publication commands + +Configuration + +* Project alist:: The central configuration variable +* Sources and destinations:: From here to there +* Selecting files:: What files are part of the project? +* Publishing action:: Setting the function doing the publishing +* Publishing options:: Tweaking HTML/LaTeX export +* Publishing links:: Which links keep working after publishing? +* Sitemap:: Generating a list of all pages +* Generating an index:: An index that reaches across pages + +Sample configuration + +* Simple example:: One-component publishing +* Complex example:: A multi-component publishing example + +Working with source code + +* Structure of code blocks:: Code block syntax described +* Editing source code:: Language major-mode editing +* Exporting code blocks:: Export contents and/or results +* Extracting source code:: Create pure source code files +* Evaluating code blocks:: Place results of evaluation in the Org mode buffer +* Library of Babel:: Use and contribute to a library of useful code blocks +* Languages:: List of supported code block languages +* Header arguments:: Configure code block functionality +* Results of evaluation:: How evaluation results are handled +* Noweb reference syntax:: Literate programming in Org mode +* Key bindings and useful functions:: Work quickly with code blocks +* Batch execution:: Call functions from the command line + +Header arguments + +* Using header arguments:: Different ways to set header arguments +* Specific header arguments:: List of header arguments + +Using header arguments + +* System-wide header arguments:: Set global default values +* Language-specific header arguments:: Set default values by language +* Header arguments in Org mode properties:: Set default values for a buffer or heading +* Language-specific header arguments in Org mode properties:: Set language-specific default values for a buffer or heading +* Code block specific header arguments:: The most common way to set values +* Header arguments in function calls:: The most specific level + +Specific header arguments + +* var:: Pass arguments to code blocks +* results:: Specify the type of results and how they will + be collected and handled +* file:: Specify a path for file output +* file-desc:: Specify a description for file results +* dir:: Specify the default (possibly remote) + directory for code block execution +* exports:: Export code and/or results +* tangle:: Toggle tangling and specify file name +* mkdirp:: Toggle creation of parent directories of target + files during tangling +* comments:: Toggle insertion of comments in tangled + code files +* padline:: Control insertion of padding lines in tangled + code files +* no-expand:: Turn off variable assignment and noweb + expansion during tangling +* session:: Preserve the state of code evaluation +* noweb:: Toggle expansion of noweb references +* noweb-ref:: Specify block's noweb reference resolution target +* noweb-sep:: String used to separate noweb references +* cache:: Avoid re-evaluating unchanged code blocks +* sep:: Delimiter for writing tabular results outside Org +* hlines:: Handle horizontal lines in tables +* colnames:: Handle column names in tables +* rownames:: Handle row names in tables +* shebang:: Make tangled files executable +* tangle-mode:: Set permission of tangled files +* eval:: Limit evaluation of specific code blocks +* wrap:: Mark source block evaluation results +* post:: Post processing of code block results +* prologue:: Text to prepend to code block body +* epilogue:: Text to append to code block body + +Miscellaneous + +* Completion:: M-TAB knows what you need +* Easy Templates:: Quick insertion of structural elements +* Speed keys:: Electric commands at the beginning of a headline +* Code evaluation security:: Org mode files evaluate inline code +* Customization:: Adapting Org to your taste +* In-buffer settings:: Overview of the #+KEYWORDS +* The very busy C-c C-c key:: When in doubt, press C-c C-c +* Clean view:: Getting rid of leading stars in the outline +* TTY keys:: Using Org on a tty +* Interaction:: Other Emacs packages +* org-crypt:: Encrypting Org files + +Interaction with other packages + +* Cooperation:: Packages Org cooperates with +* Conflicts:: Packages that lead to conflicts + +Hacking + +* Hooks:: How to reach into Org's internals +* Add-on packages:: Available extensions +* Adding hyperlink types:: New custom link types +* Adding export back-ends:: How to write new export back-ends +* Context-sensitive commands:: How to add functionality to such commands +* Tables in arbitrary syntax:: Orgtbl for LaTeX and other programs +* Dynamic blocks:: Automatically filled blocks +* Special agenda views:: Customized views +* Speeding up your agendas:: Tips on how to speed up your agendas +* Extracting agenda information:: Post-processing of agenda information +* Using the property API:: Writing programs that use entry properties +* Using the mapping API:: Mapping over all or selected entries + +Tables and lists in arbitrary syntax + +* Radio tables:: Sending and receiving radio tables +* A LaTeX example:: Step by step, almost a tutorial +* Translator functions:: Copy and modify +* Radio lists:: Sending and receiving lists + +MobileOrg + +* Setting up the staging area:: Where to interact with the mobile device +* Pushing to MobileOrg:: Uploading Org files and agendas +* Pulling from MobileOrg:: Integrating captured and flagged items + + +File: org, Node: Introduction, Next: Document Structure, Prev: Top, Up: Top + +1 Introduction +************** + +* Menu: + +* Summary:: Brief summary of what Org does +* Installation:: Installing Org +* Activation:: How to activate Org for certain buffers +* Feedback:: Bug reports, ideas, patches etc. +* Conventions:: Typesetting conventions in the manual + + +File: org, Node: Summary, Next: Installation, Prev: Introduction, Up: Introduction + +1.1 Summary +=========== + +Org is a mode for keeping notes, maintaining TODO lists, and doing +project planning with a fast and effective plain-text system. + + Org develops organizational tasks around NOTES files that contain +lists or information about projects as plain text. Org is implemented +on top of Outline mode, which makes it possible to keep the content of +large files well structured. Visibility cycling and structure editing +help to work with the tree. Tables are easily created with a built-in +table editor. Org supports TODO items, deadlines, timestamps, and +scheduling. It dynamically compiles entries into an agenda that +utilizes and smoothly integrates much of the Emacs calendar and diary. +Plain text URL-like links connect to websites, emails, Usenet messages, +BBDB entries, and any files related to the projects. For printing and +sharing notes, an Org file can be exported as a structured ASCII file, +as HTML, or (TODO and agenda items only) as an iCalendar file. It can +also serve as a publishing tool for a set of linked web pages. + + As a project planning environment, Org works by adding metadata to +outline nodes. Based on this data, specific entries can be extracted +in queries and create dynamic agenda views. + + Org mode contains the Org Babel environment which allows you to work +with embedded source code blocks in a file, to facilitate code +evaluation, documentation, and literate programming techniques. + + Org's automatic, context-sensitive table editor with spreadsheet +capabilities can be integrated into any major mode by activating the +minor Orgtbl mode. Using a translation step, it can be used to maintain +tables in arbitrary file types, for example in LaTeX. The structure +editing and list creation capabilities can be used outside Org with the +minor Orgstruct mode. + + Org keeps simple things simple. When first fired up, it should feel +like a straightforward, easy to use outliner. Complexity is not +imposed, but a large amount of functionality is available when you need +it. Org is a toolbox and can be used in different ways and for +different ends, for example: + + * an outline extension with visibility cycling and structure editing + * an ASCII system and table editor for taking structured notes + * a TODO list editor + * a full agenda and planner with deadlines and work scheduling + * an environment in which to implement David Allen's GTD system + * a simple hypertext system, with HTML and LaTeX export + * a publishing tool to create a set of interlinked web pages + * an environment for literate programming + + There is a website for Org which provides links to the newest +version of Org, as well as additional information, frequently asked +questions (FAQ), links to tutorials, etc. This page is located at +`http://orgmode.org'. + + The version 7.3 of this manual is available as a paperback book from +Network Theory Ltd. (http://www.network-theory.co.uk/org/manual/) + + +File: org, Node: Installation, Next: Activation, Prev: Summary, Up: Introduction + +1.2 Installation +================ + +Org is part of recent distributions of GNU Emacs, so you normally don't +need to install it. If, for one reason or another, you want to install +Org on top of this pre-packaged version, there are three ways to do it: + + * By using Emacs package system. + + * By downloading Org as an archive. + + * By using Org's git repository. + + We strongly recommend to stick to a single installation method. + +Using Emacs packaging system +............................ + +Recent Emacs distributions include a packaging system which lets you +install Elisp libraries. You can install Org with `M-x package-install +RET org'. + +Important: you need to do this in a session where no `.org' file has +been visited, i.e. where no Org built-in function have been loaded. +Otherwise autoload Org functions will mess up the installation. + + Then, to make sure your Org configuration is taken into account, +initialize the package system with `(package-initialize)' in your +`.emacs' before setting any Org option. If you want to use Org's +package repository, check out the Org ELPA page +(http://orgmode.org/elpa.html). + +Downloading Org as an archive +............................. + +You can download Org latest release from Org's website +(http://orgmode.org/). In this case, make sure you set the load-path +correctly in your `.emacs': + + (add-to-list 'load-path "~/path/to/orgdir/lisp") + + The downloaded archive contains contributed libraries that are not +included in Emacs. If you want to use them, add the `contrib' +directory to your load-path: + + (add-to-list 'load-path "~/path/to/orgdir/contrib/lisp" t) + + Optionally, you can compile the files and/or install them in your +system. Run `make help' to list compilation and installation options. + +Using Org's git repository +.......................... + +You can clone Org's repository and install Org like this: + + $ cd ~/src/ + $ git clone git://orgmode.org/org-mode.git + $ make autoloads + + Note that in this case, `make autoloads' is mandatory: it defines +Org's version in `org-version.el' and Org's autoloads in +`org-loaddefs.el'. + + Remember to add the correct load-path as described in the method +above. + + You can also compile with `make', generate the documentation with +`make doc', create a local configuration with `make config' and install +Org with `make install'. Please run `make help' to get the list of +compilation/installation options. + + For more detailed explanations on Org's build system, please check +the Org Build System page on Worg +(http://orgmode.org/worg/dev/org-build-system.html). + + +File: org, Node: Activation, Next: Feedback, Prev: Installation, Up: Introduction + +1.3 Activation +============== + +Since Emacs 22.2, files with the `.org' extension use Org mode by +default. If you are using an earlier version of Emacs, add this line +to your `.emacs' file: + + (add-to-list 'auto-mode-alist '("\\.org\\'" . org-mode)) + + Org mode buffers need font-lock to be turned on: this is the default +in Emacs(1). + + There are compatibility issues between Org mode and some other Elisp +packages, please take the time to check the list (*note Conflicts::). + + The four Org commands `org-store-link', `org-capture', `org-agenda', +and `org-iswitchb' should be accessible through global keys (i.e., +anywhere in Emacs, not just in Org buffers). Here are suggested +bindings for these keys, please modify the keys to your own liking. + (global-set-key "\C-cl" 'org-store-link) + (global-set-key "\C-cc" 'org-capture) + (global-set-key "\C-ca" 'org-agenda) + (global-set-key "\C-cb" 'org-iswitchb) + + With this setup, all files with extension `.org' will be put into +Org mode. As an alternative, make the first line of a file look like +this: + + MY PROJECTS -*- mode: org; -*- + +which will select Org mode for this buffer no matter what the file's +name is. See also the variable `org-insert-mode-line-in-empty-file'. + + Many commands in Org work on the region if the region is active. To +make use of this, you need to have `transient-mark-mode' +(`zmacs-regions' in XEmacs) turned on. In Emacs 23 this is the default, +in Emacs 22 you need to do this yourself with + (transient-mark-mode 1) + If you do not like `transient-mark-mode', you can create an active +region by using the mouse to select a region, or pressing `C-' +twice before moving the cursor. + + ---------- Footnotes ---------- + + (1) If you don't use font-lock globally, turn it on in Org buffer +with `(add-hook 'org-mode-hook 'turn-on-font-lock)' + + +File: org, Node: Feedback, Next: Conventions, Prev: Activation, Up: Introduction + +1.4 Feedback +============ + +If you find problems with Org, or if you have questions, remarks, or +ideas about it, please mail to the Org mailing list +. If you are not a member of the mailing list, +your mail will be passed to the list after a moderator has approved +it(1). + + For bug reports, please first try to reproduce the bug with the +latest version of Org available--if you are running an outdated +version, it is quite possible that the bug has been fixed already. If +the bug persists, prepare a report and provide as much information as +possible, including the version information of Emacs (`M-x +emacs-version ') and Org (`M-x org-version RET'), as well as the +Org related setup in `.emacs'. The easiest way to do this is to use +the command + M-x org-submit-bug-report RET + which will put all this information into an Emacs mail buffer so +that you only need to add your description. If you re not sending the +Email from within Emacs, please copy and paste the content into your +Email program. + + Sometimes you might face a problem due to an error in your Emacs or +Org mode setup. Before reporting a bug, it is very helpful to start +Emacs with minimal customizations and reproduce the problem. Doing so +often helps you determine if the problem is with your customization or +with Org mode itself. You can start a typical minimal session with a +command like the example below. + + $ emacs -Q -l /path/to/minimal-org.el + + However if you are using Org mode as distributed with Emacs, a +minimal setup is not necessary. In that case it is sufficient to start +Emacs as `emacs -Q'. The `minimal-org.el' setup file can have contents +as shown below. + + ;;; Minimal setup to load latest `org-mode' + + ;; activate debugging + (setq debug-on-error t + debug-on-signal nil + debug-on-quit nil) + + ;; add latest org-mode to load path + (add-to-list 'load-path (expand-file-name "/path/to/org-mode/lisp")) + (add-to-list 'load-path (expand-file-name "/path/to/org-mode/contrib/lisp" t)) + + If an error occurs, a backtrace can be very useful (see below on how +to create one). Often a small example file helps, along with clear +information about: + + 1. What exactly did you do? + + 2. What did you expect to happen? + + 3. What happened instead? + Thank you for helping to improve this program. + +How to create a useful backtrace +................................ + +If working with Org produces an error with a message you don't +understand, you may have hit a bug. The best way to report this is by +providing, in addition to what was mentioned above, a _backtrace_. +This is information from the built-in debugger about where and how the +error occurred. Here is how to produce a useful backtrace: + + 1. Reload uncompiled versions of all Org mode Lisp files. The + backtrace contains much more information if it is produced with + uncompiled code. To do this, use + C-u M-x org-reload RET + or select `Org -> Refresh/Reload -> Reload Org uncompiled' from the + menu. + + 2. Go to the `Options' menu and select `Enter Debugger on Error' + (XEmacs has this option in the `Troubleshooting' sub-menu). + + 3. Do whatever you have to do to hit the error. Don't forget to + document the steps you take. + + 4. When you hit the error, a `*Backtrace*' buffer will appear on the + screen. Save this buffer to a file (for example using `C-x C-w') + and attach it to your bug report. + + ---------- Footnotes ---------- + + (1) Please consider subscribing to the mailing list, in order to +minimize the work the mailing list moderators have to do. + + +File: org, Node: Conventions, Prev: Feedback, Up: Introduction + +1.5 Typesetting conventions used in this manual +=============================================== + +TODO keywords, tags, properties, etc. +..................................... + +Org mainly uses three types of keywords: TODO keywords, tags and +property names. In this manual we use the following conventions: + +`TODO' +`WAITING' + TODO keywords are written with all capitals, even if they are + user-defined. + +`boss' +`ARCHIVE' + User-defined tags are written in lowercase; built-in tags with + special meaning are written with all capitals. + +`Release' +`PRIORITY' + User-defined properties are capitalized; built-in properties with + special meaning are written with all capitals. + + Moreover, Org uses option keywords (like `#+TITLE' to set the title) +and environment keywords (like `#+BEGIN_HTML' to start a `HTML' +environment). They are written in uppercase in the manual to enhance +its readability, but you can use lowercase in your Org files(1). + +Keybindings and commands +........................ + +The manual suggests two global keybindings: `C-c a' for `org-agenda' +and `C-c c' for `org-capture'. These are only suggestions, but the +rest of the manual assumes that you are using these keybindings. + + Also, the manual lists both the keys and the corresponding commands +for accessing a functionality. Org mode often uses the same key for +different functions, depending on context. The command that is bound +to such keys has a generic name, like `org-metaright'. In the manual +we will, wherever possible, give the function that is internally called +by the generic command. For example, in the chapter on document +structure, `M-' will be listed to call `org-do-demote', while in +the chapter on tables, it will be listed to call +`org-table-move-column-right'. If you prefer, you can compile the +manual without the command names by unsetting the flag `cmdnames' in +`org.texi'. + + ---------- Footnotes ---------- + + (1) Easy templates insert lowercase keywords and Babel dynamically +inserts `#+results'. + + +File: org, Node: Document Structure, Next: Tables, Prev: Introduction, Up: Top + +2 Document structure +******************** + +Org is based on Outline mode and provides flexible commands to edit the +structure of the document. + +* Menu: + +* Outlines:: Org is based on Outline mode +* Headlines:: How to typeset Org tree headlines +* Visibility cycling:: Show and hide, much simplified +* Motion:: Jumping to other headlines +* Structure editing:: Changing sequence and level of headlines +* Sparse trees:: Matches embedded in context +* Plain lists:: Additional structure within an entry +* Drawers:: Tucking stuff away +* Blocks:: Folding blocks +* Footnotes:: How footnotes are defined in Org's syntax +* Orgstruct mode:: Structure editing outside Org +* Org syntax:: Formal description of Org's syntax + + +File: org, Node: Outlines, Next: Headlines, Prev: Document Structure, Up: Document Structure + +2.1 Outlines +============ + +Org is implemented on top of Outline mode. Outlines allow a document +to be organized in a hierarchical structure, which (at least for me) is +the best representation of notes and thoughts. An overview of this +structure is achieved by folding (hiding) large parts of the document +to show only the general document structure and the parts currently +being worked on. Org greatly simplifies the use of outlines by +compressing the entire show/hide functionality into a single command, +`org-cycle', which is bound to the key. + + +File: org, Node: Headlines, Next: Visibility cycling, Prev: Outlines, Up: Document Structure + +2.2 Headlines +============= + +Headlines define the structure of an outline tree. The headlines in Org +start with one or more stars, on the left margin(1) (2). For example: + + * Top level headline + ** Second level + *** 3rd level + some text + *** 3rd level + more text + + * Another top level headline + +Some people find the many stars too noisy and would prefer an outline +that has whitespace followed by a single star as headline starters. +*note Clean view::, describes a setup to realize this. + + An empty line after the end of a subtree is considered part of it and +will be hidden when the subtree is folded. However, if you leave at +least two empty lines, one empty line will remain visible after folding +the subtree, in order to structure the collapsed view. See the +variable `org-cycle-separator-lines' to modify this behavior. + + ---------- Footnotes ---------- + + (1) See the variables `org-special-ctrl-a/e', `org-special-ctrl-k', +and `org-ctrl-k-protect-subtree' to configure special behavior of `C-a', +`C-e', and `C-k' in headlines. + + (2) Clocking only works with headings indented less then 30 stars. + + +File: org, Node: Visibility cycling, Next: Motion, Prev: Headlines, Up: Document Structure + +2.3 Visibility cycling +====================== + +* Menu: + +* Global and local cycling:: Cycling through various visibility states +* Initial visibility:: Setting the initial visibility state +* Catching invisible edits:: Preventing mistakes when editing invisible parts + + +File: org, Node: Global and local cycling, Next: Initial visibility, Prev: Visibility cycling, Up: Visibility cycling + +2.3.1 Global and local cycling +------------------------------ + +Outlines make it possible to hide parts of the text in the buffer. Org +uses just two commands, bound to and `S-' to change the +visibility in the buffer. + +`' (`org-cycle') + _Subtree cycling_: Rotate current subtree among the states + + ,-> FOLDED -> CHILDREN -> SUBTREE --. + '-----------------------------------' + + The cursor must be on a headline for this to work(1). When the + cursor is at the beginning of the buffer and the first line is not + a headline, then actually runs global cycling (see + below)(2). Also when called with a prefix argument (`C-u '), + global cycling is invoked. + +`S-' (`org-global-cycle') +C-u + _Global cycling_: Rotate the entire buffer among the states + + ,-> OVERVIEW -> CONTENTS -> SHOW ALL --. + '--------------------------------------' + + When `S-' is called with a numeric prefix argument N, the + CONTENTS view up to headlines of level N will be shown. Note that + inside tables, `S-' jumps to the previous field. + +`C-u C-u ' (`org-set-startup-visibility') + Switch back to the startup visibility of the buffer (*note Initial + visibility::). + +`C-u C-u C-u ' (`show-all') + Show all, including drawers. + +`C-c C-r' (`org-reveal') + Reveal context around point, showing the current entry, the + following heading and the hierarchy above. Useful for working + near a location that has been exposed by a sparse tree command + (*note Sparse trees::) or an agenda command (*note Agenda + commands::). With a prefix argument show, on each level, all + sibling headings. With a double prefix argument, also show the + entire subtree of the parent. + +`C-c C-k' (`show-branches') + Expose all the headings of the subtree, CONTENT view for just one + subtree. + +`C-c ' (`show-children') + Expose all direct children of the subtree. With a numeric prefix + argument N, expose all children down to level N. + +`C-c C-x b' (`org-tree-to-indirect-buffer') + Show the current subtree in an indirect buffer(3). With a numeric + prefix argument N, go up to level N and then take that tree. If N + is negative then go up that many levels. With a `C-u' prefix, do + not remove the previously used indirect buffer. + +`C-c C-x v' (`org-copy-visible') + Copy the visible text in the region into the kill ring. + +* Menu: + +* Initial visibility:: Setting the initial visibility state +* Catching invisible edits:: Preventing mistakes when editing invisible parts + + ---------- Footnotes ---------- + + (1) see, however, the option `org-cycle-emulate-tab'. + + (2) see the option `org-cycle-global-at-bob'. + + (3) The indirect buffer (*note Indirect Buffers: (emacs)Indirect +Buffers.) will contain the entire buffer, but will be narrowed to the +current tree. Editing the indirect buffer will also change the +original buffer, but without affecting visibility in that buffer. + + +File: org, Node: Initial visibility, Next: Catching invisible edits, Prev: Global and local cycling, Up: Visibility cycling + +2.3.2 Initial visibility +------------------------ + +When Emacs first visits an Org file, the global state is set to +OVERVIEW, i.e., only the top level headlines are visible(1). This can +be configured through the variable `org-startup-folded', or on a +per-file basis by adding one of the following lines anywhere in the +buffer: + + #+STARTUP: overview + #+STARTUP: content + #+STARTUP: showall + #+STARTUP: showeverything + + The startup visibility options are ignored when the file is open for +the first time during the agenda generation: if you want the agenda to +honor the startup visibility, set `org-agenda-inhibit-startup' to `nil'. + +Furthermore, any entries with a `VISIBILITY' property (*note Properties +and Columns::) will get their visibility adapted accordingly. Allowed +values for this property are `folded', `children', `content', and `all'. + +`C-u C-u ' (`org-set-startup-visibility') + Switch back to the startup visibility of the buffer, i.e., + whatever is requested by startup options and `VISIBILITY' + properties in individual entries. + + ---------- Footnotes ---------- + + (1) When `org-agenda-inhibit-startup' is non-`nil', Org will not +honor the default visibility state when first opening a file for the +agenda (*note Speeding up your agendas::). + + +File: org, Node: Catching invisible edits, Prev: Initial visibility, Up: Visibility cycling + +2.3.3 Catching invisible edits +------------------------------ + +Sometimes you may inadvertently edit an invisible part of the buffer +and be confused on what has been edited and how to undo the mistake. +Setting `org-catch-invisible-edits' to non-`nil' will help prevent +this. See the docstring of this option on how Org should catch +invisible edits and process them. + + +File: org, Node: Motion, Next: Structure editing, Prev: Visibility cycling, Up: Document Structure + +2.4 Motion +========== + +The following commands jump to other headlines in the buffer. + +`C-c C-n' (`outline-next-visible-heading') + Next heading. + +`C-c C-p' (`outline-previous-visible-heading') + Previous heading. + +`C-c C-f' (`org-forward-same-level') + Next heading same level. + +`C-c C-b' (`org-backward-same-level') + Previous heading same level. + +`C-c C-u' (`outline-up-heading') + Backward to higher level heading. + +`C-c C-j' (`org-goto') + Jump to a different place without changing the current outline + visibility. Shows the document structure in a temporary buffer, + where you can use the following keys to find your destination: + Cycle visibility. + / Next/previous visible headline. + Select this location. + / Do a Sparse-tree search + The following keys work if you turn off `org-goto-auto-isearch' + n / p Next/previous visible headline. + f / b Next/previous headline same level. + u One level up. + 0-9 Digit argument. + q Quit + See also the option `org-goto-interface'. + + +File: org, Node: Structure editing, Next: Sparse trees, Prev: Motion, Up: Document Structure + +2.5 Structure editing +===================== + +`M-' (`org-insert-heading') + Insert a new heading/item with the same level than the one at + point. If the cursor is in a plain list item, a new item is + created (*note Plain lists::). To prevent this behavior in lists, + call the command with a prefix argument. When this command is + used in the middle of a line, the line is split and the rest of + the line becomes the new item or headline(1). If the command is + used at the _beginning_ of a headline, the new headline is created + before the current line. If the command is used at the _end_ of a + folded subtree (i.e., behind the ellipses at the end of a + headline), then a headline will be inserted after the end of the + subtree. Calling this command with `C-u C-u' will unconditionally + respect the headline's content and create a new item at the end of + the parent subtree. + +`C-' (`org-insert-heading-respect-content') + Just like `M-', except when adding a new heading below the + current heading, the new heading is placed after the body instead + of before it. This command works from anywhere in the entry. + +`M-S-' (`org-insert-todo-heading') + Insert new TODO entry with same level as current heading. See + also the variable `org-treat-insert-todo-heading-as-state-change'. + +`C-S-' (`org-insert-todo-heading-respect-content') + Insert new TODO entry with same level as current heading. Like + `C-', the new headline will be inserted after the current + subtree. + +`' (`org-cycle') + In a new entry with no text yet, the first demotes the entry + to become a child of the previous one. The next makes it a + parent, and so on, all the way to top level. Yet another , + and you are back to the initial level. + +`M-' (`org-do-promote') + Promote current heading by one level. + +`M-' (`org-do-demote') + Demote current heading by one level. + +`M-S-' (`org-promote-subtree') + Promote the current subtree by one level. + +`M-S-' (`org-demote-subtree') + Demote the current subtree by one level. + +`M-S-' (`org-move-subtree-up') + Move subtree up (swap with previous subtree of same level). + +`M-S-' (`org-move-subtree-down') + Move subtree down (swap with next subtree of same level). + +`M-h' (`org-mark-element') + Mark the element at point. Hitting repeatedly will mark + subsequent elements of the one just marked. E.g., hitting + on a paragraph will mark it, hitting immediately again will + mark the next one. + +`C-c @' (`org-mark-subtree') + Mark the subtree at point. Hitting repeatedly will mark + subsequent subtrees of the same level than the marked subtree. + +`C-c C-x C-w' (`org-cut-subtree') + Kill subtree, i.e., remove it from buffer but save in kill ring. + With a numeric prefix argument N, kill N sequential subtrees. + +`C-c C-x M-w' (`org-copy-subtree') + Copy subtree to kill ring. With a numeric prefix argument N, copy + the N sequential subtrees. + +`C-c C-x C-y' (`org-paste-subtree') + Yank subtree from kill ring. This does modify the level of the + subtree to make sure the tree fits in nicely at the yank position. + The yank level can also be specified with a numeric prefix + argument, or by yanking after a headline marker like `****'. + +`C-y' (`org-yank') + Depending on the options `org-yank-adjusted-subtrees' and + `org-yank-folded-subtrees', Org's internal `yank' command will + paste subtrees folded and in a clever way, using the same command + as `C-c C-x C-y'. With the default settings, no level adjustment + will take place, but the yanked tree will be folded unless doing + so would swallow text previously visible. Any prefix argument to + this command will force a normal `yank' to be executed, with the + prefix passed along. A good way to force a normal yank is `C-u + C-y'. If you use `yank-pop' after a yank, it will yank previous + kill items plainly, without adjustment and folding. + +`C-c C-x c' (`org-clone-subtree-with-time-shift') + Clone a subtree by making a number of sibling copies of it. You + will be prompted for the number of copies to make, and you can + also specify if any timestamps in the entry should be shifted. + This can be useful, for example, to create a number of tasks + related to a series of lectures to prepare. For more details, see + the docstring of the command `org-clone-subtree-with-time-shift'. + +`C-c C-w' (`org-refile') + Refile entry or region to a different location. *Note Refile and + copy::. + +`C-c ^' (`org-sort') + Sort same-level entries. When there is an active region, all + entries in the region will be sorted. Otherwise the children of + the current headline are sorted. The command prompts for the + sorting method, which can be alphabetically, numerically, by time + (first timestamp with active preferred, creation time, scheduled + time, deadline time), by priority, by TODO keyword (in the + sequence the keywords have been defined in the setup) or by the + value of a property. Reverse sorting is possible as well. You + can also supply your own function to extract the sorting key. + With a `C-u' prefix, sorting will be case-sensitive. + +`C-x n s' (`org-narrow-to-subtree') + Narrow buffer to current subtree. + +`C-x n b' (`org-narrow-to-block') + Narrow buffer to current block. + +`C-x n w' (`widen') + Widen buffer to remove narrowing. + +`C-c *' (`org-toggle-heading') + Turn a normal line or plain list item into a headline (so that it + becomes a subheading at its location). Also turn a headline into + a normal line by removing the stars. If there is an active + region, turn all lines in the region into headlines. If the first + line in the region was an item, turn only the item lines into + headlines. Finally, if the first line is a headline, remove the + stars from all headlines in the region. + + When there is an active region (Transient Mark mode), promotion and +demotion work on all headlines in the region. To select a region of +headlines, it is best to place both point and mark at the beginning of a +line, mark at the beginning of the first headline, and point at the line +just after the last headline to change. Note that when the cursor is +inside a table (*note Tables::), the Meta-Cursor keys have different +functionality. + + ---------- Footnotes ---------- + + (1) If you do not want the line to be split, customize the variable +`org-M-RET-may-split-line'. + + +File: org, Node: Sparse trees, Next: Plain lists, Prev: Structure editing, Up: Document Structure + +2.6 Sparse trees +================ + +An important feature of Org mode is the ability to construct _sparse +trees_ for selected information in an outline tree, so that the entire +document is folded as much as possible, but the selected information is +made visible along with the headline structure above it(1). Just try +it out and you will see immediately how it works. + + Org mode contains several commands creating such trees, all these +commands can be accessed through a dispatcher: + +`C-c /' (`org-sparse-tree') + This prompts for an extra key to select a sparse-tree creating + command. + +`C-c / r' (`org-occur') + Prompts for a regexp and shows a sparse tree with all matches. If + the match is in a headline, the headline is made visible. If the + match is in the body of an entry, headline and body are made + visible. In order to provide minimal context, also the full + hierarchy of headlines above the match is shown, as well as the + headline following the match. Each match is also highlighted; the + highlights disappear when the buffer is changed by an editing + command(2), or by pressing `C-c C-c'. When called with a `C-u' + prefix argument, previous highlights are kept, so several calls to + this command can be stacked. + +`M-g n' or `M-g M-n' (`next-error') + Jump to the next sparse tree match in this buffer. + +`M-g p' or `M-g M-p' (`previous-error') + Jump to the previous sparse tree match in this buffer. + +For frequently used sparse trees of specific search strings, you can +use the option `org-agenda-custom-commands' to define fast keyboard +access to specific sparse trees. These commands will then be +accessible through the agenda dispatcher (*note Agenda dispatcher::). +For example: + + (setq org-agenda-custom-commands + '(("f" occur-tree "FIXME"))) + +will define the key `C-c a f' as a shortcut for creating a sparse tree +matching the string `FIXME'. + + The other sparse tree commands select headings based on TODO +keywords, tags, or properties and will be discussed later in this +manual. + + To print a sparse tree, you can use the Emacs command +`ps-print-buffer-with-faces' which does not print invisible parts of +the document (3). Or you can use `C-c C-e C-v' to export only the +visible part of the document and print the resulting file. + + ---------- Footnotes ---------- + + (1) See also the variables `org-show-hierarchy-above', +`org-show-following-heading', `org-show-siblings', and +`org-show-entry-below' for detailed control on how much context is +shown around each match. + + (2) This depends on the option `org-remove-highlights-with-change' + + (3) This does not work under XEmacs, because XEmacs uses selective +display for outlining, not text properties. + + +File: org, Node: Plain lists, Next: Drawers, Prev: Sparse trees, Up: Document Structure + +2.7 Plain lists +=============== + +Within an entry of the outline tree, hand-formatted lists can provide +additional structure. They also provide a way to create lists of +checkboxes (*note Checkboxes::). Org supports editing such lists, and +every exporter (*note Exporting::) can parse and format them. + + Org knows ordered lists, unordered lists, and description lists. + * _Unordered_ list items start with `-', `+', or `*'(1) as bullets. + + * _Ordered_ list items start with a numeral followed by either a + period or a right parenthesis(2), such as `1.' or `1)'(3). If you + want a list to start with a different value (e.g., 20), start the + text of the item with `[@20]'(4). Those constructs can be used in + any item of the list in order to enforce a particular numbering. + + * _Description_ list items are unordered list items, and contain the + separator ` :: ' to distinguish the description _term_ from the + description. + + Items belonging to the same list must have the same indentation on +the first line. In particular, if an ordered list reaches number +`10.', then the 2-digit numbers must be written left-aligned with the +other numbers in the list. An item ends before the next line that is +less or equally indented than its bullet/number. + + A list ends whenever every item has ended, which means before any +line less or equally indented than items at top level. It also ends +before two blank lines(5). In that case, all items are closed. Here +is an example: + + ** Lord of the Rings + My favorite scenes are (in this order) + 1. The attack of the Rohirrim + 2. Eowyn's fight with the witch king + + this was already my favorite scene in the book + + I really like Miranda Otto. + 3. Peter Jackson being shot by Legolas + - on DVD only + He makes a really funny face when it happens. + But in the end, no individual scenes matter but the film as a whole. + Important actors in this film are: + - Elijah Wood :: He plays Frodo + - Sean Austin :: He plays Sam, Frodo's friend. I still remember + him very well from his role as Mikey Walsh in The Goonies. + + Org supports these lists by tuning filling and wrapping commands to +deal with them correctly(6), and by exporting them properly (*note +Exporting::). Since indentation is what governs the structure of these +lists, many structural constructs like `#+BEGIN_...' blocks can be +indented to signal that they belong to a particular item. + + If you find that using a different bullet for a sub-list (than that +used for the current list-level) improves readability, customize the +variable `org-list-demote-modify-bullet'. To get a greater difference +of indentation between items and theirs sub-items, customize +`org-list-indent-offset'. + + The following commands act on items when the cursor is in the first +line of an item (the line with the bullet or number). Some of them +imply the application of automatic rules to keep list structure intact. +If some of these actions get in your way, configure +`org-list-automatic-rules' to disable them individually. + +`' (`org-cycle') + Items can be folded just like headline levels. Normally this + works only if the cursor is on a plain list item. For more + details, see the variable `org-cycle-include-plain-lists'. If + this variable is set to `integrate', plain list items will be + treated like low-level headlines. The level of an item is then + given by the indentation of the bullet/number. Items are always + subordinate to real headlines, however; the hierarchies remain + completely separated. In a new item with no text yet, the first + demotes the item to become a child of the previous one. + Subsequent s move the item to meaningful levels in the list + and eventually get it back to its initial position. + +`M-' (`org-insert-heading') + Insert new item at current level. With a prefix argument, force a + new heading (*note Structure editing::). If this command is used + in the middle of an item, that item is _split_ in two, and the + second part becomes the new item(7). If this command is executed + _before item's body_, the new item is created _before_ the current + one. + +`M-S-' + Insert a new item with a checkbox (*note Checkboxes::). + +`S-up' +`S-down' + Jump to the previous/next item in the current list(8), but only if + `org-support-shift-select' is off. If not, you can still use + paragraph jumping commands like `C-' and `C-' to quite + similar effect. + +`M-up' +`M-down' + Move the item including subitems up/down(9) (swap with + previous/next item of same indentation). If the list is ordered, + renumbering is automatic. + +`M-left' +`M-right' + Decrease/increase the indentation of an item, leaving children + alone. + +`M-S-' +`M-S-' + Decrease/increase the indentation of the item, including subitems. + Initially, the item tree is selected based on current indentation. + When these commands are executed several times in direct + succession, the initially selected region is used, even if the new + indentation would imply a different hierarchy. To use the new + hierarchy, break the command chain with a cursor motion or so. + + As a special case, using this command on the very first item of a + list will move the whole list. This behavior can be disabled by + configuring `org-list-automatic-rules'. The global indentation of + a list has no influence on the text _after_ the list. + +`C-c C-c' + If there is a checkbox (*note Checkboxes::) in the item line, + toggle the state of the checkbox. In any case, verify bullets and + indentation consistency in the whole list. + +`C-c -' + Cycle the entire list level through the different + itemize/enumerate bullets (`-', `+', `*', `1.', `1)') or a subset + of them, depending on `org-plain-list-ordered-item-terminator', + the type of list, and its indentation. With a numeric prefix + argument N, select the Nth bullet from this list. If there is an + active region when calling this, selected text will be changed + into an item. With a prefix argument, all lines will be converted + to list items. If the first line already was a list item, any item + marker will be removed from the list. Finally, even without an + active region, a normal line will be converted into a list item. + +`C-c *' + Turn a plain list item into a headline (so that it becomes a + subheading at its location). *Note Structure editing::, for a + detailed explanation. + +`C-c C-*' + Turn the whole plain list into a subtree of the current heading. + Checkboxes (*note Checkboxes::) will become TODO (resp. DONE) + keywords when unchecked (resp. checked). + +`S-left/right' + This command also cycles bullet styles when the cursor in on the + bullet or anywhere in an item line, details depending on + `org-support-shift-select'. + +`C-c ^' + Sort the plain list. You will be prompted for the sorting method: + numerically, alphabetically, by time, by checked status for check + lists, or by a custom function. + + ---------- Footnotes ---------- + + (1) When using `*' as a bullet, lines must be indented or they will +be seen as top-level headlines. Also, when you are hiding leading +stars to get a clean outline view, plain list items starting with a +star may be hard to distinguish from true headlines. In short: even +though `*' is supported, it may be better to not use it for plain list +items. + + (2) You can filter out any of them by configuring +`org-plain-list-ordered-item-terminator'. + + (3) You can also get `a.', `A.', `a)' and `A)' by configuring +`org-list-allow-alphabetical'. To minimize confusion with normal text, +those are limited to one character only. Beyond that limit, bullets +will automatically fallback to numbers. + + (4) If there's a checkbox in the item, the cookie must be put +_before_ the checkbox. If you have activated alphabetical lists, you +can also use counters like `[@b]'. + + (5) See also `org-list-empty-line-terminates-plain-lists'. + + (6) Org only changes the filling settings for Emacs. For XEmacs, +you should use Kyle E. Jones' `filladapt.el'. To turn this on, put +into `.emacs': `(require 'filladapt)' + + (7) If you do not want the item to be split, customize the variable +`org-M-RET-may-split-line'. + + (8) If you want to cycle around items that way, you may customize +`org-list-use-circular-motion'. + + (9) See `org-list-use-circular-motion' for a cyclic behavior. + + +File: org, Node: Drawers, Next: Blocks, Prev: Plain lists, Up: Document Structure + +2.8 Drawers +=========== + +Sometimes you want to keep information associated with an entry, but you +normally don't want to see it. For this, Org mode has _drawers_. +Drawers need to be configured with the option `org-drawers'(1). +Drawers look like this: + + ** This is a headline + Still outside the drawer + :DRAWERNAME: + This is inside the drawer. + :END: + After the drawer. + + You can interactively insert drawers at point by calling +`org-insert-drawer', which is bound to . With an active +region, this command will put the region inside the drawer. With a +prefix argument, this command calls `org-insert-property-drawer' and +add a property drawer right below the current headline. Completion +over drawer keywords is also possible using . + + Visibility cycling (*note Visibility cycling::) on the headline will +hide and show the entry, but keep the drawer collapsed to a single +line. In order to look inside the drawer, you need to move the cursor +to the drawer line and press there. Org mode uses the +`PROPERTIES' drawer for storing properties (*note Properties and +Columns::), and you can also arrange for state change notes (*note +Tracking TODO state changes::) and clock times (*note Clocking work +time::) to be stored in a drawer `LOGBOOK'. If you want to store a +quick note in the LOGBOOK drawer, in a similar way to state changes, use + +`C-c C-z' + Add a time-stamped note to the LOGBOOK drawer. + + You can select the name of the drawers which should be exported with +`org-export-with-drawers'. In that case, drawer contents will appear in +export output. Property drawers are not affected by this variable and +are never exported. + + ---------- Footnotes ---------- + + (1) You can define additional drawers on a per-file basis with a +line like `#+DRAWERS: HIDDEN STATE' + + +File: org, Node: Blocks, Next: Footnotes, Prev: Drawers, Up: Document Structure + +2.9 Blocks +========== + +Org mode uses begin...end blocks for various purposes from including +source code examples (*note Literal examples::) to capturing time +logging information (*note Clocking work time::). These blocks can be +folded and unfolded by pressing TAB in the begin line. You can also +get all blocks folded at startup by configuring the option +`org-hide-block-startup' or on a per-file basis by using + + #+STARTUP: hideblocks + #+STARTUP: nohideblocks + + +File: org, Node: Footnotes, Next: Orgstruct mode, Prev: Blocks, Up: Document Structure + +2.10 Footnotes +============== + +Org mode supports the creation of footnotes. In contrast to the +`footnote.el' package, Org mode's footnotes are designed for work on a +larger document, not only for one-off documents like emails. + + A footnote is started by a footnote marker in square brackets in +column 0, no indentation allowed. It ends at the next footnote +definition, headline, or after two consecutive empty lines. The +footnote reference is simply the marker in square brackets, inside +text. For example: + + The Org homepage[fn:1] now looks a lot better than it used to. + ... + [fn:1] The link is: http://orgmode.org + + Org mode extends the number-based syntax to _named_ footnotes and +optional inline definition. Using plain numbers as markers (as +`footnote.el' does) is supported for backward compatibility, but not +encouraged because of possible conflicts with LaTeX snippets (*note +Embedded LaTeX::). Here are the valid references: + +`[1]' + A plain numeric footnote marker. Compatible with `footnote.el', + but not recommended because something like `[1]' could easily be + part of a code snippet. + +`[fn:name]' + A named footnote reference, where `name' is a unique label word, + or, for simplicity of automatic creation, a number. + +`[fn:: This is the inline definition of this footnote]' + A LaTeX-like anonymous footnote where the definition is given + directly at the reference point. + +`[fn:name: a definition]' + An inline definition of a footnote, which also specifies a name + for the note. Since Org allows multiple references to the same + note, you can then use `[fn:name]' to create additional references. + + Footnote labels can be created automatically, or you can create +names yourself. This is handled by the variable +`org-footnote-auto-label' and its corresponding `#+STARTUP' keywords. +See the docstring of that variable for details. + +The following command handles footnotes: + +`C-c C-x f' + The footnote action command. + + When the cursor is on a footnote reference, jump to the + definition. When it is at a definition, jump to the (first) + reference. + + Otherwise, create a new footnote. Depending on the option + `org-footnote-define-inline'(1), the definition will be placed + right into the text as part of the reference, or separately into + the location determined by the option `org-footnote-section'. + + When this command is called with a prefix argument, a menu of + additional options is offered: + s Sort the footnote definitions by reference sequence. During editing, + Org makes no effort to sort footnote definitions into a particular + sequence. If you want them sorted, use this command, which will + also move entries according to `org-footnote-section'. Automatic + sorting after each insertion/deletion can be configured using the + option `org-footnote-auto-adjust'. + r Renumber the simple `fn:N' footnotes. Automatic renumbering + after each insertion/deletion can be configured using the option + `org-footnote-auto-adjust'. + S Short for first `r', then `s' action. + n Normalize the footnotes by collecting all definitions (including + inline definitions) into a special section, and then numbering them + in sequence. The references will then also be numbers. This is + meant to be the final step before finishing a document (e.g., sending + off an email). + d Delete the footnote at point, and all definitions of and references + to it. + Depending on the variable `org-footnote-auto-adjust'(2), + renumbering and sorting footnotes can be automatic after each + insertion or deletion. + +`C-c C-c' + If the cursor is on a footnote reference, jump to the definition. + If it is a the definition, jump back to the reference. When + called at a footnote location with a prefix argument, offer the + same menu as `C-c C-x f'. + +`C-c C-o or mouse-1/2' + Footnote labels are also links to the corresponding + definition/reference, and you can use the usual commands to follow + these links. + + ---------- Footnotes ---------- + + (1) The corresponding in-buffer setting is: `#+STARTUP: fninline' or +`#+STARTUP: nofninline' + + (2) the corresponding in-buffer options are `fnadjust' and +`nofnadjust'. + + +File: org, Node: Orgstruct mode, Next: Org syntax, Prev: Footnotes, Up: Document Structure + +2.11 The Orgstruct minor mode +============================= + +If you like the intuitive way the Org mode structure editing and list +formatting works, you might want to use these commands in other modes +like Text mode or Mail mode as well. The minor mode `orgstruct-mode' +makes this possible. Toggle the mode with `M-x orgstruct-mode RET', or +turn it on by default, for example in Message mode, with one of: + + (add-hook 'message-mode-hook 'turn-on-orgstruct) + (add-hook 'message-mode-hook 'turn-on-orgstruct++) + + When this mode is active and the cursor is on a line that looks to +Org like a headline or the first line of a list item, most structure +editing commands will work, even if the same keys normally have +different functionality in the major mode you are using. If the cursor +is not in one of those special lines, Orgstruct mode lurks silently in +the shadows. + + When you use `orgstruct++-mode', Org will also export indentation and +autofill settings into that mode, and detect item context after the +first line of an item. + + You can also use Org structure editing to fold and unfold headlines +in _any_ file, provided you defined `orgstruct-heading-prefix-regexp': +the regular expression must match the local prefix to use before Org's +headlines. For example, if you set this variable to `";; "' in Emacs +Lisp files, you will be able to fold and unfold headlines in Emacs Lisp +commented lines. Some commands like `org-demote' are disabled when the +prefix is set, but folding/unfolding will work correctly. + + +File: org, Node: Org syntax, Prev: Orgstruct mode, Up: Document Structure + +2.12 Org syntax +=============== + +A reference document providing a formal description of Org's syntax is +available as a draft on Worg +(http://orgmode.org/worg/dev/org-syntax.html), written and maintained +by Nicolas Goaziou. It defines Org's core internal concepts such as +`headlines', `sections', `affiliated keywords', `(greater) elements' +and `objects'. Each part of an Org file falls into one of the +categories above. + + To explore the abstract structure of an Org buffer, run this in a +buffer: + + M-: (org-element-parse-buffer) RET + + It will output a list containing the buffer's content represented as +an abstract structure. The export engine relies on the information +stored in this list. Most interactive commands (e.g., for structure +editing) also rely on the syntactic meaning of the surrounding context. + + +File: org, Node: Tables, Next: Hyperlinks, Prev: Document Structure, Up: Top + +3 Tables +******** + +Org comes with a fast and intuitive table editor. Spreadsheet-like +calculations are supported using the Emacs `calc' package (*note Calc: +(calc)Top.). + +* Menu: + +* Built-in table editor:: Simple tables +* Column width and alignment:: Overrule the automatic settings +* Column groups:: Grouping to trigger vertical lines +* Orgtbl mode:: The table editor as minor mode +* The spreadsheet:: The table editor has spreadsheet capabilities +* Org-Plot:: Plotting from org tables + + +File: org, Node: Built-in table editor, Next: Column width and alignment, Prev: Tables, Up: Tables + +3.1 The built-in table editor +============================= + +Org makes it easy to format tables in plain ASCII. Any line with `|' as +the first non-whitespace character is considered part of a table. `|' +is also the column separator(1). A table might look like this: + + | Name | Phone | Age | + |-------+-------+-----| + | Peter | 1234 | 17 | + | Anna | 4321 | 25 | + + A table is re-aligned automatically each time you press or + or `C-c C-c' inside the table. also moves to the next +field ( to the next row) and creates new table rows at the end of +the table or before horizontal lines. The indentation of the table is +set by the first line. Any line starting with `|-' is considered as a +horizontal separator line and will be expanded on the next re-align to +span the whole table width. So, to create the above table, you would +only type + + |Name|Phone|Age| + |- + +and then press to align the table and start filling in fields. +Even faster would be to type `|Name|Phone|Age' followed by `C-c '. + + When typing text into a field, Org treats , , and +all character keys in a special way, so that inserting and deleting +avoids shifting other fields. Also, when typing _immediately after the +cursor was moved into a new field with `', `S-' or `'_, +the field is automatically made blank. If this behavior is too +unpredictable for you, configure the options `org-enable-table-editor' +and `org-table-auto-blank-field'. + +Creation and conversion +....................... + +`C-c | (`org-table-create-or-convert-from-region')' + Convert the active region to table. If every line contains at + least one TAB character, the function assumes that the material is + tab separated. If every line contains a comma, comma-separated + values (CSV) are assumed. If not, lines are split at whitespace + into fields. You can use a prefix argument to force a specific + separator: `C-u' forces CSV, `C-u C-u' forces TAB, and a numeric + argument N indicates that at least N consecutive spaces, or + alternatively a TAB will be the separator. + If there is no active region, this command creates an empty Org + table. But it is easier just to start typing, like + `|Name|Phone|Age |- '. + +Re-aligning and field motion +............................ + +`C-c C-c (`org-table-align')' + Re-align the table and don't move to another field. + +` (`org-table-next-field')' + Re-align the table, move to the next field. Creates a new row if + necessary. + +`S- (`org-table-previous-field')' + Re-align, move to previous field. + +` (`org-table-next-row')' + Re-align the table and move down to next row. Creates a new row if + necessary. At the beginning or end of a line, still does + NEWLINE, so it can be used to split a table. + +`M-a (`org-table-beginning-of-field')' + Move to beginning of the current table field, or on to the + previous field. + +`M-e (`org-table-end-of-field')' + Move to end of the current table field, or on to the next field. + +Column and row editing +...................... + +`M- (`org-table-move-column-left')' +`M- (`org-table-move-column-right')' + Move the current column left/right. + +`M-S- (`org-table-delete-column')' + Kill the current column. + +`M-S- (`org-table-insert-column')' + Insert a new column to the left of the cursor position. + +`M- (`org-table-move-row-up')' +`M- (`org-table-move-row-down')' + Move the current row up/down. + +`M-S- (`org-table-kill-row')' + Kill the current row or horizontal line. + +`M-S- (`org-table-insert-row')' + Insert a new row above the current row. With a prefix argument, + the line is created below the current one. + +`C-c - (`org-table-insert-hline')' + Insert a horizontal line below current row. With a prefix + argument, the line is created above the current line. + +`C-c (`org-table-hline-and-move')' + Insert a horizontal line below current row, and move the cursor + into the row below that line. + +`C-c ^ (`org-table-sort-lines')' + Sort the table lines in the region. The position of point + indicates the column to be used for sorting, and the range of + lines is the range between the nearest horizontal separator lines, + or the entire table. If point is before the first column, you + will be prompted for the sorting column. If there is an active + region, the mark specifies the first line and the sorting column, + while point should be in the last line to be included into the + sorting. The command prompts for the sorting type + (alphabetically, numerically, or by time). When called with a + prefix argument, alphabetic sorting will be case-sensitive. + +Regions +....... + +`C-c C-x M-w (`org-table-copy-region')' + Copy a rectangular region from a table to a special clipboard. + Point and mark determine edge fields of the rectangle. If there + is no active region, copy just the current field. The process + ignores horizontal separator lines. + +`C-c C-x C-w (`org-table-cut-region')' + Copy a rectangular region from a table to a special clipboard, and + blank all fields in the rectangle. So this is the "cut" operation. + +`C-c C-x C-y (`org-table-paste-rectangle')' + Paste a rectangular region into a table. The upper left corner + ends up in the current field. All involved fields will be + overwritten. If the rectangle does not fit into the present table, + the table is enlarged as needed. The process ignores horizontal + separator lines. + +`M- (`org-table-wrap-region')' + Split the current field at the cursor position and move the rest + to the line below. If there is an active region, and both point + and mark are in the same column, the text in the column is wrapped + to minimum width for the given number of lines. A numeric prefix + argument may be used to change the number of desired lines. If + there is no region, but you specify a prefix argument, the current + field is made blank, and the content is appended to the field + above. + +Calculations +............ + +`C-c + (`org-table-sum')' + Sum the numbers in the current column, or in the rectangle defined + by the active region. The result is shown in the echo area and can + be inserted with `C-y'. + +`S- (`org-table-copy-down')' + When current field is empty, copy from first non-empty field + above. When not empty, copy current field down to next row and + move cursor along with it. Depending on the option + `org-table-copy-increment', integer field values will be + incremented during copy. Integers that are too large will not be + incremented. Also, a `0' prefix argument temporarily disables the + increment. This key is also used by shift-selection and related + modes (*note Conflicts::). + +Miscellaneous +............. + +`C-c ` (`org-table-edit-field')' + Edit the current field in a separate window. This is useful for + fields that are not fully visible (*note Column width and + alignment::). When called with a `C-u' prefix, just make the full + field visible, so that it can be edited in place. When called + with two `C-u' prefixes, make the editor window follow the cursor + through the table and always show the current field. The follow + mode exits automatically when the cursor leaves the table, or when + you repeat this command with `C-u C-u C-c `'. + +`M-x org-table-import RET' + Import a file as a table. The table should be TAB or whitespace + separated. Use, for example, to import a spreadsheet table or data + from a database, because these programs generally can write + TAB-separated text files. This command works by inserting the + file into the buffer and then converting the region to a table. + Any prefix argument is passed on to the converter, which uses it + to determine the separator. + +`C-c | (`org-table-create-or-convert-from-region')' + Tables can also be imported by pasting tabular text into the Org + buffer, selecting the pasted text with `C-x C-x' and then using the + `C-c |' command (see above under Creation and conversion). + +`M-x org-table-export RET' + Export the table, by default as a TAB-separated file. Use for data + exchange with, for example, spreadsheet or database programs. The + format used to export the file can be configured in the option + `org-table-export-default-format'. You may also use properties + `TABLE_EXPORT_FILE' and `TABLE_EXPORT_FORMAT' to specify the file + name and the format for table export in a subtree. Org supports + quite general formats for exported tables. The exporter format is + the same as the format used by Orgtbl radio tables, see *note + Translator functions::, for a detailed description. + + If you don't like the automatic table editor because it gets in your +way on lines which you would like to start with `|', you can turn it +off with + + (setq org-enable-table-editor nil) + +Then the only table command that still works is `C-c C-c' to do a +manual re-align. + + ---------- Footnotes ---------- + + (1) To insert a vertical bar into a table field, use `\vert' or, +inside a word `abc\vert{}def'. + + +File: org, Node: Column width and alignment, Next: Column groups, Prev: Built-in table editor, Up: Tables + +3.2 Column width and alignment +============================== + +The width of columns is automatically determined by the table editor. +And also the alignment of a column is determined automatically from the +fraction of number-like versus non-number fields in the column. + + Sometimes a single field or a few fields need to carry more text, +leading to inconveniently wide columns. Or maybe you want to make a +table with several columns having a fixed width, regardless of content. +To set(1) the width of a column, one field anywhere in the column may +contain just the string `' where `N' is an integer specifying the +width of the column in characters. The next re-align will then set the +width of this column to this value. + + |---+------------------------------| |---+--------| + | | | | | <6> | + | 1 | one | | 1 | one | + | 2 | two | ----\ | 2 | two | + | 3 | This is a long chunk of text | ----/ | 3 | This=> | + | 4 | four | | 4 | four | + |---+------------------------------| |---+--------| + +Fields that are wider become clipped and end in the string `=>'. Note +that the full text is still in the buffer but is hidden. To see the +full text, hold the mouse over the field--a tool-tip window will show +the full content. To edit such a field, use the command `C-c `' (that +is `C-c' followed by the backquote). This will open a new window with +the full field. Edit it and finish with `C-c C-c'. + + When visiting a file containing a table with narrowed columns, the +necessary character hiding has not yet happened, and the table needs to +be aligned before it looks nice. Setting the option +`org-startup-align-all-tables' will realign all tables in a file upon +visiting, but also slow down startup. You can also set this option on +a per-file basis with: + + #+STARTUP: align + #+STARTUP: noalign + + If you would like to overrule the automatic alignment of number-rich +columns to the right and of string-rich column to the left, you can use +`', `'(2) or `' in a similar fashion. You may also combine +alignment and field width like this: `'. + + Lines which only contain these formatting cookies will be removed +automatically when exporting the document. + + ---------- Footnotes ---------- + + (1) This feature does not work on XEmacs. + + (2) Centering does not work inside Emacs, but it does have an effect +when exporting to HTML. + + +File: org, Node: Column groups, Next: Orgtbl mode, Prev: Column width and alignment, Up: Tables + +3.3 Column groups +================= + +When Org exports tables, it does so by default without vertical lines +because that is visually more satisfying in general. Occasionally +however, vertical lines can be useful to structure a table into groups +of columns, much like horizontal lines can do for groups of rows. In +order to specify column groups, you can use a special row where the +first field contains only `/'. The further fields can either contain +`<' to indicate that this column should start a group, `>' to indicate +the end of a column, or `<>' (no space between `<' and `>') to make a +column a group of its own. Boundaries between column groups will upon +export be marked with vertical lines. Here is an example: + + | N | N^2 | N^3 | N^4 | sqrt(n) | sqrt[4](N) | + |---+-----+-----+-----+---------+------------| + | / | < | | > | < | > | + | 1 | 1 | 1 | 1 | 1 | 1 | + | 2 | 4 | 8 | 16 | 1.4142 | 1.1892 | + | 3 | 9 | 27 | 81 | 1.7321 | 1.3161 | + |---+-----+-----+-----+---------+------------| + #+TBLFM: $2=$1^2::$3=$1^3::$4=$1^4::$5=sqrt($1)::$6=sqrt(sqrt(($1))) + + It is also sufficient to just insert the column group starters after +every vertical line you would like to have: + + | N | N^2 | N^3 | N^4 | sqrt(n) | sqrt[4](N) | + |----+-----+-----+-----+---------+------------| + | / | < | | | < | | + + +File: org, Node: Orgtbl mode, Next: The spreadsheet, Prev: Column groups, Up: Tables + +3.4 The Orgtbl minor mode +========================= + +If you like the intuitive way the Org table editor works, you might +also want to use it in other modes like Text mode or Mail mode. The +minor mode Orgtbl mode makes this possible. You can always toggle the +mode with `M-x orgtbl-mode RET'. To turn it on by default, for example +in Message mode, use + + (add-hook 'message-mode-hook 'turn-on-orgtbl) + + Furthermore, with some special setup, it is possible to maintain +tables in arbitrary syntax with Orgtbl mode. For example, it is +possible to construct LaTeX tables with the underlying ease and power of +Orgtbl mode, including spreadsheet capabilities. For details, see +*note Tables in arbitrary syntax::. + + +File: org, Node: The spreadsheet, Next: Org-Plot, Prev: Orgtbl mode, Up: Tables + +3.5 The spreadsheet +=================== + +The table editor makes use of the Emacs `calc' package to implement +spreadsheet-like capabilities. It can also evaluate Emacs Lisp forms to +derive fields from other fields. While fully featured, Org's +implementation is not identical to other spreadsheets. For example, +Org knows the concept of a _column formula_ that will be applied to all +non-header fields in a column without having to copy the formula to +each relevant field. There is also a formula debugger, and a formula +editor with features for highlighting fields in the table corresponding +to the references at the point in the formula, moving these references +by arrow keys + +* Menu: + +* References:: How to refer to another field or range +* Formula syntax for Calc:: Using Calc to compute stuff +* Formula syntax for Lisp:: Writing formulas in Emacs Lisp +* Durations and time values:: How to compute durations and time values +* Field and range formulas:: Formula for specific (ranges of) fields +* Column formulas:: Formulas valid for an entire column +* Lookup functions:: Lookup functions for searching tables +* Editing and debugging formulas:: Fixing formulas +* Updating the table:: Recomputing all dependent fields +* Advanced features:: Field and column names, parameters and automatic recalc + + +File: org, Node: References, Next: Formula syntax for Calc, Prev: The spreadsheet, Up: The spreadsheet + +3.5.1 References +---------------- + +To compute fields in the table from other fields, formulas must +reference other fields or ranges. In Org, fields can be referenced by +name, by absolute coordinates, and by relative coordinates. To find +out what the coordinates of a field are, press `C-c ?' in that field, +or press `C-c }' to toggle the display of a grid. + +Field references +................ + +Formulas can reference the value of another field in two ways. Like in +any other spreadsheet, you may reference fields with a letter/number +combination like `B3', meaning the 2nd field in the 3rd row. However, +Org prefers(1) to use another, more general representation that looks +like this: + @ROW$COLUMN + + Column specifications can be absolute like `$1', `$2',...`$N', or +relative to the current column (i.e., the column of the field which is +being computed) like `$+1' or `$-2'. `$<' and `$>' are immutable +references to the first and last column, respectively, and you can use +`$>>>' to indicate the third column from the right. + + The row specification only counts data lines and ignores horizontal +separator lines (hlines). Like with columns, you can use absolute row +numbers `@1', `@2',...`@N', and row numbers relative to the current row +like `@+3' or `@-1'. `@<' and `@>' are immutable references the first +and last(2) row in the table, respectively. You may also specify the +row relative to one of the hlines: `@I' refers to the first hline, +`@II' to the second, etc. `@-I' refers to the first such line above +the current line, `@+I' to the first such line below the current line. +You can also write `@III+2' which is the second data line after the +third hline in the table. + + `@0' and `$0' refer to the current row and column, respectively, +i.e., to the row/column for the field being computed. Also, if you omit +either the column or the row part of the reference, the current +row/column is implied. + + Org's references with _unsigned_ numbers are fixed references in the +sense that if you use the same reference in the formula for two +different fields, the same field will be referenced each time. Org's +references with _signed_ numbers are floating references because the +same reference operator can reference different fields depending on the +field being calculated by the formula. + + Here are a few examples: + + @2$3 2nd row, 3rd column (same as `C2') + $5 column 5 in the current row (same as `E&') + @2 current column, row 2 + @-1$-3 the field one row up, three columns to the left + @-I$2 field just under hline above current row, column 2 + @>$5 field in the last row, in column 5 + +Range references +................ + +You may reference a rectangular range of fields by specifying two field +references connected by two dots `..'. If both fields are in the +current row, you may simply use `$2..$7', but if at least one field is +in a different row, you need to use the general `@row$column' format at +least for the first field (i.e the reference must start with `@' in +order to be interpreted correctly). Examples: + + $1..$3 first three fields in the current row + $P..$Q range, using column names (see under Advanced) + $<<<..$>> start in third column, continue to the one but last + @2$1..@4$3 6 fields between these two fields (same as `A2..C4') + @-1$-2..@-1 3 fields in the row above, starting from 2 columns on the left + @I..II between first and second hline, short for `@I..@II' + +Range references return a vector of values that can be fed into Calc +vector functions. Empty fields in ranges are normally suppressed, so +that the vector contains only the non-empty fields. For other options +with the mode switches `E', `N' and examples *note Formula syntax for +Calc::. + +Field coordinates in formulas +............................. + +For Calc formulas and Lisp formulas `@#' and `$#' can be used to get +the row or column number of the field where the formula result goes. +The traditional Lisp formula equivalents are `org-table-current-dline' +and `org-table-current-column'. Examples: + + if(@# % 2, $#, string("")) column number on odd lines only + $3 = remote(FOO, @@#$2) copy column 2 from table FOO into + column 3 of the current table + +For the second example, table FOO must have at least as many rows as +the current table. Note that this is inefficient(3) for large number +of rows. + +Named references +................ + +`$name' is interpreted as the name of a column, parameter or constant. +Constants are defined globally through the option +`org-table-formula-constants', and locally (for the file) through a +line like + + #+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6 + +Also properties (*note Properties and Columns::) can be used as +constants in table formulas: for a property `:Xyz:' use the name +`$PROP_Xyz', and the property will be searched in the current outline +entry and in the hierarchy above it. If you have the `constants.el' +package, it will also be used to resolve constants, including natural +constants like `$h' for Planck's constant, and units like `$km' for +kilometers(4). Column names and parameters can be specified in special +table lines. These are described below, see *note Advanced features::. +All names must start with a letter, and further consist of letters and +numbers. + +Remote references +................. + +You may also reference constants, fields and ranges from a different +table, either in the current file or even in a different file. The +syntax is + + remote(NAME-OR-ID,REF) + +where NAME can be the name of a table in the current file as set by a +`#+NAME: Name' line before the table. It can also be the ID of an +entry, even in a different file, and the reference then refers to the +first table in that entry. REF is an absolute field or range reference +as described above for example `@3$3' or `$somename', valid in the +referenced table. + + ---------- Footnotes ---------- + + (1) Org will understand references typed by the user as `B4', but it +will not use this syntax when offering a formula for editing. You can +customize this behavior using the option +`org-table-use-standard-references'. + + (2) For backward compatibility you can also use special names like +`$LR5' and `$LR12' to refer in a stable way to the 5th and 12th field +in the last row of the table. However, this syntax is deprecated, it +should not be used for new documents. Use `@>$' instead. + + (3) The computation time scales as O(N^2) because table FOO is +parsed for each field to be copied. + + (4) `constants.el' can supply the values of constants in two +different unit systems, `SI' and `cgs'. Which one is used depends on +the value of the variable `constants-unit-system'. You can use the +`#+STARTUP' options `constSI' and `constcgs' to set this value for the +current buffer. + + +File: org, Node: Formula syntax for Calc, Next: Formula syntax for Lisp, Prev: References, Up: The spreadsheet + +3.5.2 Formula syntax for Calc +----------------------------- + +A formula can be any algebraic expression understood by the Emacs `Calc' +package. Note that `calc' has the non-standard convention that `/' has +lower precedence than `*', so that `a/b*c' is interpreted as `a/(b*c)'. +Before evaluation by `calc-eval' (*note calc-eval: (calc)Calling Calc +from Your Programs.), variable substitution takes place according to the +rules described above. The range vectors can be directly fed into the +Calc vector functions like `vmean' and `vsum'. + + A formula can contain an optional mode string after a semicolon. +This string consists of flags to influence Calc and other modes during +execution. By default, Org uses the standard Calc modes (precision 12, +angular units degrees, fraction and symbolic modes off). The display +format, however, has been changed to `(float 8)' to keep tables +compact. The default settings can be configured using the option +`org-calc-default-modes'. + +List of modes: + +`p20' + Set the internal Calc calculation precision to 20 digits. + +`n3', `s3', `e2', `f4' + Normal, scientific, engineering or fixed format of the result of + Calc passed back to Org. Calc formatting is unlimited in + precision as long as the Calc calculation precision is greater. + +`D', `R' + Degree and radian angle modes of Calc. + +`F', `S' + Fraction and symbolic modes of Calc. + +`T', `t' + Duration computations in Calc or Lisp, *note Durations and time + values::. + +`E' + If and how to consider empty fields. Without `E' empty fields in + range references are suppressed so that the Calc vector or Lisp + list contains only the non-empty fields. With `E' the empty + fields are kept. For empty fields in ranges or empty field + references the value `nan' (not a number) is used in Calc formulas + and the empty string is used for Lisp formulas. Add `N' to use 0 + instead for both formula types. For the value of a field the mode + `N' has higher precedence than `E'. + +`N' + Interpret all fields as numbers, use 0 for non-numbers. See the + next section to see how this is essential for computations with + Lisp formulas. In Calc formulas it is used only occasionally + because there number strings are already interpreted as numbers + without `N'. + +`L' + Literal, for Lisp formulas only. See the next section. + +Unless you use large integer numbers or high-precision-calculation and +-display for floating point numbers you may alternatively provide a +`printf' format specifier to reformat the Calc result after it has been +passed back to Org instead of letting Calc already do the +formatting(1). A few examples: + + $1+$2 Sum of first and second field + $1+$2;%.2f Same, format result to two decimals + exp($2)+exp($1) Math functions can be used + $0;%.1f Reformat current cell to 1 decimal + ($3-32)*5/9 Degrees F -> C conversion + $c/$1/$cm Hz -> cm conversion, using `constants.el' + tan($1);Dp3s1 Compute in degrees, precision 3, display SCI 1 + sin($1);Dp3%.1e Same, but use printf specifier for display + taylor($3,x=7,2) Taylor series of $3, at x=7, second degree + + Calc also contains a complete set of logical operations, (*note +Logical Operations: (calc)Logical Operations.). For example + +`if($1 < 20, teen, string(""))' + "teen" if age $1 is less than 20, else the Org table result field + is set to empty with the empty string. + +`if("$1" == "nan" || "$2" == "nan", string(""), $1 + $2); E f-1' + Sum of the first two columns. When at least one of the input + fields is empty the Org table result field is set to empty. `E' + is required to not convert empty fields to 0. `f-1' is an + optional Calc format string similar to `%.1f' but leaves empty + results empty. + +`if(typeof(vmean($1..$7)) == 12, string(""), vmean($1..$7); E' + Mean value of a range unless there is any empty field. Every + field in the range that is empty is replaced by `nan' which lets + `vmean' result in `nan'. Then `typeof == 12' detects the `nan' + from `vmean' and the Org table result field is set to empty. Use + this when the sample set is expected to never have missing values. + +`if("$1..$7" == "[]", string(""), vmean($1..$7))' + Mean value of a range with empty fields skipped. Every field in + the range that is empty is skipped. When all fields in the range + are empty the mean value is not defined and the Org table result + field is set to empty. Use this when the sample set can have a + variable size. + +`vmean($1..$7); EN' + To complete the example before: Mean value of a range with empty + fields counting as samples with value 0. Use this only when + incomplete sample sets should be padded with 0 to the full size. + + You can add your own Calc functions defined in Emacs Lisp with +`defmath' and use them in formula syntax for Calc. + + ---------- Footnotes ---------- + + (1) The `printf' reformatting is limited in precision because the +value passed to it is converted into an `integer' or `double'. The +`integer' is limited in size by truncating the signed value to 32 bits. +The `double' is limited in precision to 64 bits overall which leaves +approximately 16 significant decimal digits. + + +File: org, Node: Formula syntax for Lisp, Next: Durations and time values, Prev: Formula syntax for Calc, Up: The spreadsheet + +3.5.3 Emacs Lisp forms as formulas +---------------------------------- + +It is also possible to write a formula in Emacs Lisp. This can be +useful for string manipulation and control structures, if Calc's +functionality is not enough. + + If a formula starts with a single-quote followed by an opening +parenthesis, then it is evaluated as a Lisp form. The evaluation +should return either a string or a number. Just as with `calc' +formulas, you can specify modes and a printf format after a semicolon. + + With Emacs Lisp forms, you need to be conscious about the way field +references are interpolated into the form. By default, a reference +will be interpolated as a Lisp string (in double-quotes) containing the +field. If you provide the `N' mode switch, all referenced elements +will be numbers (non-number fields will be zero) and interpolated as +Lisp numbers, without quotes. If you provide the `L' flag, all fields +will be interpolated literally, without quotes. I.e., if you want a +reference to be interpreted as a string by the Lisp form, enclose the +reference operator itself in double-quotes, like `"$3"'. Ranges are +inserted as space-separated fields, so you can embed them in list or +vector syntax. + + Here are a few examples--note how the `N' mode is used when we do +computations in Lisp: + +`'(concat (substring $1 1 2) (substring $1 0 1) (substring $1 2))' + Swap the first two characters of the content of column 1. + +`'(+ $1 $2);N' + Add columns 1 and 2, equivalent to Calc's `$1+$2'. + +`'(apply '+ '($1..$4));N' + Compute the sum of columns 1 to 4, like Calc's `vsum($1..$4)'. + + +File: org, Node: Durations and time values, Next: Field and range formulas, Prev: Formula syntax for Lisp, Up: The spreadsheet + +3.5.4 Durations and time values +------------------------------- + +If you want to compute time values use the `T' flag, either in Calc +formulas or Elisp formulas: + + | Task 1 | Task 2 | Total | + |---------+----------+----------| + | 2:12 | 1:47 | 03:59:00 | + | 3:02:20 | -2:07:00 | 0.92 | + #+TBLFM: @2$3=$1+$2;T::@3$3=$1+$2;t + + Input duration values must be of the form `[HH:MM[:SS]', where +seconds are optional. With the `T' flag, computed durations will be +displayed as `HH:MM:SS' (see the first formula above). With the `t' +flag, computed durations will be displayed according to the value of +the option `org-table-duration-custom-format', which defaults to +`'hours' and will display the result as a fraction of hours (see the +second formula in the example above). + + Negative duration values can be manipulated as well, and integers +will be considered as seconds in addition and subtraction. + + +File: org, Node: Field and range formulas, Next: Column formulas, Prev: Durations and time values, Up: The spreadsheet + +3.5.5 Field and range formulas +------------------------------ + +To assign a formula to a particular field, type it directly into the +field, preceded by `:=', for example `:=vsum(@II..III)'. When you press + or or `C-c C-c' with the cursor still in the field, the +formula will be stored as the formula for this field, evaluated, and the +current field will be replaced with the result. + + Formulas are stored in a special line starting with `#+TBLFM:' +directly below the table. If you type the equation in the 4th field of +the 3rd data line in the table, the formula will look like +`@3$4=$1+$2'. When inserting/deleting/swapping column and rows with +the appropriate commands, absolute references (but not relative ones) +in stored formulas are modified in order to still reference the same +field. To avoid this from happening, in particular in range +references, anchor ranges at the table borders (using `@<', `@>', `$<', +`$>'), or at hlines using the `@I' notation. Automatic adaptation of +field references does of course not happen if you edit the table +structure with normal editing commands--then you must fix the equations +yourself. + + Instead of typing an equation into the field, you may also use the +following command + +`C-u C-c = (`org-table-eval-formula')' + Install a new formula for the current field. The command prompts + for a formula with default taken from the `#+TBLFM:' line, applies + it to the current field, and stores it. + + The left-hand side of a formula can also be a special expression in +order to assign the formula to a number of different fields. There is +no keyboard shortcut to enter such range formulas. To add them, use +the formula editor (*note Editing and debugging formulas::) or edit the +`#+TBLFM:' line directly. + +`$2=' + Column formula, valid for the entire column. This is so common + that Org treats these formulas in a special way, see *note Column + formulas::. + +`@3=' + Row formula, applies to all fields in the specified row. `@>=' + means the last row. + +`@1$2..@4$3=' + Range formula, applies to all fields in the given rectangular + range. This can also be used to assign a formula to some but not + all fields in a row. + +`$name=' + Named field, see *note Advanced features::. + + +File: org, Node: Column formulas, Next: Lookup functions, Prev: Field and range formulas, Up: The spreadsheet + +3.5.6 Column formulas +--------------------- + +When you assign a formula to a simple column reference like `$3=', the +same formula will be used in all fields of that column, with the +following very convenient exceptions: (i) If the table contains +horizontal separator hlines with rows above and below, everything +before the first such hline is considered part of the table _header_ +and will not be modified by column formulas. Therefore a header is +mandatory when you use column formulas and want to add hlines to group +rows, like for example to separate a total row at the bottom from the +summand rows above. (ii) Fields that already get a value from a +field/range formula will be left alone by column formulas. These +conditions make column formulas very easy to use. + + To assign a formula to a column, type it directly into any field in +the column, preceded by an equal sign, like `=$1+$2'. When you press + or or `C-c C-c' with the cursor still in the field, the +formula will be stored as the formula for the current column, evaluated +and the current field replaced with the result. If the field contains +only `=', the previously stored formula for this column is used. For +each column, Org will only remember the most recently used formula. In +the `#+TBLFM:' line, column formulas will look like `$4=$1+$2'. The +left-hand side of a column formula can not be the name of column, it +must be the numeric column reference or `$>'. + + Instead of typing an equation into the field, you may also use the +following command: + +`C-c = (`org-table-eval-formula')' + Install a new formula for the current column and replace current + field with the result of the formula. The command prompts for a + formula, with default taken from the `#+TBLFM' line, applies it to + the current field and stores it. With a numeric prefix + argument(e.g., `C-5 C-c =') the command will apply it to that many + consecutive fields in the current column. + + +File: org, Node: Lookup functions, Next: Editing and debugging formulas, Prev: Column formulas, Up: The spreadsheet + +3.5.7 Lookup functions +---------------------- + +Org has three predefined Emacs Lisp functions for lookups in tables. +`(org-lookup-first VAL S-LIST R-LIST &optional PREDICATE)' + Searches for the first element `S' in list `S-LIST' for which + (PREDICATE VAL S) + is `t'; returns the value from the corresponding position in list + `R-LIST'. The default `PREDICATE' is `equal'. Note that the + parameters `VAL' and `S' are passed to `PREDICATE' in the same + order as the corresponding parameters are in the call to + `org-lookup-first', where `VAL' precedes `S-LIST'. If `R-LIST' is + `nil', the matching element `S' of `S-LIST' is returned. + +`(org-lookup-last VAL S-LIST R-LIST &optional PREDICATE)' + Similar to `org-lookup-first' above, but searches for the last + element for which `PREDICATE' is `t'. + +`(org-lookup-all VAL S-LIST R-LIST &optional PREDICATE)' + Similar to `org-lookup-first', but searches for all elements for + which `PREDICATE' is `t', and returns all corresponding values. + This function can not be used by itself in a formula, because it + returns a list of values. However, powerful lookups can be built + when this function is combined with other Emacs Lisp functions. + + If the ranges used in these functions contain empty fields, the `E' +mode for the formula should usually be specified: otherwise empty +fields will not be included in `S-LIST' and/or `R-LIST' which can, for +example, result in an incorrect mapping from an element of `S-LIST' to +the corresponding element of `R-LIST'. + + These three functions can be used to implement associative arrays, +count matching cells, rank results, group data etc. For practical +examples see this tutorial on Worg +(http://orgmode.org/worg/org-tutorials/org-lookups.html). + + +File: org, Node: Editing and debugging formulas, Next: Updating the table, Prev: Lookup functions, Up: The spreadsheet + +3.5.8 Editing and debugging formulas +------------------------------------ + +You can edit individual formulas in the minibuffer or directly in the +field. Org can also prepare a special buffer with all active formulas +of a table. When offering a formula for editing, Org converts +references to the standard format (like `B3' or `D&') if possible. If +you prefer to only work with the internal format (like `@3$2' or `$4'), +configure the option `org-table-use-standard-references'. + +`C-c = or C-u C-c = (`org-table-eval-formula')' + Edit the formula associated with the current column/field in the + minibuffer. See *note Column formulas::, and *note Field and + range formulas::. + +`C-u C-u C-c = (`org-table-eval-formula')' + Re-insert the active formula (either a field formula, or a column + formula) into the current field, so that you can edit it directly + in the field. The advantage over editing in the minibuffer is + that you can use the command `C-c ?'. + +`C-c ? (`org-table-field-info')' + While editing a formula in a table field, highlight the field(s) + referenced by the reference at the cursor position in the formula. + +`C-c }' + Toggle the display of row and column numbers for a table, using + overlays (`org-table-toggle-coordinate-overlays'). These are + updated each time the table is aligned; you can force it with `C-c + C-c'. + +`C-c {' + Toggle the formula debugger on and off + (`org-table-toggle-formula-debugger'). See below. + +`C-c ' (`org-table-edit-formulas')' + Edit all formulas for the current table in a special buffer, where + the formulas will be displayed one per line. If the current field + has an active formula, the cursor in the formula editor will mark + it. While inside the special buffer, Org will automatically + highlight any field or range reference at the cursor position. + You may edit, remove and add formulas, and use the following + commands: + + `C-c C-c or C-x C-s (`org-table-fedit-finish')' + Exit the formula editor and store the modified formulas. + With `C-u' prefix, also apply the new formulas to the entire + table. + + `C-c C-q (`org-table-fedit-abort')' + Exit the formula editor without installing changes. + + `C-c C-r (`org-table-fedit-toggle-ref-type')' + Toggle all references in the formula editor between standard + (like `B3') and internal (like `@3$2'). + + ` (`org-table-fedit-lisp-indent')' + Pretty-print or indent Lisp formula at point. When in a line + containing a Lisp formula, format the formula according to + Emacs Lisp rules. Another collapses the formula back + again. In the open formula, re-indents just like in + Emacs Lisp mode. + + `M- (`lisp-complete-symbol')' + Complete Lisp symbols, just like in Emacs Lisp mode. + + `S-///' + Shift the reference at point. For example, if the reference + is `B3' and you press `S-', it will become `C3'. This + also works for relative references and for hline references. + + `M-S- (`org-table-fedit-line-up')' + `M-S- (`org-table-fedit-line-down')' + Move the test line for column formulas in the Org buffer up + and down. + + `M- (`org-table-fedit-scroll-down')' + `M- (`org-table-fedit-scroll-up')' + Scroll the window displaying the table. + + `C-c }' + Turn the coordinate grid in the table on and off. + + Making a table field blank does not remove the formula associated +with the field, because that is stored in a different line (the +`#+TBLFM' line)--during the next recalculation the field will be filled +again. To remove a formula from a field, you have to give an empty +reply when prompted for the formula, or to edit the `#+TBLFM' line. + + You may edit the `#+TBLFM' directly and re-apply the changed +equations with `C-c C-c' in that line or with the normal recalculation +commands in the table. + +Using multiple #+TBLFM lines +............................ + +You may apply the formula temporarily. This is useful when you switch +the formula. Place multiple `#+TBLFM' lines right after the table, and +then press `C-c C-c' on the formula to apply. Here is an example: + + | x | y | + |---+---| + | 1 | | + | 2 | | + #+TBLFM: $2=$1*1 + #+TBLFM: $2=$1*2 + +Pressing `C-c C-c' in the line of `#+TBLFM: $2=$1*2' yields: + + | x | y | + |---+---| + | 1 | 2 | + | 2 | 4 | + #+TBLFM: $2=$1*1 + #+TBLFM: $2=$1*2 + +Note: If you recalculate this table (with `C-u C-c *', for example), you +will get the following result of applying only the first `#+TBLFM' line. + + | x | y | + |---+---| + | 1 | 1 | + | 2 | 2 | + #+TBLFM: $2=$1*1 + #+TBLFM: $2=$1*2 + +Debugging formulas +.................. + +When the evaluation of a formula leads to an error, the field content +becomes the string `#ERROR'. If you would like see what is going on +during variable substitution and calculation in order to find a bug, +turn on formula debugging in the `Tbl' menu and repeat the calculation, +for example by pressing `C-u C-u C-c = ' in a field. Detailed +information will be displayed. + + +File: org, Node: Updating the table, Next: Advanced features, Prev: Editing and debugging formulas, Up: The spreadsheet + +3.5.9 Updating the table +------------------------ + +Recalculation of a table is normally not automatic, but needs to be +triggered by a command. See *note Advanced features::, for a way to +make recalculation at least semi-automatic. + + In order to recalculate a line of a table or the entire table, use +the following commands: + +`C-c * (`org-table-recalculate')' + Recalculate the current row by first applying the stored column + formulas from left to right, and all field/range formulas in the + current row. + +`C-u C-c *' +`C-u C-c C-c' + Recompute the entire table, line by line. Any lines before the + first hline are left alone, assuming that these are part of the + table header. + +`C-u C-u C-c * or C-u C-u C-c C-c (`org-table-iterate')' + Iterate the table by recomputing it until no further changes occur. + This may be necessary if some computed fields use the value of + other fields that are computed later in the calculation sequence. + +`M-x org-table-recalculate-buffer-tables RET' + Recompute all tables in the current buffer. + +`M-x org-table-iterate-buffer-tables RET' + Iterate all tables in the current buffer, in order to converge + table-to-table dependencies. + + +File: org, Node: Advanced features, Prev: Updating the table, Up: The spreadsheet + +3.5.10 Advanced features +------------------------ + +If you want the recalculation of fields to happen automatically, or if +you want to be able to assign names(1) to fields and columns, you need +to reserve the first column of the table for special marking characters. + +`C-# (`org-table-rotate-recalc-marks')' + Rotate the calculation mark in first column through the states ` ', + `#', `*', `!', `$'. When there is an active region, change all + marks in the region. + + Here is an example of a table that collects exam results of students +and makes use of these features: + + |---+---------+--------+--------+--------+-------+------| + | | Student | Prob 1 | Prob 2 | Prob 3 | Total | Note | + |---+---------+--------+--------+--------+-------+------| + | ! | | P1 | P2 | P3 | Tot | | + | # | Maximum | 10 | 15 | 25 | 50 | 10.0 | + | ^ | | m1 | m2 | m3 | mt | | + |---+---------+--------+--------+--------+-------+------| + | # | Peter | 10 | 8 | 23 | 41 | 8.2 | + | # | Sam | 2 | 4 | 3 | 9 | 1.8 | + |---+---------+--------+--------+--------+-------+------| + | | Average | | | | 25.0 | | + | ^ | | | | | at | | + | $ | max=50 | | | | | | + |---+---------+--------+--------+--------+-------+------| + #+TBLFM: $6=vsum($P1..$P3)::$7=10*$Tot/$max;%.1f::$at=vmean(@-II..@-I);%.1f + +Important: please note that for these special tables, recalculating the +table with `C-u C-c *' will only affect rows that are marked `#' or +`*', and fields that have a formula assigned to the field itself. The +column formulas are not applied in rows with empty first field. + + The marking characters have the following meaning: + +`!' + The fields in this line define names for the columns, so that you + may refer to a column as `$Tot' instead of `$6'. + +`^' + This row defines names for the fields _above_ the row. With such + a definition, any formula in the table may use `$m1' to refer to + the value `10'. Also, if you assign a formula to a names field, it + will be stored as `$name=...'. + +`_' + Similar to `^', but defines names for the fields in the row + _below_. + +`$' + Fields in this row can define _parameters_ for formulas. For + example, if a field in a `$' row contains `max=50', then formulas + in this table can refer to the value 50 using `$max'. Parameters + work exactly like constants, only that they can be defined on a + per-table basis. + +`#' + Fields in this row are automatically recalculated when pressing + or or `S-' in this row. Also, this row is + selected for a global recalculation with `C-u C-c *'. Unmarked + lines will be left alone by this command. + +`*' + Selects this line for global recalculation with `C-u C-c *', but + not for automatic recalculation. Use this when automatic + recalculation slows down editing too much. + +` ' + Unmarked lines are exempt from recalculation with `C-u C-c *'. + All lines that should be recalculated should be marked with `#' or + `*'. + +`/' + Do not export this line. Useful for lines that contain the + narrowing `' markers or column group markers. + + Finally, just to whet your appetite for what can be done with the +fantastic `calc.el' package, here is a table that computes the Taylor +series of degree `n' at location `x' for a couple of functions. + + |---+-------------+---+-----+--------------------------------------| + | | Func | n | x | Result | + |---+-------------+---+-----+--------------------------------------| + | # | exp(x) | 1 | x | 1 + x | + | # | exp(x) | 2 | x | 1 + x + x^2 / 2 | + | # | exp(x) | 3 | x | 1 + x + x^2 / 2 + x^3 / 6 | + | # | x^2+sqrt(x) | 2 | x=0 | x*(0.5 / 0) + x^2 (2 - 0.25 / 0) / 2 | + | # | x^2+sqrt(x) | 2 | x=1 | 2 + 2.5 x - 2.5 + 0.875 (x - 1)^2 | + | * | tan(x) | 3 | x | 0.0175 x + 1.77e-6 x^3 | + |---+-------------+---+-----+--------------------------------------| + #+TBLFM: $5=taylor($2,$4,$3);n3 + + ---------- Footnotes ---------- + + (1) Such names must start by an alphabetic character and use only +alphanumeric/underscore characters. + + +File: org, Node: Org-Plot, Prev: The spreadsheet, Up: Tables + +3.6 Org-Plot +============ + +Org-Plot can produce 2D and 3D graphs of information stored in org +tables using `Gnuplot' `http://www.gnuplot.info/' and `gnuplot-mode' +`http://xafs.org/BruceRavel/GnuplotMode'. To see this in action, ensure +that you have both Gnuplot and Gnuplot mode installed on your system, +then call `org-plot/gnuplot' on the following table. + + #+PLOT: title:"Citas" ind:1 deps:(3) type:2d with:histograms set:"yrange [0:]" + | Sede | Max cites | H-index | + |-----------+-----------+---------| + | Chile | 257.72 | 21.39 | + | Leeds | 165.77 | 19.68 | + | Sao Paolo | 71.00 | 11.50 | + | Stockholm | 134.19 | 14.33 | + | Morelia | 257.56 | 17.67 | + + Notice that Org Plot is smart enough to apply the table's headers as +labels. Further control over the labels, type, content, and appearance +of plots can be exercised through the `#+PLOT:' lines preceding a +table. See below for a complete list of Org-plot options. For more +information and examples see the Org-plot tutorial at +`http://orgmode.org/worg/org-tutorials/org-plot.html'. + +Plot Options +............ + +`set' + Specify any `gnuplot' option to be set when graphing. + +`title' + Specify the title of the plot. + +`ind' + Specify which column of the table to use as the `x' axis. + +`deps' + Specify the columns to graph as a Lisp style list, surrounded by + parentheses and separated by spaces for example `dep:(3 4)' to + graph the third and fourth columns (defaults to graphing all other + columns aside from the `ind' column). + +`type' + Specify whether the plot will be `2d', `3d', or `grid'. + +`with' + Specify a `with' option to be inserted for every col being plotted + (e.g., `lines', `points', `boxes', `impulses', etc...). Defaults + to `lines'. + +`file' + If you want to plot to a file, specify + `"PATH/TO/DESIRED/OUTPUT-FILE"'. + +`labels' + List of labels to be used for the `deps' (defaults to the column + headers if they exist). + +`line' + Specify an entire line to be inserted in the Gnuplot script. + +`map' + When plotting `3d' or `grid' types, set this to `t' to graph a + flat mapping rather than a `3d' slope. + +`timefmt' + Specify format of Org mode timestamps as they will be parsed by + Gnuplot. Defaults to `%Y-%m-%d-%H:%M:%S'. + +`script' + If you want total control, you can specify a script file (place + the file name between double-quotes) which will be used to plot. + Before plotting, every instance of `$datafile' in the specified + script will be replaced with the path to the generated data file. + Note: even if you set this option, you may still want to specify + the plot type, as that can impact the content of the data file. + + +File: org, Node: Hyperlinks, Next: TODO Items, Prev: Tables, Up: Top + +4 Hyperlinks +************ + +Like HTML, Org provides links inside a file, external links to other +files, Usenet articles, emails, and much more. + +* Menu: + +* Link format:: How links in Org are formatted +* Internal links:: Links to other places in the current file +* External links:: URL-like links to the world +* Handling links:: Creating, inserting and following +* Using links outside Org:: Linking from my C source code? +* Link abbreviations:: Shortcuts for writing complex links +* Search options:: Linking to a specific location +* Custom searches:: When the default search is not enough + + +File: org, Node: Link format, Next: Internal links, Prev: Hyperlinks, Up: Hyperlinks + +4.1 Link format +=============== + +Org will recognize plain URL-like links and activate them as clickable +links. The general link format, however, looks like this: + + [[link][description]] or alternatively [[link]] + +Once a link in the buffer is complete (all brackets present), Org will +change the display so that `description' is displayed instead of +`[[link][description]]' and `link' is displayed instead of `[[link]]'. +Links will be highlighted in the face `org-link', which by default is +an underlined face. You can directly edit the visible part of a link. +Note that this can be either the `link' part (if there is no +description) or the `description' part. To edit also the invisible +`link' part, use `C-c C-l' with the cursor on the link. + + If you place the cursor at the beginning or just behind the end of +the displayed text and press , you will remove the +(invisible) bracket at that location. This makes the link incomplete +and the internals are again displayed as plain text. Inserting the +missing bracket hides the link internals again. To show the internal +structure of all links, use the menu entry `Org->Hyperlinks->Literal +links'. + + +File: org, Node: Internal links, Next: External links, Prev: Link format, Up: Hyperlinks + +4.2 Internal links +================== + +If the link does not look like a URL, it is considered to be internal +in the current file. The most important case is a link like +`[[#my-custom-id]]' which will link to the entry with the `CUSTOM_ID' +property `my-custom-id'. You are responsible yourself to make sure +these custom IDs are unique in a file. + + Links such as `[[My Target]]' or `[[My Target][Find my target]]' +lead to a text search in the current file. + + The link can be followed with `C-c C-o' when the cursor is on the +link, or with a mouse click (*note Handling links::). Links to custom +IDs will point to the corresponding headline. The preferred match for +a text link is a dedicated target: the same string in double angular +brackets, like `<>'. + + If no dedicated target exists, the link will then try to match the +exact name of an element within the buffer. Naming is done with the +`#+NAME' keyword, which has to be put the line before the element it +refers to, as in the following example + + #+NAME: My Target + | a | table | + |----+------------| + | of | four cells | + + If none of the above succeeds, Org will search for a headline that +is exactly the link text but may also include a TODO keyword and +tags(1). + + During export, internal links will be used to mark objects and +assign them a number. Marked objects will then be referenced by links +pointing to them. In particular, links without a description will +appear as the number assigned to the marked object(2). In the +following excerpt from an Org buffer + + - one item + - <>another item + Here we refer to item [[target]]. + +The last sentence will appear as `Here we refer to item 2' when +exported. + + In non-Org files, the search will look for the words in the link +text. In the above example the search would be for `my target'. + + Following a link pushes a mark onto Org's own mark ring. You can +return to the previous position with `C-c &'. Using this command +several times in direct succession goes back to positions recorded +earlier. + +* Menu: + +* Radio targets:: Make targets trigger links in plain text + + ---------- Footnotes ---------- + + (1) To insert a link targeting a headline, in-buffer completion can +be used. Just type a star followed by a few optional letters into the +buffer and press `M-'. All headlines in the current buffer will +be offered as completions. + + (2) When targeting a `#+NAME' keyword, `#+CAPTION' keyword is +mandatory in order to get proper numbering (*note Images and tables::). + + +File: org, Node: Radio targets, Prev: Internal links, Up: Internal links + +4.2.1 Radio targets +------------------- + +Org can automatically turn any occurrences of certain target names in +normal text into a link. So without explicitly creating a link, the +text connects to the target radioing its position. Radio targets are +enclosed by triple angular brackets. For example, a target `<<>>' causes each occurrence of `my target' in normal text to +become activated as a link. The Org file is scanned automatically for +radio targets only when the file is first loaded into Emacs. To update +the target list during editing, press `C-c C-c' with the cursor on or +at a target. + + +File: org, Node: External links, Next: Handling links, Prev: Internal links, Up: Hyperlinks + +4.3 External links +================== + +Org supports links to files, websites, Usenet and email messages, BBDB +database entries and links to both IRC conversations and their logs. +External links are URL-like locators. They start with a short +identifying string followed by a colon. There can be no space after +the colon. The following list shows examples for each link type. + + http://www.astro.uva.nl/~dominik on the web + doi:10.1000/182 DOI for an electronic resource + file:/home/dominik/images/jupiter.jpg file, absolute path + /home/dominik/images/jupiter.jpg same as above + file:papers/last.pdf file, relative path + ./papers/last.pdf same as above + file:/myself@some.where:papers/last.pdf file, path on remote machine + /myself@some.where:papers/last.pdf same as above + file:sometextfile::NNN file, jump to line number + file:projects.org another Org file + file:projects.org::some words text search in Org file(1) + file:projects.org::*task title heading search in Org file + file+sys:/path/to/file open via OS, like double-click + file+emacs:/path/to/file force opening by Emacs + docview:papers/last.pdf::NNN open in doc-view mode at page + id:B7423F4D-2E8A-471B-8810-C40F074717E9 Link to heading by ID + news:comp.emacs Usenet link + mailto:adent@galaxy.net Mail link + mhe:folder MH-E folder link + mhe:folder#id MH-E message link + rmail:folder RMAIL folder link + rmail:folder#id RMAIL message link + gnus:group Gnus group link + gnus:group#id Gnus article link + bbdb:R.*Stallman BBDB link (with regexp) + irc:/irc.com/#emacs/bob IRC link + info:org#External links Info node link + shell:ls *.org A shell command + elisp:org-agenda Interactive Elisp command + elisp:(find-file-other-frame "Elisp.org") Elisp form to evaluate + + On top of these built-in link types, some are available through the +`contrib/' directory (*note Installation::). For example, these links +to VM or Wanderlust messages are available when you load the +corresponding libraries from the `contrib/' directory: + + vm:folder VM folder link + vm:folder#id VM message link + vm://myself@some.where.org/folder#id VM on remote machine + vm-imap:account:folder VM IMAP folder link + vm-imap:account:folder#id VM IMAP message link + wl:folder WANDERLUST folder link + wl:folder#id WANDERLUST message link + + For customizing Org to add new link types *note Adding hyperlink +types::. + + A link should be enclosed in double brackets and may contain a +descriptive text to be displayed instead of the URL (*note Link +format::), for example: + + [[http://www.gnu.org/software/emacs/][GNU Emacs]] + +If the description is a file name or URL that points to an image, HTML +export (*note HTML export::) will inline the image as a clickable +button. If there is no description at all and the link points to an +image, that image will be inlined into the exported HTML file. + + Org also finds external links in the normal text and activates them +as links. If spaces must be part of the link (for example in +`bbdb:Richard Stallman'), or if you need to remove ambiguities about +the end of the link, enclose them in square brackets. + + ---------- Footnotes ---------- + + (1) The actual behavior of the search will depend on the value of +the option `org-link-search-must-match-exact-headline'. If its value +is `nil', then a fuzzy text search will be done. If it is t, then only +the exact headline will be matched. If the value is `'query-to-create', +then an exact headline will be searched; if it is not found, then the +user will be queried to create it. + + +File: org, Node: Handling links, Next: Using links outside Org, Prev: External links, Up: Hyperlinks + +4.4 Handling links +================== + +Org provides methods to create a link in the correct syntax, to insert +it into an Org file, and to follow the link. + +`C-c l (`org-store-link')' + Store a link to the current location. This is a _global_ command + (you must create the key binding yourself) which can be used in + any buffer to create a link. The link will be stored for later + insertion into an Org buffer (see below). What kind of link will + be created depends on the current buffer: + + Org mode buffers + For Org files, if there is a `<>' at the cursor, the link + points to the target. Otherwise it points to the current + headline, which will also be the description(1). + + If the headline has a `CUSTOM_ID' property, a link to this custom + ID will be stored. In addition or alternatively (depending on the + value of `org-id-link-to-org-use-id'), a globally unique `ID' + property will be created and/or used to construct a link(2). So + using this command in Org buffers will potentially create two + links: a human-readable from the custom ID, and one that is + globally unique and works even if the entry is moved from file to + file. Later, when inserting the link, you need to decide which + one to use. + + Email/News clients: VM, Rmail, Wanderlust, MH-E, Gnus + Pretty much all Emacs mail clients are supported. The link will + point to the current article, or, in some GNUS buffers, to the + group. The description is constructed from the author and the + subject. + + Web browsers: W3 and W3M + Here the link will be the current URL, with the page title as + description. + + Contacts: BBDB + Links created in a BBDB buffer will point to the current entry. + + Chat: IRC + For IRC links, if you set the option `org-irc-link-to-logs' to `t', + a `file:/' style link to the relevant point in the logs for the + current conversation is created. Otherwise an `irc:/' style link + to the user/channel/server under the point will be stored. + + Other files + For any other files, the link will point to the file, with a + search string (*note Search options::) pointing to the contents of + the current line. If there is an active region, the selected + words will form the basis of the search string. If the + automatically created link is not working correctly or accurately + enough, you can write custom functions to select the search string + and to do the search for particular file types--see *note Custom + searches::. The key binding `C-c l' is only a suggestion--see + *note Installation::. + + Agenda view + When the cursor is in an agenda view, the created link points to + the entry referenced by the current line. + +`C-c C-l (`org-insert-link')' + Insert a link(3). This prompts for a link to be inserted into the + buffer. You can just type a link, using text for an internal + link, or one of the link type prefixes mentioned in the examples + above. The link will be inserted into the buffer(4), along with a + descriptive text. If some text was selected when this command is + called, the selected text becomes the default description. + + Inserting stored links + All links stored during the current session are part of the + history for this prompt, so you can access them with and + (or `M-p/n'). + + Completion support + Completion with will help you to insert valid link prefixes + like `http:' or `ftp:', including the prefixes defined through + link abbreviations (*note Link abbreviations::). If you press + after inserting only the PREFIX, Org will offer specific + completion support for some link types(5) For example, if you + type `file ', file name completion (alternative access: `C-u + C-c C-l', see below) will be offered, and after `bbdb ' you + can complete contact names. + +`C-u C-c C-l' + When `C-c C-l' is called with a `C-u' prefix argument, a link to a + file will be inserted and you may use file name completion to + select the name of the file. The path to the file is inserted + relative to the directory of the current Org file, if the linked + file is in the current directory or in a sub-directory of it, or + if the path is written relative to the current directory using + `../'. Otherwise an absolute path is used, if possible with `~/' + for your home directory. You can force an absolute path with two + `C-u' prefixes. + +`C-c C-l (with cursor on existing link)' + When the cursor is on an existing link, `C-c C-l' allows you to + edit the link and description parts of the link. + +`C-c C-o (`org-open-at-point')' + Open link at point. This will launch a web browser for URLs (using + `browse-url-at-point'), run VM/MH-E/Wanderlust/Rmail/Gnus/BBDB for + the corresponding links, and execute the command in a shell link. + When the cursor is on an internal link, this command runs the + corresponding search. When the cursor is on a TAG list in a + headline, it creates the corresponding TAGS view. If the cursor + is on a timestamp, it compiles the agenda for that date. + Furthermore, it will visit text and remote files in `file:' links + with Emacs and select a suitable application for local non-text + files. Classification of files is based on file extension only. + See option `org-file-apps'. If you want to override the default + application and visit the file with Emacs, use a `C-u' prefix. If + you want to avoid opening in Emacs, use a `C-u C-u' prefix. + If the cursor is on a headline, but not on a link, offer all links + in the headline and entry text. If you want to setup the frame + configuration for following links, customize + `org-link-frame-setup'. + +`' + When `org-return-follows-link' is set, `' will also follow + the link at point. + +`mouse-2' +`mouse-1' + On links, `mouse-2' will open the link just as `C-c C-o' would. + Under Emacs 22 and later, `mouse-1' will also follow a link. + +`mouse-3' + Like `mouse-2', but force file links to be opened with Emacs, and + internal links to be displayed in another window(6). + +`C-c C-x C-v (`org-toggle-inline-images')' + Toggle the inline display of linked images. Normally this will + only inline images that have no description part in the link, + i.e., images that will also be inlined during export. When called + with a prefix argument, also display images that do have a link + description. You can ask for inline images to be displayed at + startup by configuring the variable + `org-startup-with-inline-images'(7). + +`C-c % (`org-mark-ring-push')' + Push the current position onto the mark ring, to be able to return + easily. Commands following an internal link do this automatically. + +`C-c & (`org-mark-ring-goto')' + Jump back to a recorded position. A position is recorded by the + commands following internal links, and by `C-c %'. Using this + command several times in direct succession moves through a ring of + previously recorded positions. + +`C-c C-x C-n (`org-next-link')' +`C-c C-x C-p (`org-previous-link')' + Move forward/backward to the next link in the buffer. At the + limit of the buffer, the search fails once, and then wraps around. + The key bindings for this are really too long; you might want to + bind this also to `C-n' and `C-p' + (add-hook 'org-load-hook + (lambda () + (define-key org-mode-map "\C-n" 'org-next-link) + (define-key org-mode-map "\C-p" 'org-previous-link))) + + ---------- Footnotes ---------- + + (1) If the headline contains a timestamp, it will be removed from +the link and result in a wrong link--you should avoid putting timestamp +in the headline. + + (2) The library `org-id.el' must first be loaded, either through +`org-customize' by enabling `org-id' in `org-modules', or by adding +`(require 'org-id)' in your `.emacs'. + + (3) Note that you don't have to use this command to insert a link. +Links in Org are plain text, and you can type or paste them straight +into the buffer. By using this command, the links are automatically +enclosed in double brackets, and you will be asked for the optional +descriptive text. + + (4) After insertion of a stored link, the link will be removed from +the list of stored links. To keep it in the list later use, use a +triple `C-u' prefix argument to `C-c C-l', or configure the option +`org-keep-stored-link-after-insertion'. + + (5) This works by calling a special function +`org-PREFIX-complete-link'. + + (6) See the option `org-display-internal-link-with-indirect-buffer' + + (7) with corresponding `#+STARTUP' keywords `inlineimages' and +`noinlineimages' + + +File: org, Node: Using links outside Org, Next: Link abbreviations, Prev: Handling links, Up: Hyperlinks + +4.5 Using links outside Org +=========================== + +You can insert and follow links that have Org syntax not only in Org, +but in any Emacs buffer. For this, you should create two global +commands, like this (please select suitable global keys yourself): + + (global-set-key "\C-c L" 'org-insert-link-global) + (global-set-key "\C-c o" 'org-open-at-point-global) + + +File: org, Node: Link abbreviations, Next: Search options, Prev: Using links outside Org, Up: Hyperlinks + +4.6 Link abbreviations +====================== + +Long URLs can be cumbersome to type, and often many similar links are +needed in a document. For this you can use link abbreviations. An +abbreviated link looks like this + + [[linkword:tag][description]] + +where the tag is optional. The linkword must be a word, starting with +a letter, followed by letters, numbers, `-', and `_'. Abbreviations +are resolved according to the information in the variable +`org-link-abbrev-alist' that relates the linkwords to replacement text. +Here is an example: + + (setq org-link-abbrev-alist + '(("bugzilla" . "http://10.1.2.9/bugzilla/show_bug.cgi?id=") + ("url-to-ja" . "http://translate.google.fr/translate?sl=en&tl=ja&u=%h") + ("google" . "http://www.google.com/search?q=") + ("gmap" . "http://maps.google.com/maps?q=%s") + ("omap" . "http://nominatim.openstreetmap.org/search?q=%s&polygon=1") + ("ads" . "http://adsabs.harvard.edu/cgi-bin/nph-abs_connect?author=%s&db_key=AST"))) + + If the replacement text contains the string `%s', it will be +replaced with the tag. Using `%h' instead of `%s' will url-encode the +tag (see the example above, where we need to encode the URL parameter.) +Using `%(my-function)' will pass the tag to a custom function, and +replace it by the resulting string. + + If the replacement text don't contain any specifier, it will simply +be appended to the string in order to create the link. + + Instead of a string, you may also specify a function that will be +called with the tag as the only argument to create the link. + + With the above setting, you could link to a specific bug with +`[[bugzilla:129]]', search the web for `OrgMode' with +`[[google:OrgMode]]', show the map location of the Free Software +Foundation `[[gmap:51 Franklin Street, Boston]]' or of Carsten office +`[[omap:Science Park 904, Amsterdam, The Netherlands]]' and find out +what the Org author is doing besides Emacs hacking with +`[[ads:Dominik,C]]'. + + If you need special abbreviations just for a single Org buffer, you +can define them in the file with + + #+LINK: bugzilla http://10.1.2.9/bugzilla/show_bug.cgi?id= + #+LINK: google http://www.google.com/search?q=%s + +In-buffer completion (*note Completion::) can be used after `[' to +complete link abbreviations. You may also define a function +`org-PREFIX-complete-link' that implements special (e.g., completion) +support for inserting such a link with `C-c C-l'. Such a function +should not accept any arguments, and return the full link with prefix. + + +File: org, Node: Search options, Next: Custom searches, Prev: Link abbreviations, Up: Hyperlinks + +4.7 Search options in file links +================================ + +File links can contain additional information to make Emacs jump to a +particular location in the file when following a link. This can be a +line number or a search option after a double(1) colon. For example, +when the command `C-c l' creates a link (*note Handling links::) to a +file, it encodes the words in the current line as a search string that +can be used to find this line back later when following the link with +`C-c C-o'. + + Here is the syntax of the different ways to attach a search to a file +link, together with an explanation: + + [[file:~/code/main.c::255]] + [[file:~/xx.org::My Target]] + [[file:~/xx.org::*My Target]] + [[file:~/xx.org::#my-custom-id]] + [[file:~/xx.org::/regexp/]] + +`255' + Jump to line 255. + +`My Target' + Search for a link target `<>', or do a text search for + `my target', similar to the search in internal links, see *note + Internal links::. In HTML export (*note HTML export::), such a + file link will become an HTML reference to the corresponding named + anchor in the linked file. + +`*My Target' + In an Org file, restrict search to headlines. + +`#my-custom-id' + Link to a heading with a `CUSTOM_ID' property + +`/regexp/' + Do a regular expression search for `regexp'. This uses the Emacs + command `occur' to list all matches in a separate window. If the + target file is in Org mode, `org-occur' is used to create a sparse + tree with the matches. + + As a degenerate case, a file link with an empty file name can be used +to search the current file. For example, `[[file:::find me]]' does a +search for `find me' in the current file, just as `[[find me]]' would. + + ---------- Footnotes ---------- + + (1) For backward compatibility, line numbers can also follow a +single colon. + + +File: org, Node: Custom searches, Prev: Search options, Up: Hyperlinks + +4.8 Custom Searches +=================== + +The default mechanism for creating search strings and for doing the +actual search related to a file link may not work correctly in all +cases. For example, BibTeX database files have many entries like +`year="1993"' which would not result in good search strings, because +the only unique identification for a BibTeX entry is the citation key. + + If you come across such a problem, you can write custom functions to +set the right search string for a particular file type, and to do the +search for the string in the file. Using `add-hook', these functions +need to be added to the hook variables +`org-create-file-search-functions' and +`org-execute-file-search-functions'. See the docstring for these +variables for more information. Org actually uses this mechanism for +BibTeX database files, and you can use the corresponding code as an +implementation example. See the file `org-bibtex.el'. + + +File: org, Node: TODO Items, Next: Tags, Prev: Hyperlinks, Up: Top + +5 TODO items +************ + +Org mode does not maintain TODO lists as separate documents(1). +Instead, TODO items are an integral part of the notes file, because +TODO items usually come up while taking notes! With Org mode, simply +mark any entry in a tree as being a TODO item. In this way, +information is not duplicated, and the entire context from which the +TODO item emerged is always present. + + Of course, this technique for managing TODO items scatters them +throughout your notes file. Org mode compensates for this by providing +methods to give you an overview of all the things that you have to do. + +* Menu: + +* TODO basics:: Marking and displaying TODO entries +* TODO extensions:: Workflow and assignments +* Progress logging:: Dates and notes for progress +* Priorities:: Some things are more important than others +* Breaking down tasks:: Splitting a task into manageable pieces +* Checkboxes:: Tick-off lists + + ---------- Footnotes ---------- + + (1) Of course, you can make a document that contains only long lists +of TODO items, but this is not required. + + +File: org, Node: TODO basics, Next: TODO extensions, Prev: TODO Items, Up: TODO Items + +5.1 Basic TODO functionality +============================ + +Any headline becomes a TODO item when it starts with the word `TODO', +for example: + + *** TODO Write letter to Sam Fortune + +The most important commands to work with TODO entries are: + +`C-c C-t (`org-todo')' + Rotate the TODO state of the current item among + + ,-> (unmarked) -> TODO -> DONE --. + '--------------------------------' + + If TODO keywords have fast access keys (see *note Fast access to + TODO states::), you will be prompted for a TODO keyword through + the fast selection interface; this is the default behavior when + `org-use-fast-todo-selection' is non-`nil'. + + The same rotation can also be done "remotely" from the timeline + and agenda buffers with the `t' command key (*note Agenda + commands::). + +`C-u C-c C-t' + When TODO keywords have no selection keys, select a specific + keyword using completion; otherwise force cycling through TODO + states with no prompt. When `org-use-fast-todo-selection' is set + to `prefix', use the fast selection interface. + +`S- / S-' + Select the following/preceding TODO state, similar to cycling. + Useful mostly if more than two TODO states are possible (*note + TODO extensions::). See also *note Conflicts::, for a discussion + of the interaction with `shift-selection-mode'. See also the + variable `org-treat-S-cursor-todo-selection-as-state-change'. + +`C-c / t (`org-show-todo-tree')' + View TODO items in a _sparse tree_ (*note Sparse trees::). Folds + the entire buffer, but shows all TODO items (with not-DONE state) + and the headings hierarchy above them. With a prefix argument (or + by using `C-c / T'), search for a specific TODO. You will be + prompted for the keyword, and you can also give a list of keywords + like `KWD1|KWD2|...' to list entries that match any one of these + keywords. With a numeric prefix argument N, show the tree for the + Nth keyword in the option `org-todo-keywords'. With two prefix + arguments, find all TODO states, both un-done and done. + +`C-c a t (`org-todo-list')' + Show the global TODO list. Collects the TODO items (with not-DONE + states) from all agenda files (*note Agenda Views::) into a single + buffer. The new buffer will be in `agenda-mode', which provides + commands to examine and manipulate the TODO entries from the new + buffer (*note Agenda commands::). *Note Global TODO list::, for + more information. + +`S-M- (`org-insert-todo-heading')' + Insert a new TODO entry below the current one. + +Changing a TODO state can also trigger tag changes. See the docstring +of the option `org-todo-state-tags-triggers' for details. + + +File: org, Node: TODO extensions, Next: Progress logging, Prev: TODO basics, Up: TODO Items + +5.2 Extended use of TODO keywords +================================= + +By default, marked TODO entries have one of only two states: TODO and +DONE. Org mode allows you to classify TODO items in more complex ways +with _TODO keywords_ (stored in `org-todo-keywords'). With special +setup, the TODO keyword system can work differently in different files. + + Note that tags are another way to classify headlines in general and +TODO items in particular (*note Tags::). + +* Menu: + +* Workflow states:: From TODO to DONE in steps +* TODO types:: I do this, Fred does the rest +* Multiple sets in one file:: Mixing it all, and still finding your way +* Fast access to TODO states:: Single letter selection of a state +* Per-file keywords:: Different files, different requirements +* Faces for TODO keywords:: Highlighting states +* TODO dependencies:: When one task needs to wait for others + + +File: org, Node: Workflow states, Next: TODO types, Prev: TODO extensions, Up: TODO extensions + +5.2.1 TODO keywords as workflow states +-------------------------------------- + +You can use TODO keywords to indicate different _sequential_ states in +the process of working on an item, for example(1): + + (setq org-todo-keywords + '((sequence "TODO" "FEEDBACK" "VERIFY" "|" "DONE" "DELEGATED"))) + + The vertical bar separates the TODO keywords (states that _need +action_) from the DONE states (which need _no further action_). If you +don't provide the separator bar, the last state is used as the DONE +state. With this setup, the command `C-c C-t' will cycle an entry from +TODO to FEEDBACK, then to VERIFY, and finally to DONE and DELEGATED. +You may also use a numeric prefix argument to quickly select a specific +state. For example `C-3 C-c C-t' will change the state immediately to +VERIFY. Or you can use `S-' to go backward through the sequence. +If you define many keywords, you can use in-buffer completion (*note +Completion::) or even a special one-key selection scheme (*note Fast +access to TODO states::) to insert these words into the buffer. +Changing a TODO state can be logged with a timestamp, see *note +Tracking TODO state changes::, for more information. + + ---------- Footnotes ---------- + + (1) Changing this variable only becomes effective after restarting +Org mode in a buffer. + + +File: org, Node: TODO types, Next: Multiple sets in one file, Prev: Workflow states, Up: TODO extensions + +5.2.2 TODO keywords as types +---------------------------- + +The second possibility is to use TODO keywords to indicate different +_types_ of action items. For example, you might want to indicate that +items are for "work" or "home". Or, when you work with several people +on a single project, you might want to assign action items directly to +persons, by using their names as TODO keywords. This would be set up +like this: + + (setq org-todo-keywords '((type "Fred" "Sara" "Lucy" "|" "DONE"))) + + In this case, different keywords do not indicate a sequence, but +rather different types. So the normal work flow would be to assign a +task to a person, and later to mark it DONE. Org mode supports this +style by adapting the workings of the command `C-c C-t'(1). When used +several times in succession, it will still cycle through all names, in +order to first select the right type for a task. But when you return +to the item after some time and execute `C-c C-t' again, it will switch +from any name directly to DONE. Use prefix arguments or completion to +quickly select a specific name. You can also review the items of a +specific TODO type in a sparse tree by using a numeric prefix to `C-c / +t'. For example, to see all things Lucy has to do, you would use `C-3 +C-c / t'. To collect Lucy's items from all agenda files into a single +buffer, you would use the numeric prefix argument as well when creating +the global TODO list: `C-3 C-c a t'. + + ---------- Footnotes ---------- + + (1) This is also true for the `t' command in the timeline and agenda +buffers. + + +File: org, Node: Multiple sets in one file, Next: Fast access to TODO states, Prev: TODO types, Up: TODO extensions + +5.2.3 Multiple keyword sets in one file +--------------------------------------- + +Sometimes you may want to use different sets of TODO keywords in +parallel. For example, you may want to have the basic `TODO'/`DONE', +but also a workflow for bug fixing, and a separate state indicating +that an item has been canceled (so it is not DONE, but also does not +require action). Your setup would then look like this: + + (setq org-todo-keywords + '((sequence "TODO" "|" "DONE") + (sequence "REPORT" "BUG" "KNOWNCAUSE" "|" "FIXED") + (sequence "|" "CANCELED"))) + + The keywords should all be different, this helps Org mode to keep +track of which subsequence should be used for a given entry. In this +setup, `C-c C-t' only operates within a subsequence, so it switches from +`DONE' to (nothing) to `TODO', and from `FIXED' to (nothing) to +`REPORT'. Therefore you need a mechanism to initially select the +correct sequence. Besides the obvious ways like typing a keyword or +using completion, you may also apply the following commands: + +`C-u C-u C-c C-t' +`C-S-' +`C-S-' + These keys jump from one TODO subset to the next. In the above + example, `C-u C-u C-c C-t' or `C-S-' would jump from `TODO' + or `DONE' to `REPORT', and any of the words in the second row to + `CANCELED'. Note that the `C-S-' key binding conflict with + `shift-selection-mode' (*note Conflicts::). + +`S-' +`S-' + `S-<>' and `S-<>' and walk through _all_ keywords + from all sets, so for example `S-<>' would switch from + `DONE' to `REPORT' in the example above. See also *note + Conflicts::, for a discussion of the interaction with + `shift-selection-mode'. + + +File: org, Node: Fast access to TODO states, Next: Per-file keywords, Prev: Multiple sets in one file, Up: TODO extensions + +5.2.4 Fast access to TODO states +-------------------------------- + +If you would like to quickly change an entry to an arbitrary TODO state +instead of cycling through the states, you can set up keys for +single-letter access to the states. This is done by adding the +selection character after each keyword, in parentheses(1). For example: + + (setq org-todo-keywords + '((sequence "TODO(t)" "|" "DONE(d)") + (sequence "REPORT(r)" "BUG(b)" "KNOWNCAUSE(k)" "|" "FIXED(f)") + (sequence "|" "CANCELED(c)"))) + + If you then press `C-c C-t' followed by the selection key, the entry +will be switched to this state. `SPC' can be used to remove any TODO +keyword from an entry.(2) + + ---------- Footnotes ---------- + + (1) All characters are allowed except `@^!', which have a special +meaning here. + + (2) Check also the option `org-fast-tag-selection-include-todo', it +allows you to change the TODO state through the tags interface (*note +Setting tags::), in case you like to mingle the two concepts. Note +that this means you need to come up with unique keys across both sets +of keywords. + + +File: org, Node: Per-file keywords, Next: Faces for TODO keywords, Prev: Fast access to TODO states, Up: TODO extensions + +5.2.5 Setting up keywords for individual files +---------------------------------------------- + +It can be very useful to use different aspects of the TODO mechanism in +different files. For file-local settings, you need to add special lines +to the file which set the keywords and interpretation for that file +only. For example, to set one of the two examples discussed above, you +need one of the following lines, starting in column zero anywhere in the +file: + + #+TODO: TODO FEEDBACK VERIFY | DONE CANCELED + (you may also write `#+SEQ_TODO' to be explicit about the +interpretation, but it means the same as `#+TODO'), or + #+TYP_TODO: Fred Sara Lucy Mike | DONE + + A setup for using several sets in parallel would be: + + #+TODO: TODO | DONE + #+TODO: REPORT BUG KNOWNCAUSE | FIXED + #+TODO: | CANCELED + +To make sure you are using the correct keyword, type `#+' into the +buffer and then use `M-' completion. + + Remember that the keywords after the vertical bar (or the last +keyword if no bar is there) must always mean that the item is DONE +(although you may use a different word). After changing one of these +lines, use `C-c C-c' with the cursor still in the line to make the +changes known to Org mode(1). + + ---------- Footnotes ---------- + + (1) Org mode parses these lines only when Org mode is activated +after visiting a file. `C-c C-c' with the cursor in a line starting +with `#+' is simply restarting Org mode for the current buffer. + + +File: org, Node: Faces for TODO keywords, Next: TODO dependencies, Prev: Per-file keywords, Up: TODO extensions + +5.2.6 Faces for TODO keywords +----------------------------- + +Org mode highlights TODO keywords with special faces: `org-todo' for +keywords indicating that an item still has to be acted upon, and +`org-done' for keywords indicating that an item is finished. If you +are using more than 2 different states, you might want to use special +faces for some of them. This can be done using the option +`org-todo-keyword-faces'. For example: + + (setq org-todo-keyword-faces + '(("TODO" . org-warning) ("STARTED" . "yellow") + ("CANCELED" . (:foreground "blue" :weight bold)))) + + While using a list with face properties as shown for CANCELED +_should_ work, this does not always seem to be the case. If necessary, +define a special face and use that. A string is interpreted as a +color. The option `org-faces-easy-properties' determines if that color +is interpreted as a foreground or a background color. + + +File: org, Node: TODO dependencies, Prev: Faces for TODO keywords, Up: TODO extensions + +5.2.7 TODO dependencies +----------------------- + +The structure of Org files (hierarchy and lists) makes it easy to +define TODO dependencies. Usually, a parent TODO task should not be +marked DONE until all subtasks (defined as children tasks) are marked +as DONE. And sometimes there is a logical sequence to a number of +(sub)tasks, so that one task cannot be acted upon before all siblings +above it are done. If you customize the option +`org-enforce-todo-dependencies', Org will block entries from changing +state to DONE while they have children that are not DONE. Furthermore, +if an entry has a property `ORDERED', each of its children will be +blocked until all earlier siblings are marked DONE. Here is an example: + + * TODO Blocked until (two) is done + ** DONE one + ** TODO two + + * Parent + :PROPERTIES: + :ORDERED: t + :END: + ** TODO a + ** TODO b, needs to wait for (a) + ** TODO c, needs to wait for (a) and (b) + +`C-c C-x o (`org-toggle-ordered-property')' + Toggle the `ORDERED' property of the current entry. A property is + used for this behavior because this should be local to the current + entry, not inherited like a tag. However, if you would like to + track the value of this property with a tag for better visibility, + customize the option `org-track-ordered-property-with-tag'. + +`C-u C-u C-u C-c C-t' + Change TODO state, circumventing any state blocking. + + If you set the option `org-agenda-dim-blocked-tasks', TODO entries +that cannot be closed because of such dependencies will be shown in a +dimmed font or even made invisible in agenda views (*note Agenda +Views::). + + You can also block changes of TODO states by looking at checkboxes +(*note Checkboxes::). If you set the option +`org-enforce-todo-checkbox-dependencies', an entry that has unchecked +checkboxes will be blocked from switching to DONE. + + If you need more complex dependency structures, for example +dependencies between entries in different trees or files, check out the +contributed module `org-depend.el'. + + +File: org, Node: Progress logging, Next: Priorities, Prev: TODO extensions, Up: TODO Items + +5.3 Progress logging +==================== + +Org mode can automatically record a timestamp and possibly a note when +you mark a TODO item as DONE, or even each time you change the state of +a TODO item. This system is highly configurable; settings can be on a +per-keyword basis and can be localized to a file or even a subtree. For +information on how to clock working time for a task, see *note Clocking +work time::. + +* Menu: + +* Closing items:: When was this entry marked DONE? +* Tracking TODO state changes:: When did the status change? +* Tracking your habits:: How consistent have you been? + + +File: org, Node: Closing items, Next: Tracking TODO state changes, Prev: Progress logging, Up: Progress logging + +5.3.1 Closing items +------------------- + +The most basic logging is to keep track of _when_ a certain TODO item +was finished. This is achieved with(1) + + (setq org-log-done 'time) + +Then each time you turn an entry from a TODO (not-done) state into any +of the DONE states, a line `CLOSED: [timestamp]' will be inserted just +after the headline. If you turn the entry back into a TODO item +through further state cycling, that line will be removed again. If you +turn the entry back to a non-TODO state (by pressing for +example), that line will also be removed, unless you set +`org-closed-keep-when-no-todo' to non-`nil'. If you want to record a +note along with the timestamp, use(2) + + (setq org-log-done 'note) + +You will then be prompted for a note, and that note will be stored below +the entry with a `Closing Note' heading. + + In the timeline (*note Timeline::) and in the agenda (*note +Weekly/daily agenda::), you can then use the `l' key to display the +TODO items with a `CLOSED' timestamp on each day, giving you an +overview of what has been done. + + ---------- Footnotes ---------- + + (1) The corresponding in-buffer setting is: `#+STARTUP: logdone' + + (2) The corresponding in-buffer setting is: `#+STARTUP: lognotedone'. + + +File: org, Node: Tracking TODO state changes, Next: Tracking your habits, Prev: Closing items, Up: Progress logging + +5.3.2 Tracking TODO state changes +--------------------------------- + +When TODO keywords are used as workflow states (*note Workflow +states::), you might want to keep track of when a state change occurred +and maybe take a note about this change. You can either record just a +timestamp, or a time-stamped note for a change. These records will be +inserted after the headline as an itemized list, newest first(1). When +taking a lot of notes, you might want to get the notes out of the way +into a drawer (*note Drawers::). Customize `org-log-into-drawer' to +get this behavior--the recommended drawer for this is called +`LOGBOOK'(2). You can also overrule the setting of this variable for a +subtree by setting a `LOG_INTO_DRAWER' property. + + Since it is normally too much to record a note for every state, Org +mode expects configuration on a per-keyword basis for this. This is +achieved by adding special markers `!' (for a timestamp) or `@' (for a +note with timestamp) in parentheses after each keyword. For example, +with the setting + + (setq org-todo-keywords + '((sequence "TODO(t)" "WAIT(w@/!)" "|" "DONE(d!)" "CANCELED(c@)"))) + + To record a timestamp without a note for TODO keywords configured +with `@', just type `C-c C-c' to enter a blank note when prompted. + +You not only define global TODO keywords and fast access keys, but also +request that a time is recorded when the entry is set to DONE(3), and +that a note is recorded when switching to WAIT or CANCELED. The +setting for WAIT is even more special: the `!' after the slash means +that in addition to the note taken when entering the state, a timestamp +should be recorded when leaving the WAIT state, if and only if the +target state does not configure logging for entering it. So it has no +effect when switching from WAIT to DONE, because DONE is configured to +record a timestamp only. But when switching from WAIT back to TODO, +the `/!' in the WAIT setting now triggers a timestamp even though TODO +has no logging configured. + + You can use the exact same syntax for setting logging preferences +local to a buffer: + #+TODO: TODO(t) WAIT(w@/!) | DONE(d!) CANCELED(c@) + + In order to define logging settings that are local to a subtree or a +single item, define a LOGGING property in this entry. Any non-empty +LOGGING property resets all logging settings to `nil'. You may then +turn on logging for this specific tree using STARTUP keywords like +`lognotedone' or `logrepeat', as well as adding state specific settings +like `TODO(!)'. For example + + * TODO Log each state with only a time + :PROPERTIES: + :LOGGING: TODO(!) WAIT(!) DONE(!) CANCELED(!) + :END: + * TODO Only log when switching to WAIT, and when repeating + :PROPERTIES: + :LOGGING: WAIT(@) logrepeat + :END: + * TODO No logging at all + :PROPERTIES: + :LOGGING: nil + :END: + + ---------- Footnotes ---------- + + (1) See the option `org-log-states-order-reversed' + + (2) Note that the `LOGBOOK' drawer is unfolded when pressing +in the agenda to show an entry--use to keep it folded here + + (3) It is possible that Org mode will record two timestamps when you +are using both `org-log-done' and state change logging. However, it +will never prompt for two notes--if you have configured both, the state +change recording note will take precedence and cancel the `Closing +Note'. + + +File: org, Node: Tracking your habits, Prev: Tracking TODO state changes, Up: Progress logging + +5.3.3 Tracking your habits +-------------------------- + +Org has the ability to track the consistency of a special category of +TODOs, called "habits". A habit has the following properties: + + 1. You have enabled the `habits' module by customizing `org-modules'. + + 2. The habit is a TODO item, with a TODO keyword representing an open + state. + + 3. The property `STYLE' is set to the value `habit'. + + 4. The TODO has a scheduled date, usually with a `.+' style repeat + interval. A `++' style may be appropriate for habits with time + constraints, e.g., must be done on weekends, or a `+' style for an + unusual habit that can have a backlog, e.g., weekly reports. + + 5. The TODO may also have minimum and maximum ranges specified by + using the syntax `.+2d/3d', which says that you want to do the + task at least every three days, but at most every two days. + + 6. You must also have state logging for the `DONE' state enabled + (*note Tracking TODO state changes::), in order for historical + data to be represented in the consistency graph. If it is not + enabled it is not an error, but the consistency graphs will be + largely meaningless. + + To give you an idea of what the above rules look like in action, +here's an actual habit with some history: + + ** TODO Shave + SCHEDULED: <2009-10-17 Sat .+2d/4d> + - State "DONE" from "TODO" [2009-10-15 Thu] + - State "DONE" from "TODO" [2009-10-12 Mon] + - State "DONE" from "TODO" [2009-10-10 Sat] + - State "DONE" from "TODO" [2009-10-04 Sun] + - State "DONE" from "TODO" [2009-10-02 Fri] + - State "DONE" from "TODO" [2009-09-29 Tue] + - State "DONE" from "TODO" [2009-09-25 Fri] + - State "DONE" from "TODO" [2009-09-19 Sat] + - State "DONE" from "TODO" [2009-09-16 Wed] + - State "DONE" from "TODO" [2009-09-12 Sat] + :PROPERTIES: + :STYLE: habit + :LAST_REPEAT: [2009-10-19 Mon 00:36] + :END: + + What this habit says is: I want to shave at most every 2 days (given +by the `SCHEDULED' date and repeat interval) and at least every 4 days. +If today is the 15th, then the habit first appears in the agenda on Oct +17, after the minimum of 2 days has elapsed, and will appear overdue on +Oct 19, after four days have elapsed. + + What's really useful about habits is that they are displayed along +with a consistency graph, to show how consistent you've been at getting +that task done in the past. This graph shows every day that the task +was done over the past three weeks, with colors for each day. The +colors used are: + +`Blue' + If the task wasn't to be done yet on that day. + +`Green' + If the task could have been done on that day. + +`Yellow' + If the task was going to be overdue the next day. + +`Red' + If the task was overdue on that day. + + In addition to coloring each day, the day is also marked with an +asterisk if the task was actually done that day, and an exclamation +mark to show where the current day falls in the graph. + + There are several configuration variables that can be used to change +the way habits are displayed in the agenda. + +`org-habit-graph-column' + The buffer column at which the consistency graph should be drawn. + This will overwrite any text in that column, so it is a good idea + to keep your habits' titles brief and to the point. + +`org-habit-preceding-days' + The amount of history, in days before today, to appear in + consistency graphs. + +`org-habit-following-days' + The number of days after today that will appear in consistency + graphs. + +`org-habit-show-habits-only-for-today' + If non-`nil', only show habits in today's agenda view. This is + set to true by default. + + Lastly, pressing `K' in the agenda buffer will cause habits to +temporarily be disabled and they won't appear at all. Press `K' again +to bring them back. They are also subject to tag filtering, if you +have habits which should only be done in certain contexts, for example. + + +File: org, Node: Priorities, Next: Breaking down tasks, Prev: Progress logging, Up: TODO Items + +5.4 Priorities +============== + +If you use Org mode extensively, you may end up with enough TODO items +that it starts to make sense to prioritize them. Prioritizing can be +done by placing a _priority cookie_ into the headline of a TODO item, +like this + + *** TODO [#A] Write letter to Sam Fortune + +By default, Org mode supports three priorities: `A', `B', and `C'. `A' +is the highest priority. An entry without a cookie is treated just +like priority `B'. Priorities make a difference only for sorting in +the agenda (*note Weekly/daily agenda::); outside the agenda, they have +no inherent meaning to Org mode. The cookies can be highlighted with +special faces by customizing `org-priority-faces'. + + Priorities can be attached to any outline node; they do not need to +be TODO items. + +`C-c ,' + Set the priority of the current headline (`org-priority'). The + command prompts for a priority character `A', `B' or `C'. When + you press instead, the priority cookie is removed from the + headline. The priorities can also be changed "remotely" from the + timeline and agenda buffer with the `,' command (*note Agenda + commands::). + +`S- (`org-priority-up')' +`S- (`org-priority-down')' + Increase/decrease priority of current headline(1). Note that + these keys are also used to modify timestamps (*note Creating + timestamps::). See also *note Conflicts::, for a discussion of + the interaction with `shift-selection-mode'. + + You can change the range of allowed priorities by setting the options +`org-highest-priority', `org-lowest-priority', and +`org-default-priority'. For an individual buffer, you may set these +values (highest, lowest, default) like this (please make sure that the +highest priority is earlier in the alphabet than the lowest priority): + + #+PRIORITIES: A C B + + ---------- Footnotes ---------- + + (1) See also the option `org-priority-start-cycle-with-default'. + + +File: org, Node: Breaking down tasks, Next: Checkboxes, Prev: Priorities, Up: TODO Items + +5.5 Breaking tasks down into subtasks +===================================== + +It is often advisable to break down large tasks into smaller, manageable +subtasks. You can do this by creating an outline tree below a TODO +item, with detailed subtasks on the tree(1). To keep the overview over +the fraction of subtasks that are already completed, insert either +`[/]' or `[%]' anywhere in the headline. These cookies will be updated +each time the TODO status of a child changes, or when pressing `C-c +C-c' on the cookie. For example: + + * Organize Party [33%] + ** TODO Call people [1/2] + *** TODO Peter + *** DONE Sarah + ** TODO Buy food + ** DONE Talk to neighbor + + If a heading has both checkboxes and TODO children below it, the +meaning of the statistics cookie become ambiguous. Set the property +`COOKIE_DATA' to either `checkbox' or `todo' to resolve this issue. + + If you would like to have the statistics cookie count any TODO +entries in the subtree (not just direct children), configure +`org-hierarchical-todo-statistics'. To do this for a single subtree, +include the word `recursive' into the value of the `COOKIE_DATA' +property. + + * Parent capturing statistics [2/20] + :PROPERTIES: + :COOKIE_DATA: todo recursive + :END: + + If you would like a TODO entry to automatically change to DONE when +all children are done, you can use the following setup: + + (defun org-summary-todo (n-done n-not-done) + "Switch entry to DONE when all subentries are done, to TODO otherwise." + (let (org-log-done org-log-states) ; turn off logging + (org-todo (if (= n-not-done 0) "DONE" "TODO")))) + + (add-hook 'org-after-todo-statistics-hook 'org-summary-todo) + + Another possibility is the use of checkboxes to identify (a +hierarchy of) a large number of subtasks (*note Checkboxes::). + + ---------- Footnotes ---------- + + (1) To keep subtasks out of the global TODO list, see the +`org-agenda-todo-list-sublevels'. + + +File: org, Node: Checkboxes, Prev: Breaking down tasks, Up: TODO Items + +5.6 Checkboxes +============== + +Every item in a plain list(1) (*note Plain lists::) can be made into a +checkbox by starting it with the string `[ ]'. This feature is similar +to TODO items (*note TODO Items::), but is more lightweight. +Checkboxes are not included in the global TODO list, so they are often +great to split a task into a number of simple steps. Or you can use +them in a shopping list. To toggle a checkbox, use `C-c C-c', or use +the mouse (thanks to Piotr Zielinski's `org-mouse.el'). + + Here is an example of a checkbox list. + + * TODO Organize party [2/4] + - [-] call people [1/3] + - [ ] Peter + - [X] Sarah + - [ ] Sam + - [X] order food + - [ ] think about what music to play + - [X] talk to the neighbors + + Checkboxes work hierarchically, so if a checkbox item has children +that are checkboxes, toggling one of the children checkboxes will make +the parent checkbox reflect if none, some, or all of the children are +checked. + + The `[2/4]' and `[1/3]' in the first and second line are cookies +indicating how many checkboxes present in this entry have been checked +off, and the total number of checkboxes present. This can give you an +idea on how many checkboxes remain, even without opening a folded +entry. The cookies can be placed into a headline or into (the first +line of) a plain list item. Each cookie covers checkboxes of direct +children structurally below the headline/item on which the cookie +appears(2). You have to insert the cookie yourself by typing either +`[/]' or `[%]'. With `[/]' you get an `n out of m' result, as in the +examples above. With `[%]' you get information about the percentage of +checkboxes checked (in the above example, this would be `[50%]' and +`[33%]', respectively). In a headline, a cookie can count either +checkboxes below the heading or TODO states of children, and it will +display whatever was changed last. Set the property `COOKIE_DATA' to +either `checkbox' or `todo' to resolve this issue. + + If the current outline node has an `ORDERED' property, checkboxes +must be checked off in sequence, and an error will be thrown if you try +to check off a box while there are unchecked boxes above it. + +The following commands work with checkboxes: + +`C-c C-c (`org-toggle-checkbox')' + Toggle checkbox status or (with prefix arg) checkbox presence at + point. With a single prefix argument, add an empty checkbox or + remove the current one(3). With a double prefix argument, set it + to `[-]', which is considered to be an intermediate state. + +`C-c C-x C-b (`org-toggle-checkbox')' + Toggle checkbox status or (with prefix arg) checkbox presence at + point. With double prefix argument, set it to `[-]', which is + considered to be an intermediate state. + - If there is an active region, toggle the first checkbox in + the region and set all remaining boxes to the same status as + the first. With a prefix arg, add or remove the checkbox for + all items in the region. + + - If the cursor is in a headline, toggle checkboxes in the + region between this headline and the next (so _not_ the + entire subtree). + + - If there is no active region, just toggle the checkbox at + point. + +`M-S- (`org-insert-todo-heading')' + Insert a new item with a checkbox. This works only if the cursor + is already in a plain list item (*note Plain lists::). + +`C-c C-x o (`org-toggle-ordered-property')' + Toggle the `ORDERED' property of the entry, to toggle if + checkboxes must be checked off in sequence. A property is used + for this behavior because this should be local to the current + entry, not inherited like a tag. However, if you would like to + track the value of this property with a tag for better visibility, + customize `org-track-ordered-property-with-tag'. + +`C-c # (`org-update-statistics-cookies')' + Update the statistics cookie in the current outline entry. When + called with a `C-u' prefix, update the entire file. Checkbox + statistic cookies are updated automatically if you toggle + checkboxes with `C-c C-c' and make new ones with `M-S-'. + TODO statistics cookies update when changing TODO states. If you + delete boxes/entries or add/change them by hand, use this command + to get things back into sync. + + ---------- Footnotes ---------- + + (1) With the exception of description lists. But you can allow it +by modifying `org-list-automatic-rules' accordingly. + + (2) Set the option `org-checkbox-hierarchical-statistics' if you +want such cookies to count all checkboxes below the cookie, not just +those belonging to direct children. + + (3) `C-u C-c C-c' on the _first_ item of a list with no checkbox +will add checkboxes to the rest of the list. + + +File: org, Node: Tags, Next: Properties and Columns, Prev: TODO Items, Up: Top + +6 Tags +****** + +An excellent way to implement labels and contexts for cross-correlating +information is to assign tags to headlines. Org mode has extensive +support for tags. + + Every headline can contain a list of tags; they occur at the end of +the headline. Tags are normal words containing letters, numbers, `_', +and `@'. Tags must be preceded and followed by a single colon, e.g., +`:work:'. Several tags can be specified, as in `:work:urgent:'. Tags +will by default be in bold face with the same color as the headline. +You may specify special faces for specific tags using the option +`org-tag-faces', in much the same way as you can for TODO keywords +(*note Faces for TODO keywords::). + +* Menu: + +* Tag inheritance:: Tags use the tree structure of the outline +* Setting tags:: How to assign tags to a headline +* Tag groups:: Use one tag to search for several tags +* Tag searches:: Searching for combinations of tags + + +File: org, Node: Tag inheritance, Next: Setting tags, Prev: Tags, Up: Tags + +6.1 Tag inheritance +=================== + +Tags make use of the hierarchical structure of outline trees. If a +heading has a certain tag, all subheadings will inherit the tag as +well. For example, in the list + + * Meeting with the French group :work: + ** Summary by Frank :boss:notes: + *** TODO Prepare slides for him :action: + +the final heading will have the tags `:work:', `:boss:', `:notes:', and +`:action:' even though the final heading is not explicitly marked with +those tags. You can also set tags that all entries in a file should +inherit just as if these tags were defined in a hypothetical level zero +that surrounds the entire file. Use a line like this(1): + + #+FILETAGS: :Peter:Boss:Secret: + +To limit tag inheritance to specific tags, use +`org-tags-exclude-from-inheritance'. To turn it off entirely, use +`org-use-tag-inheritance'. + + When a headline matches during a tags search while tag inheritance +is turned on, all the sublevels in the same tree will (for a simple +match form) match as well(2). The list of matches may then become very +long. If you only want to see the first tags match in a subtree, +configure `org-tags-match-list-sublevels' (not recommended). + + Tag inheritance is relevant when the agenda search tries to match a +tag, either in the `tags' or `tags-todo' agenda types. In other agenda +types, `org-use-tag-inheritance' has no effect. Still, you may want to +have your tags correctly set in the agenda, so that tag filtering works +fine, with inherited tags. Set `org-agenda-use-tag-inheritance' to +control this: the default value includes all agenda types, but setting +this to `nil' can really speed up agenda generation. + + ---------- Footnotes ---------- + + (1) As with all these in-buffer settings, pressing `C-c C-c' +activates any changes in the line. + + (2) This is only true if the search does not involve more complex +tests including properties (*note Property searches::). + + +File: org, Node: Setting tags, Next: Tag groups, Prev: Tag inheritance, Up: Tags + +6.2 Setting tags +================ + +Tags can simply be typed into the buffer at the end of a headline. +After a colon, `M-' offers completion on tags. There is also a +special command for inserting tags: + +`C-c C-q (`org-set-tags-command')' + Enter new tags for the current headline. Org mode will either + offer completion or a special single-key interface for setting + tags, see below. After pressing , the tags will be inserted + and aligned to `org-tags-column'. When called with a `C-u' + prefix, all tags in the current buffer will be aligned to that + column, just to make things look nice. TAGS are automatically + realigned after promotion, demotion, and TODO state changes (*note + TODO basics::). + +`C-c C-c (`org-set-tags-command')' + When the cursor is in a headline, this does the same as `C-c C-q'. + + Org supports tag insertion based on a _list of tags_. By default +this list is constructed dynamically, containing all tags currently +used in the buffer. You may also globally specify a hard list of tags +with the variable `org-tag-alist'. Finally you can set the default +tags for a given file with lines like + + #+TAGS: @work @home @tennisclub + #+TAGS: laptop car pc sailboat + + If you have globally defined your preferred set of tags using the +variable `org-tag-alist', but would like to use a dynamic tag list in a +specific file, add an empty TAGS option line to that file: + + #+TAGS: + + If you have a preferred set of tags that you would like to use in +every file, in addition to those defined on a per-file basis by TAGS +option lines, then you may specify a list of tags with the variable +`org-tag-persistent-alist'. You may turn this off on a per-file basis +by adding a STARTUP option line to that file: + + #+STARTUP: noptag + + By default Org mode uses the standard minibuffer completion +facilities for entering tags. However, it also implements another, +quicker, tag selection method called _fast tag selection_. This allows +you to select and deselect tags with just a single key press. For this +to work well you should assign unique letters to most of your commonly +used tags. You can do this globally by configuring the variable +`org-tag-alist' in your `.emacs' file. For example, you may find the +need to tag many items in different files with `:@home:'. In this case +you can set something like: + + (setq org-tag-alist '(("@work" . ?w) ("@home" . ?h) ("laptop" . ?l))) + +If the tag is only relevant to the file you are working on, then you +can instead set the TAGS option line as: + + #+TAGS: @work(w) @home(h) @tennisclub(t) laptop(l) pc(p) + +The tags interface will show the available tags in a splash window. If +you want to start a new line after a specific tag, insert `\n' into the +tag list + + #+TAGS: @work(w) @home(h) @tennisclub(t) \n laptop(l) pc(p) + +or write them in two lines: + + #+TAGS: @work(w) @home(h) @tennisclub(t) + #+TAGS: laptop(l) pc(p) + +You can also group together tags that are mutually exclusive by using +braces, as in: + + #+TAGS: { @work(w) @home(h) @tennisclub(t) } laptop(l) pc(p) + +you indicate that at most one of `@work', `@home', and `@tennisclub' +should be selected. Multiple such groups are allowed. + +Don't forget to press `C-c C-c' with the cursor in one of these lines +to activate any changes. + +To set these mutually exclusive groups in the variable `org-tag-alist', +you must use the dummy tags `:startgroup' and `:endgroup' instead of +the braces. Similarly, you can use `:newline' to indicate a line +break. The previous example would be set globally by the following +configuration: + + (setq org-tag-alist '((:startgroup . nil) + ("@work" . ?w) ("@home" . ?h) + ("@tennisclub" . ?t) + (:endgroup . nil) + ("laptop" . ?l) ("pc" . ?p))) + + If at least one tag has a selection key then pressing `C-c C-c' will +automatically present you with a special interface, listing inherited +tags, the tags of the current headline, and a list of all valid tags +with corresponding keys(1). In this interface, you can use the +following keys: + +`a-z...' + Pressing keys assigned to tags will add or remove them from the + list of tags in the current line. Selecting a tag in a group of + mutually exclusive tags will turn off any other tags from that + group. + +`' + Enter a tag in the minibuffer, even if the tag is not in the + predefined list. You will be able to complete on all tags present + in the buffer. You can also add several tags: just separate them + with a comma. + +`' + Clear all tags for this line. + +`' + Accept the modified set. + +`C-g' + Abort without installing changes. + +`q' + If `q' is not assigned to a tag, it aborts like `C-g'. + +`!' + Turn off groups of mutually exclusive tags. Use this to (as an + exception) assign several tags from such a group. + +`C-c' + Toggle auto-exit after the next change (see below). If you are + using expert mode, the first `C-c' will display the selection + window. + +This method lets you assign tags to a headline with very few keys. With +the above setup, you could clear the current tags and set `@home', +`laptop' and `pc' tags with just the following keys: `C-c C-c h l +p '. Switching from `@home' to `@work' would be done with `C-c +C-c w ' or alternatively with `C-c C-c C-c w'. Adding the +non-predefined tag `Sarah' could be done with `C-c C-c S a r a h + '. + + If you find that most of the time you need only a single key press to +modify your list of tags, set `org-fast-tag-selection-single-key'. +Then you no longer have to press to exit fast tag selection--it +will immediately exit after the first change. If you then occasionally +need more keys, press `C-c' to turn off auto-exit for the current tag +selection process (in effect: start selection with `C-c C-c C-c' +instead of `C-c C-c'). If you set the variable to the value `expert', +the special window is not even shown for single-key tag selection, it +comes up only when you press an extra `C-c'. + + ---------- Footnotes ---------- + + (1) Keys will automatically be assigned to tags which have no +configured keys. + + +File: org, Node: Tag groups, Next: Tag searches, Prev: Setting tags, Up: Tags + +6.3 Tag groups +============== + +In a set of mutually exclusive tags, the first tag can be defined as a +_group tag_. When you search for a group tag, it will return matches +for all members in the group. In an agenda view, filtering by a group +tag will display headlines tagged with at least one of the members of +the group. This makes tag searches and filters even more flexible. + + You can set group tags by inserting a colon between the group tag +and other tags--beware that all whitespaces are mandatory so that Org +can parse this line correctly: + + #+TAGS: { @read : @read_book @read_ebook } + + In this example, `@read' is a _group tag_ for a set of three tags: +`@read', `@read_book' and `@read_ebook'. + + You can also use the `:grouptags' keyword directly when setting +`org-tag-alist': + + (setq org-tag-alist '((:startgroup . nil) + ("@read" . nil) + (:grouptags . nil) + ("@read_book" . nil) + ("@read_ebook" . nil) + (:endgroup . nil))) + + You cannot nest group tags or use a group tag as a tag in another +group. + + If you want to ignore group tags temporarily, toggle group tags +support with `org-toggle-tags-groups', bound to `C-c C-x q'. If you +want to disable tag groups completely, set `org-group-tags' to `nil'. + + +File: org, Node: Tag searches, Prev: Tag groups, Up: Tags + +6.4 Tag searches +================ + +Once a system of tags has been set up, it can be used to collect related +information into special lists. + +`C-c / m or C-c \ (`org-match-sparse-tree')' + Create a sparse tree with all headlines matching a + tags/property/TODO search. With a `C-u' prefix argument, ignore + headlines that are not a TODO line. *Note Matching tags and + properties::. + +`C-c a m (`org-tags-view')' + Create a global list of tag matches from all agenda files. *Note + Matching tags and properties::. + +`C-c a M (`org-tags-view')' + Create a global list of tag matches from all agenda files, but + check only TODO items and force checking subitems (see the option + `org-tags-match-list-sublevels'). + + These commands all prompt for a match string which allows basic +Boolean logic like `+boss+urgent-project1', to find entries with tags +`boss' and `urgent', but not `project1', or `Kathy|Sally' to find +entries which are tagged, like `Kathy' or `Sally'. The full syntax of +the search string is rich and allows also matching against TODO +keywords, entry levels and properties. For a complete description with +many examples, see *note Matching tags and properties::. + + +File: org, Node: Properties and Columns, Next: Dates and Times, Prev: Tags, Up: Top + +7 Properties and columns +************************ + +A property is a key-value pair associated with an entry. Properties +can be set so they are associated with a single entry, with every entry +in a tree, or with every entry in an Org mode file. + + There are two main applications for properties in Org mode. First, +properties are like tags, but with a value. Imagine maintaining a file +where you document bugs and plan releases for a piece of software. +Instead of using tags like `:release_1:', `:release_2:', you can use a +property, say `:Release:', that in different subtrees has different +values, such as `1.0' or `2.0'. Second, you can use properties to +implement (very basic) database capabilities in an Org buffer. Imagine +keeping track of your music CDs, where properties could be things such +as the album, artist, date of release, number of tracks, and so on. + + Properties can be conveniently edited and viewed in column view +(*note Column view::). + +* Menu: + +* Property syntax:: How properties are spelled out +* Special properties:: Access to other Org mode features +* Property searches:: Matching property values +* Property inheritance:: Passing values down the tree +* Column view:: Tabular viewing and editing +* Property API:: Properties for Lisp programmers + + +File: org, Node: Property syntax, Next: Special properties, Prev: Properties and Columns, Up: Properties and Columns + +7.1 Property syntax +=================== + +Properties are key-value pairs. When they are associated with a single +entry or with a tree they need to be inserted into a special drawer +(*note Drawers::) with the name `PROPERTIES'. Each property is +specified on a single line, with the key (surrounded by colons) first, +and the value after it. Here is an example: + + * CD collection + ** Classic + *** Goldberg Variations + :PROPERTIES: + :Title: Goldberg Variations + :Composer: J.S. Bach + :Artist: Glen Gould + :Publisher: Deutsche Grammophon + :NDisks: 1 + :END: + + Depending on the value of `org-use-property-inheritance', a property +set this way will either be associated with a single entry, or the +sub-tree defined by the entry, see *note Property inheritance::. + + You may define the allowed values for a particular property `:Xyz:' +by setting a property `:Xyz_ALL:'. This special property is +_inherited_, so if you set it in a level 1 entry, it will apply to the +entire tree. When allowed values are defined, setting the +corresponding property becomes easier and is less prone to typing +errors. For the example with the CD collection, we can predefine +publishers and the number of disks in a box like this: + + * CD collection + :PROPERTIES: + :NDisks_ALL: 1 2 3 4 + :Publisher_ALL: "Deutsche Grammophon" Philips EMI + :END: + + If you want to set properties that can be inherited by any entry in a +file, use a line like + #+PROPERTY: NDisks_ALL 1 2 3 4 + + Contrary to properties set from a special drawer, you have to +refresh the buffer with `C-c C-c' to activate this changes. + + If you want to add to the value of an existing property, append a +`+' to the property name. The following results in the property `var' +having the value "foo=1 bar=2". + #+PROPERTY: var foo=1 + #+PROPERTY: var+ bar=2 + + It is also possible to add to the values of inherited properties. +The following results in the `genres' property having the value "Classic +Baroque" under the `Goldberg Variations' subtree. + * CD collection + ** Classic + :PROPERTIES: + :GENRES: Classic + :END: + *** Goldberg Variations + :PROPERTIES: + :Title: Goldberg Variations + :Composer: J.S. Bach + :Artist: Glen Gould + :Publisher: Deutsche Grammophon + :NDisks: 1 + :GENRES+: Baroque + :END: + Note that a property can only have one entry per Drawer. + + Property values set with the global variable `org-global-properties' +can be inherited by all entries in all Org files. + +The following commands help to work with properties: + +`M- (`pcomplete')' + After an initial colon in a line, complete property keys. All + keys used in the current file will be offered as possible + completions. + +`C-c C-x p (`org-set-property')' + Set a property. This prompts for a property name and a value. If + necessary, the property drawer is created as well. + +`C-u M-x org-insert-drawer RET' + Insert a property drawer into the current entry. The drawer will + be inserted early in the entry, but after the lines with planning + information like deadlines. + +`C-c C-c (`org-property-action')' + With the cursor in a property drawer, this executes property + commands. + +`C-c C-c s (`org-set-property')' + Set a property in the current entry. Both the property and the + value can be inserted using completion. + +`S- (`org-property-next-allowed-value')' +`S- (`org-property-previous-allowed-value')' + Switch property at point to the next/previous allowed value. + +`C-c C-c d (`org-delete-property')' + Remove a property from the current entry. + +`C-c C-c D (`org-delete-property-globally')' + Globally remove a property, from all entries in the current file. + +`C-c C-c c (`org-compute-property-at-point')' + Compute the property at point, using the operator and scope from + the nearest column format definition. + + +File: org, Node: Special properties, Next: Property searches, Prev: Property syntax, Up: Properties and Columns + +7.2 Special properties +====================== + +Special properties provide an alternative access method to Org mode +features, like the TODO state or the priority of an entry, discussed in +the previous chapters. This interface exists so that you can include +these states in a column view (*note Column view::), or to use them in +queries. The following property names are special and (except for +`:CATEGORY:') should not be used as keys in the properties drawer: + + ID A globally unique ID used for synchronization during + iCalendar or MobileOrg export. + TODO The TODO keyword of the entry. + TAGS The tags defined directly in the headline. + ALLTAGS All tags, including inherited ones. + CATEGORY The category of an entry. + PRIORITY The priority of the entry, a string with a single letter. + DEADLINE The deadline time string, without the angular brackets. + SCHEDULED The scheduling timestamp, without the angular brackets. + CLOSED When was this entry closed? + TIMESTAMP The first keyword-less timestamp in the entry. + TIMESTAMP_IA The first inactive timestamp in the entry. + CLOCKSUM The sum of CLOCK intervals in the subtree. `org-clock-sum' + must be run first to compute the values in the current buffer. + CLOCKSUM_T The sum of CLOCK intervals in the subtree for today. + `org-clock-sum-today' must be run first to compute the + values in the current buffer. + BLOCKED "t" if task is currently blocked by children or siblings + ITEM The headline of the entry. + FILE The filename the entry is located in. + + +File: org, Node: Property searches, Next: Property inheritance, Prev: Special properties, Up: Properties and Columns + +7.3 Property searches +===================== + +To create sparse trees and special lists with selection based on +properties, the same commands are used as for tag searches (*note Tag +searches::). + +`C-c / m or C-c \ (`org-match-sparse-tree')' + Create a sparse tree with all matching entries. With a `C-u' + prefix argument, ignore headlines that are not a TODO line. + +`C-c a m (`org-tags-view')' + Create a global list of tag/property matches from all agenda + files. *Note Matching tags and properties::. + +`C-c a M (`org-tags-view')' + Create a global list of tag matches from all agenda files, but + check only TODO items and force checking of subitems (see the + option `org-tags-match-list-sublevels'). + + The syntax for the search string is described in *note Matching tags +and properties::. + + There is also a special command for creating sparse trees based on a +single property: + +`C-c / p' + Create a sparse tree based on the value of a property. This first + prompts for the name of a property, and then for a value. A + sparse tree is created with all entries that define this property + with the given value. If you enclose the value in curly braces, + it is interpreted as a regular expression and matched against the + property values. + + +File: org, Node: Property inheritance, Next: Column view, Prev: Property searches, Up: Properties and Columns + +7.4 Property Inheritance +======================== + +The outline structure of Org mode documents lends itself to an +inheritance model of properties: if the parent in a tree has a certain +property, the children can inherit this property. Org mode does not +turn this on by default, because it can slow down property searches +significantly and is often not needed. However, if you find inheritance +useful, you can turn it on by setting the variable +`org-use-property-inheritance'. It may be set to `t' to make all +properties inherited from the parent, to a list of properties that +should be inherited, or to a regular expression that matches inherited +properties. If a property has the value `nil', this is interpreted as +an explicit undefine of the property, so that inheritance search will +stop at this value and return `nil'. + + Org mode has a few properties for which inheritance is hard-coded, at +least for the special applications for which they are used: + +`COLUMNS' + The `:COLUMNS:' property defines the format of column view (*note + Column view::). It is inherited in the sense that the level where + a `:COLUMNS:' property is defined is used as the starting point + for a column view table, independently of the location in the + subtree from where columns view is turned on. + +`CATEGORY' + For agenda view, a category set through a `:CATEGORY:' property + applies to the entire subtree. + +`ARCHIVE' + For archiving, the `:ARCHIVE:' property may define the archive + location for the entire subtree (*note Moving subtrees::). + +`LOGGING' + The LOGGING property may define logging settings for an entry or a + subtree (*note Tracking TODO state changes::). + + +File: org, Node: Column view, Next: Property API, Prev: Property inheritance, Up: Properties and Columns + +7.5 Column view +=============== + +A great way to view and edit properties in an outline tree is _column +view_. In column view, each outline node is turned into a table row. +Columns in this table provide access to properties of the entries. Org +mode implements columns by overlaying a tabular structure over the +headline of each item. While the headlines have been turned into a +table row, you can still change the visibility of the outline tree. +For example, you get a compact table by switching to CONTENTS view +(`S- S-', or simply `c' while column view is active), but you +can still open, read, and edit the entry below each headline. Or, you +can switch to column view after executing a sparse tree command and in +this way get a table only for the selected items. Column view also +works in agenda buffers (*note Agenda Views::) where queries have +collected selected items, possibly from a number of files. + +* Menu: + +* Defining columns:: The COLUMNS format property +* Using column view:: How to create and use column view +* Capturing column view:: A dynamic block for column view + + +File: org, Node: Defining columns, Next: Using column view, Prev: Column view, Up: Column view + +7.5.1 Defining columns +---------------------- + +Setting up a column view first requires defining the columns. This is +done by defining a column format line. + +* Menu: + +* Scope of column definitions:: Where defined, where valid? +* Column attributes:: Appearance and content of a column + + +File: org, Node: Scope of column definitions, Next: Column attributes, Prev: Defining columns, Up: Defining columns + +7.5.1.1 Scope of column definitions +................................... + +To define a column format for an entire file, use a line like + + #+COLUMNS: %25ITEM %TAGS %PRIORITY %TODO + + To specify a format that only applies to a specific tree, add a +`:COLUMNS:' property to the top node of that tree, for example: + + ** Top node for columns view + :PROPERTIES: + :COLUMNS: %25ITEM %TAGS %PRIORITY %TODO + :END: + + If a `:COLUMNS:' property is present in an entry, it defines columns +for the entry itself, and for the entire subtree below it. Since the +column definition is part of the hierarchical structure of the document, +you can define columns on level 1 that are general enough for all +sublevels, and more specific columns further down, when you edit a +deeper part of the tree. + + +File: org, Node: Column attributes, Prev: Scope of column definitions, Up: Defining columns + +7.5.1.2 Column attributes +......................... + +A column definition sets the attributes of a column. The general +definition looks like this: + + %[WIDTH]PROPERTY[(TITLE)][{SUMMARY-TYPE}] + +Except for the percent sign and the property name, all items are +optional. The individual parts have the following meaning: + + WIDTH An integer specifying the width of the column in characters. + If omitted, the width will be determined automatically. + PROPERTY The property that should be edited in this column. + Special properties representing meta data are allowed here + as well (*note Special properties::) + TITLE The header text for the column. If omitted, the property + name is used. + {SUMMARY-TYPE} The summary type. If specified, the column values for + parent nodes are computed from the children. + Supported summary types are: + {+} Sum numbers in this column. + {+;%.1f} Like `+', but format result with `%.1f'. + {$} Currency, short for `+;%.2f'. + {:} Sum times, HH:MM, plain numbers are hours. + {X} Checkbox status, `[X]' if all children are `[X]'. + {X/} Checkbox status, `[n/m]'. + {X%} Checkbox status, `[n%]'. + {min} Smallest number in column. + {max} Largest number. + {mean} Arithmetic mean of numbers. + {:min} Smallest time value in column. + {:max} Largest time value. + {:mean} Arithmetic mean of time values. + {@min} Minimum age (in days/hours/mins/seconds). + {@max} Maximum age (in days/hours/mins/seconds). + {@mean} Arithmetic mean of ages (in days/hours/mins/seconds). + {est+} Add low-high estimates. + +Be aware that you can only have one summary type for any property you +include. Subsequent columns referencing the same property will all +display the same summary information. + + The `est+' summary type requires further explanation. It is used for +combining estimates, expressed as low-high ranges. For example, instead +of estimating a particular task will take 5 days, you might estimate it +as 5-6 days if you're fairly confident you know how much work is +required, or 1-10 days if you don't really know what needs to be done. +Both ranges average at 5.5 days, but the first represents a more +predictable delivery. + + When combining a set of such estimates, simply adding the lows and +highs produces an unrealistically wide result. Instead, `est+' adds the +statistical mean and variance of the sub-tasks, generating a final +estimate from the sum. For example, suppose you had ten tasks, each of +which was estimated at 0.5 to 2 days of work. Straight addition +produces an estimate of 5 to 20 days, representing what to expect if +everything goes either extremely well or extremely poorly. In +contrast, `est+' estimates the full job more realistically, at 10-15 +days. + + Numbers are right-aligned when a format specifier with an explicit +width like `%5d' or `%5.1f' is used. + + Here is an example for a complete columns definition, along with +allowed values. + + :COLUMNS: %25ITEM %9Approved(Approved?){X} %Owner %11Status \(1) + %10Time_Estimate{:} %CLOCKSUM %CLOCKSUM_T + :Owner_ALL: Tammy Mark Karl Lisa Don + :Status_ALL: "In progress" "Not started yet" "Finished" "" + :Approved_ALL: "[ ]" "[X]" + +The first column, `%25ITEM', means the first 25 characters of the item +itself, i.e., of the headline. You probably always should start the +column definition with the `ITEM' specifier. The other specifiers +create columns `Owner' with a list of names as allowed values, for +`Status' with four different possible values, and for a checkbox field +`Approved'. When no width is given after the `%' character, the column +will be exactly as wide as it needs to be in order to fully display all +values. The `Approved' column does have a modified title (`Approved?', +with a question mark). Summaries will be created for the +`Time_Estimate' column by adding time duration expressions like HH:MM, +and for the `Approved' column, by providing an `[X]' status if all +children have been checked. The `CLOCKSUM' and `CLOCKSUM_T' columns +are special, they lists the sums of CLOCK intervals in the subtree, +either for all clocks or just for today. + + ---------- Footnotes ---------- + + (1) Please note that the COLUMNS definition must be on a single +line--it is wrapped here only because of formatting constraints. + + +File: org, Node: Using column view, Next: Capturing column view, Prev: Defining columns, Up: Column view + +7.5.2 Using column view +----------------------- + +Turning column view on and off +.............................. + +`C-c C-x C-c (`org-columns')' + Turn on column view. If the cursor is before the first headline + in the file, column view is turned on for the entire file, using + the `#+COLUMNS' definition. If the cursor is somewhere inside the + outline, this command searches the hierarchy, up from point, for a + `:COLUMNS:' property that defines a format. When one is found, + the column view table is established for the tree starting at the + entry that contains the `:COLUMNS:' property. If no such property + is found, the format is taken from the `#+COLUMNS' line or from + the variable `org-columns-default-format', and column view is + established for the current entry and its subtree. + +`r (`org-columns-redo')' + Recreate the column view, to include recent changes made in the + buffer. + +`g (`org-columns-redo')' + Same as `r'. + +`q (`org-columns-quit')' + Exit column view. + +Editing values +.............. + +` ' + Move through the column view from field to field. + +`S-/' + Switch to the next/previous allowed value of the field. For this, + you have to have specified allowed values for a property. + +`1..9,0' + Directly select the Nth allowed value, `0' selects the 10th value. + +`n (`org-columns-next-allowed-value')' +`p (`org-columns-previous-allowed-value')' + Same as `S-/' + +`e (`org-columns-edit-value')' + Edit the property at point. For the special properties, this will + invoke the same interface that you normally use to change that + property. For example, when editing a TAGS property, the tag + completion or fast selection interface will pop up. + +`C-c C-c (`org-columns-set-tags-or-toggle')' + When there is a checkbox at point, toggle it. + +`v (`org-columns-show-value')' + View the full value of this property. This is useful if the width + of the column is smaller than that of the value. + +`a (`org-columns-edit-allowed')' + Edit the list of allowed values for this property. If the list is + found in the hierarchy, the modified values is stored there. If + no list is found, the new value is stored in the first entry that + is part of the current column view. + +Modifying the table structure +............................. + +`< (`org-columns-narrow')' +`> (`org-columns-widen')' + Make the column narrower/wider by one character. + +`S-M- (`org-columns-new')' + Insert a new column, to the left of the current column. + +`S-M- (`org-columns-delete')' + Delete the current column. + + +File: org, Node: Capturing column view, Prev: Using column view, Up: Column view + +7.5.3 Capturing column view +--------------------------- + +Since column view is just an overlay over a buffer, it cannot be +exported or printed directly. If you want to capture a column view, use +a `columnview' dynamic block (*note Dynamic blocks::). The frame of +this block looks like this: + + * The column view + #+BEGIN: columnview :hlines 1 :id "label" + + #+END: + +This dynamic block has the following parameters: + +`:id' + This is the most important parameter. Column view is a feature + that is often localized to a certain (sub)tree, and the capture + block might be at a different location in the file. To identify + the tree whose view to capture, you can use 4 values: + local use the tree in which the capture block is located + global make a global view, including all headings in the file + "file:PATH-TO-FILE" + run column view at the top of this file + "ID" call column view in the tree that has an `:ID:' + property with the value label. You can use + `M-x org-id-copy RET' to create a globally unique ID for + the current entry and copy it to the kill-ring. + +`:hlines' + When `t', insert an hline after every line. When a number N, + insert an hline before each headline with level `<= N'. + +`:vlines' + When set to `t', force column groups to get vertical lines. + +`:maxlevel' + When set to a number, don't capture entries below this level. + +`:skip-empty-rows' + When set to `t', skip rows where the only non-empty specifier of + the column view is `ITEM'. + + +The following commands insert or update the dynamic block: + +`C-c C-x i (`org-insert-columns-dblock')' + Insert a dynamic block capturing a column view. You will be + prompted for the scope or ID of the view. + +`C-c C-c or C-c C-x C-u (`org-dblock-update')' + Update dynamic block at point. The cursor needs to be in the + `#+BEGIN' line of the dynamic block. + +`C-u C-c C-x C-u (`org-update-all-dblocks')' + Update all dynamic blocks (*note Dynamic blocks::). This is + useful if you have several clock table blocks, column-capturing + blocks or other dynamic blocks in a buffer. + + You can add formulas to the column view table and you may add +plotting instructions in front of the table--these will survive an +update of the block. If there is a `#+TBLFM:' after the table, the +table will actually be recalculated automatically after an update. + + An alternative way to capture and process property values into a +table is provided by Eric Schulte's `org-collector.el' which is a +contributed package(1). It provides a general API to collect +properties from entries in a certain scope, and arbitrary Lisp +expressions to process these values before inserting them into a table +or a dynamic block. + + ---------- Footnotes ---------- + + (1) Contributed packages are not part of Emacs, but are distributed +with the main distribution of Org (visit `http://orgmode.org'). + + +File: org, Node: Property API, Prev: Column view, Up: Properties and Columns + +7.6 The Property API +==================== + +There is a full API for accessing and changing properties. This API can +be used by Emacs Lisp programs to work with properties and to implement +features based on them. For more information see *note Using the +property API::. + + +File: org, Node: Dates and Times, Next: Capture - Refile - Archive, Prev: Properties and Columns, Up: Top + +8 Dates and times +***************** + +To assist project planning, TODO items can be labeled with a date and/or +a time. The specially formatted string carrying the date and time +information is called a _timestamp_ in Org mode. This may be a little +confusing because timestamp is often used as indicating when something +was created or last changed. However, in Org mode this term is used in +a much wider sense. + +* Menu: + +* Timestamps:: Assigning a time to a tree entry +* Creating timestamps:: Commands which insert timestamps +* Deadlines and scheduling:: Planning your work +* Clocking work time:: Tracking how long you spend on a task +* Effort estimates:: Planning work effort in advance +* Relative timer:: Notes with a running timer +* Countdown timer:: Starting a countdown timer for a task + + +File: org, Node: Timestamps, Next: Creating timestamps, Prev: Dates and Times, Up: Dates and Times + +8.1 Timestamps, deadlines, and scheduling +========================================= + +A timestamp is a specification of a date (possibly with a time or a +range of times) in a special format, either `<2003-09-16 Tue>'(1) or +`<2003-09-16 Tue 09:39>' or `<2003-09-16 Tue 12:00-12:30>'(2). A +timestamp can appear anywhere in the headline or body of an Org tree +entry. Its presence causes entries to be shown on specific dates in the +agenda (*note Weekly/daily agenda::). We distinguish: + +PLAIN TIMESTAMP; EVENT; APPOINTMENT + A simple timestamp just assigns a date/time to an item. This is + just like writing down an appointment or event in a paper agenda. + In the timeline and agenda displays, the headline of an entry + associated with a plain timestamp will be shown exactly on that + date. + + * Meet Peter at the movies + <2006-11-01 Wed 19:15> + * Discussion on climate change + <2006-11-02 Thu 20:00-22:00> + +TIMESTAMP WITH REPEATER INTERVAL + A timestamp may contain a _repeater interval_, indicating that it + applies not only on the given date, but again and again after a + certain interval of N days (d), weeks (w), months (m), or years + (y). The following will show up in the agenda every Wednesday: + + * Pick up Sam at school + <2007-05-16 Wed 12:30 +1w> + +DIARY-STYLE SEXP ENTRIES + For more complex date specifications, Org mode supports using the + special sexp diary entries implemented in the Emacs calendar/diary + package(3). For example with optional time + + * 22:00-23:00 The nerd meeting on every 2nd Thursday of the month + <%%(diary-float t 4 2)> + +TIME/DATE RANGE + Two timestamps connected by `--' denote a range. The headline + will be shown on the first and last day of the range, and on any + dates that are displayed and fall in the range. Here is an + example: + + ** Meeting in Amsterdam + <2004-08-23 Mon>--<2004-08-26 Thu> + +INACTIVE TIMESTAMP + Just like a plain timestamp, but with square brackets instead of + angular ones. These timestamps are inactive in the sense that + they do _not_ trigger an entry to show up in the agenda. + + * Gillian comes late for the fifth time + [2006-11-01 Wed] + + + ---------- Footnotes ---------- + + (1) In this simplest form, the day name is optional when you type +the date yourself. However, any dates inserted or modified by Org will +add that day name, for reading convenience. + + (2) This is inspired by the standard ISO 8601 date/time format. To +use an alternative format, see *note Custom time format::. + + (3) When working with the standard diary sexp functions, you need to +be very careful with the order of the arguments. That order depend +evilly on the variable `calendar-date-style' (or, for older Emacs +versions, `european-calendar-style'). For example, to specify a date +December 12, 2005, the call might look like `(diary-date 12 1 2005)' or +`(diary-date 1 12 2005)' or `(diary-date 2005 12 1)', depending on the +settings. This has been the source of much confusion. Org mode users +can resort to special versions of these functions like `org-date' or +`org-anniversary'. These work just like the corresponding `diary-' +functions, but with stable ISO order of arguments (year, month, day) +wherever applicable, independent of the value of `calendar-date-style'. + + +File: org, Node: Creating timestamps, Next: Deadlines and scheduling, Prev: Timestamps, Up: Dates and Times + +8.2 Creating timestamps +======================= + +For Org mode to recognize timestamps, they need to be in the specific +format. All commands listed below produce timestamps in the correct +format. + +`C-c . (`org-time-stamp')' + Prompt for a date and insert a corresponding timestamp. When the + cursor is at an existing timestamp in the buffer, the command is + used to modify this timestamp instead of inserting a new one. + When this command is used twice in succession, a time range is + inserted. + +`C-c ! (`org-time-stamp-inactive')' + Like `C-c .', but insert an inactive timestamp that will not cause + an agenda entry. + +`C-u C-c .' +`C-u C-c !' + Like `C-c .' and `C-c !', but use the alternative format which + contains date and time. The default time can be rounded to + multiples of 5 minutes, see the option + `org-time-stamp-rounding-minutes'. + +`C-c C-c' + Normalize timestamp, insert/fix day name if missing or wrong. + +`C-c < (`org-date-from-calendar')' + Insert a timestamp corresponding to the cursor date in the + Calendar. + +`C-c > (`org-goto-calendar')' + Access the Emacs calendar for the current date. If there is a + timestamp in the current line, go to the corresponding date + instead. + +`C-c C-o (`org-open-at-point')' + Access the agenda for the date given by the timestamp or -range at + point (*note Weekly/daily agenda::). + +`S- (`org-timestamp-down-day')' +`S- (`org-timestamp-up-day')' + Change date at cursor by one day. These key bindings conflict with + shift-selection and related modes (*note Conflicts::). + +`S- (`org-timestamp-up')' +`S- (`org-timestamp-down-down')' + Change the item under the cursor in a timestamp. The cursor can + be on a year, month, day, hour or minute. When the timestamp + contains a time range like `15:30-16:30', modifying the first time + will also shift the second, shifting the time block with constant + length. To change the length, modify the second time. Note that + if the cursor is in a headline and not at a timestamp, these same + keys modify the priority of an item. (*note Priorities::). The + key bindings also conflict with shift-selection and related modes + (*note Conflicts::). + +`C-c C-y (`org-evaluate-time-range')' + Evaluate a time range by computing the difference between start + and end. With a prefix argument, insert result after the time + range (in a table: into the following column). + +* Menu: + +* The date/time prompt:: How Org mode helps you entering date and time +* Custom time format:: Making dates look different + + +File: org, Node: The date/time prompt, Next: Custom time format, Prev: Creating timestamps, Up: Creating timestamps + +8.2.1 The date/time prompt +-------------------------- + +When Org mode prompts for a date/time, the default is shown in default +date/time format, and the prompt therefore seems to ask for a specific +format. But it will in fact accept date/time information in a variety +of formats. Generally, the information should start at the beginning +of the string. Org mode will find whatever information is in there and +derive anything you have not specified from the _default date and +time_. The default is usually the current date and time, but when +modifying an existing timestamp, or when entering the second stamp of a +range, it is taken from the stamp in the buffer. When filling in +information, Org mode assumes that most of the time you will want to +enter a date in the future: if you omit the month/year and the given +day/month is before today, it will assume that you mean a future +date(1). If the date has been automatically shifted into the future, +the time prompt will show this with `(=>F).' + + For example, let's assume that today is June 13, 2006. Here is how +various inputs will be interpreted, the items filled in by Org mode are +in bold. + + 3-2-5 => 2003-02-05 + 2/5/3 => 2003-02-05 + 14 => 2006-06-14 + 12 => 2006-07-12 + 2/5 => 2007-02-05 + Fri => nearest Friday after the default date + sep 15 => 2006-09-15 + feb 15 => 2007-02-15 + sep 12 9 => 2009-09-12 + 12:45 => 2006-06-13 12:45 + 22 sept 0:34 => 2006-09-22 0:34 + w4 => ISO week for of the current year 2006 + 2012 w4 fri => Friday of ISO week 4 in 2012 + 2012-w04-5 => Same as above + + Furthermore you can specify a relative date by giving, as the _first_ +thing in the input: a plus/minus sign, a number and a letter ([hdwmy]) +to indicate change in hours, days, weeks, months, or years. With a +single plus or minus, the date is always relative to today. With a +double plus or minus, it is relative to the default date. If instead +of a single letter, you use the abbreviation of day name, the date will +be the Nth such day, e.g.: + + +0 => today + . => today + +4d => four days from today + +4 => same as above + +2w => two weeks from today + ++5 => five days from default date + +2tue => second Tuesday from now + -wed => last Wednesday + + The function understands English month and weekday abbreviations. If +you want to use unabbreviated names and/or other languages, configure +the variables `parse-time-months' and `parse-time-weekdays'. + + Not all dates can be represented in a given Emacs implementation. +By default Org mode forces dates into the compatibility range 1970-2037 +which works on all Emacs implementations. If you want to use dates +outside of this range, read the docstring of the variable +`org-read-date-force-compatible-dates'. + + You can specify a time range by giving start and end times or by +giving a start time and a duration (in HH:MM format). Use one or two +dash(es) as the separator in the former case and use '+' as the +separator in the latter case, e.g.: + + 11am-1:15pm => 11:00-13:15 + 11am--1:15pm => same as above + 11am+2:15 => same as above + + Parallel to the minibuffer prompt, a calendar is popped up(2). When +you exit the date prompt, either by clicking on a date in the calendar, +or by pressing , the date selected in the calendar will be +combined with the information entered at the prompt. You can control +the calendar fully from the minibuffer: + + Choose date at cursor in calendar. + mouse-1 Select date by clicking on it. + S-/ One day forward/backward. + S-/ One week forward/backward. + M-S-/ One month forward/backward. + > / < Scroll calendar forward/backward by one month. + M-v / C-v Scroll calendar forward/backward by 3 months. + + The actions of the date/time prompt may seem complex, but I assure +you they will grow on you, and you will start getting annoyed by pretty +much any other way of entering a date/time out there. To help you +understand what is going on, the current interpretation of your input +will be displayed live in the minibuffer(3). + + ---------- Footnotes ---------- + + (1) See the variable `org-read-date-prefer-future'. You may set +that variable to the symbol `time' to even make a time before now shift +the date to tomorrow. + + (2) If you don't need/want the calendar, configure the variable +`org-popup-calendar-for-date-prompt'. + + (3) If you find this distracting, turn the display off with +`org-read-date-display-live'. + + +File: org, Node: Custom time format, Prev: The date/time prompt, Up: Creating timestamps + +8.2.2 Custom time format +------------------------ + +Org mode uses the standard ISO notation for dates and times as it is +defined in ISO 8601. If you cannot get used to this and require another +representation of date and time to keep you happy, you can get it by +customizing the options `org-display-custom-times' and +`org-time-stamp-custom-formats'. + +`C-c C-x C-t (`org-toggle-time-stamp-overlays')' + Toggle the display of custom formats for dates and times. + +Org mode needs the default format for scanning, so the custom date/time +format does not _replace_ the default format--instead it is put _over_ +the default format using text properties. This has the following +consequences: + * You cannot place the cursor onto a timestamp anymore, only before + or after. + + * The `S-/' keys can no longer be used to adjust each + component of a timestamp. If the cursor is at the beginning of + the stamp, `S-/' will change the stamp by one day, just + like `S-/'. At the end of the stamp, the time will + be changed by one minute. + + * If the timestamp contains a range of clock times or a repeater, + these will not be overlaid, but remain in the buffer as they were. + + * When you delete a timestamp character-by-character, it will only + disappear from the buffer after _all_ (invisible) characters + belonging to the ISO timestamp have been removed. + + * If the custom timestamp format is longer than the default and you + are using dates in tables, table alignment will be messed up. If + the custom format is shorter, things do work as expected. + + +File: org, Node: Deadlines and scheduling, Next: Clocking work time, Prev: Creating timestamps, Up: Dates and Times + +8.3 Deadlines and scheduling +============================ + +A timestamp may be preceded by special keywords to facilitate planning: + +DEADLINE + Meaning: the task (most likely a TODO item, though not + necessarily) is supposed to be finished on that date. + + On the deadline date, the task will be listed in the agenda. In + addition, the agenda for _today_ will carry a warning about the + approaching or missed deadline, starting + `org-deadline-warning-days' before the due date, and continuing + until the entry is marked DONE. An example: + + *** TODO write article about the Earth for the Guide + DEADLINE: <2004-02-29 Sun> + The editor in charge is [[bbdb:Ford Prefect]] + + You can specify a different lead time for warnings for a specific + deadlines using the following syntax. Here is an example with a + warning period of 5 days `DEADLINE: <2004-02-29 Sun -5d>'. This + warning is deactivated if the task get scheduled and you set + `org-agenda-skip-deadline-prewarning-if-scheduled' to `t'. + +SCHEDULED + Meaning: you are planning to start working on that task on the + given date. + + The headline will be listed under the given date(1). In addition, + a reminder that the scheduled date has passed will be present in + the compilation for _today_, until the entry is marked DONE, i.e., + the task will automatically be forwarded until completed. + + *** TODO Call Trillian for a date on New Years Eve. + SCHEDULED: <2004-12-25 Sat> + + If you want to _delay_ the display of this task in the agenda, use + `SCHEDULED: <2004-12-25 Sat -2d>': the task is still scheduled on + the 25th but will appear two days later. In case the task + contains a repeater, the delay is considered to affect all + occurrences; if you want the delay to only affect the first + scheduled occurrence of the task, use `--2d' instead. See + `org-scheduled-delay-days' and + `org-agenda-skip-scheduled-delay-if-deadline' for details on how to + control this globally or per agenda. + + Important: Scheduling an item in Org mode should not be understood + in the same way that we understand scheduling a meeting. Setting + a date for a meeting is just a simple appointment, you should mark + this entry with a simple plain timestamp, to get this item shown + on the date where it applies. This is a frequent misunderstanding + by Org users. In Org mode, scheduling means setting a date when + you want to start working on an action item. + + You may use timestamps with repeaters in scheduling and deadline +entries. Org mode will issue early and late warnings based on the +assumption that the timestamp represents the nearest instance of the +repeater. However, the use of diary sexp entries like `<%%(diary-float +t 42)>' in scheduling and deadline timestamps is limited. Org mode +does not know enough about the internals of each sexp function to issue +early and late warnings. However, it will show the item on each day +where the sexp entry matches. + +* Menu: + +* Inserting deadline/schedule:: Planning items +* Repeated tasks:: Items that show up again and again + + ---------- Footnotes ---------- + + (1) It will still be listed on that date after it has been marked +DONE. If you don't like this, set the variable +`org-agenda-skip-scheduled-if-done'. + + +File: org, Node: Inserting deadline/schedule, Next: Repeated tasks, Prev: Deadlines and scheduling, Up: Deadlines and scheduling + +8.3.1 Inserting deadlines or schedules +-------------------------------------- + +The following commands allow you to quickly insert(1) a deadline or to +schedule an item: + +`C-c C-d (`org-deadline')' + Insert `DEADLINE' keyword along with a stamp. The insertion will + happen in the line directly following the headline. Any CLOSED + timestamp will be removed. When called with a prefix arg, an + existing deadline will be removed from the entry. Depending on + the variable `org-log-redeadline'(2), a note will be taken when + changing an existing deadline. + +`C-c C-s (`org-schedule')' + Insert `SCHEDULED' keyword along with a stamp. The insertion will + happen in the line directly following the headline. Any CLOSED + timestamp will be removed. When called with a prefix argument, + remove the scheduling date from the entry. Depending on the + variable `org-log-reschedule'(3), a note will be taken when + changing an existing scheduling time. + +`C-c C-x C-k (`org-mark-entry-for-agenda-action')' + Mark the current entry for agenda action. After you have marked + the entry like this, you can open the agenda or the calendar to + find an appropriate date. With the cursor on the selected date, + press `k s' or `k d' to schedule the marked item. + +`C-c / d (`org-check-deadlines')' + Create a sparse tree with all deadlines that are either past-due, + or which will become due within `org-deadline-warning-days'. With + `C-u' prefix, show all deadlines in the file. With a numeric + prefix, check that many days. For example, `C-1 C-c / d' shows + all deadlines due tomorrow. + +`C-c / b (`org-check-before-date')' + Sparse tree for deadlines and scheduled items before a given date. + +`C-c / a (`org-check-after-date')' + Sparse tree for deadlines and scheduled items after a given date. + + Note that `org-schedule' and `org-deadline' supports setting the +date by indicating a relative time: e.g., +1d will set the date to the +next day after today, and -1w will set the date to the previous week +before any current timestamp. + + ---------- Footnotes ---------- + + (1) The `SCHEDULED' and `DEADLINE' dates are inserted on the line +right below the headline. Don't put any text between this line and the +headline. + + (2) with corresponding `#+STARTUP' keywords `logredeadline', +`lognoteredeadline', and `nologredeadline' + + (3) with corresponding `#+STARTUP' keywords `logreschedule', +`lognotereschedule', and `nologreschedule' + + +File: org, Node: Repeated tasks, Prev: Inserting deadline/schedule, Up: Deadlines and scheduling + +8.3.2 Repeated tasks +-------------------- + +Some tasks need to be repeated again and again. Org mode helps to +organize such tasks using a so-called repeater in a DEADLINE, SCHEDULED, +or plain timestamp. In the following example + ** TODO Pay the rent + DEADLINE: <2005-10-01 Sat +1m> + the `+1m' is a repeater; the intended interpretation is that the task +has a deadline on <2005-10-01> and repeats itself every (one) month +starting from that time. You can use yearly, monthly, weekly, daily +and hourly repeat cookies by using the `y/w/m/d/h' letters. If you +need both a repeater and a special warning period in a deadline entry, +the repeater should come first and the warning period last: `DEADLINE: +<2005-10-01 Sat +1m -3d>'. + + Deadlines and scheduled items produce entries in the agenda when +they are over-due, so it is important to be able to mark such an entry +as completed once you have done so. When you mark a DEADLINE or a +SCHEDULE with the TODO keyword DONE, it will no longer produce entries +in the agenda. The problem with this is, however, that then also the +_next_ instance of the repeated entry will not be active. Org mode +deals with this in the following way: When you try to mark such an +entry DONE (using `C-c C-t'), it will shift the base date of the +repeating timestamp by the repeater interval, and immediately set the +entry state back to TODO(1). In the example above, setting the state +to DONE would actually switch the date like this: + + ** TODO Pay the rent + DEADLINE: <2005-11-01 Tue +1m> + + A timestamp(2) will be added under the deadline, to keep a record +that you actually acted on the previous instance of this deadline. + + As a consequence of shifting the base date, this entry will no +longer be visible in the agenda when checking past dates, but all +future instances will be visible. + + With the `+1m' cookie, the date shift will always be exactly one +month. So if you have not paid the rent for three months, marking this +entry DONE will still keep it as an overdue deadline. Depending on the +task, this may not be the best way to handle it. For example, if you +forgot to call your father for 3 weeks, it does not make sense to call +him 3 times in a single day to make up for it. Finally, there are tasks +like changing batteries which should always repeat a certain time after +the last time you did it. For these tasks, Org mode has special +repeaters `++' and `.+'. For example: + + ** TODO Call Father + DEADLINE: <2008-02-10 Sun ++1w> + Marking this DONE will shift the date by at least one week, + but also by as many weeks as it takes to get this date into + the future. However, it stays on a Sunday, even if you called + and marked it done on Saturday. + ** TODO Check the batteries in the smoke detectors + DEADLINE: <2005-11-01 Tue .+1m> + Marking this DONE will shift the date to one month after + today. + + You may have both scheduling and deadline information for a specific +task. If the repeater is set for the scheduling information only, you +probably want the repeater to be ignored after the deadline. If so, +set the variable `org-agenda-skip-scheduled-if-deadline-is-shown' to +`repeated-after-deadline'. If you want both scheduling and deadline +information to repeat after the same interval, set the same repeater +for both timestamps. + + An alternative to using a repeater is to create a number of copies +of a task subtree, with dates shifted in each copy. The command `C-c +C-x c' was created for this purpose, it is described in *note Structure +editing::. + + ---------- Footnotes ---------- + + (1) In fact, the target state is taken from, in this sequence, the +`REPEAT_TO_STATE' property or the variable `org-todo-repeat-to-state'. +If neither of these is specified, the target state defaults to the +first state of the TODO state sequence. + + (2) You can change this using the option `org-log-repeat', or the +`#+STARTUP' options `logrepeat', `lognoterepeat', and `nologrepeat'. +With `lognoterepeat', you will also be prompted for a note. + + +File: org, Node: Clocking work time, Next: Effort estimates, Prev: Deadlines and scheduling, Up: Dates and Times + +8.4 Clocking work time +====================== + +Org mode allows you to clock the time you spend on specific tasks in a +project. When you start working on an item, you can start the clock. +When you stop working on that task, or when you mark the task done, the +clock is stopped and the corresponding time interval is recorded. It +also computes the total time spent on each subtree(1) of a project. +And it remembers a history or tasks recently clocked, to that you can +jump quickly between a number of tasks absorbing your time. + + To save the clock history across Emacs sessions, use + (setq org-clock-persist 'history) + (org-clock-persistence-insinuate) + When you clock into a new task after resuming Emacs, the incomplete +clock(2) will be found (*note Resolving idle time::) and you will be +prompted about what to do with it. + +* Menu: + +* Clocking commands:: Starting and stopping a clock +* The clock table:: Detailed reports +* Resolving idle time:: Resolving time when you've been idle + + ---------- Footnotes ---------- + + (1) Clocking only works if all headings are indented with less than +30 stars. This is a hardcoded limitation of `lmax' in `org-clock-sum'. + + (2) To resume the clock under the assumption that you have worked on +this task while outside Emacs, use `(setq org-clock-persist t)'. + + +File: org, Node: Clocking commands, Next: The clock table, Prev: Clocking work time, Up: Clocking work time + +8.4.1 Clocking commands +----------------------- + +`C-c C-x C-i (`org-clock-in')' + Start the clock on the current item (clock-in). This inserts the + CLOCK keyword together with a timestamp. If this is not the first + clocking of this item, the multiple CLOCK lines will be wrapped + into a `:LOGBOOK:' drawer (see also the variable + `org-clock-into-drawer'). You can also overrule the setting of + this variable for a subtree by setting a `CLOCK_INTO_DRAWER' or + `LOG_INTO_DRAWER' property. When called with a `C-u' prefix + argument, select the task from a list of recently clocked tasks. + With two `C-u C-u' prefixes, clock into the task at point and mark + it as the default task; the default task will then always be + available with letter `d' when selecting a clocking task. With + three `C-u C-u C-u' prefixes, force continuous clocking by + starting the clock when the last clock stopped. + While the clock is running, the current clocking time is shown in + the mode line, along with the title of the task. The clock time + shown will be all time ever clocked for this task and its + children. If the task has an effort estimate (*note Effort + estimates::), the mode line displays the current clocking time + against it(1) If the task is a repeating one (*note Repeated + tasks::), only the time since the last reset of the task (2) will + be shown. More control over what time is shown can be exercised + with the `CLOCK_MODELINE_TOTAL' property. It may have the values + `current' to show only the current clocking instance, `today' to + show all time clocked on this tasks today (see also the variable + `org-extend-today-until'), `all' to include all time, or `auto' + which is the default(3). + Clicking with `mouse-1' onto the mode line entry will pop up a + menu with clocking options. + +`C-c C-x C-o (`org-clock-out')' + Stop the clock (clock-out). This inserts another timestamp at the + same location where the clock was last started. It also directly + computes the resulting time in inserts it after the time range as + `=> HH:MM'. See the variable `org-log-note-clock-out' for the + possibility to record an additional note together with the + clock-out timestamp(4). + +`C-c C-x C-x (`org-clock-in-last')' + Reclock the last clocked task. With one `C-u' prefix argument, + select the task from the clock history. With two `C-u' prefixes, + force continuous clocking by starting the clock when the last clock + stopped. + +`C-c C-x C-e (`org-clock-modify-effort-estimate')' + Update the effort estimate for the current clock task. + +`C-c C-c or C-c C-y (`org-evaluate-time-range')' + Recompute the time interval after changing one of the timestamps. + This is only necessary if you edit the timestamps directly. If + you change them with `S-' keys, the update is automatic. + +`C-S- (`org-clock-timestamps-up/down')' + On `CLOCK' log lines, increase/decrease both timestamps so that the + clock duration keeps the same. + +`S-M- (`org-timestamp-up/down')' + On `CLOCK' log lines, increase/decrease the timestamp at point and + the one of the previous (or the next clock) timestamp by the same + duration. For example, if you hit `S-M-' to increase a + clocked-out timestamp by five minutes, then the clocked-in + timestamp of the next clock will be increased by five minutes. + +`C-c C-t (`org-todo')' + Changing the TODO state of an item to DONE automatically stops the + clock if it is running in this same item. + +`C-c C-x C-q (`org-clock-cancel')' + Cancel the current clock. This is useful if a clock was started by + mistake, or if you ended up working on something else. + +`C-c C-x C-j (`org-clock-goto')' + Jump to the headline of the currently clocked in task. With a + `C-u' prefix arg, select the target task from a list of recently + clocked tasks. + +`C-c C-x C-d (`org-clock-display')' + Display time summaries for each subtree in the current buffer. + This puts overlays at the end of each headline, showing the total + time recorded under that heading, including the time of any + subheadings. You can use visibility cycling to study the tree, + but the overlays disappear when you change the buffer (see + variable `org-remove-highlights-with-change') or press `C-c C-c'. + + The `l' key may be used in the timeline (*note Timeline::) and in +the agenda (*note Weekly/daily agenda::) to show which tasks have been +worked on or closed during a day. + + *Important:* note that both `org-clock-out' and `org-clock-in-last' +can have a global keybinding and will not modify the window disposition. + + ---------- Footnotes ---------- + + (1) To add an effort estimate "on the fly", hook a function doing +this to `org-clock-in-prepare-hook'. + + (2) as recorded by the `LAST_REPEAT' property + + (3) See also the variable `org-clock-modeline-total'. + + (4) The corresponding in-buffer setting is: `#+STARTUP: +lognoteclock-out' + + +File: org, Node: The clock table, Next: Resolving idle time, Prev: Clocking commands, Up: Clocking work time + +8.4.2 The clock table +--------------------- + +Org mode can produce quite complex reports based on the time clocking +information. Such a report is called a _clock table_, because it is +formatted as one or several Org tables. + +`C-c C-x C-r (`org-clock-report')' + Insert a dynamic block (*note Dynamic blocks::) containing a clock + report as an Org mode table into the current file. When the + cursor is at an existing clock table, just update it. When called + with a prefix argument, jump to the first clock report in the + current document and update it. The clock table always includes + also trees with `:ARCHIVE:' tag. + +`C-c C-c or C-c C-x C-u (`org-dblock-update')' + Update dynamic block at point. The cursor needs to be in the + `#+BEGIN' line of the dynamic block. + +`C-u C-c C-x C-u' + Update all dynamic blocks (*note Dynamic blocks::). This is + useful if you have several clock table blocks in a buffer. + +`S-' +`S- (`org-clocktable-try-shift')' + Shift the current `:block' interval and update the table. The + cursor needs to be in the `#+BEGIN: clocktable' line for this + command. If `:block' is `today', it will be shifted to `today-1' + etc. + + Here is an example of the frame for a clock table as it is inserted +into the buffer with the `C-c C-x C-r' command: + + #+BEGIN: clocktable :maxlevel 2 :emphasize nil :scope file + #+END: clocktable + The `BEGIN' line and specify a number of options to define the scope, +structure, and formatting of the report. Defaults for all these +options can be configured in the variable `org-clocktable-defaults'. + +First there are options that determine which clock entries are to be +selected: + :maxlevel Maximum level depth to which times are listed in the table. + Clocks at deeper levels will be summed into the upper level. + :scope The scope to consider. This can be any of the following: + nil the current buffer or narrowed region + file the full current buffer + subtree the subtree where the clocktable is located + treeN the surrounding level N tree, for example `tree3' + tree the surrounding level 1 tree + agenda all agenda files + ("file"..) scan these files + file-with-archives current file and its archives + agenda-with-archives all agenda files, including archives + :block The time block to consider. This block is specified either + absolute, or relative to the current time and may be any of + these formats: + 2007-12-31 New year eve 2007 + 2007-12 December 2007 + 2007-W50 ISO-week 50 in 2007 + 2007-Q2 2nd quarter in 2007 + 2007 the year 2007 + today, yesterday, today-N a relative day + thisweek, lastweek, thisweek-N a relative week + thismonth, lastmonth, thismonth-N a relative month + thisyear, lastyear, thisyear-N a relative year + Use `S-/' keys to shift the time interval. + :tstart A time string specifying when to start considering times. + Relative times like `"<-2w>"' can also be used. See + *note Matching tags and properties:: for relative time syntax. + :tend A time string specifying when to stop considering times. + Relative times like `""' can also be used. See + *note Matching tags and properties:: for relative time syntax. + :wstart The starting day of the week. The default is 1 for monday. + :mstart The starting day of the month. The default 1 is for the first + day of the month. + :step `week' or `day', to split the table into chunks. + To use this, `:block' or `:tstart', `:tend' are needed. + :stepskip0 Do not show steps that have zero time. + :fileskip0 Do not show table sections from files which did not contribute. + :tags A tags match to select entries that should contribute. See + *note Matching tags and properties:: for the match syntax. + + Then there are options which determine the formatting of the table. +There options are interpreted by the function +`org-clocktable-write-default', but you can specify your own function +using the `:formatter' parameter. + :emphasize When `t', emphasize level one and level two items. + :lang Language(1) to use for descriptive cells like "Task". + :link Link the item headlines in the table to their origins. + :narrow An integer to limit the width of the headline column in + the org table. If you write it like `50!', then the + headline will also be shortened in export. + :indent Indent each headline field according to its level. + :tcolumns Number of columns to be used for times. If this is smaller + than `:maxlevel', lower levels will be lumped into one column. + :level Should a level number column be included? + :compact Abbreviation for `:level nil :indent t :narrow 40! :tcolumns 1' + All are overwritten except if there is an explicit `:narrow' + :timestamp A timestamp for the entry, when available. Look for SCHEDULED, + DEADLINE, TIMESTAMP and TIMESTAMP_IA, in this order. + :properties List of properties that should be shown in the table. Each + property will get its own column. + :inherit-props When this flag is `t', the values for `:properties' will be inherited. + :formula Content of a `#+TBLFM' line to be added and evaluated. + As a special case, `:formula %' adds a column with % time. + If you do not specify a formula here, any existing formula + below the clock table will survive updates and be evaluated. + :formatter A function to format clock data and insert it into the buffer. + To get a clock summary of the current level 1 tree, for the current +day, you could write + #+BEGIN: clocktable :maxlevel 2 :block today :scope tree1 :link t + #+END: clocktable + and to use a specific time range you could write(2) + #+BEGIN: clocktable :tstart "<2006-08-10 Thu 10:00>" + :tend "<2006-08-10 Thu 12:00>" + #+END: clocktable + A range starting a week ago and ending right now could be written as + #+BEGIN: clocktable :tstart "<-1w>" :tend "" + #+END: clocktable + A summary of the current subtree with % times would be + #+BEGIN: clocktable :scope subtree :link t :formula % + #+END: clocktable + A horizontally compact representation of everything clocked during +last week would be + #+BEGIN: clocktable :scope agenda :block lastweek :compact t + #+END: clocktable + + ---------- Footnotes ---------- + + (1) Language terms can be set through the variable +`org-clock-clocktable-language-setup'. + + (2) Note that all parameters must be specified in a single line--the +line is broken here only to fit it into the manual. + + +File: org, Node: Resolving idle time, Prev: The clock table, Up: Clocking work time + +8.4.3 Resolving idle time and continuous clocking +------------------------------------------------- + +Resolving idle time +................... + +If you clock in on a work item, and then walk away from your +computer--perhaps to take a phone call--you often need to "resolve" the +time you were away by either subtracting it from the current clock, or +applying it to another one. + + By customizing the variable `org-clock-idle-time' to some integer, +such as 10 or 15, Emacs can alert you when you get back to your +computer after being idle for that many minutes(1), and ask what you +want to do with the idle time. There will be a question waiting for +you when you get back, indicating how much idle time has passed +(constantly updated with the current amount), as well as a set of +choices to correct the discrepancy: + +`k' + To keep some or all of the minutes and stay clocked in, press `k'. + Org will ask how many of the minutes to keep. Press to keep + them all, effectively changing nothing, or enter a number to keep + that many minutes. + +`K' + If you use the shift key and press `K', it will keep however many + minutes you request and then immediately clock out of that task. + If you keep all of the minutes, this is the same as just clocking + out of the current task. + +`s' + To keep none of the minutes, use `s' to subtract all the away time + from the clock, and then check back in from the moment you + returned. + +`S' + To keep none of the minutes and just clock out at the start of the + away time, use the shift key and press `S'. Remember that using + shift will always leave you clocked out, no matter which option + you choose. + +`C' + To cancel the clock altogether, use `C'. Note that if instead of + canceling you subtract the away time, and the resulting clock + amount is less than a minute, the clock will still be canceled + rather than clutter up the log with an empty entry. + + What if you subtracted those away minutes from the current clock, +and now want to apply them to a new clock? Simply clock in to any task +immediately after the subtraction. Org will notice that you have +subtracted time "on the books", so to speak, and will ask if you want +to apply those minutes to the next task you clock in on. + + There is one other instance when this clock resolution magic occurs. +Say you were clocked in and hacking away, and suddenly your cat chased +a mouse who scared a hamster that crashed into your UPS's power button! +You suddenly lose all your buffers, but thanks to auto-save you still +have your recent Org mode changes, including your last clock in. + + If you restart Emacs and clock into any task, Org will notice that +you have a dangling clock which was never clocked out from your last +session. Using that clock's starting time as the beginning of the +unaccounted-for period, Org will ask how you want to resolve that time. +The logic and behavior is identical to dealing with away time due to +idleness; it is just happening due to a recovery event rather than a +set amount of idle time. + + You can also check all the files visited by your Org agenda for +dangling clocks at any time using `M-x org-resolve-clocks RET' (or `C-c +C-x C-z'). + +Continuous clocking +................... + +You may want to start clocking from the time when you clocked out the +previous task. To enable this systematically, set +`org-clock-continuously' to `t'. Each time you clock in, Org retrieves +the clock-out time of the last clocked entry for this session, and +start the new clock from there. + + If you only want this from time to time, use three universal prefix +arguments with `org-clock-in' and two `C-u C-u' with +`org-clock-in-last'. + + ---------- Footnotes ---------- + + (1) On computers using Mac OS X, idleness is based on actual user +idleness, not just Emacs' idle time. For X11, you can install a +utility program `x11idle.c', available in the `contrib/scripts' +directory of the Org git distribution, or install the `xprintidle' +package and set it to the variable `org-clock-x11idle-program-name' if +you are running Debian, to get the same general treatment of idleness. +On other systems, idle time refers to Emacs idle time only. + + +File: org, Node: Effort estimates, Next: Relative timer, Prev: Clocking work time, Up: Dates and Times + +8.5 Effort estimates +==================== + +If you want to plan your work in a very detailed way, or if you need to +produce offers with quotations of the estimated work effort, you may +want to assign effort estimates to entries. If you are also clocking +your work, you may later want to compare the planned effort with the +actual working time, a great way to improve planning estimates. Effort +estimates are stored in a special property `EFFORT'. You can set the +effort for an entry with the following commands: + +`C-c C-x e (`org-set-effort')' + Set the effort estimate for the current entry. With a numeric + prefix argument, set it to the Nth allowed value (see below). + This command is also accessible from the agenda with the `e' key. + +`C-c C-x C-e (`org-clock-modify-effort-estimate')' + Modify the effort estimate of the item currently being clocked. + + Clearly the best way to work with effort estimates is through column +view (*note Column view::). You should start by setting up discrete +values for effort estimates, and a `COLUMNS' format that displays these +values together with clock sums (if you want to clock your time). For +a specific buffer you can use + + #+PROPERTY: Effort_ALL 0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 + #+COLUMNS: %40ITEM(Task) %17Effort(Estimated Effort){:} %CLOCKSUM + +or, even better, you can set up these values globally by customizing the +variables `org-global-properties' and `org-columns-default-format'. In +particular if you want to use this setup also in the agenda, a global +setup may be advised. + + The way to assign estimates to individual items is then to switch to +column mode, and to use `S-' and `S-' to change the value. +The values you enter will immediately be summed up in the hierarchy. +In the column next to it, any clocked time will be displayed. + + If you switch to column view in the daily/weekly agenda, the effort +column will summarize the estimated work effort for each day(1), and +you can use this to find space in your schedule. To get an overview of +the entire part of the day that is committed, you can set the option +`org-agenda-columns-add-appointments-to-effort-sum'. The appointments +on a day that take place over a specified time interval will then also +be added to the load estimate of the day. + + Effort estimates can be used in secondary agenda filtering that is +triggered with the `/' key in the agenda (*note Agenda commands::). If +you have these estimates defined consistently, two or three key presses +will narrow down the list to stuff that fits into an available time +slot. + + ---------- Footnotes ---------- + + (1) Please note the pitfalls of summing hierarchical data in a flat +list (*note Agenda column view::). + + +File: org, Node: Relative timer, Next: Countdown timer, Prev: Effort estimates, Up: Dates and Times + +8.6 Taking notes with a relative timer +====================================== + +When taking notes during, for example, a meeting or a video viewing, it +can be useful to have access to times relative to a starting time. Org +provides such a relative timer and make it easy to create timed notes. + +`C-c C-x . (`org-timer')' + Insert a relative time into the buffer. The first time you use + this, the timer will be started. When called with a prefix + argument, the timer is restarted. + +`C-c C-x - (`org-timer-item')' + Insert a description list item with the current relative time. + With a prefix argument, first reset the timer to 0. + +`M- (`org-insert-heading')' + Once the timer list is started, you can also use `M-' to + insert new timer items. + +`C-c C-x ,' + Pause the timer, or continue it if it is already paused + (`org-timer-pause-or-continue'). + +`C-u C-c C-x ,' + Stop the timer. After this, you can only start a new timer, not + continue the old one. This command also removes the timer from + the mode line. + +`C-c C-x 0 (`org-timer-start')' + Reset the timer without inserting anything into the buffer. By + default, the timer is reset to 0. When called with a `C-u' + prefix, reset the timer to specific starting offset. The user is + prompted for the offset, with a default taken from a timer string + at point, if any, So this can be used to restart taking notes + after a break in the process. When called with a double prefix + argument `C-u C-u', change all timer strings in the active region + by a certain amount. This can be used to fix timer strings if the + timer was not started at exactly the right moment. + + +File: org, Node: Countdown timer, Prev: Relative timer, Up: Dates and Times + +8.7 Countdown timer +=================== + +Calling `org-timer-set-timer' from an Org mode buffer runs a countdown +timer. Use `;' from agenda buffers, everywhere else. + + `org-timer-set-timer' prompts the user for a duration and displays a +countdown timer in the modeline. `org-timer-default-timer' sets the +default countdown value. Giving a prefix numeric argument overrides +this default value. + + +File: org, Node: Capture - Refile - Archive, Next: Agenda Views, Prev: Dates and Times, Up: Top + +9 Capture - Refile - Archive +**************************** + +An important part of any organization system is the ability to quickly +capture new ideas and tasks, and to associate reference material with +them. Org does this using a process called capture. It also can store +files related to a task (attachments) in a special directory. Once in +the system, tasks and projects need to be moved around. Moving +completed project trees to an archive file keeps the system compact and +fast. + +* Menu: + +* Capture:: Capturing new stuff +* Attachments:: Add files to tasks +* RSS Feeds:: Getting input from RSS feeds +* Protocols:: External (e.g., Browser) access to Emacs and Org +* Refile and copy:: Moving/copying a tree from one place to another +* Archiving:: What to do with finished projects + + +File: org, Node: Capture, Next: Attachments, Prev: Capture - Refile - Archive, Up: Capture - Refile - Archive + +9.1 Capture +=========== + +Capture lets you quickly store notes with little interruption of your +work flow. Org's method for capturing new items is heavily inspired by +John Wiegley excellent `remember.el' package. Up to version 6.36, Org +used a special setup for `remember.el', then replaced it with +`org-remember.el'. As of version 8.0, `org-remember.el' has been +completely replaced by `org-capture.el'. + + If your configuration depends on `org-remember.el', you need to +update it and use the setup described below. To convert your +`org-remember-templates', run the command + M-x org-capture-import-remember-templates RET + and then customize the new variable with `M-x customize-variable +org-capture-templates', check the result, and save the customization. + +* Menu: + +* Setting up capture:: Where notes will be stored +* Using capture:: Commands to invoke and terminate capture +* Capture templates:: Define the outline of different note types + + +File: org, Node: Setting up capture, Next: Using capture, Prev: Capture, Up: Capture + +9.1.1 Setting up capture +------------------------ + +The following customization sets a default target file for notes, and +defines a global key(1) for capturing new material. + + (setq org-default-notes-file (concat org-directory "/notes.org")) + (define-key global-map "\C-cc" 'org-capture) + + ---------- Footnotes ---------- + + (1) Please select your own key, `C-c c' is only a suggestion. + + +File: org, Node: Using capture, Next: Capture templates, Prev: Setting up capture, Up: Capture + +9.1.2 Using capture +------------------- + +`C-c c (`org-capture')' + Call the command `org-capture'. Note that this keybinding is + global and not active by default: you need to install it. If you + have templates defined *note Capture templates::, it will offer + these templates for selection or use a new Org outline node as the + default template. It will insert the template into the target + file and switch to an indirect buffer narrowed to this new node. + You may then insert the information you want. + +`C-c C-c (`org-capture-finalize')' + Once you have finished entering information into the capture + buffer, `C-c C-c' will return you to the window configuration + before the capture process, so that you can resume your work + without further distraction. When called with a prefix arg, + finalize and then jump to the captured item. + +`C-c C-w (`org-capture-refile')' + Finalize the capture process by refiling (*note Refile and copy::) + the note to a different place. Please realize that this is a + normal refiling command that will be executed--so the cursor + position at the moment you run this command is important. If you + have inserted a tree with a parent and children, first move the + cursor back to the parent. Any prefix argument given to this + command will be passed on to the `org-refile' command. + +`C-c C-k (`org-capture-kill')' + Abort the capture process and return to the previous state. + + + You can also call `org-capture' in a special way from the agenda, +using the `k c' key combination. With this access, any timestamps +inserted by the selected capture template will default to the cursor +date in the agenda, rather than to the current date. + + To find the locations of the last stored capture, use `org-capture' +with prefix commands: + +`C-u C-c c' + Visit the target location of a capture template. You get to + select the template in the usual way. + +`C-u C-u C-c c' + Visit the last stored capture item in its buffer. + + You can also jump to the bookmark `org-capture-last-stored', which +will automatically be created unless you set `org-capture-bookmark' to +`nil'. + + To insert the capture at point in an Org buffer, call `org-capture' +with a `C-0' prefix argument. + + +File: org, Node: Capture templates, Prev: Using capture, Up: Capture + +9.1.3 Capture templates +----------------------- + +You can use templates for different types of capture items, and for +different target locations. The easiest way to create such templates is +through the customize interface. + +`C-c c C' + Customize the variable `org-capture-templates'. + + Before we give the formal description of template definitions, let's +look at an example. Say you would like to use one template to create +general TODO entries, and you want to put these entries under the +heading `Tasks' in your file `~/org/gtd.org'. Also, a date tree in the +file `journal.org' should capture journal entries. A possible +configuration would look like: + + (setq org-capture-templates + '(("t" "Todo" entry (file+headline "~/org/gtd.org" "Tasks") + "* TODO %?\n %i\n %a") + ("j" "Journal" entry (file+datetree "~/org/journal.org") + "* %?\nEntered on %U\n %i\n %a"))) + +If you then press `C-c c t', Org will prepare the template for you like +this: + * TODO + [[file:LINK TO WHERE YOU INITIATED CAPTURE]] + +During expansion of the template, `%a' has been replaced by a link to +the location from where you called the capture command. This can be +extremely useful for deriving tasks from emails, for example. You fill +in the task definition, press `C-c C-c' and Org returns you to the same +place where you started the capture process. + + To define special keys to capture to a particular template without +going through the interactive template selection, you can create your +key binding like this: + + (define-key global-map "\C-cx" + (lambda () (interactive) (org-capture nil "x"))) + +* Menu: + +* Template elements:: What is needed for a complete template entry +* Template expansion:: Filling in information about time and context +* Templates in contexts:: Only show a template in a specific context + + +File: org, Node: Template elements, Next: Template expansion, Prev: Capture templates, Up: Capture templates + +9.1.3.1 Template elements +......................... + +Now lets look at the elements of a template definition. Each entry in +`org-capture-templates' is a list with the following items: + +KEYS + The keys that will select the template, as a string, characters + only, for example `"a"' for a template to be selected with a + single key, or `"bt"' for selection with two keys. When using + several keys, keys using the same prefix key must be sequential in + the list and preceded by a 2-element entry explaining the prefix + key, for example + ("b" "Templates for marking stuff to buy") + If you do not define a template for the `C' key, this key will be + used to open the customize buffer for this complex variable. + +DESCRIPTION + A short string describing the template, which will be shown during + selection. + +TYPE + The type of entry, a symbol. Valid values are: + + `entry' + An Org mode node, with a headline. Will be filed as the + child of the target entry or as a top-level entry. The + target file should be an Org mode file. + + `item' + A plain list item, placed in the first plain list at the + target location. Again the target file should be an Org file. + + `checkitem' + A checkbox item. This only differs from the plain list item + by the default template. + + `table-line' + a new line in the first table at the target location. Where + exactly the line will be inserted depends on the properties + `:prepend' and `:table-line-pos' (see below). + + `plain' + Text to be inserted as it is. + +TARGET + Specification of where the captured item should be placed. In Org + mode files, targets usually define a node. Entries will become + children of this node. Other types will be added to the table or + list in the body of this node. Most target specifications contain + a file name. If that file name is the empty string, it defaults + to `org-default-notes-file'. A file can also be given as a + variable, function, or Emacs Lisp form. + + Valid values are: + + `(file "path/to/file")' + Text will be placed at the beginning or end of that file. + + `(id "id of existing org entry")' + Filing as child of this entry, or in the body of the entry. + + `(file+headline "path/to/file" "node headline")' + Fast configuration if the target heading is unique in the + file. + + `(file+olp "path/to/file" "Level 1 heading" "Level 2" ...)' + For non-unique headings, the full path is safer. + + `(file+regexp "path/to/file" "regexp to find location")' + Use a regular expression to position the cursor. + + `(file+datetree "path/to/file")' + Will create a heading in a date tree for today's date(1). + + `(file+datetree+prompt "path/to/file")' + Will create a heading in a date tree, but will prompt for the + date. + + `(file+function "path/to/file" function-finding-location)' + A function to find the right location in the file. + + `(clock)' + File to the entry that is currently being clocked. + + `(function function-finding-location)' + Most general way, write your own function to find both file + and location. + +TEMPLATE + The template for creating the capture item. If you leave this + empty, an appropriate default template will be used. Otherwise + this is a string with escape codes, which will be replaced + depending on time and context of the capture call. The string + with escapes may be loaded from a template file, using the special + syntax `(file "path/to/template")'. See below for more details. + +PROPERTIES + The rest of the entry is a property list of additional options. + Recognized properties are: + + `:prepend' + Normally new captured information will be appended at the + target location (last child, last table line, last list + item...). Setting this property will change that. + + `:immediate-finish' + When set, do not offer to edit the information, just file it + away immediately. This makes sense if the template only needs + information that can be added automatically. + + `:empty-lines' + Set this to the number of lines to insert before and after + the new item. Default 0, only common other value is 1. + + `:clock-in' + Start the clock in this item. + + `:clock-keep' + Keep the clock running when filing the captured entry. + + `:clock-resume' + If starting the capture interrupted a clock, restart that + clock when finished with the capture. Note that + `:clock-keep' has precedence over `:clock-resume'. When + setting both to `t', the current clock will run and the + previous one will not be resumed. + + `:unnarrowed' + Do not narrow the target buffer, simply show the full buffer. + Default is to narrow it so that you only see the new material. + + `:table-line-pos' + Specification of the location in the table where the new line + should be inserted. It should be a string like `"II-3"' + meaning that the new line should become the third line before + the second horizontal separator line. + + `:kill-buffer' + If the target file was not yet visited when capture was + invoked, kill the buffer again after capture is completed. + + ---------- Footnotes ---------- + + (1) Datetree headlines for years accept tags, so if you use both `* +2013 :noexport:' and `* 2013' in your file, the capture will refile the +note to the first one matched. + + +File: org, Node: Template expansion, Next: Templates in contexts, Prev: Template elements, Up: Capture templates + +9.1.3.2 Template expansion +.......................... + +In the template itself, special `%'-escapes(1) allow dynamic insertion +of content. The templates are expanded in the order given here: + + %[FILE] Insert the contents of the file given by FILE. + %(SEXP) Evaluate Elisp SEXP and replace with the result. + For convenience, %:keyword (see below) placeholders + within the expression will be expanded prior to this. + The sexp must return a string. + %<...> The result of format-time-string on the ... format specification. + %t Timestamp, date only. + %T Timestamp, with date and time. + %u, %U Like the above, but inactive timestamps. + %i Initial content, the region when capture is called while the + region is active. + The entire text will be indented like `%i' itself. + %a Annotation, normally the link created with `org-store-link'. + %A Like `%a', but prompt for the description part. + %l Like %a, but only insert the literal link. + %c Current kill ring head. + %x Content of the X clipboard. + %k Title of the currently clocked task. + %K Link to the currently clocked task. + %n User name (taken from `user-full-name'). + %f File visited by current buffer when org-capture was called. + %F Full path of the file or directory visited by current buffer. + %:keyword Specific information for certain link types, see below. + %^g Prompt for tags, with completion on tags in target file. + %^G Prompt for tags, with completion all tags in all agenda files. + %^t Like `%t', but prompt for date. Similarly `%^T', `%^u', `%^U'. + You may define a prompt like `%^{Birthday}t'. + %^C Interactive selection of which kill or clip to use. + %^L Like `%^C', but insert as link. + %^{PROP}p Prompt the user for a value for property PROP. + %^{PROMPT} prompt the user for a string and replace this sequence with it. + You may specify a default value and a completion table with + %^{prompt|default|completion2|completion3...}. + The arrow keys access a prompt-specific history. + %\\n Insert the text entered at the nth %^{PROMPT}, where `n' is + a number, starting from 1. + %? After completing the template, position cursor here. + +For specific link types, the following keywords will be defined(2): + + Link type | Available keywords + ---------------------------------+---------------------------------------------- + bbdb | %:name %:company + irc | %:server %:port %:nick + vm, vm-imap, wl, mh, mew, rmail | %:type %:subject %:message-id + | %:from %:fromname %:fromaddress + | %:to %:toname %:toaddress + | %:date (message date header field) + | %:date-timestamp (date as active timestamp) + | %:date-timestamp-inactive (date as inactive timestamp) + | %:fromto (either "to NAME" or "from NAME")(3) + gnus | %:group, for messages also all email fields + w3, w3m | %:url + info | %:file %:node + calendar | %:date + +To place the cursor after template expansion use: + + %? After completing the template, position cursor here. + + ---------- Footnotes ---------- + + (1) If you need one of these sequences literally, escape the `%' +with a backslash. + + (2) If you define your own link types (*note Adding hyperlink +types::), any property you store with `org-store-link-props' can be +accessed in capture templates in a similar way. + + (3) This will always be the other, not the user. See the variable +`org-from-is-user-regexp'. + + +File: org, Node: Templates in contexts, Prev: Template expansion, Up: Capture templates + +9.1.3.3 Templates in contexts +............................. + +To control whether a capture template should be accessible from a +specific context, you can customize `org-capture-templates-contexts'. +Let's say for example that you have a capture template `"p"' for +storing Gnus emails containing patches. Then you would configure this +option like this: + + (setq org-capture-templates-contexts + '(("p" (in-mode . "message-mode")))) + + You can also tell that the command key `"p"' should refer to another +template. In that case, add this command key like this: + + (setq org-capture-templates-contexts + '(("p" "q" (in-mode . "message-mode")))) + + See the docstring of the variable for more information. + + +File: org, Node: Attachments, Next: RSS Feeds, Prev: Capture, Up: Capture - Refile - Archive + +9.2 Attachments +=============== + +It is often useful to associate reference material with an outline +node/task. Small chunks of plain text can simply be stored in the +subtree of a project. Hyperlinks (*note Hyperlinks::) can establish +associations with files that live elsewhere on your computer or in the +cloud, like emails or source code files belonging to a project. +Another method is attachments, which are files located in a directory +belonging to an outline node. Org uses directories named by the unique +ID of each entry. These directories are located in the `data' +directory which lives in the same directory where your Org file +lives(1). If you initialize this directory with `git init', Org will +automatically commit changes when it sees them. The attachment system +has been contributed to Org by John Wiegley. + + In cases where it seems better to do so, you can also attach a +directory of your choice to an entry. You can also make children +inherit the attachment directory from a parent, so that an entire +subtree uses the same attached directory. + +The following commands deal with attachments: + +`C-c C-a (`org-attach')' + The dispatcher for commands related to the attachment system. + After these keys, a list of commands is displayed and you must + press an additional key to select a command: + + `a (`org-attach-attach')' + Select a file and move it into the task's attachment + directory. The file will be copied, moved, or linked, + depending on `org-attach-method'. Note that hard links are + not supported on all systems. + + `c/m/l' + Attach a file using the copy/move/link method. Note that + hard links are not supported on all systems. + + `n (`org-attach-new')' + Create a new attachment as an Emacs buffer. + + `z (`org-attach-sync')' + Synchronize the current task with its attachment directory, + in case you added attachments yourself. + + `o (`org-attach-open')' + Open current task's attachment. If there is more than one, + prompt for a file name first. Opening will follow the rules + set by `org-file-apps'. For more details, see the + information on following hyperlinks (*note Handling links::). + + `O (`org-attach-open-in-emacs')' + Also open the attachment, but force opening the file in Emacs. + + `f (`org-attach-reveal')' + Open the current task's attachment directory. + + `F (`org-attach-reveal-in-emacs')' + Also open the directory, but force using `dired' in Emacs. + + `d (`org-attach-delete-one')' + Select and delete a single attachment. + + `D (`org-attach-delete-all')' + Delete all of a task's attachments. A safer way is to open + the directory in `dired' and delete from there. + + `s (`org-attach-set-directory')' + Set a specific directory as the entry's attachment directory. + This works by putting the directory path into the + `ATTACH_DIR' property. + + `i (`org-attach-set-inherit')' + Set the `ATTACH_DIR_INHERIT' property, so that children will + use the same directory for attachments as the parent does. + + ---------- Footnotes ---------- + + (1) If you move entries or Org files from one directory to another, +you may want to configure `org-attach-directory' to contain an absolute +path. + + +File: org, Node: RSS Feeds, Next: Protocols, Prev: Attachments, Up: Capture - Refile - Archive + +9.3 RSS feeds +============= + +Org can add and change entries based on information found in RSS feeds +and Atom feeds. You could use this to make a task out of each new +podcast in a podcast feed. Or you could use a phone-based +note-creating service on the web to import tasks into Org. To access +feeds, configure the variable `org-feed-alist'. The docstring of this +variable has detailed information. Here is just an example: + + (setq org-feed-alist + '(("Slashdot" + "http://rss.slashdot.org/Slashdot/slashdot" + "~/txt/org/feeds.org" "Slashdot Entries"))) + +will configure that new items from the feed provided by +`rss.slashdot.org' will result in new entries in the file +`~/org/feeds.org' under the heading `Slashdot Entries', whenever the +following command is used: + +`C-c C-x g (`org-feed-update-all')' + +`C-c C-x g' + Collect items from the feeds configured in `org-feed-alist' and + act upon them. + +`C-c C-x G (`org-feed-goto-inbox')' + Prompt for a feed name and go to the inbox configured for this + feed. + + Under the same headline, Org will create a drawer `FEEDSTATUS' in +which it will store information about the status of items in the feed, +to avoid adding the same item several times. You should add +`FEEDSTATUS' to the list of drawers in that file: + + #+DRAWERS: LOGBOOK PROPERTIES FEEDSTATUS + + For more information, including how to read atom feeds, see +`org-feed.el' and the docstring of `org-feed-alist'. + + +File: org, Node: Protocols, Next: Refile and copy, Prev: RSS Feeds, Up: Capture - Refile - Archive + +9.4 Protocols for external access +================================= + +You can set up Org for handling protocol calls from outside +applications that are passed to Emacs through the `emacsserver'. For +example, you can configure bookmarks in your web browser to send a link +to the current page to Org and create a note from it using capture +(*note Capture::). Or you could create a bookmark that will tell Emacs +to open the local source file of a remote website you are looking at +with the browser. See +`http://orgmode.org/worg/org-contrib/org-protocol.php' for detailed +documentation and setup instructions. + + +File: org, Node: Refile and copy, Next: Archiving, Prev: Protocols, Up: Capture - Refile - Archive + +9.5 Refile and copy +=================== + +When reviewing the captured data, you may want to refile or to copy +some of the entries into a different list, for example into a project. +Cutting, finding the right location, and then pasting the note is +cumbersome. To simplify this process, you can use the following +special command: + +`C-c M-w (`org-copy')' + Copying works like refiling, except that the original note is not + deleted. + +`C-c C-w (`org-refile')' + Refile the entry or region at point. This command offers possible + locations for refiling the entry and lets you select one with + completion. The item (or all items in the region) is filed below + the target heading as a subitem. Depending on + `org-reverse-note-order', it will be either the first or last + subitem. + By default, all level 1 headlines in the current buffer are + considered to be targets, but you can have more complex + definitions across a number of files. See the variable + `org-refile-targets' for details. If you would like to select a + location via a file-path-like completion along the outline path, + see the variables `org-refile-use-outline-path' and + `org-outline-path-complete-in-steps'. If you would like to be + able to create new nodes as new parents for refiling on the fly, + check the variable `org-refile-allow-creating-parent-nodes'. When + the variable `org-log-refile'(1) is set, a timestamp or a note + will be recorded when an entry has been refiled. + +`C-u C-c C-w' + Use the refile interface to jump to a heading. + +`C-u C-u C-c C-w (`org-refile-goto-last-stored')' + Jump to the location where `org-refile' last moved a tree to. + +`C-2 C-c C-w' + Refile as the child of the item currently being clocked. + +`C-3 C-c C-w' + Refile and keep the entry in place. Also see `org-refile-keep' to + make this the default behavior, and beware that this may result in + duplicated `ID' properties. + +`C-0 C-c C-w or C-u C-u C-u C-c C-w (`org-refile-cache-clear')' + Clear the target cache. Caching of refile targets can be turned + on by setting `org-refile-use-cache'. To make the command see new + possible targets, you have to clear the cache with this command. + + ---------- Footnotes ---------- + + (1) with corresponding `#+STARTUP' keywords `logrefile', +`lognoterefile', and `nologrefile' + + +File: org, Node: Archiving, Prev: Refile and copy, Up: Capture - Refile - Archive + +9.6 Archiving +============= + +When a project represented by a (sub)tree is finished, you may want to +move the tree out of the way and to stop it from contributing to the +agenda. Archiving is important to keep your working files compact and +global searches like the construction of agenda views fast. + +`C-c C-x C-a (`org-archive-subtree-default')' + Archive the current entry using the command specified in the + variable `org-archive-default-command'. + +* Menu: + +* Moving subtrees:: Moving a tree to an archive file +* Internal archiving:: Switch off a tree but keep it in the file + + +File: org, Node: Moving subtrees, Next: Internal archiving, Prev: Archiving, Up: Archiving + +9.6.1 Moving a tree to the archive file +--------------------------------------- + +The most common archiving action is to move a project tree to another +file, the archive file. + +`C-c C-x C-s or short C-c $ (`org-archive-subtree')' + Archive the subtree starting at the cursor position to the location + given by `org-archive-location'. + +`C-u C-c C-x C-s' + Check if any direct children of the current headline could be + moved to the archive. To do this, each subtree is checked for + open TODO entries. If none are found, the command offers to move + it to the archive location. If the cursor is _not_ on a headline + when this command is invoked, the level 1 trees will be checked. + + The default archive location is a file in the same directory as the +current file, with the name derived by appending `_archive' to the +current file name. You can also choose what heading to file archived +items under, with the possibility to add them to a datetree in a file. +For information and examples on how to specify the file and the heading, +see the documentation string of the variable `org-archive-location'. + + There is also an in-buffer option for setting this variable, for +example(1): + + #+ARCHIVE: %s_done:: + +If you would like to have a special ARCHIVE location for a single entry +or a (sub)tree, give the entry an `:ARCHIVE:' property with the +location as the value (*note Properties and Columns::). + + When a subtree is moved, it receives a number of special properties +that record context information like the file from where the entry +came, its outline path the archiving time etc. Configure the variable +`org-archive-save-context-info' to adjust the amount of information +added. + + ---------- Footnotes ---------- + + (1) For backward compatibility, the following also works: If there +are several such lines in a file, each specifies the archive location +for the text below it. The first such line also applies to any text +before its definition. However, using this method is _strongly_ +deprecated as it is incompatible with the outline structure of the +document. The correct method for setting multiple archive locations in +a buffer is using properties. + + +File: org, Node: Internal archiving, Prev: Moving subtrees, Up: Archiving + +9.6.2 Internal archiving +------------------------ + +If you want to just switch off (for agenda views) certain subtrees +without moving them to a different file, you can use the `ARCHIVE tag'. + + A headline that is marked with the ARCHIVE tag (*note Tags::) stays +at its location in the outline tree, but behaves in the following way: + - It does not open when you attempt to do so with a visibility + cycling command (*note Visibility cycling::). You can force + cycling archived subtrees with `C-', or by setting the option + `org-cycle-open-archived-trees'. Also normal outline commands like + `show-all' will open archived subtrees. + + - During sparse tree construction (*note Sparse trees::), matches in + archived subtrees are not exposed, unless you configure the option + `org-sparse-tree-open-archived-trees'. + + - During agenda view construction (*note Agenda Views::), the + content of archived trees is ignored unless you configure the + option `org-agenda-skip-archived-trees', in which case these trees + will always be included. In the agenda you can press `v a' to get + archives temporarily included. + + - Archived trees are not exported (*note Exporting::), only the + headline is. Configure the details using the variable + `org-export-with-archived-trees'. + + - Archived trees are excluded from column view unless the variable + `org-columns-skip-archived-trees' is configured to `nil'. + + The following commands help manage the ARCHIVE tag: + +`C-c C-x a (`org-toggle-archive-tag')' + Toggle the ARCHIVE tag for the current headline. When the tag is + set, the headline changes to a shadowed face, and the subtree + below it is hidden. + +`C-u C-c C-x a' + Check if any direct children of the current headline should be + archived. To do this, each subtree is checked for open TODO + entries. If none are found, the command offers to set the ARCHIVE + tag for the child. If the cursor is _not_ on a headline when this + command is invoked, the level 1 trees will be checked. + +`C-TAB (`org-force-cycle-archived')' + Cycle a tree even if it is tagged with ARCHIVE. + +`C-c C-x A (`org-archive-to-archive-sibling')' + Move the current entry to the _Archive Sibling_. This is a + sibling of the entry with the heading `Archive' and the tag + `ARCHIVE'. The entry becomes a child of that sibling and in this + way retains a lot of its original context, including inherited + tags and approximate position in the outline. + + +File: org, Node: Agenda Views, Next: Markup, Prev: Capture - Refile - Archive, Up: Top + +10 Agenda views +*************** + +Due to the way Org works, TODO items, time-stamped items, and tagged +headlines can be scattered throughout a file or even a number of files. +To get an overview of open action items, or of events that are +important for a particular date, this information must be collected, +sorted and displayed in an organized way. + + Org can select items based on various criteria and display them in a +separate buffer. Seven different view types are provided: + + * an _agenda_ that is like a calendar and shows information for + specific dates, + + * a _TODO list_ that covers all unfinished action items, + + * a _match view_, showings headlines based on the tags, properties, + and TODO state associated with them, + + * a _timeline view_ that shows all events in a single Org file, in + time-sorted view, + + * a _text search view_ that shows all entries from multiple files + that contain specified keywords, + + * a _stuck projects view_ showing projects that currently don't move + along, and + + * _custom views_ that are special searches and combinations of + different views. + +The extracted information is displayed in a special _agenda buffer_. +This buffer is read-only, but provides commands to visit the +corresponding locations in the original Org files, and even to edit +these files remotely. + + Two variables control how the agenda buffer is displayed and whether +the window configuration is restored when the agenda exits: +`org-agenda-window-setup' and `org-agenda-restore-windows-after-quit'. + +* Menu: + +* Agenda files:: Files being searched for agenda information +* Agenda dispatcher:: Keyboard access to agenda views +* Built-in agenda views:: What is available out of the box? +* Presentation and sorting:: How agenda items are prepared for display +* Agenda commands:: Remote editing of Org trees +* Custom agenda views:: Defining special searches and views +* Exporting Agenda Views:: Writing a view to a file +* Agenda column view:: Using column view for collected entries + + +File: org, Node: Agenda files, Next: Agenda dispatcher, Prev: Agenda Views, Up: Agenda Views + +10.1 Agenda files +================= + +The information to be shown is normally collected from all _agenda +files_, the files listed in the variable `org-agenda-files'(1). If a +directory is part of this list, all files with the extension `.org' in +this directory will be part of the list. + + Thus, even if you only work with a single Org file, that file should +be put into the list(2). You can customize `org-agenda-files', but the +easiest way to maintain it is through the following commands + +`C-c [ (`org-agenda-file-to-front')' + Add current file to the list of agenda files. The file is added to + the front of the list. If it was already in the list, it is moved + to the front. With a prefix argument, file is added/moved to the + end. + +`C-c ] (`org-remove-file')' + Remove current file from the list of agenda files. + +`C-' (`org-cycle-agenda-files')' +`C-,' + Cycle through agenda file list, visiting one file after the other. + +`M-x org-iswitchb RET' + Command to use an `iswitchb'-like interface to switch to and + between Org buffers. + +The Org menu contains the current list of files and can be used to +visit any of them. + + If you would like to focus the agenda temporarily on a file not in +this list, or on just one file in the list, or even on only a subtree +in a file, then this can be done in different ways. For a single +agenda command, you may press `<' once or several times in the +dispatcher (*note Agenda dispatcher::). To restrict the agenda scope +for an extended period, use the following commands: + +`C-c C-x < (`org-agenda-set-restriction-lock')' + Permanently restrict the agenda to the current subtree. When with + a prefix argument, or with the cursor before the first headline in + a file, the agenda scope is set to the entire file. This + restriction remains in effect until removed with `C-c C-x >', or + by typing either `<' or `>' in the agenda dispatcher. If there is + a window displaying an agenda view, the new restriction takes + effect immediately. + +`C-c C-x > (`org-agenda-remove-restriction-lock')' + Remove the permanent restriction created by `C-c C-x <'. + +When working with `speedbar.el', you can use the following commands in +the Speedbar frame: + +`< in the speedbar frame (`org-speedbar-set-agenda-restriction')' + Permanently restrict the agenda to the item--either an Org file or + a subtree in such a file--at the cursor in the Speedbar frame. If + there is a window displaying an agenda view, the new restriction + takes effect immediately. + +`> in the speedbar frame (`org-agenda-remove-restriction-lock')' + Lift the restriction. + + ---------- Footnotes ---------- + + (1) If the value of that variable is not a list, but a single file +name, then the list of agenda files will be maintained in that external +file. + + (2) When using the dispatcher, pressing `<' before selecting a +command will actually limit the command to the current file, and ignore +`org-agenda-files' until the next dispatcher command. + + +File: org, Node: Agenda dispatcher, Next: Built-in agenda views, Prev: Agenda files, Up: Agenda Views + +10.2 The agenda dispatcher +========================== + +The views are created through a dispatcher, which should be bound to a +global key--for example `C-c a' (*note Activation::). In the following +we will assume that `C-c a' is indeed how the dispatcher is accessed +and list keyboard access to commands accordingly. After pressing `C-c +a', an additional letter is required to execute a command. The +dispatcher offers the following default commands: + +`a' + Create the calendar-like agenda (*note Weekly/daily agenda::). + +`t / T' + Create a list of all TODO items (*note Global TODO list::). + +`m / M' + Create a list of headlines matching a TAGS expression (*note + Matching tags and properties::). + +`L' + Create the timeline view for the current buffer (*note Timeline::). + +`s' + Create a list of entries selected by a boolean expression of + keywords and/or regular expressions that must or must not occur in + the entry. + +`/' + Search for a regular expression in all agenda files and + additionally in the files listed in + `org-agenda-text-search-extra-files'. This uses the Emacs command + `multi-occur'. A prefix argument can be used to specify the + number of context lines for each match, default is 1. + +`# / !' + Create a list of stuck projects (*note Stuck projects::). + +`<' + Restrict an agenda command to the current buffer(1). After + pressing `<', you still need to press the character selecting the + command. + +`< <' + If there is an active region, restrict the following agenda + command to the region. Otherwise, restrict it to the current + subtree(2). After pressing `< <', you still need to press the + character selecting the command. + +`*' + Toggle sticky agenda views. By default, Org maintains only a + single agenda buffer and rebuilds it each time you change the + view, to make sure everything is always up to date. If you switch + between views often and the build time bothers you, you can turn + on sticky agenda buffers (make this the default by customizing the + variable `org-agenda-sticky'). With sticky agendas, the + dispatcher only switches to the selected view, you need to update + it by hand with `r' or `g'. You can toggle sticky agenda view any + time with `org-toggle-sticky-agenda'. + + You can also define custom commands that will be accessible through +the dispatcher, just like the default commands. This includes the +possibility to create extended agenda buffers that contain several +blocks together, for example the weekly agenda, the global TODO list and +a number of special tags matches. *Note Custom agenda views::. + + ---------- Footnotes ---------- + + (1) For backward compatibility, you can also press `1' to restrict +to the current buffer. + + (2) For backward compatibility, you can also press `0' to restrict +to the current region/subtree. + + +File: org, Node: Built-in agenda views, Next: Presentation and sorting, Prev: Agenda dispatcher, Up: Agenda Views + +10.3 The built-in agenda views +============================== + +In this section we describe the built-in views. + +* Menu: + +* Weekly/daily agenda:: The calendar page with current tasks +* Global TODO list:: All unfinished action items +* Matching tags and properties:: Structured information with fine-tuned search +* Timeline:: Time-sorted view for single file +* Search view:: Find entries by searching for text +* Stuck projects:: Find projects you need to review + + +File: org, Node: Weekly/daily agenda, Next: Global TODO list, Prev: Built-in agenda views, Up: Built-in agenda views + +10.3.1 The weekly/daily agenda +------------------------------ + +The purpose of the weekly/daily _agenda_ is to act like a page of a +paper agenda, showing all the tasks for the current week or day. + +`C-c a a (`org-agenda-list')' + Compile an agenda for the current week from a list of Org files. + The agenda shows the entries for each day. With a numeric + prefix(1) (like `C-u 2 1 C-c a a') you may set the number of days + to be displayed. + + The default number of days displayed in the agenda is set by the +variable `org-agenda-span' (or the obsolete `org-agenda-ndays'). This +variable can be set to any number of days you want to see by default in +the agenda, or to a span name, such as `day', `week', `month' or +`year'. For weekly agendas, the default is to start on the previous +monday (see `org-agenda-start-on-weekday'). You can also set the start +date using a date shift: `(setq org-agenda-start-day "+10d")' will +start the agenda ten days from today in the future. + + Remote editing from the agenda buffer means, for example, that you +can change the dates of deadlines and appointments from the agenda +buffer. The commands available in the Agenda buffer are listed in +*note Agenda commands::. + +Calendar/Diary integration +.......................... + +Emacs contains the calendar and diary by Edward M. Reingold. The +calendar displays a three-month calendar with holidays from different +countries and cultures. The diary allows you to keep track of +anniversaries, lunar phases, sunrise/set, recurrent appointments +(weekly, monthly) and more. In this way, it is quite complementary to +Org. It can be very useful to combine output from Org with the diary. + + In order to include entries from the Emacs diary into Org mode's +agenda, you only need to customize the variable + + (setq org-agenda-include-diary t) + +After that, everything will happen automatically. All diary entries +including holidays, anniversaries, etc., will be included in the agenda +buffer created by Org mode. , , and can be used from +the agenda buffer to jump to the diary file in order to edit existing +diary entries. The `i' command to insert new entries for the current +date works in the agenda buffer, as well as the commands `S', `M', and +`C' to display Sunrise/Sunset times, show lunar phases and to convert +to other calendars, respectively. `c' can be used to switch back and +forth between calendar and agenda. + + If you are using the diary only for sexp entries and holidays, it is +faster to not use the above setting, but instead to copy or even move +the entries into an Org file. Org mode evaluates diary-style sexp +entries, and does it faster because there is no overhead for first +creating the diary display. Note that the sexp entries must start at +the left margin, no whitespace is allowed before them. For example, +the following segment of an Org file will be processed and entries will +be made in the agenda: + + * Birthdays and similar stuff + #+CATEGORY: Holiday + %%(org-calendar-holiday) ; special function for holiday names + #+CATEGORY: Ann + %%(org-anniversary 1956 5 14)(2) Arthur Dent is %d years old + %%(org-anniversary 1869 10 2) Mahatma Gandhi would be %d years old + +Anniversaries from BBDB +....................... + +If you are using the Big Brothers Database to store your contacts, you +will very likely prefer to store anniversaries in BBDB rather than in a +separate Org or diary file. Org supports this and will show BBDB +anniversaries as part of the agenda. All you need to do is to add the +following to one of your agenda files: + + * Anniversaries + :PROPERTIES: + :CATEGORY: Anniv + :END: + %%(org-bbdb-anniversaries) + + You can then go ahead and define anniversaries for a BBDB record. +Basically, you need to press `C-o anniversary ' with the cursor in +a BBDB record and then add the date in the format `YYYY-MM-DD' or +`MM-DD', followed by a space and the class of the anniversary +(`birthday' or `wedding', or a format string). If you omit the class, +it will default to `birthday'. Here are a few examples, the header for +the file `org-bbdb.el' contains more detailed information. + + 1973-06-22 + 06-22 + 1955-08-02 wedding + 2008-04-14 %s released version 6.01 of org mode, %d years ago + + After a change to BBDB, or for the first agenda display during an +Emacs session, the agenda display will suffer a short delay as Org +updates its hash with anniversaries. However, from then on things will +be very fast--much faster in fact than a long list of +`%%(diary-anniversary)' entries in an Org or Diary file. + +Appointment reminders +..................... + +Org can interact with Emacs appointments notification facility. To add +the appointments of your agenda files, use the command +`org-agenda-to-appt'. This command lets you filter through the list of +your appointments and add only those belonging to a specific category +or matching a regular expression. It also reads a `APPT_WARNTIME' +property which will then override the value of +`appt-message-warning-time' for this appointment. See the docstring +for details. + + ---------- Footnotes ---------- + + (1) For backward compatibility, the universal prefix `C-u' causes +all TODO entries to be listed before the agenda. This feature is +deprecated, use the dedicated TODO list, or a block agenda instead +(*note Block agenda::). + + (2) `org-anniversary' is just like `diary-anniversary', but the +argument order is always according to ISO and therefore independent of +the value of `calendar-date-style'. + + +File: org, Node: Global TODO list, Next: Matching tags and properties, Prev: Weekly/daily agenda, Up: Built-in agenda views + +10.3.2 The global TODO list +--------------------------- + +The global TODO list contains all unfinished TODO items formatted and +collected into a single place. + +`C-c a t (`org-todo-list')' + Show the global TODO list. This collects the TODO items from all + agenda files (*note Agenda Views::) into a single buffer. By + default, this lists items with a state the is not a DONE state. + The buffer is in `agenda-mode', so there are commands to examine + and manipulate the TODO entries directly from that buffer (*note + Agenda commands::). + +`C-c a T (`org-todo-list')' + Like the above, but allows selection of a specific TODO keyword. + You can also do this by specifying a prefix argument to `C-c a t'. + You are prompted for a keyword, and you may also specify several + keywords by separating them with `|' as the boolean OR operator. + With a numeric prefix, the Nth keyword in `org-todo-keywords' is + selected. The `r' key in the agenda buffer regenerates it, and + you can give a prefix argument to this command to change the + selected TODO keyword, for example `3 r'. If you often need a + search for a specific keyword, define a custom command for it + (*note Agenda dispatcher::). + Matching specific TODO keywords can also be done as part of a tags + search (*note Tag searches::). + + Remote editing of TODO items means that you can change the state of a +TODO entry with a single key press. The commands available in the TODO +list are described in *note Agenda commands::. + + Normally the global TODO list simply shows all headlines with TODO +keywords. This list can become very long. There are two ways to keep +it more compact: + - Some people view a TODO item that has been _scheduled_ for + execution or have a _deadline_ (*note Timestamps::) as no longer + _open_. Configure the variables + `org-agenda-todo-ignore-scheduled', + `org-agenda-todo-ignore-deadlines', + `org-agenda-todo-ignore-timestamp' and/or + `org-agenda-todo-ignore-with-date' to exclude such items from the + global TODO list. + + - TODO items may have sublevels to break up the task into subtasks. + In such cases it may be enough to list only the highest level TODO + headline and omit the sublevels from the global list. Configure + the variable `org-agenda-todo-list-sublevels' to get this behavior. + + +File: org, Node: Matching tags and properties, Next: Timeline, Prev: Global TODO list, Up: Built-in agenda views + +10.3.3 Matching tags and properties +----------------------------------- + +If headlines in the agenda files are marked with _tags_ (*note Tags::), +or have properties (*note Properties and Columns::), you can select +headlines based on this metadata and collect them into an agenda +buffer. The match syntax described here also applies when creating +sparse trees with `C-c / m'. + +`C-c a m (`org-tags-view')' + Produce a list of all headlines that match a given set of tags. + The command prompts for a selection criterion, which is a boolean + logic expression with tags, like `+work+urgent-withboss' or + `work|home' (*note Tags::). If you often need a specific search, + define a custom command for it (*note Agenda dispatcher::). + +`C-c a M (`org-tags-view')' + Like `C-c a m', but only select headlines that are also TODO items + in a not-DONE state and force checking subitems (see variable + `org-tags-match-list-sublevels'). To exclude scheduled/deadline + items, see the variable + `org-agenda-tags-todo-honor-ignore-options'. Matching specific + TODO keywords together with a tags match is also possible, see + *note Tag searches::. + + The commands available in the tags list are described in *note +Agenda commands::. + +Match syntax +............ + +A search string can use Boolean operators `&' for `AND' and `|' for +`OR'. `&' binds more strongly than `|'. Parentheses are not +implemented. Each element in the search is either a tag, a regular +expression matching tags, or an expression like `PROPERTY OPERATOR +VALUE' with a comparison operator, accessing a property value. Each +element may be preceded by `-', to select against it, and `+' is +syntactic sugar for positive selection. The `AND' operator `&' is +optional when `+' or `-' is present. Here are some examples, using +only tags. + +`work' + Select headlines tagged `:work:'. + +`work&boss' + Select headlines tagged `:work:' and `:boss:'. + +`+work-boss' + Select headlines tagged `:work:', but discard those also tagged + `:boss:'. + +`work|laptop' + Selects lines tagged `:work:' or `:laptop:'. + +`work|laptop+night' + Like before, but require the `:laptop:' lines to be tagged also + `:night:'. + + Instead of a tag, you may also specify a regular expression enclosed +in curly braces. For example, `work+{^boss.*}' matches headlines that +contain the tag `:work:' and any tag starting with `boss'. + + Group tags (*note Tag groups::) are expanded as regular expressions. +E.g., if `:work:' is a group tag for the group `:work:lab:conf:', then +searching for `work' will search for `{\(?:work\|lab\|conf\)}' and +searching for `-work' will search for all headlines but those with one +of the tag in the group (i.e., `-{\(?:work\|lab\|conf\)}'). + + You may also test for properties (*note Properties and Columns::) at +the same time as matching tags. The properties may be real properties, +or special properties that represent other metadata (*note Special +properties::). For example, the "property" `TODO' represents the TODO +keyword of the entry and the "property" `PRIORITY' represents the +PRIORITY keyword of the entry. The ITEM special property cannot +currently be used in tags/property searches(1). + + Except the *note Special properties::, one other "property" can also +be used. `LEVEL' represents the level of an entry. So a search +`+LEVEL=3+boss-TODO="DONE"' lists all level three headlines that have +the tag `boss' and are _not_ marked with the TODO keyword DONE. In +buffers with `org-odd-levels-only' set, `LEVEL' does not count the +number of stars, but `LEVEL=2' will correspond to 3 stars etc. + + Here are more examples: + +`work+TODO="WAITING"' + Select `:work:'-tagged TODO lines with the specific TODO keyword + `WAITING'. + +`work+TODO="WAITING"|home+TODO="WAITING"' + Waiting tasks both at work and at home. + + When matching properties, a number of different operators can be +used to test the value of a property. Here is a complex example: + + +work-boss+PRIORITY="A"+Coffee="unlimited"+Effort<2 \ + +With={Sarah\|Denny}+SCHEDULED>="<2008-10-11>" + +The type of comparison will depend on how the comparison value is +written: + - If the comparison value is a plain number, a numerical comparison + is done, and the allowed operators are `<', `=', `>', `<=', `>=', + and `<>'. + + - If the comparison value is enclosed in double-quotes, a string + comparison is done, and the same operators are allowed. + + - If the comparison value is enclosed in double-quotes _and_ angular + brackets (like `DEADLINE<="<2008-12-24 18:30>"'), both values are + assumed to be date/time specifications in the standard Org way, + and the comparison will be done accordingly. Special values that + will be recognized are `""' for now (including time), and + `""', and `""' for these days at 0:00 hours, + i.e., without a time specification. Also strings like `"<+5d>"' + or `"<-2m>"' with units `d', `w', `m', and `y' for day, week, + month, and year, respectively, can be used. + + - If the comparison value is enclosed in curly braces, a regexp + match is performed, with `=' meaning that the regexp matches the + property value, and `<>' meaning that it does not match. + + So the search string in the example finds entries tagged `:work:' but +not `:boss:', which also have a priority value `A', a `:Coffee:' +property with the value `unlimited', an `Effort' property that is +numerically smaller than 2, a `:With:' property that is matched by the +regular expression `Sarah\|Denny', and that are scheduled on or after +October 11, 2008. + + Accessing TODO, LEVEL, and CATEGORY during a search is fast. +Accessing any other properties will slow down the search. However, +once you have paid the price by accessing one property, testing +additional properties is cheap again. + + You can configure Org mode to use property inheritance during a +search, but beware that this can slow down searches considerably. See +*note Property inheritance::, for details. + + For backward compatibility, and also for typing speed, there is also +a different way to test TODO states in a search. For this, terminate +the tags/property part of the search string (which may include several +terms connected with `|') with a `/' and then specify a Boolean +expression just for TODO keywords. The syntax is then similar to that +for tags, but should be applied with care: for example, a positive +selection on several TODO keywords cannot meaningfully be combined with +boolean AND. However, _negative selection_ combined with AND can be +meaningful. To make sure that only lines are checked that actually +have any TODO keyword (resulting in a speed-up), use `C-c a M', or +equivalently start the TODO part after the slash with `!'. Using `C-c +a M' or `/!' will not match TODO keywords in a DONE state. Examples: + +`work/WAITING' + Same as `work+TODO="WAITING"' + +`work/!-WAITING-NEXT' + Select `:work:'-tagged TODO lines that are neither `WAITING' nor + `NEXT' + +`work/!+WAITING|+NEXT' + Select `:work:'-tagged TODO lines that are either `WAITING' or + `NEXT'. + + ---------- Footnotes ---------- + + (1) But *note skipping entries based on regexp: +x-agenda-skip-entry-regexp. + + +File: org, Node: Timeline, Next: Search view, Prev: Matching tags and properties, Up: Built-in agenda views + +10.3.4 Timeline for a single file +--------------------------------- + +The timeline summarizes all time-stamped items from a single Org mode +file in a _time-sorted view_. The main purpose of this command is to +give an overview over events in a project. + +`C-c a L (`org-timeline')' + Show a time-sorted view of the Org file, with all time-stamped + items. When called with a `C-u' prefix, all unfinished TODO + entries (scheduled or not) are also listed under the current date. + +The commands available in the timeline buffer are listed in *note +Agenda commands::. + + +File: org, Node: Search view, Next: Stuck projects, Prev: Timeline, Up: Built-in agenda views + +10.3.5 Search view +------------------ + +This agenda view is a general text search facility for Org mode entries. +It is particularly useful to find notes. + +`C-c a s (`org-search-view')' + This is a special search that lets you select entries by matching + a substring or specific words using a boolean logic. + For example, the search string `computer equipment' will find entries +that contain `computer equipment' as a substring. If the two words are +separated by more space or a line break, the search will still match. +Search view can also search for specific keywords in the entry, using +Boolean logic. The search string `+computer +wifi -ethernet +-{8\.11[bg]}' will search for note entries that contain the keywords +`computer' and `wifi', but not the keyword `ethernet', and which are +also not matched by the regular expression `8\.11[bg]', meaning to +exclude both 8.11b and 8.11g. The first `+' is necessary to turn on +word search, other `+' characters are optional. For more details, see +the docstring of the command `org-search-view'. + + Note that in addition to the agenda files, this command will also +search the files listed in `org-agenda-text-search-extra-files'. + + +File: org, Node: Stuck projects, Prev: Search view, Up: Built-in agenda views + +10.3.6 Stuck projects +--------------------- + +If you are following a system like David Allen's GTD to organize your +work, one of the "duties" you have is a regular review to make sure +that all projects move along. A _stuck_ project is a project that has +no defined next actions, so it will never show up in the TODO lists Org +mode produces. During the review, you need to identify such projects +and define next actions for them. + +`C-c a # (`org-agenda-list-stuck-projects')' + List projects that are stuck. + +`C-c a !' + Customize the variable `org-stuck-projects' to define what a stuck + project is and how to find it. + + You almost certainly will have to configure this view before it will +work for you. The built-in default assumes that all your projects are +level-2 headlines, and that a project is not stuck if it has at least +one entry marked with a TODO keyword TODO or NEXT or NEXTACTION. + + Let's assume that you, in your own way of using Org mode, identify +projects with a tag PROJECT, and that you use a TODO keyword MAYBE to +indicate a project that should not be considered yet. Let's further +assume that the TODO keyword DONE marks finished projects, and that NEXT +and TODO indicate next actions. The tag @SHOP indicates shopping and +is a next action even without the NEXT tag. Finally, if the project +contains the special word IGNORE anywhere, it should not be listed +either. In this case you would start by identifying eligible projects +with a tags/todo match(1) `+PROJECT/-MAYBE-DONE', and then check for +TODO, NEXT, @SHOP, and IGNORE in the subtree to identify projects that +are not stuck. The correct customization for this is + + (setq org-stuck-projects + '("+PROJECT/-MAYBE-DONE" ("NEXT" "TODO") ("@SHOP") + "\\")) + + Note that if a project is identified as non-stuck, the subtree of +this entry will still be searched for stuck projects. + + ---------- Footnotes ---------- + + (1) *Note Tag searches::. + + +File: org, Node: Presentation and sorting, Next: Agenda commands, Prev: Built-in agenda views, Up: Agenda Views + +10.4 Presentation and sorting +============================= + +Before displaying items in an agenda view, Org mode visually prepares +the items and sorts them. Each item occupies a single line. The line +starts with a _prefix_ that contains the _category_ (*note Categories::) +of the item and other important information. You can customize in which +column tags will be displayed through `org-agenda-tags-column'. You can +also customize the prefix using the option `org-agenda-prefix-format'. +This prefix is followed by a cleaned-up version of the outline headline +associated with the item. + +* Menu: + +* Categories:: Not all tasks are equal +* Time-of-day specifications:: How the agenda knows the time +* Sorting agenda items:: The order of things +* Filtering/limiting agenda items:: Dynamically narrow the agenda + + +File: org, Node: Categories, Next: Time-of-day specifications, Prev: Presentation and sorting, Up: Presentation and sorting + +10.4.1 Categories +----------------- + +The category is a broad label assigned to each agenda item. By default, +the category is simply derived from the file name, but you can also +specify it with a special line in the buffer, like this(1): + + #+CATEGORY: Thesis + +If you would like to have a special CATEGORY for a single entry or a +(sub)tree, give the entry a `:CATEGORY:' property with the special +category you want to apply as the value. + +The display in the agenda buffer looks best if the category is not +longer than 10 characters. + +You can set up icons for category by customizing the +`org-agenda-category-icon-alist' variable. + + ---------- Footnotes ---------- + + (1) For backward compatibility, the following also works: if there +are several such lines in a file, each specifies the category for the +text below it. The first category also applies to any text before the +first CATEGORY line. However, using this method is _strongly_ +deprecated as it is incompatible with the outline structure of the +document. The correct method for setting multiple categories in a +buffer is using a property. + + +File: org, Node: Time-of-day specifications, Next: Sorting agenda items, Prev: Categories, Up: Presentation and sorting + +10.4.2 Time-of-day specifications +--------------------------------- + +Org mode checks each agenda item for a time-of-day specification. The +time can be part of the timestamp that triggered inclusion into the +agenda, for example as in `<2005-05-10 Tue 19:00>'. Time ranges can be +specified with two timestamps, like +`<2005-05-10 Tue 20:30>--<2005-05-10 Tue 22:15>'. + + In the headline of the entry itself, a time(range) may also appear as +plain text (like `12:45' or a `8:30-1pm'). If the agenda integrates +the Emacs diary (*note Weekly/daily agenda::), time specifications in +diary entries are recognized as well. + + For agenda display, Org mode extracts the time and displays it in a +standard 24 hour format as part of the prefix. The example times in +the previous paragraphs would end up in the agenda like this: + + 8:30-13:00 Arthur Dent lies in front of the bulldozer + 12:45...... Ford Prefect arrives and takes Arthur to the pub + 19:00...... The Vogon reads his poem + 20:30-22:15 Marvin escorts the Hitchhikers to the bridge + + If the agenda is in single-day mode, or for the display of today, the +timed entries are embedded in a time grid, like + + 8:00...... ------------------ + 8:30-13:00 Arthur Dent lies in front of the bulldozer + 10:00...... ------------------ + 12:00...... ------------------ + 12:45...... Ford Prefect arrives and takes Arthur to the pub + 14:00...... ------------------ + 16:00...... ------------------ + 18:00...... ------------------ + 19:00...... The Vogon reads his poem + 20:00...... ------------------ + 20:30-22:15 Marvin escorts the Hitchhikers to the bridge + + The time grid can be turned on and off with the variable +`org-agenda-use-time-grid', and can be configured with +`org-agenda-time-grid'. + + +File: org, Node: Sorting agenda items, Next: Filtering/limiting agenda items, Prev: Time-of-day specifications, Up: Presentation and sorting + +10.4.3 Sorting agenda items +--------------------------- + +Before being inserted into a view, the items are sorted. How this is +done depends on the type of view. + * For the daily/weekly agenda, the items for each day are sorted. + The default order is to first collect all items containing an + explicit time-of-day specification. These entries will be shown + at the beginning of the list, as a _schedule_ for the day. After + that, items remain grouped in categories, in the sequence given by + `org-agenda-files'. Within each category, items are sorted by + priority (*note Priorities::), which is composed of the base + priority (2000 for priority `A', 1000 for `B', and 0 for `C'), + plus additional increments for overdue scheduled or deadline items. + + * For the TODO list, items remain in the order of categories, but + within each category, sorting takes place according to priority + (*note Priorities::). The priority used for sorting derives from + the priority cookie, with additions depending on how close an item + is to its due or scheduled date. + + * For tags matches, items are not sorted at all, but just appear in + the sequence in which they are found in the agenda files. + + Sorting can be customized using the variable +`org-agenda-sorting-strategy', and may also include criteria based on +the estimated effort of an entry (*note Effort estimates::). + + +File: org, Node: Filtering/limiting agenda items, Prev: Sorting agenda items, Up: Presentation and sorting + +10.4.4 Filtering/limiting agenda items +-------------------------------------- + +Agenda built-in or customized commands are statically defined. Agenda +filters and limits provide two ways of dynamically narrowing down the +list of agenda entries: _fitlers_ and _limits_. Filters only act on the +display of the items, while limits take effect before the list of agenda +entries is built. Filter are more often used interactively, while +limits are mostly useful when defined as local variables within custom +agenda commands. + +Filtering in the agenda +....................... + +`/ (`org-agenda-filter-by-tag')' + Filter the agenda view with respect to a tag and/or effort + estimates. The difference between this and a custom agenda + command is that filtering is very fast, so that you can switch + quickly between different filters without having to recreate the + agenda.(1) + + You will be prompted for a tag selection letter; will mean + any tag at all. Pressing at that prompt will offer use + completion to select a tag (including any tags that do not have a + selection character). The command then hides all entries that do + not contain or inherit this tag. When called with prefix arg, + remove the entries that _do_ have the tag. A second `/' at the + prompt will turn off the filter and unhide any hidden entries. If + the first key you press is either `+' or `-', the previous filter + will be narrowed by requiring or forbidding the selected + additional tag. Instead of pressing `+' or `-' after `/', you can + also immediately use the `\' command. + + In order to filter for effort estimates, you should set up allowed + efforts globally, for example + (setq org-global-properties + '(("Effort_ALL". "0 0:10 0:30 1:00 2:00 3:00 4:00"))) + You can then filter for an effort by first typing an operator, one + of `<', `>', and `=', and then the one-digit index of an effort + estimate in your array of allowed values, where `0' means the 10th + value. The filter will then restrict to entries with effort + smaller-or-equal, equal, or larger-or-equal than the selected + value. If the digits 0-9 are not used as fast access keys to + tags, you can also simply press the index digit directly without + an operator. In this case, `<' will be assumed. For application + of the operator, entries without a defined effort will be treated + according to the value of `org-sort-agenda-noeffort-is-high'. To + filter for tasks without effort definition, press `?' as the + operator. + + Org also supports automatic, context-aware tag filtering. If the + variable `org-agenda-auto-exclude-function' is set to a + user-defined function, that function can decide which tags should + be excluded from the agenda automatically. Once this is set, the + `/' command then accepts `RET' as a sub-option key and runs the + auto exclusion logic. For example, let's say you use a `Net' tag + to identify tasks which need network access, an `Errand' tag for + errands in town, and a `Call' tag for making phone calls. You + could auto-exclude these tags based on the availability of the + Internet, and outside of business hours, with something like this: + + (defun org-my-auto-exclude-function (tag) + (and (cond + ((string= tag "Net") + (/= 0 (call-process "/sbin/ping" nil nil nil + "-c1" "-q" "-t1" "mail.gnu.org"))) + ((or (string= tag "Errand") (string= tag "Call")) + (let ((hour (nth 2 (decode-time)))) + (or (< hour 8) (> hour 21))))) + (concat "-" tag))) + + (setq org-agenda-auto-exclude-function 'org-my-auto-exclude-function) + +`\ (`org-agenda-filter-by-tag-refine')' + Narrow the current agenda filter by an additional condition. When + called with prefix arg, remove the entries that _do_ have the tag, + or that do match the effort criterion. You can achieve the same + effect by pressing `+' or `-' as the first key after the `/' + command. + +`[ ] { }' + + in search view + add new search words (`[' and `]') or new regular expressions + (`{' and `}') to the query string. The opening bracket/brace + will add a positive search term prefixed by `+', indicating + that this search term must occur/match in the entry. The + closing bracket/brace will add a negative search term which + must not occur/match in the entry for it to be selected. + +`< (`org-agenda-filter-by-category')' + Filter the current agenda view with respect to the category of the + item at point. Pressing `<' another time will remove this filter. + You can add a filter preset through the option + `org-agenda-category-filter-preset' (see below.) + +`^ (`org-agenda-filter-by-top-headline')' + Filter the current agenda view and only display the siblings and + the parent headline of the one at point. + +`= (`org-agenda-filter-by-regexp')' + Filter the agenda view by a regular expression: only show agenda + entries matching the regular expression the user entered. When + called with a prefix argument, it will filter _out_ entries + matching the regexp. With two universal prefix arguments, it will + remove all the regexp filters, which can be accumulated. You can + add a filter preset through the option + `org-agenda-category-filter-preset' (see below.) + +`| (`org-agenda-filter-remove-all')' + Remove all filters in the current agenda view. + +Setting limits for the agenda +............................. + +Here is a list of options that you can set, either globally, or locally +in your custom agenda views*note Custom agenda views::. + +ORG-AGENDA-MAX-ENTRIES + Limit the number of entries. + +ORG-AGENDA-MAX-EFFORT + Limit the duration of accumulated efforts (as minutes). + +ORG-AGENDA-MAX-TODOS + Limit the number of entries with TODO keywords. + +ORG-AGENDA-MAX-TAGS + Limit the number of tagged entries. + + When set to a positive integer, each option will exclude entries +from other categories: for example, `(setq org-agenda-max-effort 100)' +will limit the agenda to 100 minutes of effort and exclude any entry +that as no effort property. If you want to include entries with no +effort property, use a negative value for `org-agenda-max-effort'. + + One useful setup is to use `org-agenda-max-entries' locally in a +custom command. For example, this custom command will display the next +five entries with a `NEXT' TODO keyword. + + (setq org-agenda-custom-commands + '(("n" todo "NEXT" + ((org-agenda-max-entries 5))))) + + Once you mark one of these five entry as `DONE', rebuilding the +agenda will again the next five entries again, including the first +entry that was excluded so far. + + You can also dynamically set temporary limits(2): + +`~ (`org-agenda-limit-interactively')' + This prompts for the type of limit to apply and its value. + + ---------- Footnotes ---------- + + (1) Custom commands can preset a filter by binding the variable +`org-agenda-tag-filter-preset' as an option. This filter will then be +applied to the view and persist as a basic filter through refreshes and +more secondary filtering. The filter is a global property of the +entire agenda view--in a block agenda, you should only set this in the +global options section, not in the section of an individual block. + + (2) Those temporary limits are lost when rebuilding the agenda. + + +File: org, Node: Agenda commands, Next: Custom agenda views, Prev: Presentation and sorting, Up: Agenda Views + +10.5 Commands in the agenda buffer +================================== + +Entries in the agenda buffer are linked back to the Org file or diary +file where they originate. You are not allowed to edit the agenda +buffer itself, but commands are provided to show and jump to the +original entry location, and to edit the Org files "remotely" from the +agenda buffer. In this way, all information is stored only once, +removing the risk that your agenda and note files may diverge. + + Some commands can be executed with mouse clicks on agenda lines. For +the other commands, the cursor needs to be in the desired line. + +Motion +...... + +`n (`org-agenda-next-line')' + Next line (same as and `C-n'). + +`p (`org-agenda-previous-line')' + Previous line (same as and `C-p'). + +View/Go to Org file +................... + +` or mouse-3 (`org-agenda-show-and-scroll-up')' + Display the original location of the item in another window. With + prefix arg, make sure that the entire entry is made visible in the + outline, not only the heading. + +`L (`org-agenda-recenter')' + Display original location and recenter that window. + +` or mouse-2 (`org-agenda-goto')' + Go to the original location of the item in another window. + +` (`org-agenda-switch-to')' + Go to the original location of the item and delete other windows. + +`F (`org-agenda-follow-mode')' + Toggle Follow mode. In Follow mode, as you move the cursor through + the agenda buffer, the other window always shows the corresponding + location in the Org file. The initial setting for this mode in new + agenda buffers can be set with the variable + `org-agenda-start-with-follow-mode'. + +`C-c C-x b (`org-agenda-tree-to-indirect-buffer')' + Display the entire subtree of the current item in an indirect + buffer. With a numeric prefix argument N, go up to level N and + then take that tree. If N is negative, go up that many levels. + With a `C-u' prefix, do not remove the previously used indirect + buffer. + +`C-c C-o (`org-agenda-open-link')' + Follow a link in the entry. This will offer a selection of any + links in the text belonging to the referenced Org node. If there + is only one link, it will be followed without a selection prompt. + +Change display +.............. + +`A' + Interactively select another agenda view and append it to the + current view. + +`o' + Delete other windows. + +`v d or short d (`org-agenda-day-view')' +`v w or short w (`org-agenda-week-view')' +`v t (`org-agenda-fortnight-view')' +`v m (`org-agenda-month-view')' +`v y (`org-agenda-year-view')' +`v SPC (`org-agenda-reset-view')' + Switch to day/week/month/year view. When switching to day or week + view, this setting becomes the default for subsequent agenda + refreshes. Since month and year views are slow to create, they do + not become the default. A numeric prefix argument may be used to + jump directly to a specific day of the year, ISO week, month, or + year, respectively. For example, `32 d' jumps to February 1st, `9 + w' to ISO week number 9. When setting day, week, or month view, a + year may be encoded in the prefix argument as well. For example, + `200712 w' will jump to week 12 in 2007. If such a year + specification has only one or two digits, it will be mapped to the + interval 1938-2037. `v ' will reset to what is set in + `org-agenda-span'. + +`f (`org-agenda-later')' + Go forward in time to display the following + `org-agenda-current-span' days. For example, if the display + covers a week, switch to the following week. With prefix arg, go + forward that many times `org-agenda-current-span' days. + +`b (`org-agenda-earlier')' + Go backward in time to display earlier dates. + +`. (`org-agenda-goto-today')' + Go to today. + +`j (`org-agenda-goto-date')' + Prompt for a date and go there. + +`J (`org-agenda-clock-goto')' + Go to the currently clocked-in task in the agenda buffer. + +`D (`org-agenda-toggle-diary')' + Toggle the inclusion of diary entries. See *note Weekly/daily + agenda::. + +`v l or short l (`org-agenda-log-mode')' + Toggle Logbook mode. In Logbook mode, entries that were marked + DONE while logging was on (variable `org-log-done') are shown in + the agenda, as are entries that have been clocked on that day. + You can configure the entry types that should be included in log + mode using the variable `org-agenda-log-mode-items'. When called + with a `C-u' prefix, show all possible logbook entries, including + state changes. When called with two prefix arguments `C-u C-u', + show only logging information, nothing else. `v L' is equivalent + to `C-u v l'. + +`v [ or short [ (`org-agenda-manipulate-query-add')' + Include inactive timestamps into the current view. Only for + weekly/daily agenda and timeline views. + +`v a (`org-agenda-archives-mode')' +`v A (`org-agenda-archives-mode 'files')' + Toggle Archives mode. In Archives mode, trees that are marked + `ARCHIVED' are also scanned when producing the agenda. When you + use the capital `A', even all archive files are included. To exit + archives mode, press `v a' again. + +`v R or short R (`org-agenda-clockreport-mode')' + Toggle Clockreport mode. In Clockreport mode, the daily/weekly + agenda will always show a table with the clocked times for the + time span and file scope covered by the current agenda view. The + initial setting for this mode in new agenda buffers can be set + with the variable `org-agenda-start-with-clockreport-mode'. By + using a prefix argument when toggling this mode (i.e., `C-u R'), + the clock table will not show contributions from entries that are + hidden by agenda filtering(1). See also the variable + `org-clock-report-include-clocking-task'. + +`v c' + Show overlapping clock entries, clocking gaps, and other clocking + problems in the current agenda range. You can then visit clocking + lines and fix them manually. See the variable + `org-agenda-clock-consistency-checks' for information on how to + customize the definition of what constituted a clocking problem. + To return to normal agenda display, press `l' to exit Logbook mode. + +`v E or short E (`org-agenda-entry-text-mode')' + Toggle entry text mode. In entry text mode, a number of lines + from the Org outline node referenced by an agenda line will be + displayed below the line. The maximum number of lines is given by + the variable `org-agenda-entry-text-maxlines'. Calling this + command with a numeric prefix argument will temporarily modify + that number to the prefix value. + +`G (`org-agenda-toggle-time-grid')' + Toggle the time grid on and off. See also the variables + `org-agenda-use-time-grid' and `org-agenda-time-grid'. + +`r (`org-agenda-redo')' + Recreate the agenda buffer, for example to reflect the changes + after modification of the timestamps of items with `S-' and + `S-'. When the buffer is the global TODO list, a prefix + argument is interpreted to create a selective list for a specific + TODO keyword. + +`g (`org-agenda-redo')' + Same as `r'. + +`C-x C-s or short s (`org-save-all-org-buffers')' + Save all Org buffers in the current Emacs session, and also the + locations of IDs. + +`C-c C-x C-c (`org-agenda-columns')' + Invoke column view (*note Column view::) in the agenda buffer. + The column view format is taken from the entry at point, or (if + there is no entry at point), from the first entry in the agenda + view. So whatever the format for that entry would be in the + original buffer (taken from a property, from a `#+COLUMNS' line, + or from the default variable `org-columns-default-format'), will + be used in the agenda. + +`C-c C-x > (`org-agenda-remove-restriction-lock')' + Remove the restriction lock on the agenda, if it is currently + restricted to a file or subtree (*note Agenda files::). + +Secondary filtering and query editing +..................................... + + For a detailed description of these commands, see *note + Filtering/limiting agenda items::. + +`/ (`org-agenda-filter-by-tag')' + Filter the agenda view with respect to a tag and/or effort + estimates. + +`\ (`org-agenda-filter-by-tag-refine')' + Narrow the current agenda filter by an additional condition. + +`< (`org-agenda-filter-by-category')' + Filter the current agenda view with respect to the category of the + item at point. Pressing `<' another time will remove this filter. + +`^ (`org-agenda-filter-by-top-headline')' + Filter the current agenda view and only display the siblings and + the parent headline of the one at point. + +`= (`org-agenda-filter-by-regexp')' + Filter the agenda view by a regular expression: only show agenda + entries matching the regular expression the user entered. When + called with a prefix argument, it will filter _out_ entries + matching the regexp. With two universal prefix arguments, it will + remove all the regexp filters, which can be accumulated. You can + add a filter preset through the option + `org-agenda-category-filter-preset' (see below.) + +`| (`org-agenda-filter-remove-all')' + Remove all filters in the current agenda view. + +Remote editing +.............. + +`0--9' + Digit argument. + +`C-_ (`org-agenda-undo')' + Undo a change due to a remote editing command. The change is + undone both in the agenda buffer and in the remote buffer. + +`t (`org-agenda-todo')' + Change the TODO state of the item, both in the agenda and in the + original org file. + +`C-S- (`org-agenda-todo-nextset')' + +`C-S- (`org-agenda-todo-previousset')' + Switch to the next/previous set of TODO keywords. + +`C-k (`org-agenda-kill')' + Delete the current agenda item along with the entire subtree + belonging to it in the original Org file. If the text to be + deleted remotely is longer than one line, the kill needs to be + confirmed by the user. See variable `org-agenda-confirm-kill'. + +`C-c C-w (`org-agenda-refile')' + Refile the entry at point. + +`C-c C-x C-a or short a (`org-agenda-archive-default-with-confirmation')' + Archive the subtree corresponding to the entry at point using the + default archiving command set in `org-archive-default-command'. + When using the `a' key, confirmation will be required. + +`C-c C-x a (`org-agenda-toggle-archive-tag')' + Toggle the ARCHIVE tag for the current headline. + +`C-c C-x A (`org-agenda-archive-to-archive-sibling')' + Move the subtree corresponding to the current entry to its _archive + sibling_. + +`C-c C-x C-s or short $ (`org-agenda-archive')' + Archive the subtree corresponding to the current headline. This + means the entry will be moved to the configured archive location, + most likely a different file. + +`T (`org-agenda-show-tags')' + Show all tags associated with the current item. This is useful if + you have turned off `org-agenda-show-inherited-tags', but still + want to see all tags of a headline occasionally. + +`: (`org-agenda-set-tags')' + Set tags for the current headline. If there is an active region + in the agenda, change a tag for all headings in the region. + +`,' + Set the priority for the current item (`org-agenda-priority'). + Org mode prompts for the priority character. If you reply with + , the priority cookie is removed from the entry. + +`P (`org-agenda-show-priority')' + Display weighted priority of current item. + +`+ or S- (`org-agenda-priority-up')' + Increase the priority of the current item. The priority is + changed in the original buffer, but the agenda is not resorted. + Use the `r' key for this. + +`- or S- (`org-agenda-priority-down')' + Decrease the priority of the current item. + +`z or C-c C-z (`org-agenda-add-note')' + Add a note to the entry. This note will be recorded, and then + filed to the same location where state change notes are put. + Depending on `org-log-into-drawer', this may be inside a drawer. + +`C-c C-a (`org-attach')' + Dispatcher for all command related to attachments. + +`C-c C-s (`org-agenda-schedule')' + Schedule this item. With prefix arg remove the scheduling + timestamp + +`C-c C-d (`org-agenda-deadline')' + Set a deadline for this item. With prefix arg remove the deadline. + +`S- (`org-agenda-do-date-later')' + Change the timestamp associated with the current line by one day + into the future. If the date is in the past, the first call to + this command will move it to today. + With a numeric prefix argument, change it by that many days. For + example, `3 6 5 S-' will change it by a year. With a `C-u' + prefix, change the time by one hour. If you immediately repeat + the command, it will continue to change hours even without the + prefix arg. With a double `C-u C-u' prefix, do the same for + changing minutes. + The stamp is changed in the original Org file, but the change is + not directly reflected in the agenda buffer. Use `r' or `g' to + update the buffer. + +`S- (`org-agenda-do-date-earlier')' + Change the timestamp associated with the current line by one day + into the past. + +`> (`org-agenda-date-prompt')' + Change the timestamp associated with the current line. The key + `>' has been chosen, because it is the same as `S-.' on my + keyboard. + +`I (`org-agenda-clock-in')' + Start the clock on the current item. If a clock is running + already, it is stopped first. + +`O (`org-agenda-clock-out')' + Stop the previously started clock. + +`X (`org-agenda-clock-cancel')' + Cancel the currently running clock. + +`J (`org-agenda-clock-goto')' + Jump to the running clock in another window. + +`k (`org-agenda-capture')' + Like `org-capture', but use the date at point as the default date + for the capture template. See `org-capture-use-agenda-date' to + make this the default behavior of `org-capture'. + +Dragging agenda lines forward/backward +...................................... + +`M- (`org-agenda-drag-line-backward')' + Drag the line at point backward one line(2). With a numeric + prefix argument, drag backward by that many lines. + +`M- (`org-agenda-drag-line-forward')' + Drag the line at point forward one line. With a numeric prefix + argument, drag forward by that many lines. + +Bulk remote editing selected entries +.................................... + +`m (`org-agenda-bulk-mark')' + Mark the entry at point for bulk action. With numeric prefix + argument, mark that many successive entries. + +`* (`org-agenda-bulk-mark-all')' + Mark all visible agenda entries for bulk action. + +`u (`org-agenda-bulk-unmark')' + Unmark entry at point for bulk action. + +`U (`org-agenda-bulk-remove-all-marks')' + Unmark all marked entries for bulk action. + +`M-m (`org-agenda-bulk-toggle')' + Toggle mark of the entry at point for bulk action. + +`M-* (`org-agenda-bulk-toggle-all')' + Toggle marks of all visible entries for bulk action. + +`% (`org-agenda-bulk-mark-regexp')' + Mark entries matching a regular expression for bulk action. + +`B (`org-agenda-bulk-action')' + Bulk action: act on all marked entries in the agenda. This will + prompt for another key to select the action to be applied. The + prefix arg to `B' will be passed through to the `s' and `d' + commands, to bulk-remove these special timestamps. By default, + marks are removed after the bulk. If you want them to persist, + set `org-agenda-bulk-persistent-marks' to `t' or hit `p' at the + prompt. + + `*' + Toggle persistent marks. + + `$' + Archive all selected entries. + + `A' + Archive entries by moving them to their respective archive + siblings. + + `t' + Change TODO state. This prompts for a single TODO keyword + and changes the state of all selected entries, bypassing + blocking and suppressing logging notes (but not timestamps). + + `+' + Add a tag to all selected entries. + + `-' + Remove a tag from all selected entries. + + `s' + Schedule all items to a new date. To shift existing schedule + dates by a fixed number of days, use something starting with + double plus at the prompt, for example `++8d' or `++2w'. + + `d' + Set deadline to a specific date. + + `r' + Prompt for a single refile target and move all entries. The + entries will no longer be in the agenda; refresh (`g') to + bring them back. + + `S' + Reschedule randomly into the coming N days. N will be + prompted for. With prefix arg (`C-u B S'), scatter only + across weekdays. + + `f' + Apply a function(3) to marked entries. For example, the + function below sets the CATEGORY property of the entries to + web. + + (defun set-category () + (interactive "P") + (let* ((marker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer marker))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char marker) + (org-back-to-heading t) + (org-set-property "CATEGORY" "web")))))) + +Calendar commands +................. + +`c (`org-agenda-goto-calendar')' + Open the Emacs calendar and move to the date at the agenda cursor. + +`c (`org-calendar-goto-agenda')' + When in the calendar, compute and show the Org mode agenda for the + date at the cursor. + +`i (`org-agenda-diary-entry')' + Insert a new entry into the diary, using the date at the cursor + and (for block entries) the date at the mark. This will add to + the Emacs diary file(4), in a way similar to the `i' command in + the calendar. The diary file will pop up in another window, where + you can add the entry. + + If you configure `org-agenda-diary-file' to point to an Org mode + file, Org will create entries (in Org mode syntax) in that file + instead. Most entries will be stored in a date-based outline tree + that will later make it easy to archive appointments from previous + months/years. The tree will be built under an entry with a + `DATE_TREE' property, or else with years as top-level entries. + Emacs will prompt you for the entry text--if you specify it, the + entry will be created in `org-agenda-diary-file' without further + interaction. If you directly press at the prompt without + typing text, the target file will be shown in another window for + you to finish the entry there. See also the `k r' command. + +`M (`org-agenda-phases-of-moon')' + Show the phases of the moon for the three months around current + date. + +`S (`org-agenda-sunrise-sunset')' + Show sunrise and sunset times. The geographical location must be + set with calendar variables, see the documentation for the Emacs + calendar. + +`C (`org-agenda-convert-date')' + Convert the date at cursor into many other cultural and historic + calendars. + +`H (`org-agenda-holidays')' + Show holidays for three months around the cursor date. + +`M-x org-icalendar-combine-agenda-files RET' + Export a single iCalendar file containing entries from all agenda + files. This is a globally available command, and also available + in the agenda menu. + +Exporting to a file +................... + +`C-x C-w (`org-agenda-write')' + Write the agenda view to a file. Depending on the extension of + the selected file name, the view will be exported as HTML (`.html' + or `.htm'), Postscript (`.ps'), PDF (`.pdf'), Org (`.org') and + plain text (any other extension). When exporting to Org, only the + body of original headlines are exported, not subtrees or inherited + tags. When called with a `C-u' prefix argument, immediately open + the newly created file. Use the variable + `org-agenda-exporter-settings' to set options for `ps-print' and + for `htmlize' to be used during export. + +Quit and Exit +............. + +`q (`org-agenda-quit')' + Quit agenda, remove the agenda buffer. + +`x (`org-agenda-exit')' + Exit agenda, remove the agenda buffer and all buffers loaded by + Emacs for the compilation of the agenda. Buffers created by the + user to visit Org files will not be removed. + + ---------- Footnotes ---------- + + (1) Only tags filtering will be respected here, effort filtering is +ignored. + + (2) Moving agenda lines does not persist after an agenda refresh and +does not modify the contributing `.org' files + + (3) You can also create persistent custom functions through +`org-agenda-bulk-custom-functions'. + + (4) This file is parsed for the agenda when +`org-agenda-include-diary' is set. + + +File: org, Node: Custom agenda views, Next: Exporting Agenda Views, Prev: Agenda commands, Up: Agenda Views + +10.6 Custom agenda views +======================== + +Custom agenda commands serve two purposes: to store and quickly access +frequently used TODO and tags searches, and to create special composite +agenda buffers. Custom agenda commands will be accessible through the +dispatcher (*note Agenda dispatcher::), just like the default commands. + +* Menu: + +* Storing searches:: Type once, use often +* Block agenda:: All the stuff you need in a single buffer +* Setting Options:: Changing the rules + + +File: org, Node: Storing searches, Next: Block agenda, Prev: Custom agenda views, Up: Custom agenda views + +10.6.1 Storing searches +----------------------- + +The first application of custom searches is the definition of keyboard +shortcuts for frequently used searches, either creating an agenda +buffer, or a sparse tree (the latter covering of course only the current +buffer). + + Custom commands are configured in the variable +`org-agenda-custom-commands'. You can customize this variable, for +example by pressing `C-c a C'. You can also directly set it with Emacs +Lisp in `.emacs'. The following example contains all valid agenda +views: + + (setq org-agenda-custom-commands + '(("x" agenda) + ("y" agenda*) + ("w" todo "WAITING") + ("W" todo-tree "WAITING") + ("u" tags "+boss-urgent") + ("v" tags-todo "+boss-urgent") + ("U" tags-tree "+boss-urgent") + ("f" occur-tree "\\") + ("h" . "HOME+Name tags searches") ; description for "h" prefix + ("hl" tags "+home+Lisa") + ("hp" tags "+home+Peter") + ("hk" tags "+home+Kim"))) + +The initial string in each entry defines the keys you have to press +after the dispatcher command `C-c a' in order to access the command. +Usually this will be just a single character, but if you have many +similar commands, you can also define two-letter combinations where the +first character is the same in several combinations and serves as a +prefix key(1). The second parameter is the search type, followed by +the string or regular expression to be used for the matching. The +example above will therefore define: + +`C-c a x' + as a global search for agenda entries planned(2) this week/day. + +`C-c a y' + as a global search for agenda entries planned this week/day, but + only those with an hour specification like `[h]h:mm'--think of + them as appointments. + +`C-c a w' + as a global search for TODO entries with `WAITING' as the TODO + keyword + +`C-c a W' + as the same search, but only in the current buffer and displaying + the results as a sparse tree + +`C-c a u' + as a global tags search for headlines marked `:boss:' but not + `:urgent:' + +`C-c a v' + as the same search as `C-c a u', but limiting the search to + headlines that are also TODO items + +`C-c a U' + as the same search as `C-c a u', but only in the current buffer and + displaying the result as a sparse tree + +`C-c a f' + to create a sparse tree (again: current buffer only) with all + entries containing the word `FIXME' + +`C-c a h' + as a prefix command for a HOME tags search where you have to press + an additional key (`l', `p' or `k') to select a name (Lisa, Peter, + or Kim) as additional tag to match. + + Note that the `*-tree' agenda views need to be called from an Org +buffer as they operate on the current buffer only. + + ---------- Footnotes ---------- + + (1) You can provide a description for a prefix key by inserting a +cons cell with the prefix and the description. + + (2) _Planned_ means here that these entries have some planning +information attached to them, like a time-stamp, a scheduled or a +deadline string. See `org-agenda-entry-types' on how to set what +planning information will be taken into account. + + +File: org, Node: Block agenda, Next: Setting Options, Prev: Storing searches, Up: Custom agenda views + +10.6.2 Block agenda +------------------- + +Another possibility is the construction of agenda views that comprise +the results of _several_ commands, each of which creates a block in the +agenda buffer. The available commands include `agenda' for the daily +or weekly agenda (as created with `C-c a a'), `alltodo' for the global +TODO list (as constructed with `C-c a t'), and the matching commands +discussed above: `todo', `tags', and `tags-todo'. Here are two +examples: + + (setq org-agenda-custom-commands + '(("h" "Agenda and Home-related tasks" + ((agenda "") + (tags-todo "home") + (tags "garden"))) + ("o" "Agenda and Office-related tasks" + ((agenda "") + (tags-todo "work") + (tags "office"))))) + +This will define `C-c a h' to create a multi-block view for stuff you +need to attend to at home. The resulting agenda buffer will contain +your agenda for the current week, all TODO items that carry the tag +`home', and also all lines tagged with `garden'. Finally the command +`C-c a o' provides a similar view for office tasks. + + +File: org, Node: Setting Options, Prev: Block agenda, Up: Custom agenda views + +10.6.3 Setting options for custom commands +------------------------------------------ + +Org mode contains a number of variables regulating agenda construction +and display. The global variables define the behavior for all agenda +commands, including the custom commands. However, if you want to change +some settings just for a single custom view, you can do so. Setting +options requires inserting a list of variable names and values at the +right spot in `org-agenda-custom-commands'. For example: + + (setq org-agenda-custom-commands + '(("w" todo "WAITING" + ((org-agenda-sorting-strategy '(priority-down)) + (org-agenda-prefix-format " Mixed: "))) + ("U" tags-tree "+boss-urgent" + ((org-show-following-heading nil) + (org-show-hierarchy-above nil))) + ("N" search "" + ((org-agenda-files '("~org/notes.org")) + (org-agenda-text-search-extra-files nil))))) + +Now the `C-c a w' command will sort the collected entries only by +priority, and the prefix format is modified to just say ` Mixed: ' +instead of giving the category of the entry. The sparse tags tree of +`C-c a U' will now turn out ultra-compact, because neither the headline +hierarchy above the match, nor the headline following the match will be +shown. The command `C-c a N' will do a text search limited to only a +single file. + + For command sets creating a block agenda, +`org-agenda-custom-commands' has two separate spots for setting +options. You can add options that should be valid for just a single +command in the set, and options that should be valid for all commands in +the set. The former are just added to the command entry; the latter +must come after the list of command entries. Going back to the block +agenda example (*note Block agenda::), let's change the sorting strategy +for the `C-c a h' commands to `priority-down', but let's sort the +results for GARDEN tags query in the opposite order, `priority-up'. +This would look like this: + + (setq org-agenda-custom-commands + '(("h" "Agenda and Home-related tasks" + ((agenda) + (tags-todo "home") + (tags "garden" + ((org-agenda-sorting-strategy '(priority-up))))) + ((org-agenda-sorting-strategy '(priority-down)))) + ("o" "Agenda and Office-related tasks" + ((agenda) + (tags-todo "work") + (tags "office"))))) + + As you see, the values and parentheses setting is a little complex. +When in doubt, use the customize interface to set this variable--it +fully supports its structure. Just one caveat: when setting options in +this interface, the _values_ are just Lisp expressions. So if the +value is a string, you need to add the double-quotes around the value +yourself. + + To control whether an agenda command should be accessible from a +specific context, you can customize +`org-agenda-custom-commands-contexts'. Let's say for example that you +have an agenda commands `"o"' displaying a view that you only need when +reading emails. Then you would configure this option like this: + + (setq org-agenda-custom-commands-contexts + '(("o" (in-mode . "message-mode")))) + + You can also tell that the command key `"o"' should refer to another +command key `"r"'. In that case, add this command key like this: + + (setq org-agenda-custom-commands-contexts + '(("o" "r" (in-mode . "message-mode")))) + + See the docstring of the variable for more information. + + +File: org, Node: Exporting Agenda Views, Next: Agenda column view, Prev: Custom agenda views, Up: Agenda Views + +10.7 Exporting Agenda Views +=========================== + +If you are away from your computer, it can be very useful to have a +printed version of some agenda views to carry around. Org mode can +export custom agenda views as plain text, HTML(1), Postscript, PDF(2), +and iCalendar files. If you want to do this only occasionally, use the +command + +`C-x C-w (`org-agenda-write')' + Write the agenda view to a file. Depending on the extension of + the selected file name, the view will be exported as HTML + (extension `.html' or `.htm'), Postscript (extension `.ps'), + iCalendar (extension `.ics'), or plain text (any other extension). + Use the variable `org-agenda-exporter-settings' to set options for + `ps-print' and for `htmlize' to be used during export, for example + + (setq org-agenda-exporter-settings + '((ps-number-of-columns 2) + (ps-landscape-mode t) + (org-agenda-add-entry-text-maxlines 5) + (htmlize-output-type 'css))) + + If you need to export certain agenda views frequently, you can +associate any custom agenda command with a list of output file names +(3). Here is an example that first defines custom commands for the +agenda and the global TODO list, together with a number of files to +which to export them. Then we define two block agenda commands and +specify file names for them as well. File names can be relative to the +current working directory, or absolute. + + (setq org-agenda-custom-commands + '(("X" agenda "" nil ("agenda.html" "agenda.ps")) + ("Y" alltodo "" nil ("todo.html" "todo.txt" "todo.ps")) + ("h" "Agenda and Home-related tasks" + ((agenda "") + (tags-todo "home") + (tags "garden")) + nil + ("~/views/home.html")) + ("o" "Agenda and Office-related tasks" + ((agenda) + (tags-todo "work") + (tags "office")) + nil + ("~/views/office.ps" "~/calendars/office.ics")))) + + The extension of the file name determines the type of export. If it +is `.html', Org mode will use the `htmlize.el' package to convert the +buffer to HTML and save it to this file name. If the extension is +`.ps', `ps-print-buffer-with-faces' is used to produce Postscript +output. If the extension is `.ics', iCalendar export is run export +over all files that were used to construct the agenda, and limit the +export to entries listed in the agenda. Any other extension produces a +plain ASCII file. + + The export files are _not_ created when you use one of those +commands interactively because this might use too much overhead. +Instead, there is a special command to produce _all_ specified files in +one step: + +`C-c a e (`org-store-agenda-views')' + Export all agenda views that have export file names associated with + them. + + You can use the options section of the custom agenda commands to also +set options for the export commands. For example: + + (setq org-agenda-custom-commands + '(("X" agenda "" + ((ps-number-of-columns 2) + (ps-landscape-mode t) + (org-agenda-prefix-format " [ ] ") + (org-agenda-with-colors nil) + (org-agenda-remove-tags t)) + ("theagenda.ps")))) + +This command sets two options for the Postscript exporter, to make it +print in two columns in landscape format--the resulting page can be cut +in two and then used in a paper agenda. The remaining settings modify +the agenda prefix to omit category and scheduling information, and +instead include a checkbox to check off items. We also remove the tags +to make the lines compact, and we don't want to use colors for the +black-and-white printer. Settings specified in +`org-agenda-exporter-settings' will also apply, but the settings in +`org-agenda-custom-commands' take precedence. + +From the command line you may also use + emacs -eval (org-batch-store-agenda-views) -kill + or, if you need to modify some parameters(4) + emacs -eval '(org-batch-store-agenda-views \ + org-agenda-span (quote month) \ + org-agenda-start-day "2007-11-01" \ + org-agenda-include-diary nil \ + org-agenda-files (quote ("~/org/project.org")))' \ + -kill + which will create the agenda views restricted to the file +`~/org/project.org', without diary entries and with a 30-day extent. + + You can also extract agenda information in a way that allows further +processing by other programs. See *note Extracting agenda +information::, for more information. + + ---------- Footnotes ---------- + + (1) You need to install Hrvoje Niksic's `htmlize.el'. + + (2) To create PDF output, the ghostscript `ps2pdf' utility must be +installed on the system. Selecting a PDF file will also create the +postscript file. + + (3) If you want to store standard views like the weekly agenda or +the global TODO list as well, you need to define custom commands for +them in order to be able to specify file names. + + (4) Quoting depends on the system you use, please check the FAQ for +examples. + + +File: org, Node: Agenda column view, Prev: Exporting Agenda Views, Up: Agenda Views + +10.8 Using column view in the agenda +==================================== + +Column view (*note Column view::) is normally used to view and edit +properties embedded in the hierarchical structure of an Org file. It +can be quite useful to use column view also from the agenda, where +entries are collected by certain criteria. + +`C-c C-x C-c (`org-agenda-columns')' + Turn on column view in the agenda. + + To understand how to use this properly, it is important to realize +that the entries in the agenda are no longer in their proper outline +environment. This causes the following issues: + + 1. Org needs to make a decision which `COLUMNS' format to use. Since + the entries in the agenda are collected from different files, and + different files may have different `COLUMNS' formats, this is a + non-trivial problem. Org first checks if the variable + `org-agenda-overriding-columns-format' is currently set, and if + so, takes the format from there. Otherwise it takes the format + associated with the first item in the agenda, or, if that item + does not have a specific format (defined in a property, or in its + file), it uses `org-columns-default-format'. + + 2. If any of the columns has a summary type defined (*note Column + attributes::), turning on column view in the agenda will visit all + relevant agenda files and make sure that the computations of this + property are up to date. This is also true for the special + `CLOCKSUM' property. Org will then sum the values displayed in + the agenda. In the daily/weekly agenda, the sums will cover a + single day; in all other views they cover the entire block. It is + vital to realize that the agenda may show the same entry _twice_ + (for example as scheduled and as a deadline), and it may show two + entries from the same hierarchy (for example a _parent_ and its + _child_). In these cases, the summation in the agenda will lead + to incorrect results because some values will count double. + + 3. When the column view in the agenda shows the `CLOCKSUM', that is + always the entire clocked time for this item. So even in the + daily/weekly agenda, the clocksum listed in column view may + originate from times outside the current view. This has the + advantage that you can compare these values with a column listing + the planned total effort for a task--one of the major applications + for column view in the agenda. If you want information about + clocked time in the displayed period use clock table mode (press + `R' in the agenda). + + 4. When the column view in the agenda shows the `CLOCKSUM_T', that is + always today's clocked time for this item. So even in the weekly + agenda, the clocksum listed in column view only originates from + today. This lets you compare the time you spent on a task for + today, with the time already spent (via `CLOCKSUM') and with the + planned total effort for it. + + +File: org, Node: Markup, Next: Exporting, Prev: Agenda Views, Up: Top + +11 Markup for rich export +************************* + +When exporting Org mode documents, the exporter tries to reflect the +structure of the document as accurately as possible in the back-end. +Since export targets like HTML, LaTeX allow much richer formatting, Org +mode has rules on how to prepare text for rich export. This section +summarizes the markup rules used in an Org mode buffer. + +* Menu: + +* Structural markup elements:: The basic structure as seen by the exporter +* Images and tables:: Images, tables and caption mechanism +* Literal examples:: Source code examples with special formatting +* Include files:: Include additional files into a document +* Index entries:: Making an index +* Macro replacement:: Use macros to create templates +* Embedded LaTeX:: LaTeX can be freely used inside Org documents +* Special blocks:: Containers targeted at export back-ends + + +File: org, Node: Structural markup elements, Next: Images and tables, Prev: Markup, Up: Markup + +11.1 Structural markup elements +=============================== + +* Menu: + +* Document title:: Where the title is taken from +* Headings and sections:: The document structure as seen by the exporter +* Table of contents:: The if and where of the table of contents +* Lists:: Lists +* Paragraphs:: Paragraphs +* Footnote markup:: Footnotes +* Emphasis and monospace:: Bold, italic, etc. +* Horizontal rules:: Make a line +* Comment lines:: What will *not* be exported + + +File: org, Node: Document title, Next: Headings and sections, Prev: Structural markup elements, Up: Structural markup elements + +Document title +-------------- + +The title of the exported document is taken from the special line + + #+TITLE: This is the title of the document + +If this line does not exist, the title will be the name of the file +associated to buffer, without extension, or the buffer name. + + If you are exporting only a subtree, its heading will become the +title of the document. If the subtree has a property `EXPORT_TITLE', +that will take precedence. + + +File: org, Node: Headings and sections, Next: Table of contents, Prev: Document title, Up: Structural markup elements + +Headings and sections +--------------------- + +The outline structure of the document as described in *note Document +Structure::, forms the basis for defining sections of the exported +document. However, since the outline structure is also used for (for +example) lists of tasks, only the first three outline levels will be +used as headings. Deeper levels will become itemized lists. You can +change the location of this switch globally by setting the variable +`org-export-headline-levels', or on a per-file basis with a line + + #+OPTIONS: H:4 + + +File: org, Node: Table of contents, Next: Lists, Prev: Headings and sections, Up: Structural markup elements + +Table of contents +----------------- + +The table of contents is normally inserted directly before the first +headline of the file. The depth of the table is by default the same as +the number of headline levels, but you can choose a smaller number, or +turn off the table of contents entirely, by configuring the variable +`org-export-with-toc', or on a per-file basis with a line like + + #+OPTIONS: toc:2 (only to two levels in TOC) + #+OPTIONS: toc:nil (no default TOC at all) + + If you would like to move the table of contents to a different +location, you should turn off the default table using +`org-export-with-toc' or `#+OPTIONS' and insert `#+TOC: headlines N' at +the desired location(s). + + #+OPTIONS: toc:nil (no default TOC) + ... + #+TOC: headlines 2 (insert TOC here, with two headline levels) + + Multiple `#+TOC: headline' lines are allowed. The same `TOC' +keyword can also generate a list of all tables (resp. all listings) +with a caption in the buffer. + + #+TOC: listings (build a list of listings) + #+TOC: tables (build a list of tables) + + The headline's title usually determines its corresponding entry in a +table of contents. However, it is possible to specify an alternative +title by setting `ALT_TITLE' property accordingly. It will then be +used when building the table. + + +File: org, Node: Lists, Next: Paragraphs, Prev: Table of contents, Up: Structural markup elements + +Lists +----- + +Plain lists as described in *note Plain lists::, are translated to the +back-end's syntax for such lists. Most back-ends support unordered, +ordered, and description lists. + + +File: org, Node: Paragraphs, Next: Footnote markup, Prev: Lists, Up: Structural markup elements + +Paragraphs, line breaks, and quoting +------------------------------------ + +Paragraphs are separated by at least one empty line. If you need to +enforce a line break within a paragraph, use `\\' at the end of a line. + + To keep the line breaks in a region, but otherwise use normal +formatting, you can use this construct, which can also be used to +format poetry. + + #+BEGIN_VERSE + Great clouds overhead + Tiny black birds rise and fall + Snow covers Emacs + + -- AlexSchroeder + #+END_VERSE + + When quoting a passage from another document, it is customary to +format this as a paragraph that is indented on both the left and the +right margin. You can include quotations in Org mode documents like +this: + + #+BEGIN_QUOTE + Everything should be made as simple as possible, + but not any simpler -- Albert Einstein + #+END_QUOTE + + If you would like to center some text, do it like this: + #+BEGIN_CENTER + Everything should be made as simple as possible, \\ + but not any simpler + #+END_CENTER + + +File: org, Node: Footnote markup, Next: Emphasis and monospace, Prev: Paragraphs, Up: Structural markup elements + +Footnote markup +--------------- + +Footnotes defined in the way described in *note Footnotes::, will be +exported by all back-ends. Org allows multiple references to the same +note, and multiple footnotes side by side. + + +File: org, Node: Emphasis and monospace, Next: Horizontal rules, Prev: Footnote markup, Up: Structural markup elements + +Emphasis and monospace +---------------------- + +You can make words *bold*, /italic/, _underlined_, `=verbatim=' and +`~code~', and, if you must, `+strike-through+'. Text in the code and +verbatim string is not processed for Org mode specific syntax, it is +exported verbatim. + + To turn off fontification for marked up text, you can set +`org-fontify-emphasized-text' to `nil'. To narrow down the list of +available markup syntax, you can customize `org-emphasis-alist'. To +fine tune what characters are allowed before and after the markup +characters, you can tweak `org-emphasis-regexp-components'. Beware +that changing one of the above variables will no take effect until you +reload Org, for which you may need to restart Emacs. + + +File: org, Node: Horizontal rules, Next: Comment lines, Prev: Emphasis and monospace, Up: Structural markup elements + +Horizontal rules +---------------- + +A line consisting of only dashes, and at least 5 of them, will be +exported as a horizontal line. + + +File: org, Node: Comment lines, Prev: Horizontal rules, Up: Structural markup elements + +Comment lines +------------- + +Lines starting with zero or more whitespace characters followed by one +`#' and a whitespace are treated as comments and will never be exported. +Also entire subtrees starting with the word `COMMENT' will never be +exported. Finally, regions surrounded by `#+BEGIN_COMMENT' ... +`#+END_COMMENT' will not be exported. + +`C-c ;' + Toggle the COMMENT keyword at the beginning of an entry. + + +File: org, Node: Images and tables, Next: Literal examples, Prev: Structural markup elements, Up: Markup + +11.2 Images and Tables +====================== + +Both the native Org mode tables (*note Tables::) and tables formatted +with the `table.el' package will be exported properly. For Org mode +tables, the lines before the first horizontal separator line will +become table header lines. You can use the following lines somewhere +before the table to assign a caption and a label for cross references, +and in the text you can refer to the object with `[[tab:basic-data]]' +(*note Internal links::): + + #+CAPTION: This is the caption for the next table (or link) + #+NAME: tab:basic-data + | ... | ...| + |-----|----| + + Optionally, the caption can take the form: + #+CAPTION[Caption for list of tables]: Caption for table. + + Some back-ends allow you to directly include images into the exported +document. Org does this, if a link to an image files does not have a +description part, for example `[[./img/a.jpg]]'. If you wish to define +a caption for the image and maybe a label for internal cross +references, make sure that the link is on a line by itself and precede +it with `#+CAPTION' and `#+NAME' as follows: + + #+CAPTION: This is the caption for the next figure link (or table) + #+NAME: fig:SED-HR4049 + [[./img/a.jpg]] + +Such images can be displayed within the buffer. *Note the discussion +of image links: Handling links. + + Even though images and tables are prominent examples of captioned +structures, the same caption mechanism can apply to many others (e.g., +LaTeX equations, source code blocks). Depending on the export +back-end, those may or may not be handled. + + +File: org, Node: Literal examples, Next: Include files, Prev: Images and tables, Up: Markup + +11.3 Literal examples +===================== + +You can include literal examples that should not be subjected to +markup. Such examples will be typeset in monospace, so this is well +suited for source code and similar examples. + + #+BEGIN_EXAMPLE + Some example from a text file. + #+END_EXAMPLE + + Note that such blocks may be indented in order to align nicely with +indented text and in particular with plain list structure (*note Plain +lists::). For simplicity when using small examples, you can also start +the example lines with a colon followed by a space. There may also be +additional whitespace before the colon: + + Here is an example + : Some example from a text file. + + If the example is source code from a programming language, or any +other text that can be marked up by font-lock in Emacs, you can ask for +the example to look like the fontified Emacs buffer(1). This is done +with the `src' block, where you also need to specify the name of the +major mode that should be used to fontify the example(2), see *note +Easy Templates:: for shortcuts to easily insert code blocks. + + #+BEGIN_SRC emacs-lisp + (defun org-xor (a b) + "Exclusive or." + (if a (not b) b)) + #+END_SRC + + Both in `example' and in `src' snippets, you can add a `-n' switch +to the end of the `BEGIN' line, to get the lines of the example +numbered. If you use a `+n' switch, the numbering from the previous +numbered snippet will be continued in the current one. In literal +examples, Org will interpret strings like `(ref:name)' as labels, and +use them as targets for special hyperlinks like `[[(name)]]' (i.e., the +reference name enclosed in single parenthesis). In HTML, hovering the +mouse over such a link will remote-highlight the corresponding code +line, which is kind of cool. + + You can also add a `-r' switch which removes the labels from the +source code(3). With the `-n' switch, links to these references will +be labeled by the line numbers from the code listing, otherwise links +will use the labels with no parentheses. Here is an example: + + #+BEGIN_SRC emacs-lisp -n -r + (save-excursion (ref:sc) + (goto-char (point-min))) (ref:jump) + #+END_SRC + In line [[(sc)]] we remember the current position. [[(jump)][Line (jump)]] + jumps to point-min. + + If the syntax for the label format conflicts with the language +syntax, use a `-l' switch to change the format, for example +`#+BEGIN_SRC pascal -n -r -l "((%s))"'. See also the variable +`org-coderef-label-format'. + + HTML export also allows examples to be published as text areas +(*note Text areas in HTML export::). + + Because the `#+BEGIN_...' and `#+END_...' patterns need to be added +so often, shortcuts are provided using the Easy Templates facility +(*note Easy Templates::). + +`C-c '' + Edit the source code example at point in its native mode. This + works by switching to a temporary buffer with the source code. + You need to exit by pressing `C-c '' again(4). The edited version + will then replace the old version in the Org buffer. Fixed-width + regions (where each line starts with a colon followed by a space) + will be edited using `artist-mode'(5) to allow creating ASCII + drawings easily. Using this command in an empty line will create + a new fixed-width region. + +`C-c l' + Calling `org-store-link' while editing a source code example in a + temporary buffer created with `C-c '' will prompt for a label. + Make sure that it is unique in the current buffer, and insert it + with the proper formatting like `(ref:label)' at the end of the + current line. Then the label is stored as a link `(label)', for + retrieval with `C-c C-l'. + + ---------- Footnotes ---------- + + (1) This works automatically for the HTML back-end (it requires +version 1.34 of the `htmlize.el' package, which is distributed with +Org). Fontified code chunks in LaTeX can be achieved using either the +listings or the minted (http://code.google.com/p/minted) package. +Refer to `org-latex-listings' documentation for details. + + (2) Code in `src' blocks may also be evaluated either interactively +or on export. See *note Working With Source Code:: for more +information on evaluating code blocks. + + (3) Adding `-k' to `-n -r' will keep the labels in the source code +while using line numbers for the links, which might be useful to +explain those in an Org mode example code. + + (4) Upon exit, lines starting with `*', `,*', `#+' and `,#+' will +get a comma prepended, to keep them from being interpreted by Org as +outline nodes or special syntax. These commas will be stripped for +editing with `C-c '', and also for export. + + (5) You may select a different-mode with the variable +`org-edit-fixed-width-region-mode'. + + +File: org, Node: Include files, Next: Index entries, Prev: Literal examples, Up: Markup + +11.4 Include files +================== + +During export, you can include the content of another file. For +example, to include your `.emacs' file, you could use: + + #+INCLUDE: "~/.emacs" src emacs-lisp + +The optional second and third parameter are the markup (i.e., `example' +or `src'), and, if the markup is `src', the language for formatting the +contents. The markup is optional; if it is not given, the text will be +assumed to be in Org mode format and will be processed normally. + + Contents of the included file will belong to the same structure +(headline, item) containing the `INCLUDE' keyword. In particular, +headlines within the file will become children of the current section. +That behavior can be changed by providing an additional keyword +parameter, `:minlevel'. In that case, all headlines in the included +file will be shifted so the one with the lowest level reaches that +specified level. For example, to make a file become a sibling of the +current top-level headline, use + + #+INCLUDE: "~/my-book/chapter2.org" :minlevel 1 + + You can also include a portion of a file by specifying a lines range +using the `:lines' parameter. The line at the upper end of the range +will not be included. The start and/or the end of the range may be +omitted to use the obvious defaults. + + #+INCLUDE: "~/.emacs" :lines "5-10" Include lines 5 to 10, 10 excluded + #+INCLUDE: "~/.emacs" :lines "-10" Include lines 1 to 10, 10 excluded + #+INCLUDE: "~/.emacs" :lines "10-" Include lines from 10 to EOF + +`C-c '' + Visit the include file at point. + + +File: org, Node: Index entries, Next: Macro replacement, Prev: Include files, Up: Markup + +11.5 Index entries +================== + +You can specify entries that will be used for generating an index during +publishing. This is done by lines starting with `#+INDEX'. An entry +the contains an exclamation mark will create a sub item. See *note +Generating an index:: for more information. + + * Curriculum Vitae + #+INDEX: CV + #+INDEX: Application!CV + + +File: org, Node: Macro replacement, Next: Embedded LaTeX, Prev: Index entries, Up: Markup + +11.6 Macro replacement +====================== + +You can define text snippets with + + #+MACRO: name replacement text $1, $2 are arguments + +which can be referenced in paragraphs, verse blocks, table cells and +some keywords with `{{{name(arg1,arg2)}}}'(1). In addition to defined +macros, `{{{title}}}', `{{{author}}}', etc., will reference information +set by the `#+TITLE:', `#+AUTHOR:', and similar lines. Also, +`{{{time(FORMAT)}}}' and `{{{modification-time(FORMAT)}}}' refer to +current date time and to the modification time of the file being +exported, respectively. FORMAT should be a format string understood by +`format-time-string'. + + Macro expansion takes place during export. + + ---------- Footnotes ---------- + + (1) Since commas separate arguments, commas within arguments have to +be escaped with a backslash character. Conversely, backslash +characters before a comma, and only them, need to be escaped with +another backslash character. + + +File: org, Node: Embedded LaTeX, Next: Special blocks, Prev: Macro replacement, Up: Markup + +11.7 Embedded LaTeX +=================== + +Plain ASCII is normally sufficient for almost all note taking. +Exceptions include scientific notes, which often require mathematical +symbols and the occasional formula. LaTeX(1) is widely used to +typeset scientific documents. Org mode supports embedding LaTeX code +into its files, because many academics are used to writing and reading +LaTeX source code, and because it can be readily processed to produce +pretty output for a number of export back-ends. + +* Menu: + +* Special symbols:: Greek letters and other symbols +* Subscripts and superscripts:: Simple syntax for raising/lowering text +* LaTeX fragments:: Complex formulas made easy +* Previewing LaTeX fragments:: What will this snippet look like? +* CDLaTeX mode:: Speed up entering of formulas + + ---------- Footnotes ---------- + + (1) LaTeX is a macro system based on Donald E. Knuth's TeX system. +Many of the features described here as "LaTeX" are really from TeX, but +for simplicity I am blurring this distinction. + + +File: org, Node: Special symbols, Next: Subscripts and superscripts, Prev: Embedded LaTeX, Up: Embedded LaTeX + +11.7.1 Special symbols +---------------------- + +You can use LaTeX-like syntax to insert special symbols like `\alpha' +to indicate the Greek letter, or `\to' to indicate an arrow. Completion +for these symbols is available, just type `\' and maybe a few letters, +and press `M-' to see possible completions. Unlike LaTeX code, +Org mode allows these symbols to be present without surrounding math +delimiters, for example: + + Angles are written as Greek letters \alpha, \beta and \gamma. + + During export, these symbols will be transformed into the native +format of the exporter back-end. Strings like `\alpha' will be +exported as `α' in the HTML output, and as `$\alpha$' in the LaTeX +output. Similarly, `\nbsp' will become ` ' in HTML and `~' in +LaTeX. If you need such a symbol inside a word, terminate it like +this: `\Aacute{}stor'. + + A large number of entities is provided, with names taken from both +HTML and LaTeX; see the variable `org-entities' for the complete list. +`\-' is treated as a shy hyphen, and `--', `---', and `...' are all +converted into special commands creating hyphens of different lengths +or a compact set of dots. + + If you would like to see entities displayed as UTF-8 characters, use +the following command(1): + +`C-c C-x \' + Toggle display of entities as UTF-8 characters. This does not + change the buffer content which remains plain ASCII, but it + overlays the UTF-8 character for display purposes only. + + ---------- Footnotes ---------- + + (1) You can turn this on by default by setting the variable +`org-pretty-entities', or on a per-file base with the `#+STARTUP' +option `entitiespretty'. + + +File: org, Node: Subscripts and superscripts, Next: LaTeX fragments, Prev: Special symbols, Up: Embedded LaTeX + +11.7.2 Subscripts and superscripts +---------------------------------- + +Just like in LaTeX, `^' and `_' are used to indicate super- and +subscripts. Again, these can be used without embedding them in +math-mode delimiters. To increase the readability of ASCII text, it is +not necessary (but OK) to surround multi-character sub- and +superscripts with curly braces. For example + + The mass of the sun is M_sun = 1.989 x 10^30 kg. The radius of + the sun is R_{sun} = 6.96 x 10^8 m. + + If you write a text where the underscore is often used in a different +context, Org's convention to always interpret these as subscripts can +get in your way. Configure the variable `org-use-sub-superscripts' to +change this convention. For example, when setting this variable to +`{}', `a_b' will not be interpreted as a subscript, but `a_{b}' will. + +`C-c C-x \' + In addition to showing entities as UTF-8 characters, this command + will also format sub- and superscripts in a WYSIWYM way. + + +File: org, Node: LaTeX fragments, Next: Previewing LaTeX fragments, Prev: Subscripts and superscripts, Up: Embedded LaTeX + +11.7.3 LaTeX fragments +---------------------- + +Going beyond symbols and sub- and superscripts, a full formula language +is needed. Org mode can contain LaTeX math fragments, and it supports +ways to process these for several export back-ends. When exporting to +LaTeX, the code is obviously left as it is. When exporting to HTML, +Org invokes the MathJax library (http://www.mathjax.org) (*note Math +formatting in HTML export::) to process and display the math(1). +Finally, it can also process the mathematical expressions into +images(2) that can be displayed in a browser. + + LaTeX fragments don't need any special marking at all. The following +snippets will be identified as LaTeX source code: + * Environments of any kind(3). The only requirement is that the + `\begin' and `\end' statements appear on a new line, at the + beginning of the line or after whitespaces only. + + * Text within the usual LaTeX math delimiters. To avoid conflicts + with currency specifications, single `$' characters are only + recognized as math delimiters if the enclosed text contains at + most two line breaks, is directly attached to the `$' characters + with no whitespace in between, and if the closing `$' is followed + by whitespace, punctuation or a dash. For the other delimiters, + there is no such restriction, so when in doubt, use `\(...\)' as + inline math delimiters. + +For example: + + \begin{equation} + x=\sqrt{b} + \end{equation} + + If $a^2=b$ and \( b=2 \), then the solution must be + either $$ a=+\sqrt{2} $$ or \[ a=-\sqrt{2} \]. + + LaTeX processing can be configured with the variable +`org-export-with-latex'. The default setting is `t' which means +`MathJax' for HTML, and no processing for ASCII and LaTeX back-ends. +You can also set this variable on a per-file basis using one of these +lines: + + #+OPTIONS: tex:t Do the right thing automatically (MathJax) + #+OPTIONS: tex:nil Do not process LaTeX fragments at all + #+OPTIONS: tex:verbatim Verbatim export, for jsMath or so + + ---------- Footnotes ---------- + + (1) If you plan to use this regularly or on pages with significant +page views, you should install `MathJax' on your own server in order to +limit the load of our server. + + (2) For this to work you need to be on a system with a working LaTeX +installation. You also need the `dvipng' program or the `convert', +respectively available at `http://sourceforge.net/projects/dvipng/' and +from the `imagemagick' suite. The LaTeX header that will be used when +processing a fragment can be configured with the variable +`org-format-latex-header'. + + (3) When `MathJax' is used, only the environments recognized by +`MathJax' will be processed. When `dvipng' program or `imagemagick' +suite is used to create images, any LaTeX environment will be handled. + + +File: org, Node: Previewing LaTeX fragments, Next: CDLaTeX mode, Prev: LaTeX fragments, Up: Embedded LaTeX + +11.7.4 Previewing LaTeX fragments +--------------------------------- + +If you have `dvipng' or `imagemagick' installed(1), LaTeX fragments can +be processed to produce preview images of the typeset expressions: + +`C-c C-x C-l' + Produce a preview image of the LaTeX fragment at point and overlay + it over the source code. If there is no fragment at point, + process all fragments in the current entry (between two + headlines). When called with a prefix argument, process the + entire subtree. When called with two prefix arguments, or when + the cursor is before the first headline, process the entire buffer. + +`C-c C-c' + Remove the overlay preview images. + + You can customize the variable `org-format-latex-options' to +influence some aspects of the preview. In particular, the `:scale' +(and for HTML export, `:html-scale') property can be used to adjust the +size of the preview images. + + You can turn on the previewing of all LaTeX fragments in a file with + + #+STARTUP: latexpreview + + To disable it, simply use + + #+STARTUP: nolatexpreview + + ---------- Footnotes ---------- + + (1) Choose the converter by setting the variable +`org-latex-create-formula-image-program' accordingly. + + +File: org, Node: CDLaTeX mode, Prev: Previewing LaTeX fragments, Up: Embedded LaTeX + +11.7.5 Using CDLaTeX to enter math +---------------------------------- + +CDLaTeX mode is a minor mode that is normally used in combination with a +major LaTeX mode like AUCTeX in order to speed-up insertion of +environments and math templates. Inside Org mode, you can make use of +some of the features of CDLaTeX mode. You need to install `cdlatex.el' +and `texmathp.el' (the latter comes also with AUCTeX) from +`http://www.astro.uva.nl/~dominik/Tools/cdlatex'. Don't use CDLaTeX +mode itself under Org mode, but use the light version +`org-cdlatex-mode' that comes as part of Org mode. Turn it on for the +current buffer with `M-x org-cdlatex-mode RET', or for all Org files +with + + (add-hook 'org-mode-hook 'turn-on-org-cdlatex) + + When this mode is enabled, the following features are present (for +more details see the documentation of CDLaTeX mode): + * Environment templates can be inserted with `C-c {'. + + * The key will do template expansion if the cursor is inside a + LaTeX fragment(1). For example, will expand `fr' to + `\frac{}{}' and position the cursor correctly inside the first + brace. Another will get you into the second brace. Even + outside fragments, will expand environment abbreviations at + the beginning of a line. For example, if you write `equ' at the + beginning of a line and press , this abbreviation will be + expanded to an `equation' environment. To get a list of all + abbreviations, type `M-x cdlatex-command-help RET'. + + * Pressing `_' and `^' inside a LaTeX fragment will insert these + characters together with a pair of braces. If you use to + move out of the braces, and if the braces surround only a single + character or macro, they are removed again (depending on the + variable `cdlatex-simplify-sub-super-scripts'). + + * Pressing the backquote ``' followed by a character inserts math + macros, also outside LaTeX fragments. If you wait more than 1.5 + seconds after the backquote, a help window will pop up. + + * Pressing the single-quote `'' followed by another character + modifies the symbol before point with an accent or a font. If you + wait more than 1.5 seconds after the single-quote, a help window + will pop up. Character modification will work only inside LaTeX + fragments; outside the quote is normal. + + ---------- Footnotes ---------- + + (1) Org mode has a method to test if the cursor is inside such a +fragment, see the documentation of the function +`org-inside-LaTeX-fragment-p'. + + +File: org, Node: Special blocks, Prev: Embedded LaTeX, Up: Markup + +11.8 Special blocks +=================== + +Org syntax includes pre-defined blocks (*note Paragraphs:: and *note +Literal examples::). It is also possible to create blocks containing +raw code targeted at a specific back-ends (e.g., `#+BEGIN_LATEX'). + + Any other block is a _special block_. + + For example, `#+BEGIN_ABSTRACT' and `#+BEGIN_VIDEO' are special +blocks. The first one is useful when exporting to LaTeX, the second one +when exporting to HTML5. + + Each export back-end decides if they should be exported, and how. +When the block is ignored, its contents are still exported, as if the +opening and closing block lines were not there. For example, when +exporting a `#+BEGIN_TEST' block, HTML back-end wraps its contents +within a `
' tag. + + Refer to back-end specific documentation for more information. + + +File: org, Node: Exporting, Next: Publishing, Prev: Markup, Up: Top + +12 Exporting +************ + +The Org mode export facilities can be used to export Org documents or +parts of Org documents to a variety of other formats. In addition, +these facilities can be used with `orgtbl-mode' and/or `orgstruct-mode' +in foreign buffers so you can author tables and lists in Org syntax and +convert them in place to the target language. + + ASCII export produces a readable and simple version of an Org file +for printing and sharing notes. HTML export allows you to easily +publish notes on the web, or to build full-fledged websites. LaTeX +export lets you use Org mode and its structured editing functions to +create arbitrarily complex LaTeX files for any kind of document. +OpenDocument Text (ODT) export allows seamless collaboration across +organizational boundaries. Markdown export lets you seamlessly +collaborate with other developers. Finally, iCal export can extract +entries with deadlines or appointments to produce a file in the +iCalendar format. + +* Menu: + +* The Export Dispatcher:: The main exporter interface +* Export back-ends:: Built-in export formats +* Export settings:: Generic export settings +* ASCII/Latin-1/UTF-8 export:: Exporting to flat files with encoding +* Beamer export:: Exporting as a Beamer presentation +* HTML export:: Exporting to HTML +* LaTeX and PDF export:: Exporting to LaTeX, and processing to PDF +* Markdown export:: Exporting to Markdown +* OpenDocument Text export:: Exporting to OpenDocument Text +* Org export:: Exporting to Org +* Texinfo export:: Exporting to Texinfo +* iCalendar export:: Exporting to iCalendar +* Other built-in back-ends:: Exporting to a man page +* Export in foreign buffers:: Author tables and lists in Org syntax +* Advanced configuration:: Fine-tuning the export output + + +File: org, Node: The Export Dispatcher, Next: Export back-ends, Prev: Exporting, Up: Exporting + +12.1 The Export Dispatcher +========================== + +The main entry point for export related tasks is the dispatcher, a +hierarchical menu from which it is possible to select an export format +and toggle export options(1) from which it is possible to select an +export format and to toggle export options. + +`C-c C-e' (`org-export-dispatch') + Dispatch for export and publishing commands. When called with a + `C-u' prefix argument, repeat the last export command on the + current buffer while preserving toggled options. If the current + buffer hasn't changed and subtree export was activated, the + command will affect that same subtree. + + Normally the entire buffer is exported, but if there is an active +region only that part of the buffer will be exported. + + Several export options (*note Export settings::) can be toggled from +the export dispatcher with the following key combinations: + +`C-a' + Toggle asynchronous export. Asynchronous export uses an external + Emacs process that is configured with a specified initialization + file. + + While exporting asynchronously, the output is not displayed, but + stored in a place called "the export stack". This stack can be + displayed by calling the dispatcher with a double `C-u' prefix + argument, or with `&' key from the dispatcher menu. + + To make this behavior the default, customize the variable + `org-export-in-background'. + +`C-b' + Toggle body-only export. Its effect depends on the back-end used. + Typically, if the back-end has a header section (like + `...' in the HTML back-end), a body-only export will + not include this header. + +`C-s' + Toggle subtree export. The top heading becomes the document title. + + You can change the default state of this option by setting + `org-export-initial-scope'. + +`C-v' + Toggle visible-only export. Only export the text that is currently + visible, i.e. not hidden by outline visibility in the buffer. + + + With the exception of asynchronous export, a successful export +process writes its output to the kill-ring. You can configure this +behavior by altering the option `org-export-copy-to-kill-ring'. + + ---------- Footnotes ---------- + + (1) It is also possible to use a less intrusive interface by setting +`org-export-dispatch-use-expert-ui' to a non-`nil' value. In that +case, only a prompt is visible from the minibuffer. From there one can +still switch back to regular menu by pressing . + + +File: org, Node: Export back-ends, Next: Export settings, Prev: The Export Dispatcher, Up: Exporting + +12.2 Export back-ends +===================== + +An export back-end is a library that translates Org syntax into a +foreign format. An export format is not available until the proper +back-end has been loaded. + + By default, the following four back-ends are loaded: `ascii', +`html', `icalendar' and `latex'. It is possible to add more (or remove +some) by customizing `org-export-backends'. + + Built-in back-ends include: + + * ascii (ASCII format) + + * beamer (LaTeX Beamer format) + + * html (HTML format) + + * icalendar (iCalendar format) + + * latex (LaTeX format) + + * man (Man page format) + + * md (Markdown format) + + * odt (OpenDocument Text format) + + * org (Org format) + + * texinfo (Texinfo format) + + Other back-ends might be found in the `contrib/' directory (*note +Installation::). + + +File: org, Node: Export settings, Next: ASCII/Latin-1/UTF-8 export, Prev: Export back-ends, Up: Exporting + +12.3 Export settings +==================== + +Export options can be set: globally with variables; for an individual +file by making variables buffer-local with in-buffer settings (*note +In-buffer settings::), by setting individual keywords, or by specifying +them in a compact form with the `#+OPTIONS' keyword; or for a tree by +setting properties (*note Properties and Columns::). Options set at a +specific level override options set at a more general level. + + In-buffer settings may appear anywhere in the file, either directly +or indirectly through a file included using `#+SETUPFILE: filename' +syntax. Option keyword sets tailored to a particular back-end can be +inserted from the export dispatcher (*note The Export Dispatcher::) +using the `Insert template' command by pressing <#>. To insert +keywords individually, a good way to make sure the keyword is correct +is to type `#+' and then to use `M-' for completion. + + The export keywords available for every back-end, and their +equivalent global variables, include: + +`AUTHOR' + The document author (`user-full-name'). + +`CREATOR' + Entity responsible for output generation + (`org-export-creator-string'). + +`DATE' + A date or a time-stamp(1). + +`DESCRIPTION' + The document description. Back-ends handle it as they see fit + (e.g., for the XHTML meta tag), if at all. You can use several + such keywords for long descriptions. + +`EMAIL' + The email address (`user-mail-address'). + +`KEYWORDS' + The keywords defining the contents of the document. Back-ends + handle it as they see fit (e.g., for the XHTML meta tag), if at + all. You can use several such keywords if the list is long. + +`LANGUAGE' + The language used for translating some strings + (`org-export-default-language'). E.g., `#+LANGUAGE: fr' will tell + Org to translate _File_ (english) into _Fichier_ (french) in the + clocktable. + +`SELECT_TAGS' + The tags that select a tree for export (`org-export-select-tags'). + The default value is `:export:'. Within a subtree tagged with + `:export:', you can still exclude entries with `:noexport:' (see + below). When headlines are selectively exported with `:export:' + anywhere in a file, text before the first headline is ignored. + +`EXCLUDE_TAGS' + The tags that exclude a tree from export + (`org-export-exclude-tags'). The default value is `:noexport:'. + Entries with the `:noexport:' tag will be unconditionally excluded + from the export, even if they have an `:export:' tag. + +`TITLE' + The title to be shown (otherwise derived from buffer's name). You + can use several such keywords for long titles. + + The `#+OPTIONS' keyword is a compact(2) form that recognizes the +following arguments: + +`':' + Toggle smart quotes (`org-export-with-smart-quotes'). + +`*:' + Toggle emphasized text (`org-export-with-emphasize'). + +`-:' + Toggle conversion of special strings + (`org-export-with-special-strings'). + +`::' + Toggle fixed-width sections (`org-export-with-fixed-width'). + +`<:' + Toggle inclusion of any time/date active/inactive stamps + (`org-export-with-timestamps'). + +`\n:' + Toggle line-break-preservation (`org-export-preserve-breaks'). + +`^:' + Toggle TeX-like syntax for sub- and superscripts. If you write + "^:{}", `a_{b}' will be interpreted, but the simple `a_b' will be + left as it is (`org-export-with-sub-superscripts'). + +`arch:' + Configure export of archived trees. Can be set to `headline' to + only process the headline, skipping its contents + (`org-export-with-archived-trees'). + +`author:' + Toggle inclusion of author name into exported file + (`org-export-with-author'). + +`c:' + Toggle inclusion of CLOCK keywords (`org-export-with-clocks'). + +`creator:' + Configure inclusion of creator info into exported file. It may be + set to `comment' (`org-export-with-creator'). + +`d:' + Toggle inclusion of drawers, or list drawers to include + (`org-export-with-drawers'). + +`e:' + Toggle inclusion of entities (`org-export-with-entities'). + +`email:' + Toggle inclusion of the author's e-mail into exported file + (`org-export-with-email'). + +`f:' + Toggle the inclusion of footnotes (`org-export-with-footnotes'). + +`H:' + Set the number of headline levels for export + (`org-export-headline-levels'). Below that level, headlines are + treated differently. In most back-ends, they become list items. + +`inline:' + Toggle inclusion of inlinetasks (`org-export-with-inlinetasks'). + +`num:' + Toggle section-numbers (`org-export-with-section-numbers'). It + can also be set to a number `n', so only headlines at that level + or above will be numbered. + +`p:' + Toggle export of planning information (`org-export-with-planning'). + "Planning information" is the line containing the `SCHEDULED:', the + `DEADLINE:' or the `CLOSED:' cookies or a combination of them. + +`pri:' + Toggle inclusion of priority cookies (`org-export-with-priority'). + +`stat:' + Toggle inclusion of statistics cookies + (`org-export-with-statistics-cookies'). + +`tags:' + Toggle inclusion of tags, may also be `not-in-toc' + (`org-export-with-tags'). + +`tasks:' + Toggle inclusion of tasks (TODO items), can be `nil' to remove all + tasks, `todo' to remove DONE tasks, or a list of keywords to keep + (`org-export-with-tasks'). + +`tex:' + Configure export of LaTeX fragments and environments. It may be + set to `verbatim' (`org-export-with-latex'). + +`timestamp:' + Toggle inclusion of the creation time into exported file + (`org-export-time-stamp-file'). + +`toc:' + Toggle inclusion of the table of contents, or set the level limit + (`org-export-with-toc'). + +`todo:' + Toggle inclusion of TODO keywords into exported text + (`org-export-with-todo-keywords'). + +`|:' + Toggle inclusion of tables (`org-export-with-tables'). + + When exporting only a subtree, each of the previous keywords(3) can +be overridden locally by special node properties. These begin with +`EXPORT_', followed by the name of the keyword they supplant. For +example, `DATE' and `OPTIONS' keywords become, respectively, +`EXPORT_DATE' and `EXPORT_OPTIONS' properties. + + If `org-export-allow-bind-keywords' is non-`nil', Emacs variables +can become buffer-local during export by using the BIND keyword. Its +syntax is `#+BIND: variable value'. This is particularly useful for +in-buffer settings that cannot be changed using specific keywords. + + The name of the output file to be generated is taken from the file +associated to the buffer, when possible, or asked to you otherwise. +For subtree export, you can also set `EXPORT_FILE_NAME' property. In +all cases, only the base name of the file is retained, and a back-end +specific extension is added. + + ---------- Footnotes ---------- + + (1) The variable `org-export-date-timestamp-format' defines how this +time-stamp will be exported. + + (2) If you want to configure many options this way, you can use +several `#+OPTIONS' lines. + + (3) With the exception of `SETUPFILE'. + + +File: org, Node: ASCII/Latin-1/UTF-8 export, Next: Beamer export, Prev: Export settings, Up: Exporting + +12.4 ASCII/Latin-1/UTF-8 export +=============================== + +ASCII export produces a simple and very readable version of an Org mode +file, containing only plain ASCII. Latin-1 and UTF-8 export augment +the file with special characters and symbols available in these +encodings. + + Links are exported in a footnote-like style, with the descriptive +part in the text and the link in a note before the next heading. See +the variable `org-ascii-links-to-notes' for details and other options. + +ASCII export commands +--------------------- + +`C-c C-e t a/l/u (`org-ascii-export-to-ascii')' + Export as an ASCII file. For an Org file, `myfile.org', the ASCII + file will be `myfile.txt'. The file will be overwritten without + warning. When the original file is `myfile.txt', the resulting + file becomes `myfile.txt.txt' in order to prevent data loss. + +`C-c C-e t A/L/U (`org-ascii-export-as-ascii')' + Export to a temporary buffer. Do not create a file. + +Header and sectioning structure +------------------------------- + +In the exported version, the first three outline levels become +headlines, defining a general document structure. Additional levels +are exported as lists. The transition can also occur at a different +level (*note Export settings::). + +Quoting ASCII text +------------------ + +You can insert text that will only appear when using `ASCII' back-end +with the following constructs: + + Text @@ascii:and additional text@@ within a paragraph. + + #+ASCII: Some text + + #+BEGIN_ASCII + All lines in this block will appear only when using this back-end. + #+END_ASCII + +ASCII specific attributes +------------------------- + +`ASCII' back-end only understands one attribute, `:width', which +specifies the length, in characters, of a given horizontal rule. It +must be specified using an `ATTR_ASCII' line, directly preceding the +rule. + + #+ATTR_ASCII: :width 10 + ----- + + +File: org, Node: Beamer export, Next: HTML export, Prev: ASCII/Latin-1/UTF-8 export, Up: Exporting + +12.5 Beamer export +================== + +The LaTeX class _Beamer_ allows production of high quality +presentations using LaTeX and pdf processing. Org mode has special +support for turning an Org mode file or tree into a Beamer presentation. + +Beamer export commands +---------------------- + +`C-c C-e l b (`org-beamer-export-to-latex')' + Export as a LaTeX file. For an Org file `myfile.org', the LaTeX + file will be `myfile.tex'. The file will be overwritten without + warning. + +`C-c C-e l B (`org-beamer-export-as-latex')' + Export to a temporary buffer. Do not create a file. + +`C-c C-e l P (`org-beamer-export-to-pdf')' + Export as LaTeX and then process to PDF. + +`C-c C-e l O' + Export as LaTeX and then process to PDF, then open the resulting + PDF file. + +Sectioning, Frames and Blocks +----------------------------- + +Any tree with not-too-deep level nesting should in principle be +exportable as a Beamer presentation. Headlines fall into three +categories: sectioning elements, frames and blocks. + + - Headlines become frames when their level is equal to + `org-beamer-frame-level' or `H' value in an `OPTIONS' line (*note + Export settings::). + + Though, if a headline in the current tree has a `BEAMER_ENV' + property set to either to `frame' or `fullframe', its level + overrides the variable. A `fullframe' is a frame with an empty + (ignored) title. + + - All frame's children become `block' environments. Special block + types can be enforced by setting headline's `BEAMER_ENV' + property(1) to an appropriate value (see + `org-beamer-environments-default' for supported values and + `org-beamer-environments-extra' for adding more). + + - As a special case, if the `BEAMER_ENV' property is set to either + `appendix', `note', `noteNH' or `againframe', the headline will + become, respectively, an appendix, a note (within frame or between + frame, depending on its level), a note with its title ignored or an + `\againframe' command. In the latter case, a `BEAMER_REF' property + is mandatory in order to refer to the frame being resumed, and + contents are ignored. + + Also, a headline with an `ignoreheading' environment will have its + contents only inserted in the output. This special value is + useful to have data between frames, or to properly close a + `column' environment. + + Headlines also support `BEAMER_ACT' and `BEAMER_OPT' properties. +The former is translated as an overlay/action specification, or a +default overlay specification when enclosed within square brackets. +The latter specifies options(2) for the current frame or block. The +export back-end will automatically wrap properties within angular or +square brackets when appropriate. + + Moreover, headlines handle the `BEAMER_COL' property. Its value +should be a decimal number representing the width of the column as a +fraction of the total text width. If the headline has no specific +environment, its title will be ignored and its contents will fill the +column created. Otherwise, the block will fill the whole column and +the title will be preserved. Two contiguous headlines with a non-`nil' +`BEAMER_COL' value share the same `columns' LaTeX environment. It will +end before the next headline without such a property. This environment +is generated automatically. Although, it can also be explicitly +created, with a special `columns' value for `BEAMER_ENV' property (if +it needs to be set up with some specific options, for example). + +Beamer specific syntax +---------------------- + +Beamer back-end is an extension of LaTeX back-end. As such, all LaTeX +specific syntax (e.g., `#+LATEX:' or `#+ATTR_LATEX:') is recognized. +See *note LaTeX and PDF export:: for more information. + + Beamer export introduces a number of keywords to insert code in the +document's header. Four control appearance of the presentation: +`#+BEAMER_THEME', `#+BEAMER_COLOR_THEME', `#+BEAMER_FONT_THEME', +`#+BEAMER_INNER_THEME' and `#+BEAMER_OUTER_THEME'. All of them accept +optional arguments within square brackets. The last one, +`#+BEAMER_HEADER', is more generic and allows you to append any line of +code in the header. + + #+BEAMER_THEME: Rochester [height=20pt] + #+BEAMER_COLOR_THEME: spruce + + Table of contents generated from `toc:t' `OPTION' keyword are +wrapped within a `frame' environment. Those generated from a `TOC' +keyword (*note Table of contents::) are not. In that case, it is also +possible to specify options, enclosed within square brackets. + + #+TOC: headlines [currentsection] + + Beamer specific code can be inserted with the following constructs: + + #+BEAMER: \pause + + #+BEGIN_BEAMER + All lines in this block will appear only when using this back-end. + #+END_BEAMER + + Text @@beamer:some code@@ within a paragraph. + + In particular, this last example can be used to add overlay +specifications to objects whose type is among `bold', `item', `link', +`radio-target' and `target', when the value is enclosed within angular +brackets and put at the beginning the object. + + A *@@beamer:<2->@@useful* feature + + Eventually, every plain list has support for `:environment', +`:overlay' and `:options' attributes through `ATTR_BEAMER' affiliated +keyword. The first one allows the use of a different environment, the +second sets overlay specifications and the last one inserts optional +arguments in current list environment. + + #+ATTR_BEAMER: :overlay +- + - item 1 + - item 2 + +Editing support +--------------- + +You can turn on a special minor mode `org-beamer-mode' for faster +editing with: + + #+STARTUP: beamer + +`C-c C-b (`org-beamer-select-environment')' + In `org-beamer-mode', this key offers fast selection of a Beamer + environment or the `BEAMER_COL' property. + + Also, a template for useful in-buffer settings or properties can be +inserted into the buffer with `M-x org-beamer-insert-options-template'. +Among other things, this will install a column view format which is +very handy for editing special properties used by Beamer. + +An example +---------- + +Here is a simple example Org document that is intended for Beamer +export. + + #+TITLE: Example Presentation + #+AUTHOR: Carsten Dominik + #+OPTIONS: H:2 + #+LATEX_CLASS: beamer + #+LATEX_CLASS_OPTIONS: [presentation] + #+BEAMER_THEME: Madrid + #+COLUMNS: %45ITEM %10BEAMER_ENV(Env) %10BEAMER_ACT(Act) %4BEAMER_COL(Col) %8BEAMER_OPT(Opt) + + * This is the first structural section + + ** Frame 1 + *** Thanks to Eric Fraga :B_block:BMCOL: + :PROPERTIES: + :BEAMER_COL: 0.48 + :BEAMER_ENV: block + :END: + for the first viable Beamer setup in Org + *** Thanks to everyone else :B_block:BMCOL: + :PROPERTIES: + :BEAMER_COL: 0.48 + :BEAMER_ACT: <2-> + :BEAMER_ENV: block + :END: + for contributing to the discussion + **** This will be formatted as a beamer note :B_note: + :PROPERTIES: + :BEAMER_env: note + :END: + ** Frame 2 (where we will not use columns) + *** Request + Please test this stuff! + + ---------- Footnotes ---------- + + (1) If this property is set, the entry will also get a +`:B_environment:' tag to make this visible. This tag has no semantic +meaning, it is only a visual aid. + + (2) The `fragile' option is added automatically if it contains code +that requires a verbatim environment, though. + + +File: org, Node: HTML export, Next: LaTeX and PDF export, Prev: Beamer export, Up: Exporting + +12.6 HTML export +================ + +Org mode contains an HTML (XHTML 1.0 strict) exporter with extensive +HTML formatting, in ways similar to John Gruber's _markdown_ language, +but with additional support for tables. + +* Menu: + +* HTML Export commands:: How to invoke HTML export +* HTML doctypes:: Org can export to various (X)HTML flavors +* HTML preamble and postamble:: How to insert a preamble and a postamble +* Quoting HTML tags:: Using direct HTML in Org mode +* Links in HTML export:: How links will be interpreted and formatted +* Tables in HTML export:: How to modify the formatting of tables +* Images in HTML export:: How to insert figures into HTML output +* Math formatting in HTML export:: Beautiful math also on the web +* Text areas in HTML export:: An alternative way to show an example +* CSS support:: Changing the appearance of the output +* JavaScript support:: Info and Folding in a web browser + + +File: org, Node: HTML Export commands, Next: HTML doctypes, Prev: HTML export, Up: HTML export + +12.6.1 HTML export commands +--------------------------- + +`C-c C-e h h (`org-html-export-to-html')' + Export as an HTML file. For an Org file `myfile.org', the HTML + file will be `myfile.html'. The file will be overwritten without + warning. `C-c C-e h o' Export as an HTML file and immediately + open it with a browser. + +`C-c C-e h H (`org-html-export-as-html')' + Export to a temporary buffer. Do not create a file. + + +File: org, Node: HTML doctypes, Next: HTML preamble and postamble, Prev: HTML Export commands, Up: HTML export + +12.6.2 HTML doctypes +-------------------- + +Org can export to various (X)HTML flavors. + + Setting the variable `org-html-doctype' allows you to export to +different (X)HTML variants. The exported HTML will be adjusted +according to the syntax requirements of that variant. You can either +set this variable to a doctype string directly, in which case the +exporter will try to adjust the syntax automatically, or you can use a +ready-made doctype. The ready-made options are: + + * "html4-strict" + + * "html4-transitional" + + * "html4-frameset" + + * "xhtml-strict" + + * "xhtml-transitional" + + * "xhtml-frameset" + + * "xhtml-11" + + * "html5" + + * "xhtml5" + + See the variable `org-html-doctype-alist' for details. The default +is "xhtml-strict". + +Fancy HTML5 export +.................. + +HTML5 introduces several new element types. By default, Org will not +make use of these element types, but you can set `org-html-html5-fancy' +to `t' (or set `html5-fancy' item in an `OPTIONS' line), to enable a +few new block-level elements. These are created using arbitrary +#+BEGIN and #+END blocks. For instance: + + #+BEGIN_ASIDE + Lorem ipsum + #+END_ASIDE + + Will export to: + + + + While this: + + #+ATTR_HTML: :controls controls :width 350 + #+BEGIN_VIDEO + #+HTML: + #+HTML: + Your browser does not support the video tag. + #+END_VIDEO + + Becomes: + + + + Special blocks that do not correspond to HTML5 elements (see +`org-html-html5-elements') will revert to the usual behavior, i.e., +`#+BEGIN_LEDERHOSEN' will still export to `
'. + + Headlines cannot appear within special blocks. To wrap a headline +and its contents in e.g., `
' or `
' tags, set the +`HTML_CONTAINER' property on the headline itself. + + +File: org, Node: HTML preamble and postamble, Next: Quoting HTML tags, Prev: HTML doctypes, Up: HTML export + +12.6.3 HTML preamble and postamble +---------------------------------- + +The HTML exporter lets you define a preamble and a postamble. + + The default value for `org-html-preamble' is `t', which means that +the preamble is inserted depending on the relevant format string in +`org-html-preamble-format'. + + Setting `org-html-preamble' to a string will override the default +format string. If you set it to a function, it will insert the output +of the function, which must be a string. Setting to `nil' will not +insert any preamble. + + The default value for `org-html-postamble' is `'auto', which means +that the HTML exporter will look for information about the author, the +email, the creator and the date, and build the postamble from these +values. Setting `org-html-postamble' to `t' will insert the postamble +from the relevant format string found in `org-html-postamble-format'. +Setting it to `nil' will not insert any postamble. + + +File: org, Node: Quoting HTML tags, Next: Links in HTML export, Prev: HTML preamble and postamble, Up: HTML export + +12.6.4 Quoting HTML tags +------------------------ + +Plain `<' and `>' are always transformed to `<' and `>' in HTML +export. If you want to include raw HTML code, which should only appear +in HTML export, mark it with `@@html:' as in `@@html:@@bold +text@@html:@@'. For more extensive HTML that should be copied +verbatim to the exported file use either + + #+HTML: Literal HTML code for export + +or + + #+BEGIN_HTML + All lines between these markers are exported literally + #+END_HTML + + +File: org, Node: Links in HTML export, Next: Tables in HTML export, Prev: Quoting HTML tags, Up: HTML export + +12.6.5 Links in HTML export +--------------------------- + +Internal links (*note Internal links::) will continue to work in HTML. +This includes automatic links created by radio targets (*note Radio +targets::). Links to external files will still work if the target file +is on the same relative path as the published Org file. Links to other +`.org' files will be translated into HTML links under the assumption +that an HTML version also exists of the linked file, at the same +relative path. `id:' links can then be used to jump to specific +entries across files. For information related to linking files while +publishing them to a publishing directory see *note Publishing links::. + + If you want to specify attributes for links, you can do so using a +special `#+ATTR_HTML' line to define attributes that will be added to +the `' or `' tags. Here is an example that sets `title' and +`style' attributes for a link: + + #+ATTR_HTML: :title The Org mode homepage :style color:red; + [[http://orgmode.org]] + + +File: org, Node: Tables in HTML export, Next: Images in HTML export, Prev: Links in HTML export, Up: HTML export + +12.6.6 Tables +------------- + +Org mode tables are exported to HTML using the table attributes defined +in `org-html-table-default-attributes'. The default setting makes +tables without cell borders and frame. If you would like to change +this for individual tables, place something like the following before +the table: + + #+CAPTION: This is a table with lines around and between cells + #+ATTR_HTML: :border 2 :rules all :frame border + + You can also modify the default tags used for each row by setting +`org-html-table-row-tags'. See the docstring for an example on how to +use this option. + + +File: org, Node: Images in HTML export, Next: Math formatting in HTML export, Prev: Tables in HTML export, Up: HTML export + +12.6.7 Images in HTML export +---------------------------- + +HTML export can inline images given as links in the Org file, and it +can make an image the clickable part of a link. By default(1), images +are inlined if a link does not have a description. So +`[[file:myimg.jpg]]' will be inlined, while `[[file:myimg.jpg][the +image]]' will just produce a link `the image' that points to the image. +If the description part itself is a `file:' link or a `http:' URL +pointing to an image, this image will be inlined and activated so that +clicking on the image will activate the link. For example, to include +a thumbnail that will link to a high resolution version of the image, +you could use: + + [[file:highres.jpg][file:thumb.jpg]] + + If you need to add attributes to an inlined image, use a +`#+ATTR_HTML'. In the example below we specify the `alt' and `title' +attributes to support text viewers and accessibility, and align it to +the right. + + #+CAPTION: A black cat stalking a spider + #+ATTR_HTML: :alt cat/spider image :title Action! :align right + [[./img/a.jpg]] + +You could use `http' addresses just as well. + + ---------- Footnotes ---------- + + (1) But see the variable `org-html-inline-images'. + + +File: org, Node: Math formatting in HTML export, Next: Text areas in HTML export, Prev: Images in HTML export, Up: HTML export + +12.6.8 Math formatting in HTML export +------------------------------------- + +LaTeX math snippets (*note LaTeX fragments::) can be displayed in two +different ways on HTML pages. The default is to use the MathJax system +(http://www.mathjax.org) which should work out of the box with Org mode +installation because `http://orgmode.org' serves `MathJax' for Org mode +users for small applications and for testing purposes. If you plan to +use this regularly or on pages with significant page views, you should +install(1) MathJax on your own server in order to limit the load of our +server. To configure `MathJax', use the variable +`org-html-mathjax-options' or insert something like the following into +the buffer: + + #+HTML_MATHJAX: align:"left" mathml:t path:"/MathJax/MathJax.js" + +See the docstring of the variable `org-html-mathjax-options' for the +meaning of the parameters in this line. + + If you prefer, you can also request that LaTeX fragments are +processed into small images that will be inserted into the browser +page. Before the availability of MathJax, this was the default method +for Org files. This method requires that the `dvipng' program or +`imagemagick' suite is available on your system. You can still get +this processing with + + #+OPTIONS: tex:dvipng + + or: + + #+OPTIONS: tex:imagemagick + + ---------- Footnotes ---------- + + (1) Installation instructions can be found on the MathJax website, +see `http://www.mathjax.org/resources/docs/?installation.html'. + + +File: org, Node: Text areas in HTML export, Next: CSS support, Prev: Math formatting in HTML export, Up: HTML export + +12.6.9 Text areas in HTML export +-------------------------------- + +An alternative way to publish literal code examples in HTML is to use +text areas, where the example can even be edited before pasting it into +an application. It is triggered by `:textarea' attribute at an +`example' or `src' block. + + You may also use `:height' and `:width' attributes to specify the +height and width of the text area, which default to the number of lines +in the example, and 80, respectively. For example + + #+ATTR_HTML: :textarea t :width 40 + #+BEGIN_EXAMPLE + (defun org-xor (a b) + "Exclusive or." + (if a (not b) b)) + #+END_EXAMPLE + + +File: org, Node: CSS support, Next: JavaScript support, Prev: Text areas in HTML export, Up: HTML export + +12.6.10 CSS support +------------------- + +You can modify the CSS style definitions for the exported file. The +HTML exporter assigns the following special CSS classes(1) to +appropriate parts of the document--your style specifications may change +these, in addition to any of the standard classes like for headlines, +tables, etc. + p.author author information, including email + p.date publishing date + p.creator creator info, about org mode version + .title document title + .todo TODO keywords, all not-done states + .done the DONE keywords, all states that count as done + .WAITING each TODO keyword also uses a class named after itself + .timestamp timestamp + .timestamp-kwd keyword associated with a timestamp, like SCHEDULED + .timestamp-wrapper span around keyword plus timestamp + .tag tag in a headline + ._HOME each tag uses itself as a class, "@" replaced by "_" + .target target for links + .linenr the line number in a code example + .code-highlighted for highlighting referenced code lines + div.outline-N div for outline level N (headline plus text)) + div.outline-text-N extra div for text at outline level N + .section-number-N section number in headlines, different for each level + .figure-number label like "Figure 1:" + .table-number label like "Table 1:" + .listing-number label like "Listing 1:" + div.figure how to format an inlined image + pre.src formatted source code + pre.example normal example + p.verse verse paragraph + div.footnotes footnote section headline + p.footnote footnote definition paragraph, containing a footnote + .footref a footnote reference number (always a ) + .footnum footnote number in footnote definition (always ) + + Each exported file contains a compact default style that defines +these classes in a basic way(2). You may overwrite these settings, or +add to them by using the variables `org-html-head' and +`org-html-head-extra'. You can override the global values of these +variables for each file by using these keywords: + + #+HTML_HEAD: + #+HTML_HEAD_EXTRA: + +For longer style definitions, you can use several such lines. You +could also directly write a `' section in this way, +without referring to an external file. + + In order to add styles to a subtree, use the `:HTML_CONTAINER_CLASS:' +property to assign a class to the tree. In order to specify CSS styles +for a particular headline, you can use the id specified in a +`:CUSTOM_ID:' property. + + ---------- Footnotes ---------- + + (1) If the classes on TODO keywords and tags lead to conflicts, use +the variables `org-html-todo-kwd-class-prefix' and +`org-html-tag-class-prefix' to make them unique. + + (2) This style is defined in the constant `org-html-style-default', +which you should not modify. To turn inclusion of these defaults off, +customize `org-html-head-include-default-style' or set `html-style' to +`nil' in an `OPTIONS' line. + + +File: org, Node: JavaScript support, Prev: CSS support, Up: HTML export + +12.6.11 JavaScript supported display of web pages +------------------------------------------------- + +Sebastian Rose has written a JavaScript program especially designed to +enhance the web viewing experience of HTML files created with Org. This +program allows you to view large files in two different ways. The +first one is an _Info_-like mode where each section is displayed +separately and navigation can be done with the `n' and `p' keys (and +some other keys as well, press `?' for an overview of the available +keys). The second view type is a _folding_ view much like Org provides +inside Emacs. The script is available at +`http://orgmode.org/org-info.js' and you can find the documentation for +it at `http://orgmode.org/worg/code/org-info-js/'. We host the script +at our site, but if you use it a lot, you might not want to be +dependent on `http://orgmode.org' and prefer to install a local copy on +your own web server. + + All it then takes to use this program is adding a single line to the +Org file: + + #+INFOJS_OPT: view:info toc:nil + +If this line is found, the HTML header will automatically contain the +code needed to invoke the script. Using the line above, you can set +the following viewing options: + + path: The path to the script. The default is to grab the script from + `http://orgmode.org/org-info.js', but you might want to have + a local copy and use a path like `../scripts/org-info.js'. + view: Initial view when the website is first shown. Possible values are: + info Info-like interface with one section per page. + overview Folding interface, initially showing only top-level. + content Folding interface, starting with all headlines visible. + showall Folding interface, all headlines and text visible. + sdepth: Maximum headline level that will still become an independent + section for info and folding modes. The default is taken from + `org-export-headline-levels' (= the `H' switch in `#+OPTIONS'). + If this is smaller than in `org-export-headline-levels', each + info/folding section can still contain child headlines. + toc: Should the table of contents _initially_ be visible? + Even when `nil', you can always get to the "toc" with `i'. + tdepth: The depth of the table of contents. The defaults are taken from + the variables `org-export-headline-levels' and `org-export-with-toc'. + ftoc: Does the CSS of the page specify a fixed position for the "toc"? + If yes, the toc will never be displayed as a section. + ltoc: Should there be short contents (children) in each section? + Make this `above' if the section should be above initial text. + mouse: Headings are highlighted when the mouse is over them. Should be + `underline' (default) or a background color like `#cccccc'. + buttons: Should view-toggle buttons be everywhere? When `nil' (the + default), only one such button will be present. + You can choose default values for these options by customizing the +variable `org-html-infojs-options'. If you always want to apply the +script to your pages, configure the variable `org-html-use-infojs'. + + +File: org, Node: LaTeX and PDF export, Next: Markdown export, Prev: HTML export, Up: Exporting + +12.7 LaTeX and PDF export +========================= + +LaTeX export can produce an arbitrarily complex LaTeX document of any +standard or custom document class. With further processing(1), which +the LaTeX exporter is able to control, this back-end is able to produce +PDF output. Because the LaTeX exporter can be configured to use the +`hyperref' package, the default setup produces fully-linked PDF output. + + As in LaTeX, blank lines are meaningful for this back-end: a +paragraph will not be started if two contiguous syntactical elements +are not separated by an empty line. + + This back-end also offers enhanced support for footnotes. Thus, it +handles nested footnotes, footnotes in tables and footnotes in a list +item's description. + +* Menu: + +* LaTeX export commands:: How to export to LaTeX and PDF +* Header and sectioning:: Setting up the export file structure +* Quoting LaTeX code:: Incorporating literal LaTeX code +* LaTeX specific attributes:: Controlling LaTeX output + + ---------- Footnotes ---------- + + (1) The default LaTeX output is designed for processing with +`pdftex' or LaTeX. It includes packages that are not compatible with +`xetex' and possibly `luatex'. The LaTeX exporter can be configured to +support alternative TeX engines, see the options +`org-latex-default-packages-alist' and `org-latex-packages-alist'. + + +File: org, Node: LaTeX export commands, Next: Header and sectioning, Prev: LaTeX and PDF export, Up: LaTeX and PDF export + +12.7.1 LaTeX export commands +---------------------------- + +`C-c C-e l l (`org-latex-export-to-latex')' + Export as a LaTeX file. For an Org file `myfile.org', the LaTeX + file will be `myfile.tex'. The file will be overwritten without + warning. + +`C-c C-e l L (`org-latex-export-as-latex')' + Export to a temporary buffer. Do not create a file. + +`C-c C-e l p (`org-latex-export-to-pdf')' + Export as LaTeX and then process to PDF. + +`C-c C-e l o' + Export as LaTeX and then process to PDF, then open the resulting + PDF file. + + +File: org, Node: Header and sectioning, Next: Quoting LaTeX code, Prev: LaTeX export commands, Up: LaTeX and PDF export + +12.7.2 Header and sectioning structure +-------------------------------------- + +By default, the first three outline levels become headlines, defining a +general document structure. Additional levels are exported as `itemize' +or `enumerate' lists. The transition can also occur at a different +level (*note Export settings::). + + By default, the LaTeX output uses the class `article'. + + You can change this globally by setting a different value for +`org-latex-default-class' or locally by adding an option like +`#+LATEX_CLASS: myclass' in your file, or with a `EXPORT_LATEX_CLASS' +property that applies when exporting a region containing only this +(sub)tree. The class must be listed in `org-latex-classes'. This +variable defines a header template for each class(1), and allows you to +define the sectioning structure for each class. You can also define +your own classes there. + + The `LATEX_CLASS_OPTIONS' keyword or `EXPORT_LATEX_CLASS_OPTIONS' +property can specify the options for the `\documentclass' macro. These +options have to be provided, as expected by LaTeX, within square +brackets. + + You can also use the `LATEX_HEADER' and `LATEX_HEADER_EXTRA'(2) +keywords in order to add lines to the header. See the docstring of +`org-latex-classes' for more information. + + An example is shown below. + + #+LATEX_CLASS: article + #+LATEX_CLASS_OPTIONS: [a4paper] + #+LATEX_HEADER: \usepackage{xyz} + + * Headline 1 + some text + + ---------- Footnotes ---------- + + (1) Into which the values of `org-latex-default-packages-alist' and +`org-latex-packages-alist' are spliced. + + (2) Unlike `LATEX_HEADER', contents from `LATEX_HEADER_EXTRA' +keywords will not be loaded when previewing LaTeX snippets (*note +Previewing LaTeX fragments::). + + +File: org, Node: Quoting LaTeX code, Next: LaTeX specific attributes, Prev: Header and sectioning, Up: LaTeX and PDF export + +12.7.3 Quoting LaTeX code +------------------------- + +Embedded LaTeX as described in *note Embedded LaTeX::, will be correctly +inserted into the LaTeX file. Furthermore, you can add special code +that should only be present in LaTeX export with the following +constructs: + + Code within @@latex:some code@@ a paragraph. + + #+LATEX: Literal LaTeX code for export + + #+BEGIN_LATEX + All lines between these markers are exported literally + #+END_LATEX + + +File: org, Node: LaTeX specific attributes, Prev: Quoting LaTeX code, Up: LaTeX and PDF export + +12.7.4 LaTeX specific attributes +-------------------------------- + +LaTeX understands attributes specified in an `ATTR_LATEX' line. They +affect tables, images, plain lists, special blocks and source blocks. + +Tables in LaTeX export +...................... + +For LaTeX export of a table, you can specify a label and a caption +(*note Images and tables::). You can also use attributes to control +table layout and contents. Valid LaTeX attributes include: + +`:mode' + Nature of table's contents. It can be set to `table', `math', + `inline-math' or `verbatim'. In particular, when in `math' or + `inline-math' mode, every cell is exported as-is, horizontal rules + are ignored and the table will be wrapped in a math environment. + Also, contiguous tables sharing the same math mode will be wrapped + within the same environment. Default mode is determined in + `org-latex-default-table-mode'. + +`:environment' + Environment used for the table. It can be set to any LaTeX table + environment, like `tabularx'(1), `longtable', `array', `tabu'(2), + `bmatrix'... It defaults to `org-latex-default-table-environment' + value. + +`:caption' + `#+CAPTION' keyword is the simplest way to set a caption for a + table (*note Images and tables::). If you need more advanced + commands for that task, you can use `:caption' attribute instead. + Its value should be raw LaTeX code. It has precedence over + `#+CAPTION'. + +`:float' +`:placement' + Float environment for the table. Possible values are + `sidewaystable', `multicolumn', `t' and `nil'. When unspecified, + a table with a caption will have a `table' environment. Moreover, + `:placement' attribute can specify the positioning of the float. + +`:align' +`:font' +`:width' + Set, respectively, the alignment string of the table, its font + size and its width. They only apply on regular tables. + +`:spread' + Boolean specific to the `tabu' and `longtabu' environments, and + only takes effect when used in conjunction with the `:width' + attribute. When `:spread' is non-`nil', the table will be spread + or shrunk by the value of `:width'. + +`:booktabs' +`:center' +`:rmlines' + They toggle, respectively, `booktabs' usage (assuming the package + is properly loaded), table centering and removal of every + horizontal rule but the first one (in a "table.el" table only). + In particular, `org-latex-tables-booktabs' (respectively + `org-latex-tables-centered') activates the first (respectively + second) attribute globally. + +`:math-prefix' +`:math-suffix' +`:math-arguments' + A string that will be inserted, respectively, before the table + within the math environment, after the table within the math + environment, and between the macro name and the contents of the + table. The `:math-arguments' attribute is used for matrix macros + that require more than one argument (e.g., `qbordermatrix'). + + Thus, attributes can be used in a wide array of situations, like +writing a table that will span over multiple pages, or a matrix product: + + #+ATTR_LATEX: :environment longtable :align l|lp{3cm}r|l + | ..... | ..... | + | ..... | ..... | + + #+ATTR_LATEX: :mode math :environment bmatrix :math-suffix \times + | a | b | + | c | d | + #+ATTR_LATEX: :mode math :environment bmatrix + | 1 | 2 | + | 3 | 4 | + + In the example below, LaTeX command `\bicaption{HeadingA}{HeadingB}' +will set the caption. + + #+ATTR_LATEX: :caption \bicaption{HeadingA}{HeadingB} + | ..... | ..... | + | ..... | ..... | + +Images in LaTeX export +...................... + +Images that are linked to without a description part in the link, like +`[[file:img.jpg]]' or `[[./img.jpg]]' will be inserted into the PDF +output file resulting from LaTeX processing. Org will use an +`\includegraphics' macro to insert the image(3). + + You can specify specify image width or height with, respectively, +`:width' and `:height' attributes. It is also possible to add any +other option with the `:options' attribute, as shown in the following +example: + + #+ATTR_LATEX: :width 5cm :options angle=90 + [[./img/sed-hr4049.pdf]] + + If you need a specific command for the caption, use `:caption' +attribute. It will override standard `#+CAPTION' value, if any. + + #+ATTR_LATEX: :caption \bicaption{HeadingA}{HeadingB} + [[./img/sed-hr4049.pdf]] + + If you have specified a caption as described in *note Images and +tables::, the picture will be wrapped into a `figure' environment and +thus become a floating element. You can also ask Org to export an +image as a float without specifying caption by setting the `:float' +attribute. You may also set it to: + - `t': if you want to use the standard `figure' environment. It is + used by default if you provide a caption to the image. + + - `multicolumn': if you wish to include an image which spans multiple + columns in a page. This will export the image wrapped in a + `figure*' environment. + + - `wrap': if you would like to let text flow around the image. It + will make the figure occupy the left half of the page. + + - `nil': if you need to avoid any floating environment, even when a + caption is provided. + To modify the placement option of any floating environment, set the +`placement' attribute. + + #+ATTR_LATEX: :float wrap :width 0.38\textwidth :placement {r}{0.4\textwidth} + [[./img/hst.png]] + + If the `:comment-include' attribute is set to a non-`nil' value, the +LaTeX `\includegraphics' macro will be commented out. + +Plain lists in LaTeX export +........................... + +Plain lists accept two optional attributes: `:environment' and +`:options'. The first one allows the use of a non-standard environment +(e.g., `inparaenum'). The second one specifies additional arguments for +that environment. + + #+ATTR_LATEX: :environment compactitem :options [$\circ$] + - you need ``paralist'' package to reproduce this example. + +Source blocks in LaTeX export +............................. + +In addition to syntax defined in *note Literal examples::, names and +captions (*note Images and tables::), source blocks also accept a +`:float' attribute. You may set it to: + - `t': if you want to make the source block a float. It is the + default value when a caption is provided. + + - `multicolumn': if you wish to include a source block which spans + multiple columns in a page. + + - `nil': if you need to avoid any floating environment, even when a + caption is provided. It is useful for source code that may not + fit in a single page. + + #+ATTR_LATEX: :float nil + #+BEGIN_SRC emacs-lisp + Code that may not fit in a single page. + #+END_SRC + +Special blocks in LaTeX export +.............................. + +In LaTeX back-end, special blocks become environments of the same name. +Value of `:options' attribute will be appended as-is to that +environment's opening string. For example: + + #+BEGIN_ABSTRACT + We demonstrate how to solve the Syracuse problem. + #+END_ABSTRACT + + #+ATTR_LATEX: :options [Proof of important theorem] + #+BEGIN_PROOF + ... + Therefore, any even number greater than 2 is the sum of two primes. + #+END_PROOF + +becomes + + \begin{abstract} + We demonstrate how to solve the Syracuse problem. + \end{abstract} + + \begin{proof}[Proof of important theorem] + ... + Therefore, any even number greater than 2 is the sum of two primes. + \end{proof} + + If you need to insert a specific caption command, use `:caption' +attribute. It will override standard `#+CAPTION' value, if any. For +example: + + #+ATTR_LATEX: :caption \MyCaption{HeadingA} + #+BEGIN_PROOF + ... + #+END_PROOF + +Horizontal rules +................ + +Width and thickness of a given horizontal rule can be controlled with, +respectively, `:width' and `:thickness' attributes: + + #+ATTR_LATEX: :width .6\textwidth :thickness 0.8pt + ----- + + ---------- Footnotes ---------- + + (1) Requires adding the `tabularx' package to +`org-latex-packages-alist'. + + (2) Requires adding the `tabu' package to `org-latex-packages-alist'. + + (3) In the case of TikZ (`http://sourceforge.net/projects/pgf/') +images, it will become an `\input' macro wrapped within a `tikzpicture' +environment. + + +File: org, Node: Markdown export, Next: OpenDocument Text export, Prev: LaTeX and PDF export, Up: Exporting + +12.8 Markdown export +==================== + +`md' export back-end generates Markdown syntax(1) for an Org mode +buffer. + + It is built over HTML back-end: any construct not supported by +Markdown syntax (e.g., tables) will be controlled and translated by +`html' back-end (*note HTML export::). + +Markdown export commands +------------------------ + +`C-c C-e m m (`org-md-export-to-markdown')' + Export as a text file written in Markdown syntax. For an Org file, + `myfile.org', the resulting file will be `myfile.md'. The file + will be overwritten without warning. + +`C-c C-e m M (`org-md-export-as-markdown')' + Export to a temporary buffer. Do not create a file. + +`C-c C-e m o' + Export as a text file with Markdown syntax, then open it. + +Header and sectioning structure +------------------------------- + +Markdown export can generate both `atx' and `setext' types for +headlines, according to `org-md-headline-style'. The former introduces +a hard limit of two levels, whereas the latter pushes it to six. +Headlines below that limit are exported as lists. You can also set a +soft limit before that one (*note Export settings::). + + ---------- Footnotes ---------- + + (1) Vanilla flavor, as defined at +`http://daringfireball.net/projects/markdown/'. + + +File: org, Node: OpenDocument Text export, Next: Org export, Prev: Markdown export, Up: Exporting + +12.9 OpenDocument Text export +============================= + +Org mode(1) supports export to OpenDocument Text (ODT) format. +Documents created by this exporter use the `OpenDocument-v1.2 +specification'(2) and are compatible with LibreOffice 3.4. + +* Menu: + +* Pre-requisites for ODT export:: What packages ODT exporter relies on +* ODT export commands:: How to invoke ODT export +* Extending ODT export:: How to produce `doc', `pdf' files +* Applying custom styles:: How to apply custom styles to the output +* Links in ODT export:: How links will be interpreted and formatted +* Tables in ODT export:: How Tables are exported +* Images in ODT export:: How to insert images +* Math formatting in ODT export:: How LaTeX fragments are formatted +* Labels and captions in ODT export:: How captions are rendered +* Literal examples in ODT export:: How source and example blocks are formatted +* Advanced topics in ODT export:: Read this if you are a power user + + ---------- Footnotes ---------- + + (1) Versions 7.8 or later + + (2) Open Document Format for Office Applications (OpenDocument) +Version 1.2 +(http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html) + + +File: org, Node: Pre-requisites for ODT export, Next: ODT export commands, Prev: OpenDocument Text export, Up: OpenDocument Text export + +12.9.1 Pre-requisites for ODT export +------------------------------------ + +The ODT exporter relies on the `zip' program to create the final +output. Check the availability of this program before proceeding +further. + + +File: org, Node: ODT export commands, Next: Extending ODT export, Prev: Pre-requisites for ODT export, Up: OpenDocument Text export + +12.9.2 ODT export commands +-------------------------- + +Exporting to ODT +................ + +`C-c C-e o o (`org-odt-export-to-odt')' + Export as OpenDocument Text file. + + If `org-odt-preferred-output-format' is specified, automatically + convert the exported file to that format. *Note Automatically + exporting to other formats: x-export-to-other-formats. + + For an Org file `myfile.org', the ODT file will be `myfile.odt'. + The file will be overwritten without warning. If there is an + active region,(1) only the region will be exported. If the + selected region is a single tree,(2) the tree head will become the + document title. If the tree head entry has, or inherits, an + `EXPORT_FILE_NAME' property, that name will be used for the export. + + `C-c C-e o O' Export as an OpenDocument Text file and open the + resulting file. + + If `org-odt-preferred-output-format' is specified, open the + converted file instead. *Note Automatically exporting to other + formats: x-export-to-other-formats. + + ---------- Footnotes ---------- + + (1) This requires `transient-mark-mode' to be turned on + + (2) To select the current subtree, use `C-c @' + + +File: org, Node: Extending ODT export, Next: Applying custom styles, Prev: ODT export commands, Up: OpenDocument Text export + +12.9.3 Extending ODT export +--------------------------- + +The ODT exporter can interface with a variety of document converters +and supports popular converters out of the box. As a result, you can +use it to export to formats like `doc' or convert a document from one +format (say `csv') to another format (say `ods' or `xls'). + + If you have a working installation of LibreOffice, a document +converter is pre-configured for you and you can use it right away. If +you would like to use `unoconv' as your preferred converter, customize +the variable `org-odt-convert-process' to point to `unoconv'. You can +also use your own favorite converter or tweak the default settings of +the `LibreOffice' and `unoconv' converters. *Note Configuring a +document converter::. + +12.9.3.1 Automatically exporting to other formats +................................................. + +Very often, you will find yourself exporting to ODT format, only to +immediately save the exported document to other formats like `doc', +`docx', `rtf', `pdf' etc. In such cases, you can specify your +preferred output format by customizing the variable +`org-odt-preferred-output-format'. This way, the export commands +(*note Exporting to ODT: x-export-to-odt.) can be extended to export to +a format that is of immediate interest to you. + +12.9.3.2 Converting between document formats +............................................ + +There are many document converters in the wild which support conversion +to and from various file formats, including, but not limited to the ODT +format. LibreOffice converter, mentioned above, is one such converter. +Once a converter is configured, you can interact with it using the +following command. + +`M-x org-odt-convert RET' + Convert an existing document from one format to another. With a + prefix argument, also open the newly produced file. + + +File: org, Node: Applying custom styles, Next: Links in ODT export, Prev: Extending ODT export, Up: OpenDocument Text export + +12.9.4 Applying custom styles +----------------------------- + +The ODT exporter ships with a set of OpenDocument styles (*note Working +with OpenDocument style files::) that ensure a well-formatted output. +These factory styles, however, may not cater to your specific tastes. +To customize the output, you can either modify the above styles files +directly, or generate the required styles using an application like +LibreOffice. The latter method is suitable for expert and non-expert +users alike, and is described here. + +12.9.4.1 Applying custom styles: the easy way +............................................. + + 1. Create a sample `example.org' file with the below settings and + export it to ODT format. + + #+OPTIONS: H:10 num:t + + 2. Open the above `example.odt' using LibreOffice. Use the `Stylist' + to locate the target styles--these typically have the `Org' + prefix--and modify those to your taste. Save the modified file + either as an OpenDocument Text (`.odt') or OpenDocument Template + (`.ott') file. + + 3. Customize the variable `org-odt-styles-file' and point it to the + newly created file. For additional configuration options *note + Overriding factory styles: x-overriding-factory-styles. + + If you would like to choose a style on a per-file basis, you can + use the `#+ODT_STYLES_FILE' option. A typical setting will look + like + + #+ODT_STYLES_FILE: "/path/to/example.ott" + + or + + #+ODT_STYLES_FILE: ("/path/to/file.ott" ("styles.xml" "image/hdr.png")) + + +12.9.4.2 Using third-party styles and templates +............................................... + +You can use third-party styles and templates for customizing your +output. This will produce the desired output only if the template +provides all style names that the `ODT' exporter relies on. Unless +this condition is met, the output is going to be less than +satisfactory. So it is highly recommended that you only work with +templates that are directly derived from the factory settings. + + +File: org, Node: Links in ODT export, Next: Tables in ODT export, Prev: Applying custom styles, Up: OpenDocument Text export + +12.9.5 Links in ODT export +-------------------------- + +ODT exporter creates native cross-references for internal links. It +creates Internet-style links for all other links. + + A link with no description and destined to a regular (un-itemized) +outline heading is replaced with a cross-reference and section number +of the heading. + + A `\ref{label}'-style reference to an image, table etc. is replaced +with a cross-reference and sequence number of the labeled entity. +*Note Labels and captions in ODT export::. + + +File: org, Node: Tables in ODT export, Next: Images in ODT export, Prev: Links in ODT export, Up: OpenDocument Text export + +12.9.6 Tables in ODT export +--------------------------- + +Export of native Org mode tables (*note Tables::) and simple `table.el' +tables is supported. However, export of complex `table.el' +tables--tables that have column or row spans--is not supported. Such +tables are stripped from the exported document. + + By default, a table is exported with top and bottom frames and with +rules separating row and column groups (*note Column groups::). +Furthermore, all tables are typeset to occupy the same width. If the +table specifies alignment and relative width for its columns (*note +Column width and alignment::) then these are honored on export.(1) + + You can control the width of the table by specifying `:rel-width' +property using an `#+ATTR_ODT' line. + + For example, consider the following table which makes use of all the +rules mentioned above. + + #+ATTR_ODT: :rel-width 50 + | Area/Month | Jan | Feb | Mar | Sum | + |---------------+-------+-------+-------+-------| + | / | < | | | < | + | | | | | | + | North America | 1 | 21 | 926 | 948 | + | Middle East | 6 | 75 | 844 | 925 | + | Asia Pacific | 9 | 27 | 790 | 826 | + |---------------+-------+-------+-------+-------| + | Sum | 16 | 123 | 2560 | 2699 | + + On export, the table will occupy 50% of text area. The columns will +be sized (roughly) in the ratio of 13:5:5:5:6. The first column will +be left-aligned and rest of the columns will be right-aligned. There +will be vertical rules after separating the header and last columns +from other columns. There will be horizontal rules separating the +header and last rows from other rows. + + If you are not satisfied with the above formatting options, you can +create custom table styles and associate them with a table using the +`#+ATTR_ODT' line. *Note Customizing tables in ODT export::. + + ---------- Footnotes ---------- + + (1) The column widths are interpreted as weighted ratios with the +default weight being 1 + + +File: org, Node: Images in ODT export, Next: Math formatting in ODT export, Prev: Tables in ODT export, Up: OpenDocument Text export + +12.9.7 Images in ODT export +--------------------------- + +Embedding images +................ + +You can embed images within the exported document by providing a link +to the desired image file with no link description. For example, to +embed `img.png' do either of the following: + + [[file:img.png]] + + [[./img.png]] + +Embedding clickable images +.......................... + +You can create clickable images by providing a link whose description +is a link to an image file. For example, to embed a image +`org-mode-unicorn.png' which when clicked jumps to `http://Orgmode.org' +website, do the following + + [[http://orgmode.org][./org-mode-unicorn.png]] + +Sizing and scaling of embedded images +..................................... + +You can control the size and scale of the embedded images using the +`#+ATTR_ODT' attribute. + + The exporter specifies the desired size of the image in the final +document in units of centimeters. In order to scale the embedded +images, the exporter queries for pixel dimensions of the images using +one of a) ImageMagick's `identify' program or b) Emacs `create-image' +and `image-size' APIs(1). The pixel dimensions are subsequently +converted in to units of centimeters using `org-odt-pixels-per-inch'. +The default value of this variable is set to `display-pixels-per-inch'. +You can tweak this variable to achieve the best results. + + The examples below illustrate the various possibilities. + +Explicitly size the image + To embed `img.png' as a 10 cm x 10 cm image, do the following: + + #+ATTR_ODT: :width 10 :height 10 + [[./img.png]] + +Scale the image + To embed `img.png' at half its size, do the following: + + #+ATTR_ODT: :scale 0.5 + [[./img.png]] + +Scale the image to a specific width + To embed `img.png' with a width of 10 cm while retaining the + original height:width ratio, do the following: + + #+ATTR_ODT: :width 10 + [[./img.png]] + +Scale the image to a specific height + To embed `img.png' with a height of 10 cm while retaining the + original height:width ratio, do the following + + #+ATTR_ODT: :height 10 + [[./img.png]] + +Anchoring of images +................... + +You can control the manner in which an image is anchored by setting the +`:anchor' property of it's `#+ATTR_ODT' line. You can specify one of +the following three values for the `:anchor' property: `"as-char"', +`"paragraph"' and `"page"'. + + To create an image that is anchored to a page, do the following: + #+ATTR_ODT: :anchor "page" + [[./img.png]] + + ---------- Footnotes ---------- + + (1) Use of `ImageMagick' is only desirable. However, if you +routinely produce documents that have large images or you export your +Org files that has images using a Emacs batch script, then the use of +`ImageMagick' is mandatory. + + +File: org, Node: Math formatting in ODT export, Next: Labels and captions in ODT export, Prev: Images in ODT export, Up: OpenDocument Text export + +12.9.8 Math formatting in ODT export +------------------------------------ + +The ODT exporter has special support for handling math. + +* Menu: + +* Working with LaTeX math snippets:: How to embed LaTeX math fragments +* Working with MathML or OpenDocument formula files:: How to embed equations in native format + + +File: org, Node: Working with LaTeX math snippets, Next: Working with MathML or OpenDocument formula files, Prev: Math formatting in ODT export, Up: Math formatting in ODT export + +12.9.8.1 Working with LaTeX math snippets +......................................... + +LaTeX math snippets (*note LaTeX fragments::) can be embedded in the ODT +document in one of the following ways: + + 1. MathML + + This option is activated on a per-file basis with + + #+OPTIONS: LaTeX:t + + With this option, LaTeX fragments are first converted into MathML + fragments using an external LaTeX-to-MathML converter program. The + resulting MathML fragments are then embedded as an OpenDocument + Formula in the exported document. + + You can specify the LaTeX-to-MathML converter by customizing the + variables `org-latex-to-mathml-convert-command' and + `org-latex-to-mathml-jar-file'. + + If you prefer to use `MathToWeb'(1) as your converter, you can + configure the above variables as shown below. + + (setq org-latex-to-mathml-convert-command + "java -jar %j -unicode -force -df %o %I" + org-latex-to-mathml-jar-file + "/path/to/mathtoweb.jar") + + You can use the following commands to quickly verify the + reliability of the LaTeX-to-MathML converter. + + `M-x org-odt-export-as-odf RET' + Convert a LaTeX math snippet to an OpenDocument formula + (`.odf') file. + + `M-x org-odt-export-as-odf-and-open RET' + Convert a LaTeX math snippet to an OpenDocument formula + (`.odf') file and open the formula file with the + system-registered application. + + 2. PNG images + + This option is activated on a per-file basis with + + #+OPTIONS: tex:dvipng + + or: + + #+OPTIONS: tex:imagemagick + + With this option, LaTeX fragments are processed into PNG images + and the resulting images are embedded in the exported document. + This method requires that the `dvipng' program or `imagemagick' + suite be available on your system. + + ---------- Footnotes ---------- + + (1) See MathToWeb +(http://www.mathtoweb.com/cgi-bin/mathtoweb_home.pl) + + +File: org, Node: Working with MathML or OpenDocument formula files, Prev: Working with LaTeX math snippets, Up: Math formatting in ODT export + +12.9.8.2 Working with MathML or OpenDocument formula files +.......................................................... + +For various reasons, you may find embedding LaTeX math snippets in an +ODT document less than reliable. In that case, you can embed a math +equation by linking to its MathML (`.mml') source or its OpenDocument +formula (`.odf') file as shown below: + + [[./equation.mml]] + + or + + [[./equation.odf]] + + +File: org, Node: Labels and captions in ODT export, Next: Literal examples in ODT export, Prev: Math formatting in ODT export, Up: OpenDocument Text export + +12.9.9 Labels and captions in ODT export +---------------------------------------- + +You can label and caption various category of objects--an inline image, +a table, a LaTeX fragment or a Math formula--using `#+LABEL' and +`#+CAPTION' lines. *Note Images and tables::. ODT exporter enumerates +each labeled or captioned object of a given category separately. As a +result, each such object is assigned a sequence number based on order +of it's appearance in the Org file. + + In the exported document, a user-provided caption is augmented with +the category and sequence number. Consider the following inline image +in an Org file. + + #+CAPTION: Bell curve + #+LABEL: fig:SED-HR4049 + [[./img/a.png]] + + It could be rendered as shown below in the exported document. + + Figure 2: Bell curve + + You can modify the category component of the caption by customizing +the option `org-odt-category-map-alist'. For example, to tag all +embedded images with the string `Illustration' (instead of the default +`Figure') use the following setting: + + (setq org-odt-category-map-alist + (("__Figure__" "Illustration" "value" "Figure" org-odt--enumerable-image-p))) + + With this, previous image will be captioned as below in the exported +document. + + Illustration 2: Bell curve + + +File: org, Node: Literal examples in ODT export, Next: Advanced topics in ODT export, Prev: Labels and captions in ODT export, Up: OpenDocument Text export + +12.9.10 Literal examples in ODT export +-------------------------------------- + +Export of literal examples (*note Literal examples::) with full +fontification is supported. Internally, the exporter relies on +`htmlfontify.el' to generate all style definitions needed for a fancy +listing.(1) The auto-generated styles have `OrgSrc' as prefix and +inherit their color from the faces used by Emacs `font-lock' library +for the source language. + + If you prefer to use your own custom styles for fontification, you +can do so by customizing the option +`org-odt-create-custom-styles-for-srcblocks'. + + You can turn off fontification of literal examples by customizing the +option `org-odt-fontify-srcblocks'. + + ---------- Footnotes ---------- + + (1) Your `htmlfontify.el' library must at least be at Emacs 24.1 +levels for fontification to be turned on. + + +File: org, Node: Advanced topics in ODT export, Prev: Literal examples in ODT export, Up: OpenDocument Text export + +12.9.11 Advanced topics in ODT export +------------------------------------- + +If you rely heavily on ODT export, you may want to exploit the full set +of features that the exporter offers. This section describes features +that would be of interest to power users. + +* Menu: + +* Configuring a document converter:: How to register a document converter +* Working with OpenDocument style files:: Explore the internals +* Creating one-off styles:: How to produce custom highlighting etc +* Customizing tables in ODT export:: How to define and use Table templates +* Validating OpenDocument XML:: How to debug corrupt OpenDocument files + + +File: org, Node: Configuring a document converter, Next: Working with OpenDocument style files, Prev: Advanced topics in ODT export, Up: Advanced topics in ODT export + +12.9.11.1 Configuring a document converter +.......................................... + +The ODT exporter can work with popular converters with little or no +extra configuration from your side. *Note Extending ODT export::. If +you are using a converter that is not supported by default or if you +would like to tweak the default converter settings, proceed as below. + + 1. Register the converter + + Name your converter and add it to the list of known converters by + customizing the option `org-odt-convert-processes'. Also specify + how the converter can be invoked via command-line to effect the + conversion. + + 2. Configure its capabilities + + Specify the set of formats the converter can handle by customizing + the variable `org-odt-convert-capabilities'. Use the default + value for this variable as a guide for configuring your converter. + As suggested by the default setting, you can specify the full set + of formats supported by the converter and not limit yourself to + specifying formats that are related to just the OpenDocument Text + format. + + 3. Choose the converter + + Select the newly added converter as the preferred one by + customizing the option `org-odt-convert-process'. + + +File: org, Node: Working with OpenDocument style files, Next: Creating one-off styles, Prev: Configuring a document converter, Up: Advanced topics in ODT export + +12.9.11.2 Working with OpenDocument style files +............................................... + +This section explores the internals of the ODT exporter and the means +by which it produces styled documents. Read this section if you are +interested in exploring the automatic and custom OpenDocument styles +used by the exporter. + +Factory styles +.............. + +The ODT exporter relies on two files for generating its output. These +files are bundled with the distribution under the directory pointed to +by the variable `org-odt-styles-dir'. The two files are: + + * `OrgOdtStyles.xml' + + This file contributes to the `styles.xml' file of the final `ODT' + document. This file gets modified for the following purposes: + 1. To control outline numbering based on user settings. + + 2. To add styles generated by `htmlfontify.el' for fontification + of code blocks. + + * `OrgOdtContentTemplate.xml' + + This file contributes to the `content.xml' file of the final `ODT' + document. The contents of the Org outline are inserted between the + `'...`' elements of this file. + + Apart from serving as a template file for the final `content.xml', + the file serves the following purposes: + 1. It contains automatic styles for formatting of tables which + are referenced by the exporter. + + 2. It contains `'...`' + elements that control how various entities--tables, images, + equations, etc.--are numbered. + +Overriding factory styles +......................... + +The following two variables control the location from which the ODT +exporter picks up the custom styles and content template files. You can +customize these variables to override the factory styles used by the +exporter. + + * `org-odt-styles-file' + + Use this variable to specify the `styles.xml' that will be used in + the final output. You can specify one of the following values: + + 1. A `styles.xml' file + + Use this file instead of the default `styles.xml' + + 2. A `.odt' or `.ott' file + + Use the `styles.xml' contained in the specified OpenDocument + Text or Template file + + 3. A `.odt' or `.ott' file and a subset of files contained + within them + + Use the `styles.xml' contained in the specified OpenDocument + Text or Template file. Additionally extract the specified + member files and embed those within the final `ODT' document. + + Use this option if the `styles.xml' file references + additional files like header and footer images. + + 4. `nil' + + Use the default `styles.xml' + + * `org-odt-content-template-file' + + Use this variable to specify the blank `content.xml' that will be + used in the final output. + + +File: org, Node: Creating one-off styles, Next: Customizing tables in ODT export, Prev: Working with OpenDocument style files, Up: Advanced topics in ODT export + +12.9.11.3 Creating one-off styles +................................. + +There are times when you would want one-off formatting in the exported +document. You can achieve this by embedding raw OpenDocument XML in +the Org file. The use of this feature is better illustrated with +couple of examples. + + 1. Embedding ODT tags as part of regular text + + You can inline OpenDocument syntax by enclosing it within + `@@odt:...@@' markup. For example, to highlight a region of text + do the following: + + @@odt:This is a highlighted + text@@. But this is a regular text. + + *Hint:* To see the above example in action, edit your `styles.xml' + (*note Factory styles: x-orgodtstyles-xml.) and add a custom + `Highlight' style as shown below. + + + + + + 2. Embedding a one-line OpenDocument XML + + You can add a simple OpenDocument one-liner using the `#+ODT:' + directive. For example, to force a page break do the following: + + #+ODT: + + *Hint:* To see the above example in action, edit your `styles.xml' + (*note Factory styles: x-orgodtstyles-xml.) and add a custom + `PageBreak' style as shown below. + + + + + + 3. Embedding a block of OpenDocument XML + + You can add a large block of OpenDocument XML using the + `#+BEGIN_ODT'...`#+END_ODT' construct. + + For example, to create a one-off paragraph that uses bold text, do + the following: + + #+BEGIN_ODT + + This paragraph is specially formatted and uses bold text. + + #+END_ODT + + + +File: org, Node: Customizing tables in ODT export, Next: Validating OpenDocument XML, Prev: Creating one-off styles, Up: Advanced topics in ODT export + +12.9.11.4 Customizing tables in ODT export +.......................................... + +You can override the default formatting of the table by specifying a +custom table style with the `#+ATTR_ODT' line. For a discussion on +default formatting of tables *note Tables in ODT export::. + + This feature closely mimics the way table templates are defined in +the OpenDocument-v1.2 specification.(1) + +Custom table styles: an illustration +.................................... + +To have a quick preview of this feature, install the below setting and +export the table that follows: + + (setq org-odt-table-styles + (append org-odt-table-styles + '(("TableWithHeaderRowAndColumn" "Custom" + ((use-first-row-styles . t) + (use-first-column-styles . t))) + ("TableWithFirstRowandLastRow" "Custom" + ((use-first-row-styles . t) + (use-last-row-styles . t)))))) + + #+ATTR_ODT: :style "TableWithHeaderRowAndColumn" + | Name | Phone | Age | + | Peter | 1234 | 17 | + | Anna | 4321 | 25 | + + In the above example, you used a template named `Custom' and +installed two table styles with the names `TableWithHeaderRowAndColumn' +and `TableWithFirstRowandLastRow'. (*Important:* The OpenDocument +styles needed for producing the above template have been pre-defined for +you. These styles are available under the section marked `Custom Table +Template' in `OrgOdtContentTemplate.xml' (*note Factory styles: +x-orgodtcontenttemplate-xml.). If you need additional templates you +have to define these styles yourselves. + +Custom table styles: the nitty-gritty +..................................... + +To use this feature proceed as follows: + + 1. Create a table template(2) + + A table template is nothing but a set of `table-cell' and + `paragraph' styles for each of the following table cell categories: + + - Body + + - First column + + - Last column + + - First row + + - Last row + + - Even row + + - Odd row + + - Even column + + - Odd Column + + The names for the above styles must be chosen based on the name of + the table template using a well-defined convention. + + The naming convention is better illustrated with an example. For + a table template with the name `Custom', the needed style names + are listed in the following table. + + Table cell type `table-cell' style `paragraph' style + ------------------------------------------------------------------------------- + + Body `CustomTableCell' `CustomTableParagraph' + First column `CustomFirstColumnTableCell'`CustomFirstColumnTableParagraph' + Last column `CustomLastColumnTableCell' `CustomLastColumnTableParagraph' + First row `CustomFirstRowTableCell' `CustomFirstRowTableParagraph' + Last row `CustomLastRowTableCell' `CustomLastRowTableParagraph' + Even row `CustomEvenRowTableCell' `CustomEvenRowTableParagraph' + Odd row `CustomOddRowTableCell' `CustomOddRowTableParagraph' + Even column `CustomEvenColumnTableCell' `CustomEvenColumnTableParagraph' + Odd column `CustomOddColumnTableCell' `CustomOddColumnTableParagraph' + + To create a table template with the name `Custom', define the above + styles in the + `'...`' element + of the content template file (*note Factory styles: + x-orgodtcontenttemplate-xml.). + + 2. Define a table style(3) + + To define a table style, create an entry for the style in the + variable `org-odt-table-styles' and specify the following: + + - the name of the table template created in step (1) + + - the set of cell styles in that template that are to be + activated + + For example, the entry below defines two different table styles + `TableWithHeaderRowAndColumn' and `TableWithFirstRowandLastRow' + based on the same template `Custom'. The styles achieve their + intended effect by selectively activating the individual cell + styles in that template. + + (setq org-odt-table-styles + (append org-odt-table-styles + '(("TableWithHeaderRowAndColumn" "Custom" + ((use-first-row-styles . t) + (use-first-column-styles . t))) + ("TableWithFirstRowandLastRow" "Custom" + ((use-first-row-styles . t) + (use-last-row-styles . t)))))) + + 3. Associate a table with the table style + + To do this, specify the table style created in step (2) as part of + the `ATTR_ODT' line as shown below. + + #+ATTR_ODT: :style "TableWithHeaderRowAndColumn" + | Name | Phone | Age | + | Peter | 1234 | 17 | + | Anna | 4321 | 25 | + + ---------- Footnotes ---------- + + (1) OpenDocument-v1.2 Specification +(http://docs.oasis-open.org/office/v1.2/OpenDocument-v1.2.html) + + (2) See the `' element of the +OpenDocument-v1.2 specification + + (3) See the attributes `table:template-name', +`table:use-first-row-styles', `table:use-last-row-styles', +`table:use-first-column-styles', `table:use-last-column-styles', +`table:use-banding-rows-styles', and `table:use-banding-column-styles' +of the `' element in the OpenDocument-v1.2 specification + + +File: org, Node: Validating OpenDocument XML, Prev: Customizing tables in ODT export, Up: Advanced topics in ODT export + +12.9.11.5 Validating OpenDocument XML +..................................... + +Occasionally, you will discover that the document created by the ODT +exporter cannot be opened by your favorite application. One of the +common reasons for this is that the `.odt' file is corrupt. In such +cases, you may want to validate the document against the OpenDocument +RELAX NG Compact Syntax (RNC) schema. + + For de-compressing the `.odt' file(1): *note (emacs)File Archives::. +For general help with validation (and schema-sensitive editing) of XML +files: *note (nxml-mode)Introduction::. + + If you have ready access to OpenDocument `.rnc' files and the needed +schema-locating rules in a single folder, you can customize the variable +`org-odt-schema-dir' to point to that directory. The ODT exporter will +take care of updating the `rng-schema-locating-files' for you. + + ---------- Footnotes ---------- + + (1) `.odt' files are nothing but `zip' archives + + +File: org, Node: Org export, Next: Texinfo export, Prev: OpenDocument Text export, Up: Exporting + +12.10 Org export +================ + +`org' export back-end creates a normalized version of the Org document +in current buffer. In particular, it evaluates Babel code (*note +Evaluating code blocks::) and removes other back-ends specific contents. + +Org export commands +------------------- + +`C-c C-e O o (`org-org-export-to-org')' + Export as an Org document. For an Org file, `myfile.org', the + resulting file will be `myfile.org.org'. The file will be + overwritten without warning. + +`C-c C-e O O (`org-org-export-as-org')' + Export to a temporary buffer. Do not create a file. + +`C-c C-e O v' + Export to an Org file, then open it. + + +File: org, Node: Texinfo export, Next: iCalendar export, Prev: Org export, Up: Exporting + +12.11 Texinfo export +==================== + +`texinfo' export back-end generates Texinfo code and can compile it into +an Info file. + +* Menu: + +* Texinfo export commands:: How to invoke Texinfo export +* Document preamble:: File header, title and copyright page +* Headings and sectioning structure:: Building document structure +* Indices:: Creating indices +* Quoting Texinfo code:: Incorporating literal Texinfo code +* Texinfo specific attributes:: Controlling Texinfo output +* An example:: + + +File: org, Node: Texinfo export commands, Next: Document preamble, Prev: Texinfo export, Up: Texinfo export + +12.11.1 Texinfo export commands +------------------------------- + +`C-c C-e i t (`org-texinfo-export-to-texinfo')' + Export as a Texinfo file. For an Org file, `myfile.org', the + resulting file will be `myfile.texi'. The file will be + overwritten without warning. + +`C-c C-e i i (`org-texinfo-export-to-info')' + Export to Texinfo and then process to an Info file(1). + + ---------- Footnotes ---------- + + (1) By setting `org-texinfo-info-process', it is possible to +generate other formats, including DocBook. + + +File: org, Node: Document preamble, Next: Headings and sectioning structure, Prev: Texinfo export commands, Up: Texinfo export + +12.11.2 Document preamble +------------------------- + +When processing a document, `texinfo' back-end generates a minimal file +header along with a title page, a copyright page, and a menu. You +control the latter through the structure of the document (*note +Headings and sectioning structure::). Various keywords allow to tweak +the other parts. It is also possible to give directions to install the +document in the `Top' node. + +File header +........... + +Upon creating the header of a Texinfo file, the back-end guesses a name +for the Info file to be compiled. This may not be a sensible choice, +e.g., if you want to produce the final document in a different +directory. Specify an alternate path with `#+TEXINFO_FILENAME' keyword +to override the default destination. + + Along with the output file name, the header contains information +about the language (*note Export settings::) and current encoding +used(1). Insert a `#+TEXINFO_HEADER' keyword for each additional +command needed, e.g., @code{@synindex}. + + If you happen to regularly install the same set of commands, it may +be easier to define your own class in `org-texinfo-classes', which see. +Set `#+TEXINFO_CLASS' keyword accordingly in your document to activate +it. + +Title and copyright page +........................ + +The default template includes a title page for hard copy output. The +title and author displayed on this page are extracted from, +respectively, `#+TITLE' and `#+AUTHOR' keywords (*note Export +settings::). It is also possible to print a different, more specific, +title with `#+TEXINFO_PRINTED_TITLE' keyword, and add subtitles with +`#+SUBTITLE' keyword. Both expect raw Texinfo code in their value. + + Likewise, information brought by `#+AUTHOR' may not be enough. You +can include other authors with several `#+SUBAUTHOR' keywords. Values +are also expected to be written in Texinfo code. + + #+AUTHOR: Jane Smith + #+SUBAUTHOR: John Doe + #+TEXINFO_PRINTED_TITLE: This Long Title@inlinefmt{tex,@*} Is Broken in @TeX{} + + Copying material is defined in a dedicated headline with a non-nil +`:COPYING:' property. The contents are inserted within a `@copying' +command at the beginning of the document whereas the heading itself +does not appear in the structure of the document. + + Copyright information is printed on the back of the title page. + + * Copying + :PROPERTIES: + :COPYING: t + :END: + + This is a short example of a complete Texinfo file, version 1.0. + + Copyright \copy 2014 Free Software Foundation, Inc. + +The Top node +............ + +You may ultimately want to install your new Info file in your system. +You can write an appropriate entry in the top level directory +specifying its category and title with, respectively, +`#+TEXINFO_DIR_CATEGORY' and `#+TEXINFO_DIR_TITLE'. Optionally, you +can add a short description using `#+TEXINFO_DIR_DESC'. The following +example would write an entry similar to Org's in the `Top' node. + + #+TEXINFO_DIR_CATEGORY: Emacs + #+TEXINFO_DIR_TITLE: Org Mode: (org) + #+TEXINFO_DIR_DESC: Outline-based notes management and organizer + + ---------- Footnotes ---------- + + (1) See `org-texinfo-coding-system' for more information. + + +File: org, Node: Headings and sectioning structure, Next: Indices, Prev: Document preamble, Up: Texinfo export + +12.11.3 Headings and sectioning structure +----------------------------------------- + +`texinfo' uses a pre-defined scheme, or class, to convert headlines into +Texinfo structuring commands. For example, a top level headline +appears as `@chapter' if it should be numbered or as `@unnumbered' +otherwise. If you need to use a different set of commands, e.g., to +start with `@part' instead of `@chapter', install a new class in +`org-texinfo-classes', then activate it with `#+TEXINFO_CLASS' keyword. +Export process defaults to `org-texinfo-default-class' when there is no +such keyword in the document. + + If a headline's level has no associated structuring command, or is +below a certain threshold (*note Export settings::), that headline +becomes a list in Texinfo output. + + As an exception, a headline with a non-nil `:APPENDIX:' property +becomes an appendix, independently on its level and the class used. + + Each regular sectioning structure creates a menu entry, named after +the heading. You can provide a different, e.g., shorter, title in +`:ALT_TITLE:' property (*note Table of contents::). Optionally, you can +specify a description for the item in `:DESCRIPTION:' property. E.g., + + * Controlling Screen Display + :PROPERTIES: + :ALT_TITLE: Display + :DESCRIPTION: Controlling Screen Display + :END: + + +File: org, Node: Indices, Next: Quoting Texinfo code, Prev: Headings and sectioning structure, Up: Texinfo export + +12.11.4 Indices +--------------- + +Index entries are created using dedicated keywords. `texinfo' back-end +provides one for each predefined type: `#+CINDEX', `#+FINDEX', +`#+KINDEX', `#+PINDEX', `#+TINDEX' and `#+VINDEX'. For custom indices, +you can write raw Texinfo code (*note Quoting Texinfo code::). + + #+CINDEX: Defining indexing entries + + To generate an index, you need to set the `:INDEX:' property of a +headline to an appropriate abbreviation (e.g., `cp' or `vr'). The +headline is then exported as an unnumbered chapter or section command +and the index is inserted after its contents. + + * Concept Index + :PROPERTIES: + :INDEX: cp + :END: + + +File: org, Node: Quoting Texinfo code, Next: Texinfo specific attributes, Prev: Indices, Up: Texinfo export + +12.11.5 Quoting Texinfo code +---------------------------- + +It is possible to insert raw Texinfo code using any of the following +constructs + + Richard @@texinfo:@sc{@@Stallman@@texinfo:}@@ commence' GNU. + + #+TEXINFO: @need800 + This paragraph is preceded by... + + #+BEGIN_TEXINFO + @auindex Johnson, Mark + @auindex Lakoff, George + #+END_TEXINFO + + +File: org, Node: Texinfo specific attributes, Next: An example, Prev: Quoting Texinfo code, Up: Texinfo export + +12.11.6 Texinfo specific attributes +----------------------------------- + +`texinfo' back-end understands several attributes in plain lists and +tables. They must be specified using an `#+ATTR_TEXINFO' keyword, +written just above the list or table. + +Plain lists +........... + +In Texinfo output, description lists appear as two-column tables, using +the default command `@table'. You can use `@ftable' or `@vtable'(1) +instead with `:table-type' attribute. + + In any case, these constructs require a highlighting command for +entries in the list. You can provide one with `:indic' attribute. If +you do not, it defaults to the value stored in +`org-texinfo-def-table-markup', which see. + + #+ATTR_TEXINFO: :indic @asis + - foo :: This is the text for /foo/, with no highlighting. + +Tables +...... + +When exporting a table, column widths are deduced from the longest cell +in each column. You can also define them explicitly as fractions of +the line length, using `:columns' attribute. + + #+ATTR_TEXINFO: :columns .5 .5 + | a cell | another cell | + + ---------- Footnotes ---------- + + (1) For more information, *note (texinfo)Two-column Tables::. + + +File: org, Node: An example, Prev: Texinfo specific attributes, Up: Texinfo export + +12.11.7 An example +------------------ + +Here is a thorough example, taken from *note (texinfo)GNU Sample +Texts::. + + #+MACRO: version 2.0 + #+MACRO: updated last updated 4 March 2014 + + #+OPTIONS: ':t toc:t author:t email:t + #+TITLE: GNU Sample {{{version}}} + #+AUTHOR: A.U. Thor + #+EMAIL: bug-sample@gnu.org + #+LANGUAGE: en + + #+TEXINFO_FILENAME: sample.info + #+TEXINFO_HEADER: @syncodeindex pg cp + + #+TEXINFO_DIR_CATEGORY: Texinfo documentation system + #+TEXINFO_DIR_TITLE: sample: (sample) + #+TEXINFO_DIR_DESC: Invoking sample + + #+TEXINFO_PRINTED_TITLE: GNU Sample + #+SUBTITLE: for version 2.0, last updated 4 March 2014 + + * Copying + :PROPERTIES: + :COPYING: t + :END: + + This manual is for GNU Sample (version {{{version}}}, + {{{updated}}}), which is an example in the Texinfo documentation. + + Copyright @@texinfo:@copyright{}@@ 2013 Free Software Foundation, + Inc. + + #+BEGIN_QUOTE + Permission is granted to copy, distribute and/or modify this + document under the terms of the GNU Free Documentation License, + Version 1.3 or any later version published by the Free Software + Foundation; with no Invariant Sections, with no Front-Cover Texts, + and with no Back-Cover Texts. A copy of the license is included in + the section entitled "GNU Free Documentation License". + #+END_QUOTE + + * Invoking sample + + #+PINDEX: sample + #+CINDEX: invoking @command{sample} + + This is a sample manual. There is no sample program to invoke, but + if there were, you could see its basic usage and command line + options here. + + * GNU Free Documentation License + :PROPERTIES: + :APPENDIX: t + :END: + + #+TEXINFO: @include fdl.texi + + * Index + :PROPERTIES: + :INDEX: cp + :END: + + +File: org, Node: iCalendar export, Next: Other built-in back-ends, Prev: Texinfo export, Up: Exporting + +12.12 iCalendar export +====================== + +Some people use Org mode for keeping track of projects, but still +prefer a standard calendar application for anniversaries and +appointments. In this case it can be useful to show deadlines and +other time-stamped items in Org files in the calendar application. Org +mode can export calendar information in the standard iCalendar format. +If you also want to have TODO entries included in the export, configure +the variable `org-icalendar-include-todo'. Plain timestamps are +exported as VEVENT, and TODO items as VTODO. It will also create +events from deadlines that are in non-TODO items. Deadlines and +scheduling dates in TODO items will be used to set the start and due +dates for the TODO entry(1). As categories, it will use the tags +locally defined in the heading, and the file/tree category(2). See the +variable `org-icalendar-alarm-time' for a way to assign alarms to +entries with a time. + + The iCalendar standard requires each entry to have a globally unique +identifier (UID). Org creates these identifiers during export. If you +set the variable `org-icalendar-store-UID', the UID will be stored in +the `:ID:' property of the entry and re-used next time you report this +entry. Since a single entry can give rise to multiple iCalendar +entries (as a timestamp, a deadline, a scheduled item, and as a TODO +item), Org adds prefixes to the UID, depending on what triggered the +inclusion of the entry. In this way the UID remains unique, but a +synchronization program can still figure out from which entry all the +different instances originate. + +`C-c C-e c f (`org-icalendar-export-to-ics')' + Create iCalendar entries for the current buffer and store them in + the same directory, using a file extension `.ics'. + +`C-c C-e c a (`org-icalendar-export-agenda-files')' + Like `C-c C-e c f', but do this for all files in + `org-agenda-files'. For each of these files, a separate iCalendar + file will be written. + +`C-c C-e c c (`org-icalendar-combine-agenda-files')' + Create a single large iCalendar file from all files in + `org-agenda-files' and write it to the file given by + `org-icalendar-combined-agenda-file'. + + The export will honor SUMMARY, DESCRIPTION and LOCATION(3) +properties if the selected entries have them. If not, the summary will +be derived from the headline, and the description from the body +(limited to `org-icalendar-include-body' characters). + + How this calendar is best read and updated, depends on the +application you are using. The FAQ covers this issue. + + ---------- Footnotes ---------- + + (1) See the variables `org-icalendar-use-deadline' and +`org-icalendar-use-scheduled'. + + (2) To add inherited tags or the TODO state, configure the variable +`org-icalendar-categories'. + + (3) The LOCATION property can be inherited from higher in the +hierarchy if you configure `org-use-property-inheritance' accordingly. + + +File: org, Node: Other built-in back-ends, Next: Export in foreign buffers, Prev: iCalendar export, Up: Exporting + +12.13 Other built-in back-ends +============================== + +On top of the aforementioned back-ends, Org comes with other built-in +ones: + + * `ox-man.el': export to a man page. + + To activate these export back-end, customize `org-export-backends' or +load them directly with e.g., `(require 'ox-man)'. This will add new +keys in the export dispatcher (*note The Export Dispatcher::). + + See the comment section of these files for more information on how +to use them. + + +File: org, Node: Export in foreign buffers, Next: Advanced configuration, Prev: Other built-in back-ends, Up: Exporting + +12.14 Export in foreign buffers +=============================== + +Most built-in back-ends come with a command to convert the selected +region into a selected format and replace this region by the exported +output. Here is a list of such conversion commands: + +`org-html-convert-region-to-html' + Convert the selected region into HTML. + +`org-latex-convert-region-to-latex' + Convert the selected region into LaTeX. + +`org-texinfo-convert-region-to-texinfo' + Convert the selected region into `Texinfo'. + +`org-md-convert-region-to-md' + Convert the selected region into `MarkDown'. + + This is particularly useful for converting tables and lists in +foreign buffers. E.g., in an HTML buffer, you can turn on +`orgstruct-mode', then use Org commands for editing a list, and finally +select and convert the list with `M-x org-html-convert-region-to-html +RET'. + + +File: org, Node: Advanced configuration, Prev: Export in foreign buffers, Up: Exporting + +12.15 Advanced configuration +============================ + +Hooks +----- + +Two hooks are run during the first steps of the export process. The +first one, `org-export-before-processing-hook' is called before +expanding macros, Babel code and include keywords in the buffer. The +second one, `org-export-before-parsing-hook', as its name suggests, +happens just before parsing the buffer. Their main use is for heavy +duties, that is duties involving structural modifications of the +document. For example, one may want to remove every headline in the +buffer during export. The following code can achieve this: + + (defun my-headline-removal (backend) + "Remove all headlines in the current buffer. + BACKEND is the export back-end being used, as a symbol." + (org-map-entries + (lambda () (delete-region (point) (progn (forward-line) (point)))))) + + (add-hook 'org-export-before-parsing-hook 'my-headline-removal) + + Note that functions used in these hooks require a mandatory argument, +a symbol representing the back-end used. + +Filters +------- + +Filters are lists of functions applied on a specific part of the output +from a given back-end. More explicitly, each time a back-end +transforms an Org object or element into another language, all +functions within a given filter type are called in turn on the string +produced. The string returned by the last function will be the one +used in the final output. + + There are filters sets for each type of element or object, for plain +text, for the parse tree, for the export options and for the final +output. They are all named after the same scheme: +`org-export-filter-TYPE-functions', where `TYPE' is the type targeted +by the filter. Valid types are: + +bold babel-call center-block +clock code comment +comment-block diary-sexp drawer +dynamic-block entity example-block +export-block export-snippet final-output +fixed-width footnote-definition footnote-reference +headline horizontal-rule inline-babel-call +inline-src-block inlinetask italic +item keyword latex-environment +latex-fragment line-break link +node-property options paragraph +parse-tree plain-list plain-text +planning property-drawer quote-block +quote-section radio-target section +special-block src-block statistics-cookie +strike-through subscript superscript +table table-cell table-row +target timestamp underline +verbatim verse-block + + For example, the following snippet allows me to use non-breaking +spaces in the Org buffer and get them translated into LaTeX without +using the `\nbsp' macro (where `_' stands for the non-breaking space): + + (defun my-latex-filter-nobreaks (text backend info) + "Ensure \" \" are properly handled in LaTeX export." + (when (org-export-derived-backend-p backend 'latex) + (replace-regexp-in-string " " "~" text))) + + (add-to-list 'org-export-filter-plain-text-functions + 'my-latex-filter-nobreaks) + + Three arguments must be provided to a filter: the code being +changed, the back-end used, and some information about the export +process. You can safely ignore the third argument for most purposes. +Note the use of `org-export-derived-backend-p', which ensures that the +filter will only be applied when using `latex' back-end or any other +back-end derived from it (e.g., `beamer'). + +Extending an existing back-end +------------------------------ + +This is obviously the most powerful customization, since the changes +happen at the parser level. Indeed, some export back-ends are built as +extensions of other ones (e.g. Markdown back-end an extension of HTML +back-end). + + Extending a back-end means that if an element type is not transcoded +by the new back-end, it will be handled by the original one. Hence you +can extend specific parts of a back-end without too much work. + + As an example, imagine we want the `ascii' back-end to display the +language used in a source block, when it is available, but only when +some attribute is non-`nil', like the following: + + #+ATTR_ASCII: :language t + + Because that back-end is lacking in that area, we are going to +create a new back-end, `my-ascii' that will do the job. + + (defun my-ascii-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to ASCII. + CONTENTS is nil. INFO is a plist used as a communication + channel." + (if (not (org-export-read-attribute :attr_ascii src-block :language)) + (org-export-with-backend 'ascii src-block contents info) + (concat + (format ",--[ %s ]--\n%s`----" + (org-element-property :language src-block) + (replace-regexp-in-string + "^" "| " + (org-element-normalize-string + (org-export-format-code-default src-block info))))))) + + (org-export-define-derived-backend 'my-ascii 'ascii + :translate-alist '((src-block . my-ascii-src-block))) + + The `my-ascii-src-block' function looks at the attribute above the +element. If it isn't true, it gives hand to the `ascii' back-end. +Otherwise, it creates a box around the code, leaving room for the +language. A new back-end is then created. It only changes its +behavior when translating `src-block' type element. Now, all it takes +to use the new back-end is calling the following from an Org buffer: + + (org-export-to-buffer 'my-ascii "*Org MY-ASCII Export*") + + It is obviously possible to write an interactive function for this, +install it in the export dispatcher menu, and so on. + + +File: org, Node: Publishing, Next: Working With Source Code, Prev: Exporting, Up: Top + +13 Publishing +************* + +Org includes a publishing management system that allows you to configure +automatic HTML conversion of _projects_ composed of interlinked org +files. You can also configure Org to automatically upload your +exported HTML pages and related attachments, such as images and source +code files, to a web server. + + You can also use Org to convert files into PDF, or even combine HTML +and PDF conversion so that files are available in both formats on the +server. + + Publishing has been contributed to Org by David O'Toole. + +* Menu: + +* Configuration:: Defining projects +* Uploading files:: How to get files up on the server +* Sample configuration:: Example projects +* Triggering publication:: Publication commands + + +File: org, Node: Configuration, Next: Uploading files, Prev: Publishing, Up: Publishing + +13.1 Configuration +================== + +Publishing needs significant configuration to specify files, destination +and many other properties of a project. + +* Menu: + +* Project alist:: The central configuration variable +* Sources and destinations:: From here to there +* Selecting files:: What files are part of the project? +* Publishing action:: Setting the function doing the publishing +* Publishing options:: Tweaking HTML/LaTeX export +* Publishing links:: Which links keep working after publishing? +* Sitemap:: Generating a list of all pages +* Generating an index:: An index that reaches across pages + + +File: org, Node: Project alist, Next: Sources and destinations, Prev: Configuration, Up: Configuration + +13.1.1 The variable `org-publish-project-alist' +----------------------------------------------- + +Publishing is configured almost entirely through setting the value of +one variable, called `org-publish-project-alist'. Each element of the +list configures one project, and may be in one of the two following +forms: + + ("project-name" :property value :property value ...) + i.e., a well-formed property list with alternating keys and values + or + ("project-name" :components ("project-name" "project-name" ...)) + + In both cases, projects are configured by specifying property +values. A project defines the set of files that will be published, as +well as the publishing configuration to use when publishing those +files. When a project takes the second form listed above, the +individual members of the `:components' property are taken to be +sub-projects, which group together files requiring different publishing +options. When you publish such a "meta-project", all the components +will also be published, in the sequence given. + + +File: org, Node: Sources and destinations, Next: Selecting files, Prev: Project alist, Up: Configuration + +13.1.2 Sources and destinations for files +----------------------------------------- + +Most properties are optional, but some should always be set. In +particular, Org needs to know where to look for source files, and where +to put published files. + +`:base-directory' Directory containing publishing source files +`:publishing-directory'Directory where output files will be published. + You can directly publish to a web server using a + file name syntax appropriate for the Emacs + `tramp' package. Or you can publish to a local + directory and use external tools to upload your + website (*note Uploading files::). +`:preparation-function'Function or list of functions to be called before + starting the publishing process, for example, to + run `make' for updating files to be published. + The project property list is scoped into this + call as the variable `project-plist'. +`:completion-function' Function or list of functions called after + finishing the publishing process, for example, to + change permissions of the resulting files. The + project property list is scoped into this call as + the variable `project-plist'. + + +File: org, Node: Selecting files, Next: Publishing action, Prev: Sources and destinations, Up: Configuration + +13.1.3 Selecting files +---------------------- + +By default, all files with extension `.org' in the base directory are +considered part of the project. This can be modified by setting the +properties +`:base-extension' Extension (without the dot!) of source files. This + actually is a regular expression. Set this to the + symbol `any' if you want to get all files in + `:base-directory', even without extension. +`:exclude' Regular expression to match file names that should + not be published, even though they have been selected + on the basis of their extension. +`:include' List of files to be included regardless of + `:base-extension' and `:exclude'. +`:recursive' non-`nil' means, check base-directory recursively for + files to publish. + + +File: org, Node: Publishing action, Next: Publishing options, Prev: Selecting files, Up: Configuration + +13.1.4 Publishing action +------------------------ + +Publishing means that a file is copied to the destination directory and +possibly transformed in the process. The default transformation is to +export Org files as HTML files, and this is done by the function +`org-html-publish-to-html', which calls the HTML exporter (*note HTML +export::). But you also can publish your content as PDF files using +`org-latex-publish-to-pdf' or as `ascii', `Texinfo', etc., using the +corresponding functions. + + If you want to publish the Org file as an `.org' file but with the +archived, commented and tag-excluded trees removed, use the function +`org-org-publish-to-org'. This will produce `file.org' and put it in +the publishing directory. If you want a htmlized version of this file, +set the parameter `:htmlized-source' to `t', it will produce +`file.org.html' in the publishing directory(1). + + Other files like images only need to be copied to the publishing +destination. For this you can use `org-publish-attachment'. For +non-org files, you always need to specify the publishing function: + +`:publishing-function' Function executing the publication of a file. + This may also be a list of functions, which will + all be called in turn. +`:htmlized-source' non-`nil' means, publish htmlized source. + + The function must accept three arguments: a property list containing +at least a `:publishing-directory' property, the name of the file to be +published and the path to the publishing directory of the output file. +It should take the specified file, make the necessary transformation +(if any) and place the result into the destination folder. + + ---------- Footnotes ---------- + + (1) If the publishing directory is the same than the source +directory, `file.org' will be exported as `file.org.org', so probably +don't want to do this. + + +File: org, Node: Publishing options, Next: Publishing links, Prev: Publishing action, Up: Configuration + +13.1.5 Options for the exporters +-------------------------------- + +The property list can be used to set many export options for the +exporters. In most cases, these properties correspond to user +variables in Org. The first table below lists these properties along +with the variable they belong to. The second table list HTML specific +properties. See the documentation string of these options for details. + +`:archived-trees' `org-export-with-archived-trees' +`:exclude-tags' `org-export-exclude-tags' +`:headline-levels' `org-export-headline-levels' +`:language' `org-export-default-language' +`:preserve-breaks' `org-export-preserve-breaks' +`:section-numbers' `org-export-with-section-numbers' +`:select-tags' `org-export-select-tags' +`:with-author' `org-export-with-author' +`:with-creator' `org-export-with-creator' +`:with-drawers' `org-export-with-drawers' +`:with-email' `org-export-with-email' +`:with-emphasize' `org-export-with-emphasize' +`:with-fixed-width' `org-export-with-fixed-width' +`:with-footnotes' `org-export-with-footnotes' +`:with-latex' `org-export-with-latex' +`:with-planning' `org-export-with-planning' +`:with-priority' `org-export-with-priority' +`:with-special-strings' `org-export-with-special-strings' +`:with-sub-superscript' `org-export-with-sub-superscripts' +`:with-tables' `org-export-with-tables' +`:with-tags' `org-export-with-tags' +`:with-tasks' `org-export-with-tasks' +`:with-timestamps' `org-export-with-timestamps' +`:with-toc' `org-export-with-toc' +`:with-todo-keywords' `org-export-with-todo-keywords' + +`:html-doctype' `org-html-doctype' +`:html-container' `org-html-container-element' +`:html-html5-fancy' `org-html-html5-fancy' +`:html-xml-declaration' `org-html-xml-declaration' +`:html-link-up' `org-html-link-up' +`:html-link-home' `org-html-link-home' +`:html-link-org-as-html'`org-html-link-org-files-as-html' +`:html-link-use-abs-url'`org-html-link-use-abs-url' +`:html-head' `org-html-head' +`:html-head-extra' `org-html-head-extra' +`:html-inline-images' `org-html-inline-images' +`:html-extension' `org-html-extension' +`:html-preamble' `org-html-preamble' +`:html-postamble' `org-html-postamble' +`:html-table-attributes'`org-html-table-default-attributes' +`:html-table-row-tags' `org-html-table-row-tags' +`:html-head-include-default-style'`org-html-head-include-default-style' +`:html-head-include-scripts'`org-html-head-include-scripts' + + Most of the `org-export-with-*' variables have the same effect in +each exporter. + + When a property is given a value in `org-publish-project-alist', its +setting overrides the value of the corresponding user variable (if any) +during publishing. Options set within a file (*note Export settings::), +however, override everything. + + +File: org, Node: Publishing links, Next: Sitemap, Prev: Publishing options, Up: Configuration + +13.1.6 Links between published files +------------------------------------ + +To create a link from one Org file to another, you would use something +like `[[file:foo.org][The foo]]' or simply `file:foo.org.' (*note +Hyperlinks::). When published, this link becomes a link to `foo.html'. +You can thus interlink the pages of your "org web" project and the +links will work as expected when you publish them to HTML. If you also +publish the Org source file and want to link to it, use an `http:' link +instead of a `file:' link, because `file:' links are converted to link +to the corresponding `html' file. + + You may also link to related files, such as images. Provided you +are careful with relative file names, and provided you have also +configured Org to upload the related files, these links will work too. +See *note Complex example::, for an example of this usage. + + +File: org, Node: Sitemap, Next: Generating an index, Prev: Publishing links, Up: Configuration + +13.1.7 Generating a sitemap +--------------------------- + +The following properties may be used to control publishing of a map of +files for a given project. + +`:auto-sitemap' When non-`nil', publish a sitemap during + `org-publish-current-project' or + `org-publish-all'. +`:sitemap-filename' Filename for output of sitemap. Defaults to + `sitemap.org' (which becomes `sitemap.html'). +`:sitemap-title' Title of sitemap page. Defaults to name of + file. +`:sitemap-function' Plug-in function to use for generation of the + sitemap. Defaults to + `org-publish-org-sitemap', which generates a + plain list of links to all files in the + project. +`:sitemap-sort-folders' Where folders should appear in the sitemap. + Set this to `first' (default) or `last' to + display folders first or last, respectively. + Any other value will mix files and folders. +`:sitemap-sort-files' How the files are sorted in the site map. Set + this to `alphabetically' (default), + `chronologically' or `anti-chronologically'. + `chronologically' sorts the files with older + date first while `anti-chronologically' sorts + the files with newer date first. + `alphabetically' sorts the files + alphabetically. The date of a file is + retrieved with `org-publish-find-date'. +`:sitemap-ignore-case' Should sorting be case-sensitive? Default + `nil'. +`:sitemap-file-entry-format'With this option one can tell how a sitemap's + entry is formatted in the sitemap. This is a + format string with some escape sequences: `%t' + stands for the title of the file, `%a' stands + for the author of the file and `%d' stands for + the date of the file. The date is retrieved + with the `org-publish-find-date' function and + formatted with + `org-publish-sitemap-date-format'. Default + `%t'. +`:sitemap-date-format' Format string for the `format-time-string' + function that tells how a sitemap entry's date + is to be formatted. This property bypasses + `org-publish-sitemap-date-format' which + defaults to `%Y-%m-%d'. +`:sitemap-sans-extension' When non-`nil', remove filenames' extensions + from the generated sitemap. Useful to have + cool URIs (see + `http://www.w3.org/Provider/Style/URI'). + Defaults to `nil'. + + +File: org, Node: Generating an index, Prev: Sitemap, Up: Configuration + +13.1.8 Generating an index +-------------------------- + +Org mode can generate an index across the files of a publishing project. + +`:makeindex' When non-`nil', generate in index in the file + `theindex.org' and publish it as `theindex.html'. + + The file will be created when first publishing a project with the +`:makeindex' set. The file only contains a statement `#+INCLUDE: +"theindex.inc"'. You can then build around this include statement by +adding a title, style information, etc. + + +File: org, Node: Uploading files, Next: Sample configuration, Prev: Configuration, Up: Publishing + +13.2 Uploading files +==================== + +For those people already utilizing third party sync tools such as +`rsync' or `unison', it might be preferable not to use the built in +remote publishing facilities of Org mode which rely heavily on Tramp. +Tramp, while very useful and powerful, tends not to be so efficient for +multiple file transfer and has been known to cause problems under heavy +usage. + + Specialized synchronization utilities offer several advantages. In +addition to timestamp comparison, they also do content and +permissions/attribute checks. For this reason you might prefer to +publish your web to a local directory (possibly even in place with your +Org files) and then use `unison' or `rsync' to do the synchronization +with the remote host. + + Since Unison (for example) can be configured as to which files to +transfer to a certain remote destination, it can greatly simplify the +project publishing definition. Simply keep all files in the correct +location, process your Org files with `org-publish' and let the +synchronization tool do the rest. You do not need, in this scenario, +to include attachments such as `jpg', `css' or `gif' files in the +project definition since the 3rd party tool syncs them. + + Publishing to a local directory is also much faster than to a remote +one, so that you can afford more easily to republish entire projects. +If you set `org-publish-use-timestamps-flag' to `nil', you gain the main +benefit of re-including any changed external files such as source +example files you might include with `#+INCLUDE:'. The timestamp +mechanism in Org is not smart enough to detect if included files have +been modified. + + +File: org, Node: Sample configuration, Next: Triggering publication, Prev: Uploading files, Up: Publishing + +13.3 Sample configuration +========================= + +Below we provide two example configurations. The first one is a simple +project publishing only a set of Org files. The second example is more +complex, with a multi-component project. + +* Menu: + +* Simple example:: One-component publishing +* Complex example:: A multi-component publishing example + + +File: org, Node: Simple example, Next: Complex example, Prev: Sample configuration, Up: Sample configuration + +13.3.1 Example: simple publishing configuration +----------------------------------------------- + +This example publishes a set of Org files to the `public_html' +directory on the local machine. + + (setq org-publish-project-alist + '(("org" + :base-directory "~/org/" + :publishing-directory "~/public_html" + :section-numbers nil + :with-toc nil + :html-head ""))) + + +File: org, Node: Complex example, Prev: Simple example, Up: Sample configuration + +13.3.2 Example: complex publishing configuration +------------------------------------------------ + +This more complicated example publishes an entire website, including +Org files converted to HTML, image files, Emacs Lisp source code, and +style sheets. The publishing directory is remote and private files are +excluded. + + To ensure that links are preserved, care should be taken to replicate +your directory structure on the web server, and to use relative file +paths. For example, if your Org files are kept in `~/org' and your +publishable images in `~/images', you would link to an image with + file:../images/myimage.png + On the web server, the relative path to the image should be the +same. You can accomplish this by setting up an "images" folder in the +right place on the web server, and publishing images to it. + + (setq org-publish-project-alist + '(("orgfiles" + :base-directory "~/org/" + :base-extension "org" + :publishing-directory "/ssh:user@host:~/html/notebook/" + :publishing-function org-html-publish-to-html + :exclude "PrivatePage.org" ;; regexp + :headline-levels 3 + :section-numbers nil + :with-toc nil + :html-head "" + :html-preamble t) + + ("images" + :base-directory "~/images/" + :base-extension "jpg\\|gif\\|png" + :publishing-directory "/ssh:user@host:~/html/images/" + :publishing-function org-publish-attachment) + + ("other" + :base-directory "~/other/" + :base-extension "css\\|el" + :publishing-directory "/ssh:user@host:~/html/other/" + :publishing-function org-publish-attachment) + ("website" :components ("orgfiles" "images" "other")))) + + +File: org, Node: Triggering publication, Prev: Sample configuration, Up: Publishing + +13.4 Triggering publication +=========================== + +Once properly configured, Org can publish with the following commands: + +`C-c C-e P x (`org-publish')' + Prompt for a specific project and publish all files that belong to + it. + +`C-c C-e P p (`org-publish-current-project')' + Publish the project containing the current file. + +`C-c C-e P f (`org-publish-current-file')' + Publish only the current file. + +`C-c C-e P a (`org-publish-all')' + Publish every project. + + Org uses timestamps to track when a file has changed. The above +functions normally only publish changed files. You can override this +and force publishing of all files by giving a prefix argument to any of +the commands above, or by customizing the variable +`org-publish-use-timestamps-flag'. This may be necessary in particular +if files include other files via `#+SETUPFILE:' or `#+INCLUDE:'. + + +File: org, Node: Working With Source Code, Next: Miscellaneous, Prev: Publishing, Up: Top + +14 Working with source code +*************************** + +Source code can be included in Org mode documents using a `src' block, +e.g.: + + #+BEGIN_SRC emacs-lisp + (defun org-xor (a b) + "Exclusive or." + (if a (not b) b)) + #+END_SRC + + Org mode provides a number of features for working with live source +code, including editing of code blocks in their native major-mode, +evaluation of code blocks, converting code blocks into source files +(known as "tangling" in literate programming), and exporting code +blocks and their results in several formats. This functionality was +contributed by Eric Schulte and Dan Davison, and was originally named +Org-babel. + + The following sections describe Org mode's code block handling +facilities. + +* Menu: + +* Structure of code blocks:: Code block syntax described +* Editing source code:: Language major-mode editing +* Exporting code blocks:: Export contents and/or results +* Extracting source code:: Create pure source code files +* Evaluating code blocks:: Place results of evaluation in the Org mode buffer +* Library of Babel:: Use and contribute to a library of useful code blocks +* Languages:: List of supported code block languages +* Header arguments:: Configure code block functionality +* Results of evaluation:: How evaluation results are handled +* Noweb reference syntax:: Literate programming in Org mode +* Key bindings and useful functions:: Work quickly with code blocks +* Batch execution:: Call functions from the command line + + +File: org, Node: Structure of code blocks, Next: Editing source code, Prev: Working With Source Code, Up: Working With Source Code + +14.1 Structure of code blocks +============================= + +Live code blocks can be specified with a `src' block or inline.(1) The +structure of a `src' block is + + #+NAME: + #+BEGIN_SRC
+ + #+END_SRC + + The `#+NAME:' line is optional, and can be used to name the code +block. Live code blocks require that a language be specified on the +`#+BEGIN_SRC' line. Switches and header arguments are optional. + + Live code blocks can also be specified inline using + + src_{} + + or + + src_[
]{} + +`<#+NAME: name>' + This line associates a name with the code block. This is similar + to the `#+NAME: Name' lines that can be used to name tables in Org + mode files. Referencing the name of a code block makes it + possible to evaluate the block from other places in the file, from + other files, or from Org mode table formulas (see *note The + spreadsheet::). Names are assumed to be unique and the behavior + of Org mode when two or more blocks share the same name is + undefined. + +`' + The language of the code in the block (see *note Languages::). + +`' + Optional switches control code block export (see the discussion of + switches in *note Literal examples::) + +`
' + Optional header arguments control many aspects of evaluation, + export and tangling of code blocks (see *note Header arguments::). + Header arguments can also be set on a per-buffer or per-subtree + basis using properties. + +`source code, header arguments' + +`' + Source code in the specified language. + + ---------- Footnotes ---------- + + (1) Note that `src' blocks may be inserted using Org mode's *note +Easy Templates:: system + + +File: org, Node: Editing source code, Next: Exporting code blocks, Prev: Structure of code blocks, Up: Working With Source Code + +14.2 Editing source code +======================== + +Use `C-c '' to edit the current code block. This brings up a language +major-mode edit buffer containing the body of the code block. Manually +saving this buffer with will write the contents back to the +Org buffer. You can also set `org-edit-src-auto-save-idle-delay' to +save the base buffer after some idle delay, or +`org-edit-src-turn-on-auto-save' to auto-save this buffer into a +separate file using `auto-save-mode'. Use `C-c '' again to exit. + + The `org-src-mode' minor mode will be active in the edit buffer. The +following variables can be used to configure the behavior of the edit +buffer. See also the customization group `org-edit-structure' for +further configuration options. + +`org-src-lang-modes' + If an Emacs major-mode named `-mode' exists, where `' + is the language named in the header line of the code block, then + the edit buffer will be placed in that major-mode. This variable + can be used to map arbitrary language names to existing major + modes. + +`org-src-window-setup' + Controls the way Emacs windows are rearranged when the edit buffer + is created. + +`org-src-preserve-indentation' + By default, the value is `nil', which means that when code blocks + are evaluated during export or tangled, they are re-inserted into + the code block, which may replace sequences of spaces with tab + characters. When non-nil, whitespace in code blocks will be + preserved during export or tangling, exactly as it appears. This + variable is especially useful for tangling languages such as + Python, in which whitespace indentation in the output is critical. + +`org-src-ask-before-returning-to-edit-buffer' + By default, Org will ask before returning to an open edit buffer. + Set this variable to `nil' to switch without asking. + + To turn on native code fontification in the _Org_ buffer, configure +the variable `org-src-fontify-natively'. + + +File: org, Node: Exporting code blocks, Next: Extracting source code, Prev: Editing source code, Up: Working With Source Code + +14.3 Exporting code blocks +========================== + +It is possible to export the _code_ of code blocks, the _results_ of +code block evaluation, _both_ the code and the results of code block +evaluation, or _none_. For most languages, the default exports code. +However, for some languages (e.g., `ditaa') the default exports the +results of code block evaluation. For information on exporting code +block bodies, see *note Literal examples::. + + The `:exports' header argument can be used to specify export +behavior: + +Header arguments: +................. + +`:exports code' + The default in most languages. The body of the code block is + exported, as described in *note Literal examples::. + +`:exports results' + The code block will be evaluated and the results will be placed in + the Org mode buffer for export, either updating previous results + of the code block located anywhere in the buffer or, if no + previous results exist, placing the results immediately after the + code block. The body of the code block will not be exported. + +`:exports both' + Both the code block and its results will be exported. + +`:exports none' + Neither the code block nor its results will be exported. + + It is possible to inhibit the evaluation of code blocks during +export. Setting the `org-export-babel-evaluate' variable to `nil' will +ensure that no code blocks are evaluated as part of the export process. +This can be useful in situations where potentially untrusted Org mode +files are exported in an automated fashion, for example when Org mode +is used as the markup language for a wiki. It is also possible to set +this variable to `'inline-only'. In that case, only inline code blocks +will be evaluated, in order to insert their results. Non-inline code +blocks are assumed to have their results already inserted in the buffer +by manual evaluation. This setting is useful to avoid expensive +recalculations during export, not to provide security. + + +File: org, Node: Extracting source code, Next: Evaluating code blocks, Prev: Exporting code blocks, Up: Working With Source Code + +14.4 Extracting source code +=========================== + +Creating pure source code files by extracting code from source blocks is +referred to as "tangling"--a term adopted from the literate programming +community. During "tangling" of code blocks their bodies are expanded +using `org-babel-expand-src-block' which can expand both variable and +"noweb" style references (see *note Noweb reference syntax::). + +Header arguments +................ + +`:tangle no' + The default. The code block is not included in the tangled output. + +`:tangle yes' + Include the code block in the tangled output. The output file + name is the name of the org file with the extension `.org' + replaced by the extension for the block language. + +`:tangle filename' + Include the code block in the tangled output to file `filename'. + +Functions +......... + +`org-babel-tangle' + Tangle the current file. Bound to `C-c C-v t'. + + With prefix argument only tangle the current code block. + +`org-babel-tangle-file' + Choose a file to tangle. Bound to `C-c C-v f'. + +Hooks +..... + +`org-babel-post-tangle-hook' + This hook is run from within code files tangled by + `org-babel-tangle'. Example applications could include + post-processing, compilation or evaluation of tangled code files. + +Jumping between code and Org +............................ + +When tangling code from an Org-mode buffer to a source code file, you'll +frequently find yourself viewing the file of tangled source code (e.g., +many debuggers point to lines of the source code file). It is useful +to be able to navigate from the tangled source to the Org-mode buffer +from which the code originated. + + The `org-babel-tangle-jump-to-org' function provides this jumping +from code to Org-mode functionality. Two header arguments are required +for jumping to work, first the `padline' (*note padline::) option must +be set to true (the default setting), second the `comments' (*note +comments::) header argument must be set to `links', which will insert +comments into the source code buffer which point back to the original +Org-mode file. + + +File: org, Node: Evaluating code blocks, Next: Library of Babel, Prev: Extracting source code, Up: Working With Source Code + +14.5 Evaluating code blocks +=========================== + +Code blocks can be evaluated(1) and the results of evaluation +optionally placed in the Org mode buffer. The results of evaluation +are placed following a line that begins by default with `#+RESULTS' and +optionally a cache identifier and/or the name of the evaluated code +block. The default value of `#+RESULTS' can be changed with the +customizable variable `org-babel-results-keyword'. + + By default, the evaluation facility is only enabled for Lisp code +blocks specified as `emacs-lisp'. However, source code blocks in many +languages can be evaluated within Org mode (see *note Languages:: for a +list of supported languages and *note Structure of code blocks:: for +information on the syntax used to define a code block). + + There are a number of ways to evaluate code blocks. The simplest is +to press `C-c C-c' or `C-c C-v e' with the point on a code block(2). +This will call the `org-babel-execute-src-block' function to evaluate +the block and insert its results into the Org mode buffer. + + It is also possible to evaluate named code blocks from anywhere in +an Org mode buffer or an Org mode table. Live code blocks located in +the current Org mode buffer or in the "Library of Babel" (see *note +Library of Babel::) can be executed. Named code blocks can be executed +with a separate `#+CALL:' line or inline within a block of text. + + The syntax of the `#+CALL:' line is + + #+CALL: () + #+CALL: []() + + The syntax for inline evaluation of named code blocks is + + ... call_() ... + ... call_[]()[] ... + +`' + The name of the code block to be evaluated (see *note Structure of + code blocks::). + +`' + Arguments specified in this section will be passed to the code + block. These arguments use standard function call syntax, rather + than header argument syntax. For example, a `#+CALL:' line that + passes the number four to a code block named `double', which + declares the header argument `:var n=2', would be written as + `#+CALL: double(n=4)'. + +`' + Inside header arguments are passed through and applied to the + named code block. These arguments use header argument syntax + rather than standard function call syntax. Inside header + arguments affect how the code block is evaluated. For example, + `[:results output]' will collect the results of everything printed + to `STDOUT' during execution of the code block. + +`' + End header arguments are applied to the calling instance and do + not affect evaluation of the named code block. They affect how + the results are incorporated into the Org mode buffer and how the + call line is exported. For example, `:results html' will insert + the results of the call line evaluation in the Org buffer, wrapped + in a `BEGIN_HTML:' block. + + For more examples of passing header arguments to `#+CALL:' lines + see *note Header arguments in function calls::. + + ---------- Footnotes ---------- + + (1) Whenever code is evaluated there is a potential for that code to +do harm. Org mode provides safeguards to ensure that code is only +evaluated after explicit confirmation from the user. For information +on these safeguards (and on how to disable them) see *note Code +evaluation security::. + + (2) The option `org-babel-no-eval-on-ctrl-c-ctrl-c' can be used to +remove code evaluation from the `C-c C-c' key binding. + + +File: org, Node: Library of Babel, Next: Languages, Prev: Evaluating code blocks, Up: Working With Source Code + +14.6 Library of Babel +===================== + +The "Library of Babel" consists of code blocks that can be called from +any Org mode file. Code blocks defined in the "Library of Babel" can +be called remotely as if they were in the current Org mode buffer (see +*note Evaluating code blocks:: for information on the syntax of remote +code block evaluation). + + The central repository of code blocks in the "Library of Babel" is +housed in an Org mode file located in the `contrib' directory of Org +mode. + + Users can add code blocks they believe to be generally useful to +their "Library of Babel." The code blocks can be stored in any Org +mode file and then loaded into the library with `org-babel-lob-ingest'. + + Code blocks located in any Org mode file can be loaded into the +"Library of Babel" with the `org-babel-lob-ingest' function, bound to +`C-c C-v i'. + + +File: org, Node: Languages, Next: Header arguments, Prev: Library of Babel, Up: Working With Source Code + +14.7 Languages +============== + +Code blocks in the following languages are supported. + +Language Identifier Language Identifier +Asymptote asymptote Awk awk +Emacs Calc calc C C +C++ C++ Clojure clojure +CSS css ditaa ditaa +Graphviz dot Emacs Lisp emacs-lisp +gnuplot gnuplot Haskell haskell +Java java +Javascript js LaTeX latex +Ledger ledger Lisp lisp +Lilypond lilypond MATLAB matlab +Mscgen mscgen Objective Caml ocaml +Octave octave Org mode org +Oz oz Perl perl +Plantuml plantuml Python python +R R Ruby ruby +Sass sass Scheme scheme +GNU Screen screen shell sh +SQL sql SQLite sqlite + + Language-specific documentation is available for some languages. If +available, it can be found at +`http://orgmode.org/worg/org-contrib/babel/languages.html'. + + The option `org-babel-load-languages' controls which languages are +enabled for evaluation (by default only `emacs-lisp' is enabled). This +variable can be set using the customization interface or by adding code +like the following to your emacs configuration. + + The following disables `emacs-lisp' evaluation and enables + evaluation of `R' code blocks. + + (org-babel-do-load-languages + 'org-babel-load-languages + '((emacs-lisp . nil) + (R . t))) + + It is also possible to enable support for a language by loading the +related elisp file with `require'. + + The following adds support for evaluating `clojure' code blocks. + + (require 'ob-clojure) + + +File: org, Node: Header arguments, Next: Results of evaluation, Prev: Languages, Up: Working With Source Code + +14.8 Header arguments +===================== + +Code block functionality can be configured with header arguments. This +section provides an overview of the use of header arguments, and then +describes each header argument in detail. + +* Menu: + +* Using header arguments:: Different ways to set header arguments +* Specific header arguments:: List of header arguments + + +File: org, Node: Using header arguments, Next: Specific header arguments, Prev: Header arguments, Up: Header arguments + +14.8.1 Using header arguments +----------------------------- + +The values of header arguments can be set in several way. When the +header arguments in each layer have been determined, they are combined +in order from the first, least specific (having the lowest priority) up +to the last, most specific (having the highest priority). A header +argument with a higher priority replaces the same header argument +specified at lower priority. + +* Menu: + +* System-wide header arguments:: Set global default values +* Language-specific header arguments:: Set default values by language +* Header arguments in Org mode properties:: Set default values for a buffer or heading +* Language-specific header arguments in Org mode properties:: Set language-specific default values for a buffer or heading +* Code block specific header arguments:: The most common way to set values +* Header arguments in function calls:: The most specific level + + +File: org, Node: System-wide header arguments, Next: Language-specific header arguments, Prev: Using header arguments, Up: Using header arguments + +System-wide header arguments +............................ + +System-wide values of header arguments can be specified by adapting the +`org-babel-default-header-args' variable: + + :session => "none" + :results => "replace" + :exports => "code" + :cache => "no" + :noweb => "no" + + For example, the following example could be used to set the default +value of `:noweb' header arguments to `yes'. This would have the +effect of expanding `:noweb' references by default when evaluating +source code blocks. + + (setq org-babel-default-header-args + (cons '(:noweb . "yes") + (assq-delete-all :noweb org-babel-default-header-args))) + + +File: org, Node: Language-specific header arguments, Next: Header arguments in Org mode properties, Prev: System-wide header arguments, Up: Using header arguments + +Language-specific header arguments +.................................. + +Each language can define its own set of default header arguments in +variable `org-babel-default-header-args:', where `' is the +name of the language. See the language-specific documentation +available online at `http://orgmode.org/worg/org-contrib/babel'. + + +File: org, Node: Header arguments in Org mode properties, Next: Language-specific header arguments in Org mode properties, Prev: Language-specific header arguments, Up: Using header arguments + +Header arguments in Org mode properties +....................................... + +Buffer-wide header arguments may be specified as properties through the +use of `#+PROPERTY:' lines placed anywhere in an Org mode file (see +*note Property syntax::). + + For example the following would set `session' to `*R*' (only for R +code blocks), and `results' to `silent' for every code block in the +buffer, ensuring that all execution took place in the same session, and +no results would be inserted into the buffer. + + #+PROPERTY: header-args:R :session *R* + #+PROPERTY: header-args :results silent + + Header arguments read from Org mode properties can also be set on a +per-subtree basis using property drawers (see *note Property syntax::). When +properties are used to set default header arguments, they are always +looked up with inheritance, regardless of the value of +`org-use-property-inheritance'. Properties are evaluated as seen by the +outermost call or source block.(1) + + In the following example the value of the `:cache' header argument +will default to `yes' in all code blocks in the subtree rooted at the +following heading: + + * outline header + :PROPERTIES: + :header-args: :cache yes + :END: + + Properties defined in this way override the properties set in +`org-babel-default-header-args' and are applied for all activated +languages. It is convenient to use the `org-set-property' function +bound to `C-c C-x p' to set properties in Org mode documents. + + ---------- Footnotes ---------- + + (1) The deprecated syntax for default header argument properties, +using the name of the header argument as a property name directly, +evaluates the property as seen by the corresponding source block +definition. This behavior has been kept for backwards compatibility. + + +File: org, Node: Language-specific header arguments in Org mode properties, Next: Code block specific header arguments, Prev: Header arguments in Org mode properties, Up: Using header arguments + +Language-specific header arguments in Org mode properties +......................................................... + +Language-specific header arguments are also read from properties +`header-args:' where `' is the name of the language +targeted. As an example + + * Heading + :PROPERTIES: + :header-args:clojure: :session *clojure-1* + :header-args:R: :session *R* + :END: + ** Subheading + :PROPERTIES: + :header-args:clojure: :session *clojure-2* + :END: + + would independently set a default session header argument for R and +clojure for calls and source blocks under subtree "Heading" and change +to a different clojure setting for evaluations under subtree +"Subheading", while the R session is inherited from "Heading" and +therefore unchanged. + + +File: org, Node: Code block specific header arguments, Next: Header arguments in function calls, Prev: Language-specific header arguments in Org mode properties, Up: Using header arguments + +Code block specific header arguments +.................................... + +The most common way to assign values to header arguments is at the code +block level. This can be done by listing a sequence of header +arguments and their values as part of the `#+BEGIN_SRC' line. +Properties set in this way override both the values of +`org-babel-default-header-args' and header arguments specified as +properties. In the following example, the `:results' header argument +is set to `silent', meaning the results of execution will not be +inserted in the buffer, and the `:exports' header argument is set to +`code', meaning only the body of the code block will be preserved on +export to HTML or LaTeX. + + #+NAME: factorial + #+BEGIN_SRC haskell :results silent :exports code :var n=0 + fac 0 = 1 + fac n = n * fac (n-1) + #+END_SRC + Similarly, it is possible to set header arguments for inline code +blocks + + src_haskell[:exports both]{fac 5} + + Code block header arguments can span multiple lines using +`#+HEADER:' or `#+HEADERS:' lines preceding a code block or nested +between the `#+NAME:' line and the `#+BEGIN_SRC' line of a named code +block. + + Multi-line header arguments on an un-named code block: + + #+HEADERS: :var data1=1 + #+BEGIN_SRC emacs-lisp :var data2=2 + (message "data1:%S, data2:%S" data1 data2) + #+END_SRC + + #+RESULTS: + : data1:1, data2:2 + + Multi-line header arguments on a named code block: + + #+NAME: named-block + #+HEADER: :var data=2 + #+BEGIN_SRC emacs-lisp + (message "data:%S" data) + #+END_SRC + + #+RESULTS: named-block + : data:2 + + +File: org, Node: Header arguments in function calls, Prev: Code block specific header arguments, Up: Using header arguments + +Header arguments in function calls +.................................. + +At the most specific level, header arguments for "Library of Babel" or +`#+CALL:' lines can be set as shown in the two examples below. For more +information on the structure of `#+CALL:' lines see *note Evaluating +code blocks::. + + The following will apply the `:exports results' header argument to +the evaluation of the `#+CALL:' line. + + #+CALL: factorial(n=5) :exports results + + The following will apply the `:session special' header argument to +the evaluation of the `factorial' code block. + + #+CALL: factorial[:session special](n=5) + + +File: org, Node: Specific header arguments, Prev: Using header arguments, Up: Header arguments + +14.8.2 Specific header arguments +-------------------------------- + +Header arguments consist of an initial colon followed by the name of the +argument in lowercase letters. The following header arguments are +defined: + +* Menu: + +* var:: Pass arguments to code blocks +* results:: Specify the type of results and how they will + be collected and handled +* file:: Specify a path for file output +* file-desc:: Specify a description for file results +* dir:: Specify the default (possibly remote) + directory for code block execution +* exports:: Export code and/or results +* tangle:: Toggle tangling and specify file name +* mkdirp:: Toggle creation of parent directories of target + files during tangling +* comments:: Toggle insertion of comments in tangled + code files +* padline:: Control insertion of padding lines in tangled + code files +* no-expand:: Turn off variable assignment and noweb + expansion during tangling +* session:: Preserve the state of code evaluation +* noweb:: Toggle expansion of noweb references +* noweb-ref:: Specify block's noweb reference resolution target +* noweb-sep:: String used to separate noweb references +* cache:: Avoid re-evaluating unchanged code blocks +* sep:: Delimiter for writing tabular results outside Org +* hlines:: Handle horizontal lines in tables +* colnames:: Handle column names in tables +* rownames:: Handle row names in tables +* shebang:: Make tangled files executable +* tangle-mode:: Set permission of tangled files +* eval:: Limit evaluation of specific code blocks +* wrap:: Mark source block evaluation results +* post:: Post processing of code block results +* prologue:: Text to prepend to code block body +* epilogue:: Text to append to code block body + + Additional header arguments are defined on a language-specific +basis, see *note Languages::. + + +File: org, Node: var, Next: results, Prev: Specific header arguments, Up: Specific header arguments + +14.8.2.1 `:var' +............... + +The `:var' header argument is used to pass arguments to code blocks. +The specifics of how arguments are included in a code block vary by +language; these are addressed in the language-specific documentation. +However, the syntax used to specify arguments is the same across all +languages. In every case, variables require a default value when they +are declared. + + The values passed to arguments can either be literal values, +references, or Emacs Lisp code (see *note Emacs Lisp evaluation of +variables: var.). References include anything in the Org mode file +that takes a `#+NAME:' or `#+RESULTS:' line: tables, lists, +`#+BEGIN_EXAMPLE' blocks, other code blocks and the results of other +code blocks. + + Note: When a reference is made to another code block, the referenced +block will be evaluated unless it has current cached results (see *note +cache::). + + Argument values can be indexed in a manner similar to arrays (see +*note Indexable variable values: var.). + + The following syntax is used to pass arguments to code blocks using +the `:var' header argument. + + :var name=assign + + The argument, `assign', can either be a literal value, such as a +string `"string"' or a number `9', or a reference to a table, a list, a +literal example, another code block (with or without arguments), or the +results of evaluating another code block. + + Here are examples of passing values by reference: + +"table" + an Org mode table named with either a `#+NAME:' line + + #+NAME: example-table + | 1 | + | 2 | + | 3 | + | 4 | + + #+NAME: table-length + #+BEGIN_SRC emacs-lisp :var table=example-table + (length table) + #+END_SRC + + #+RESULTS: table-length + : 4 + +"list" + a simple list named with a `#+NAME:' line (note that nesting is not + carried through to the source code block) + + #+NAME: example-list + - simple + - not + - nested + - list + + #+BEGIN_SRC emacs-lisp :var x=example-list + (print x) + #+END_SRC + + #+RESULTS: + | simple | list | + +"code block without arguments" + a code block name (from the example above), as assigned by + `#+NAME:', optionally followed by parentheses + + #+BEGIN_SRC emacs-lisp :var length=table-length() + (* 2 length) + #+END_SRC + + #+RESULTS: + : 8 + +"code block with arguments" + a code block name, as assigned by `#+NAME:', followed by + parentheses and optional arguments passed within the parentheses + following the code block name using standard function call syntax + + #+NAME: double + #+BEGIN_SRC emacs-lisp :var input=8 + (* 2 input) + #+END_SRC + + #+RESULTS: double + : 16 + + #+NAME: squared + #+BEGIN_SRC emacs-lisp :var input=double(input=1) + (* input input) + #+END_SRC + + #+RESULTS: squared + : 4 + +"literal example" + a literal example block named with a `#+NAME:' line + + #+NAME: literal-example + #+BEGIN_EXAMPLE + A literal example + on two lines + #+END_EXAMPLE + + #+NAME: read-literal-example + #+BEGIN_SRC emacs-lisp :var x=literal-example + (concatenate 'string x " for you.") + #+END_SRC + + #+RESULTS: read-literal-example + : A literal example + : on two lines for you. + + +Indexable variable values +......................... + +It is possible to reference portions of variable values by "indexing" +into the variables. Indexes are 0 based with negative values counting +back from the end. If an index is separated by `,'s then each +subsequent section will index into the next deepest nesting or +dimension of the value. Note that this indexing occurs _before_ other +table related header arguments like `:hlines', `:colnames' and +`:rownames' are applied. The following example assigns the last cell +of the first row the table `example-table' to the variable `data': + + #+NAME: example-table + | 1 | a | + | 2 | b | + | 3 | c | + | 4 | d | + + #+BEGIN_SRC emacs-lisp :var data=example-table[0,-1] + data + #+END_SRC + + #+RESULTS: + : a + + Ranges of variable values can be referenced using two integers +separated by a `:', in which case the entire inclusive range is +referenced. For example the following assigns the middle three rows of +`example-table' to `data'. + + #+NAME: example-table + | 1 | a | + | 2 | b | + | 3 | c | + | 4 | d | + | 5 | 3 | + + #+BEGIN_SRC emacs-lisp :var data=example-table[1:3] + data + #+END_SRC + + #+RESULTS: + | 2 | b | + | 3 | c | + | 4 | d | + + Additionally, an empty index, or the single character `*', are both +interpreted to mean the entire range and as such are equivalent to +`0:-1', as shown in the following example in which the entire first +column is referenced. + + #+NAME: example-table + | 1 | a | + | 2 | b | + | 3 | c | + | 4 | d | + + #+BEGIN_SRC emacs-lisp :var data=example-table[,0] + data + #+END_SRC + + #+RESULTS: + | 1 | 2 | 3 | 4 | + + It is possible to index into the results of code blocks as well as +tables. Any number of dimensions can be indexed. Dimensions are +separated from one another by commas, as shown in the following example. + + #+NAME: 3D + #+BEGIN_SRC emacs-lisp + '(((1 2 3) (4 5 6) (7 8 9)) + ((10 11 12) (13 14 15) (16 17 18)) + ((19 20 21) (22 23 24) (25 26 27))) + #+END_SRC + + #+BEGIN_SRC emacs-lisp :var data=3D[1,,1] + data + #+END_SRC + + #+RESULTS: + | 11 | 14 | 17 | + +Emacs Lisp evaluation of variables +.................................. + +Emacs lisp code can be used to initialize variable values. When a +variable value starts with `(', `[', `'' or ``' it will be evaluated as +Emacs Lisp and the result of the evaluation will be assigned as the +variable value. The following example demonstrates use of this +evaluation to reliably pass the file-name of the Org mode buffer to a +code block--note that evaluation of header arguments is guaranteed to +take place in the original Org mode file, while there is no such +guarantee for evaluation of the code block body. + + #+BEGIN_SRC sh :var filename=(buffer-file-name) :exports both + wc -w $filename + #+END_SRC + + Note that values read from tables and lists will not be evaluated as +Emacs Lisp, as shown in the following example. + + #+NAME: table + | (a b c) | + + #+HEADERS: :var data=table[0,0] + #+BEGIN_SRC perl + $data + #+END_SRC + + #+RESULTS: + : (a b c) + + +File: org, Node: results, Next: file, Prev: var, Up: Specific header arguments + +14.8.2.2 `:results' +................... + +There are four classes of `:results' header argument. Only one option +per class may be supplied per code block. + + * collection header arguments specify how the results should be + collected from the code block + + * type header arguments specify what type of result the code block + will return--which has implications for how they will be processed + before insertion into the Org mode buffer + + * format header arguments specify what type of result the code block + will return--which has implications for how they will be inserted + into the Org mode buffer + + * handling header arguments specify how the results of evaluating + the code block should be handled. + +Collection +.......... + +The following options are mutually exclusive, and specify how the +results should be collected from the code block. + + * `value' This is the default. The result is the value of the last + statement in the code block. This header argument places the + evaluation in functional mode. Note that in some languages, e.g., + Python, use of this result type requires that a `return' statement + be included in the body of the source code block. E.g., `:results + value'. + + * `output' The result is the collection of everything printed to + STDOUT during the execution of the code block. This header + argument places the evaluation in scripting mode. E.g., `:results + output'. + +Type +.... + +The following options are mutually exclusive and specify what type of +results the code block will return. By default, results are inserted +as either a table or scalar depending on their value. + + * `table', `vector' The results should be interpreted as an Org mode + table. If a single value is returned, it will be converted into a + table with one row and one column. E.g., `:results value table'. + + * `list' The results should be interpreted as an Org mode list. If + a single scalar value is returned it will be converted into a list + with only one element. + + * `scalar', `verbatim' The results should be interpreted + literally--they will not be converted into a table. The results + will be inserted into the Org mode buffer as quoted text. E.g., + `:results value verbatim'. + + * `file' The results will be interpreted as the path to a file, and + will be inserted into the Org mode buffer as a file link. E.g., + `:results value file'. + +Format +...... + +The following options are mutually exclusive and specify what type of +results the code block will return. By default, results are inserted +according to the type as specified above. + + * `raw' The results are interpreted as raw Org mode code and are + inserted directly into the buffer. If the results look like a + table they will be aligned as such by Org mode. E.g., `:results + value raw'. + + * `org' The results are will be enclosed in a `BEGIN_SRC org' block. + They are not comma-escaped by default but they will be if you hit + `TAB' in the block and/or if you export the file. E.g., `:results + value org'. + + * `html' Results are assumed to be HTML and will be enclosed in a + `BEGIN_HTML' block. E.g., `:results value html'. + + * `latex' Results assumed to be LaTeX and are enclosed in a + `BEGIN_LaTeX' block. E.g., `:results value latex'. + + * `code' Result are assumed to be parsable code and are enclosed in + a code block. E.g., `:results value code'. + + * `pp' The result is converted to pretty-printed code and is + enclosed in a code block. This option currently supports Emacs + Lisp, Python, and Ruby. E.g., `:results value pp'. + + * `drawer' The result is wrapped in a RESULTS drawer. This can be + useful for inserting `raw' or `org' syntax results in such a way + that their extent is known and they can be automatically removed + or replaced. + +Handling +........ + +The following results options indicate what happens with the results +once they are collected. + + * `silent' The results will be echoed in the minibuffer but will not + be inserted into the Org mode buffer. E.g., `:results output + silent'. + + * `replace' The default value. Any existing results will be + removed, and the new results will be inserted into the Org mode + buffer in their place. E.g., `:results output replace'. + + * `append' If there are pre-existing results of the code block then + the new results will be appended to the existing results. + Otherwise the new results will be inserted as with `replace'. + + * `prepend' If there are pre-existing results of the code block then + the new results will be prepended to the existing results. + Otherwise the new results will be inserted as with `replace'. + + +File: org, Node: file, Next: file-desc, Prev: results, Up: Specific header arguments + +14.8.2.3 `:file' +................ + +The header argument `:file' is used to specify an external file in which +to save code block results. After code block evaluation an Org mode +style `[[file:]]' link (see *note Link format::) to the file will be +inserted into the Org mode buffer. Some languages including R, +gnuplot, dot, and ditaa provide special handling of the `:file' header +argument automatically wrapping the code block body in the boilerplate +code required to save output to the specified file. This is often +useful for saving graphical output of a code block to the specified +file. + + The argument to `:file' should be either a string specifying the +path to a file, or a list of two strings in which case the first +element of the list should be the path to a file and the second a +description for the link. + + +File: org, Node: file-desc, Next: dir, Prev: file, Up: Specific header arguments + +14.8.2.4 `:file-desc' +..................... + +The value of the `:file-desc' header argument is used to provide a +description for file code block results which are inserted as Org mode +links (see *note Link format::). If the `:file-desc' header argument +is given with no value the link path will be placed in both the "link" +and the "description" portion of the Org mode link. + + +File: org, Node: dir, Next: exports, Prev: file-desc, Up: Specific header arguments + +14.8.2.5 `:dir' and remote execution +.................................... + +While the `:file' header argument can be used to specify the path to the +output file, `:dir' specifies the default directory during code block +execution. If it is absent, then the directory associated with the +current buffer is used. In other words, supplying `:dir path' +temporarily has the same effect as changing the current directory with +`M-x cd path RET', and then not supplying `:dir'. Under the surface, +`:dir' simply sets the value of the Emacs variable `default-directory'. + + When using `:dir', you should supply a relative path for file output +(e.g., `:file myfile.jpg' or `:file results/myfile.jpg') in which case +that path will be interpreted relative to the default directory. + + In other words, if you want your plot to go into a folder called +`Work' in your home directory, you could use + + #+BEGIN_SRC R :file myplot.png :dir ~/Work + matplot(matrix(rnorm(100), 10), type="l") + #+END_SRC + +Remote execution +................ + +A directory on a remote machine can be specified using tramp file +syntax, in which case the code will be evaluated on the remote machine. +An example is + + #+BEGIN_SRC R :file plot.png :dir /dand@yakuba.princeton.edu: + plot(1:10, main=system("hostname", intern=TRUE)) + #+END_SRC + + Text results will be returned to the local Org mode buffer as usual, +and file output will be created on the remote machine with relative +paths interpreted relative to the remote directory. An Org mode link +to the remote file will be created. + + So, in the above example a plot will be created on the remote +machine, and a link of the following form will be inserted in the org +buffer: + + [[file:/scp:dand@yakuba.princeton.edu:/home/dand/plot.png][plot.png]] + + Most of this functionality follows immediately from the fact that +`:dir' sets the value of the Emacs variable `default-directory', thanks +to tramp. Those using XEmacs, or GNU Emacs prior to version 23 may +need to install tramp separately in order for these features to work +correctly. + +Further points +.............. + + * If `:dir' is used in conjunction with `:session', although it will + determine the starting directory for a new session as expected, no + attempt is currently made to alter the directory associated with + an existing session. + + * `:dir' should typically not be used to create files during export + with `:exports results' or `:exports both'. The reason is that, + in order to retain portability of exported material between + machines, during export links inserted into the buffer will _not_ + be expanded against `default directory'. Therefore, if + `default-directory' is altered using `:dir', it is probable that + the file will be created in a location to which the link does not + point. + + +File: org, Node: exports, Next: tangle, Prev: dir, Up: Specific header arguments + +14.8.2.6 `:exports' +................... + +The `:exports' header argument specifies what should be included in HTML +or LaTeX exports of the Org mode file. + + * `code' The default. The body of code is included into the + exported file. E.g., `:exports code'. + + * `results' The result of evaluating the code is included in the + exported file. E.g., `:exports results'. + + * `both' Both the code and results are included in the exported + file. E.g., `:exports both'. + + * `none' Nothing is included in the exported file. E.g., `:exports + none'. + + +File: org, Node: tangle, Next: mkdirp, Prev: exports, Up: Specific header arguments + +14.8.2.7 `:tangle' +.................. + +The `:tangle' header argument specifies whether or not the code block +should be included in tangled extraction of source code files. + + * `tangle' The code block is exported to a source code file named + after the full path (including the directory) and file name (w/o + extension) of the Org mode file. E.g., `:tangle yes'. + + * `no' The default. The code block is not exported to a source code + file. E.g., `:tangle no'. + + * other Any other string passed to the `:tangle' header argument is + interpreted as a path (directory and file name relative to the + directory of the Org mode file) to which the block will be + exported. E.g., `:tangle path'. + + +File: org, Node: mkdirp, Next: comments, Prev: tangle, Up: Specific header arguments + +14.8.2.8 `:mkdirp' +.................. + +The `:mkdirp' header argument can be used to create parent directories +of tangled files when missing. This can be set to `yes' to enable +directory creation or to `no' to inhibit directory creation. + + +File: org, Node: comments, Next: padline, Prev: mkdirp, Up: Specific header arguments + +14.8.2.9 `:comments' +.................... + +By default code blocks are tangled to source-code files without any +insertion of comments beyond those which may already exist in the body +of the code block. The `:comments' header argument can be set as +follows to control the insertion of extra comments into the tangled +code file. + + * `no' The default. No extra comments are inserted during tangling. + + * `link' The code block is wrapped in comments which contain + pointers back to the original Org file from which the code was + tangled. + + * `yes' A synonym for "link" to maintain backwards compatibility. + + * `org' Include text from the Org mode file as a comment. The text + is picked from the leading context of the tangled code and is + limited by the nearest headline or source block as the case may be. + + * `both' Turns on both the "link" and "org" comment options. + + * `noweb' Turns on the "link" comment option, and additionally wraps + expanded noweb references in the code block body in link comments. + + +File: org, Node: padline, Next: no-expand, Prev: comments, Up: Specific header arguments + +14.8.2.10 `:padline' +.................... + +Control in insertion of padding lines around code block bodies in +tangled code files. The default value is `yes' which results in +insertion of newlines before and after each tangled code block. The +following arguments are accepted. + + * `yes' Insert newlines before and after each code block body in + tangled code files. + + * `no' Do not insert any newline padding in tangled output. + + +File: org, Node: no-expand, Next: session, Prev: padline, Up: Specific header arguments + +14.8.2.11 `:no-expand' +...................... + +By default, code blocks are expanded with `org-babel-expand-src-block' +during tangling. This has the effect of assigning values to variables +specified with `:var' (see *note var::), and of replacing "noweb" +references (see *note Noweb reference syntax::) with their targets. The +`:no-expand' header argument can be used to turn off this behavior. + + +File: org, Node: session, Next: noweb, Prev: no-expand, Up: Specific header arguments + +14.8.2.12 `:session' +.................... + +The `:session' header argument starts a session for an interpreted +language where state is preserved. + + By default, a session is not started. + + A string passed to the `:session' header argument will give the +session a name. This makes it possible to run concurrent sessions for +each interpreted language. + + +File: org, Node: noweb, Next: noweb-ref, Prev: session, Up: Specific header arguments + +14.8.2.13 `:noweb' +.................. + +The `:noweb' header argument controls expansion of "noweb" syntax +references (see *note Noweb reference syntax::) when the code block is +evaluated, tangled, or exported. The `:noweb' header argument can have +one of the five values: `no', `yes', `tangle', or `no-export' +`strip-export'. + + * `no' The default. "Noweb" syntax references in the body of the + code block will not be expanded before the code block is + evaluated, tangled or exported. + + * `yes' "Noweb" syntax references in the body of the code block will + be expanded before the code block is evaluated, tangled or + exported. + + * `tangle' "Noweb" syntax references in the body of the code block + will be expanded before the code block is tangled. However, + "noweb" syntax references will not be expanded when the code block + is evaluated or exported. + + * `no-export' "Noweb" syntax references in the body of the code + block will be expanded before the block is evaluated or tangled. + However, "noweb" syntax references will not be expanded when the + code block is exported. + + * `strip-export' "Noweb" syntax references in the body of the code + block will be expanded before the block is evaluated or tangled. + However, "noweb" syntax references will be removed when the code + block is exported. + + * `eval' "Noweb" syntax references in the body of the code block + will only be expanded before the block is evaluated. + +Noweb prefix lines +.................. + +Noweb insertions are now placed behind the line prefix of the +`<>'. This behavior is illustrated in the following +example. Because the `<>' noweb reference appears behind the +SQL comment syntax, each line of the expanded noweb reference will be +commented. + + This code block: + + -- <> + + expands to: + + -- this is the + -- multi-line body of example + + Note that noweb replacement text that does not contain any newlines +will not be affected by this change, so it is still possible to use +inline noweb references. + + +File: org, Node: noweb-ref, Next: noweb-sep, Prev: noweb, Up: Specific header arguments + +14.8.2.14 `:noweb-ref' +...................... + +When expanding "noweb" style references the bodies of all code block +with _either_ a block name matching the reference name _or_ a +`:noweb-ref' header argument matching the reference name will be +concatenated together to form the replacement text. + + By setting this header argument at the sub-tree or file level, +simple code block concatenation may be achieved. For example, when +tangling the following Org mode file, the bodies of code blocks will be +concatenated into the resulting pure code file(1). + + #+BEGIN_SRC sh :tangle yes :noweb yes :shebang #!/bin/sh + <> + #+END_SRC + * the mount point of the fullest disk + :PROPERTIES: + :noweb-ref: fullest-disk + :END: + + ** query all mounted disks + #+BEGIN_SRC sh + df \ + #+END_SRC + + ** strip the header row + #+BEGIN_SRC sh + |sed '1d' \ + #+END_SRC + + ** sort by the percent full + #+BEGIN_SRC sh + |awk '{print $5 " " $6}'|sort -n |tail -1 \ + #+END_SRC + + ** extract the mount point + #+BEGIN_SRC sh + |awk '{print $2}' + #+END_SRC + + The `:noweb-sep' (see *note noweb-sep::) header argument holds the +string used to separate accumulate noweb references like those above. +By default a newline is used. + + ---------- Footnotes ---------- + + (1) (The example needs property inheritance to be turned on for the +`noweb-ref' property, see *note Property inheritance::). + + +File: org, Node: noweb-sep, Next: cache, Prev: noweb-ref, Up: Specific header arguments + +14.8.2.15 `:noweb-sep' +...................... + +The `:noweb-sep' header argument holds the string used to separate +accumulate noweb references (see *note noweb-ref::). By default a +newline is used. + + +File: org, Node: cache, Next: sep, Prev: noweb-sep, Up: Specific header arguments + +14.8.2.16 `:cache' +.................. + +The `:cache' header argument controls the use of in-buffer caching of +the results of evaluating code blocks. It can be used to avoid +re-evaluating unchanged code blocks. Note that the `:cache' header +argument will not attempt to cache results when the `:session' header +argument is used, because the results of the code block execution may +be stored in the session outside of the Org mode buffer. The `:cache' +header argument can have one of two values: `yes' or `no'. + + * `no' The default. No caching takes place, and the code block will + be evaluated every time it is called. + + * `yes' Every time the code block is run a SHA1 hash of the code and + arguments passed to the block will be generated. This hash is + packed into the `#+RESULTS:' line and will be checked on subsequent + executions of the code block. If the code block has not changed + since the last time it was evaluated, it will not be re-evaluated. + + Code block caches notice if the value of a variable argument to the +code block has changed. If this is the case, the cache is invalidated +and the code block is re-run. In the following example, `caller' will +not be re-run unless the results of `random' have changed since it was +last run. + + #+NAME: random + #+BEGIN_SRC R :cache yes + runif(1) + #+END_SRC + + #+RESULTS[a2a72cd647ad44515fab62e144796432793d68e1]: random + 0.4659510825295 + + #+NAME: caller + #+BEGIN_SRC emacs-lisp :var x=random :cache yes + x + #+END_SRC + + #+RESULTS[bec9c8724e397d5df3b696502df3ed7892fc4f5f]: caller + 0.254227238707244 + + +File: org, Node: sep, Next: hlines, Prev: cache, Up: Specific header arguments + +14.8.2.17 `:sep' +................ + +The `:sep' header argument can be used to control the delimiter used +when writing tabular results out to files external to Org mode. This +is used either when opening tabular results of a code block by calling +the `org-open-at-point' function bound to `C-c C-o' on the code block, +or when writing code block results to an external file (see *note +file::) header argument. + + By default, when `:sep' is not specified output tables are tab +delimited. + + +File: org, Node: hlines, Next: colnames, Prev: sep, Up: Specific header arguments + +14.8.2.18 `:hlines' +................... + +Tables are frequently represented with one or more horizontal lines, or +hlines. The `:hlines' argument to a code block accepts the values +`yes' or `no', with a default value of `no'. + + * `no' Strips horizontal lines from the input table. In most + languages this is the desired effect because an `hline' symbol is + interpreted as an unbound variable and raises an error. Setting + `:hlines no' or relying on the default value yields the following + results. + + #+NAME: many-cols + | a | b | c | + |---+---+---| + | d | e | f | + |---+---+---| + | g | h | i | + + #+NAME: echo-table + #+BEGIN_SRC python :var tab=many-cols + return tab + #+END_SRC + + #+RESULTS: echo-table + | a | b | c | + | d | e | f | + | g | h | i | + + * `yes' Leaves hlines in the table. Setting `:hlines yes' has this + effect. + + #+NAME: many-cols + | a | b | c | + |---+---+---| + | d | e | f | + |---+---+---| + | g | h | i | + + #+NAME: echo-table + #+BEGIN_SRC python :var tab=many-cols :hlines yes + return tab + #+END_SRC + + #+RESULTS: echo-table + | a | b | c | + |---+---+---| + | d | e | f | + |---+---+---| + | g | h | i | + + +File: org, Node: colnames, Next: rownames, Prev: hlines, Up: Specific header arguments + +14.8.2.19 `:colnames' +..................... + +The `:colnames' header argument accepts the values `yes', `no', or +`nil' for unassigned. The default value is `nil'. Note that the +behavior of the `:colnames' header argument may differ across languages. + + * `nil' If an input table looks like it has column names (because + its second row is an hline), then the column names will be removed + from the table before processing, then reapplied to the results. + + #+NAME: less-cols + | a | + |---| + | b | + | c | + + #+NAME: echo-table-again + #+BEGIN_SRC python :var tab=less-cols + return [[val + '*' for val in row] for row in tab] + #+END_SRC + + #+RESULTS: echo-table-again + | a | + |----| + | b* | + | c* | + + Please note that column names are not removed before the table is + indexed using variable indexing *Note Indexable variable values: + var. + + * `no' No column name pre-processing takes place + + * `yes' Column names are removed and reapplied as with `nil' even if + the table does not "look like" it has column names (i.e., the + second row is not an hline) + + +File: org, Node: rownames, Next: shebang, Prev: colnames, Up: Specific header arguments + +14.8.2.20 `:rownames' +..................... + +The `:rownames' header argument can take on the values `yes' or `no', +with a default value of `no'. Note that Emacs Lisp code blocks ignore +the `:rownames' header argument entirely given the ease with which +tables with row names may be handled directly in Emacs Lisp. + + * `no' No row name pre-processing will take place. + + * `yes' The first column of the table is removed from the table + before processing, and is then reapplied to the results. + + #+NAME: with-rownames + | one | 1 | 2 | 3 | 4 | 5 | + | two | 6 | 7 | 8 | 9 | 10 | + + #+NAME: echo-table-once-again + #+BEGIN_SRC python :var tab=with-rownames :rownames yes + return [[val + 10 for val in row] for row in tab] + #+END_SRC + + #+RESULTS: echo-table-once-again + | one | 11 | 12 | 13 | 14 | 15 | + | two | 16 | 17 | 18 | 19 | 20 | + + Please note that row names are not removed before the table is + indexed using variable indexing *Note Indexable variable values: + var. + + + +File: org, Node: shebang, Next: tangle-mode, Prev: rownames, Up: Specific header arguments + +14.8.2.21 `:shebang' +.................... + +Setting the `:shebang' header argument to a string value (e.g., +`:shebang "#!/bin/bash"') causes the string to be inserted as the first +line of any tangled file holding the code block, and the file +permissions of the tangled file are set to make it executable. + + +File: org, Node: tangle-mode, Next: eval, Prev: shebang, Up: Specific header arguments + +14.8.2.22 `:tangle-mode' +........................ + +The `tangle-mode' header argument controls the permission set on tangled +files. The value of this header argument will be passed to +`set-file-modes'. For example, to set a tangled file as read only use +`:tangle-mode (identity #o444)', or to set a tangled file as executable +use `:tangle-mode (identity #o755)'. Blocks with `shebang' (*note +shebang::) header arguments will automatically be made executable unless +the `tangle-mode' header argument is also used. The behavior is +undefined if multiple code blocks with different values for the +`tangle-mode' header argument are tangled to the same file. + + +File: org, Node: eval, Next: wrap, Prev: tangle-mode, Up: Specific header arguments + +14.8.2.23 `:eval' +................. + +The `:eval' header argument can be used to limit the evaluation of +specific code blocks. The `:eval' header argument can be useful for +protecting against the evaluation of dangerous code blocks or to ensure +that evaluation will require a query regardless of the value of the +`org-confirm-babel-evaluate' variable. The possible values of `:eval' +and their effects are shown below. + +`never or no' + The code block will not be evaluated under any circumstances. + +`query' + Evaluation of the code block will require a query. + +`never-export or no-export' + The code block will not be evaluated during export but may still + be called interactively. + +`query-export' + Evaluation of the code block during export will require a query. + + If this header argument is not set then evaluation is determined by +the value of the `org-confirm-babel-evaluate' variable see *note Code +evaluation security::. + + +File: org, Node: wrap, Next: post, Prev: eval, Up: Specific header arguments + +14.8.2.24 `:wrap' +................. + +The `:wrap' header argument is used to mark the results of source block +evaluation. The header argument can be passed a string that will be +appended to `#+BEGIN_' and `#+END_', which will then be used to wrap the +results. If not string is specified then the results will be wrapped +in a `#+BEGIN/END_RESULTS' block. + + +File: org, Node: post, Next: prologue, Prev: wrap, Up: Specific header arguments + +14.8.2.25 `:post' +................. + +The `:post' header argument is used to post-process the results of a +code block execution. When a post argument is given, the results of +the code block will temporarily be bound to the `*this*' variable. +This variable may then be included in header argument forms such as +those used in *note var:: header argument specifications allowing +passing of results to other code blocks, or direct execution via Emacs +Lisp. + + The following example illustrates the usage of the `:post' header +argument. + + #+name: attr_wrap + #+begin_src sh :var data="" :var width="\\textwidth" :results output + echo "#+ATTR_LATEX :width $width" + echo "$data" + #+end_src + + #+header: :file /tmp/it.png + #+begin_src dot :post attr_wrap(width="5cm", data=*this*) :results drawer + digraph{ + a -> b; + b -> c; + c -> a; + } + #+end_src + + #+RESULTS: + :RESULTS: + #+ATTR_LATEX :width 5cm + [[file:/tmp/it.png]] + :END: + + +File: org, Node: prologue, Next: epilogue, Prev: post, Up: Specific header arguments + +14.8.2.26 `:prologue' +..................... + +The value of the `prologue' header argument will be prepended to the +code block body before execution. For example, `:prologue "reset"' may +be used to reset a gnuplot session before execution of a particular code +block, or the following configuration may be used to do this for all +gnuplot code blocks. Also see *note epilogue::. + + (add-to-list 'org-babel-default-header-args:gnuplot + '((:prologue . "reset"))) + + +File: org, Node: epilogue, Prev: prologue, Up: Specific header arguments + +14.8.2.27 `:epilogue' +..................... + +The value of the `epilogue' header argument will be appended to the code +block body before execution. Also see *note prologue::. + + +File: org, Node: Results of evaluation, Next: Noweb reference syntax, Prev: Header arguments, Up: Working With Source Code + +14.9 Results of evaluation +========================== + +The way in which results are handled depends on whether a session is +invoked, as well as on whether `:results value' or `:results output' is +used. The following table shows the table possibilities. For a full +listing of the possible results header arguments see *note results::. + + Non-session Session +`:results value' value of last value of last expression + expression +`:results output' contents of STDOUT concatenation of interpreter + output + + Note: With `:results value', the result in both `:session' and +non-session is returned to Org mode as a table (a one- or +two-dimensional vector of strings or numbers) when appropriate. + +14.9.1 Non-session +------------------ + +14.9.1.1 `:results value' +......................... + +This is the default. Internally, the value is obtained by wrapping the +code in a function definition in the external language, and evaluating +that function. Therefore, code should be written as if it were the +body of such a function. In particular, note that Python does not +automatically return a value from a function unless a `return' +statement is present, and so a `return' statement will usually be +required in Python. + + This is the only one of the four evaluation contexts in which the +code is automatically wrapped in a function definition. + +14.9.1.2 `:results output' +.......................... + +The code is passed to the interpreter as an external process, and the +contents of the standard output stream are returned as text. (In +certain languages this also contains the error output stream; this is +an area for future work.) + +14.9.2 Session +-------------- + +14.9.2.1 `:results value' +......................... + +The code is passed to an interpreter running as an interactive Emacs +inferior process. Only languages which provide tools for interactive +evaluation of code have session support, so some language (e.g., C and +ditaa) do not support the `:session' header argument, and in other +languages (e.g., Python and Haskell) which have limitations on the code +which may be entered into interactive sessions, those limitations apply +to the code in code blocks using the `:session' header argument as well. + + Unless the `:results output' option is supplied (see below) the +result returned is the result of the last evaluation performed by the +interpreter. (This is obtained in a language-specific manner: the +value of the variable `_' in Python and Ruby, and the value of +`.Last.value' in R). + +14.9.2.2 `:results output' +.......................... + +The code is passed to the interpreter running as an interactive Emacs +inferior process. The result returned is the concatenation of the +sequence of (text) output from the interactive interpreter. Notice +that this is not necessarily the same as what would be sent to `STDOUT' +if the same code were passed to a non-interactive interpreter running +as an external process. For example, compare the following two blocks: + + #+BEGIN_SRC python :results output + print "hello" + 2 + print "bye" + #+END_SRC + + #+RESULTS: + : hello + : bye + + In non-session mode, the `2' is not printed and does not appear. + + #+BEGIN_SRC python :results output :session + print "hello" + 2 + print "bye" + #+END_SRC + + #+RESULTS: + : hello + : 2 + : bye + + But in `:session' mode, the interactive interpreter receives input +`2' and prints out its value, `2'. (Indeed, the other print statements +are unnecessary here). + + +File: org, Node: Noweb reference syntax, Next: Key bindings and useful functions, Prev: Results of evaluation, Up: Working With Source Code + +14.10 Noweb reference syntax +============================ + +The "noweb" (see `http://www.cs.tufts.edu/~nr/noweb/') Literate +Programming system allows named blocks of code to be referenced by +using the familiar Noweb syntax: + + <> + + When a code block is tangled or evaluated, whether or not "noweb" +references are expanded depends upon the value of the `:noweb' header +argument. If `:noweb yes', then a Noweb reference is expanded before +evaluation. If `:noweb no', the default, then the reference is not +expanded before evaluation. See the *note noweb-ref:: header argument +for a more flexible way to resolve noweb references. + + It is possible to include the _results_ of a code block rather than +the body. This is done by appending parenthesis to the code block name +which may optionally contain arguments to the code block as shown below. + + <> + + Note: the default value, `:noweb no', was chosen to ensure that +correct code is not broken in a language, such as Ruby, where `<>' +is a syntactically valid construct. If `<>' is not syntactically +valid in languages that you use, then please consider setting the +default value. + + Note: if noweb tangling is slow in large Org mode files consider +setting the `org-babel-use-quick-and-dirty-noweb-expansion' variable to +`t'. This will result in faster noweb reference resolution at the +expense of not correctly resolving inherited values of the `:noweb-ref' +header argument. + + +File: org, Node: Key bindings and useful functions, Next: Batch execution, Prev: Noweb reference syntax, Up: Working With Source Code + +14.11 Key bindings and useful functions +======================================= + +Many common Org mode key sequences are re-bound depending on the +context. + + Within a code block, the following key bindings are active: + +`C-c C-c' `org-babel-execute-src-block' +`C-c C-o' `org-babel-open-src-block-result' +`M-' `org-babel-load-in-session' +`M-' `org-babel-switch-to-session' + + In an Org mode buffer, the following key bindings are active: + +`C-c C-v p' or `C-c C-v `org-babel-previous-src-block' +C-p' +`C-c C-v n' or `C-c C-v `org-babel-next-src-block' +C-n' +`C-c C-v e' or `C-c C-v `org-babel-execute-maybe' +C-e' +`C-c C-v o' or `C-c C-v `org-babel-open-src-block-result' +C-o' +`C-c C-v v' or `C-c C-v `org-babel-expand-src-block' +C-v' +`C-c C-v u' or `C-c C-v `org-babel-goto-src-block-head' +C-u' +`C-c C-v g' or `C-c C-v `org-babel-goto-named-src-block' +C-g' +`C-c C-v r' or `C-c C-v `org-babel-goto-named-result' +C-r' +`C-c C-v b' or `C-c C-v `org-babel-execute-buffer' +C-b' +`C-c C-v s' or `C-c C-v `org-babel-execute-subtree' +C-s' +`C-c C-v d' or `C-c C-v `org-babel-demarcate-block' +C-d' +`C-c C-v t' or `C-c C-v `org-babel-tangle' +C-t' +`C-c C-v f' or `C-c C-v `org-babel-tangle-file' +C-f' +`C-c C-v c' or `C-c C-v `org-babel-check-src-block' +C-c' +`C-c C-v j' or `C-c C-v `org-babel-insert-header-arg' +C-j' +`C-c C-v l' or `C-c C-v `org-babel-load-in-session' +C-l' +`C-c C-v i' or `C-c C-v `org-babel-lob-ingest' +C-i' +`C-c C-v I' or `C-c C-v `org-babel-view-src-block-info' +C-I' +`C-c C-v z' or `C-c C-v `org-babel-switch-to-session-with-code' +C-z' +`C-c C-v a' or `C-c C-v `org-babel-sha1-hash' +C-a' +`C-c C-v h' or `C-c C-v `org-babel-describe-bindings' +C-h' +`C-c C-v x' or `C-c C-v `org-babel-do-key-sequence-in-edit-buffer' +C-x' + + +File: org, Node: Batch execution, Prev: Key bindings and useful functions, Up: Working With Source Code + +14.12 Batch execution +===================== + +It is possible to call functions from the command line. This shell +script calls `org-babel-tangle' on every one of its arguments. + + Be sure to adjust the paths to fit your system. + + #!/bin/sh + # -*- mode: shell-script -*- + # + # tangle files with org-mode + # + DIR=`pwd` + FILES="" + + # wrap each argument in the code required to call tangle on it + for i in $@; do + FILES="$FILES \"$i\"" + done + + emacs -Q --batch \ + --eval "(progn + (add-to-list 'load-path (expand-file-name \"~/src/org/lisp/\")) + (add-to-list 'load-path (expand-file-name \"~/src/org/contrib/lisp/\" t)) + (require 'org)(require 'org-exp)(require 'ob)(require 'ob-tangle) + (mapc (lambda (file) + (find-file (expand-file-name file \"$DIR\")) + (org-babel-tangle) + (kill-buffer)) '($FILES)))" 2>&1 |grep tangled + + +File: org, Node: Miscellaneous, Next: Hacking, Prev: Working With Source Code, Up: Top + +15 Miscellaneous +**************** + +* Menu: + +* Completion:: M-TAB knows what you need +* Easy Templates:: Quick insertion of structural elements +* Speed keys:: Electric commands at the beginning of a headline +* Code evaluation security:: Org mode files evaluate inline code +* Customization:: Adapting Org to your taste +* In-buffer settings:: Overview of the #+KEYWORDS +* The very busy C-c C-c key:: When in doubt, press C-c C-c +* Clean view:: Getting rid of leading stars in the outline +* TTY keys:: Using Org on a tty +* Interaction:: Other Emacs packages +* org-crypt:: Encrypting Org files + + +File: org, Node: Completion, Next: Easy Templates, Prev: Miscellaneous, Up: Miscellaneous + +15.1 Completion +=============== + +Emacs would not be Emacs without completion, and Org mode uses it +whenever it makes sense. If you prefer an iswitchb- or ido-like +interface for some of the completion prompts, you can specify your +preference by setting at most one of the variables +`org-completion-use-iswitchb' `org-completion-use-ido'. + + Org supports in-buffer completion. This type of completion does not +make use of the minibuffer. You simply type a few letters into the +buffer and use the key to complete text right there. + +`M-' + Complete word at point + * At the beginning of a headline, complete TODO keywords. + + * After `\', complete TeX symbols supported by the exporter. + + * After `*', complete headlines in the current buffer so that + they can be used in search links like `[[*find this + headline]]'. + + * After `:' in a headline, complete tags. The list of tags is + taken from the variable `org-tag-alist' (possibly set through + the `#+TAGS' in-buffer option, *note Setting tags::), or it + is created dynamically from all tags used in the current + buffer. + + * After `:' and not in a headline, complete property keys. The + list of keys is constructed dynamically from all keys used in + the current buffer. + + * After `[', complete link abbreviations (*note Link + abbreviations::). + + * After `#+', complete the special keywords like `TYP_TODO' or + `OPTIONS' which set file-specific options for Org mode. When + the option keyword is already complete, pressing `M-' + again will insert example settings for this keyword. + + * In the line after `#+STARTUP: ', complete startup keywords, + i.e., valid keys for this line. + + * Elsewhere, complete dictionary words using Ispell. + + +File: org, Node: Easy Templates, Next: Speed keys, Prev: Completion, Up: Miscellaneous + +15.2 Easy Templates +=================== + +Org mode supports insertion of empty structural elements (like +`#+BEGIN_SRC' and `#+END_SRC' pairs) with just a few key strokes. This +is achieved through a native template expansion mechanism. Note that +Emacs has several other template mechanisms which could be used in a +similar way, for example `yasnippet'. + + To insert a structural element, type a `<', followed by a template +selector and `'. Completion takes effect only when the above +keystrokes are typed on a line by itself. + + The following template selectors are currently supported. + +`s' `#+BEGIN_SRC ... #+END_SRC' +`e' `#+BEGIN_EXAMPLE ... #+END_EXAMPLE' +`q' `#+BEGIN_QUOTE ... #+END_QUOTE' +`v' `#+BEGIN_VERSE ... #+END_VERSE' +`c' `#+BEGIN_CENTER ... #+END_CENTER' +`l' `#+BEGIN_LaTeX ... #+END_LaTeX' +`L' `#+LaTeX:' +`h' `#+BEGIN_HTML ... #+END_HTML' +`H' `#+HTML:' +`a' `#+BEGIN_ASCII ... #+END_ASCII' +`A' `#+ASCII:' +`i' `#+INDEX:' line +`I' `#+INCLUDE:' line + + For example, on an empty line, typing "Customization' menu. Many settings can also be +activated on a per-file basis, by putting special lines into the buffer +(*note In-buffer settings::). + + +File: org, Node: In-buffer settings, Next: The very busy C-c C-c key, Prev: Customization, Up: Miscellaneous + +15.6 Summary of in-buffer settings +================================== + +Org mode uses special lines in the buffer to define settings on a +per-file basis. These lines start with a `#+' followed by a keyword, a +colon, and then individual words defining a setting. Several setting +words can be in the same line, but you can also have multiple lines for +the keyword. While these settings are described throughout the manual, +here is a summary. After changing any of those lines in the buffer, +press `C-c C-c' with the cursor still in the line to activate the +changes immediately. Otherwise they become effective only when the +file is visited again in a new Emacs session. + +`#+ARCHIVE: %s_done::' + This line sets the archive location for the agenda file. It + applies for all subsequent lines until the next `#+ARCHIVE' line, + or the end of the file. The first such line also applies to any + entries before it. The corresponding variable is + `org-archive-location'. + +`#+CATEGORY:' + This line sets the category for the agenda file. The category + applies for all subsequent lines until the next `#+CATEGORY' line, + or the end of the file. The first such line also applies to any + entries before it. + +`#+COLUMNS: %25ITEM ...' + Set the default format for columns view. This format applies when + columns view is invoked in locations where no `COLUMNS' property + applies. + +`#+CONSTANTS: name1=value1 ...' + Set file-local values for constants to be used in table formulas. + This line sets the local variable + `org-table-formula-constants-local'. The global version of this + variable is `org-table-formula-constants'. + +`#+FILETAGS: :tag1:tag2:tag3:' + Set tags that can be inherited by any entry in the file, including + the top-level entries. + +`#+DRAWERS: NAME1 ...' + Set the file-local set of additional drawers. The corresponding + global variable is `org-drawers'. + +`#+LINK: linkword replace' + These lines (several are allowed) specify link abbreviations. + *Note Link abbreviations::. The corresponding variable is + `org-link-abbrev-alist'. + +`#+PRIORITIES: highest lowest default' + This line sets the limits and the default for the priorities. All + three must be either letters A-Z or numbers 0-9. The highest + priority must have a lower ASCII number than the lowest priority. + +`#+PROPERTY: Property_Name Value' + This line sets a default inheritance value for entries in the + current buffer, most useful for specifying the allowed values of a + property. + +`#+SETUPFILE: file' + This line defines a file that holds more in-buffer setup. + Normally this is entirely ignored. Only when the buffer is parsed + for option-setting lines (i.e., when starting Org mode for a file, + when pressing `C-c C-c' in a settings line, or when exporting), + then the contents of this file are parsed as if they had been + included in the buffer. In particular, the file can be any other + Org mode file with internal setup. You can visit the file the + cursor is in the line with `C-c ''. + +`#+STARTUP:' + This line sets options to be used at startup of Org mode, when an + Org file is being visited. + + The first set of options deals with the initial visibility of the + outline tree. The corresponding variable for global default + settings is `org-startup-folded', with a default value `t', which + means `overview'. + overview top-level headlines only + content all headlines + showall no folding of any entries + showeverything show even drawer contents + + Dynamic virtual indentation is controlled by the variable + `org-startup-indented'(1) + indent start with `org-indent-mode' turned on + noindent start with `org-indent-mode' turned off + + Then there are options for aligning tables upon visiting a file. + This is useful in files containing narrowed table columns. The + corresponding variable is `org-startup-align-all-tables', with a + default value `nil'. + align align all tables + noalign don't align tables on startup + + When visiting a file, inline images can be automatically + displayed. The corresponding variable is + `org-startup-with-inline-images', with a default value `nil' to + avoid delays when visiting a file. + inlineimages show inline images + noinlineimages don't show inline images on startup + + When visiting a file, LaTeX fragments can be converted to images + automatically. The variable `org-startup-with-latex-preview' which + controls this behavior, is set to `nil' by default to avoid delays + on startup. + latexpreview preview LaTeX fragments + nolatexpreview don't preview LaTeX fragments + + Logging the closing and reopening of TODO items and clock + intervals can be configured using these options (see variables + `org-log-done', `org-log-note-clock-out' and `org-log-repeat') + logdone record a timestamp when an item is marked DONE + lognotedone record timestamp and a note when DONE + nologdone don't record when items are marked DONE + logrepeat record a time when reinstating a repeating item + lognoterepeat record a note when reinstating a repeating item + nologrepeat do not record when reinstating repeating item + lognoteclock-out record a note when clocking out + nolognoteclock-out don't record a note when clocking out + logreschedule record a timestamp when scheduling time changes + lognotereschedule record a note when scheduling time changes + nologreschedule do not record when a scheduling date changes + logredeadline record a timestamp when deadline changes + lognoteredeadline record a note when deadline changes + nologredeadline do not record when a deadline date changes + logrefile record a timestamp when refiling + lognoterefile record a note when refiling + nologrefile do not record when refiling + logdrawer store log into drawer + nologdrawer store log outside of drawer + logstatesreversed reverse the order of states notes + nologstatesreversed do not reverse the order of states notes + + Here are the options for hiding leading stars in outline headings, + and for indenting outlines. The corresponding variables are + `org-hide-leading-stars' and `org-odd-levels-only', both with a + default setting `nil' (meaning `showstars' and `oddeven'). + hidestars make all but one of the stars starting a headline invisible. + showstars show all stars starting a headline + indent virtual indentation according to outline level + noindent no virtual indentation according to outline level + odd allow only odd outline levels (1,3,...) + oddeven allow all outline levels + + To turn on custom format overlays over timestamps (variables + `org-put-time-stamp-overlays' and + `org-time-stamp-overlay-formats'), use + customtime overlay custom time format + + The following options influence the table spreadsheet (variable + `constants-unit-system'). + constcgs `constants.el' should use the c-g-s unit system + constSI `constants.el' should use the SI unit system + + To influence footnote settings, use the following keywords. The + corresponding variables are `org-footnote-define-inline', + `org-footnote-auto-label', and `org-footnote-auto-adjust'. + fninline define footnotes inline + fnnoinline define footnotes in separate section + fnlocal define footnotes near first reference, but not inline + fnprompt prompt for footnote labels + fnauto create `[fn:1]'-like labels automatically (default) + fnconfirm offer automatic label for editing or confirmation + fnplain create `[1]'-like labels automatically + fnadjust automatically renumber and sort footnotes + nofnadjust do not renumber and sort automatically + + To hide blocks on startup, use these keywords. The corresponding + variable is `org-hide-block-startup'. + hideblocks Hide all begin/end blocks on startup + nohideblocks Do not hide blocks on startup + + The display of entities as UTF-8 characters is governed by the + variable `org-pretty-entities' and the keywords + entitiespretty Show entities as UTF-8 characters where possible + entitiesplain Leave entities plain + +`#+TAGS: TAG1(c1) TAG2(c2)' + These lines (several such lines are allowed) specify the valid + tags in this file, and (potentially) the corresponding _fast tag + selection_ keys. The corresponding variable is `org-tag-alist'. + +`#+TBLFM:' + This line contains the formulas for the table directly above the + line. + + Table can have multiple lines containing `#+TBLFM:'. Note that + only the first line of `#+TBLFM:' will be applied when you + recalculate the table. For more details see *note Using multiple + #+TBLFM lines:: in *note Editing and debugging formulas::. + +`#+TITLE:, #+AUTHOR:, #+EMAIL:, #+LANGUAGE:, #+DATE:,' +`#+OPTIONS:, #+BIND:,' +`#+DESCRIPTION:, #+KEYWORDS:,' +`#+LaTeX_HEADER:, #+LaTeX_HEADER_EXTRA:,' +`#+HTML_HEAD:, #+HTML_HEAD_EXTRA:, #+HTML_LINK_UP:, #+HTML_LINK_HOME:,' +`#+SELECT_TAGS:, #+EXCLUDE_TAGS:' + These lines provide settings for exporting files. For more + details see *note Export settings::. + +`#+TODO: #+SEQ_TODO: #+TYP_TODO:' + These lines set the TODO keywords and their interpretation in the + current file. The corresponding variable is `org-todo-keywords'. + + ---------- Footnotes ---------- + + (1) Emacs 23 and Org mode 6.29 are required + + +File: org, Node: The very busy C-c C-c key, Next: Clean view, Prev: In-buffer settings, Up: Miscellaneous + +15.7 The very busy C-c C-c key +============================== + +The key `C-c C-c' has many purposes in Org, which are all mentioned +scattered throughout this manual. One specific function of this key is +to add _tags_ to a headline (*note Tags::). In many other +circumstances it means something like _"Hey Org, look here and update +according to what you see here"_. Here is a summary of what this means +in different contexts. + + - If there are highlights in the buffer from the creation of a sparse + tree, or from clock display, remove these highlights. + + - If the cursor is in one of the special `#+KEYWORD' lines, this + triggers scanning the buffer for these lines and updating the + information. + + - If the cursor is inside a table, realign the table. This command + works even if the automatic table editor has been turned off. + + - If the cursor is on a `#+TBLFM' line, re-apply the formulas to the + entire table. + + - If the current buffer is a capture buffer, close the note and file + it. With a prefix argument, file it, without further interaction, + to the default location. + + - If the cursor is on a `<<>>', update radio targets and + corresponding links in this buffer. + + - If the cursor is in a property line or at the start or end of a + property drawer, offer property commands. + + - If the cursor is at a footnote reference, go to the corresponding + definition, and _vice versa_. + + - If the cursor is on a statistics cookie, update it. + + - If the cursor is in a plain list item with a checkbox, toggle the + status of the checkbox. + + - If the cursor is on a numbered item in a plain list, renumber the + ordered list. + + - If the cursor is on the `#+BEGIN' line of a dynamic block, the + block is updated. + + - If the cursor is at a timestamp, fix the day name in the timestamp. + + +File: org, Node: Clean view, Next: TTY keys, Prev: The very busy C-c C-c key, Up: Miscellaneous + +15.8 A cleaner outline view +=========================== + +Some people find it noisy and distracting that the Org headlines start +with a potentially large number of stars, and that text below the +headlines is not indented. While this is no problem when writing a +_book-like_ document where the outline headings are really section +headings, in a more _list-oriented_ outline, indented structure is a +lot cleaner: + + * Top level headline | * Top level headline + ** Second level | * Second level + *** 3rd level | * 3rd level + some text | some text + *** 3rd level | * 3rd level + more text | more text + * Another top level headline | * Another top level headline + +If you are using at least Emacs 23.2(1) and version 6.29 of Org, this +kind of view can be achieved dynamically at display time using +`org-indent-mode'. In this minor mode, all lines are prefixed for +display with the necessary amount of space(2). Also headlines are +prefixed with additional stars, so that the amount of indentation +shifts by two(3) spaces per level. All headline stars but the last +one are made invisible using the `org-hide' face(4); see below under +`2.' for more information on how this works. You can turn on +`org-indent-mode' for all files by customizing the variable +`org-startup-indented', or you can turn it on for individual files using + + #+STARTUP: indent + + If you want a similar effect in an earlier version of Emacs and/or +Org, or if you want the indentation to be hard space characters so that +the plain text file looks as similar as possible to the Emacs display, +Org supports you in the following way: + + 1. _Indentation of text below headlines_ + You may indent text below each headline to make the left boundary + line up with the headline, like + + *** 3rd level + more text, now indented + + Org supports this with paragraph filling, line wrapping, and + structure editing(5), preserving or adapting the indentation as + appropriate. + + 2. _Hiding leading stars_ + You can modify the display in such a way that all leading stars + become invisible. To do this in a global way, configure the + variable `org-hide-leading-stars' or change this on a per-file + basis with + + #+STARTUP: hidestars + #+STARTUP: showstars + + With hidden stars, the tree becomes: + + * Top level headline + * Second level + * 3rd level + ... + + The leading stars are not truly replaced by whitespace, they are + only fontified with the face `org-hide' that uses the background + color as font color. If you are not using either white or black + background, you may have to customize this face to get the wanted + effect. Another possibility is to set this font such that the + extra stars are almost invisible, for example using the color + `grey90' on a white background. + + 3. Things become cleaner still if you skip all the even levels and + use only odd levels 1, 3, 5..., effectively adding two stars to go + from one outline level to the next(6). In this way we get the + outline view shown at the beginning of this section. In order to + make the structure editing and export commands handle this + convention correctly, configure the variable + `org-odd-levels-only', or set this on a per-file basis with one of + the following lines: + + #+STARTUP: odd + #+STARTUP: oddeven + + You can convert an Org file from single-star-per-level to the + double-star-per-level convention with `M-x + org-convert-to-odd-levels RET' in that file. The reverse + operation is `M-x org-convert-to-oddeven-levels'. + + ---------- Footnotes ---------- + + (1) Emacs 23.1 can actually crash with `org-indent-mode' + + (2) `org-indent-mode' also sets the `wrap-prefix' property, such +that `visual-line-mode' (or purely setting `word-wrap') wraps long +lines (including headlines) correctly indented. + + (3) See the variable `org-indent-indentation-per-level'. + + (4) Turning on `org-indent-mode' sets `org-hide-leading-stars' to +`t' and `org-adapt-indentation' to `nil'. + + (5) See also the variable `org-adapt-indentation'. + + (6) When you need to specify a level for a property search or refile +targets, `LEVEL=2' will correspond to 3 stars, etc. + + +File: org, Node: TTY keys, Next: Interaction, Prev: Clean view, Up: Miscellaneous + +15.9 Using Org on a tty +======================= + +Because Org contains a large number of commands, by default many of +Org's core commands are bound to keys that are generally not accessible +on a tty, such as the cursor keys (, , , ), + and , in particular when used together with modifiers like + and/or . To access these commands on a tty when special +keys are unavailable, the following alternative bindings can be used. +The tty bindings below will likely be more cumbersome; you may find for +some of the bindings below that a customized workaround suits you +better. For example, changing a timestamp is really only fun with +`S-' keys, whereas on a tty you would rather use `C-c .' to +re-insert the timestamp. + +Default Alternative 1 Speed Alternative 2 + key +`S-' `C-u ' `C' +`M-' `C-c C-x l' `l' ` ' +`M-S-'`C-c C-x L' `L' +`M-' `C-c C-x r' `r' ` + ' +`M-S-'`C-c C-x R' `R' +`M-' `C-c C-x u' ` ' ` ' +`M-S-' `C-c C-x U' `U' +`M-' `C-c C-x d' ` ' ` ' +`M-S-'`C-c C-x D' `D' +`S-' `C-c C-x c' ` ' +`M-' `C-c C-x m' ` ' ` ' +`M-S-' `C-c C-x M' ` ' +`S-' `C-c ' ` ' +`S-' `C-c ' ` ' +`S-' `C-c ' ` ' +`S-' `C-c ' ` ' +`C-S-'`C-c C-x ` ' + ' +`C-S-'`C-c C-x ` ' + ' + + +File: org, Node: Interaction, Next: org-crypt, Prev: TTY keys, Up: Miscellaneous + +15.10 Interaction with other packages +===================================== + +Org lives in the world of GNU Emacs and interacts in various ways with +other code out there. + +* Menu: + +* Cooperation:: Packages Org cooperates with +* Conflicts:: Packages that lead to conflicts + + +File: org, Node: Cooperation, Next: Conflicts, Prev: Interaction, Up: Interaction + +15.10.1 Packages that Org cooperates with +----------------------------------------- + +`calc.el' by Dave Gillespie + Org uses the Calc package for implementing spreadsheet + functionality in its tables (*note The spreadsheet::). Org checks + for the availability of Calc by looking for the function + `calc-eval' which will have been autoloaded during setup if Calc + has been installed properly. As of Emacs 22, Calc is part of the + Emacs distribution. Another possibility for interaction between + the two packages is using Calc for embedded calculations. *Note + Embedded Mode: (calc)Embedded Mode. + +`constants.el' by Carsten Dominik + In a table formula (*note The spreadsheet::), it is possible to use + names for natural constants or units. Instead of defining your own + constants in the variable `org-table-formula-constants', install + the `constants' package which defines a large number of constants + and units, and lets you use unit prefixes like `M' for `Mega', + etc. You will need version 2.0 of this package, available at + `http://www.astro.uva.nl/~dominik/Tools'. Org checks for the + function `constants-get', which has to be autoloaded in your + setup. See the installation instructions in the file + `constants.el'. + +`cdlatex.el' by Carsten Dominik + Org mode can make use of the CDLaTeX package to efficiently enter + LaTeX fragments into Org files. See *note CDLaTeX mode::. + +`imenu.el' by Ake Stenhoff and Lars Lindberg + Imenu allows menu access to an index of items in a file. Org mode + supports Imenu--all you need to do to get the index is the + following: + (add-hook 'org-mode-hook + (lambda () (imenu-add-to-menubar "Imenu"))) + By default the index is two levels deep--you can modify the depth + using the option `org-imenu-depth'. + +`remember.el' by John Wiegley + Org used to use this package for capture, but no longer does. + +`speedbar.el' by Eric M. Ludlam + Speedbar is a package that creates a special frame displaying + files and index items in files. Org mode supports Speedbar and + allows you to drill into Org files directly from the Speedbar. It + also allows you to restrict the scope of agenda commands to a file + or a subtree by using the command `<' in the Speedbar frame. + +`table.el' by Takaaki Ota + Complex ASCII tables with automatic line wrapping, column- and + row-spanning, and alignment can be created using the Emacs table + package by Takaaki Ota (`http://sourceforge.net/projects/table', + and also part of Emacs 22). Org mode will recognize these tables + and export them properly. Because of interference with other Org + mode functionality, you unfortunately cannot edit these tables + directly in the buffer. Instead, you need to use the command `C-c + '' to edit them, similar to source code snippets. + + `C-c ' (`org-edit-special')' + Edit a `table.el' table. Works when the cursor is in a + table.el table. + + `C-c ~ (`org-table-create-with-table.el')' + Insert a `table.el' table. If there is already a table at + point, this command converts it between the `table.el' format + and the Org mode format. See the documentation string of the + command `org-convert-table' for the restrictions under which + this is possible. + `table.el' is part of Emacs since Emacs 22. + +`footnote.el' by Steven L. Baur + Org mode recognizes numerical footnotes as provided by this + package. However, Org mode also has its own footnote support + (*note Footnotes::), which makes using `footnote.el' unnecessary. + + +File: org, Node: Conflicts, Prev: Cooperation, Up: Interaction + +15.10.2 Packages that lead to conflicts with Org mode +----------------------------------------------------- + + In Emacs 23, `shift-selection-mode' is on by default, meaning that + cursor motions combined with the shift key should start or enlarge + regions. This conflicts with the use of `S-' commands in + Org to change timestamps, TODO keywords, priorities, and item + bullet types if the cursor is at such a location. By default, + `S-' commands outside special contexts don't do anything, + but you can customize the variable `org-support-shift-select'. + Org mode then tries to accommodate shift selection by (i) using it + outside of the special contexts where special commands apply, and + by (ii) extending an existing active region even if the cursor + moves across a special context. + +`CUA.el' by Kim. F. Storm + Key bindings in Org conflict with the `S-' keys used by + CUA mode (as well as `pc-select-mode' and `s-region-mode') to + select and extend the region. In fact, Emacs 23 has this built-in + in the form of `shift-selection-mode', see previous paragraph. If + you are using Emacs 23, you probably don't want to use another + package for this purpose. However, if you prefer to leave these + keys to a different package while working in Org mode, configure + the variable `org-replace-disputed-keys'. When set, Org will move + the following key bindings in Org files, and in the agenda buffer + (but not during date selection). + + S-UP => M-p S-DOWN => M-n + S-LEFT => M-- S-RIGHT => M-+ + C-S-LEFT => M-S-- C-S-RIGHT => M-S-+ + + Yes, these are unfortunately more difficult to remember. If you + want to have other replacement keys, look at the variable + `org-disputed-keys'. + +`ecomplete.el' by Lars Magne Ingebrigtsen + Ecomplete provides "electric" address completion in address header + lines in message buffers. Sadly Orgtbl mode cuts ecompletes power + supply: No completion happens when Orgtbl mode is enabled in + message buffers while entering text in address header lines. If + one wants to use ecomplete one should _not_ follow the advice to + automagically turn on Orgtbl mode in message buffers (see *note + Orgtbl mode::), but instead--after filling in the message + headers--turn on Orgtbl mode manually when needed in the messages + body. + +`filladapt.el' by Kyle Jones + Org mode tries to do the right thing when filling paragraphs, list + items and other elements. Many users reported they had problems + using both `filladapt.el' and Org mode, so a safe thing to do is + to disable it like this: + + (add-hook 'org-mode-hook 'turn-off-filladapt-mode) + +`yasnippet.el' + The way Org mode binds the key (binding to `[tab]' instead of + `"\t"') overrules YASnippet's access to this key. The following + code fixed this problem: + + (add-hook 'org-mode-hook + (lambda () + (org-set-local 'yas/trigger-key [tab]) + (define-key yas/keymap [tab] 'yas/next-field-or-maybe-expand))) + + The latest version of yasnippet doesn't play well with Org mode. + If the above code does not fix the conflict, start by defining the + following function: + + (defun yas/org-very-safe-expand () + (let ((yas/fallback-behavior 'return-nil)) (yas/expand))) + + Then, tell Org mode what to do with the new function: + + (add-hook 'org-mode-hook + (lambda () + (make-variable-buffer-local 'yas/trigger-key) + (setq yas/trigger-key [tab]) + (add-to-list 'org-tab-first-hook 'yas/org-very-safe-expand) + (define-key yas/keymap [tab] 'yas/next-field))) + +`windmove.el' by Hovav Shacham + This package also uses the `S-' keys, so everything written + in the paragraph above about CUA mode also applies here. If you + want make the windmove function active in locations where Org mode + does not have special functionality on `S-', add this to + your configuration: + + ;; Make windmove work in org-mode: + (add-hook 'org-shiftup-final-hook 'windmove-up) + (add-hook 'org-shiftleft-final-hook 'windmove-left) + (add-hook 'org-shiftdown-final-hook 'windmove-down) + (add-hook 'org-shiftright-final-hook 'windmove-right) + +`viper.el' by Michael Kifer + Viper uses `C-c /' and therefore makes this key not access the + corresponding Org mode command `org-sparse-tree'. You need to find + another key for this command, or override the key in + `viper-vi-global-user-map' with + + (define-key viper-vi-global-user-map "C-c /" 'org-sparse-tree) + + + +File: org, Node: org-crypt, Prev: Interaction, Up: Miscellaneous + +15.11 org-crypt.el +================== + +Org-crypt will encrypt the text of an entry, but not the headline, or +properties. Org-crypt uses the Emacs EasyPG library to encrypt and +decrypt files. + + Any text below a headline that has a `:crypt:' tag will be +automatically be encrypted when the file is saved. If you want to use +a different tag just customize the `org-crypt-tag-matcher' setting. + + To use org-crypt it is suggested that you have the following in your +`.emacs': + + (require 'org-crypt) + (org-crypt-use-before-save-magic) + (setq org-tags-exclude-from-inheritance (quote ("crypt"))) + + (setq org-crypt-key nil) + ;; GPG key to use for encryption + ;; Either the Key ID or set to nil to use symmetric encryption. + + (setq auto-save-default nil) + ;; Auto-saving does not cooperate with org-crypt.el: so you need + ;; to turn it off if you plan to use org-crypt.el quite often. + ;; Otherwise, you'll get an (annoying) message each time you + ;; start Org. + + ;; To turn it off only locally, you can insert this: + ;; + ;; # -*- buffer-auto-save-file-name: nil; -*- + + Excluding the crypt tag from inheritance prevents already encrypted +text being encrypted again. + + +File: org, Node: Hacking, Next: MobileOrg, Prev: Miscellaneous, Up: Top + +Appendix A Hacking +****************** + +This appendix covers some aspects where users can extend the +functionality of Org. + +* Menu: + +* Hooks:: How to reach into Org's internals +* Add-on packages:: Available extensions +* Adding hyperlink types:: New custom link types +* Adding export back-ends:: How to write new export back-ends +* Context-sensitive commands:: How to add functionality to such commands +* Tables in arbitrary syntax:: Orgtbl for LaTeX and other programs +* Dynamic blocks:: Automatically filled blocks +* Special agenda views:: Customized views +* Speeding up your agendas:: Tips on how to speed up your agendas +* Extracting agenda information:: Post-processing of agenda information +* Using the property API:: Writing programs that use entry properties +* Using the mapping API:: Mapping over all or selected entries + + +File: org, Node: Hooks, Next: Add-on packages, Prev: Hacking, Up: Hacking + +A.1 Hooks +========= + +Org has a large number of hook variables that can be used to add +functionality. This appendix about hacking is going to illustrate the +use of some of them. A complete list of all hooks with documentation is +maintained by the Worg project and can be found at +`http://orgmode.org/worg/org-configs/org-hooks.php'. + + +File: org, Node: Add-on packages, Next: Adding hyperlink types, Prev: Hooks, Up: Hacking + +A.2 Add-on packages +=================== + +A large number of add-on packages have been written by various authors. + + These packages are not part of Emacs, but they are distributed as +contributed packages with the separate release available at +`http://orgmode.org'. See the `contrib/README' file in the source code +directory for a list of contributed files. You may also find some more +information on the Worg page: `http://orgmode.org/worg/org-contrib/'. + + +File: org, Node: Adding hyperlink types, Next: Adding export back-ends, Prev: Add-on packages, Up: Hacking + +A.3 Adding hyperlink types +========================== + +Org has a large number of hyperlink types built-in (*note +Hyperlinks::). If you would like to add new link types, Org provides +an interface for doing so. Let's look at an example file, +`org-man.el', that will add support for creating links like +`[[man:printf][The printf manpage]]' to show Unix manual pages inside +Emacs: + + ;;; org-man.el - Support for links to manpages in Org + + (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 manpage." + (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 + +You would activate this new link type in `.emacs' with + + (require 'org-man) + +Let's go through the file and see what it does. + 1. It does `(require 'org)' to make sure that `org.el' has been + loaded. + + 2. The next line calls `org-add-link-type' to define a new link type + with prefix `man'. The call also contains the name of a function + that will be called to follow such a link. + + 3. The next line adds a function to `org-store-link-functions', in + order to allow the command `C-c l' to record a useful link in a + buffer displaying a man page. + + The rest of the file defines the necessary variables and functions. +First there is a customization variable that determines which Emacs +command should be used to display man pages. There are two options, +`man' and `woman'. Then the function to follow a link is defined. It +gets the link path as an argument--in this case the link path is just a +topic for the manual command. The function calls the value of +`org-man-command' to display the man page. + + Finally the function `org-man-store-link' is defined. When you try +to store a link with `C-c l', this function will be called to try to +make a link. The function must first decide if it is supposed to +create the link for this buffer type; we do this by checking the value +of the variable `major-mode'. If not, the function must exit and +return the value `nil'. If yes, the link is created by getting the +manual topic from the buffer name and prefixing it with the string +`man:'. Then it must call the command `org-store-link-props' and set +the `:type' and `:link' properties. Optionally you can also set the +`:description' property to provide a default for the link description +when the link is later inserted into an Org buffer with `C-c C-l'. + + When it makes sense for your new link type, you may also define a +function `org-PREFIX-complete-link' that implements special (e.g., +completion) support for inserting such a link with `C-c C-l'. Such a +function should not accept any arguments, and return the full link with +prefix. + + +File: org, Node: Adding export back-ends, Next: Context-sensitive commands, Prev: Adding hyperlink types, Up: Hacking + +A.4 Adding export back-ends +=========================== + +Org 8.0 comes with a completely rewritten export engine which makes it +easy to write new export back-ends, either from scratch, or from +deriving them from existing ones. + + Your two entry points are respectively `org-export-define-backend' +and `org-export-define-derived-backend'. To grok these functions, you +should first have a look at `ox-latex.el' (for how to define a new +back-end from scratch) and `ox-beamer.el' (for how to derive a new +back-end from an existing one. + + When creating a new back-end from scratch, the basic idea is to set +the name of the back-end (as a symbol) and an an alist of elements and +export functions. On top of this, you will need to set additional +keywords like `:menu-entry' (to display the back-end in the export +dispatcher), `:export-block' (to specify what blocks should not be +exported by this back-end), and `:options-alist' (to let the user set +export options that are specific to this back-end.) + + Deriving a new back-end is similar, except that you need to set +`:translate-alist' to an alist of export functions that should be used +instead of the parent back-end functions. + + For a complete reference documentation, see the Org Export Reference +on Worg (http://orgmode.org/worg/dev/org-export-reference.html). + + +File: org, Node: Context-sensitive commands, Next: Tables in arbitrary syntax, Prev: Adding export back-ends, Up: Hacking + +A.5 Context-sensitive commands +============================== + +Org has several commands that act differently depending on context. +The most important example is the `C-c C-c' (*note The very busy C-c +C-c key::). Also the `M-cursor' and `M-S-cursor' keys have this +property. + + Add-ons can tap into this functionality by providing a function that +detects special context for that add-on and executes functionality +appropriate for the context. Here is an example from Dan Davison's +`org-R.el' which allows you to evaluate commands based on the `R' +programming language (1). For this package, special contexts are lines +that start with `#+R:' or `#+RR:'. + + (defun org-R-apply-maybe () + "Detect if this is context for org-R and execute R commands." + (if (save-excursion + (beginning-of-line 1) + (looking-at "#\\+RR?:")) + (progn (call-interactively 'org-R-apply) + t) ;; to signal that we took action + nil)) ;; to signal that we did not + + (add-hook 'org-ctrl-c-ctrl-c-hook 'org-R-apply-maybe) + + The function first checks if the cursor is in such a line. If that +is the case, `org-R-apply' is called and the function returns `t' to +signal that action was taken, and `C-c C-c' will stop looking for other +contexts. If the function finds it should do nothing locally, it +returns `nil' so that other, similar functions can have a try. + + ---------- Footnotes ---------- + + (1) `org-R.el' has been replaced by the Org mode functionality +described in *note Working With Source Code:: and is now obsolete. + + +File: org, Node: Tables in arbitrary syntax, Next: Dynamic blocks, Prev: Context-sensitive commands, Up: Hacking + +A.6 Tables and lists in arbitrary syntax +======================================== + +Since Orgtbl mode can be used as a minor mode in arbitrary buffers, a +frequent feature request has been to make it work with native tables in +specific languages, for example LaTeX. However, this is extremely hard +to do in a general way, would lead to a customization nightmare, and +would take away much of the simplicity of the Orgtbl mode table editor. + + This appendix describes a different approach. We keep the Orgtbl +mode table in its native format (the source table), and use a custom +function to translate the table to the correct syntax, and to install +it in the right location (the target table). This puts the burden of +writing conversion functions on the user, but it allows for a very +flexible system. + + Bastien added the ability to do the same with lists, in Orgstruct +mode. You can use Org's facilities to edit and structure lists by +turning `orgstruct-mode' on, then locally exporting such lists in +another format (HTML, LaTeX or Texinfo.) + +* Menu: + +* Radio tables:: Sending and receiving radio tables +* A LaTeX example:: Step by step, almost a tutorial +* Translator functions:: Copy and modify +* Radio lists:: Sending and receiving lists + + +File: org, Node: Radio tables, Next: A LaTeX example, Prev: Tables in arbitrary syntax, Up: Tables in arbitrary syntax + +A.6.1 Radio tables +------------------ + +To define the location of the target table, you first need to create two +lines that are comments in the current mode, but contain magic words +`BEGIN/END RECEIVE ORGTBL' for Orgtbl mode to find. Orgtbl mode will +insert the translated table between these lines, replacing whatever was +there before. For example in C mode where comments are between `/* ... +*/': + + /* BEGIN RECEIVE ORGTBL table_name */ + /* END RECEIVE ORGTBL table_name */ + +Just above the source table, we put a special line that tells Orgtbl +mode how to translate this table and where to install it. For example: + #+ORGTBL: SEND table_name translation_function arguments... + +`table_name' is the reference name for the table that is also used in +the receiver lines. `translation_function' is the Lisp function that +does the translation. Furthermore, the line can contain a list of +arguments (alternating key and value) at the end. The arguments will be +passed as a property list to the translation function for +interpretation. A few standard parameters are already recognized and +acted upon before the translation function is called: + +`:skip N' + Skip the first N lines of the table. Hlines do count as separate + lines for this parameter! + +`:skipcols (n1 n2 ...)' + List of columns that should be skipped. If the table has a column + with calculation marks, that column is automatically discarded as + well. Please note that the translator function sees the table + _after_ the removal of these columns, the function never knows + that there have been additional columns. + +`:no-escape t' + When non-`nil', do not escape special characters `&%#_^' when + exporting the table. The default value is `nil'. + +The one problem remaining is how to keep the source table in the buffer +without disturbing the normal workings of the file, for example during +compilation of a C file or processing of a LaTeX file. There are a +number of different solutions: + + * The table could be placed in a block comment if that is supported + by the language. For example, in C mode you could wrap the table + between `/*' and `*/' lines. + + * Sometimes it is possible to put the table after some kind of END + statement, for example `\bye' in TeX and `\end{document}' in LaTeX. + + * You can just comment the table line-by-line whenever you want to + process the file, and uncomment it whenever you need to edit the + table. This only sounds tedious--the command `M-x + orgtbl-toggle-comment RET' makes this comment-toggling very easy, + in particular if you bind it to a key. + + +File: org, Node: A LaTeX example, Next: Translator functions, Prev: Radio tables, Up: Tables in arbitrary syntax + +A.6.2 A LaTeX example of radio tables +------------------------------------- + +The best way to wrap the source table in LaTeX is to use the `comment' +environment provided by `comment.sty'. It has to be activated by +placing `\usepackage{comment}' into the document header. Orgtbl mode +can insert a radio table skeleton(1) with the command `M-x +orgtbl-insert-radio-table RET'. You will be prompted for a table name, +let's say we use `salesfigures'. You will then get the following +template: + + % BEGIN RECEIVE ORGTBL salesfigures + % END RECEIVE ORGTBL salesfigures + \begin{comment} + #+ORGTBL: SEND salesfigures orgtbl-to-latex + | | | + \end{comment} + +The `#+ORGTBL: SEND' line tells Orgtbl mode to use the function +`orgtbl-to-latex' to convert the table into LaTeX and to put it into +the receiver location with name `salesfigures'. You may now fill in +the table--feel free to use the spreadsheet features(2): + + % BEGIN RECEIVE ORGTBL salesfigures + % END RECEIVE ORGTBL salesfigures + \begin{comment} + #+ORGTBL: SEND salesfigures orgtbl-to-latex + | Month | Days | Nr sold | per day | + |-------+------+---------+---------| + | Jan | 23 | 55 | 2.4 | + | Feb | 21 | 16 | 0.8 | + | March | 22 | 278 | 12.6 | + #+TBLFM: $4=$3/$2;%.1f + % $ (optional extra dollar to keep font-lock happy, see footnote) + \end{comment} + +When you are done, press `C-c C-c' in the table to get the converted +table inserted between the two marker lines. + + Now let's assume you want to make the table header by hand, because +you want to control how columns are aligned, etc. In this case we make +sure that the table translator skips the first 2 lines of the source +table, and tell the command to work as a splice, i.e., to not produce +header and footer commands of the target table: + + \begin{tabular}{lrrr} + Month & \multicolumn{1}{c}{Days} & Nr.\ sold & per day\\ + % BEGIN RECEIVE ORGTBL salesfigures + % END RECEIVE ORGTBL salesfigures + \end{tabular} + % + \begin{comment} + #+ORGTBL: SEND salesfigures orgtbl-to-latex :splice t :skip 2 + | Month | Days | Nr sold | per day | + |-------+------+---------+---------| + | Jan | 23 | 55 | 2.4 | + | Feb | 21 | 16 | 0.8 | + | March | 22 | 278 | 12.6 | + #+TBLFM: $4=$3/$2;%.1f + \end{comment} + + The LaTeX translator function `orgtbl-to-latex' is already part of +Orgtbl mode. It uses a `tabular' environment to typeset the table and +marks horizontal lines with `\hline'. Furthermore, it interprets the +following parameters (see also *note Translator functions::): + +`:splice nil/t' + When set to t, return only table body lines, don't wrap them into a + tabular environment. Default is `nil'. + +`:fmt fmt' + A format to be used to wrap each field, it should contain `%s' for + the original field value. For example, to wrap each field value + in dollars, you could use `:fmt "$%s$"'. This may also be a + property list with column numbers and formats, for example `:fmt + (2 "$%s$" 4 "%s\\%%")'. A function of one argument can be used in + place of the strings; the function must return a formatted string. + +`:efmt efmt' + Use this format to print numbers with exponentials. The format + should have `%s' twice for inserting mantissa and exponent, for + example `"%s\\times10^{%s}"'. The default is `"%s\\,(%s)"'. This + may also be a property list with column numbers and formats, for + example `:efmt (2 "$%s\\times10^{%s}$" 4 "$%s\\cdot10^{%s}$")'. + After `efmt' has been applied to a value, `fmt' will also be + applied. Similar to `fmt', functions of two arguments can be + supplied instead of strings. + + ---------- Footnotes ---------- + + (1) By default this works only for LaTeX, HTML, and Texinfo. +Configure the variable `orgtbl-radio-table-templates' to install +templates for other modes. + + (2) If the `#+TBLFM' line contains an odd number of dollar +characters, this may cause problems with font-lock in LaTeX mode. As +shown in the example you can fix this by adding an extra line inside the +`comment' environment that is used to balance the dollar expressions. +If you are using AUCTeX with the font-latex library, a much better +solution is to add the `comment' environment to the variable +`LaTeX-verbatim-environments'. + + +File: org, Node: Translator functions, Next: Radio lists, Prev: A LaTeX example, Up: Tables in arbitrary syntax + +A.6.3 Translator functions +-------------------------- + +Orgtbl mode has several translator functions built-in: `orgtbl-to-csv' +(comma-separated values), `orgtbl-to-tsv' (TAB-separated values) +`orgtbl-to-latex', `orgtbl-to-html', and `orgtbl-to-texinfo'. Except +for `orgtbl-to-html'(1), these all use a generic translator, +`orgtbl-to-generic'. For example, `orgtbl-to-latex' itself is a very +short function that computes the column definitions for the `tabular' +environment, defines a few field and line separators and then hands +processing over to the generic translator. Here is the entire code: + + (defun orgtbl-to-latex (table params) + "Convert the Orgtbl mode TABLE to LaTeX." + (let* ((alignment (mapconcat (lambda (x) (if x "r" "l")) + org-table-last-alignment "")) + (params2 + (list + :tstart (concat "\\begin{tabular}{" alignment "}") + :tend "\\end{tabular}" + :lstart "" :lend " \\\\" :sep " & " + :efmt "%s\\,(%s)" :hline "\\hline"))) + (orgtbl-to-generic table (org-combine-plists params2 params)))) + + As you can see, the properties passed into the function (variable +PARAMS) are combined with the ones newly defined in the function +(variable PARAMS2). The ones passed into the function (i.e., the ones +set by the `ORGTBL SEND' line) take precedence. So if you would like +to use the LaTeX translator, but wanted the line endings to be +`\\[2mm]' instead of the default `\\', you could just overrule the +default with + + #+ORGTBL: SEND test orgtbl-to-latex :lend " \\\\[2mm]" + + For a new language, you can either write your own converter function +in analogy with the LaTeX translator, or you can use the generic +function directly. For example, if you have a language where a table +is started with `!BTBL!', ended with `!ETBL!', and where table lines are +started with `!BL!', ended with `!EL!', and where the field separator +is a TAB, you could call the generic translator like this (on a single +line!): + + #+ORGTBL: SEND test orgtbl-to-generic :tstart "!BTBL!" :tend "!ETBL!" + :lstart "!BL! " :lend " !EL!" :sep "\t" + +Please check the documentation string of the function +`orgtbl-to-generic' for a full list of parameters understood by that +function, and remember that you can pass each of them into +`orgtbl-to-latex', `orgtbl-to-texinfo', and any other function using +the generic function. + + Of course you can also write a completely new function doing +complicated things the generic translator cannot do. A translator +function takes two arguments. The first argument is the table, a list +of lines, each line either the symbol `hline' or a list of fields. The +second argument is the property list containing all parameters +specified in the `#+ORGTBL: SEND' line. The function must return a +single string containing the formatted table. If you write a generally +useful translator, please post it on so that +others can benefit from your work. + + ---------- Footnotes ---------- + + (1) The HTML translator uses the same code that produces tables +during HTML export. + + +File: org, Node: Radio lists, Prev: Translator functions, Up: Tables in arbitrary syntax + +A.6.4 Radio lists +----------------- + +Sending and receiving radio lists works exactly the same way as sending +and receiving radio tables (*note Radio tables::). As for radio +tables, you can insert radio list templates in HTML, LaTeX and Texinfo +modes by calling `org-list-insert-radio-list'. + + Here are the differences with radio tables: + + - Orgstruct mode must be active. + + - Use the `ORGLST' keyword instead of `ORGTBL'. + + - The available translation functions for radio lists don't take + parameters. + + - `C-c C-c' will work when pressed on the first item of the list. + + Here is a LaTeX example. Let's say that you have this in your LaTeX +file: + + % BEGIN RECEIVE ORGLST to-buy + % END RECEIVE ORGLST to-buy + \begin{comment} + #+ORGLST: SEND to-buy org-list-to-latex + - a new house + - a new computer + + a new keyboard + + a new mouse + - a new life + \end{comment} + + Pressing `C-c C-c' on `a new house' and will insert the converted +LaTeX list between the two marker lines. + + +File: org, Node: Dynamic blocks, Next: Special agenda views, Prev: Tables in arbitrary syntax, Up: Hacking + +A.7 Dynamic blocks +================== + +Org documents can contain _dynamic blocks_. These are specially marked +regions that are updated by some user-written function. A good example +for such a block is the clock table inserted by the command `C-c C-x +C-r' (*note Clocking work time::). + + Dynamic blocks are enclosed by a BEGIN-END structure that assigns a +name to the block and can also specify parameters for the function +producing the content of the block. + + #+BEGIN: myblock :parameter1 value1 :parameter2 value2 ... + + #+END: + + Dynamic blocks are updated with the following commands + +`C-c C-x C-u (`org-dblock-update')' + Update dynamic block at point. + +`C-u C-c C-x C-u' + Update all dynamic blocks in the current file. + + Updating a dynamic block means to remove all the text between BEGIN +and END, parse the BEGIN line for parameters and then call the specific +writer function for this block to insert the new content. If you want +to use the original content in the writer function, you can use the +extra parameter `:content'. + + For a block with name `myblock', the writer function is +`org-dblock-write:myblock' with as only parameter a property list with +the parameters given in the begin line. Here is a trivial example of a +block that keeps track of when the block update function was last run: + + #+BEGIN: block-update-time :format "on %m/%d/%Y at %H:%M" + + #+END: + +The corresponding block writer function could look like this: + + (defun org-dblock-write:block-update-time (params) + (let ((fmt (or (plist-get params :format) "%d. %m. %Y"))) + (insert "Last block update at: " + (format-time-string fmt (current-time))))) + + If you want to make sure that all dynamic blocks are always +up-to-date, you could add the function `org-update-all-dblocks' to a +hook, for example `before-save-hook'. `org-update-all-dblocks' is +written in a way such that it does nothing in buffers that are not in +`org-mode'. + + You can narrow the current buffer to the current dynamic block (like +any other block) with `org-narrow-to-block'. + + +File: org, Node: Special agenda views, Next: Speeding up your agendas, Prev: Dynamic blocks, Up: Hacking + +A.8 Special agenda views +======================== + +Org provides a special hook that can be used to narrow down the +selection made by these agenda views: `agenda', `agenda*'(1), `todo', +`alltodo', `tags', `tags-todo', `tags-tree'. You may specify a +function that is used at each match to verify if the match should +indeed be part of the agenda view, and if not, how much should be +skipped. You can specify a global condition that will be applied to +all agenda views, this condition would be stored in the variable +`org-agenda-skip-function-global'. More commonly, such a definition is +applied only to specific custom searches, using +`org-agenda-skip-function'. + + Let's say you want to produce a list of projects that contain a +WAITING tag anywhere in the project tree. Let's further assume that +you have marked all tree headings that define a project with the TODO +keyword PROJECT. In this case you would run a TODO search for the +keyword PROJECT, but skip the match unless there is a WAITING tag +anywhere in the subtree belonging to the project line. + + To achieve this, you must write a function that searches the subtree +for the tag. If the tag is found, the function must return `nil' to +indicate that this match should not be skipped. If there is no such +tag, return the location of the end of the subtree, to indicate that +search should continue from there. + + (defun my-skip-unless-waiting () + "Skip trees that are not waiting" + (let ((subtree-end (save-excursion (org-end-of-subtree t)))) + (if (re-search-forward ":waiting:" subtree-end t) + nil ; tag found, do not skip + subtree-end))) ; tag not found, continue after end of subtree + + Now you may use this function in an agenda custom command, for +example like this: + + (org-add-agenda-custom-command + '("b" todo "PROJECT" + ((org-agenda-skip-function 'my-skip-unless-waiting) + (org-agenda-overriding-header "Projects waiting for something: ")))) + + Note that this also binds `org-agenda-overriding-header' to get a +meaningful header in the agenda view. + + A general way to create custom searches is to base them on a search +for entries with a certain level limit. If you want to study all +entries with your custom search function, simply do a search for +`LEVEL>0'(2), and then use `org-agenda-skip-function' to select the +entries you really want to have. + + You may also put a Lisp form into `org-agenda-skip-function'. In +particular, you may use the functions `org-agenda-skip-entry-if' and +`org-agenda-skip-subtree-if' in this form, for example: + +`(org-agenda-skip-entry-if 'scheduled)' + Skip current entry if it has been scheduled. + +`(org-agenda-skip-entry-if 'notscheduled)' + Skip current entry if it has not been scheduled. + +`(org-agenda-skip-entry-if 'deadline)' + Skip current entry if it has a deadline. + +`(org-agenda-skip-entry-if 'scheduled 'deadline)' + Skip current entry if it has a deadline, or if it is scheduled. + +`(org-agenda-skip-entry-if 'todo '("TODO" "WAITING"))' + Skip current entry if the TODO keyword is TODO or WAITING. + +`(org-agenda-skip-entry-if 'todo 'done)' + Skip current entry if the TODO keyword marks a DONE state. + +`(org-agenda-skip-entry-if 'timestamp)' + Skip current entry if it has any timestamp, may also be deadline + or scheduled. + +`(org-agenda-skip-entry-if 'regexp "regular expression")' + Skip current entry if the regular expression matches in the entry. + +`(org-agenda-skip-entry-if 'notregexp "regular expression")' + Skip current entry unless the regular expression matches. + +`(org-agenda-skip-subtree-if 'regexp "regular expression")' + Same as above, but check and skip the entire subtree. + + Therefore we could also have written the search for WAITING projects +like this, even without defining a special function: + + (org-add-agenda-custom-command + '("b" todo "PROJECT" + ((org-agenda-skip-function '(org-agenda-skip-subtree-if + 'regexp ":waiting:")) + (org-agenda-overriding-header "Projects waiting for something: ")))) + + ---------- Footnotes ---------- + + (1) The `agenda*' view is the same than `agenda' except that it only +considers _appointments_, i.e., scheduled and deadline items that have a +time specification `[h]h:mm' in their time-stamps. + + (2) Note that, when using `org-odd-levels-only', a level number +corresponds to order in the hierarchy, not to the number of stars. + + +File: org, Node: Speeding up your agendas, Next: Extracting agenda information, Prev: Special agenda views, Up: Hacking + +A.9 Speeding up your agendas +============================ + +When your Org files grow in both number and size, agenda commands may +start to become slow. Below are some tips on how to speed up the +agenda commands. + + 1. Reduce the number of Org agenda files: this will reduce the + slowness caused by accessing a hard drive. + + 2. Reduce the number of DONE and archived headlines: this way the + agenda does not need to skip them. + + 3. Inhibit the dimming of blocked tasks: + (setq org-agenda-dim-blocked-tasks nil) + + 4. Inhibit agenda files startup options: + (setq org-agenda-inhibit-startup nil) + + 5. Disable tag inheritance in agenda: + (setq org-agenda-use-tag-inheritance nil) + + You can set these options for specific agenda views only. See the +docstrings of these variables for details on why they affect the agenda +generation, and this dedicated Worg page +(http://orgmode.org/worg/agenda-optimization.html) for further +explanations. + + +File: org, Node: Extracting agenda information, Next: Using the property API, Prev: Speeding up your agendas, Up: Hacking + +A.10 Extracting agenda information +================================== + +Org provides commands to access agenda information for the command line +in Emacs batch mode. This extracted information can be sent directly +to a printer, or it can be read by a program that does further +processing of the data. The first of these commands is the function +`org-batch-agenda', that produces an agenda view and sends it as ASCII +text to STDOUT. The command takes a single string as parameter. If +the string has length 1, it is used as a key to one of the commands you +have configured in `org-agenda-custom-commands', basically any key you +can use after `C-c a'. For example, to directly print the current TODO +list, you could use + + emacs -batch -l ~/.emacs -eval '(org-batch-agenda "t")' | lpr + + If the parameter is a string with 2 or more characters, it is used +as a tags/TODO match string. For example, to print your local shopping +list (all items with the tag `shop', but excluding the tag `NewYork'), +you could use + + emacs -batch -l ~/.emacs \ + -eval '(org-batch-agenda "+shop-NewYork")' | lpr + +You may also modify parameters on the fly like this: + + emacs -batch -l ~/.emacs \ + -eval '(org-batch-agenda "a" \ + org-agenda-span (quote month) \ + org-agenda-include-diary nil \ + org-agenda-files (quote ("~/org/project.org")))' \ + | lpr + +which will produce a 30-day agenda, fully restricted to the Org file +`~/org/projects.org', not even including the diary. + + If you want to process the agenda data in more sophisticated ways, +you can use the command `org-batch-agenda-csv' to get a comma-separated +list of values for each agenda item. Each line in the output will +contain a number of fields separated by commas. The fields in a line +are: + + category The category of the item + head The headline, without TODO keyword, TAGS and PRIORITY + type The type of the agenda entry, can be + todo selected in TODO match + tagsmatch selected in tags match + diary imported from diary + deadline a deadline + scheduled scheduled + timestamp appointment, selected by timestamp + closed entry was closed on date + upcoming-deadline warning about nearing deadline + past-scheduled forwarded scheduled item + block entry has date block including date + todo The TODO keyword, if any + tags All tags including inherited ones, separated by colons + date The relevant date, like 2007-2-14 + time The time, like 15:00-16:50 + extra String with extra planning info + priority-l The priority letter if any was given + priority-n The computed numerical priority + +Time and date will only be given if a timestamp (or deadline/scheduled) +led to the selection of the item. + + A CSV list like this is very easy to use in a post-processing script. +For example, here is a Perl program that gets the TODO list from +Emacs/Org and prints all the items, preceded by a checkbox: + + #!/usr/bin/perl + + # define the Emacs command to run + $cmd = "emacs -batch -l ~/.emacs -eval '(org-batch-agenda-csv \"t\")'"; + + # run it and capture the output + $agenda = qx{$cmd 2>/dev/null}; + + # loop over all lines + foreach $line (split(/\n/,$agenda)) { + # get the individual values + ($category,$head,$type,$todo,$tags,$date,$time,$extra, + $priority_l,$priority_n) = split(/,/,$line); + # process and print + print "[ ] $head\n"; + } + + +File: org, Node: Using the property API, Next: Using the mapping API, Prev: Extracting agenda information, Up: Hacking + +A.11 Using the property API +=========================== + +Here is a description of the functions that can be used to work with +properties. + + -- Function: org-entry-properties &optional pom which + Get all properties of the entry at point-or-marker POM. + This includes the TODO keyword, the tags, time strings for + deadline, scheduled, and clocking, and any additional properties + defined in the entry. The return value is an alist. Keys may + occur multiple times if the property key was used several times. + POM may also be `nil', in which case the current entry is used. + If WHICH is `nil' or `all', get all properties. If WHICH is + `special' or `standard', only get that subclass. + + -- Function: org-entry-get pom property &optional inherit + Get value of `PROPERTY' for entry at point-or-marker `POM'. By + default, this only looks at properties defined locally in the + entry. If `INHERIT' is non-`nil' and the entry does not have the + property, then also check higher levels of the hierarchy. If + `INHERIT' is the symbol `selective', use inheritance if and only + if the setting of `org-use-property-inheritance' selects + `PROPERTY' for inheritance. + + -- Function: org-entry-delete pom property + Delete the property `PROPERTY' from entry at point-or-marker POM. + + -- Function: org-entry-put pom property value + Set `PROPERTY' to `VALUE' for entry at point-or-marker POM. + + -- Function: org-buffer-property-keys &optional include-specials + Get all property keys in the current buffer. + + -- Function: org-insert-property-drawer + Insert a property drawer for the current entry. Also + + -- Function: org-entry-put-multivalued-property pom property &rest + values + Set `PROPERTY' at point-or-marker `POM' to `VALUES'. `VALUES' + should be a list of strings. They will be concatenated, with + spaces as separators. + + -- Function: org-entry-get-multivalued-property pom property + Treat the value of the property `PROPERTY' as a + whitespace-separated list of values and return the values as a + list of strings. + + -- Function: org-entry-add-to-multivalued-property pom property value + Treat the value of the property `PROPERTY' as a + whitespace-separated list of values and make sure that `VALUE' is + in this list. + + -- Function: org-entry-remove-from-multivalued-property pom property + value + Treat the value of the property `PROPERTY' as a + whitespace-separated list of values and make sure that `VALUE' is + _not_ in this list. + + -- Function: org-entry-member-in-multivalued-property pom property + value + Treat the value of the property `PROPERTY' as a + whitespace-separated list of values and check if `VALUE' is in + this list. + + -- User Option: org-property-allowed-value-functions + Hook for functions supplying allowed values for a specific + property. The functions must take a single argument, the name of + the property, and return a flat list of allowed values. If `:ETC' + is one of the values, use the values as completion help, but allow + also other values to be entered. The functions must return `nil' + if they are not responsible for this property. + + +File: org, Node: Using the mapping API, Prev: Using the property API, Up: Hacking + +A.12 Using the mapping API +========================== + +Org has sophisticated mapping capabilities to find all entries +satisfying certain criteria. Internally, this functionality is used to +produce agenda views, but there is also an API that can be used to +execute arbitrary functions for each or selected entries. The main +entry point for this API is: + + -- Function: org-map-entries func &optional match scope &rest skip + Call `FUNC' at each headline selected by `MATCH' in `SCOPE'. + + `FUNC' is a function or a Lisp form. The function will be called + without arguments, with the cursor positioned at the beginning of + the headline. The return values of all calls to the function will + be collected and returned as a list. + + The call to `FUNC' will be wrapped into a save-excursion form, so + `FUNC' does not need to preserve point. After evaluation, the + cursor will be moved to the end of the line (presumably of the + headline of the processed entry) and search continues from there. + Under some circumstances, this may not produce the wanted results. + For example, if you have removed (e.g., archived) the current + (sub)tree it could mean that the next entry will be skipped + entirely. In such cases, you can specify the position from where + search should continue by making `FUNC' set the variable + `org-map-continue-from' to the desired buffer position. + + `MATCH' is a tags/property/todo match as it is used in the agenda + match view. Only headlines that are matched by this query will be + considered during the iteration. When `MATCH' is `nil' or `t', all + headlines will be visited by the iteration. + + `SCOPE' determines the scope of this command. It can be any of: + + nil the current buffer, respecting the restriction if any + tree the subtree started with the entry at point + region The entries within the active region, if any + 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 + The remaining args are treated as settings for the skipping + facilities of the scanner. The following items can be given here: + + archive skip trees with the archive tag + comment skip trees with the COMMENT keyword + function or Lisp form + will be used as value for `org-agenda-skip-function', + so whenever the function returns t, FUNC + will not be called for that entry and search will + continue from the point where the function leaves it + + The function given to that mapping routine can really do anything +you like. It can use the property API (*note Using the property API::) +to gather more information about the entry, or in order to change +metadata in the entry. Here are a couple of functions that might be +handy: + + -- Function: org-todo &optional arg + Change the TODO state of the entry. See the docstring of the + functions for the many possible values for the argument `ARG'. + + -- Function: org-priority &optional action + Change the priority of the entry. See the docstring of this + function for the possible values for `ACTION'. + + -- Function: org-toggle-tag tag &optional onoff + Toggle the tag `TAG' in the current entry. Setting `ONOFF' to + either `on' or `off' will not toggle tag, but ensure that it is + either on or off. + + -- Function: org-promote + Promote the current entry. + + -- Function: org-demote + Demote the current entry. + + Here is a simple example that will turn all entries in the current +file with a tag `TOMORROW' into TODO entries with the keyword +`UPCOMING'. Entries in comment trees and in archive trees will be +ignored. + + (org-map-entries + '(org-todo "UPCOMING") + "+TOMORROW" 'file 'archive 'comment) + + The following example counts the number of entries with TODO keyword +`WAITING', in all agenda files. + + (length (org-map-entries t "/+WAITING" 'agenda)) + + +File: org, Node: MobileOrg, Next: History and Acknowledgments, Prev: Hacking, Up: Top + +Appendix B MobileOrg +******************** + +MobileOrg is the name of the mobile companion app for Org mode, +currently available for iOS and for Android. MobileOrg offers offline +viewing and capture support for an Org mode system rooted on a "real" +computer. It does also allow you to record changes to existing +entries. The iOS implementation (https://github.com/MobileOrg/) for the +iPhone/iPod Touch/iPad series of devices, was started by Richard +Moreland and is now in the hands Sean Escriva. Android users should +check out MobileOrg Android +(http://wiki.github.com/matburt/mobileorg-android/) by Matt Jones. The +two implementations are not identical but offer similar features. + + This appendix describes the support Org has for creating agenda +views in a format that can be displayed by MobileOrg, and for +integrating notes captured and changes made by MobileOrg into the main +system. + + For changing tags and TODO states in MobileOrg, you should have set +up the customization variables `org-todo-keywords' and `org-tag-alist' +to cover all important tags and TODO keywords, even if individual files +use only part of these. MobileOrg will also offer you states and tags +set up with in-buffer settings, but it will understand the logistics of +TODO state sets (*note Per-file keywords::) and mutually exclusive tags +(*note Setting tags::) only for those set in these variables. + +* Menu: + +* Setting up the staging area:: Where to interact with the mobile device +* Pushing to MobileOrg:: Uploading Org files and agendas +* Pulling from MobileOrg:: Integrating captured and flagged items + + +File: org, Node: Setting up the staging area, Next: Pushing to MobileOrg, Prev: MobileOrg, Up: MobileOrg + +B.1 Setting up the staging area +=============================== + +MobileOrg needs to interact with Emacs through a directory on a server. +If you are using a public server, you should consider to encrypt the +files that are uploaded to the server. This can be done with Org mode +7.02 and with MobileOrg 1.5 (iPhone version), and you need an `openssl' +installation on your system. To turn on encryption, set a password in +MobileOrg and, on the Emacs side, configure the variable +`org-mobile-use-encryption'(1). + + The easiest way to create that directory is to use a free +Dropbox.com (http://dropbox.com) account(2). When MobileOrg first +connects to your Dropbox, it will create a directory MobileOrg inside +the Dropbox. After the directory has been created, tell Emacs about it: + + (setq org-mobile-directory "~/Dropbox/MobileOrg") + + Org mode has commands to put files for MobileOrg into that directory, +and to read captured notes from there. + + ---------- Footnotes ---------- + + (1) If you can safely store the password in your Emacs setup, you +might also want to configure `org-mobile-encryption-password'. Please +read the docstring of that variable. Note that encryption will apply +only to the contents of the `.org' files. The file names themselves +will remain visible. + + (2) If you cannot use Dropbox, or if your version of MobileOrg does +not support it, you can use a webdav server. For more information, +check out the documentation of MobileOrg and also this FAQ entry +(http://orgmode.org/worg/org-faq.html#mobileorg_webdav). + + +File: org, Node: Pushing to MobileOrg, Next: Pulling from MobileOrg, Prev: Setting up the staging area, Up: MobileOrg + +B.2 Pushing to MobileOrg +======================== + +This operation copies all files currently listed in `org-mobile-files' +to the directory `org-mobile-directory'. By default this list contains +all agenda files (as listed in `org-agenda-files'), but additional files +can be included by customizing `org-mobile-files'. File names will be +staged with paths relative to `org-directory', so all files should be +inside this directory(1). + + The push operation also creates a special Org file `agendas.org' with +all custom agenda view defined by the user(2). + + Finally, Org writes the file `index.org', containing links to all +other files. MobileOrg first reads this file from the server, and then +downloads all agendas and Org files listed in it. To speed up the +download, MobileOrg will only read files whose checksums(3) have +changed. + + ---------- Footnotes ---------- + + (1) Symbolic links in `org-directory' need to have the same name +than their targets. + + (2) While creating the agendas, Org mode will force ID properties on +all referenced entries, so that these entries can be uniquely +identified if MobileOrg flags them for further action. If you do not +want to get these properties in so many entries, you can set the +variable `org-mobile-force-id-on-agenda-items' to `nil'. Org mode will +then rely on outline paths, in the hope that these will be unique +enough. + + (3) Checksums are stored automatically in the file `checksums.dat' + + +File: org, Node: Pulling from MobileOrg, Prev: Pushing to MobileOrg, Up: MobileOrg + +B.3 Pulling from MobileOrg +========================== + +When MobileOrg synchronizes with the server, it not only pulls the Org +files for viewing. It also appends captured entries and pointers to +flagged and changed entries to the file `mobileorg.org' on the server. +Org has a _pull_ operation that integrates this information into an +inbox file and operates on the pointers to flagged entries. Here is +how it works: + + 1. Org moves all entries found in `mobileorg.org'(1) and appends them + to the file pointed to by the variable + `org-mobile-inbox-for-pull'. Each captured entry and each editing + event will be a top-level entry in the inbox file. + + 2. After moving the entries, Org will attempt to implement the + changes made in MobileOrg. Some changes are applied directly and + without user interaction. Examples are all changes to tags, TODO + state, headline and body text that can be cleanly applied. + Entries that have been flagged for further action will receive a + tag `:FLAGGED:', so that they can be easily found again. When + there is a problem finding an entry or applying the change, the + pointer entry will remain in the inbox and will be marked with an + error message. You need to later resolve these issues by hand. + + 3. Org will then generate an agenda view with all flagged entries. + The user should then go through these entries and do whatever + actions are necessary. If a note has been stored while flagging + an entry in MobileOrg, that note will be displayed in the echo + area when the cursor is on the corresponding agenda line. + + `?' + Pressing `?' in that special agenda will display the full + flagging note in another window and also push it onto the + kill ring. So you could use `? z C-y C-c C-c' to store that + flagging note as a normal note in the entry. Pressing `?' + twice in succession will offer to remove the `:FLAGGED:' tag + along with the recorded flagging note (which is stored in a + property). In this way you indicate that the intended + processing for this flagged entry is finished. + + If you are not able to process all flagged entries directly, you can +always return to this agenda view(2) using `C-c a ?'. + + ---------- Footnotes ---------- + + (1) `mobileorg.org' will be empty after this operation. + + (2) Note, however, that there is a subtle difference. The view +created automatically by `M-x org-mobile-pull RET' is guaranteed to +search all files that have been addressed by the last pull. This might +include a file that is not currently in your list of agenda files. If +you later use `C-c a ?' to regenerate the view, only the current agenda +files will be searched. + + +File: org, Node: History and Acknowledgments, Next: GNU Free Documentation License, Prev: MobileOrg, Up: Top + +Appendix C History and acknowledgments +************************************** + +C.1 From Carsten +================ + +Org was born in 2003, out of frustration over the user interface of the +Emacs Outline mode. I was trying to organize my notes and projects, +and using Emacs seemed to be the natural way to go. However, having to +remember eleven different commands with two or three keys per command, +only to hide and show parts of the outline tree, that seemed entirely +unacceptable to me. Also, when using outlines to take notes, I +constantly wanted to restructure the tree, organizing it parallel to my +thoughts and plans. _Visibility cycling_ and _structure editing_ were +originally implemented in the package `outline-magic.el', but quickly +moved to the more general `org.el'. As this environment became +comfortable for project planning, the next step was adding _TODO +entries_, basic _timestamps_, and _table support_. These areas +highlighted the two main goals that Org still has today: to be a new, +outline-based, plain text mode with innovative and intuitive editing +features, and to incorporate project planning functionality directly +into a notes file. + + Since the first release, literally thousands of emails to me or to + have provided a constant stream of bug reports, +feedback, new ideas, and sometimes patches and add-on code. Many +thanks to everyone who has helped to improve this package. I am trying +to keep here a list of the people who had significant influence in +shaping one or more aspects of Org. The list may not be complete, if I +have forgotten someone, please accept my apologies and let me know. + + Before I get to this list, a few special mentions are in order: + +Bastien Guerry + Bastien has written a large number of extensions to Org (most of + them integrated into the core by now), including the LaTeX + exporter and the plain list parser. His support during the early + days, when he basically acted as co-maintainer, was central to the + success of this project. Bastien also invented Worg, helped + establishing the Web presence of Org, and sponsored hosting costs + for the orgmode.org website. + +Eric Schulte and Dan Davison + Eric and Dan are jointly responsible for the Org-babel system, + which turns Org into a multi-language environment for evaluating + code and doing literate programming and reproducible research. + +John Wiegley + John has contributed a number of great ideas and patches directly + to Org, including the attachment system (`org-attach.el'), + integration with Apple Mail (`org-mac-message.el'), hierarchical + dependencies of TODO items, habit tracking (`org-habits.el'), and + encryption (`org-crypt.el'). Also, the capture system is really + an extended copy of his great `remember.el'. + +Sebastian Rose + Without Sebastian, the HTML/XHTML publishing of Org would be the + pitiful work of an ignorant amateur. Sebastian has pushed this + part of Org onto a much higher level. He also wrote + `org-info.js', a Java script for displaying web pages derived from + Org using an Info-like or a folding interface with single-key + navigation. + +See below for the full list of contributions! Again, please let me +know what I am missing here! + +C.2 From Bastien +================ + +I (Bastien) have been maintaining Org since January 2011. This appendix +would not be complete without adding a few more acknowledgements and +thanks to Carsten's ones above. + + I am first grateful to Carsten for his trust while handing me over +the maintainership of Org. His unremitting support is what really +helped me getting more confident over time, with both the community and +the code. + + When I took over maintainership, I knew I would have to make Org more +collaborative than ever, as I would have to rely on people that are more +knowledgeable than I am on many parts of the code. Here is a list of +the persons I could rely on, they should really be considered +co-maintainers, either of the code or the community: + +Eric Schulte + Eric is maintaining the Babel parts of Org. His reactivity here + kept me away from worrying about possible bugs here and let me + focus on other parts. + +Nicolas Goaziou + Nicolas is maintaining the consistency of the deepest parts of + Org. His work on `org-element.el' and `ox.el' has been + outstanding, and opened the doors for many new ideas and features. + He rewrote many of the old exporters to use the new export engine, + and helped with documenting this major change. More importantly + (if that's possible), he has been more than reliable during all + the work done for Org 8.0, and always very reactive on the mailing + list. + +Achim Gratz + Achim rewrote the building process of Org, turning some _ad hoc_ + tools into a flexible and conceptually clean process. He + patiently coped with the many hiccups that such a change can + create for users. + +Nick Dokos + The Org mode mailing list would not be such a nice place without + Nick, who patiently helped users so many times. It is impossible + to overestimate such a great help, and the list would not be so + active without him. + + I received support from so many users that it is clearly impossible +to be fair when shortlisting a few of them, but Org's history would not +be complete if the ones above were not mentioned in this manual. + +C.3 List of contributions +========================= + + * Russel Adams came up with the idea for drawers. + + * Suvayu Ali has steadily helped on the mailing list, providing + useful feedback on many features and several patches. + + * Luis Anaya wrote `ox-man.el'. + + * Thomas Baumann wrote `org-bbdb.el' and `org-mhe.el'. + + * Michael Brand helped by reporting many bugs and testing many + features. He also implemented the distinction between empty + fields and 0-value fields in Org's spreadsheets. + + * Christophe Bataillon created the great unicorn logo that we use on + the Org mode website. + + * Alex Bochannek provided a patch for rounding timestamps. + + * Jan Böcker wrote `org-docview.el'. + + * Brad Bozarth showed how to pull RSS feed data into Org mode files. + + * Tom Breton wrote `org-choose.el'. + + * Charles Cave's suggestion sparked the implementation of templates + for Remember, which are now templates for capture. + + * Pavel Chalmoviansky influenced the agenda treatment of items with + specified time. + + * Gregory Chernov patched support for Lisp forms into table + calculations and improved XEmacs compatibility, in particular by + porting `nouline.el' to XEmacs. + + * Sacha Chua suggested copying some linking code from Planner. + + * Toby S. Cubitt contributed to the code for clock formats. + + * Baoqiu Cui contributed the DocBook exporter. It has been deleted + from Org 8.0: you can now export to Texinfo and export the `.texi' + file to DocBook using `makeinfo'. + + * Eddward DeVilla proposed and tested checkbox statistics. He also + came up with the idea of properties, and that there should be an + API for them. + + * Nick Dokos tracked down several nasty bugs. + + * Kees Dullemond used to edit projects lists directly in HTML and so + inspired some of the early development, including HTML export. He + also asked for a way to narrow wide table columns. + + * Jason Dunsmore has been maintaining the Org-Mode server at + Rackspace for several years now. He also sponsored the hosting + costs until Rackspace started to host us for free. + + * Thomas S. Dye contributed documentation on Worg and helped + integrating the Org-Babel documentation into the manual. + + * Christian Egli converted the documentation into Texinfo format, + inspired the agenda, patched CSS formatting into the HTML + exporter, and wrote `org-taskjuggler.el', which has been rewritten + by Nicolas Goaziou as `ox-taskjuggler.el' for Org 8.0. + + * David Emery provided a patch for custom CSS support in exported + HTML agendas. + + * Sean Escriva took over MobileOrg development on the iPhone + platform. + + * Nic Ferrier contributed mailcap and XOXO support. + + * Miguel A. Figueroa-Villanueva implemented hierarchical checkboxes. + + * John Foerch figured out how to make incremental search show context + around a match in a hidden outline tree. + + * Raimar Finken wrote `org-git-line.el'. + + * Mikael Fornius works as a mailing list moderator. + + * Austin Frank works as a mailing list moderator. + + * Eric Fraga drove the development of BEAMER export with ideas and + testing. + + * Barry Gidden did proofreading the manual in preparation for the + book publication through Network Theory Ltd. + + * Niels Giesen had the idea to automatically archive DONE trees. + + * Nicolas Goaziou rewrote much of the plain list code. He also wrote + `org-element.el' and `org-export.el', which was a huge step forward + in implementing a clean framework for Org exporters. + + * Kai Grossjohann pointed out key-binding conflicts with other + packages. + + * Brian Gough of Network Theory Ltd publishes the Org mode manual as + a book. + + * Bernt Hansen has driven much of the support for auto-repeating + tasks, task state change logging, and the clocktable. His clear + explanations have been critical when we started to adopt the Git + version control system. + + * Manuel Hermenegildo has contributed various ideas, small fixes and + patches. + + * Phil Jackson wrote `org-irc.el'. + + * Scott Jaderholm proposed footnotes, control over whitespace between + folded entries, and column view for properties. + + * Matt Jones wrote MobileOrg Android. + + * Tokuya Kameshima wrote `org-wl.el' and `org-mew.el'. + + * Jonathan Leech-Pepin wrote `ox-texinfo.el'. + + * Shidai Liu ("Leo") asked for embedded LaTeX and tested it. He also + provided frequent feedback and some patches. + + * Matt Lundin has proposed last-row references for table formulas + and named invisible anchors. He has also worked a lot on the FAQ. + + * David Maus wrote `org-atom.el', maintains the issues file for Org, + and is a prolific contributor on the mailing list with competent + replies, small fixes and patches. + + * Jason F. McBrayer suggested agenda export to CSV format. + + * Max Mikhanosha came up with the idea of refiling and sticky + agendas. + + * Dmitri Minaev sent a patch to set priority limits on a per-file + basis. + + * Stefan Monnier provided a patch to keep the Emacs-Lisp compiler + happy. + + * Richard Moreland wrote MobileOrg for the iPhone. + + * Rick Moynihan proposed allowing multiple TODO sequences in a file + and being able to quickly restrict the agenda to a subtree. + + * Todd Neal provided patches for links to Info files and Elisp forms. + + * Greg Newman refreshed the unicorn logo into its current form. + + * Tim O'Callaghan suggested in-file links, search options for general + file links, and TAGS. + + * Osamu Okano wrote `orgcard2ref.pl', a Perl program to create a text + version of the reference card. + + * Takeshi Okano translated the manual and David O'Toole's tutorial + into Japanese. + + * Oliver Oppitz suggested multi-state TODO items. + + * Scott Otterson sparked the introduction of descriptive text for + links, among other things. + + * Pete Phillips helped during the development of the TAGS feature, + and provided frequent feedback. + + * Francesco Pizzolante provided patches that helped speeding up the + agenda generation. + + * Martin Pohlack provided the code snippet to bundle character + insertion into bundles of 20 for undo. + + * Rackspace.com is hosting our website for free. Thank you + Rackspace! + + * T.V. Raman reported bugs and suggested improvements. + + * Matthias Rempe (Oelde) provided ideas, Windows support, and quality + control. + + * Paul Rivier provided the basic implementation of named footnotes. + He also acted as mailing list moderator for some time. + + * Kevin Rogers contributed code to access VM files on remote hosts. + + * Frank Ruell solved the mystery of the `keymapp nil' bug, a + conflict with `allout.el'. + + * Jason Riedy generalized the send-receive mechanism for Orgtbl + tables with extensive patches. + + * Philip Rooke created the Org reference card, provided lots of + feedback, developed and applied standards to the Org documentation. + + * Christian Schlauer proposed angular brackets around links, among + other things. + + * Christopher Schmidt reworked `orgstruct-mode' so that users can + enjoy folding in non-org buffers by using Org headlines in + comments. + + * Paul Sexton wrote `org-ctags.el'. + + * Linking to VM/BBDB/Gnus was first inspired by Tom Shannon's + `organizer-mode.el'. + + * Ilya Shlyakhter proposed the Archive Sibling, line numbering in + literal examples, and remote highlighting for referenced code + lines. + + * Stathis Sideris wrote the `ditaa.jar' ASCII to PNG converter that + is now packaged into Org's `contrib' directory. + + * Daniel Sinder came up with the idea of internal archiving by + locking subtrees. + + * Dale Smith proposed link abbreviations. + + * James TD Smith has contributed a large number of patches for useful + tweaks and features. + + * Adam Spiers asked for global linking commands, inspired the link + extension system, added support for mairix, and proposed the + mapping API. + + * Ulf Stegemann created the table to translate special symbols to + HTML, LaTeX, UTF-8, Latin-1 and ASCII. + + * Andy Stewart contributed code to `org-w3m.el', to copy HTML content + with links transformation to Org syntax. + + * David O'Toole wrote `org-publish.el' and drafted the manual + chapter about publishing. + + * Jambunathan K contributed the ODT exporter and rewrote the HTML + exporter. + + * Sebastien Vauban reported many issues with LaTeX and BEAMER export + and enabled source code highlighting in Gnus. + + * Stefan Vollmar organized a video-recorded talk at the + Max-Planck-Institute for Neurology. He also inspired the creation + of a concept index for HTML export. + + * Jürgen Vollmer contributed code generating the table of contents + in HTML output. + + * Samuel Wales has provided important feedback and bug reports. + + * Chris Wallace provided a patch implementing the `QUOTE' keyword. + + * David Wainberg suggested archiving, and improvements to the linking + system. + + * Carsten Wimmer suggested some changes and helped fix a bug in + linking to Gnus. + + * Roland Winkler requested additional key bindings to make Org work + on a tty. + + * Piotr Zielinski wrote `org-mouse.el', proposed agenda blocks and + contributed various ideas and code snippets. + + +File: org, Node: GNU Free Documentation License, Next: Main Index, Prev: History and Acknowledgments, Up: Top + +Appendix D GNU Free Documentation License +***************************************** + + Version 1.3, 3 November 2008 + + Copyright (C) 2000, 2001, 2002, 2007, 2008, 2013, 2014 Free Software Foundation, Inc. + `http://fsf.org/' + + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + 0. PREAMBLE + + The purpose of this License is to make a manual, textbook, or other + functional and useful document "free" in the sense of freedom: to + assure everyone the effective freedom to copy and redistribute it, + with or without modifying it, either commercially or + noncommercially. Secondarily, this License preserves for the + author and publisher a way to get credit for their work, while not + being considered responsible for modifications made by others. + + This License is a kind of "copyleft", which means that derivative + works of the document must themselves be free in the same sense. + It complements the GNU General Public License, which is a copyleft + license designed for free software. + + We have designed this License in order to use it for manuals for + free software, because free software needs free documentation: a + free program should come with manuals providing the same freedoms + that the software does. But this License is not limited to + software manuals; it can be used for any textual work, regardless + of subject matter or whether it is published as a printed book. + We recommend this License principally for works whose purpose is + instruction or reference. + + 1. APPLICABILITY AND DEFINITIONS + + This License applies to any manual or other work, in any medium, + that contains a notice placed by the copyright holder saying it + can be distributed under the terms of this License. Such a notice + grants a world-wide, royalty-free license, unlimited in duration, + to use that work under the conditions stated herein. The + "Document", below, refers to any such manual or work. Any member + of the public is a licensee, and is addressed as "you". You + accept the license if you copy, modify or distribute the work in a + way requiring permission under copyright law. + + A "Modified Version" of the Document means any work containing the + Document or a portion of it, either copied verbatim, or with + modifications and/or translated into another language. + + A "Secondary Section" is a named appendix or a front-matter section + of the Document that deals exclusively with the relationship of the + publishers or authors of the Document to the Document's overall + subject (or to related matters) and contains nothing that could + fall directly within that overall subject. (Thus, if the Document + is in part a textbook of mathematics, a Secondary Section may not + explain any mathematics.) The relationship could be a matter of + historical connection with the subject or with related matters, or + of legal, commercial, philosophical, ethical or political position + regarding them. + + The "Invariant Sections" are certain Secondary Sections whose + titles are designated, as being those of Invariant Sections, in + the notice that says that the Document is released under this + License. If a section does not fit the above definition of + Secondary then it is not allowed to be designated as Invariant. + The Document may contain zero Invariant Sections. If the Document + does not identify any Invariant Sections then there are none. + + The "Cover Texts" are certain short passages of text that are + listed, as Front-Cover Texts or Back-Cover Texts, in the notice + that says that the Document is released under this License. A + Front-Cover Text may be at most 5 words, and a Back-Cover Text may + be at most 25 words. + + A "Transparent" copy of the Document means a machine-readable copy, + represented in a format whose specification is available to the + general public, that is suitable for revising the document + straightforwardly with generic text editors or (for images + composed of pixels) generic paint programs or (for drawings) some + widely available drawing editor, and that is suitable for input to + text formatters or for automatic translation to a variety of + formats suitable for input to text formatters. A copy made in an + otherwise Transparent file format whose markup, or absence of + markup, has been arranged to thwart or discourage subsequent + modification by readers is not Transparent. An image format is + not Transparent if used for any substantial amount of text. A + copy that is not "Transparent" is called "Opaque". + + Examples of suitable formats for Transparent copies include plain + ASCII without markup, Texinfo input format, LaTeX input format, + SGML or XML using a publicly available DTD, and + standard-conforming simple HTML, PostScript or PDF designed for + human modification. Examples of transparent image formats include + PNG, XCF and JPG. Opaque formats include proprietary formats that + can be read and edited only by proprietary word processors, SGML or + XML for which the DTD and/or processing tools are not generally + available, and the machine-generated HTML, PostScript or PDF + produced by some word processors for output purposes only. + + The "Title Page" means, for a printed book, the title page itself, + plus such following pages as are needed to hold, legibly, the + material this License requires to appear in the title page. For + works in formats which do not have any title page as such, "Title + Page" means the text near the most prominent appearance of the + work's title, preceding the beginning of the body of the text. + + The "publisher" means any person or entity that distributes copies + of the Document to the public. + + A section "Entitled XYZ" means a named subunit of the Document + whose title either is precisely XYZ or contains XYZ in parentheses + following text that translates XYZ in another language. (Here XYZ + stands for a specific section name mentioned below, such as + "Acknowledgements", "Dedications", "Endorsements", or "History".) + To "Preserve the Title" of such a section when you modify the + Document means that it remains a section "Entitled XYZ" according + to this definition. + + The Document may include Warranty Disclaimers next to the notice + which states that this License applies to the Document. These + Warranty Disclaimers are considered to be included by reference in + this License, but only as regards disclaiming warranties: any other + implication that these Warranty Disclaimers may have is void and + has no effect on the meaning of this License. + + 2. VERBATIM COPYING + + You may copy and distribute the Document in any medium, either + commercially or noncommercially, provided that this License, the + copyright notices, and the license notice saying this License + applies to the Document are reproduced in all copies, and that you + add no other conditions whatsoever to those of this License. You + may not use technical measures to obstruct or control the reading + or further copying of the copies you make or distribute. However, + you may accept compensation in exchange for copies. If you + distribute a large enough number of copies you must also follow + the conditions in section 3. + + You may also lend copies, under the same conditions stated above, + and you may publicly display copies. + + 3. COPYING IN QUANTITY + + If you publish printed copies (or copies in media that commonly + have printed covers) of the Document, numbering more than 100, and + the Document's license notice requires Cover Texts, you must + enclose the copies in covers that carry, clearly and legibly, all + these Cover Texts: Front-Cover Texts on the front cover, and + Back-Cover Texts on the back cover. Both covers must also clearly + and legibly identify you as the publisher of these copies. The + front cover must present the full title with all words of the + title equally prominent and visible. You may add other material + on the covers in addition. Copying with changes limited to the + covers, as long as they preserve the title of the Document and + satisfy these conditions, can be treated as verbatim copying in + other respects. + + If the required texts for either cover are too voluminous to fit + legibly, you should put the first ones listed (as many as fit + reasonably) on the actual cover, and continue the rest onto + adjacent pages. + + If you publish or distribute Opaque copies of the Document + numbering more than 100, you must either include a + machine-readable Transparent copy along with each Opaque copy, or + state in or with each Opaque copy a computer-network location from + which the general network-using public has access to download + using public-standard network protocols a complete Transparent + copy of the Document, free of added material. If you use the + latter option, you must take reasonably prudent steps, when you + begin distribution of Opaque copies in quantity, to ensure that + this Transparent copy will remain thus accessible at the stated + location until at least one year after the last time you + distribute an Opaque copy (directly or through your agents or + retailers) of that edition to the public. + + It is requested, but not required, that you contact the authors of + the Document well before redistributing any large number of + copies, to give them a chance to provide you with an updated + version of the Document. + + 4. MODIFICATIONS + + You may copy and distribute a Modified Version of the Document + under the conditions of sections 2 and 3 above, provided that you + release the Modified Version under precisely this License, with + the Modified Version filling the role of the Document, thus + licensing distribution and modification of the Modified Version to + whoever possesses a copy of it. In addition, you must do these + things in the Modified Version: + + A. Use in the Title Page (and on the covers, if any) a title + distinct from that of the Document, and from those of + previous versions (which should, if there were any, be listed + in the History section of the Document). You may use the + same title as a previous version if the original publisher of + that version gives permission. + + B. List on the Title Page, as authors, one or more persons or + entities responsible for authorship of the modifications in + the Modified Version, together with at least five of the + principal authors of the Document (all of its principal + authors, if it has fewer than five), unless they release you + from this requirement. + + C. State on the Title page the name of the publisher of the + Modified Version, as the publisher. + + D. Preserve all the copyright notices of the Document. + + E. Add an appropriate copyright notice for your modifications + adjacent to the other copyright notices. + + F. Include, immediately after the copyright notices, a license + notice giving the public permission to use the Modified + Version under the terms of this License, in the form shown in + the Addendum below. + + G. Preserve in that license notice the full lists of Invariant + Sections and required Cover Texts given in the Document's + license notice. + + H. Include an unaltered copy of this License. + + I. Preserve the section Entitled "History", Preserve its Title, + and add to it an item stating at least the title, year, new + authors, and publisher of the Modified Version as given on + the Title Page. If there is no section Entitled "History" in + the Document, create one stating the title, year, authors, + and publisher of the Document as given on its Title Page, + then add an item describing the Modified Version as stated in + the previous sentence. + + J. Preserve the network location, if any, given in the Document + for public access to a Transparent copy of the Document, and + likewise the network locations given in the Document for + previous versions it was based on. These may be placed in + the "History" section. You may omit a network location for a + work that was published at least four years before the + Document itself, or if the original publisher of the version + it refers to gives permission. + + K. For any section Entitled "Acknowledgements" or "Dedications", + Preserve the Title of the section, and preserve in the + section all the substance and tone of each of the contributor + acknowledgements and/or dedications given therein. + + L. Preserve all the Invariant Sections of the Document, + unaltered in their text and in their titles. Section numbers + or the equivalent are not considered part of the section + titles. + + M. Delete any section Entitled "Endorsements". Such a section + may not be included in the Modified Version. + + N. Do not retitle any existing section to be Entitled + "Endorsements" or to conflict in title with any Invariant + Section. + + O. Preserve any Warranty Disclaimers. + + If the Modified Version includes new front-matter sections or + appendices that qualify as Secondary Sections and contain no + material copied from the Document, you may at your option + designate some or all of these sections as invariant. To do this, + add their titles to the list of Invariant Sections in the Modified + Version's license notice. These titles must be distinct from any + other section titles. + + You may add a section Entitled "Endorsements", provided it contains + nothing but endorsements of your Modified Version by various + parties--for example, statements of peer review or that the text + has been approved by an organization as the authoritative + definition of a standard. + + You may add a passage of up to five words as a Front-Cover Text, + and a passage of up to 25 words as a Back-Cover Text, to the end + of the list of Cover Texts in the Modified Version. Only one + passage of Front-Cover Text and one of Back-Cover Text may be + added by (or through arrangements made by) any one entity. If the + Document already includes a cover text for the same cover, + previously added by you or by arrangement made by the same entity + you are acting on behalf of, you may not add another; but you may + replace the old one, on explicit permission from the previous + publisher that added the old one. + + The author(s) and publisher(s) of the Document do not by this + License give permission to use their names for publicity for or to + assert or imply endorsement of any Modified Version. + + 5. COMBINING DOCUMENTS + + You may combine the Document with other documents released under + this License, under the terms defined in section 4 above for + modified versions, provided that you include in the combination + all of the Invariant Sections of all of the original documents, + unmodified, and list them all as Invariant Sections of your + combined work in its license notice, and that you preserve all + their Warranty Disclaimers. + + The combined work need only contain one copy of this License, and + multiple identical Invariant Sections may be replaced with a single + copy. If there are multiple Invariant Sections with the same name + but different contents, make the title of each such section unique + by adding at the end of it, in parentheses, the name of the + original author or publisher of that section if known, or else a + unique number. Make the same adjustment to the section titles in + the list of Invariant Sections in the license notice of the + combined work. + + In the combination, you must combine any sections Entitled + "History" in the various original documents, forming one section + Entitled "History"; likewise combine any sections Entitled + "Acknowledgements", and any sections Entitled "Dedications". You + must delete all sections Entitled "Endorsements." + + 6. COLLECTIONS OF DOCUMENTS + + You may make a collection consisting of the Document and other + documents released under this License, and replace the individual + copies of this License in the various documents with a single copy + that is included in the collection, provided that you follow the + rules of this License for verbatim copying of each of the + documents in all other respects. + + You may extract a single document from such a collection, and + distribute it individually under this License, provided you insert + a copy of this License into the extracted document, and follow + this License in all other respects regarding verbatim copying of + that document. + + 7. AGGREGATION WITH INDEPENDENT WORKS + + A compilation of the Document or its derivatives with other + separate and independent documents or works, in or on a volume of + a storage or distribution medium, is called an "aggregate" if the + copyright resulting from the compilation is not used to limit the + legal rights of the compilation's users beyond what the individual + works permit. When the Document is included in an aggregate, this + License does not apply to the other works in the aggregate which + are not themselves derivative works of the Document. + + If the Cover Text requirement of section 3 is applicable to these + copies of the Document, then if the Document is less than one half + of the entire aggregate, the Document's Cover Texts may be placed + on covers that bracket the Document within the aggregate, or the + electronic equivalent of covers if the Document is in electronic + form. Otherwise they must appear on printed covers that bracket + the whole aggregate. + + 8. TRANSLATION + + Translation is considered a kind of modification, so you may + distribute translations of the Document under the terms of section + 4. Replacing Invariant Sections with translations requires special + permission from their copyright holders, but you may include + translations of some or all Invariant Sections in addition to the + original versions of these Invariant Sections. You may include a + translation of this License, and all the license notices in the + Document, and any Warranty Disclaimers, provided that you also + include the original English version of this License and the + original versions of those notices and disclaimers. In case of a + disagreement between the translation and the original version of + this License or a notice or disclaimer, the original version will + prevail. + + If a section in the Document is Entitled "Acknowledgements", + "Dedications", or "History", the requirement (section 4) to + Preserve its Title (section 1) will typically require changing the + actual title. + + 9. TERMINATION + + You may not copy, modify, sublicense, or distribute the Document + except as expressly provided under this License. Any attempt + otherwise to copy, modify, sublicense, or distribute it is void, + and will automatically terminate your rights under this License. + + However, if you cease all violation of this License, then your + license from a particular copyright holder is reinstated (a) + provisionally, unless and until the copyright holder explicitly + and finally terminates your license, and (b) permanently, if the + copyright holder fails to notify you of the violation by some + reasonable means prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is + reinstated permanently if the copyright holder notifies you of the + violation by some reasonable means, this is the first time you have + received notice of violation of this License (for any work) from + that copyright holder, and you cure the violation prior to 30 days + after your receipt of the notice. + + Termination of your rights under this section does not terminate + the licenses of parties who have received copies or rights from + you under this License. If your rights have been terminated and + not permanently reinstated, receipt of a copy of some or all of + the same material does not give you any rights to use it. + + 10. FUTURE REVISIONS OF THIS LICENSE + + The Free Software Foundation may publish new, revised versions of + the GNU Free Documentation License from time to time. Such new + versions will be similar in spirit to the present version, but may + differ in detail to address new problems or concerns. See + `http://www.gnu.org/copyleft/'. + + Each version of the License is given a distinguishing version + number. If the Document specifies that a particular numbered + version of this License "or any later version" applies to it, you + have the option of following the terms and conditions either of + that specified version or of any later version that has been + published (not as a draft) by the Free Software Foundation. If + the Document does not specify a version number of this License, + you may choose any version ever published (not as a draft) by the + Free Software Foundation. If the Document specifies that a proxy + can decide which future versions of this License can be used, that + proxy's public statement of acceptance of a version permanently + authorizes you to choose that version for the Document. + + 11. RELICENSING + + "Massive Multiauthor Collaboration Site" (or "MMC Site") means any + World Wide Web server that publishes copyrightable works and also + provides prominent facilities for anybody to edit those works. A + public wiki that anybody can edit is an example of such a server. + A "Massive Multiauthor Collaboration" (or "MMC") contained in the + site means any set of copyrightable works thus published on the MMC + site. + + "CC-BY-SA" means the Creative Commons Attribution-Share Alike 3.0 + license published by Creative Commons Corporation, a not-for-profit + corporation with a principal place of business in San Francisco, + California, as well as future copyleft versions of that license + published by that same organization. + + "Incorporate" means to publish or republish a Document, in whole or + in part, as part of another Document. + + An MMC is "eligible for relicensing" if it is licensed under this + License, and if all works that were first published under this + License somewhere other than this MMC, and subsequently + incorporated in whole or in part into the MMC, (1) had no cover + texts or invariant sections, and (2) were thus incorporated prior + to November 1, 2008. + + The operator of an MMC Site may republish an MMC contained in the + site under CC-BY-SA on the same site at any time before August 1, + 2009, provided the MMC is eligible for relicensing. + + +ADDENDUM: How to use this License for your documents +==================================================== + +To use this License in a document you have written, include a copy of +the License in the document and put the following copyright and license +notices just after the title page: + + Copyright (C) YEAR YOUR NAME. + Permission is granted to copy, distribute and/or modify this document + under the terms of the GNU Free Documentation License, Version 1.3 + or any later version published by the Free Software Foundation; + with no Invariant Sections, no Front-Cover Texts, and no Back-Cover + Texts. A copy of the license is included in the section entitled ``GNU + Free Documentation License''. + + If you have Invariant Sections, Front-Cover Texts and Back-Cover +Texts, replace the "with...Texts." line with this: + + with the Invariant Sections being LIST THEIR TITLES, with + the Front-Cover Texts being LIST, and with the Back-Cover Texts + being LIST. + + If you have Invariant Sections without Cover Texts, or some other +combination of the three, merge those two alternatives to suit the +situation. + + If your document contains nontrivial examples of program code, we +recommend releasing these examples in parallel under your choice of +free software license, such as the GNU General Public License, to +permit their use in free software. + + +File: org, Node: Main Index, Next: Key Index, Prev: GNU Free Documentation License, Up: Top + +Concept index +************* + +[index] +* Menu: + +* #+ARCHIVE: Moving subtrees. (line 30) +* #+ASCII: ASCII/Latin-1/UTF-8 export. + (line 41) +* #+ATTR_ASCII: ASCII/Latin-1/UTF-8 export. + (line 52) +* #+ATTR_BEAMER: Beamer export. (line 124) +* #+ATTR_HTML <1>: Images in HTML export. + (line 24) +* #+ATTR_HTML <2>: Tables in HTML export. + (line 12) +* #+ATTR_HTML: Links in HTML export. + (line 21) +* #+ATTR_LATEX: LaTeX specific attributes. + (line 6) +* #+ATTR_ODT <1>: Customizing tables in ODT export. + (line 6) +* #+ATTR_ODT <2>: Images in ODT export. + (line 30) +* #+ATTR_ODT: Tables in ODT export. + (line 17) +* #+ATTR_TEXINFO: Texinfo specific attributes. + (line 6) +* #+BEAMER: Beamer export. (line 109) +* #+BEAMER_COLOR_THEME: Beamer export. (line 89) +* #+BEAMER_FONT_THEME: Beamer export. (line 89) +* #+BEAMER_INNER_THEME: Beamer export. (line 89) +* #+BEAMER_OUTER_THEME: Beamer export. (line 89) +* #+BEAMER_THEME: Beamer export. (line 89) +* #+BEGIN, clocktable: The clock table. (line 36) +* #+BEGIN, columnview: Capturing column view. + (line 11) +* #+BEGIN:dynamic block: Dynamic blocks. (line 15) +* #+BEGIN_ASCII: ASCII/Latin-1/UTF-8 export. + (line 41) +* #+BEGIN_BEAMER: Beamer export. (line 109) +* #+BEGIN_CENTER: Paragraphs. (line 31) +* #+BEGIN_COMMENT: Comment lines. (line 6) +* #+BEGIN_EXAMPLE: Literal examples. (line 8) +* #+BEGIN_HTML: Quoting HTML tags. (line 12) +* #+BEGIN_LATEX: Quoting LaTeX code. (line 11) +* #+BEGIN_QUOTE: Paragraphs. (line 26) +* #+BEGIN_SRC <1>: Structure of code blocks. + (line 6) +* #+BEGIN_SRC: Literal examples. (line 28) +* #+BEGIN_TEXINFO: Quoting Texinfo code. + (line 9) +* #+BEGIN_VERSE: Paragraphs. (line 13) +* #+BIND: Export settings. (line 187) +* #+CALL: Evaluating code blocks. + (line 22) +* #+CAPTION <1>: Images in HTML export. + (line 24) +* #+CAPTION <2>: Tables in HTML export. + (line 12) +* #+CAPTION: Images and tables. (line 6) +* #+CATEGORY: Categories. (line 6) +* #+CINDEX: Indices. (line 6) +* #+COLUMNS: Scope of column definitions. + (line 8) +* #+CONSTANTS: References. (line 102) +* #+DRAWERS: Drawers. (line 6) +* #+FILETAGS: Tag inheritance. (line 20) +* #+FINDEX: Indices. (line 6) +* #+HEADER:: Code block specific header arguments. + (line 30) +* #+HEADERS:: Code block specific header arguments. + (line 30) +* #+HTML: Quoting HTML tags. (line 12) +* #+HTML_HEAD: CSS support. (line 47) +* #+HTML_HEAD_EXTRA: CSS support. (line 47) +* #+HTML_INCLUDE_STYLE: CSS support. (line 41) +* #+INCLUDE: Include files. (line 7) +* #+INFOJS_OPT: JavaScript support. (line 23) +* #+KINDEX: Indices. (line 6) +* #+LATEX: Quoting LaTeX code. (line 11) +* #+LATEX_CLASS: Header and sectioning. + (line 22) +* #+LATEX_CLASS_OPTIONS: Header and sectioning. + (line 22) +* #+LATEX_HEADER: Header and sectioning. + (line 27) +* #+LATEX_HEADER_EXTRA: Header and sectioning. + (line 27) +* #+LINK: Link abbreviations. (line 49) +* #+MACRO: Macro replacement. (line 6) +* #+NAME <1>: Structure of code blocks. + (line 6) +* #+NAME <2>: Images and tables. (line 6) +* #+NAME: Internal links. (line 21) +* #+NAME, for table: References. (line 123) +* #+ODT_STYLES_FILE: Applying custom styles. + (line 28) +* #+OPTIONS: Headings and sections. + (line 14) +* #+ORGLST: Radio lists. (line 25) +* #+ORGTBL: Radio tables. (line 17) +* #+ORGTBL, SEND: A LaTeX example. (line 14) +* #+PINDEX: Indices. (line 6) +* #+PLOT: Org-Plot. (line 6) +* #+PRIORITIES: Priorities. (line 44) +* #+PROPERTY: Property syntax. (line 42) +* #+RESULTS: Evaluating code blocks. + (line 6) +* #+SEQ_TODO: Per-file keywords. (line 6) +* #+SETUPFILE <1>: In-buffer settings. (line 61) +* #+SETUPFILE: Export settings. (line 13) +* #+STARTUP: In-buffer settings. (line 74) +* #+SUBAUTHOR: Document preamble. (line 42) +* #+SUBTITLE: Document preamble. (line 35) +* #+TAGS: Setting tags. (line 29) +* #+TBLFM <1>: In-buffer settings. (line 184) +* #+TBLFM <2>: Editing and debugging formulas. + (line 99) +* #+TBLFM: Field and range formulas. + (line 12) +* #+TBLFM line, multiple: Editing and debugging formulas. + (line 99) +* #+TBLFM, switching: Editing and debugging formulas. + (line 99) +* #+TEXINFO: Quoting Texinfo code. + (line 9) +* #+TEXINFO_CLASS <1>: Headings and sectioning structure. + (line 6) +* #+TEXINFO_CLASS: Document preamble. (line 22) +* #+TEXINFO_DIR_CATEGORY: Document preamble. (line 69) +* #+TEXINFO_DIR_DESC: Document preamble. (line 69) +* #+TEXINFO_DIR_TITLE: Document preamble. (line 69) +* #+TEXINFO_FILENAME: Document preamble. (line 16) +* #+TEXINFO_HEADER: Document preamble. (line 22) +* #+TEXINFO_PRINTED_TITLE: Document preamble. (line 35) +* #+TINDEX: Indices. (line 6) +* #+TITLE: Document title. (line 8) +* #+TOC: Table of contents. (line 6) +* #+TODO: Per-file keywords. (line 6) +* #+TYP_TODO: Per-file keywords. (line 6) +* #+VINDEX: Indices. (line 6) +* abbreviation, links: Link abbreviations. (line 6) +* abstract, in LaTeX export: LaTeX specific attributes. + (line 180) +* acknowledgments: History and Acknowledgments. + (line 6) +* action, for publishing: Publishing action. (line 6) +* activation: Activation. (line 6) +* active region <1>: ODT export commands. (line 9) +* active region <2>: Built-in table editor. + (line 156) +* active region: Structure editing. (line 137) +* add-on packages: Add-on packages. (line 6) +* add-ons, context-sensitive commands: Context-sensitive commands. + (line 6) +* agenda: Weekly/daily agenda. (line 6) +* agenda dispatcher: Agenda dispatcher. (line 6) +* agenda files: Agenda files. (line 6) +* agenda files, removing buffers: Agenda commands. (line 521) +* agenda views: Agenda Views. (line 6) +* agenda views, custom: Custom agenda views. (line 6) +* agenda views, exporting <1>: Exporting Agenda Views. + (line 6) +* agenda views, exporting: Agenda commands. (line 507) +* agenda views, main example: Storing searches. (line 9) +* agenda views, optimization: Speeding up your agendas. + (line 6) +* agenda views, user-defined: Special agenda views. + (line 6) +* agenda*, as an agenda views: Storing searches. (line 9) +* agenda, as an agenda views: Storing searches. (line 9) +* agenda, column view: Agenda column view. (line 6) +* agenda, pipe: Extracting agenda information. + (line 6) +* agenda, with block views: Block agenda. (line 6) +* align, STARTUP keyword: In-buffer settings. (line 94) +* alignment in tables: Column width and alignment. + (line 6) +* anniversaries, from BBDB: Weekly/daily agenda. (line 73) +* API, for mapping: Using the mapping API. + (line 6) +* API, for properties <1>: Using the property API. + (line 6) +* API, for properties: Property API. (line 6) +* appointment <1>: Weekly/daily agenda. (line 107) +* appointment: Timestamps. (line 14) +* appointment reminders: Weekly/daily agenda. (line 107) +* appt.el: Weekly/daily agenda. (line 107) +* archive locations: Moving subtrees. (line 20) +* archiving: Archiving. (line 6) +* ASCII export: ASCII/Latin-1/UTF-8 export. + (line 6) +* Atom feeds: RSS Feeds. (line 6) +* attachments: Attachments. (line 6) +* author: Feedback. (line 6) +* autoload: Activation. (line 6) +* babel, languages: Languages. (line 6) +* babel, library of: Library of Babel. (line 6) +* backtrace of an error: Feedback. (line 65) +* Baur, Steven L.: Cooperation. (line 74) +* BBDB links: External links. (line 6) +* BBDB, anniversaries: Weekly/daily agenda. (line 73) +* Beamer export: Beamer export. (line 6) +* block agenda: Block agenda. (line 6) +* blocking, of checkboxes: Checkboxes. (line 46) +* blocks, folding: Blocks. (line 6) +* bold text, markup rules: Emphasis and monospace. + (line 6) +* Boolean logic, for tag/property searches: Matching tags and properties. + (line 34) +* bug reports: Feedback. (line 6) +* C-c C-c, overview: The very busy C-c C-c key. + (line 6) +* calc package: The spreadsheet. (line 6) +* calc.el: Cooperation. (line 6) +* calculations, in tables <1>: The spreadsheet. (line 6) +* calculations, in tables: Built-in table editor. + (line 156) +* calendar commands, from agenda: Agenda commands. (line 456) +* calendar integration: Weekly/daily agenda. (line 32) +* calendar, for selecting date: The date/time prompt. + (line 76) +* capture <1>: Capture. (line 6) +* capture: Capture - Refile - Archive. + (line 6) +* capturing, from agenda: Agenda commands. (line 349) +* category: Categories. (line 6) +* category filtering, in agenda: Filtering/limiting agenda items. + (line 17) +* category, require for tags/property match: Matching tags and properties. + (line 71) +* CDLaTeX: CDLaTeX mode. (line 6) +* cdlatex.el: Cooperation. (line 29) +* checkbox blocking: Checkboxes. (line 46) +* checkbox statistics: Checkboxes. (line 30) +* checkboxes: Checkboxes. (line 6) +* checkboxes and TODO dependencies: TODO dependencies. (line 44) +* children, subtree visibility state: Global and local cycling. + (line 10) +* clean outline view: Clean view. (line 6) +* clocking time: Clocking work time. (line 6) +* clocktable, dynamic block: The clock table. (line 6) +* code block, batch execution: Batch execution. (line 6) +* code block, editing: Editing source code. (line 6) +* code block, evaluating: Evaluating code blocks. + (line 6) +* code block, exporting: Exporting code blocks. + (line 6) +* code block, extracting source code: Extracting source code. + (line 6) +* code block, header arguments: Header arguments. (line 6) +* code block, key bindings: Key bindings and useful functions. + (line 6) +* code block, languages: Languages. (line 6) +* code block, library: Library of Babel. (line 6) +* code block, noweb reference: Noweb reference syntax. + (line 6) +* code block, results of evaluation: Results of evaluation. + (line 6) +* code block, structure: Structure of code blocks. + (line 6) +* code line references, markup rules: Literal examples. (line 6) +* code text, markup rules: Emphasis and monospace. + (line 6) +* column formula: Column formulas. (line 6) +* column view, for properties: Defining columns. (line 6) +* column view, in agenda: Agenda column view. (line 6) +* column, of field coordinates: References. (line 86) +* commands, in agenda buffer: Agenda commands. (line 6) +* comment lines: Comment lines. (line 6) +* completion, of dictionary words: Completion. (line 6) +* completion, of file names: Handling links. (line 89) +* completion, of link abbreviations: Completion. (line 6) +* completion, of links: Handling links. (line 66) +* completion, of option keywords <1>: Completion. (line 6) +* completion, of option keywords: Per-file keywords. (line 24) +* completion, of property keys: Completion. (line 6) +* completion, of tags <1>: Completion. (line 6) +* completion, of tags: Setting tags. (line 11) +* completion, of TeX symbols: Completion. (line 6) +* completion, of TODO keywords <1>: Completion. (line 6) +* completion, of TODO keywords: Workflow states. (line 15) +* constants, in calculations: References. (line 102) +* constants.el: Cooperation. (line 17) +* constcgs, STARTUP keyword: In-buffer settings. (line 154) +* constSI, STARTUP keyword: In-buffer settings. (line 154) +* content, STARTUP keyword <1>: In-buffer settings. (line 80) +* content, STARTUP keyword: Initial visibility. (line 6) +* contents, global visibility state: Global and local cycling. + (line 22) +* context-sensitive commands, hooks: Context-sensitive commands. + (line 6) +* continuous clocking: Resolving idle time. (line 78) +* convert: Configuring a document converter. + (line 6) +* converter: Configuring a document converter. + (line 6) +* coordinates, of field: References. (line 86) +* copying notes: Refile and copy. (line 6) +* copying, of subtrees: Structure editing. (line 6) +* Countdown timer: Countdown timer. (line 6) +* creating timestamps: Creating timestamps. (line 6) +* CSS, for HTML export: CSS support. (line 6) +* CUA.el: Conflicts. (line 19) +* custom agenda views: Custom agenda views. (line 6) +* custom date/time format: Custom time format. (line 6) +* custom search strings: Custom searches. (line 6) +* customization: Customization. (line 6) +* customtime, STARTUP keyword: In-buffer settings. (line 150) +* cutting, of subtrees: Structure editing. (line 6) +* cycling, in plain lists: Plain lists. (line 69) +* cycling, of agenda files: Agenda files. (line 22) +* cycling, of TODO states: TODO basics. (line 14) +* cycling, visibility: Visibility cycling. (line 6) +* daily agenda: Weekly/daily agenda. (line 6) +* date format, custom: Custom time format. (line 6) +* date range: Timestamps. (line 43) +* date stamp: Dates and Times. (line 6) +* date stamps: Timestamps. (line 6) +* date tree: Using capture. (line 9) +* date, reading in minibuffer: The date/time prompt. + (line 6) +* dates: Dates and Times. (line 6) +* Davison, Dan: Working With Source Code. + (line 6) +* DEADLINE keyword: Deadlines and scheduling. + (line 9) +* deadlines: Timestamps. (line 6) +* debugging, of table formulas: Editing and debugging formulas. + (line 132) +* demotion, of subtrees: Structure editing. (line 6) +* dependencies, of TODO states: TODO dependencies. (line 6) +* diary entries, creating from agenda: Agenda commands. (line 461) +* diary integration: Weekly/daily agenda. (line 32) +* dictionary word completion: Completion. (line 6) +* directories, for publishing: Sources and destinations. + (line 6) +* dispatching agenda commands: Agenda dispatcher. (line 6) +* display changing, in agenda: Agenda commands. (line 64) +* doc, docx, rtf: Configuring a document converter. + (line 6) +* document structure: Document Structure. (line 6) +* document title, markup rules: Document title. (line 6) +* Dominik, Carsten: Cooperation. (line 17) +* DONE, final TODO keyword: Per-file keywords. (line 27) +* dragging, agenda lines: Agenda commands. (line 354) +* drawer, for properties: Property syntax. (line 6) +* drawer, for state change recording: Tracking TODO state changes. + (line 6) +* drawers: Drawers. (line 6) +* Duration, computing: Durations and time values. + (line 6) +* dvipng <1>: Working with LaTeX math snippets. + (line 44) +* dvipng: Math formatting in HTML export. + (line 6) +* dynamic blocks: Dynamic blocks. (line 6) +* dynamic indentation: Clean view. (line 6) +* ecomplete.el: Conflicts. (line 39) +* editing tables: Tables. (line 6) +* editing, of table formulas: Editing and debugging formulas. + (line 6) +* edits, catching invisible: Catching invisible edits. + (line 6) +* effort estimates: Effort estimates. (line 6) +* effort filtering, in agenda: Filtering/limiting agenda items. + (line 17) +* Elisp links: External links. (line 6) +* ELPA: Activation. (line 6) +* emacsserver: Protocols. (line 6) +* embedding images in ODT: Images in ODT export. + (line 6) +* entitiesplain, STARTUP keyword: In-buffer settings. (line 177) +* entitiespretty, STARTUP keyword <1>: In-buffer settings. (line 177) +* entitiespretty, STARTUP keyword: Special symbols. (line 31) +* evaluate time range: Creating timestamps. (line 62) +* even, STARTUP keyword: In-buffer settings. (line 140) +* export back-ends, built-in: Other built-in back-ends. + (line 6) +* Export, back-ends: Export back-ends. (line 6) +* Export, dispatcher: The Export Dispatcher. + (line 6) +* export, OpenDocument: OpenDocument Text export. + (line 6) +* Export, settings: Export settings. (line 6) +* Export, writing back-ends: Adding export back-ends. + (line 6) +* exporting: Exporting. (line 6) +* exporting agenda views <1>: Exporting Agenda Views. + (line 13) +* exporting agenda views: Agenda commands. (line 507) +* exporting, not: Comment lines. (line 6) +* extended TODO keywords: TODO extensions. (line 6) +* external archiving: Moving subtrees. (line 6) +* external links: External links. (line 6) +* external links, in HTML export: Links in HTML export. + (line 6) +* faces, for TODO keywords: Faces for TODO keywords. + (line 6) +* FAQ: Summary. (line 53) +* feedback: Feedback. (line 6) +* field coordinates: References. (line 86) +* field formula: Field and range formulas. + (line 6) +* field references: References. (line 15) +* file links: External links. (line 6) +* file links, searching: Search options. (line 6) +* file name completion: Handling links. (line 89) +* files for agenda: Agenda files. (line 6) +* files, adding to agenda list: Agenda files. (line 15) +* files, selecting for publishing: Selecting files. (line 6) +* filladapt.el: Conflicts. (line 50) +* filtering, by tag, category, top headline and effort, in agenda: Filtering/limiting agenda items. + (line 17) +* Filters, exporting: Advanced configuration. + (line 32) +* fnadjust, STARTUP keyword: In-buffer settings. (line 160) +* fnauto, STARTUP keyword: In-buffer settings. (line 160) +* fnconfirm, STARTUP keyword: In-buffer settings. (line 160) +* fninline, STARTUP keyword: In-buffer settings. (line 160) +* fnlocal, STARTUP keyword: In-buffer settings. (line 160) +* fnplain, STARTUP keyword: In-buffer settings. (line 160) +* fnprompt, STARTUP keyword: In-buffer settings. (line 160) +* folded, subtree visibility state: Global and local cycling. + (line 10) +* folding, sparse trees: Sparse trees. (line 6) +* following links: Handling links. (line 101) +* footnote.el <1>: Cooperation. (line 74) +* footnote.el: Footnote markup. (line 6) +* footnotes: Footnotes. (line 6) +* footnotes, markup rules: Footnote markup. (line 6) +* format specifier: Formula syntax for Calc. + (line 14) +* format, of links: Link format. (line 6) +* formatting source code, markup rules: Literal examples. (line 23) +* formula debugging: Editing and debugging formulas. + (line 132) +* formula editing: Editing and debugging formulas. + (line 6) +* formula syntax, Calc: Formula syntax for Calc. + (line 6) +* formula, for individual table field: Field and range formulas. + (line 6) +* formula, for range of fields: Field and range formulas. + (line 6) +* formula, for table column: Column formulas. (line 6) +* formula, in tables: Built-in table editor. + (line 156) +* Gillespie, Dave: Cooperation. (line 6) +* global cycling: Global and local cycling. + (line 22) +* global key bindings: Activation. (line 6) +* global TODO list: Global TODO list. (line 6) +* global visibility states: Global and local cycling. + (line 22) +* Gnus links: External links. (line 6) +* graph, in tables: Org-Plot. (line 6) +* group tags: Tag groups. (line 6) +* group tags, as regular expressions: Matching tags and properties. + (line 65) +* grouping columns in tables: Column groups. (line 6) +* habits: Tracking your habits. + (line 6) +* hacking: Hacking. (line 6) +* header, for LaTeX files: Header and sectioning. + (line 6) +* headings and sections, markup rules: Headings and sections. + (line 6) +* headline navigation: Motion. (line 6) +* headline tagging: Tags. (line 6) +* headline, promotion and demotion: Structure editing. (line 6) +* headlines: Headlines. (line 6) +* hide text: Visibility cycling. (line 6) +* hideblocks, STARTUP keyword <1>: In-buffer settings. (line 172) +* hideblocks, STARTUP keyword: Blocks. (line 13) +* hidestars, STARTUP keyword: In-buffer settings. (line 140) +* hiding leading stars: Clean view. (line 6) +* history: History and Acknowledgments. + (line 6) +* hooks: Hooks. (line 6) +* horizontal rules, in ASCII export: ASCII/Latin-1/UTF-8 export. + (line 52) +* horizontal rules, in LaTeX export: LaTeX specific attributes. + (line 217) +* horizontal rules, markup rules: Horizontal rules. (line 6) +* HTML entities: Special symbols. (line 6) +* HTML export: HTML export. (line 6) +* HTML export, CSS: CSS support. (line 6) +* HTML, and Orgtbl mode: Translator functions. + (line 6) +* hyperlinks: Hyperlinks. (line 6) +* hyperlinks, adding new types: Adding hyperlink types. + (line 6) +* iCalendar export: iCalendar export. (line 6) +* identify, ImageMagick: Images in ODT export. + (line 33) +* idle, resolve, dangling: Resolving idle time. (line 9) +* imagemagick <1>: Working with LaTeX math snippets. + (line 44) +* imagemagick: Math formatting in HTML export. + (line 6) +* images, embedding in ODT: Images in ODT export. + (line 6) +* images, inline in HTML: Images in HTML export. + (line 6) +* images, inline in LaTeX: LaTeX specific attributes. + (line 100) +* images, inlining: Handling links. (line 136) +* imenu.el: Cooperation. (line 33) +* in-buffer settings: In-buffer settings. (line 6) +* inactive timestamp: Timestamps. (line 52) +* include files, markup rules: Include files. (line 6) +* indent, STARTUP keyword: In-buffer settings. (line 86) +* index entries, for publishing: Index entries. (line 6) +* index, in a publishing project: Generating an index. (line 6) +* Info links: External links. (line 6) +* inheritance, of properties: Property inheritance. + (line 6) +* inheritance, of tags: Tag inheritance. (line 6) +* inlined images, markup rules: Images and tables. (line 22) +* inlineimages, STARTUP keyword <1>: In-buffer settings. (line 101) +* inlineimages, STARTUP keyword: Handling links. (line 136) +* inlining images: Handling links. (line 136) +* inlining images in HTML: Images in HTML export. + (line 6) +* inlining images in LaTeX: LaTeX specific attributes. + (line 100) +* inserting links: Handling links. (line 66) +* insertion, of templates: Easy Templates. (line 6) +* installation: Installation. (line 6) +* internal links: Internal links. (line 6) +* internal links, in HTML export: Links in HTML export. + (line 6) +* introduction: Introduction. (line 6) +* iPhone: MobileOrg. (line 6) +* IRC links: External links. (line 6) +* italic text, markup rules: Emphasis and monospace. + (line 6) +* jumping, to headlines: Motion. (line 6) +* key bindings, global: Activation. (line 6) +* keyword options: Per-file keywords. (line 6) +* LaTeX class: Header and sectioning. + (line 6) +* LaTeX entities: Special symbols. (line 6) +* LaTeX export: LaTeX and PDF export. + (line 6) +* LaTeX fragments: LaTeX fragments. (line 6) +* LaTeX fragments, markup rules: Special symbols. (line 6) +* LaTeX fragments, preview: Previewing LaTeX fragments. + (line 6) +* LaTeX header: Header and sectioning. + (line 6) +* LaTeX interpretation: Embedded LaTeX. (line 6) +* LaTeX sectioning structure: Header and sectioning. + (line 6) +* LaTeX, and Orgtbl mode: A LaTeX example. (line 6) +* latexpreview, STARTUP keyword: In-buffer settings. (line 108) +* Latin-1 export: ASCII/Latin-1/UTF-8 export. + (line 6) +* level, require for tags/property match: Matching tags and properties. + (line 71) +* LibreOffice <1>: Extending ODT export. + (line 11) +* LibreOffice: OpenDocument Text export. + (line 6) +* limits, in agenda: Filtering/limiting agenda items. + (line 118) +* link abbreviations: Link abbreviations. (line 6) +* link abbreviations, completion of: Completion. (line 6) +* link completion: Handling links. (line 66) +* link format: Link format. (line 6) +* links, external: External links. (line 6) +* links, finding next/previous: Handling links. (line 156) +* links, handling: Handling links. (line 6) +* links, in HTML export: Links in HTML export. + (line 6) +* links, in ODT export: Links in ODT export. (line 6) +* links, internal: Internal links. (line 6) +* links, publishing: Publishing links. (line 6) +* links, radio targets: Radio targets. (line 6) +* links, returning to: Handling links. (line 149) +* Lisp forms, as table formulas: Formula syntax for Lisp. + (line 6) +* lists, in other modes: Tables in arbitrary syntax. + (line 6) +* lists, markup rules: Lists. (line 6) +* lists, ordered: Plain lists. (line 6) +* lists, plain: Plain lists. (line 6) +* literal examples, markup rules: Literal examples. (line 6) +* logdone, STARTUP keyword: In-buffer settings. (line 114) +* logdrawer, STARTUP keyword: In-buffer settings. (line 114) +* logging, of progress: Progress logging. (line 6) +* lognoteclock-out, STARTUP keyword: In-buffer settings. (line 114) +* lognotedone, STARTUP keyword: In-buffer settings. (line 114) +* lognoteredeadline, STARTUP keyword: In-buffer settings. (line 114) +* lognoterefile, STARTUP keyword: In-buffer settings. (line 114) +* lognoterepeat, STARTUP keyword: In-buffer settings. (line 114) +* lognotereschedule, STARTUP keyword: In-buffer settings. (line 114) +* logredeadline, STARTUP keyword: In-buffer settings. (line 114) +* logrefile, STARTUP keyword: In-buffer settings. (line 114) +* logrepeat, STARTUP keyword: In-buffer settings. (line 114) +* logreschedule, STARTUP keyword: In-buffer settings. (line 114) +* logstatesreversed, STARTUP keyword: In-buffer settings. (line 114) +* lookup functions in tables: Lookup functions. (line 6) +* Ludlam, Eric M.: Cooperation. (line 45) +* macro replacement, during export: Macro replacement. (line 6) +* maintainer: Feedback. (line 6) +* mapping entries, API: Using the mapping API. + (line 6) +* mark ring: Handling links. (line 145) +* Markdown export: Markdown export. (line 6) +* marking characters, tables: Advanced features. (line 39) +* match view: Matching tags and properties. + (line 6) +* matching, of properties: Matching tags and properties. + (line 6) +* matching, of tags: Matching tags and properties. + (line 6) +* matching, tags: Tags. (line 6) +* math symbols: Special symbols. (line 6) +* MathJax: Math formatting in HTML export. + (line 6) +* MathML: Working with LaTeX math snippets. + (line 9) +* MH-E links: External links. (line 6) +* minor mode for structure editing: Orgstruct mode. (line 6) +* minor mode for tables: Orgtbl mode. (line 6) +* MobileOrg: MobileOrg. (line 6) +* mode, for calc: Formula syntax for Calc. + (line 14) +* motion commands in agenda: Agenda commands. (line 19) +* motion, between headlines: Motion. (line 6) +* name, of column or field: References. (line 102) +* named references: References. (line 102) +* names as TODO keywords: TODO types. (line 6) +* narrow columns in tables: Column width and alignment. + (line 6) +* noalign, STARTUP keyword: In-buffer settings. (line 94) +* nofnadjust, STARTUP keyword: In-buffer settings. (line 160) +* nofninline, STARTUP keyword: In-buffer settings. (line 160) +* nohideblocks, STARTUP keyword <1>: In-buffer settings. (line 172) +* nohideblocks, STARTUP keyword: Blocks. (line 13) +* noindent, STARTUP keyword: In-buffer settings. (line 86) +* noinlineimages, STARTUP keyword <1>: In-buffer settings. (line 101) +* noinlineimages, STARTUP keyword: Handling links. (line 136) +* nolatexpreview, STARTUP keyword: In-buffer settings. (line 108) +* nologdone, STARTUP keyword: In-buffer settings. (line 114) +* nologdrawer, STARTUP keyword: In-buffer settings. (line 114) +* nolognoteclock-out, STARTUP keyword: In-buffer settings. (line 114) +* nologredeadline, STARTUP keyword: In-buffer settings. (line 114) +* nologrefile, STARTUP keyword: In-buffer settings. (line 114) +* nologrepeat, STARTUP keyword: In-buffer settings. (line 114) +* nologreschedule, STARTUP keyword: In-buffer settings. (line 114) +* nologstatesreversed, STARTUP keyword: In-buffer settings. (line 114) +* occur, command: Sparse trees. (line 6) +* occur-tree: Storing searches. (line 9) +* odd, STARTUP keyword: In-buffer settings. (line 140) +* odd-levels-only outlines: Clean view. (line 6) +* ODT: OpenDocument Text export. + (line 6) +* OpenDocument: OpenDocument Text export. + (line 6) +* option keyword completion: Completion. (line 6) +* options, for custom agenda views: Setting Options. (line 6) +* options, for customization: Customization. (line 6) +* options, for publishing: Publishing options. (line 6) +* ordered lists: Plain lists. (line 6) +* Org export: Org export. (line 6) +* Org mode, turning on: Activation. (line 27) +* Org syntax: Org syntax. (line 6) +* org-agenda, command: Weekly/daily agenda. (line 9) +* org-capture-last-stored: Using capture. (line 50) +* org-crypt.el: org-crypt. (line 6) +* org-decrypt-entry: org-crypt. (line 6) +* org-hide-block-startup: In-buffer settings. (line 171) +* org-insert-drawer <1>: Property syntax. (line 88) +* org-insert-drawer: Drawers. (line 6) +* org-list-insert-radio-list: Radio lists. (line 6) +* org-pretty-entities: In-buffer settings. (line 176) +* org-publish-project-alist: Project alist. (line 6) +* Orgstruct mode: Orgstruct mode. (line 6) +* Orgtbl mode <1>: Tables in arbitrary syntax. + (line 6) +* Orgtbl mode: Orgtbl mode. (line 6) +* Ota, Takaaki: Cooperation. (line 52) +* Outline mode: Outlines. (line 6) +* outline tree: Headlines. (line 6) +* outlines: Outlines. (line 6) +* overview, global visibility state: Global and local cycling. + (line 22) +* overview, STARTUP keyword <1>: In-buffer settings. (line 80) +* overview, STARTUP keyword: Initial visibility. (line 6) +* packages, interaction with other: Interaction. (line 6) +* paragraphs, markup rules: Paragraphs. (line 6) +* pasting, of subtrees: Structure editing. (line 6) +* PDF export: LaTeX and PDF export. + (line 6) +* per-file keywords: Per-file keywords. (line 6) +* plain lists: Plain lists. (line 6) +* plain lists, in LaTeX export: LaTeX specific attributes. + (line 148) +* plain text external links: External links. (line 70) +* plot tables using Gnuplot: Org-Plot. (line 6) +* presentation, of agenda items: Presentation and sorting. + (line 6) +* print edition: Summary. (line 58) +* printing sparse trees: Sparse trees. (line 53) +* priorities: Priorities. (line 6) +* priorities, of agenda items: Sorting agenda items. + (line 6) +* progress logging: Progress logging. (line 6) +* projects, for publishing: Project alist. (line 6) +* promotion, of subtrees: Structure editing. (line 6) +* proof, in LaTeX export: LaTeX specific attributes. + (line 180) +* properties: Properties and Columns. + (line 6) +* properties, API <1>: Using the property API. + (line 6) +* properties, API: Property API. (line 6) +* properties, column view: Defining columns. (line 6) +* properties, inheritance: Property inheritance. + (line 6) +* properties, searching: Property searches. (line 6) +* properties, special: Special properties. (line 6) +* property EXPORT_FILE_NAME: ODT export commands. (line 10) +* property syntax: Property syntax. (line 6) +* property, +: Property syntax. (line 50) +* property, _ALL: Property syntax. (line 42) +* property, ALT_TITLE: Table of contents. (line 31) +* property, APPENDIX: Headings and sectioning structure. + (line 19) +* property, ARCHIVE <1>: Moving subtrees. (line 32) +* property, ARCHIVE: Property inheritance. + (line 34) +* property, ATTACH_DIR: Attachments. (line 71) +* property, ATTACH_DIR_INHERIT: Attachments. (line 76) +* property, BEAMER_ACT: Beamer export. (line 63) +* property, BEAMER_COL: Beamer export. (line 70) +* property, BEAMER_ENV: Beamer export. (line 39) +* property, BEAMER_OPT: Beamer export. (line 63) +* property, BEAMER_REF: Beamer export. (line 50) +* property, CATEGORY <1>: Categories. (line 12) +* property, CATEGORY: Property inheritance. + (line 30) +* property, COLUMNS <1>: In-buffer settings. (line 30) +* property, COLUMNS: Property inheritance. + (line 22) +* property, COOKIE_DATA <1>: Checkboxes. (line 30) +* property, COOKIE_DATA: Breaking down tasks. (line 21) +* property, COPYING: Document preamble. (line 50) +* property, CUSTOM_ID <1>: Handling links. (line 21) +* property, CUSTOM_ID: Internal links. (line 6) +* property, DESCRIPTION <1>: iCalendar export. (line 46) +* property, DESCRIPTION: Headings and sectioning structure. + (line 22) +* property, Effort: Effort estimates. (line 6) +* property, EXPORT_FILE_NAME: Export settings. (line 192) +* property, EXPORT_LATEX_CLASS: Header and sectioning. + (line 22) +* property, EXPORT_LATEX_CLASS_OPTIONS: Header and sectioning. + (line 22) +* property, EXPORT_TITLE: Document title. (line 13) +* property, ID <1>: iCalendar export. (line 21) +* property, ID <2>: Capturing column view. + (line 22) +* property, ID: Handling links. (line 21) +* property, INDEX: Indices. (line 13) +* property, LOCATION: iCalendar export. (line 46) +* property, LOG_INTO_DRAWER <1>: Clocking commands. (line 7) +* property, LOG_INTO_DRAWER: Tracking TODO state changes. + (line 6) +* property, LOGGING <1>: Property inheritance. + (line 38) +* property, LOGGING: Tracking TODO state changes. + (line 45) +* property, ORDERED <1>: Checkboxes. (line 46) +* property, ORDERED: TODO dependencies. (line 6) +* property, special, ALLTAGS: Special properties. (line 13) +* property, special, BLOCKED: Special properties. (line 13) +* property, special, CATEGORY: Special properties. (line 13) +* property, special, CLOCKSUM <1>: Agenda column view. (line 28) +* property, special, CLOCKSUM: Special properties. (line 13) +* property, special, CLOCKSUM_T <1>: Agenda column view. (line 51) +* property, special, CLOCKSUM_T: Special properties. (line 13) +* property, special, CLOSED: Special properties. (line 13) +* property, special, DEADLINE: Special properties. (line 13) +* property, special, FILE: Special properties. (line 13) +* property, special, ID: Special properties. (line 13) +* property, special, ITEM: Special properties. (line 13) +* property, special, PRIORITY: Special properties. (line 13) +* property, special, SCHEDULED: Special properties. (line 13) +* property, special, TAGS: Special properties. (line 13) +* property, special, TIMESTAMP: Special properties. (line 13) +* property, special, TIMESTAMP_IA: Special properties. (line 13) +* property, special, TODO: Special properties. (line 13) +* property, SUMMARY: iCalendar export. (line 46) +* property, VISIBILITY: Initial visibility. (line 21) +* property: CLOCK_MODELINE_TOTAL: Clocking commands. (line 20) +* property: LAST_REPEAT: Clocking commands. (line 20) +* protocols, for external access: Protocols. (line 6) +* publishing: Publishing. (line 6) +* query editing, in agenda: Filtering/limiting agenda items. + (line 17) +* radio lists: Radio lists. (line 6) +* radio tables: Radio tables. (line 6) +* radio targets: Radio targets. (line 6) +* range formula: Field and range formulas. + (line 6) +* range references: References. (line 63) +* ranges, time: Timestamps. (line 6) +* recomputing table fields: Updating the table. (line 6) +* references: References. (line 6) +* references, named: References. (line 102) +* references, remote: References. (line 123) +* references, to a different table: References. (line 123) +* references, to fields: References. (line 15) +* references, to ranges: References. (line 63) +* refiling notes: Refile and copy. (line 6) +* region, active <1>: ODT export commands. (line 9) +* region, active <2>: Built-in table editor. + (line 156) +* region, active: Structure editing. (line 137) +* regular expressions, with tags search: Matching tags and properties. + (line 61) +* relative timer: Relative timer. (line 6) +* remember.el: Cooperation. (line 42) +* reminders: Weekly/daily agenda. (line 107) +* remote editing, bulk, from agenda: Agenda commands. (line 365) +* remote editing, from agenda: Agenda commands. (line 228) +* remote editing, undo: Agenda commands. (line 229) +* remote references: References. (line 123) +* repeated tasks: Repeated tasks. (line 6) +* report, of clocked time: The clock table. (line 6) +* resolve idle time: Resolving idle time. (line 9) +* revealing context: Global and local cycling. + (line 38) +* RMAIL links: External links. (line 6) +* Rose, Sebastian: JavaScript support. (line 6) +* row, of field coordinates: References. (line 86) +* RSS feeds: RSS Feeds. (line 6) +* rsync: Uploading files. (line 6) +* SCHEDULED keyword: Deadlines and scheduling. + (line 29) +* scheduling: Timestamps. (line 6) +* Schulte, Eric: Working With Source Code. + (line 6) +* Scripts, for agenda processing: Extracting agenda information. + (line 6) +* search option in file links: Search options. (line 6) +* search strings, custom: Custom searches. (line 6) +* search view: Search view. (line 6) +* searching for tags: Tag searches. (line 6) +* searching, for text: Search view. (line 6) +* searching, of properties: Property searches. (line 6) +* sectioning structure, for LaTeX export: Header and sectioning. + (line 6) +* set startup visibility, command: Global and local cycling. + (line 33) +* setting tags: Setting tags. (line 6) +* SHELL links: External links. (line 6) +* shift-selection-mode <1>: Conflicts. (line 6) +* shift-selection-mode: Plain lists. (line 94) +* show all, command: Global and local cycling. + (line 35) +* show all, global visibility state: Global and local cycling. + (line 22) +* show branches, command: Global and local cycling. + (line 47) +* show children, command: Global and local cycling. + (line 51) +* show hidden text: Visibility cycling. (line 6) +* showall, STARTUP keyword <1>: In-buffer settings. (line 80) +* showall, STARTUP keyword: Initial visibility. (line 6) +* showeverything, STARTUP keyword <1>: In-buffer settings. (line 80) +* showeverything, STARTUP keyword: Initial visibility. (line 6) +* showstars, STARTUP keyword: In-buffer settings. (line 140) +* sitemap, of published pages: Sitemap. (line 6) +* sorting, of agenda items: Sorting agenda items. + (line 6) +* sorting, of plain list: Plain lists. (line 154) +* sorting, of subtrees: Structure editing. (line 6) +* source blocks, in LaTeX export: LaTeX specific attributes. + (line 159) +* source code, batch execution: Batch execution. (line 6) +* source code, block header arguments: Header arguments. (line 6) +* source code, block structure: Structure of code blocks. + (line 6) +* source code, editing: Editing source code. (line 6) +* source code, evaluating: Evaluating code blocks. + (line 6) +* source code, exporting: Exporting code blocks. + (line 6) +* source code, extracting: Extracting source code. + (line 6) +* source code, inline: Structure of code blocks. + (line 16) +* source code, language: Structure of code blocks. + (line 37) +* source code, languages: Languages. (line 6) +* source code, library: Library of Babel. (line 6) +* source code, noweb reference: Noweb reference syntax. + (line 6) +* source code, results of evaluation: Results of evaluation. + (line 6) +* source code, switches: Structure of code blocks. + (line 41) +* source code, working with: Working With Source Code. + (line 6) +* sparse tree, for deadlines: Inserting deadline/schedule. + (line 32) +* sparse tree, for TODO: TODO basics. (line 42) +* sparse tree, tag based: Tags. (line 6) +* sparse trees: Sparse trees. (line 6) +* Special blocks: Special blocks. (line 6) +* special blocks, in LaTeX export: LaTeX specific attributes. + (line 180) +* special keywords: In-buffer settings. (line 6) +* special symbols: Special symbols. (line 6) +* speed keys: Speed keys. (line 6) +* speedbar.el: Cooperation. (line 45) +* spreadsheet capabilities: The spreadsheet. (line 6) +* square brackets, around links: External links. (line 70) +* statistics, for checkboxes: Checkboxes. (line 30) +* statistics, for TODO items: Breaking down tasks. (line 6) +* storing links: Handling links. (line 10) +* Storm, Kim. F.: Conflicts. (line 19) +* strike-through text, markup rules: Emphasis and monospace. + (line 6) +* structure editing: Structure editing. (line 6) +* structure of document: Document Structure. (line 6) +* styles, custom <1>: Working with OpenDocument style files. + (line 6) +* styles, custom: Applying custom styles. + (line 6) +* sublevels, inclusion into tags match: Tag inheritance. (line 6) +* sublevels, inclusion into TODO list: Global TODO list. (line 35) +* subscript: Subscripts and superscripts. + (line 6) +* subtree cycling: Global and local cycling. + (line 10) +* subtree visibility states: Global and local cycling. + (line 10) +* subtree, cut and paste: Structure editing. (line 6) +* subtree, subtree visibility state: Global and local cycling. + (line 10) +* subtrees, cut and paste: Structure editing. (line 6) +* summary: Summary. (line 6) +* superscript: Subscripts and superscripts. + (line 6) +* syntax, noweb: Noweb reference syntax. + (line 6) +* syntax, of formulas: Formula syntax for Calc. + (line 6) +* table editor, built-in: Built-in table editor. + (line 6) +* table editor, table.el: Cooperation. (line 52) +* table lookup functions: Lookup functions. (line 6) +* table of contents, markup rules: Table of contents. (line 6) +* table.el: Cooperation. (line 49) +* tables: Tables. (line 6) +* tables, in HTML: Tables in HTML export. + (line 6) +* tables, in LaTeX export: LaTeX specific attributes. + (line 12) +* tables, in ODT export <1>: Customizing tables in ODT export. + (line 6) +* tables, in ODT export: Tables in ODT export. + (line 6) +* tables, in other modes: Tables in arbitrary syntax. + (line 6) +* tables, markup rules: Images and tables. (line 6) +* tag completion: Completion. (line 6) +* tag filtering, in agenda: Filtering/limiting agenda items. + (line 17) +* tag inheritance: Tag inheritance. (line 6) +* tag searches: Tag searches. (line 6) +* tags: Tags. (line 6) +* tags view: Matching tags and properties. + (line 6) +* tags, as an agenda view: Storing searches. (line 9) +* tags, groups: Tag groups. (line 6) +* tags, setting: Setting tags. (line 6) +* tags-todo: Storing searches. (line 9) +* tags-tree: Storing searches. (line 9) +* tangling: Extracting source code. + (line 6) +* targets, for links: Internal links. (line 6) +* targets, radio: Radio targets. (line 6) +* tasks, breaking down: Breaking down tasks. (line 6) +* tasks, repeated: Repeated tasks. (line 6) +* template insertion: Easy Templates. (line 6) +* template, custom <1>: Working with OpenDocument style files. + (line 6) +* template, custom: Applying custom styles. + (line 6) +* templates, for Capture: Capture templates. (line 6) +* TeX interpretation: Embedded LaTeX. (line 6) +* TeX macros: Special symbols. (line 6) +* TeX symbol completion: Completion. (line 6) +* Texinfo export: Texinfo export. (line 6) +* text areas, in HTML: Text areas in HTML export. + (line 6) +* text search: Search view. (line 6) +* thanks: History and Acknowledgments. + (line 6) +* time clocking: Clocking work time. (line 6) +* time format, custom: Custom time format. (line 6) +* time grid: Time-of-day specifications. + (line 26) +* Time, computing: Durations and time values. + (line 6) +* time, reading in minibuffer: The date/time prompt. + (line 6) +* time-of-day specification: Time-of-day specifications. + (line 6) +* time-sorted view: Timeline. (line 6) +* timeline, single file: Timeline. (line 6) +* timerange: Timestamps. (line 43) +* times: Dates and Times. (line 6) +* timestamp <1>: Timestamps. (line 14) +* timestamp: Dates and Times. (line 6) +* timestamp, inactive: Timestamps. (line 52) +* timestamp, with repeater interval: Timestamps. (line 26) +* timestamps: Timestamps. (line 6) +* timestamps, creating: Creating timestamps. (line 6) +* TODO dependencies: TODO dependencies. (line 6) +* TODO items: TODO Items. (line 6) +* TODO keyword matching: Global TODO list. (line 18) +* TODO keyword matching, with tags search: Matching tags and properties. + (line 71) +* TODO keyword sets: Multiple sets in one file. + (line 6) +* TODO keywords completion: Completion. (line 6) +* TODO list, global: Global TODO list. (line 6) +* TODO types: TODO types. (line 6) +* TODO workflow: Workflow states. (line 6) +* todo, as an agenda view: Storing searches. (line 9) +* todo-tree: Storing searches. (line 9) +* top headline filtering, in agenda: Filtering/limiting agenda items. + (line 17) +* transient mark mode <1>: Built-in table editor. + (line 156) +* transient mark mode: Structure editing. (line 137) +* transient-mark-mode: ODT export commands. (line 9) +* translator function: Translator functions. + (line 6) +* trees, sparse: Sparse trees. (line 6) +* trees, visibility: Visibility cycling. (line 6) +* tty key bindings: TTY keys. (line 6) +* types as TODO keywords: TODO types. (line 6) +* underlined text, markup rules: Emphasis and monospace. + (line 6) +* undoing remote-editing events: Agenda commands. (line 229) +* unison: Uploading files. (line 6) +* unoconv: Extending ODT export. + (line 11) +* updating, table: Updating the table. (line 6) +* URL links: External links. (line 6) +* USENET links: External links. (line 6) +* UTF-8 export: ASCII/Latin-1/UTF-8 export. + (line 6) +* variables, for customization: Customization. (line 6) +* vectors, in table calculations: Formula syntax for Calc. + (line 11) +* verbatim text, markup rules: Emphasis and monospace. + (line 6) +* viper.el: Conflicts. (line 97) +* visibility cycling: Visibility cycling. (line 6) +* visibility cycling, drawers: Drawers. (line 6) +* visibility, initialize: Initial visibility. (line 6) +* visible text, printing: Sparse trees. (line 53) +* VM links: External links. (line 43) +* WANDERLUST links: External links. (line 43) +* weekly agenda: Weekly/daily agenda. (line 6) +* Wiegley, John: Cooperation. (line 42) +* windmove.el: Conflicts. (line 84) +* workflow states as TODO keywords: Workflow states. (line 6) +* XEmacs: Installation. (line 6) +* yasnippet.el: Conflicts. (line 58) +* zip: Pre-requisites for ODT export. + (line 6) + + +File: org, Node: Key Index, Next: Command and Function Index, Prev: Main Index, Up: Top + +Key index +********* + +[index] +* Menu: + +* $: Agenda commands. (line 263) +* %: Agenda commands. (line 382) +* ': CDLaTeX mode. (line 43) +* *: Agenda commands. (line 367) +* +: Agenda commands. (line 285) +* ,: Agenda commands. (line 277) +* -: Agenda commands. (line 290) +* .: Agenda commands. (line 97) +* / <1>: Agenda commands. (line 198) +* /: Filtering/limiting agenda items. + (line 17) +* :: Agenda commands. (line 273) +* ;: Countdown timer. (line 6) +* < <1>: Agenda commands. (line 205) +* < <2>: Filtering/limiting agenda items. + (line 93) +* < <3>: Agenda files. (line 57) +* < <4>: The date/time prompt. + (line 82) +* <: Using column view. (line 70) +* <1>: Agenda commands. (line 37) +* <2>: The date/time prompt. + (line 82) +* <3>: Setting tags. (line 116) +* <4>: Handling links. (line 122) +* : Built-in table editor. + (line 65) +* <1>: Agenda commands. (line 28) +* : Setting tags. (line 115) +* <1>: CDLaTeX mode. (line 23) +* <2>: Agenda commands. (line 34) +* <3>: Setting tags. (line 107) +* <4>: Editing and debugging formulas. + (line 57) +* <5>: Built-in table editor. + (line 58) +* <6>: Plain lists. (line 68) +* <7>: Structure editing. (line 33) +* : Global and local cycling. + (line 10) +* = <1>: Agenda commands. (line 213) +* =: Filtering/limiting agenda items. + (line 103) +* > <1>: Agenda commands. (line 326) +* > <2>: Agenda files. (line 61) +* > <3>: The date/time prompt. + (line 82) +* >: Using column view. (line 70) +* ?: Pulling from MobileOrg. + (line 34) +* [ <1>: Agenda commands. (line 121) +* [: Filtering/limiting agenda items. + (line 83) +* \ <1>: Agenda commands. (line 202) +* \: Filtering/limiting agenda items. + (line 76) +* ]: Filtering/limiting agenda items. + (line 83) +* ^ <1>: CDLaTeX mode. (line 33) +* ^ <2>: Agenda commands. (line 209) +* ^: Filtering/limiting agenda items. + (line 99) +* _: CDLaTeX mode. (line 33) +* `: CDLaTeX mode. (line 39) +* a: Agenda commands. (line 251) +* A: Agenda commands. (line 64) +* a: Using column view. (line 59) +* B: Agenda commands. (line 385) +* b: Agenda commands. (line 94) +* C: Agenda commands. (line 489) +* c: Agenda commands. (line 456) +* C-#: Advanced features. (line 10) +* C-': Agenda files. (line 22) +* C-,: Agenda files. (line 22) +* C-0 C-c C-w: Refile and copy. (line 47) +* C-: Structure editing. (line 19) +* C-_: Agenda commands. (line 229) +* C-c !: Creating timestamps. (line 15) +* C-c #: Checkboxes. (line 84) +* C-c $: Moving subtrees. (line 9) +* C-c %: Handling links. (line 142) +* C-c &: Handling links. (line 146) +* C-c ' <1>: Cooperation. (line 61) +* C-c ' <2>: Editing source code. (line 6) +* C-c ' <3>: Include files. (line 36) +* C-c ' <4>: Literal examples. (line 70) +* C-c ': Editing and debugging formulas. + (line 36) +* C-c * <1>: Updating the table. (line 13) +* C-c * <2>: Plain lists. (line 139) +* C-c *: Structure editing. (line 126) +* C-c +: Built-in table editor. + (line 156) +* C-c ,: Priorities. (line 24) +* C-c - <1>: Built-in table editor. + (line 101) +* C-c -: Plain lists. (line 127) +* C-c .: Creating timestamps. (line 10) +* C-c / <1>: Conflicts. (line 97) +* C-c /: Sparse trees. (line 15) +* C-c / a: Inserting deadline/schedule. + (line 39) +* C-c / b: Inserting deadline/schedule. + (line 36) +* C-c / d: Inserting deadline/schedule. + (line 29) +* C-c / m <1>: Property searches. (line 10) +* C-c / m: Tag searches. (line 9) +* C-c / p: Property searches. (line 29) +* C-c / r: Sparse trees. (line 17) +* C-c / t: TODO basics. (line 39) +* C-c ;: Comment lines. (line 12) +* C-c <: Creating timestamps. (line 29) +* C-c : Built-in table editor. + (line 105) +* C-c : Global and local cycling. + (line 51) +* C-c = <1>: Editing and debugging formulas. + (line 13) +* C-c =: Column formulas. (line 32) +* C-c >: Creating timestamps. (line 33) +* C-c ?: Editing and debugging formulas. + (line 22) +* C-c @: Structure editing. (line 63) +* C-c [: Agenda files. (line 15) +* C-c \ <1>: Property searches. (line 10) +* C-c \: Tag searches. (line 9) +* C-c ]: Agenda files. (line 19) +* C-c ^ <1>: Built-in table editor. + (line 109) +* C-c ^ <2>: Plain lists. (line 154) +* C-c ^: Structure editing. (line 105) +* C-c `: Built-in table editor. + (line 174) +* C-c a: Conventions. (line 35) +* C-c a !: Stuck projects. (line 14) +* C-c a #: Stuck projects. (line 13) +* C-c a ?: Pulling from MobileOrg. + (line 44) +* C-c a a: Weekly/daily agenda. (line 9) +* C-c a C: Storing searches. (line 9) +* C-c a e: Exporting Agenda Views. + (line 64) +* C-c a L: Timeline. (line 10) +* C-c a M: Matching tags and properties. + (line 17) +* C-c a m: Matching tags and properties. + (line 12) +* C-c a M: Property searches. (line 16) +* C-c a m: Property searches. (line 12) +* C-c a M: Tag searches. (line 17) +* C-c a m: Tag searches. (line 13) +* C-c a s: Search view. (line 9) +* C-c a T: Global TODO list. (line 15) +* C-c a t <1>: Global TODO list. (line 9) +* C-c a t: TODO basics. (line 50) +* C-c c <1>: Using capture. (line 6) +* C-c c: Conventions. (line 35) +* C-c c C: Capture templates. (line 10) +* C-c C-*: Plain lists. (line 144) +* C-c C-a <1>: Agenda commands. (line 298) +* C-c C-a: Attachments. (line 26) +* C-c C-a a: Attachments. (line 31) +* C-c C-a c: Attachments. (line 37) +* C-c C-a D: Attachments. (line 66) +* C-c C-a d: Attachments. (line 63) +* C-c C-a F: Attachments. (line 60) +* C-c C-a f: Attachments. (line 57) +* C-c C-a i: Attachments. (line 75) +* C-c C-a l: Attachments. (line 37) +* C-c C-a m: Attachments. (line 37) +* C-c C-a n: Attachments. (line 41) +* C-c C-a O: Attachments. (line 54) +* C-c C-a o: Attachments. (line 48) +* C-c C-a s: Attachments. (line 70) +* C-c C-a z: Attachments. (line 44) +* C-c C-b <1>: Beamer export. (line 142) +* C-c C-b: Motion. (line 15) +* C-c C-c <1>: Cooperation. (line 52) +* C-c C-c <2>: The very busy C-c C-c key. + (line 6) +* C-c C-c <3>: Key bindings and useful functions. + (line 11) +* C-c C-c <4>: Evaluating code blocks. + (line 19) +* C-c C-c <5>: Previewing LaTeX fragments. + (line 15) +* C-c C-c <6>: Using capture. (line 15) +* C-c C-c <7>: The clock table. (line 16) +* C-c C-c <8>: Clocking commands. (line 51) +* C-c C-c <9>: Creating timestamps. (line 26) +* C-c C-c <10>: Capturing column view. + (line 51) +* C-c C-c <11>: Using column view. (line 52) +* C-c C-c <12>: Property syntax. (line 90) +* C-c C-c <13>: Setting tags. (line 20) +* C-c C-c <14>: Checkboxes. (line 52) +* C-c C-c <15>: Editing and debugging formulas. + (line 47) +* C-c C-c <16>: Built-in table editor. + (line 57) +* C-c C-c <17>: Footnotes. (line 86) +* C-c C-c: Plain lists. (line 122) +* C-c C-c c: Property syntax. (line 108) +* C-c C-c D: Property syntax. (line 105) +* C-c C-c d: Property syntax. (line 102) +* C-c C-c s: Property syntax. (line 94) +* C-c C-d <1>: Agenda commands. (line 305) +* C-c C-d: Inserting deadline/schedule. + (line 9) +* C-c C-e: The Export Dispatcher. + (line 11) +* C-c C-e c a: iCalendar export. (line 34) +* C-c C-e c c: iCalendar export. (line 39) +* C-c C-e c f: iCalendar export. (line 32) +* C-c C-e C-v: Sparse trees. (line 53) +* C-c C-e h H: HTML Export commands. + (line 10) +* C-c C-e h h: HTML Export commands. + (line 6) +* C-c C-e i i: Texinfo export commands. + (line 9) +* C-c C-e i t: Texinfo export commands. + (line 6) +* C-c C-e l B: Beamer export. (line 16) +* C-c C-e l b: Beamer export. (line 13) +* C-c C-e l L: LaTeX export commands. + (line 9) +* C-c C-e l l: LaTeX export commands. + (line 6) +* C-c C-e l p: LaTeX export commands. + (line 12) +* C-c C-e l P: Beamer export. (line 19) +* C-c C-e m M: Markdown export. (line 19) +* C-c C-e m m: Markdown export. (line 16) +* C-c C-e O O: Org export. (line 16) +* C-c C-e O o: Org export. (line 13) +* C-c C-e o o: ODT export commands. (line 9) +* C-c C-e P a: Triggering publication. + (line 16) +* C-c C-e P f: Triggering publication. + (line 13) +* C-c C-e P p: Triggering publication. + (line 10) +* C-c C-e P x: Triggering publication. + (line 8) +* C-c C-e t A/L/U: ASCII/Latin-1/UTF-8 export. + (line 22) +* C-c C-e t a/l/u: ASCII/Latin-1/UTF-8 export. + (line 18) +* C-c C-f: Motion. (line 12) +* C-c C-j: Motion. (line 21) +* C-c C-k <1>: Using capture. (line 31) +* C-c C-k: Global and local cycling. + (line 47) +* C-c C-l: Handling links. (line 65) +* C-c C-n: Motion. (line 8) +* C-c C-o <1>: Key bindings and useful functions. + (line 11) +* C-c C-o <2>: Agenda commands. (line 56) +* C-c C-o <3>: Creating timestamps. (line 38) +* C-c C-o <4>: Handling links. (line 101) +* C-c C-o: Footnotes. (line 90) +* C-c C-p: Motion. (line 9) +* C-c C-q <1>: Setting tags. (line 10) +* C-c C-q: Editing and debugging formulas. + (line 50) +* C-c C-r <1>: Editing and debugging formulas. + (line 53) +* C-c C-r: Global and local cycling. + (line 38) +* C-c C-s <1>: Agenda commands. (line 301) +* C-c C-s: Inserting deadline/schedule. + (line 17) +* C-c C-t <1>: Clocking commands. (line 67) +* C-c C-t: TODO basics. (line 13) +* C-c C-u: Motion. (line 18) +* C-c C-v a: Key bindings and useful functions. + (line 54) +* C-c C-v b: Key bindings and useful functions. + (line 32) +* C-c C-v c: Key bindings and useful functions. + (line 42) +* C-c C-v C-a: Key bindings and useful functions. + (line 54) +* C-c C-v C-b: Key bindings and useful functions. + (line 32) +* C-c C-v C-c: Key bindings and useful functions. + (line 42) +* C-c C-v C-d: Key bindings and useful functions. + (line 36) +* C-c C-v C-e: Key bindings and useful functions. + (line 20) +* C-c C-v C-f: Key bindings and useful functions. + (line 40) +* C-c C-v C-g: Key bindings and useful functions. + (line 28) +* C-c C-v C-h: Key bindings and useful functions. + (line 56) +* C-c C-v C-I: Key bindings and useful functions. + (line 50) +* C-c C-v C-i: Key bindings and useful functions. + (line 48) +* C-c C-v C-j: Key bindings and useful functions. + (line 44) +* C-c C-v C-l: Key bindings and useful functions. + (line 46) +* C-c C-v C-n: Key bindings and useful functions. + (line 18) +* C-c C-v C-o: Key bindings and useful functions. + (line 22) +* C-c C-v C-p: Key bindings and useful functions. + (line 18) +* C-c C-v C-r: Key bindings and useful functions. + (line 30) +* C-c C-v C-s: Key bindings and useful functions. + (line 34) +* C-c C-v C-t: Key bindings and useful functions. + (line 38) +* C-c C-v C-u: Key bindings and useful functions. + (line 26) +* C-c C-v C-v: Key bindings and useful functions. + (line 24) +* C-c C-v C-x: Key bindings and useful functions. + (line 58) +* C-c C-v C-z: Key bindings and useful functions. + (line 52) +* C-c C-v d: Key bindings and useful functions. + (line 36) +* C-c C-v e: Key bindings and useful functions. + (line 20) +* C-c C-v f: Key bindings and useful functions. + (line 40) +* C-c C-v g: Key bindings and useful functions. + (line 28) +* C-c C-v h: Key bindings and useful functions. + (line 56) +* C-c C-v I: Key bindings and useful functions. + (line 50) +* C-c C-v i <1>: Key bindings and useful functions. + (line 48) +* C-c C-v i: Library of Babel. (line 20) +* C-c C-v j: Key bindings and useful functions. + (line 44) +* C-c C-v l: Key bindings and useful functions. + (line 46) +* C-c C-v n: Key bindings and useful functions. + (line 18) +* C-c C-v o: Key bindings and useful functions. + (line 22) +* C-c C-v p: Key bindings and useful functions. + (line 18) +* C-c C-v r: Key bindings and useful functions. + (line 30) +* C-c C-v s: Key bindings and useful functions. + (line 34) +* C-c C-v t <1>: Key bindings and useful functions. + (line 38) +* C-c C-v t: Extracting source code. + (line 26) +* C-c C-v u: Key bindings and useful functions. + (line 26) +* C-c C-v v: Key bindings and useful functions. + (line 24) +* C-c C-v x: Key bindings and useful functions. + (line 58) +* C-c C-v z: Key bindings and useful functions. + (line 52) +* C-c C-w <1>: Agenda commands. (line 248) +* C-c C-w <2>: Refile and copy. (line 14) +* C-c C-w <3>: Using capture. (line 22) +* C-c C-w: Structure editing. (line 101) +* C-c C-x ,: Relative timer. (line 21) +* C-c C-x -: Relative timer. (line 13) +* C-c C-x .: Relative timer. (line 10) +* C-c C-x 0: Relative timer. (line 30) +* C-c C-x ;: Countdown timer. (line 6) +* C-c C-x <: Agenda files. (line 42) +* C-c C-x > <1>: Agenda commands. (line 188) +* C-c C-x >: Agenda files. (line 49) +* C-c C-x \ <1>: Subscripts and superscripts. + (line 21) +* C-c C-x \: Special symbols. (line 31) +* C-c C-x A: Agenda commands. (line 259) +* C-c C-x a: Agenda commands. (line 256) +* C-c C-x A: Internal archiving. (line 49) +* C-c C-x a: Internal archiving. (line 36) +* C-c C-x b <1>: Agenda commands. (line 47) +* C-c C-x b: Global and local cycling. + (line 55) +* C-c C-x c: Structure editing. (line 93) +* C-c C-x C-a <1>: Agenda commands. (line 251) +* C-c C-x C-a: Archiving. (line 11) +* C-c C-x C-b: Checkboxes. (line 56) +* C-c C-x C-c <1>: Agenda column view. (line 11) +* C-c C-x C-c <2>: Agenda commands. (line 177) +* C-c C-x C-c: Using column view. (line 9) +* C-c C-x C-d: Clocking commands. (line 80) +* C-c C-x C-e <1>: Effort estimates. (line 17) +* C-c C-x C-e: Clocking commands. (line 48) +* C-c C-x C-i: Clocking commands. (line 6) +* C-c C-x C-j: Clocking commands. (line 75) +* C-c C-x C-k: Inserting deadline/schedule. + (line 23) +* C-c C-x C-l: Previewing LaTeX fragments. + (line 9) +* C-c C-x C-n: Handling links. (line 152) +* C-c C-x C-o: Clocking commands. (line 34) +* C-c C-x C-p: Handling links. (line 152) +* C-c C-x C-q: Clocking commands. (line 71) +* C-c C-x C-r: The clock table. (line 10) +* C-c C-x C-s <1>: Agenda commands. (line 263) +* C-c C-x C-s: Moving subtrees. (line 9) +* C-c C-x C-t: Custom time format. (line 12) +* C-c C-x C-u <1>: Dynamic blocks. (line 21) +* C-c C-x C-u <2>: The clock table. (line 16) +* C-c C-x C-u: Capturing column view. + (line 51) +* C-c C-x C-v: Handling links. (line 133) +* C-c C-x C-w <1>: Built-in table editor. + (line 130) +* C-c C-x C-w: Structure editing. (line 67) +* C-c C-x C-x: Clocking commands. (line 42) +* C-c C-x C-y <1>: Built-in table editor. + (line 134) +* C-c C-x C-y: Structure editing. (line 75) +* C-c C-x d: Drawers. (line 6) +* C-c C-x e: Effort estimates. (line 14) +* C-c C-x f: Footnotes. (line 51) +* C-c C-x G: RSS Feeds. (line 27) +* C-c C-x g: RSS Feeds. (line 23) +* C-c C-x i: Capturing column view. + (line 49) +* C-c C-x M-w <1>: Built-in table editor. + (line 126) +* C-c C-x M-w: Structure editing. (line 71) +* C-c C-x o <1>: Checkboxes. (line 76) +* C-c C-x o: TODO dependencies. (line 29) +* C-c C-x p <1>: Header arguments in Org mode properties. + (line 34) +* C-c C-x p: Property syntax. (line 81) +* C-c C-x q: Tag groups. (line 34) +* C-c C-x v: Global and local cycling. + (line 61) +* C-c C-y <1>: Clocking commands. (line 51) +* C-c C-y: Creating timestamps. (line 59) +* C-c C-z <1>: Agenda commands. (line 293) +* C-c C-z: Drawers. (line 35) +* C-c l <1>: Literal examples. (line 78) +* C-c l: Handling links. (line 9) +* C-c M-w: Refile and copy. (line 12) +* C-c { <1>: CDLaTeX mode. (line 21) +* C-c {: Editing and debugging formulas. + (line 32) +* C-c |: Built-in table editor. + (line 41) +* C-c }: Editing and debugging formulas. + (line 26) +* C-c ~: Cooperation. (line 63) +* C-k: Agenda commands. (line 242) +* C-S- <1>: Agenda commands. (line 240) +* C-S-: Multiple sets in one file. + (line 25) +* C-S-: Structure editing. (line 28) +* C-S- <1>: Agenda commands. (line 237) +* C-S-: Multiple sets in one file. + (line 25) +* C-S-: Clocking commands. (line 56) +* C-TAB: Internal archiving. (line 46) +* C-u C-c !: Creating timestamps. (line 19) +* C-u C-c *: Updating the table. (line 16) +* C-u C-c .: Creating timestamps. (line 19) +* C-u C-c = <1>: Editing and debugging formulas. + (line 13) +* C-u C-c =: Field and range formulas. + (line 28) +* C-u C-c c: Using capture. (line 43) +* C-u C-c C-c: Updating the table. (line 19) +* C-u C-c C-l: Handling links. (line 86) +* C-u C-c C-t: TODO basics. (line 28) +* C-u C-c C-w: Refile and copy. (line 33) +* C-u C-c C-x ,: Relative timer. (line 25) +* C-u C-c C-x a: Internal archiving. (line 39) +* C-u C-c C-x C-s: Moving subtrees. (line 11) +* C-u C-c C-x C-u <1>: Dynamic blocks. (line 22) +* C-u C-c C-x C-u <2>: The clock table. (line 20) +* C-u C-c C-x C-u: Capturing column view. + (line 55) +* C-u C-u <1>: Initial visibility. (line 25) +* C-u C-u : Global and local cycling. + (line 33) +* C-u C-u C-c *: Updating the table. (line 22) +* C-u C-u C-c =: Editing and debugging formulas. + (line 16) +* C-u C-u C-c c: Using capture. (line 45) +* C-u C-u C-c C-c: Updating the table. (line 22) +* C-u C-u C-c C-t: Multiple sets in one file. + (line 25) +* C-u C-u C-c C-w: Refile and copy. (line 36) +* C-u C-u C-u : Global and local cycling. + (line 35) +* C-u C-u C-u C-c C-t: TODO dependencies. (line 34) +* C-v: The date/time prompt. + (line 82) +* C-x C-s <1>: Agenda commands. (line 173) +* C-x C-s: Editing and debugging formulas. + (line 47) +* C-x C-w <1>: Exporting Agenda Views. + (line 12) +* C-x C-w: Agenda commands. (line 506) +* C-x n b: Structure editing. (line 120) +* C-x n s: Structure editing. (line 117) +* C-x n w: Structure editing. (line 123) +* C-y: Structure editing. (line 81) +* D: Agenda commands. (line 106) +* d: Agenda commands. (line 69) +* E: Agenda commands. (line 151) +* e: Using column view. (line 46) +* f: Agenda commands. (line 88) +* F: Agenda commands. (line 40) +* g: Agenda commands. (line 170) +* G: Agenda commands. (line 159) +* g: Using column view. (line 23) +* H: Agenda commands. (line 493) +* i: Agenda commands. (line 461) +* I: Agenda commands. (line 331) +* J: Agenda commands. (line 103) +* j: Agenda commands. (line 100) +* k: Agenda commands. (line 344) +* k a: Inserting deadline/schedule. + (line 26) +* k s: Inserting deadline/schedule. + (line 26) +* l: Agenda commands. (line 110) +* L: Agenda commands. (line 31) +* M: Agenda commands. (line 480) +* m: Agenda commands. (line 365) +* M-*: Agenda commands. (line 379) +* M- <1>: Agenda commands. (line 358) +* M- <2>: Editing and debugging formulas. + (line 77) +* M- <3>: Built-in table editor. + (line 90) +* M-: Plain lists. (line 97) +* M- <1>: Built-in table editor. + (line 82) +* M- <2>: Plain lists. (line 103) +* M-: Structure editing. (line 39) +* M- <1>: Relative timer. (line 17) +* M- <2>: Built-in table editor. + (line 141) +* M- <3>: Plain lists. (line 79) +* M-: Structure editing. (line 6) +* M- <1>: Built-in table editor. + (line 82) +* M- <2>: Plain lists. (line 103) +* M-: Structure editing. (line 42) +* M- <1>: Completion. (line 16) +* M- <2>: Property syntax. (line 78) +* M- <3>: Setting tags. (line 6) +* M- <4>: Per-file keywords. (line 24) +* M-: Editing and debugging formulas. + (line 64) +* M- <1>: Agenda commands. (line 354) +* M- <2>: Editing and debugging formulas. + (line 77) +* M- <3>: Built-in table editor. + (line 90) +* M-: Plain lists. (line 97) +* M-a: Built-in table editor. + (line 70) +* M-down: Key bindings and useful functions. + (line 13) +* M-e: Built-in table editor. + (line 74) +* M-g M-n: Sparse trees. (line 29) +* M-g M-p: Sparse trees. (line 32) +* M-g n: Sparse trees. (line 29) +* M-g p: Sparse trees. (line 32) +* M-h: Structure editing. (line 57) +* M-m: Agenda commands. (line 376) +* M-S- <1>: Editing and debugging formulas. + (line 72) +* M-S- <2>: Built-in table editor. + (line 97) +* M-S-: Structure editing. (line 54) +* M-S- <1>: The date/time prompt. + (line 82) +* M-S- <2>: Built-in table editor. + (line 84) +* M-S- <3>: Plain lists. (line 108) +* M-S-: Structure editing. (line 45) +* M-S- <1>: Checkboxes. (line 73) +* M-S- <2>: Plain lists. (line 89) +* M-S-: Structure editing. (line 24) +* M-S- <1>: The date/time prompt. + (line 82) +* M-S- <2>: Built-in table editor. + (line 87) +* M-S- <3>: Plain lists. (line 108) +* M-S-: Structure editing. (line 48) +* M-S- <1>: Editing and debugging formulas. + (line 72) +* M-S- <2>: Built-in table editor. + (line 94) +* M-S-: Structure editing. (line 51) +* M-up: Key bindings and useful functions. + (line 12) +* M-v: The date/time prompt. + (line 82) +* M-x org-iswitchb: Agenda files. (line 26) +* mouse-1 <1>: The date/time prompt. + (line 82) +* mouse-1 <2>: Handling links. (line 124) +* mouse-1: Footnotes. (line 90) +* mouse-2 <1>: Agenda commands. (line 34) +* mouse-2 <2>: Handling links. (line 124) +* mouse-2: Footnotes. (line 90) +* mouse-3 <1>: Agenda commands. (line 28) +* mouse-3: Handling links. (line 129) +* n <1>: Agenda commands. (line 19) +* n: Using column view. (line 42) +* O: Agenda commands. (line 335) +* o: Agenda commands. (line 66) +* P: Agenda commands. (line 282) +* p <1>: Agenda commands. (line 20) +* p: Using column view. (line 42) +* q <1>: Agenda commands. (line 520) +* q: Using column view. (line 26) +* r: Agenda commands. (line 163) +* R: Agenda commands. (line 132) +* r <1>: Global TODO list. (line 23) +* r: Using column view. (line 19) +* S: Agenda commands. (line 484) +* s: Agenda commands. (line 173) +* S- <1>: Agenda commands. (line 290) +* S- <2>: The date/time prompt. + (line 82) +* S- <3>: Creating timestamps. (line 47) +* S- <4>: Priorities. (line 29) +* S- <5>: Editing and debugging formulas. + (line 67) +* S-: Plain lists. (line 90) +* S- <1>: Agenda commands. (line 322) +* S- <2>: The clock table. (line 24) +* S- <3>: The date/time prompt. + (line 82) +* S- <4>: Creating timestamps. (line 42) +* S- <5>: Using column view. (line 35) +* S- <6>: Property syntax. (line 98) +* S- <7>: Multiple sets in one file. + (line 32) +* S- <8>: TODO basics. (line 34) +* S- <9>: Editing and debugging formulas. + (line 67) +* S-: Plain lists. (line 149) +* S-: Built-in table editor. + (line 159) +* S- <1>: Agenda commands. (line 308) +* S- <2>: The clock table. (line 24) +* S- <3>: The date/time prompt. + (line 82) +* S- <4>: Creating timestamps. (line 42) +* S- <5>: Using column view. (line 35) +* S- <6>: Property syntax. (line 98) +* S- <7>: Multiple sets in one file. + (line 32) +* S- <8>: TODO basics. (line 34) +* S- <9>: Editing and debugging formulas. + (line 67) +* S-: Plain lists. (line 149) +* S- <1>: Built-in table editor. + (line 62) +* S-: Global and local cycling. + (line 22) +* S- <1>: Agenda commands. (line 285) +* S- <2>: The date/time prompt. + (line 82) +* S- <3>: Creating timestamps. (line 47) +* S- <4>: Priorities. (line 29) +* S-: Editing and debugging formulas. + (line 67) +* S-M-: Using column view. (line 75) +* S-M-: TODO basics. (line 58) +* S-M-: Using column view. (line 72) +* S-M-: Clocking commands. (line 60) +* T: Agenda commands. (line 268) +* t: Agenda commands. (line 233) +* U: Agenda commands. (line 373) +* u: Agenda commands. (line 370) +* v: Using column view. (line 55) +* v [: Agenda commands. (line 121) +* v A: Agenda commands. (line 128) +* v a: Agenda commands. (line 125) +* v c: Agenda commands. (line 143) +* v d: Agenda commands. (line 69) +* v E: Agenda commands. (line 151) +* v L: Agenda commands. (line 113) +* v l: Agenda commands. (line 110) +* v m: Agenda commands. (line 74) +* v R: Agenda commands. (line 132) +* v SPC: Agenda commands. (line 76) +* v t: Agenda commands. (line 73) +* v w: Agenda commands. (line 72) +* v y: Agenda commands. (line 75) +* w: Agenda commands. (line 72) +* x: Agenda commands. (line 521) +* X: Agenda commands. (line 338) +* z: Agenda commands. (line 293) +* {: Filtering/limiting agenda items. + (line 83) +* | <1>: Agenda commands. (line 222) +* |: Filtering/limiting agenda items. + (line 112) +* }: Filtering/limiting agenda items. + (line 83) +* ~: Filtering/limiting agenda items. + (line 153) + + +File: org, Node: Command and Function Index, Next: Variable Index, Prev: Key Index, Up: Top + +Command and function index +************************** + +[index] +* Menu: + +* lisp-complete-symbol: Editing and debugging formulas. + (line 64) +* next-error: Sparse trees. (line 29) +* org-agenda <1>: Conventions. (line 35) +* org-agenda: Activation. (line 6) +* org-agenda-add-note: Agenda commands. (line 293) +* org-agenda-archive: Agenda commands. (line 263) +* org-agenda-archive-default-with-confirmation: Agenda commands. + (line 251) +* org-agenda-archive-to-archive-sibling: Agenda commands. (line 259) +* org-agenda-archives-mode: Agenda commands. (line 125) +* org-agenda-archives-mode 'files: Agenda commands. (line 128) +* org-agenda-bulk-action: Agenda commands. (line 385) +* org-agenda-bulk-mark: Agenda commands. (line 365) +* org-agenda-bulk-mark-all: Agenda commands. (line 367) +* org-agenda-bulk-mark-regexp: Agenda commands. (line 382) +* org-agenda-bulk-remove-all-marks: Agenda commands. (line 373) +* org-agenda-bulk-toggle: Agenda commands. (line 376) +* org-agenda-bulk-toggle-all: Agenda commands. (line 379) +* org-agenda-bulk-unmark: Agenda commands. (line 370) +* org-agenda-capture: Agenda commands. (line 344) +* org-agenda-clock-cancel: Agenda commands. (line 338) +* org-agenda-clock-goto: Agenda commands. (line 103) +* org-agenda-clock-in: Agenda commands. (line 331) +* org-agenda-clock-out: Agenda commands. (line 335) +* org-agenda-clockreport-mode: Agenda commands. (line 132) +* org-agenda-columns <1>: Agenda column view. (line 11) +* org-agenda-columns: Agenda commands. (line 177) +* org-agenda-convert-date: Agenda commands. (line 489) +* org-agenda-date-prompt: Agenda commands. (line 326) +* org-agenda-day-view: Agenda commands. (line 69) +* org-agenda-deadline: Agenda commands. (line 305) +* org-agenda-diary-entry: Agenda commands. (line 461) +* org-agenda-do-date-earlier: Agenda commands. (line 322) +* org-agenda-do-date-later: Agenda commands. (line 308) +* org-agenda-drag-line-backward: Agenda commands. (line 354) +* org-agenda-drag-line-forward: Agenda commands. (line 358) +* org-agenda-earlier: Agenda commands. (line 94) +* org-agenda-entry-text-mode: Agenda commands. (line 151) +* org-agenda-exit: Agenda commands. (line 521) +* org-agenda-file-to-front: Agenda files. (line 15) +* org-agenda-filter-by-category <1>: Agenda commands. (line 205) +* org-agenda-filter-by-category: Filtering/limiting agenda items. + (line 93) +* org-agenda-filter-by-regexp <1>: Agenda commands. (line 213) +* org-agenda-filter-by-regexp: Filtering/limiting agenda items. + (line 103) +* org-agenda-filter-by-tag <1>: Agenda commands. (line 198) +* org-agenda-filter-by-tag: Filtering/limiting agenda items. + (line 17) +* org-agenda-filter-by-tag-refine <1>: Agenda commands. (line 202) +* org-agenda-filter-by-tag-refine: Filtering/limiting agenda items. + (line 76) +* org-agenda-filter-by-top-headline <1>: Agenda commands. (line 209) +* org-agenda-filter-by-top-headline: Filtering/limiting agenda items. + (line 99) +* org-agenda-filter-remove-all <1>: Agenda commands. (line 222) +* org-agenda-filter-remove-all: Filtering/limiting agenda items. + (line 112) +* org-agenda-follow-mode: Agenda commands. (line 40) +* org-agenda-fortnight-view: Agenda commands. (line 73) +* org-agenda-goto: Agenda commands. (line 34) +* org-agenda-goto-calendar: Agenda commands. (line 456) +* org-agenda-goto-date: Agenda commands. (line 100) +* org-agenda-goto-today: Agenda commands. (line 97) +* org-agenda-holidays: Agenda commands. (line 493) +* org-agenda-kill: Agenda commands. (line 242) +* org-agenda-later: Agenda commands. (line 88) +* org-agenda-limit-interactively: Filtering/limiting agenda items. + (line 153) +* org-agenda-list: Weekly/daily agenda. (line 9) +* org-agenda-list-stuck-projects: Stuck projects. (line 13) +* org-agenda-log-mode: Agenda commands. (line 110) +* org-agenda-manipulate-query-add: Agenda commands. (line 121) +* org-agenda-month-view: Agenda commands. (line 74) +* org-agenda-next-line: Agenda commands. (line 19) +* org-agenda-open-link: Agenda commands. (line 56) +* org-agenda-phases-of-moon: Agenda commands. (line 480) +* org-agenda-previous-line: Agenda commands. (line 20) +* org-agenda-priority-down: Agenda commands. (line 290) +* org-agenda-priority-up: Agenda commands. (line 285) +* org-agenda-quit: Agenda commands. (line 520) +* org-agenda-recenter: Agenda commands. (line 31) +* org-agenda-redo: Agenda commands. (line 163) +* org-agenda-refile: Agenda commands. (line 248) +* org-agenda-remove-restriction-lock <1>: Agenda commands. (line 188) +* org-agenda-remove-restriction-lock: Agenda files. (line 49) +* org-agenda-reset-view: Agenda commands. (line 76) +* org-agenda-schedule: Agenda commands. (line 301) +* org-agenda-set-restriction-lock: Agenda files. (line 42) +* org-agenda-set-tags: Agenda commands. (line 273) +* org-agenda-show-and-scroll-up: Agenda commands. (line 28) +* org-agenda-show-priority: Agenda commands. (line 282) +* org-agenda-show-tags: Agenda commands. (line 268) +* org-agenda-sunrise-sunset: Agenda commands. (line 484) +* org-agenda-switch-to: Agenda commands. (line 37) +* org-agenda-todo: Agenda commands. (line 233) +* org-agenda-todo-nextset: Agenda commands. (line 237) +* org-agenda-todo-previousset: Agenda commands. (line 240) +* org-agenda-toggle-archive-tag: Agenda commands. (line 256) +* org-agenda-toggle-diary: Agenda commands. (line 106) +* org-agenda-toggle-time-grid: Agenda commands. (line 159) +* org-agenda-tree-to-indirect-buffer: Agenda commands. (line 47) +* org-agenda-undo: Agenda commands. (line 229) +* org-agenda-week-view: Agenda commands. (line 72) +* org-agenda-write <1>: Exporting Agenda Views. + (line 12) +* org-agenda-write: Agenda commands. (line 506) +* org-agenda-year-view: Agenda commands. (line 75) +* org-archive-subtree: Moving subtrees. (line 9) +* org-archive-subtree-default: Archiving. (line 11) +* org-archive-to-archive-sibling: Internal archiving. (line 49) +* org-ascii-export-as-ascii: ASCII/Latin-1/UTF-8 export. + (line 22) +* org-ascii-export-to-ascii: ASCII/Latin-1/UTF-8 export. + (line 18) +* org-attach <1>: Agenda commands. (line 298) +* org-attach: Attachments. (line 26) +* org-attach-attach: Attachments. (line 31) +* org-attach-delete-all: Attachments. (line 66) +* org-attach-delete-one: Attachments. (line 63) +* org-attach-new: Attachments. (line 41) +* org-attach-open: Attachments. (line 48) +* org-attach-open-in-emacs: Attachments. (line 54) +* org-attach-reveal: Attachments. (line 57) +* org-attach-reveal-in-emacs: Attachments. (line 60) +* org-attach-set-directory: Attachments. (line 70) +* org-attach-set-inherit: Attachments. (line 75) +* org-attach-sync: Attachments. (line 44) +* org-backward-same-level: Motion. (line 15) +* org-beamer-export-as-latex: Beamer export. (line 16) +* org-beamer-export-to-latex: Beamer export. (line 13) +* org-beamer-export-to-pdf: Beamer export. (line 19) +* org-beamer-select-environment: Beamer export. (line 142) +* org-buffer-property-keys: Using the property API. + (line 35) +* org-calendar-goto-agenda: Agenda commands. (line 457) +* org-capture <1>: Using capture. (line 6) +* org-capture <2>: Conventions. (line 35) +* org-capture: Activation. (line 6) +* org-capture-finalize: Using capture. (line 15) +* org-capture-kill: Using capture. (line 31) +* org-capture-refile: Using capture. (line 22) +* org-check-after-date: Inserting deadline/schedule. + (line 39) +* org-check-before-date: Inserting deadline/schedule. + (line 36) +* org-check-deadlines: Inserting deadline/schedule. + (line 29) +* org-clock-cancel: Clocking commands. (line 71) +* org-clock-display: Clocking commands. (line 80) +* org-clock-goto: Clocking commands. (line 75) +* org-clock-in: Clocking commands. (line 6) +* org-clock-in-last: Clocking commands. (line 42) +* org-clock-modify-effort-estimate <1>: Effort estimates. (line 17) +* org-clock-modify-effort-estimate: Clocking commands. (line 48) +* org-clock-out: Clocking commands. (line 34) +* org-clock-report: The clock table. (line 10) +* org-clock-timestamps-up/down: Clocking commands. (line 56) +* org-clocktable-try-shift: The clock table. (line 24) +* org-clone-subtree-with-time-shift: Structure editing. (line 93) +* org-columns: Using column view. (line 9) +* org-columns-delete: Using column view. (line 75) +* org-columns-edit-allowed: Using column view. (line 59) +* org-columns-edit-value: Using column view. (line 46) +* org-columns-narrow: Using column view. (line 70) +* org-columns-new: Using column view. (line 72) +* org-columns-next-allowed-value: Using column view. (line 42) +* org-columns-previous-allowed-value: Using column view. (line 42) +* org-columns-quit: Using column view. (line 26) +* org-columns-redo: Using column view. (line 19) +* org-columns-set-tags-or-toggle: Using column view. (line 52) +* org-columns-show-value: Using column view. (line 55) +* org-columns-widen: Using column view. (line 70) +* org-compute-property-at-point: Property syntax. (line 108) +* org-copy: Refile and copy. (line 12) +* org-copy-subtree: Structure editing. (line 71) +* org-copy-visible: Global and local cycling. + (line 61) +* org-cut-subtree: Structure editing. (line 67) +* org-cycle <1>: Plain lists. (line 68) +* org-cycle <2>: Structure editing. (line 33) +* org-cycle: Global and local cycling. + (line 10) +* org-cycle-agenda-files: Agenda files. (line 22) +* org-date-from-calendar: Creating timestamps. (line 29) +* org-dblock-update <1>: Dynamic blocks. (line 21) +* org-dblock-update <2>: The clock table. (line 16) +* org-dblock-update: Capturing column view. + (line 51) +* org-deadline: Inserting deadline/schedule. + (line 9) +* org-delete-property: Property syntax. (line 102) +* org-delete-property-globally: Property syntax. (line 105) +* org-demote: Using the mapping API. + (line 83) +* org-demote-subtree: Structure editing. (line 48) +* org-do-demote: Structure editing. (line 42) +* org-do-promote: Structure editing. (line 39) +* org-edit-special: Cooperation. (line 61) +* org-entry-add-to-multivalued-property: Using the property API. + (line 52) +* org-entry-delete: Using the property API. + (line 29) +* org-entry-get: Using the property API. + (line 20) +* org-entry-get-multivalued-property: Using the property API. + (line 47) +* org-entry-member-in-multivalued-property: Using the property API. + (line 64) +* org-entry-properties: Using the property API. + (line 10) +* org-entry-put: Using the property API. + (line 32) +* org-entry-put-multivalued-property: Using the property API. + (line 42) +* org-entry-remove-from-multivalued-property: Using the property API. + (line 58) +* org-evaluate-time-range <1>: Clocking commands. (line 51) +* org-evaluate-time-range: Creating timestamps. (line 59) +* org-export-dispatch: The Export Dispatcher. + (line 11) +* org-feed-goto-inbox: RSS Feeds. (line 27) +* org-feed-update-all: RSS Feeds. (line 23) +* org-force-cycle-archived: Internal archiving. (line 46) +* org-forward-same-level: Motion. (line 12) +* org-global-cycle: Global and local cycling. + (line 22) +* org-goto: Motion. (line 21) +* org-goto-calendar: Creating timestamps. (line 33) +* org-html-export-as-html: HTML Export commands. + (line 10) +* org-html-export-to-html: HTML Export commands. + (line 6) +* org-icalendar-combine-agenda-files: iCalendar export. (line 39) +* org-icalendar-export-agenda-files: iCalendar export. (line 34) +* org-icalendar-export-to-ics: iCalendar export. (line 32) +* org-insert-columns-dblock: Capturing column view. + (line 49) +* org-insert-heading <1>: Relative timer. (line 17) +* org-insert-heading <2>: Plain lists. (line 79) +* org-insert-heading: Structure editing. (line 6) +* org-insert-heading-respect-content: Structure editing. (line 19) +* org-insert-link: Handling links. (line 65) +* org-insert-property-drawer: Using the property API. + (line 18) +* org-insert-todo-heading <1>: Checkboxes. (line 73) +* org-insert-todo-heading <2>: TODO basics. (line 58) +* org-insert-todo-heading: Structure editing. (line 24) +* org-insert-todo-heading-respect-content: Structure editing. (line 28) +* org-iswitchb: Activation. (line 6) +* org-latex-export-as-latex: LaTeX export commands. + (line 9) +* org-latex-export-to-latex: LaTeX export commands. + (line 6) +* org-latex-export-to-pdf: LaTeX export commands. + (line 12) +* org-lookup-all: Lookup functions. (line 22) +* org-lookup-first: Lookup functions. (line 8) +* org-lookup-last: Lookup functions. (line 18) +* org-map-entries: Using the mapping API. + (line 13) +* org-mark-element: Structure editing. (line 57) +* org-mark-entry-for-agenda-action: Inserting deadline/schedule. + (line 23) +* org-mark-ring-goto: Handling links. (line 146) +* org-mark-ring-push: Handling links. (line 142) +* org-mark-subtree: Structure editing. (line 63) +* org-match-sparse-tree <1>: Property searches. (line 10) +* org-match-sparse-tree: Tag searches. (line 9) +* org-md-export-as-markdown: Markdown export. (line 19) +* org-md-export-to-markdown: Markdown export. (line 16) +* org-move-subtree-down: Structure editing. (line 54) +* org-move-subtree-up: Structure editing. (line 51) +* org-narrow-to-block: Structure editing. (line 120) +* org-narrow-to-subtree: Structure editing. (line 117) +* org-next-link: Handling links. (line 152) +* org-occur: Sparse trees. (line 17) +* org-odt-export-to-odt: ODT export commands. (line 9) +* org-open-at-point <1>: Creating timestamps. (line 38) +* org-open-at-point: Handling links. (line 101) +* org-org-export-as-org: Org export. (line 16) +* org-org-export-to-org: Org export. (line 13) +* org-paste-subtree: Structure editing. (line 75) +* org-previous-link: Handling links. (line 152) +* org-priority <1>: Using the mapping API. + (line 71) +* org-priority: Priorities. (line 24) +* org-priority-down: Priorities. (line 29) +* org-priority-up: Priorities. (line 29) +* org-promote: Using the mapping API. + (line 80) +* org-promote-subtree: Structure editing. (line 45) +* org-property-action: Property syntax. (line 90) +* org-property-next-allowed-value: Property syntax. (line 98) +* org-property-previous-allowed-value: Property syntax. (line 98) +* org-publish: Triggering publication. + (line 8) +* org-publish-all: Triggering publication. + (line 16) +* org-publish-current-file: Triggering publication. + (line 13) +* org-publish-current-project: Triggering publication. + (line 10) +* org-refile <1>: Refile and copy. (line 14) +* org-refile: Structure editing. (line 101) +* org-refile-cache-clear: Refile and copy. (line 47) +* org-refile-goto-last-stored: Refile and copy. (line 36) +* org-remove-file: Agenda files. (line 19) +* org-reveal: Global and local cycling. + (line 38) +* org-save-all-org-buffers: Agenda commands. (line 173) +* org-schedule: Inserting deadline/schedule. + (line 17) +* org-search-view: Search view. (line 9) +* org-set-effort: Effort estimates. (line 14) +* org-set-property: Property syntax. (line 81) +* org-set-startup-visibility <1>: Initial visibility. (line 25) +* org-set-startup-visibility: Global and local cycling. + (line 33) +* org-set-tags-command: Setting tags. (line 10) +* org-show-todo-tree: TODO basics. (line 39) +* org-sort: Structure editing. (line 105) +* org-sparse-tree: Sparse trees. (line 15) +* org-speedbar-set-agenda-restriction: Agenda files. (line 57) +* org-store-agenda-views: Exporting Agenda Views. + (line 64) +* org-store-link <1>: Handling links. (line 9) +* org-store-link: Activation. (line 6) +* org-table-align: Built-in table editor. + (line 57) +* org-table-beginning-of-field: Built-in table editor. + (line 70) +* org-table-copy-down: Built-in table editor. + (line 159) +* org-table-copy-region: Built-in table editor. + (line 126) +* org-table-create-or-convert-from-region: Built-in table editor. + (line 41) +* org-table-create-with-table.el: Cooperation. (line 63) +* org-table-cut-region: Built-in table editor. + (line 130) +* org-table-delete-column: Built-in table editor. + (line 84) +* org-table-edit-field: Built-in table editor. + (line 174) +* org-table-edit-formulas: Editing and debugging formulas. + (line 36) +* org-table-end-of-field: Built-in table editor. + (line 74) +* org-table-eval-formula <1>: Editing and debugging formulas. + (line 13) +* org-table-eval-formula <2>: Column formulas. (line 32) +* org-table-eval-formula: Field and range formulas. + (line 28) +* org-table-export: Built-in table editor. + (line 199) +* org-table-fedit-abort: Editing and debugging formulas. + (line 50) +* org-table-fedit-finish: Editing and debugging formulas. + (line 47) +* org-table-fedit-line-down: Editing and debugging formulas. + (line 72) +* org-table-fedit-line-up: Editing and debugging formulas. + (line 72) +* org-table-fedit-lisp-indent: Editing and debugging formulas. + (line 57) +* org-table-fedit-ref-down: Editing and debugging formulas. + (line 67) +* org-table-fedit-ref-left: Editing and debugging formulas. + (line 67) +* org-table-fedit-ref-right: Editing and debugging formulas. + (line 67) +* org-table-fedit-ref-up: Editing and debugging formulas. + (line 67) +* org-table-fedit-scroll-down: Editing and debugging formulas. + (line 77) +* org-table-fedit-scroll-up: Editing and debugging formulas. + (line 77) +* org-table-fedit-toggle-ref-type: Editing and debugging formulas. + (line 53) +* org-table-field-info: Editing and debugging formulas. + (line 22) +* org-table-hline-and-move: Built-in table editor. + (line 105) +* org-table-insert-column: Built-in table editor. + (line 87) +* org-table-insert-hline: Built-in table editor. + (line 101) +* org-table-insert-row: Built-in table editor. + (line 97) +* org-table-iterate: Updating the table. (line 22) +* org-table-iterate-buffer-tables: Updating the table. (line 33) +* org-table-kill-row: Built-in table editor. + (line 94) +* org-table-move-column-left: Built-in table editor. + (line 82) +* org-table-move-column-right: Built-in table editor. + (line 82) +* org-table-move-row-down: Built-in table editor. + (line 90) +* org-table-move-row-up: Built-in table editor. + (line 90) +* org-table-next-field: Built-in table editor. + (line 58) +* org-table-next-row: Built-in table editor. + (line 65) +* org-table-paste-rectangle: Built-in table editor. + (line 134) +* org-table-previous-field: Built-in table editor. + (line 62) +* org-table-recalculate: Updating the table. (line 13) +* org-table-recalculate-buffer-tables: Updating the table. (line 30) +* org-table-rotate-recalc-marks: Advanced features. (line 10) +* org-table-sort-lines: Built-in table editor. + (line 109) +* org-table-sum: Built-in table editor. + (line 156) +* org-table-toggle-coordinate-overlays: Editing and debugging formulas. + (line 26) +* org-table-toggle-formula-debugger: Editing and debugging formulas. + (line 32) +* org-table-wrap-region: Built-in table editor. + (line 141) +* org-tags-view <1>: Matching tags and properties. + (line 12) +* org-tags-view <2>: Property searches. (line 12) +* org-tags-view: Tag searches. (line 13) +* org-texinfo-export-to-info: Texinfo export commands. + (line 9) +* org-texinfo-export-to-texinfo: Texinfo export commands. + (line 6) +* org-time-stamp: Creating timestamps. (line 10) +* org-time-stamp-inactive: Creating timestamps. (line 15) +* org-timeline: Timeline. (line 10) +* org-timer: Relative timer. (line 10) +* org-timer-item: Relative timer. (line 13) +* org-timer-start: Relative timer. (line 30) +* org-timestamp-down-day: Creating timestamps. (line 42) +* org-timestamp-down-down: Creating timestamps. (line 47) +* org-timestamp-up: Creating timestamps. (line 47) +* org-timestamp-up-day: Creating timestamps. (line 42) +* org-timestamp-up/down: Clocking commands. (line 60) +* org-todo <1>: Using the mapping API. + (line 67) +* org-todo <2>: Clocking commands. (line 67) +* org-todo: TODO basics. (line 13) +* org-todo-list <1>: Global TODO list. (line 9) +* org-todo-list: TODO basics. (line 50) +* org-toggle-archive-tag: Internal archiving. (line 36) +* org-toggle-checkbox: Checkboxes. (line 52) +* org-toggle-heading: Structure editing. (line 126) +* org-toggle-inline-images: Handling links. (line 133) +* org-toggle-ordered-property <1>: Checkboxes. (line 76) +* org-toggle-ordered-property: TODO dependencies. (line 29) +* org-toggle-tag: Using the mapping API. + (line 75) +* org-toggle-time-stamp-overlays: Custom time format. (line 12) +* org-tree-to-indirect-buffer: Global and local cycling. + (line 55) +* org-update-all-dblocks: Capturing column view. + (line 55) +* org-update-statistics-cookies: Checkboxes. (line 84) +* org-yank: Structure editing. (line 81) +* outline-next-visible-heading: Motion. (line 8) +* outline-previous-visible-heading: Motion. (line 9) +* outline-up-heading: Motion. (line 18) +* pcomplete: Property syntax. (line 78) +* previous-error: Sparse trees. (line 32) +* show-all: Global and local cycling. + (line 35) +* show-branches: Global and local cycling. + (line 47) +* show-children: Global and local cycling. + (line 51) +* widen: Structure editing. (line 123) + + +File: org, Node: Variable Index, Prev: Command and Function Index, Up: Top + +Variable index +************** + +This is not a complete index of variables and faces, only the ones that +are mentioned in the manual. For a more complete list, use `M-x +org-customize ' and then click yourself through the tree. + +[index] +* Menu: + +* cdlatex-simplify-sub-super-scripts: CDLaTeX mode. (line 33) +* constants-unit-system <1>: In-buffer settings. (line 153) +* constants-unit-system: References. (line 109) +* htmlize-output-type: Exporting Agenda Views. + (line 20) +* LaTeX-verbatim-environments: A LaTeX example. (line 21) +* org-adapt-indentation: Clean view. (line 46) +* org-agenda-add-entry-text-maxlines: Exporting Agenda Views. + (line 20) +* org-agenda-bulk-custom-functions: Agenda commands. (line 365) +* org-agenda-category-filter-preset <1>: Agenda commands. (line 206) +* org-agenda-category-filter-preset: Filtering/limiting agenda items. + (line 94) +* org-agenda-clock-consistency-checks: Agenda commands. (line 146) +* org-agenda-columns-add-appointments-to-effort-sum: Effort estimates. + (line 41) +* org-agenda-confirm-kill: Agenda commands. (line 245) +* org-agenda-custom-commands <1>: Extracting agenda information. + (line 6) +* org-agenda-custom-commands <2>: Setting Options. (line 6) +* org-agenda-custom-commands <3>: Storing searches. (line 9) +* org-agenda-custom-commands: Sparse trees. (line 37) +* org-agenda-custom-commands-contexts: Setting Options. (line 62) +* org-agenda-diary-file: Agenda commands. (line 464) +* org-agenda-dim-blocked-tasks <1>: Speeding up your agendas. + (line 16) +* org-agenda-dim-blocked-tasks: TODO dependencies. (line 39) +* org-agenda-entry-text-maxlines: Agenda commands. (line 154) +* org-agenda-exporter-settings <1>: Exporting Agenda Views. + (line 13) +* org-agenda-exporter-settings: Agenda commands. (line 507) +* org-agenda-files <1>: iCalendar export. (line 37) +* org-agenda-files <2>: Sorting agenda items. + (line 8) +* org-agenda-files: Agenda files. (line 6) +* org-agenda-inhibit-startup <1>: Speeding up your agendas. + (line 19) +* org-agenda-inhibit-startup: Initial visibility. (line 6) +* org-agenda-log-mode-items: Agenda commands. (line 113) +* org-agenda-max-effort: Filtering/limiting agenda items. + (line 118) +* org-agenda-max-entries: Filtering/limiting agenda items. + (line 118) +* org-agenda-max-tags: Filtering/limiting agenda items. + (line 118) +* org-agenda-max-todos: Filtering/limiting agenda items. + (line 118) +* org-agenda-ndays: Weekly/daily agenda. (line 15) +* org-agenda-overriding-header: Special agenda views. + (line 45) +* org-agenda-prefix-format: Presentation and sorting. + (line 6) +* org-agenda-regexp-filter-preset <1>: Agenda commands. (line 214) +* org-agenda-regexp-filter-preset: Filtering/limiting agenda items. + (line 104) +* org-agenda-restore-windows-after-quit: Agenda Views. (line 40) +* org-agenda-show-inherited-tags <1>: Speeding up your agendas. + (line 22) +* org-agenda-show-inherited-tags: Agenda commands. (line 271) +* org-agenda-skip-archived-trees: Internal archiving. (line 21) +* org-agenda-skip-deadline-prewarning-if-scheduled: Deadlines and scheduling. + (line 12) +* org-agenda-skip-function <1>: Using the mapping API. + (line 52) +* org-agenda-skip-function: Special agenda views. + (line 6) +* org-agenda-skip-function-global: Special agenda views. + (line 6) +* org-agenda-skip-scheduled-delay-if-deadline: Deadlines and scheduling. + (line 40) +* org-agenda-skip-scheduled-if-deadline-is-shown: Repeated tasks. + (line 62) +* org-agenda-skip-scheduled-if-done: Deadlines and scheduling. + (line 32) +* org-agenda-sorting-strategy: Sorting agenda items. + (line 27) +* org-agenda-span <1>: Agenda commands. (line 77) +* org-agenda-span: Weekly/daily agenda. (line 15) +* org-agenda-start-day: Weekly/daily agenda. (line 15) +* org-agenda-start-on-weekday: Weekly/daily agenda. (line 15) +* org-agenda-start-with-clockreport-mode: Agenda commands. (line 135) +* org-agenda-start-with-entry-text-mode: Agenda commands. (line 154) +* org-agenda-start-with-follow-mode: Agenda commands. (line 43) +* org-agenda-sticky: Agenda dispatcher. (line 53) +* org-agenda-tag-filter-preset <1>: Agenda commands. (line 199) +* org-agenda-tag-filter-preset: Filtering/limiting agenda items. + (line 18) +* org-agenda-tags-column: Presentation and sorting. + (line 6) +* org-agenda-tags-todo-honor-ignore-options: Matching tags and properties. + (line 20) +* org-agenda-text-search-extra-files <1>: Search view. (line 24) +* org-agenda-text-search-extra-files: Agenda dispatcher. (line 32) +* org-agenda-time-grid <1>: Agenda commands. (line 162) +* org-agenda-time-grid: Time-of-day specifications. + (line 41) +* org-agenda-todo-ignore-deadlines: Global TODO list. (line 38) +* org-agenda-todo-ignore-scheduled: Global TODO list. (line 38) +* org-agenda-todo-ignore-timestamp: Global TODO list. (line 38) +* org-agenda-todo-ignore-with-date: Global TODO list. (line 38) +* org-agenda-todo-list-sublevels <1>: Global TODO list. (line 47) +* org-agenda-todo-list-sublevels: Breaking down tasks. (line 6) +* org-agenda-use-tag-inheritance <1>: Speeding up your agendas. + (line 22) +* org-agenda-use-tag-inheritance: Tag inheritance. (line 32) +* org-agenda-use-time-grid <1>: Agenda commands. (line 162) +* org-agenda-use-time-grid: Time-of-day specifications. + (line 41) +* org-agenda-window-setup: Agenda Views. (line 40) +* org-archive-default-command <1>: Agenda commands. (line 254) +* org-archive-default-command: Archiving. (line 12) +* org-archive-location <1>: In-buffer settings. (line 16) +* org-archive-location: Moving subtrees. (line 10) +* org-archive-save-context-info: Moving subtrees. (line 36) +* org-ascii-links-to-notes: ASCII/Latin-1/UTF-8 export. + (line 11) +* org-attach-directory: Attachments. (line 6) +* org-attach-method: Attachments. (line 32) +* org-babel-default-header-args <1>: Header arguments in Org mode properties. + (line 34) +* org-babel-default-header-args: System-wide header arguments. + (line 6) +* org-beamer-environments-default: Beamer export. (line 44) +* org-beamer-environments-extra: Beamer export. (line 44) +* org-beamer-frame-level: Beamer export. (line 35) +* org-calc-default-modes: Formula syntax for Calc. + (line 14) +* org-capture-bookmark: Using capture. (line 50) +* org-capture-templates-contexts: Templates in contexts. + (line 6) +* org-capture-use-agenda-date: Agenda commands. (line 349) +* org-catch-invisible-edits: Catching invisible edits. + (line 6) +* org-checkbox-hierarchical-statistics: Checkboxes. (line 30) +* org-clock-continuously <1>: Resolving idle time. (line 78) +* org-clock-continuously: Clocking commands. (line 7) +* org-clock-idle-time: Resolving idle time. (line 14) +* org-clock-into-drawer: Clocking commands. (line 7) +* org-clock-modeline-total: Clocking commands. (line 20) +* org-clock-report-include-clocking-task: Agenda commands. (line 135) +* org-clock-x11idle-program-name: Resolving idle time. (line 9) +* org-clocktable-defaults: The clock table. (line 38) +* org-closed-keep-when-no-todo: Closing items. (line 11) +* org-coderef-label-format: Literal examples. (line 58) +* org-columns-default-format <1>: Agenda column view. (line 18) +* org-columns-default-format <2>: Agenda commands. (line 180) +* org-columns-default-format <3>: Effort estimates. (line 31) +* org-columns-default-format: Using column view. (line 10) +* org-columns-skip-archived-trees: Internal archiving. (line 31) +* org-confirm-babel-evaluate: Code evaluation security. + (line 34) +* org-confirm-elisp-link-function: Code evaluation security. + (line 56) +* org-confirm-shell-link-function: Code evaluation security. + (line 53) +* org-create-file-search-functions: Custom searches. (line 12) +* org-ctrl-c-ctrl-c-hook: Context-sensitive commands. + (line 6) +* org-ctrl-k-protect-subtree: Headlines. (line 6) +* org-cycle-emulate-tab: Global and local cycling. + (line 16) +* org-cycle-global-at-bob: Global and local cycling. + (line 16) +* org-cycle-include-plain-lists: Plain lists. (line 69) +* org-cycle-open-archived-trees: Internal archiving. (line 11) +* org-cycle-separator-lines: Headlines. (line 22) +* org-deadline-warning-days <1>: Inserting deadline/schedule. + (line 32) +* org-deadline-warning-days: Deadlines and scheduling. + (line 12) +* org-default-notes-file <1>: Template elements. (line 49) +* org-default-notes-file: Setting up capture. (line 9) +* org-default-priority <1>: In-buffer settings. (line 54) +* org-default-priority: Priorities. (line 38) +* org-display-custom-times <1>: Publishing options. (line 12) +* org-display-custom-times: Custom time format. (line 6) +* org-display-internal-link-with-indirect-buffer: Handling links. + (line 132) +* org-disputed-keys: Conflicts. (line 34) +* org-done (face): Faces for TODO keywords. + (line 6) +* org-drawers <1>: In-buffer settings. (line 45) +* org-drawers: Drawers. (line 6) +* org-edit-src-auto-save-idle-delay: Editing source code. (line 6) +* org-edit-src-turn-on-auto-save: Editing source code. (line 6) +* org-emphasis-alist: Emphasis and monospace. + (line 6) +* org-emphasis-regexp-components: Emphasis and monospace. + (line 6) +* org-enable-table-editor: Built-in table editor. + (line 30) +* org-enforce-todo-dependencies: TODO dependencies. (line 6) +* org-entities: Special symbols. (line 15) +* org-execute-file-search-functions: Custom searches. (line 12) +* org-export-allow-bind-keywords: Export settings. (line 187) +* org-export-async-init-file: The Export Dispatcher. + (line 25) +* org-export-backends <1>: Other built-in back-ends. + (line 6) +* org-export-backends: Export back-ends. (line 10) +* org-export-before-parsing-hook: Advanced configuration. + (line 9) +* org-export-before-processing-hook: Advanced configuration. + (line 9) +* org-export-copy-to-kill-ring: The Export Dispatcher. + (line 54) +* org-export-creator-string <1>: HTML preamble and postamble. + (line 6) +* org-export-creator-string: Export settings. (line 28) +* org-export-date-timestamp-format: Export settings. (line 32) +* org-export-default-language <1>: Publishing options. (line 12) +* org-export-default-language: Export settings. (line 48) +* org-export-dispatch-use-expert-ui: The Export Dispatcher. + (line 6) +* org-export-exclude-tags: Publishing options. (line 12) +* org-export-headline-levels <1>: Publishing options. (line 12) +* org-export-headline-levels <2>: Export settings. (line 129) +* org-export-headline-levels: Headings and sections. + (line 6) +* org-export-in-background: The Export Dispatcher. + (line 34) +* org-export-initial-scope: The Export Dispatcher. + (line 44) +* org-export-preserve-breaks <1>: Publishing options. (line 12) +* org-export-preserve-breaks: Export settings. (line 91) +* org-export-publishing-directory: Publishing options. (line 12) +* org-export-select-tags <1>: Publishing options. (line 12) +* org-export-select-tags: Export settings. (line 54) +* org-export-time-stamp-file <1>: HTML preamble and postamble. + (line 6) +* org-export-time-stamp-file: Export settings. (line 167) +* org-export-with-archived-trees <1>: Publishing options. (line 12) +* org-export-with-archived-trees <2>: Export settings. (line 99) +* org-export-with-archived-trees: Internal archiving. (line 27) +* org-export-with-author <1>: Publishing options. (line 12) +* org-export-with-author: Export settings. (line 104) +* org-export-with-clocks: Export settings. (line 108) +* org-export-with-creator <1>: Publishing options. (line 12) +* org-export-with-creator: Export settings. (line 111) +* org-export-with-drawers <1>: Publishing options. (line 12) +* org-export-with-drawers <2>: Export settings. (line 115) +* org-export-with-drawers: Drawers. (line 38) +* org-export-with-email <1>: Publishing options. (line 12) +* org-export-with-email: Export settings. (line 122) +* org-export-with-emphasize: Publishing options. (line 12) +* org-export-with-entities: Export settings. (line 119) +* org-export-with-fixed-width <1>: Publishing options. (line 12) +* org-export-with-fixed-width: Export settings. (line 84) +* org-export-with-footnotes <1>: Publishing options. (line 12) +* org-export-with-footnotes: Export settings. (line 126) +* org-export-with-inlinetasks: Export settings. (line 134) +* org-export-with-latex <1>: Publishing options. (line 12) +* org-export-with-latex <2>: Export settings. (line 163) +* org-export-with-latex: LaTeX fragments. (line 39) +* org-export-with-planning <1>: Publishing options. (line 12) +* org-export-with-planning: Export settings. (line 142) +* org-export-with-priority <1>: Publishing options. (line 12) +* org-export-with-priority: Export settings. (line 147) +* org-export-with-section-numbers <1>: Publishing options. (line 12) +* org-export-with-section-numbers: Export settings. (line 137) +* org-export-with-smart-quotes: Export settings. (line 74) +* org-export-with-special-strings <1>: Publishing options. (line 12) +* org-export-with-special-strings: Export settings. (line 80) +* org-export-with-statistics-cookies: Export settings. (line 150) +* org-export-with-sub-superscripts <1>: Publishing options. (line 12) +* org-export-with-sub-superscripts: Export settings. (line 94) +* org-export-with-tables <1>: Publishing options. (line 12) +* org-export-with-tables: Export settings. (line 179) +* org-export-with-tags <1>: Publishing options. (line 12) +* org-export-with-tags: Export settings. (line 154) +* org-export-with-tasks <1>: Publishing options. (line 12) +* org-export-with-tasks: Export settings. (line 158) +* org-export-with-timestamps <1>: Publishing options. (line 12) +* org-export-with-timestamps: Export settings. (line 87) +* org-export-with-toc <1>: Publishing options. (line 12) +* org-export-with-toc <2>: Export settings. (line 171) +* org-export-with-toc: Table of contents. (line 6) +* org-export-with-todo-keywords <1>: Publishing options. (line 12) +* org-export-with-todo-keywords: Export settings. (line 175) +* org-fast-tag-selection-include-todo: Fast access to TODO states. + (line 16) +* org-fast-tag-selection-single-key: Setting tags. (line 144) +* org-file-apps <1>: Attachments. (line 49) +* org-file-apps: Handling links. (line 104) +* org-fontify-emphasized-text: Emphasis and monospace. + (line 6) +* org-footnote-auto-adjust <1>: In-buffer settings. (line 158) +* org-footnote-auto-adjust: Footnotes. (line 58) +* org-footnote-auto-label <1>: In-buffer settings. (line 158) +* org-footnote-auto-label: Footnotes. (line 44) +* org-footnote-define-inline <1>: In-buffer settings. (line 158) +* org-footnote-define-inline: Footnotes. (line 58) +* org-footnote-section: Footnotes. (line 58) +* org-format-latex-header: LaTeX fragments. (line 6) +* org-format-latex-options: Previewing LaTeX fragments. + (line 20) +* org-from-is-user-regexp: Template expansion. (line 49) +* org-global-properties <1>: Effort estimates. (line 31) +* org-global-properties: Property syntax. (line 73) +* org-goto-auto-isearch: Motion. (line 26) +* org-goto-interface: Motion. (line 37) +* org-group-tags: Tag groups. (line 34) +* org-hide (face): Clean view. (line 66) +* org-hide-block-startup: Blocks. (line 6) +* org-hide-leading-stars <1>: Clean view. (line 50) +* org-hide-leading-stars: In-buffer settings. (line 137) +* org-hierarchical-todo-statistics: Breaking down tasks. (line 25) +* org-highest-priority <1>: In-buffer settings. (line 54) +* org-highest-priority: Priorities. (line 38) +* org-html-container-element: Publishing options. (line 38) +* org-html-doctype <1>: Publishing options. (line 38) +* org-html-doctype: HTML doctypes. (line 6) +* org-html-doctype-alist: HTML doctypes. (line 6) +* org-html-extension: Publishing options. (line 38) +* org-html-head <1>: Publishing options. (line 38) +* org-html-head: CSS support. (line 41) +* org-html-head-extra <1>: Publishing options. (line 38) +* org-html-head-extra: CSS support. (line 41) +* org-html-head-include-default-style <1>: Publishing options. + (line 38) +* org-html-head-include-default-style: CSS support. (line 41) +* org-html-head-include-scripts: Publishing options. (line 38) +* org-html-html5-elements: HTML doctypes. (line 39) +* org-html-html5-fancy <1>: Publishing options. (line 38) +* org-html-html5-fancy: HTML doctypes. (line 39) +* org-html-infojs-options: JavaScript support. (line 54) +* org-html-inline-images <1>: Publishing options. (line 38) +* org-html-inline-images: Images in HTML export. + (line 6) +* org-html-link-home: Publishing options. (line 38) +* org-html-link-org-files-as-html: Publishing options. (line 38) +* org-html-link-up: Publishing options. (line 38) +* org-html-link-use-abs-url: Publishing options. (line 38) +* org-html-postamble <1>: Publishing options. (line 38) +* org-html-postamble: HTML preamble and postamble. + (line 6) +* org-html-postamble-format: HTML preamble and postamble. + (line 6) +* org-html-preamble <1>: Publishing options. (line 38) +* org-html-preamble: HTML preamble and postamble. + (line 6) +* org-html-preamble-format: HTML preamble and postamble. + (line 6) +* org-html-style-default: CSS support. (line 41) +* org-html-table-default-attributes <1>: Publishing options. (line 38) +* org-html-table-default-attributes: Tables in HTML export. + (line 6) +* org-html-table-row-tags <1>: Publishing options. (line 38) +* org-html-table-row-tags: Tables in HTML export. + (line 15) +* org-html-tag-class-prefix: CSS support. (line 6) +* org-html-todo-kwd-class-prefix: CSS support. (line 6) +* org-html-use-infojs: JavaScript support. (line 54) +* org-html-validation-link: HTML preamble and postamble. + (line 6) +* org-html-xml-declaration: Publishing options. (line 38) +* org-icalendar-alarm-time: iCalendar export. (line 6) +* org-icalendar-categories: iCalendar export. (line 6) +* org-icalendar-combined-agenda-file: iCalendar export. (line 42) +* org-icalendar-include-body: iCalendar export. (line 46) +* org-icalendar-include-todo: iCalendar export. (line 6) +* org-icalendar-store-UID: iCalendar export. (line 21) +* org-icalendar-use-deadline: iCalendar export. (line 6) +* org-icalendar-use-scheduled: iCalendar export. (line 6) +* org-id-link-to-org-use-id: Handling links. (line 21) +* org-imenu-depth: Cooperation. (line 38) +* org-insert-mode-line-in-empty-file: Activation. (line 33) +* org-irc-link-to-logs: Handling links. (line 45) +* org-keep-stored-link-after-insertion: Handling links. (line 66) +* org-latex-classes: Header and sectioning. + (line 13) +* org-latex-create-formula-image-program: Previewing LaTeX fragments. + (line 6) +* org-latex-default-class: Header and sectioning. + (line 13) +* org-latex-default-packages-alist: Header and sectioning. + (line 13) +* org-latex-default-table-environment: LaTeX specific attributes. + (line 26) +* org-latex-default-table-mode: LaTeX specific attributes. + (line 17) +* org-latex-packages-alist: Header and sectioning. + (line 13) +* org-latex-tables-booktabs: LaTeX specific attributes. + (line 60) +* org-latex-tables-centered: LaTeX specific attributes. + (line 60) +* org-latex-to-mathml-convert-command: Working with LaTeX math snippets. + (line 20) +* org-latex-to-mathml-jar-file: Working with LaTeX math snippets. + (line 20) +* org-link-abbrev-alist <1>: In-buffer settings. (line 49) +* org-link-abbrev-alist: Link abbreviations. (line 12) +* org-link-frame-setup: Handling links. (line 104) +* org-list-allow-alphabetical: Plain lists. (line 14) +* org-list-automatic-rules <1>: Checkboxes. (line 6) +* org-list-automatic-rules: Plain lists. (line 62) +* org-list-demote-modify-bullet: Plain lists. (line 56) +* org-list-empty-line-terminates-plain-lists: Plain lists. (line 30) +* org-list-indent-offset: Plain lists. (line 56) +* org-list-use-circular-motion: Plain lists. (line 94) +* org-log-done <1>: In-buffer settings. (line 112) +* org-log-done <2>: Agenda commands. (line 113) +* org-log-done: Tracking TODO state changes. + (line 29) +* org-log-into-drawer <1>: Agenda commands. (line 296) +* org-log-into-drawer: Tracking TODO state changes. + (line 6) +* org-log-note-clock-out <1>: In-buffer settings. (line 112) +* org-log-note-clock-out: Clocking commands. (line 37) +* org-log-refile: Refile and copy. (line 17) +* org-log-repeat <1>: In-buffer settings. (line 112) +* org-log-repeat: Repeated tasks. (line 34) +* org-log-states-order-reversed: Tracking TODO state changes. + (line 6) +* org-lowest-priority <1>: In-buffer settings. (line 54) +* org-lowest-priority: Priorities. (line 38) +* org-M-RET-may-split-line <1>: Plain lists. (line 82) +* org-M-RET-may-split-line: Structure editing. (line 7) +* org-md-headline-style: Markdown export. (line 30) +* org-odd-levels-only <1>: Special agenda views. + (line 48) +* org-odd-levels-only <2>: Clean view. (line 74) +* org-odd-levels-only <3>: In-buffer settings. (line 137) +* org-odd-levels-only: Matching tags and properties. + (line 71) +* org-odt-category-map-alist: Labels and captions in ODT export. + (line 25) +* org-odt-convert: Extending ODT export. + (line 39) +* org-odt-convert-capabilities: Configuring a document converter. + (line 20) +* org-odt-convert-process: Configuring a document converter. + (line 30) +* org-odt-convert-processes: Configuring a document converter. + (line 13) +* org-odt-create-custom-styles-for-srcblocks: Literal examples in ODT export. + (line 17) +* org-odt-fontify-srcblocks: Literal examples in ODT export. + (line 13) +* org-odt-pixels-per-inch: Images in ODT export. + (line 33) +* org-odt-preferred-output-format <1>: Extending ODT export. + (line 22) +* org-odt-preferred-output-format: ODT export commands. (line 12) +* org-odt-schema-dir: Validating OpenDocument XML. + (line 16) +* org-odt-styles-file: Applying custom styles. + (line 28) +* org-odt-table-styles: Customizing tables in ODT export. + (line 16) +* org-outline-path-complete-in-steps: Refile and copy. (line 17) +* org-overriding-columns-format: Agenda column view. (line 18) +* org-plain-list-ordered-item-terminator: Plain lists. (line 14) +* org-popup-calendar-for-date-prompt: The date/time prompt. + (line 76) +* org-priority-faces: Priorities. (line 13) +* org-priority-start-cycle-with-default: Priorities. (line 33) +* org-property-allowed-value-functions: Using the property API. + (line 69) +* org-publish-project-alist <1>: Publishing options. (line 60) +* org-publish-project-alist: Project alist. (line 6) +* org-publish-use-timestamps-flag: Triggering publication. + (line 21) +* org-put-time-stamp-overlays: In-buffer settings. (line 148) +* org-read-date-display-live: The date/time prompt. + (line 90) +* org-read-date-force-compatible-dates: The date/time prompt. + (line 61) +* org-read-date-prefer-future: The date/time prompt. + (line 6) +* org-refile-allow-creating-parent-nodes: Refile and copy. (line 17) +* org-refile-keep: Refile and copy. (line 17) +* org-refile-targets: Refile and copy. (line 17) +* org-refile-use-cache: Refile and copy. (line 17) +* org-refile-use-outline-path: Refile and copy. (line 17) +* org-remove-highlights-with-change <1>: Clocking commands. (line 83) +* org-remove-highlights-with-change: Sparse trees. (line 20) +* org-replace-disputed-keys: Conflicts. (line 19) +* org-return-follows-link: Handling links. (line 123) +* org-reverse-note-order: Refile and copy. (line 17) +* org-scheduled-delay-days: Deadlines and scheduling. + (line 40) +* org-show-entry-below: Sparse trees. (line 6) +* org-show-following-heading: Sparse trees. (line 6) +* org-show-hierarchy-above: Sparse trees. (line 6) +* org-show-siblings: Sparse trees. (line 6) +* org-sort-agenda-noeffort-is-high: Filtering/limiting agenda items. + (line 36) +* org-sparse-tree-open-archived-trees: Internal archiving. (line 17) +* org-special-ctrl-a/e: Headlines. (line 6) +* org-special-ctrl-k: Headlines. (line 6) +* org-speed-commands-user: Speed keys. (line 6) +* org-startup-align-all-tables <1>: In-buffer settings. (line 91) +* org-startup-align-all-tables: Column width and alignment. + (line 33) +* org-startup-folded <1>: Speeding up your agendas. + (line 19) +* org-startup-folded <2>: In-buffer settings. (line 80) +* org-startup-folded: Initial visibility. (line 6) +* org-startup-indented: In-buffer settings. (line 86) +* org-startup-with-inline-images <1>: In-buffer settings. (line 98) +* org-startup-with-inline-images: Handling links. (line 136) +* org-startup-with-latex-preview <1>: In-buffer settings. (line 105) +* org-startup-with-latex-preview: Previewing LaTeX fragments. + (line 25) +* org-store-link-functions: Adding hyperlink types. + (line 65) +* org-stuck-projects: Stuck projects. (line 17) +* org-support-shift-select <1>: Conflicts. (line 6) +* org-support-shift-select: Plain lists. (line 94) +* org-table-auto-blank-field: Built-in table editor. + (line 30) +* org-table-copy-increment: Built-in table editor. + (line 162) +* org-table-duration-custom-format: Durations and time values. + (line 6) +* org-table-export-default-format: Built-in table editor. + (line 199) +* org-table-formula: In-buffer settings. (line 35) +* org-table-formula-constants <1>: Cooperation. (line 17) +* org-table-formula-constants <2>: In-buffer settings. (line 35) +* org-table-formula-constants: References. (line 102) +* org-table-use-standard-references <1>: Editing and debugging formulas. + (line 6) +* org-table-use-standard-references: References. (line 17) +* org-tag-alist <1>: In-buffer settings. (line 182) +* org-tag-alist: Setting tags. (line 23) +* org-tag-faces: Tags. (line 10) +* org-tag-persistent-alist: Setting tags. (line 38) +* org-tags-column: Setting tags. (line 11) +* org-tags-exclude-from-inheritance: Tag inheritance. (line 22) +* org-tags-match-list-sublevels <1>: Matching tags and properties. + (line 20) +* org-tags-match-list-sublevels <2>: Property searches. (line 19) +* org-tags-match-list-sublevels <3>: Tag searches. (line 20) +* org-tags-match-list-sublevels: Tag inheritance. (line 26) +* org-texinfo-classes <1>: Headings and sectioning structure. + (line 6) +* org-texinfo-classes: Document preamble. (line 22) +* org-texinfo-coding-system: Document preamble. (line 22) +* org-texinfo-def-table-markup: Texinfo specific attributes. + (line 17) +* org-texinfo-default-class: Headings and sectioning structure. + (line 6) +* org-texinfo-info-process: Texinfo export commands. + (line 6) +* org-time-stamp-custom-formats: Custom time format. (line 6) +* org-time-stamp-overlay-formats: In-buffer settings. (line 148) +* org-time-stamp-rounding-minutes: Creating timestamps. (line 23) +* org-todo (face): Faces for TODO keywords. + (line 6) +* org-todo-keyword-faces: Faces for TODO keywords. + (line 6) +* org-todo-keywords <1>: In-buffer settings. (line 205) +* org-todo-keywords <2>: Global TODO list. (line 18) +* org-todo-keywords <3>: TODO extensions. (line 6) +* org-todo-keywords: TODO basics. (line 42) +* org-todo-repeat-to-state: Repeated tasks. (line 19) +* org-todo-state-tags-triggers: TODO basics. (line 63) +* org-track-ordered-property-with-tag <1>: Checkboxes. (line 79) +* org-track-ordered-property-with-tag: TODO dependencies. (line 30) +* org-treat-insert-todo-heading-as-state-change: Structure editing. + (line 27) +* org-treat-S-cursor-todo-selection-as-state-change: TODO basics. + (line 35) +* org-use-fast-todo-selection: TODO basics. (line 14) +* org-use-property-inheritance <1>: Using the property API. + (line 18) +* org-use-property-inheritance <2>: Header arguments in Org mode properties. + (line 19) +* org-use-property-inheritance <3>: iCalendar export. (line 46) +* org-use-property-inheritance: Property inheritance. + (line 6) +* org-use-speed-commands: Speed keys. (line 6) +* org-use-sub-superscripts: Subscripts and superscripts. + (line 15) +* org-use-tag-inheritance: Tag inheritance. (line 22) +* org-yank-adjusted-subtrees: Structure editing. (line 84) +* org-yank-folded-subtrees: Structure editing. (line 84) +* orgstruct-heading-prefix-regexp: Orgstruct mode. (line 26) +* parse-time-months: The date/time prompt. + (line 57) +* parse-time-weekdays: The date/time prompt. + (line 57) +* ps-landscape-mode: Exporting Agenda Views. + (line 20) +* ps-number-of-columns: Exporting Agenda Views. + (line 20) +* user-full-name: Export settings. (line 25) +* user-mail-address <1>: Publishing options. (line 12) +* user-mail-address: Export settings. (line 40) + + + +Tag Table: +Node: Top895 +Node: Introduction24003 +Node: Summary24444 +Node: Installation27498 +Node: Activation30179 +Ref: Activation-Footnote-132009 +Node: Feedback32131 +Ref: Feedback-Footnote-135734 +Node: Conventions35861 +Ref: Conventions-Footnote-137872 +Node: Document Structure37964 +Node: Outlines38955 +Node: Headlines39611 +Ref: Headlines-Footnote-140615 +Ref: Headlines-Footnote-240791 +Node: Visibility cycling40862 +Node: Global and local cycling41241 +Ref: Global and local cycling-Footnote-144088 +Ref: Global and local cycling-Footnote-244146 +Ref: Global and local cycling-Footnote-344196 +Node: Initial visibility44466 +Ref: Initial visibility-Footnote-145718 +Node: Catching invisible edits45899 +Node: Motion46364 +Node: Structure editing47699 +Ref: Structure editing-Footnote-154507 +Node: Sparse trees54607 +Ref: Sparse trees-Footnote-157102 +Ref: Sparse trees-Footnote-257308 +Ref: Sparse trees-Footnote-357379 +Node: Plain lists57494 +Ref: Plain lists-Footnote-164908 +Ref: Plain lists-Footnote-265262 +Ref: Plain lists-Footnote-365358 +Ref: Plain lists-Footnote-465605 +Ref: Plain lists-Footnote-565776 +Ref: Plain lists-Footnote-665839 +Ref: Plain lists-Footnote-766015 +Ref: Plain lists-Footnote-866115 +Ref: Plain lists-Footnote-966217 +Node: Drawers66283 +Ref: Drawers-Footnote-168118 +Node: Blocks68223 +Node: Footnotes68782 +Ref: Footnotes-Footnote-173164 +Ref: Footnotes-Footnote-273261 +Node: Orgstruct mode73338 +Node: Org syntax74968 +Node: Tables75872 +Node: Built-in table editor76513 +Ref: Built-in table editor-Footnote-186003 +Node: Column width and alignment86103 +Ref: Column width and alignment-Footnote-188663 +Ref: Column width and alignment-Footnote-288709 +Node: Column groups88806 +Node: Orgtbl mode90350 +Node: The spreadsheet91159 +Node: References92619 +Ref: References-Footnote-198727 +Ref: References-Footnote-298949 +Ref: References-Footnote-399218 +Ref: References-Footnote-499321 +Node: Formula syntax for Calc99611 +Ref: Formula syntax for Calc-Footnote-1104758 +Node: Formula syntax for Lisp105082 +Node: Durations and time values106818 +Node: Field and range formulas107897 +Node: Column formulas110308 +Node: Lookup functions112397 +Node: Editing and debugging formulas114320 +Ref: Using multiple #+TBLFM lines118579 +Node: Updating the table119792 +Node: Advanced features121148 +Ref: Advanced features-Footnote-1125629 +Node: Org-Plot125735 +Node: Hyperlinks128577 +Node: Link format129334 +Node: Internal links130612 +Ref: Internal links-Footnote-1132904 +Ref: Internal links-Footnote-2133144 +Node: Radio targets133282 +Node: External links133972 +Ref: External links-Footnote-1138038 +Node: Handling links138428 +Ref: Handling links-Footnote-1146333 +Ref: Handling links-Footnote-2146492 +Ref: Handling links-Footnote-3146667 +Ref: Handling links-Footnote-4146963 +Ref: Handling links-Footnote-5147209 +Ref: Handling links-Footnote-6147286 +Ref: Handling links-Footnote-7147358 +Node: Using links outside Org147442 +Node: Link abbreviations147927 +Node: Search options150607 +Ref: Search options-Footnote-1152489 +Node: Custom searches152570 +Node: TODO Items153580 +Ref: TODO Items-Footnote-1154688 +Node: TODO basics154802 +Node: TODO extensions157667 +Node: Workflow states158697 +Ref: Workflow states-Footnote-1160022 +Node: TODO types160115 +Ref: TODO types-Footnote-1161713 +Node: Multiple sets in one file161795 +Node: Fast access to TODO states163660 +Ref: Fast access to TODO states-Footnote-1164533 +Ref: Fast access to TODO states-Footnote-2164617 +Node: Per-file keywords164910 +Ref: Per-file keywords-Footnote-1166306 +Node: Faces for TODO keywords166507 +Node: TODO dependencies167548 +Node: Progress logging169711 +Node: Closing items170423 +Ref: Closing items-Footnote-1171653 +Ref: Closing items-Footnote-2171722 +Node: Tracking TODO state changes171796 +Ref: Tracking TODO state changes-Footnote-1174832 +Ref: Tracking TODO state changes-Footnote-2174887 +Ref: Tracking TODO state changes-Footnote-3175027 +Node: Tracking your habits175315 +Node: Priorities179549 +Ref: Priorities-Footnote-1181539 +Node: Breaking down tasks181608 +Ref: Breaking down tasks-Footnote-1183587 +Node: Checkboxes183683 +Ref: Checkboxes-Footnote-1188209 +Ref: Checkboxes-Footnote-2188333 +Ref: Checkboxes-Footnote-3188507 +Node: Tags188621 +Node: Tag inheritance189689 +Ref: Tag inheritance-Footnote-1191513 +Ref: Tag inheritance-Footnote-2191613 +Node: Setting tags191739 +Ref: Setting tags-Footnote-1198043 +Node: Tag groups198126 +Node: Tag searches199575 +Node: Properties and Columns200867 +Node: Property syntax202303 +Node: Special properties206527 +Node: Property searches208361 +Node: Property inheritance209796 +Node: Column view211612 +Node: Defining columns212847 +Node: Scope of column definitions213245 +Node: Column attributes214175 +Ref: Column attributes-Footnote-1218978 +Node: Using column view219111 +Node: Capturing column view221973 +Ref: Capturing column view-Footnote-1224969 +Node: Property API225105 +Node: Dates and Times225459 +Node: Timestamps226438 +Ref: Timestamps-Footnote-1228881 +Ref: Timestamps-Footnote-2229067 +Ref: Timestamps-Footnote-3229198 +Node: Creating timestamps229967 +Node: The date/time prompt232791 +Ref: The date/time prompt-Footnote-1237317 +Ref: The date/time prompt-Footnote-2237480 +Ref: The date/time prompt-Footnote-3237586 +Node: Custom time format237680 +Node: Deadlines and scheduling239402 +Ref: Deadlines and scheduling-Footnote-1242784 +Node: Inserting deadline/schedule242939 +Ref: Inserting deadline/schedule-Footnote-1245251 +Ref: Inserting deadline/schedule-Footnote-2245403 +Ref: Inserting deadline/schedule-Footnote-3245511 +Node: Repeated tasks245619 +Ref: Repeated tasks-Footnote-1249366 +Ref: Repeated tasks-Footnote-2249615 +Node: Clocking work time249814 +Ref: Clocking work time-Footnote-1250999 +Ref: Clocking work time-Footnote-2251143 +Node: Clocking commands251281 +Ref: Clocking commands-Footnote-1256254 +Ref: Clocking commands-Footnote-2256361 +Ref: Clocking commands-Footnote-3256411 +Ref: Clocking commands-Footnote-4256469 +Node: The clock table256547 +Ref: The clock table-Footnote-1263805 +Ref: The clock table-Footnote-2263899 +Node: Resolving idle time264024 +Ref: Resolving idle time-Footnote-1267871 +Node: Effort estimates268339 +Ref: Effort estimates-Footnote-1271100 +Node: Relative timer271207 +Node: Countdown timer273054 +Node: Capture - Refile - Archive273546 +Node: Capture274536 +Node: Setting up capture275639 +Ref: Setting up capture-Footnote-1276064 +Node: Using capture276130 +Node: Capture templates278537 +Node: Template elements280498 +Ref: Template elements-Footnote-1286162 +Node: Template expansion286337 +Ref: Template expansion-Footnote-1290327 +Ref: Template expansion-Footnote-2290414 +Ref: Template expansion-Footnote-3290596 +Node: Templates in contexts290694 +Node: Attachments291516 +Ref: Attachments-Footnote-1294898 +Node: RSS Feeds295048 +Node: Protocols296638 +Node: Refile and copy297353 +Ref: Refile and copy-Footnote-1299775 +Node: Archiving299871 +Node: Moving subtrees300571 +Ref: Moving subtrees-Footnote-1302428 +Node: Internal archiving302872 +Node: Agenda Views305502 +Node: Agenda files307693 +Ref: Agenda files-Footnote-1310517 +Ref: Agenda files-Footnote-2310666 +Node: Agenda dispatcher310859 +Ref: Agenda dispatcher-Footnote-1313674 +Ref: Agenda dispatcher-Footnote-2313768 +Node: Built-in agenda views313870 +Node: Weekly/daily agenda314519 +Ref: Weekly/daily agenda-Footnote-1319827 +Ref: Weekly/daily agenda-Footnote-2320054 +Node: Global TODO list320229 +Node: Matching tags and properties322757 +Ref: Matching tags and properties-Footnote-1330084 +Node: Timeline330164 +Node: Search view330856 +Node: Stuck projects332149 +Ref: Stuck projects-Footnote-1334209 +Node: Presentation and sorting334239 +Node: Categories335196 +Ref: Categories-Footnote-1335997 +Node: Time-of-day specifications336434 +Node: Sorting agenda items338403 +Node: Filtering/limiting agenda items339972 +Ref: Filtering/limiting agenda items-Footnote-1347243 +Ref: Filtering/limiting agenda items-Footnote-2347658 +Node: Agenda commands347726 +Ref: Agenda commands-Footnote-1369053 +Ref: Agenda commands-Footnote-2369134 +Ref: Agenda commands-Footnote-3369253 +Ref: Agenda commands-Footnote-4369353 +Node: Custom agenda views369436 +Node: Storing searches370077 +Ref: Storing searches-Footnote-1373046 +Ref: Storing searches-Footnote-2373163 +Node: Block agenda373411 +Node: Setting Options374649 +Node: Exporting Agenda Views378283 +Ref: Exporting Agenda Views-Footnote-1383184 +Ref: Exporting Agenda Views-Footnote-2383242 +Ref: Exporting Agenda Views-Footnote-3383398 +Ref: Exporting Agenda Views-Footnote-4383585 +Node: Agenda column view383667 +Node: Markup386741 +Node: Structural markup elements387770 +Node: Document title388440 +Node: Headings and sections389017 +Node: Table of contents389687 +Node: Lists391171 +Node: Paragraphs391462 +Node: Footnote markup392612 +Node: Emphasis and monospace392949 +Node: Horizontal rules393806 +Node: Comment lines394063 +Node: Images and tables394571 +Node: Literal examples396288 +Ref: Literal examples-Footnote-1400167 +Ref: Literal examples-Footnote-2400497 +Ref: Literal examples-Footnote-3400669 +Ref: Literal examples-Footnote-4400848 +Ref: Literal examples-Footnote-5401098 +Node: Include files401192 +Node: Index entries402859 +Node: Macro replacement403321 +Ref: Macro replacement-Footnote-1404145 +Node: Embedded LaTeX404375 +Ref: Embedded LaTeX-Footnote-1405339 +Node: Special symbols405529 +Ref: Special symbols-Footnote-1407151 +Node: Subscripts and superscripts407306 +Node: LaTeX fragments408411 +Ref: LaTeX fragments-Footnote-1410636 +Ref: LaTeX fragments-Footnote-2410809 +Ref: LaTeX fragments-Footnote-3411178 +Node: Previewing LaTeX fragments411386 +Ref: Previewing LaTeX fragments-Footnote-1412617 +Node: CDLaTeX mode412724 +Ref: CDLaTeX mode-Footnote-1415219 +Node: Special blocks415367 +Node: Exporting416270 +Node: The Export Dispatcher418225 +Ref: The Export Dispatcher-Footnote-1420563 +Node: Export back-ends420826 +Node: Export settings421736 +Ref: Export settings-Footnote-1428706 +Ref: Export settings-Footnote-2428808 +Ref: Export settings-Footnote-3428903 +Node: ASCII/Latin-1/UTF-8 export428946 +Node: Beamer export430977 +Ref: Beamer export-Footnote-1438379 +Ref: Beamer export-Footnote-2438542 +Node: HTML export438660 +Node: HTML Export commands439745 +Node: HTML doctypes440295 +Node: HTML preamble and postamble442533 +Node: Quoting HTML tags443581 +Node: Links in HTML export444211 +Node: Tables in HTML export445344 +Node: Images in HTML export446062 +Ref: Images in HTML export-Footnote-1447352 +Node: Math formatting in HTML export447407 +Ref: Math formatting in HTML export-Footnote-1448896 +Node: Text areas in HTML export449031 +Node: CSS support449811 +Ref: CSS support-Footnote-1452875 +Ref: CSS support-Footnote-2453047 +Node: JavaScript support453289 +Node: LaTeX and PDF export456670 +Ref: LaTeX and PDF export-Footnote-1457804 +Node: LaTeX export commands458127 +Node: Header and sectioning458822 +Ref: Header and sectioning-Footnote-1460434 +Ref: Header and sectioning-Footnote-2460546 +Node: Quoting LaTeX code460709 +Node: LaTeX specific attributes461304 +Ref: LaTeX specific attributes-Footnote-1469402 +Ref: LaTeX specific attributes-Footnote-2469480 +Ref: LaTeX specific attributes-Footnote-3469554 +Node: Markdown export469708 +Ref: Markdown export-Footnote-1471012 +Node: OpenDocument Text export471098 +Ref: OpenDocument Text export-Footnote-1472231 +Ref: OpenDocument Text export-Footnote-2472261 +Node: Pre-requisites for ODT export472405 +Node: ODT export commands472764 +Ref: x-export-to-odt472993 +Ref: ODT export commands-Footnote-1473992 +Ref: ODT export commands-Footnote-2474052 +Node: Extending ODT export474103 +Ref: x-export-to-other-formats475098 +Ref: x-convert-to-other-formats475626 +Node: Applying custom styles476083 +Node: Links in ODT export478241 +Node: Tables in ODT export478886 +Ref: Tables in ODT export-Footnote-1481020 +Node: Images in ODT export481113 +Ref: Images in ODT export-Footnote-1483838 +Node: Math formatting in ODT export484071 +Node: Working with LaTeX math snippets484533 +Ref: Working with LaTeX math snippets-Footnote-1486643 +Node: Working with MathML or OpenDocument formula files486718 +Node: Labels and captions in ODT export487290 +Node: Literal examples in ODT export488745 +Ref: Literal examples in ODT export-Footnote-1489646 +Node: Advanced topics in ODT export489757 +Node: Configuring a document converter490511 +Ref: x-odt-converter-capabilities491341 +Node: Working with OpenDocument style files491922 +Ref: x-factory-styles492418 +Ref: x-orgodtstyles-xml492650 +Ref: x-orgodtcontenttemplate-xml492977 +Ref: x-overriding-factory-styles493633 +Ref: x-org-odt-styles-file493907 +Ref: x-org-odt-content-template-file494788 +Node: Creating one-off styles494929 +Node: Customizing tables in ODT export497150 +Ref: Customizing tables in ODT export-Footnote-1502295 +Ref: Customizing tables in ODT export-Footnote-2502399 +Ref: Customizing tables in ODT export-Footnote-3502487 +Node: Validating OpenDocument XML502802 +Ref: Validating OpenDocument XML-Footnote-1503821 +Node: Org export503873 +Node: Texinfo export504637 +Node: Texinfo export commands505261 +Ref: Texinfo export commands-Footnote-1505804 +Node: Document preamble505912 +Ref: Document preamble-Footnote-1509186 +Node: Headings and sectioning structure509248 +Node: Indices510700 +Node: Quoting Texinfo code511493 +Node: Texinfo specific attributes511977 +Ref: Texinfo specific attributes-Footnote-1513183 +Node: An example513249 +Node: iCalendar export515221 +Ref: iCalendar export-Footnote-1517953 +Ref: iCalendar export-Footnote-2518043 +Ref: iCalendar export-Footnote-3518143 +Node: Other built-in back-ends518280 +Node: Export in foreign buffers518873 +Node: Advanced configuration519863 +Node: Publishing525964 +Node: Configuration526832 +Node: Project alist527614 +Node: Sources and destinations528777 +Node: Selecting files530295 +Node: Publishing action531296 +Ref: Publishing action-Footnote-1533125 +Node: Publishing options533282 +Node: Publishing links536335 +Node: Sitemap537302 +Node: Generating an index540521 +Node: Uploading files541108 +Node: Sample configuration542872 +Node: Simple example543361 +Node: Complex example544037 +Node: Triggering publication546088 +Node: Working With Source Code547084 +Node: Structure of code blocks548776 +Ref: Structure of code blocks-Footnote-1550642 +Node: Editing source code550736 +Node: Exporting code blocks552857 +Node: Extracting source code554963 +Node: Evaluating code blocks557199 +Ref: Evaluating code blocks-Footnote-1560553 +Ref: Evaluating code blocks-Footnote-2560850 +Node: Library of Babel560976 +Node: Languages561953 +Node: Header arguments564269 +Node: Using header arguments564754 +Node: System-wide header arguments565809 +Node: Language-specific header arguments566647 +Node: Header arguments in Org mode properties567156 +Ref: Header arguments in Org mode properties-Footnote-1568885 +Node: Language-specific header arguments in Org mode properties569157 +Node: Code block specific header arguments570173 +Node: Header arguments in function calls572019 +Node: Specific header arguments572768 +Node: var575397 +Node: results582222 +Node: file587075 +Node: file-desc587987 +Node: dir588452 +Node: exports591386 +Node: tangle592040 +Node: mkdirp592851 +Node: comments593182 +Node: padline594315 +Node: no-expand594847 +Node: session595339 +Node: noweb595786 +Node: noweb-ref597963 +Ref: noweb-ref-Footnote-1599429 +Node: noweb-sep599558 +Node: cache599852 +Node: sep601584 +Node: hlines602156 +Node: colnames603658 +Node: rownames604961 +Node: shebang606136 +Node: tangle-mode606539 +Node: eval607290 +Node: wrap608328 +Node: post608768 +Node: prologue609884 +Node: epilogue610456 +Node: Results of evaluation610711 +Node: Noweb reference syntax614479 +Node: Key bindings and useful functions616130 +Node: Batch execution618875 +Node: Miscellaneous619909 +Node: Completion620738 +Node: Easy Templates622714 +Node: Speed keys624123 +Node: Code evaluation security624950 +Node: Customization627664 +Node: In-buffer settings628259 +Ref: In-buffer settings-Footnote-1638407 +Node: The very busy C-c C-c key638455 +Node: Clean view640439 +Ref: Clean view-Footnote-1644424 +Ref: Clean view-Footnote-2644485 +Ref: Clean view-Footnote-3644669 +Ref: Clean view-Footnote-4644730 +Ref: Clean view-Footnote-5644842 +Ref: Clean view-Footnote-6644897 +Node: TTY keys645022 +Node: Interaction646788 +Node: Cooperation647182 +Node: Conflicts650980 +Node: org-crypt655949 +Node: Hacking657260 +Node: Hooks658248 +Node: Add-on packages658664 +Node: Adding hyperlink types659218 +Node: Adding export back-ends663138 +Node: Context-sensitive commands664583 +Ref: Context-sensitive commands-Footnote-1666160 +Node: Tables in arbitrary syntax666294 +Node: Radio tables667706 +Node: A LaTeX example670466 +Ref: A LaTeX example-Footnote-1674395 +Ref: A LaTeX example-Footnote-2674552 +Node: Translator functions674987 +Ref: Translator functions-Footnote-1678211 +Node: Radio lists678299 +Node: Dynamic blocks679428 +Node: Special agenda views681641 +Ref: x-agenda-skip-entry-regexp685104 +Ref: Special agenda views-Footnote-1685907 +Ref: Special agenda views-Footnote-2686104 +Node: Speeding up your agendas686239 +Node: Extracting agenda information687342 +Node: Using the property API691420 +Node: Using the mapping API694796 +Node: MobileOrg699218 +Node: Setting up the staging area700917 +Ref: Setting up the staging area-Footnote-1702016 +Ref: Setting up the staging area-Footnote-2702317 +Node: Pushing to MobileOrg702579 +Ref: Pushing to MobileOrg-Footnote-1703579 +Ref: Pushing to MobileOrg-Footnote-2703668 +Ref: Pushing to MobileOrg-Footnote-3704084 +Node: Pulling from MobileOrg704155 +Ref: Pulling from MobileOrg-Footnote-1706576 +Ref: Pulling from MobileOrg-Footnote-2706636 +Node: History and Acknowledgments707011 +Node: GNU Free Documentation License721967 +Node: Main Index747157 +Node: Key Index824688 +Node: Command and Function Index876736 +Node: Variable Index911060 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/elpa/org-20150427/org-agenda.el b/elpa/org-20150427/org-agenda.el new file mode 100644 index 00000000..403f6212 --- /dev/null +++ b/elpa/org-20150427/org-agenda.el @@ -0,0 +1,10100 @@ +;;; org-agenda.el --- Dynamic task and appointment lists for Org + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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 . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains the code for creating and using the Agenda for Org-mode. +;; +;; The functions `org-batch-agenda', `org-batch-agenda-csv', and +;; `org-batch-store-agenda-views' are implemented as macros to provide +;; a convenient way for extracting agenda information from the command +;; line. The Lisp does not evaluate parameters of a macro call; thus +;; it is not necessary to quote the parameters passed to one of those +;; functions. E.g. you can write: +;; +;; emacs -batch -l ~/.emacs -eval '(org-batch-agenda "a" org-agenda-span 7)' +;; +;; To export an agenda spanning 7 days. If `org-batch-agenda' would +;; have been implemented as a regular function you'd have to quote the +;; symbol org-agenda-span. Moreover: To use a symbol as parameter +;; value you would have to double quote the symbol. +;; +;; This is a hack, but it works even when running Org byte-compiled. +;; + +;;; Code: + +(require 'org) +(require 'org-macs) +(eval-when-compile + (require 'cl)) + +(declare-function diary-add-to-list "diary-lib" + (date string specifier &optional marker globcolor literal)) +(declare-function calendar-iso-to-absolute "cal-iso" (date)) +(declare-function calendar-astro-date-string "cal-julian" (&optional date)) +(declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) +(declare-function calendar-chinese-date-string "cal-china" (&optional date)) +(declare-function calendar-coptic-date-string "cal-coptic" (&optional date)) +(declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date)) +(declare-function calendar-french-date-string "cal-french" (&optional date)) +(declare-function calendar-goto-date "cal-move" (date)) +(declare-function calendar-hebrew-date-string "cal-hebrew" (&optional date)) +(declare-function calendar-islamic-date-string "cal-islam" (&optional date)) +(declare-function calendar-iso-date-string "cal-iso" (&optional date)) +(declare-function calendar-iso-from-absolute "cal-iso" (date)) +(declare-function calendar-julian-date-string "cal-julian" (&optional date)) +(declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) +(declare-function calendar-persian-date-string "cal-persia" (&optional date)) +(declare-function calendar-check-holidays "holidays" (date)) + +(declare-function org-datetree-find-date-create "org-datetree" + (date &optional keep-restriction)) +(declare-function org-columns-quit "org-colview" ()) +(declare-function diary-date-display-form "diary-lib" (&optional type)) +(declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file)) +(declare-function org-habit-insert-consistency-graphs + "org-habit" (&optional line)) +(declare-function org-is-habit-p "org-habit" (&optional pom)) +(declare-function org-habit-parse-todo "org-habit" (&optional pom)) +(declare-function org-habit-get-priority "org-habit" (habit &optional moment)) +(declare-function org-pop-to-buffer-same-window "org-compat" + (&optional buffer-or-name norecord label)) +(declare-function org-agenda-columns "org-colview" ()) +(declare-function org-add-archive-files "org-archive" (files)) +(declare-function org-capture "org-capture" (&optional goto keys)) + +(defvar calendar-mode-map) ; defined in calendar.el +(defvar org-clock-current-task nil) ; defined in org-clock.el +(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el +(defvar org-habit-show-habits) ; defined in org-habit.el +(defvar org-habit-show-habits-only-for-today) +(defvar org-habit-show-all-today) + +;; Defined somewhere in this file, but used before definition. +(defvar org-agenda-buffer-name "*Org Agenda*") +(defvar org-agenda-overriding-header nil) +(defvar org-agenda-title-append nil) +(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el +(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el +(defvar original-date) ; dynamically scoped, calendar.el does scope this + +(defvar org-agenda-undo-list nil + "List of undoable operations in the agenda since last refresh.") +(defvar org-agenda-pending-undo-list nil + "In a series of undo commands, this is the list of remaining undo items.") + +(defcustom org-agenda-confirm-kill 1 + "When set, remote killing from the agenda buffer needs confirmation. +When t, a confirmation is always needed. When a number N, confirmation is +only needed when the text to be killed contains more than N non-white lines." + :group 'org-agenda + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t) + (integer :tag "When more than N lines"))) + +(defcustom org-agenda-compact-blocks nil + "Non-nil means make the block agenda more compact. +This is done globally by leaving out lines like the agenda span +name and week number or the separator lines." + :group 'org-agenda + :type 'boolean) + +(defcustom org-agenda-block-separator ?= + "The separator between blocks in the agenda. +If this is a string, it will be used as the separator, with a newline added. +If it is a character, it will be repeated to fill the window width. +If nil the separator is disabled. In `org-agenda-custom-commands' this +addresses the separator between the current and the previous block." + :group 'org-agenda + :type '(choice + (const :tag "Disabled" nil) + (character) + (string))) + +(defgroup org-agenda-export nil + "Options concerning exporting agenda views in Org-mode." + :tag "Org Agenda Export" + :group 'org-agenda) + +(defcustom org-agenda-with-colors t + "Non-nil means use colors in agenda views." + :group 'org-agenda-export + :type 'boolean) + +(defcustom org-agenda-exporter-settings nil + "Alist of variable/value pairs that should be active during agenda export. +This is a good place to set options for ps-print and for htmlize. +Note that the way this is implemented, the values will be evaluated +before assigned to the variables. So make sure to quote values you do +*not* want evaluated, for example + + (setq org-agenda-exporter-settings + '((ps-print-color-p 'black-white)))" + :group 'org-agenda-export + :type '(repeat + (list + (variable) + (sexp :tag "Value")))) + +(defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text) + "Hook run in a temporary buffer before writing the agenda to an export file. +A useful function for this hook is `org-agenda-add-entry-text'." + :group 'org-agenda-export + :type 'hook + :options '(org-agenda-add-entry-text)) + +(defcustom org-agenda-add-entry-text-maxlines 0 + "Maximum number of entry text lines to be added to agenda. +This is only relevant when `org-agenda-add-entry-text' is part of +`org-agenda-before-write-hook', which is the default. +When this is 0, nothing will happen. When it is greater than 0, it +specifies the maximum number of lines that will be added for each entry +that is listed in the agenda view. + +Note that this variable is not used during display, only when exporting +the agenda. For agenda display, see the variables `org-agenda-entry-text-mode' +and `org-agenda-entry-text-maxlines'." + :group 'org-agenda + :type 'integer) + +(defcustom org-agenda-add-entry-text-descriptive-links t + "Non-nil means export org-links as descriptive links in agenda added text. +This variable applies to the text added to the agenda when +`org-agenda-add-entry-text-maxlines' is larger than 0. +When this variable nil, the URL will (also) be shown." + :group 'org-agenda + :type 'boolean) + +(defcustom org-agenda-export-html-style nil + "The style specification for exported HTML Agenda files. +If this variable contains a string, it will replace the default + +or, if you want to keep the style in a file, + + + +As the value of this option simply gets inserted into the HTML header, +you can \"misuse\" it to also add other text to the header." + :group 'org-agenda-export + :group 'org-export-html + :type '(choice + (const nil) + (string))) + +(defcustom org-agenda-persistent-filter nil + "When set, keep filters from one agenda view to the next." + :group 'org-agenda + :type 'boolean) + +(defgroup org-agenda-custom-commands nil + "Options concerning agenda views in Org-mode." + :tag "Org Agenda Custom Commands" + :group 'org-agenda) + +(defconst org-sorting-choice + '(choice + (const time-up) (const time-down) + (const timestamp-up) (const timestamp-down) + (const scheduled-up) (const scheduled-down) + (const deadline-up) (const deadline-down) + (const ts-up) (const ts-down) + (const tsia-up) (const tsia-down) + (const category-keep) (const category-up) (const category-down) + (const tag-down) (const tag-up) + (const priority-up) (const priority-down) + (const todo-state-up) (const todo-state-down) + (const effort-up) (const effort-down) + (const habit-up) (const habit-down) + (const alpha-up) (const alpha-down) + (const user-defined-up) (const user-defined-down)) + "Sorting choices.") + +;; Keep custom values for `org-agenda-filter-preset' compatible with +;; the new variable `org-agenda-tag-filter-preset'. +(org-defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) +(org-defvaralias 'org-agenda-filter 'org-agenda-tag-filter) + +(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp) + "List of types searched for when creating the daily/weekly agenda. +This variable is a list of symbols that controls the types of +items that appear in the daily/weekly agenda. Allowed symbols in this +list are are + + :timestamp List items containing a date stamp or date range matching + the selected date. This includes sexp entries in angular + brackets. + + :sexp List entries resulting from plain diary-like sexps. + + :deadline List deadline due on that date. When the date is today, + also list any deadlines past due, or due within + `org-deadline-warning-days'. `:deadline' must appear before + `:scheduled' if the setting of + `org-agenda-skip-scheduled-if-deadline-is-shown' is to have + any effect. + + :deadline* Same as above, but only include the deadline if it has an + hour specification as [h]h:mm. + + :scheduled List all items which are scheduled for the given date. + The diary for *today* also contains items which were + scheduled earlier and are not yet marked DONE. + + :scheduled* Same as above, but only include the scheduled item if it + has an hour specification as [h]h:mm. + +By default, all four non-starred types are turned on. + +When :scheduled* or :deadline* are included, :schedule or :deadline +will be ignored. + +Never set this variable globally using `setq', because then it +will apply to all future agenda commands. Instead, bind it with +`let' to scope it dynamically into the agenda-constructing +command. A good way to set it is through options in +`org-agenda-custom-commands'. For a more flexible (though +somewhat less efficient) way of determining what is included in +the daily/weekly agenda, see `org-agenda-skip-function'.") + +(defconst org-agenda-custom-commands-local-options + `(repeat :tag "Local settings for this command. Remember to quote values" + (choice :tag "Setting" + (list :tag "Heading for this block" + (const org-agenda-overriding-header) + (string :tag "Headline")) + (list :tag "Files to be searched" + (const org-agenda-files) + (list + (const :format "" quote) + (repeat (file)))) + (list :tag "Sorting strategy" + (const org-agenda-sorting-strategy) + (list + (const :format "" quote) + (repeat + ,org-sorting-choice))) + (list :tag "Prefix format" + (const org-agenda-prefix-format :value " %-12:c%?-12t% s") + (string)) + (list :tag "Number of days in agenda" + (const org-agenda-span) + (choice (const :tag "Day" day) + (const :tag "Week" week) + (const :tag "Fortnight" fortnight) + (const :tag "Month" month) + (const :tag "Year" year) + (integer :tag "Custom"))) + (list :tag "Fixed starting date" + (const org-agenda-start-day) + (string :value "2007-11-01")) + (list :tag "Start on day of week" + (const org-agenda-start-on-weekday) + (choice :value 1 + (const :tag "Today" nil) + (integer :tag "Weekday No."))) + (list :tag "Include data from diary" + (const org-agenda-include-diary) + (boolean)) + (list :tag "Deadline Warning days" + (const org-deadline-warning-days) + (integer :value 1)) + (list :tag "Category filter preset" + (const org-agenda-category-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+category or -category")))) + (list :tag "Tags filter preset" + (const org-agenda-tag-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+tag or -tag")))) + (list :tag "Regexp filter preset" + (const org-agenda-regexp-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+regexp or -regexp")))) + (list :tag "Set daily/weekly entry types" + (const org-agenda-entry-types) + (list + (const :format "" quote) + (set :greedy t :value ,org-agenda-entry-types + (const :deadline) + (const :scheduled) + (const :deadline*) + (const :scheduled*) + (const :timestamp) + (const :sexp)))) + (list :tag "Standard skipping condition" + :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) + (const org-agenda-skip-function) + (list + (const :format "" quote) + (list + (choice + :tag "Skipping range" + (const :tag "Skip entry" org-agenda-skip-entry-if) + (const :tag "Skip subtree" org-agenda-skip-subtree-if)) + (repeat :inline t :tag "Conditions for skipping" + (choice + :tag "Condition type" + (list :tag "Regexp matches" :inline t + (const :format "" 'regexp) + (regexp)) + (list :tag "Regexp does not match" :inline t + (const :format "" 'notregexp) + (regexp)) + (list :tag "TODO state is" :inline t + (const 'todo) + (choice + (const :tag "Any not-done state" 'todo) + (const :tag "Any done state" 'done) + (const :tag "Any state" 'any) + (list :tag "Keyword list" + (const :format "" quote) + (repeat (string :tag "Keyword"))))) + (list :tag "TODO state is not" :inline t + (const 'nottodo) + (choice + (const :tag "Any not-done state" 'todo) + (const :tag "Any done state" 'done) + (const :tag "Any state" 'any) + (list :tag "Keyword list" + (const :format "" quote) + (repeat (string :tag "Keyword"))))) + (const :tag "scheduled" 'scheduled) + (const :tag "not scheduled" 'notscheduled) + (const :tag "deadline" 'deadline) + (const :tag "no deadline" 'notdeadline) + (const :tag "timestamp" 'timestamp) + (const :tag "no timestamp" 'nottimestamp)))))) + (list :tag "Non-standard skipping condition" + :value (org-agenda-skip-function) + (const org-agenda-skip-function) + (sexp :tag "Function or form (quoted!)")) + (list :tag "Any variable" + (variable :tag "Variable") + (sexp :tag "Value (sexp)")))) + "Selection of examples for agenda command settings. +This will be spliced into the custom type of +`org-agenda-custom-commands'.") + + +(defcustom org-agenda-custom-commands + '(("n" "Agenda and all TODO's" ((agenda "") (alltodo "")))) + "Custom commands for the agenda. +These commands will be offered on the splash screen displayed by the +agenda dispatcher \\[org-agenda]. Each entry is a list like this: + + (key desc type match settings files) + +key The key (one or more characters as a string) to be associated + with the command. +desc A description of the command, when omitted or nil, a default + description is built using MATCH. +type The command type, any of the following symbols: + agenda The daily/weekly agenda. + todo Entries with a specific TODO keyword, in all agenda files. + search Entries containing search words entry or headline. + tags Tags/Property/TODO match in all agenda files. + tags-todo Tags/P/T match in all agenda files, TODO entries only. + todo-tree Sparse tree of specific TODO keyword in *current* file. + tags-tree Sparse tree with all tags matches in *current* file. + occur-tree Occur sparse tree for *current* file. + ... A user-defined function. +match What to search for: + - a single keyword for TODO keyword searches + - a tags match expression for tags searches + - a word search expression for text searches. + - a regular expression for occur searches + For all other commands, this should be the empty string. +settings A list of option settings, similar to that in a let form, so like + this: ((opt1 val1) (opt2 val2) ...). The values will be + evaluated at the moment of execution, so quote them when needed. +files A list of files file to write the produced agenda buffer to + with the command `org-store-agenda-views'. + If a file name ends in \".html\", an HTML version of the buffer + is written out. If it ends in \".ps\", a postscript version is + produced. Otherwise, only the plain text is written to the file. + +You can also define a set of commands, to create a composite agenda buffer. +In this case, an entry looks like this: + + (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files) + +where + +desc A description string to be displayed in the dispatcher menu. +cmd An agenda command, similar to the above. However, tree commands + are not allowed, but instead you can get agenda and global todo list. + So valid commands for a set are: + (agenda \"\" settings) + (alltodo \"\" settings) + (stuck \"\" settings) + (todo \"match\" settings files) + (search \"match\" settings files) + (tags \"match\" settings files) + (tags-todo \"match\" settings files) + +Each command can carry a list of options, and another set of options can be +given for the whole set of commands. Individual command options take +precedence over the general options. + +When using several characters as key to a command, the first characters +are prefix commands. For the dispatcher to display useful information, you +should provide a description for the prefix, like + + (setq org-agenda-custom-commands + '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\" + (\"hl\" tags \"+HOME+Lisa\") + (\"hp\" tags \"+HOME+Peter\") + (\"hk\" tags \"+HOME+Kim\")))" + :group 'org-agenda-custom-commands + :type `(repeat + (choice :value ("x" "Describe command here" tags "" nil) + (list :tag "Single command" + (string :tag "Access Key(s) ") + (option (string :tag "Description")) + (choice + (const :tag "Agenda" agenda) + (const :tag "TODO list" alltodo) + (const :tag "Search words" search) + (const :tag "Stuck projects" stuck) + (const :tag "Tags/Property match (all agenda files)" tags) + (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo) + (const :tag "TODO keyword search (all agenda files)" todo) + (const :tag "Tags sparse tree (current buffer)" tags-tree) + (const :tag "TODO keyword tree (current buffer)" todo-tree) + (const :tag "Occur tree (current buffer)" occur-tree) + (sexp :tag "Other, user-defined function")) + (string :tag "Match (only for some commands)") + ,org-agenda-custom-commands-local-options + (option (repeat :tag "Export" (file :tag "Export to")))) + (list :tag "Command series, all agenda files" + (string :tag "Access Key(s)") + (string :tag "Description ") + (repeat :tag "Component" + (choice + (list :tag "Agenda" + (const :format "" agenda) + (const :tag "" :format "" "") + ,org-agenda-custom-commands-local-options) + (list :tag "TODO list (all keywords)" + (const :format "" alltodo) + (const :tag "" :format "" "") + ,org-agenda-custom-commands-local-options) + (list :tag "Search words" + (const :format "" search) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "Stuck projects" + (const :format "" stuck) + (const :tag "" :format "" "") + ,org-agenda-custom-commands-local-options) + (list :tag "Tags search" + (const :format "" tags) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "Tags search, TODO entries only" + (const :format "" tags-todo) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "TODO keyword search" + (const :format "" todo) + (string :tag "Match") + ,org-agenda-custom-commands-local-options) + (list :tag "Other, user-defined function" + (symbol :tag "function") + (string :tag "Match") + ,org-agenda-custom-commands-local-options))) + + (repeat :tag "Settings for entire command set" + (list (variable :tag "Any variable") + (sexp :tag "Value"))) + (option (repeat :tag "Export" (file :tag "Export to")))) + (cons :tag "Prefix key documentation" + (string :tag "Access Key(s)") + (string :tag "Description "))))) + +(defcustom org-agenda-query-register ?o + "The register holding the current query string. +The purpose of this is that if you construct a query string interactively, +you can then use it to define a custom command." + :group 'org-agenda-custom-commands + :type 'character) + +(defcustom org-stuck-projects + '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "") + "How to identify stuck projects. +This is a list of four items: +1. A tags/todo/property matcher string that is used to identify a project. + See the manual for a description of tag and property searches. + The entire tree below a headline matched by this is considered one project. +2. A list of TODO keywords identifying non-stuck projects. + If the project subtree contains any headline with one of these todo + keywords, the project is considered to be not stuck. If you specify + \"*\" as a keyword, any TODO keyword will mark the project unstuck. +3. A list of tags identifying non-stuck projects. + If the project subtree contains any headline with one of these tags, + the project is considered to be not stuck. If you specify \"*\" as + a tag, any tag will mark the project unstuck. Note that this is about + the explicit presence of a tag somewhere in the subtree, inherited + tags do not count here. If inherited tags make a project not stuck, + use \"-TAG\" in the tags part of the matcher under (1.) above. +4. An arbitrary regular expression matching non-stuck projects. + +If the project turns out to be not stuck, search continues also in the +subtree to see if any of the subtasks have project status. + +See also the variable `org-tags-match-list-sublevels' which applies +to projects matched by this search as well. + +After defining this variable, you may use \\[org-agenda-list-stuck-projects] +or `C-c a #' to produce the list." + :group 'org-agenda-custom-commands + :type '(list + (string :tag "Tags/TODO match to identify a project") + (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string)) + (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string)) + (regexp :tag "Projects are *not* stuck if this regexp matches inside the subtree"))) + +(defcustom org-agenda-filter-effort-default-operator "<" + "The default operator for effort estimate filtering. +If you select an effort estimate limit without first pressing an operator, +this one will be used." + :group 'org-agenda-custom-commands + :type '(choice (const :tag "less or equal" "<") + (const :tag "greater or equal"">") + (const :tag "equal" "="))) + +(defgroup org-agenda-skip nil + "Options concerning skipping parts of agenda files." + :tag "Org Agenda Skip" + :group 'org-agenda) + +(defcustom org-agenda-skip-function-global nil + "Function to be called at each match during agenda construction. +If this function returns nil, the current match should not be skipped. +If the function decided to skip an agenda match, is must return the +buffer position from which the search should be continued. +This may also be a Lisp form, which will be evaluated. + +This variable will be applied to every agenda match, including +tags/property searches and TODO lists. So try to make the test function +do its checking as efficiently as possible. To implement a skipping +condition just for specific agenda commands, use the variable +`org-agenda-skip-function' which can be set in the options section +of custom agenda commands." + :group 'org-agenda-skip + :type 'sexp) + +(defgroup org-agenda-daily/weekly nil + "Options concerning the daily/weekly agenda." + :tag "Org Agenda Daily/Weekly" + :group 'org-agenda) +(defgroup org-agenda-todo-list nil + "Options concerning the global todo list agenda view." + :tag "Org Agenda Todo List" + :group 'org-agenda) +(defgroup org-agenda-match-view nil + "Options concerning the general tags/property/todo match agenda view." + :tag "Org Agenda Match View" + :group 'org-agenda) +(defgroup org-agenda-search-view nil + "Options concerning the search agenda view." + :tag "Org Agenda Search View" + :group 'org-agenda) + +(defvar org-agenda-archives-mode nil + "Non-nil means the agenda will include archived items. +If this is the symbol `trees', trees in the selected agenda scope +that are marked with the ARCHIVE tag will be included anyway. When this is +t, also all archive files associated with the current selection of agenda +files will be included.") + +(defcustom org-agenda-restriction-lock-highlight-subtree t + "Non-nil means highlight the whole subtree when restriction is active. +Otherwise only highlight the headline. Highlighting the whole subtree is +useful to ensure no edits happen beyond the restricted region." + :group 'org-agenda + :type 'boolean) + +(defcustom org-agenda-skip-comment-trees t + "Non-nil means skip trees that start with the COMMENT keyword. +When nil, these trees are also scanned by agenda commands." + :group 'org-agenda-skip + :type 'boolean) + +(defcustom org-agenda-todo-list-sublevels t + "Non-nil means check also the sublevels of a TODO entry for TODO entries. +When nil, the sublevels of a TODO entry are not checked, resulting in +potentially much shorter TODO lists." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :type 'boolean) + +(defcustom org-agenda-todo-ignore-with-date nil + "Non-nil means don't show entries with a date in the global todo list. +You can use this if you prefer to mark mere appointments with a TODO keyword, +but don't want them to show up in the TODO list. +When this is set, it also covers deadlines and scheduled items, the settings +of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines' +will be ignored. +See also the variable `org-agenda-tags-todo-honor-ignore-options'." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :type 'boolean) + +(defcustom org-agenda-todo-ignore-timestamp nil + "Non-nil means don't show entries with a timestamp. +This applies when creating the global todo list. +Valid values are: + +past Don't show entries for today or in the past. + +future Don't show entries with a timestamp in the future. + The idea behind this is that if it has a future + timestamp, you don't want to think about it until the + date. + +all Don't show any entries with a timestamp in the global todo list. + The idea behind this is that by setting a timestamp, you + have already \"taken care\" of this item. + +This variable can also have an integer as a value. If positive (N), +todos with a timestamp N or more days in the future will be ignored. If +negative (-N), todos with a timestamp N or more days in the past will be +ignored. If 0, todos with a timestamp either today or in the future will +be ignored. For example, a value of -1 will exclude todos with a +timestamp in the past (yesterday or earlier), while a value of 7 will +exclude todos with a timestamp a week or more in the future. + +See also `org-agenda-todo-ignore-with-date'. +See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want +to make his option also apply to the tags-todo list." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :version "24.1" + :type '(choice + (const :tag "Ignore future timestamp todos" future) + (const :tag "Ignore past or present timestamp todos" past) + (const :tag "Ignore all timestamp todos" all) + (const :tag "Show timestamp todos" nil) + (integer :tag "Ignore if N or more days in past(-) or future(+)."))) + +(defcustom org-agenda-todo-ignore-scheduled nil + "Non-nil means, ignore some scheduled TODO items when making TODO list. +This applies when creating the global todo list. +Valid values are: + +past Don't show entries scheduled today or in the past. + +future Don't show entries scheduled in the future. + The idea behind this is that by scheduling it, you don't want to + think about it until the scheduled date. + +all Don't show any scheduled entries in the global todo list. + The idea behind this is that by scheduling it, you have already + \"taken care\" of this item. + +t Same as `all', for backward compatibility. + +This variable can also have an integer as a value. See +`org-agenda-todo-ignore-timestamp' for more details. + +See also `org-agenda-todo-ignore-with-date'. +See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want +to make his option also apply to the tags-todo list." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :type '(choice + (const :tag "Ignore future-scheduled todos" future) + (const :tag "Ignore past- or present-scheduled todos" past) + (const :tag "Ignore all scheduled todos" all) + (const :tag "Ignore all scheduled todos (compatibility)" t) + (const :tag "Show scheduled todos" nil) + (integer :tag "Ignore if N or more days in past(-) or future(+)."))) + +(defcustom org-agenda-todo-ignore-deadlines nil + "Non-nil means ignore some deadline TODO items when making TODO list. +There are different motivations for using different values, please think +carefully when configuring this variable. + +This applies when creating the global todo list. +Valid values are: + +near Don't show near deadline entries. A deadline is near when it is + closer than `org-deadline-warning-days' days. The idea behind this + is that such items will appear in the agenda anyway. + +far Don't show TODO entries where a deadline has been defined, but + the deadline is not near. This is useful if you don't want to + use the todo list to figure out what to do now. + +past Don't show entries with a deadline timestamp for today or in the past. + +future Don't show entries with a deadline timestamp in the future, not even + when they become `near' ones. Use it with caution. + +all Ignore all TODO entries that do have a deadline. + +t Same as `near', for backward compatibility. + +This variable can also have an integer as a value. See +`org-agenda-todo-ignore-timestamp' for more details. + +See also `org-agenda-todo-ignore-with-date'. +See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want +to make his option also apply to the tags-todo list." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :type '(choice + (const :tag "Ignore near deadlines" near) + (const :tag "Ignore near deadlines (compatibility)" t) + (const :tag "Ignore far deadlines" far) + (const :tag "Ignore all TODOs with a deadlines" all) + (const :tag "Show all TODOs, even if they have a deadline" nil) + (integer :tag "Ignore if N or more days in past(-) or future(+)."))) + +(defcustom org-agenda-todo-ignore-time-comparison-use-seconds nil + "Time unit to use when possibly ignoring an agenda item. + +See the docstring of various `org-agenda-todo-ignore-*' options. +The default is to compare time stamps using days. An item is thus +considered to be in the future if it is at least one day after today. +Non-nil means to compare time stamps using seconds. An item is then +considered future if it has a time value later than current time." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Compare time with days" nil) + (const :tag "Compare time with seconds" t))) + +(defcustom org-agenda-tags-todo-honor-ignore-options nil + "Non-nil means honor todo-list ignores options also in tags-todo search. +The variables + `org-agenda-todo-ignore-with-date', + `org-agenda-todo-ignore-timestamp', + `org-agenda-todo-ignore-scheduled', + `org-agenda-todo-ignore-deadlines' +make the global TODO list skip entries that have time stamps of certain +kinds. If this option is set, the same options will also apply for the +tags-todo search, which is the general tags/property matcher +restricted to unfinished TODO entries only." + :group 'org-agenda-skip + :group 'org-agenda-todo-list + :group 'org-agenda-match-view + :type 'boolean) + +(defcustom org-agenda-skip-scheduled-if-done nil + "Non-nil means don't show scheduled items in agenda when they are done. +This is relevant for the daily/weekly agenda, not for the TODO list. And +it applies only to the actual date of the scheduling. Warnings about +an item with a past scheduling dates are always turned off when the item +is DONE." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil + "Non-nil means skip scheduling line if same entry shows because of deadline. + +In the agenda of today, an entry can show up multiple times +because it is both scheduled and has a nearby deadline, and maybe +a plain time stamp as well. + +When this variable is nil, the entry will be shown several times. + +When set to t, then only the deadline is shown and the fact that +the entry is scheduled today or was scheduled previously is not +shown. + +When set to the symbol `not-today', skip scheduled previously, +but not scheduled today. + +When set to the symbol `repeated-after-deadline', skip scheduled +items if they are repeated beyond the current deadline." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "Not when scheduled today" not-today) + (const :tag "When repeated past deadline" repeated-after-deadline))) + +(defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil + "Non-nil means skip timestamp line if same entry shows because of deadline. +In the agenda of today, an entry can show up multiple times +because it has both a plain timestamp and has a nearby deadline. +When this variable is t, then only the deadline is shown and the +fact that the entry has a timestamp for or including today is not +shown. When this variable is nil, the entry will be shown +several times." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :version "24.1" + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t))) + +(defcustom org-agenda-skip-deadline-if-done nil + "Non-nil means don't show deadlines when the corresponding item is done. +When nil, the deadline is still shown and should give you a happy feeling. +This is relevant for the daily/weekly agenda. And it applied only to the +actually date of the deadline. Warnings about approaching and past-due +deadlines are always turned off when the item is DONE." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil + "Non-nil means skip deadline prewarning when entry is also scheduled. +This will apply on all days where a prewarning for the deadline would +be shown, but not at the day when the entry is actually due. On that day, +the deadline will be shown anyway. +This variable may be set to nil, t, the symbol `pre-scheduled', +or a number which will then give the number of days before the actual +deadline when the prewarnings should resume. The symbol `pre-scheduled' +eliminates the deadline prewarning only prior to the scheduled date. +This can be used in a workflow where the first showing of the deadline will +trigger you to schedule it, and then you don't want to be reminded of it +because you will take care of it on the day when scheduled." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :version "24.1" + :type '(choice + (const :tag "Always show prewarning" nil) + (const :tag "Remove prewarning prior to scheduled date" pre-scheduled) + (const :tag "Remove prewarning if entry is scheduled" t) + (integer :tag "Restart prewarning N days before deadline"))) + +(defcustom org-agenda-skip-scheduled-delay-if-deadline nil + "Non-nil means skip scheduled delay when entry also has a deadline. +This variable may be set to nil, t, the symbol `post-deadline', +or a number which will then give the number of days after the actual +scheduled date when the delay should expire. The symbol `post-deadline' +eliminates the schedule delay when the date is posterior to the deadline." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Always honor delay" nil) + (const :tag "Ignore delay if posterior to the deadline" post-deadline) + (const :tag "Ignore delay if entry has a deadline" t) + (integer :tag "Honor delay up until N days after the scheduled date"))) + +(defcustom org-agenda-skip-additional-timestamps-same-entry nil + "When nil, multiple same-day timestamps in entry make multiple agenda lines. +When non-nil, after the search for timestamps has matched once in an +entry, the rest of the entry will not be searched." + :group 'org-agenda-skip + :type 'boolean) + +(defcustom org-agenda-skip-timestamp-if-done nil + "Non-nil means don't select item by timestamp or -range if it is DONE." + :group 'org-agenda-skip + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-dim-blocked-tasks t + "Non-nil means dim blocked tasks in the agenda display. +This causes some overhead during agenda construction, but if you +have turned on `org-enforce-todo-dependencies', +`org-enforce-todo-checkbox-dependencies', or any other blocking +mechanism, this will create useful feedback in the agenda. + +Instead of t, this variable can also have the value `invisible'. +Then blocked tasks will be invisible and only become visible when +they become unblocked. An exemption to this behavior is when a task is +blocked because of unchecked checkboxes below it. Since checkboxes do +not show up in the agenda views, making this task invisible you remove any +trace from agenda views that there is something to do. Therefore, a task +that is blocked because of checkboxes will never be made invisible, it +will only be dimmed." + :group 'org-agenda-daily/weekly + :group 'org-agenda-todo-list + :version "24.3" + :type '(choice + (const :tag "Do not dim" nil) + (const :tag "Dim to a gray face" t) + (const :tag "Make invisible" invisible))) + +(defcustom org-timeline-show-empty-dates 3 + "Non-nil means `org-timeline' also shows dates without an entry. +When nil, only the days which actually have entries are shown. +When t, all days between the first and the last date are shown. +When an integer, show also empty dates, but if there is a gap of more than +N days, just insert a special line indicating the size of the gap." + :group 'org-agenda-skip + :type '(choice + (const :tag "None" nil) + (const :tag "All" t) + (integer :tag "at most"))) + +(defgroup org-agenda-startup nil + "Options concerning initial settings in the Agenda in Org Mode." + :tag "Org Agenda Startup" + :group 'org-agenda) + +(defcustom org-agenda-menu-show-matcher t + "Non-nil means show the match string in the agenda dispatcher menu. +When nil, the matcher string is not shown, but is put into the help-echo +property so than moving the mouse over the command shows it. +Setting it to nil is good if matcher strings are very long and/or if +you want to use two-columns display (see `org-agenda-menu-two-columns')." + :group 'org-agenda + :version "24.1" + :type 'boolean) + +(define-obsolete-variable-alias 'org-agenda-menu-two-column 'org-agenda-menu-two-columns "24.3") + +(defcustom org-agenda-menu-two-columns nil + "Non-nil means, use two columns to show custom commands in the dispatcher. +If you use this, you probably want to set `org-agenda-menu-show-matcher' +to nil." + :group 'org-agenda + :version "24.1" + :type 'boolean) + +(define-obsolete-variable-alias 'org-finalize-agenda-hook 'org-agenda-finalize-hook "24.3") +(defcustom org-agenda-finalize-hook nil + "Hook run just before displaying an agenda buffer. +The buffer is still writable when the hook is called. + +You can modify some of the buffer substrings but you should be +extra careful not to modify the text properties of the agenda +headlines as the agenda display heavily relies on them." + :group 'org-agenda-startup + :type 'hook) + +(defcustom org-agenda-mouse-1-follows-link nil + "Non-nil means mouse-1 on a link will follow the link in the agenda. +A longer mouse click will still set point. Does not work on XEmacs. +Needs to be set before org.el is loaded." + :group 'org-agenda-startup + :type 'boolean) + +(defcustom org-agenda-start-with-follow-mode nil + "The initial value of follow mode in a newly created agenda window." + :group 'org-agenda-startup + :type 'boolean) + +(defcustom org-agenda-follow-indirect nil + "Non-nil means `org-agenda-follow-mode' displays only the +current item's tree, in an indirect buffer." + :group 'org-agenda + :version "24.1" + :type 'boolean) + +(defcustom org-agenda-show-outline-path t + "Non-nil means show outline path in echo area after line motion." + :group 'org-agenda-startup + :type 'boolean) + +(defcustom org-agenda-start-with-entry-text-mode nil + "The initial value of entry-text-mode in a newly created agenda window." + :group 'org-agenda-startup + :type 'boolean) + +(defcustom org-agenda-entry-text-maxlines 5 + "Number of text lines to be added when `E' is pressed in the agenda. + +Note that this variable only used during agenda display. Add add entry text +when exporting the agenda, configure the variable +`org-agenda-add-entry-ext-maxlines'." + :group 'org-agenda + :type 'integer) + +(defcustom org-agenda-entry-text-exclude-regexps nil + "List of regular expressions to clean up entry text. +The complete matches of all regular expressions in this list will be +removed from entry text before it is shown in the agenda." + :group 'org-agenda + :type '(repeat (regexp))) + +(defcustom org-agenda-entry-text-leaders " > " + "Text prepended to the entry text in agenda buffers." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda + :type 'string) + +(defvar org-agenda-entry-text-cleanup-hook nil + "Hook that is run after basic cleanup of entry text to be shown in agenda. +This cleanup is done in a temporary buffer, so the function may inspect and +change the entire buffer. +Some default stuff like drawers and scheduling/deadline dates will already +have been removed when this is called, as will any matches for regular +expressions listed in `org-agenda-entry-text-exclude-regexps'.") + +(defvar org-agenda-include-inactive-timestamps nil + "Non-nil means include inactive time stamps in agenda and timeline. +Dynamically scoped.") + +(defgroup org-agenda-windows nil + "Options concerning the windows used by the Agenda in Org Mode." + :tag "Org Agenda Windows" + :group 'org-agenda) + +(defcustom org-agenda-window-setup 'reorganize-frame + "How the agenda buffer should be displayed. +Possible values for this option are: + +current-window Show agenda in the current window, keeping all other windows. +other-window Use `switch-to-buffer-other-window' to display agenda. +reorganize-frame Show only two windows on the current frame, the current + window and the agenda. +other-frame Use `switch-to-buffer-other-frame' to display agenda. + Also, when exiting the agenda, kill that frame. +See also the variable `org-agenda-restore-windows-after-quit'." + :group 'org-agenda-windows + :type '(choice + (const current-window) + (const other-frame) + (const other-window) + (const reorganize-frame))) + +(defcustom org-agenda-window-frame-fractions '(0.5 . 0.75) + "The min and max height of the agenda window as a fraction of frame height. +The value of the variable is a cons cell with two numbers between 0 and 1. +It only matters if `org-agenda-window-setup' is `reorganize-frame'." + :group 'org-agenda-windows + :type '(cons (number :tag "Minimum") (number :tag "Maximum"))) + +(defcustom org-agenda-restore-windows-after-quit nil + "Non-nil means restore window configuration upon exiting agenda. +Before the window configuration is changed for displaying the agenda, +the current status is recorded. When the agenda is exited with +`q' or `x' and this option is set, the old state is restored. If +`org-agenda-window-setup' is `other-frame', the value of this +option will be ignored." + :group 'org-agenda-windows + :type 'boolean) + +(defcustom org-agenda-ndays nil + "Number of days to include in overview display. +Should be 1 or 7. +Obsolete, see `org-agenda-span'." + :group 'org-agenda-daily/weekly + :type '(choice (const nil) + (integer))) + +(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1") + +(defcustom org-agenda-span 'week + "Number of days to include in overview display. +Can be day, week, month, year, or any number of days. +Custom commands can set this variable in the options section." + :group 'org-agenda-daily/weekly + :type '(choice (const :tag "Day" day) + (const :tag "Week" week) + (const :tag "Fortnight" fortnight) + (const :tag "Month" month) + (const :tag "Year" year) + (integer :tag "Custom"))) + +(defcustom org-agenda-start-on-weekday 1 + "Non-nil means start the overview always on the specified weekday. +0 denotes Sunday, 1 denotes Monday, etc. +When nil, always start on the current day. +Custom commands can set this variable in the options section." + :group 'org-agenda-daily/weekly + :type '(choice (const :tag "Today" nil) + (integer :tag "Weekday No."))) + +(defcustom org-agenda-show-all-dates t + "Non-nil means `org-agenda' shows every day in the selected range. +When nil, only the days which actually have entries are shown." + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-format-date 'org-agenda-format-date-aligned + "Format string for displaying dates in the agenda. +Used by the daily/weekly agenda and by the timeline. This should be +a format string understood by `format-time-string', or a function returning +the formatted date as a string. The function must take a single argument, +a calendar-style date list like (month day year)." + :group 'org-agenda-daily/weekly + :type '(choice + (string :tag "Format string") + (function :tag "Function"))) + +(defun org-agenda-format-date-aligned (date) + "Format a DATE string for display in the daily/weekly agenda, or timeline. +This function makes sure that dates are aligned for easy reading." + (require 'cal-iso) + (let* ((dayname (calendar-day-name date)) + (day (cadr date)) + (day-of-week (calendar-day-of-week date)) + (month (car date)) + (monthname (calendar-month-name month)) + (year (nth 2 date)) + (iso-week (org-days-to-iso-week + (calendar-absolute-from-gregorian date))) + (weekyear (cond ((and (= month 1) (>= iso-week 52)) + (1- year)) + ((and (= month 12) (<= iso-week 1)) + (1+ year)) + (t year))) + (weekstring (if (= day-of-week 1) + (format " W%02d" iso-week) + ""))) + (format "%-10s %2d %s %4d%s" + dayname day monthname year weekstring))) + +(defcustom org-agenda-time-leading-zero nil + "Non-nil means use leading zero for military times in agenda. +For example, 9:30am would become 09:30 rather than 9:30." + :group 'org-agenda-daily/weekly + :version "24.1" + :type 'boolean) + +(defcustom org-agenda-timegrid-use-ampm nil + "When set, show AM/PM style timestamps on the timegrid." + :group 'org-agenda + :version "24.1" + :type 'boolean) + +(defun org-agenda-time-of-day-to-ampm (time) + "Convert TIME of a string like '13:45' to an AM/PM style time string." + (let* ((hour-number (string-to-number (substring time 0 -3))) + (minute (substring time -2)) + (ampm "am")) + (cond + ((equal hour-number 12) + (setq ampm "pm")) + ((> hour-number 12) + (setq ampm "pm") + (setq hour-number (- hour-number 12)))) + (concat + (if org-agenda-time-leading-zero + (format "%02d" hour-number) + (format "%02s" (number-to-string hour-number))) + ":" minute ampm))) + +(defun org-agenda-time-of-day-to-ampm-maybe (time) + "Conditionally convert TIME to AM/PM format based on `org-agenda-timegrid-use-ampm'." + (if org-agenda-timegrid-use-ampm + (org-agenda-time-of-day-to-ampm time) + time)) + +(defcustom org-agenda-weekend-days '(6 0) + "Which days are weekend? +These days get the special face `org-agenda-date-weekend' in the agenda +and timeline buffers." + :group 'org-agenda-daily/weekly + :type '(set :greedy t + (const :tag "Monday" 1) + (const :tag "Tuesday" 2) + (const :tag "Wednesday" 3) + (const :tag "Thursday" 4) + (const :tag "Friday" 5) + (const :tag "Saturday" 6) + (const :tag "Sunday" 0))) + +(defcustom org-agenda-move-date-from-past-immediately-to-today t + "Non-nil means jump to today when moving a past date forward in time. +When using S-right in the agenda to move a a date forward, and the date +stamp currently points to the past, the first key press will move it +to today. WHen nil, just move one day forward even if the date stays +in the past." + :group 'org-agenda-daily/weekly + :version "24.1" + :type 'boolean) + +(defcustom org-agenda-include-diary nil + "If non-nil, include in the agenda entries from the Emacs Calendar's diary. +Custom commands can set this variable in the options section." + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-include-deadlines t + "If non-nil, include entries within their deadline warning period. +Custom commands can set this variable in the options section." + :group 'org-agenda-daily/weekly + :version "24.1" + :type 'boolean) + +(defcustom org-agenda-repeating-timestamp-show-all t + "Non-nil means show all occurrences of a repeating stamp in the agenda. +When set to a list of strings, only show occurrences of repeating +stamps for these TODO keywords. When nil, only one occurrence is +shown, either today or the nearest into the future." + :group 'org-agenda-daily/weekly + :type '(choice + (const :tag "Show repeating stamps" t) + (repeat :tag "Show repeating stamps for these TODO keywords" + (string :tag "TODO Keyword")) + (const :tag "Don't show repeating stamps" nil))) + +(defcustom org-scheduled-past-days 10000 + "Number of days to continue listing scheduled items not marked DONE. +When an item is scheduled on a date, it shows up in the agenda on this +day and will be listed until it is marked done for the number of days +given here." + :group 'org-agenda-daily/weekly + :type 'integer) + +(defcustom org-agenda-log-mode-items '(closed clock) + "List of items that should be shown in agenda log mode. +This list may contain the following symbols: + + closed Show entries that have been closed on that day. + clock Show entries that have received clocked time on that day. + state Show all logged state changes. +Note that instead of changing this variable, you can also press `C-u l' in +the agenda to display all available LOG items temporarily." + :group 'org-agenda-daily/weekly + :type '(set :greedy t (const closed) (const clock) (const state))) + +(defcustom org-agenda-clock-consistency-checks + '(:max-duration "10:00" :min-duration 0 :max-gap "0:05" + :gap-ok-around ("4:00") + :default-face ((:background "DarkRed") (:foreground "white")) + :overlap-face nil :gap-face nil :no-end-time-face nil + :long-face nil :short-face nil) + "This is a property list, with the following keys: + +:max-duration Mark clocking chunks that are longer than this time. + This is a time string like \"HH:MM\", or the number + of minutes as an integer. + +:min-duration Mark clocking chunks that are shorter that this. + This is a time string like \"HH:MM\", or the number + of minutes as an integer. + +:max-gap Mark gaps between clocking chunks that are longer than + this duration. A number of minutes, or a string + like \"HH:MM\". + +:gap-ok-around List of times during the day which are usually not working + times. When a gap is detected, but the gap contains any + of these times, the gap is *not* reported. For example, + if this is (\"4:00\" \"13:00\") then gaps that contain + 4:00 in the morning (i.e. the night) and 13:00 + (i.e. a typical lunch time) do not cause a warning. + You should have at least one time during the night in this + list, or otherwise the first task each morning will trigger + a warning because it follows a long gap. + +Furthermore, the following properties can be used to define faces for +issue display. + +:default-face the default face, if the specific face is undefined +:overlap-face face for overlapping clocks +:gap-face face for gaps between clocks +:no-end-time-face face for incomplete clocks +:long-face face for clock intervals that are too long +:short-face face for clock intervals that are too short" + :group 'org-agenda-daily/weekly + :group 'org-clock + :version "24.1" + :type 'plist) + +(defcustom org-agenda-log-mode-add-notes t + "Non-nil means add first line of notes to log entries in agenda views. +If a log item like a state change or a clock entry is associated with +notes, the first line of these notes will be added to the entry in the +agenda display." + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-start-with-log-mode nil + "The initial value of log-mode in a newly created agenda window. +See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further +explanations on the possible values." + :group 'org-agenda-startup + :group 'org-agenda-daily/weekly + :type '(choice (const :tag "Don't show log items" nil) + (const :tag "Show only log items" only) + (const :tag "Show all possible log items" clockcheck) + (repeat :tag "Choose among possible values for `org-agenda-log-mode-items'" + (choice (const :tag "Show closed log items" closed) + (const :tag "Show clocked log items" clock) + (const :tag "Show all logged state changes" state))))) + +(defcustom org-agenda-start-with-clockreport-mode nil + "The initial value of clockreport-mode in a newly created agenda window." + :group 'org-agenda-startup + :group 'org-agenda-daily/weekly + :type 'boolean) + +(defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2) + "Property list with parameters for the clocktable in clockreport mode. +This is the display mode that shows a clock table in the daily/weekly +agenda, the properties for this dynamic block can be set here. +The usual clocktable parameters are allowed here, but you cannot set +the properties :name, :tstart, :tend, :block, and :scope - these will +be overwritten to make sure the content accurately reflects the +current display in the agenda." + :group 'org-agenda-daily/weekly + :type 'plist) + +(defcustom org-agenda-search-view-always-boolean nil + "Non-nil means the search string is interpreted as individual parts. + +The search string for search view can either be interpreted as a phrase, +or as a list of snippets that define a boolean search for a number of +strings. + +When this is non-nil, the string will be split on whitespace, and each +snippet will be searched individually, and all must match in order to +select an entry. A snippet is then a single string of non-white +characters, or a string in double quotes, or a regexp in {} braces. +If a snippet is preceded by \"-\", the snippet must *not* match. +\"+\" is syntactic sugar for positive selection. Each snippet may +be found as a full word or a partial word, but see the variable +`org-agenda-search-view-force-full-words'. + +When this is nil, search will look for the entire search phrase as one, +with each space character matching any amount of whitespace, including +line breaks. + +Even when this is nil, you can still switch to Boolean search dynamically +by preceding the first snippet with \"+\" or \"-\". If the first snippet +is a regexp marked with braces like \"{abc}\", this will also switch to +boolean search." + :group 'org-agenda-search-view + :version "24.1" + :type 'boolean) + +(org-defvaralias 'org-agenda-search-view-search-words-only + 'org-agenda-search-view-always-boolean) + +(defcustom org-agenda-search-view-force-full-words nil + "Non-nil means, search words must be matches as complete words. +When nil, they may also match part of a word." + :group 'org-agenda-search-view + :version "24.1" + :type 'boolean) + +(defcustom org-agenda-search-view-max-outline-level 0 + "Maximum outline level to display in search view. +E.g. when this is set to 1, the search view will only +show headlines of level 1. When set to 0, the default +value, don't limit agenda view by outline level." + :group 'org-agenda-search-view + :version "24.4" + :package-version '(Org . "8.3") + :type 'integer) + +(defgroup org-agenda-time-grid nil + "Options concerning the time grid in the Org-mode Agenda." + :tag "Org Agenda Time Grid" + :group 'org-agenda) + +(defcustom org-agenda-search-headline-for-time t + "Non-nil means search headline for a time-of-day. +If the headline contains a time-of-day in one format or another, it will +be used to sort the entry into the time sequence of items for a day. +Some people have time stamps in the headline that refer to the creation +time or so, and then this produces an unwanted side effect. If this is +the case for your, use this variable to turn off searching the headline +for a time." + :group 'org-agenda-time-grid + :type 'boolean) + +(defcustom org-agenda-use-time-grid t + "Non-nil means show a time grid in the agenda schedule. +A time grid is a set of lines for specific times (like every two hours between +8:00 and 20:00). The items scheduled for a day at specific times are +sorted in between these lines. +For details about when the grid will be shown, and what it will look like, see +the variable `org-agenda-time-grid'." + :group 'org-agenda-time-grid + :type 'boolean) + +(defcustom org-agenda-time-grid + '((daily today require-timed) + "----------------" + (800 1000 1200 1400 1600 1800 2000)) + + "The settings for time grid for agenda display. +This is a list of three items. The first item is again a list. It contains +symbols specifying conditions when the grid should be displayed: + + daily if the agenda shows a single day + weekly if the agenda shows an entire week + today show grid on current date, independent of daily/weekly display + require-timed show grid only if at least one item has a time specification + remove-match skip grid times already present in an entry + +The second item is a string which will be placed behind the grid time. + +The third item is a list of integers, indicating the times that should have +a grid line." + :group 'org-agenda-time-grid + :type + '(list + (set :greedy t :tag "Grid Display Options" + (const :tag "Show grid in single day agenda display" daily) + (const :tag "Show grid in weekly agenda display" weekly) + (const :tag "Always show grid for today" today) + (const :tag "Show grid only if any timed entries are present" + require-timed) + (const :tag "Skip grid times already present in an entry" + remove-match)) + (string :tag "Grid String") + (repeat :tag "Grid Times" (integer :tag "Time")))) + +(defcustom org-agenda-show-current-time-in-grid t + "Non-nil means show the current time in the time grid." + :group 'org-agenda-time-grid + :version "24.1" + :type 'boolean) + +(defcustom org-agenda-current-time-string + "now - - - - - - - - - - - - - - - - - - - - - - - - -" + "The string for the current time marker in the agenda." + :group 'org-agenda-time-grid + :version "24.1" + :type 'string) + +(defgroup org-agenda-sorting nil + "Options concerning sorting in the Org-mode Agenda." + :tag "Org Agenda Sorting" + :group 'org-agenda) + +(defcustom org-agenda-sorting-strategy + '((agenda habit-down time-up priority-down category-keep) + (todo priority-down category-keep) + (tags priority-down category-keep) + (search category-keep)) + "Sorting structure for the agenda items of a single day. +This is a list of symbols which will be used in sequence to determine +if an entry should be listed before another entry. The following +symbols are recognized: + +time-up Put entries with time-of-day indications first, early first +time-down Put entries with time-of-day indications first, late first +timestamp-up Sort by any timestamp, early first +timestamp-down Sort by any timestamp, late first +scheduled-up Sort by scheduled timestamp, early first +scheduled-down Sort by scheduled timestamp, late first +deadline-up Sort by deadline timestamp, early first +deadline-down Sort by deadline timestamp, late first +ts-up Sort by active timestamp, early first +ts-down Sort by active timestamp, late first +tsia-up Sort by inactive timestamp, early first +tsia-down Sort by inactive timestamp, late first +category-keep Keep the default order of categories, corresponding to the + sequence in `org-agenda-files'. +category-up Sort alphabetically by category, A-Z. +category-down Sort alphabetically by category, Z-A. +tag-up Sort alphabetically by last tag, A-Z. +tag-down Sort alphabetically by last tag, Z-A. +priority-up Sort numerically by priority, high priority last. +priority-down Sort numerically by priority, high priority first. +todo-state-up Sort by todo state, tasks that are done last. +todo-state-down Sort by todo state, tasks that are done first. +effort-up Sort numerically by estimated effort, high effort last. +effort-down Sort numerically by estimated effort, high effort first. +user-defined-up Sort according to `org-agenda-cmp-user-defined', high last. +user-defined-down Sort according to `org-agenda-cmp-user-defined', high first. +habit-up Put entries that are habits first +habit-down Put entries that are habits last +alpha-up Sort headlines alphabetically +alpha-down Sort headlines alphabetically, reversed + +The different possibilities will be tried in sequence, and testing stops +if one comparison returns a \"not-equal\". For example, the default + '(time-up category-keep priority-down) +means: Pull out all entries having a specified time of day and sort them, +in order to make a time schedule for the current day the first thing in the +agenda listing for the day. Of the entries without a time indication, keep +the grouped in categories, don't sort the categories, but keep them in +the sequence given in `org-agenda-files'. Within each category sort by +priority. + +Leaving out `category-keep' would mean that items will be sorted across +categories by priority. + +Instead of a single list, this can also be a set of list for specific +contents, with a context symbol in the car of the list, any of +`agenda', `todo', `tags', `search' for the corresponding agenda views. + +Custom commands can bind this variable in the options section." + :group 'org-agenda-sorting + :type `(choice + (repeat :tag "General" ,org-sorting-choice) + (list :tag "Individually" + (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) + (repeat ,org-sorting-choice)) + (cons (const :tag "Strategy for TODO lists" todo) + (repeat ,org-sorting-choice)) + (cons (const :tag "Strategy for Tags matches" tags) + (repeat ,org-sorting-choice)) + (cons (const :tag "Strategy for search matches" search) + (repeat ,org-sorting-choice))))) + +(defcustom org-agenda-cmp-user-defined nil + "A function to define the comparison `user-defined'. +This function must receive two arguments, agenda entry a and b. +If a>b, return +1. If a effort operator. Then, tasks with no effort defined will be treated +as tasks with high effort. +When nil, such items are sorted as 0 minutes effort." + :group 'org-agenda-sorting + :type 'boolean) + +(defgroup org-agenda-line-format nil + "Options concerning the entry prefix in the Org-mode agenda display." + :tag "Org Agenda Line Format" + :group 'org-agenda) + +(defcustom org-agenda-prefix-format + '((agenda . " %i %-12:c%?-12t% s") + (timeline . " % s") + (todo . " %i %-12:c") + (tags . " %i %-12:c") + (search . " %i %-12:c")) + "Format specifications for the prefix of items in the agenda views. +An alist with five entries, each for the different agenda types. The +keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'. +The values are format strings. + +This format works similar to a printf format, with the following meaning: + + %c the category of the item, \"Diary\" for entries from the diary, + or as given by the CATEGORY keyword or derived from the file name + %e the effort required by the item + %l the level of the item (insert X space(s) if item is of level X) + %i the icon category of the item, see `org-agenda-category-icon-alist' + %T the last tag of the item (ignore inherited tags, which come first) + %t the HH:MM time-of-day specification if one applies to the entry + %s Scheduling/Deadline information, a short string + %b show breadcrumbs, i.e., the names of the higher levels + %(expression) Eval EXPRESSION and replace the control string + by the result + +All specifiers work basically like the standard `%s' of printf, but may +contain two additional characters: a question mark just after the `%' +and a whitespace/punctuation character just before the final letter. + +If the first character after `%' is a question mark, the entire field +will only be included if the corresponding value applies to the current +entry. This is useful for fields which should have fixed width when +present, but zero width when absent. For example, \"%?-12t\" will +result in a 12 character time field if a time of the day is specified, +but will completely disappear in entries which do not contain a time. + +If there is punctuation or whitespace character just before the +final format letter, this character will be appended to the field +value if the value is not empty. For example, the format +\"%-12:c\" leads to \"Diary: \" if the category is \"Diary\". If +the category is empty, no additional colon is inserted. + +The default value for the agenda sublist is \" %-12:c%?-12t% s\", +which means: + +- Indent the line with two space characters +- Give the category a 12 chars wide field, padded with whitespace on + the right (because of `-'). Append a colon if there is a category + (because of `:'). +- If there is a time-of-day, put it into a 12 chars wide field. If no + time, don't put in an empty field, just skip it (because of '?'). +- Finally, put the scheduling information. + +See also the variables `org-agenda-remove-times-when-in-prefix' and +`org-agenda-remove-tags'. + +Custom commands can set this variable in the options section." + :type '(choice + (string :tag "General format") + (list :greedy t :tag "View dependent" + (cons (const agenda) (string :tag "Format")) + (cons (const timeline) (string :tag "Format")) + (cons (const todo) (string :tag "Format")) + (cons (const tags) (string :tag "Format")) + (cons (const search) (string :tag "Format")))) + :group 'org-agenda-line-format) + +(defvar org-prefix-format-compiled nil + "The compiled prefix format and associated variables. +This is a list where first element is a list of variable bindings, and second +element is the compiled format expression. See the variable +`org-agenda-prefix-format'.") + +(defcustom org-agenda-todo-keyword-format "%-1s" + "Format for the TODO keyword in agenda lines. +Set this to something like \"%-12s\" if you want all TODO keywords +to occupy a fixed space in the agenda display." + :group 'org-agenda-line-format + :type 'string) + +(defcustom org-agenda-diary-sexp-prefix nil + "A regexp that matches part of a diary sexp entry +which should be treated as scheduling/deadline information in +`org-agenda'. + +For example, you can use this to extract the `diary-remind-message' from +`diary-remind' entries." + :group 'org-agenda-line-format + :type '(choice (const :tag "None" nil) (regexp :tag "Regexp"))) + +(defcustom org-agenda-timerange-leaders '("" "(%d/%d): ") + "Text preceding timerange entries in the agenda view. +This is a list with two strings. The first applies when the range +is entirely on one day. The second applies if the range spans several days. +The strings may have two \"%d\" format specifiers which will be filled +with the sequence number of the days, and the total number of days in the +range, respectively." + :group 'org-agenda-line-format + :type '(list + (string :tag "Deadline today ") + (choice :tag "Deadline relative" + (string :tag "Format string") + (function)))) + +(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") + "Text preceding scheduled items in the agenda view. +This is a list with two strings. The first applies when the item is +scheduled on the current day. The second applies when it has been scheduled +previously, it may contain a %d indicating that this is the nth time that +this item is scheduled, due to automatic rescheduling of unfinished items +for the following day. So this number is one larger than the number of days +that passed since this item was scheduled first." + :group 'org-agenda-line-format + :version "24.4" + :package-version '(Org . "8.0") + :type '(list + (string :tag "Scheduled today ") + (string :tag "Scheduled previously"))) + +(defcustom org-agenda-inactive-leader "[" + "Text preceding item pulled into the agenda by inactive time stamps. +These entries are added to the agenda when pressing \"[\"." + :group 'org-agenda-line-format + :version "24.1" + :type 'string) + +(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: " "%2d d. ago: ") + "Text preceding deadline items in the agenda view. +This is a list with three strings. The first applies when the item has its +deadline on the current day. The second applies when the deadline is in the +future, the third one when it is in the past. The strings may contain %d +to capture the number of days." + :group 'org-agenda-line-format + :version "24.4" + :package-version '(Org . "8.0") + :type '(list + (string :tag "Deadline today ") + (string :tag "Deadline in the future ") + (string :tag "Deadline in the past "))) + +(defcustom org-agenda-remove-times-when-in-prefix t + "Non-nil means remove duplicate time specifications in agenda items. +When the format `org-agenda-prefix-format' contains a `%t' specifier, a +time-of-day specification in a headline or diary entry is extracted and +placed into the prefix. If this option is non-nil, the original specification +\(a timestamp or -range, or just a plain time(range) specification like +11:30-4pm) will be removed for agenda display. This makes the agenda less +cluttered. +The option can be t or nil. It may also be the symbol `beg', indicating +that the time should only be removed when it is located at the beginning of +the headline/diary entry." + :group 'org-agenda-line-format + :type '(choice + (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "When at beginning of entry" beg))) + +(defcustom org-agenda-remove-timeranges-from-blocks nil + "Non-nil means remove time ranges specifications in agenda +items that span on several days." + :group 'org-agenda-line-format + :version "24.1" + :type 'boolean) + +(defcustom org-agenda-default-appointment-duration nil + "Default duration for appointments that only have a starting time. +When nil, no duration is specified in such cases. +When non-nil, this must be the number of minutes, e.g. 60 for one hour." + :group 'org-agenda-line-format + :type '(choice + (integer :tag "Minutes") + (const :tag "No default duration"))) + +(defcustom org-agenda-show-inherited-tags t + "Non-nil means show inherited tags in each agenda line. + +When this option is set to 'always, it take precedences over +`org-agenda-use-tag-inheritance' and inherited tags are shown +in every agenda. + +When this option is set to t (the default), inherited tags are +shown when they are available, i.e. when the value of +`org-agenda-use-tag-inheritance' has been taken into account. + +This can be set to a list of agenda types in which the agenda +must display the inherited tags. Available types are 'todo, +'agenda, 'search and 'timeline. + +When set to nil, never show inherited tags in agenda lines." + :group 'org-agenda-line-format + :group 'org-agenda + :version "24.3" + :type '(choice + (const :tag "Show inherited tags when available" t) + (const :tag "Always show inherited tags" always) + (repeat :tag "Show inherited tags only in selected agenda types" + (symbol :tag "Agenda type")))) + +(defcustom org-agenda-use-tag-inheritance '(todo search timeline agenda) + "List of agenda view types where to use tag inheritance. + +In tags/tags-todo/tags-tree agenda views, tag inheritance is +controlled by `org-use-tag-inheritance'. In other agenda types, +`org-use-tag-inheritance' is not used for the selection of the +agenda entries. Still, you may want the agenda to be aware of +the inherited tags anyway, e.g. for later tag filtering. + +Allowed value are 'todo, 'search, 'timeline and 'agenda. + +This variable has no effect if `org-agenda-show-inherited-tags' +is set to 'always. In that case, the agenda is aware of those +tags. + +The default value sets tags in every agenda type. Setting this +option to nil will speed up non-tags agenda view a lot." + :group 'org-agenda + :version "24.3" + :type '(choice + (const :tag "Use tag inheritance in all agenda types" t) + (repeat :tag "Use tag inheritance in selected agenda types" + (symbol :tag "Agenda type")))) + +(defcustom org-agenda-hide-tags-regexp nil + "Regular expression used to filter away specific tags in agenda views. +This means that these tags will be present, but not be shown in the agenda +line. Secondary filtering will still work on the hidden tags. +Nil means don't hide any tags." + :group 'org-agenda-line-format + :type '(choice + (const :tag "Hide none" nil) + (string :tag "Regexp "))) + +(defcustom org-agenda-remove-tags nil + "Non-nil means remove the tags from the headline copy in the agenda. +When this is the symbol `prefix', only remove tags when +`org-agenda-prefix-format' contains a `%T' specifier." + :group 'org-agenda-line-format + :type '(choice + (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "When prefix format contains %T" prefix))) + +(org-defvaralias 'org-agenda-remove-tags-when-in-prefix + 'org-agenda-remove-tags) + +(defcustom org-agenda-tags-column (if (featurep 'xemacs) -79 -80) + "Shift tags in agenda items to this column. +If this number is positive, it specifies the column. If it is negative, +it means that the tags should be flushright to that column. For example, +-80 works well for a normal 80 character screen." + :group 'org-agenda-line-format + :type 'integer) + +(org-defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column) + +(defcustom org-agenda-fontify-priorities 'cookies + "Non-nil means highlight low and high priorities in agenda. +When t, the highest priority entries are bold, lowest priority italic. +However, settings in `org-priority-faces' will overrule these faces. +When this variable is the symbol `cookies', only fontify the +cookies, not the entire task. +This may also be an association list of priority faces, whose +keys are the character values of `org-highest-priority', +`org-default-priority', and `org-lowest-priority' (the default values +are ?A, ?B, and ?C, respectively). The face may be a named face, a +color as a string, or a list like `(:background \"Red\")'. +If it is a color, the variable `org-faces-easy-properties' +determines if it is a foreground or a background color." + :group 'org-agenda-line-format + :type '(choice + (const :tag "Never" nil) + (const :tag "Defaults" t) + (const :tag "Cookies only" cookies) + (repeat :tag "Specify" + (list (character :tag "Priority" :value ?A) + (choice :tag "Face " + (string :tag "Color") + (sexp :tag "Face")))))) + +(defcustom org-agenda-day-face-function nil + "Function called to determine what face should be used to display a day. +The only argument passed to that function is the day. It should +returns a face, or nil if does not want to specify a face and let +the normal rules apply." + :group 'org-agenda-line-format + :version "24.1" + :type '(choice (const nil) (function))) + +(defcustom org-agenda-category-icon-alist nil + "Alist of category icon to be displayed in agenda views. + +Each entry should have the following format: + + (CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS) + +Where CATEGORY-REGEXP is a regexp matching the categories where +the icon should be displayed. +FILE-OR-DATA either a file path or a string containing image data. + +The other fields can be omitted safely if not needed: +TYPE indicates the image type. +DATA-P is a boolean indicating whether the FILE-OR-DATA string is +image data. +PROPS are additional image attributes to assign to the image, +like, e.g. `:ascent center'. + + (\"Org\" \"/path/to/icon.png\" nil nil :ascent center) + +If you want to set the display properties yourself, just put a +list as second element: + + (CATEGORY-REGEXP (MY PROPERTY LIST)) + +For example, to display a 16px horizontal space for Emacs +category, you can use: + + (\"Emacs\" '(space . (:width (16))))" + :group 'org-agenda-line-format + :version "24.1" + :type '(alist :key-type (string :tag "Regexp matching category") + :value-type (choice (list :tag "Icon" + (string :tag "File or data") + (symbol :tag "Type") + (boolean :tag "Data?") + (repeat :tag "Extra image properties" :inline t symbol)) + (list :tag "Display properties" sexp)))) + +(defgroup org-agenda-column-view nil + "Options concerning column view in the agenda." + :tag "Org Agenda Column View" + :group 'org-agenda) + +(defcustom org-agenda-columns-show-summaries t + "Non-nil means show summaries for columns displayed in the agenda view." + :group 'org-agenda-column-view + :type 'boolean) + +(defcustom org-agenda-columns-compute-summary-properties t + "Non-nil means recompute all summary properties before column view. +When column view in the agenda is listing properties that have a summary +operator, it can go to all relevant buffers and recompute the summaries +there. This can mean overhead for the agenda column view, but is necessary +to have thing up to date. +As a special case, a CLOCKSUM property also makes sure that the clock +computations are current." + :group 'org-agenda-column-view + :type 'boolean) + +(defcustom org-agenda-columns-add-appointments-to-effort-sum nil + "Non-nil means the duration of an appointment will add to day effort. +The property to which appointment durations will be added is the one given +in the option `org-effort-property'. If an appointment does not have +an end time, `org-agenda-default-appointment-duration' will be used. If that +is not set, an appointment without end time will not contribute to the time +estimate." + :group 'org-agenda-column-view + :type 'boolean) + +(defcustom org-agenda-auto-exclude-function nil + "A function called with a tag to decide if it is filtered on '/ RET'. +The sole argument to the function, which is called once for each +possible tag, is a string giving the name of the tag. The +function should return either nil if the tag should be included +as normal, or \"-\" to exclude the tag. +Note that for the purpose of tag filtering, only the lower-case version of +all tags will be considered, so that this function will only ever see +the lower-case version of all tags." + :group 'org-agenda + :type '(choice (const nil) (function))) + +(defcustom org-agenda-bulk-custom-functions nil + "Alist of characters and custom functions for bulk actions. +For example, this value makes those two functions available: + + '((?R set-category) + (?C bulk-cut)) + +With selected entries in an agenda buffer, `B R' will call +the custom function `set-category' on the selected entries. +Note that functions in this alist don't need to be quoted." + :type 'alist + :version "24.1" + :group 'org-agenda) + +(defmacro org-agenda-with-point-at-orig-entry (string &rest body) + "Execute BODY with point at location given by `org-hd-marker' property. +If STRING is non-nil, the text property will be fetched from position 0 +in that string. If STRING is nil, it will be fetched from the beginning +of the current line." + (org-with-gensyms (marker) + `(let ((,marker (get-text-property (if string 0 (point-at-bol)) + 'org-hd-marker ,string))) + (with-current-buffer (marker-buffer ,marker) + (save-excursion + (goto-char ,marker) + ,@body))))) +(def-edebug-spec org-agenda-with-point-at-orig-entry (form body)) + +(defun org-add-agenda-custom-command (entry) + "Replace or add a command in `org-agenda-custom-commands'. +This is mostly for hacking and trying a new command - once the command +works you probably want to add it to `org-agenda-custom-commands' for good." + (let ((ass (assoc (car entry) org-agenda-custom-commands))) + (if ass + (setcdr ass (cdr entry)) + (push entry org-agenda-custom-commands)))) + +;;; Define the org-agenda-mode + +(defvar org-agenda-mode-map (make-sparse-keymap) + "Keymap for `org-agenda-mode'.") +(org-defvaralias 'org-agenda-keymap 'org-agenda-mode-map) + +(defvar org-agenda-menu) ; defined later in this file. +(defvar org-agenda-restrict nil) ; defined later in this file. +(defvar org-agenda-follow-mode nil) +(defvar org-agenda-entry-text-mode nil) +(defvar org-agenda-clockreport-mode nil) +(defvar org-agenda-show-log nil) +(defvar org-agenda-redo-command nil) +(defvar org-agenda-query-string nil) +(defvar org-agenda-mode-hook nil + "Hook run after `org-agenda-mode' is turned on. +The buffer is still writable when this hook is called.") +(defvar org-agenda-type nil) +(defvar org-agenda-force-single-file nil) +(defvar org-agenda-bulk-marked-entries nil + "List of markers that refer to marked entries in the agenda.") + +;;; Multiple agenda buffers support + +(defcustom org-agenda-sticky nil + "Non-nil means agenda q key will bury agenda buffers. +Agenda commands will then show existing buffer instead of generating new ones. +When nil, `q' will kill the single agenda buffer." + :group 'org-agenda + :version "24.3" + :type 'boolean) + + +;;;###autoload +(defun org-toggle-sticky-agenda (&optional arg) + "Toggle `org-agenda-sticky'." + (interactive "P") + (let ((new-value (if arg + (> (prefix-numeric-value arg) 0) + (not org-agenda-sticky)))) + (if (equal new-value org-agenda-sticky) + (and (org-called-interactively-p 'interactive) + (message "Sticky agenda was already %s" + (if org-agenda-sticky "enabled" "disabled"))) + (setq org-agenda-sticky new-value) + (org-agenda-kill-all-agenda-buffers) + (and (org-called-interactively-p 'interactive) + (message "Sticky agenda was %s" + (if org-agenda-sticky "enabled" "disabled")))))) + +(defvar org-agenda-buffer nil + "Agenda buffer currently being generated.") + +(defvar org-agenda-last-prefix-arg nil) +(defvar org-agenda-this-buffer-name nil) +(defvar org-agenda-doing-sticky-redo nil) +(defvar org-agenda-this-buffer-is-sticky nil) + +(defconst org-agenda-local-vars + '(org-agenda-this-buffer-name + org-agenda-undo-list + org-agenda-pending-undo-list + org-agenda-follow-mode + org-agenda-entry-text-mode + org-agenda-clockreport-mode + org-agenda-show-log + org-agenda-redo-command + org-agenda-query-string + org-agenda-type + org-agenda-bulk-marked-entries + org-agenda-undo-has-started-in + org-agenda-info + org-agenda-pre-window-conf + org-agenda-columns-active + org-agenda-tag-filter + org-agenda-category-filter + org-agenda-top-headline-filter + org-agenda-regexp-filter + org-agenda-markers + org-agenda-last-search-view-search-was-boolean + org-agenda-filtered-by-category + org-agenda-filter-form + org-agenda-cycle-counter + org-agenda-last-prefix-arg) + "Variables that must be local in agenda buffers to allow multiple buffers.") + +(defun org-agenda-mode () + "Mode for time-sorted view on action items in Org-mode files. + +The following commands are available: + +\\{org-agenda-mode-map}" + (interactive) + (cond (org-agenda-doing-sticky-redo + ;; Refreshing sticky agenda-buffer + ;; + ;; Preserve the value of `org-agenda-local-vars' variables, + ;; while letting `kill-all-local-variables' kill the rest + (let ((save (buffer-local-variables))) + (kill-all-local-variables) + (mapc 'make-local-variable org-agenda-local-vars) + (dolist (elem save) + (let ((var (car elem)) + (val (cdr elem))) + (when (and val + (member var org-agenda-local-vars)) + (set var val))))) + (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t)) + (org-agenda-sticky + ;; Creating a sticky Agenda buffer for the first time + (kill-all-local-variables) + (mapc 'make-local-variable org-agenda-local-vars) + (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t)) + (t + ;; Creating a non-sticky agenda buffer + (kill-all-local-variables) + (set (make-local-variable 'org-agenda-this-buffer-is-sticky) nil))) + (setq org-agenda-undo-list nil + org-agenda-pending-undo-list nil + org-agenda-bulk-marked-entries nil) + (setq major-mode 'org-agenda-mode) + ;; Keep global-font-lock-mode from turning on font-lock-mode + (org-set-local 'font-lock-global-modes (list 'not major-mode)) + (setq mode-name "Org-Agenda") + (setq indent-tabs-mode nil) + (use-local-map org-agenda-mode-map) + (easy-menu-add org-agenda-menu) + (if org-startup-truncated (setq truncate-lines t)) + (org-set-local 'line-move-visual nil) + (org-add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local) + (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) + ;; Make sure properties are removed when copying text + (org-add-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (substring-no-properties (funcall fun start end delete))) + nil t) + (unless org-agenda-keep-modes + (setq org-agenda-follow-mode org-agenda-start-with-follow-mode + org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode)) + (setq org-agenda-show-log org-agenda-start-with-log-mode) + (setq org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode) + (add-to-invisibility-spec '(org-filtered)) + (add-to-invisibility-spec '(org-link)) + (easy-menu-change + '("Agenda") "Agenda Files" + (append + (list + (vector + (if (get 'org-agenda-files 'org-restrict) + "Restricted to single file" + "Edit File List") + '(org-edit-agenda-file-list) + (not (get 'org-agenda-files 'org-restrict))) + "--") + (mapcar 'org-file-menu-entry (org-agenda-files)))) + (org-agenda-set-mode-name) + (apply + (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks) + (list 'org-agenda-mode-hook))) + +(substitute-key-definition 'undo 'org-agenda-undo + org-agenda-mode-map global-map) +(org-defkey org-agenda-mode-map "\C-i" 'org-agenda-goto) +(org-defkey org-agenda-mode-map [(tab)] 'org-agenda-goto) +(org-defkey org-agenda-mode-map "\C-m" 'org-agenda-switch-to) +(org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill) +(org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile) +(org-defkey org-agenda-mode-map [(meta down)] 'org-agenda-drag-line-forward) +(org-defkey org-agenda-mode-map [(meta up)] 'org-agenda-drag-line-backward) +(org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark) +(org-defkey org-agenda-mode-map "\M-m" 'org-agenda-bulk-toggle) +(org-defkey org-agenda-mode-map "*" 'org-agenda-bulk-mark-all) +(org-defkey org-agenda-mode-map "\M-*" 'org-agenda-bulk-toggle-all) +(org-defkey org-agenda-mode-map "#" 'org-agenda-dim-blocked-tasks) +(org-defkey org-agenda-mode-map "%" 'org-agenda-bulk-mark-regexp) +(org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark) +(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-unmark-all) +(org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action) +(org-defkey org-agenda-mode-map "k" 'org-agenda-capture) +(org-defkey org-agenda-mode-map "A" 'org-agenda-append-agenda) +(org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-a" 'org-agenda-archive-default) +(org-defkey org-agenda-mode-map "\C-c\C-xa" 'org-agenda-toggle-archive-tag) +(org-defkey org-agenda-mode-map "\C-c\C-xA" 'org-agenda-archive-to-archive-sibling) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive) +(org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive) +(org-defkey org-agenda-mode-map "$" 'org-agenda-archive) +(org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link) +(org-defkey org-agenda-mode-map " " 'org-agenda-show-and-scroll-up) +(org-defkey org-agenda-mode-map [backspace] 'org-agenda-show-scroll-down) +(org-defkey org-agenda-mode-map "\d" 'org-agenda-show-scroll-down) +(org-defkey org-agenda-mode-map [(control shift right)] 'org-agenda-todo-nextset) +(org-defkey org-agenda-mode-map [(control shift left)] 'org-agenda-todo-previousset) +(org-defkey org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer) +(org-defkey org-agenda-mode-map "o" 'delete-other-windows) +(org-defkey org-agenda-mode-map "L" 'org-agenda-recenter) +(org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) +(org-defkey org-agenda-mode-map "t" 'org-agenda-todo) +(org-defkey org-agenda-mode-map "a" 'org-agenda-archive-default-with-confirmation) +(org-defkey org-agenda-mode-map ":" 'org-agenda-set-tags) +(org-defkey org-agenda-mode-map "\C-c\C-q" 'org-agenda-set-tags) +(org-defkey org-agenda-mode-map "." 'org-agenda-goto-today) +(org-defkey org-agenda-mode-map "j" 'org-agenda-goto-date) +(org-defkey org-agenda-mode-map "d" 'org-agenda-day-view) +(org-defkey org-agenda-mode-map "w" 'org-agenda-week-view) +(org-defkey org-agenda-mode-map "y" 'org-agenda-year-view) +(org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note) +(org-defkey org-agenda-mode-map "z" 'org-agenda-add-note) +(org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later) +(org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier) +(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later) +(org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-do-date-earlier) + +(org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt) +(org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule) +(org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline) +(let ((l '(1 2 3 4 5 6 7 8 9 0))) + (while l (org-defkey org-agenda-mode-map + (int-to-string (pop l)) 'digit-argument))) + +(org-defkey org-agenda-mode-map "F" 'org-agenda-follow-mode) +(org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode) +(org-defkey org-agenda-mode-map "E" 'org-agenda-entry-text-mode) +(org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) +(org-defkey org-agenda-mode-map "v" 'org-agenda-view-mode-dispatch) +(org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary) +(org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines) +(org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid) +(org-defkey org-agenda-mode-map "r" 'org-agenda-redo) +(org-defkey org-agenda-mode-map "g" (lambda () (interactive) (org-agenda-redo t))) +(org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort) +(org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-e" + 'org-clock-modify-effort-estimate) +(org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property) +(org-defkey org-agenda-mode-map "q" 'org-agenda-quit) +(org-defkey org-agenda-mode-map "Q" 'org-agenda-Quit) +(org-defkey org-agenda-mode-map "x" 'org-agenda-exit) +(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write) +(org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers) +(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers) +(org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags) +(org-defkey org-agenda-mode-map "n" 'org-agenda-next-line) +(org-defkey org-agenda-mode-map "p" 'org-agenda-previous-line) +(org-defkey org-agenda-mode-map "N" 'org-agenda-next-item) +(org-defkey org-agenda-mode-map "P" 'org-agenda-previous-item) +(substitute-key-definition 'next-line 'org-agenda-next-line + org-agenda-mode-map global-map) +(substitute-key-definition 'previous-line 'org-agenda-previous-line + org-agenda-mode-map global-map) +(org-defkey org-agenda-mode-map "\C-c\C-a" 'org-attach) +(org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line) +(org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line) +(org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority) +(org-defkey org-agenda-mode-map "," 'org-agenda-priority) +(org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry) +(org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar) +(org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date) +(org-defkey org-agenda-mode-map "M" 'org-agenda-phases-of-moon) +(org-defkey org-agenda-mode-map "S" 'org-agenda-sunrise-sunset) +(org-defkey org-agenda-mode-map "h" 'org-agenda-holidays) +(org-defkey org-agenda-mode-map "H" 'org-agenda-holidays) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-i" 'org-agenda-clock-in) +(org-defkey org-agenda-mode-map "I" 'org-agenda-clock-in) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-o" 'org-agenda-clock-out) +(org-defkey org-agenda-mode-map "O" 'org-agenda-clock-out) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel) +(org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto) +(org-defkey org-agenda-mode-map "J" 'org-agenda-clock-goto) +(org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up) +(org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down) +(org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up) +(org-defkey org-agenda-mode-map [(shift down)] 'org-agenda-priority-down) +(org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up) +(org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down) +(org-defkey org-agenda-mode-map "f" 'org-agenda-later) +(org-defkey org-agenda-mode-map "b" 'org-agenda-earlier) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) +(org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) + +(org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add) +(org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract) +(org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re) +(org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re) +(org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag) +(org-defkey org-agenda-mode-map "=" 'org-agenda-filter-by-regexp) +(org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all) +(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine) +(org-defkey org-agenda-mode-map "~" 'org-agenda-limit-interactively) +(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category) +(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline) +(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer) +(define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) +(org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) + +(org-defkey org-agenda-mode-map [mouse-2] 'org-agenda-goto-mouse) +(org-defkey org-agenda-mode-map [mouse-3] 'org-agenda-show-mouse) +(when org-agenda-mouse-1-follows-link + (org-defkey org-agenda-mode-map [follow-link] 'mouse-face)) +(easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu" + '("Agenda" + ("Agenda Files") + "--" + ("Agenda Dates" + ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)] + ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)] + ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)] + ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)]) + "--" + ("View" + ["Day View" org-agenda-day-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (eq org-agenda-current-span 'day) + :keys "v d (or just d)"] + ["Week View" org-agenda-week-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (eq org-agenda-current-span 'week) + :keys "v w"] + ["Fortnight View" org-agenda-fortnight-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (eq org-agenda-current-span 'fortnight) + :keys "v f"] + ["Month View" org-agenda-month-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (eq org-agenda-current-span 'month) + :keys "v m"] + ["Year View" org-agenda-year-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (eq org-agenda-current-span 'year) + :keys "v y"] + "--" + ["Include Diary" org-agenda-toggle-diary + :style toggle :selected org-agenda-include-diary + :active (org-agenda-check-type nil 'agenda)] + ["Include Deadlines" org-agenda-toggle-deadlines + :style toggle :selected org-agenda-include-deadlines + :active (org-agenda-check-type nil 'agenda)] + ["Use Time Grid" org-agenda-toggle-time-grid + :style toggle :selected org-agenda-use-time-grid + :active (org-agenda-check-type nil 'agenda)] + "--" + ["Show clock report" org-agenda-clockreport-mode + :style toggle :selected org-agenda-clockreport-mode + :active (org-agenda-check-type nil 'agenda)] + ["Show some entry text" org-agenda-entry-text-mode + :style toggle :selected org-agenda-entry-text-mode + :active t] + "--" + ["Show Logbook entries" org-agenda-log-mode + :style toggle :selected org-agenda-show-log + :active (org-agenda-check-type nil 'agenda 'timeline) + :keys "v l (or just l)"] + ["Include archived trees" org-agenda-archives-mode + :style toggle :selected org-agenda-archives-mode :active t + :keys "v a"] + ["Include archive files" (org-agenda-archives-mode t) + :style toggle :selected (eq org-agenda-archives-mode t) :active t + :keys "v A"] + "--" + ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict]) + ["Write view to file" org-agenda-write t] + ["Rebuild buffer" org-agenda-redo t] + ["Save all Org-mode Buffers" org-save-all-org-buffers t] + "--" + ["Show original entry" org-agenda-show t] + ["Go To (other window)" org-agenda-goto t] + ["Go To (this window)" org-agenda-switch-to t] + ["Capture with cursor date" org-agenda-capture t] + ["Follow Mode" org-agenda-follow-mode + :style toggle :selected org-agenda-follow-mode :active t] + ;; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] + "--" + ("TODO" + ["Cycle TODO" org-agenda-todo t] + ["Next TODO set" org-agenda-todo-nextset t] + ["Previous TODO set" org-agenda-todo-previousset t] + ["Add note" org-agenda-add-note t]) + ("Archive/Refile/Delete" + ["Archive default" org-agenda-archive-default t] + ["Archive default" org-agenda-archive-default-with-confirmation t] + ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t] + ["Move to archive sibling" org-agenda-archive-to-archive-sibling t] + ["Archive subtree" org-agenda-archive t] + "--" + ["Refile" org-agenda-refile t] + "--" + ["Delete subtree" org-agenda-kill t]) + ("Bulk action" + ["Mark entry" org-agenda-bulk-mark t] + ["Mark all" org-agenda-bulk-mark-all t] + ["Unmark entry" org-agenda-bulk-unmark t] + ["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"] + ["Toggle mark" org-agenda-bulk-toggle t] + ["Toggle all" org-agenda-bulk-toggle-all t] + ["Mark regexp" org-agenda-bulk-mark-regexp t]) + ["Act on all marked" org-agenda-bulk-action t] + "--" + ("Tags and Properties" + ["Show all Tags" org-agenda-show-tags t] + ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))] + ["Change tag in region" org-agenda-set-tags (org-region-active-p)] + "--" + ["Column View" org-columns t]) + ("Deadline/Schedule" + ["Schedule" org-agenda-schedule t] + ["Set Deadline" org-agenda-deadline t] + "--" + ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] + ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] + ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"] + ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-left"] + ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-right"] + ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-left"] + ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) + ("Clock and Effort" + ["Clock in" org-agenda-clock-in t] + ["Clock out" org-agenda-clock-out t] + ["Clock cancel" org-agenda-clock-cancel t] + ["Goto running clock" org-clock-goto t] + "--" + ["Set Effort" org-agenda-set-effort t] + ["Change clocked effort" org-clock-modify-effort-estimate + (org-clock-is-active)]) + ("Priority" + ["Set Priority" org-agenda-priority t] + ["Increase Priority" org-agenda-priority-up t] + ["Decrease Priority" org-agenda-priority-down t] + ["Show Priority" org-show-priority t]) + ("Calendar/Diary" + ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)] + ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)] + ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)] + ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)] + ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)] + ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)] + "--" + ["Create iCalendar File" org-icalendar-combine-agenda-files t]) + "--" + ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list] + "--" + ("MobileOrg" + ["Push Files and Views" org-mobile-push t] + ["Get Captured and Flagged" org-mobile-pull t] + ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "C-c a ?"] + ["Show note / unflag" org-agenda-show-the-flagging-note t] + "--" + ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t]) + "--" + ["Quit" org-agenda-quit t] + ["Exit and Release Buffers" org-agenda-exit t] + )) + +;;; Agenda undo + +(defvar org-agenda-allow-remote-undo t + "Non-nil means allow remote undo from the agenda buffer.") +(defvar org-agenda-undo-has-started-in nil + "Buffers that have already seen `undo-start' in the current undo sequence.") + +(defun org-agenda-undo () + "Undo a remote editing step in the agenda. +This undoes changes both in the agenda buffer and in the remote buffer +that have been changed along." + (interactive) + (or org-agenda-allow-remote-undo + (user-error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo")) + (if (not (eq this-command last-command)) + (setq org-agenda-undo-has-started-in nil + org-agenda-pending-undo-list org-agenda-undo-list)) + (if (not org-agenda-pending-undo-list) + (user-error "No further undo information")) + (let* ((entry (pop org-agenda-pending-undo-list)) + buf line cmd rembuf) + (setq cmd (pop entry) line (pop entry)) + (setq rembuf (nth 2 entry)) + (org-with-remote-undo rembuf + (while (bufferp (setq buf (pop entry))) + (if (pop entry) + (with-current-buffer buf + (let ((last-undo-buffer buf) + (inhibit-read-only t)) + (unless (memq buf org-agenda-undo-has-started-in) + (push buf org-agenda-undo-has-started-in) + (make-local-variable 'pending-undo-list) + (undo-start)) + (while (and pending-undo-list + (listp pending-undo-list) + (not (car pending-undo-list))) + (pop pending-undo-list)) + (undo-more 1)))))) + (org-goto-line line) + (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf)))) + +(defun org-verify-change-for-undo (l1 l2) + "Verify that a real change occurred between the undo lists L1 and L2." + (while (and l1 (listp l1) (null (car l1))) (pop l1)) + (while (and l2 (listp l2) (null (car l2))) (pop l2)) + (not (eq l1 l2))) + +;;; Agenda dispatch + +(defvar org-agenda-restrict-begin (make-marker)) +(defvar org-agenda-restrict-end (make-marker)) +(defvar org-agenda-last-dispatch-buffer nil) +(defvar org-agenda-overriding-restriction nil) + +(defcustom org-agenda-custom-commands-contexts nil + "Alist of custom agenda keys and contextual rules. + +For example, if you have a custom agenda command \"p\" and you +want this command to be accessible only from plain text files, +use this: + + '((\"p\" ((in-file . \"\\.txt\")))) + +Here are the available contexts definitions: + + in-file: command displayed only in matching files + in-mode: command displayed only in matching modes + not-in-file: command not displayed in matching files + not-in-mode: command not displayed in matching modes + in-buffer: command displayed only in matching buffers +not-in-buffer: command not displayed in matching buffers + [function]: a custom function taking no argument + +If you define several checks, the agenda command will be +accessible if there is at least one valid check. + +You can also bind a key to another agenda custom command +depending on contextual rules. + + '((\"p\" \"q\" ((in-file . \"\\.txt\")))) + +Here it means: in .txt files, use \"p\" as the key for the +agenda command otherwise associated with \"q\". (The command +originally associated with \"q\" is not displayed to avoid +duplicates.)" + :version "24.3" + :group 'org-agenda-custom-commands + :type '(repeat (list :tag "Rule" + (string :tag " Agenda key") + (string :tag "Replace by command") + (repeat :tag "Available when" + (choice + (cons :tag "Condition" + (choice + (const :tag "In file" in-file) + (const :tag "Not in file" not-in-file) + (const :tag "In buffer" in-buffer) + (const :tag "Not in buffer" not-in-buffer) + (const :tag "In mode" in-mode) + (const :tag "Not in mode" not-in-mode)) + (regexp)) + (function :tag "Custom function")))))) + +(defcustom org-agenda-max-entries nil + "Maximum number of entries to display in an agenda. +This can be nil (no limit) or an integer or an alist of agenda +types with an associated number of entries to display in this +type." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda-custom-commands + :type '(choice (symbol :tag "No limit" nil) + (integer :tag "Max number of entries") + (repeat + (cons (choice :tag "Agenda type" + (const agenda) + (const todo) + (const tags) + (const search) + (const timeline)) + (integer :tag "Max number of entries"))))) + +(defcustom org-agenda-max-todos nil + "Maximum number of TODOs to display in an agenda. +This can be nil (no limit) or an integer or an alist of agenda +types with an associated number of entries to display in this +type." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda-custom-commands + :type '(choice (symbol :tag "No limit" nil) + (integer :tag "Max number of TODOs") + (repeat + (cons (choice :tag "Agenda type" + (const agenda) + (const todo) + (const tags) + (const search) + (const timeline)) + (integer :tag "Max number of TODOs"))))) + +(defcustom org-agenda-max-tags nil + "Maximum number of tagged entries to display in an agenda. +This can be nil (no limit) or an integer or an alist of agenda +types with an associated number of entries to display in this +type." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda-custom-commands + :type '(choice (symbol :tag "No limit" nil) + (integer :tag "Max number of tagged entries") + (repeat + (cons (choice :tag "Agenda type" + (const agenda) + (const todo) + (const tags) + (const search) + (const timeline)) + (integer :tag "Max number of tagged entries"))))) + +(defcustom org-agenda-max-effort nil + "Maximum cumulated effort duration for the agenda. +This can be nil (no limit) or a number of minutes (as an integer) +or an alist of agenda types with an associated number of minutes +to limit entries to in this type." + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-agenda-custom-commands + :type '(choice (symbol :tag "No limit" nil) + (integer :tag "Max number of minutes") + (repeat + (cons (choice :tag "Agenda type" + (const agenda) + (const todo) + (const tags) + (const search) + (const timeline)) + (integer :tag "Max number of minutes"))))) + +(defvar org-keys nil) +(defvar org-match nil) +;;;###autoload +(defun org-agenda (&optional arg org-keys restriction) + "Dispatch agenda commands to collect entries to the agenda buffer. +Prompts for a command to execute. Any prefix arg will be passed +on to the selected command. The default selections are: + +a Call `org-agenda-list' to display the agenda for current day or week. +t Call `org-todo-list' to display the global todo list. +T Call `org-todo-list' to display the global todo list, select only + entries with a specific TODO keyword (the user gets a prompt). +m Call `org-tags-view' to display headlines with tags matching + a condition (the user is prompted for the condition). +M Like `m', but select only TODO entries, no ordinary headlines. +L Create a timeline for the current buffer. +e Export views to associated files. +s Search entries for keywords. +S Search entries for keywords, only with TODO keywords. +/ Multi occur across all agenda files and also files listed + in `org-agenda-text-search-extra-files'. +< Restrict agenda commands to buffer, subtree, or region. + Press several times to get the desired effect. +> Remove a previous restriction. +# List \"stuck\" projects. +! Configure what \"stuck\" means. +C Configure custom agenda commands. + +More commands can be added by configuring the variable +`org-agenda-custom-commands'. In particular, specific tags and TODO keyword +searches can be pre-defined in this way. + +If the current buffer is in Org-mode and visiting a file, you can also +first press `<' once to indicate that the agenda should be temporarily +\(until the next use of \\[org-agenda]) restricted to the current file. +Pressing `<' twice means to restrict to the current subtree or region +\(if active)." + (interactive "P") + (catch 'exit + (let* ((prefix-descriptions nil) + (org-agenda-buffer-name org-agenda-buffer-name) + (org-agenda-window-setup (if (equal (buffer-name) + org-agenda-buffer-name) + 'current-window + org-agenda-window-setup)) + (org-agenda-custom-commands-orig org-agenda-custom-commands) + (org-agenda-custom-commands + ;; normalize different versions + (delq nil + (mapcar + (lambda (x) + (cond ((stringp (cdr x)) + (push x prefix-descriptions) + nil) + ((stringp (nth 1 x)) x) + ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) + (t (cons (car x) (cons "" (cdr x)))))) + org-agenda-custom-commands))) + (org-agenda-custom-commands + (org-contextualize-keys + org-agenda-custom-commands org-agenda-custom-commands-contexts)) + (buf (current-buffer)) + (bfn (buffer-file-name (buffer-base-buffer))) + entry key type org-match lprops ans) + ;; Turn off restriction unless there is an overriding one, + (unless org-agenda-overriding-restriction + (unless (org-bound-and-true-p org-agenda-keep-restricted-file-list) + ;; There is a request to keep the file list in place + (put 'org-agenda-files 'org-restrict nil)) + (setq org-agenda-restrict nil) + (move-marker org-agenda-restrict-begin nil) + (move-marker org-agenda-restrict-end nil)) + ;; Delete old local properties + (put 'org-agenda-redo-command 'org-lprops nil) + ;; Delete previously set last-arguments + (put 'org-agenda-redo-command 'last-args nil) + ;; Remember where this call originated + (setq org-agenda-last-dispatch-buffer (current-buffer)) + (unless org-keys + (setq ans (org-agenda-get-restriction-and-command prefix-descriptions) + org-keys (car ans) + restriction (cdr ans))) + ;; If we have sticky agenda buffers, set a name for the buffer, + ;; depending on the invoking keys. The user may still set this + ;; as a command option, which will overwrite what we do here. + (if org-agenda-sticky + (setq org-agenda-buffer-name + (format "*Org Agenda(%s)*" org-keys))) + ;; Establish the restriction, if any + (when (and (not org-agenda-overriding-restriction) restriction) + (put 'org-agenda-files 'org-restrict (list bfn)) + (cond + ((eq restriction 'region) + (setq org-agenda-restrict (current-buffer)) + (move-marker org-agenda-restrict-begin (region-beginning)) + (move-marker org-agenda-restrict-end (region-end))) + ((eq restriction 'subtree) + (save-excursion + (setq org-agenda-restrict (current-buffer)) + (org-back-to-heading t) + (move-marker org-agenda-restrict-begin (point)) + (move-marker org-agenda-restrict-end + (progn (org-end-of-subtree t))))))) + + ;; For example the todo list should not need it (but does...) + (cond + ((setq entry (assoc org-keys org-agenda-custom-commands)) + (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry))) + (progn + (setq type (nth 2 entry) org-match (eval (nth 3 entry)) + lprops (nth 4 entry)) + (if org-agenda-sticky + (setq org-agenda-buffer-name + (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match)) + (format "*Org Agenda(%s)*" org-keys)))) + (put 'org-agenda-redo-command 'org-lprops lprops) + (cond + ((eq type 'agenda) + (org-let lprops '(org-agenda-list current-prefix-arg))) + ((eq type 'agenda*) + (org-let lprops '(org-agenda-list current-prefix-arg nil nil t))) + ((eq type 'alltodo) + (org-let lprops '(org-todo-list current-prefix-arg))) + ((eq type 'search) + (org-let lprops '(org-search-view current-prefix-arg org-match nil))) + ((eq type 'stuck) + (org-let lprops '(org-agenda-list-stuck-projects + current-prefix-arg))) + ((eq type 'tags) + (org-let lprops '(org-tags-view current-prefix-arg org-match))) + ((eq type 'tags-todo) + (org-let lprops '(org-tags-view '(4) org-match))) + ((eq type 'todo) + (org-let lprops '(org-todo-list org-match))) + ((eq type 'tags-tree) + (org-check-for-org-mode) + (org-let lprops '(org-match-sparse-tree current-prefix-arg org-match))) + ((eq type 'todo-tree) + (org-check-for-org-mode) + (org-let lprops + '(org-occur (concat "^" org-outline-regexp "[ \t]*" + (regexp-quote org-match) "\\>")))) + ((eq type 'occur-tree) + (org-check-for-org-mode) + (org-let lprops '(org-occur org-match))) + ((functionp type) + (org-let lprops '(funcall type org-match))) + ((fboundp type) + (org-let lprops '(funcall type org-match))) + (t (user-error "Invalid custom agenda command type %s" type)))) + (org-agenda-run-series (nth 1 entry) (cddr entry)))) + ((equal org-keys "C") + (setq org-agenda-custom-commands org-agenda-custom-commands-orig) + (customize-variable 'org-agenda-custom-commands)) + ((equal org-keys "a") (call-interactively 'org-agenda-list)) + ((equal org-keys "s") (call-interactively 'org-search-view)) + ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4)))) + ((equal org-keys "t") (call-interactively 'org-todo-list)) + ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) + ((equal org-keys "m") (call-interactively 'org-tags-view)) + ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) + ((equal org-keys "e") (call-interactively 'org-store-agenda-views)) + ((equal org-keys "?") (org-tags-view nil "+FLAGGED") + (org-add-hook + 'post-command-hook + (lambda () + (unless (current-message) + (let* ((m (org-agenda-get-any-marker)) + (note (and m (org-entry-get m "THEFLAGGINGNOTE")))) + (when note + (message (concat + "FLAGGING-NOTE ([?] for more info): " + (org-add-props + (replace-regexp-in-string + "\\\\n" "//" + (copy-sequence note)) + nil 'face 'org-warning))))))) + t t)) + ((equal org-keys "L") + (unless (derived-mode-p 'org-mode) + (user-error "This is not an Org-mode file")) + (unless restriction + (put 'org-agenda-files 'org-restrict (list bfn)) + (org-call-with-arg 'org-timeline arg))) + ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects)) + ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files)) + ((equal org-keys "!") (customize-variable 'org-stuck-projects)) + (t (user-error "Invalid agenda key")))))) + +(defvar org-agenda-multi) + +(defun org-agenda-append-agenda () + "Append another agenda view to the current one. +This function allows interactive building of block agendas. +Agenda views are separated by `org-agenda-block-separator'." + (interactive) + (unless (derived-mode-p 'org-agenda-mode) + (user-error "Can only append from within agenda buffer")) + (let ((org-agenda-multi t)) + (org-agenda) + (widen) + (org-agenda-finalize) + (setq buffer-read-only t) + (org-agenda-fit-window-to-buffer))) + +(defun org-agenda-normalize-custom-commands (cmds) + "Normalize custom commands CMDS." + (delq nil + (mapcar + (lambda (x) + (cond ((stringp (cdr x)) nil) + ((stringp (nth 1 x)) x) + ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) + (t (cons (car x) (cons "" (cdr x)))))) + cmds))) + +(defun org-agenda-get-restriction-and-command (prefix-descriptions) + "The user interface for selecting an agenda command." + (catch 'exit + (let* ((bfn (buffer-file-name (buffer-base-buffer))) + (restrict-ok (and bfn (derived-mode-p 'org-mode))) + (region-p (org-region-active-p)) + (custom org-agenda-custom-commands) + (selstring "") + restriction second-time + c entry key type match prefixes rmheader header-end custom1 desc + line lines left right n n1) + (save-window-excursion + (delete-other-windows) + (org-switch-to-buffer-other-window " *Agenda Commands*") + (erase-buffer) + (insert (eval-when-compile + (let ((header + "Press key for an agenda command: < Buffer, subtree/region restriction +-------------------------------- > Remove restriction +a Agenda for current week or day e Export agenda views +t List of all TODO entries T Entries with special TODO kwd +m Match a TAGS/PROP/TODO query M Like m, but only TODO entries +s Search for keywords S Like s, but only TODO entries +L Timeline for current buffer # List stuck projects (!=configure) +/ Multi-occur C Configure custom agenda commands +? Find :FLAGGED: entries * Toggle sticky agenda views +") + (start 0)) + (while (string-match + "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)" + header start) + (setq start (match-end 0)) + (add-text-properties (match-beginning 2) (match-end 2) + '(face bold) header)) + header))) + (setq header-end (point-marker)) + (while t + (setq custom1 custom) + (when (eq rmheader t) + (org-goto-line 1) + (re-search-forward ":" nil t) + (delete-region (match-end 0) (point-at-eol)) + (forward-char 1) + (looking-at "-+") + (delete-region (match-end 0) (point-at-eol)) + (move-marker header-end (match-end 0))) + (goto-char header-end) + (delete-region (point) (point-max)) + + ;; Produce all the lines that describe custom commands and prefixes + (setq lines nil) + (while (setq entry (pop custom1)) + (setq key (car entry) desc (nth 1 entry) + type (nth 2 entry) + match (nth 3 entry)) + (if (> (length key) 1) + (add-to-list 'prefixes (string-to-char key)) + (setq line + (format + "%-4s%-14s" + (org-add-props (copy-sequence key) + '(face bold)) + (cond + ((string-match "\\S-" desc) desc) + ((eq type 'agenda) "Agenda for current week or day") + ((eq type 'agenda*) "Appointments for current week or day") + ((eq type 'alltodo) "List of all TODO entries") + ((eq type 'search) "Word search") + ((eq type 'stuck) "List of stuck projects") + ((eq type 'todo) "TODO keyword") + ((eq type 'tags) "Tags query") + ((eq type 'tags-todo) "Tags (TODO)") + ((eq type 'tags-tree) "Tags tree") + ((eq type 'todo-tree) "TODO kwd tree") + ((eq type 'occur-tree) "Occur tree") + ((functionp type) (if (symbolp type) + (symbol-name type) + "Lambda expression")) + (t "???")))) + (if org-agenda-menu-show-matcher + (setq line + (concat line ": " + (cond + ((stringp match) + (setq match (copy-sequence match)) + (org-add-props match nil 'face 'org-warning)) + ((listp type) + (format "set of %d commands" (length type)))))) + (if (org-string-nw-p match) + (add-text-properties + 0 (length line) (list 'help-echo + (concat "Matcher: " match)) line))) + (push line lines))) + (setq lines (nreverse lines)) + (when prefixes + (mapc (lambda (x) + (push + (format "%s %s" + (org-add-props (char-to-string x) + nil 'face 'bold) + (or (cdr (assoc (concat selstring + (char-to-string x)) + prefix-descriptions)) + "Prefix key")) + lines)) + prefixes)) + + ;; Check if we should display in two columns + (if org-agenda-menu-two-columns + (progn + (setq n (length lines) + n1 (+ (/ n 2) (mod n 2)) + right (nthcdr n1 lines) + left (copy-sequence lines)) + (setcdr (nthcdr (1- n1) left) nil)) + (setq left lines right nil)) + (while left + (insert "\n" (pop left)) + (when right + (if (< (current-column) 40) + (move-to-column 40 t) + (insert " ")) + (insert (pop right)))) + + ;; Make the window the right size + (goto-char (point-min)) + (if second-time + (if (not (pos-visible-in-window-p (point-max))) + (org-fit-window-to-buffer)) + (setq second-time t) + (org-fit-window-to-buffer)) + + ;; Ask for selection + (message "Press key for agenda command%s:" + (if (or restrict-ok org-agenda-overriding-restriction) + (if org-agenda-overriding-restriction + " (restriction lock active)" + (if restriction + (format " (restricted to %s)" restriction) + " (unrestricted)")) + "")) + (setq c (read-char-exclusive)) + (message "") + (cond + ((assoc (char-to-string c) custom) + (setq selstring (concat selstring (char-to-string c))) + (throw 'exit (cons selstring restriction))) + ((memq c prefixes) + (setq selstring (concat selstring (char-to-string c)) + prefixes nil + rmheader (or rmheader t) + custom (delq nil (mapcar + (lambda (x) + (if (or (= (length (car x)) 1) + (/= (string-to-char (car x)) c)) + nil + (cons (substring (car x) 1) (cdr x)))) + custom)))) + ((eq c ?*) + (call-interactively 'org-toggle-sticky-agenda) + (sit-for 2)) + ((and (not restrict-ok) (memq c '(?1 ?0 ?<))) + (message "Restriction is only possible in Org-mode buffers") + (ding) (sit-for 1)) + ((eq c ?1) + (org-agenda-remove-restriction-lock 'noupdate) + (setq restriction 'buffer)) + ((eq c ?0) + (org-agenda-remove-restriction-lock 'noupdate) + (setq restriction (if region-p 'region 'subtree))) + ((eq c ?<) + (org-agenda-remove-restriction-lock 'noupdate) + (setq restriction + (cond + ((eq restriction 'buffer) + (if region-p 'region 'subtree)) + ((memq restriction '(subtree region)) + nil) + (t 'buffer)))) + ((eq c ?>) + (org-agenda-remove-restriction-lock 'noupdate) + (setq restriction nil)) + ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??))) + (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) + ((and (> (length selstring) 0) (eq c ?\d)) + (delete-window) + (org-agenda-get-restriction-and-command prefix-descriptions)) + + ((equal c ?q) (error "Abort")) + (t (user-error "Invalid key %c" c)))))))) + +(defun org-agenda-fit-window-to-buffer () + "Fit the window to the buffer size." + (and (memq org-agenda-window-setup '(reorganize-frame)) + (fboundp 'fit-window-to-buffer) + (org-fit-window-to-buffer + nil + (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) + (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))) + +(defvar org-cmd nil) +(defvar org-agenda-overriding-cmd nil) +(defvar org-agenda-overriding-arguments nil) +(defvar org-agenda-overriding-cmd-arguments nil) +(defun org-agenda-run-series (name series) + "Run agenda NAME as a SERIES of agenda commands." + (org-let (nth 1 series) '(org-agenda-prepare name)) + ;; We need to reset agenda markers here, because when constructing a + ;; block agenda, the individual blocks do not do that. + (org-agenda-reset-markers) + (let* ((org-agenda-multi t) + (redo (list 'org-agenda-run-series name (list 'quote series))) + (cmds (car series)) + (gprops (nth 1 series)) + match ;; The byte compiler incorrectly complains about this. Keep it! + org-cmd type lprops) + (while (setq org-cmd (pop cmds)) + (setq type (car org-cmd) + match (eval (nth 1 org-cmd)) + lprops (nth 2 org-cmd)) + (let ((org-agenda-overriding-arguments + (if (eq org-agenda-overriding-cmd org-cmd) + (or org-agenda-overriding-arguments + org-agenda-overriding-cmd-arguments)))) + (cond + ((eq type 'agenda) + (org-let2 gprops lprops + '(call-interactively 'org-agenda-list))) + ((eq type 'agenda*) + (org-let2 gprops lprops + '(funcall 'org-agenda-list nil nil t))) + ((eq type 'alltodo) + (org-let2 gprops lprops + '(call-interactively 'org-todo-list))) + ((eq type 'search) + (org-let2 gprops lprops + '(org-search-view current-prefix-arg match nil))) + ((eq type 'stuck) + (org-let2 gprops lprops + '(call-interactively 'org-agenda-list-stuck-projects))) + ((eq type 'tags) + (org-let2 gprops lprops + '(org-tags-view current-prefix-arg match))) + ((eq type 'tags-todo) + (org-let2 gprops lprops + '(org-tags-view '(4) match))) + ((eq type 'todo) + (org-let2 gprops lprops + '(org-todo-list match))) + ((fboundp type) + (org-let2 gprops lprops + '(funcall type match))) + (t (error "Invalid type in command series"))))) + (widen) + (let ((inhibit-read-only t)) + (add-text-properties (point-min) (point-max) + `(org-series t org-series-redo-cmd ,redo))) + (setq org-agenda-redo-command redo) + (goto-char (point-min))) + (org-agenda-fit-window-to-buffer) + (org-let (nth 1 series) '(org-agenda-finalize))) + +;;;###autoload +(defmacro org-batch-agenda (cmd-key &rest parameters) + "Run an agenda command in batch mode and send the result to STDOUT. +If CMD-KEY is a string of length 1, it is used as a key in +`org-agenda-custom-commands' and triggers this command. If it is a +longer string it is used as a tags/todo match string. +Parameters are alternating variable names and values that will be bound +before running the agenda command." + (org-eval-in-environment (org-make-parameter-alist parameters) + (let (org-agenda-sticky) + (if (> (length cmd-key) 2) + (org-tags-view nil cmd-key) + (org-agenda nil cmd-key)))) + (set-buffer org-agenda-buffer-name) + (princ (buffer-string))) + +(defvar org-agenda-info nil) + +;;;###autoload +(defmacro org-batch-agenda-csv (cmd-key &rest parameters) + "Run an agenda command in batch mode and send the result to STDOUT. +If CMD-KEY is a string of length 1, it is used as a key in +`org-agenda-custom-commands' and triggers this command. If it is a +longer string it is used as a tags/todo match string. +Parameters are alternating variable names and values that will be bound +before running the agenda command. + +The output gives a line for each selected agenda item. Each +item is a list of comma-separated values, like this: + +category,head,type,todo,tags,date,time,extra,priority-l,priority-n + +category The category of the item +head The headline, without TODO kwd, TAGS and PRIORITY +type The type of the agenda entry, can be + todo selected in TODO match + tagsmatch selected in tags match + diary imported from diary + deadline a deadline on given date + scheduled scheduled on given date + timestamp entry has timestamp on given date + closed entry was closed on given date + upcoming-deadline warning about deadline + past-scheduled forwarded scheduled item + block entry has date block including g. date +todo The todo keyword, if any +tags All tags including inherited ones, separated by colons +date The relevant date, like 2007-2-14 +time The time, like 15:00-16:50 +extra Sting with extra planning info +priority-l The priority letter if any was given +priority-n The computed numerical priority +agenda-day The day in the agenda where this is listed" + (org-eval-in-environment (append '((org-agenda-remove-tags t)) + (org-make-parameter-alist parameters)) + (if (> (length cmd-key) 2) + (org-tags-view nil cmd-key) + (org-agenda nil cmd-key))) + (set-buffer org-agenda-buffer-name) + (let* ((lines (org-split-string (buffer-string) "\n")) + line) + (while (setq line (pop lines)) + (catch 'next + (if (not (get-text-property 0 'org-category line)) (throw 'next nil)) + (setq org-agenda-info + (org-fix-agenda-info (text-properties-at 0 line))) + (princ + (mapconcat 'org-agenda-export-csv-mapper + '(org-category txt type todo tags date time extra + priority-letter priority agenda-day) + ",")) + (princ "\n"))))) + +(defun org-fix-agenda-info (props) + "Make sure all properties on an agenda item have a canonical form. +This ensures the export commands can easily use it." + (let (tmp re) + (when (setq tmp (plist-get props 'tags)) + (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) + (when (setq tmp (plist-get props 'date)) + (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) + (let ((calendar-date-display-form '(year "-" month "-" day))) + '((format "%4d, %9s %2s, %4s" dayname monthname day year)) + + (setq tmp (calendar-date-string tmp))) + (setq props (plist-put props 'date tmp))) + (when (setq tmp (plist-get props 'day)) + (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) + (let ((calendar-date-display-form '(year "-" month "-" day))) + (setq tmp (calendar-date-string tmp))) + (setq props (plist-put props 'day tmp)) + (setq props (plist-put props 'agenda-day tmp))) + (when (setq tmp (plist-get props 'txt)) + (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp) + (plist-put props 'priority-letter (match-string 1 tmp)) + (setq tmp (replace-match "" t t tmp))) + (when (and (setq re (plist-get props 'org-todo-regexp)) + (setq re (concat "\\`\\.*" re " ?")) + (string-match re tmp)) + (plist-put props 'todo (match-string 1 tmp)) + (setq tmp (replace-match "" t t tmp))) + (plist-put props 'txt tmp))) + props) + +(defun org-agenda-export-csv-mapper (prop) + (let ((res (plist-get org-agenda-info prop))) + (setq res + (cond + ((not res) "") + ((stringp res) res) + (t (prin1-to-string res)))) + (while (string-match "," res) + (setq res (replace-match ";" t t res))) + (org-trim res))) + +;;;###autoload +(defun org-store-agenda-views (&rest parameters) + "Store agenda views." + (interactive) + (eval (list 'org-batch-store-agenda-views))) + +;;;###autoload +(defmacro org-batch-store-agenda-views (&rest parameters) + "Run all custom agenda commands that have a file argument." + (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands)) + (pop-up-frames nil) + (dir default-directory) + (pars (org-make-parameter-alist parameters)) + cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname) + (save-window-excursion + (while cmds + (setq cmd (pop cmds) + thiscmdkey (car cmd) + thiscmdcmd (cdr cmd) + match (nth 2 thiscmdcmd) + bufname (if org-agenda-sticky + (or (and (stringp match) + (format "*Org Agenda(%s:%s)*" thiscmdkey match)) + (format "*Org Agenda(%s)*" thiscmdkey)) + org-agenda-buffer-name) + cmd-or-set (nth 2 cmd) + opts (nth (if (listp cmd-or-set) 3 4) cmd) + files (nth (if (listp cmd-or-set) 4 5) cmd)) + (if (stringp files) (setq files (list files))) + (when files + (org-eval-in-environment (append org-agenda-exporter-settings + opts pars) + (org-agenda nil thiscmdkey)) + (set-buffer bufname) + (while files + (org-eval-in-environment (append org-agenda-exporter-settings + opts pars) + (org-agenda-write (expand-file-name (pop files) dir) nil t bufname))) + (and (get-buffer bufname) + (kill-buffer bufname))))))) + +(defvar org-agenda-current-span nil + "The current span used in the agenda view.") ; local variable in the agenda buffer +(defun org-agenda-mark-header-line (pos) + "Mark the line at POS as an agenda structure header." + (save-excursion + (goto-char pos) + (put-text-property (point-at-bol) (point-at-eol) + 'org-agenda-structural-header t) + (when org-agenda-title-append + (put-text-property (point-at-bol) (point-at-eol) + 'org-agenda-title-append org-agenda-title-append)))) + +(defvar org-mobile-creating-agendas) ; defined in org-mobile.el +(defvar org-agenda-write-buffer-name "Agenda View") +(defun org-agenda-write (file &optional open nosettings agenda-bufname) + "Write the current buffer (an agenda view) as a file. +Depending on the extension of the file name, plain text (.txt), +HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced. +If the extension is .ics, run icalendar export over all files used +to construct the agenda and limit the export to entries listed in the +agenda now. +If the extension is .org, collect all subtrees corresponding to the +agenda entries and add them in an .org file. +With prefix argument OPEN, open the new file immediately. +If NOSETTINGS is given, do not scope the settings of +`org-agenda-exporter-settings' into the export commands. This is used when +the settings have already been scoped and we do not wish to overrule other, +higher priority settings. +If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write." + (interactive "FWrite agenda to file: \nP") + (if (or (not (file-writable-p file)) + (and (file-exists-p file) + (if (org-called-interactively-p 'any) + (not (y-or-n-p (format "Overwrite existing file %s? " file)))))) + (user-error "Cannot write agenda to file %s" file)) + (org-let (if nosettings nil org-agenda-exporter-settings) + '(save-excursion + (save-window-excursion + (let ((bs (copy-sequence (buffer-string))) beg content) + (with-temp-buffer + (rename-buffer org-agenda-write-buffer-name t) + (set-buffer-modified-p nil) + (insert bs) + (org-agenda-remove-marked-text 'org-filtered) + (run-hooks 'org-agenda-before-write-hook) + (cond + ((org-bound-and-true-p org-mobile-creating-agendas) + (org-mobile-write-agenda-for-mobile file)) + ((string-match "\\.org\\'" file) + (let (content p m message-log-max) + (goto-char (point-min)) + (while (setq p (next-single-property-change (point) 'org-hd-marker nil)) + (goto-char p) + (setq m (get-text-property (point) 'org-hd-marker)) + (when m + (push (save-excursion + (set-buffer (marker-buffer m)) + (goto-char m) + (org-copy-subtree 1 nil t t) + org-subtree-clip) + content))) + (find-file file) + (erase-buffer) + (dolist (s content) (org-paste-subtree 1 s)) + (write-file file) + (kill-buffer (current-buffer)) + (message "Org file written to %s" file))) + ((string-match "\\.html?\\'" file) + (require 'htmlize) + (set-buffer (htmlize-buffer (current-buffer))) + (when org-agenda-export-html-style + ;; replace ")) + (insert org-agenda-export-html-style)) + (write-file file) + (kill-buffer (current-buffer)) + (message "HTML written to %s" file)) + ((string-match "\\.ps\\'" file) + (require 'ps-print) + (ps-print-buffer-with-faces file) + (message "Postscript written to %s" file)) + ((string-match "\\.pdf\\'" file) + (require 'ps-print) + (ps-print-buffer-with-faces + (concat (file-name-sans-extension file) ".ps")) + (call-process "ps2pdf" nil nil nil + (expand-file-name + (concat (file-name-sans-extension file) ".ps")) + (expand-file-name file)) + (delete-file (concat (file-name-sans-extension file) ".ps")) + (message "PDF written to %s" file)) + ((string-match "\\.ics\\'" file) + (require 'ox-icalendar) + (org-icalendar-export-current-agenda (expand-file-name file))) + (t + (let ((bs (buffer-string))) + (find-file file) + (erase-buffer) + (insert bs) + (save-buffer 0) + (kill-buffer (current-buffer)) + (message "Plain text written to %s" file)))))))) + (set-buffer (or agenda-bufname + (and (org-called-interactively-p 'any) (buffer-name)) + org-agenda-buffer-name))) + (when open (org-open-file file))) + +(defun org-agenda-remove-marked-text (property &optional value) + "Delete all text marked with VALUE of PROPERTY. +VALUE defaults to t." + (let (beg) + (setq value (or value t)) + (while (setq beg (text-property-any (point-min) (point-max) + property value)) + (delete-region + beg (or (next-single-property-change beg property) + (point-max)))))) + +(defun org-agenda-add-entry-text () + "Add entry text to agenda lines. +This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the +entry text following headings shown in the agenda. +Drawers will be excluded, also the line with scheduling/deadline info." + (when (and (> org-agenda-add-entry-text-maxlines 0) + (not (org-bound-and-true-p org-mobile-creating-agendas))) + (let (m txt) + (goto-char (point-min)) + (while (not (eobp)) + (if (not (setq m (org-get-at-bol 'org-hd-marker))) + (beginning-of-line 2) + (setq txt (org-agenda-get-some-entry-text + m org-agenda-add-entry-text-maxlines " > ")) + (end-of-line 1) + (if (string-match "\\S-" txt) + (insert "\n" txt) + (or (eobp) (forward-char 1)))))))) + +(defun org-agenda-get-some-entry-text (marker n-lines &optional indent + &rest keep) + "Extract entry text from MARKER, at most N-LINES lines. +This will ignore drawers etc, just get the text. +If INDENT is given, prefix every line with this string. If KEEP is +given, it is a list of symbols, defining stuff that should not be +removed from the entry content. Currently only `planning' is allowed here." + (let (txt drawer-re kwd-time-re ind) + (save-excursion + (with-current-buffer (marker-buffer marker) + (if (not (derived-mode-p 'org-mode)) + (setq txt "") + (save-excursion + (save-restriction + (widen) + (goto-char marker) + (end-of-line 1) + (setq txt (buffer-substring + (min (1+ (point)) (point-max)) + (progn (outline-next-heading) (point))) + drawer-re org-drawer-regexp + kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp + ".*\n?")) + (with-temp-buffer + (insert txt) + (when org-agenda-add-entry-text-descriptive-links + (goto-char (point-min)) + (while (org-activate-bracket-links (point-max)) + (add-text-properties (match-beginning 0) (match-end 0) + '(face org-link)))) + (goto-char (point-min)) + (while (re-search-forward org-bracket-link-regexp (point-max) t) + (set-text-properties (match-beginning 0) (match-end 0) + nil)) + (goto-char (point-min)) + (while (re-search-forward drawer-re nil t) + (delete-region + (match-beginning 0) + (progn (re-search-forward + "^[ \t]*:END:.*\n?" nil 'move) + (point)))) + (unless (member 'planning keep) + (goto-char (point-min)) + (while (re-search-forward kwd-time-re nil t) + (replace-match ""))) + (goto-char (point-min)) + (when org-agenda-entry-text-exclude-regexps + (let ((re-list org-agenda-entry-text-exclude-regexps) re) + (while (setq re (pop re-list)) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (replace-match ""))))) + (goto-char (point-max)) + (skip-chars-backward " \t\n") + (if (looking-at "[ \t\n]+\\'") (replace-match "")) + + ;; find and remove min common indentation + (goto-char (point-min)) + (untabify (point-min) (point-max)) + (setq ind (org-get-indentation)) + (while (not (eobp)) + (unless (looking-at "[ \t]*$") + (setq ind (min ind (org-get-indentation)))) + (beginning-of-line 2)) + (goto-char (point-min)) + (while (not (eobp)) + (unless (looking-at "[ \t]*$") + (move-to-column ind) + (delete-region (point-at-bol) (point))) + (beginning-of-line 2)) + + (run-hooks 'org-agenda-entry-text-cleanup-hook) + + (goto-char (point-min)) + (when indent + (while (and (not (eobp)) (re-search-forward "^" nil t)) + (replace-match indent t t))) + (goto-char (point-min)) + (while (looking-at "[ \t]*\n") (replace-match "")) + (goto-char (point-max)) + (when (> (org-current-line) + n-lines) + (org-goto-line (1+ n-lines)) + (backward-char 1)) + (setq txt (buffer-substring (point-min) (point))))))))) + txt)) + +(defun org-check-for-org-mode () + "Make sure current buffer is in org-mode. Error if not." + (or (derived-mode-p 'org-mode) + (error "Cannot execute org-mode agenda command on buffer in %s" + major-mode))) + +;;; Agenda prepare and finalize + +(defvar org-agenda-multi nil) ; dynamically scoped +(defvar org-agenda-pre-window-conf nil) +(defvar org-agenda-columns-active nil) +(defvar org-agenda-name nil) +(defvar org-agenda-tag-filter nil) +(defvar org-agenda-category-filter nil) +(defvar org-agenda-regexp-filter nil) +(defvar org-agenda-top-headline-filter nil) +(defvar org-agenda-tag-filter-preset nil + "A preset of the tags filter used for secondary agenda filtering. +This must be a list of strings, each string must be a single tag preceded +by \"+\" or \"-\". +This variable should not be set directly, but agenda custom commands can +bind it in the options section. The preset filter is a global property of +the entire agenda view. In a block agenda, it will not work reliably to +define a filter for one of the individual blocks. You need to set it in +the global options and expect it to be applied to the entire view.") + +(defvar org-agenda-category-filter-preset nil + "A preset of the category filter used for secondary agenda filtering. +This must be a list of strings, each string must be a single category +preceded by \"+\" or \"-\". +This variable should not be set directly, but agenda custom commands can +bind it in the options section. The preset filter is a global property of +the entire agenda view. In a block agenda, it will not work reliably to +define a filter for one of the individual blocks. You need to set it in +the global options and expect it to be applied to the entire view.") + +(defvar org-agenda-regexp-filter-preset nil + "A preset of the regexp filter used for secondary agenda filtering. +This must be a list of strings, each string must be a single regexp +preceded by \"+\" or \"-\". +This variable should not be set directly, but agenda custom commands can +bind it in the options section. The preset filter is a global property of +the entire agenda view. In a block agenda, it will not work reliably to +define a filter for one of the individual blocks. You need to set it in +the global options and expect it to be applied to the entire view.") + +(defun org-agenda-use-sticky-p () + "Return non-nil if an agenda buffer named +`org-agenda-buffer-name' exists and should be shown instead of +generating a new one." + (and + ;; turned off by user + org-agenda-sticky + ;; For multi-agenda buffer already exists + (not org-agenda-multi) + ;; buffer found + (get-buffer org-agenda-buffer-name) + ;; C-u parameter is same as last call + (with-current-buffer (get-buffer org-agenda-buffer-name) + (and + (equal current-prefix-arg + org-agenda-last-prefix-arg) + ;; In case user turned stickiness on, while having existing + ;; Agenda buffer active, don't reuse that buffer, because it + ;; does not have org variables local + org-agenda-this-buffer-is-sticky)))) + +(defun org-agenda-prepare-window (abuf filter-alist) + "Setup agenda buffer in the window. +ABUF is the buffer for the agenda window. +FILTER-ALIST is an alist of filters we need to apply when +`org-agenda-persistent-filter' is non-nil." + (let* ((awin (get-buffer-window abuf)) wconf) + (cond + ((equal (current-buffer) abuf) nil) + (awin (select-window awin)) + ((not (setq wconf (current-window-configuration)))) + ((equal org-agenda-window-setup 'current-window) + (org-pop-to-buffer-same-window abuf)) + ((equal org-agenda-window-setup 'other-window) + (org-switch-to-buffer-other-window abuf)) + ((equal org-agenda-window-setup 'other-frame) + (switch-to-buffer-other-frame abuf)) + ((equal org-agenda-window-setup 'reorganize-frame) + (delete-other-windows) + (org-switch-to-buffer-other-window abuf))) + (setq org-agenda-tag-filter (cdr (assoc 'tag filter-alist))) + (setq org-agenda-category-filter (cdr (assoc 'cat filter-alist))) + (setq org-agenda-regexp-filter (cdr (assoc 're filter-alist))) + ;; Additional test in case agenda is invoked from within agenda + ;; buffer via elisp link. + (unless (equal (current-buffer) abuf) + (org-pop-to-buffer-same-window abuf)) + (setq org-agenda-pre-window-conf + (or org-agenda-pre-window-conf wconf)))) + +(defun org-agenda-prepare (&optional name) + (let ((filter-alist (if org-agenda-persistent-filter + (list `(tag . ,org-agenda-tag-filter) + `(re . ,org-agenda-regexp-filter) + `(car . ,org-agenda-category-filter))))) + (if (org-agenda-use-sticky-p) + (progn + (put 'org-agenda-tag-filter :preset-filter nil) + (put 'org-agenda-category-filter :preset-filter nil) + (put 'org-agenda-regexp-filter :preset-filter nil) + ;; Popup existing buffer + (org-agenda-prepare-window (get-buffer org-agenda-buffer-name) + filter-alist) + (message "Sticky Agenda buffer, use `r' to refresh") + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (throw 'exit "Sticky Agenda buffer, use `r' to refresh")) + (setq org-todo-keywords-for-agenda nil) + (setq org-drawers-for-agenda nil) + (put 'org-agenda-tag-filter :preset-filter + org-agenda-tag-filter-preset) + (put 'org-agenda-category-filter :preset-filter + org-agenda-category-filter-preset) + (put 'org-agenda-regexp-filter :preset-filter + org-agenda-regexp-filter-preset) + (if org-agenda-multi + (progn + (setq buffer-read-only nil) + (goto-char (point-max)) + (unless (or (bobp) org-agenda-compact-blocks + (not org-agenda-block-separator)) + (insert "\n" + (if (stringp org-agenda-block-separator) + org-agenda-block-separator + (make-string (window-width) org-agenda-block-separator)) + "\n")) + (narrow-to-region (point) (point-max))) + (setq org-done-keywords-for-agenda nil) + + ;; Setting any org variables that are in org-agenda-local-vars + ;; list need to be done after the prepare call + (org-agenda-prepare-window + (get-buffer-create org-agenda-buffer-name) filter-alist) + (setq buffer-read-only nil) + (org-agenda-reset-markers) + (let ((inhibit-read-only t)) (erase-buffer)) + (org-agenda-mode) + (setq org-agenda-buffer (current-buffer)) + (setq org-agenda-contributing-files nil) + (setq org-agenda-columns-active nil) + (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) + (setq org-todo-keywords-for-agenda + (org-uniquify org-todo-keywords-for-agenda)) + (setq org-done-keywords-for-agenda + (org-uniquify org-done-keywords-for-agenda)) + (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda)) + (setq org-agenda-last-prefix-arg current-prefix-arg) + (setq org-agenda-this-buffer-name org-agenda-buffer-name) + (and name (not org-agenda-name) + (org-set-local 'org-agenda-name name))) + (setq buffer-read-only nil)))) + +(defvar org-agenda-overriding-columns-format) ; From org-colview.el +(defun org-agenda-finalize () + "Finishing touch for the agenda buffer, called just before displaying it." + (unless org-agenda-multi + (save-excursion + (let ((inhibit-read-only t)) + (goto-char (point-min)) + (save-excursion + (while (org-activate-bracket-links (point-max)) + (add-text-properties (match-beginning 0) (match-end 0) + '(face org-link)))) + (save-excursion + (while (org-activate-plain-links (point-max)) + (add-text-properties (match-beginning 0) (match-end 0) + '(face org-link)))) + (unless (eq org-agenda-remove-tags t) + (org-agenda-align-tags)) + (unless org-agenda-with-colors + (remove-text-properties (point-min) (point-max) '(face nil))) + (if (and (boundp 'org-agenda-overriding-columns-format) + org-agenda-overriding-columns-format) + (org-set-local 'org-agenda-overriding-columns-format + org-agenda-overriding-columns-format)) + (if (and (boundp 'org-agenda-view-columns-initially) + org-agenda-view-columns-initially) + (org-agenda-columns)) + (when org-agenda-fontify-priorities + (org-agenda-fontify-priorities)) + (when (and org-agenda-dim-blocked-tasks org-blocker-hook) + (org-agenda-dim-blocked-tasks)) + (org-agenda-mark-clocking-task) + (when org-agenda-entry-text-mode + (org-agenda-entry-text-hide) + (org-agenda-entry-text-show)) + (if (and (functionp 'org-habit-insert-consistency-graphs) + (save-excursion (next-single-property-change (point-min) 'org-habit-p))) + (org-habit-insert-consistency-graphs)) + (setq org-agenda-type (org-get-at-bol 'org-agenda-type)) + (unless (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq org-agenda-type org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (and (listp org-agenda-use-tag-inheritance) + (not (memq org-agenda-type + org-agenda-use-tag-inheritance)))))) + (let (mrk) + (save-excursion + (goto-char (point-min)) + (while (equal (forward-line) 0) + (when (setq mrk (get-text-property (point) 'org-hd-marker)) + (put-text-property (point-at-bol) (point-at-eol) + 'tags (org-with-point-at mrk + (delete-dups + (mapcar 'downcase (org-get-tags-at)))))))))) + (run-hooks 'org-agenda-finalize-hook) + (when org-agenda-top-headline-filter + (org-agenda-filter-top-headline-apply + org-agenda-top-headline-filter)) + (when org-agenda-tag-filter + (org-agenda-filter-apply org-agenda-tag-filter 'tag)) + (when (get 'org-agenda-tag-filter :preset-filter) + (org-agenda-filter-apply + (get 'org-agenda-tag-filter :preset-filter) 'tag)) + (when org-agenda-category-filter + (org-agenda-filter-apply org-agenda-category-filter 'category)) + (when (get 'org-agenda-category-filter :preset-filter) + (org-agenda-filter-apply + (get 'org-agenda-category-filter :preset-filter) 'category)) + (when org-agenda-regexp-filter + (org-agenda-filter-apply org-agenda-regexp-filter 'regexp)) + (when (get 'org-agenda-regexp-filter :preset-filter) + (org-agenda-filter-apply + (get 'org-agenda-regexp-filter :preset-filter) 'regexp)) + (org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local))))) + +(defun org-agenda-mark-clocking-task () + "Mark the current clock entry in the agenda if it is present." + ;; We need to widen when `org-agenda-finalize' is called from + ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in') + (when org-clock-current-task + (save-restriction + (widen) + (org-agenda-unmark-clocking-task) + (when (marker-buffer org-clock-hd-marker) + (save-excursion + (goto-char (point-min)) + (let (s ov) + (while (setq s (next-single-property-change (point) 'org-hd-marker)) + (goto-char s) + (when (equal (org-get-at-bol 'org-hd-marker) + org-clock-hd-marker) + (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol)))) + (overlay-put ov 'type 'org-agenda-clocking) + (overlay-put ov 'face 'org-agenda-clocking) + (overlay-put ov 'help-echo + "The clock is running in this item"))))))))) + +(defun org-agenda-unmark-clocking-task () + "Unmark the current clocking task." + (mapc (lambda (o) + (if (eq (overlay-get o 'type) 'org-agenda-clocking) + (delete-overlay o))) + (overlays-in (point-min) (point-max)))) + +(defun org-agenda-fontify-priorities () + "Make highest priority lines bold, and lowest italic." + (interactive) + (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-priority) + (delete-overlay o))) + (overlays-in (point-min) (point-max))) + (save-excursion + (let (b e p ov h l) + (goto-char (point-min)) + (while (re-search-forward "\\[#\\(.\\)\\]" nil t) + (setq h (or (get-char-property (point) 'org-highest-priority) + org-highest-priority) + l (or (get-char-property (point) 'org-lowest-priority) + org-lowest-priority) + p (string-to-char (match-string 1)) + b (match-beginning 0) + e (if (eq org-agenda-fontify-priorities 'cookies) + (match-end 0) + (point-at-eol)) + ov (make-overlay b e)) + (overlay-put + ov 'face + (cons (cond ((org-face-from-face-or-color + 'priority nil + (cdr (assoc p org-priority-faces)))) + ((and (listp org-agenda-fontify-priorities) + (org-face-from-face-or-color + 'priority nil + (cdr (assoc p org-agenda-fontify-priorities))))) + ((equal p l) 'italic) + ((equal p h) 'bold)) + 'org-priority)) + (overlay-put ov 'org-type 'org-priority))))) + +(defvar org-depend-tag-blocked) + +(defun org-agenda-dim-blocked-tasks (&optional invisible) + "Dim currently blocked TODO's in the agenda display. +When INVISIBLE is non-nil, hide currently blocked TODO instead of +dimming them." + (interactive "P") + (when (org-called-interactively-p 'interactive) + (message "Dim or hide blocked tasks...")) + (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-blocked-todo) + (delete-overlay o))) + (overlays-in (point-min) (point-max))) + (save-excursion + (let ((inhibit-read-only t) + (org-depend-tag-blocked nil) + (invis (or (not (null invisible)) + (eq org-agenda-dim-blocked-tasks 'invisible))) + org-blocked-by-checkboxes + invis1 b e p ov h l) + (goto-char (point-min)) + (while (let ((pos (next-single-property-change (point) 'todo-state))) + (and pos (goto-char (1+ pos)))) + (setq org-blocked-by-checkboxes nil invis1 invis) + (let ((marker (org-get-at-bol 'org-hd-marker))) + (when (and marker + (with-current-buffer (marker-buffer marker) + (save-excursion (goto-char marker) + (org-entry-blocked-p)))) + (if org-blocked-by-checkboxes (setq invis1 nil)) + (setq b (if invis1 + (max (point-min) (1- (point-at-bol))) + (point-at-bol)) + e (point-at-eol) + ov (make-overlay b e)) + (if invis1 + (progn (overlay-put ov 'invisible t) + (overlay-put ov 'intangible t)) + (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) + (overlay-put ov 'org-type 'org-blocked-todo)))))) + (when (org-called-interactively-p 'interactive) + (message "Dim or hide blocked tasks...done"))) + +(defvar org-agenda-skip-function nil + "Function to be called at each match during agenda construction. +If this function returns nil, the current match should not be skipped. +Otherwise, the function must return a position from where the search +should be continued. +This may also be a Lisp form, it will be evaluated. +Never set this variable using `setq' or so, because then it will apply +to all future agenda commands. If you do want a global skipping condition, +use the option `org-agenda-skip-function-global' instead. +The correct usage for `org-agenda-skip-function' is to bind it with +`let' to scope it dynamically into the agenda-constructing command. +A good way to set it is through options in `org-agenda-custom-commands'.") + +(defun org-agenda-skip () + "Throw to `:skip' in places that should be skipped. +Also moves point to the end of the skipped region, so that search can +continue from there." + (let ((p (point-at-bol)) to) + (when (or + (save-excursion (goto-char p) (looking-at comment-start-skip)) + (and org-agenda-skip-archived-trees (not org-agenda-archives-mode) + (get-text-property p :org-archived) + (org-end-of-subtree t)) + (and org-agenda-skip-comment-trees + (get-text-property p :org-comment) + (org-end-of-subtree t)) + (and (setq to (or (org-agenda-skip-eval org-agenda-skip-function-global) + (org-agenda-skip-eval org-agenda-skip-function))) + (goto-char to)) + (org-in-src-block-p t)) + (throw :skip t)))) + +(defun org-agenda-skip-eval (form) + "If FORM is a function or a list, call (or eval) it and return the result. +`save-excursion' and `save-match-data' are wrapped around the call, so point +and match data are returned to the previous state no matter what these +functions do." + (let (fp) + (and form + (or (setq fp (functionp form)) + (consp form)) + (save-excursion + (save-match-data + (if fp + (funcall form) + (eval form))))))) + +(defvar org-agenda-markers nil + "List of all currently active markers created by `org-agenda'.") +(defvar org-agenda-last-marker-time (org-float-time) + "Creation time of the last agenda marker.") + +(defun org-agenda-new-marker (&optional pos) + "Return a new agenda marker. +Org-mode keeps a list of these markers and resets them when they are +no longer in use." + (let ((m (copy-marker (or pos (point))))) + (setq org-agenda-last-marker-time (org-float-time)) + (if org-agenda-buffer + (with-current-buffer org-agenda-buffer + (push m org-agenda-markers)) + (push m org-agenda-markers)) + m)) + +(defun org-agenda-reset-markers () + "Reset markers created by `org-agenda'." + (while org-agenda-markers + (move-marker (pop org-agenda-markers) nil))) + +(defun org-agenda-save-markers-for-cut-and-paste (beg end) + "Save relative positions of markers in region. +This check for agenda markers in all agenda buffers currently active." + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (eq major-mode 'org-agenda-mode) + (mapc (lambda (m) (org-check-and-save-marker m beg end)) + org-agenda-markers))))) + +;;; Entry text mode + +(defun org-agenda-entry-text-show-here () + "Add some text from the entry as context to the current line." + (let (m txt o) + (setq m (org-get-at-bol 'org-hd-marker)) + (unless (marker-buffer m) + (error "No marker points to an entry here")) + (setq txt (concat "\n" (org-no-properties + (org-agenda-get-some-entry-text + m org-agenda-entry-text-maxlines + org-agenda-entry-text-leaders)))) + (when (string-match "\\S-" txt) + (setq o (make-overlay (point-at-bol) (point-at-eol))) + (overlay-put o 'evaporate t) + (overlay-put o 'org-overlay-type 'agenda-entry-content) + (overlay-put o 'after-string txt)))) + +(defun org-agenda-entry-text-show () + "Add entry context for all agenda lines." + (interactive) + (save-excursion + (goto-char (point-max)) + (beginning-of-line 1) + (while (not (bobp)) + (when (org-get-at-bol 'org-hd-marker) + (org-agenda-entry-text-show-here)) + (beginning-of-line 0)))) + +(defun org-agenda-entry-text-hide () + "Remove any shown entry context." + (delq nil + (mapcar (lambda (o) + (if (eq (overlay-get o 'org-overlay-type) + 'agenda-entry-content) + (progn (delete-overlay o) t))) + (overlays-in (point-min) (point-max))))) + +(defun org-agenda-get-day-face (date) + "Return the face DATE should be displayed with." + (or (and (functionp org-agenda-day-face-function) + (funcall org-agenda-day-face-function date)) + (cond ((org-agenda-todayp date) + 'org-agenda-date-today) + ((member (calendar-day-of-week date) org-agenda-weekend-days) + 'org-agenda-date-weekend) + (t 'org-agenda-date)))) + +;;; Agenda timeline + +(defvar org-agenda-only-exact-dates nil) ; dynamically scoped +(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list' + +(defun org-timeline (&optional dotodo) + "Show a time-sorted view of the entries in the current org file. +Only entries with a time stamp of today or later will be listed. With +\\[universal-argument] prefix, all unfinished TODO items will also be shown, +under the current date. +If the buffer contains an active region, only check the region for +dates." + (interactive "P") + (let* ((dopast t) + (org-agenda-show-log-scoped org-agenda-show-log) + (org-agenda-show-log org-agenda-show-log-scoped) + (entry (buffer-file-name (or (buffer-base-buffer (current-buffer)) + (current-buffer)))) + (date (calendar-current-date)) + (beg (if (org-region-active-p) (region-beginning) (point-min))) + (end (if (org-region-active-p) (region-end) (point-max))) + (day-numbers (org-get-all-dates + beg end 'no-ranges + t org-agenda-show-log-scoped ; always include today + org-timeline-show-empty-dates)) + (org-deadline-warning-days 0) + (org-agenda-only-exact-dates t) + (today (org-today)) + (past t) + args + s e rtn d emptyp) + (setq org-agenda-redo-command + (list 'let + (list (list 'org-agenda-show-log 'org-agenda-show-log)) + (list 'org-switch-to-buffer-other-window (current-buffer)) + (list 'org-timeline (list 'quote dotodo)))) + (put 'org-agenda-redo-command 'org-lprops nil) + (if (not dopast) + ;; Remove past dates from the list of dates. + (setq day-numbers (delq nil (mapcar (lambda(x) + (if (>= x today) x nil)) + day-numbers)))) + (org-agenda-prepare (concat "Timeline " (file-name-nondirectory entry))) + (org-compile-prefix-format 'timeline) + (org-set-sorting-strategy 'timeline) + (if org-agenda-show-log-scoped (push :closed args)) + (push :timestamp args) + (push :deadline args) + (push :scheduled args) + (push :sexp args) + (if dotodo (push :todo args)) + (insert "Timeline of file " entry "\n") + (add-text-properties (point-min) (point) + (list 'face 'org-agenda-structure)) + (org-agenda-mark-header-line (point-min)) + (while (setq d (pop day-numbers)) + (if (and (listp d) (eq (car d) :omitted)) + (progn + (setq s (point)) + (insert (format "\n[... %d empty days omitted]\n\n" (cdr d))) + (put-text-property s (1- (point)) 'face 'org-agenda-structure)) + (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil)) + (if (and (>= d today) + dopast + past) + (progn + (setq past nil) + (insert (make-string 79 ?-) "\n"))) + (setq date (calendar-gregorian-from-absolute d)) + (setq s (point)) + (setq rtn (and (not emptyp) + (apply 'org-agenda-get-day-entries entry + date args))) + (if (or rtn (equal d today) org-timeline-show-empty-dates) + (progn + (insert + (if (stringp org-agenda-format-date) + (format-time-string org-agenda-format-date + (org-time-from-absolute date)) + (funcall org-agenda-format-date date)) + "\n") + (put-text-property s (1- (point)) 'face + (org-agenda-get-day-face date)) + (put-text-property s (1- (point)) 'org-date-line t) + (put-text-property s (1- (point)) 'org-agenda-date-header t) + (if (equal d today) + (put-text-property s (1- (point)) 'org-today t)) + (and rtn (insert (org-agenda-finalize-entries rtn 'timeline) "\n")) + (put-text-property s (1- (point)) 'day d))))) + (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) + (point-min))) + (add-text-properties + (point-min) (point-max) + `(org-agenda-type timeline org-redo-cmd ,org-agenda-redo-command)) + (org-agenda-finalize) + (setq buffer-read-only t))) + +(defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re) + "Return a list of all relevant day numbers from BEG to END buffer positions. +If NO-RANGES is non-nil, include only the start and end dates of a range, +not every single day in the range. If FORCE-TODAY is non-nil, make +sure that TODAY is included in the list. If INACTIVE is non-nil, also +inactive time stamps (those in square brackets) are included. +When EMPTY is non-nil, also include days without any entries." + (let ((re (concat + (if pre-re pre-re "") + (if inactive org-ts-regexp-both org-ts-regexp))) + dates dates1 date day day1 day2 ts1 ts2 pos) + (if force-today + (setq dates (list (org-today)))) + (save-excursion + (goto-char beg) + (while (re-search-forward re end t) + (setq day (time-to-days (org-time-string-to-time + (substring (match-string 1) 0 10) + (current-buffer) (match-beginning 0)))) + (or (memq day dates) (push day dates))) + (unless no-ranges + (goto-char beg) + (while (re-search-forward org-tr-regexp end t) + (setq pos (match-beginning 0)) + (setq ts1 (substring (match-string 1) 0 10) + ts2 (substring (match-string 2) 0 10) + day1 (time-to-days (org-time-string-to-time + ts1 (current-buffer) pos)) + day2 (time-to-days (org-time-string-to-time + ts2 (current-buffer) pos))) + (while (< (setq day1 (1+ day1)) day2) + (or (memq day1 dates) (push day1 dates))))) + (setq dates (sort dates '<)) + (when empty + (while (setq day (pop dates)) + (setq day2 (car dates)) + (push day dates1) + (when (and day2 empty) + (if (or (eq empty t) + (and (numberp empty) (<= (- day2 day) empty))) + (while (< (setq day (1+ day)) day2) + (push (list day) dates1)) + (push (cons :omitted (- day2 day)) dates1)))) + (setq dates (nreverse dates1))) + dates))) + +;;; Agenda Daily/Weekly + +(defvar org-agenda-start-day nil ; dynamically scoped parameter + "Start day for the agenda view. +Custom commands can set this variable in the options section. +This is usually a string like \"2007-11-01\", \"+2d\" or any other +input allowed when reading a date through the Org calendar. +See the docstring of `org-read-date' for details.") +(defvar org-starting-day nil) ; local variable in the agenda buffer +(defvar org-arg-loc nil) ; local variable + +(defvar org-agenda-buffer-tmp-name nil) +;;;###autoload +(defun org-agenda-list (&optional arg start-day span with-hour) + "Produce a daily/weekly view from all files in variable `org-agenda-files'. +The view will be for the current day or week, but from the overview buffer +you will be able to go to other days/weeks. + +With a numeric prefix argument in an interactive call, the agenda will +span ARG days. Lisp programs should instead specify SPAN to change +the number of days. SPAN defaults to `org-agenda-span'. + +START-DAY defaults to TODAY, or to the most recent match for the weekday +given in `org-agenda-start-on-weekday'. + +When WITH-HOUR is non-nil, only include scheduled and deadline +items if they have an hour specification like [h]h:mm." + (interactive "P") + (if org-agenda-overriding-arguments + (setq arg (car org-agenda-overriding-arguments) + start-day (nth 1 org-agenda-overriding-arguments) + span (nth 2 org-agenda-overriding-arguments))) + (if (and (integerp arg) (> arg 0)) + (setq span arg arg nil)) + (catch 'exit + (setq org-agenda-buffer-name + (or org-agenda-buffer-tmp-name + (if org-agenda-sticky + (cond ((and org-keys (stringp org-match)) + (format "*Org Agenda(%s:%s)*" org-keys org-match)) + (org-keys + (format "*Org Agenda(%s)*" org-keys)) + (t "*Org Agenda(a)*"))) + org-agenda-buffer-name)) + (org-agenda-prepare "Day/Week") + (setq start-day (or start-day org-agenda-start-day)) + (if (stringp start-day) + ;; Convert to an absolute day number + (setq start-day (time-to-days (org-read-date nil t start-day)))) + (org-compile-prefix-format 'agenda) + (org-set-sorting-strategy 'agenda) + (let* ((span (org-agenda-ndays-to-span + (or span org-agenda-ndays org-agenda-span))) + (today (org-today)) + (sd (or start-day today)) + (ndays (org-agenda-span-to-ndays span sd)) + (org-agenda-start-on-weekday + (if (or (eq ndays 7) (eq ndays 14)) + org-agenda-start-on-weekday)) + (thefiles (org-agenda-files nil 'ifmode)) + (files thefiles) + (start (if (or (null org-agenda-start-on-weekday) + (< ndays 7)) + sd + (let* ((nt (calendar-day-of-week + (calendar-gregorian-from-absolute sd))) + (n1 org-agenda-start-on-weekday) + (d (- nt n1))) + (- sd (+ (if (< d 0) 7 0) d))))) + (day-numbers (list start)) + (day-cnt 0) + (inhibit-redisplay (not debug-on-error)) + (org-agenda-show-log-scoped org-agenda-show-log) + s e rtn rtnall file date d start-pos end-pos todayp + clocktable-start clocktable-end filter) + (setq org-agenda-redo-command + (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour)) + (dotimes (n (1- ndays)) + (push (1+ (car day-numbers)) day-numbers)) + (setq day-numbers (nreverse day-numbers)) + (setq clocktable-start (car day-numbers) + clocktable-end (1+ (or (org-last day-numbers) 0))) + (org-set-local 'org-starting-day (car day-numbers)) + (org-set-local 'org-arg-loc arg) + (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span)) + (unless org-agenda-compact-blocks + (let* ((d1 (car day-numbers)) + (d2 (org-last day-numbers)) + (w1 (org-days-to-iso-week d1)) + (w2 (org-days-to-iso-week d2))) + (setq s (point)) + (if org-agenda-overriding-header + (insert (org-add-props (copy-sequence org-agenda-overriding-header) + nil 'face 'org-agenda-structure) "\n") + (insert (org-agenda-span-name span) + "-agenda" + (if (< (- d2 d1) 350) + (if (= w1 w2) + (format " (W%02d)" w1) + (format " (W%02d-W%02d)" w1 w2)) + "") + ":\n"))) + (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure + 'org-date-line t)) + (org-agenda-mark-header-line s)) + (while (setq d (pop day-numbers)) + (setq date (calendar-gregorian-from-absolute d) + s (point)) + (if (or (setq todayp (= d today)) + (and (not start-pos) (= d sd))) + (setq start-pos (point)) + (if (and start-pos (not end-pos)) + (setq end-pos (point)))) + (setq files thefiles + rtnall nil) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (let ((org-agenda-entry-types org-agenda-entry-types)) + ;; Starred types override non-starred equivalents + (when (member :deadline* org-agenda-entry-types) + (setq org-agenda-entry-types + (delq :deadline org-agenda-entry-types))) + (when (member :scheduled* org-agenda-entry-types) + (setq org-agenda-entry-types + (delq :scheduled org-agenda-entry-types))) + ;; Honor with-hour + (when with-hour + (when (member :deadline org-agenda-entry-types) + (setq org-agenda-entry-types + (delq :deadline org-agenda-entry-types)) + (push :deadline* org-agenda-entry-types)) + (when (member :scheduled org-agenda-entry-types) + (setq org-agenda-entry-types + (delq :scheduled org-agenda-entry-types)) + (push :scheduled* org-agenda-entry-types))) + (unless org-agenda-include-deadlines + (setq org-agenda-entry-types + (delq :deadline* (delq :deadline org-agenda-entry-types)))) + (cond + ((memq org-agenda-show-log-scoped '(only clockcheck)) + (setq rtn (org-agenda-get-day-entries + file date :closed))) + (org-agenda-show-log-scoped + (setq rtn (apply 'org-agenda-get-day-entries + file date + (append '(:closed) org-agenda-entry-types)))) + (t + (setq rtn (apply 'org-agenda-get-day-entries + file date + org-agenda-entry-types))))) + (setq rtnall (append rtnall rtn)))) ;; all entries + (if org-agenda-include-diary + (let ((org-agenda-search-headline-for-time t)) + (require 'diary-lib) + (setq rtn (org-get-entries-from-diary date)) + (setq rtnall (append rtnall rtn)))) + (if (or rtnall org-agenda-show-all-dates) + (progn + (setq day-cnt (1+ day-cnt)) + (insert + (if (stringp org-agenda-format-date) + (format-time-string org-agenda-format-date + (org-time-from-absolute date)) + (funcall org-agenda-format-date date)) + "\n") + (put-text-property s (1- (point)) 'face + (org-agenda-get-day-face date)) + (put-text-property s (1- (point)) 'org-date-line t) + (put-text-property s (1- (point)) 'org-agenda-date-header t) + (put-text-property s (1- (point)) 'org-day-cnt day-cnt) + (when todayp + (put-text-property s (1- (point)) 'org-today t)) + (setq rtnall + (org-agenda-add-time-grid-maybe rtnall ndays todayp)) + (if rtnall (insert ;; all entries + (org-agenda-finalize-entries rtnall 'agenda) + "\n")) + (put-text-property s (1- (point)) 'day d) + (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))) + (when (and org-agenda-clockreport-mode clocktable-start) + (let ((org-agenda-files (org-agenda-files nil 'ifmode)) + ;; the above line is to ensure the restricted range! + (p (copy-sequence org-agenda-clockreport-parameter-plist)) + tbl) + (setq p (org-plist-delete p :block)) + (setq p (plist-put p :tstart clocktable-start)) + (setq p (plist-put p :tend clocktable-end)) + (setq p (plist-put p :scope 'agenda)) + (setq tbl (apply 'org-clock-get-clocktable p)) + (insert tbl))) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (unless (and (pos-visible-in-window-p (point-min)) + (pos-visible-in-window-p (point-max))) + (goto-char (1- (point-max))) + (recenter -1) + (if (not (pos-visible-in-window-p (or start-pos 1))) + (progn + (goto-char (or start-pos 1)) + (recenter 1)))) + (goto-char (or start-pos 1)) + (add-text-properties (point-min) (point-max) + `(org-agenda-type agenda + org-last-args (,arg ,start-day ,span) + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) + (if (eq org-agenda-show-log-scoped 'clockcheck) + (org-agenda-show-clocking-issues)) + (org-agenda-finalize) + (setq buffer-read-only t) + (message "")))) + +(defun org-agenda-ndays-to-span (n) + "Return a span symbol for a span of N days, or N if none matches." + (cond ((symbolp n) n) + ((= n 1) 'day) + ((= n 7) 'week) + ((= n 14) 'fortnight) + (t n))) + +(defun org-agenda-span-to-ndays (span &optional start-day) + "Return ndays from SPAN, possibly starting at START-DAY. +START-DAY is an absolute time value." + (cond ((numberp span) span) + ((eq span 'day) 1) + ((eq span 'week) 7) + ((eq span 'fortnight) 14) + ((eq span 'month) + (let ((date (calendar-gregorian-from-absolute start-day))) + (calendar-last-day-of-month (car date) (caddr date)))) + ((eq span 'year) + (let ((date (calendar-gregorian-from-absolute start-day))) + (if (calendar-leap-year-p (caddr date)) 366 365))))) + +(defun org-agenda-span-name (span) + "Return a SPAN name." + (if (null span) + "" + (if (symbolp span) + (capitalize (symbol-name span)) + (format "%d days" span)))) + +;;; Agenda word search + +(defvar org-agenda-search-history nil) + +(defvar org-search-syntax-table nil + "Special syntax table for org-mode search. +In this table, we have single quotes not as word constituents, to +that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"") + +(defvar org-mode-syntax-table) ; From org.el +(defun org-search-syntax-table () + (unless org-search-syntax-table + (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table)) + (modify-syntax-entry ?' "." org-search-syntax-table) + (modify-syntax-entry ?` "." org-search-syntax-table)) + org-search-syntax-table) + +(defvar org-agenda-last-search-view-search-was-boolean nil) + +;;;###autoload +(defun org-search-view (&optional todo-only string edit-at) + "Show all entries that contain a phrase or words or regular expressions. + +With optional prefix argument TODO-ONLY, only consider entries that are +TODO entries. The argument STRING can be used to pass a default search +string into this function. If EDIT-AT is non-nil, it means that the +user should get a chance to edit this string, with cursor at position +EDIT-AT. + +The search string can be viewed either as a phrase that should be found as +is, or it can be broken into a number of snippets, each of which must match +in a Boolean way to select an entry. The default depends on the variable +`org-agenda-search-view-always-boolean'. +Even if this is turned off (the default) you can always switch to +Boolean search dynamically by preceding the first word with \"+\" or \"-\". + +The default is a direct search of the whole phrase, where each space in +the search string can expand to an arbitrary amount of whitespace, +including newlines. + +If using a Boolean search, the search string is split on whitespace and +each snippet is searched separately, with logical AND to select an entry. +Words prefixed with a minus must *not* occur in the entry. Words without +a prefix or prefixed with a plus must occur in the entry. Matching is +case-insensitive. Words are enclosed by word delimiters (i.e. they must +match whole words, not parts of a word) if +`org-agenda-search-view-force-full-words' is set (default is nil). + +Boolean search snippets enclosed by curly braces are interpreted as +regular expressions that must or (when preceded with \"-\") must not +match in the entry. Snippets enclosed into double quotes will be taken +as a whole, to include whitespace. + +- If the search string starts with an asterisk, search only in headlines. +- If (possibly after the leading star) the search string starts with an + exclamation mark, this also means to look at TODO entries only, an effect + that can also be achieved with a prefix argument. +- If (possibly after star and exclamation mark) the search string starts + with a colon, this will mean that the (non-regexp) snippets of the + Boolean search must match as full words. + +This command searches the agenda files, and in addition the files listed +in `org-agenda-text-search-extra-files'." + (interactive "P") + (if org-agenda-overriding-arguments + (setq todo-only (car org-agenda-overriding-arguments) + string (nth 1 org-agenda-overriding-arguments) + edit-at (nth 2 org-agenda-overriding-arguments))) + (let* ((props (list 'face nil + 'done-face 'org-agenda-done + 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'mouse-face 'highlight + 'help-echo (format "mouse-2 or RET jump to location"))) + (full-words org-agenda-search-view-force-full-words) + (org-agenda-text-search-extra-files org-agenda-text-search-extra-files) + regexp rtn rtnall files file pos inherited-tags + marker category category-pos level tags c neg re boolean + ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) + (unless (and (not edit-at) + (stringp string) + (string-match "\\S-" string)) + (setq string (read-string + (if org-agenda-search-view-always-boolean + "[+-]Word/{Regexp} ...: " + "Phrase or [+-]Word/{Regexp} ...: ") + (cond + ((integerp edit-at) (cons string edit-at)) + (edit-at string)) + 'org-agenda-search-history))) + (catch 'exit + (if org-agenda-sticky + (setq org-agenda-buffer-name + (if (stringp string) + (format "*Org Agenda(%s:%s)*" + (or org-keys (or (and todo-only "S") "s")) string) + (format "*Org Agenda(%s)*" (or (and todo-only "S") "s"))))) + (org-agenda-prepare "SEARCH") + (org-compile-prefix-format 'search) + (org-set-sorting-strategy 'search) + (setq org-agenda-redo-command + (list 'org-search-view (if todo-only t nil) + (list 'if 'current-prefix-arg nil string))) + (setq org-agenda-query-string string) + (if (equal (string-to-char string) ?*) + (setq hdl-only t + words (substring string 1)) + (setq words string)) + (when (equal (string-to-char words) ?!) + (setq todo-only t + words (substring words 1))) + (when (equal (string-to-char words) ?:) + (setq full-words t + words (substring words 1))) + (if (or org-agenda-search-view-always-boolean + (member (string-to-char words) '(?- ?+ ?\{))) + (setq boolean t)) + (setq words (org-split-string words)) + (let (www w) + (while (setq w (pop words)) + (while (and (string-match "\\\\\\'" w) words) + (setq w (concat (substring w 0 -1) " " (pop words)))) + (push w www)) + (setq words (nreverse www) www nil) + (while (setq w (pop words)) + (when (and (string-match "\\`[-+]?{" w) + (not (string-match "}\\'" w))) + (while (and words (not (string-match "}\\'" (car words)))) + (setq w (concat w " " (pop words)))) + (setq w (concat w " " (pop words)))) + (push w www)) + (setq words (nreverse www))) + (setq org-agenda-last-search-view-search-was-boolean boolean) + (when boolean + (let (wds w) + (while (setq w (pop words)) + (if (or (equal (substring w 0 1) "\"") + (and (> (length w) 1) + (member (substring w 0 1) '("+" "-")) + (equal (substring w 1 2) "\""))) + (while (and words (not (equal (substring w -1) "\""))) + (setq w (concat w " " (pop words))))) + (and (string-match "\\`\\([-+]?\\)\"" w) + (setq w (replace-match "\\1" nil nil w))) + (and (equal (substring w -1) "\"") (setq w (substring w 0 -1))) + (push w wds)) + (setq words (nreverse wds)))) + (if boolean + (mapc (lambda (w) + (setq c (string-to-char w)) + (if (equal c ?-) + (setq neg t w (substring w 1)) + (if (equal c ?+) + (setq neg nil w (substring w 1)) + (setq neg nil))) + (if (string-match "\\`{.*}\\'" w) + (setq re (substring w 1 -1)) + (if full-words + (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>")) + (setq re (regexp-quote (downcase w))))) + (if neg (push re regexps-) (push re regexps+))) + words) + (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+") + regexps+)) + (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) + (if (not regexps+) + (setq regexp org-outline-regexp-bol) + (setq regexp (pop regexps+)) + (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?" + regexp)))) + (setq files (org-agenda-files nil 'ifmode)) + (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) + (pop org-agenda-text-search-extra-files) + (setq files (org-add-archive-files files))) + (setq files (append files org-agenda-text-search-extra-files) + rtnall nil) + (while (setq file (pop files)) + (setq ee nil) + (catch 'nextfile + (org-check-agenda-file file) + (setq buffer (if (file-exists-p file) + (org-get-agenda-file-buffer file) + (error "No such file %s" file))) + (if (not buffer) + ;; If file does not exist, make sure an error message is sent + (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s" + file)))) + (with-current-buffer buffer + (with-syntax-table (org-search-syntax-table) + (unless (derived-mode-p 'org-mode) + (error "Agenda file %s is not in `org-mode'" file)) + (let ((case-fold-search t)) + (save-excursion + (save-restriction + (if (eq buffer org-agenda-restrict) + (narrow-to-region org-agenda-restrict-begin + org-agenda-restrict-end) + (widen)) + (goto-char (point-min)) + (unless (or (org-at-heading-p) + (outline-next-heading)) + (throw 'nextfile t)) + (goto-char (max (point-min) (1- (point)))) + (while (re-search-forward regexp nil t) + (org-back-to-heading t) + (while (and (not (zerop org-agenda-search-view-max-outline-level)) + (> (org-reduced-level (org-outline-level)) + org-agenda-search-view-max-outline-level) + (forward-line -1) + (outline-back-to-heading t))) + (skip-chars-forward "* ") + (setq beg (point-at-bol) + beg1 (point) + end (progn + (outline-next-heading) + (while (and (not (zerop org-agenda-search-view-max-outline-level)) + (> (org-reduced-level (org-outline-level)) + org-agenda-search-view-max-outline-level) + (forward-line 1) + (outline-next-heading))) + (point))) + + (catch :skip + (goto-char beg) + (org-agenda-skip) + (setq str (buffer-substring-no-properties + (point-at-bol) + (if hdl-only (point-at-eol) end))) + (mapc (lambda (wr) (when (string-match wr str) + (goto-char (1- end)) + (throw :skip t))) + regexps-) + (mapc (lambda (wr) (unless (string-match wr str) + (goto-char (1- end)) + (throw :skip t))) + (if todo-only + (cons (concat "^\*+[ \t]+" org-not-done-regexp) + regexps+) + regexps+)) + (goto-char beg) + (setq marker (org-agenda-new-marker (point)) + category (org-get-category) + level (make-string (org-reduced-level (org-outline-level)) ? ) + category-pos (get-text-property (point) 'org-category-position) + inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'todo org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'todo org-agenda-use-tag-inheritance)))) + tags (org-get-tags-at nil (not inherited-tags)) + txt (org-agenda-format-item + "" + (buffer-substring-no-properties + beg1 (point-at-eol)) + level category tags t)) + (org-add-props txt props + 'org-marker marker 'org-hd-marker marker + 'org-todo-regexp org-todo-regexp + 'level level + 'org-complex-heading-regexp org-complex-heading-regexp + 'priority 1000 'org-category category + 'org-category-position category-pos + 'type "search") + (push txt ee) + (goto-char (1- end)))))))))) + (setq rtn (nreverse ee)) + (setq rtnall (append rtnall rtn))) + (if org-agenda-overriding-header + (insert (org-add-props (copy-sequence org-agenda-overriding-header) + nil 'face 'org-agenda-structure) "\n") + (insert "Search words: ") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-agenda-structure)) + (setq pos (point)) + (insert string "\n") + (add-text-properties pos (1- (point)) (list 'face 'org-warning)) + (setq pos (point)) + (unless org-agenda-multi + (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n") + (add-text-properties pos (1- (point)) + (list 'face 'org-agenda-structure)))) + (org-agenda-mark-header-line (point-min)) + (when rtnall + (insert (org-agenda-finalize-entries rtnall 'search) "\n")) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (add-text-properties (point-min) (point-max) + `(org-agenda-type search + org-last-args (,todo-only ,string ,edit-at) + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) + (org-agenda-finalize) + (setq buffer-read-only t)))) + +;;; Agenda TODO list + +(defun org-agenda-propertize-selected-todo-keywords (keywords) + "Use `org-todo-keyword-faces' for the selected todo KEYWORDS." + (concat + (if (or (equal keywords "ALL") (not keywords)) + (propertize "ALL" 'face 'warning) + (mapconcat + (lambda (kw) + (propertize kw 'face (org-get-todo-face kw))) + (org-split-string keywords "|") + "|")) + "\n")) + +(defvar org-select-this-todo-keyword nil) +(defvar org-last-arg nil) + +;;;###autoload +(defun org-todo-list (&optional arg) + "Show all (not done) TODO entries from all agenda file in a single list. +The prefix arg can be used to select a specific TODO keyword and limit +the list to these. When using \\[universal-argument], you will be prompted +for a keyword. A numeric prefix directly selects the Nth keyword in +`org-todo-keywords-1'." + (interactive "P") + (if org-agenda-overriding-arguments + (setq arg org-agenda-overriding-arguments)) + (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) + (let* ((today (org-today)) + (date (calendar-gregorian-from-absolute today)) + (kwds org-todo-keywords-for-agenda) + (completion-ignore-case t) + (org-select-this-todo-keyword + (if (stringp arg) arg + (and arg (integerp arg) (> arg 0) + (nth (1- arg) kwds)))) + rtn rtnall files file pos) + (when (equal arg '(4)) + (setq org-select-this-todo-keyword + (org-icompleting-read "Keyword (or KWD1|K2D2|...): " + (mapcar 'list kwds) nil nil))) + (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) + (catch 'exit + (if org-agenda-sticky + (setq org-agenda-buffer-name + (if (stringp org-select-this-todo-keyword) + (format "*Org Agenda(%s:%s)*" (or org-keys "t") + org-select-this-todo-keyword) + (format "*Org Agenda(%s)*" (or org-keys "t"))))) + (org-agenda-prepare "TODO") + (org-compile-prefix-format 'todo) + (org-set-sorting-strategy 'todo) + (setq org-agenda-redo-command + `(org-todo-list (or (and (numberp current-prefix-arg) + current-prefix-arg) + ,org-select-this-todo-keyword + current-prefix-arg ,arg))) + (setq files (org-agenda-files nil 'ifmode) + rtnall nil) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (setq rtn (org-agenda-get-day-entries file date :todo)) + (setq rtnall (append rtnall rtn)))) + (if org-agenda-overriding-header + (insert (org-add-props (copy-sequence org-agenda-overriding-header) + nil 'face 'org-agenda-structure) "\n") + (insert "Global list of TODO items of type: ") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-agenda-structure + 'short-heading + (concat "ToDo: " + (or org-select-this-todo-keyword "ALL")))) + (org-agenda-mark-header-line (point-min)) + (insert (org-agenda-propertize-selected-todo-keywords + org-select-this-todo-keyword)) + (setq pos (point)) + (unless org-agenda-multi + (insert "Available with `N r': (0)[ALL]") + (let ((n 0) s) + (mapc (lambda (x) + (setq s (format "(%d)%s" (setq n (1+ n)) x)) + (if (> (+ (current-column) (string-width s) 1) (frame-width)) + (insert "\n ")) + (insert " " s)) + kwds)) + (insert "\n")) + (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) + (org-agenda-mark-header-line (point-min)) + (when rtnall + (insert (org-agenda-finalize-entries rtnall 'todo) "\n")) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (add-text-properties (point-min) (point-max) + `(org-agenda-type todo + org-last-args ,arg + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) + (org-agenda-finalize) + (setq buffer-read-only t)))) + +;;; Agenda tags match + +;;;###autoload +(defun org-tags-view (&optional todo-only match) + "Show all headlines for all `org-agenda-files' matching a TAGS criterion. +The prefix arg TODO-ONLY limits the search to TODO entries." + (interactive "P") + (if org-agenda-overriding-arguments + (setq todo-only (car org-agenda-overriding-arguments) + match (nth 1 org-agenda-overriding-arguments))) + (let* ((org-tags-match-list-sublevels + org-tags-match-list-sublevels) + (completion-ignore-case t) + rtn rtnall files file pos matcher + buffer) + (when (and (stringp match) (not (string-match "\\S-" match))) + (setq match nil)) + (catch 'exit + (if org-agenda-sticky + (setq org-agenda-buffer-name + (if (stringp match) + (format "*Org Agenda(%s:%s)*" + (or org-keys (or (and todo-only "M") "m")) match) + (format "*Org Agenda(%s)*" (or (and todo-only "M") "m"))))) + ;; Prepare agendas (and `org-tag-alist-for-agenda') before + ;; expanding tags within `org-make-tags-matcher' + (org-agenda-prepare (concat "TAGS " match)) + (setq matcher (org-make-tags-matcher match) + match (car matcher) matcher (cdr matcher)) + (org-compile-prefix-format 'tags) + (org-set-sorting-strategy 'tags) + (setq org-agenda-query-string match) + (setq org-agenda-redo-command + (list 'org-tags-view `(quote ,todo-only) + (list 'if 'current-prefix-arg nil `(quote ,org-agenda-query-string)))) + (setq files (org-agenda-files nil 'ifmode) + rtnall nil) + (while (setq file (pop files)) + (catch 'nextfile + (org-check-agenda-file file) + (setq buffer (if (file-exists-p file) + (org-get-agenda-file-buffer file) + (error "No such file %s" file))) + (if (not buffer) + ;; If file does not exist, error message to agenda + (setq rtn (list + (format "ORG-AGENDA-ERROR: No such org-file %s" file)) + rtnall (append rtnall rtn)) + (with-current-buffer buffer + (unless (derived-mode-p 'org-mode) + (error "Agenda file %s is not in `org-mode'" file)) + (save-excursion + (save-restriction + (if (eq buffer org-agenda-restrict) + (narrow-to-region org-agenda-restrict-begin + org-agenda-restrict-end) + (widen)) + (setq rtn (org-scan-tags 'agenda matcher todo-only)) + (setq rtnall (append rtnall rtn)))))))) + (if org-agenda-overriding-header + (insert (org-add-props (copy-sequence org-agenda-overriding-header) + nil 'face 'org-agenda-structure) "\n") + (insert "Headlines with TAGS match: ") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-agenda-structure + 'short-heading + (concat "Match: " match))) + (setq pos (point)) + (insert match "\n") + (add-text-properties pos (1- (point)) (list 'face 'org-warning)) + (setq pos (point)) + (unless org-agenda-multi + (insert "Press `C-u r' to search again with new search string\n")) + (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) + (org-agenda-mark-header-line (point-min)) + (when rtnall + (insert (org-agenda-finalize-entries rtnall 'tags) "\n")) + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (add-text-properties (point-min) (point-max) + `(org-agenda-type tags + org-last-args (,todo-only ,match) + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) + (org-agenda-finalize) + (setq buffer-read-only t)))) + +;;; Agenda Finding stuck projects + +(defvar org-agenda-skip-regexp nil + "Regular expression used in skipping subtrees for the agenda. +This is basically a temporary global variable that can be set and then +used by user-defined selections using `org-agenda-skip-function'.") + +(defvar org-agenda-overriding-header nil + "When set during agenda, todo and tags searches it replaces the header. +This variable should not be set directly, but custom commands can bind it +in the options section.") + +(defun org-agenda-skip-entry-when-regexp-matches () + "Check if the current entry contains match for `org-agenda-skip-regexp'. +If yes, it returns the end position of this entry, causing agenda commands +to skip the entry but continuing the search in the subtree. This is a +function that can be put into `org-agenda-skip-function' for the duration +of a command." + (let ((end (save-excursion (org-end-of-subtree t))) + skip) + (save-excursion + (setq skip (re-search-forward org-agenda-skip-regexp end t))) + (and skip end))) + +(defun org-agenda-skip-subtree-when-regexp-matches () + "Check if the current subtree contains match for `org-agenda-skip-regexp'. +If yes, it returns the end position of this tree, causing agenda commands +to skip this subtree. This is a function that can be put into +`org-agenda-skip-function' for the duration of a command." + (let ((end (save-excursion (org-end-of-subtree t))) + skip) + (save-excursion + (setq skip (re-search-forward org-agenda-skip-regexp end t))) + (and skip end))) + +(defun org-agenda-skip-entry-when-regexp-matches-in-subtree () + "Check if the current subtree contains match for `org-agenda-skip-regexp'. +If yes, it returns the end position of the current entry (NOT the tree), +causing agenda commands to skip the entry but continuing the search in +the subtree. This is a function that can be put into +`org-agenda-skip-function' for the duration of a command. An important +use of this function is for the stuck project list." + (let ((end (save-excursion (org-end-of-subtree t))) + (entry-end (save-excursion (outline-next-heading) (1- (point)))) + skip) + (save-excursion + (setq skip (re-search-forward org-agenda-skip-regexp end t))) + (and skip entry-end))) + +(defun org-agenda-skip-entry-if (&rest conditions) + "Skip entry if any of CONDITIONS is true. +See `org-agenda-skip-if' for details." + (org-agenda-skip-if nil conditions)) + +(defun org-agenda-skip-subtree-if (&rest conditions) + "Skip subtree if any of CONDITIONS is true. +See `org-agenda-skip-if' for details." + (org-agenda-skip-if t conditions)) + +(defun org-agenda-skip-if (subtree conditions) + "Checks current entity for CONDITIONS. +If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only +the entry (i.e. the text before the next heading) is checked. + +CONDITIONS is a list of symbols, boolean OR is used to combine the results +from different tests. Valid conditions are: + +scheduled Check if there is a scheduled cookie +notscheduled Check if there is no scheduled cookie +deadline Check if there is a deadline +notdeadline Check if there is no deadline +timestamp Check if there is a timestamp (also deadline or scheduled) +nottimestamp Check if there is no timestamp (also deadline or scheduled) +regexp Check if regexp matches +notregexp Check if regexp does not match. +todo Check if TODO keyword matches +nottodo Check if TODO keyword does not match + +The regexp is taken from the conditions list, it must come right after +the `regexp' or `notregexp' element. + +`todo' and `nottodo' accept as an argument a list of todo +keywords, which may include \"*\" to match any todo keyword. + + (org-agenda-skip-entry-if 'todo '(\"TODO\" \"WAITING\")) + +would skip all entries with \"TODO\" or \"WAITING\" keywords. + +Instead of a list, a keyword class may be given. For example: + + (org-agenda-skip-entry-if 'nottodo 'done) + +would skip entries that haven't been marked with any of \"DONE\" +keywords. Possible classes are: `todo', `done', `any'. + +If any of these conditions is met, this function returns the end point of +the entity, causing the search to continue from there. This is a function +that can be put into `org-agenda-skip-function' for the duration of a command." + (let (beg end m) + (org-back-to-heading t) + (setq beg (point) + end (if subtree + (progn (org-end-of-subtree t) (point)) + (progn (outline-next-heading) (1- (point))))) + (goto-char beg) + (and + (or + (and (memq 'scheduled conditions) + (re-search-forward org-scheduled-time-regexp end t)) + (and (memq 'notscheduled conditions) + (not (re-search-forward org-scheduled-time-regexp end t))) + (and (memq 'deadline conditions) + (re-search-forward org-deadline-time-regexp end t)) + (and (memq 'notdeadline conditions) + (not (re-search-forward org-deadline-time-regexp end t))) + (and (memq 'timestamp conditions) + (re-search-forward org-ts-regexp end t)) + (and (memq 'nottimestamp conditions) + (not (re-search-forward org-ts-regexp end t))) + (and (setq m (memq 'regexp conditions)) + (stringp (nth 1 m)) + (re-search-forward (nth 1 m) end t)) + (and (setq m (memq 'notregexp conditions)) + (stringp (nth 1 m)) + (not (re-search-forward (nth 1 m) end t))) + (and (or + (setq m (memq 'nottodo conditions)) + (setq m (memq 'todo-unblocked conditions)) + (setq m (memq 'nottodo-unblocked conditions)) + (setq m (memq 'todo conditions))) + (org-agenda-skip-if-todo m end))) + end))) + +(defun org-agenda-skip-if-todo (args end) + "Helper function for `org-agenda-skip-if', do not use it directly. +ARGS is a list with first element either `todo', `nottodo', +`todo-unblocked' or `nottodo-unblocked'. The remainder is either +a list of TODO keywords, or a state symbol `todo' or `done' or +`any'." + (let ((kw (car args)) + (arg (cadr args)) + todo-wds todo-re) + (setq todo-wds + (org-uniquify + (cond + ((listp arg) ;; list of keywords + (if (member "*" arg) + (mapcar 'substring-no-properties org-todo-keywords-1) + arg)) + ((symbolp arg) ;; keyword class name + (cond + ((eq arg 'todo) + (org-delete-all org-done-keywords + (mapcar 'substring-no-properties + org-todo-keywords-1))) + ((eq arg 'done) org-done-keywords) + ((eq arg 'any) + (mapcar 'substring-no-properties org-todo-keywords-1))))))) + (setq todo-re + (concat "^\\*+[ \t]+\\<\\(" + (mapconcat 'identity todo-wds "\\|") + "\\)\\>")) + (cond + ((eq kw 'todo) (re-search-forward todo-re end t)) + ((eq kw 'nottodo) (not (re-search-forward todo-re end t))) + ((eq kw 'todo-unblocked) + (catch 'unblocked + (while (re-search-forward todo-re end t) + (or (org-entry-blocked-p) (throw 'unblocked t))) + nil)) + ((eq kw 'nottodo-unblocked) + (catch 'unblocked + (while (re-search-forward todo-re end t) + (or (org-entry-blocked-p) (throw 'unblocked nil))) + t)) + ))) + +;;;###autoload +(defun org-agenda-list-stuck-projects (&rest ignore) + "Create agenda view for projects that are stuck. +Stuck projects are project that have no next actions. For the definitions +of what a project is and how to check if it stuck, customize the variable +`org-stuck-projects'." + (interactive) + (let* ((org-agenda-skip-function + 'org-agenda-skip-entry-when-regexp-matches-in-subtree) + ;; We could have used org-agenda-skip-if here. + (org-agenda-overriding-header + (or org-agenda-overriding-header "List of stuck projects: ")) + (matcher (nth 0 org-stuck-projects)) + (todo (nth 1 org-stuck-projects)) + (todo-wds (if (member "*" todo) + (progn + (org-agenda-prepare-buffers (org-agenda-files + nil 'ifmode)) + (org-delete-all + org-done-keywords-for-agenda + (copy-sequence org-todo-keywords-for-agenda))) + todo)) + (todo-re (concat "^\\*+[ \t]+\\(" + (mapconcat 'identity todo-wds "\\|") + "\\)\\>")) + (tags (nth 2 org-stuck-projects)) + (tags-re (if (member "*" tags) + (concat org-outline-regexp-bol + (org-re ".*:[[:alnum:]_@#%]+:[ \t]*$")) + (if tags + (concat org-outline-regexp-bol + ".*:\\(" + (mapconcat 'identity tags "\\|") + (org-re "\\):[[:alnum:]_@#%:]*[ \t]*$"))))) + (gen-re (nth 3 org-stuck-projects)) + (re-list + (delq nil + (list + (if todo todo-re) + (if tags tags-re) + (and gen-re (stringp gen-re) (string-match "\\S-" gen-re) + gen-re))))) + (setq org-agenda-skip-regexp + (if re-list + (mapconcat 'identity re-list "\\|") + (error "No information how to identify unstuck projects"))) + (org-tags-view nil matcher) + (setq org-agenda-buffer-name (buffer-name)) + (with-current-buffer org-agenda-buffer-name + (setq org-agenda-redo-command + `(org-agenda-list-stuck-projects ,current-prefix-arg))))) + +;;; Diary integration + +(defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. +(defvar diary-list-entries-hook) +(defvar diary-time-regexp) +(defun org-get-entries-from-diary (date) + "Get the (Emacs Calendar) diary entries for DATE." + (require 'diary-lib) + (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*") + (diary-display-function 'diary-fancy-display) + (pop-up-frames nil) + (diary-list-entries-hook + (cons 'org-diary-default-entry diary-list-entries-hook)) + (diary-file-name-prefix nil) ; turn this feature off + (diary-modify-entry-list-string-function 'org-modify-diary-entry-string) + entries + (org-disable-agenda-to-diary t)) + (save-excursion + (save-window-excursion + (funcall (if (fboundp 'diary-list-entries) + 'diary-list-entries 'list-diary-entries) + date 1))) + (if (not (get-buffer diary-fancy-buffer)) + (setq entries nil) + (with-current-buffer diary-fancy-buffer + (setq buffer-read-only nil) + (if (zerop (buffer-size)) + ;; No entries + (setq entries nil) + ;; Omit the date and other unnecessary stuff + (org-agenda-cleanup-fancy-diary) + ;; Add prefix to each line and extend the text properties + (if (zerop (buffer-size)) + (setq entries nil) + (setq entries (buffer-substring (point-min) (- (point-max) 1))) + (setq entries + (with-temp-buffer + (insert entries) (goto-char (point-min)) + (while (re-search-forward "\n[ \t]+\\(.+\\)$" nil t) + (unless (save-match-data (string-match diary-time-regexp (match-string 1))) + (replace-match (concat "; " (match-string 1))))) + (buffer-string))))) + (set-buffer-modified-p nil) + (kill-buffer diary-fancy-buffer))) + (when entries + (setq entries (org-split-string entries "\n")) + (setq entries + (mapcar + (lambda (x) + (setq x (org-agenda-format-item "" x nil "Diary" nil 'time)) + ;; Extend the text properties to the beginning of the line + (org-add-props x (text-properties-at (1- (length x)) x) + 'type "diary" 'date date 'face 'org-agenda-diary)) + entries))))) + +(defvar org-agenda-cleanup-fancy-diary-hook nil + "Hook run when the fancy diary buffer is cleaned up.") + +(defun org-agenda-cleanup-fancy-diary () + "Remove unwanted stuff in buffer created by `fancy-diary-display'. +This gets rid of the date, the underline under the date, and +the dummy entry installed by `org-mode' to ensure non-empty diary for each +date. It also removes lines that contain only whitespace." + (goto-char (point-min)) + (if (looking-at ".*?:[ \t]*") + (progn + (replace-match "") + (re-search-forward "\n=+$" nil t) + (replace-match "") + (while (re-search-backward "^ +\n?" nil t) (replace-match ""))) + (re-search-forward "\n=+$" nil t) + (delete-region (point-min) (min (point-max) (1+ (match-end 0))))) + (goto-char (point-min)) + (while (re-search-forward "^ +\n" nil t) + (replace-match "")) + (goto-char (point-min)) + (if (re-search-forward "^Org-mode dummy\n?" nil t) + (replace-match "")) + (run-hooks 'org-agenda-cleanup-fancy-diary-hook)) + +;; Make sure entries from the diary have the right text properties. +(eval-after-load "diary-lib" + '(if (boundp 'diary-modify-entry-list-string-function) + ;; We can rely on the hook, nothing to do + nil + ;; Hook not available, must use advice to make this work + (defadvice add-to-diary-list (before org-mark-diary-entry activate) + "Make the position visible." + (if (and org-disable-agenda-to-diary ;; called from org-agenda + (stringp string) + buffer-file-name) + (setq string (org-modify-diary-entry-string string)))))) + +(defun org-modify-diary-entry-string (string) + "Add text properties to string, allowing org-mode to act on it." + (org-add-props string nil + 'mouse-face 'highlight + 'help-echo (if buffer-file-name + (format "mouse-2 or RET jump to diary file %s" + (abbreviate-file-name buffer-file-name)) + "") + 'org-agenda-diary-link t + 'org-marker (org-agenda-new-marker (point-at-bol)))) + +(defun org-diary-default-entry () + "Add a dummy entry to the diary. +Needed to avoid empty dates which mess up holiday display." + ;; Catch the error if dealing with the new add-to-diary-alist + (when org-disable-agenda-to-diary + (condition-case nil + (org-add-to-diary-list original-date "Org-mode dummy" "") + (error + (org-add-to-diary-list original-date "Org-mode dummy" "" nil))))) + +(defun org-add-to-diary-list (&rest args) + (if (fboundp 'diary-add-to-list) + (apply 'diary-add-to-list args) + (apply 'add-to-diary-list args))) + +(defvar org-diary-last-run-time nil) + +;;;###autoload +(defun org-diary (&rest args) + "Return diary information from org files. +This function can be used in a \"sexp\" diary entry in the Emacs calendar. +It accesses org files and extracts information from those files to be +listed in the diary. The function accepts arguments specifying what +items should be listed. For a list of arguments allowed here, see the +variable `org-agenda-entry-types'. + +The call in the diary file should look like this: + + &%%(org-diary) ~/path/to/some/orgfile.org + +Use a separate line for each org file to check. Or, if you omit the file name, +all files listed in `org-agenda-files' will be checked automatically: + + &%%(org-diary) + +If you don't give any arguments (as in the example above), the default value +of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp). +So the example above may also be written as + + &%%(org-diary :deadline :timestamp :sexp :scheduled) + +The function expects the lisp variables `entry' and `date' to be provided +by the caller, because this is how the calendar works. Don't use this +function from a program - use `org-agenda-get-day-entries' instead." + (when (> (- (org-float-time) + org-agenda-last-marker-time) + 5) + ;; I am not sure if this works with sticky agendas, because the marker + ;; list is then no longer a global variable. + (org-agenda-reset-markers)) + (org-compile-prefix-format 'agenda) + (org-set-sorting-strategy 'agenda) + (setq args (or args org-agenda-entry-types)) + (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) + (list entry) + (org-agenda-files t))) + (time (org-float-time)) + file rtn results) + (when (or (not org-diary-last-run-time) + (> (- time + org-diary-last-run-time) + 3)) + (org-agenda-prepare-buffers files)) + (setq org-diary-last-run-time time) + ;; If this is called during org-agenda, don't return any entries to + ;; the calendar. Org Agenda will list these entries itself. + (if org-disable-agenda-to-diary (setq files nil)) + (while (setq file (pop files)) + (setq rtn (apply 'org-agenda-get-day-entries file date args)) + (setq results (append results rtn))) + (when results + (setq results + (mapcar (lambda (i) (replace-regexp-in-string + org-bracket-link-regexp "\\3" i)) results)) + (concat (org-agenda-finalize-entries results) "\n")))) + +;;; Agenda entry finders + +(defun org-agenda-get-day-entries (file date &rest args) + "Does the work for `org-diary' and `org-agenda'. +FILE is the path to a file to be checked for entries. DATE is date like +the one returned by `calendar-current-date'. ARGS are symbols indicating +which kind of entries should be extracted. For details about these, see +the documentation of `org-diary'." + (setq args (or args org-agenda-entry-types)) + (let* ((org-startup-folded nil) + (org-startup-align-all-tables nil) + (buffer (if (file-exists-p file) + (org-get-agenda-file-buffer file) + (error "No such file %s" file))) + arg results rtn deadline-results) + (if (not buffer) + ;; If file does not exist, make sure an error message ends up in diary + (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) + (with-current-buffer buffer + (unless (derived-mode-p 'org-mode) + (error "Agenda file %s is not in `org-mode'" file)) + (setq org-agenda-buffer (or org-agenda-buffer buffer)) + (let ((case-fold-search nil)) + (save-excursion + (save-restriction + (if (eq buffer org-agenda-restrict) + (narrow-to-region org-agenda-restrict-begin + org-agenda-restrict-end) + (widen)) + ;; The way we repeatedly append to `results' makes it O(n^2) :-( + (while (setq arg (pop args)) + (cond + ((and (eq arg :todo) + (equal date (calendar-gregorian-from-absolute + (org-today)))) + (setq rtn (org-agenda-get-todos)) + (setq results (append results rtn))) + ((eq arg :timestamp) + (setq rtn (org-agenda-get-blocks)) + (setq results (append results rtn)) + (setq rtn (org-agenda-get-timestamps deadline-results)) + (setq results (append results rtn))) + ((eq arg :sexp) + (setq rtn (org-agenda-get-sexps)) + (setq results (append results rtn))) + ((eq arg :scheduled) + (setq rtn (org-agenda-get-scheduled deadline-results)) + (setq results (append results rtn))) + ((eq arg :scheduled*) + (setq rtn (org-agenda-get-scheduled deadline-results t)) + (setq results (append results rtn))) + ((eq arg :closed) + (setq rtn (org-agenda-get-progress)) + (setq results (append results rtn))) + ((eq arg :deadline) + (setq rtn (org-agenda-get-deadlines)) + (setq deadline-results (copy-sequence rtn)) + (setq results (append results rtn))) + ((eq arg :deadline*) + (setq rtn (org-agenda-get-deadlines t)) + (setq deadline-results (copy-sequence rtn)) + (setq results (append results rtn)))))))) + results)))) + +(defsubst org-em (x y list) + "Is X or Y a member of LIST?" + (or (memq x list) (memq y list))) + +(defvar org-heading-keyword-regexp-format) ; defined in org.el +(defvar org-agenda-sorting-strategy-selected nil) + +(defun org-agenda-get-todos () + "Return the TODO information for agenda display." + (let* ((props (list 'face nil + 'done-face 'org-agenda-done + 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'mouse-face 'highlight + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name buffer-file-name)))) + (regexp (format org-heading-keyword-regexp-format + (cond + ((and org-select-this-todo-keyword + (equal org-select-this-todo-keyword "*")) + org-todo-regexp) + (org-select-this-todo-keyword + (concat "\\(" + (mapconcat 'identity + (org-split-string + org-select-this-todo-keyword + "|") + "\\|") "\\)")) + (t org-not-done-regexp)))) + marker priority category category-pos level tags todo-state ts-date ts-date-type + ee txt beg end inherited-tags todo-state-end-pos) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (catch :skip + (save-match-data + (beginning-of-line) + (org-agenda-skip) + (setq beg (point) end (save-excursion (outline-next-heading) (point))) + (unless (and (setq todo-state (org-get-todo-state)) + (setq todo-state-end-pos (match-end 2))) + (goto-char end) + (throw :skip nil)) + (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end) + (goto-char (1+ beg)) + (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible)) + (throw :skip nil))) + (goto-char (match-beginning 2)) + (setq marker (org-agenda-new-marker (match-beginning 0)) + category (org-get-category) + ts-date (let (ts) + (save-match-data + (cond ((org-em 'scheduled-up 'scheduled-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get (point) "SCHEDULED") + ts-date-type " scheduled")) + ((org-em 'deadline-up 'deadline-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get (point) "DEADLINE") + ts-date-type " deadline")) + ((org-em 'ts-up 'ts-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get (point) "TIMESTAMP") + ts-date-type " timestamp")) + ((org-em 'tsia-up 'tsia-down + org-agenda-sorting-strategy-selected) + (setq ts (org-entry-get (point) "TIMESTAMP_IA") + ts-date-type " timestamp_ia")) + ((org-em 'timestamp-up 'timestamp-down + org-agenda-sorting-strategy-selected) + (setq ts (or (org-entry-get (point) "SCHEDULED") + (org-entry-get (point) "DEADLINE") + (org-entry-get (point) "TIMESTAMP") + (org-entry-get (point) "TIMESTAMP_IA")) + ts-date-type "")) + (t (setq ts-date-type ""))) + (when ts (ignore-errors (org-time-string-to-absolute ts))))) + category-pos (get-text-property (point) 'org-category-position) + txt (org-trim + (buffer-substring (match-beginning 2) (match-end 0))) + inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'todo org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'todo org-agenda-use-tag-inheritance)))) + tags (org-get-tags-at nil (not inherited-tags)) + level (make-string (org-reduced-level (org-outline-level)) ? ) + txt (org-agenda-format-item "" txt level category tags t) + priority (1+ (org-get-priority txt))) + (org-add-props txt props + 'org-marker marker 'org-hd-marker marker + 'priority priority 'org-category category + 'level level + 'ts-date ts-date + 'org-category-position category-pos + 'type (concat "todo" ts-date-type) 'todo-state todo-state) + (push txt ee) + (if org-agenda-todo-list-sublevels + (goto-char todo-state-end-pos) + (org-end-of-subtree 'invisible)))) + (nreverse ee))) + +(defun org-agenda-todo-custom-ignore-p (time n) + "Check whether timestamp is farther away than n number of days. +This function is invoked if `org-agenda-todo-ignore-deadlines', +`org-agenda-todo-ignore-scheduled' or +`org-agenda-todo-ignore-timestamp' is set to an integer." + (let ((days (org-time-stamp-to-now + time org-agenda-todo-ignore-time-comparison-use-seconds))) + (if (>= n 0) + (>= days n) + (<= days n)))) + +;;;###autoload +(defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item + (&optional end) + "Do we have a reason to ignore this TODO entry because it has a time stamp?" + (when (or org-agenda-todo-ignore-with-date + org-agenda-todo-ignore-scheduled + org-agenda-todo-ignore-deadlines + org-agenda-todo-ignore-timestamp) + (setq end (or end (save-excursion (outline-next-heading) (point)))) + (save-excursion + (or (and org-agenda-todo-ignore-with-date + (re-search-forward org-ts-regexp end t)) + (and org-agenda-todo-ignore-scheduled + (re-search-forward org-scheduled-time-regexp end t) + (cond + ((eq org-agenda-todo-ignore-scheduled 'future) + (> (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) + ((eq org-agenda-todo-ignore-scheduled 'past) + (<= (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) + ((numberp org-agenda-todo-ignore-scheduled) + (org-agenda-todo-custom-ignore-p + (match-string 1) org-agenda-todo-ignore-scheduled)) + (t))) + (and org-agenda-todo-ignore-deadlines + (re-search-forward org-deadline-time-regexp end t) + (cond + ((memq org-agenda-todo-ignore-deadlines '(t all)) t) + ((eq org-agenda-todo-ignore-deadlines 'far) + (not (org-deadline-close (match-string 1)))) + ((eq org-agenda-todo-ignore-deadlines 'future) + (> (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) + ((eq org-agenda-todo-ignore-deadlines 'past) + (<= (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) + ((numberp org-agenda-todo-ignore-deadlines) + (org-agenda-todo-custom-ignore-p + (match-string 1) org-agenda-todo-ignore-deadlines)) + (t (org-deadline-close (match-string 1))))) + (and org-agenda-todo-ignore-timestamp + (let ((buffer (current-buffer)) + (regexp + (concat + org-scheduled-time-regexp "\\|" org-deadline-time-regexp)) + (start (point))) + ;; Copy current buffer into a temporary one + (with-temp-buffer + (insert-buffer-substring buffer start end) + (goto-char (point-min)) + ;; Delete SCHEDULED and DEADLINE items + (while (re-search-forward regexp end t) + (delete-region (match-beginning 0) (match-end 0))) + (goto-char (point-min)) + ;; No search for timestamp left + (when (re-search-forward org-ts-regexp nil t) + (cond + ((eq org-agenda-todo-ignore-timestamp 'future) + (> (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) + ((eq org-agenda-todo-ignore-timestamp 'past) + (<= (org-time-stamp-to-now + (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) + ((numberp org-agenda-todo-ignore-timestamp) + (org-agenda-todo-custom-ignore-p + (match-string 1) org-agenda-todo-ignore-timestamp)) + (t)))))))))) + +(defun org-agenda-get-timestamps (&optional deadline-results) + "Return the date stamp information for agenda display." + (let* ((props (list 'face 'org-agenda-calendar-event + 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'mouse-face 'highlight + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name buffer-file-name)))) + (d1 (calendar-absolute-from-gregorian date)) + mm + (deadline-position-alist + (mapcar (lambda (a) (and (setq mm (get-text-property + 0 'org-hd-marker a)) + (cons (marker-position mm) a))) + deadline-results)) + (remove-re org-ts-regexp) + (regexp + (concat + (if org-agenda-include-inactive-timestamps "[[<]" "<") + (regexp-quote + (substring + (format-time-string + (car org-time-stamp-formats) + (apply 'encode-time ; DATE bound by calendar + (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) + 1 11)) + "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)" + "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) + marker hdmarker deadlinep scheduledp clockp closedp inactivep + donep tmp priority category category-pos level ee txt timestr tags + b0 b3 e3 head todo-state end-of-match show-all warntime habitp + inherited-tags ts-date) + (goto-char (point-min)) + (while (setq end-of-match (re-search-forward regexp nil t)) + (setq b0 (match-beginning 0) + b3 (match-beginning 3) e3 (match-end 3) + todo-state (save-match-data (ignore-errors (org-get-todo-state))) + habitp (and (functionp 'org-is-habit-p) (save-match-data (org-is-habit-p))) + show-all (or (eq org-agenda-repeating-timestamp-show-all t) + (member todo-state + org-agenda-repeating-timestamp-show-all))) + (catch :skip + (and (org-at-date-range-p) (throw :skip nil)) + (org-agenda-skip) + (if (and (match-end 1) + (not (= d1 (org-time-string-to-absolute + (match-string 1) d1 nil show-all + (current-buffer) b0)))) + (throw :skip nil)) + (if (and e3 + (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date))) + (throw :skip nil)) + (setq tmp (buffer-substring (max (point-min) + (- b0 org-ds-keyword-length)) + b0) + timestr (if b3 "" (buffer-substring b0 (point-at-eol))) + inactivep (= (char-after b0) ?\[) + deadlinep (string-match org-deadline-regexp tmp) + scheduledp (string-match org-scheduled-regexp tmp) + closedp (and org-agenda-include-inactive-timestamps + (string-match org-closed-string tmp)) + clockp (and org-agenda-include-inactive-timestamps + (or (string-match org-clock-string tmp) + (string-match "]-+\\'" tmp))) + warntime (get-text-property (point) 'org-appt-warntime) + donep (member todo-state org-done-keywords)) + (if (or scheduledp deadlinep closedp clockp + (and donep org-agenda-skip-timestamp-if-done)) + (throw :skip t)) + (if (string-match ">" timestr) + ;; substring should only run to end of time stamp + (setq timestr (substring timestr 0 (match-end 0)))) + (setq marker (org-agenda-new-marker b0) + category (org-get-category b0) + category-pos (get-text-property b0 'org-category-position)) + (save-excursion + (if (not (re-search-backward org-outline-regexp-bol nil t)) + (throw :skip nil) + (goto-char (match-beginning 0)) + (if (and (eq t org-agenda-skip-timestamp-if-deadline-is-shown) + (assoc (point) deadline-position-alist)) + (throw :skip nil)) + (setq hdmarker (org-agenda-new-marker) + inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda org-agenda-use-tag-inheritance)))) + tags (org-get-tags-at nil (not inherited-tags)) + level (make-string (org-reduced-level (org-outline-level)) ? )) + (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") + (setq head (or (match-string 1) "")) + (setq txt (org-agenda-format-item + (if inactivep org-agenda-inactive-leader nil) + head level category tags timestr + remove-re habitp))) + (setq priority (org-get-priority txt)) + (org-add-props txt props 'priority priority + 'org-marker marker 'org-hd-marker hdmarker + 'org-category category 'date date + 'level level + 'ts-date + (ignore-errors (org-time-string-to-absolute timestr)) + 'org-category-position category-pos + 'todo-state todo-state + 'warntime warntime + 'type "timestamp") + (push txt ee)) + (if org-agenda-skip-additional-timestamps-same-entry + (outline-next-heading) + (goto-char end-of-match)))) + (nreverse ee))) + +(defun org-agenda-get-sexps () + "Return the sexp information for agenda display." + (require 'diary-lib) + (let* ((props (list 'face 'org-agenda-calendar-sexp + 'mouse-face 'highlight + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name buffer-file-name)))) + (regexp "^&?%%(") + marker category extra category-pos level ee txt tags entry + result beg b sexp sexp-entry todo-state warntime inherited-tags) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (catch :skip + (org-agenda-skip) + (setq beg (match-beginning 0)) + (goto-char (1- (match-end 0))) + (setq b (point)) + (forward-sexp 1) + (setq sexp (buffer-substring b (point))) + (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)") + (org-trim (match-string 1)) + "")) + (setq result (org-diary-sexp-entry sexp sexp-entry date)) + (when result + (setq marker (org-agenda-new-marker beg) + level (make-string (org-reduced-level (org-outline-level)) ? ) + category (org-get-category beg) + category-pos (get-text-property beg 'org-category-position) + inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda org-agenda-use-tag-inheritance)))) + tags (org-get-tags-at nil (not inherited-tags)) + todo-state (org-get-todo-state) + warntime (get-text-property (point) 'org-appt-warntime) + extra nil) + + (dolist (r (if (stringp result) + (list result) + result)) ;; we expect a list here + (when (and org-agenda-diary-sexp-prefix + (string-match org-agenda-diary-sexp-prefix r)) + (setq extra (match-string 0 r) + r (replace-match "" nil nil r))) + (if (string-match "\\S-" r) + (setq txt r) + (setq txt "SEXP entry returned empty string")) + (setq txt (org-agenda-format-item extra txt level category tags 'time)) + (org-add-props txt props 'org-marker marker + 'org-category category 'date date 'todo-state todo-state + 'org-category-position category-pos + 'level level + 'type "sexp" 'warntime warntime) + (push txt ee))))) + (nreverse ee))) + +;; Calendar sanity: define some functions that are independent of +;; `calendar-date-style'. +;; Normally I would like to use ISO format when calling the diary functions, +;; but to make sure we still have Emacs 22 compatibility we bind +;; also `european-calendar-style' and use european format +(defun org-anniversary (year month day &optional mark) + "Like `diary-anniversary', but with fixed (ISO) order of arguments." + (org-no-warnings + (let ((calendar-date-style 'european) (european-calendar-style t)) + (diary-anniversary day month year mark)))) +(defun org-cyclic (N year month day &optional mark) + "Like `diary-cyclic', but with fixed (ISO) order of arguments." + (org-no-warnings + (let ((calendar-date-style 'european) (european-calendar-style t)) + (diary-cyclic N day month year mark)))) +(defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark) + "Like `diary-block', but with fixed (ISO) order of arguments." + (org-no-warnings + (let ((calendar-date-style 'european) (european-calendar-style t)) + (diary-block D1 M1 Y1 D2 M2 Y2 mark)))) +(defun org-date (year month day &optional mark) + "Like `diary-date', but with fixed (ISO) order of arguments." + (org-no-warnings + (let ((calendar-date-style 'european) (european-calendar-style t)) + (diary-date day month year mark)))) + +;; Define the` org-class' function +(defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks) + "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS. +DAYNAME is a number between 0 (Sunday) and 6 (Saturday). +SKIP-WEEKS is any number of ISO weeks in the block period for which the +item should be skipped. If any of the SKIP-WEEKS arguments is the symbol +`holidays', then any date that is known by the Emacs calendar to be a +holiday will also be skipped. If SKIP-WEEKS arguments are holiday strings, +then those holidays will be skipped." + (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1))) + (date2 (calendar-absolute-from-gregorian (list m2 d2 y2))) + (d (calendar-absolute-from-gregorian date)) + (h (when skip-weeks (calendar-check-holidays date)))) + (and + (<= date1 d) + (<= d date2) + (= (calendar-day-of-week date) dayname) + (or (not skip-weeks) + (progn + (require 'cal-iso) + (not (member (car (calendar-iso-from-absolute d)) skip-weeks)))) + (not (or (and h (memq 'holidays skip-weeks)) + (delq nil (mapcar (lambda(g) (member g skip-weeks)) h)))) + entry))) + +(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks) + "Like `org-class', but honor `calendar-date-style'. +The order of the first 2 times 3 arguments depends on the variable +`calendar-date-style' or, if that is not defined, on `european-calendar-style'. +So for American calendars, give this as MONTH DAY YEAR, for European as +DAY MONTH YEAR, and for ISO as YEAR MONTH DAY. +DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS +is any number of ISO weeks in the block period for which the item should +be skipped. + +This function is here only for backward compatibility and it is deprecated, +please use `org-class' instead." + (let* ((date1 (org-order-calendar-date-args m1 d1 y1)) + (date2 (org-order-calendar-date-args m2 d2 y2))) + (org-class + (nth 2 date1) (car date1) (nth 1 date1) + (nth 2 date2) (car date2) (nth 1 date2) + dayname skip-weeks))) +(make-obsolete 'org-diary-class 'org-class "") + +(defalias 'org-get-closed 'org-agenda-get-progress) +(defun org-agenda-get-progress () + "Return the logged TODO entries for agenda display." + (let* ((props (list 'mouse-face 'highlight + 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name buffer-file-name)))) + (items (if (consp org-agenda-show-log-scoped) + org-agenda-show-log-scoped + (if (eq org-agenda-show-log-scoped 'clockcheck) + '(clock) + org-agenda-log-mode-items))) + (parts + (delq nil + (list + (if (memq 'closed items) (concat "\\<" org-closed-string)) + (if (memq 'clock items) (concat "\\<" org-clock-string)) + (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\".*?")))) + (parts-re (if parts (mapconcat 'identity parts "\\|") + (error "`org-agenda-log-mode-items' is empty"))) + (regexp (concat + "\\(" parts-re "\\)" + " *\\[" + (regexp-quote + (substring + (format-time-string + (car org-time-stamp-formats) + (apply 'encode-time ; DATE bound by calendar + (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) + 1 11)))) + (org-agenda-search-headline-for-time nil) + marker hdmarker priority category category-pos level tags closedp + statep clockp state ee txt extra timestr rest clocked inherited-tags) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (catch :skip + (org-agenda-skip) + (setq marker (org-agenda-new-marker (match-beginning 0)) + closedp (equal (match-string 1) org-closed-string) + statep (equal (string-to-char (match-string 1)) ?-) + clockp (not (or closedp statep)) + state (and statep (match-string 2)) + category (org-get-category (match-beginning 0)) + category-pos (get-text-property (match-beginning 0) 'org-category-position) + timestr (buffer-substring (match-beginning 0) (point-at-eol))) + (when (string-match "\\]" timestr) + ;; substring should only run to end of time stamp + (setq rest (substring timestr (match-end 0)) + timestr (substring timestr 0 (match-end 0))) + (if (and (not closedp) (not statep) + (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" + rest)) + (progn (setq timestr (concat (substring timestr 0 -1) + "-" (match-string 1 rest) "]")) + (setq clocked (match-string 2 rest))) + (setq clocked "-"))) + (save-excursion + (setq extra + (cond + ((not org-agenda-log-mode-add-notes) nil) + (statep + (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$") + (match-string 1))) + (clockp + (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$") + (match-string 1))))) + (if (not (re-search-backward org-outline-regexp-bol nil t)) + (throw :skip nil) + (goto-char (match-beginning 0)) + (setq hdmarker (org-agenda-new-marker) + inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'todo org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'todo org-agenda-use-tag-inheritance)))) + tags (org-get-tags-at nil (not inherited-tags)) + level (make-string (org-reduced-level (org-outline-level)) ? )) + (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") + (setq txt (match-string 1)) + (when extra + (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt) + (setq txt (concat (substring txt 0 (match-beginning 1)) + " - " extra " " (match-string 2 txt))) + (setq txt (concat txt " - " extra)))) + (setq txt (org-agenda-format-item + (cond + (closedp "Closed: ") + (statep (concat "State: (" state ")")) + (t (concat "Clocked: (" clocked ")"))) + txt level category tags timestr))) + (setq priority 100000) + (org-add-props txt props + 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done + 'priority priority 'org-category category + 'org-category-position category-pos + 'level level + 'type "closed" 'date date + 'undone-face 'org-warning 'done-face 'org-agenda-done) + (push txt ee)) + (goto-char (point-at-eol)))) + (nreverse ee))) + +(defun org-agenda-show-clocking-issues () + "Add overlays, showing issues with clocking. +See also the user option `org-agenda-clock-consistency-checks'." + (interactive) + (let* ((org-time-clocksum-use-effort-durations nil) + (pl org-agenda-clock-consistency-checks) + (re (concat "^[ \t]*" + org-clock-string + "[ \t]+" + "\\(\\[.*?\\]\\)" ; group 1 is first stamp + "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second + (tlstart 0.) + (tlend 0.) + (maxtime (org-hh:mm-string-to-minutes + (or (plist-get pl :max-duration) "24:00"))) + (mintime (org-hh:mm-string-to-minutes + (or (plist-get pl :min-duration) 0))) + (maxgap (org-hh:mm-string-to-minutes + ;; default 30:00 means never complain + (or (plist-get pl :max-gap) "30:00"))) + (gapok (mapcar 'org-hh:mm-string-to-minutes + (plist-get pl :gap-ok-around))) + (def-face (or (plist-get pl :default-face) + '((:background "DarkRed") (:foreground "white")))) + issue face m te ts dt ov) + (goto-char (point-min)) + (while (re-search-forward " Clocked: +(-\\|\\([0-9]+:[0-9]+\\))" nil t) + (setq issue nil face def-face) + (catch 'next + (setq m (org-get-at-bol 'org-marker) + te nil ts nil) + (unless (and m (markerp m)) + (setq issue "No valid clock line") (throw 'next t)) + (org-with-point-at m + (save-excursion + (goto-char (point-at-bol)) + (unless (looking-at re) + (error "No valid Clock line") + (throw 'next t)) + (unless (match-end 3) + (setq issue "No end time" + face (or (plist-get pl :no-end-time-face) face)) + (throw 'next t)) + (setq ts (match-string 1) + te (match-string 3) + ts (org-float-time + (apply 'encode-time (org-parse-time-string ts))) + te (org-float-time + (apply 'encode-time (org-parse-time-string te))) + dt (- te ts)))) + (cond + ((> dt (* 60 maxtime)) + ;; a very long clocking chunk + (setq issue (format "Clocking interval is very long: %s" + (org-minutes-to-clocksum-string + (floor (/ (float dt) 60.)))) + face (or (plist-get pl :long-face) face))) + ((< dt (* 60 mintime)) + ;; a very short clocking chunk + (setq issue (format "Clocking interval is very short: %s" + (org-minutes-to-clocksum-string + (floor (/ (float dt) 60.)))) + face (or (plist-get pl :short-face) face))) + ((and (> tlend 0) (< ts tlend)) + ;; Two clock entries are overlapping + (setq issue (format "Clocking overlap: %d minutes" + (/ (- tlend ts) 60)) + face (or (plist-get pl :overlap-face) face))) + ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap)))) + ;; There is a gap, lets see if we need to report it + (unless (org-agenda-check-clock-gap tlend ts gapok) + (setq issue (format "Clocking gap: %d minutes" + (/ (- ts tlend) 60)) + face (or (plist-get pl :gap-face) face)))) + (t nil))) + (setq tlend (or te tlend) tlstart (or ts tlstart)) + (when issue + ;; OK, there was some issue, add an overlay to show the issue + (setq ov (make-overlay (point-at-bol) (point-at-eol))) + (overlay-put ov 'before-string + (concat + (org-add-props + (format "%-43s" (concat " " issue)) + nil + 'face face) + "\n")) + (overlay-put ov 'evaporate t))))) + +(defun org-agenda-check-clock-gap (t1 t2 ok-list) + "Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values." + (catch 'exit + (unless ok-list + ;; there are no OK times for gaps... + (throw 'exit nil)) + (if (> (- (/ t2 36000) (/ t1 36000)) 24) + ;; This is more than 24 hours, so it is OK. + ;; because we have at least one OK time, that must be in the + ;; 24 hour interval. + (throw 'exit t)) + ;; We have a shorter gap. + ;; Now we have to get the minute of the day when these times are + (let* ((t1dec (decode-time (seconds-to-time t1))) + (t2dec (decode-time (seconds-to-time t2))) + ;; compute the minute on the day + (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec)))) + (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec))))) + (when (< min2 min1) + ;; if min2 is smaller than min1, this means it is on the next day. + ;; Wrap it to after midnight. + (setq min2 (+ min2 1440))) + ;; Now check if any of the OK times is in the gap + (mapc (lambda (x) + ;; Wrap the time to after midnight if necessary + (if (< x min1) (setq x (+ x 1440))) + ;; Check if in interval + (and (<= min1 x) (>= min2 x) (throw 'exit t))) + ok-list) + ;; Nope, this gap is not OK + nil))) + +(defun org-agenda-get-deadlines (&optional with-hour) + "Return the deadline information for agenda display. +When WITH-HOUR is non-nil, only return deadlines with an hour +specification like [h]h:mm." + (let* ((props (list 'mouse-face 'highlight + 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name buffer-file-name)))) + (regexp (if with-hour + org-deadline-time-hour-regexp + org-deadline-time-regexp)) + (todayp (org-agenda-todayp date)) ; DATE bound by calendar + (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar + (dl0 (car org-agenda-deadline-leaders)) + (dl1 (nth 1 org-agenda-deadline-leaders)) + (dl2 (or (nth 2 org-agenda-deadline-leaders) dl1)) + d2 diff dfrac wdays pos pos1 category category-pos level + tags suppress-prewarning ee txt head face s todo-state + show-all upcomingp donep timestr warntime inherited-tags ts-date) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (catch :skip + (org-agenda-skip) + (setq s (match-string 1) + txt nil + pos (1- (match-beginning 1)) + todo-state (save-match-data (org-get-todo-state)) + show-all (or (eq org-agenda-repeating-timestamp-show-all t) + (member todo-state + org-agenda-repeating-timestamp-show-all)) + d2 (org-time-string-to-absolute + s d1 'past show-all (current-buffer) pos) + diff (- d2 d1)) + (setq suppress-prewarning + (let ((ds (and org-agenda-skip-deadline-prewarning-if-scheduled + (let ((item (buffer-substring (point-at-bol) + (point-at-eol)))) + (save-match-data + (and (string-match + org-scheduled-time-regexp item) + (match-string 1 item))))))) + (cond + ((not ds) nil) + ;; The current item has a scheduled date (in ds), so + ;; evaluate its prewarning lead time. + ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) + ;; Use global prewarning-restart lead time. + org-agenda-skip-deadline-prewarning-if-scheduled) + ((eq org-agenda-skip-deadline-prewarning-if-scheduled + 'pre-scheduled) + ;; Set prewarning to no earlier than scheduled. + (min (- d2 (org-time-string-to-absolute + ds d1 'past show-all (current-buffer) pos)) + org-deadline-warning-days)) + ;; Set prewarning to deadline. + (t 0)))) + (setq wdays (if suppress-prewarning + (let ((org-deadline-warning-days suppress-prewarning)) + (org-get-wdays s)) + (org-get-wdays s)) + dfrac (- 1 (/ (* 1.0 diff) (max wdays 1))) + upcomingp (and todayp (> diff 0))) + ;; When to show a deadline in the calendar: + ;; If the expiration is within wdays warning time. + ;; Past-due deadlines are only shown on the current date + (if (and (or (and (<= diff wdays) + (and todayp (not org-agenda-only-exact-dates))) + (= diff 0))) + (save-excursion + ;; (setq todo-state (org-get-todo-state)) + (setq donep (member todo-state org-done-keywords)) + (if (and donep + (or org-agenda-skip-deadline-if-done + (not (= diff 0)))) + (setq txt nil) + (setq category (org-get-category) + warntime (get-text-property (point) 'org-appt-warntime) + category-pos (get-text-property (point) 'org-category-position)) + (if (not (re-search-backward "^\\*+[ \t]+" nil t)) + (throw :skip nil) + (goto-char (match-end 0)) + (setq pos1 (match-beginning 0)) + (setq level (make-string (org-reduced-level (org-outline-level)) ? )) + (setq inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda org-agenda-use-tag-inheritance)))) + tags (org-get-tags-at pos1 (not inherited-tags))) + (setq head (buffer-substring + (point) + (progn (skip-chars-forward "^\r\n") + (point)))) + (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) + (setq timestr + (concat (substring s (match-beginning 1)) " ")) + (setq timestr 'time)) + (setq txt (org-agenda-format-item + (cond ((= diff 0) dl0) + ((> diff 0) + (if (functionp dl1) + (funcall dl1 diff date) + (format dl1 diff))) + (t + (if (functionp dl2) + (funcall dl2 diff date) + (format dl2 (if (string= dl2 dl1) + diff (abs diff)))))) + head level category tags + (if (not (= diff 0)) nil timestr))))) + (when txt + (setq face (org-agenda-deadline-face dfrac)) + (org-add-props txt props + 'org-marker (org-agenda-new-marker pos) + 'warntime warntime + 'level level + 'ts-date d2 + 'org-hd-marker (org-agenda-new-marker pos1) + 'priority (+ (- diff) + (org-get-priority txt)) + 'org-category category + 'org-category-position category-pos + 'todo-state todo-state + 'type (if upcomingp "upcoming-deadline" "deadline") + 'date (if upcomingp date d2) + 'face (if donep 'org-agenda-done face) + 'undone-face face 'done-face 'org-agenda-done) + (push txt ee)))))) + (nreverse ee))) + +(defun org-agenda-deadline-face (fraction) + "Return the face to displaying a deadline item. +FRACTION is what fraction of the head-warning time has passed." + (let ((faces org-agenda-deadline-faces) f) + (catch 'exit + (while (setq f (pop faces)) + (if (>= fraction (car f)) (throw 'exit (cdr f))))))) + +(defun org-agenda-get-scheduled (&optional deadline-results with-hour) + "Return the scheduled information for agenda display. +When WITH-HOUR is non-nil, only return scheduled items with +an hour specification like [h]h:mm." + (let* ((props (list 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'done-face 'org-agenda-done + 'mouse-face 'highlight + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name buffer-file-name)))) + (regexp (if with-hour + org-scheduled-time-hour-regexp + org-scheduled-time-regexp)) + (todayp (org-agenda-todayp date)) ; DATE bound by calendar + (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar + mm + (deadline-position-alist + (mapcar (lambda (a) (and (setq mm (get-text-property + 0 'org-hd-marker a)) + (cons (marker-position mm) a))) + deadline-results)) + d2 diff pos pos1 category category-pos level tags donep + ee txt head pastschedp todo-state face timestr s habitp show-all + did-habit-check-p warntime inherited-tags ts-date suppress-delay + ddays) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (catch :skip + (org-agenda-skip) + (setq s (match-string 1) + txt nil + pos (1- (match-beginning 1)) + todo-state (save-match-data (org-get-todo-state)) + show-all (or (eq org-agenda-repeating-timestamp-show-all t) + (member todo-state + org-agenda-repeating-timestamp-show-all)) + d2 (org-time-string-to-absolute + s d1 'past show-all (current-buffer) pos) + diff (- d2 d1) + warntime (get-text-property (point) 'org-appt-warntime)) + (setq pastschedp (and todayp (< diff 0))) + (setq did-habit-check-p nil) + (setq suppress-delay + (let ((ds (and org-agenda-skip-scheduled-delay-if-deadline + (let ((item (buffer-substring (point-at-bol) (point-at-eol)))) + (save-match-data + (and (string-match + org-deadline-time-regexp item) + (match-string 1 item))))))) + (cond + ((not ds) nil) + ;; The current item has a deadline date (in ds), so + ;; evaluate its delay time. + ((integerp org-agenda-skip-scheduled-delay-if-deadline) + ;; Use global delay time. + (- org-agenda-skip-scheduled-delay-if-deadline)) + ((eq org-agenda-skip-scheduled-delay-if-deadline + 'post-deadline) + ;; Set delay to no later than deadline. + (min (- d2 (org-time-string-to-absolute + ds d1 'past show-all (current-buffer) pos)) + org-scheduled-delay-days)) + (t 0)))) + (setq ddays (if suppress-delay + (let ((org-scheduled-delay-days suppress-delay)) + (org-get-wdays s t t)) + (org-get-wdays s t))) + ;; Use a delay of 0 when there is a repeater and the delay is + ;; of the form --3d + (when (and (save-match-data (string-match "--[0-9]+[hdwmy]" s)) + (< (org-time-string-to-absolute s) + (org-time-string-to-absolute + s d2 'past nil (current-buffer) pos))) + (setq ddays 0)) + ;; When to show a scheduled item in the calendar: + ;; If it is on or past the date. + (when (or (and (> ddays 0) (= diff (- ddays))) + (and (zerop ddays) (= diff 0)) + (and (< (+ diff ddays) 0) + (< (abs diff) org-scheduled-past-days) + (and todayp (not org-agenda-only-exact-dates))) + ;; org-is-habit-p uses org-entry-get, which is expansive + ;; so we go extra mile to only call it once + (and todayp + (boundp 'org-habit-show-all-today) + org-habit-show-all-today + (setq did-habit-check-p t) + (setq habitp (and (functionp 'org-is-habit-p) + (org-is-habit-p))))) + (save-excursion + (setq donep (member todo-state org-done-keywords)) + (if (and donep + (or org-agenda-skip-scheduled-if-done + (not (= diff 0)) + (and (functionp 'org-is-habit-p) + (org-is-habit-p)))) + (setq txt nil) + (setq habitp (if did-habit-check-p habitp + (and (functionp 'org-is-habit-p) + (org-is-habit-p)))) + (setq category (org-get-category) + category-pos (get-text-property (point) 'org-category-position)) + (if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown + 'repeated-after-deadline) + (org-get-deadline-time (point)) + (<= 0 (- d2 (time-to-days (org-get-deadline-time (point)))))) + (throw :skip nil)) + (if (not (re-search-backward "^\\*+[ \t]+" nil t)) + (throw :skip nil) + (goto-char (match-end 0)) + (setq pos1 (match-beginning 0)) + (if habitp + (if (or (not org-habit-show-habits) + (and (not todayp) + (boundp 'org-habit-show-habits-only-for-today) + org-habit-show-habits-only-for-today)) + (throw :skip nil)) + (if (and + (or (eq t org-agenda-skip-scheduled-if-deadline-is-shown) + (and (eq org-agenda-skip-scheduled-if-deadline-is-shown 'not-today) + pastschedp)) + (setq mm (assoc pos1 deadline-position-alist))) + (throw :skip nil))) + (setq inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda org-agenda-use-tag-inheritance)))) + + tags (org-get-tags-at nil (not inherited-tags))) + (setq level (make-string (org-reduced-level (org-outline-level)) ? )) + (setq head (buffer-substring + (point) + (progn (skip-chars-forward "^\r\n") (point)))) + (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) + (setq timestr + (concat (substring s (match-beginning 1)) " ")) + (setq timestr 'time)) + (setq txt (org-agenda-format-item + (if (= diff 0) + (car org-agenda-scheduled-leaders) + (format (nth 1 org-agenda-scheduled-leaders) + (- 1 diff))) + head level category tags + (if (not (= diff 0)) nil timestr) + nil habitp)))) + (when txt + (setq face + (cond + ((and (not habitp) pastschedp) + 'org-scheduled-previously) + (todayp 'org-scheduled-today) + (t 'org-scheduled)) + habitp (and habitp (org-habit-parse-todo))) + (org-add-props txt props + 'undone-face face + 'face (if donep 'org-agenda-done face) + 'org-marker (org-agenda-new-marker pos) + 'org-hd-marker (org-agenda-new-marker pos1) + 'type (if pastschedp "past-scheduled" "scheduled") + 'date (if pastschedp d2 date) + 'ts-date d2 + 'warntime warntime + 'level level + 'priority (if habitp + (org-habit-get-priority habitp) + (+ 94 (- 5 diff) (org-get-priority txt))) + 'org-category category + 'category-position category-pos + 'org-habit-p habitp + 'todo-state todo-state) + (push txt ee)))))) + (nreverse ee))) + +(defun org-agenda-get-blocks () + "Return the date-range information for agenda display." + (let* ((props (list 'face nil + 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'mouse-face 'highlight + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name buffer-file-name)))) + (regexp org-tr-regexp) + (d0 (calendar-absolute-from-gregorian date)) + marker hdmarker ee txt d1 d2 s1 s2 category category-pos + level todo-state tags pos head donep inherited-tags) + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (catch :skip + (org-agenda-skip) + (setq pos (point)) + (let ((start-time (match-string 1)) + (end-time (match-string 2))) + (setq s1 (match-string 1) + s2 (match-string 2) + d1 (time-to-days (org-time-string-to-time s1 (current-buffer) pos)) + d2 (time-to-days (org-time-string-to-time s2 (current-buffer) pos))) + (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) + ;; Only allow days between the limits, because the normal + ;; date stamps will catch the limits. + (save-excursion + (setq todo-state (org-get-todo-state)) + (setq donep (member todo-state org-done-keywords)) + (if (and donep org-agenda-skip-timestamp-if-done) + (throw :skip t)) + (setq marker (org-agenda-new-marker (point))) + (setq category (org-get-category) + category-pos (get-text-property (point) 'org-category-position)) + (if (not (re-search-backward org-outline-regexp-bol nil t)) + (throw :skip nil) + (goto-char (match-beginning 0)) + (setq hdmarker (org-agenda-new-marker (point)) + inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'agenda org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'agenda org-agenda-use-tag-inheritance)))) + + tags (org-get-tags-at nil (not inherited-tags))) + (setq level (make-string (org-reduced-level (org-outline-level)) ? )) + (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") + (setq head (match-string 1)) + (let ((remove-re + (if org-agenda-remove-timeranges-from-blocks + (concat + "<" (regexp-quote s1) ".*?>" + "--" + "<" (regexp-quote s2) ".*?>") + nil))) + (setq txt (org-agenda-format-item + (format + (nth (if (= d1 d2) 0 1) + org-agenda-timerange-leaders) + (1+ (- d0 d1)) (1+ (- d2 d1))) + head level category tags + (cond ((and (= d1 d0) (= d2 d0)) + (concat "<" start-time ">--<" end-time ">")) + ((= d1 d0) + (concat "<" start-time ">")) + ((= d2 d0) + (concat "<" end-time ">"))) + remove-re)))) + (org-add-props txt props + 'org-marker marker 'org-hd-marker hdmarker + 'type "block" 'date date + 'level level + 'todo-state todo-state + 'priority (org-get-priority txt) 'org-category category + 'org-category-position category-pos) + (push txt ee)))) + (goto-char pos))) + ;; Sort the entries by expiration date. + (nreverse ee))) + +;;; Agenda presentation and sorting + +(defvar org-prefix-has-time nil + "A flag, set by `org-compile-prefix-format'. +The flag is set if the currently compiled format contains a `%t'.") +(defvar org-prefix-has-tag nil + "A flag, set by `org-compile-prefix-format'. +The flag is set if the currently compiled format contains a `%T'.") +(defvar org-prefix-has-effort nil + "A flag, set by `org-compile-prefix-format'. +The flag is set if the currently compiled format contains a `%e'.") +(defvar org-prefix-has-breadcrumbs nil + "A flag, set by `org-compile-prefix-format'. +The flag is set if the currently compiled format contains a `%b'.") +(defvar org-prefix-category-length nil + "Used by `org-compile-prefix-format' to remember the category field width.") +(defvar org-prefix-category-max-length nil + "Used by `org-compile-prefix-format' to remember the category field width.") + +(defun org-agenda-get-category-icon (category) + "Return an image for CATEGORY according to `org-agenda-category-icon-alist'." + (dolist (entry org-agenda-category-icon-alist) + (when (org-string-match-p (car entry) category) + (if (listp (cadr entry)) + (return (cadr entry)) + (return (apply 'create-image (cdr entry))))))) + +(defun org-agenda-format-item (extra txt &optional level category tags dotime + remove-re habitp) + "Format TXT to be inserted into the agenda buffer. +In particular, add the prefix and corresponding text properties. + +EXTRA must be a string to replace the `%s' specifier in the prefix format. +LEVEL may be a string to replace the `%l' specifier. +CATEGORY (a string, a symbol or nil) may be used to overrule the default +category taken from local variable or file name. It will replace the `%c' +specifier in the format. +DOTIME, when non-nil, indicates that a time-of-day should be extracted from +TXT for sorting of this entry, and for the `%t' specifier in the format. +When DOTIME is a string, this string is searched for a time before TXT is. +TAGS can be the tags of the headline. +Any match of REMOVE-RE will be removed from TXT." + ;; We keep the org-prefix-* variable values along with a compiled + ;; formatter, so that multiple agendas existing at the same time do + ;; not step on each other toes. + ;; + ;; It was inconvenient to make these variables buffer local in + ;; Agenda buffers, because this function expects to be called with + ;; the buffer where item comes from being current, and not agenda + ;; buffer + (let* ((bindings (car org-prefix-format-compiled)) + (formatter (cadr org-prefix-format-compiled))) + (loop for (var value) in bindings + do (set var value)) + (save-match-data + ;; Diary entries sometimes have extra whitespace at the beginning + (setq txt (org-trim txt)) + + ;; Fix the tags part in txt + (setq txt (org-agenda-fix-displayed-tags + txt tags + org-agenda-show-inherited-tags + org-agenda-hide-tags-regexp)) + + (let* ((category (or category + (if (stringp org-category) + org-category + (and org-category (symbol-name org-category))) + (if buffer-file-name + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + ""))) + (category-icon (org-agenda-get-category-icon category)) + (category-icon (if category-icon + (propertize " " 'display category-icon) + "")) + ;; time, tag, effort are needed for the eval of the prefix format + (tag (if tags (nth (1- (length tags)) tags) "")) + time effort neffort + (ts (if dotime (concat + (if (stringp dotime) dotime "") + (and org-agenda-search-headline-for-time txt)))) + (time-of-day (and dotime (org-get-time-of-day ts))) + stamp plain s0 s1 s2 rtn srp l + duration thecategory breadcrumbs) + (and (derived-mode-p 'org-mode) buffer-file-name + (add-to-list 'org-agenda-contributing-files buffer-file-name)) + (when (and dotime time-of-day) + ;; Extract starting and ending time and move them to prefix + (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) + (setq plain (string-match org-plain-time-of-day-regexp ts))) + (setq s0 (match-string 0 ts) + srp (and stamp (match-end 3)) + s1 (match-string (if plain 1 2) ts) + s2 (match-string (if plain 8 (if srp 4 6)) ts)) + + ;; If the times are in TXT (not in DOTIMES), and the prefix will list + ;; them, we might want to remove them there to avoid duplication. + ;; The user can turn this off with a variable. + (if (and org-prefix-has-time + org-agenda-remove-times-when-in-prefix (or stamp plain) + (string-match (concat (regexp-quote s0) " *") txt) + (not (equal ?\] (string-to-char (substring txt (match-end 0))))) + (if (eq org-agenda-remove-times-when-in-prefix 'beg) + (= (match-beginning 0) 0) + t)) + (setq txt (replace-match "" nil nil txt)))) + ;; Normalize the time(s) to 24 hour + (if s1 (setq s1 (org-get-time-of-day s1 'string t))) + (if s2 (setq s2 (org-get-time-of-day s2 'string t))) + + ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set + (let (org-time-clocksum-use-effort-durations) + (when (and s1 (not s2) org-agenda-default-appointment-duration) + (setq s2 + (org-minutes-to-clocksum-string + (+ (org-hh:mm-string-to-minutes s1) + org-agenda-default-appointment-duration))))) + + ;; Compute the duration + (when s2 + (setq duration (- (org-hh:mm-string-to-minutes s2) + (org-hh:mm-string-to-minutes s1))))) + + (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") + txt) + ;; Tags are in the string + (if (or (eq org-agenda-remove-tags t) + (and org-agenda-remove-tags + org-prefix-has-tag)) + (setq txt (replace-match "" t t txt)) + (setq txt (replace-match + (concat (make-string (max (- 50 (length txt)) 1) ?\ ) + (match-string 2 txt)) + t t txt)))) + (when (derived-mode-p 'org-mode) + (setq effort (ignore-errors (get-text-property 0 'org-effort txt)))) + + ;; org-agenda-add-time-grid-maybe calls us with *Agenda* as + ;; current buffer, so move this check outside of above + (if effort + (setq neffort (org-duration-string-to-minutes effort) + effort (setq effort (concat "[" effort "]"))) + ;; prevent erroring out with %e format when there is no effort + (setq effort "")) + + (when remove-re + (while (string-match remove-re txt) + (setq txt (replace-match "" t t txt)))) + + ;; Set org-heading property on `txt' to mark the start of the + ;; heading. + (add-text-properties 0 (length txt) '(org-heading t) txt) + + ;; Prepare the variables needed in the eval of the compiled format + (if org-prefix-has-breadcrumbs + (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker) + (let ((s (org-display-outline-path nil nil "->" t))) + (if (eq "" s) "" (concat s "->")))))) + (setq time (cond (s2 (concat + (org-agenda-time-of-day-to-ampm-maybe s1) + "-" (org-agenda-time-of-day-to-ampm-maybe s2) + (if org-agenda-timegrid-use-ampm " "))) + (s1 (concat + (org-agenda-time-of-day-to-ampm-maybe s1) + (if org-agenda-timegrid-use-ampm + "........ " + "......"))) + (t "")) + extra (or (and (not habitp) extra) "") + category (if (symbolp category) (symbol-name category) category) + thecategory (copy-sequence category) + level (or level "")) + (if (string-match org-bracket-link-regexp category) + (progn + (setq l (if (match-end 3) + (- (match-end 3) (match-beginning 3)) + (- (match-end 1) (match-beginning 1)))) + (when (< l (or org-prefix-category-length 0)) + (setq category (copy-sequence category)) + (org-add-props category nil + 'extra-space (make-string + (- org-prefix-category-length l 1) ?\ )))) + (if (and org-prefix-category-max-length + (>= (length category) org-prefix-category-max-length)) + (setq category (substring category 0 (1- org-prefix-category-max-length))))) + ;; Evaluate the compiled format + (setq rtn (concat (eval formatter) txt)) + + ;; And finally add the text properties + (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) + (org-add-props rtn nil + 'org-category (if thecategory (downcase thecategory) category) + 'tags (mapcar 'org-downcase-keep-props tags) + 'org-highest-priority org-highest-priority + 'org-lowest-priority org-lowest-priority + 'time-of-day time-of-day + 'duration duration + 'effort effort + 'effort-minutes neffort + 'breadcrumbs breadcrumbs + 'txt txt + 'level level + 'time time + 'extra extra + 'format org-prefix-format-compiled + 'dotime dotime))))) + +(defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re) + "Remove tags string from TXT, and add a modified list of tags. +The modified list may contain inherited tags, and tags matched by +`org-agenda-hide-tags-regexp' will be removed." + (when (or add-inherited hide-re) + (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt) + (setq txt (substring txt 0 (match-beginning 0)))) + (setq tags + (delq nil + (mapcar (lambda (tg) + (if (or (and hide-re (string-match hide-re tg)) + (and (not add-inherited) + (get-text-property 0 'inherited tg))) + nil + tg)) + tags))) + (when tags + (let ((have-i (get-text-property 0 'inherited (car tags))) + i) + (setq txt (concat txt " :" + (mapconcat + (lambda (x) + (setq i (get-text-property 0 'inherited x)) + (if (and have-i (not i)) + (progn + (setq have-i nil) + (concat ":" x)) + x)) + tags ":") + (if have-i "::" ":")))))) + txt) + +(defun org-downcase-keep-props (s) + (let ((props (text-properties-at 0 s))) + (setq s (downcase s)) + (add-text-properties 0 (length s) props s) + s)) + +(defvar org-agenda-sorting-strategy) ;; because the def is in a let form + +(defun org-agenda-add-time-grid-maybe (list ndays todayp) + "Add a time-grid for agenda items which need it. + +LIST is the list of agenda items formatted by `org-agenda-list'. +NDAYS is the span of the current agenda view. +TODAYP is `t' when the current agenda view is on today." + (catch 'exit + (cond ((not org-agenda-use-time-grid) (throw 'exit list)) + ((and todayp (member 'today (car org-agenda-time-grid)))) + ((and (= ndays 1) (member 'daily (car org-agenda-time-grid)))) + ((member 'weekly (car org-agenda-time-grid))) + (t (throw 'exit list))) + (let* ((have (delq nil (mapcar + (lambda (x) (get-text-property 1 'time-of-day x)) + list))) + (string (nth 1 org-agenda-time-grid)) + (gridtimes (nth 2 org-agenda-time-grid)) + (req (car org-agenda-time-grid)) + (remove (member 'remove-match req)) + new time) + (if (and (member 'require-timed req) (not have)) + ;; don't show empty grid + (throw 'exit list)) + (while (setq time (pop gridtimes)) + (unless (and remove (member time have)) + (setq time (replace-regexp-in-string " " "0" (format "%04s" time))) + (push (org-agenda-format-item + nil string nil "" nil + (concat (substring time 0 -2) ":" (substring time -2))) + new) + (put-text-property + 2 (length (car new)) 'face 'org-time-grid (car new)))) + (when (and todayp org-agenda-show-current-time-in-grid) + (push (org-agenda-format-item + nil org-agenda-current-time-string nil "" nil + (format-time-string "%H:%M ")) + new) + (put-text-property + 2 (length (car new)) 'face 'org-agenda-current-time (car new))) + + (if (member 'time-up org-agenda-sorting-strategy-selected) + (append new list) + (append list new))))) + +(defun org-compile-prefix-format (key) + "Compile the prefix format into a Lisp form that can be evaluated. +The resulting form and associated variable bindings is returned +and stored in the variable `org-prefix-format-compiled'." + (setq org-prefix-has-time nil + org-prefix-has-tag nil + org-prefix-category-length nil + org-prefix-has-effort nil + org-prefix-has-breadcrumbs nil) + (let ((s (cond + ((stringp org-agenda-prefix-format) + org-agenda-prefix-format) + ((assq key org-agenda-prefix-format) + (cdr (assq key org-agenda-prefix-format))) + (t " %-12:c%?-12t% s"))) + (start 0) + varform vars var e c f opt) + (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)" + s start) + (setq var (or (cdr (assoc (match-string 4 s) + '(("c" . category) ("t" . time) ("l" . level) ("s" . extra) + ("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs)))) + 'eval) + c (or (match-string 3 s) "") + opt (match-beginning 1) + start (1+ (match-beginning 0))) + (if (equal var 'time) (setq org-prefix-has-time t)) + (if (equal var 'tag) (setq org-prefix-has-tag t)) + (if (equal var 'effort) (setq org-prefix-has-effort t)) + (if (equal var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t)) + (setq f (concat "%" (match-string 2 s) "s")) + (when (equal var 'category) + (setq org-prefix-category-length + (floor (abs (string-to-number (match-string 2 s))))) + (setq org-prefix-category-max-length + (let ((x (match-string 2 s))) + (save-match-data + (if (string-match "\\.[0-9]+" x) + (string-to-number (substring (match-string 0 x) 1))))))) + (if (eq var 'eval) + (setq varform `(format ,f (org-eval ,(read (match-string 4 s))))) + (if opt + (setq varform + `(if (equal "" ,var) + "" + (format ,f (if (equal "" ,var) "" (concat ,var ,c))))) + (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c (get-text-property 0 'extra-space ,var))))))) + (setq s (replace-match "%s" t nil s)) + (push varform vars)) + (setq vars (nreverse vars)) + (with-current-buffer (or org-agenda-buffer (current-buffer)) + (setq org-prefix-format-compiled + (list + `((org-prefix-has-time ,org-prefix-has-time) + (org-prefix-has-tag ,org-prefix-has-tag) + (org-prefix-category-length ,org-prefix-category-length) + (org-prefix-has-effort ,org-prefix-has-effort) + (org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs)) + `(format ,s ,@vars)))))) + +(defun org-set-sorting-strategy (key) + (if (symbolp (car org-agenda-sorting-strategy)) + ;; the old format + (setq org-agenda-sorting-strategy-selected org-agenda-sorting-strategy) + (setq org-agenda-sorting-strategy-selected + (or (cdr (assq key org-agenda-sorting-strategy)) + (cdr (assq 'agenda org-agenda-sorting-strategy)) + '(time-up category-keep priority-down))))) + +(defun org-get-time-of-day (s &optional string mod24) + "Check string S for a time of day. +If found, return it as a military time number between 0 and 2400. +If not found, return nil. +The optional STRING argument forces conversion into a 5 character wide string +HH:MM." + (save-match-data + (when + (and + (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) + (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) + (not (eq (get-text-property 1 'face s) 'org-link))) + (let* ((h (string-to-number (match-string 1 s))) + (m (if (match-end 3) (string-to-number (match-string 3 s)) 0)) + (ampm (if (match-end 4) (downcase (match-string 4 s)))) + (am-p (equal ampm "am")) + (h1 (cond ((not ampm) h) + ((= h 12) (if am-p 0 12)) + (t (+ h (if am-p 0 12))))) + (h2 (if (and string mod24 (not (and (= m 0) (= h1 24)))) + (mod h1 24) h1)) + (t0 (+ (* 100 h2) m)) + (t1 (concat (if (>= h1 24) "+" " ") + (if (and org-agenda-time-leading-zero + (< t0 1000)) "0" "") + (if (< t0 100) "0" "") + (if (< t0 10) "0" "") + (int-to-string t0)))) + (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) + +(defvar org-agenda-before-sorting-filter-function nil + "Function to be applied to agenda items prior to sorting. +Prior to sorting also means just before they are inserted into the agenda. + +To aid sorting, you may revisit the original entries and add more text +properties which will later be used by the sorting functions. + +The function should take a string argument, an agenda line. +It has access to the text properties in that line, which contain among +other things, the property `org-hd-marker' that points to the entry +where the line comes from. Note that not all lines going into the agenda +have this property, only most. + +The function should return the modified string. It is probably best +to ONLY change text properties. + +You can also use this function as a filter, by returning nil for lines +you don't want to have in the agenda at all. For this application, you +could bind the variable in the options section of a custom command.") + +(defun org-agenda-finalize-entries (list &optional type) + "Sort, limit and concatenate the LIST of agenda items. +The optional argument TYPE tells the agenda type." + (let ((max-effort (cond ((listp org-agenda-max-effort) + (cdr (assoc type org-agenda-max-effort))) + (t org-agenda-max-effort))) + (max-todo (cond ((listp org-agenda-max-todos) + (cdr (assoc type org-agenda-max-todos))) + (t org-agenda-max-todos))) + (max-tags (cond ((listp org-agenda-max-tags) + (cdr (assoc type org-agenda-max-tags))) + (t org-agenda-max-tags))) + (max-entries (cond ((listp org-agenda-max-entries) + (cdr (assoc type org-agenda-max-entries))) + (t org-agenda-max-entries))) l) + (when org-agenda-before-sorting-filter-function + (setq list + (delq nil + (mapcar + org-agenda-before-sorting-filter-function list)))) + (setq list (mapcar 'org-agenda-highlight-todo list) + list (mapcar 'identity (sort list 'org-entries-lessp))) + (when max-effort + (setq list (org-agenda-limit-entries + list 'effort-minutes max-effort 'identity))) + (when max-todo + (setq list (org-agenda-limit-entries list 'todo-state max-todo))) + (when max-tags + (setq list (org-agenda-limit-entries list 'tags max-tags))) + (when max-entries + (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries))) + (mapconcat 'identity list "\n"))) + +(defun org-agenda-limit-entries (list prop limit &optional fn) + "Limit the number of agenda entries." + (let ((include (and limit (< limit 0)))) + (if limit + (let ((fun (or fn (lambda (p) (if p 1)))) + (lim 0)) + (delq nil + (mapcar + (lambda (e) + (let ((pval (funcall fun (get-text-property 1 prop e)))) + (if pval (setq lim (+ lim pval))) + (cond ((and pval (<= lim (abs limit))) e) + ((and include (not pval)) e)))) + list))) + list))) + +(defun org-agenda-limit-interactively () + "In agenda, interactively limit entries to various maximums." + (interactive) + (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? ")) + (num (string-to-number (read-from-minibuffer "How many? ")))) + (cond ((equal max ?e) + (let ((org-agenda-max-entries num)) (org-agenda-redo))) + ((equal max ?t) + (let ((org-agenda-max-todos num)) (org-agenda-redo))) + ((equal max ?T) + (let ((org-agenda-max-tags num)) (org-agenda-redo))) + ((equal max ?E) + (let ((org-agenda-max-effort num)) (org-agenda-redo))))) + (org-agenda-fit-window-to-buffer)) + +(defun org-agenda-highlight-todo (x) + (let ((org-done-keywords org-done-keywords-for-agenda) + (case-fold-search nil) + re) + (if (eq x 'line) + (save-excursion + (beginning-of-line 1) + (setq re (org-get-at-bol 'org-todo-regexp)) + (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point))) + (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) + (add-text-properties (match-beginning 0) (match-end 1) + (list 'face (org-get-todo-face 1))) + (let ((s (buffer-substring (match-beginning 1) (match-end 1)))) + (delete-region (match-beginning 1) (1- (match-end 0))) + (goto-char (match-beginning 1)) + (insert (format org-agenda-todo-keyword-format s))))) + (let ((pl (text-property-any 0 (length x) 'org-heading t x))) + (setq re (get-text-property 0 'org-todo-regexp x)) + (when (and re + ;; Test `pl' because if there's no heading content, + ;; there's no point matching to highlight. Note + ;; that if we didn't test `pl' first, and there + ;; happened to be no keyword from `org-todo-regexp' + ;; on this heading line, then the `equal' comparison + ;; afterwards would spuriously succeed in the case + ;; where `pl' is nil -- causing an args-out-of-range + ;; error when we try to add text properties to text + ;; that isn't there. + pl + (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") + x pl) pl)) + (add-text-properties + (or (match-end 1) (match-end 0)) (match-end 0) + (list 'face (org-get-todo-face (match-string 2 x))) + x) + (when (match-end 1) + (setq x (concat (substring x 0 (match-end 1)) + (format org-agenda-todo-keyword-format + (match-string 2 x)) + (org-add-props " " (text-properties-at 0 x)) + (substring x (match-end 3))))))) + x))) + +(defsubst org-cmp-priority (a b) + "Compare the priorities of string A and B." + (let ((pa (or (get-text-property 1 'priority a) 0)) + (pb (or (get-text-property 1 'priority b) 0))) + (cond ((> pa pb) +1) + ((< pa pb) -1)))) + +(defsubst org-cmp-effort (a b) + "Compare the effort values of string A and B." + (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1)) + (ea (or (get-text-property 1 'effort-minutes a) def)) + (eb (or (get-text-property 1 'effort-minutes b) def))) + (cond ((> ea eb) +1) + ((< ea eb) -1)))) + +(defsubst org-cmp-category (a b) + "Compare the string values of categories of strings A and B." + (let ((ca (or (get-text-property 1 'org-category a) "")) + (cb (or (get-text-property 1 'org-category b) ""))) + (cond ((string-lessp ca cb) -1) + ((string-lessp cb ca) +1)))) + +(defsubst org-cmp-todo-state (a b) + "Compare the todo states of strings A and B." + (let* ((ma (or (get-text-property 1 'org-marker a) + (get-text-property 1 'org-hd-marker a))) + (mb (or (get-text-property 1 'org-marker b) + (get-text-property 1 'org-hd-marker b))) + (fa (and ma (marker-buffer ma))) + (fb (and mb (marker-buffer mb))) + (todo-kwds + (or (and fa (with-current-buffer fa org-todo-keywords-1)) + (and fb (with-current-buffer fb org-todo-keywords-1)))) + (ta (or (get-text-property 1 'todo-state a) "")) + (tb (or (get-text-property 1 'todo-state b) "")) + (la (- (length (member ta todo-kwds)))) + (lb (- (length (member tb todo-kwds)))) + (donepa (member ta org-done-keywords-for-agenda)) + (donepb (member tb org-done-keywords-for-agenda))) + (cond ((and donepa (not donepb)) -1) + ((and (not donepa) donepb) +1) + ((< la lb) -1) + ((< lb la) +1)))) + +(defsubst org-cmp-alpha (a b) + "Compare the headlines, alphabetically." + (let* ((pla (text-property-any 0 (length a) 'org-heading t a)) + (plb (text-property-any 0 (length b) 'org-heading t b)) + (ta (and pla (substring a pla))) + (tb (and plb (substring b plb)))) + (when pla + (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "") + "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta) + (setq ta (substring ta (match-end 0)))) + (setq ta (downcase ta))) + (when plb + (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "") + "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") tb) + (setq tb (substring tb (match-end 0)))) + (setq tb (downcase tb))) + (cond ((not ta) +1) + ((not tb) -1) + ((string-lessp ta tb) -1) + ((string-lessp tb ta) +1)))) + +(defsubst org-cmp-tag (a b) + "Compare the string values of the first tags of A and B." + (let ((ta (car (last (get-text-property 1 'tags a)))) + (tb (car (last (get-text-property 1 'tags b))))) + (cond ((not ta) +1) + ((not tb) -1) + ((string-lessp ta tb) -1) + ((string-lessp tb ta) +1)))) + +(defsubst org-cmp-time (a b) + "Compare the time-of-day values of strings A and B." + (let* ((def (if org-sort-agenda-notime-is-late 9901 -1)) + (ta (or (get-text-property 1 'time-of-day a) def)) + (tb (or (get-text-property 1 'time-of-day b) def))) + (cond ((< ta tb) -1) + ((< tb ta) +1)))) + +(defsubst org-cmp-ts (a b type) + "Compare the timestamps values of entries A and B. +When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or +\"timestamp_ia\", compare within each of these type. When TYPE +is the empty string, compare all timestamps without respect of +their type." + (let* ((def (if org-sort-agenda-notime-is-late most-positive-fixnum -1)) + (ta (or (and (string-match type (or (get-text-property 1 'type a) "")) + (get-text-property 1 'ts-date a)) + def)) + (tb (or (and (string-match type (or (get-text-property 1 'type b) "")) + (get-text-property 1 'ts-date b)) + def))) + (cond ((< ta tb) -1) + ((< tb ta) +1)))) + +(defsubst org-cmp-habit-p (a b) + "Compare the todo states of strings A and B." + (let ((ha (get-text-property 1 'org-habit-p a)) + (hb (get-text-property 1 'org-habit-p b))) + (cond ((and ha (not hb)) -1) + ((and (not ha) hb) +1)))) + +(defun org-entries-lessp (a b) + "Predicate for sorting agenda entries." + ;; The following variables will be used when the form is evaluated. + ;; So even though the compiler complains, keep them. + (let* ((ss org-agenda-sorting-strategy-selected) + (timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss) + (org-cmp-ts a b ""))) + (timestamp-down (if timestamp-up (- timestamp-up) nil)) + (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss) + (org-cmp-ts a b "scheduled"))) + (scheduled-down (if scheduled-up (- scheduled-up) nil)) + (deadline-up (and (org-em 'deadline-up 'deadline-down ss) + (org-cmp-ts a b "deadline"))) + (deadline-down (if deadline-up (- deadline-up) nil)) + (tsia-up (and (org-em 'tsia-up 'tsia-down ss) + (org-cmp-ts a b "timestamp_ia"))) + (tsia-down (if tsia-up (- tsia-up) nil)) + (ts-up (and (org-em 'ts-up 'ts-down ss) + (org-cmp-ts a b "timestamp"))) + (ts-down (if ts-up (- ts-up) nil)) + (time-up (and (org-em 'time-up 'time-down ss) + (org-cmp-time a b))) + (time-down (if time-up (- time-up) nil)) + (priority-up (and (org-em 'priority-up 'priority-down ss) + (org-cmp-priority a b))) + (priority-down (if priority-up (- priority-up) nil)) + (effort-up (and (org-em 'effort-up 'effort-down ss) + (org-cmp-effort a b))) + (effort-down (if effort-up (- effort-up) nil)) + (category-up (and (or (org-em 'category-up 'category-down ss) + (memq 'category-keep ss)) + (org-cmp-category a b))) + (category-down (if category-up (- category-up) nil)) + (category-keep (if category-up +1 nil)) + (tag-up (and (org-em 'tag-up 'tag-down ss) + (org-cmp-tag a b))) + (tag-down (if tag-up (- tag-up) nil)) + (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss) + (org-cmp-todo-state a b))) + (todo-state-down (if todo-state-up (- todo-state-up) nil)) + (habit-up (and (org-em 'habit-up 'habit-down ss) + (org-cmp-habit-p a b))) + (habit-down (if habit-up (- habit-up) nil)) + (alpha-up (and (org-em 'alpha-up 'alpha-down ss) + (org-cmp-alpha a b))) + (alpha-down (if alpha-up (- alpha-up) nil)) + (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss)) + user-defined-up user-defined-down) + (if (and need-user-cmp org-agenda-cmp-user-defined + (functionp org-agenda-cmp-user-defined)) + (setq user-defined-up + (funcall org-agenda-cmp-user-defined a b) + user-defined-down (if user-defined-up (- user-defined-up) nil))) + (cdr (assoc + (eval (cons 'or org-agenda-sorting-strategy-selected)) + '((-1 . t) (1 . nil) (nil . nil)))))) + +;;; Agenda restriction lock + +(defvar org-agenda-restriction-lock-overlay (make-overlay 1 1) + "Overlay to mark the headline to which agenda commands are restricted.") +(overlay-put org-agenda-restriction-lock-overlay + 'face 'org-agenda-restriction-lock) +(overlay-put org-agenda-restriction-lock-overlay + 'help-echo "Agendas are currently limited to this subtree.") +(org-detach-overlay org-agenda-restriction-lock-overlay) + +;;;###autoload +(defun org-agenda-set-restriction-lock (&optional type) + "Set restriction lock for agenda, to current subtree or file. +Restriction will be the file if TYPE is `file', or if type is the +universal prefix '(4), or if the cursor is before the first headline +in the file. Otherwise, restriction will be to the current subtree." + (interactive "P") + (and (equal type '(4)) (setq type 'file)) + (setq type (cond + (type type) + ((org-at-heading-p) 'subtree) + ((condition-case nil (org-back-to-heading t) (error nil)) + 'subtree) + (t 'file))) + (if (eq type 'subtree) + (progn + (setq org-agenda-restrict (current-buffer)) + (setq org-agenda-overriding-restriction 'subtree) + (put 'org-agenda-files 'org-restrict + (list (buffer-file-name (buffer-base-buffer)))) + (org-back-to-heading t) + (move-overlay org-agenda-restriction-lock-overlay + (point) + (if org-agenda-restriction-lock-highlight-subtree + (save-excursion (org-end-of-subtree t t) (point)) + (point-at-eol))) + (move-marker org-agenda-restrict-begin (point)) + (move-marker org-agenda-restrict-end + (save-excursion (org-end-of-subtree t t))) + (message "Locking agenda restriction to subtree")) + (put 'org-agenda-files 'org-restrict + (list (buffer-file-name (buffer-base-buffer)))) + (setq org-agenda-restrict nil) + (setq org-agenda-overriding-restriction 'file) + (move-marker org-agenda-restrict-begin nil) + (move-marker org-agenda-restrict-end nil) + (message "Locking agenda restriction to file")) + (setq current-prefix-arg nil) + (org-agenda-maybe-redo)) + +(defun org-agenda-remove-restriction-lock (&optional noupdate) + "Remove the agenda restriction lock." + (interactive "P") + (org-detach-overlay org-agenda-restriction-lock-overlay) + (org-detach-overlay org-speedbar-restriction-lock-overlay) + (setq org-agenda-overriding-restriction nil) + (setq org-agenda-restrict nil) + (put 'org-agenda-files 'org-restrict nil) + (move-marker org-agenda-restrict-begin nil) + (move-marker org-agenda-restrict-end nil) + (setq current-prefix-arg nil) + (message "Agenda restriction lock removed") + (or noupdate (org-agenda-maybe-redo))) + +(defun org-agenda-maybe-redo () + "If there is any window showing the agenda view, update it." + (let ((w (get-buffer-window org-agenda-buffer-name t)) + (w0 (selected-window))) + (when w + (select-window w) + (org-agenda-redo) + (select-window w0) + (if org-agenda-overriding-restriction + (message "Agenda view shifted to new %s restriction" + org-agenda-overriding-restriction) + (message "Agenda restriction lock removed"))))) + +;;; Agenda commands + +(defun org-agenda-check-type (error &rest types) + "Check if agenda buffer is of allowed type. +If ERROR is non-nil, throw an error, otherwise just return nil. +Allowed types are 'agenda 'timeline 'todo 'tags 'search." + (if (not org-agenda-type) + (error "No Org agenda currently displayed") + (if (memq org-agenda-type types) + t + (if error + (error "Not allowed in %s-type agenda buffers" org-agenda-type) + nil)))) + +(defun org-agenda-Quit () + "Exit the agenda and kill buffers loaded by `org-agenda'. +Also restore the window configuration." + (interactive) + (if org-agenda-columns-active + (org-columns-quit) + (let ((buf (current-buffer))) + (if (eq org-agenda-window-setup 'other-frame) + (progn + (org-agenda-reset-markers) + (kill-buffer buf) + (org-columns-remove-overlays) + (setq org-agenda-archives-mode nil) + (delete-frame)) + (and (not (eq org-agenda-window-setup 'current-window)) + (not (one-window-p)) + (delete-window)) + (org-agenda-reset-markers) + (kill-buffer buf) + (org-columns-remove-overlays) + (setq org-agenda-archives-mode nil))) + (setq org-agenda-buffer nil) + ;; Maybe restore the pre-agenda window configuration. + (and org-agenda-restore-windows-after-quit + (not (eq org-agenda-window-setup 'other-frame)) + org-agenda-pre-window-conf + (set-window-configuration org-agenda-pre-window-conf) + (setq org-agenda-pre-window-conf nil)))) + +(defun org-agenda-quit () + "Exit the agenda and restore the window configuration. +When `org-agenda-sticky' is non-nil, only bury the agenda." + (interactive) + (if (and (eq org-indirect-buffer-display 'other-window) + org-last-indirect-buffer) + (let ((org-last-indirect-window + (get-buffer-window org-last-indirect-buffer))) + (if org-last-indirect-window + (delete-window org-last-indirect-window)))) + (if org-agenda-columns-active + (org-columns-quit) + (if org-agenda-sticky + (let ((buf (current-buffer))) + (if (eq org-agenda-window-setup 'other-frame) + (progn + (delete-frame)) + (and (not (eq org-agenda-window-setup 'current-window)) + (not (one-window-p)) + (delete-window))) + (with-current-buffer buf + (bury-buffer) + ;; Maybe restore the pre-agenda window configuration. + (and org-agenda-restore-windows-after-quit + (not (eq org-agenda-window-setup 'other-frame)) + org-agenda-pre-window-conf + (set-window-configuration org-agenda-pre-window-conf) + (setq org-agenda-pre-window-conf nil)))) + (org-agenda-Quit)))) + +(defun org-agenda-exit () + "Exit the agenda and restore the window configuration. +Also kill Org-mode buffers loaded by `org-agenda'. Org-mode +buffers visited directly by the user will not be touched." + (interactive) + (org-release-buffers org-agenda-new-buffers) + (setq org-agenda-new-buffers nil) + (org-agenda-Quit)) + +(defun org-agenda-kill-all-agenda-buffers () + "Kill all buffers in `org-agenda-mode'. +This is used when toggling sticky agendas. +You can also explicitly invoke it with `C-c a C-k'." + (interactive) + (let (blist) + (dolist (buf (buffer-list)) + (when (with-current-buffer buf (eq major-mode 'org-agenda-mode)) + (push buf blist))) + (mapc 'kill-buffer blist))) + +(defun org-agenda-execute (arg) + "Execute another agenda command, keeping same window. +So this is just a shortcut for \\`\\[org-agenda]', available +in the agenda." + (interactive "P") + (let ((org-agenda-window-setup 'current-window)) + (org-agenda arg))) + +(defun org-agenda-redo (&optional all) + "Rebuild possibly ALL agenda view(s) in the current buffer." + (interactive "P") + (let* ((p (or (and (looking-at "\\'") (1- (point))) (point))) + (cpa (unless (eq all t) current-prefix-arg)) + (org-agenda-doing-sticky-redo org-agenda-sticky) + (org-agenda-sticky nil) + (org-agenda-buffer-name (or org-agenda-this-buffer-name + org-agenda-buffer-name)) + (org-agenda-keep-modes t) + (tag-filter org-agenda-tag-filter) + (tag-preset (get 'org-agenda-tag-filter :preset-filter)) + (top-hl-filter org-agenda-top-headline-filter) + (cat-filter org-agenda-category-filter) + (cat-preset (get 'org-agenda-category-filter :preset-filter)) + (re-filter org-agenda-regexp-filter) + (re-preset (get 'org-agenda-regexp-filter :preset-filter)) + (cols org-agenda-columns-active) + (line (org-current-line)) + (window-line (- line (org-current-line (window-start)))) + (lprops (get 'org-agenda-redo-command 'org-lprops)) + (redo-cmd (get-text-property p 'org-redo-cmd)) + (last-args (get-text-property p 'org-last-args)) + (org-agenda-overriding-cmd (get-text-property p 'org-series-cmd)) + (org-agenda-overriding-cmd-arguments + (unless (eq all t) + (cond ((listp last-args) + (cons (or cpa (car last-args)) (cdr last-args))) + ((stringp last-args) + last-args)))) + (series-redo-cmd (get-text-property p 'org-series-redo-cmd))) + (put 'org-agenda-tag-filter :preset-filter nil) + (put 'org-agenda-category-filter :preset-filter nil) + (put 'org-agenda-regexp-filter :preset-filter nil) + (and cols (org-columns-quit)) + (message "Rebuilding agenda buffer...") + (if series-redo-cmd + (eval series-redo-cmd) + (org-let lprops redo-cmd)) + (setq org-agenda-undo-list nil + org-agenda-pending-undo-list nil + org-agenda-tag-filter tag-filter + org-agenda-category-filter cat-filter + org-agenda-regexp-filter re-filter + org-agenda-top-headline-filter top-hl-filter) + (message "Rebuilding agenda buffer...done") + (put 'org-agenda-tag-filter :preset-filter tag-preset) + (put 'org-agenda-category-filter :preset-filter cat-preset) + (put 'org-agenda-regexp-filter :preset-filter re-preset) + (let ((tag (or tag-filter tag-preset)) + (cat (or cat-filter cat-preset)) + (re (or re-filter re-preset))) + (when tag (org-agenda-filter-apply tag 'tag)) + (when cat (org-agenda-filter-apply cat 'category)) + (when re (org-agenda-filter-apply re 'regexp))) + (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter)) + (and cols (org-called-interactively-p 'any) (org-agenda-columns)) + (org-goto-line line) + (recenter window-line))) + +(defvar org-global-tags-completion-table nil) +(defvar org-agenda-filter-form nil) +(defvar org-agenda-filtered-by-category nil) + +(defun org-agenda-filter-by-category (strip) + "Keep only those lines in the agenda buffer that have a specific category. +The category is that of the current line." + (interactive "P") + (if (and org-agenda-filtered-by-category + org-agenda-category-filter) + (org-agenda-filter-show-all-cat) + (let ((cat (org-no-properties (get-text-property (point) 'org-category)))) + (cond + ((and cat strip) + (org-agenda-filter-apply + (push (concat "-" cat) org-agenda-category-filter) 'category)) + ((and cat) + (org-agenda-filter-apply + (setq org-agenda-category-filter + (list (concat "+" cat))) 'category)) + (t (error "No category at point")))))) + +(defun org-find-top-headline (&optional pos) + "Find the topmost parent headline and return it." + (save-excursion + (with-current-buffer (if pos (marker-buffer pos) (current-buffer)) + (if pos (goto-char pos)) + ;; Skip up to the topmost parent + (while (ignore-errors (outline-up-heading 1) t)) + (ignore-errors + (nth 4 (org-heading-components)))))) + +(defvar org-agenda-filtered-by-top-headline nil) +(defun org-agenda-filter-by-top-headline (strip) + "Keep only those lines that are descendants from the same top headline. +The top headline is that of the current line." + (interactive "P") + (if org-agenda-filtered-by-top-headline + (progn + (setq org-agenda-filtered-by-top-headline nil + org-agenda-top-headline-filter nil) + (org-agenda-filter-show-all-top-filter)) + (let ((toph (org-find-top-headline (org-get-at-bol 'org-hd-marker)))) + (if toph (org-agenda-filter-top-headline-apply toph strip) + (error "No top-level headline at point"))))) + +(defvar org-agenda-regexp-filter nil) +(defun org-agenda-filter-by-regexp (strip) + "Filter agenda entries by a regular expression. +Regexp filters are cumulative. +With no prefix argument, keep entries matching the regexp. +With one prefix argument, filter out entries matching the regexp. +With two prefix arguments, remove the regexp filters." + (interactive "P") + (if (not (equal strip '(16))) + (let ((flt (concat (if (equal strip '(4)) "-" "+") + (read-from-minibuffer + (if (equal strip '(4)) + "Filter out entries matching regexp: " + "Narrow to entries matching regexp: "))))) + (push flt org-agenda-regexp-filter) + (org-agenda-filter-apply org-agenda-regexp-filter 'regexp)) + (org-agenda-filter-show-all-re) + (message "Regexp filter removed"))) + +(defun org-agenda-filter-remove-all () + "Remove all filters from the current agenda buffer." + (interactive) + (when org-agenda-tag-filter + (org-agenda-filter-show-all-tag)) + (when org-agenda-category-filter + (org-agenda-filter-show-all-cat)) + (when org-agenda-regexp-filter + (org-agenda-filter-show-all-re)) + (when org-agenda-top-headline-filter + (org-agenda-filter-show-all-top-filter)) + (org-agenda-finalize)) + +(defun org-agenda-filter-by-tag (strip &optional char narrow) + "Keep only those lines in the agenda buffer that have a specific tag. +The tag is selected with its fast selection letter, as configured. +With prefix argument STRIP, remove all lines that do have the tag. +A lisp caller can specify CHAR. NARROW means that the new tag should be +used to narrow the search - the interactive user can also press `-' or `+' +to switch to narrowing." + (interactive "P") + (let* ((alist org-tag-alist-for-agenda) + (tag-chars (mapconcat + (lambda (x) (if (and (not (symbolp (car x))) + (cdr x)) + (char-to-string (cdr x)) + "")) + alist "")) + (efforts (org-split-string + (or (cdr (assoc (concat org-effort-property "_ALL") + org-global-properties)) + "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00" + ""))) + (effort-op org-agenda-filter-effort-default-operator) + (effort-prompt "") + (inhibit-read-only t) + (current org-agenda-tag-filter) + maybe-refresh a n tag) + (unless char + (message + "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>==<]:effort: " tag-chars) + (setq char (read-char-exclusive))) + (when (member char '(?< ?> ?= ??)) + ;; An effort operator + (setq effort-op (char-to-string char)) + (setq alist nil) ; to make sure it will be interpreted as effort. + (unless (equal char ??) + (loop for i from 0 to 9 do + (setq effort-prompt + (concat + effort-prompt " [" + (if (= i 9) "0" (int-to-string (1+ i))) + "]" (nth i efforts)))) + (message "Effort%s: %s " effort-op effort-prompt) + (setq char (read-char-exclusive)) + (when (or (< char ?0) (> char ?9)) + (error "Need 1-9,0 to select effort")))) + (when (equal char ?\t) + (unless (local-variable-p 'org-global-tags-completion-table (current-buffer)) + (org-set-local 'org-global-tags-completion-table + (org-global-tags-completion-table))) + (let ((completion-ignore-case t)) + (setq tag (org-icompleting-read + "Tag: " org-global-tags-completion-table)))) + (cond + ((equal char ?\r) + (org-agenda-filter-show-all-tag) + (when org-agenda-auto-exclude-function + (setq org-agenda-tag-filter nil) + (dolist (tag (org-agenda-get-represented-tags)) + (let ((modifier (funcall org-agenda-auto-exclude-function tag))) + (if modifier + (push modifier org-agenda-tag-filter)))) + (if (not (null org-agenda-tag-filter)) + (org-agenda-filter-apply org-agenda-tag-filter 'tag))) + (setq maybe-refresh t)) + ((equal char ?/) + (org-agenda-filter-show-all-tag) + (when (get 'org-agenda-tag-filter :preset-filter) + (org-agenda-filter-apply org-agenda-tag-filter 'tag)) + (setq maybe-refresh t)) + ((equal char ?. ) + (setq org-agenda-tag-filter + (mapcar (lambda(tag) (concat "+" tag)) + (org-get-at-bol 'tags))) + (org-agenda-filter-apply org-agenda-tag-filter 'tag) + (setq maybe-refresh t)) + ((or (equal char ?\ ) + (setq a (rassoc char alist)) + (and (>= char ?0) (<= char ?9) + (setq n (if (= char ?0) 9 (- char ?0 1)) + tag (concat effort-op (nth n efforts)) + a (cons tag nil))) + (and (= char ??) + (setq tag "?eff") + a (cons tag nil)) + (and tag (setq a (cons tag nil)))) + (org-agenda-filter-show-all-tag) + (setq tag (car a)) + (setq org-agenda-tag-filter + (cons (concat (if strip "-" "+") tag) + (if narrow current nil))) + (org-agenda-filter-apply org-agenda-tag-filter 'tag) + (setq maybe-refresh t)) + (t (error "Invalid tag selection character %c" char))) + (when maybe-refresh + (org-agenda-redo)))) + +(defun org-agenda-get-represented-tags () + "Get a list of all tags currently represented in the agenda." + (let (p tags) + (save-excursion + (goto-char (point-min)) + (while (setq p (next-single-property-change (point) 'tags)) + (goto-char p) + (mapc (lambda (x) (add-to-list 'tags x)) + (get-text-property (point) 'tags)))) + tags)) + +(defun org-agenda-filter-by-tag-refine (strip &optional char) + "Refine the current filter. See `org-agenda-filter-by-tag'." + (interactive "P") + (org-agenda-filter-by-tag strip char 'refine)) + +(defun org-agenda-filter-make-matcher (filter type) + "Create the form that tests a line for agenda filter." + (let (f f1) + (cond + ;; Tag filter + ((eq type 'tag) + (setq filter + (delete-dups + (append (get 'org-agenda-tag-filter :preset-filter) + filter))) + (dolist (x filter) + (let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1 + (ffunc + (lambda (nf0 nf01 fltr notgroup op) + (dolist (x fltr) + (if (member x '("-" "+")) + (setq nf01 (if (equal x "-") 'tags '(not tags))) + (if (string-match "[<=>?]" x) + (setq nf01 (org-agenda-filter-effort-form x)) + (setq nf01 (list 'member (downcase (substring x 1)) + 'tags))) + (when (equal (string-to-char x) ?-) + (setq nf01 (list 'not nf01)) + (when (not notgroup) (setq op 'and)))) + (push nf01 nf0)) + (if notgroup + (push (cons 'and nf0) f) + (push (cons (or op 'or) nf0) f))))) + (cond ((equal filter '("+")) + (setq f (list (list 'not 'tags)))) + ((equal nfilter filter) + (funcall ffunc f1 f filter t nil)) + (t (funcall ffunc nf1 nf nfilter nil nil)))))) + ;; Category filter + ((eq type 'category) + (setq filter + (delete-dups + (append (get 'org-agenda-category-filter :preset-filter) + filter))) + (dolist (x filter) + (if (equal "-" (substring x 0 1)) + (setq f1 (list 'not (list 'equal (substring x 1) 'cat))) + (setq f1 (list 'equal (substring x 1) 'cat))) + (push f1 f))) + ;; Regexp filter + ((eq type 'regexp) + (setq filter + (delete-dups + (append (get 'org-agenda-regexp-filter :preset-filter) + filter))) + (dolist (x filter) + (if (equal "-" (substring x 0 1)) + (setq f1 (list 'not (list 'string-match (substring x 1) 'txt))) + (setq f1 (list 'string-match (substring x 1) 'txt))) + (push f1 f)))) + (cons 'and (nreverse f)))) + +(defun org-agenda-filter-effort-form (e) + "Return the form to compare the effort of the current line with what E says. +E looks like \"+<2:25\"." + (let (op) + (setq e (substring e 1)) + (setq op (string-to-char e) e (substring e 1)) + (setq op (cond ((equal op ?<) '<=) + ((equal op ?>) '>=) + ((equal op ??) op) + (t '=))) + (list 'org-agenda-compare-effort (list 'quote op) + (org-duration-string-to-minutes e)))) + +(defun org-agenda-compare-effort (op value) + "Compare the effort of the current line with VALUE, using OP. +If the line does not have an effort defined, return nil." + (let ((eff (org-get-at-bol 'effort-minutes))) + (if (equal op ??) + (not eff) + (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0)) + value)))) + +(defun org-agenda-filter-expand-tags (filter &optional no-operator) + "Expand group tags in FILTER for the agenda. +When NO-OPERATOR is non-nil, do not add the + operator to returned tags." + (if org-group-tags + (let ((case-fold-search t) rtn) + (mapc + (lambda (f) + (let (f0 dir) + (if (string-match "^\\([+-]\\)\\(.+\\)" f) + (setq dir (match-string 1 f) f0 (match-string 2 f)) + (setq dir (if no-operator "" "+") f0 f)) + (setq rtn (append (mapcar (lambda(f1) (concat dir f1)) + (org-tags-expand f0 t t)) + rtn)))) + filter) + (reverse rtn)) + filter)) + +(defun org-agenda-filter-apply (filter type) + "Set FILTER as the new agenda filter and apply it." + ;; Deactivate `org-agenda-entry-text-mode' when filtering + (if org-agenda-entry-text-mode (org-agenda-entry-text-mode)) + (let (tags cat txt) + (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type)) + ;; Only set `org-agenda-filtered-by-category' to t when a unique + ;; category is used as the filter: + (setq org-agenda-filtered-by-category + (and (eq type 'category) + (not (equal (substring (car filter) 0 1) "-")))) + (org-agenda-set-mode-name) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (if (org-get-at-bol 'org-marker) + (progn + (setq tags ; used in eval + (apply 'append + (mapcar (lambda (f) + (org-agenda-filter-expand-tags (list f) t)) + (org-get-at-bol 'tags))) + cat (get-text-property (point) 'org-category) + txt (get-text-property (point) 'txt)) + (if (not (eval org-agenda-filter-form)) + (org-agenda-filter-hide-line type)) + (beginning-of-line 2)) + (beginning-of-line 2)))) + (if (get-char-property (point) 'invisible) + (ignore-errors (org-agenda-previous-line))))) + +(defun org-agenda-filter-top-headline-apply (hl &optional negative) + "Filter by top headline HL." + (org-agenda-set-mode-name) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let* ((pos (org-get-at-bol 'org-hd-marker)) + (tophl (and pos (org-find-top-headline pos)))) + (if (and tophl (funcall (if negative 'identity 'not) + (string= hl tophl))) + (org-agenda-filter-hide-line 'top-headline))) + (beginning-of-line 2))) + (if (get-char-property (point) 'invisible) + (org-agenda-previous-line)) + (setq org-agenda-top-headline-filter hl + org-agenda-filtered-by-top-headline t)) + +(defun org-agenda-filter-hide-line (type) + "Hide lines with TYPE in the agenda buffer." + (let* ((b (max (point-min) (1- (point-at-bol)))) + (e (point-at-eol))) + (let ((inhibit-read-only t)) + (add-text-properties + b e `(invisible org-filtered org-filter-type ,type))))) + +(defun org-agenda-remove-filter (type) + (interactive) + "Remove filter of type TYPE from the agenda buffer." + (save-excursion + (goto-char (point-min)) + (let ((inhibit-read-only t) pos) + (while (setq pos (text-property-any (point) (point-max) 'org-filter-type type)) + (goto-char pos) + (remove-text-properties + (point) (next-single-property-change (point) 'org-filter-type) + `(invisible org-filtered org-filter-type ,type)))) + (set (intern (format "org-agenda-%s-filter" (intern-soft type))) nil) + (setq org-agenda-filter-form nil) + (org-agenda-set-mode-name) + (org-agenda-finalize))) + +(defun org-agenda-filter-show-all-tag nil + (org-agenda-remove-filter 'tag)) +(defun org-agenda-filter-show-all-re nil + (org-agenda-remove-filter 'regexp)) +(defun org-agenda-filter-show-all-cat nil + (org-agenda-remove-filter 'category)) +(defun org-agenda-filter-show-all-top-filter nil + (org-agenda-remove-filter 'top-headline)) + +(defun org-agenda-manipulate-query-add () + "Manipulate the query by adding a search term with positive selection. +Positive selection means the term must be matched for selection of an entry." + (interactive) + (org-agenda-manipulate-query ?\[)) +(defun org-agenda-manipulate-query-subtract () + "Manipulate the query by adding a search term with negative selection. +Negative selection means term must not be matched for selection of an entry." + (interactive) + (org-agenda-manipulate-query ?\])) +(defun org-agenda-manipulate-query-add-re () + "Manipulate the query by adding a search regexp with positive selection. +Positive selection means the regexp must match for selection of an entry." + (interactive) + (org-agenda-manipulate-query ?\{)) +(defun org-agenda-manipulate-query-subtract-re () + "Manipulate the query by adding a search regexp with negative selection. +Negative selection means regexp must not match for selection of an entry." + (interactive) + (org-agenda-manipulate-query ?\})) +(defun org-agenda-manipulate-query (char) + (cond + ((memq org-agenda-type '(timeline agenda)) + (let ((org-agenda-include-inactive-timestamps t)) + (org-agenda-redo)) + (message "Display now includes inactive timestamps as well")) + ((eq org-agenda-type 'search) + (org-add-to-string + 'org-agenda-query-string + (if org-agenda-last-search-view-search-was-boolean + (cdr (assoc char '((?\[ . " +") (?\] . " -") + (?\{ . " +{}") (?\} . " -{}")))) + " ")) + (setq org-agenda-redo-command + (list 'org-search-view + (car (get-text-property (min (1- (point-max)) (point)) + 'org-last-args)) + org-agenda-query-string + (+ (length org-agenda-query-string) + (if (member char '(?\{ ?\})) 0 1)))) + (set-register org-agenda-query-register org-agenda-query-string) + (let ((org-agenda-overriding-arguments + (cdr org-agenda-redo-command))) + (org-agenda-redo))) + (t (error "Cannot manipulate query for %s-type agenda buffers" + org-agenda-type)))) + +(defun org-add-to-string (var string) + (set var (concat (symbol-value var) string))) + +(defun org-agenda-goto-date (span) + "Jump to DATE in agenda." + (interactive "P") + (let* ((org-read-date-prefer-future + (eval org-agenda-jump-prefer-future)) + (date (org-read-date)) + (day (time-to-days (org-time-string-to-time date))) + (org-agenda-sticky-orig org-agenda-sticky) + (org-agenda-buffer-tmp-name (buffer-name)) + (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (0-arg (or current-prefix-arg (car args))) + (2-arg (nth 2 args)) + (with-hour-p (nth 4 org-agenda-redo-command)) + (newcmd (list 'org-agenda-list 0-arg date + (org-agenda-span-to-ndays + 2-arg (org-time-string-to-absolute date)) + with-hour-p)) + (newargs (cdr newcmd)) + (inhibit-read-only t) + org-agenda-sticky) + (if (not (org-agenda-check-type t 'agenda)) + (error "Not available in non-agenda views") + (add-text-properties (point-min) (point-max) + `(org-redo-cmd ,newcmd org-last-args ,newargs)) + (org-agenda-redo) + (goto-char (point-min)) + (while (not (or (= (or (get-text-property (point) 'day) 0) day) + (save-excursion (move-beginning-of-line 2) (eobp)))) + (move-beginning-of-line 2)) + (setq org-agenda-sticky org-agenda-sticky-orig + org-agenda-this-buffer-is-sticky org-agenda-sticky)))) + +(defun org-agenda-goto-today () + "Go to today." + (interactive) + (org-agenda-check-type t 'timeline 'agenda) + (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (curspan (nth 2 args)) + (tdpos (text-property-any (point-min) (point-max) 'org-today t))) + (cond + (tdpos (goto-char tdpos)) + ((eq org-agenda-type 'agenda) + (let* ((sd (org-agenda-compute-starting-span + (org-today) (or curspan org-agenda-ndays org-agenda-span))) + (org-agenda-overriding-arguments args)) + (setf (nth 1 org-agenda-overriding-arguments) sd) + (org-agenda-redo) + (org-agenda-find-same-or-today-or-agenda))) + (t (error "Cannot find today"))))) + +(defun org-agenda-find-same-or-today-or-agenda (&optional cnt) + (goto-char + (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt)) + (text-property-any (point-min) (point-max) 'org-today t) + (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda) + (and (get-text-property (min (1- (point-max)) (point)) 'org-series) + (org-agenda-goto-block-beginning)) + (point-min)))) + +(defun org-agenda-goto-block-beginning () + "Go the agenda block beginning." + (interactive) + (if (not (derived-mode-p 'org-agenda-mode)) + (error "Cannot execute this command outside of org-agenda-mode buffers") + (let (dest) + (save-excursion + (unless (looking-at "\\'") + (forward-char)) + (let* ((prop 'org-agenda-structural-header) + (p (previous-single-property-change (point) prop)) + (n (next-single-property-change (or (and (looking-at "\\`") 1) + (1- (point))) prop))) + (setq dest (cond ((eq n (point-at-eol)) (1- n)) (p (1- p)))))) + (if (not dest) + (error "Cannot find the beginning of the blog") + (goto-char dest) + (move-beginning-of-line 1))))) + +(defun org-agenda-later (arg) + "Go forward in time by the current span. +With prefix ARG, go forward that many times the current span." + (interactive "p") + (org-agenda-check-type t 'agenda) + (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (span (or (nth 2 args) org-agenda-current-span)) + (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day)) + (greg (calendar-gregorian-from-absolute sd)) + (cnt (org-get-at-bol 'org-day-cnt)) + greg2) + (cond + ((numberp span) + (setq sd (+ (* span arg) sd))) + ((eq span 'day) + (setq sd (+ arg sd))) + ((eq span 'week) + (setq sd (+ (* 7 arg) sd))) + ((eq span 'fortnight) + (setq sd (+ (* 14 arg) sd))) + ((eq span 'month) + (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg)) + sd (calendar-absolute-from-gregorian greg2)) + (setcar greg2 (1+ (car greg2)))) + ((eq span 'year) + (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg))) + sd (calendar-absolute-from-gregorian greg2)) + (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2)))) + (t + (setq sd (+ (* span arg) sd)))) + (let ((org-agenda-overriding-cmd + ;; `cmd' may have been set by `org-agenda-run-series' which + ;; uses `org-agenda-overriding-cmd' to decide whether + ;; overriding is allowed for `cmd' + (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd)) + (org-agenda-overriding-arguments + (list (car args) sd span))) + (org-agenda-redo) + (org-agenda-find-same-or-today-or-agenda cnt)))) + +(defun org-agenda-earlier (arg) + "Go backward in time by the current span. +With prefix ARG, go backward that many times the current span." + (interactive "p") + (org-agenda-later (- arg))) + +(defun org-agenda-view-mode-dispatch () + "Call one of the view mode commands." + (interactive) + (message "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort + time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck + [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText") + (let ((a (read-char-exclusive))) + (case a + (?\ (call-interactively 'org-agenda-reset-view)) + (?d (call-interactively 'org-agenda-day-view)) + (?w (call-interactively 'org-agenda-week-view)) + (?t (call-interactively 'org-agenda-fortnight-view)) + (?m (call-interactively 'org-agenda-month-view)) + (?y (call-interactively 'org-agenda-year-view)) + (?l (call-interactively 'org-agenda-log-mode)) + (?L (org-agenda-log-mode '(4))) + (?c (org-agenda-log-mode 'clockcheck)) + ((?F ?f) (call-interactively 'org-agenda-follow-mode)) + (?a (call-interactively 'org-agenda-archives-mode)) + (?A (org-agenda-archives-mode 'files)) + ((?R ?r) (call-interactively 'org-agenda-clockreport-mode)) + ((?E ?e) (call-interactively 'org-agenda-entry-text-mode)) + (?G (call-interactively 'org-agenda-toggle-time-grid)) + (?D (call-interactively 'org-agenda-toggle-diary)) + (?\! (call-interactively 'org-agenda-toggle-deadlines)) + (?\[ (let ((org-agenda-include-inactive-timestamps t)) + (org-agenda-check-type t 'timeline 'agenda) + (org-agenda-redo)) + (message "Display now includes inactive timestamps as well")) + (?q (message "Abort")) + (otherwise (error "Invalid key" ))))) + +(defun org-agenda-reset-view () + "Switch to default view for agenda." + (interactive) + (org-agenda-change-time-span (or org-agenda-ndays org-agenda-span))) +(defun org-agenda-day-view (&optional day-of-month) + "Switch to daily view for agenda. +With argument DAY-OF-MONTH, switch to that day of the month." + (interactive "P") + (org-agenda-change-time-span 'day day-of-month)) +(defun org-agenda-week-view (&optional iso-week) + "Switch to daily view for agenda. +With argument ISO-WEEK, switch to the corresponding ISO week. +If ISO-WEEK has more then 2 digits, only the last two encode the +week. Any digits before this encode a year. So 200712 means +week 12 of year 2007. Years in the range 1938-2037 can also be +written as 2-digit years." + (interactive "P") + (org-agenda-change-time-span 'week iso-week)) +(defun org-agenda-fortnight-view (&optional iso-week) + "Switch to daily view for agenda. +With argument ISO-WEEK, switch to the corresponding ISO week. +If ISO-WEEK has more then 2 digits, only the last two encode the +week. Any digits before this encode a year. So 200712 means +week 12 of year 2007. Years in the range 1938-2037 can also be +written as 2-digit years." + (interactive "P") + (org-agenda-change-time-span 'fortnight iso-week)) +(defun org-agenda-month-view (&optional month) + "Switch to monthly view for agenda. +With argument MONTH, switch to that month." + (interactive "P") + (org-agenda-change-time-span 'month month)) +(defun org-agenda-year-view (&optional year) + "Switch to yearly view for agenda. +With argument YEAR, switch to that year. +If MONTH has more then 2 digits, only the last two encode the +month. Any digits before this encode a year. So 200712 means +December year 2007. Years in the range 1938-2037 can also be +written as 2-digit years." + (interactive "P") + (when year + (setq year (org-small-year-to-year year))) + (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ") + (org-agenda-change-time-span 'year year) + (error "Abort"))) + +(defun org-agenda-change-time-span (span &optional n) + "Change the agenda view to SPAN. +SPAN may be `day', `week', `fortnight', `month', `year'." + (org-agenda-check-type t 'agenda) + (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) + (curspan (nth 2 args))) + (if (and (not n) (equal curspan span)) + (error "Viewing span is already \"%s\"" span)) + (let* ((sd (or (org-get-at-bol 'day) + (nth 1 args) + org-starting-day)) + (sd (org-agenda-compute-starting-span sd span n)) + (org-agenda-overriding-cmd + (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd)) + (org-agenda-overriding-arguments + (list (car args) sd span))) + (org-agenda-redo) + (org-agenda-find-same-or-today-or-agenda)) + (org-agenda-set-mode-name) + (message "Switched to %s view" span))) + +(defun org-agenda-compute-starting-span (sd span &optional n) + "Compute starting date for agenda. +SPAN may be `day', `week', `fortnight', `month', `year'. The return value +is a cons cell with the starting date and the number of days, +so that the date SD will be in that range." + (let* ((greg (calendar-gregorian-from-absolute sd)) + (dg (nth 1 greg)) + (mg (car greg)) + (yg (nth 2 greg))) + (cond + ((eq span 'day) + (when n + (setq sd (+ (calendar-absolute-from-gregorian + (list mg 1 yg)) + n -1)))) + ((or (eq span 'week) (eq span 'fortnight)) + (let* ((nt (calendar-day-of-week + (calendar-gregorian-from-absolute sd))) + (d (if org-agenda-start-on-weekday + (- nt org-agenda-start-on-weekday) + 0)) + y1) + (setq sd (- sd (+ (if (< d 0) 7 0) d))) + (when n + (require 'cal-iso) + (when (> n 99) + (setq y1 (org-small-year-to-year (/ n 100)) + n (mod n 100))) + (setq sd + (calendar-iso-to-absolute + (list n 1 + (or y1 (nth 2 (calendar-iso-from-absolute sd))))))))) + ((eq span 'month) + (let (y1) + (when (and n (> n 99)) + (setq y1 (org-small-year-to-year (/ n 100)) + n (mod n 100))) + (setq sd (calendar-absolute-from-gregorian + (list (or n mg) 1 (or y1 yg)))))) + ((eq span 'year) + (setq sd (calendar-absolute-from-gregorian + (list 1 1 (or n yg)))))) + sd)) + +(defun org-agenda-next-date-line (&optional arg) + "Jump to the next line indicating a date in agenda buffer." + (interactive "p") + (org-agenda-check-type t 'agenda 'timeline) + (beginning-of-line 1) + ;; This does not work if user makes date format that starts with a blank + (if (looking-at "^\\S-") (forward-char 1)) + (if (not (re-search-forward "^\\S-" nil t arg)) + (progn + (backward-char 1) + (error "No next date after this line in this buffer"))) + (goto-char (match-beginning 0))) + +(defun org-agenda-previous-date-line (&optional arg) + "Jump to the previous line indicating a date in agenda buffer." + (interactive "p") + (org-agenda-check-type t 'agenda 'timeline) + (beginning-of-line 1) + (if (not (re-search-backward "^\\S-" nil t arg)) + (error "No previous date before this line in this buffer"))) + +;; Initialize the highlight +(defvar org-hl (make-overlay 1 1)) +(overlay-put org-hl 'face 'highlight) + +(defun org-highlight (begin end &optional buffer) + "Highlight a region with overlay." + (move-overlay org-hl begin end (or buffer (current-buffer)))) + +(defun org-unhighlight () + "Detach overlay INDEX." + (org-detach-overlay org-hl)) + +(defun org-unhighlight-once () + "Remove the highlight from its position, and this function from the hook." + (remove-hook 'pre-command-hook 'org-unhighlight-once) + (org-unhighlight)) + +(defvar org-agenda-pre-follow-window-conf nil) +(defun org-agenda-follow-mode () + "Toggle follow mode in an agenda buffer." + (interactive) + (unless org-agenda-follow-mode + (setq org-agenda-pre-follow-window-conf + (current-window-configuration))) + (setq org-agenda-follow-mode (not org-agenda-follow-mode)) + (unless org-agenda-follow-mode + (set-window-configuration org-agenda-pre-follow-window-conf)) + (org-agenda-set-mode-name) + (org-agenda-do-context-action) + (message "Follow mode is %s" + (if org-agenda-follow-mode "on" "off"))) + +(defun org-agenda-entry-text-mode (&optional arg) + "Toggle entry text mode in an agenda buffer." + (interactive "P") + (if (or org-agenda-tag-filter + org-agenda-category-filter + org-agenda-regexp-filter + org-agenda-top-headline-filter) + (user-error "Can't show entry text in filtered views") + (setq org-agenda-entry-text-mode (or (integerp arg) + (not org-agenda-entry-text-mode))) + (org-agenda-entry-text-hide) + (and org-agenda-entry-text-mode + (let ((org-agenda-entry-text-maxlines + (if (integerp arg) arg org-agenda-entry-text-maxlines))) + (org-agenda-entry-text-show))) + (org-agenda-set-mode-name) + (message "Entry text mode is %s%s" + (if org-agenda-entry-text-mode "on" "off") + (if (not org-agenda-entry-text-mode) "" + (format " (maximum number of lines is %d)" + (if (integerp arg) arg org-agenda-entry-text-maxlines)))))) + +(defun org-agenda-clockreport-mode () + "Toggle clocktable mode in an agenda buffer." + (interactive) + (org-agenda-check-type t 'agenda) + (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode)) + (setq org-agenda-start-with-clockreport-mode org-agenda-clockreport-mode) + (org-agenda-set-mode-name) + (org-agenda-redo) + (message "Clocktable mode is %s" + (if org-agenda-clockreport-mode "on" "off"))) + +(defun org-agenda-log-mode (&optional special) + "Toggle log mode in an agenda buffer. +With argument SPECIAL, show all possible log items, not only the ones +configured in `org-agenda-log-mode-items'. +With a double `C-u' prefix arg, show *only* log items, nothing else." + (interactive "P") + (org-agenda-check-type t 'agenda 'timeline) + (setq org-agenda-show-log + (cond + ((equal special '(16)) 'only) + ((eq special 'clockcheck) + (if (eq org-agenda-show-log 'clockcheck) + nil 'clockcheck)) + (special '(closed clock state)) + (t (not org-agenda-show-log)))) + (setq org-agenda-start-with-log-mode org-agenda-show-log) + (org-agenda-set-mode-name) + (org-agenda-redo) + (message "Log mode is %s" + (if org-agenda-show-log "on" "off"))) + +(defun org-agenda-archives-mode (&optional with-files) + "Toggle inclusion of items in trees marked with :ARCHIVE:. +When called with a prefix argument, include all archive files as well." + (interactive "P") + (setq org-agenda-archives-mode + (if with-files t (if org-agenda-archives-mode nil 'trees))) + (org-agenda-set-mode-name) + (org-agenda-redo) + (message + "%s" + (cond + ((eq org-agenda-archives-mode nil) + "No archives are included") + ((eq org-agenda-archives-mode 'trees) + (format "Trees with :%s: tag are included" org-archive-tag)) + ((eq org-agenda-archives-mode t) + (format "Trees with :%s: tag and all active archive files are included" + org-archive-tag))))) + +(defun org-agenda-toggle-diary () + "Toggle diary inclusion in an agenda buffer." + (interactive) + (org-agenda-check-type t 'agenda) + (setq org-agenda-include-diary (not org-agenda-include-diary)) + (org-agenda-redo) + (org-agenda-set-mode-name) + (message "Diary inclusion turned %s" + (if org-agenda-include-diary "on" "off"))) + +(defun org-agenda-toggle-deadlines () + "Toggle inclusion of entries with a deadline in an agenda buffer." + (interactive) + (org-agenda-check-type t 'agenda) + (setq org-agenda-include-deadlines (not org-agenda-include-deadlines)) + (org-agenda-redo) + (org-agenda-set-mode-name) + (message "Deadlines inclusion turned %s" + (if org-agenda-include-deadlines "on" "off"))) + +(defun org-agenda-toggle-time-grid () + "Toggle time grid in an agenda buffer." + (interactive) + (org-agenda-check-type t 'agenda) + (setq org-agenda-use-time-grid (not org-agenda-use-time-grid)) + (org-agenda-redo) + (org-agenda-set-mode-name) + (message "Time-grid turned %s" + (if org-agenda-use-time-grid "on" "off"))) + +(defun org-agenda-set-mode-name () + "Set the mode name to indicate all the small mode settings." + (setq mode-name + (list "Org-Agenda" + (if (get 'org-agenda-files 'org-restrict) " []" "") + " " + '(:eval (org-agenda-span-name org-agenda-current-span)) + (if org-agenda-follow-mode " Follow" "") + (if org-agenda-entry-text-mode " ETxt" "") + (if org-agenda-include-diary " Diary" "") + (if org-agenda-include-deadlines " Ddl" "") + (if org-agenda-use-time-grid " Grid" "") + (if (and (boundp 'org-habit-show-habits) + org-habit-show-habits) " Habit" "") + (cond + ((consp org-agenda-show-log) " LogAll") + ((eq org-agenda-show-log 'clockcheck) " ClkCk") + (org-agenda-show-log " Log") + (t "")) + (if (or org-agenda-category-filter + (get 'org-agenda-category-filter :preset-filter)) + '(:eval (org-propertize + (concat " <" + (mapconcat + 'identity + (append + (get 'org-agenda-category-filter :preset-filter) + org-agenda-category-filter) + "") + ">") + 'face 'org-agenda-filter-category + 'help-echo "Category used in filtering")) "") + (if (or org-agenda-tag-filter + (get 'org-agenda-tag-filter :preset-filter)) + '(:eval (org-propertize + (concat " {" + (mapconcat + 'identity + (append + (get 'org-agenda-tag-filter :preset-filter) + org-agenda-tag-filter) + "") + "}") + 'face 'org-agenda-filter-tags + 'help-echo "Tags used in filtering")) "") + (if (or org-agenda-regexp-filter + (get 'org-agenda-regexp-filter :preset-filter)) + '(:eval (org-propertize + (concat " [" + (mapconcat + 'identity + (append + (get 'org-agenda-regexp-filter :preset-filter) + org-agenda-regexp-filter) + "") + "]") + 'face 'org-agenda-filter-regexp + 'help-echo "Regexp used in filtering")) "") + (if org-agenda-archives-mode + (if (eq org-agenda-archives-mode t) + " Archives" + (format " :%s:" org-archive-tag)) + "") + (if org-agenda-clockreport-mode " Clock" ""))) + (force-mode-line-update)) + +(define-obsolete-function-alias + 'org-agenda-post-command-hook 'org-agenda-update-agenda-type "24.3") + +(defun org-agenda-update-agenda-type () + "Update the agenda type after each command." + (setq org-agenda-type + (or (get-text-property (point) 'org-agenda-type) + (get-text-property (max (point-min) (1- (point))) 'org-agenda-type)))) + +(defun org-agenda-next-line () + "Move cursor to the next line, and show if follow mode is active." + (interactive) + (call-interactively 'next-line) + (org-agenda-do-context-action)) + +(defun org-agenda-previous-line () + "Move cursor to the previous line, and show if follow-mode is active." + (interactive) + (call-interactively 'previous-line) + (org-agenda-do-context-action)) + +(defun org-agenda-next-item (n) + "Move cursor to next agenda item." + (interactive "p") + (let ((col (current-column))) + (dotimes (c n) + (when (next-single-property-change (point-at-eol) 'org-marker) + (move-end-of-line 1) + (goto-char (next-single-property-change (point) 'org-marker)))) + (org-move-to-column col)) + (org-agenda-do-context-action)) + +(defun org-agenda-previous-item (n) + "Move cursor to next agenda item." + (interactive "p") + (dotimes (c n) + (let ((col (current-column)) + (goto (save-excursion + (move-end-of-line 0) + (previous-single-property-change (point) 'org-marker)))) + (if goto (goto-char goto)) + (org-move-to-column col))) + (org-agenda-do-context-action)) + +(defun org-agenda-do-context-action () + "Show outline path and, maybe, follow mode window." + (let ((m (org-get-at-bol 'org-marker))) + (when (and (markerp m) (marker-buffer m)) + (and org-agenda-follow-mode + (if org-agenda-follow-indirect + (org-agenda-tree-to-indirect-buffer nil) + (org-agenda-show))) + (and org-agenda-show-outline-path + (org-with-point-at m (org-display-outline-path t)))))) + +(defun org-agenda-show-tags () + "Show the tags applicable to the current item." + (interactive) + (let* ((tags (org-get-at-bol 'tags))) + (if tags + (message "Tags are :%s:" + (org-no-properties (mapconcat 'identity tags ":"))) + (message "No tags associated with this line")))) + +(defun org-agenda-goto (&optional highlight) + "Go to the Org-mode file which contains the item at point." + (interactive) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker))) + (switch-to-buffer-other-window buffer) + (widen) + (push-mark) + (goto-char pos) + (when (derived-mode-p 'org-mode) + (org-show-context 'agenda) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil)))) ; show the next heading + (when (outline-invisible-p) + (show-entry)) ; display invisible text + (recenter (/ (window-height) 2)) + (run-hooks 'org-agenda-after-show-hook) + (and highlight (org-highlight (point-at-bol) (point-at-eol))))) + +(defvar org-agenda-after-show-hook nil + "Normal hook run after an item has been shown from the agenda. +Point is in the buffer where the item originated.") + +(defun org-agenda-kill () + "Kill the entry or subtree belonging to the current agenda entry." + (interactive) + (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) + (let* ((bufname-orig (buffer-name)) + (marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (type (org-get-at-bol 'type)) + dbeg dend (n 0) conf) + (org-with-remote-undo buffer + (with-current-buffer buffer + (save-excursion + (goto-char pos) + (if (and (derived-mode-p 'org-mode) (not (member type '("sexp")))) + (setq dbeg (progn (org-back-to-heading t) (point)) + dend (org-end-of-subtree t t)) + (setq dbeg (point-at-bol) + dend (min (point-max) (1+ (point-at-eol))))) + (goto-char dbeg) + (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) + (setq conf (or (eq t org-agenda-confirm-kill) + (and (numberp org-agenda-confirm-kill) + (> n org-agenda-confirm-kill)))) + (and conf + (not (y-or-n-p + (format "Delete entry with %d lines in buffer \"%s\"? " + n (buffer-name buffer)))) + (error "Abort")) + (let ((org-agenda-buffer-name bufname-orig)) + (org-remove-subtree-entries-from-agenda buffer dbeg dend)) + (with-current-buffer buffer (delete-region dbeg dend)) + (message "Agenda item and source killed")))) + +(defvar org-archive-default-command) ; defined in org-archive.el +(defun org-agenda-archive-default () + "Archive the entry or subtree belonging to the current agenda entry." + (interactive) + (require 'org-archive) + (org-agenda-archive-with org-archive-default-command)) + +(defun org-agenda-archive-default-with-confirmation () + "Archive the entry or subtree belonging to the current agenda entry." + (interactive) + (require 'org-archive) + (org-agenda-archive-with org-archive-default-command 'confirm)) + +(defun org-agenda-archive () + "Archive the entry or subtree belonging to the current agenda entry." + (interactive) + (org-agenda-archive-with 'org-archive-subtree)) + +(defun org-agenda-archive-to-archive-sibling () + "Move the entry to the archive sibling." + (interactive) + (org-agenda-archive-with 'org-archive-to-archive-sibling)) + +(defun org-agenda-archive-with (cmd &optional confirm) + "Move the entry to the archive sibling." + (interactive) + (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) + (let* ((bufname-orig (buffer-name)) + (marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker))) + (org-with-remote-undo buffer + (with-current-buffer buffer + (if (derived-mode-p 'org-mode) + (if (and confirm + (not (y-or-n-p "Archive this subtree or entry? "))) + (error "Abort") + (save-window-excursion + (goto-char pos) + (let ((org-agenda-buffer-name bufname-orig)) + (org-remove-subtree-entries-from-agenda)) + (org-back-to-heading t) + (funcall cmd))) + (error "Archiving works only in Org-mode files")))))) + +(defun org-remove-subtree-entries-from-agenda (&optional buf beg end) + "Remove all lines in the agenda that correspond to a given subtree. +The subtree is the one in buffer BUF, starting at BEG and ending at END. +If this information is not given, the function uses the tree at point." + (let ((buf (or buf (current-buffer))) m p) + (save-excursion + (unless (and beg end) + (org-back-to-heading t) + (setq beg (point)) + (org-end-of-subtree t) + (setq end (point))) + (set-buffer (get-buffer org-agenda-buffer-name)) + (save-excursion + (goto-char (point-max)) + (beginning-of-line 1) + (while (not (bobp)) + (when (and (setq m (org-get-at-bol 'org-marker)) + (equal buf (marker-buffer m)) + (setq p (marker-position m)) + (>= p beg) + (< p end)) + (let ((inhibit-read-only t)) + (delete-region (point-at-bol) (1+ (point-at-eol))))) + (beginning-of-line 0)))))) + +(defun org-agenda-refile (&optional goto rfloc no-update) + "Refile the item at point. + +When GOTO is 0 or '(64), clear the refile cache. +When GOTO is '(16), go to the location of the last refiled item. +RFLOC can be a refile location obtained in a different way. +When NO-UPDATE is non-nil, don't redo the agenda buffer." + (interactive "P") + (cond + ((member goto '(0 (64))) + (org-refile-cache-clear)) + ((equal goto '(16)) + (org-refile-goto-last-stored)) + (t + (let* ((buffer-orig (buffer-name)) + (marker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (rfloc (or rfloc + (org-refile-get-location + (if goto "Goto" "Refile to") buffer + org-refile-allow-creating-parent-nodes)))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char marker) + (let ((org-agenda-buffer-name buffer-orig)) + (org-remove-subtree-entries-from-agenda)) + (org-refile goto buffer rfloc))))) + (unless no-update (org-agenda-redo))))) + +(defun org-agenda-open-link (&optional arg) + "Open the link(s) in the current entry, if any. +This looks for a link in the displayed line in the agenda. +It also looks at the text of the entry itself." + (interactive "P") + (let* ((marker (or (org-get-at-bol 'org-hd-marker) + (org-get-at-bol 'org-marker))) + (buffer (and marker (marker-buffer marker))) + (prefix (buffer-substring (point-at-bol) (point-at-eol))) + (lkall (and buffer (org-offer-links-in-entry + buffer marker arg prefix))) + (lk0 (car lkall)) + (lk (if (stringp lk0) (list lk0) lk0)) + (lkend (cdr lkall)) + trg) + (cond + ((and buffer lk) + (mapcar (lambda(l) + (with-current-buffer buffer + (setq trg (and (string-match org-bracket-link-regexp l) + (match-string 1 l))) + (if (or (not trg) (string-match org-any-link-re trg)) + (save-excursion + (save-restriction + (widen) + (goto-char marker) + (when (search-forward l nil lkend) + (goto-char (match-beginning 0)) + (org-open-at-point)))) + ;; This is an internal link, widen the buffer + (switch-to-buffer-other-window buffer) + (widen) + (goto-char marker) + (when (search-forward l nil lkend) + (goto-char (match-beginning 0)) + (org-open-at-point))))) + lk)) + ((or (org-in-regexp (concat "\\(" org-bracket-link-regexp "\\)")) + (save-excursion + (beginning-of-line 1) + (looking-at (concat ".*?\\(" org-bracket-link-regexp "\\)")))) + (org-open-link-from-string (match-string 1))) + (t (message "No link to open here"))))) + +(defun org-agenda-copy-local-variable (var) + "Get a variable from a referenced buffer and install it here." + (let ((m (org-get-at-bol 'org-marker))) + (when (and m (buffer-live-p (marker-buffer m))) + (org-set-local var (with-current-buffer (marker-buffer m) + (symbol-value var)))))) + +(defun org-agenda-switch-to (&optional delete-other-windows) + "Go to the Org-mode file which contains the item at point." + (interactive) + (if (and org-return-follows-link + (not (org-get-at-bol 'org-marker)) + (org-in-regexp org-bracket-link-regexp)) + (org-open-link-from-string (match-string 0)) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker))) + (org-pop-to-buffer-same-window buffer) + (and delete-other-windows (delete-other-windows)) + (widen) + (goto-char pos) + (when (derived-mode-p 'org-mode) + (org-show-context 'agenda) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (when (outline-invisible-p) + (show-entry)) ; display invisible text + (run-hooks 'org-agenda-after-show-hook))))) + +(defun org-agenda-goto-mouse (ev) + "Go to the Org-mode file which contains the item at the mouse click." + (interactive "e") + (mouse-set-point ev) + (org-agenda-goto)) + +(defun org-agenda-show (&optional full-entry) + "Display the Org-mode file which contains the item at point. +With prefix argument FULL-ENTRY, make the entire entry visible +if it was hidden in the outline." + (interactive "P") + (let ((win (selected-window))) + (if full-entry + (let ((org-show-entry-below t)) + (org-agenda-goto t)) + (org-agenda-goto t)) + (select-window win))) + +(defvar org-agenda-show-window nil) +(defun org-agenda-show-and-scroll-up (&optional arg) + "Display the Org-mode file which contains the item at point. +When called repeatedly, scroll the window that is displaying the buffer. +With a \\[universal-argument] prefix, use `org-show-entry' instead of +`show-subtree' to display the item, so that drawers and logbooks stay +folded." + (interactive "P") + (let ((win (selected-window))) + (if (and (window-live-p org-agenda-show-window) + (eq this-command last-command)) + (progn + (select-window org-agenda-show-window) + (ignore-errors (scroll-up))) + (org-agenda-goto t) + (if arg (org-show-entry) (show-subtree)) + (setq org-agenda-show-window (selected-window))) + (select-window win))) + +(defun org-agenda-show-scroll-down () + "Scroll down the window showing the agenda." + (interactive) + (let ((win (selected-window))) + (when (window-live-p org-agenda-show-window) + (select-window org-agenda-show-window) + (ignore-errors (scroll-down)) + (select-window win)))) + +(defun org-agenda-show-1 (&optional more) + "Display the Org-mode file which contains the item at point. +The prefix arg selects the amount of information to display: + +0 hide the subtree +1 just show the entry according to defaults. +2 show the children view +3 show the subtree view +4 show the entire subtree and any LOGBOOK drawers +5 show the entire subtree and any drawers +With prefix argument FULL-ENTRY, make the entire entry visible +if it was hidden in the outline." + (interactive "p") + (let ((win (selected-window))) + (org-agenda-goto t) + (org-back-to-heading) + (set-window-start (selected-window) (point-at-bol)) + (cond + ((= more 0) + (hide-subtree) + (save-excursion + (org-back-to-heading) + (run-hook-with-args 'org-cycle-hook 'folded)) + (message "Remote: FOLDED")) + ((and (org-called-interactively-p 'any) (= more 1)) + (message "Remote: show with default settings")) + ((= more 2) + (show-entry) + (show-children) + (save-excursion + (org-back-to-heading) + (run-hook-with-args 'org-cycle-hook 'children)) + (message "Remote: CHILDREN")) + ((= more 3) + (show-subtree) + (save-excursion + (org-back-to-heading) + (run-hook-with-args 'org-cycle-hook 'subtree)) + (message "Remote: SUBTREE")) + ((= more 4) + (let* ((org-drawers (delete "LOGBOOK" (copy-sequence org-drawers))) + (org-drawer-regexp + (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$"))) + (show-subtree) + (save-excursion + (org-back-to-heading) + (org-cycle-hide-drawers 'subtree))) + (message "Remote: SUBTREE AND LOGBOOK")) + ((> more 4) + (show-subtree) + (message "Remote: SUBTREE AND ALL DRAWERS"))) + (select-window win))) + +(defvar org-agenda-cycle-counter nil) +(defun org-agenda-cycle-show (&optional n) + "Show the current entry in another window, with default settings. +Default settings are taken from `org-show-hierarchy-above' and siblings. +When use repeatedly in immediate succession, the remote entry will cycle +through visibility + +children -> subtree -> folded + +When called with a numeric prefix arg, that arg will be passed through to +`org-agenda-show-1'. For the interpretation of that argument, see the +docstring of `org-agenda-show-1'." + (interactive "P") + (if (integerp n) + (setq org-agenda-cycle-counter n) + (if (not (eq last-command this-command)) + (setq org-agenda-cycle-counter 1) + (if (equal org-agenda-cycle-counter 0) + (setq org-agenda-cycle-counter 2) + (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter)) + (if (> org-agenda-cycle-counter 3) + (setq org-agenda-cycle-counter 0))))) + (org-agenda-show-1 org-agenda-cycle-counter)) + +(defun org-agenda-recenter (arg) + "Display the Org-mode file which contains the item at point and recenter." + (interactive "P") + (let ((win (selected-window))) + (org-agenda-goto t) + (recenter arg) + (select-window win))) + +(defun org-agenda-show-mouse (ev) + "Display the Org-mode file which contains the item at the mouse click." + (interactive "e") + (mouse-set-point ev) + (org-agenda-show)) + +(defun org-agenda-check-no-diary () + "Check if the entry is a diary link and abort if yes." + (if (org-get-at-bol 'org-agenda-diary-link) + (org-agenda-error))) + +(defun org-agenda-error () + (error "Command not allowed in this line")) + +(defun org-agenda-tree-to-indirect-buffer (arg) + "Show the subtree corresponding to the current entry in an indirect buffer. +This calls the command `org-tree-to-indirect-buffer' from the original buffer. + +With a numerical prefix ARG, go up to this level and then take that tree. +With a negative numeric ARG, go up by this number of levels. +With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't +use the dedicated frame)." + (interactive "P") + (if current-prefix-arg + (org-agenda-do-tree-to-indirect-buffer arg) + (let ((agenda-buffer (buffer-name)) + (agenda-window (selected-window)) + (indirect-window + (and org-last-indirect-buffer + (get-buffer-window org-last-indirect-buffer)))) + (save-window-excursion (org-agenda-do-tree-to-indirect-buffer arg)) + (unless (or (eq org-indirect-buffer-display 'new-frame) + (eq org-indirect-buffer-display 'dedicated-frame)) + (unwind-protect + (unless (and indirect-window (window-live-p indirect-window)) + (setq indirect-window (split-window agenda-window))) + (and indirect-window (select-window indirect-window)) + (switch-to-buffer org-last-indirect-buffer :norecord) + (fit-window-to-buffer indirect-window))) + (select-window (get-buffer-window agenda-buffer))))) + +(defun org-agenda-do-tree-to-indirect-buffer (arg) + "Same as `org-agenda-tree-to-indirect-buffer' without saving window." + (org-agenda-check-no-diary) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker))) + (with-current-buffer buffer + (save-excursion + (goto-char pos) + (funcall 'org-tree-to-indirect-buffer arg))))) + +(defvar org-last-heading-marker (make-marker) + "Marker pointing to the headline that last changed its TODO state +by a remote command from the agenda.") + +(defun org-agenda-todo-nextset () + "Switch TODO entry to next sequence." + (interactive) + (org-agenda-todo 'nextset)) + +(defun org-agenda-todo-previousset () + "Switch TODO entry to previous sequence." + (interactive) + (org-agenda-todo 'previousset)) + +(defun org-agenda-todo (&optional arg) + "Cycle TODO state of line at point, also in Org-mode file. +This changes the line at point, all other lines in the agenda referring to +the same tree node, and the headline of the tree node in the Org-mode file." + (interactive "P") + (org-agenda-check-no-diary) + (let* ((col (current-column)) + (marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (hdmarker (org-get-at-bol 'org-hd-marker)) + (todayp (org-agenda-todayp (org-get-at-bol 'day))) + (inhibit-read-only t) + org-agenda-headline-snapshot-before-repeat newhead just-one) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (let ((current-prefix-arg arg)) + (call-interactively 'org-todo)) + (and (bolp) (forward-char 1)) + (setq newhead (org-get-heading)) + (when (and (org-bound-and-true-p + org-agenda-headline-snapshot-before-repeat) + (not (equal org-agenda-headline-snapshot-before-repeat + newhead)) + todayp) + (setq newhead org-agenda-headline-snapshot-before-repeat + just-one t)) + (save-excursion + (org-back-to-heading) + (move-marker org-last-heading-marker (point)))) + (beginning-of-line 1) + (save-window-excursion + (org-agenda-change-all-lines newhead hdmarker 'fixface just-one)) + (when (org-bound-and-true-p org-clock-out-when-done) + (string-match (concat "^" (regexp-opt org-done-keywords-for-agenda)) + newhead) + (org-agenda-unmark-clocking-task)) + (org-move-to-column col)))) + +(defun org-agenda-add-note (&optional arg) + "Add a time-stamped note to the entry at point." + (interactive "P") + (org-agenda-check-no-diary) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (hdmarker (org-get-at-bol 'org-hd-marker)) + (inhibit-read-only t)) + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (org-add-note)))) + +(defun org-agenda-change-all-lines (newhead hdmarker + &optional fixface just-this) + "Change all lines in the agenda buffer which match HDMARKER. +The new content of the line will be NEWHEAD (as modified by +`org-agenda-format-item'). HDMARKER is checked with +`equal' against all `org-hd-marker' text properties in the file. +If FIXFACE is non-nil, the face of each item is modified according to +the new TODO state. +If JUST-THIS is non-nil, change just the current line, not all. +If FORCE-TAGS is non nil, the car of it returns the new tags." + (let* ((inhibit-read-only t) + (line (org-current-line)) + (org-agenda-buffer (current-buffer)) + (thetags (with-current-buffer (marker-buffer hdmarker) + (save-excursion (save-restriction (widen) + (goto-char hdmarker) + (org-get-tags-at))))) + props m pl undone-face done-face finish new dotime level cat tags) + (save-excursion + (goto-char (point-max)) + (beginning-of-line 1) + (while (not finish) + (setq finish (bobp)) + (when (and (setq m (org-get-at-bol 'org-hd-marker)) + (or (not just-this) (= (org-current-line) line)) + (equal m hdmarker)) + (setq props (text-properties-at (point)) + dotime (org-get-at-bol 'dotime) + cat (org-get-at-bol 'org-category) + level (org-get-at-bol 'level) + tags thetags + new + (let ((org-prefix-format-compiled + (or (get-text-property (min (1- (point-max)) (point)) 'format) + org-prefix-format-compiled)) + (extra (org-get-at-bol 'extra))) + (with-current-buffer (marker-buffer hdmarker) + (save-excursion + (save-restriction + (widen) + (org-agenda-format-item extra newhead level cat tags dotime))))) + pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) + undone-face (org-get-at-bol 'undone-face) + done-face (org-get-at-bol 'done-face)) + (beginning-of-line 1) + (cond + ((equal new "") + (and (looking-at ".*\n?") (replace-match ""))) + ((looking-at ".*") + (replace-match new t t) + (beginning-of-line 1) + (add-text-properties (point-at-bol) (point-at-eol) props) + (when fixface + (add-text-properties + (point-at-bol) (point-at-eol) + (list 'face + (if org-last-todo-state-is-todo + undone-face done-face)))) + (org-agenda-highlight-todo 'line) + (beginning-of-line 1)) + (t (error "Line update did not work"))) + (save-restriction + (narrow-to-region (point-at-bol) (point-at-eol)) + (org-agenda-finalize))) + (beginning-of-line 0))))) + +(defun org-agenda-align-tags (&optional line) + "Align all tags in agenda items to `org-agenda-tags-column'." + (let ((inhibit-read-only t) l c) + (save-excursion + (goto-char (if line (point-at-bol) (point-min))) + (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") + (if line (point-at-eol) nil) t) + (add-text-properties + (match-beginning 2) (match-end 2) + (list 'face (delq nil (let ((prop (get-text-property + (match-beginning 2) 'face))) + (or (listp prop) (setq prop (list prop))) + (if (memq 'org-tag prop) + prop + (cons 'org-tag prop)))))) + (setq l (- (match-end 2) (match-beginning 2)) + c (if (< org-agenda-tags-column 0) + (- (abs org-agenda-tags-column) l) + org-agenda-tags-column)) + (delete-region (match-beginning 1) (match-end 1)) + (goto-char (match-beginning 1)) + (insert (org-add-props + (make-string (max 1 (- c (current-column))) ?\ ) + (plist-put (copy-sequence (text-properties-at (point))) + 'face nil)))) + (goto-char (point-min)) + (org-font-lock-add-tag-faces (point-max))))) + +(defun org-agenda-priority-up () + "Increase the priority of line at point, also in Org-mode file." + (interactive) + (org-agenda-priority 'up)) + +(defun org-agenda-priority-down () + "Decrease the priority of line at point, also in Org-mode file." + (interactive) + (org-agenda-priority 'down)) + +(defun org-agenda-priority (&optional force-direction) + "Set the priority of line at point, also in Org-mode file. +This changes the line at point, all other lines in the agenda referring to +the same tree node, and the headline of the tree node in the Org-mode file. +Called with a universal prefix arg, show the priority instead of setting it." + (interactive "P") + (if (equal force-direction '(4)) + (org-show-priority) + (unless org-enable-priority-commands + (error "Priority commands are disabled")) + (org-agenda-check-no-diary) + (let* ((col (current-column)) + (marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (hdmarker (org-get-at-bol 'org-hd-marker)) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (funcall 'org-priority force-direction) + (end-of-line 1) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker) + (org-move-to-column col))))) + +;; FIXME: should fix the tags property of the agenda line. +(defun org-agenda-set-tags (&optional tag onoff) + "Set tags for the current headline." + (interactive) + (org-agenda-check-no-diary) + (if (and (org-region-active-p) (org-called-interactively-p 'any)) + (call-interactively 'org-change-tag-in-region) + (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (save-excursion + (org-show-context 'agenda)) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (goto-char pos) + (if tag + (org-toggle-tag tag onoff) + (call-interactively 'org-set-tags)) + (end-of-line 1) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker) + (beginning-of-line 1))))) + +(defun org-agenda-set-property () + "Set a property for the current headline." + (interactive) + (org-agenda-check-no-diary) + (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (save-excursion + (org-show-context 'agenda)) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (goto-char pos) + (call-interactively 'org-set-property))))) + +(defun org-agenda-set-effort () + "Set the effort property for the current headline." + (interactive) + (org-agenda-check-no-diary) + (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (save-excursion + (org-show-context 'agenda)) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (goto-char pos) + (call-interactively 'org-set-effort) + (end-of-line 1) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker)))) + +(defun org-agenda-toggle-archive-tag () + "Toggle the archive tag for the current entry." + (interactive) + (org-agenda-check-no-diary) + (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (call-interactively 'org-toggle-archive-tag) + (end-of-line 1) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker) + (beginning-of-line 1)))) + +(defun org-agenda-do-date-later (arg) + (interactive "P") + (cond + ((or (equal arg '(16)) + (memq last-command + '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) + (setq this-command 'org-agenda-date-later-minutes) + (org-agenda-date-later-minutes 1)) + ((or (equal arg '(4)) + (memq last-command + '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) + (setq this-command 'org-agenda-date-later-hours) + (org-agenda-date-later-hours 1)) + (t + (org-agenda-date-later (prefix-numeric-value arg))))) + +(defun org-agenda-do-date-earlier (arg) + (interactive "P") + (cond + ((or (equal arg '(16)) + (memq last-command + '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) + (setq this-command 'org-agenda-date-earlier-minutes) + (org-agenda-date-earlier-minutes 1)) + ((or (equal arg '(4)) + (memq last-command + '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) + (setq this-command 'org-agenda-date-earlier-hours) + (org-agenda-date-earlier-hours 1)) + (t + (org-agenda-date-earlier (prefix-numeric-value arg))))) + +(defun org-agenda-date-later (arg &optional what) + "Change the date of this item to ARG day(s) later." + (interactive "p") + (org-agenda-check-type t 'agenda 'timeline) + (org-agenda-check-no-diary) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + cdate today) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (if (not (org-at-timestamp-p)) + (error "Cannot find time stamp")) + (when (and org-agenda-move-date-from-past-immediately-to-today + (equal arg 1) + (or (not what) (eq what 'day)) + (not (save-match-data (org-at-date-range-p)))) + (setq cdate (org-parse-time-string (match-string 0) 'nodefault) + cdate (calendar-absolute-from-gregorian + (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate))) + today (org-today)) + (if (> today cdate) + ;; immediately shift to today + (setq arg (- today cdate)))) + (org-timestamp-change arg (or what 'day)) + (when (and (org-at-date-range-p) + (re-search-backward org-tr-regexp-both (point-at-bol))) + (let ((end org-last-changed-timestamp)) + (org-timestamp-change arg (or what 'day)) + (setq org-last-changed-timestamp + (concat org-last-changed-timestamp "--" end))))) + (org-agenda-show-new-time marker org-last-changed-timestamp)) + (message "Time stamp changed to %s" org-last-changed-timestamp))) + +(defun org-agenda-date-earlier (arg &optional what) + "Change the date of this item to ARG day(s) earlier." + (interactive "p") + (org-agenda-date-later (- arg) what)) + +(defun org-agenda-date-later-minutes (arg) + "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." + (interactive "p") + (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) + (org-agenda-date-later arg 'minute)) + +(defun org-agenda-date-earlier-minutes (arg) + "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." + (interactive "p") + (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) + (org-agenda-date-earlier arg 'minute)) + +(defun org-agenda-date-later-hours (arg) + "Change the time of this item, in hour steps." + (interactive "p") + (org-agenda-date-later arg 'hour)) + +(defun org-agenda-date-earlier-hours (arg) + "Change the time of this item, in hour steps." + (interactive "p") + (org-agenda-date-earlier arg 'hour)) + +(defun org-agenda-show-new-time (marker stamp &optional prefix) + "Show new date stamp via text properties." + ;; We use text properties to make this undoable + (let ((inhibit-read-only t)) + (setq stamp (concat prefix " => " stamp " ")) + (save-excursion + (goto-char (point-max)) + (while (not (bobp)) + (when (equal marker (org-get-at-bol 'org-marker)) + (remove-text-properties (point-at-bol) (point-at-eol) '(display)) + (org-move-to-column (- (window-width) (length stamp)) t) + (if (featurep 'xemacs) + ;; Use `duplicable' property to trigger undo recording + (let ((ex (make-extent nil nil)) + (gl (make-glyph stamp))) + (set-glyph-face gl 'secondary-selection) + (set-extent-properties + ex (list 'invisible t 'end-glyph gl 'duplicable t)) + (insert-extent ex (1- (point)) (point-at-eol))) + (add-text-properties + (1- (point)) (point-at-eol) + (list 'display (org-add-props stamp nil + 'face '(secondary-selection default))))) + (beginning-of-line 1)) + (beginning-of-line 0))))) + +(defun org-agenda-date-prompt (arg) + "Change the date of this item. Date is prompted for, with default today. +The prefix ARG is passed to the `org-time-stamp' command and can therefore +be used to request time specification in the time stamp." + (interactive "P") + (org-agenda-check-type t 'agenda 'timeline) + (org-agenda-check-no-diary) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker))) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (if (not (org-at-timestamp-p t)) + (error "Cannot find time stamp")) + (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[))) + (org-agenda-show-new-time marker org-last-changed-timestamp)) + (message "Time stamp changed to %s" org-last-changed-timestamp))) + +(defun org-agenda-schedule (arg &optional time) + "Schedule the item at point. +ARG is passed through to `org-schedule'." + (interactive "P") + (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) + (org-agenda-check-no-diary) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (type (marker-insertion-type marker)) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (org-insert-labeled-timestamps-at-point nil) + ts) + (set-marker-insertion-type marker t) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (setq ts (org-schedule arg time))) + (org-agenda-show-new-time marker ts " S")) + (message "%s" ts))) + +(defun org-agenda-deadline (arg &optional time) + "Schedule the item at point. +ARG is passed through to `org-deadline'." + (interactive "P") + (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) + (org-agenda-check-no-diary) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (org-insert-labeled-timestamps-at-point nil) + ts) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (setq ts (org-deadline arg time))) + (org-agenda-show-new-time marker ts " D")) + (message "%s" ts))) + +(defun org-agenda-clock-in (&optional arg) + "Start the clock on the currently selected item." + (interactive "P") + (org-agenda-check-no-diary) + (if (equal arg '(4)) + (org-clock-in arg) + (let* ((marker (or (org-get-at-bol 'org-marker) + (org-agenda-error))) + (hdmarker (or (org-get-at-bol 'org-hd-marker) marker)) + (pos (marker-position marker)) + (col (current-column)) + newhead) + (org-with-remote-undo (marker-buffer marker) + (with-current-buffer (marker-buffer marker) + (widen) + (goto-char pos) + (org-show-context 'agenda) + (org-show-entry) + (org-cycle-hide-drawers 'children) + (org-clock-in arg) + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead hdmarker)) + (org-move-to-column col)))) + +(defun org-agenda-clock-out () + "Stop the currently running clock." + (interactive) + (unless (marker-buffer org-clock-marker) + (error "No running clock")) + (let ((marker (make-marker)) (col (current-column)) newhead) + (org-with-remote-undo (marker-buffer org-clock-marker) + (with-current-buffer (marker-buffer org-clock-marker) + (save-excursion + (save-restriction + (widen) + (goto-char org-clock-marker) + (org-back-to-heading t) + (move-marker marker (point)) + (org-clock-out) + (setq newhead (org-get-heading)))))) + (org-agenda-change-all-lines newhead marker) + (move-marker marker nil) + (org-move-to-column col) + (org-agenda-unmark-clocking-task))) + +(defun org-agenda-clock-cancel (&optional arg) + "Cancel the currently running clock." + (interactive "P") + (unless (marker-buffer org-clock-marker) + (user-error "No running clock")) + (org-with-remote-undo (marker-buffer org-clock-marker) + (org-clock-cancel))) + +(defun org-agenda-clock-goto () + "Jump to the currently clocked in task within the agenda. +If the currently clocked in task is not listed in the agenda +buffer, display it in another window." + (interactive) + (let (pos) + (mapc (lambda (o) + (if (eq (overlay-get o 'type) 'org-agenda-clocking) + (setq pos (overlay-start o)))) + (overlays-in (point-min) (point-max))) + (cond (pos (goto-char pos)) + ;; If the currently clocked entry is not in the agenda + ;; buffer, we visit it in another window: + (org-clock-current-task + (org-switch-to-buffer-other-window (org-clock-goto))) + (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one"))))) + +(defun org-agenda-diary-entry-in-org-file () + "Make a diary entry in the file `org-agenda-diary-file'." + (let (d1 d2 char (text "") dp1 dp2) + (if (equal (buffer-name) "*Calendar*") + (setq d1 (calendar-cursor-to-date t) + d2 (car calendar-mark-ring)) + (setq dp1 (get-text-property (point-at-bol) 'day)) + (unless dp1 (user-error "No date defined in current line")) + (setq d1 (calendar-gregorian-from-absolute dp1) + d2 (and (ignore-errors (mark)) + (save-excursion + (goto-char (mark)) + (setq dp2 (get-text-property (point-at-bol) 'day))) + (calendar-gregorian-from-absolute dp2)))) + (message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree") + (setq char (read-char-exclusive)) + (cond + ((equal char ?d) + (setq text (read-string "Day entry: ")) + (org-agenda-add-entry-to-org-agenda-diary-file 'day text d1) + (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) + ((equal char ?a) + (setq d1 (list (car d1) (nth 1 d1) + (read-number (format "Reference year [%d]: " (nth 2 d1)) + (nth 2 d1)))) + (setq text (read-string "Anniversary (use %d to show years): ")) + (org-agenda-add-entry-to-org-agenda-diary-file 'anniversary text d1) + (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) + ((equal char ?b) + (setq text (read-string "Block entry: ")) + (unless (and d1 d2 (not (equal d1 d2))) + (user-error "No block of days selected")) + (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2) + (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) + ((equal char ?j) + (org-switch-to-buffer-other-window + (find-file-noselect org-agenda-diary-file)) + (require 'org-datetree) + (org-datetree-find-date-create d1) + (org-reveal t)) + (t (user-error "Invalid selection character `%c'" char))))) + +(defcustom org-agenda-insert-diary-strategy 'date-tree + "Where in `org-agenda-diary-file' should new entries be added? +Valid values: + +date-tree in the date tree, as child of the date +top-level as top-level entries at the end of the file." + :group 'org-agenda + :type '(choice + (const :tag "in a date tree" date-tree) + (const :tag "as top level at end of file" top-level))) + +(defcustom org-agenda-insert-diary-extract-time nil + "Non-nil means extract any time specification from the diary entry." + :group 'org-agenda + :version "24.1" + :type 'boolean) + +(defcustom org-agenda-bulk-mark-char ">" + "A single-character string to be used as the bulk mark." + :group 'org-agenda + :version "24.1" + :type 'string) + +(defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2) + "Add a diary entry with TYPE to `org-agenda-diary-file'. +If TEXT is not empty, it will become the headline of the new entry, and +the resulting entry will not be shown. When TEXT is empty, switch to +`org-agenda-diary-file' and let the user finish the entry there." + (let ((cw (current-window-configuration))) + (org-switch-to-buffer-other-window + (find-file-noselect org-agenda-diary-file)) + (widen) + (goto-char (point-min)) + (cond + ((eq type 'anniversary) + (or (re-search-forward "^*[ \t]+Anniversaries" nil t) + (progn + (or (org-at-heading-p t) + (progn + (outline-next-heading) + (insert "* Anniversaries\n\n") + (beginning-of-line -1))))) + (outline-next-heading) + (org-back-over-empty-lines) + (backward-char 1) + (insert "\n") + (insert (format "%%%%(org-anniversary %d %2d %2d) %s" + (nth 2 d1) (car d1) (nth 1 d1) text))) + ((eq type 'day) + (let ((org-prefix-has-time t) + (org-agenda-time-leading-zero t) + fmt time time2) + (if org-agenda-insert-diary-extract-time + ;; Use org-agenda-format-item to parse text for a time-range and + ;; remove it. FIXME: This is a hack, we should refactor + ;; that function to make time extraction available separately + (setq fmt (org-agenda-format-item nil text nil nil nil t) + time (get-text-property 0 'time fmt) + time2 (if (> (length time) 0) + ;; split-string removes trailing ...... if + ;; no end time given. First space + ;; separates time from date. + (concat " " (car (split-string time "\\."))) + nil) + text (get-text-property 0 'txt fmt))) + (if (eq org-agenda-insert-diary-strategy 'top-level) + (org-agenda-insert-diary-as-top-level text) + (require 'org-datetree) + (org-datetree-find-date-create d1) + (org-agenda-insert-diary-make-new-entry text)) + (org-insert-time-stamp (org-time-from-absolute + (calendar-absolute-from-gregorian d1)) + nil nil nil nil time2)) + (end-of-line 0)) + ((eq type 'block) + (if (> (calendar-absolute-from-gregorian d1) + (calendar-absolute-from-gregorian d2)) + (setq d1 (prog1 d2 (setq d2 d1)))) + (if (eq org-agenda-insert-diary-strategy 'top-level) + (org-agenda-insert-diary-as-top-level text) + (require 'org-datetree) + (org-datetree-find-date-create d1) + (org-agenda-insert-diary-make-new-entry text)) + (org-insert-time-stamp (org-time-from-absolute + (calendar-absolute-from-gregorian d1))) + (insert "--") + (org-insert-time-stamp (org-time-from-absolute + (calendar-absolute-from-gregorian d2))) + (end-of-line 0))) + (if (string-match "\\S-" text) + (progn + (set-window-configuration cw) + (message "%s entry added to %s" + (capitalize (symbol-name type)) + (abbreviate-file-name org-agenda-diary-file))) + (org-reveal t) + (message "Please finish entry here")))) + +(defun org-agenda-insert-diary-as-top-level (text) + "Make new entry as a top-level entry at the end of the file. +Add TEXT as headline, and position the cursor in the second line so that +a timestamp can be added there." + (widen) + (goto-char (point-max)) + (or (bolp) (insert "\n")) + (insert "* " text "\n") + (if org-adapt-indentation (org-indent-to-column 2))) + +(defun org-agenda-insert-diary-make-new-entry (text) + "Make a new entry with TEXT as the first child of the current subtree. +Position the point in the line right after the new heading so +that a timestamp can be added there." + (let ((org-show-following-heading t) + (org-show-siblings t) + (org-show-hierarchy-above t) + (org-show-entry-below t) + col) + (outline-next-heading) + (org-back-over-empty-lines) + (or (looking-at "[ \t]*$") + (progn (insert "\n") (backward-char 1))) + (org-insert-heading nil t) + (org-do-demote) + (setq col (current-column)) + (insert text "\n") + (if org-adapt-indentation (org-indent-to-column col)) + (let ((org-show-following-heading t) + (org-show-siblings t) + (org-show-hierarchy-above t) + (org-show-entry-below t)) + (org-show-context)))) + +(defun org-agenda-diary-entry () + "Make a diary entry, like the `i' command from the calendar. +All the standard commands work: block, weekly etc. +When `org-agenda-diary-file' points to a file, +`org-agenda-diary-entry-in-org-file' is called instead to create +entries in that Org-mode file." + (interactive) + (if (not (eq org-agenda-diary-file 'diary-file)) + (org-agenda-diary-entry-in-org-file) + (require 'diary-lib) + (let* ((char (progn + (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") + (read-char-exclusive))) + (cmd (cdr (assoc char + '((?d . diary-insert-entry) + (?w . diary-insert-weekly-entry) + (?m . diary-insert-monthly-entry) + (?y . diary-insert-yearly-entry) + (?a . diary-insert-anniversary-entry) + (?b . diary-insert-block-entry) + (?c . diary-insert-cyclic-entry))))) + (oldf (symbol-function 'calendar-cursor-to-date)) + ;; (buf (get-file-buffer (substitute-in-file-name diary-file))) + (point (point)) + (mark (or (mark t) (point)))) + (unless cmd + (user-error "No command associated with <%c>" char)) + (unless (and (get-text-property point 'day) + (or (not (equal ?b char)) + (get-text-property mark 'day))) + (user-error "Don't know which date to use for diary entry")) + ;; We implement this by hacking the `calendar-cursor-to-date' function + ;; and the `calendar-mark-ring' variable. Saves a lot of code. + (let ((calendar-mark-ring + (list (calendar-gregorian-from-absolute + (or (get-text-property mark 'day) + (get-text-property point 'day)))))) + (unwind-protect + (progn + (fset 'calendar-cursor-to-date + (lambda (&optional error dummy) + (calendar-gregorian-from-absolute + (get-text-property point 'day)))) + (call-interactively cmd)) + (fset 'calendar-cursor-to-date oldf)))))) + +(defun org-agenda-execute-calendar-command (cmd) + "Execute a calendar command from the agenda with date from cursor." + (org-agenda-check-type t 'agenda 'timeline) + (require 'diary-lib) + (unless (get-text-property (min (1- (point-max)) (point)) 'day) + (user-error "Don't know which date to use for the calendar command")) + (let* ((oldf (symbol-function 'calendar-cursor-to-date)) + (point (point)) + (date (calendar-gregorian-from-absolute + (get-text-property point 'day))) + ;; the following 2 vars are needed in the calendar + (displayed-month (car date)) + (displayed-year (nth 2 date))) + (unwind-protect + (progn + (fset 'calendar-cursor-to-date + (lambda (&optional error dummy) + (calendar-gregorian-from-absolute + (get-text-property point 'day)))) + (call-interactively cmd)) + (fset 'calendar-cursor-to-date oldf)))) + +(defun org-agenda-phases-of-moon () + "Display the phases of the moon for the 3 months around the cursor date." + (interactive) + (org-agenda-execute-calendar-command 'calendar-lunar-phases)) + +(defun org-agenda-holidays () + "Display the holidays for the 3 months around the cursor date." + (interactive) + (org-agenda-execute-calendar-command 'calendar-list-holidays)) + +(defvar calendar-longitude) ; defined in calendar.el +(defvar calendar-latitude) ; defined in calendar.el +(defvar calendar-location-name) ; defined in calendar.el + +(defun org-agenda-sunrise-sunset (arg) + "Display sunrise and sunset for the cursor date. +Latitude and longitude can be specified with the variables +`calendar-latitude' and `calendar-longitude'. When called with prefix +argument, latitude and longitude will be prompted for." + (interactive "P") + (require 'solar) + (let ((calendar-longitude (if arg nil calendar-longitude)) + (calendar-latitude (if arg nil calendar-latitude)) + (calendar-location-name + (if arg "the given coordinates" calendar-location-name))) + (org-agenda-execute-calendar-command 'calendar-sunrise-sunset))) + +(defun org-agenda-goto-calendar () + "Open the Emacs calendar with the date at the cursor." + (interactive) + (org-agenda-check-type t 'agenda 'timeline) + (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day) + (user-error "Don't know which date to open in calendar"))) + (date (calendar-gregorian-from-absolute day)) + (calendar-move-hook nil) + (calendar-view-holidays-initially-flag nil) + (calendar-view-diary-initially-flag nil)) + (calendar) + (calendar-goto-date date))) + +;;;###autoload +(defun org-calendar-goto-agenda () + "Compute the Org-mode agenda for the calendar date displayed at the cursor. +This is a command that has to be installed in `calendar-mode-map'." + (interactive) + (org-agenda-list nil (calendar-absolute-from-gregorian + (calendar-cursor-to-date)) + nil)) + +(defun org-agenda-convert-date () + (interactive) + (org-agenda-check-type t 'agenda 'timeline) + (let ((day (get-text-property (min (1- (point-max)) (point)) 'day)) + date s) + (unless day + (user-error "Don't know which date to convert")) + (setq date (calendar-gregorian-from-absolute day)) + (setq s (concat + "Gregorian: " (calendar-date-string date) "\n" + "ISO: " (calendar-iso-date-string date) "\n" + "Day of Yr: " (calendar-day-of-year-string date) "\n" + "Julian: " (calendar-julian-date-string date) "\n" + "Astron. JD: " (calendar-astro-date-string date) + " (Julian date number at noon UTC)\n" + "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" + "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" + "French: " (calendar-french-date-string date) "\n" + "Baha'i: " (calendar-bahai-date-string date) " (until sunset)\n" + "Mayan: " (calendar-mayan-date-string date) "\n" + "Coptic: " (calendar-coptic-date-string date) "\n" + "Ethiopic: " (calendar-ethiopic-date-string date) "\n" + "Persian: " (calendar-persian-date-string date) "\n" + "Chinese: " (calendar-chinese-date-string date) "\n")) + (with-output-to-temp-buffer "*Dates*" + (princ s)) + (org-fit-window-to-buffer (get-buffer-window "*Dates*")))) + +;;; Bulk commands + +(defun org-agenda-bulk-marked-p () + (eq (get-char-property (point-at-bol) 'type) + 'org-marked-entry-overlay)) + +(defun org-agenda-bulk-mark (&optional arg) + "Mark the entry at point for future bulk action." + (interactive "p") + (dotimes (i (or arg 1)) + (unless (org-get-at-bol 'org-agenda-diary-link) + (let* ((m (org-get-at-bol 'org-hd-marker)) + ov) + (unless (org-agenda-bulk-marked-p) + (unless m (user-error "Nothing to mark at point")) + (push m org-agenda-bulk-marked-entries) + (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol)))) + (org-overlay-display ov (concat org-agenda-bulk-mark-char " ") + (org-get-todo-face "TODO") + 'evaporate) + (overlay-put ov 'type 'org-marked-entry-overlay)) + (end-of-line 1) + (or (ignore-errors + (goto-char (next-single-property-change (point) 'org-hd-marker))) + (beginning-of-line 2)) + (while (and (get-char-property (point) 'invisible) (not (eobp))) + (beginning-of-line 2)) + (message "%d entries marked for bulk action" + (length org-agenda-bulk-marked-entries)))))) + +(defun org-agenda-bulk-mark-all () + "Mark all entries for future agenda bulk action." + (interactive) + (org-agenda-bulk-mark-regexp ".")) + +(defun org-agenda-bulk-mark-regexp (regexp) + "Mark entries matching REGEXP for future agenda bulk action." + (interactive "sMark entries matching regexp: ") + (let ((entries-marked 0) txt-at-point) + (save-excursion + (goto-char (point-min)) + (goto-char (next-single-property-change (point) 'org-hd-marker)) + (while (and (re-search-forward regexp nil t) + (setq txt-at-point (get-text-property (point) 'txt))) + (when (string-match regexp txt-at-point) + (setq entries-marked (1+ entries-marked)) + (call-interactively 'org-agenda-bulk-mark)))) + (if (not entries-marked) + (message "No entry matching this regexp.")))) + +(defun org-agenda-bulk-unmark (&optional arg) + "Unmark the entry at point for future bulk action." + (interactive "P") + (if arg + (org-agenda-bulk-unmark-all) + (cond ((org-agenda-bulk-marked-p) + (org-agenda-bulk-remove-overlays + (point-at-bol) (+ 2 (point-at-bol))) + (setq org-agenda-bulk-marked-entries + (delete (org-get-at-bol 'org-hd-marker) + org-agenda-bulk-marked-entries)) + (end-of-line 1) + (or (ignore-errors + (goto-char (next-single-property-change (point) 'txt))) + (beginning-of-line 2)) + (while (and (get-char-property (point) 'invisible) (not (eobp))) + (beginning-of-line 2)) + (message "%d entries left marked for bulk action" + (length org-agenda-bulk-marked-entries))) + (t (message "No entry to unmark here"))))) + +(defun org-agenda-bulk-toggle-all () + "Toggle all marks for bulk action." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (ignore-errors + (goto-char (next-single-property-change (point) 'org-hd-marker))) + (org-agenda-bulk-toggle)))) + +(defun org-agenda-bulk-toggle () + "Toggle the mark at point for bulk action." + (interactive) + (if (org-agenda-bulk-marked-p) + (org-agenda-bulk-unmark) + (org-agenda-bulk-mark))) + +(defun org-agenda-bulk-remove-overlays (&optional beg end) + "Remove the mark overlays between BEG and END in the agenda buffer. +BEG and END default to the buffer limits. + +This only removes the overlays, it does not remove the markers +from the list in `org-agenda-bulk-marked-entries'." + (interactive) + (mapc (lambda (ov) + (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay) + (delete-overlay ov))) + (overlays-in (or beg (point-min)) (or end (point-max))))) + +(defun org-agenda-bulk-unmark-all () + "Remove all marks in the agenda buffer. +This will remove the markers and the overlays." + (interactive) + (if (null org-agenda-bulk-marked-entries) + (message "No entry to unmark") + (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries) + (setq org-agenda-bulk-marked-entries nil) + (org-agenda-bulk-remove-overlays (point-min) (point-max)))) + +(defcustom org-agenda-persistent-marks nil + "Non-nil means marked items will stay marked after a bulk action. +You can toggle this interactively by typing `p' when prompted for a +bulk action." + :group 'org-agenda + :version "24.1" + :type 'boolean) + +(defun org-agenda-bulk-action (&optional arg) + "Execute an remote-editing action on all marked entries. +The prefix arg is passed through to the command if possible." + (interactive "P") + ;; Make sure we have markers, and only valid ones + (unless org-agenda-bulk-marked-entries (user-error "No entries are marked")) + (mapc + (lambda (m) + (unless (and (markerp m) + (marker-buffer m) + (buffer-live-p (marker-buffer m)) + (marker-position m)) + (user-error "Marker %s for bulk command is invalid" m))) + org-agenda-bulk-marked-entries) + + ;; Prompt for the bulk command + (let* ((msg (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: "))) + (message (concat msg "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile " + "[S]catter [f]unction " + (when org-agenda-bulk-custom-functions + (concat " Custom: [" + (mapconcat (lambda(f) (char-to-string (car f))) + org-agenda-bulk-custom-functions "") + "]")))) + (catch 'exit + (let* ((action (read-char-exclusive)) + (org-log-refile (if org-log-refile 'time nil)) + (entries (reverse org-agenda-bulk-marked-entries)) + (org-overriding-default-time + (if (get-text-property (point) 'org-agenda-date-header) + (org-get-cursor-date))) + redo-at-end + cmd rfloc state e tag pos (cnt 0) (cntskip 0)) + (cond + ((equal action ?p) + (let ((org-agenda-persistent-marks + (not org-agenda-persistent-marks))) + (org-agenda-bulk-action) + (throw 'exit nil))) + + ((equal action ?$) + (setq cmd '(org-agenda-archive))) + + ((equal action ?A) + (setq cmd '(org-agenda-archive-to-archive-sibling))) + + ((member action '(?r ?w)) + (setq rfloc (org-refile-get-location + "Refile to" + (marker-buffer (car entries)) + org-refile-allow-creating-parent-nodes)) + (if (nth 3 rfloc) + (setcar (nthcdr 3 rfloc) + (move-marker (make-marker) (nth 3 rfloc) + (or (get-file-buffer (nth 1 rfloc)) + (find-buffer-visiting (nth 1 rfloc)) + (error "This should not happen"))))) + + (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t) + redo-at-end t)) + + ((equal action ?t) + (setq state (org-icompleting-read + "Todo state: " + (with-current-buffer (marker-buffer (car entries)) + (mapcar 'list org-todo-keywords-1)))) + (setq cmd `(let ((org-inhibit-blocking t) + (org-inhibit-logging 'note)) + (org-agenda-todo ,state)))) + + ((memq action '(?- ?+)) + (setq tag (org-icompleting-read + (format "Tag to %s: " (if (eq action ?+) "add" "remove")) + (with-current-buffer (marker-buffer (car entries)) + (delq nil + (mapcar (lambda (x) + (if (stringp (car x)) x)) org-tag-alist))))) + (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off)))) + + ((memq action '(?s ?d)) + (let* ((time + (unless arg + (org-read-date + nil nil nil + (if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to") + org-overriding-default-time))) + (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline))) + (setq cmd `(eval '(,c1 arg ,time))))) + + ((equal action ?S) + (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo)) + (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type) + (let ((days (read-number + (format "Scatter tasks across how many %sdays: " + (if arg "week" "")) 7))) + (setq cmd + `(let ((distance (1+ (random ,days)))) + (if arg + (let ((dist distance) + (day-of-week + (calendar-day-of-week + (calendar-gregorian-from-absolute (org-today))))) + (dotimes (i (1+ dist)) + (while (member day-of-week org-agenda-weekend-days) + (incf distance) + (incf day-of-week) + (if (= day-of-week 7) + (setq day-of-week 0))) + (incf day-of-week) + (if (= day-of-week 7) + (setq day-of-week 0))))) + ;; silently fail when try to replan a sexp entry + (condition-case nil + (let* ((date (calendar-gregorian-from-absolute + (+ (org-today) distance))) + (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) + (nth 2 date)))) + (org-agenda-schedule nil time)) + (error nil))))))) + + ((assoc action org-agenda-bulk-custom-functions) + (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions))) + redo-at-end t)) + + ((equal action ?f) + (setq cmd (list (intern + (org-icompleting-read "Function: " + obarray 'fboundp t nil nil))))) + + (t (user-error "Invalid bulk action"))) + + ;; Sort the markers, to make sure that parents are handled before children + (setq entries (sort entries + (lambda (a b) + (cond + ((equal (marker-buffer a) (marker-buffer b)) + (< (marker-position a) (marker-position b))) + (t + (string< (buffer-name (marker-buffer a)) + (buffer-name (marker-buffer b)))))))) + + ;; Now loop over all markers and apply cmd + (while (setq e (pop entries)) + (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e)) + (if (not pos) + (progn (message "Skipping removed entry at %s" e) + (setq cntskip (1+ cntskip))) + (goto-char pos) + (let (org-loop-over-headlines-in-active-region) + (eval cmd)) + (setq cnt (1+ cnt)))) + (when redo-at-end (org-agenda-redo)) + (unless org-agenda-persistent-marks + (org-agenda-bulk-unmark-all)) + (message "Acted on %d entries%s%s" + cnt + (if (= cntskip 0) + "" + (format ", skipped %d (disappeared before their turn)" + cntskip)) + (if (not org-agenda-persistent-marks) + "" " (kept marked)")))))) + +(defun org-agenda-capture (&optional with-time) + "Call `org-capture' with the date at point. +With a `C-1' prefix, use the HH:MM value at point (if any) or the +current HH:MM time." + (interactive "P") + (if (not (eq major-mode 'org-agenda-mode)) + (user-error "You cannot do this outside of agenda buffers") + (let ((org-overriding-default-time + (org-get-cursor-date (equal with-time 1)))) + (call-interactively 'org-capture)))) + +;;; Dragging agenda lines forward/backward + +(defun org-agenda-reapply-filters () + "Re-apply all agenda filters." + (mapcar + (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f)))) + `((,org-agenda-tag-filter tag) + (,org-agenda-category-filter category) + (,org-agenda-regexp-filter regexp) + (,(get 'org-agenda-tag-filter :preset-filter) tag) + (,(get 'org-agenda-category-filter :preset-filter) category) + (,(get 'org-agenda-regexp-filter :preset-filter) regexp)))) + +(defun org-agenda-drag-line-forward (arg &optional backward) + "Drag an agenda line forward by ARG lines. +When the optional argument `backward' is non-nil, move backward." + (interactive "p") + (let ((inhibit-read-only t) lst line) + (if (or (not (get-text-property (point) 'txt)) + (save-excursion + (dotimes (n arg) + (move-beginning-of-line (if backward 0 2)) + (push (not (get-text-property (point) 'txt)) lst)) + (delq nil lst))) + (message "Cannot move line forward") + (let ((end (save-excursion (move-beginning-of-line 2) (point)))) + (move-beginning-of-line 1) + (setq line (buffer-substring (point) end)) + (delete-region (point) end) + (move-beginning-of-line (funcall (if backward '1- '1+) arg)) + (insert line) + (org-agenda-reapply-filters) + (org-agenda-mark-clocking-task) + (move-beginning-of-line 0))))) + +(defun org-agenda-drag-line-backward (arg) + "Drag an agenda line backward by ARG lines." + (interactive "p") + (org-agenda-drag-line-forward arg t)) + +;;; Flagging notes + +(defun org-agenda-show-the-flagging-note () + "Display the flagging note in the other window. +When called a second time in direct sequence, offer to remove the FLAGGING +tag and (if present) the flagging note." + (interactive) + (let ((hdmarker (org-get-at-bol 'org-hd-marker)) + (win (selected-window)) + note heading newhead) + (unless hdmarker + (user-error "No linked entry at point")) + (if (and (eq this-command last-command) + (y-or-n-p "Unflag and remove any flagging note? ")) + (progn + (org-agenda-remove-flag hdmarker) + (let ((win (get-buffer-window "*Flagging Note*"))) + (and win (delete-window win))) + (message "Entry unflagged")) + (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE")) + (unless note + (user-error "No flagging note")) + (org-kill-new note) + (org-switch-to-buffer-other-window "*Flagging Note*") + (erase-buffer) + (insert note) + (goto-char (point-min)) + (while (re-search-forward "\\\\n" nil t) + (replace-match "\n" t t)) + (goto-char (point-min)) + (select-window win) + (message "Flagging note pushed to kill ring. Press [?] again to remove tag and note")))) + +(defun org-agenda-remove-flag (marker) + "Remove the FLAGGED tag and any flagging note in the entry." + (let (newhead) + (org-with-point-at marker + (org-toggle-tag "FLAGGED" 'off) + (org-entry-delete nil "THEFLAGGINGNOTE") + (setq newhead (org-get-heading))) + (org-agenda-change-all-lines newhead marker) + (message "Entry unflagged"))) + +(defun org-agenda-get-any-marker (&optional pos) + (or (get-text-property (or pos (point-at-bol)) 'org-hd-marker) + (get-text-property (or pos (point-at-bol)) 'org-marker))) + +;;; Appointment reminders + +(defvar appt-time-msg-list) ; defined in appt.el + +;;;###autoload +(defun org-agenda-to-appt (&optional refresh filter &rest args) + "Activate appointments found in `org-agenda-files'. +With a \\[universal-argument] prefix, refresh the list of +appointments. + +If FILTER is t, interactively prompt the user for a regular +expression, and filter out entries that don't match it. + +If FILTER is a string, use this string as a regular expression +for filtering entries out. + +If FILTER is a function, filter out entries against which +calling the function returns nil. This function takes one +argument: an entry from `org-agenda-get-day-entries'. + +FILTER can also be an alist with the car of each cell being +either 'headline or 'category. For example: + + '((headline \"IMPORTANT\") + (category \"Work\")) + +will only add headlines containing IMPORTANT or headlines +belonging to the \"Work\" category. + +ARGS are symbols indicating what kind of entries to consider. +By default `org-agenda-to-appt' will use :deadline*, :scheduled* +\(i.e., deadlines and scheduled items with a hh:mm specification) +and :timestamp entries. See the docstring of `org-diary' for +details and examples. + +If an entry has a APPT_WARNTIME property, its value will be used +to override `appt-message-warning-time'." + (interactive "P") + (if refresh (setq appt-time-msg-list nil)) + (if (eq filter t) + (setq filter (read-from-minibuffer "Regexp filter: "))) + (let* ((cnt 0) ; count added events + (scope (or args '(:deadline* :scheduled* :timestamp))) + (org-agenda-new-buffers nil) + (org-deadline-warning-days 0) + ;; Do not use `org-today' here because appt only takes + ;; time and without date as argument, so it may pass wrong + ;; information otherwise + (today (org-date-to-gregorian + (time-to-days (current-time)))) + (org-agenda-restrict nil) + (files (org-agenda-files 'unrestricted)) entries file + (org-agenda-buffer nil)) + ;; Get all entries which may contain an appt + (org-agenda-prepare-buffers files) + (while (setq file (pop files)) + (setq entries + (delq nil + (append entries + (apply 'org-agenda-get-day-entries + file today scope))))) + ;; Map thru entries and find if we should filter them out + (mapc + (lambda(x) + (let* ((evt (org-trim + (replace-regexp-in-string + org-bracket-link-regexp "\\3" + (or (get-text-property 1 'txt x) "")))) + (cat (get-text-property 1 'org-category x)) + (tod (get-text-property 1 'time-of-day x)) + (ok (or (null filter) + (and (stringp filter) (string-match filter evt)) + (and (functionp filter) (funcall filter x)) + (and (listp filter) + (let ((cat-filter (cadr (assoc 'category filter))) + (evt-filter (cadr (assoc 'headline filter)))) + (or (and (stringp cat-filter) + (string-match cat-filter cat)) + (and (stringp evt-filter) + (string-match evt-filter evt))))))) + (wrn (get-text-property 1 'warntime x))) + ;; FIXME: Shall we remove text-properties for the appt text? + ;; (setq evt (set-text-properties 0 (length evt) nil evt)) + (when (and ok tod) + (setq tod (concat "00" (number-to-string tod)) + tod (when (string-match + "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) + (concat (match-string 1 tod) ":" + (match-string 2 tod)))) + (if (version< emacs-version "23.3") + (appt-add tod evt) + (appt-add tod evt wrn)) + (setq cnt (1+ cnt))))) entries) + (org-release-buffers org-agenda-new-buffers) + (if (eq cnt 0) + (message "No event to add") + (message "Added %d event%s for today" cnt (if (> cnt 1) "s" ""))))) + +(defun org-agenda-todayp (date) + "Does DATE mean today, when considering `org-extend-today-until'?" + (let ((today (org-today)) + (date (if (and date (listp date)) (calendar-absolute-from-gregorian date) + date))) + (eq date today))) + +(defun org-agenda-todo-yesterday (&optional arg) + "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday." + (interactive "P") + (let* ((hour (third (decode-time + (org-current-time)))) + (org-extend-today-until (1+ hour))) + (org-agenda-todo arg))) + +(provide 'org-agenda) + +;;; org-agenda.el ends here diff --git a/elpa/org-20150427/org-archive.el b/elpa/org-20150427/org-archive.el new file mode 100644 index 00000000..6deac47b --- /dev/null +++ b/elpa/org-20150427/org-archive.el @@ -0,0 +1,557 @@ +;;; org-archive.el --- Archiving for Org-mode + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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 . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains the face definitions for Org. + +;;; Code: + +(require 'org) + +(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) +(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) + +(defcustom org-archive-default-command 'org-archive-subtree + "The default archiving command." + :group 'org-archive + :type '(choice + (const org-archive-subtree) + (const org-archive-to-archive-sibling) + (const org-archive-set-tag))) + +(defcustom org-archive-reversed-order nil + "Non-nil means make the tree first child under the archive heading, not last." + :group 'org-archive + :version "24.1" + :type 'boolean) + +(defcustom org-archive-sibling-heading "Archive" + "Name of the local archive sibling that is used to archive entries locally. +Locally means: in the tree, under a sibling. +See `org-archive-to-archive-sibling' for more information." + :group 'org-archive + :type 'string) + +(defcustom org-archive-mark-done nil + "Non-nil means mark entries as DONE when they are moved to the archive file. +This can be a string to set the keyword to use. When t, Org-mode will +use the first keyword in its list that means done." + :group 'org-archive + :type '(choice + (const :tag "No" nil) + (const :tag "Yes" t) + (string :tag "Use this keyword"))) + +(defcustom org-archive-stamp-time t + "Non-nil means add a time stamp to entries moved to an archive file. +This variable is obsolete and has no effect anymore, instead add or remove +`time' from the variable `org-archive-save-context-info'." + :group 'org-archive + :type 'boolean) + +(defcustom org-archive-file-header-format "\nArchived entries from file %s\n\n" + "The header format string for newly created archive files. +When nil, no header will be inserted. +When a string, a %s formatter will be replaced by the file name." + :group 'org-archive + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-archive-subtree-add-inherited-tags 'infile + "Non-nil means append inherited tags when archiving a subtree." + :group 'org-archive + :version "24.1" + :type '(choice + (const :tag "Never" nil) + (const :tag "When archiving a subtree to the same file" infile) + (const :tag "Always" t))) + +(defcustom org-archive-save-context-info '(time file olpath category todo itags) + "Parts of context info that should be stored as properties when archiving. +When a subtree is moved to an archive file, it loses information given by +context, like inherited tags, the category, and possibly also the TODO +state (depending on the variable `org-archive-mark-done'). +This variable can be a list of any of the following symbols: + +time The time of archiving. +file The file where the entry originates. +ltags The local tags, in the headline of the subtree. +itags The tags the subtree inherits from further up the hierarchy. +todo The pre-archive TODO state. +category The category, taken from file name or #+CATEGORY lines. +olpath The outline path to the item. These are all headlines above + the current item, separated by /, like a file path. + +For each symbol present in the list, a property will be created in +the archived entry, with a prefix \"ARCHIVE_\", to remember this +information." + :group 'org-archive + :type '(set :greedy t + (const :tag "Time" time) + (const :tag "File" file) + (const :tag "Category" category) + (const :tag "TODO state" todo) + (const :tag "Priority" priority) + (const :tag "Inherited tags" itags) + (const :tag "Outline path" olpath) + (const :tag "Local tags" ltags))) + +(defun org-get-local-archive-location () + "Get the archive location applicable at point." + (let ((re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") + prop) + (save-excursion + (save-restriction + (widen) + (setq prop (org-entry-get nil "ARCHIVE" 'inherit)) + (cond + ((and prop (string-match "\\S-" prop)) + prop) + ((or (re-search-backward re nil t) + (re-search-forward re nil t)) + (match-string 1)) + (t org-archive-location)))))) + +;;;###autoload +(defun org-add-archive-files (files) + "Splice the archive files into the list of files. +This implies visiting all these files and finding out what the +archive file is." + (org-uniquify + (apply + 'append + (mapcar + (lambda (f) + (if (not (file-exists-p f)) + nil + (with-current-buffer (org-get-agenda-file-buffer f) + (cons f (org-all-archive-files))))) + files)))) + +(defun org-all-archive-files () + "Get a list of all archive files used in the current buffer." + (let (file files) + (save-excursion + (save-restriction + (goto-char (point-min)) + (while (re-search-forward + "^\\(#\\+\\|[ \t]*:\\)ARCHIVE:[ \t]+\\(.*\\)" + nil t) + (setq file (org-extract-archive-file + (org-match-string-no-properties 2))) + (and file (> (length file) 0) (file-exists-p file) + (add-to-list 'files file))))) + (setq files (nreverse files)) + (setq file (org-extract-archive-file)) + (and file (> (length file) 0) (file-exists-p file) + (add-to-list 'files file)) + files)) + +(defun org-extract-archive-file (&optional location) + "Extract and expand the file name from archive LOCATION. +if LOCATION is not given, the value of `org-archive-location' is used." + (setq location (or location org-archive-location)) + (if (string-match "\\(.*\\)::\\(.*\\)" location) + (if (= (match-beginning 1) (match-end 1)) + (buffer-file-name (buffer-base-buffer)) + (expand-file-name + (format (match-string 1 location) + (file-name-nondirectory + (buffer-file-name (buffer-base-buffer)))))))) + +(defun org-extract-archive-heading (&optional location) + "Extract the heading from archive LOCATION. +if LOCATION is not given, the value of `org-archive-location' is used." + (setq location (or location org-archive-location)) + (if (string-match "\\(.*\\)::\\(.*\\)" location) + (format (match-string 2 location) + (file-name-nondirectory + (buffer-file-name (buffer-base-buffer)))))) + +;;;###autoload +(defun org-archive-subtree (&optional find-done) + "Move the current subtree to the archive. +The archive can be a certain top-level heading in the current file, or in +a different file. The tree will be moved to that location, the subtree +heading be marked DONE, and the current time will be added. + +When called with prefix argument FIND-DONE, find whole trees without any +open TODO items and archive them (after getting confirmation from the user). +If the cursor is not at a headline when this command is called, try all level +1 trees. If the cursor is on a headline, only try the direct children of +this heading." + (interactive "P") + (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) + (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level 'region)) + org-loop-over-headlines-in-active-region) + (org-map-entries + `(progn (setq org-map-continue-from (progn (org-back-to-heading) (point))) + (org-archive-subtree ,find-done)) + org-loop-over-headlines-in-active-region + cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + (if find-done + (org-archive-all-done) + ;; Save all relevant TODO keyword-relatex variables + (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler + (tr-org-todo-keywords-1 org-todo-keywords-1) + (tr-org-todo-kwd-alist org-todo-kwd-alist) + (tr-org-done-keywords org-done-keywords) + (tr-org-todo-regexp org-todo-regexp) + (tr-org-todo-line-regexp org-todo-line-regexp) + (tr-org-odd-levels-only org-odd-levels-only) + (this-buffer (current-buffer)) + ;; start of variables that will be used for saving context + ;; The compiler complains about them - keep them anyway! + (file (abbreviate-file-name + (or (buffer-file-name (buffer-base-buffer)) + (error "No file associated to buffer")))) + (olpath (mapconcat 'identity (org-get-outline-path) "/")) + (time (format-time-string + (substring (cdr org-time-stamp-formats) 1 -1) + (current-time))) + category todo priority ltags itags atags + ;; end of variables that will be used for saving context + location afile heading buffer level newfile-p infile-p visiting + datetree-date datetree-subheading-p) + + ;; Find the local archive location + (setq location (org-get-local-archive-location) + afile (org-extract-archive-file location) + heading (org-extract-archive-heading location) + infile-p (equal file (abbreviate-file-name (or afile "")))) + (unless afile + (error "Invalid `org-archive-location'")) + + (if (> (length afile) 0) + (setq newfile-p (not (file-exists-p afile)) + visiting (find-buffer-visiting afile) + buffer (or visiting (find-file-noselect afile))) + (setq buffer (current-buffer))) + (unless buffer + (error "Cannot access file \"%s\"" afile)) + (when (string-match "\\`datetree/" heading) + ;; Replace with ***, to represent the 3 levels of headings the + ;; datetree has. + (setq heading (replace-regexp-in-string "\\`datetree/" "***" heading)) + (setq datetree-subheading-p (> (length heading) 3)) + (setq datetree-date (org-date-to-gregorian + (or (org-entry-get nil "CLOSED" t) time)))) + (if (and (> (length heading) 0) + (string-match "^\\*+" heading)) + (setq level (match-end 0)) + (setq heading nil level 0)) + (save-excursion + (org-back-to-heading t) + ;; Get context information that will be lost by moving the tree + (setq category (org-get-category nil 'force-refresh) + todo (and (looking-at org-todo-line-regexp) + (match-string 2)) + priority (org-get-priority + (if (match-end 3) (match-string 3) "")) + ltags (org-get-tags) + itags (org-delete-all ltags (org-get-tags-at)) + atags (org-get-tags-at)) + (setq ltags (mapconcat 'identity ltags " ") + itags (mapconcat 'identity itags " ")) + ;; We first only copy, in case something goes wrong + ;; we need to protect `this-command', to avoid kill-region sets it, + ;; which would lead to duplication of subtrees + (let (this-command) (org-copy-subtree 1 nil t)) + (set-buffer buffer) + ;; Enforce org-mode for the archive buffer + (if (not (derived-mode-p 'org-mode)) + ;; Force the mode for future visits. + (let ((org-insert-mode-line-in-empty-file t) + (org-inhibit-startup t)) + (call-interactively 'org-mode))) + (when (and newfile-p org-archive-file-header-format) + (goto-char (point-max)) + (insert (format org-archive-file-header-format + (buffer-file-name this-buffer)))) + (when datetree-date + (require 'org-datetree) + (org-datetree-find-date-create datetree-date) + (org-narrow-to-subtree)) + ;; Force the TODO keywords of the original buffer + (let ((org-todo-line-regexp tr-org-todo-line-regexp) + (org-todo-keywords-1 tr-org-todo-keywords-1) + (org-todo-kwd-alist tr-org-todo-kwd-alist) + (org-done-keywords tr-org-done-keywords) + (org-todo-regexp tr-org-todo-regexp) + (org-todo-line-regexp tr-org-todo-line-regexp) + (org-odd-levels-only + (if (local-variable-p 'org-odd-levels-only (current-buffer)) + org-odd-levels-only + tr-org-odd-levels-only))) + (goto-char (point-min)) + (show-all) + (if (and heading (not (and datetree-date (not datetree-subheading-p)))) + (progn + (if (re-search-forward + (concat "^" (regexp-quote heading) + (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)")) + nil t) + (goto-char (match-end 0)) + ;; Heading not found, just insert it at the end + (goto-char (point-max)) + (or (bolp) (insert "\n")) + ;; datetrees don't need too much spacing + (insert (if datetree-date "" "\n") heading "\n") + (end-of-line 0)) + ;; Make the subtree visible + (show-subtree) + (if org-archive-reversed-order + (progn + (org-back-to-heading t) + (outline-next-heading)) + (org-end-of-subtree t)) + (skip-chars-backward " \t\r\n") + (and (looking-at "[ \t\r\n]*") + ;; datetree archives don't need so much spacing. + (replace-match (if datetree-date "\n" "\n\n")))) + ;; No specific heading, just go to end of file. + (goto-char (point-max)) (unless datetree-date (insert "\n"))) + ;; Paste + (org-paste-subtree (org-get-valid-level level (and heading 1))) + ;; Shall we append inherited tags? + (and itags + (or (and (eq org-archive-subtree-add-inherited-tags 'infile) + infile-p) + (eq org-archive-subtree-add-inherited-tags t)) + (org-set-tags-to atags)) + ;; Mark the entry as done + (when (and org-archive-mark-done + (looking-at org-todo-line-regexp) + (or (not (match-end 2)) + (not (member (match-string 2) org-done-keywords)))) + (let (org-log-done org-todo-log-states) + (org-todo + (car (or (member org-archive-mark-done org-done-keywords) + org-done-keywords))))) + + ;; Add the context info + (when org-archive-save-context-info + (let ((l org-archive-save-context-info) e n v) + (while (setq e (pop l)) + (when (and (setq v (symbol-value e)) + (stringp v) (string-match "\\S-" v)) + (setq n (concat "ARCHIVE_" (upcase (symbol-name e)))) + (org-entry-put (point) n v))))) + + (widen) + ;; Save and kill the buffer, if it is not the same buffer. + (when (not (eq this-buffer buffer)) + (save-buffer)))) + ;; Here we are back in the original buffer. Everything seems to have + ;; worked. So now cut the tree and finish up. + (let (this-command) (org-cut-subtree)) + (when (featurep 'org-inlinetask) + (org-inlinetask-remove-END-maybe)) + (setq org-markers-to-move nil) + (message "Subtree archived %s" + (if (eq this-buffer buffer) + (concat "under heading: " heading) + (concat "in file: " (abbreviate-file-name afile)))))) + (org-reveal) + (if (looking-at "^[ \t]*$") + (outline-next-visible-heading 1)))) + +;;;###autoload +(defun org-archive-to-archive-sibling () + "Archive the current heading by moving it under the archive sibling. +The archive sibling is a sibling of the heading with the heading name +`org-archive-sibling-heading' and an `org-archive-tag' tag. If this +sibling does not exist, it will be created at the end of the subtree." + (interactive) + (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) + (let ((cl (when (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level 'region)) + org-loop-over-headlines-in-active-region) + (org-map-entries + '(progn (setq org-map-continue-from + (progn (org-back-to-heading) + (if (looking-at (concat "^.*:" org-archive-tag ":.*$")) + (org-end-of-subtree t) + (point)))) + (when (org-at-heading-p) + (org-archive-to-archive-sibling))) + org-loop-over-headlines-in-active-region + cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + (save-restriction + (widen) + (let (b e pos leader level) + (org-back-to-heading t) + (looking-at org-outline-regexp) + (setq leader (match-string 0) + level (funcall outline-level)) + (setq pos (point)) + (condition-case nil + (outline-up-heading 1 t) + (error (setq e (point-max)) (goto-char (point-min)))) + (setq b (point)) + (unless e + (condition-case nil + (org-end-of-subtree t t) + (error (goto-char (point-max)))) + (setq e (point))) + (goto-char b) + (unless (re-search-forward + (concat "^" (regexp-quote leader) + "[ \t]*" + org-archive-sibling-heading + "[ \t]*:" + org-archive-tag ":") e t) + (goto-char e) + (or (bolp) (newline)) + (insert leader org-archive-sibling-heading "\n") + (beginning-of-line 0) + (org-toggle-tag org-archive-tag 'on)) + (beginning-of-line 1) + (if org-archive-reversed-order + (outline-next-heading) + (org-end-of-subtree t t)) + (save-excursion + (goto-char pos) + (let ((this-command this-command)) (org-cut-subtree))) + (org-paste-subtree (org-get-valid-level level 1)) + (org-set-property + "ARCHIVE_TIME" + (format-time-string + (substring (cdr org-time-stamp-formats) 1 -1) + (current-time))) + (outline-up-heading 1 t) + (hide-subtree) + (org-cycle-show-empty-lines 'folded) + (goto-char pos))) + (org-reveal) + (if (looking-at "^[ \t]*$") + (outline-next-visible-heading 1)))) + +(defun org-archive-all-done (&optional tag) + "Archive sublevels of the current tree without open TODO items. +If the cursor is not on a headline, try all level 1 trees. If +it is on a headline, try all direct children. +When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." + (let ((re org-not-done-heading-regexp) re1 + (rea (concat ".*:" org-archive-tag ":")) + (begm (make-marker)) + (endm (make-marker)) + (question (if tag "Set ARCHIVE tag (no open TODO items)? " + "Move subtree to archive (no open TODO items)? ")) + beg end (cntarch 0)) + (if (org-at-heading-p) + (progn + (setq re1 (concat "^" (regexp-quote + (make-string + (+ (- (match-end 0) (match-beginning 0) 1) + (if org-odd-levels-only 2 1)) + ?*)) + " ")) + (move-marker begm (point)) + (move-marker endm (org-end-of-subtree t))) + (setq re1 "^* ") + (move-marker begm (point-min)) + (move-marker endm (point-max))) + (save-excursion + (goto-char begm) + (while (re-search-forward re1 endm t) + (setq beg (match-beginning 0) + end (save-excursion (org-end-of-subtree t) (point))) + (goto-char beg) + (if (re-search-forward re end t) + (goto-char end) + (goto-char beg) + (if (and (or (not tag) (not (looking-at rea))) + (y-or-n-p question)) + (progn + (if tag + (org-toggle-tag org-archive-tag 'on) + (org-archive-subtree)) + (setq cntarch (1+ cntarch))) + (goto-char end))))) + (message "%d trees archived" cntarch))) + +;;;###autoload +(defun org-toggle-archive-tag (&optional find-done) + "Toggle the archive tag for the current headline. +With prefix ARG, check all children of current headline and offer tagging +the children that do not contain any open TODO items." + (interactive "P") + (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) + (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level 'region)) + org-loop-over-headlines-in-active-region) + (org-map-entries + `(org-toggle-archive-tag ,find-done) + org-loop-over-headlines-in-active-region + cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + (if find-done + (org-archive-all-done 'tag) + (let (set) + (save-excursion + (org-back-to-heading t) + (setq set (org-toggle-tag org-archive-tag)) + (when set (hide-subtree))) + (and set (beginning-of-line 1)) + (message "Subtree %s" (if set "archived" "unarchived")))))) + +(defun org-archive-set-tag () + "Set the ARCHIVE tag." + (interactive) + (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) + (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level 'region)) + org-loop-over-headlines-in-active-region) + (org-map-entries + 'org-archive-set-tag + org-loop-over-headlines-in-active-region + cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + (org-toggle-tag org-archive-tag 'on))) + +;;;###autoload +(defun org-archive-subtree-default () + "Archive the current subtree with the default command. +This command is set with the variable `org-archive-default-command'." + (interactive) + (call-interactively org-archive-default-command)) + +;;;###autoload +(defun org-archive-subtree-default-with-confirmation () + "Archive the current subtree with the default command. +This command is set with the variable `org-archive-default-command'." + (interactive) + (if (y-or-n-p "Archive this subtree or entry? ") + (call-interactively org-archive-default-command) + (error "Abort"))) + +(provide 'org-archive) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-archive.el ends here diff --git a/elpa/org-20150427/org-attach.el b/elpa/org-20150427/org-attach.el new file mode 100644 index 00000000..bcf7ba73 --- /dev/null +++ b/elpa/org-20150427/org-attach.el @@ -0,0 +1,484 @@ +;;; org-attach.el --- Manage file attachments to org-mode tasks + +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. + +;; Author: John Wiegley +;; Keywords: org data task + +;; 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 . + +;;; Commentary: + +;; See the Org-mode manual for information on how to use it. +;; +;; Attachments are managed in a special directory called "data", which +;; lives in the same directory as the org file itself. If this data +;; directory is initialized as a Git repository, then org-attach will +;; automatically commit changes when it sees them. +;; +;; Attachment directories are identified using a UUID generated for the +;; task which has the attachments. These are added as property to the +;; task when necessary, and should not be deleted or changed by the +;; user, ever. UUIDs are generated by a mechanism defined in the variable +;; `org-id-method'. + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'org-id) +(require 'org) +(require 'vc-git) + +(defgroup org-attach nil + "Options concerning entry attachments in Org-mode." + :tag "Org Attach" + :group 'org) + +(defcustom org-attach-directory "data/" + "The directory where attachments are stored. +If this is a relative path, it will be interpreted relative to the directory +where the Org file lives." + :group 'org-attach + :type 'directory) + +(defcustom org-attach-git-annex-cutoff (* 32 1024) + "If non-nil, files larger than this will be annexed instead of stored." + :group 'org-attach + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "None" nil) + (integer :tag "Bytes"))) + +(defcustom org-attach-auto-tag "ATTACH" + "Tag that will be triggered automatically when an entry has an attachment." + :group 'org-attach + :type '(choice + (const :tag "None" nil) + (string :tag "Tag"))) + +(defcustom org-attach-file-list-property "Attachments" + "The property used to keep a list of attachment belonging to this entry. +This is not really needed, so you may set this to nil if you don't want it. +Also, for entries where children inherit the directory, the list of +attachments is not kept in this property." + :group 'org-attach + :type '(choice + (const :tag "None" nil) + (string :tag "Tag"))) + +(defcustom org-attach-method 'cp + "The preferred method to attach a file. +Allowed values are: + +mv rename the file to move it into the attachment directory +cp copy the file +ln create a hard link. Note that this is not supported + on all systems, and then the result is not defined. +lns create a symbol link. Note that this is not supported + on all systems, and then the result is not defined." + :group 'org-attach + :type '(choice + (const :tag "Copy" cp) + (const :tag "Move/Rename" mv) + (const :tag "Hard Link" ln) + (const :tag "Symbol Link" lns))) + +(defcustom org-attach-expert nil + "Non-nil means do not show the splash buffer with the attach dispatcher." + :group 'org-attach + :type 'boolean) + +(defcustom org-attach-allow-inheritance t + "Non-nil means allow attachment directories be inherited." + :group 'org-attach + :type 'boolean) + +(defvar org-attach-inherited nil + "Indicates if the last access to the attachment directory was inherited.") + +(defcustom org-attach-store-link-p nil + "Non-nil means store a link to a file when attaching it." + :group 'org-attach + :version "24.1" + :type '(choice + (const :tag "Don't store link" nil) + (const :tag "Link to origin location" t) + (const :tag "Link to the attach-dir location" attached))) + +;;;###autoload +(defun org-attach () + "The dispatcher for attachment commands. +Shows a list of commands and prompts for another key to execute a command." + (interactive) + (let (c marker) + (when (eq major-mode 'org-agenda-mode) + (setq marker (or (get-text-property (point) 'org-hd-marker) + (get-text-property (point) 'org-marker))) + (unless marker + (error "No task in current line"))) + (save-excursion + (when marker + (set-buffer (marker-buffer marker)) + (goto-char marker)) + (org-back-to-heading t) + (save-excursion + (save-window-excursion + (unless org-attach-expert + (with-output-to-temp-buffer "*Org Attach*" + (princ "Select an Attachment Command: + +a Select a file and attach it to the task, using `org-attach-method'. +c/m/l/y Attach a file using copy/move/link/symbolic-link method. +n Create a new attachment, as an Emacs buffer. +z Synchronize the current task with its attachment + directory, in case you added attachments yourself. + +o Open current task's attachments. +O Like \"o\", but force opening in Emacs. +f Open current task's attachment directory. +F Like \"f\", but force using dired in Emacs. + +d Delete one attachment, you will be prompted for a file name. +D Delete all of a task's attachments. A safer way is + to open the directory in dired and delete from there. + +s Set a specific attachment directory for this entry. +i Make children of the current entry inherit its attachment directory."))) + (org-fit-window-to-buffer (get-buffer-window "*Org Attach*")) + (message "Select command: [acmlzoOfFdD]") + (setq c (read-char-exclusive)) + (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*")))) + (cond + ((memq c '(?a ?\C-a)) (call-interactively 'org-attach-attach)) + ((memq c '(?c ?\C-c)) + (let ((org-attach-method 'cp)) (call-interactively 'org-attach-attach))) + ((memq c '(?m ?\C-m)) + (let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach))) + ((memq c '(?l ?\C-l)) + (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach))) + ((memq c '(?y ?\C-y)) + (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach))) + ((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new)) + ((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync)) + ((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open)) + ((eq c ?O) (call-interactively 'org-attach-open-in-emacs)) + ((memq c '(?f ?\C-f)) (call-interactively 'org-attach-reveal)) + ((memq c '(?F)) (call-interactively 'org-attach-reveal-in-emacs)) + ((memq c '(?d ?\C-d)) (call-interactively + 'org-attach-delete-one)) + ((eq c ?D) (call-interactively 'org-attach-delete-all)) + ((eq c ?q) (message "Abort")) + ((memq c '(?s ?\C-s)) (call-interactively + 'org-attach-set-directory)) + ((memq c '(?i ?\C-i)) (call-interactively + 'org-attach-set-inherit)) + (t (error "No such attachment command %c" c)))))) + +(defun org-attach-dir (&optional create-if-not-exists-p) + "Return the directory associated with the current entry. +This first checks for a local property ATTACH_DIR, and then for an inherited +property ATTACH_DIR_INHERIT. If neither exists, the default mechanism +using the entry ID will be invoked to access the unique directory for the +current entry. +If the directory does not exist and CREATE-IF-NOT-EXISTS-P is non-nil, +the directory and (if necessary) the corresponding ID will be created." + (let (attach-dir uuid inherit) + (setq org-attach-inherited (org-entry-get nil "ATTACH_DIR_INHERIT")) + (cond + ((setq attach-dir (org-entry-get nil "ATTACH_DIR")) + (org-attach-check-absolute-path attach-dir)) + ((and org-attach-allow-inheritance + (setq inherit (org-entry-get nil "ATTACH_DIR_INHERIT" t))) + (setq attach-dir + (save-excursion + (save-restriction + (widen) + (if (marker-position org-entry-property-inherited-from) + (goto-char org-entry-property-inherited-from) + (org-back-to-heading t)) + (let (org-attach-allow-inheritance) + (org-attach-dir create-if-not-exists-p))))) + (org-attach-check-absolute-path attach-dir) + (setq org-attach-inherited t)) + (t ; use the ID + (org-attach-check-absolute-path nil) + (setq uuid (org-id-get (point) create-if-not-exists-p)) + (when (or uuid create-if-not-exists-p) + (unless uuid (error "ID retrieval/creation failed")) + (setq attach-dir (expand-file-name + (format "%s/%s" + (substring uuid 0 2) + (substring uuid 2)) + (expand-file-name org-attach-directory)))))) + (when attach-dir + (if (and create-if-not-exists-p + (not (file-directory-p attach-dir))) + (make-directory attach-dir t)) + (and (file-exists-p attach-dir) + attach-dir)))) + +(defun org-attach-check-absolute-path (dir) + "Check if we have enough information to root the attachment directory. +When DIR is given, check also if it is already absolute. Otherwise, +assume that it will be relative, and check if `org-attach-directory' is +absolute, or if at least the current buffer has a file name. +Throw an error if we cannot root the directory." + (or (and dir (file-name-absolute-p dir)) + (file-name-absolute-p org-attach-directory) + (buffer-file-name (buffer-base-buffer)) + (error "Need absolute `org-attach-directory' to attach in buffers without filename"))) + +(defun org-attach-set-directory () + "Set the ATTACH_DIR property of the current entry. +The property defines the directory that is used for attachments +of the entry." + (interactive) + (let ((dir (org-entry-get nil "ATTACH_DIR"))) + (setq dir (read-directory-name "Attachment directory: " dir)) + (org-entry-put nil "ATTACH_DIR" dir))) + +(defun org-attach-set-inherit () + "Set the ATTACH_DIR_INHERIT property of the current entry. +The property defines the directory that is used for attachments +of the entry and any children that do not explicitly define (by setting +the ATTACH_DIR property) their own attachment directory." + (interactive) + (org-entry-put nil "ATTACH_DIR_INHERIT" "t") + (message "Children will inherit attachment directory")) + +(defun org-attach-commit () + "Commit changes to git if `org-attach-directory' is properly initialized. +This checks for the existence of a \".git\" directory in that directory." + (let* ((dir (expand-file-name org-attach-directory)) + (git-dir (vc-git-root dir)) + (changes 0)) + (when (and git-dir (executable-find "git")) + (with-temp-buffer + (cd dir) + (let ((have-annex + (and org-attach-git-annex-cutoff + (file-exists-p (expand-file-name "annex" git-dir))))) + (dolist (new-or-modified + (split-string + (shell-command-to-string + "git ls-files -zmo --exclude-standard") "\0" t)) + (if (and have-annex + (>= (nth 7 (file-attributes new-or-modified)) + org-attach-git-annex-cutoff)) + (call-process "git" nil nil nil "annex" "add" new-or-modified) + (call-process "git" nil nil nil "add" new-or-modified)) + (incf changes))) + (dolist (deleted + (split-string + (shell-command-to-string "git ls-files -z --deleted") "\0" t)) + (call-process "git" nil nil nil "rm" deleted) + (incf changes)) + (when (> changes 0) + (shell-command "git commit -m 'Synchronized attachments'")))))) + +(defun org-attach-tag (&optional off) + "Turn the autotag on or (if OFF is set) off." + (when org-attach-auto-tag + (save-excursion + (org-back-to-heading t) + (org-toggle-tag org-attach-auto-tag (if off 'off 'on))))) + +(defun org-attach-untag () + "Turn the autotag off." + (org-attach-tag 'off)) + +(defun org-attach-store-link (file) + "Add a link to `org-stored-link' when attaching a file. +Only do this when `org-attach-store-link-p' is non-nil." + (setq org-stored-links + (cons (list (org-attach-expand-link file) + (file-name-nondirectory file)) + org-stored-links))) + +(defun org-attach-attach (file &optional visit-dir method) + "Move/copy/link FILE into the attachment directory of the current task. +If VISIT-DIR is non-nil, visit the directory with dired. +METHOD may be `cp', `mv', `ln', or `lns' default taken from +`org-attach-method'." + (interactive "fFile to keep as an attachment: \nP") + (setq method (or method org-attach-method)) + (let ((basename (file-name-nondirectory file))) + (when (and org-attach-file-list-property (not org-attach-inherited)) + (org-entry-add-to-multivalued-property + (point) org-attach-file-list-property basename)) + (let* ((attach-dir (org-attach-dir t)) + (fname (expand-file-name basename attach-dir))) + (cond + ((eq method 'mv) (rename-file file fname)) + ((eq method 'cp) (copy-file file fname)) + ((eq method 'ln) (add-name-to-file file fname)) + ((eq method 'lns) (make-symbolic-link file fname))) + (org-attach-commit) + (org-attach-tag) + (cond ((eq org-attach-store-link-p 'attached) + (org-attach-store-link fname)) + ((eq org-attach-store-link-p t) + (org-attach-store-link file))) + (if visit-dir + (dired attach-dir) + (message "File \"%s\" is now a task attachment." basename))))) + +(defun org-attach-attach-cp () + "Attach a file by copying it." + (interactive) + (let ((org-attach-method 'cp)) (call-interactively 'org-attach-attach))) +(defun org-attach-attach-mv () + "Attach a file by moving (renaming) it." + (interactive) + (let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach))) +(defun org-attach-attach-ln () + "Attach a file by creating a hard link to it. +Beware that this does not work on systems that do not support hard links. +On some systems, this apparently does copy the file instead." + (interactive) + (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach))) +(defun org-attach-attach-lns () + "Attach a file by creating a symbolic link to it. + +Beware that this does not work on systems that do not support symbolic links. +On some systems, this apparently does copy the file instead." + (interactive) + (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach))) + +(defun org-attach-new (file) + "Create a new attachment FILE for the current task. +The attachment is created as an Emacs buffer." + (interactive "sCreate attachment named: ") + (when (and org-attach-file-list-property (not org-attach-inherited)) + (org-entry-add-to-multivalued-property + (point) org-attach-file-list-property file)) + (let ((attach-dir (org-attach-dir t))) + (org-attach-tag) + (find-file (expand-file-name file attach-dir)) + (message "New attachment %s" file))) + +(defun org-attach-delete-one (&optional file) + "Delete a single attachment." + (interactive) + (let* ((attach-dir (org-attach-dir t)) + (files (org-attach-file-list attach-dir)) + (file (or file + (org-icompleting-read + "Delete attachment: " + (mapcar (lambda (f) + (list (file-name-nondirectory f))) + files))))) + (setq file (expand-file-name file attach-dir)) + (unless (file-exists-p file) + (error "No such attachment: %s" file)) + (delete-file file) + (org-attach-commit))) + +(defun org-attach-delete-all (&optional force) + "Delete all attachments from the current task. +This actually deletes the entire attachment directory. +A safer way is to open the directory in dired and delete from there." + (interactive "P") + (when (and org-attach-file-list-property (not org-attach-inherited)) + (org-entry-delete (point) org-attach-file-list-property)) + (let ((attach-dir (org-attach-dir))) + (when + (and attach-dir + (or force + (y-or-n-p "Are you sure you want to remove all attachments of this entry? "))) + (shell-command (format "rm -fr %s" attach-dir)) + (message "Attachment directory removed") + (org-attach-commit) + (org-attach-untag)))) + +(defun org-attach-sync () + "Synchronize the current tasks with its attachments. +This can be used after files have been added externally." + (interactive) + (org-attach-commit) + (when (and org-attach-file-list-property (not org-attach-inherited)) + (org-entry-delete (point) org-attach-file-list-property)) + (let ((attach-dir (org-attach-dir))) + (when attach-dir + (let ((files (org-attach-file-list attach-dir))) + (and files (org-attach-tag)) + (when org-attach-file-list-property + (dolist (file files) + (unless (string-match "^\\." file) + (org-entry-add-to-multivalued-property + (point) org-attach-file-list-property file)))))))) + +(defun org-attach-file-list (dir) + "Return a list of files in the attachment directory. +This ignores files starting with a \".\", and files ending in \"~\"." + (delq nil + (mapcar (lambda (x) (if (string-match "^\\." x) nil x)) + (directory-files dir nil "[^~]\\'")))) + +(defun org-attach-reveal (&optional if-exists) + "Show the attachment directory of the current task. +This will attempt to use an external program to show the directory." + (interactive "P") + (let ((attach-dir (org-attach-dir (not if-exists)))) + (and attach-dir (org-open-file attach-dir)))) + +(defun org-attach-reveal-in-emacs () + "Show the attachment directory of the current task in dired." + (interactive) + (let ((attach-dir (org-attach-dir t))) + (dired attach-dir))) + +(defun org-attach-open (&optional in-emacs) + "Open an attachment of the current task. +If there are more than one attachment, you will be prompted for the file name. +This command will open the file using the settings in `org-file-apps' +and in the system-specific variants of this variable. +If IN-EMACS is non-nil, force opening in Emacs." + (interactive "P") + (let* ((attach-dir (org-attach-dir t)) + (files (org-attach-file-list attach-dir)) + (file (if (= (length files) 1) + (car files) + (org-icompleting-read "Open attachment: " + (mapcar 'list files) nil t)))) + (org-open-file (expand-file-name file attach-dir) in-emacs))) + +(defun org-attach-open-in-emacs () + "Open attachment, force opening in Emacs. +See `org-attach-open'." + (interactive) + (org-attach-open 'in-emacs)) + +(defun org-attach-expand (file) + "Return the full path to the current entry's attachment file FILE. +Basically, this adds the path to the attachment directory." + (expand-file-name file (org-attach-dir))) + +(defun org-attach-expand-link (file) + "Return a file link pointing to the current entry's attachment file FILE. +Basically, this adds the path to the attachment directory, and a \"file:\" +prefix." + (concat "file:" (org-attach-expand file))) + +(provide 'org-attach) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-attach.el ends here diff --git a/elpa/org-20150427/org-autoloads.el b/elpa/org-20150427/org-autoloads.el new file mode 100644 index 00000000..741525f1 --- /dev/null +++ b/elpa/org-20150427/org-autoloads.el @@ -0,0 +1,682 @@ +;;; org-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "org" "org.el" (21822 1136 0 0)) +;;; Generated autoloads from org.el + +(autoload 'org-babel-do-load-languages "org" "\ +Load the languages defined in `org-babel-load-languages'. + +\(fn SYM VALUE)" nil nil) + +(autoload 'org-babel-load-file "org" "\ +Load Emacs Lisp source code blocks in the Org-mode FILE. +This function exports the source code using `org-babel-tangle' +and then loads the resulting file using `load-file'. With prefix +arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp +file to byte-code before it is loaded. + +\(fn FILE &optional COMPILE)" t nil) + +(autoload 'org-version "org" "\ +Show the org-mode version in the echo area. +With prefix argument HERE, insert it at point. +When FULL is non-nil, use a verbose version string. +When MESSAGE is non-nil, display a message with the version. + +\(fn &optional HERE FULL MESSAGE)" t nil) + +(autoload 'turn-on-orgtbl "org" "\ +Unconditionally turn on `orgtbl-mode'. + +\(fn)" nil nil) + +(autoload 'org-clock-persistence-insinuate "org" "\ +Set up hooks for clock persistence. + +\(fn)" nil nil) + +(autoload 'org-mode "org" "\ +Outline-based notes management and organizer, alias +\"Carsten's outline-mode for keeping track of everything.\" + +Org-mode develops organizational tasks around a NOTES file which +contains information about projects as plain text. Org-mode is +implemented on top of outline-mode, which is ideal to keep the content +of large files well structured. It supports ToDo items, deadlines and +time stamps, which magically appear in the diary listing of the Emacs +calendar. Tables are easily created with a built-in table editor. +Plain text URL-like links connect to websites, emails (VM), Usenet +messages (Gnus), BBDB entries, and any files related to the project. +For printing and sharing of notes, an Org-mode file (or a part of it) +can be exported as a structured ASCII or HTML file. + +The following commands are available: + +\\{org-mode-map} + +\(fn)" t nil) + +(autoload 'org-cycle "org" "\ +TAB-action and visibility cycling for Org-mode. + +This is the command invoked in Org-mode by the TAB key. Its main purpose +is outline visibility cycling, but it also invokes other actions +in special contexts. + +- When this function is called with a prefix argument, rotate the entire + buffer through 3 states (global cycling) + 1. OVERVIEW: Show only top-level headlines. + 2. CONTENTS: Show all headlines of all levels, but no body text. + 3. SHOW ALL: Show everything. + When called with two `C-u C-u' prefixes, switch to the startup visibility, + determined by the variable `org-startup-folded', and by any VISIBILITY + properties in the buffer. + When called with three `C-u C-u C-u' prefixed, show the entire buffer, + including any drawers. + +- When inside a table, re-align the table and move to the next field. + +- When point is at the beginning of a headline, rotate the subtree started + by this line through 3 different states (local cycling) + 1. FOLDED: Only the main headline is shown. + 2. CHILDREN: The main headline and the direct children are shown. + From this state, you can move to one of the children + and zoom in further. + 3. SUBTREE: Show the entire subtree, including body text. + If there is no subtree, switch directly from CHILDREN to FOLDED. + +- When point is at the beginning of an empty headline and the variable + `org-cycle-level-after-item/entry-creation' is set, cycle the level + of the headline by demoting and promoting it to likely levels. This + speeds up creation document structure by pressing TAB once or several + times right after creating a new headline. + +- When there is a numeric prefix, go up to a heading with level ARG, do + a `show-subtree' and return to the previous cursor position. If ARG + is negative, go up that many levels. + +- When point is not at the beginning of a headline, execute the global + binding for TAB, which is re-indenting the line. See the option + `org-cycle-emulate-tab' for details. + +- Special case: if point is at the beginning of the buffer and there is + no headline in line 1, this function will act as if called with prefix arg + (C-u TAB, same as S-TAB) also when called without prefix arg. + But only if also the variable `org-cycle-global-at-bob' is t. + +\(fn &optional ARG)" t nil) + +(autoload 'org-global-cycle "org" "\ +Cycle the global visibility. For details see `org-cycle'. +With \\[universal-argument] prefix arg, switch to startup visibility. +With a numeric prefix, show all headlines up to that level. + +\(fn &optional ARG)" t nil) +(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp) + +(autoload 'orgstruct-mode "org" "\ +Toggle the minor mode `orgstruct-mode'. +This mode is for using Org-mode structure commands in other +modes. The following keys behave as if Org-mode were active, if +the cursor is on a headline, or on a plain list item (both as +defined by Org-mode). + +\(fn &optional ARG)" t nil) + +(autoload 'turn-on-orgstruct "org" "\ +Unconditionally turn on `orgstruct-mode'. + +\(fn)" nil nil) + +(autoload 'turn-on-orgstruct++ "org" "\ +Unconditionally turn on `orgstruct++-mode'. + +\(fn)" nil nil) + +(autoload 'org-run-like-in-org-mode "org" "\ +Run a command, pretending that the current buffer is in Org-mode. +This will temporarily bind local variables that are typically bound in +Org-mode to the values they have in Org-mode, and then interactively +call CMD. + +\(fn CMD)" nil nil) + +(autoload 'org-store-link "org" "\ +\\Store an org-link to the current location. +This link is added to `org-stored-links' and can later be inserted +into an org-buffer with \\[org-insert-link]. + +For some link types, a prefix arg is interpreted. +For links to Usenet articles, arg negates `org-gnus-prefer-web-links'. +For file links, arg negates `org-context-in-file-links'. + +A double prefix arg force skipping storing functions that are not +part of Org's core. + +A triple prefix arg force storing a link for each line in the +active region. + +\(fn ARG)" t nil) + +(autoload 'org-insert-link-global "org" "\ +Insert a link like Org-mode does. +This command can be called in any mode to insert a link in Org-mode syntax. + +\(fn)" t nil) + +(autoload 'org-open-at-point-global "org" "\ +Follow a link like Org-mode does. +This command can be called in any mode to follow a link that has +Org-mode syntax. + +\(fn)" t nil) + +(autoload 'org-open-link-from-string "org" "\ +Open a link in the string S, as if it was in Org-mode. + +\(fn S &optional ARG REFERENCE-BUFFER)" t nil) + +(autoload 'org-switchb "org" "\ +Switch between Org buffers. +With one prefix argument, restrict available buffers to files. +With two prefix arguments, restrict available buffers to agenda files. + +Defaults to `iswitchb' for buffer name completion. +Set `org-completion-use-ido' to make it use ido instead. + +\(fn &optional ARG)" t nil) + +(defalias 'org-ido-switchb 'org-switchb) + +(defalias 'org-iswitchb 'org-switchb) + +(autoload 'org-cycle-agenda-files "org" "\ +Cycle through the files in `org-agenda-files'. +If the current buffer visits an agenda file, find the next one in the list. +If the current buffer does not, find the first agenda file. + +\(fn)" t nil) + +(autoload 'org-submit-bug-report "org" "\ +Submit a bug report on Org-mode via mail. + +Don't hesitate to report any problems or inaccurate documentation. + +If you don't have setup sending mail from (X)Emacs, please copy the +output buffer into your mail program, as it gives us important +information about your Org-mode version and configuration. + +\(fn)" t nil) + +(autoload 'org-reload "org" "\ +Reload all org lisp files. +With prefix arg UNCOMPILED, load the uncompiled versions. + +\(fn &optional UNCOMPILED)" t nil) + +(autoload 'org-customize "org" "\ +Call the customize function with org as argument. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "org-agenda" "org-agenda.el" (21822 1136 0 +;;;;;; 0)) +;;; Generated autoloads from org-agenda.el + +(autoload 'org-toggle-sticky-agenda "org-agenda" "\ +Toggle `org-agenda-sticky'. + +\(fn &optional ARG)" t nil) + +(autoload 'org-agenda "org-agenda" "\ +Dispatch agenda commands to collect entries to the agenda buffer. +Prompts for a command to execute. Any prefix arg will be passed +on to the selected command. The default selections are: + +a Call `org-agenda-list' to display the agenda for current day or week. +t Call `org-todo-list' to display the global todo list. +T Call `org-todo-list' to display the global todo list, select only + entries with a specific TODO keyword (the user gets a prompt). +m Call `org-tags-view' to display headlines with tags matching + a condition (the user is prompted for the condition). +M Like `m', but select only TODO entries, no ordinary headlines. +L Create a timeline for the current buffer. +e Export views to associated files. +s Search entries for keywords. +S Search entries for keywords, only with TODO keywords. +/ Multi occur across all agenda files and also files listed + in `org-agenda-text-search-extra-files'. +< Restrict agenda commands to buffer, subtree, or region. + Press several times to get the desired effect. +> Remove a previous restriction. +# List \"stuck\" projects. +! Configure what \"stuck\" means. +C Configure custom agenda commands. + +More commands can be added by configuring the variable +`org-agenda-custom-commands'. In particular, specific tags and TODO keyword +searches can be pre-defined in this way. + +If the current buffer is in Org-mode and visiting a file, you can also +first press `<' once to indicate that the agenda should be temporarily +\(until the next use of \\[org-agenda]) restricted to the current file. +Pressing `<' twice means to restrict to the current subtree or region +\(if active). + +\(fn &optional ARG ORG-KEYS RESTRICTION)" t nil) + +(autoload 'org-batch-agenda "org-agenda" "\ +Run an agenda command in batch mode and send the result to STDOUT. +If CMD-KEY is a string of length 1, it is used as a key in +`org-agenda-custom-commands' and triggers this command. If it is a +longer string it is used as a tags/todo match string. +Parameters are alternating variable names and values that will be bound +before running the agenda command. + +\(fn CMD-KEY &rest PARAMETERS)" nil t) + +(autoload 'org-batch-agenda-csv "org-agenda" "\ +Run an agenda command in batch mode and send the result to STDOUT. +If CMD-KEY is a string of length 1, it is used as a key in +`org-agenda-custom-commands' and triggers this command. If it is a +longer string it is used as a tags/todo match string. +Parameters are alternating variable names and values that will be bound +before running the agenda command. + +The output gives a line for each selected agenda item. Each +item is a list of comma-separated values, like this: + +category,head,type,todo,tags,date,time,extra,priority-l,priority-n + +category The category of the item +head The headline, without TODO kwd, TAGS and PRIORITY +type The type of the agenda entry, can be + todo selected in TODO match + tagsmatch selected in tags match + diary imported from diary + deadline a deadline on given date + scheduled scheduled on given date + timestamp entry has timestamp on given date + closed entry was closed on given date + upcoming-deadline warning about deadline + past-scheduled forwarded scheduled item + block entry has date block including g. date +todo The todo keyword, if any +tags All tags including inherited ones, separated by colons +date The relevant date, like 2007-2-14 +time The time, like 15:00-16:50 +extra Sting with extra planning info +priority-l The priority letter if any was given +priority-n The computed numerical priority +agenda-day The day in the agenda where this is listed + +\(fn CMD-KEY &rest PARAMETERS)" nil t) + +(autoload 'org-store-agenda-views "org-agenda" "\ +Store agenda views. + +\(fn &rest PARAMETERS)" t nil) + +(autoload 'org-batch-store-agenda-views "org-agenda" "\ +Run all custom agenda commands that have a file argument. + +\(fn &rest PARAMETERS)" nil t) + +(autoload 'org-agenda-list "org-agenda" "\ +Produce a daily/weekly view from all files in variable `org-agenda-files'. +The view will be for the current day or week, but from the overview buffer +you will be able to go to other days/weeks. + +With a numeric prefix argument in an interactive call, the agenda will +span ARG days. Lisp programs should instead specify SPAN to change +the number of days. SPAN defaults to `org-agenda-span'. + +START-DAY defaults to TODAY, or to the most recent match for the weekday +given in `org-agenda-start-on-weekday'. + +When WITH-HOUR is non-nil, only include scheduled and deadline +items if they have an hour specification like [h]h:mm. + +\(fn &optional ARG START-DAY SPAN WITH-HOUR)" t nil) + +(autoload 'org-search-view "org-agenda" "\ +Show all entries that contain a phrase or words or regular expressions. + +With optional prefix argument TODO-ONLY, only consider entries that are +TODO entries. The argument STRING can be used to pass a default search +string into this function. If EDIT-AT is non-nil, it means that the +user should get a chance to edit this string, with cursor at position +EDIT-AT. + +The search string can be viewed either as a phrase that should be found as +is, or it can be broken into a number of snippets, each of which must match +in a Boolean way to select an entry. The default depends on the variable +`org-agenda-search-view-always-boolean'. +Even if this is turned off (the default) you can always switch to +Boolean search dynamically by preceding the first word with \"+\" or \"-\". + +The default is a direct search of the whole phrase, where each space in +the search string can expand to an arbitrary amount of whitespace, +including newlines. + +If using a Boolean search, the search string is split on whitespace and +each snippet is searched separately, with logical AND to select an entry. +Words prefixed with a minus must *not* occur in the entry. Words without +a prefix or prefixed with a plus must occur in the entry. Matching is +case-insensitive. Words are enclosed by word delimiters (i.e. they must +match whole words, not parts of a word) if +`org-agenda-search-view-force-full-words' is set (default is nil). + +Boolean search snippets enclosed by curly braces are interpreted as +regular expressions that must or (when preceded with \"-\") must not +match in the entry. Snippets enclosed into double quotes will be taken +as a whole, to include whitespace. + +- If the search string starts with an asterisk, search only in headlines. +- If (possibly after the leading star) the search string starts with an + exclamation mark, this also means to look at TODO entries only, an effect + that can also be achieved with a prefix argument. +- If (possibly after star and exclamation mark) the search string starts + with a colon, this will mean that the (non-regexp) snippets of the + Boolean search must match as full words. + +This command searches the agenda files, and in addition the files listed +in `org-agenda-text-search-extra-files'. + +\(fn &optional TODO-ONLY STRING EDIT-AT)" t nil) + +(autoload 'org-todo-list "org-agenda" "\ +Show all (not done) TODO entries from all agenda file in a single list. +The prefix arg can be used to select a specific TODO keyword and limit +the list to these. When using \\[universal-argument], you will be prompted +for a keyword. A numeric prefix directly selects the Nth keyword in +`org-todo-keywords-1'. + +\(fn &optional ARG)" t nil) + +(autoload 'org-tags-view "org-agenda" "\ +Show all headlines for all `org-agenda-files' matching a TAGS criterion. +The prefix arg TODO-ONLY limits the search to TODO entries. + +\(fn &optional TODO-ONLY MATCH)" t nil) + +(autoload 'org-agenda-list-stuck-projects "org-agenda" "\ +Create agenda view for projects that are stuck. +Stuck projects are project that have no next actions. For the definitions +of what a project is and how to check if it stuck, customize the variable +`org-stuck-projects'. + +\(fn &rest IGNORE)" t nil) + +(autoload 'org-diary "org-agenda" "\ +Return diary information from org files. +This function can be used in a \"sexp\" diary entry in the Emacs calendar. +It accesses org files and extracts information from those files to be +listed in the diary. The function accepts arguments specifying what +items should be listed. For a list of arguments allowed here, see the +variable `org-agenda-entry-types'. + +The call in the diary file should look like this: + + &%%(org-diary) ~/path/to/some/orgfile.org + +Use a separate line for each org file to check. Or, if you omit the file name, +all files listed in `org-agenda-files' will be checked automatically: + + &%%(org-diary) + +If you don't give any arguments (as in the example above), the default value +of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp). +So the example above may also be written as + + &%%(org-diary :deadline :timestamp :sexp :scheduled) + +The function expects the lisp variables `entry' and `date' to be provided +by the caller, because this is how the calendar works. Don't use this +function from a program - use `org-agenda-get-day-entries' instead. + +\(fn &rest ARGS)" nil nil) + +(autoload 'org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item "org-agenda" "\ +Do we have a reason to ignore this TODO entry because it has a time stamp? + +\(fn &optional END)" nil nil) + +(autoload 'org-agenda-set-restriction-lock "org-agenda" "\ +Set restriction lock for agenda, to current subtree or file. +Restriction will be the file if TYPE is `file', or if type is the +universal prefix '(4), or if the cursor is before the first headline +in the file. Otherwise, restriction will be to the current subtree. + +\(fn &optional TYPE)" t nil) + +(autoload 'org-calendar-goto-agenda "org-agenda" "\ +Compute the Org-mode agenda for the calendar date displayed at the cursor. +This is a command that has to be installed in `calendar-mode-map'. + +\(fn)" t nil) + +(autoload 'org-agenda-to-appt "org-agenda" "\ +Activate appointments found in `org-agenda-files'. +With a \\[universal-argument] prefix, refresh the list of +appointments. + +If FILTER is t, interactively prompt the user for a regular +expression, and filter out entries that don't match it. + +If FILTER is a string, use this string as a regular expression +for filtering entries out. + +If FILTER is a function, filter out entries against which +calling the function returns nil. This function takes one +argument: an entry from `org-agenda-get-day-entries'. + +FILTER can also be an alist with the car of each cell being +either 'headline or 'category. For example: + + '((headline \"IMPORTANT\") + (category \"Work\")) + +will only add headlines containing IMPORTANT or headlines +belonging to the \"Work\" category. + +ARGS are symbols indicating what kind of entries to consider. +By default `org-agenda-to-appt' will use :deadline*, :scheduled* +\(i.e., deadlines and scheduled items with a hh:mm specification) +and :timestamp entries. See the docstring of `org-diary' for +details and examples. + +If an entry has a APPT_WARNTIME property, its value will be used +to override `appt-message-warning-time'. + +\(fn &optional REFRESH FILTER &rest ARGS)" t nil) + +;;;*** + +;;;### (autoloads nil "org-capture" "org-capture.el" (21822 1136 +;;;;;; 0 0)) +;;; Generated autoloads from org-capture.el + +(autoload 'org-capture-string "org-capture" "\ +Capture STRING with the template selected by KEYS. + +\(fn STRING &optional KEYS)" t nil) + +(autoload 'org-capture "org-capture" "\ +Capture something. +\\ +This will let you select a template from `org-capture-templates', and then +file the newly captured information. The text is immediately inserted +at the target location, and an indirect buffer is shown where you can +edit it. Pressing \\[org-capture-finalize] brings you back to the previous state +of Emacs, so that you can continue your work. + +When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture +anything, just go to the file/headline where the selected template +stores its notes. With a double prefix argument \\[universal-argument] \\[universal-argument], go to the last note +stored. + +When called with a `C-0' (zero) prefix, insert a template at point. + +ELisp programs can set KEYS to a string associated with a template +in `org-capture-templates'. In this case, interactive selection +will be bypassed. + +If `org-capture-use-agenda-date' is non-nil, capturing from the +agenda will use the date at point as the default date. Then, a +`C-1' prefix will tell the capture process to use the HH:MM time +of the day at point (if any) or the current HH:MM time. + +\(fn &optional GOTO KEYS)" t nil) + +(autoload 'org-capture-import-remember-templates "org-capture" "\ +Set `org-capture-templates' to be similar to `org-remember-templates'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "org-colview" "org-colview.el" (21822 1136 +;;;;;; 0 0)) +;;; Generated autoloads from org-colview.el + +(autoload 'org-columns-remove-overlays "org-colview" "\ +Remove all currently active column overlays. + +\(fn)" t nil) + +(autoload 'org-columns-get-format-and-top-level "org-colview" "\ + + +\(fn)" nil nil) + +(autoload 'org-columns "org-colview" "\ +Turn on column view on an org-mode file. +When COLUMNS-FMT-STRING is non-nil, use it as the column format. + +\(fn &optional COLUMNS-FMT-STRING)" t nil) + +(autoload 'org-columns-compute "org-colview" "\ +Sum the values of property PROPERTY hierarchically, for the entire buffer. + +\(fn PROPERTY)" t nil) + +(autoload 'org-columns-number-to-string "org-colview" "\ +Convert a computed column number to a string value, according to FMT. + +\(fn N FMT &optional PRINTF)" nil nil) + +(autoload 'org-dblock-write:columnview "org-colview" "\ +Write the column view table. +PARAMS is a property list of parameters: + +:width enforce same column widths with specifiers. +:id the :ID: property of the entry where the columns view + should be built. When the symbol `local', call locally. + When `global' call column view with the cursor at the beginning + of the buffer (usually this means that the whole buffer switches + to column view). When \"file:path/to/file.org\", invoke column + view at the start of that file. Otherwise, the ID is located + using `org-id-find'. +:hlines When t, insert a hline before each item. When a number, insert + a hline before each level <= that number. +:vlines When t, make each column a colgroup to enforce vertical lines. +:maxlevel When set to a number, don't capture headlines below this level. +:skip-empty-rows + When t, skip rows where all specifiers other than ITEM are empty. +:format When non-nil, specify the column view format to use. + +\(fn PARAMS)" nil nil) + +(autoload 'org-insert-columns-dblock "org-colview" "\ +Create a dynamic block capturing a column view table. + +\(fn)" t nil) + +(autoload 'org-agenda-columns "org-colview" "\ +Turn on or update column view in the agenda. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "org-compat" "org-compat.el" (21822 1135 0 +;;;;;; 0)) +;;; Generated autoloads from org-compat.el + +(autoload 'org-check-version "org-compat" "\ +Try very hard to provide sensible version strings. + +\(fn)" nil t) + +;;;*** + +;;;### (autoloads nil "org-macs" "org-macs.el" (21822 1136 0 0)) +;;; Generated autoloads from org-macs.el + +(autoload 'org-load-noerror-mustsuffix "org-macs" "\ +Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it. + +\(fn FILE)" nil t) + +;;;*** + +;;;### (autoloads nil "org-version" "org-version.el" (21822 1136 +;;;;;; 0 0)) +;;; Generated autoloads from org-version.el + +(autoload 'org-release "org-version" "\ +The release version of org-mode. + Inserted by installing org-mode or when a release is made. + +\(fn)" nil nil) + +(autoload 'org-git-version "org-version" "\ +The Git version of org-mode. + Inserted by installing org-mode or when a release is made. + +\(fn)" nil nil) + +(defvar org-odt-data-dir "/usr/share/emacs/etc/org" "\ +The location of ODT styles.") + +;;;*** + +;;;### (autoloads nil nil ("ob-C.el" "ob-R.el" "ob-asymptote.el" +;;;;;; "ob-awk.el" "ob-calc.el" "ob-clojure.el" "ob-comint.el" "ob-core.el" +;;;;;; "ob-css.el" "ob-ditaa.el" "ob-dot.el" "ob-emacs-lisp.el" +;;;;;; "ob-eval.el" "ob-exp.el" "ob-fortran.el" "ob-gnuplot.el" +;;;;;; "ob-haskell.el" "ob-io.el" "ob-java.el" "ob-js.el" "ob-keys.el" +;;;;;; "ob-latex.el" "ob-ledger.el" "ob-lilypond.el" "ob-lisp.el" +;;;;;; "ob-lob.el" "ob-makefile.el" "ob-matlab.el" "ob-maxima.el" +;;;;;; "ob-mscgen.el" "ob-ocaml.el" "ob-octave.el" "ob-org.el" "ob-perl.el" +;;;;;; "ob-picolisp.el" "ob-plantuml.el" "ob-python.el" "ob-ref.el" +;;;;;; "ob-ruby.el" "ob-sass.el" "ob-scala.el" "ob-scheme.el" "ob-screen.el" +;;;;;; "ob-sh.el" "ob-shen.el" "ob-sql.el" "ob-sqlite.el" "ob-table.el" +;;;;;; "ob-tangle.el" "ob.el" "org-archive.el" "org-attach.el" "org-bbdb.el" +;;;;;; "org-bibtex.el" "org-clock.el" "org-crypt.el" "org-ctags.el" +;;;;;; "org-datetree.el" "org-docview.el" "org-element.el" "org-entities.el" +;;;;;; "org-eshell.el" "org-faces.el" "org-feed.el" "org-footnote.el" +;;;;;; "org-gnus.el" "org-habit.el" "org-id.el" "org-indent.el" +;;;;;; "org-info.el" "org-inlinetask.el" "org-install.el" "org-irc.el" +;;;;;; "org-list.el" "org-loaddefs.el" "org-macro.el" "org-mhe.el" +;;;;;; "org-mobile.el" "org-mouse.el" "org-pcomplete.el" "org-pkg.el" +;;;;;; "org-plot.el" "org-protocol.el" "org-rmail.el" "org-src.el" +;;;;;; "org-table.el" "org-timer.el" "org-w3m.el" "ox-ascii.el" +;;;;;; "ox-beamer.el" "ox-html.el" "ox-icalendar.el" "ox-latex.el" +;;;;;; "ox-man.el" "ox-md.el" "ox-odt.el" "ox-org.el" "ox-publish.el" +;;;;;; "ox-texinfo.el" "ox.el") (21822 1136 169682 0)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; org-autoloads.el ends here diff --git a/elpa/org-20150427/org-bbdb.el b/elpa/org-20150427/org-bbdb.el new file mode 100644 index 00000000..cfd5b3b6 --- /dev/null +++ b/elpa/org-20150427/org-bbdb.el @@ -0,0 +1,448 @@ +;;; org-bbdb.el --- Support for links to BBDB entries from within Org-mode + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Authors: Carsten Dominik +;; Thomas Baumann +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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 . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file implements links to BBDB database entries from within Org-mode. +;; Org-mode loads this module by default - if this is not what you want, +;; configure the variable `org-modules'. + +;; It also implements an interface (based on Ivar Rummelhoff's +;; bbdb-anniv.el) for those org-mode users, who do not use the diary +;; but who do want to include the anniversaries stored in the BBDB +;; into the org-agenda. If you already include the `diary' into the +;; agenda, you might want to prefer to include the anniversaries in +;; the diary using bbdb-anniv.el. +;; +;; Put the following in /somewhere/at/home/diary.org and make sure +;; that this file is in `org-agenda-files` +;; +;; %%(org-bbdb-anniversaries) +;; +;; For example my diary.org looks like: +;; * Anniversaries +;; #+CATEGORY: Anniv +;; %%(org-bbdb-anniversaries) +;; +;; +;; To add an anniversary to a BBDB record, press `C-o' in the record. +;; You will be prompted for the field name, in this case it must be +;; "anniversary". If this is the first time you are using this field, +;; you need to confirm that it should be created. +;; +;; The format of an anniversary field stored in BBDB is the following +;; (items in {} are optional): +;; +;; YYYY-MM-DD{ CLASS-OR-FORMAT-STRING} +;; {\nYYYY-MM-DD CLASS-OR-FORMAT-STRING}... +;; +;; CLASS-OR-FORMAT-STRING is one of two things: +;; +;; - an identifier for a class of anniversaries (eg. birthday or +;; wedding) from `org-bbdb-anniversary-format-alist' which then +;; defines the format string for this class +;; - the (format) string displayed in the diary. +;; +;; You can enter multiple anniversaries for a single BBDB record by +;; separating them with a newline character. At the BBDB prompt for +;; the field value, type `C-q C-j' to enter a newline between two +;; anniversaries. +;; +;; If you omit the CLASS-OR-FORMAT-STRING entirely, it defaults to the +;; value of `org-bbdb-default-anniversary-format' ("birthday" by +;; default). +;; +;; The substitutions in the format string are (in order): +;; - the name of the record containing this anniversary +;; - the number of years +;; - an ordinal suffix (st, nd, rd, th) for the year +;; +;; See the documentation of `org-bbdb-anniversary-format-alist' for +;; further options. +;; +;; Example +;; +;; 1973-06-22 +;; 20??-??-?? wedding +;; 1998-03-12 %s created bbdb-anniv.el %d years ago +;; +;; From Org's agenda, you can use `C-c C-o' to jump to the BBDB +;; link from which the entry at point originates. +;; +;;; Code: + +(require 'org) +(eval-when-compile + (require 'cl)) + +;; Declare external functions and variables + +(declare-function bbdb "ext:bbdb-com" (string elidep)) +(declare-function bbdb-company "ext:bbdb-com" (string elidep)) +(declare-function bbdb-current-record "ext:bbdb-com" + (&optional planning-on-modifying)) +(declare-function bbdb-name "ext:bbdb-com" (string elidep)) +(declare-function bbdb-completing-read-record "ext:bbdb-com" + (prompt &optional omit-records)) +(declare-function bbdb-record-getprop "ext:bbdb" (record property)) +(declare-function bbdb-record-name "ext:bbdb" (record)) +(declare-function bbdb-records "ext:bbdb" + (&optional dont-check-disk already-in-db-buffer)) +(declare-function bbdb-split "ext:bbdb" (string separators)) +(declare-function bbdb-string-trim "ext:bbdb" (string)) +(declare-function bbdb-record-get-field "ext:bbdb" (record field)) +(declare-function bbdb-search-name "ext:bbdb-com" (regexp &optional layout)) +(declare-function bbdb-search-organization "ext:bbdb-com" (regexp &optional layout)) + +;; `bbdb-record-note' was part of BBDB v3.x +(declare-function bbdb-record-note "ext:bbdb" (record label)) +;; `bbdb-record-xfield' replaces it in recent BBDB v3.x+ +(declare-function bbdb-record-xfield "ext:bbdb" (record label)) + +(declare-function calendar-leap-year-p "calendar" (year)) +(declare-function diary-ordinal-suffix "diary-lib" (n)) + +(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el + +;; Customization + +(defgroup org-bbdb-anniversaries nil + "Customizations for including anniversaries from BBDB into Agenda." + :group 'org-bbdb) + +(defcustom org-bbdb-default-anniversary-format "birthday" + "Default anniversary class." + :type 'string + :group 'org-bbdb-anniversaries + :require 'bbdb) + +(defcustom org-bbdb-anniversary-format-alist + '(("birthday" . + (lambda (name years suffix) + (concat "Birthday: [[bbdb:" name "][" name " (" + (format "%s" years) ; handles numbers as well as strings + suffix ")]]"))) + ("wedding" . + (lambda (name years suffix) + (concat "[[bbdb:" name "][" name "'s " + (format "%s" years) + suffix " wedding anniversary]]")))) + "How different types of anniversaries should be formatted. +An alist of elements (STRING . FORMAT) where STRING is the name of an +anniversary class and format is either: +1) A format string with the following substitutions (in order): + - the name of the record containing this anniversary + - the number of years + - an ordinal suffix (st, nd, rd, th) for the year + +2) A function to be called with three arguments: NAME YEARS SUFFIX + (string int string) returning a string for the diary or nil. + +3) An Emacs Lisp form that should evaluate to a string (or nil) in the + scope of variables NAME, YEARS and SUFFIX (among others)." + :type '(alist :key-type (string :tag "Class") + :value-type (function :tag "Function")) + :group 'org-bbdb-anniversaries + :require 'bbdb) + +(defcustom org-bbdb-anniversary-field 'anniversary + "The BBDB field which contains anniversaries. +The anniversaries are stored in the following format + +YYYY-MM-DD Class-or-Format-String + +where class is one of the customized classes for anniversaries; +birthday and wedding are predefined. Format-String can take three +substitutions 1) the name of the record containing this +anniversary, 2) the number of years, and 3) an ordinal suffix for +the year. + +Multiple anniversaries can be separated by \\n." + :type 'symbol + :group 'org-bbdb-anniversaries + :require 'bbdb) + +(defcustom org-bbdb-extract-date-fun 'org-bbdb-anniv-extract-date + "How to retrieve `month date year' from the anniversary field. + +Customize if you have already filled your BBDB with dates +different from YYYY-MM-DD. The function must return a list (month +date year)." + :type 'function + :group 'org-bbdb-anniversaries + :require 'bbdb) + + +;; Install the link type +(org-add-link-type "bbdb" 'org-bbdb-open 'org-bbdb-export) +(add-hook 'org-store-link-functions 'org-bbdb-store-link) + +;; Implementation +(defun org-bbdb-store-link () + "Store a link to a BBDB database entry." + (when (eq major-mode 'bbdb-mode) + ;; This is BBDB, we make this link! + (let* ((rec (bbdb-current-record)) + (name (bbdb-record-name rec)) + (company (if (fboundp 'bbdb-record-getprop) + (bbdb-record-getprop rec 'company) + (car (bbdb-record-get-field rec 'organization)))) + (link (concat "bbdb:" name))) + (org-store-link-props :type "bbdb" :name name :company company + :link link :description name) + link))) + +(defun org-bbdb-export (path desc format) + "Create the export version of a BBDB link specified by PATH or DESC. +If exporting to either HTML or LaTeX FORMAT the link will be +italicized, in all other cases it is left unchanged." + (when (string= desc (format "bbdb:%s" path)) + (setq desc path)) + (cond + ((eq format 'html) (format "%s" desc)) + ((eq format 'latex) (format "\\textit{%s}" desc)) + ((eq format 'odt) + (format "%s" desc)) + (t desc))) + +(defun org-bbdb-open (name) + "Follow a BBDB link to NAME." + (require 'bbdb-com) + (let ((inhibit-redisplay (not debug-on-error)) + (bbdb-electric-p nil)) + (if (fboundp 'bbdb-name) + (org-bbdb-open-old name) + (org-bbdb-open-new name)))) + +(defun org-bbdb-open-old (name) + (catch 'exit + ;; Exact match on name + (bbdb-name (concat "\\`" name "\\'") nil) + (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) + ;; Exact match on name + (bbdb-company (concat "\\`" name "\\'") nil) + (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) + ;; Partial match on name + (bbdb-name name nil) + (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) + ;; Partial match on company + (bbdb-company name nil) + (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) + ;; General match including network address and notes + (bbdb name nil) + (when (= 0 (buffer-size (get-buffer "*BBDB*"))) + (delete-window (get-buffer-window "*BBDB*")) + (error "No matching BBDB record")))) + +(defun org-bbdb-open-new (name) + (catch 'exit + ;; Exact match on name + (bbdb-search-name (concat "\\`" name "\\'") nil) + (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) + ;; Exact match on name + (bbdb-search-organization (concat "\\`" name "\\'") nil) + (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) + ;; Partial match on name + (bbdb-search-name name nil) + (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) + ;; Partial match on company + (bbdb-search-organization name nil) + (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) + ;; General match including network address and notes + (bbdb name nil) + (when (= 0 (buffer-size (get-buffer "*BBDB*"))) + (delete-window (get-buffer-window "*BBDB*")) + (error "No matching BBDB record")))) + +(defun org-bbdb-anniv-extract-date (time-str) + "Convert YYYY-MM-DD to (month date year). +Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted +it will be considered unknown." + (multiple-value-bind (a b c) (values-list (org-split-string time-str "-")) + (if (eq c nil) + (list (string-to-number a) + (string-to-number b) + nil) + (list (string-to-number b) + (string-to-number c) + (string-to-number a))))) + +(defun org-bbdb-anniv-split (str) + "Split multiple entries in the BBDB anniversary field. +Argument STR is the anniversary field in BBDB." + (let ((pos (string-match "[ \t]" str))) + (if pos (list (substring str 0 pos) + (bbdb-string-trim (substring str pos))) + (list str nil)))) + +(defvar org-bbdb-anniv-hash nil + "A hash holding anniversaries extracted from BBDB. +The hash table is created on first use.") + +(defvar org-bbdb-updated-p t + "This is non-nil if BBDB has been updated since we last built the hash.") + +(defun org-bbdb-make-anniv-hash () + "Create a hash with anniversaries extracted from BBDB, for fast access. +The anniversaries are assumed to be stored `org-bbdb-anniversary-field'." + (let ((old-bbdb (fboundp 'bbdb-record-getprop)) + (record-func (if (fboundp 'bbdb-record-xfield) + 'bbdb-record-xfield + 'bbdb-record-note)) + split tmp annivs) + (clrhash org-bbdb-anniv-hash) + (dolist (rec (bbdb-records)) + (when (setq annivs (if old-bbdb + (bbdb-record-getprop + rec org-bbdb-anniversary-field) + (funcall record-func + rec org-bbdb-anniversary-field))) + (setq annivs (if old-bbdb + (bbdb-split annivs "\n") + ;; parameter order is reversed in new bbdb + (bbdb-split "\n" annivs))) + (while annivs + (setq split (org-bbdb-anniv-split (pop annivs))) + (multiple-value-bind (m d y) + (values-list (funcall org-bbdb-extract-date-fun (car split))) + (setq tmp (gethash (list m d) org-bbdb-anniv-hash)) + (puthash (list m d) (cons (list y + (bbdb-record-name rec) + (cadr split)) + tmp) + org-bbdb-anniv-hash)))))) + (setq org-bbdb-updated-p nil)) + +(defun org-bbdb-updated (rec) + "Record the fact that BBDB has been updated. +This is used by Org to re-create the anniversary hash table." + (setq org-bbdb-updated-p t)) + +(add-hook 'bbdb-after-change-hook 'org-bbdb-updated) + +;;;###autoload +(defun org-bbdb-anniversaries () + "Extract anniversaries from BBDB for display in the agenda." + (require 'bbdb) + (require 'diary-lib) + (unless (hash-table-p org-bbdb-anniv-hash) + (setq org-bbdb-anniv-hash + (make-hash-table :test 'equal :size 366))) + + (when (or org-bbdb-updated-p + (= 0 (hash-table-count org-bbdb-anniv-hash))) + (org-bbdb-make-anniv-hash)) + + (let* ((m (car date)) ; month + (d (nth 1 date)) ; day + (y (nth 2 date)) ; year + (annivs (gethash (list m d) org-bbdb-anniv-hash)) + (text ()) + rec recs) + + ;; we don't want to miss people born on Feb. 29th + (when (and (= m 3) (= d 1) + (not (null (gethash (list 2 29) org-bbdb-anniv-hash))) + (not (calendar-leap-year-p y))) + (setq recs (gethash (list 2 29) org-bbdb-anniv-hash)) + (while (setq rec (pop recs)) + (push rec annivs))) + + (when annivs + (while (setq rec (pop annivs)) + (when rec + (let* ((class (or (nth 2 rec) + org-bbdb-default-anniversary-format)) + (form (or (cdr (assoc-string + class org-bbdb-anniversary-format-alist t)) + class)) ; (as format string) + (name (nth 1 rec)) + (years (if (eq (car rec) nil) + "unknown" + (- y (car rec)))) + (suffix (if (eq (car rec) nil) + "" + (diary-ordinal-suffix years))) + (tmp (cond + ((functionp form) + (funcall form name years suffix)) + ((listp form) (eval form)) + (t (format form name years suffix))))) + (org-add-props tmp nil 'org-bbdb-name name) + (if text + (setq text (append text (list tmp))) + (setq text (list tmp))))) + )) + text)) + +(defun org-bbdb-complete-link () + "Read a bbdb link with name completion." + (require 'bbdb-com) + (let ((rec (bbdb-completing-read-record "Name: "))) + (concat "bbdb:" + (bbdb-record-name (if (listp rec) + (car rec) + rec))))) + +(defun org-bbdb-anniv-export-ical () + "Extract anniversaries from BBDB and convert them to icalendar format." + (require 'bbdb) + (require 'diary-lib) + (unless (hash-table-p org-bbdb-anniv-hash) + (setq org-bbdb-anniv-hash + (make-hash-table :test 'equal :size 366))) + (when (or org-bbdb-updated-p + (= 0 (hash-table-count org-bbdb-anniv-hash))) + (org-bbdb-make-anniv-hash)) + (maphash 'org-bbdb-format-vevent org-bbdb-anniv-hash)) + +(defun org-bbdb-format-vevent (key recs) + (let (rec categ) + (while (setq rec (pop recs)) + (setq categ (or (nth 2 rec) org-bbdb-default-anniversary-format)) + (princ (format "BEGIN:VEVENT +UID: ANNIV-%4i%02i%02i-%s +DTSTART:%4i%02i%02i +SUMMARY:%s +DESCRIPTION:%s +CATEGORIES:%s +RRULE:FREQ=YEARLY +END:VEVENT\n" + (nth 0 rec) (nth 0 key) (nth 1 key) + (mapconcat 'identity + (org-split-string (nth 1 rec) "[^a-zA-Z0-90]+") + "-") + (nth 0 rec) (nth 0 key) (nth 1 key) + (nth 1 rec) + (concat (capitalize categ) " " (nth 1 rec)) + categ))))) + +(provide 'org-bbdb) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-bbdb.el ends here diff --git a/elpa/org-20150427/org-bibtex.el b/elpa/org-20150427/org-bibtex.el new file mode 100644 index 00000000..75ac69ba --- /dev/null +++ b/elpa/org-20150427/org-bibtex.el @@ -0,0 +1,722 @@ +;;; org-bibtex.el --- Org links to BibTeX entries +;; +;; Copyright (C) 2007-2014 Free Software Foundation, Inc. +;; +;; Authors: Bastien Guerry +;; Carsten Dominik +;; Eric Schulte +;; Keywords: org, wp, capture +;; +;; 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 . +;; +;;; Commentary: +;; +;; This file implements links to database entries in BibTeX files. +;; Instead of defining a special link prefix, it uses the normal file +;; links combined with a custom search mechanism to find entries +;; by reference key. And it constructs a nice description tag for +;; the link that contains the author name, the year and a short title. +;; +;; It also stores detailed information about the entry so that +;; capture templates can access and enter this information easily. +;; +;; The available properties for each entry are listed here: +;; +;; :author :publisher :volume :pages +;; :editor :url :number :journal +;; :title :year :series :address +;; :booktitle :month :annote :abstract +;; :key :btype +;; +;; Here is an example of a capture template that use some of this +;; information (:author :year :title :journal :pages): +;; +;; (setq org-capture-templates +;; '((?b "* READ %?\n\n%a\n\n%:author (%:year): %:title\n \ +;; In %:journal, %:pages."))) +;; +;; Let's say you want to capture this BibTeX entry: +;; +;; @Article{dolev83, +;; author = {Danny Dolev and Andrew C. Yao}, +;; title = {On the security of public-key protocols}, +;; journal = {IEEE Transaction on Information Theory}, +;; year = 1983, +;; volume = 2, +;; number = 29, +;; pages = {198--208}, +;; month = {Mars} +;; } +;; +;; M-x `org-capture' on this entry will produce this buffer: +;; +;; ===================================================================== +;; * READ <== [point here] +;; +;; [[file:file.bib::dolev83][Dolev & Yao 1983: security of public key protocols]] +;; +;; Danny Dolev and Andrew C. Yao (1983): On the security of public-key protocols +;; In IEEE Transaction on Information Theory, 198--208. +;; ===================================================================== +;; +;; Additionally, the following functions are now available for storing +;; bibtex entries within Org-mode documents. +;; +;; - Run `org-bibtex' to export the current file to a .bib. +;; +;; - Run `org-bibtex-check' or `org-bibtex-check-all' to check and +;; fill in missing field of either the current, or all headlines +;; +;; - Run `org-bibtex-create' to add a bibtex entry +;; +;; - Use `org-bibtex-read' to read a bibtex entry after `point' or in +;; the active region, then call `org-bibtex-write' in a .org file to +;; insert a heading for the read bibtex entry +;; +;; - All Bibtex information is taken from the document compiled by +;; Andrew Roberts from the Bibtex manual, available at +;; http://www.andy-roberts.net/res/writing/latex/bibentries.pdf +;; +;;; History: +;; +;; The link creation part has been part of Org-mode for a long time. +;; +;; Creating better capture template information was inspired by a request +;; of Austin Frank: http://article.gmane.org/gmane.emacs.orgmode/4112 +;; and then implemented by Bastien Guerry. +;; +;; Eric Schulte eventually added the functions for translating between +;; Org-mode headlines and Bibtex entries, and for fleshing out the Bibtex +;; fields of existing Org-mode headlines. +;; +;; Org-mode loads this module by default - if this is not what you want, +;; configure the variable `org-modules'. + +;;; Code: + +(require 'org) +(require 'bibtex) +(eval-when-compile + (require 'cl)) +(require 'org-compat) + +(defvar org-bibtex-description nil) ; dynamically scoped from org.el +(defvar org-id-locations) + +(declare-function bibtex-beginning-of-entry "bibtex" ()) +(declare-function bibtex-generate-autokey "bibtex" ()) +(declare-function bibtex-parse-entry "bibtex" (&optional content)) +(declare-function bibtex-url "bibtex" (&optional pos no-browse)) +(declare-function org-babel-trim "ob" (string &optional regexp)) + + +;;; Bibtex data +(defvar org-bibtex-types + '((:article + (:description . "An article from a journal or magazine") + (:required :author :title :journal :year) + (:optional :volume :number :pages :month :note)) + (:book + (:description . "A book with an explicit publisher") + (:required (:editor :author) :title :publisher :year) + (:optional (:volume :number) :series :address :edition :month :note)) + (:booklet + (:description . "A work that is printed and bound, but without a named publisher or sponsoring institution.") + (:required :title) + (:optional :author :howpublished :address :month :year :note)) + (:conference + (:description . "") + (:required :author :title :booktitle :year) + (:optional :editor :pages :organization :publisher :address :month :note)) + (:inbook + (:description . "A part of a book, which may be a chapter (or section or whatever) and/or a range of pages.") + (:required (:author :editor) :title (:chapter :pages) :publisher :year) + (:optional :crossref (:volume :number) :series :type :address :edition :month :note)) + (:incollection + (:description . "A part of a book having its own title.") + (:required :author :title :booktitle :publisher :year) + (:optional :crossref :editor (:volume :number) :series :type :chapter :pages :address :edition :month :note)) + (:inproceedings + (:description . "An article in a conference proceedings") + (:required :author :title :booktitle :year) + (:optional :crossref :editor (:volume :number) :series :pages :address :month :organization :publisher :note)) + (:manual + (:description . "Technical documentation.") + (:required :title) + (:optional :author :organization :address :edition :month :year :note)) + (:mastersthesis + (:description . "A Master’s thesis.") + (:required :author :title :school :year) + (:optional :type :address :month :note)) + (:misc + (:description . "Use this type when nothing else fits.") + (:required) + (:optional :author :title :howpublished :month :year :note)) + (:phdthesis + (:description . "A PhD thesis.") + (:required :author :title :school :year) + (:optional :type :address :month :note)) + (:proceedings + (:description . "The proceedings of a conference.") + (:required :title :year) + (:optional :editor (:volume :number) :series :address :month :organization :publisher :note)) + (:techreport + (:description . "A report published by a school or other institution.") + (:required :author :title :institution :year) + (:optional :type :address :month :note)) + (:unpublished + (:description . "A document having an author and title, but not formally published.") + (:required :author :title :note) + (:optional :month :year))) + "Bibtex entry types with required and optional parameters.") + +(defvar org-bibtex-fields + '((:address . "Usually the address of the publisher or other type of institution. For major publishing houses, van Leunen recommends omitting the information entirely. For small publishers, on the other hand, you can help the reader by giving the complete address.") + (:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.") + (:author . "The name(s) of the author(s), in the format described in the LaTeX book. Remember, all names are separated with the and keyword, and not commas.") + (:booktitle . "Title of a book, part of which is being cited. See the LaTeX book for how to type titles. For book entries, use the title field instead.") + (:chapter . "A chapter (or section or whatever) number.") + (:crossref . "The database key of the entry being cross referenced.") + (:edition . "The edition of a book for example, 'Second'. This should be an ordinal, and should have the first letter capitalized, as shown here; the standard styles convert to lower case when necessary.") + (:editor . "Name(s) of editor(s), typed as indicated in the LaTeX book. If there is also an author field, then the editor field gives the editor of the book or collection in which the reference appears.") + (:howpublished . "How something strange has been published. The first word should be capitalized.") + (:institution . "The sponsoring institution of a technical report.") + (:journal . "A journal name.") + (:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \cite command and at the beginning of the database entry.") + (:month . "The month in which the work was published or, for an unpublished work, in which it was written. You should use the standard three-letter abbreviation,") + (:note . "Any additional information that can help the reader. The first word should be capitalized.") + (:number . "Any additional information that can help the reader. The first word should be capitalized.") + (:organization . "The organization that sponsors a conference or that publishes a manual.") + (:pages . "One or more page numbers or range of numbers, such as 42-111 or 7,41,73-97 or 43+ (the ‘+’ in this last example indicates pages following that don’t form simple range). BibTEX requires double dashes for page ranges (--).") + (:publisher . "The publisher’s name.") + (:school . "The name of the school where a thesis was written.") + (:series . "The name of a series or set of books. When citing an entire book, the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.") + (:title . "The work’s title, typed as explained in the LaTeX book.") + (:type . "The type of a technical report for example, 'Research Note'.") + (:volume . "The volume of a journal or multi-volume book.") + (:year . "The year of publication or, for an unpublished work, the year it was written. Generally it should consist of four numerals, such as 1984, although the standard styles can handle any year whose last four nonpunctuation characters are numerals, such as '(about 1984)'")) + "Bibtex fields with descriptions.") + +(defvar org-bibtex-entries nil + "List to hold parsed bibtex entries.") + +(defcustom org-bibtex-autogen-keys nil + "Set to a truth value to use `bibtex-generate-autokey' to generate keys." + :group 'org-bibtex + :version "24.1" + :type 'boolean) + +(defcustom org-bibtex-prefix nil + "Optional prefix for all bibtex property names. +For example setting to 'BIB_' would allow interoperability with fireforg." + :group 'org-bibtex + :version "24.1" + :type '(choice + (const nil) + (string))) + +(defcustom org-bibtex-treat-headline-as-title t + "Treat headline text as title if title property is absent. +If an entry is missing a title property, use the headline text as +the property. If this value is t, `org-bibtex-check' will ignore +a missing title field." + :group 'org-bibtex + :version "24.1" + :type 'boolean) + +(defcustom org-bibtex-export-arbitrary-fields nil + "When converting to bibtex allow fields not defined in `org-bibtex-fields'. +This only has effect if `org-bibtex-prefix' is defined, so as to +ensure that other org-properties, such as CATEGORY or LOGGING are +not placed in the exported bibtex entry." + :group 'org-bibtex + :version "24.1" + :type 'boolean) + +(defcustom org-bibtex-key-property "CUSTOM_ID" + "Property that holds the bibtex key. +By default, this is CUSTOM_ID, which enables easy linking to +bibtex headlines from within an org file. This can be set to ID +to enable global links, but only with great caution, as global +IDs must be unique." + :group 'org-bibtex + :version "24.1" + :type 'string) + +(defcustom org-bibtex-tags nil + "List of tag(s) that should be added to new bib entries." + :group 'org-bibtex + :version "24.1" + :type '(repeat :tag "Tag" (string))) + +(defcustom org-bibtex-tags-are-keywords nil + "Convert the value of the keywords field to tags and vice versa. +If set to t, comma-separated entries in a bibtex entry's keywords +field will be converted to org tags. Note: spaces will be escaped +with underscores, and characters that are not permitted in org +tags will be removed. + +If t, local tags in an org entry will be exported as a +comma-separated string of keywords when exported to bibtex. Tags +defined in `org-bibtex-tags' or `org-bibtex-no-export-tags' will +not be exported." + :group 'org-bibtex + :version "24.1" + :type 'boolean) + +(defcustom org-bibtex-no-export-tags nil + "List of tag(s) that should not be converted to keywords. +This variable is relevant only if `org-bibtex-tags-are-keywords' is t." + :group 'org-bibtex + :version "24.1" + :type '(repeat :tag "Tag" (string))) + +(defcustom org-bibtex-type-property-name "btype" + "Property in which to store bibtex entry type (e.g., article)." + :group 'org-bibtex + :version "24.1" + :type 'string) + + +;;; Utility functions +(defun org-bibtex-get (property) + (let ((it (let ((org-special-properties + (delete "FILE" (copy-sequence org-special-properties)))) + (or + (org-entry-get (point) (upcase property)) + (org-entry-get (point) (concat org-bibtex-prefix + (upcase property))))))) + (when it (org-babel-trim it)))) + +(defun org-bibtex-put (property value) + (let ((prop (upcase (if (keywordp property) + (substring (symbol-name property) 1) + property)))) + (org-set-property + (concat (unless (string= org-bibtex-key-property prop) org-bibtex-prefix) + prop) + value))) + +(defun org-bibtex-headline () + "Return a bibtex entry of the given headline as a string." + (let* ((val (lambda (key lst) (cdr (assoc key lst)))) + (to (lambda (string) (intern (concat ":" string)))) + (from (lambda (key) (substring (symbol-name key) 1))) + flatten ; silent compiler warning + (flatten (lambda (&rest lsts) + (apply #'append (mapcar + (lambda (e) + (if (listp e) (apply flatten e) (list e))) + lsts)))) + (notes (buffer-string)) + (id (org-bibtex-get org-bibtex-key-property)) + (type (org-bibtex-get org-bibtex-type-property-name)) + (tags (when org-bibtex-tags-are-keywords + (delq nil + (mapcar + (lambda (tag) + (unless (member tag + (append org-bibtex-tags + org-bibtex-no-export-tags)) + tag)) + (org-get-local-tags-at)))))) + (when type + (let ((entry (format + "@%s{%s,\n%s\n}\n" type id + (mapconcat + (lambda (pair) + (format " %s={%s}" (car pair) (cdr pair))) + (remove nil + (if (and org-bibtex-export-arbitrary-fields + org-bibtex-prefix) + (mapcar + (lambda (kv) + (let ((key (car kv)) (val0 (cdr kv))) + (when (and + (string-match org-bibtex-prefix key) + (not (string= + (downcase (concat org-bibtex-prefix + org-bibtex-type-property-name)) + (downcase key)))) + (cons (downcase (replace-regexp-in-string + org-bibtex-prefix "" key)) + val0)))) + (org-entry-properties nil 'standard)) + (mapcar + (lambda (field) + (let ((value (or (org-bibtex-get (funcall from field)) + (and (equal :title field) + (nth 4 (org-heading-components)))))) + (when value (cons (funcall from field) value)))) + (funcall flatten + (funcall val :required (funcall val (funcall to type) org-bibtex-types)) + (funcall val :optional (funcall val (funcall to type) org-bibtex-types)))))) + ",\n")))) + (with-temp-buffer + (insert entry) + (when tags + (bibtex-beginning-of-entry) + (if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t) + (progn (goto-char (match-end 1)) (insert ", ")) + (search-forward ",\n" nil t) + (insert " keywords={},\n") + (search-backward "}," nil t)) + (insert (mapconcat #'identity tags ", "))) + (buffer-string)))))) + +(defun org-bibtex-ask (field) + (unless (assoc field org-bibtex-fields) + (error "Field:%s is not known" field)) + (save-window-excursion + (let* ((name (substring (symbol-name field) 1)) + (buf-name (format "*Bibtex Help %s*" name))) + (with-output-to-temp-buffer buf-name + (princ (cdr (assoc field org-bibtex-fields)))) + (with-current-buffer buf-name (visual-line-mode 1)) + (org-fit-window-to-buffer (get-buffer-window buf-name)) + (let ((result (read-from-minibuffer (format "%s: " name)))) + (when (> (length result) 0) result))))) + +(defun org-bibtex-autokey () + "Generate an autokey for the current headline." + (org-bibtex-put org-bibtex-key-property + (if org-bibtex-autogen-keys + (let* ((entry (org-bibtex-headline)) + (key + (with-temp-buffer + (insert entry) + (bibtex-generate-autokey)))) + ;; test for duplicate IDs if using global ID + (when (and + (equal org-bibtex-key-property "ID") + (featurep 'org-id) + (hash-table-p org-id-locations) + (gethash key org-id-locations)) + (warn "Another entry has the same ID")) + key) + (read-from-minibuffer "id: ")))) + +(defun org-bibtex-fleshout (type &optional optional) + "Fleshout current heading, ensuring all required fields are present. +With optional argument OPTIONAL, also prompt for optional fields." + (let ((val (lambda (key lst) (cdr (assoc key lst)))) + (keyword (lambda (name) (intern (concat ":" (downcase name))))) + (name (lambda (keyword) (substring (symbol-name keyword) 1)))) + (dolist (field (append + (if org-bibtex-treat-headline-as-title + (remove :title (funcall val :required (funcall val type org-bibtex-types))) + (funcall val :required (funcall val type org-bibtex-types))) + (when optional (funcall val :optional (funcall val type org-bibtex-types))))) + (when (consp field) ; or'd pair of fields e.g., (:editor :author) + (let ((present (first (remove + nil + (mapcar + (lambda (f) (when (org-bibtex-get (funcall name f)) f)) + field))))) + (setf field (or present (funcall keyword + (org-icompleting-read + "Field: " (mapcar name field))))))) + (let ((name (funcall name field))) + (unless (org-bibtex-get name) + (let ((prop (org-bibtex-ask field))) + (when prop (org-bibtex-put name prop))))))) + (when (and type (assoc type org-bibtex-types) + (not (org-bibtex-get org-bibtex-key-property))) + (org-bibtex-autokey))) + + +;;; Bibtex link functions +(org-add-link-type "bibtex" 'org-bibtex-open) +(add-hook 'org-store-link-functions 'org-bibtex-store-link) + +(defun org-bibtex-open (path) + "Visit the bibliography entry on 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-bibtex-store-link () + "Store a link to a BibTeX entry." + (when (eq major-mode 'bibtex-mode) + (let* ((search (org-create-file-search-in-bibtex)) + (link (concat "file:" (abbreviate-file-name buffer-file-name) + "::" search)) + (entry (mapcar ; repair strings enclosed in "..." or {...} + (lambda(c) + (if (string-match + "^\\(?:{\\|\"\\)\\(.*\\)\\(?:}\\|\"\\)$" (cdr c)) + (cons (car c) (match-string 1 (cdr c))) c)) + (save-excursion + (bibtex-beginning-of-entry) + (bibtex-parse-entry))))) + (org-store-link-props + :key (cdr (assoc "=key=" entry)) + :author (or (cdr (assoc "author" entry)) "[no author]") + :editor (or (cdr (assoc "editor" entry)) "[no editor]") + :title (or (cdr (assoc "title" entry)) "[no title]") + :booktitle (or (cdr (assoc "booktitle" entry)) "[no booktitle]") + :journal (or (cdr (assoc "journal" entry)) "[no journal]") + :publisher (or (cdr (assoc "publisher" entry)) "[no publisher]") + :pages (or (cdr (assoc "pages" entry)) "[no pages]") + :url (or (cdr (assoc "url" entry)) "[no url]") + :year (or (cdr (assoc "year" entry)) "[no year]") + :month (or (cdr (assoc "month" entry)) "[no month]") + :address (or (cdr (assoc "address" entry)) "[no address]") + :volume (or (cdr (assoc "volume" entry)) "[no volume]") + :number (or (cdr (assoc "number" entry)) "[no number]") + :annote (or (cdr (assoc "annote" entry)) "[no annotation]") + :series (or (cdr (assoc "series" entry)) "[no series]") + :abstract (or (cdr (assoc "abstract" entry)) "[no abstract]") + :btype (or (cdr (assoc "=type=" entry)) "[no type]") + :type "bibtex" + :link link + :description org-bibtex-description)))) + +(defun org-create-file-search-in-bibtex () + "Create the search string and description for a BibTeX database entry." + ;; Make a good description for this entry, using names, year and the title + ;; Put it into the `description' variable which is dynamically scoped. + (let ((bibtex-autokey-names 1) + (bibtex-autokey-names-stretch 1) + (bibtex-autokey-name-case-convert-function 'identity) + (bibtex-autokey-name-separator " & ") + (bibtex-autokey-additional-names " et al.") + (bibtex-autokey-year-length 4) + (bibtex-autokey-name-year-separator " ") + (bibtex-autokey-titlewords 3) + (bibtex-autokey-titleword-separator " ") + (bibtex-autokey-titleword-case-convert-function 'identity) + (bibtex-autokey-titleword-length 'infty) + (bibtex-autokey-year-title-separator ": ")) + (setq org-bibtex-description (bibtex-generate-autokey))) + ;; Now parse the entry, get the key and return it. + (save-excursion + (bibtex-beginning-of-entry) + (cdr (assoc "=key=" (bibtex-parse-entry))))) + +(defun org-execute-file-search-in-bibtex (s) + "Find the link search string S as a key for a database entry." + (when (eq major-mode 'bibtex-mode) + ;; Yes, we want to do the search in this file. + ;; We construct a regexp that searches for "@entrytype{" followed by the key + (goto-char (point-min)) + (and (re-search-forward (concat "@[a-zA-Z]+[ \t\n]*{[ \t\n]*" + (regexp-quote s) "[ \t\n]*,") nil t) + (goto-char (match-beginning 0))) + (if (and (match-beginning 0) (equal current-prefix-arg '(16))) + ;; Use double prefix to indicate that any web link should be browsed + (let ((b (current-buffer)) (p (point))) + ;; Restore the window configuration because we just use the web link + (set-window-configuration org-window-config-before-follow-link) + (with-current-buffer b + (goto-char p) + (bibtex-url))) + (recenter 0)) ; Move entry start to beginning of window + ;; return t to indicate that the search is done. + t)) + +;; Finally add the link search function to the right hook. +(add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex) + + +;;; Bibtex <-> Org-mode headline translation functions +(defun org-bibtex (&optional filename) + "Export each headline in the current file to a bibtex entry. +Headlines are exported using `org-bibtex-headline'." + (interactive + (list (read-file-name + "Bibtex file: " nil nil nil + (file-name-nondirectory + (concat (file-name-sans-extension (buffer-file-name)) ".bib"))))) + (let ((error-point + (catch 'bib + (let ((bibtex-entries + (remove nil (org-map-entries + (lambda () + (condition-case foo + (org-bibtex-headline) + (error (throw 'bib (point))))))))) + (with-temp-file filename + (insert (mapconcat #'identity bibtex-entries "\n"))) + (message "Successfully exported %d BibTeX entries to %s" + (length bibtex-entries) filename) nil)))) + (when error-point + (goto-char error-point) + (message "Bibtex error at %S" (nth 4 (org-heading-components)))))) + +(defun org-bibtex-check (&optional optional) + "Check the current headline for required fields. +With prefix argument OPTIONAL also prompt for optional fields." + (interactive "P") + (save-restriction + (org-narrow-to-subtree) + (let ((type (let ((name (org-bibtex-get org-bibtex-type-property-name))) + (when name (intern (concat ":" name)))))) + (when type (org-bibtex-fleshout type optional))))) + +(defun org-bibtex-check-all (&optional optional) + "Check all headlines in the current file. +With prefix argument OPTIONAL also prompt for optional fields." + (interactive) (org-map-entries (lambda () (org-bibtex-check optional)))) + +(defun org-bibtex-create (&optional arg nonew) + "Create a new entry at the given level. +With a prefix arg, query for optional fields as well. +If nonew is t, add data to the headline of the entry at point." + (interactive "P") + (let* ((type (org-icompleting-read + "Type: " (mapcar (lambda (type) + (substring (symbol-name (car type)) 1)) + org-bibtex-types) + nil nil (when nonew + (org-bibtex-get org-bibtex-type-property-name)))) + (type (if (keywordp type) type (intern (concat ":" type)))) + (org-bibtex-treat-headline-as-title (if nonew nil t))) + (unless (assoc type org-bibtex-types) + (error "Type:%s is not known" type)) + (if nonew + (org-back-to-heading) + (org-insert-heading) + (let ((title (org-bibtex-ask :title))) + (insert title) + (org-bibtex-put "TITLE" title))) + (org-bibtex-put org-bibtex-type-property-name + (substring (symbol-name type) 1)) + (org-bibtex-fleshout type arg) + (mapc (lambda (tag) (org-toggle-tag tag 'on)) org-bibtex-tags))) + +(defun org-bibtex-create-in-current-entry (&optional arg) + "Add bibliographical data to the current entry. +With a prefix arg, query for optional fields." + (interactive "P") + (org-bibtex-create arg t)) + +(defun org-bibtex-read () + "Read a bibtex entry and save to `org-bibtex-entries'. +This uses `bibtex-parse-entry'." + (interactive) + (let ((keyword (lambda (str) (intern (concat ":" (downcase str))))) + (clean-space (lambda (str) (replace-regexp-in-string + "[[:space:]\n\r]+" " " str))) + (strip-delim + (lambda (str) ; strip enclosing "..." and {...} + (dolist (pair '((34 . 34) (123 . 125) (123 . 125))) + (when (and (> (length str) 1) + (= (aref str 0) (car pair)) + (= (aref str (1- (length str))) (cdr pair))) + (setf str (substring str 1 (1- (length str)))))) str))) + (push (mapcar + (lambda (pair) + (cons (let ((field (funcall keyword (car pair)))) + (case field + (:=type= :type) + (:=key= :key) + (otherwise field))) + (funcall clean-space (funcall strip-delim (cdr pair))))) + (save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry))) + org-bibtex-entries))) + +(defun org-bibtex-read-buffer (buffer) + "Read all bibtex entries in BUFFER and save to `org-bibtex-entries'. +Return the number of saved entries." + (interactive "bbuffer: ") + (let ((start-length (length org-bibtex-entries))) + (with-current-buffer buffer + (save-excursion + (goto-char (point-max)) + (while (not (= (point) (point-min))) + (backward-char 1) + (org-bibtex-read) + (bibtex-beginning-of-entry)))) + (let ((added (- (length org-bibtex-entries) start-length))) + (message "parsed %d entries" added) + added))) + +(defun org-bibtex-read-file (file) + "Read FILE with `org-bibtex-read-buffer'." + (interactive "ffile: ") + (org-bibtex-read-buffer (find-file-noselect file 'nowarn 'rawfile))) + +(defun org-bibtex-write () + "Insert a heading built from the first element of `org-bibtex-entries'." + (interactive) + (when (= (length org-bibtex-entries) 0) + (error "No entries in `org-bibtex-entries'")) + (let* ((entry (pop org-bibtex-entries)) + (org-special-properties nil) ; avoids errors with `org-entry-put' + (val (lambda (field) (cdr (assoc field entry)))) + (togtag (lambda (tag) (org-toggle-tag tag 'on)))) + (org-insert-heading) + (insert (funcall val :title)) + (org-bibtex-put "TITLE" (funcall val :title)) + (org-bibtex-put org-bibtex-type-property-name + (downcase (funcall val :type))) + (dolist (pair entry) + (case (car pair) + (:title nil) + (:type nil) + (:key (org-bibtex-put org-bibtex-key-property (cdr pair))) + (:keywords (if org-bibtex-tags-are-keywords + (mapc + (lambda (kw) + (funcall + togtag + (replace-regexp-in-string + "[^[:alnum:]_@#%]" "" + (replace-regexp-in-string "[ \t]+" "_" kw)))) + (split-string (cdr pair) ", *")) + (org-bibtex-put (car pair) (cdr pair)))) + (otherwise (org-bibtex-put (car pair) (cdr pair))))) + (mapc togtag org-bibtex-tags))) + +(defun org-bibtex-yank () + "If kill ring holds a bibtex entry yank it as an Org-mode headline." + (interactive) + (let (entry) + (with-temp-buffer (yank 1) (setf entry (org-bibtex-read))) + (if entry + (org-bibtex-write) + (error "Yanked text does not appear to contain a BibTeX entry")))) + +(defun org-bibtex-import-from-file (file) + "Read bibtex entries from FILE and insert as Org-mode headlines after point." + (interactive "ffile: ") + (dotimes (_ (org-bibtex-read-file file)) + (save-excursion (org-bibtex-write)) + (re-search-forward org-property-end-re) + (open-line 1) (forward-char 1))) + +(defun org-bibtex-export-to-kill-ring () + "Export current headline to kill ring as bibtex entry." + (interactive) + (let ((result (org-bibtex-headline))) + (kill-new result) result)) + +(defun org-bibtex-search (string) + "Search for bibliographical entries in agenda files. +This function relies `org-search-view' to locate results." + (interactive "sSearch string: ") + (let ((org-agenda-overriding-header "Bib search results:") + (org-agenda-search-view-always-boolean t)) + (org-search-view nil + (format "%s +{:%s%s:}" + string (or org-bibtex-prefix "") + org-bibtex-type-property-name)))) + +(provide 'org-bibtex) + +;;; org-bibtex.el ends here diff --git a/elpa/org-20150427/org-capture.el b/elpa/org-20150427/org-capture.el new file mode 100644 index 00000000..88d7ee5a --- /dev/null +++ b/elpa/org-20150427/org-capture.el @@ -0,0 +1,1835 @@ +;;; org-capture.el --- Fast note taking in Org-mode + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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 . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains an alternative implementation of the functionality +;; that used to be provided by org-remember.el. The implementation is more +;; streamlined, can produce more target types (e.g. plain list items or +;; table lines). Also, it does not use a temporary buffer for editing +;; the captured entry - instead it uses an indirect buffer that visits +;; the new entry already in the target buffer (this was an idea by Samuel +;; Wales). John Wiegley's excellent `remember.el' is not needed anymore +;; for this implementation, even though we borrow heavily from its ideas. + +;; This implementation heavily draws on ideas by James TD Smith and +;; Samuel Wales, and, of cause, uses John Wiegley's remember.el as inspiration. + +;;; TODO + +;; - find a clever way to not always insert an annotation maybe a +;; predicate function that can check for conditions for %a to be +;; used. This could be one of the properties. + +;; - Should there be plist members that arrange for properties to be +;; asked for, like James proposed in his RFC? + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'org) + +(declare-function org-datetree-find-date-create "org-datetree" + (date &optional keep-restriction)) +(declare-function org-table-get-specials "org-table" ()) +(declare-function org-table-goto-line "org-table" (N)) +(declare-function org-pop-to-buffer-same-window "org-compat" + (&optional buffer-or-name norecord label)) +(declare-function org-at-encrypted-entry-p "org-crypt" ()) +(declare-function org-encrypt-entry "org-crypt" ()) +(declare-function org-decrypt-entry "org-crypt" ()) + +(defvar org-remember-default-headline) +(defvar org-remember-templates) +(defvar org-table-hlines) +(defvar dired-buffers) + +(defvar org-capture-clock-was-started nil + "Internal flag, noting if the clock was started.") + +(defvar org-capture-last-stored-marker (make-marker) + "Marker pointing to the entry most recently stored with `org-capture'.") + +;; The following variable is scoped dynamically by org-protocol +;; to indicate that the link properties have already been stored +(defvar org-capture-link-is-already-stored nil) + +(defgroup org-capture nil + "Options concerning capturing new entries." + :tag "Org Capture" + :group 'org) + +(defcustom org-capture-templates nil + "Templates for the creation of new entries. + +Each entry is a list with the following items: + +keys The keys that will select the template, as a string, characters + only, for example \"a\" for a template to be selected with a + single key, or \"bt\" for selection with two keys. When using + several keys, keys using the same prefix key must be together + in the list and preceded by a 2-element entry explaining the + prefix key, for example + + (\"b\" \"Templates for marking stuff to buy\") + + The \"C\" key is used by default for quick access to the + customization of the template variable. But if you want to use + that key for a template, you can. + +description A short string describing the template, will be shown during + selection. + +type The type of entry. Valid types are: + entry an Org-mode node, with a headline. Will be + filed as the child of the target entry or as + a top-level entry. + item a plain list item, will be placed in the + first plain list at the target + location. + checkitem a checkbox item. This differs from the + plain list item only is so far as it uses a + different default template. + table-line a new line in the first table at target location. + plain text to be inserted as it is. + +target Specification of where the captured item should be placed. + In Org-mode files, targets usually define a node. Entries will + become children of this node, other types will be added to the + table or list in the body of this node. + + Most target specifications contain a file name. If that file + name is the empty string, it defaults to `org-default-notes-file'. + A file can also be given as a variable, function, or Emacs Lisp + form. + + Valid values are: + + (file \"path/to/file\") + Text will be placed at the beginning or end of that file + + (id \"id of existing org entry\") + File as child of this entry, or in the body of the entry + + (file+headline \"path/to/file\" \"node headline\") + Fast configuration if the target heading is unique in the file + + (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...) + For non-unique headings, the full path is safer + + (file+regexp \"path/to/file\" \"regexp to find location\") + File to the entry matching regexp + + (file+datetree \"path/to/file\") + Will create a heading in a date tree for today's date + + (file+datetree+prompt \"path/to/file\") + Will create a heading in a date tree, prompts for date + + (file+function \"path/to/file\" function-finding-location) + A function to find the right location in the file + + (clock) + File to the entry that is currently being clocked + + (function function-finding-location) + Most general way, write your own function to find both + file and location + +template The template for creating the capture item. If you leave this + empty, an appropriate default template will be used. See below + for more details. Instead of a string, this may also be one of + + (file \"/path/to/template-file\") + (function function-returning-the-template) + + in order to get a template from a file, or dynamically + from a function. + +The rest of the entry is a property list of additional options. Recognized +properties are: + + :prepend Normally newly captured information will be appended at + the target location (last child, last table line, + last list item...). Setting this property will + change that. + + :immediate-finish When set, do not offer to edit the information, just + file it away immediately. This makes sense if the + template only needs information that can be added + automatically. + + :jump-to-captured When set, jump to the captured entry when finished. + + :empty-lines Set this to the number of lines the should be inserted + before and after the new item. Default 0, only common + other value is 1. + + :empty-lines-before Set this to the number of lines the should be inserted + before the new item. Overrides :empty-lines for the + number lines inserted before. + + :empty-lines-after Set this to the number of lines the should be inserted + after the new item. Overrides :empty-lines for the + number of lines inserted after. + + :clock-in Start the clock in this item. + + :clock-keep Keep the clock running when filing the captured entry. + + :clock-resume Start the interrupted clock when finishing the capture. + Note that :clock-keep has precedence over :clock-resume. + When setting both to `t', the current clock will run and + the previous one will not be resumed. + + :unnarrowed Do not narrow the target buffer, simply show the + full buffer. Default is to narrow it so that you + only see the new stuff. + + :table-line-pos Specification of the location in the table where the + new line should be inserted. It should be a string like + \"II-3\", meaning that the new line should become the + third line before the second horizontal separator line. + + :kill-buffer If the target file was not yet visited by a buffer when + capture was invoked, kill the buffer again after capture + is finalized. + +The template defines the text to be inserted. Often this is an +org-mode entry (so the first line should start with a star) that +will be filed as a child of the target headline. It can also be +freely formatted text. Furthermore, the following %-escapes will +be replaced with content and expanded in this order: + + %[pathname] Insert the contents of the file given by `pathname'. + %(sexp) Evaluate elisp `(sexp)' and replace it with the results. + For convenience, %:keyword (see below) placeholders within + the expression will be expanded prior to this. + %<...> The result of format-time-string on the ... format specification. + %t Time stamp, date only. + %T Time stamp with date and time. + %u, %U Like the above, but inactive time stamps. + %i Initial content, copied from the active region. If %i is + indented, the entire inserted text will be indented as well. + %a Annotation, normally the link created with `org-store-link'. + %A Like %a, but prompt for the description part. + %l Like %a, but only insert the literal link. + %c Current kill ring head. + %x Content of the X clipboard. + %k Title of currently clocked task. + %K Link to currently clocked task. + %n User name (taken from the variable `user-full-name'). + %f File visited by current buffer when org-capture was called. + %F Full path of the file or directory visited by current buffer. + %:keyword Specific information for certain link types, see below. + %^g Prompt for tags, with completion on tags in target file. + %^G Prompt for tags, with completion on all tags in all agenda files. + %^t Like %t, but prompt for date. Similarly %^T, %^u, %^U. + You may define a prompt like: %^{Please specify birthday}t + %^C Interactive selection of which kill or clip to use. + %^L Like %^C, but insert as link. + %^{prop}p Prompt the user for a value for property `prop'. + %^{prompt} Prompt the user for a string and replace this sequence with it. + A default value and a completion table ca be specified like this: + %^{prompt|default|completion2|completion3|...}. + %? After completing the template, position cursor here. + %\\n Insert the text entered at the nth %^{prompt}, where `n' is + a number, starting from 1. + +Apart from these general escapes, you can access information specific to +the link type that is created. For example, calling `org-capture' in emails +or in Gnus will record the author and the subject of the message, which you +can access with \"%:from\" and \"%:subject\", respectively. Here is a +complete list of what is recorded for each link type. + +Link type | Available information +------------------------+------------------------------------------------------ +bbdb | %:type %:name %:company +vm, wl, mh, mew, rmail, | %:type %:subject %:message-id +gnus | %:from %:fromname %:fromaddress + | %:to %:toname %:toaddress + | %:fromto (either \"to NAME\" or \"from NAME\") + | %:date %:date-timestamp (as active timestamp) + | %:date-timestamp-inactive (as inactive timestamp) +gnus | %:group, for messages also all email fields +w3, w3m | %:type %:url +info | %:type %:file %:node +calendar | %:type %:date" + :group 'org-capture + :version "24.1" + :type + '(repeat + (choice :value ("" "" entry (file "~/org/notes.org") "") + (list :tag "Multikey description" + (string :tag "Keys ") + (string :tag "Description")) + (list :tag "Template entry" + (string :tag "Keys ") + (string :tag "Description ") + (choice :tag "Capture Type " :value entry + (const :tag "Org entry" entry) + (const :tag "Plain list item" item) + (const :tag "Checkbox item" checkitem) + (const :tag "Plain text" plain) + (const :tag "Table line" table-line)) + (choice :tag "Target location" + (list :tag "File" + (const :format "" file) + (file :tag " File")) + (list :tag "ID" + (const :format "" id) + (string :tag " ID")) + (list :tag "File & Headline" + (const :format "" file+headline) + (file :tag " File ") + (string :tag " Headline")) + (list :tag "File & Outline path" + (const :format "" file+olp) + (file :tag " File ") + (repeat :tag "Outline path" :inline t + (string :tag "Headline"))) + (list :tag "File & Regexp" + (const :format "" file+regexp) + (file :tag " File ") + (regexp :tag " Regexp")) + (list :tag "File & Date tree" + (const :format "" file+datetree) + (file :tag " File")) + (list :tag "File & Date tree, prompt for date" + (const :format "" file+datetree+prompt) + (file :tag " File")) + (list :tag "File & function" + (const :format "" file+function) + (file :tag " File ") + (sexp :tag " Function")) + (list :tag "Current clocking task" + (const :format "" clock)) + (list :tag "Function" + (const :format "" function) + (sexp :tag " Function"))) + (choice :tag "Template" + (string) + (list :tag "File" + (const :format "" file) + (file :tag "Template file")) + (list :tag "Function" + (const :format "" function) + (function :tag "Template function"))) + (plist :inline t + ;; Give the most common options as checkboxes + :options (((const :format "%v " :prepend) (const t)) + ((const :format "%v " :immediate-finish) (const t)) + ((const :format "%v " :jump-to-captured) (const t)) + ((const :format "%v " :empty-lines) (const 1)) + ((const :format "%v " :empty-lines-before) (const 1)) + ((const :format "%v " :empty-lines-after) (const 1)) + ((const :format "%v " :clock-in) (const t)) + ((const :format "%v " :clock-keep) (const t)) + ((const :format "%v " :clock-resume) (const t)) + ((const :format "%v " :unnarrowed) (const t)) + ((const :format "%v " :table-line-pos) (const t)) + ((const :format "%v " :kill-buffer) (const t)))))))) + +(defcustom org-capture-before-finalize-hook nil + "Hook that is run right before a capture process is finalized. +The capture buffer is still current when this hook runs and it is +widened to the entire buffer." + :group 'org-capture + :version "24.1" + :type 'hook) + +(defcustom org-capture-after-finalize-hook nil + "Hook that is run right after a capture process is finalized. +Suitable for window cleanup." + :group 'org-capture + :version "24.1" + :type 'hook) + +(defcustom org-capture-prepare-finalize-hook nil + "Hook that is run before the finalization starts. +The capture buffer is current and still narrowed." + :group 'org-capture + :version "24.1" + :type 'hook) + +(defcustom org-capture-bookmark t + "When non-nil, add a bookmark pointing at the last stored +position when capturing." + :group 'org-capture + :version "24.3" + :type 'boolean) + +;;; The property list for keeping information about the capture process + +(defvar org-capture-plist nil + "Plist for the current capture process, global, to avoid having to pass it.") + +(defvar org-capture-current-plist nil + "Local variable holding the plist in a capture buffer. +This is used to store the plist for use when finishing a capture process +because another such process might have changed the global variable by then. + +Each time a new capture buffer has been set up, the global `org-capture-plist' +is copied to this variable, which is local in the indirect buffer.") + +(defvar org-capture-clock-keep nil + "Local variable to store the value of the :clock-keep parameter. +This is needed in case org-capture-finalize is called interactively.") + +(defun org-capture-put (&rest stuff) + "Add properties to the capture property list `org-capture-plist'." + (while stuff + (setq org-capture-plist (plist-put org-capture-plist + (pop stuff) (pop stuff))))) +(defun org-capture-get (prop &optional local) + "Get properties from the capture property list `org-capture-plist'. +When LOCAL is set, use the local variable `org-capture-current-plist', +this is necessary after initialization of the capture process, +to avoid conflicts with other active capture processes." + (plist-get (if local org-capture-current-plist org-capture-plist) prop)) + +(defun org-capture-member (prop &optional local) + "Is PROP a property in `org-capture-plist'. +When LOCAL is set, use the local variable `org-capture-current-plist', +this is necessary after initialization of the capture process, +to avoid conflicts with other active capture processes." + (plist-get (if local org-capture-current-plist org-capture-plist) prop)) + +;;; The minor mode + +(defvar org-capture-mode-map (make-sparse-keymap) + "Keymap for `org-capture-mode', a minor mode. +Use this map to set additional keybindings for when Org-mode is used +for a capture buffer.") + +(defvar org-capture-mode-hook nil + "Hook for the minor `org-capture-mode'.") + +(define-minor-mode org-capture-mode + "Minor mode for special key bindings in a capture buffer. + +Turning on this mode runs the normal hook `org-capture-mode-hook'." + nil " Rem" org-capture-mode-map + (org-set-local + 'header-line-format + "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.")) +(define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize) +(define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill) +(define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile) + +;;; The main commands + +(defvar org-capture-initial nil) +(defvar org-capture-entry nil) + +;;;###autoload +(defun org-capture-string (string &optional keys) + "Capture STRING with the template selected by KEYS." + (interactive "sInitial text: \n") + (let ((org-capture-initial string) + (org-capture-entry (org-capture-select-template keys))) + (org-capture))) + +(defcustom org-capture-templates-contexts nil + "Alist of capture templates and valid contexts. + +For example, if you have a capture template \"c\" and you want +this template to be accessible only from `message-mode' buffers, +use this: + + '((\"c\" ((in-mode . \"message-mode\")))) + +Here are the available contexts definitions: + + in-file: command displayed only in matching files + in-mode: command displayed only in matching modes + not-in-file: command not displayed in matching files + not-in-mode: command not displayed in matching modes + in-buffer: command displayed only in matching buffers +not-in-buffer: command not displayed in matching buffers + [function]: a custom function taking no argument + +If you define several checks, the agenda command will be +accessible if there is at least one valid check. + +You can also bind a key to another agenda custom command +depending on contextual rules. + + '((\"c\" \"d\" ((in-mode . \"message-mode\")))) + +Here it means: in `message-mode buffers', use \"c\" as the +key for the capture template otherwise associated with \"d\". +\(The template originally associated with \"d\" is not displayed +to avoid duplicates.)" + :version "24.3" + :group 'org-capture + :type '(repeat (list :tag "Rule" + (string :tag " Capture key") + (string :tag "Replace by template") + (repeat :tag "Available when" + (choice + (cons :tag "Condition" + (choice + (const :tag "In file" in-file) + (const :tag "Not in file" not-in-file) + (const :tag "In buffer" in-buffer) + (const :tag "Not in buffer" not-in-buffer) + (const :tag "In mode" in-mode) + (const :tag "Not in mode" not-in-mode)) + (regexp)) + (function :tag "Custom function")))))) + +(defcustom org-capture-use-agenda-date nil + "Non-nil means use the date at point when capturing from agendas. +When nil, you can still capture using the date at point with \\[org-agenda-capture]." + :group 'org-capture + :version "24.3" + :type 'boolean) + +;;;###autoload +(defun org-capture (&optional goto keys) + "Capture something. +\\ +This will let you select a template from `org-capture-templates', and then +file the newly captured information. The text is immediately inserted +at the target location, and an indirect buffer is shown where you can +edit it. Pressing \\[org-capture-finalize] brings you back to the previous state +of Emacs, so that you can continue your work. + +When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture +anything, just go to the file/headline where the selected template +stores its notes. With a double prefix argument \ +\\[universal-argument] \\[universal-argument], go to the last note +stored. + +When called with a `C-0' (zero) prefix, insert a template at point. + +ELisp programs can set KEYS to a string associated with a template +in `org-capture-templates'. In this case, interactive selection +will be bypassed. + +If `org-capture-use-agenda-date' is non-nil, capturing from the +agenda will use the date at point as the default date. Then, a +`C-1' prefix will tell the capture process to use the HH:MM time +of the day at point (if any) or the current HH:MM time." + (interactive "P") + (when (and org-capture-use-agenda-date + (eq major-mode 'org-agenda-mode)) + (setq org-overriding-default-time + (org-get-cursor-date (equal goto 1)))) + (cond + ((equal goto '(4)) (org-capture-goto-target)) + ((equal goto '(16)) (org-capture-goto-last-stored)) + (t + ;; FIXME: Are these needed? + (let* ((orig-buf (current-buffer)) + (annotation (if (and (boundp 'org-capture-link-is-already-stored) + org-capture-link-is-already-stored) + (plist-get org-store-link-plist :annotation) + (ignore-errors (org-store-link nil)))) + (entry (or org-capture-entry (org-capture-select-template keys))) + initial) + (setq initial (or org-capture-initial + (and (org-region-active-p) + (buffer-substring (point) (mark))))) + (when (stringp initial) + (remove-text-properties 0 (length initial) '(read-only t) initial)) + (when (stringp annotation) + (remove-text-properties 0 (length annotation) + '(read-only t) annotation)) + (cond + ((equal entry "C") + (customize-variable 'org-capture-templates)) + ((equal entry "q") + (error "Abort")) + (t + (org-capture-set-plist entry) + (org-capture-get-template) + (org-capture-put :original-buffer orig-buf + :original-file (or (buffer-file-name orig-buf) + (and (featurep 'dired) + (car (rassq orig-buf + dired-buffers)))) + :original-file-nondirectory + (and (buffer-file-name orig-buf) + (file-name-nondirectory + (buffer-file-name orig-buf))) + :annotation annotation + :initial initial + :return-to-wconf (current-window-configuration) + :default-time + (or org-overriding-default-time + (org-current-time))) + (org-capture-set-target-location) + (condition-case error + (org-capture-put :template (org-capture-fill-template)) + ((error quit) + (if (get-buffer "*Capture*") (kill-buffer "*Capture*")) + (error "Capture abort: %s" error))) + + (setq org-capture-clock-keep (org-capture-get :clock-keep)) + (if (equal goto 0) + ;;insert at point + (org-capture-insert-template-here) + (condition-case error + (org-capture-place-template + (equal (car (org-capture-get :target)) 'function)) + ((error quit) + (if (and (buffer-base-buffer (current-buffer)) + (string-match "\\`CAPTURE-" (buffer-name))) + (kill-buffer (current-buffer))) + (set-window-configuration (org-capture-get :return-to-wconf)) + (error "Capture template `%s': %s" + (org-capture-get :key) + (nth 1 error)))) + (if (and (derived-mode-p 'org-mode) + (org-capture-get :clock-in)) + (condition-case nil + (progn + (if (org-clock-is-active) + (org-capture-put :interrupted-clock + (copy-marker org-clock-marker))) + (org-clock-in) + (org-set-local 'org-capture-clock-was-started t)) + (error + "Could not start the clock in this capture buffer"))) + (if (org-capture-get :immediate-finish) + (org-capture-finalize))))))))) + +(defun org-capture-get-template () + "Get the template from a file or a function if necessary." + (let ((txt (org-capture-get :template)) file) + (cond + ((and (listp txt) (eq (car txt) 'file)) + (if (file-exists-p + (setq file (expand-file-name (nth 1 txt) org-directory))) + (setq txt (org-file-contents file)) + (setq txt (format "* Template file %s not found" (nth 1 txt))))) + ((and (listp txt) (eq (car txt) 'function)) + (if (fboundp (nth 1 txt)) + (setq txt (funcall (nth 1 txt))) + (setq txt (format "* Template function %s not found" (nth 1 txt))))) + ((not txt) (setq txt "")) + ((stringp txt)) + (t (setq txt "* Invalid capture template"))) + (org-capture-put :template txt))) + +(defun org-capture-finalize (&optional stay-with-capture) + "Finalize the capture process. +With prefix argument STAY-WITH-CAPTURE, jump to the location of the +captured item after finalizing." + (interactive "P") + (when (org-capture-get :jump-to-captured) + (setq stay-with-capture t)) + (unless (and org-capture-mode + (buffer-base-buffer (current-buffer))) + (error "This does not seem to be a capture buffer for Org-mode")) + + (run-hooks 'org-capture-prepare-finalize-hook) + + ;; Did we start the clock in this capture buffer? + (when (and org-capture-clock-was-started + org-clock-marker (marker-buffer org-clock-marker) + (equal (marker-buffer org-clock-marker) (buffer-base-buffer)) + (> org-clock-marker (point-min)) + (< org-clock-marker (point-max))) + ;; Looks like the clock we started is still running. Clock out. + (when (not org-capture-clock-keep) (let (org-log-note-clock-out) (org-clock-out))) + (when (and (not org-capture-clock-keep) + (org-capture-get :clock-resume 'local) + (markerp (org-capture-get :interrupted-clock 'local)) + (buffer-live-p (marker-buffer + (org-capture-get :interrupted-clock 'local)))) + (let ((clock-in-task (org-capture-get :interrupted-clock 'local))) + (org-with-point-at clock-in-task + (org-clock-in))) + (message "Interrupted clock has been resumed"))) + + (let ((beg (point-min)) + (end (point-max)) + (abort-note nil)) + ;; Store the size of the capture buffer + (org-capture-put :captured-entry-size (- (point-max) (point-min))) + (widen) + ;; Store the insertion point in the target buffer + (org-capture-put :insertion-point (point)) + + (if org-note-abort + (let ((m1 (org-capture-get :begin-marker 'local)) + (m2 (org-capture-get :end-marker 'local))) + (if (and m1 m2 (= m1 beg) (= m2 end)) + (progn + (setq m2 (if (cdr (assoc 'heading org-blank-before-new-entry)) + m2 (1+ m2)) + m2 (if (< (point-max) m2) (point-max) m2)) + (setq abort-note 'clean) + (kill-region m1 m2)) + (setq abort-note 'dirty))) + + ;; Make sure that the empty lines after are correct + (when (and (> (point-max) end) ; indeed, the buffer was still narrowed + (member (org-capture-get :type 'local) + '(entry item checkitem plain))) + (save-excursion + (goto-char end) + (or (bolp) (newline)) + (org-capture-empty-lines-after + (or (org-capture-get :empty-lines-after 'local) + (org-capture-get :empty-lines 'local) 0)))) + ;; Postprocessing: Update Statistics cookies, do the sorting + (when (derived-mode-p 'org-mode) + (save-excursion + (when (ignore-errors (org-back-to-heading)) + (org-update-parent-todo-statistics) + (org-update-checkbox-count))) + ;; FIXME Here we should do the sorting + ;; If we have added a table line, maybe recompute? + (when (and (eq (org-capture-get :type 'local) 'table-line) + (org-at-table-p)) + (if (org-table-get-stored-formulas) + (org-table-recalculate 'all) ;; FIXME: Should we iterate??? + (org-table-align)))) + ;; Store this place as the last one where we stored something + ;; Do the marking in the base buffer, so that it makes sense after + ;; the indirect buffer has been killed. + (when org-capture-bookmark + (org-capture-bookmark-last-stored-position)) + + ;; Run the hook + (run-hooks 'org-capture-before-finalize-hook)) + + (when (org-capture-get :decrypted) + (save-excursion + (goto-char (org-capture-get :decrypted)) + (org-encrypt-entry))) + + ;; Kill the indirect buffer + (save-buffer) + (let ((return-wconf (org-capture-get :return-to-wconf 'local)) + (new-buffer (org-capture-get :new-buffer 'local)) + (kill-buffer (org-capture-get :kill-buffer 'local)) + (base-buffer (buffer-base-buffer (current-buffer)))) + + ;; Kill the indirect buffer + (kill-buffer (current-buffer)) + + ;; Narrow back the target buffer to its previous state + (with-current-buffer (org-capture-get :buffer) + (let ((reg (org-capture-get :initial-target-region)) + (pos (org-capture-get :initial-target-position)) + (ipt (org-capture-get :insertion-point)) + (size (org-capture-get :captured-entry-size))) + (if (not reg) + (widen) + (cond ((< ipt (car reg)) + ;; insertion point is before the narrowed region + (narrow-to-region (+ size (car reg)) (+ size (cdr reg)))) + ((> ipt (cdr reg)) + ;; insertion point is after the narrowed region + (narrow-to-region (car reg) (cdr reg))) + (t + ;; insertion point is within the narrowed region + (narrow-to-region (car reg) (+ size (cdr reg))))) + ;; now place back the point at its original position + (if (< ipt (car reg)) + (goto-char (+ size pos)) + (goto-char (if (< ipt pos) (+ size pos) pos)))))) + + ;; Kill the target buffer if that is desired + (when (and base-buffer new-buffer kill-buffer) + (with-current-buffer base-buffer (save-buffer)) + (kill-buffer base-buffer)) + + ;; Restore the window configuration before capture + (set-window-configuration return-wconf)) + + (run-hooks 'org-capture-after-finalize-hook) + ;; Special cases + (cond + (abort-note + (cond + ((equal abort-note 'clean) + (message "Capture process aborted and target buffer cleaned up")) + ((equal abort-note 'dirty) + (error "Capture process aborted, but target buffer could not be cleaned up correctly")))) + (stay-with-capture + (org-capture-goto-last-stored))) + ;; Return if we did store something + (not abort-note))) + +(defun org-capture-refile () + "Finalize the current capture and then refile the entry. +Refiling is done from the base buffer, because the indirect buffer is then +already gone. Any prefix argument will be passed to the refile command." + (interactive) + (unless (eq (org-capture-get :type 'local) 'entry) + (error + "Refiling from a capture buffer makes only sense for `entry'-type templates")) + (let ((pos (point)) + (base (buffer-base-buffer (current-buffer))) + (org-refile-for-capture t)) + (save-window-excursion + (with-current-buffer (or base (current-buffer)) + (save-excursion + (save-restriction + (widen) + (goto-char pos) + (call-interactively 'org-refile))))) + (org-capture-finalize))) + +(defun org-capture-kill () + "Abort the current capture process." + (interactive) + ;; FIXME: This does not do the right thing, we need to remove the + ;; new stuff by hand it is easy: undo, then kill the buffer + (let ((org-note-abort t) + (org-capture-before-finalize-hook nil)) + (org-capture-finalize))) + +(defun org-capture-goto-last-stored () + "Go to the location where the last capture note was stored." + (interactive) + (org-goto-marker-or-bmk org-capture-last-stored-marker + "org-capture-last-stored") + (message "This is the last note stored by a capture process")) + +;;; Supporting functions for handling the process + +(defun org-capture-put-target-region-and-position () + "Store the initial region with `org-capture-put'." + (org-capture-put + :initial-target-region + ;; Check if the buffer is currently narrowed + (when (/= (buffer-size) (- (point-max) (point-min))) + (cons (point-min) (point-max)))) + ;; store the current point + (org-capture-put :initial-target-position (point))) + +(defvar org-time-was-given) ; dynamically scoped parameter +(defun org-capture-set-target-location (&optional target) + "Find TARGET buffer and position. +Store them in the capture property list." + (let ((target-entry-p t) decrypted-hl-pos) + (setq target (or target (org-capture-get :target))) + (save-excursion + (cond + ((eq (car target) 'file) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (org-capture-put-target-region-and-position) + (widen) + (setq target-entry-p nil)) + + ((eq (car target) 'id) + (let ((loc (org-id-find (nth 1 target)))) + (if (not loc) + (error "Cannot find target ID \"%s\"" (nth 1 target)) + (set-buffer (org-capture-target-buffer (car loc))) + (widen) + (org-capture-put-target-region-and-position) + (goto-char (cdr loc))))) + + ((eq (car target) 'file+headline) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (org-capture-put-target-region-and-position) + (widen) + (let ((hd (nth 2 target))) + (goto-char (point-min)) + (unless (derived-mode-p 'org-mode) + (error + "Target buffer \"%s\" for file+headline should be in Org mode" + (current-buffer))) + (if (re-search-forward + (format org-complex-heading-regexp-format (regexp-quote hd)) + nil t) + (goto-char (point-at-bol)) + (goto-char (point-max)) + (or (bolp) (insert "\n")) + (insert "* " hd "\n") + (beginning-of-line 0)))) + + ((eq (car target) 'file+olp) + (let ((m (org-find-olp + (cons (org-capture-expand-file (nth 1 target)) + (cddr target))))) + (set-buffer (marker-buffer m)) + (org-capture-put-target-region-and-position) + (widen) + (goto-char m))) + + ((eq (car target) 'file+regexp) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (org-capture-put-target-region-and-position) + (widen) + (goto-char (point-min)) + (if (re-search-forward (nth 2 target) nil t) + (progn + (goto-char (if (org-capture-get :prepend) + (match-beginning 0) (match-end 0))) + (org-capture-put :exact-position (point)) + (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) + (error "No match for target regexp in file %s" (nth 1 target)))) + + ((memq (car target) '(file+datetree file+datetree+prompt)) + (require 'org-datetree) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (org-capture-put-target-region-and-position) + (widen) + ;; Make a date tree entry, with the current date (or yesterday, + ;; if we are extending dates for a couple of hours) + (org-datetree-find-date-create + (calendar-gregorian-from-absolute + (cond + (org-overriding-default-time + ;; use the overriding default time + (time-to-days org-overriding-default-time)) + + ((eq (car target) 'file+datetree+prompt) + ;; prompt for date + (let ((prompt-time (org-read-date + nil t nil "Date for tree entry:" + (current-time)))) + (org-capture-put + :default-time + (cond ((and (or (not (boundp 'org-time-was-given)) + (not org-time-was-given)) + (not (= (time-to-days prompt-time) (org-today)))) + ;; Use 00:00 when no time is given for another date than today? + (apply 'encode-time (append '(0 0 0) (cdddr (decode-time prompt-time))))) + ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" org-read-date-final-answer) + ;; Replace any time range by its start + (apply 'encode-time + (org-read-date-analyze + (replace-match "\\1 \\2" nil nil org-read-date-final-answer) + prompt-time (decode-time prompt-time)))) + (t prompt-time))) + (time-to-days prompt-time))) + (t + ;; current date, possibly corrected for late night workers + (org-today)))))) + + ((eq (car target) 'file+function) + (set-buffer (org-capture-target-buffer (nth 1 target))) + (org-capture-put-target-region-and-position) + (widen) + (funcall (nth 2 target)) + (org-capture-put :exact-position (point)) + (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) + + ((eq (car target) 'function) + (funcall (nth 1 target)) + (org-capture-put :exact-position (point)) + (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) + + ((eq (car target) 'clock) + (if (and (markerp org-clock-hd-marker) + (marker-buffer org-clock-hd-marker)) + (progn (set-buffer (marker-buffer org-clock-hd-marker)) + (org-capture-put-target-region-and-position) + (widen) + (goto-char org-clock-hd-marker)) + (error "No running clock that could be used as capture target"))) + + (t (error "Invalid capture target specification"))) + + (when (and (featurep 'org-crypt) (org-at-encrypted-entry-p)) + (org-decrypt-entry) + (setq decrypted-hl-pos + (save-excursion (and (org-back-to-heading t) (point))))) + + (org-capture-put :buffer (current-buffer) :pos (point) + :target-entry-p target-entry-p + :decrypted decrypted-hl-pos)))) + +(defun org-capture-expand-file (file) + "Expand functions and symbols for FILE. +When FILE is a function, call it. When it is a form, evaluate +it. When it is a variable, retrieve the value. Return whatever we get." + (cond + ((org-string-nw-p file) file) + ((functionp file) (funcall file)) + ((and (symbolp file) (boundp file)) (symbol-value file)) + ((and file (consp file)) (eval file)) + (t file))) + +(defun org-capture-target-buffer (file) + "Get a buffer for FILE." + (setq file (org-capture-expand-file file)) + (setq file (or (org-string-nw-p file) + org-default-notes-file + (error "No notes file specified, and no default available"))) + (or (org-find-base-buffer-visiting file) + (progn (org-capture-put :new-buffer t) + (find-file-noselect (expand-file-name file org-directory))))) + +(defun org-capture-steal-local-variables (buffer) + "Install Org-mode local variables of BUFFER." + (mapc (lambda (v) + (ignore-errors (org-set-local (car v) (cdr v)))) + (buffer-local-variables buffer))) + +(defun org-capture-place-template (&optional inhibit-wconf-store) + "Insert the template at the target location, and display the buffer. +When `inhibit-wconf-store', don't store the window configuration, as it +may have been stored before." + (unless inhibit-wconf-store + (org-capture-put :return-to-wconf (current-window-configuration))) + (delete-other-windows) + (org-switch-to-buffer-other-window + (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")) + (widen) + (show-all) + (goto-char (org-capture-get :pos)) + (org-set-local 'org-capture-target-marker + (point-marker)) + (org-set-local 'outline-level 'org-outline-level) + (let* ((template (org-capture-get :template)) + (type (org-capture-get :type))) + (case type + ((nil entry) (org-capture-place-entry)) + (table-line (org-capture-place-table-line)) + (plain (org-capture-place-plain-text)) + (item (org-capture-place-item)) + (checkitem (org-capture-place-item)))) + (org-capture-mode 1) + (org-set-local 'org-capture-current-plist org-capture-plist)) + +(defun org-capture-place-entry () + "Place the template as a new Org entry." + (let* ((txt (org-capture-get :template)) + (reversed (org-capture-get :prepend)) + (target-entry-p (org-capture-get :target-entry-p)) + level beg end file) + + (cond + ((org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) + ((not target-entry-p) + ;; Insert as top-level entry, either at beginning or at end of file + (setq level 1) + (if reversed + (progn (goto-char (point-min)) + (or (org-at-heading-p) + (outline-next-heading))) + (goto-char (point-max)) + (or (bolp) (insert "\n")))) + (t + ;; Insert as a child of the current entry + (and (looking-at "\\*+") + (setq level (- (match-end 0) (match-beginning 0)))) + (setq level (org-get-valid-level (or level 1) 1)) + (if reversed + (progn + (outline-next-heading) + (or (bolp) (insert "\n"))) + (org-end-of-subtree t nil) + (or (bolp) (insert "\n"))))) + (org-capture-empty-lines-before) + (setq beg (point)) + (org-capture-verify-tree txt) + (org-paste-subtree level txt 'for-yank) + (org-capture-empty-lines-after 1) + (org-capture-position-for-last-stored beg) + (outline-next-heading) + (setq end (point)) + (org-capture-mark-kill-region beg (1- end)) + (org-capture-narrow beg (1- end)) + (if (or (re-search-backward "%\\?" beg t) + (re-search-forward "%\\?" end t)) + (replace-match "")))) + +(defun org-capture-place-item () + "Place the template as a new plain list item." + (let* ((txt (org-capture-get :template)) + (target-entry-p (org-capture-get :target-entry-p)) + (ind 0) + beg end) + (if (org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position)) + (cond + ((not target-entry-p) + ;; Insert as top-level entry, either at beginning or at end of file + (setq beg (point-min) end (point-max))) + (t + (setq beg (1+ (point-at-eol)) + end (save-excursion (outline-next-heading) (point))))) + (if (org-capture-get :prepend) + (progn + (goto-char beg) + (if (org-list-search-forward (org-item-beginning-re) end t) + (progn + (goto-char (match-beginning 0)) + (setq ind (org-get-indentation))) + (goto-char end) + (setq ind 0))) + (goto-char end) + (if (org-list-search-backward (org-item-beginning-re) beg t) + (progn + (setq ind (org-get-indentation)) + (org-end-of-item)) + (setq ind 0)))) + ;; Remove common indentation + (setq txt (org-remove-indentation txt)) + ;; Make sure this is indeed an item + (unless (string-match (concat "\\`" (org-item-re)) txt) + (setq txt (concat "- " + (mapconcat 'identity (split-string txt "\n") + "\n ")))) + ;; Set the correct indentation, depending on context + (setq ind (make-string ind ?\ )) + (setq txt (concat ind + (mapconcat 'identity (split-string txt "\n") + (concat "\n" ind)) + "\n")) + ;; Insert, with surrounding empty lines + (org-capture-empty-lines-before) + (setq beg (point)) + (insert txt) + (or (bolp) (insert "\n")) + (org-capture-empty-lines-after 1) + (org-capture-position-for-last-stored beg) + (forward-char 1) + (setq end (point)) + (org-capture-mark-kill-region beg (1- end)) + (org-capture-narrow beg (1- end)) + (if (or (re-search-backward "%\\?" beg t) + (re-search-forward "%\\?" end t)) + (replace-match "")))) + +(defun org-capture-place-table-line () + "Place the template as a table line." + (require 'org-table) + (let* ((txt (org-capture-get :template)) + (target-entry-p (org-capture-get :target-entry-p)) + (table-line-pos (org-capture-get :table-line-pos)) + ind beg end) + (cond + ((org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) + ((not target-entry-p) + ;; Table is not necessarily under a heading + (setq beg (point-min) end (point-max))) + (t + ;; WE are at a heading, limit search to the body + (setq beg (1+ (point-at-eol)) + end (save-excursion (outline-next-heading) (point))))) + (if (re-search-forward org-table-dataline-regexp end t) + (let ((b (org-table-begin)) (e (org-table-end)) (case-fold-search t)) + (goto-char e) + (if (looking-at "[ \t]*#\\+tblfm:") + (forward-line 1)) + (narrow-to-region b (point))) + (goto-char end) + (insert "\n| |\n|----|\n| |\n") + (narrow-to-region (1+ end) (point))) + ;; We are narrowed to the table, or to an empty line if there was no table + + ;; Check if the template is good + (if (not (string-match org-table-dataline-regexp txt)) + (setq txt "| %?Bad template |\n")) + (cond + ((and table-line-pos + (string-match "\\(I+\\)\\([-+][0-9]\\)" table-line-pos)) + ;; we have a complex line specification + (goto-char (point-min)) + (let ((nh (- (match-end 1) (match-beginning 1))) + (delta (string-to-number (match-string 2 table-line-pos))) + ll) + ;; The user wants a special position in the table + (org-table-get-specials) + (setq ll (ignore-errors (aref org-table-hlines nh))) + (unless ll (error "Invalid table line specification \"%s\"" + table-line-pos)) + (setq ll (+ ll delta (if (< delta 0) 0 -1))) + (org-goto-line ll) + (org-table-insert-row 'below) + (beginning-of-line 1) + (delete-region (point) (1+ (point-at-eol))) + (setq beg (point)) + (insert txt) + (setq end (point)))) + ((org-capture-get :prepend) + (goto-char (point-min)) + (re-search-forward org-table-hline-regexp nil t) + (beginning-of-line 1) + (re-search-forward org-table-dataline-regexp nil t) + (beginning-of-line 1) + (setq beg (point)) + (org-table-insert-row) + (beginning-of-line 1) + (delete-region (point) (1+ (point-at-eol))) + (insert txt) + (setq end (point))) + (t + (goto-char (point-max)) + (re-search-backward org-table-dataline-regexp nil t) + (beginning-of-line 1) + (org-table-insert-row 'below) + (beginning-of-line 1) + (delete-region (point) (1+ (point-at-eol))) + (setq beg (point)) + (insert txt) + (setq end (point)))) + (goto-char beg) + (org-capture-position-for-last-stored 'table-line) + (if (or (re-search-backward "%\\?" beg t) + (re-search-forward "%\\?" end t)) + (replace-match "")) + (org-table-align))) + +(defun org-capture-place-plain-text () + "Place the template plainly. +If the target locator points at an Org node, place the template into +the text of the entry, before the first child. If not, place the +template at the beginning or end of the file. +Of course, if exact position has been required, just put it there." + (let* ((txt (org-capture-get :template)) + beg end) + (cond + ((org-capture-get :exact-position) + (goto-char (org-capture-get :exact-position))) + ((and (org-capture-get :target-entry-p) + (bolp) + (looking-at org-outline-regexp)) + ;; we should place the text into this entry + (if (org-capture-get :prepend) + ;; Skip meta data and drawers + (org-end-of-meta-data-and-drawers) + ;; go to ent of the entry text, before the next headline + (outline-next-heading))) + (t + ;; beginning or end of file + (goto-char (if (org-capture-get :prepend) (point-min) (point-max))))) + (or (bolp) (newline)) + (org-capture-empty-lines-before) + (setq beg (point)) + (insert txt) + (org-capture-empty-lines-after 1) + (org-capture-position-for-last-stored beg) + (setq end (point)) + (org-capture-mark-kill-region beg (1- end)) + (org-capture-narrow beg (1- end)) + (if (or (re-search-backward "%\\?" beg t) + (re-search-forward "%\\?" end t)) + (replace-match "")))) + +(defun org-capture-mark-kill-region (beg end) + "Mark the region that will have to be killed when aborting capture." + (let ((m1 (move-marker (make-marker) beg)) + (m2 (move-marker (make-marker) end))) + (org-capture-put :begin-marker m1) + (org-capture-put :end-marker m2))) + +(defun org-capture-position-for-last-stored (where) + "Memorize the position that should later become the position of last capture." + (cond + ((integerp where) + (org-capture-put :position-for-last-stored + (move-marker (make-marker) where + (or (buffer-base-buffer (current-buffer)) + (current-buffer))))) + ((eq where 'table-line) + (org-capture-put :position-for-last-stored + (list 'table-line + (org-table-current-dline)))) + (t (error "This should not happen")))) + +(defun org-capture-bookmark-last-stored-position () + "Bookmark the last-captured position." + (let* ((where (org-capture-get :position-for-last-stored 'local)) + (pos (cond + ((markerp where) + (prog1 (marker-position where) + (move-marker where nil))) + ((and (listp where) (eq (car where) 'table-line)) + (if (org-at-table-p) + (save-excursion + (org-table-goto-line (nth 1 where)) + (point-at-bol)) + (point)))))) + (with-current-buffer (buffer-base-buffer (current-buffer)) + (save-excursion + (save-restriction + (widen) + (goto-char pos) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-capture))) + (when bookmark-name + (with-demoted-errors + (bookmark-set bookmark-name)))) + (move-marker org-capture-last-stored-marker (point))))))) + +(defun org-capture-narrow (beg end) + "Narrow, unless configuration says not to narrow." + (unless (org-capture-get :unnarrowed) + (narrow-to-region beg end) + (goto-char beg))) + +(defun org-capture-empty-lines-before (&optional n) + "Set the correct number of empty lines before the insertion point. +Point will be after the empty lines, so insertion can directly be done." + (setq n (or n (org-capture-get :empty-lines-before) + (org-capture-get :empty-lines) 0)) + (let ((pos (point))) + (org-back-over-empty-lines) + (delete-region (point) pos) + (if (> n 0) (newline n)))) + +(defun org-capture-empty-lines-after (&optional n) + "Set the correct number of empty lines after the inserted string. +Point will remain at the first line after the inserted text." + (setq n (or n (org-capture-get :empty-lines-after) + (org-capture-get :empty-lines) 0)) + (org-back-over-empty-lines) + (while (looking-at "[ \t]*\n") (replace-match "")) + (let ((pos (point))) + (if (> n 0) (newline n)) + (goto-char pos))) + +(defvar org-clock-marker) ; Defined in org.el + +(defun org-capture-insert-template-here () + "Insert the capture template at point." + (let* ((template (org-capture-get :template)) + (type (org-capture-get :type)) + beg end pp) + (or (bolp) (newline)) + (setq beg (point)) + (cond + ((and (eq type 'entry) (derived-mode-p 'org-mode)) + (org-capture-verify-tree (org-capture-get :template)) + (org-paste-subtree nil template t)) + ((and (memq type '(item checkitem)) + (derived-mode-p 'org-mode) + (save-excursion (skip-chars-backward " \t\n") + (setq pp (point)) + (org-in-item-p))) + (goto-char pp) + (org-insert-item) + (skip-chars-backward " ") + (skip-chars-backward "-+*0123456789).") + (delete-region (point) (point-at-eol)) + (setq beg (point)) + (org-remove-indentation template) + (insert template) + (org-capture-empty-lines-after) + (goto-char beg) + (org-list-repair) + (org-end-of-item) + (setq end (point))) + (t (insert template))) + (setq end (point)) + (goto-char beg) + (if (re-search-forward "%\\?" end t) + (replace-match "")))) + +(defun org-capture-set-plist (entry) + "Initialize the property list from the template definition." + (setq org-capture-plist (copy-sequence (nthcdr 5 entry))) + (org-capture-put :key (car entry) :description (nth 1 entry) + :target (nth 3 entry)) + (let ((txt (nth 4 entry)) (type (or (nth 2 entry) 'entry))) + (when (or (not txt) (and (stringp txt) (not (string-match "\\S-" txt)))) + ;; The template may be empty or omitted for special types. + ;; Here we insert the default templates for such cases. + (cond + ((eq type 'item) (setq txt "- %?")) + ((eq type 'checkitem) (setq txt "- [ ] %?")) + ((eq type 'table-line) (setq txt "| %? |")) + ((member type '(nil entry)) (setq txt "* %?\n %a")))) + (org-capture-put :template txt :type type))) + +(defun org-capture-goto-target (&optional template-key) + "Go to the target location of a capture template. +The user is queried for the template." + (interactive) + (let* (org-select-template-temp-major-mode + (entry (org-capture-select-template template-key))) + (unless entry + (error "No capture template selected")) + (org-capture-set-plist entry) + (org-capture-set-target-location) + (org-pop-to-buffer-same-window (org-capture-get :buffer)) + (goto-char (org-capture-get :pos)))) + +(defun org-capture-get-indirect-buffer (&optional buffer prefix) + "Make an indirect buffer for a capture process. +Use PREFIX as a prefix for the name of the indirect buffer." + (setq buffer (or buffer (current-buffer))) + (let ((n 1) (base (buffer-name buffer)) bname) + (setq bname (concat prefix "-" base)) + (while (buffer-live-p (get-buffer bname)) + (setq bname (concat prefix "-" (number-to-string (incf n)) "-" base))) + (condition-case nil + (make-indirect-buffer buffer bname 'clone) + (error + (let ((buf (make-indirect-buffer buffer bname))) + (with-current-buffer buf (org-mode)) + buf))))) + +(defun org-capture-verify-tree (tree) + "Throw error if TREE is not a valid tree." + (unless (org-kill-is-subtree-p tree) + (error "Template is not a valid Org entry or tree"))) + +(defun org-mks (table title &optional prompt specials) + "Select a member of an alist with multiple keys. +TABLE is the alist which should contain entries where the car is a string. +There should be two types of entries. + +1. prefix descriptions like (\"a\" \"Description\") + This indicates that `a' is a prefix key for multi-letter selection, and + that there are entries following with keys like \"ab\", \"ax\"... + +2. Selectable members must have more than two elements, with the first + being the string of keys that lead to selecting it, and the second a + short description string of the item. + +The command will then make a temporary buffer listing all entries +that can be selected with a single key, and all the single key +prefixes. When you press the key for a single-letter entry, it is selected. +When you press a prefix key, the commands (and maybe further prefixes) +under this key will be shown and offered for selection. + +TITLE will be placed over the selection in the temporary buffer, +PROMPT will be used when prompting for a key. SPECIAL is an alist with +also (\"key\" \"description\") entries. When one of these is selection, +only the bare key is returned." + (setq prompt (or prompt "Select: ")) + (let (tbl orig-table dkey ddesc des-keys allowed-keys + current prefix rtn re pressed buffer (inhibit-quit t)) + (save-window-excursion + (setq buffer (org-switch-to-buffer-other-window "*Org Select*")) + (setq orig-table table) + (catch 'exit + (while t + (erase-buffer) + (insert title "\n\n") + (setq tbl table + des-keys nil + allowed-keys nil + cursor-type nil) + (setq prefix (if current (concat current " ") "")) + (while tbl + (cond + ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1)) + ;; This is a description on this level + (setq dkey (caar tbl) ddesc (cadar tbl)) + (pop tbl) + (push dkey des-keys) + (push dkey allowed-keys) + (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n") + ;; Skip keys which are below this prefix + (setq re (concat "\\`" (regexp-quote dkey))) + (let (case-fold-search) + (while (and tbl (string-match re (caar tbl))) (pop tbl)))) + ((= 2 (length (car tbl))) + ;; Not yet a usable description, skip it + ) + (t + ;; usable entry on this level + (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n") + (push (caar tbl) allowed-keys) + (pop tbl)))) + (when specials + (insert "-------------------------------------------------------------------------------\n") + (let ((sp specials)) + (while sp + (insert (format "[%s] %s\n" + (caar sp) (nth 1 (car sp)))) + (push (caar sp) allowed-keys) + (pop sp)))) + (push "\C-g" allowed-keys) + (goto-char (point-min)) + (if (not (pos-visible-in-window-p (point-max))) + (org-fit-window-to-buffer)) + (message prompt) + (setq pressed (char-to-string (read-char-exclusive))) + (while (not (member pressed allowed-keys)) + (message "Invalid key `%s'" pressed) (sit-for 1) + (message prompt) + (setq pressed (char-to-string (read-char-exclusive)))) + (when (equal pressed "\C-g") + (kill-buffer buffer) + (error "Abort")) + (when (and (not (assoc pressed table)) + (not (member pressed des-keys)) + (assoc pressed specials)) + (throw 'exit (setq rtn pressed))) + (unless (member pressed des-keys) + (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table)) + orig-table)))) + (setq current (concat current pressed)) + (setq table (mapcar + (lambda (x) + (if (and (> (length (car x)) 1) + (equal (substring (car x) 0 1) pressed)) + (cons (substring (car x) 1) (cdr x)) + nil)) + table)) + (setq table (remove nil table))))) + (when buffer (kill-buffer buffer)) + rtn)) + +;;; The template code +(defun org-capture-select-template (&optional keys) + "Select a capture template. +Lisp programs can force the template by setting KEYS to a string." + (let ((org-capture-templates + (or (org-contextualize-keys + org-capture-templates org-capture-templates-contexts) + '(("t" "Task" entry (file+headline "" "Tasks") + "* TODO %?\n %u\n %a"))))) + (if keys + (or (assoc keys org-capture-templates) + (error "No capture template referred to by \"%s\" keys" keys)) + (org-mks org-capture-templates + "Select a capture template\n=========================" + "Template key: " + '(("C" "Customize org-capture-templates") + ("q" "Abort")))))) + +(defun org-capture-fill-template (&optional template initial annotation) + "Fill a template and return the filled template as a string. +The template may still contain \"%?\" for cursor positioning." + (setq template (or template (org-capture-get :template))) + (when (stringp initial) + (setq initial (org-no-properties initial))) + (let* ((buffer (org-capture-get :buffer)) + (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) + (ct (org-capture-get :default-time)) + (dct (decode-time ct)) + (ct1 + (if (< (nth 2 dct) org-extend-today-until) + (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) + ct)) + (plist-p (if org-store-link-plist t nil)) + (v-c (and (> (length kill-ring) 0) (current-kill 0))) + (v-x (or (org-get-x-clipboard 'PRIMARY) + (org-get-x-clipboard 'CLIPBOARD) + (org-get-x-clipboard 'SECONDARY))) + (v-t (format-time-string (car org-time-stamp-formats) ct1)) + (v-T (format-time-string (cdr org-time-stamp-formats) ct1)) + (v-u (concat "[" (substring v-t 1 -1) "]")) + (v-U (concat "[" (substring v-T 1 -1) "]")) + ;; `initial' and `annotation' might habe been passed. + ;; But if the property list has them, we prefer those values + (v-i (or (plist-get org-store-link-plist :initial) + initial + (org-capture-get :initial) + "")) + (v-a (or (plist-get org-store-link-plist :annotation) + annotation + (org-capture-get :annotation) + "")) + ;; Is the link empty? Then we do not want it... + (v-a (if (equal v-a "[[]]") "" v-a)) + (clipboards (remove nil (list v-i + (org-get-x-clipboard 'PRIMARY) + (org-get-x-clipboard 'CLIPBOARD) + (org-get-x-clipboard 'SECONDARY) + v-c))) + (l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]") + (v-A (if (and v-a (string-match l-re v-a)) + (replace-match "[[\\1][%^{Link description}]]" nil nil v-a) + v-a)) + (v-l (if (and v-a (string-match l-re v-a)) + (replace-match "\\1" nil nil v-a) + v-a)) + (v-n user-full-name) + (v-k (if (marker-buffer org-clock-marker) + (org-no-properties org-clock-heading))) + (v-K (if (marker-buffer org-clock-marker) + (org-make-link-string + (buffer-file-name (marker-buffer org-clock-marker)) + org-clock-heading))) + (v-f (or (org-capture-get :original-file-nondirectory) "")) + (v-F (or (org-capture-get :original-file) "")) + v-I + (org-startup-folded nil) + (org-inhibit-startup t) + org-time-was-given org-end-time-was-given x + prompt completions char time pos default histvar strings) + + (setq org-store-link-plist + (plist-put org-store-link-plist :annotation v-a) + org-store-link-plist + (plist-put org-store-link-plist :initial v-i)) + (setq initial v-i) + + (unless template (setq template "") (message "No template") (ding) + (sit-for 1)) + (save-window-excursion + (delete-other-windows) + (org-pop-to-buffer-same-window (get-buffer-create "*Capture*")) + (erase-buffer) + (insert template) + (goto-char (point-min)) + (org-capture-steal-local-variables buffer) + (setq buffer-file-name nil mark-active nil) + + ;; %[] Insert contents of a file. + (goto-char (point-min)) + (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) + (unless (org-capture-escaped-%) + (let ((start (match-beginning 0)) + (end (match-end 0)) + (filename (expand-file-name (match-string 1)))) + (goto-char start) + (delete-region start end) + (condition-case error + (insert-file-contents filename) + (error (insert (format "%%![Couldn't insert %s: %s]" + filename error))))))) + + ;; The current time + (goto-char (point-min)) + (while (re-search-forward "%<\\([^>\n]+\\)>" nil t) + (replace-match (format-time-string (match-string 1)) t t)) + + ;; Simple %-escapes + (goto-char (point-min)) + (while (re-search-forward "%\\([tTuUaliAcxkKInfF]\\)" nil t) + (unless (org-capture-escaped-%) + (when (and initial (equal (match-string 0) "%i")) + (save-match-data + (let* ((lead (buffer-substring + (point-at-bol) (match-beginning 0)))) + (setq v-i (mapconcat 'identity + (org-split-string initial "\n") + (concat "\n" lead)))))) + (replace-match (or (eval (intern (concat "v-" (match-string 1)))) "") + t t))) + + ;; From the property list + (when plist-p + (goto-char (point-min)) + (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) + (unless (org-capture-escaped-%) + (and (setq x (or (plist-get org-store-link-plist + (intern (match-string 1))) "")) + (replace-match x t t))))) + + ;; %() embedded elisp + (goto-char (point-min)) + (org-capture-expand-embedded-elisp) + + ;; Turn on org-mode in temp buffer, set local variables + ;; This is to support completion in interactive prompts + (let ((org-inhibit-startup t)) (org-mode)) + ;; Interactive template entries + (goto-char (point-min)) + (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) + (unless (org-capture-escaped-%) + (setq char (if (match-end 3) (match-string-no-properties 3)) + prompt (if (match-end 2) (match-string-no-properties 2))) + (goto-char (match-beginning 0)) + (replace-match "") + (setq completions nil default nil) + (when prompt + (setq completions (org-split-string prompt "|") + prompt (pop completions) + default (car completions) + histvar (intern (concat + "org-capture-template-prompt-history::" + (or prompt ""))) + completions (mapcar 'list completions))) + (unless (boundp histvar) (set histvar nil)) + (cond + ((member char '("G" "g")) + (let* ((org-last-tags-completion-table + (org-global-tags-completion-table + (if (equal char "G") + (org-agenda-files) + (and file (list file))))) + (org-add-colon-after-tag-completion t) + (ins (org-icompleting-read + (if prompt (concat prompt ": ") "Tags: ") + 'org-tags-completion-function nil nil nil + 'org-tags-history))) + (setq ins (mapconcat 'identity + (org-split-string + ins (org-re "[^[:alnum:]_@#%]+")) + ":")) + (when (string-match "\\S-" ins) + (or (equal (char-before) ?:) (insert ":")) + (insert ins) + (or (equal (char-after) ?:) (insert ":")) + (and (org-at-heading-p) + (let ((org-ignore-region t)) + (org-set-tags nil 'align)))))) + ((equal char "C") + (cond ((= (length clipboards) 1) (insert (car clipboards))) + ((> (length clipboards) 1) + (insert (read-string "Clipboard/kill value: " + (car clipboards) '(clipboards . 1) + (car clipboards)))))) + ((equal char "L") + (cond ((= (length clipboards) 1) + (org-insert-link 0 (car clipboards))) + ((> (length clipboards) 1) + (org-insert-link 0 (read-string "Clipboard/kill value: " + (car clipboards) + '(clipboards . 1) + (car clipboards)))))) + ((equal char "p") + (org-set-property (org-no-properties prompt) nil)) + (char + ;; These are the date/time related ones + (setq org-time-was-given (equal (upcase char) char)) + (setq time (org-read-date (equal (upcase char) char) t nil + prompt)) + (if (equal (upcase char) char) (setq org-time-was-given t)) + (org-insert-time-stamp time org-time-was-given + (member char '("u" "U")) + nil nil (list org-end-time-was-given))) + (t + (let (org-completion-use-ido) + (push (org-completing-read-no-i + (concat (if prompt prompt "Enter string") + (if default (concat " [" default "]")) + ": ") + completions nil nil nil histvar default) + strings) + (insert (car strings))))))) + ;; Replace %n escapes with nth %^{...} string + (setq strings (nreverse strings)) + (goto-char (point-min)) + (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t) + (unless (org-capture-escaped-%) + (replace-match + (nth (1- (string-to-number (match-string 1))) strings) + nil t))) + ;; Make sure there are no empty lines before the text, and that + ;; it ends with a newline character + (goto-char (point-min)) + (while (looking-at "[ \t]*\n") (replace-match "")) + (if (re-search-forward "[ \t\n]*\\'" nil t) (replace-match "\n")) + ;; Return the expanded template and kill the temporary buffer + (untabify (point-min) (point-max)) + (set-buffer-modified-p nil) + (prog1 (buffer-string) (kill-buffer (current-buffer)))))) + +(defun org-capture-escaped-% () + "Check if % was escaped - if yes, unescape it now." + (if (equal (char-before (match-beginning 0)) ?\\) + (progn + (delete-region (1- (match-beginning 0)) (match-beginning 0)) + t) + nil)) + +(defun org-capture-expand-embedded-elisp () + "Evaluate embedded elisp %(sexp) and replace with the result." + (goto-char (point-min)) + (while (re-search-forward "%(" nil t) + (unless (org-capture-escaped-%) + (goto-char (match-beginning 0)) + (let ((template-start (point))) + (forward-char 1) + (let* ((sexp (read (current-buffer))) + (result (org-eval + (org-capture--expand-keyword-in-embedded-elisp sexp)))) + (delete-region template-start (point)) + (when result + (if (stringp result) + (insert result) + (error "Capture template sexp `%s' must evaluate to string or nil" + sexp)))))))) + +(defun org-capture--expand-keyword-in-embedded-elisp (attr) + "Recursively replace capture link keywords in ATTR sexp. +Such keywords are prefixed with \"%:\". See +`org-capture-template' for more information." + (cond ((consp attr) + (mapcar 'org-capture--expand-keyword-in-embedded-elisp attr)) + ((symbolp attr) + (let* ((attr-symbol (symbol-name attr)) + (key (and (string-match "%\\(:.*\\)" attr-symbol) + (intern (match-string 1 attr-symbol))))) + (or (plist-get org-store-link-plist key) + attr))) + (t attr))) + +(defun org-capture-inside-embedded-elisp-p () + "Return non-nil if point is inside of embedded elisp %(sexp)." + (let (beg end) + (with-syntax-table emacs-lisp-mode-syntax-table + (save-excursion + ;; `looking-at' and `search-backward' below do not match the "%(" if + ;; point is in its middle + (when (equal (char-before) ?%) + (backward-char)) + (save-match-data + (when (or (looking-at "%(") (search-backward "%(" nil t)) + (setq beg (point)) + (setq end (progn (forward-char) (forward-sexp) (1- (point))))))) + (when (and beg end) + (and (<= (point) end) (>= (point) beg)))))) + +;;;###autoload +(defun org-capture-import-remember-templates () + "Set `org-capture-templates' to be similar to `org-remember-templates'." + (interactive) + (when (and (yes-or-no-p + "Import old remember templates into org-capture-templates? ") + (yes-or-no-p + "Note that this will remove any templates currently defined in `org-capture-templates'. Do you still want to go ahead? ")) + (require 'org-remember) + (setq org-capture-templates + (mapcar + (lambda (entry) + (let ((desc (car entry)) + (key (char-to-string (nth 1 entry))) + (template (nth 2 entry)) + (file (or (nth 3 entry) org-default-notes-file)) + (position (or (nth 4 entry) org-remember-default-headline)) + (type 'entry) + (prepend org-reverse-note-order) + immediate target jump-to-captured) + (cond + ((member position '(top bottom)) + (setq target (list 'file file) + prepend (eq position 'top))) + ((eq position 'date-tree) + (setq target (list 'file+datetree file) + prepend nil)) + (t (setq target (list 'file+headline file position)))) + + (when (string-match "%!" template) + (setq template (replace-match "" t t template) + immediate t)) + + (when (string-match "%&" template) + (setq jump-to-captured t)) + + (append (list key desc type target template) + (if prepend '(:prepend t)) + (if immediate '(:immediate-finish t)) + (if jump-to-captured '(:jump-to-captured t))))) + + org-remember-templates)))) + +(provide 'org-capture) + +;;; org-capture.el ends here diff --git a/elpa/org-20150427/org-clock.el b/elpa/org-20150427/org-clock.el new file mode 100644 index 00000000..319c1c47 --- /dev/null +++ b/elpa/org-20150427/org-clock.el @@ -0,0 +1,2900 @@ +;;; org-clock.el --- The time clocking code for Org-mode + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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 . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains the time clocking code for Org-mode + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'org) + +(declare-function calendar-iso-to-absolute "cal-iso" (&optional date)) +(declare-function notifications-notify "notifications" (&rest params)) +(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) +(declare-function org-refresh-properties "org" (dprop tprop)) +(defvar org-time-stamp-formats) +(defvar org-ts-what) +(defvar org-frame-title-format-backup frame-title-format) + +(defgroup org-clock nil + "Options concerning clocking working time in Org-mode." + :tag "Org Clock" + :group 'org-progress) + +(defcustom org-clock-into-drawer org-log-into-drawer + "Should clocking info be wrapped into a drawer? +When t, clocking info will always be inserted into a :LOGBOOK: drawer. +If necessary, the drawer will be created. +When nil, the drawer will not be created, but used when present. +When an integer and the number of clocking entries in an item +reaches or exceeds this number, a drawer will be created. +When a string, it names the drawer to be used. + +The default for this variable is the value of `org-log-into-drawer', +which see." + :group 'org-todo + :group 'org-clock + :type '(choice + (const :tag "Always" t) + (const :tag "Only when drawer exists" nil) + (integer :tag "When at least N clock entries") + (const :tag "Into LOGBOOK drawer" "LOGBOOK") + (string :tag "Into Drawer named..."))) + +(defun org-clock-into-drawer () + "Return the value of `org-clock-into-drawer', but let properties overrule. +If the current entry has or inherits a CLOCK_INTO_DRAWER +property, it will be used instead of the default value; otherwise +if the current entry has or inherits a LOG_INTO_DRAWER property, +it will be used instead of the default value. +The default is the value of the customizable variable `org-clock-into-drawer', +which see." + (let ((p (org-entry-get nil "CLOCK_INTO_DRAWER" 'inherit)) + (q (org-entry-get nil "LOG_INTO_DRAWER" 'inherit))) + (cond + ((or (not (or p q)) (equal p "nil") (equal q "nil")) org-clock-into-drawer) + ((or (equal p "t") (equal q "t")) "LOGBOOK") + ((not p) q) + (t p)))) + +(defcustom org-clock-out-when-done t + "When non-nil, clock will be stopped when the clocked entry is marked DONE. +DONE here means any DONE-like state. +A nil value means clock will keep running until stopped explicitly with +`C-c C-x C-o', or until the clock is started in a different item. +Instead of t, this can also be a list of TODO states that should trigger +clocking out." + :group 'org-clock + :type '(choice + (const :tag "No" nil) + (const :tag "Yes, when done" t) + (repeat :tag "State list" + (string :tag "TODO keyword")))) + +(defcustom org-clock-rounding-minutes 0 + "Rounding minutes when clocking in or out. +The default value is 0 so that no rounding is done. +When set to a non-integer value, use the car of +`org-time-stamp-rounding-minutes', like for setting a time-stamp. + +E.g. if `org-clock-rounding-minutes' is set to 5, time is 14:47 +and you clock in: then the clock starts at 14:45. If you clock +out within the next 5 minutes, the clock line will be removed; +if you clock out 8 minutes after your clocked in, the clock +out time will be 14:50." + :group 'org-clock + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (integer :tag "Minutes (0 for no rounding)") + (symbol :tag "Use `org-time-stamp-rounding-minutes'" 'same-as-time-stamp))) + +(defcustom org-clock-out-remove-zero-time-clocks nil + "Non-nil means remove the clock line when the resulting time is zero." + :group 'org-clock + :type 'boolean) + +(defcustom org-clock-in-switch-to-state nil + "Set task to a special todo state while clocking it. +The value should be the state to which the entry should be +switched. If the value is a function, it must take one +parameter (the current TODO state of the item) and return the +state to switch it to." + :group 'org-clock + :group 'org-todo + :type '(choice + (const :tag "Don't force a state" nil) + (string :tag "State") + (symbol :tag "Function"))) + +(defcustom org-clock-out-switch-to-state nil + "Set task to a special todo state after clocking out. +The value should be the state to which the entry should be +switched. If the value is a function, it must take one +parameter (the current TODO state of the item) and return the +state to switch it to." + :group 'org-clock + :group 'org-todo + :type '(choice + (const :tag "Don't force a state" nil) + (string :tag "State") + (symbol :tag "Function"))) + +(defcustom org-clock-history-length 5 + "Number of clock tasks to remember in history." + :group 'org-clock + :type 'integer) + +(defcustom org-clock-goto-may-find-recent-task t + "Non-nil means `org-clock-goto' can go to recent task if no active clock." + :group 'org-clock + :type 'boolean) + +(defcustom org-clock-heading-function nil + "When non-nil, should be a function to create `org-clock-heading'. +This is the string shown in the mode line when a clock is running. +The function is called with point at the beginning of the headline." + :group 'org-clock + :type '(choice (const nil) (function))) + +(defcustom org-clock-string-limit 0 + "Maximum length of clock strings in the mode line. 0 means no limit." + :group 'org-clock + :type 'integer) + +(defcustom org-clock-in-resume nil + "If non-nil, resume clock when clocking into task with open clock. +When clocking into a task with a clock entry which has not been closed, +the clock can be resumed from that point." + :group 'org-clock + :type 'boolean) + +(defcustom org-clock-persist nil + "When non-nil, save the running clock when Emacs is closed. +The clock is resumed when Emacs restarts. +When this is t, both the running clock, and the entire clock +history are saved. When this is the symbol `clock', only the +running clock is saved. When this is the symbol `history', only +the clock history is saved. + +When Emacs restarts with saved clock information, the file containing +the running clock as well as all files mentioned in the clock history +will be visited. + +All this depends on running `org-clock-persistence-insinuate' in your +Emacs initialization file." + :group 'org-clock + :type '(choice + (const :tag "Just the running clock" clock) + (const :tag "Just the history" history) + (const :tag "Clock and history" t) + (const :tag "No persistence" nil))) + +(defcustom org-clock-persist-file (convert-standard-filename + (concat user-emacs-directory "org-clock-save.el")) + "File to save clock data to." + :group 'org-clock + :type 'string) + +(defcustom org-clock-persist-query-save nil + "When non-nil, ask before saving the current clock on exit." + :group 'org-clock + :type 'boolean) + +(defcustom org-clock-persist-query-resume t + "When non-nil, ask before resuming any stored clock during load." + :group 'org-clock + :type 'boolean) + +(defcustom org-clock-sound nil + "Sound to use for notifications. +Possible values are: + +nil No sound played +t Standard Emacs beep +file name Play this sound file, fall back to beep" + :group 'org-clock + :type '(choice + (const :tag "No sound" nil) + (const :tag "Standard beep" t) + (file :tag "Play sound file"))) + +(define-obsolete-variable-alias 'org-clock-modeline-total + 'org-clock-mode-line-total "24.3") + +(defcustom org-clock-mode-line-total 'auto + "Default setting for the time included for the mode line clock. +This can be overruled locally using the CLOCK_MODELINE_TOTAL property. +Allowed values are: + +current Only the time in the current instance of the clock +today All time clocked into this task today +repeat All time clocked into this task since last repeat +all All time ever recorded for this task +auto Automatically, either `all', or `repeat' for repeating tasks" + :group 'org-clock + :type '(choice + (const :tag "Current clock" current) + (const :tag "Today's task time" today) + (const :tag "Since last repeat" repeat) + (const :tag "All task time" all) + (const :tag "Automatically, `all' or since `repeat'" auto))) + +(org-defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text) +(defcustom org-clock-task-overrun-text nil + "Extra mode line text to indicate that the clock is overrun. +The can be nil to indicate that instead of adding text, the clock time +should get a different face (`org-mode-line-clock-overrun'). +When this is a string, it is prepended to the clock string as an indication, +also using the face `org-mode-line-clock-overrun'." + :group 'org-clock + :version "24.1" + :type '(choice + (const :tag "Just mark the time string" nil) + (string :tag "Text to prepend"))) + +(defcustom org-show-notification-handler nil + "Function or program to send notification with. +The function or program will be called with the notification +string as argument." + :group 'org-clock + :type '(choice + (const nil) + (string :tag "Program") + (function :tag "Function"))) + +(defgroup org-clocktable nil + "Options concerning the clock table in Org-mode." + :tag "Org Clock Table" + :group 'org-clock) + +(defcustom org-clocktable-defaults + (list + :maxlevel 2 + :lang (or (org-bound-and-true-p org-export-default-language) "en") + :scope 'file + :block nil + :wstart 1 + :mstart 1 + :tstart nil + :tend nil + :step nil + :stepskip0 nil + :fileskip0 nil + :tags nil + :emphasize nil + :link nil + :narrow '40! + :indent t + :formula nil + :timestamp nil + :level nil + :tcolumns nil + :formatter nil) + "Default properties for clock tables." + :group 'org-clock + :version "24.1" + :type 'plist) + +(defcustom org-clock-clocktable-formatter 'org-clocktable-write-default + "Function to turn clocking data into a table. +For more information, see `org-clocktable-write-default'." + :group 'org-clocktable + :version "24.1" + :type 'function) + +;; FIXME: translate es and nl last string "Clock summary at" +(defcustom org-clock-clocktable-language-setup + '(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at") + ("es" "Archivo" "N" "Fecha y hora" "Tarea" "Tiempo" "TODO" "Tiempo total" "Tiempo archivo" "Clock summary at") + ("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à") + ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at")) + "Terms used in clocktable, translated to different languages." + :group 'org-clocktable + :version "24.1" + :type 'alist) + +(defcustom org-clock-clocktable-default-properties '(:maxlevel 2 :scope file) + "Default properties for new clocktables. +These will be inserted into the BEGIN line, to make it easy for users to +play with them." + :group 'org-clocktable + :type 'plist) + +(defcustom org-clock-idle-time nil + "When non-nil, resolve open clocks if the user is idle more than X minutes." + :group 'org-clock + :type '(choice + (const :tag "Never" nil) + (integer :tag "After N minutes"))) + +(defcustom org-clock-auto-clock-resolution 'when-no-clock-is-running + "When to automatically resolve open clocks found in Org buffers." + :group 'org-clock + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "When no clock is running" when-no-clock-is-running))) + +(defcustom org-clock-report-include-clocking-task nil + "When non-nil, include the current clocking task time in clock reports." + :group 'org-clock + :version "24.1" + :type 'boolean) + +(defcustom org-clock-resolve-expert nil + "Non-nil means do not show the splash buffer with the clock resolver." + :group 'org-clock + :version "24.1" + :type 'boolean) + +(defcustom org-clock-continuously nil + "Non-nil means to start clocking from the last clock-out time, if any." + :type 'boolean + :version "24.1" + :group 'org-clock) + +(defcustom org-clock-total-time-cell-format "*%s*" + "Format string for the total time cells." + :group 'org-clock + :version "24.1" + :type 'string) + +(defcustom org-clock-file-time-cell-format "*%s*" + "Format string for the file time cells." + :group 'org-clock + :version "24.1" + :type 'string) + +(defcustom org-clock-clocked-in-display 'mode-line + "When clocked in for a task, org-mode can display the current +task and accumulated time in the mode line and/or frame title. +Allowed values are: + +both displays in both mode line and frame title +mode-line displays only in mode line (default) +frame-title displays only in frame title +nil current clock is not displayed" + :group 'org-clock + :type '(choice + (const :tag "Mode line" mode-line) + (const :tag "Frame title" frame-title) + (const :tag "Both" both) + (const :tag "None" nil))) + +(defcustom org-clock-frame-title-format '(t org-mode-line-string) + "The value for `frame-title-format' when clocking in. + +When `org-clock-clocked-in-display' is set to 'frame-title +or 'both, clocking in will replace `frame-title-format' with +this value. Clocking out will restore `frame-title-format'. + +`org-frame-title-string' is a format string using the same +specifications than `frame-title-format', which see." + :version "24.1" + :group 'org-clock + :type 'sexp) + +(defcustom org-clock-x11idle-program-name "x11idle" + "Name of the program which prints X11 idle time in milliseconds. + +You can find x11idle.c in the contrib/scripts directory of the +Org git distribution. Or, you can do: + + sudo apt-get install xprintidle + +if you are using Debian." + :group 'org-clock + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defvar org-clock-in-prepare-hook nil + "Hook run when preparing the clock. +This hook is run before anything happens to the task that +you want to clock in. For example, you can use this hook +to add an effort property.") +(defvar org-clock-in-hook nil + "Hook run when starting the clock.") +(defvar org-clock-out-hook nil + "Hook run when stopping the current clock.") + +(defvar org-clock-cancel-hook nil + "Hook run when canceling the current clock.") +(defvar org-clock-goto-hook nil + "Hook run when selecting the currently clocked-in entry.") +(defvar org-clock-has-been-used nil + "Has the clock been used during the current Emacs session?") + +;;; The clock for measuring work time. + +(defvar org-mode-line-string "") +(put 'org-mode-line-string 'risky-local-variable t) + +(defvar org-clock-mode-line-timer nil) +(defvar org-clock-idle-timer nil) +(defvar org-clock-heading) ; defined in org.el +(defvar org-clock-start-time "") + +(defvar org-clock-leftover-time nil + "If non-nil, user canceled a clock; this is when leftover time started.") + +(defvar org-clock-effort "" + "Effort estimate of the currently clocking task.") + +(defvar org-clock-total-time nil + "Holds total time, spent previously on currently clocked item. +This does not include the time in the currently running clock.") + +(defvar org-clock-history nil + "List of marker pointing to recent clocked tasks.") + +(defvar org-clock-default-task (make-marker) + "Marker pointing to the default task that should clock time. +The clock can be made to switch to this task after clocking out +of a different task.") + +(defvar org-clock-interrupted-task (make-marker) + "Marker pointing to the task that has been interrupted by the current clock.") + +(defvar org-clock-mode-line-map (make-sparse-keymap)) +(define-key org-clock-mode-line-map [mode-line mouse-2] 'org-clock-goto) +(define-key org-clock-mode-line-map [mode-line mouse-1] 'org-clock-menu) + +(defun org-clock-menu () + (interactive) + (popup-menu + '("Clock" + ["Clock out" org-clock-out t] + ["Change effort estimate" org-clock-modify-effort-estimate t] + ["Go to clock entry" org-clock-goto t] + ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"]))) + +(defun org-clock-history-push (&optional pos buffer) + "Push a marker to the clock history." + (setq org-clock-history-length (max 1 (min 35 org-clock-history-length))) + (let ((m (move-marker (make-marker) + (or pos (point)) (org-base-buffer + (or buffer (current-buffer))))) + n l) + (while (setq n (member m org-clock-history)) + (move-marker (car n) nil)) + (setq org-clock-history + (delq nil + (mapcar (lambda (x) (if (marker-buffer x) x nil)) + org-clock-history))) + (when (>= (setq l (length org-clock-history)) org-clock-history-length) + (setq org-clock-history + (nreverse + (nthcdr (- l org-clock-history-length -1) + (nreverse org-clock-history))))) + (push m org-clock-history))) + +(defun org-clock-save-markers-for-cut-and-paste (beg end) + "Save relative positions of markers in region." + (org-check-and-save-marker org-clock-marker beg end) + (org-check-and-save-marker org-clock-hd-marker beg end) + (org-check-and-save-marker org-clock-default-task beg end) + (org-check-and-save-marker org-clock-interrupted-task beg end) + (mapc (lambda (m) (org-check-and-save-marker m beg end)) + org-clock-history)) + +(defun org-clocking-buffer () + "Return the clocking buffer if we are currently clocking a task or nil." + (marker-buffer org-clock-marker)) + +(defun org-clocking-p () + "Return t when clocking a task." + (not (equal (org-clocking-buffer) nil))) + +(defvar org-clock-before-select-task-hook nil + "Hook called in task selection just before prompting the user.") + +(defun org-clock-select-task (&optional prompt) + "Select a task that was recently associated with clocking." + (interactive) + (let (och chl sel-list rpl (i 0) s) + ;; Remove successive dups from the clock history to consider + (mapc (lambda (c) (if (not (equal c (car och))) (push c och))) + org-clock-history) + (setq och (reverse och) chl (length och)) + (if (zerop chl) + (user-error "No recent clock") + (save-window-excursion + (org-switch-to-buffer-other-window + (get-buffer-create "*Clock Task Select*")) + (erase-buffer) + (when (marker-buffer org-clock-default-task) + (insert (org-add-props "Default Task\n" nil 'face 'bold)) + (setq s (org-clock-insert-selection-line ?d org-clock-default-task)) + (push s sel-list)) + (when (marker-buffer org-clock-interrupted-task) + (insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold)) + (setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task)) + (push s sel-list)) + (when (org-clocking-p) + (insert (org-add-props "Current Clocking Task\n" nil 'face 'bold)) + (setq s (org-clock-insert-selection-line ?c org-clock-marker)) + (push s sel-list)) + (insert (org-add-props "Recent Tasks\n" nil 'face 'bold)) + (mapc + (lambda (m) + (when (marker-buffer m) + (setq i (1+ i) + s (org-clock-insert-selection-line + (if (< i 10) + (+ i ?0) + (+ i (- ?A 10))) m)) + (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s)))) + (push s sel-list))) + och) + (run-hooks 'org-clock-before-select-task-hook) + (goto-char (point-min)) + ;; Set min-height relatively to circumvent a possible but in + ;; `fit-window-to-buffer' + (fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl))) + (message (or prompt "Select task for clocking:")) + (setq cursor-type nil rpl (read-char-exclusive)) + (cond + ((eq rpl ?q) nil) + ((eq rpl ?x) nil) + ((assoc rpl sel-list) (cdr (assoc rpl sel-list))) + (t (user-error "Invalid task choice %c" rpl))))))) + +(defun org-clock-insert-selection-line (i marker) + "Insert a line for the clock selection menu. +And return a cons cell with the selection character integer and the marker +pointing to it." + (when (marker-buffer marker) + (let (file cat task heading prefix) + (with-current-buffer (org-base-buffer (marker-buffer marker)) + (save-excursion + (save-restriction + (widen) + (ignore-errors + (goto-char marker) + (setq file (buffer-file-name (marker-buffer marker)) + cat (org-get-category) + heading (org-get-heading 'notags) + prefix (save-excursion + (org-back-to-heading t) + (looking-at org-outline-regexp) + (match-string 0)) + task (substring + (org-fontify-like-in-org-mode + (concat prefix heading) + org-odd-levels-only) + (length prefix))))))) + (when (and cat task) + (insert (format "[%c] %-12s %s\n" i cat task)) + (cons i marker))))) + +(defvar org-clock-task-overrun nil + "Internal flag indicating if the clock has overrun the planned time.") +(defvar org-clock-update-period 60 + "Number of seconds between mode line clock string updates.") + +(defun org-clock-get-clock-string () + "Form a clock-string, that will be shown in the mode line. +If an effort estimate was defined for the current item, use +01:30/01:50 format (clocked/estimated). +If not, show simply the clocked time like 01:50." + (let ((clocked-time (org-clock-get-clocked-time))) + (if org-clock-effort + (let* ((effort-in-minutes + (org-duration-string-to-minutes org-clock-effort)) + (work-done-str + (org-propertize + (org-minutes-to-clocksum-string clocked-time) + 'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text)) + 'org-mode-line-clock-overrun 'org-mode-line-clock))) + (effort-str (org-minutes-to-clocksum-string effort-in-minutes)) + (clockstr (org-propertize + (concat " [%s/" effort-str + "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")") + 'face 'org-mode-line-clock))) + (format clockstr work-done-str)) + (org-propertize (concat "[" (org-minutes-to-clocksum-string clocked-time) + (format " (%s)" org-clock-heading) "]") + 'face 'org-mode-line-clock)))) + +(defun org-clock-get-last-clock-out-time () + "Get the last clock-out time for the current subtree." + (save-excursion + (let ((end (save-excursion (org-end-of-subtree)))) + (when (re-search-forward (concat org-clock-string + ".*\\]--\\(\\[[^]]+\\]\\)") end t) + (org-time-string-to-time (match-string 1)))))) + +(defun org-clock-update-mode-line () + (if org-clock-effort + (org-clock-notify-once-if-expired) + (setq org-clock-task-overrun nil)) + (setq org-mode-line-string + (org-propertize + (let ((clock-string (org-clock-get-clock-string)) + (help-text "Org-mode clock is running.\nmouse-1 shows a menu\nmouse-2 will jump to task")) + (if (and (> org-clock-string-limit 0) + (> (length clock-string) org-clock-string-limit)) + (org-propertize + (substring clock-string 0 org-clock-string-limit) + 'help-echo (concat help-text ": " org-clock-heading)) + (org-propertize clock-string 'help-echo help-text))) + 'local-map org-clock-mode-line-map + 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight))) + (if (and org-clock-task-overrun org-clock-task-overrun-text) + (setq org-mode-line-string + (concat (org-propertize + org-clock-task-overrun-text + 'face 'org-mode-line-clock-overrun) org-mode-line-string))) + (force-mode-line-update)) + +(defun org-clock-get-clocked-time () + "Get the clocked time for the current item in minutes. +The time returned includes the time spent on this task in +previous clocking intervals." + (let ((currently-clocked-time + (floor (- (org-float-time) + (org-float-time org-clock-start-time)) 60))) + (+ currently-clocked-time (or org-clock-total-time 0)))) + +(defun org-clock-modify-effort-estimate (&optional value) + "Add to or set the effort estimate of the item currently being clocked. +VALUE can be a number of minutes, or a string with format hh:mm or mm. +When the string starts with a + or a - sign, the current value of the effort +property will be changed by that amount. If the effort value is expressed +as an `org-effort-durations' (e.g. \"3h\"), the modified value will be +converted to a hh:mm duration. + +This command will update the \"Effort\" property of the currently +clocked item, and the value displayed in the mode line." + (interactive) + (if (org-clock-is-active) + (let ((current org-clock-effort) sign) + (unless value + ;; Prompt user for a value or a change + (setq value + (read-string + (format "Set effort (hh:mm or mm%s): " + (if current + (format ", prefix + to add to %s" org-clock-effort) + ""))))) + (when (stringp value) + ;; A string. See if it is a delta + (setq sign (string-to-char value)) + (if (member sign '(?- ?+)) + (setq current (org-duration-string-to-minutes current) + value (substring value 1)) + (setq current 0)) + (setq value (org-duration-string-to-minutes value)) + (if (equal ?- sign) + (setq value (- current value)) + (if (equal ?+ sign) (setq value (+ current value))))) + (setq value (max 0 value) + org-clock-effort (org-minutes-to-clocksum-string value)) + (org-entry-put org-clock-marker "Effort" org-clock-effort) + (org-clock-update-mode-line) + (message "Effort is now %s" org-clock-effort)) + (message "Clock is not currently active"))) + +(defvar org-clock-notification-was-shown nil + "Shows if we have shown notification already.") + +(defun org-clock-notify-once-if-expired () + "Show notification if we spent more time than we estimated before. +Notification is shown only once." + (when (org-clocking-p) + (let ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort)) + (clocked-time (org-clock-get-clocked-time))) + (if (setq org-clock-task-overrun + (if (or (null effort-in-minutes) (zerop effort-in-minutes)) + nil + (>= clocked-time effort-in-minutes))) + (unless org-clock-notification-was-shown + (setq org-clock-notification-was-shown t) + (org-notify + (format "Task '%s' should be finished by now. (%s)" + org-clock-heading org-clock-effort) org-clock-sound)) + (setq org-clock-notification-was-shown nil))))) + +(defun org-notify (notification &optional play-sound) + "Send a NOTIFICATION and maybe PLAY-SOUND. +If PLAY-SOUND is non-nil, it overrides `org-clock-sound'." + (org-show-notification notification) + (if play-sound (org-clock-play-sound play-sound))) + +(defun org-show-notification (notification) + "Show notification. +Use `org-show-notification-handler' if defined, +use libnotify if available, or fall back on a message." + (cond ((functionp org-show-notification-handler) + (funcall org-show-notification-handler notification)) + ((stringp org-show-notification-handler) + (start-process "emacs-timer-notification" nil + org-show-notification-handler notification)) + ((fboundp 'notifications-notify) + (notifications-notify + :title "Org-mode message" + :body notification + ;; FIXME how to link to the Org icon? + ;; :app-icon "~/.emacs.d/icons/mail.png" + :urgency 'low)) + ((executable-find "notify-send") + (start-process "emacs-timer-notification" nil + "notify-send" notification)) + ;; Maybe the handler will send a message, so only use message as + ;; a fall back option + (t (message "%s" notification)))) + +(defun org-clock-play-sound (&optional clock-sound) + "Play sound as configured by `org-clock-sound'. +Use alsa's aplay tool if available. +If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'." + (let ((org-clock-sound (or clock-sound org-clock-sound))) + (cond + ((not org-clock-sound)) + ((eq org-clock-sound t) (beep t) (beep t)) + ((stringp org-clock-sound) + (let ((file (expand-file-name org-clock-sound))) + (if (file-exists-p file) + (if (executable-find "aplay") + (start-process "org-clock-play-notification" nil + "aplay" file) + (condition-case nil + (play-sound-file file) + (error (beep t) (beep t)))))))))) + +(defvar org-clock-mode-line-entry nil + "Information for the mode line about the running clock.") + +(defun org-find-open-clocks (file) + "Search through the given file and find all open clocks." + (let ((buf (or (get-file-buffer file) + (find-file-noselect file))) + clocks) + (with-current-buffer buf + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "CLOCK: \\(\\[.*?\\]\\)$" nil t) + (push (cons (copy-marker (match-end 1) t) + (org-time-string-to-time (match-string 1))) clocks)))) + clocks)) + +(defsubst org-is-active-clock (clock) + "Return t if CLOCK is the currently active clock." + (and (org-clock-is-active) + (= org-clock-marker (car clock)))) + +(defmacro org-with-clock-position (clock &rest forms) + "Evaluate FORMS with CLOCK as the current active clock." + `(with-current-buffer (marker-buffer (car ,clock)) + (save-excursion + (save-restriction + (widen) + (goto-char (car ,clock)) + (beginning-of-line) + ,@forms)))) +(def-edebug-spec org-with-clock-position (form body)) +(put 'org-with-clock-position 'lisp-indent-function 1) + +(defmacro org-with-clock (clock &rest forms) + "Evaluate FORMS with CLOCK as the current active clock. +This macro also protects the current active clock from being altered." + `(org-with-clock-position ,clock + (let ((org-clock-start-time (cdr ,clock)) + (org-clock-total-time) + (org-clock-history) + (org-clock-effort) + (org-clock-marker (car ,clock)) + (org-clock-hd-marker (save-excursion + (outline-back-to-heading t) + (point-marker)))) + ,@forms))) +(def-edebug-spec org-with-clock (form body)) +(put 'org-with-clock 'lisp-indent-function 1) + +(defsubst org-clock-clock-in (clock &optional resume start-time) + "Clock in to the clock located by CLOCK. +If necessary, clock-out of the currently active clock." + (org-with-clock-position clock + (let ((org-clock-in-resume (or resume org-clock-in-resume))) + (org-clock-in nil start-time)))) + +(defsubst org-clock-clock-out (clock &optional fail-quietly at-time) + "Clock out of the clock located by CLOCK." + (let ((temp (copy-marker (car clock) + (marker-insertion-type (car clock))))) + (if (org-is-active-clock clock) + (org-clock-out nil fail-quietly at-time) + (org-with-clock clock + (org-clock-out nil fail-quietly at-time))) + (setcar clock temp))) + +(defsubst org-clock-clock-cancel (clock) + "Cancel the clock located by CLOCK." + (let ((temp (copy-marker (car clock) + (marker-insertion-type (car clock))))) + (if (org-is-active-clock clock) + (org-clock-cancel) + (org-with-clock clock + (org-clock-cancel))) + (setcar clock temp))) + +(defvar org-clock-clocking-in nil) +(defvar org-clock-resolving-clocks nil) +(defvar org-clock-resolving-clocks-due-to-idleness nil) + +(defun org-clock-resolve-clock (clock resolve-to clock-out-time + &optional close-p restart-p fail-quietly) + "Resolve `CLOCK' given the time `RESOLVE-TO', and the present. +`CLOCK' is a cons cell of the form (MARKER START-TIME)." + (let ((org-clock-resolving-clocks t)) + (cond + ((null resolve-to) + (org-clock-clock-cancel clock) + (if (and restart-p (not org-clock-clocking-in)) + (org-clock-clock-in clock))) + + ((eq resolve-to 'now) + (if restart-p + (error "RESTART-P is not valid here")) + (if (or close-p org-clock-clocking-in) + (org-clock-clock-out clock fail-quietly) + (unless (org-is-active-clock clock) + (org-clock-clock-in clock t)))) + + ((not (time-less-p resolve-to (current-time))) + (error "RESOLVE-TO must refer to a time in the past")) + + (t + (if restart-p + (error "RESTART-P is not valid here")) + (org-clock-clock-out clock fail-quietly (or clock-out-time + resolve-to)) + (unless org-clock-clocking-in + (if close-p + (setq org-clock-leftover-time (and (null clock-out-time) + resolve-to)) + (org-clock-clock-in clock nil (and clock-out-time + resolve-to)))))))) + +(defun org-clock-jump-to-current-clock (&optional effective-clock) + (interactive) + (let ((org-clock-into-drawer (org-clock-into-drawer)) + (clock (or effective-clock (cons org-clock-marker + org-clock-start-time)))) + (unless (marker-buffer (car clock)) + (error "No clock is currently running")) + (org-with-clock clock (org-clock-goto)) + (with-current-buffer (marker-buffer (car clock)) + (goto-char (car clock)) + (if org-clock-into-drawer + (let ((logbook + (if (stringp org-clock-into-drawer) + (concat ":" org-clock-into-drawer ":") + ":LOGBOOK:"))) + (ignore-errors + (outline-flag-region + (save-excursion + (outline-back-to-heading t) + (search-forward logbook) + (goto-char (match-beginning 0))) + (save-excursion + (outline-back-to-heading t) + (search-forward logbook) + (search-forward ":END:") + (goto-char (match-end 0))) + nil))))))) + +(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly) + "Resolve an open org-mode clock. +An open clock was found, with `dangling' possibly being non-nil. +If this function was invoked with a prefix argument, non-dangling +open clocks are ignored. The given clock requires some sort of +user intervention to resolve it, either because a clock was left +dangling or due to an idle timeout. The clock resolution can +either be: + + (a) deleted, the user doesn't care about the clock + (b) restarted from the current time (if no other clock is open) + (c) closed, giving the clock X minutes + (d) closed and then restarted + (e) resumed, as if the user had never left + +The format of clock is (CONS MARKER START-TIME), where MARKER +identifies the buffer and position the clock is open at (and +thus, the heading it's under), and START-TIME is when the clock +was started." + (assert clock) + (let* ((ch + (save-window-excursion + (save-excursion + (unless org-clock-resolving-clocks-due-to-idleness + (org-clock-jump-to-current-clock clock)) + (unless org-clock-resolve-expert + (with-output-to-temp-buffer "*Org Clock*" + (princ "Select a Clock Resolution Command: + +i/q Ignore this question; the same as keeping all the idle time. + +k/K Keep X minutes of the idle time (default is all). If this + amount is less than the default, you will be clocked out + that many minutes after the time that idling began, and then + clocked back in at the present time. + +g/G Indicate that you \"got back\" X minutes ago. This is quite + different from 'k': it clocks you out from the beginning of + the idle period and clock you back in X minutes ago. + +s/S Subtract the idle time from the current clock. This is the + same as keeping 0 minutes. + +C Cancel the open timer altogether. It will be as though you + never clocked in. + +j/J Jump to the current clock, to make manual adjustments. + +For all these options, using uppercase makes your final state +to be CLOCKED OUT."))) + (org-fit-window-to-buffer (get-buffer-window "*Org Clock*")) + (let (char-pressed) + (when (featurep 'xemacs) + (message (concat (funcall prompt-fn clock) + " [jkKgGsScCiq]? ")) + (setq char-pressed (read-char-exclusive))) + (while (or (null char-pressed) + (and (not (memq char-pressed + '(?k ?K ?g ?G ?s ?S ?C + ?j ?J ?i ?q))) + (or (ding) t))) + (setq char-pressed + (read-char (concat (funcall prompt-fn clock) + " [jkKgGSscCiq]? ") + nil 45))) + (and (not (memq char-pressed '(?i ?q))) char-pressed))))) + (default + (floor (/ (org-float-time + (time-subtract (current-time) last-valid)) 60))) + (keep + (and (memq ch '(?k ?K)) + (read-number "Keep how many minutes? " default))) + (gotback + (and (memq ch '(?g ?G)) + (read-number "Got back how many minutes ago? " default))) + (subtractp (memq ch '(?s ?S))) + (barely-started-p (< (- (org-float-time last-valid) + (org-float-time (cdr clock))) 45)) + (start-over (and subtractp barely-started-p))) + (cond + ((memq ch '(?j ?J)) + (if (eq ch ?J) + (org-clock-resolve-clock clock 'now nil t nil fail-quietly)) + (org-clock-jump-to-current-clock clock)) + ((or (null ch) + (not (memq ch '(?k ?K ?g ?G ?s ?S ?C)))) + (message "")) + (t + (org-clock-resolve-clock + clock (cond + ((or (eq ch ?C) + ;; If the time on the clock was less than a minute before + ;; the user went away, and they've ask to subtract all the + ;; time... + start-over) + nil) + ((or subtractp + (and gotback (= gotback 0))) + last-valid) + ((or (and keep (= keep default)) + (and gotback (= gotback default))) + 'now) + (keep + (time-add last-valid (seconds-to-time (* 60 keep)))) + (gotback + (time-subtract (current-time) + (seconds-to-time (* 60 gotback)))) + (t + (error "Unexpected, please report this as a bug"))) + (and gotback last-valid) + (memq ch '(?K ?G ?S)) + (and start-over + (not (memq ch '(?K ?G ?S ?C)))) + fail-quietly))))) + +;;;###autoload +(defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid) + "Resolve all currently open org-mode clocks. +If `only-dangling-p' is non-nil, only ask to resolve dangling +\(i.e., not currently open and valid) clocks." + (interactive "P") + (unless org-clock-resolving-clocks + (let ((org-clock-resolving-clocks t)) + (dolist (file (org-files-list)) + (let ((clocks (org-find-open-clocks file))) + (dolist (clock clocks) + (let ((dangling (or (not (org-clock-is-active)) + (/= (car clock) org-clock-marker)))) + (if (or (not only-dangling-p) dangling) + (org-clock-resolve + clock + (or prompt-fn + (function + (lambda (clock) + (format + "Dangling clock started %d mins ago" + (floor + (/ (- (org-float-time (current-time)) + (org-float-time (cdr clock))) 60)))))) + (or last-valid + (cdr clock))))))))))) + +(defun org-emacs-idle-seconds () + "Return the current Emacs idle time in seconds, or nil if not idle." + (let ((idle-time (current-idle-time))) + (if idle-time + (org-float-time idle-time) + 0))) + +(defun org-mac-idle-seconds () + "Return the current Mac idle time in seconds." + (string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'"))) + +(defvar org-x11idle-exists-p + ;; Check that x11idle exists + (and (eq window-system 'x) + (eq (call-process-shell-command "command" nil nil nil "-v" org-clock-x11idle-program-name) 0) + ;; Check that x11idle can retrieve the idle time + (eq (call-process-shell-command org-clock-x11idle-program-name nil nil nil) 0))) + +(defun org-x11-idle-seconds () + "Return the current X11 idle time in seconds." + (/ (string-to-number (shell-command-to-string org-clock-x11idle-program-name)) 1000)) + +(defun org-user-idle-seconds () + "Return the number of seconds the user has been idle for. +This routine returns a floating point number." + (cond + ((eq system-type 'darwin) + (org-mac-idle-seconds)) + ((and (eq window-system 'x) org-x11idle-exists-p) + (org-x11-idle-seconds)) + (t + (org-emacs-idle-seconds)))) + +(defvar org-clock-user-idle-seconds) + +(defun org-resolve-clocks-if-idle () + "Resolve all currently open org-mode clocks. +This is performed after `org-clock-idle-time' minutes, to check +if the user really wants to stay clocked in after being idle for +so long." + (when (and org-clock-idle-time (not org-clock-resolving-clocks) + org-clock-marker (marker-buffer org-clock-marker)) + (let* ((org-clock-user-idle-seconds (org-user-idle-seconds)) + (org-clock-user-idle-start + (time-subtract (current-time) + (seconds-to-time org-clock-user-idle-seconds))) + (org-clock-resolving-clocks-due-to-idleness t)) + (if (> org-clock-user-idle-seconds (* 60 org-clock-idle-time)) + (org-clock-resolve + (cons org-clock-marker + org-clock-start-time) + (function + (lambda (clock) + (format "Clocked in & idle for %.1f mins" + (/ (org-float-time + (time-subtract (current-time) + org-clock-user-idle-start)) + 60.0)))) + org-clock-user-idle-start))))) + +(defvar org-clock-current-task nil "Task currently clocked in.") +(defvar org-clock-out-time nil) ; store the time of the last clock-out +(defvar org--msg-extra) + +;;;###autoload +(defun org-clock-in (&optional select start-time) + "Start the clock on the current item. +If necessary, clock-out of the currently active clock. +With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked +tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task +and mark it as the default task, a special task that will always be offered +in the clocking selection, associated with the letter `d'. +When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], \ +clock in by using the last clock-out +time as the start time \(see `org-clock-continuously' to +make this the default behavior.)" + (interactive "P") + (setq org-clock-notification-was-shown nil) + (org-refresh-properties org-effort-property 'org-effort) + (catch 'abort + (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness) + (org-clocking-p))) + ts selected-task target-pos (org--msg-extra "") + (leftover (and (not org-clock-resolving-clocks) + org-clock-leftover-time))) + + (when (and org-clock-auto-clock-resolution + (or (not interrupting) + (eq t org-clock-auto-clock-resolution)) + (not org-clock-clocking-in) + (not org-clock-resolving-clocks)) + (setq org-clock-leftover-time nil) + (let ((org-clock-clocking-in t)) + (org-resolve-clocks))) ; check if any clocks are dangling + + (when (equal select '(64)) + ;; Set start-time to `org-clock-out-time' + (let ((org-clock-continuously t)) + (org-clock-in nil org-clock-out-time))) + + (when (equal select '(4)) + (setq selected-task (org-clock-select-task "Clock-in on task: ")) + (if selected-task + (setq selected-task (copy-marker selected-task)) + (error "Abort"))) + + (when (equal select '(16)) + ;; Mark as default clocking task + (org-clock-mark-default-task)) + + (when interrupting + ;; We are interrupting the clocking of a different task. + ;; Save a marker to this task, so that we can go back. + ;; First check if we are trying to clock into the same task! + (when (save-excursion + (unless selected-task + (org-back-to-heading t)) + (and (equal (marker-buffer org-clock-hd-marker) + (if selected-task + (marker-buffer selected-task) + (current-buffer))) + (= (marker-position org-clock-hd-marker) + (if selected-task + (marker-position selected-task) + (point))) + (equal org-clock-current-task (nth 4 (org-heading-components))))) + (message "Clock continues in \"%s\"" org-clock-heading) + (throw 'abort nil)) + (move-marker org-clock-interrupted-task + (marker-position org-clock-marker) + (marker-buffer org-clock-marker)) + (let ((org-clock-clocking-in t)) + (org-clock-out nil t))) + + ;; Clock in at which position? + (setq target-pos + (if (and (eobp) (not (org-at-heading-p))) + (point-at-bol 0) + (point))) + (save-excursion + (when (and selected-task (marker-buffer selected-task)) + ;; There is a selected task, move to the correct buffer + ;; and set the new target position. + (set-buffer (org-base-buffer (marker-buffer selected-task))) + (setq target-pos (marker-position selected-task)) + (move-marker selected-task nil)) + (save-excursion + (save-restriction + (widen) + (goto-char target-pos) + (org-back-to-heading t) + (or interrupting (move-marker org-clock-interrupted-task nil)) + (run-hooks 'org-clock-in-prepare-hook) + (org-clock-history-push) + (setq org-clock-current-task (nth 4 (org-heading-components))) + (cond ((functionp org-clock-in-switch-to-state) + (looking-at org-complex-heading-regexp) + (let ((newstate (funcall org-clock-in-switch-to-state + (match-string 2)))) + (if newstate (org-todo newstate)))) + ((and org-clock-in-switch-to-state + (not (looking-at (concat org-outline-regexp "[ \t]*" + org-clock-in-switch-to-state + "\\>")))) + (org-todo org-clock-in-switch-to-state))) + (setq org-clock-heading + (cond ((and org-clock-heading-function + (functionp org-clock-heading-function)) + (funcall org-clock-heading-function)) + ((nth 4 (org-heading-components)) + (replace-regexp-in-string + "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1" + (match-string-no-properties 4))) + (t "???"))) + (org-clock-find-position org-clock-in-resume) + (cond + ((and org-clock-in-resume + (looking-at + (concat "^[ \t]*" org-clock-string + " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" + " *\\sw+\.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) + (message "Matched %s" (match-string 1)) + (setq ts (concat "[" (match-string 1) "]")) + (goto-char (match-end 1)) + (setq org-clock-start-time + (apply 'encode-time + (org-parse-time-string (match-string 1)))) + (setq org-clock-effort (org-entry-get (point) org-effort-property)) + (setq org-clock-total-time (org-clock-sum-current-item + (org-clock-get-sum-start)))) + ((eq org-clock-in-resume 'auto-restart) + ;; called from org-clock-load during startup, + ;; do not interrupt, but warn! + (message "Cannot restart clock because task does not contain unfinished clock") + (ding) + (sit-for 2) + (throw 'abort nil)) + (t + (insert-before-markers "\n") + (backward-char 1) + (org-indent-line) + (when (and (save-excursion + (end-of-line 0) + (org-in-item-p))) + (beginning-of-line 1) + (org-indent-line-to (- (org-get-indentation) 2))) + (insert org-clock-string " ") + (setq org-clock-effort (org-entry-get (point) org-effort-property)) + (setq org-clock-total-time (org-clock-sum-current-item + (org-clock-get-sum-start))) + (setq org-clock-start-time + (or (and org-clock-continuously org-clock-out-time) + (and leftover + (y-or-n-p + (format + "You stopped another clock %d mins ago; start this one from then? " + (/ (- (org-float-time + (org-current-time org-clock-rounding-minutes t)) + (org-float-time leftover)) 60))) + leftover) + start-time + (org-current-time org-clock-rounding-minutes t))) + (setq ts (org-insert-time-stamp org-clock-start-time + 'with-hm 'inactive)))) + (move-marker org-clock-marker (point) (buffer-base-buffer)) + (move-marker org-clock-hd-marker + (save-excursion (org-back-to-heading t) (point)) + (buffer-base-buffer)) + (setq org-clock-has-been-used t) + ;; add to mode line + (when (or (eq org-clock-clocked-in-display 'mode-line) + (eq org-clock-clocked-in-display 'both)) + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'org-mode-line-string global-mode-string) + (setq global-mode-string + (append global-mode-string '(org-mode-line-string))))) + ;; add to frame title + (when (or (eq org-clock-clocked-in-display 'frame-title) + (eq org-clock-clocked-in-display 'both)) + (setq frame-title-format org-clock-frame-title-format)) + (org-clock-update-mode-line) + (when org-clock-mode-line-timer + (cancel-timer org-clock-mode-line-timer) + (setq org-clock-mode-line-timer nil)) + (when org-clock-clocked-in-display + (setq org-clock-mode-line-timer + (run-with-timer org-clock-update-period + org-clock-update-period + 'org-clock-update-mode-line))) + (when org-clock-idle-timer + (cancel-timer org-clock-idle-timer) + (setq org-clock-idle-timer nil)) + (setq org-clock-idle-timer + (run-with-timer 60 60 'org-resolve-clocks-if-idle)) + (message "Clock starts at %s - %s" ts org--msg-extra) + (run-hooks 'org-clock-in-hook))))))) + +;;;###autoload +(defun org-clock-in-last (&optional arg) + "Clock in the last closed clocked item. +When already clocking in, send an warning. +With a universal prefix argument, select the task you want to +clock in from the last clocked in tasks. +With two universal prefix arguments, start clocking using the +last clock-out time, if any. +With three universal prefix arguments, interactively prompt +for a todo state to switch to, overriding the existing value +`org-clock-in-switch-to-state'." + (interactive "P") + (if (equal arg '(4)) + (org-clock-in (org-clock-select-task)) + (let ((start-time (if (or org-clock-continuously (equal arg '(16))) + (or org-clock-out-time + (org-current-time org-clock-rounding-minutes t)) + (org-current-time org-clock-rounding-minutes t)))) + (if (null org-clock-history) + (message "No last clock") + (let ((org-clock-in-switch-to-state + (if (and (not org-clock-current-task) (equal arg '(64))) + (completing-read "Switch to state: " + (and org-clock-history + (with-current-buffer + (marker-buffer (car org-clock-history)) + org-todo-keywords-1))) + org-clock-in-switch-to-state)) + (already-clocking org-clock-current-task)) + (org-clock-clock-in (list (car org-clock-history)) nil start-time) + (or already-clocking + ;; Don't display a message if we are already clocking in + (message "Clocking back: %s (in %s)" + org-clock-current-task + (buffer-name (marker-buffer org-clock-marker))))))))) + +(defun org-clock-mark-default-task () + "Mark current task as default task." + (interactive) + (save-excursion + (org-back-to-heading t) + (move-marker org-clock-default-task (point)))) + +(defun org-clock-get-sum-start () + "Return the time from which clock times should be counted. +This is for the currently running clock as it is displayed +in the mode line. This function looks at the properties +LAST_REPEAT and in particular CLOCK_MODELINE_TOTAL and the +corresponding variable `org-clock-mode-line-total' and then +decides which time to use." + (let ((cmt (or (org-entry-get nil "CLOCK_MODELINE_TOTAL") + (symbol-name org-clock-mode-line-total))) + (lr (org-entry-get nil "LAST_REPEAT"))) + (cond + ((equal cmt "current") + (setq org--msg-extra "showing time in current clock instance") + (current-time)) + ((equal cmt "today") + (setq org--msg-extra "showing today's task time.") + (let* ((dt (decode-time (current-time)))) + (setq dt (append (list 0 0 0) (nthcdr 3 dt))) + (if org-extend-today-until + (setf (nth 2 dt) org-extend-today-until)) + (apply 'encode-time dt))) + ((or (equal cmt "all") + (and (or (not cmt) (equal cmt "auto")) + (not lr))) + (setq org--msg-extra "showing entire task time.") + nil) + ((or (equal cmt "repeat") + (and (or (not cmt) (equal cmt "auto")) + lr)) + (setq org--msg-extra "showing task time since last repeat.") + (if (not lr) + nil + (org-time-string-to-time lr))) + (t nil)))) + +(defun org-clock-find-position (find-unclosed) + "Find the location where the next clock line should be inserted. +When FIND-UNCLOSED is non-nil, first check if there is an unclosed clock +line and position cursor in that line." + (org-back-to-heading t) + (catch 'exit + (let* ((org-clock-into-drawer (org-clock-into-drawer)) + (beg (save-excursion + (beginning-of-line 2) + (or (bolp) (newline)) + (point))) + (end (progn (outline-next-heading) (point))) + (re (concat "^[ \t]*" org-clock-string)) + (cnt 0) + (drawer (if (stringp org-clock-into-drawer) + org-clock-into-drawer "LOGBOOK")) + first last ind-last) + (goto-char beg) + (when (and find-unclosed + (re-search-forward + (concat "^[ \t]*" org-clock-string + " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" + " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$") + end t)) + (beginning-of-line 1) + (throw 'exit t)) + (when (eobp) (newline) (setq end (max (point) end))) + (when (re-search-forward (concat "^[ \t]*:" drawer ":") end t) + ;; we seem to have a CLOCK drawer, so go there. + (beginning-of-line 2) + (or org-log-states-order-reversed + (and (re-search-forward org-property-end-re nil t) + (goto-char (match-beginning 0)))) + (throw 'exit t)) + ;; Lets count the CLOCK lines + (goto-char beg) + (while (re-search-forward re end t) + (setq first (or first (match-beginning 0)) + last (match-beginning 0) + cnt (1+ cnt))) + (when (and (integerp org-clock-into-drawer) + last + (>= (1+ cnt) org-clock-into-drawer)) + ;; Wrap current entries into a new drawer + (goto-char last) + (setq ind-last (org-get-indentation)) + (beginning-of-line 2) + (if (and (>= (org-get-indentation) ind-last) + (org-at-item-p)) + (when (and (>= (org-get-indentation) ind-last) + (org-at-item-p)) + (let ((struct (org-list-struct))) + (goto-char (org-list-get-bottom-point struct))))) + (insert ":END:\n") + (beginning-of-line 0) + (org-indent-line-to ind-last) + (goto-char first) + (insert ":" drawer ":\n") + (beginning-of-line 0) + (org-indent-line) + (org-flag-drawer t) + (beginning-of-line 2) + (or org-log-states-order-reversed + (and (re-search-forward org-property-end-re nil t) + (goto-char (match-beginning 0)))) + (throw 'exit nil)) + + (goto-char beg) + (while (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) + (not (equal (match-string 1) org-clock-string))) + ;; Planning info, skip to after it + (beginning-of-line 2) + (or (bolp) (newline))) + (when (or (eq org-clock-into-drawer t) + (stringp org-clock-into-drawer) + (and (integerp org-clock-into-drawer) + (< org-clock-into-drawer 2))) + (insert ":" drawer ":\n:END:\n") + (beginning-of-line -1) + (org-indent-line) + (org-flag-drawer t) + (beginning-of-line 2) + (org-indent-line) + (beginning-of-line) + (or org-log-states-order-reversed + (and (re-search-forward org-property-end-re nil t) + (goto-char (match-beginning 0)))))))) + +;;;###autoload +(defun org-clock-out (&optional switch-to-state fail-quietly at-time) + "Stop the currently running clock. +Throw an error if there is no running clock and FAIL-QUIETLY is nil. +With a universal prefix, prompt for a state to switch the clocked out task +to, overriding the existing value of `org-clock-out-switch-to-state'." + (interactive "P") + (catch 'exit + (when (not (org-clocking-p)) + (setq global-mode-string + (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) + (force-mode-line-update) + (if fail-quietly (throw 'exit t) (user-error "No active clock"))) + (let ((org-clock-out-switch-to-state + (if switch-to-state + (completing-read "Switch to state: " + (with-current-buffer + (marker-buffer org-clock-marker) + org-todo-keywords-1) + nil t "DONE") + org-clock-out-switch-to-state)) + (now (org-current-time org-clock-rounding-minutes)) + ts te s h m remove) + (setq org-clock-out-time now) + (save-excursion ; Do not replace this with `with-current-buffer'. + (org-no-warnings (set-buffer (org-clocking-buffer))) + (save-restriction + (widen) + (goto-char org-clock-marker) + (beginning-of-line 1) + (if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) + (equal (match-string 1) org-clock-string)) + (setq ts (match-string 2)) + (if fail-quietly (throw 'exit nil) (error "Clock start time is gone"))) + (goto-char (match-end 0)) + (delete-region (point) (point-at-eol)) + (insert "--") + (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) + (setq s (- (org-float-time (apply 'encode-time (org-parse-time-string te))) + (org-float-time (apply 'encode-time (org-parse-time-string ts)))) + h (floor (/ s 3600)) + s (- s (* 3600 h)) + m (floor (/ s 60)) + s (- s (* 60 s))) + (insert " => " (format "%2d:%02d" h m)) + (when (setq remove (and org-clock-out-remove-zero-time-clocks + (= (+ h m) 0))) + (beginning-of-line 1) + (delete-region (point) (point-at-eol)) + (and (looking-at "\n") (> (point-max) (1+ (point))) + (delete-char 1))) + (move-marker org-clock-marker nil) + (move-marker org-clock-hd-marker nil) + (when org-log-note-clock-out + (org-add-log-setup 'clock-out nil nil nil nil + (concat "# Task: " (org-get-heading t) "\n\n"))) + (when org-clock-mode-line-timer + (cancel-timer org-clock-mode-line-timer) + (setq org-clock-mode-line-timer nil)) + (when org-clock-idle-timer + (cancel-timer org-clock-idle-timer) + (setq org-clock-idle-timer nil)) + (setq global-mode-string + (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) + (when org-clock-out-switch-to-state + (save-excursion + (org-back-to-heading t) + (let ((org-inhibit-logging t) + (org-clock-out-when-done nil)) + (cond + ((functionp org-clock-out-switch-to-state) + (looking-at org-complex-heading-regexp) + (let ((newstate (funcall org-clock-out-switch-to-state + (match-string 2)))) + (if newstate (org-todo newstate)))) + ((and org-clock-out-switch-to-state + (not (looking-at (concat org-outline-regexp "[ \t]*" + org-clock-out-switch-to-state + "\\>")))) + (org-todo org-clock-out-switch-to-state)))))) + (force-mode-line-update) + (message (concat "Clock stopped at %s after " + (org-minutes-to-clocksum-string (+ (* 60 h) m)) "%s") + te (if remove " => LINE REMOVED" "")) + (let ((h org-clock-out-hook)) + ;; If a closing note needs to be stored in the drawer + ;; where clocks are stored, let's temporarily disable + ;; `org-clock-remove-empty-clock-drawer' + (if (and (equal org-clock-into-drawer org-log-into-drawer) + (eq org-log-done 'note) + org-clock-out-when-done) + (setq h (delq 'org-clock-remove-empty-clock-drawer h))) + (mapc (lambda (f) (funcall f)) h)) + (unless (org-clocking-p) + (setq org-clock-current-task nil))))))) + +(add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer) + +(defun org-clock-remove-empty-clock-drawer nil + "Remove empty clock drawer in the current subtree." + (let* ((olid (or (org-entry-get (point) "LOG_INTO_DRAWER") + org-log-into-drawer)) + (clock-drawer (if (eq t olid) "LOGBOOK" olid)) + (end (save-excursion (org-end-of-subtree t t)))) + (when clock-drawer + (save-excursion + (org-back-to-heading t) + (while (and (< (point) end) + (search-forward clock-drawer end t)) + (goto-char (match-beginning 0)) + (org-remove-empty-drawer-at clock-drawer (point)) + (forward-line 1)))))) + +(defun org-clock-timestamps-up (&optional n) + "Increase CLOCK timestamps at cursor. +Optional argument N tells to change by that many units." + (interactive "P") + (org-clock-timestamps-change 'up n)) + +(defun org-clock-timestamps-down (&optional n) + "Increase CLOCK timestamps at cursor. +Optional argument N tells to change by that many units." + (interactive "P") + (org-clock-timestamps-change 'down n)) + +(defun org-clock-timestamps-change (updown &optional n) + "Change CLOCK timestamps synchronously at cursor. +UPDOWN tells whether to change 'up or 'down. +Optional argument N tells to change by that many units." + (setq org-ts-what nil) + (when (org-at-timestamp-p t) + (let ((tschange (if (eq updown 'up) 'org-timestamp-up + 'org-timestamp-down)) + ts1 begts1 ts2 begts2 updatets1 tdiff) + (save-excursion + (move-beginning-of-line 1) + (re-search-forward org-ts-regexp3 nil t) + (setq ts1 (match-string 0) begts1 (match-beginning 0)) + (when (re-search-forward org-ts-regexp3 nil t) + (setq ts2 (match-string 0) begts2 (match-beginning 0)))) + ;; Are we on the second timestamp? + (if (<= begts2 (point)) (setq updatets1 t)) + (if (not ts2) + ;; fall back on org-timestamp-up if there is only one + (funcall tschange n) + ;; setq this so that (boundp 'org-ts-what is non-nil) + (funcall tschange n) + (let ((ts (if updatets1 ts2 ts1)) + (begts (if updatets1 begts1 begts2))) + (setq tdiff + (subtract-time + (org-time-string-to-time org-last-changed-timestamp) + (org-time-string-to-time ts))) + (save-excursion + (goto-char begts) + (org-timestamp-change + (round (/ (org-float-time tdiff) + (cond ((eq org-ts-what 'minute) 60) + ((eq org-ts-what 'hour) 3600) + ((eq org-ts-what 'day) (* 24 3600)) + ((eq org-ts-what 'month) (* 24 3600 31)) + ((eq org-ts-what 'year) (* 24 3600 365.2))))) + org-ts-what 'updown))))))) + +;;;###autoload +(defun org-clock-cancel () + "Cancel the running clock by removing the start timestamp." + (interactive) + (when (not (org-clocking-p)) + (setq global-mode-string + (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) + (force-mode-line-update) + (error "No active clock")) + (save-excursion ; Do not replace this with `with-current-buffer'. + (org-no-warnings (set-buffer (org-clocking-buffer))) + (goto-char org-clock-marker) + (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*")) + (progn (delete-region (1- (point-at-bol)) (point-at-eol)) + (org-remove-empty-drawer-at "LOGBOOK" (point))) + (message "Clock gone, cancel the timer anyway") + (sit-for 2))) + (move-marker org-clock-marker nil) + (move-marker org-clock-hd-marker nil) + (setq global-mode-string + (delq 'org-mode-line-string global-mode-string)) + (setq frame-title-format org-frame-title-format-backup) + (force-mode-line-update) + (message "Clock canceled") + (run-hooks 'org-clock-cancel-hook)) + +(defcustom org-clock-goto-before-context 2 + "Number of lines of context to display before currently clocked-in entry. +This applies when using `org-clock-goto'." + :group 'org-clock + :type 'integer) + +;;;###autoload +(defun org-clock-goto (&optional select) + "Go to the currently clocked-in entry, or to the most recently clocked one. +With prefix arg SELECT, offer recently clocked tasks for selection." + (interactive "@P") + (let* ((recent nil) + (m (cond + (select + (or (org-clock-select-task "Select task to go to: ") + (error "No task selected"))) + ((org-clocking-p) org-clock-marker) + ((and org-clock-goto-may-find-recent-task + (car org-clock-history) + (marker-buffer (car org-clock-history))) + (setq recent t) + (car org-clock-history)) + (t (error "No active or recent clock task"))))) + (org-pop-to-buffer-same-window (marker-buffer m)) + (if (or (< m (point-min)) (> m (point-max))) (widen)) + (goto-char m) + (org-show-entry) + (org-back-to-heading t) + (org-cycle-hide-drawers 'children) + (recenter org-clock-goto-before-context) + (org-reveal) + (if recent + (message "No running clock, this is the most recently clocked task")) + (run-hooks 'org-clock-goto-hook))) + +(defvar org-clock-file-total-minutes nil + "Holds the file total time in minutes, after a call to `org-clock-sum'.") +(make-variable-buffer-local 'org-clock-file-total-minutes) + +(defun org-clock-sum-today (&optional headline-filter) + "Sum the times for each subtree for today." + (interactive) + (let ((range (org-clock-special-range 'today))) + (org-clock-sum (car range) (cadr range) nil :org-clock-minutes-today))) + +;;;###autoload +(defun org-clock-sum (&optional tstart tend headline-filter propname) + "Sum the times for each subtree. +Puts the resulting times in minutes as a text property on each headline. +TSTART and TEND can mark a time range to be considered. +HEADLINE-FILTER is a zero-arg function that, if specified, is called for +each headline in the time range with point at the headline. Headlines for +which HEADLINE-FILTER returns nil are excluded from the clock summation. +PROPNAME lets you set a custom text property instead of :org-clock-minutes." + (interactive) + (org-with-silent-modifications + (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" + org-clock-string + "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)")) + (lmax 30) + (ltimes (make-vector lmax 0)) + (t1 0) + (level 0) + ts te dt + time) + (if (stringp tstart) (setq tstart (org-time-string-to-seconds tstart))) + (if (stringp tend) (setq tend (org-time-string-to-seconds tend))) + (if (consp tstart) (setq tstart (org-float-time tstart))) + (if (consp tend) (setq tend (org-float-time tend))) + (remove-text-properties (point-min) (point-max) + `(,(or propname :org-clock-minutes) t + :org-clock-force-headline-inclusion t)) + (save-excursion + (goto-char (point-max)) + (while (re-search-backward re nil t) + (cond + ((match-end 2) + ;; Two time stamps + (setq ts (match-string 2) + te (match-string 3) + ts (org-float-time + (apply 'encode-time (org-parse-time-string ts))) + te (org-float-time + (apply 'encode-time (org-parse-time-string te))) + ts (if tstart (max ts tstart) ts) + te (if tend (min te tend) te) + dt (- te ts) + t1 (if (> dt 0) (+ t1 (floor (/ dt 60))) t1))) + ((match-end 4) + ;; A naked time + (setq t1 (+ t1 (string-to-number (match-string 5)) + (* 60 (string-to-number (match-string 4)))))) + (t ;; A headline + ;; Add the currently clocking item time to the total + (when (and org-clock-report-include-clocking-task + (equal (org-clocking-buffer) (current-buffer)) + (equal (marker-position org-clock-hd-marker) (point)) + tstart + tend + (>= (org-float-time org-clock-start-time) tstart) + (<= (org-float-time org-clock-start-time) tend)) + (let ((time (floor (- (org-float-time) + (org-float-time org-clock-start-time)) 60))) + (setq t1 (+ t1 time)))) + (let* ((headline-forced + (get-text-property (point) + :org-clock-force-headline-inclusion)) + (headline-included + (or (null headline-filter) + (save-excursion + (save-match-data (funcall headline-filter)))))) + (setq level (- (match-end 1) (match-beginning 1))) + (when (or (> t1 0) (> (aref ltimes level) 0)) + (when (or headline-included headline-forced) + (if headline-included + (loop for l from 0 to level do + (aset ltimes l (+ (aref ltimes l) t1)))) + (setq time (aref ltimes level)) + (goto-char (match-beginning 0)) + (put-text-property (point) (point-at-eol) + (or propname :org-clock-minutes) time) + (if headline-filter + (save-excursion + (save-match-data + (while + (> (funcall outline-level) 1) + (outline-up-heading 1 t) + (put-text-property + (point) (point-at-eol) + :org-clock-force-headline-inclusion t)))))) + (setq t1 0) + (loop for l from level to (1- lmax) do + (aset ltimes l 0))))))) + (setq org-clock-file-total-minutes (aref ltimes 0)))))) + +(defun org-clock-sum-current-item (&optional tstart) + "Return time, clocked on current item in total." + (save-excursion + (save-restriction + (org-narrow-to-subtree) + (org-clock-sum tstart) + org-clock-file-total-minutes))) + +;;;###autoload +(defun org-clock-display (&optional total-only) + "Show subtree times in the entire buffer. +If TOTAL-ONLY is non-nil, only show the total time for the entire file +in the echo area. + +Use \\[org-clock-remove-overlays] to remove the subtree times." + (interactive) + (org-clock-remove-overlays) + (let (time h m p) + (org-clock-sum) + (unless total-only + (save-excursion + (goto-char (point-min)) + (while (or (and (equal (setq p (point)) (point-min)) + (get-text-property p :org-clock-minutes)) + (setq p (next-single-property-change + (point) :org-clock-minutes))) + (goto-char p) + (when (setq time (get-text-property p :org-clock-minutes)) + (org-clock-put-overlay time (funcall outline-level)))) + (setq h (/ org-clock-file-total-minutes 60) + m (- org-clock-file-total-minutes (* 60 h))) + ;; Arrange to remove the overlays upon next change. + (when org-remove-highlights-with-change + (org-add-hook 'before-change-functions 'org-clock-remove-overlays + nil 'local)))) + (message (concat "Total file time: " + (org-minutes-to-clocksum-string org-clock-file-total-minutes) + " (%d hours and %d minutes)") h m))) + +(defvar org-clock-overlays nil) +(make-variable-buffer-local 'org-clock-overlays) + +(defun org-clock-put-overlay (time &optional level) + "Put an overlays on the current line, displaying TIME. +If LEVEL is given, prefix time with a corresponding number of stars. +This creates a new overlay and stores it in `org-clock-overlays', so that it +will be easy to remove." + (let* ((l (if level (org-get-valid-level level 0) 0)) + ov tx) + (beginning-of-line) + (when (looking-at org-complex-heading-regexp) + (goto-char (match-beginning 4))) + (setq ov (make-overlay (point) (point-at-eol)) + tx (concat (buffer-substring-no-properties (point) (match-end 4)) + (make-string + (max 0 (- (- 60 (current-column)) + (- (match-end 4) (match-beginning 4)) + (length (org-get-at-bol 'line-prefix)))) ?.) + (org-add-props (concat (make-string l ?*) " " + (org-minutes-to-clocksum-string time) + (make-string (- 16 l) ?\ )) + (list 'face 'org-clock-overlay)) + "")) + (if (not (featurep 'xemacs)) + (overlay-put ov 'display tx) + (overlay-put ov 'invisible t) + (overlay-put ov 'end-glyph (make-glyph tx))) + (push ov org-clock-overlays))) + +;;;###autoload +(defun org-clock-remove-overlays (&optional beg end noremove) + "Remove the occur highlights from the buffer. +BEG and END are ignored. If NOREMOVE is nil, remove this function +from the `before-change-functions' in the current buffer." + (interactive) + (unless org-inhibit-highlight-removal + (mapc 'delete-overlay org-clock-overlays) + (setq org-clock-overlays nil) + (unless noremove + (remove-hook 'before-change-functions + 'org-clock-remove-overlays 'local)))) + +(defvar org-state) ;; dynamically scoped into this function +(defun org-clock-out-if-current () + "Clock out if the current entry contains the running clock. +This is used to stop the clock after a TODO entry is marked DONE, +and is only done if the variable `org-clock-out-when-done' is not nil." + (when (and (org-clocking-p) + org-clock-out-when-done + (marker-buffer org-clock-marker) + (or (and (eq t org-clock-out-when-done) + (member org-state org-done-keywords)) + (and (listp org-clock-out-when-done) + (member org-state org-clock-out-when-done))) + (equal (or (buffer-base-buffer (org-clocking-buffer)) + (org-clocking-buffer)) + (or (buffer-base-buffer (current-buffer)) + (current-buffer))) + (< (point) org-clock-marker) + (> (save-excursion (outline-next-heading) (point)) + org-clock-marker)) + ;; Clock out, but don't accept a logging message for this. + (let ((org-log-note-clock-out nil) + (org-clock-out-switch-to-state nil)) + (org-clock-out)))) + +(add-hook 'org-after-todo-state-change-hook + 'org-clock-out-if-current) + +;;;###autoload +(defun org-clock-get-clocktable (&rest props) + "Get a formatted clocktable with parameters according to PROPS. +The table is created in a temporary buffer, fully formatted and +fontified, and then returned." + ;; Set the defaults + (setq props (plist-put props :name "clocktable")) + (unless (plist-member props :maxlevel) + (setq props (plist-put props :maxlevel 2))) + (unless (plist-member props :scope) + (setq props (plist-put props :scope 'agenda))) + (with-temp-buffer + (org-mode) + (org-create-dblock props) + (org-update-dblock) + (font-lock-fontify-buffer) + (forward-line 2) + (buffer-substring (point) (progn + (re-search-forward "^[ \t]*#\\+END" nil t) + (point-at-bol))))) + +;;;###autoload +(defun org-clock-report (&optional arg) + "Create a table containing a report about clocked time. +If the cursor is inside an existing clocktable block, then the table +will be updated. If not, a new clocktable will be inserted. The scope +of the new clock will be subtree when called from within a subtree, and +file elsewhere. + +When called with a prefix argument, move to the first clock table in the +buffer and update it." + (interactive "P") + (org-clock-remove-overlays) + (when arg + (org-find-dblock "clocktable") + (org-show-entry)) + (if (org-in-clocktable-p) + (goto-char (org-in-clocktable-p)) + (let ((props (if (ignore-errors + (save-excursion (org-back-to-heading))) + (list :name "clocktable" :scope 'subtree) + (list :name "clocktable")))) + (org-create-dblock + (org-combine-plists org-clock-clocktable-default-properties props)))) + (org-update-dblock)) + +(defun org-day-of-week (day month year) + "Returns the day of the week as an integer." + (nth 6 + (decode-time + (date-to-time + (format "%d-%02d-%02dT00:00:00" year month day))))) + +(defun org-quarter-to-date (quarter year) + "Get the date (week day year) of the first day of a given quarter." + (let (startday) + (cond + ((= quarter 1) + (setq startday (org-day-of-week 1 1 year)) + (cond + ((= startday 0) + (list 52 7 (- year 1))) + ((= startday 6) + (list 52 6 (- year 1))) + ((<= startday 4) + (list 1 startday year)) + ((> startday 4) + (list 53 startday (- year 1))) + ) + ) + ((= quarter 2) + (setq startday (org-day-of-week 1 4 year)) + (cond + ((= startday 0) + (list 13 startday year)) + ((< startday 4) + (list 14 startday year)) + ((>= startday 4) + (list 13 startday year)) + ) + ) + ((= quarter 3) + (setq startday (org-day-of-week 1 7 year)) + (cond + ((= startday 0) + (list 26 startday year)) + ((< startday 4) + (list 27 startday year)) + ((>= startday 4) + (list 26 startday year)) + ) + ) + ((= quarter 4) + (setq startday (org-day-of-week 1 10 year)) + (cond + ((= startday 0) + (list 39 startday year)) + ((<= startday 4) + (list 40 startday year)) + ((> startday 4) + (list 39 startday year))))))) + +(defun org-clock-special-range (key &optional time as-strings wstart mstart) + "Return two times bordering a special time range. +Key is a symbol specifying the range and can be one of `today', `yesterday', +`thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'. +By default, a week starts Monday 0:00 and ends Sunday 24:00. +The range is determined relative to TIME, which defaults to current time. +The return value is a cons cell with two internal times like the ones +returned by `current time' or `encode-time'. +If AS-STRINGS is non-nil, the returned times will be formatted strings. +If WSTART is non-nil, use this number to specify the starting day of a +week (monday is 1). +If MSTART is non-nil, use this number to specify the starting day of a +month (1 is the first day of the month). +If you can combine both, the month starting day will have priority." + (if (integerp key) (setq key (intern (number-to-string key)))) + (let* ((tm (decode-time (or time (current-time)))) + (s 0) (m (nth 1 tm)) (h (nth 2 tm)) + (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm)) + (dow (nth 6 tm)) + (ws (or wstart 1)) + (ms (or mstart 1)) + (skey (symbol-name key)) + (shift 0) + (q (cond ((>= (nth 4 tm) 10) 4) + ((>= (nth 4 tm) 7) 3) + ((>= (nth 4 tm) 4) 2) + ((>= (nth 4 tm) 1) 1))) + s1 m1 h1 d1 month1 y1 diff ts te fm txt w date + interval tmp shiftedy shiftedm shiftedq) + (cond + ((string-match "^[0-9]+$" skey) + (setq y (string-to-number skey) m 1 d 1 key 'year)) + ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)$" skey) + (setq y (string-to-number (match-string 1 skey)) + month (string-to-number (match-string 2 skey)) + d 1 key 'month)) + ((string-match "^\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)$" skey) + (require 'cal-iso) + (setq y (string-to-number (match-string 1 skey)) + w (string-to-number (match-string 2 skey))) + (setq date (calendar-gregorian-from-absolute + (calendar-iso-to-absolute (list w 1 y)))) + (setq d (nth 1 date) month (car date) y (nth 2 date) + dow 1 + key 'week)) + ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey) + (require 'cal-iso) + (setq y (string-to-number (match-string 1 skey))) + (setq q (string-to-number (match-string 2 skey))) + (setq date (calendar-gregorian-from-absolute + (calendar-iso-to-absolute (org-quarter-to-date q y)))) + (setq d (nth 1 date) month (car date) y (nth 2 date) + dow 1 + key 'quarter)) + ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey) + (setq y (string-to-number (match-string 1 skey)) + month (string-to-number (match-string 2 skey)) + d (string-to-number (match-string 3 skey)) + key 'day)) + ((string-match "\\([-+][0-9]+\\)$" skey) + (setq shift (string-to-number (match-string 1 skey)) + key (intern (substring skey 0 (match-beginning 1)))) + (if (and (memq key '(quarter thisq)) (> shift 0)) + (error "Looking forward with quarters isn't implemented")))) + + (when (= shift 0) + (cond ((eq key 'yesterday) (setq key 'today shift -1)) + ((eq key 'lastweek) (setq key 'week shift -1)) + ((eq key 'lastmonth) (setq key 'month shift -1)) + ((eq key 'lastyear) (setq key 'year shift -1)) + ((eq key 'lastq) (setq key 'quarter shift -1)))) + (cond + ((memq key '(day today)) + (setq d (+ d shift) h 0 m 0 h1 24 m1 0)) + ((memq key '(week thisweek)) + (setq diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws))) + m 0 h 0 d (- d diff) d1 (+ 7 d))) + ((memq key '(month thismonth)) + (setq d (or ms 1) h 0 m 0 d1 (or ms 1) + month (+ month shift) month1 (1+ month) h1 0 m1 0)) + ((memq key '(quarter thisq)) + ;; Compute if this shift remains in this year. If not, compute + ;; how many years and quarters we have to shift (via floor*) and + ;; compute the shifted years, months and quarters. + (cond + ((< (+ (- q 1) shift) 0) ; shift not in this year + (setq interval (* -1 (+ (- q 1) shift))) + ;; Set tmp to ((years to shift) (quarters to shift)). + (setq tmp (org-floor* interval 4)) + ;; Due to the use of floor, 0 quarters actually means 4. + (if (= 0 (nth 1 tmp)) + (setq shiftedy (- y (nth 0 tmp)) + shiftedm 1 + shiftedq 1) + (setq shiftedy (- y (+ 1 (nth 0 tmp))) + shiftedm (- 13 (* 3 (nth 1 tmp))) + shiftedq (- 5 (nth 1 tmp)))) + (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy)) + ((> (+ q shift) 0) ; shift is within this year + (setq shiftedq (+ q shift)) + (setq shiftedy y) + (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0)))) + ((memq key '(year thisyear)) + (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y))) + (t (error "No such time block %s" key))) + (setq ts (encode-time s m h d month y) + te (encode-time (or s1 s) (or m1 m) (or h1 h) + (or d1 d) (or month1 month) (or y1 y))) + (setq fm (cdr org-time-stamp-formats)) + (cond + ((memq key '(day today)) + (setq txt (format-time-string "%A, %B %d, %Y" ts))) + ((memq key '(week thisweek)) + (setq txt (format-time-string "week %G-W%V" ts))) + ((memq key '(month thismonth)) + (setq txt (format-time-string "%B %Y" ts))) + ((memq key '(year thisyear)) + (setq txt (format-time-string "the year %Y" ts))) + ((memq key '(quarter thisq)) + (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))))) + (if as-strings + (list (format-time-string fm ts) (format-time-string fm te) txt) + (list ts te txt)))) + +(defun org-count-quarter (n) + (cond + ((= n 1) "1st") + ((= n 2) "2nd") + ((= n 3) "3rd") + ((= n 4) "4th"))) + +;;;###autoload +(defun org-clocktable-shift (dir n) + "Try to shift the :block date of the clocktable at point. +Point must be in the #+BEGIN: line of a clocktable, or this function +will throw an error. +DIR is a direction, a symbol `left', `right', `up', or `down'. +Both `left' and `down' shift the block toward the past, `up' and `right' +push it toward the future. +N is the number of shift steps to take. The size of the step depends on +the currently selected interval size." + (setq n (prefix-numeric-value n)) + (and (memq dir '(left down)) (setq n (- n))) + (save-excursion + (goto-char (point-at-bol)) + (if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)")) + (error "Line needs a :block definition before this command works") + (let* ((b (match-beginning 1)) (e (match-end 1)) + (s (match-string 1)) + block shift ins y mw d date wp m) + (cond + ((equal s "yesterday") (setq s "today-1")) + ((equal s "lastweek") (setq s "thisweek-1")) + ((equal s "lastmonth") (setq s "thismonth-1")) + ((equal s "lastyear") (setq s "thisyear-1")) + ((equal s "lastq") (setq s "thisq-1"))) + + (cond + ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s) + (setq block (match-string 1 s) + shift (if (match-end 2) + (string-to-number (match-string 2 s)) + 0)) + (setq shift (+ shift n)) + (setq ins (if (= shift 0) block (format "%s%+d" block shift)))) + ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s) + ;; 1 1 2 3 3 4 4 5 6 6 5 2 + (setq y (string-to-number (match-string 1 s)) + wp (and (match-end 3) (match-string 3 s)) + mw (and (match-end 4) (string-to-number (match-string 4 s))) + d (and (match-end 6) (string-to-number (match-string 6 s)))) + (cond + (d (setq ins (format-time-string + "%Y-%m-%d" + (encode-time 0 0 0 (+ d n) m y)))) + ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0)) + (require 'cal-iso) + (setq date (calendar-gregorian-from-absolute + (calendar-iso-to-absolute (list (+ mw n) 1 y)))) + (setq ins (format-time-string + "%G-W%V" + (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) + ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0)) + (require 'cal-iso) + ; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year + (if (> (+ mw n) 4) + (setq mw 0 + y (+ 1 y)) + ()) + ; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year + (if (= (+ mw n) 0) + (setq mw 5 + y (- y 1)) + ()) + (setq date (calendar-gregorian-from-absolute + (calendar-iso-to-absolute (org-quarter-to-date (+ mw n) y)))) + (setq ins (format-time-string + (concat (number-to-string y) "-Q" (number-to-string (+ mw n))) + (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) + (mw + (setq ins (format-time-string + "%Y-%m" + (encode-time 0 0 0 1 (+ mw n) y)))) + (y + (setq ins (number-to-string (+ y n)))))) + (t (error "Cannot shift clocktable block"))) + (when ins + (goto-char b) + (insert ins) + (delete-region (point) (+ (point) (- e b))) + (beginning-of-line 1) + (org-update-dblock) + t))))) + +;;;###autoload +(defun org-dblock-write:clocktable (params) + "Write the standard clocktable." + (setq params (org-combine-plists org-clocktable-defaults params)) + (catch 'exit + (let* ((scope (plist-get params :scope)) + (block (plist-get params :block)) + (ts (plist-get params :tstart)) + (te (plist-get params :tend)) + (link (plist-get params :link)) + (maxlevel (or (plist-get params :maxlevel) 3)) + (ws (plist-get params :wstart)) + (ms (plist-get params :mstart)) + (step (plist-get params :step)) + (timestamp (plist-get params :timestamp)) + (formatter (or (plist-get params :formatter) + org-clock-clocktable-formatter + 'org-clocktable-write-default)) + cc range-text ipos pos one-file-with-archives + scope-is-list tbls level) + ;; Check if we need to do steps + (when block + ;; Get the range text for the header + (setq cc (org-clock-special-range block nil t ws ms) + ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) + (when step + ;; Write many tables, in steps + (unless (or block (and ts te)) + (error "Clocktable `:step' can only be used with `:block' or `:tstart,:end'")) + (org-clocktable-steps params) + (throw 'exit nil)) + + (setq ipos (point)) ; remember the insertion position + + ;; Get the right scope + (setq pos (point)) + (cond + ((and scope (listp scope) (symbolp (car scope))) + (setq scope (eval scope))) + ((eq scope 'agenda) + (setq scope (org-agenda-files t))) + ((eq scope 'agenda-with-archives) + (setq scope (org-agenda-files t)) + (setq scope (org-add-archive-files scope))) + ((eq scope 'file-with-archives) + (setq scope (org-add-archive-files (list (buffer-file-name))) + one-file-with-archives t))) + (setq scope-is-list (and scope (listp scope))) + (if scope-is-list + ;; we collect from several files + (let* ((files scope) + file) + (org-agenda-prepare-buffers files) + (while (setq file (pop files)) + (with-current-buffer (find-buffer-visiting file) + (save-excursion + (save-restriction + (push (org-clock-get-table-data file params) tbls)))))) + ;; Just from the current file + (save-restriction + ;; get the right range into the restriction + (org-agenda-prepare-buffers (list (buffer-file-name))) + (cond + ((not scope)) ; use the restriction as it is now + ((eq scope 'file) (widen)) + ((eq scope 'subtree) (org-narrow-to-subtree)) + ((eq scope 'tree) + (while (org-up-heading-safe)) + (org-narrow-to-subtree)) + ((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$" + (symbol-name scope))) + (setq level (string-to-number (match-string 1 (symbol-name scope)))) + (catch 'exit + (while (org-up-heading-safe) + (looking-at org-outline-regexp) + (if (<= (org-reduced-level (funcall outline-level)) level) + (throw 'exit nil)))) + (org-narrow-to-subtree))) + ;; do the table, with no file name. + (push (org-clock-get-table-data nil params) tbls))) + + ;; OK, at this point we tbls as a list of tables, one per file + (setq tbls (nreverse tbls)) + + (setq params (plist-put params :multifile scope-is-list)) + (setq params (plist-put params :one-file-with-archives + one-file-with-archives)) + + (funcall formatter ipos tbls params)))) + +(defun org-clocktable-write-default (ipos tables params) + "Write out a clock table at position IPOS in the current buffer. +TABLES is a list of tables with clocking data as produced by +`org-clock-get-table-data'. PARAMS is the parameter property list obtained +from the dynamic block definition." + ;; This function looks quite complicated, mainly because there are a + ;; lot of options which can add or remove columns. I have massively + ;; commented this function, the I hope it is understandable. If + ;; someone wants to write their own special formatter, this maybe + ;; much easier because there can be a fixed format with a + ;; well-defined number of columns... + (let* ((hlchars '((1 . "*") (2 . "/"))) + (lwords (assoc (or (plist-get params :lang) + (org-bound-and-true-p org-export-default-language) + "en") + org-clock-clocktable-language-setup)) + (multifile (plist-get params :multifile)) + (block (plist-get params :block)) + (ts (plist-get params :tstart)) + (te (plist-get params :tend)) + (header (plist-get params :header)) + (narrow (plist-get params :narrow)) + (ws (or (plist-get params :wstart) 1)) + (ms (or (plist-get params :mstart) 1)) + (link (plist-get params :link)) + (maxlevel (or (plist-get params :maxlevel) 3)) + (emph (plist-get params :emphasize)) + (level-p (plist-get params :level)) + (org-time-clocksum-use-effort-durations + (plist-get params :effort-durations)) + (timestamp (plist-get params :timestamp)) + (properties (plist-get params :properties)) + (ntcol (max 1 (or (plist-get params :tcolumns) 100))) + (rm-file-column (plist-get params :one-file-with-archives)) + (indent (plist-get params :indent)) + (case-fold-search t) + range-text total-time tbl level hlc formula pcol + file-time entries entry headline + recalc content narrow-cut-p tcol) + + ;; Implement abbreviations + (when (plist-get params :compact) + (setq level nil indent t narrow (or narrow '40!) ntcol 1)) + + ;; Some consistency test for parameters + (unless (integerp ntcol) + (setq params (plist-put params :tcolumns (setq ntcol 100)))) + + (when (and narrow (integerp narrow) link) + ;; We cannot have both integer narrow and link + (message + "Using hard narrowing in clocktable to allow for links") + (setq narrow (intern (format "%d!" narrow)))) + + (when narrow + (cond + ((integerp narrow)) + ((and (symbolp narrow) + (string-match "\\`[0-9]+!\\'" (symbol-name narrow))) + (setq narrow-cut-p t + narrow (string-to-number (substring (symbol-name narrow) + 0 -1)))) + (t + (error "Invalid value %s of :narrow property in clock table" + narrow)))) + + (when block + ;; Get the range text for the header + (setq range-text (nth 2 (org-clock-special-range block nil t ws ms)))) + + ;; Compute the total time + (setq total-time (apply '+ (mapcar 'cadr tables))) + + ;; Now we need to output this tsuff + (goto-char ipos) + + ;; Insert the text *before* the actual table + (insert-before-markers + (or header + ;; Format the standard header + (concat + "#+CAPTION: " + (nth 9 lwords) " [" + (substring + (format-time-string (cdr org-time-stamp-formats)) + 1 -1) + "]" + (if block (concat ", for " range-text ".") "") + "\n"))) + + ;; Insert the narrowing line + (when (and narrow (integerp narrow) (not narrow-cut-p)) + (insert-before-markers + "|" ; table line starter + (if multifile "|" "") ; file column, maybe + (if level-p "|" "") ; level column, maybe + (if timestamp "|" "") ; timestamp column, maybe + (if properties (make-string (length properties) ?|) "") ;properties columns, maybe + (format "<%d>| |\n" narrow))) ; headline and time columns + + ;; Insert the table header line + (insert-before-markers + "|" ; table line starter + (if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe + (if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe + (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe + (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe + (concat (nth 4 lwords) "|" + (nth 5 lwords) "|\n")) ; headline and time columns + + ;; Insert the total time in the table + (insert-before-markers + "|-\n" ; a hline + "|" ; table line starter + (if multifile (concat "| " (nth 6 lwords) " ") "") + ; file column, maybe + (if level-p "|" "") ; level column, maybe + (if timestamp "|" "") ; timestamp column, maybe + (if properties (make-string (length properties) ?|) "") ; properties columns, maybe + (concat (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline + (format org-clock-total-time-cell-format + (org-minutes-to-clocksum-string (or total-time 0))) ; the time + "|\n") ; close line + + ;; Now iterate over the tables and insert the data + ;; but only if any time has been collected + (when (and total-time (> total-time 0)) + + (while (setq tbl (pop tables)) + ;; now tbl is the table resulting from one file. + (setq file-time (nth 1 tbl)) + (when (or (and file-time (> file-time 0)) + (not (plist-get params :fileskip0))) + (insert-before-markers "|-\n") ; a hline because a new file starts + ;; First the file time, if we have multiple files + (when multifile + ;; Summarize the time collected from this file + (insert-before-markers + (format (concat "| %s %s | %s%s" + (format org-clock-file-time-cell-format (nth 8 lwords)) + " | *%s*|\n") + (file-name-nondirectory (car tbl)) + (if level-p "| " "") ; level column, maybe + (if timestamp "| " "") ; timestamp column, maybe + (if properties (make-string (length properties) ?|) "") ;properties columns, maybe + (org-minutes-to-clocksum-string (nth 1 tbl))))) ; the time + + ;; Get the list of node entries and iterate over it + (setq entries (nth 2 tbl)) + (while (setq entry (pop entries)) + (setq level (car entry) + headline (nth 1 entry) + hlc (if emph (or (cdr (assoc level hlchars)) "") "")) + (when narrow-cut-p + (if (and (string-match (concat "\\`" org-bracket-link-regexp + "\\'") + headline) + (match-end 3)) + (setq headline + (format "[[%s][%s]]" + (match-string 1 headline) + (org-shorten-string (match-string 3 headline) + narrow))) + (setq headline (org-shorten-string headline narrow)))) + (insert-before-markers + "|" ; start the table line + (if multifile "|" "") ; free space for file name column? + (if level-p (format "%d|" (car entry)) "") ; level, maybe + (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe + (if properties + (concat + (mapconcat + (lambda (p) (or (cdr (assoc p (nth 4 entry))) "")) + properties "|") "|") "") ;properties columns, maybe + (if indent (org-clocktable-indent-string level) "") ; indentation + hlc headline hlc "|" ; headline + (make-string (min (1- ntcol) (or (- level 1))) ?|) + ; empty fields for higher levels + hlc (org-minutes-to-clocksum-string (nth 3 entry)) hlc ; time + "|\n" ; close line + ))))) + ;; When exporting subtrees or regions the region might be + ;; activated, so let's disable ̀delete-active-region' + (let ((delete-active-region nil)) (backward-delete-char 1)) + (if (setq formula (plist-get params :formula)) + (cond + ((eq formula '%) + ;; compute the column where the % numbers need to go + (setq pcol (+ 2 + (if multifile 1 0) + (if level-p 1 0) + (if timestamp 1 0) + (min maxlevel (or ntcol 100)))) + ;; compute the column where the total time is + (setq tcol (+ 2 + (if multifile 1 0) + (if level-p 1 0) + (if timestamp 1 0))) + (insert + (format + "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f" + pcol ; the column where the % numbers should go + (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time + tcol ; column of the total time + tcol (1- pcol) ; range of columns where times can be found + )) + (setq recalc t)) + ((stringp formula) + (insert "\n#+TBLFM: " formula) + (setq recalc t)) + (t (error "Invalid formula in clocktable"))) + ;; Should we rescue an old formula? + (when (stringp (setq content (plist-get params :content))) + (when (string-match "^\\([ \t]*#\\+tblfm:.*\\)" content) + (setq recalc t) + (insert "\n" (match-string 1 (plist-get params :content))) + (beginning-of-line 0)))) + ;; Back to beginning, align the table, recalculate if necessary + (goto-char ipos) + (skip-chars-forward "^|") + (org-table-align) + (when org-hide-emphasis-markers + ;; we need to align a second time + (org-table-align)) + (when recalc + (if (eq formula '%) + (save-excursion + (if (and narrow (not narrow-cut-p)) (beginning-of-line 2)) + (org-table-goto-column pcol nil 'force) + (insert "%"))) + (org-table-recalculate 'all)) + (when rm-file-column + ;; The file column is actually not wanted + (forward-char 1) + (org-table-delete-column)) + total-time)) + +(defun org-clocktable-indent-string (level) + (if (= level 1) "" + (let ((str " ")) + (dotimes (k (1- level) str) + (setq str (concat "\\emsp" str)))))) + +(defun org-clocktable-steps (params) + "Step through the range to make a number of clock tables." + (let* ((p1 (copy-sequence params)) + (ts (plist-get p1 :tstart)) + (te (plist-get p1 :tend)) + (ws (plist-get p1 :wstart)) + (ms (plist-get p1 :mstart)) + (step0 (plist-get p1 :step)) + (step (cdr (assoc step0 '((day . 86400) (week . 604800))))) + (stepskip0 (plist-get p1 :stepskip0)) + (block (plist-get p1 :block)) + cc range-text step-time tsb) + (when block + (setq cc (org-clock-special-range block nil t ws ms) + ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) + (cond + ((numberp ts) + ;; If ts is a number, it's an absolute day number from org-agenda. + (destructuring-bind (month day year) (calendar-gregorian-from-absolute ts) + (setq ts (org-float-time (encode-time 0 0 0 day month year))))) + (ts + (setq ts (org-float-time + (apply 'encode-time (org-parse-time-string ts)))))) + (cond + ((numberp te) + ;; Likewise for te. + (destructuring-bind (month day year) (calendar-gregorian-from-absolute te) + (setq te (org-float-time (encode-time 0 0 0 day month year))))) + (te + (setq te (org-float-time + (apply 'encode-time (org-parse-time-string te)))))) + (setq tsb + (if (eq step0 'week) + (- ts (* 86400 (- (nth 6 (decode-time (seconds-to-time ts))) ws))) + ts)) + (setq p1 (plist-put p1 :header "")) + (setq p1 (plist-put p1 :step nil)) + (setq p1 (plist-put p1 :block nil)) + (while (< tsb te) + (or (bolp) (insert "\n")) + (setq p1 (plist-put p1 :tstart (format-time-string + (org-time-stamp-format nil t) + (seconds-to-time (max tsb ts))))) + (setq p1 (plist-put p1 :tend (format-time-string + (org-time-stamp-format nil t) + (seconds-to-time (min te (setq tsb (+ tsb step))))))) + (insert "\n" (if (eq step0 'day) "Daily report: " + "Weekly report starting on: ") + (plist-get p1 :tstart) "\n") + (setq step-time (org-dblock-write:clocktable p1)) + (re-search-forward "^[ \t]*#\\+END:") + (when (and (equal step-time 0) stepskip0) + ;; Remove the empty table + (delete-region (point-at-bol) + (save-excursion + (re-search-backward "^\\(Daily\\|Weekly\\) report" + nil t) + (point)))) + (end-of-line 0)))) + +(defun org-clock-get-table-data (file params) + "Get the clocktable data for file FILE, with parameters PARAMS. +FILE is only for identification - this function assumes that +the correct buffer is current, and that the wanted restriction is +in place. +The return value will be a list with the file name and the total +file time (in minutes) as 1st and 2nd elements. The third element +of this list will be a list of headline entries. Each entry has the +following structure: + + (LEVEL HEADLINE TIMESTAMP TIME) + +LEVEL: The level of the headline, as an integer. This will be + the reduced leve, so 1,2,3,... even if only odd levels + are being used. +HEADLINE: The text of the headline. Depending on PARAMS, this may + already be formatted like a link. +TIMESTAMP: If PARAMS require it, this will be a time stamp found in the + entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive, + in this sequence. +TIME: The sum of all time spend in this tree, in minutes. This time + will of cause be restricted to the time block and tags match + specified in PARAMS." + (let* ((maxlevel (or (plist-get params :maxlevel) 3)) + (timestamp (plist-get params :timestamp)) + (ts (plist-get params :tstart)) + (te (plist-get params :tend)) + (ws (plist-get params :wstart)) + (ms (plist-get params :mstart)) + (block (plist-get params :block)) + (link (plist-get params :link)) + (tags (plist-get params :tags)) + (properties (plist-get params :properties)) + (inherit-property-p (plist-get params :inherit-props)) + todo-only + (matcher (if tags (cdr (org-make-tags-matcher tags)))) + cc range-text st p time level hdl props tsp tbl) + + (setq org-clock-file-total-minutes nil) + (when block + (setq cc (org-clock-special-range block nil t ws ms) + ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) + (when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts))) + (when (integerp te) (setq te (calendar-gregorian-from-absolute te))) + (when (and ts (listp ts)) + (setq ts (format "%4d-%02d-%02d" (nth 2 ts) (car ts) (nth 1 ts)))) + (when (and te (listp te)) + (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te)))) + ;; Now the times are strings we can parse. + (if ts (setq ts (org-float-time + (seconds-to-time (org-matcher-time ts))))) + (if te (setq te (org-float-time + (seconds-to-time (org-matcher-time te))))) + (save-excursion + (org-clock-sum ts te + (unless (null matcher) + (lambda () + (let* ((tags-list (org-get-tags-at)) + (org-scanner-tags tags-list) + (org-trust-scanner-tags t)) + (eval matcher))))) + (goto-char (point-min)) + (setq st t) + (while (or (and (bobp) (prog1 st (setq st nil)) + (get-text-property (point) :org-clock-minutes) + (setq p (point-min))) + (setq p (next-single-property-change + (point) :org-clock-minutes))) + (goto-char p) + (when (setq time (get-text-property p :org-clock-minutes)) + (save-excursion + (beginning-of-line 1) + (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$")) + (setq level (org-reduced-level + (- (match-end 1) (match-beginning 1)))) + (<= level maxlevel)) + (setq hdl (if (not link) + (match-string 2) + (org-make-link-string + (format "file:%s::%s" + (buffer-file-name) + (save-match-data + (match-string 2))) + (org-make-org-heading-search-string + (replace-regexp-in-string + org-bracket-link-regexp + (lambda (m) (or (match-string 3 m) + (match-string 1 m))) + (match-string 2))))) + tsp (when timestamp + (setq props (org-entry-properties (point))) + (or (cdr (assoc "SCHEDULED" props)) + (cdr (assoc "DEADLINE" props)) + (cdr (assoc "TIMESTAMP" props)) + (cdr (assoc "TIMESTAMP_IA" props)))) + props (when properties + (remove nil + (mapcar + (lambda (p) + (when (org-entry-get (point) p inherit-property-p) + (cons p (org-entry-get (point) p inherit-property-p)))) + properties)))) + (when (> time 0) (push (list level hdl tsp time props) tbl)))))) + (setq tbl (nreverse tbl)) + (list file org-clock-file-total-minutes tbl)))) + +(defun org-clock-time% (total &rest strings) + "Compute a time fraction in percent. +TOTAL s a time string like 10:21 specifying the total times. +STRINGS is a list of strings that should be checked for a time. +The first string that does have a time will be used. +This function is made for clock tables." + (let ((re "\\([0-9]+\\):\\([0-9]+\\)") + tot s) + (save-match-data + (catch 'exit + (if (not (string-match re total)) + (throw 'exit 0.) + (setq tot (+ (string-to-number (match-string 2 total)) + (* 60 (string-to-number (match-string 1 total))))) + (if (= tot 0.) (throw 'exit 0.))) + (while (setq s (pop strings)) + (if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s) + (throw 'exit + (/ (* 100.0 (+ (string-to-number (match-string 2 s)) + (* 60 (string-to-number + (match-string 1 s))))) + tot)))) + 0)))) + +;; Saving and loading the clock + +(defvar org-clock-loaded nil + "Was the clock file loaded?") + +;;;###autoload +(defun org-clock-update-time-maybe () + "If this is a CLOCK line, update it and return t. +Otherwise, return nil." + (interactive) + (save-excursion + (beginning-of-line 1) + (skip-chars-forward " \t") + (when (looking-at org-clock-string) + (let ((re (concat "[ \t]*" org-clock-string + " *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]" + "\\([ \t]*=>.*\\)?\\)?")) + ts te h m s neg) + (cond + ((not (looking-at re)) + nil) + ((not (match-end 2)) + (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) + (> org-clock-marker (point)) + (<= org-clock-marker (point-at-eol))) + ;; The clock is running here + (setq org-clock-start-time + (apply 'encode-time + (org-parse-time-string (match-string 1)))) + (org-clock-update-mode-line))) + (t + (and (match-end 4) (delete-region (match-beginning 4) (match-end 4))) + (end-of-line 1) + (setq ts (match-string 1) + te (match-string 3)) + (setq s (- (org-float-time + (apply 'encode-time (org-parse-time-string te))) + (org-float-time + (apply 'encode-time (org-parse-time-string ts)))) + neg (< s 0) + s (abs s) + h (floor (/ s 3600)) + s (- s (* 3600 h)) + m (floor (/ s 60)) + s (- s (* 60 s))) + (insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m)) + t)))))) + +(defun org-clock-save () + "Persist various clock-related data to disk. +The details of what will be saved are regulated by the variable +`org-clock-persist'." + (when (and org-clock-persist + (or org-clock-loaded + org-clock-has-been-used + (not (file-exists-p org-clock-persist-file)))) + (let (b) + (with-current-buffer (find-file (expand-file-name org-clock-persist-file)) + (progn + (delete-region (point-min) (point-max)) + ;;Store clock + (insert (format ";; org-persist.el - %s at %s\n" + system-name (format-time-string + (cdr org-time-stamp-formats)))) + (if (and (memq org-clock-persist '(t clock)) + (setq b (org-clocking-buffer)) + (setq b (or (buffer-base-buffer b) b)) + (buffer-live-p b) + (buffer-file-name b) + (or (not org-clock-persist-query-save) + (y-or-n-p (concat "Save current clock (" + org-clock-heading ") ")))) + (insert "(setq resume-clock '(\"" + (buffer-file-name (org-clocking-buffer)) + "\" . " (int-to-string (marker-position org-clock-marker)) + "))\n")) + ;; Store clocked task history. Tasks are stored reversed to make + ;; reading simpler + (when (and (memq org-clock-persist '(t history)) + org-clock-history) + (insert + "(setq stored-clock-history '(" + (mapconcat + (lambda (m) + (when (and (setq b (marker-buffer m)) + (setq b (or (buffer-base-buffer b) b)) + (buffer-live-p b) + (buffer-file-name b)) + (concat "(\"" (buffer-file-name b) + "\" . " (int-to-string (marker-position m)) + ")"))) + (reverse org-clock-history) " ") "))\n")) + (save-buffer) + (kill-buffer (current-buffer))))))) + +(defun org-clock-load () + "Load clock-related data from disk, maybe resuming a stored clock." + (when (and org-clock-persist (not org-clock-loaded)) + (let ((filename (expand-file-name org-clock-persist-file)) + (org-clock-in-resume 'auto-restart) + resume-clock stored-clock-history) + (if (not (file-readable-p filename)) + (message "Not restoring clock data; %s not found" + org-clock-persist-file) + (message "%s" "Restoring clock data") + (setq org-clock-loaded t) + (load-file filename) + ;; load history + (when stored-clock-history + (save-window-excursion + (mapc (lambda (task) + (if (file-exists-p (car task)) + (org-clock-history-push (cdr task) + (find-file (car task))))) + stored-clock-history))) + ;; resume clock + (when (and resume-clock org-clock-persist + (file-exists-p (car resume-clock)) + (or (not org-clock-persist-query-resume) + (y-or-n-p + (concat + "Resume clock (" + (with-current-buffer (find-file (car resume-clock)) + (save-excursion + (goto-char (cdr resume-clock)) + (org-back-to-heading t) + (and (looking-at org-complex-heading-regexp) + (match-string 4)))) + ") ")))) + (when (file-exists-p (car resume-clock)) + (with-current-buffer (find-file (car resume-clock)) + (goto-char (cdr resume-clock)) + (let ((org-clock-auto-clock-resolution nil)) + (org-clock-in) + (if (outline-invisible-p) + (org-show-context)))))))))) + +;; Suggested bindings +(org-defkey org-mode-map "\C-c\C-x\C-e" 'org-clock-modify-effort-estimate) + +(provide 'org-clock) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-clock.el ends here diff --git a/elpa/org-20150427/org-colview.el b/elpa/org-20150427/org-colview.el new file mode 100644 index 00000000..07ee69f1 --- /dev/null +++ b/elpa/org-20150427/org-colview.el @@ -0,0 +1,1586 @@ +;;; org-colview.el --- Column View in Org-mode + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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 . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains the column view for Org. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'org) + +(declare-function org-agenda-redo "org-agenda" ()) +(declare-function org-agenda-do-context-action "org-agenda" ()) +(declare-function org-clock-sum-today "org-clock" (&optional headline-filter)) + +(when (featurep 'xemacs) + (error "Do not load this file into XEmacs, use `org-colview-xemacs.el' from the contrib/ directory")) + +;;; Column View + +(defvar org-columns-overlays nil + "Holds the list of current column overlays.") + +(defvar org-columns-current-fmt nil + "Local variable, holds the currently active column format.") +(make-variable-buffer-local 'org-columns-current-fmt) +(defvar org-columns-current-fmt-compiled nil + "Local variable, holds the currently active column format. +This is the compiled version of the format.") +(make-variable-buffer-local 'org-columns-current-fmt-compiled) +(defvar org-columns-current-widths nil + "Loval variable, holds the currently widths of fields.") +(make-variable-buffer-local 'org-columns-current-widths) +(defvar org-columns-current-maxwidths nil + "Loval variable, holds the currently active maximum column widths.") +(make-variable-buffer-local 'org-columns-current-maxwidths) +(defvar org-columns-begin-marker (make-marker) + "Points to the position where last a column creation command was called.") +(defvar org-columns-top-level-marker (make-marker) + "Points to the position where current columns region starts.") + +(defvar org-columns-map (make-sparse-keymap) + "The keymap valid in column display.") + +(defun org-columns-content () + "Switch to contents view while in columns view." + (interactive) + (org-overview) + (org-content)) + +(org-defkey org-columns-map "c" 'org-columns-content) +(org-defkey org-columns-map "o" 'org-overview) +(org-defkey org-columns-map "e" 'org-columns-edit-value) +(org-defkey org-columns-map "\C-c\C-t" 'org-columns-todo) +(org-defkey org-columns-map "\C-c\C-c" 'org-columns-set-tags-or-toggle) +(org-defkey org-columns-map "\C-c\C-o" 'org-columns-open-link) +(org-defkey org-columns-map "v" 'org-columns-show-value) +(org-defkey org-columns-map "q" 'org-columns-quit) +(org-defkey org-columns-map "r" 'org-columns-redo) +(org-defkey org-columns-map "g" 'org-columns-redo) +(org-defkey org-columns-map [left] 'backward-char) +(org-defkey org-columns-map "\M-b" 'backward-char) +(org-defkey org-columns-map "a" 'org-columns-edit-allowed) +(org-defkey org-columns-map "s" 'org-columns-edit-attributes) +(org-defkey org-columns-map "\M-f" + (lambda () (interactive) (goto-char (1+ (point))))) +(org-defkey org-columns-map [right] + (lambda () (interactive) (goto-char (1+ (point))))) +(org-defkey org-columns-map [down] + (lambda () (interactive) + (let ((col (current-column))) + (beginning-of-line 2) + (while (and (org-invisible-p2) (not (eobp))) + (beginning-of-line 2)) + (move-to-column col) + (if (eq major-mode 'org-agenda-mode) + (org-agenda-do-context-action))))) +(org-defkey org-columns-map [up] + (lambda () (interactive) + (let ((col (current-column))) + (beginning-of-line 0) + (while (and (org-invisible-p2) (not (bobp))) + (beginning-of-line 0)) + (move-to-column col) + (if (eq major-mode 'org-agenda-mode) + (org-agenda-do-context-action))))) +(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value) +(org-defkey org-columns-map "n" 'org-columns-next-allowed-value) +(org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value) +(org-defkey org-columns-map "p" 'org-columns-previous-allowed-value) +(org-defkey org-columns-map "<" 'org-columns-narrow) +(org-defkey org-columns-map ">" 'org-columns-widen) +(org-defkey org-columns-map [(meta right)] 'org-columns-move-right) +(org-defkey org-columns-map [(meta left)] 'org-columns-move-left) +(org-defkey org-columns-map [(shift meta right)] 'org-columns-new) +(org-defkey org-columns-map [(shift meta left)] 'org-columns-delete) +(dotimes (i 10) + (org-defkey org-columns-map (number-to-string i) + `(lambda () (interactive) + (org-columns-next-allowed-value nil ,i)))) + +(easy-menu-define org-columns-menu org-columns-map "Org Column Menu" + '("Column" + ["Edit property" org-columns-edit-value t] + ["Next allowed value" org-columns-next-allowed-value t] + ["Previous allowed value" org-columns-previous-allowed-value t] + ["Show full value" org-columns-show-value t] + ["Edit allowed values" org-columns-edit-allowed t] + "--" + ["Edit column attributes" org-columns-edit-attributes t] + ["Increase column width" org-columns-widen t] + ["Decrease column width" org-columns-narrow t] + "--" + ["Move column right" org-columns-move-right t] + ["Move column left" org-columns-move-left t] + ["Add column" org-columns-new t] + ["Delete column" org-columns-delete t] + "--" + ["CONTENTS" org-columns-content t] + ["OVERVIEW" org-overview t] + ["Refresh columns display" org-columns-redo t] + "--" + ["Open link" org-columns-open-link t] + "--" + ["Quit" org-columns-quit t])) + +(defun org-columns-new-overlay (beg end &optional string face) + "Create a new column overlay and add it to the list." + (let ((ov (make-overlay beg end))) + (overlay-put ov 'face (or face 'secondary-selection)) + (remove-text-properties 0 (length string) '(face nil) string) + (org-overlay-display ov string face) + (push ov org-columns-overlays) + ov)) + +(defun org-columns-display-here (&optional props dateline) + "Overlay the current line with column display." + (interactive) + (let* ((fmt org-columns-current-fmt-compiled) + (beg (point-at-bol)) + (level-face (save-excursion + (beginning-of-line 1) + (and (looking-at "\\(\\**\\)\\(\\* \\)") + (org-get-level-face 2)))) + (ref-face (or level-face + (and (eq major-mode 'org-agenda-mode) + (get-text-property (point-at-bol) 'face)) + 'default)) + (color (list :foreground (face-attribute ref-face :foreground))) + (font (list :height (face-attribute 'default :height) + :family (face-attribute 'default :family))) + (face (list color font 'org-column ref-face)) + (face1 (list color font 'org-agenda-column-dateline ref-face)) + (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp)) + pom property ass width f fc string fm ov column val modval s2 title calc) + ;; Check if the entry is in another buffer. + (unless props + (if (eq major-mode 'org-agenda-mode) + (setq pom (or (org-get-at-bol 'org-hd-marker) + (org-get-at-bol 'org-marker)) + props (if pom (org-entry-properties pom) nil)) + (setq props (org-entry-properties nil)))) + ;; Walk the format + (while (setq column (pop fmt)) + (setq property (car column) + title (nth 1 column) + ass (if (equal property "ITEM") + (cons "ITEM" + ;; When in a buffer, get the whole line, + ;; we'll clean it later… + (if (derived-mode-p 'org-mode) + (save-match-data + (org-remove-tabs + (buffer-substring-no-properties + (point-at-bol) (point-at-eol)))) + ;; In agenda, just get the `txt' property + (or (org-get-at-bol 'txt) + (buffer-substring-no-properties + (point) (progn (end-of-line) (point)))))) + (assoc property props)) + width (or (cdr (assoc property org-columns-current-maxwidths)) + (nth 2 column) + (length property)) + f (format "%%-%d.%ds | " width width) + fm (nth 4 column) + fc (nth 5 column) + calc (nth 7 column) + val (or (cdr ass) "") + modval (cond ((and org-columns-modify-value-for-display-function + (functionp + org-columns-modify-value-for-display-function)) + (funcall org-columns-modify-value-for-display-function + title val)) + ((equal property "ITEM") + (org-columns-cleanup-item + val org-columns-current-fmt-compiled + (or org-complex-heading-regexp cphr))) + (fc (org-columns-number-to-string + (org-columns-string-to-number val fm) fm fc)) + ((and calc (functionp calc) + (not (string= val "")) + (not (get-text-property 0 'org-computed val))) + (org-columns-number-to-string + (funcall calc (org-columns-string-to-number + val fm)) fm)))) + (setq s2 (org-columns-add-ellipses (or modval val) width)) + (setq string (format f s2)) + ;; Create the overlay + (org-with-silent-modifications + (setq ov (org-columns-new-overlay + beg (setq beg (1+ beg)) string (if dateline face1 face))) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'org-columns-key property) + (overlay-put ov 'org-columns-value (cdr ass)) + (overlay-put ov 'org-columns-value-modified modval) + (overlay-put ov 'org-columns-pom pom) + (overlay-put ov 'org-columns-format f) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "")) + (if (or (not (char-after beg)) + (equal (char-after beg) ?\n)) + (let ((inhibit-read-only t)) + (save-excursion + (goto-char beg) + (org-unmodified (insert " ")))))) ;; FIXME: add props and remove later? + ;; Make the rest of the line disappear. + (org-unmodified + (setq ov (org-columns-new-overlay beg (point-at-eol))) + (overlay-put ov 'invisible t) + (overlay-put ov 'keymap org-columns-map) + (overlay-put ov 'intangible t) + (overlay-put ov 'line-prefix "") + (overlay-put ov 'wrap-prefix "") + (push ov org-columns-overlays) + (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) + (overlay-put ov 'keymap org-columns-map) + (push ov org-columns-overlays) + (let ((inhibit-read-only t)) + (put-text-property (max (point-min) (1- (point-at-bol))) + (min (point-max) (1+ (point-at-eol))) + 'read-only "Type `e' to edit property"))))) + +(defun org-columns-add-ellipses (string width) + "Truncate STRING with WIDTH characters, with ellipses." + (cond + ((<= (length string) width) string) + ((<= width (length org-columns-ellipses)) + (substring org-columns-ellipses 0 width)) + (t (concat (substring string 0 (- width (length org-columns-ellipses))) + org-columns-ellipses)))) + +(defvar org-columns-full-header-line-format nil + "The full header line format, will be shifted by horizontal scrolling." ) +(defvar org-previous-header-line-format nil + "The header line format before column view was turned on.") +(defvar org-columns-inhibit-recalculation nil + "Inhibit recomputing of columns on column view startup.") +(defvar org-columns-flyspell-was-active nil + "Remember the state of `flyspell-mode' before column view. +Flyspell-mode can cause problems in columns view, so it is turned off +for the duration of the command.") + +(defvar header-line-format) +(defvar org-columns-previous-hscroll 0) + +(defun org-columns-display-here-title () + "Overlay the newline before the current line with the table title." + (interactive) + (let ((fmt org-columns-current-fmt-compiled) + string (title "") + property width f column str widths) + (while (setq column (pop fmt)) + (setq property (car column) + str (or (nth 1 column) property) + width (or (cdr (assoc property org-columns-current-maxwidths)) + (nth 2 column) + (length str)) + widths (push width widths) + f (format "%%-%d.%ds | " width width) + string (format f str) + title (concat title string))) + (setq title (concat + (org-add-props " " nil 'display '(space :align-to 0)) + ;;(org-add-props title nil 'face '(:weight bold :underline t :inherit default)))) + (org-add-props title nil 'face 'org-column-title))) + (org-set-local 'org-previous-header-line-format header-line-format) + (org-set-local 'org-columns-current-widths (nreverse widths)) + (setq org-columns-full-header-line-format title) + (setq org-columns-previous-hscroll -1) + ; (org-columns-hscoll-title) + (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local))) + +(defun org-columns-hscoll-title () + "Set the `header-line-format' so that it scrolls along with the table." + (sit-for .0001) ; need to force a redisplay to update window-hscroll + (when (not (= (window-hscroll) org-columns-previous-hscroll)) + (setq header-line-format + (concat (substring org-columns-full-header-line-format 0 1) + (substring org-columns-full-header-line-format + (1+ (window-hscroll)))) + org-columns-previous-hscroll (window-hscroll)) + (force-mode-line-update))) + +(defvar org-colview-initial-truncate-line-value nil + "Remember the value of `truncate-lines' across colview.") + +;;;###autoload +(defun org-columns-remove-overlays () + "Remove all currently active column overlays." + (interactive) + (when (marker-buffer org-columns-begin-marker) + (with-current-buffer (marker-buffer org-columns-begin-marker) + (when (local-variable-p 'org-previous-header-line-format) + (setq header-line-format org-previous-header-line-format) + (kill-local-variable 'org-previous-header-line-format) + (remove-hook 'post-command-hook 'org-columns-hscoll-title 'local)) + (move-marker org-columns-begin-marker nil) + (move-marker org-columns-top-level-marker nil) + (org-with-silent-modifications + (mapc 'delete-overlay org-columns-overlays) + (setq org-columns-overlays nil) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) '(read-only t)))) + (when org-columns-flyspell-was-active + (flyspell-mode 1)) + (when (local-variable-p 'org-colview-initial-truncate-line-value) + (setq truncate-lines org-colview-initial-truncate-line-value))))) + +(defun org-columns-cleanup-item (item fmt cphr) + "Remove from ITEM what is a column in the format FMT. +CPHR is the complex heading regexp to use for parsing ITEM." + (let (fixitem) + (if (not cphr) + item + (unless (string-match "^\*+ " item) + (setq item (concat "* " item) fixitem t)) + (if (string-match cphr item) + (setq item + (concat + (org-add-props (match-string 1 item) nil + 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1)))))) + (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item))) + (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item))) + " " (save-match-data (org-columns-compact-links (or (match-string 4 item) ""))) + (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item))))) + (add-text-properties + 0 (1+ (match-end 1)) + (list 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1)))))) + item)) + (if fixitem (replace-regexp-in-string "^\*+ " "" item) item)))) + +(defun org-columns-compact-links (s) + "Replace [[link][desc]] with [desc] or [link]." + (while (string-match org-bracket-link-regexp s) + (setq s (replace-match + (concat "[" (match-string (if (match-end 3) 3 1) s) "]") + t t s))) + s) + +(defun org-columns-show-value () + "Show the full value of the property." + (interactive) + (let ((value (get-char-property (point) 'org-columns-value))) + (message "Value is: %s" (or value "")))) + +(defvar org-agenda-columns-active) ;; defined in org-agenda.el + +(defun org-columns-quit () + "Remove the column overlays and in this way exit column editing." + (interactive) + (org-with-silent-modifications + (org-columns-remove-overlays) + (let ((inhibit-read-only t)) + (remove-text-properties (point-min) (point-max) '(read-only t)))) + (when (eq major-mode 'org-agenda-mode) + (setq org-agenda-columns-active nil) + (message + "Modification not yet reflected in Agenda buffer, use `r' to refresh"))) + +(defun org-columns-check-computed () + "Check if this column value is computed. +If yes, throw an error indicating that changing it does not make sense." + (let ((val (get-char-property (point) 'org-columns-value))) + (when (and (stringp val) + (get-char-property 0 'org-computed val)) + (error "This value is computed from the entry's children")))) + +(defun org-columns-todo (&optional arg) + "Change the TODO state during column view." + (interactive "P") + (org-columns-edit-value "TODO")) + +(defun org-columns-set-tags-or-toggle (&optional arg) + "Toggle checkbox at point, or set tags for current headline." + (interactive "P") + (if (string-match "\\`\\[[ xX-]\\]\\'" + (get-char-property (point) 'org-columns-value)) + (org-columns-next-allowed-value) + (org-columns-edit-value "TAGS"))) + +(defvar org-agenda-overriding-columns-format nil + "When set, overrides any other format definition for the agenda. +Don't set this, this is meant for dynamic scoping.") + +(defun org-columns-edit-value (&optional key) + "Edit the value of the property at point in column view. +Where possible, use the standard interface for changing this line." + (interactive) + (org-columns-check-computed) + (let* ((col (current-column)) + (key (or key (get-char-property (point) 'org-columns-key))) + (value (get-char-property (point) 'org-columns-value)) + (bol (point-at-bol)) (eol (point-at-eol)) + (pom (or (get-text-property bol 'org-hd-marker) + (point))) ; keep despite of compiler waring + (line-overlays + (delq nil (mapcar (lambda (x) + (and (eq (overlay-buffer x) (current-buffer)) + (>= (overlay-start x) bol) + (<= (overlay-start x) eol) + x)) + org-columns-overlays))) + (org-columns-time (time-to-number-of-days (current-time))) + nval eval allowed) + (cond + ((equal key "CLOCKSUM") + (error "This special column cannot be edited")) + ((equal key "ITEM") + (setq eval '(org-with-point-at pom + (org-edit-headline)))) + ((equal key "TODO") + (setq eval '(org-with-point-at + pom + (call-interactively 'org-todo)))) + ((equal key "PRIORITY") + (setq eval '(org-with-point-at pom + (call-interactively 'org-priority)))) + ((equal key "TAGS") + (setq eval '(org-with-point-at pom + (let ((org-fast-tag-selection-single-key + (if (eq org-fast-tag-selection-single-key 'expert) + t org-fast-tag-selection-single-key))) + (call-interactively 'org-set-tags))))) + ((equal key "DEADLINE") + (setq eval '(org-with-point-at pom + (call-interactively 'org-deadline)))) + ((equal key "SCHEDULED") + (setq eval '(org-with-point-at pom + (call-interactively 'org-schedule)))) + ((equal key "BEAMER_env") + (setq eval '(org-with-point-at pom + (call-interactively 'org-beamer-select-environment)))) + (t + (setq allowed (org-property-get-allowed-values pom key 'table)) + (if allowed + (setq nval (org-icompleting-read + "Value: " allowed nil + (not (get-text-property 0 'org-unrestricted + (caar allowed))))) + (setq nval (read-string "Edit: " value))) + (setq nval (org-trim nval)) + (when (not (equal nval value)) + (setq eval '(org-entry-put pom key nval))))) + (when eval + + (cond + ((equal major-mode 'org-agenda-mode) + (org-columns-eval eval) + ;; The following let preserves the current format, and makes sure + ;; that in only a single file things need to be updated. + (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) + (buffer (marker-buffer pom)) + (org-agenda-contributing-files + (list (with-current-buffer buffer + (buffer-file-name (buffer-base-buffer)))))) + (org-agenda-columns))) + (t + (let ((inhibit-read-only t)) + (org-with-silent-modifications + (remove-text-properties + (max (point-min) (1- bol)) eol '(read-only t))) + (unwind-protect + (progn + (setq org-columns-overlays + (org-delete-all line-overlays org-columns-overlays)) + (mapc 'delete-overlay line-overlays) + (org-columns-eval eval)) + (org-columns-display-here))) + (org-move-to-column col) + (if (and (derived-mode-p 'org-mode) + (nth 3 (assoc key org-columns-current-fmt-compiled))) + (org-columns-update key))))))) + +(defun org-edit-headline () ; FIXME: this is not columns specific. Make interactive????? Use from agenda???? + "Edit the current headline, the part without TODO keyword, TAGS." + (org-back-to-heading) + (when (looking-at org-todo-line-regexp) + (let ((pos (point)) + (pre (buffer-substring (match-beginning 0) (match-beginning 3))) + (txt (match-string 3)) + (post "") + txt2) + (if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt) + (setq post (match-string 0 txt) + txt (substring txt 0 (match-beginning 0)))) + (setq txt2 (read-string "Edit: " txt)) + (when (not (equal txt txt2)) + (goto-char pos) + (insert pre txt2 post) + (delete-region (point) (point-at-eol)) + (org-set-tags nil t))))) + +(defun org-columns-edit-allowed () + "Edit the list of allowed values for the current property." + (interactive) + (let* ((pom (or (org-get-at-bol 'org-marker) + (org-get-at-bol 'org-hd-marker) + (point))) + (key (get-char-property (point) 'org-columns-key)) + (key1 (concat key "_ALL")) + (allowed (org-entry-get pom key1 t)) + nval) + ;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.???? + ;; FIXME: Write back to #+PROPERTY setting if that is needed. + (setq nval (read-string "Allowed: " allowed)) + (org-entry-put + (cond ((marker-position org-entry-property-inherited-from) + org-entry-property-inherited-from) + ((marker-position org-columns-top-level-marker) + org-columns-top-level-marker) + (t pom)) + key1 nval))) + +(defun org-columns-eval (form) + (let (hidep) + (save-excursion + (beginning-of-line 1) + ;; `next-line' is needed here, because it skips invisible line. + (condition-case nil (org-no-warnings (next-line 1)) (error nil)) + (setq hidep (org-at-heading-p 1))) + (eval form) + (and hidep (hide-entry)))) + +(defun org-columns-previous-allowed-value () + "Switch to the previous allowed value for this column." + (interactive) + (org-columns-next-allowed-value t)) + +(defun org-columns-next-allowed-value (&optional previous nth) + "Switch to the next allowed value for this column. +When PREVIOUS is set, go to the previous value. When NTH is +an integer, select that value." + (interactive) + (org-columns-check-computed) + (let* ((col (current-column)) + (key (get-char-property (point) 'org-columns-key)) + (value (get-char-property (point) 'org-columns-value)) + (bol (point-at-bol)) (eol (point-at-eol)) + (pom (or (get-text-property bol 'org-hd-marker) + (point))) ; keep despite of compiler waring + (line-overlays + (delq nil (mapcar (lambda (x) + (and (eq (overlay-buffer x) (current-buffer)) + (>= (overlay-start x) bol) + (<= (overlay-start x) eol) + x)) + org-columns-overlays))) + (allowed (or (org-property-get-allowed-values pom key) + (and (memq + (nth 4 (assoc key org-columns-current-fmt-compiled)) + '(checkbox checkbox-n-of-m checkbox-percent)) + '("[ ]" "[X]")) + (org-colview-construct-allowed-dates value))) + nval) + (when (integerp nth) + (setq nth (1- nth)) + (if (= nth -1) (setq nth 9))) + (when (equal key "ITEM") + (error "Cannot edit item headline from here")) + (unless (or allowed (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM"))) + (error "Allowed values for this property have not been defined")) + (if (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")) + (setq nval (if previous 'earlier 'later)) + (if previous (setq allowed (reverse allowed))) + (cond + (nth + (setq nval (nth nth allowed)) + (if (not nval) + (error "There are only %d allowed values for property `%s'" + (length allowed) key))) + ((member value allowed) + (setq nval (or (car (cdr (member value allowed))) + (car allowed))) + (if (equal nval value) + (error "Only one allowed value for this property"))) + (t (setq nval (car allowed))))) + (cond + ((equal major-mode 'org-agenda-mode) + (org-columns-eval '(org-entry-put pom key nval)) + ;; The following let preserves the current format, and makes sure + ;; that in only a single file things need to be updated. + (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) + (buffer (marker-buffer pom)) + (org-agenda-contributing-files + (list (with-current-buffer buffer + (buffer-file-name (buffer-base-buffer)))))) + (org-agenda-columns))) + (t + (let ((inhibit-read-only t)) + (remove-text-properties (1- bol) eol '(read-only t)) + (unwind-protect + (progn + (setq org-columns-overlays + (org-delete-all line-overlays org-columns-overlays)) + (mapc 'delete-overlay line-overlays) + (org-columns-eval '(org-entry-put pom key nval))) + (org-columns-display-here))) + (org-move-to-column col) + (and (nth 3 (assoc key org-columns-current-fmt-compiled)) + (org-columns-update key)))))) + +(defun org-colview-construct-allowed-dates (s) + "Construct a list of three dates around the date in S. +This respects the format of the time stamp in S, active or non-active, +and also including time or not. S must be just a time stamp, no text +around it." + (when (and s (string-match (concat "^" org-ts-regexp3 "$") s)) + (let* ((time (org-parse-time-string s 'nodefaults)) + (active (equal (string-to-char s) ?<)) + (fmt (funcall (if (nth 1 time) 'cdr 'car) org-time-stamp-formats)) + time-before time-after) + (unless active (setq fmt (concat "[" (substring fmt 1 -1) "]"))) + (setf (car time) (or (car time) 0)) + (setf (nth 1 time) (or (nth 1 time) 0)) + (setf (nth 2 time) (or (nth 2 time) 0)) + (setq time-before (copy-sequence time)) + (setq time-after (copy-sequence time)) + (setf (nth 3 time-before) (1- (nth 3 time))) + (setf (nth 3 time-after) (1+ (nth 3 time))) + (mapcar (lambda (x) (format-time-string fmt (apply 'encode-time x))) + (list time-before time time-after))))) + +(defun org-verify-version (task) + (cond + ((eq task 'columns) + (if (or (featurep 'xemacs) + (< emacs-major-version 22)) + (error "Emacs 22 is required for the columns feature"))))) + +(defun org-columns-open-link (&optional arg) + (interactive "P") + (let ((value (get-char-property (point) 'org-columns-value))) + (org-open-link-from-string value arg))) + +;;;###autoload +(defun org-columns-get-format-and-top-level () + (let ((fmt (org-columns-get-format))) + (org-columns-goto-top-level) + fmt)) + +(defun org-columns-get-format (&optional fmt-string) + (interactive) + (let (fmt-as-property fmt) + (when (condition-case nil (org-back-to-heading) (error nil)) + (setq fmt-as-property (org-entry-get nil "COLUMNS" t))) + (setq fmt (or fmt-string fmt-as-property org-columns-default-format)) + (org-set-local 'org-columns-current-fmt fmt) + (org-columns-compile-format fmt) + fmt)) + +(defun org-columns-goto-top-level () + (when (condition-case nil (org-back-to-heading) (error nil)) + (org-entry-get nil "COLUMNS" t)) + (if (marker-position org-entry-property-inherited-from) + (move-marker org-columns-top-level-marker org-entry-property-inherited-from) + (move-marker org-columns-top-level-marker (point)))) + +;;;###autoload +(defun org-columns (&optional columns-fmt-string) + "Turn on column view on an org-mode file. +When COLUMNS-FMT-STRING is non-nil, use it as the column format." + (interactive) + (org-verify-version 'columns) + (org-columns-remove-overlays) + (move-marker org-columns-begin-marker (point)) + (let ((org-columns-time (time-to-number-of-days (current-time))) + beg end fmt cache maxwidths) + (org-columns-goto-top-level) + (setq fmt (org-columns-get-format columns-fmt-string)) + (save-excursion + (goto-char org-columns-top-level-marker) + (setq beg (point)) + (unless org-columns-inhibit-recalculation + (org-columns-compute-all)) + (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil)) + (point-max))) + ;; Get and cache the properties + (goto-char beg) + (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (org-clock-sum)))) + (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (org-clock-sum-today)))) + (while (re-search-forward org-outline-regexp-bol end t) + (if (and org-columns-skip-archived-trees + (looking-at (concat ".*:" org-archive-tag ":"))) + (org-end-of-subtree t) + (push (cons (org-current-line) (org-entry-properties)) cache))) + (when cache + (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) + (org-set-local 'org-columns-current-maxwidths maxwidths) + (org-columns-display-here-title) + (when (org-set-local 'org-columns-flyspell-was-active + (org-bound-and-true-p flyspell-mode)) + (flyspell-mode 0)) + (unless (local-variable-p 'org-colview-initial-truncate-line-value) + (org-set-local 'org-colview-initial-truncate-line-value + truncate-lines)) + (setq truncate-lines t) + (mapc (lambda (x) + (org-goto-line (car x)) + (org-columns-display-here (cdr x))) + cache))))) + +(eval-when-compile (defvar org-columns-time)) + +(defvar org-columns-compile-map + '(("none" none +) + (":" add_times +) + ("+" add_numbers +) + ("$" currency +) + ("X" checkbox +) + ("X/" checkbox-n-of-m +) + ("X%" checkbox-percent +) + ("max" max_numbers max) + ("min" min_numbers min) + ("mean" mean_numbers + (lambda (&rest x) (/ (apply '+ x) (float (length x))))) + (":max" max_times max) + (":min" min_times min) + (":mean" mean_times + (lambda (&rest x) (/ (apply '+ x) (float (length x))))) + ("@min" min_age min (lambda (x) (- org-columns-time x))) + ("@max" max_age max (lambda (x) (- org-columns-time x))) + ("@mean" mean_age + (lambda (&rest x) (/ (apply '+ x) (float (length x)))) + (lambda (x) (- org-columns-time x))) + ("est+" estimate org-estimate-combine)) + "Operator <-> format,function,calc map. +Used to compile/uncompile columns format and completing read in +interactive function `org-columns-new'. + +operator string used in #+COLUMNS definition describing the + summary type +format symbol describing summary type selected interactively in + `org-columns-new' and internally in + `org-columns-number-to-string' and + `org-columns-string-to-number' +function called with a list of values as argument to calculate + the summary value +calc function called on every element before summarizing. This is + optional and should only be specified if needed") + +(defun org-columns-new (&optional prop title width op fmt fun &rest rest) + "Insert a new column, to the left of the current column." + (interactive) + (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled))) + cell) + (setq prop (org-icompleting-read + "Property: " (mapcar 'list (org-buffer-property-keys t nil t)) + nil nil prop)) + (setq title (read-string (concat "Column title [" prop "]: ") (or title prop))) + (setq width (read-string "Column width: " (if width (number-to-string width)))) + (if (string-match "\\S-" width) + (setq width (string-to-number width)) + (setq width nil)) + (setq fmt (org-icompleting-read + "Summary [none]: " + (mapcar (lambda (x) (list (symbol-name (cadr x)))) + org-columns-compile-map) + nil t)) + (setq fmt (intern fmt) + fun (cdr (assoc fmt (mapcar 'cdr org-columns-compile-map)))) + (if (eq fmt 'none) (setq fmt nil)) + (if editp + (progn + (setcar editp prop) + (setcdr editp (list title width nil fmt nil fun))) + (setq cell (nthcdr (1- (current-column)) + org-columns-current-fmt-compiled)) + (setcdr cell (cons (list prop title width nil fmt nil + (car fun) (cadr fun)) + (cdr cell)))) + (org-columns-store-format) + (org-columns-redo))) + +(defun org-columns-delete () + "Delete the column at point from columns view." + (interactive) + (let* ((n (current-column)) + (title (nth 1 (nth n org-columns-current-fmt-compiled)))) + (when (y-or-n-p + (format "Are you sure you want to remove column \"%s\"? " title)) + (setq org-columns-current-fmt-compiled + (delq (nth n org-columns-current-fmt-compiled) + org-columns-current-fmt-compiled)) + (org-columns-store-format) + (org-columns-redo) + (if (>= (current-column) (length org-columns-current-fmt-compiled)) + (backward-char 1))))) + +(defun org-columns-edit-attributes () + "Edit the attributes of the current column." + (interactive) + (let* ((n (current-column)) + (info (nth n org-columns-current-fmt-compiled))) + (apply 'org-columns-new info))) + +(defun org-columns-widen (arg) + "Make the column wider by ARG characters." + (interactive "p") + (let* ((n (current-column)) + (entry (nth n org-columns-current-fmt-compiled)) + (width (or (nth 2 entry) + (cdr (assoc (car entry) org-columns-current-maxwidths))))) + (setq width (max 1 (+ width arg))) + (setcar (nthcdr 2 entry) width) + (org-columns-store-format) + (org-columns-redo))) + +(defun org-columns-narrow (arg) + "Make the column narrower by ARG characters." + (interactive "p") + (org-columns-widen (- arg))) + +(defun org-columns-move-right () + "Swap this column with the one to the right." + (interactive) + (let* ((n (current-column)) + (cell (nthcdr n org-columns-current-fmt-compiled)) + e) + (when (>= n (1- (length org-columns-current-fmt-compiled))) + (error "Cannot shift this column further to the right")) + (setq e (car cell)) + (setcar cell (car (cdr cell))) + (setcdr cell (cons e (cdr (cdr cell)))) + (org-columns-store-format) + (org-columns-redo) + (forward-char 1))) + +(defun org-columns-move-left () + "Swap this column with the one to the left." + (interactive) + (let* ((n (current-column))) + (when (= n 0) + (error "Cannot shift this column further to the left")) + (backward-char 1) + (org-columns-move-right) + (backward-char 1))) + +(defun org-columns-store-format () + "Store the text version of the current columns format in appropriate place. +This is either in the COLUMNS property of the node starting the current column +display, or in the #+COLUMNS line of the current buffer." + (let (fmt (cnt 0)) + (setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled)) + (org-set-local 'org-columns-current-fmt fmt) + (if (marker-position org-columns-top-level-marker) + (save-excursion + (goto-char org-columns-top-level-marker) + (if (and (org-at-heading-p) + (org-entry-get nil "COLUMNS")) + (org-entry-put nil "COLUMNS" fmt) + (goto-char (point-min)) + ;; Overwrite all #+COLUMNS lines.... + (while (re-search-forward "^#\\+COLUMNS:.*" nil t) + (setq cnt (1+ cnt)) + (replace-match (concat "#+COLUMNS: " fmt) t t)) + (unless (> cnt 0) + (goto-char (point-min)) + (or (org-at-heading-p t) (outline-next-heading)) + (let ((inhibit-read-only t)) + (insert-before-markers "#+COLUMNS: " fmt "\n"))) + (org-set-local 'org-columns-default-format fmt)))))) + +(defun org-columns-get-autowidth-alist (s cache) + "Derive the maximum column widths from the format and the cache." + (let ((start 0) rtn) + (while (string-match (org-re "%\\([[:alpha:]][[:alnum:]_-]*\\)") s start) + (push (cons (match-string 1 s) 1) rtn) + (setq start (match-end 0))) + (mapc (lambda (x) + (setcdr x (apply 'max + (mapcar + (lambda (y) + (length (or (cdr (assoc (car x) (cdr y))) " "))) + cache)))) + rtn) + rtn)) + +(defun org-columns-compute-all () + "Compute all columns that have operators defined." + (org-with-silent-modifications + (remove-text-properties (point-min) (point-max) '(org-summaries t))) + (let ((columns org-columns-current-fmt-compiled) + (org-columns-time (time-to-number-of-days (current-time))) + col) + (while (setq col (pop columns)) + (when (nth 3 col) + (save-excursion + (org-columns-compute (car col))))))) + +(defun org-columns-update (property) + "Recompute PROPERTY, and update the columns display for it." + (org-columns-compute property) + (let (fmt val pos) + (save-excursion + (mapc (lambda (ov) + (when (equal (overlay-get ov 'org-columns-key) property) + (setq pos (overlay-start ov)) + (goto-char pos) + (when (setq val (cdr (assoc property + (get-text-property + (point-at-bol) 'org-summaries)))) + (setq fmt (overlay-get ov 'org-columns-format)) + (overlay-put ov 'org-columns-value val) + (overlay-put ov 'display (format fmt val))))) + org-columns-overlays)))) + +(defvar org-inlinetask-min-level + (if (featurep 'org-inlinetask) org-inlinetask-min-level 15)) + +;;;###autoload +(defun org-columns-compute (property) + "Sum the values of property PROPERTY hierarchically, for the entire buffer." + (interactive) + (let* ((re org-outline-regexp-bol) + (lmax 30) ; Does anyone use deeper levels??? + (lvals (make-vector lmax nil)) + (lflag (make-vector lmax nil)) + (level 0) + (ass (assoc property org-columns-current-fmt-compiled)) + (format (nth 4 ass)) + (printf (nth 5 ass)) + (fun (nth 6 ass)) + (calc (or (nth 7 ass) 'identity)) + (beg org-columns-top-level-marker) + (inminlevel org-inlinetask-min-level) + (last-level org-inlinetask-min-level) + val valflag flag end sumpos sum-alist sum str str1 useval) + (save-excursion + ;; Find the region to compute + (goto-char beg) + (setq end (condition-case nil (org-end-of-subtree t) (error (point-max)))) + (goto-char end) + ;; Walk the tree from the back and do the computations + (while (re-search-backward re beg t) + (setq sumpos (match-beginning 0) + last-level (if (not (or (zerop level) (eq level inminlevel))) + level last-level) + level (org-outline-level) + val (org-entry-get nil property) + valflag (and val (string-match "\\S-" val))) + (cond + ((< level last-level) + ;; put the sum of lower levels here as a property + (setq sum (+ (if (and (/= last-level inminlevel) + (aref lvals last-level)) + (apply fun (aref lvals last-level)) 0) + (if (aref lvals inminlevel) + (apply fun (aref lvals inminlevel)) 0)) + flag (or (aref lflag last-level) ; any valid entries from children? + (aref lflag inminlevel)) ; or inline tasks? + str (org-columns-number-to-string sum format printf) + str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold) + useval (if flag str1 (if valflag val "")) + sum-alist (get-text-property sumpos 'org-summaries)) + (if (assoc property sum-alist) + (setcdr (assoc property sum-alist) useval) + (push (cons property useval) sum-alist) + (org-with-silent-modifications + (add-text-properties sumpos (1+ sumpos) + (list 'org-summaries sum-alist)))) + (when (and val (not (equal val (if flag str val)))) + (org-entry-put nil property (if flag str val))) + ;; add current to current level accumulator + (when (or flag valflag) + (push (if flag + sum + (funcall calc (org-columns-string-to-number + (if flag str val) format))) + (aref lvals level)) + (aset lflag level t)) + ;; clear accumulators for deeper levels + (loop for l from (1+ level) to (1- lmax) do + (aset lvals l nil) + (aset lflag l nil))) + ((>= level last-level) + ;; add what we have here to the accumulator for this level + (when valflag + (push (funcall calc (org-columns-string-to-number val format)) + (aref lvals level)) + (aset lflag level t))) + (t (error "This should not happen"))))))) + +(defun org-columns-redo () + "Construct the column display again." + (interactive) + (message "Recomputing columns...") + (let ((line (org-current-line)) + (col (current-column))) + (save-excursion + (if (marker-position org-columns-begin-marker) + (goto-char org-columns-begin-marker)) + (org-columns-remove-overlays) + (if (derived-mode-p 'org-mode) + (call-interactively 'org-columns) + (org-agenda-redo) + (call-interactively 'org-agenda-columns))) + (org-goto-line line) + (move-to-column col)) + (message "Recomputing columns...done")) + +(defun org-columns-not-in-agenda () + (if (eq major-mode 'org-agenda-mode) + (error "This command is only allowed in Org-mode buffers"))) + +(defun org-string-to-number (s) + "Convert string to number, and interpret hh:mm:ss." + (if (not (string-match ":" s)) + (string-to-number s) + (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) + (while l + (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) + sum))) + +;;;###autoload +(defun org-columns-number-to-string (n fmt &optional printf) + "Convert a computed column number to a string value, according to FMT." + (cond + ((memq fmt '(estimate)) (org-estimate-print n printf)) + ((not (numberp n)) "") + ((memq fmt '(add_times max_times min_times mean_times)) + (org-hours-to-clocksum-string n)) + ((eq fmt 'checkbox) + (cond ((= n (floor n)) "[X]") + ((> n 1.) "[-]") + (t "[ ]"))) + ((memq fmt '(checkbox-n-of-m checkbox-percent)) + (let* ((n1 (floor n)) (n2 (floor (+ .5 (* 1000000 (- n n1)))))) + (org-nofm-to-completion n1 (+ n2 n1) (eq fmt 'checkbox-percent)))) + (printf (format printf n)) + ((eq fmt 'currency) + (format "%.2f" n)) + ((memq fmt '(min_age max_age mean_age)) + (org-format-time-period n)) + (t (number-to-string n)))) + +(defun org-nofm-to-completion (n m &optional percent) + (if (not percent) + (format "[%d/%d]" n m) + (format "[%d%%]"(floor (+ 0.5 (* 100. (/ (* 1.0 n) m))))))) + + +(defun org-columns-string-to-number (s fmt) + "Convert a column value to a number that can be used for column computing." + (if s + (cond + ((memq fmt '(min_age max_age mean_age)) + (cond ((string= s "") org-columns-time) + ((string-match + "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" + s) + (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s))) + (string-to-number (match-string 2 s)))) + (string-to-number (match-string 3 s)))) + (string-to-number (match-string 4 s)))) + (t (time-to-number-of-days (apply 'encode-time + (org-parse-time-string s t)))))) + ((string-match ":" s) + (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) + (while l + (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) + sum)) + ((string-match (concat "\\([0-9.]+\\) *\\(" + (regexp-opt (mapcar 'car org-effort-durations)) + "\\)") s) + (setq s (concat "0:" (org-duration-string-to-minutes s t))) + (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) + (while l + (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) + sum)) + ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent)) + (if (equal s "[X]") 1. 0.000001)) + ((memq fmt '(estimate)) (org-string-to-estimate s)) + (t (string-to-number s))))) + +(defun org-columns-uncompile-format (cfmt) + "Turn the compiled columns format back into a string representation." + (let ((rtn "") e s prop title op op-match width fmt printf fun calc) + (while (setq e (pop cfmt)) + (setq prop (car e) + title (nth 1 e) + width (nth 2 e) + op (nth 3 e) + fmt (nth 4 e) + printf (nth 5 e) + fun (nth 6 e) + calc (nth 7 e)) + (when (setq op-match (rassoc (list fmt fun calc) org-columns-compile-map)) + (setq op (car op-match))) + (if (and op printf) (setq op (concat op ";" printf))) + (if (equal title prop) (setq title nil)) + (setq s (concat "%" (if width (number-to-string width)) + prop + (if title (concat "(" title ")")) + (if op (concat "{" op "}")))) + (setq rtn (concat rtn " " s))) + (org-trim rtn))) + +(defun org-columns-compile-format (fmt) + "Turn a column format string into an alist of specifications. +The alist has one entry for each column in the format. The elements of +that list are: +property the property +title the title field for the columns +width the column width in characters, can be nil for automatic +operator the operator if any +format the output format for computed results, derived from operator +printf a printf format for computed values +fun the lisp function to compute summary values, derived from operator +calc function to get values from base elements" + (let ((start 0) width prop title op op-match f printf fun calc) + (setq org-columns-current-fmt-compiled nil) + (while (string-match + (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*") + fmt start) + (setq start (match-end 0) + width (match-string 1 fmt) + prop (match-string 2 fmt) + title (or (match-string 3 fmt) prop) + op (match-string 4 fmt) + f nil + printf nil + fun '+ + calc nil) + (if width (setq width (string-to-number width))) + (when (and op (string-match ";" op)) + (setq printf (substring op (match-end 0)) + op (substring op 0 (match-beginning 0)))) + (when (setq op-match (assoc op org-columns-compile-map)) + (setq f (cadr op-match) + fun (caddr op-match) + calc (cadddr op-match))) + (push (list prop title width op f printf fun calc) + org-columns-current-fmt-compiled)) + (setq org-columns-current-fmt-compiled + (nreverse org-columns-current-fmt-compiled)))) + + +;;; Dynamic block for Column view + +(defvar org-heading-regexp) ; defined in org.el +(defvar org-heading-keyword-regexp-format) ; defined in org.el +(defun org-columns-capture-view (&optional maxlevel skip-empty-rows) + "Get the column view of the current buffer or subtree. +The first optional argument MAXLEVEL sets the level limit. A +second optional argument SKIP-EMPTY-ROWS tells whether to skip +empty rows, an empty row being one where all the column view +specifiers except ITEM are empty. This function returns a list +containing the title row and all other rows. Each row is a list +of fields." + (save-excursion + (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled)) + (re-comment (format org-heading-keyword-regexp-format + org-comment-string)) + (re-archive (concat ".*:" org-archive-tag ":")) + (n (length title)) row tbl) + (goto-char (point-min)) + (while (re-search-forward org-heading-regexp nil t) + (catch 'next + (when (and (or (null maxlevel) + (>= maxlevel + (if org-odd-levels-only + (/ (1+ (length (match-string 1))) 2) + (length (match-string 1))))) + (get-char-property (match-beginning 0) 'org-columns-key)) + (when (save-excursion + (goto-char (point-at-bol)) + (or (looking-at re-comment) + (looking-at re-archive))) + (org-end-of-subtree t) + (throw 'next t)) + (setq row nil) + (loop for i from 0 to (1- n) do + (push + (org-quote-vert + (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified) + (get-char-property (+ (match-beginning 0) i) 'org-columns-value) + "")) + row)) + (setq row (nreverse row)) + (unless (and skip-empty-rows + (eq 1 (length (delete "" (delete-dups (copy-sequence row)))))) + (push row tbl))))) + (append (list title 'hline) (nreverse tbl))))) + +;;;###autoload +(defun org-dblock-write:columnview (params) + "Write the column view table. +PARAMS is a property list of parameters: + +:width enforce same column widths with specifiers. +:id the :ID: property of the entry where the columns view + should be built. When the symbol `local', call locally. + When `global' call column view with the cursor at the beginning + of the buffer (usually this means that the whole buffer switches + to column view). When \"file:path/to/file.org\", invoke column + view at the start of that file. Otherwise, the ID is located + using `org-id-find'. +:hlines When t, insert a hline before each item. When a number, insert + a hline before each level <= that number. +:vlines When t, make each column a colgroup to enforce vertical lines. +:maxlevel When set to a number, don't capture headlines below this level. +:skip-empty-rows + When t, skip rows where all specifiers other than ITEM are empty. +:format When non-nil, specify the column view format to use." + (let ((pos (point-marker)) + (hlines (plist-get params :hlines)) + (vlines (plist-get params :vlines)) + (maxlevel (plist-get params :maxlevel)) + (content-lines (org-split-string (plist-get params :content) "\n")) + (skip-empty-rows (plist-get params :skip-empty-rows)) + (columns-fmt (plist-get params :format)) + (case-fold-search t) + tbl id idpos nfields tmp recalc line + id-as-string view-file view-pos) + (when (setq id (plist-get params :id)) + (setq id-as-string (cond ((numberp id) (number-to-string id)) + ((symbolp id) (symbol-name id)) + ((stringp id) id) + (t ""))) + (cond ((not id) nil) + ((eq id 'global) (setq view-pos (point-min))) + ((eq id 'local)) + ((string-match "^file:\\(.*\\)" id-as-string) + (setq view-file (match-string 1 id-as-string) + view-pos 1) + (unless (file-exists-p view-file) + (error "No such file: \"%s\"" id-as-string))) + ((setq idpos (org-find-entry-with-id id)) + (setq view-pos idpos)) + ((setq idpos (org-id-find id)) + (setq view-file (car idpos)) + (setq view-pos (cdr idpos))) + (t (error "Cannot find entry with :ID: %s" id)))) + (with-current-buffer (if view-file + (get-file-buffer view-file) + (current-buffer)) + (save-excursion + (save-restriction + (widen) + (goto-char (or view-pos (point))) + (org-columns columns-fmt) + (setq tbl (org-columns-capture-view maxlevel skip-empty-rows)) + (setq nfields (length (car tbl))) + (org-columns-quit)))) + (goto-char pos) + (move-marker pos nil) + (when tbl + (when (plist-get params :hlines) + (setq tmp nil) + (while tbl + (if (eq (car tbl) 'hline) + (push (pop tbl) tmp) + (if (string-match "\\` *\\(\\*+\\)" (caar tbl)) + (if (and (not (eq (car tmp) 'hline)) + (or (eq hlines t) + (and (numberp hlines) + (<= (- (match-end 1) (match-beginning 1)) + hlines)))) + (push 'hline tmp))) + (push (pop tbl) tmp))) + (setq tbl (nreverse tmp))) + (when vlines + (setq tbl (mapcar (lambda (x) + (if (eq 'hline x) x (cons "" x))) + tbl)) + (setq tbl (append tbl (list (cons "/" (make-list nfields "<>")))))) + (when content-lines + (while (string-match "^#" (car content-lines)) + (insert (pop content-lines) "\n"))) + (setq pos (point)) + (insert (org-listtable-to-string tbl)) + (when (plist-get params :width) + (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x))) + org-columns-current-widths "|"))) + (while (setq line (pop content-lines)) + (when (string-match "^#" line) + (insert "\n" line) + (when (string-match "^[ \t]*#\\+tblfm" line) + (setq recalc t)))) + (if recalc + (progn (goto-char pos) (org-table-recalculate 'all)) + (goto-char pos) + (org-table-align))))) + +(defun org-listtable-to-string (tbl) + "Convert a listtable TBL to a string that contains the Org-mode table. +The table still need to be aligned. The resulting string has no leading +and tailing newline characters." + (mapconcat + (lambda (x) + (cond + ((listp x) + (concat "|" (mapconcat 'identity x "|") "|")) + ((eq x 'hline) "|-|") + (t (error "Garbage in listtable: %s" x)))) + tbl "\n")) + +;;;###autoload +(defun org-insert-columns-dblock () + "Create a dynamic block capturing a column view table." + (interactive) + (let ((defaults '(:name "columnview" :hlines 1)) + (id (org-icompleting-read + "Capture columns (local, global, entry with :ID: property) [local]: " + (append '(("global") ("local")) + (mapcar 'list (org-property-values "ID")))))) + (if (equal id "") (setq id 'local)) + (if (equal id "global") (setq id 'global)) + (setq defaults (append defaults (list :id id))) + (org-create-dblock defaults) + (org-update-dblock))) + +;;; Column view in the agenda + +(defvar org-agenda-view-columns-initially nil + "When set, switch to columns view immediately after creating the agenda.") + +(defvar org-agenda-columns-show-summaries) ; defined in org-agenda.el +(defvar org-agenda-columns-compute-summary-properties); defined in org-agenda.el +(defvar org-agenda-columns-add-appointments-to-effort-sum); as well + +;;;###autoload +(defun org-agenda-columns () + "Turn on or update column view in the agenda." + (interactive) + (org-verify-version 'columns) + (org-columns-remove-overlays) + (move-marker org-columns-begin-marker (point)) + (let ((org-columns-time (time-to-number-of-days (current-time))) + cache maxwidths m p a d fmt) + (cond + ((and (boundp 'org-agenda-overriding-columns-format) + org-agenda-overriding-columns-format) + (setq fmt org-agenda-overriding-columns-format)) + ((setq m (org-get-at-bol 'org-hd-marker)) + (setq fmt (or (org-entry-get m "COLUMNS" t) + (with-current-buffer (marker-buffer m) + org-columns-default-format)))) + ((and (boundp 'org-columns-current-fmt) + (local-variable-p 'org-columns-current-fmt) + org-columns-current-fmt) + (setq fmt org-columns-current-fmt)) + ((setq m (next-single-property-change (point-min) 'org-hd-marker)) + (setq m (get-text-property m 'org-hd-marker)) + (setq fmt (or (org-entry-get m "COLUMNS" t) + (with-current-buffer (marker-buffer m) + org-columns-default-format))))) + (setq fmt (or fmt org-columns-default-format)) + (org-set-local 'org-columns-current-fmt fmt) + (org-columns-compile-format fmt) + (when org-agenda-columns-compute-summary-properties + (org-agenda-colview-compute org-columns-current-fmt-compiled)) + (save-excursion + ;; Get and cache the properties + (goto-char (point-min)) + (while (not (eobp)) + (when (setq m (or (org-get-at-bol 'org-hd-marker) + (org-get-at-bol 'org-marker))) + (setq p (org-entry-properties m)) + + (when (or (not (setq a (assoc org-effort-property p))) + (not (string-match "\\S-" (or (cdr a) "")))) + ;; OK, the property is not defined. Use appointment duration? + (when (and org-agenda-columns-add-appointments-to-effort-sum + (setq d (get-text-property (point) 'duration))) + (setq d (org-minutes-to-clocksum-string d)) + (put-text-property 0 (length d) 'face 'org-warning d) + (push (cons org-effort-property d) p))) + (push (cons (org-current-line) p) cache)) + (beginning-of-line 2)) + (when cache + (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) + (org-set-local 'org-columns-current-maxwidths maxwidths) + (org-columns-display-here-title) + (when (org-set-local 'org-columns-flyspell-was-active + (org-bound-and-true-p flyspell-mode)) + (flyspell-mode 0)) + (mapc (lambda (x) + (org-goto-line (car x)) + (org-columns-display-here (cdr x))) + cache) + (when org-agenda-columns-show-summaries + (org-agenda-colview-summarize cache)))))) + +(defun org-agenda-colview-summarize (cache) + "Summarize the summarizable columns in column view in the agenda. +This will add overlays to the date lines, to show the summary for each day." + (let* ((fmt (mapcar (lambda (x) + (if (string-match "CLOCKSUM.*" (car x)) + (list (match-string 0 (car x)) + (nth 1 x) (nth 2 x) ":" 'add_times + nil '+ nil) + x)) + org-columns-current-fmt-compiled)) + line c c1 stype calc sumfunc props lsum entries prop v title) + (catch 'exit + (when (delq nil (mapcar 'cadr fmt)) + ;; OK, at least one summation column, it makes sense to try this + (goto-char (point-max)) + (while t + (when (or (get-text-property (point) 'org-date-line) + (eq (get-text-property (point) 'face) + 'org-agenda-structure)) + ;; OK, this is a date line that should be used + (setq line (org-current-line)) + (setq entries nil c cache cache nil) + (while (setq c1 (pop c)) + (if (> (car c1) line) + (push c1 entries) + (push c1 cache))) + ;; now ENTRIES are the ones we want to use, CACHE is the rest + ;; Compute the summaries for the properties we want, + ;; set nil properties for the rest. + (when (setq entries (mapcar 'cdr entries)) + (setq props + (mapcar + (lambda (f) + (setq prop (car f) + title (nth 1 f) + stype (nth 4 f) + sumfunc (nth 6 f) + calc (or (nth 7 f) 'identity)) + (cond + ((equal prop "ITEM") + (cons prop (buffer-substring (point-at-bol) + (point-at-eol)))) + ((not stype) (cons prop "")) + (t ;; do the summary + (setq lsum nil) + (dolist (x entries) + (setq v (cdr (assoc prop x))) + (if v + (push + (funcall + (if (not (get-text-property 0 'org-computed v)) + calc + 'identity) + (org-columns-string-to-number + v stype)) + lsum))) + (setq lsum (remove nil lsum)) + (setq lsum + (cond ((> (length lsum) 1) + (org-columns-number-to-string + (apply sumfunc lsum) stype)) + ((eq (length lsum) 1) + (org-columns-number-to-string + (car lsum) stype)) + (t ""))) + (put-text-property 0 (length lsum) 'face 'bold lsum) + (unless (eq calc 'identity) + (put-text-property 0 (length lsum) 'org-computed t lsum)) + (cons prop lsum)))) + fmt)) + (org-columns-display-here props 'dateline) + (org-set-local 'org-agenda-columns-active t))) + (if (bobp) (throw 'exit t)) + (beginning-of-line 0)))))) + +(defun org-agenda-colview-compute (fmt) + "Compute the relevant columns in the contributing source buffers." + (let ((files org-agenda-contributing-files) + (org-columns-begin-marker (make-marker)) + (org-columns-top-level-marker (make-marker)) + f fm a b) + (while (setq f (pop files)) + (setq b (find-buffer-visiting f)) + (with-current-buffer (or (buffer-base-buffer b) b) + (save-excursion + (save-restriction + (widen) + (org-with-silent-modifications + (remove-text-properties (point-min) (point-max) '(org-summaries t))) + (goto-char (point-min)) + (org-columns-get-format-and-top-level) + (while (setq fm (pop fmt)) + (cond ((equal (car fm) "CLOCKSUM") + (org-clock-sum)) + ((equal (car fm) "CLOCKSUM_T") + (org-clock-sum-today)) + ((and (nth 4 fm) + (setq a (assoc (car fm) + org-columns-current-fmt-compiled)) + (equal (nth 4 a) (nth 4 fm))) + (org-columns-compute (car fm))))))))))) + +(defun org-format-time-period (interval) + "Convert time in fractional days to days/hours/minutes/seconds." + (if (numberp interval) + (let* ((days (floor interval)) + (frac-hours (* 24 (- interval days))) + (hours (floor frac-hours)) + (minutes (floor (* 60 (- frac-hours hours)))) + (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes))))) + (format "%dd %02dh %02dm %02ds" days hours minutes seconds)) + "")) + +(defun org-estimate-mean-and-var (v) + "Return the mean and variance of an estimate." + (let* ((low (float (car v))) + (high (float (cadr v))) + (mean (/ (+ low high) 2.0)) + (var (/ (+ (expt (- mean low) 2.0) (expt (- high mean) 2.0)) 2.0))) + (list mean var))) + +(defun org-estimate-combine (&rest el) + "Combine a list of estimates, using mean and variance. +The mean and variance of the result will be the sum of the means +and variances (respectively) of the individual estimates." + (let ((mean 0) + (var 0)) + (mapc (lambda (e) + (let ((stats (org-estimate-mean-and-var e))) + (setq mean (+ mean (car stats))) + (setq var (+ var (cadr stats))))) + el) + (let ((stdev (sqrt var))) + (list (- mean stdev) (+ mean stdev))))) + +(defun org-estimate-print (e &optional fmt) + "Prepare a string representation of an estimate. +This formats these numbers as two numbers with a \"-\" between them." + (if (null fmt) (set 'fmt "%.0f")) + (format "%s" (mapconcat (lambda (n) (format fmt n)) e "-"))) + +(defun org-string-to-estimate (s) + "Convert a string to an estimate. +The string should be two numbers joined with a \"-\"." + (if (string-match "\\(.*\\)-\\(.*\\)" s) + (list (string-to-number (match-string 1 s)) + (string-to-number(match-string 2 s))) + (list (string-to-number s) (string-to-number s)))) + +(provide 'org-colview) + +;;; org-colview.el ends here diff --git a/elpa/org-20150427/org-compat.el b/elpa/org-20150427/org-compat.el new file mode 100644 index 00000000..90380a88 --- /dev/null +++ b/elpa/org-20150427/org-compat.el @@ -0,0 +1,560 @@ +;;; org-compat.el --- Compatibility code for Org-mode + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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 . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains code needed for compatibility with XEmacs and older +;; versions of GNU Emacs. + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(require 'org-macs) + +(declare-function w32-focus-frame "term/w32-win" (frame)) + +;; The following constant is for backward compatibility. We do not use +;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs) +;; at compilation time and can therefore optimize code better. +(defconst org-xemacs-p (featurep 'xemacs)) +(defconst org-format-transports-properties-p + (let ((x "a")) + (add-text-properties 0 1 '(test t) x) + (get-text-property 0 'test (format "%s" x))) + "Does format transport text properties?") + +(defun org-compatible-face (inherits specs) + "Make a compatible face specification. +If INHERITS is an existing face and if the Emacs version supports it, +just inherit the face. If INHERITS is set and the Emacs version does +not support it, copy the face specification from the inheritance face. +If INHERITS is not given and SPECS is, use SPECS to define the face. +XEmacs and Emacs 21 do not know about the `min-colors' attribute. +For them we convert a (min-colors 8) entry to a `tty' entry and move it +to the top of the list. The `min-colors' attribute will be removed from +any other entries, and any resulting duplicates will be removed entirely." + (when (and inherits (facep inherits) (not specs)) + (setq specs (or specs + (get inherits 'saved-face) + (get inherits 'face-defface-spec)))) + (cond + ((and inherits (facep inherits) + (not (featurep 'xemacs)) + (>= emacs-major-version 22) + ;; do not inherit outline faces before Emacs 23 + (or (>= emacs-major-version 23) + (not (string-match "\\`outline-[0-9]+" + (symbol-name inherits))))) + (list (list t :inherit inherits))) + ((or (featurep 'xemacs) (< emacs-major-version 22)) + ;; These do not understand the `min-colors' attribute. + (let (r e a) + (while (setq e (pop specs)) + (cond + ((memq (car e) '(t default)) (push e r)) + ((setq a (member '(min-colors 8) (car e))) + (nconc r (list (cons (cons '(type tty) (delq (car a) (car e))) + (cdr e))))) + ((setq a (assq 'min-colors (car e))) + (setq e (cons (delq a (car e)) (cdr e))) + (or (assoc (car e) r) (push e r))) + (t (or (assoc (car e) r) (push e r))))) + (nreverse r))) + (t specs))) +(put 'org-compatible-face 'lisp-indent-function 1) + +(defun org-version-check (version feature level) + (let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) + (v2 (mapcar 'string-to-number (split-string emacs-version "[.]"))) + (rmaj (or (nth 0 v1) 99)) + (rmin (or (nth 1 v1) 99)) + (rbld (or (nth 2 v1) 99)) + (maj (or (nth 0 v2) 0)) + (min (or (nth 1 v2) 0)) + (bld (or (nth 2 v2) 0))) + (if (or (< maj rmaj) + (and (= maj rmaj) + (< min rmin)) + (and (= maj rmaj) + (= min rmin) + (< bld rbld))) + (if (eq level :predicate) + ;; just return if we have the version + nil + (let ((msg (format "Emacs %s or greater is recommended for %s" + version feature))) + (display-warning 'org msg level) + t)) + t))) + + +;;;; Emacs/XEmacs compatibility + +(eval-and-compile + (defun org-defvaralias (new-alias base-variable &optional docstring) + "Compatibility function for defvaralias. +Don't do the aliasing when `defvaralias' is not bound." + (declare (indent 1)) + (when (fboundp 'defvaralias) + (defvaralias new-alias base-variable docstring))) + + (when (and (not (boundp 'user-emacs-directory)) + (boundp 'user-init-directory)) + (org-defvaralias 'user-emacs-directory 'user-init-directory))) + +(when (featurep 'xemacs) + (defadvice custom-handle-keyword + (around org-custom-handle-keyword + activate preactivate) + "Remove custom keywords not recognized to avoid producing an error." + (cond + ((eq (ad-get-arg 1) :package-version)) + (t ad-do-it))) + (defadvice define-obsolete-variable-alias + (around org-define-obsolete-variable-alias + (obsolete-name current-name &optional when docstring) + activate preactivate) + "Declare arguments defined in later versions of Emacs." + ad-do-it) + (defadvice define-obsolete-function-alias + (around org-define-obsolete-function-alias + (obsolete-name current-name &optional when docstring) + activate preactivate) + "Declare arguments defined in later versions of Emacs." + ad-do-it) + (defvar customize-package-emacs-version-alist nil) + (defvar temporary-file-directory (temp-directory))) + +;; Keys +(defconst org-xemacs-key-equivalents + '(([mouse-1] . [button1]) + ([mouse-2] . [button2]) + ([mouse-3] . [button3]) + ([C-mouse-4] . [(control mouse-4)]) + ([C-mouse-5] . [(control mouse-5)])) + "Translation alist for a couple of keys.") + +;; Overlay compatibility functions +(defun org-detach-overlay (ovl) + (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl))) +(defun org-overlay-display (ovl text &optional face evap) + "Make overlay OVL display TEXT with face FACE." + (if (featurep 'xemacs) + (let ((gl (make-glyph text))) + (and face (set-glyph-face gl face)) + (set-extent-property ovl 'invisible t) + (set-extent-property ovl 'end-glyph gl)) + (overlay-put ovl 'display text) + (if face (overlay-put ovl 'face face)) + (if evap (overlay-put ovl 'evaporate t)))) +(defun org-overlay-before-string (ovl text &optional face evap) + "Make overlay OVL display TEXT with face FACE." + (if (featurep 'xemacs) + (let ((gl (make-glyph text))) + (and face (set-glyph-face gl face)) + (set-extent-property ovl 'begin-glyph gl)) + (if face (org-add-props text nil 'face face)) + (overlay-put ovl 'before-string text) + (if evap (overlay-put ovl 'evaporate t)))) +(defun org-find-overlays (prop &optional pos delete) + "Find all overlays specifying PROP at POS or point. +If DELETE is non-nil, delete all those overlays." + (let ((overlays (overlays-at (or pos (point)))) + ov found) + (while (setq ov (pop overlays)) + (if (overlay-get ov prop) + (if delete (delete-overlay ov) (push ov found)))) + found)) + +(defun org-get-x-clipboard (value) + "Get the value of the x or Windows clipboard, compatible with XEmacs, and GNU Emacs 21." + (cond ((eq window-system 'x) + (let ((x (org-get-x-clipboard-compat value))) + (if x (org-no-properties x)))) + ((and (eq window-system 'w32) (fboundp 'w32-get-clipboard-data)) + (w32-get-clipboard-data)))) + +(defsubst org-decompose-region (beg end) + "Decompose from BEG to END." + (if (featurep 'xemacs) + (let ((modified-p (buffer-modified-p)) + (buffer-read-only nil)) + (remove-text-properties beg end '(composition nil)) + (set-buffer-modified-p modified-p)) + (decompose-region beg end))) + +;; Miscellaneous functions + +(defun org-add-hook (hook function &optional append local) + "Add-hook, compatible with both Emacsen." + (if (and local (featurep 'xemacs)) + (add-local-hook hook function append) + (add-hook hook function append local))) + +(defun org-add-props (string plist &rest props) + "Add text properties to entire string, from beginning to end. +PLIST may be a list of properties, PROPS are individual properties and values +that will be added to PLIST. Returns the string that was modified." + (add-text-properties + 0 (length string) (if props (append plist props) plist) string) + string) +(put 'org-add-props 'lisp-indent-function 2) + +(defun org-fit-window-to-buffer (&optional window max-height min-height + shrink-only) + "Fit WINDOW to the buffer, but only if it is not a side-by-side window. +WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are +passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call +`shrink-window-if-larger-than-buffer' instead, the height limit is +ignored in this case." + (cond ((if (fboundp 'window-full-width-p) + (not (window-full-width-p window)) + ;; do nothing if another window would suffer + (> (frame-width) (window-width window)))) + ((and (fboundp 'fit-window-to-buffer) (not shrink-only)) + (fit-window-to-buffer window max-height min-height)) + ((fboundp 'shrink-window-if-larger-than-buffer) + (shrink-window-if-larger-than-buffer window))) + (or window (selected-window))) + +(defun org-number-sequence (from &optional to inc) + "Call `number-sequence or emulate it." + (if (fboundp 'number-sequence) + (number-sequence from to inc) + (if (or (not to) (= from to)) + (list from) + (or inc (setq inc 1)) + (when (zerop inc) (error "The increment can not be zero")) + (let (seq (n 0) (next from)) + (if (> inc 0) + (while (<= next to) + (setq seq (cons next seq) + n (1+ n) + next (+ from (* n inc)))) + (while (>= next to) + (setq seq (cons next seq) + n (1+ n) + next (+ from (* n inc))))) + (nreverse seq))))) + +;; `set-transient-map' is only in Emacs >= 24.4 +(defalias 'org-set-transient-map + (if (fboundp 'set-transient-map) + 'set-transient-map + 'set-temporary-overlay-map)) + +;; Region compatibility + +(defvar org-ignore-region nil + "Non-nil means temporarily disable the active region.") + +(defun org-region-active-p () + "Is `transient-mark-mode' on and the region active? +Works on both Emacs and XEmacs." + (if org-ignore-region + nil + (if (featurep 'xemacs) + (and zmacs-regions (region-active-p)) + (if (fboundp 'use-region-p) + (use-region-p) + (and transient-mark-mode mark-active))))) ; Emacs 22 and before + +(defun org-cursor-to-region-beginning () + (when (and (org-region-active-p) + (> (point) (region-beginning))) + (exchange-point-and-mark))) + +;; Emacs 22 misses `activate-mark' +(if (fboundp 'activate-mark) + (defalias 'org-activate-mark 'activate-mark) + (defun org-activate-mark () + (when (mark t) + (setq mark-active t) + (when (and (boundp 'transient-mark-mode) + (not transient-mark-mode)) + (setq transient-mark-mode 'lambda)) + (when (boundp 'zmacs-regions) + (setq zmacs-regions t))))) + +;; Invisibility compatibility + +(defun org-remove-from-invisibility-spec (arg) + "Remove elements from `buffer-invisibility-spec'." + (if (fboundp 'remove-from-invisibility-spec) + (remove-from-invisibility-spec arg) + (if (consp buffer-invisibility-spec) + (setq buffer-invisibility-spec + (delete arg buffer-invisibility-spec))))) + +(defun org-in-invisibility-spec-p (arg) + "Is ARG a member of `buffer-invisibility-spec'?" + (if (consp buffer-invisibility-spec) + (member arg buffer-invisibility-spec))) + +(defmacro org-xemacs-without-invisibility (&rest body) + "Turn off extents with invisibility while executing BODY." + `(let ((ext-inv (extent-list nil (point-at-bol) (point-at-eol) + 'all-extents-closed-open 'invisible)) + ext-inv-specs) + (dolist (ext ext-inv) + (when (extent-property ext 'invisible) + (add-to-list 'ext-inv-specs (list ext (extent-property + ext 'invisible))) + (set-extent-property ext 'invisible nil))) + ,@body + (dolist (ext-inv-spec ext-inv-specs) + (set-extent-property (car ext-inv-spec) 'invisible + (cadr ext-inv-spec))))) +(def-edebug-spec org-xemacs-without-invisibility (body)) + +(defun org-indent-to-column (column &optional minimum buffer) + "Work around a bug with extents with invisibility in XEmacs." + (if (featurep 'xemacs) + (org-xemacs-without-invisibility (indent-to-column column minimum buffer)) + (indent-to-column column minimum))) + +(defun org-indent-line-to (column) + "Work around a bug with extents with invisibility in XEmacs." + (if (featurep 'xemacs) + (org-xemacs-without-invisibility (indent-line-to column)) + (indent-line-to column))) + +(defun org-move-to-column (column &optional force buffer) + "Move to column COLUMN. +Pass COLUMN and FORCE to `move-to-column'. +Pass BUFFER to the XEmacs version of `move-to-column'." + (let ((buffer-invisibility-spec + (remove '(org-filtered) buffer-invisibility-spec))) + (if (featurep 'xemacs) + (org-xemacs-without-invisibility + (move-to-column column force buffer)) + (move-to-column column force)))) + +(defun org-get-x-clipboard-compat (value) + "Get the clipboard value on XEmacs or Emacs 21." + (cond ((featurep 'xemacs) + (org-no-warnings (get-selection-no-error value))) + ((fboundp 'x-get-selection) + (condition-case nil + (or (x-get-selection value 'UTF8_STRING) + (x-get-selection value 'COMPOUND_TEXT) + (x-get-selection value 'STRING) + (x-get-selection value 'TEXT)) + (error nil))))) + +(defun org-propertize (string &rest properties) + (if (featurep 'xemacs) + (progn + (add-text-properties 0 (length string) properties string) + string) + (apply 'propertize string properties))) + +(defmacro org-find-library-dir (library) + `(file-name-directory (or (locate-library ,library) ""))) + +(defun org-count-lines (s) + "How many lines in string S?" + (let ((start 0) (n 1)) + (while (string-match "\n" s start) + (setq start (match-end 0) n (1+ n))) + (if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n)) + (setq n (1- n))) + n)) + +(defun org-kill-new (string &rest args) + (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t) + string) + (apply 'kill-new string args)) + +(defun org-select-frame-set-input-focus (frame) + "Select FRAME, raise it, and set input focus, if possible." + (cond ((featurep 'xemacs) + (if (fboundp 'select-frame-set-input-focus) + (select-frame-set-input-focus frame) + (raise-frame frame) + (select-frame frame) + (focus-frame frame))) + ;; `select-frame-set-input-focus' defined in Emacs 21 will not + ;; set the input focus. + ((>= emacs-major-version 22) + (select-frame-set-input-focus frame)) + (t + (raise-frame frame) + (select-frame frame) + (cond ((memq window-system '(x ns mac)) + (x-focus-frame frame)) + ((eq window-system 'w32) + (w32-focus-frame frame))) + (when focus-follows-mouse + (set-mouse-position frame (1- (frame-width frame)) 0))))) + +(defun org-float-time (&optional time) + "Convert time value TIME to a floating point number. +TIME defaults to the current time." + (if (featurep 'xemacs) + (time-to-seconds (or time (current-time))) + (float-time time))) + +;; `user-error' is only available from 24.2.50 on +(unless (fboundp 'user-error) + (defalias 'user-error 'error)) + +(defmacro org-no-popups (&rest body) + "Suppress popup windows. +Let-bind some variables to nil around BODY to achieve the desired +effect, which variables to use depends on the Emacs version." + (if (org-version-check "24.2.50" "" :predicate) + `(let (pop-up-frames display-buffer-alist) + ,@body) + `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) + ,@body))) + +(if (fboundp 'string-match-p) + (defalias 'org-string-match-p 'string-match-p) + (defun org-string-match-p (regexp string &optional start) + (save-match-data + (funcall 'string-match regexp string start)))) + +(if (fboundp 'looking-at-p) + (defalias 'org-looking-at-p 'looking-at-p) + (defun org-looking-at-p (&rest args) + (save-match-data + (apply 'looking-at args)))) + +;; XEmacs does not have `looking-back'. +(if (fboundp 'looking-back) + (defalias 'org-looking-back 'looking-back) + (defun org-looking-back (regexp &optional limit greedy) + "Return non-nil if text before point matches regular expression REGEXP. +Like `looking-at' except matches before point, and is slower. +LIMIT if non-nil speeds up the search by specifying a minimum +starting position, to avoid checking matches that would start +before LIMIT. + +If GREEDY is non-nil, extend the match backwards as far as +possible, stopping when a single additional previous character +cannot be part of a match for REGEXP. When the match is +extended, its starting position is allowed to occur before +LIMIT." + (let ((start (point)) + (pos + (save-excursion + (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t) + (point))))) + (if (and greedy pos) + (save-restriction + (narrow-to-region (point-min) start) + (while (and (> pos (point-min)) + (save-excursion + (goto-char pos) + (backward-char 1) + (looking-at (concat "\\(?:" regexp "\\)\\'")))) + (setq pos (1- pos))) + (save-excursion + (goto-char pos) + (looking-at (concat "\\(?:" regexp "\\)\\'"))))) + (not (null pos))))) + +(defun org-floor* (x &optional y) + "Return a list of the floor of X and the fractional part of X. +With two arguments, return floor and remainder of their quotient." + (let ((q (floor x y))) + (list q (- x (if y (* y q) q))))) + +;; `pop-to-buffer-same-window' has been introduced in Emacs 24.1. +(defun org-pop-to-buffer-same-window + (&optional buffer-or-name norecord label) + "Pop to buffer specified by BUFFER-OR-NAME in the selected window." + (if (fboundp 'pop-to-buffer-same-window) + (funcall + 'pop-to-buffer-same-window buffer-or-name norecord) + (funcall 'switch-to-buffer buffer-or-name norecord))) + +;; RECURSIVE has been introduced with Emacs 23.2. +;; This is copying and adapted from `tramp-compat-delete-directory' +(defun org-delete-directory (directory &optional recursive) + "Compatibility function for `delete-directory'." + (if (null recursive) + (delete-directory directory) + (condition-case nil + (funcall 'delete-directory directory recursive) + ;; This Emacs version does not support the RECURSIVE flag. We + ;; use the implementation from Emacs 23.2. + (wrong-number-of-arguments + (setq directory (directory-file-name (expand-file-name directory))) + (if (not (file-symlink-p directory)) + (mapc (lambda (file) + (if (eq t (car (file-attributes file))) + (org-delete-directory file recursive) + (delete-file file))) + (directory-files + directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) + (delete-directory directory))))) + +;;;###autoload +(defmacro org-check-version () + "Try very hard to provide sensible version strings." + (let* ((org-dir (org-find-library-dir "org")) + (org-version.el (concat org-dir "org-version.el")) + (org-fixup.el (concat org-dir "../mk/org-fixup.el"))) + (if (require 'org-version org-version.el 'noerror) + '(progn + (autoload 'org-release "org-version.el") + (autoload 'org-git-version "org-version.el")) + (if (require 'org-fixup org-fixup.el 'noerror) + '(org-fixup) + ;; provide fallback definitions and complain + (warn "Could not define org version correctly. Check installation!") + '(progn + (defun org-release () "N/A") + (defun org-git-version () "N/A !!check installation!!")))))) + +(defun org-file-equal-p (f1 f2) + "Return t if files F1 and F2 are the same. +Implements `file-equal-p' for older emacsen and XEmacs." + (if (fboundp 'file-equal-p) + (file-equal-p f1 f2) + (let (f1-attr f2-attr) + (and (setq f1-attr (file-attributes (file-truename f1))) + (setq f2-attr (file-attributes (file-truename f2))) + (equal f1-attr f2-attr))))) + +;; `buffer-narrowed-p' is available for Emacs >=24.3 +(defun org-buffer-narrowed-p () + "Compatibility function for `buffer-narrowed-p'." + (if (fboundp 'buffer-narrowed-p) + (buffer-narrowed-p) + (/= (- (point-max) (point-min)) (buffer-size)))) + +(defmacro org-with-silent-modifications (&rest body) + (if (fboundp 'with-silent-modifications) + `(with-silent-modifications ,@body) + `(org-unmodified ,@body))) +(def-edebug-spec org-with-silent-modifications (body)) + +(provide 'org-compat) + +;;; org-compat.el ends here diff --git a/elpa/org-20150427/org-crypt.el b/elpa/org-20150427/org-crypt.el new file mode 100644 index 00000000..46fd3e66 --- /dev/null +++ b/elpa/org-20150427/org-crypt.el @@ -0,0 +1,275 @@ +;;; org-crypt.el --- Public key encryption for org-mode entries + +;; Copyright (C) 2007-2014 Free Software Foundation, Inc. + +;; Emacs Lisp Archive Entry +;; Filename: org-crypt.el +;; Keywords: org-mode +;; Author: John Wiegley +;; Maintainer: Peter Jones +;; Description: Adds public key encryption to org-mode buffers +;; URL: http://www.newartisans.com/software/emacs.html +;; Compatibility: Emacs22 + +;; 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 . + +;;; Commentary: + +;; Right now this is just a set of functions to play with. It depends +;; on the epg library. Here's how you would use it: +;; +;; 1. To mark an entry for encryption, tag the heading with "crypt". +;; You can change the tag to any complex tag matching string by +;; setting the `org-crypt-tag-matcher' variable. +;; +;; 2. Set the encryption key to use in the `org-crypt-key' variable, +;; or use `M-x org-set-property' to set the property CRYPTKEY to +;; any address in your public keyring. The text of the entry (but +;; not its properties or headline) will be encrypted for this user. +;; For them to read it, the corresponding secret key must be +;; located in the secret key ring of the account where you try to +;; decrypt it. This makes it possible to leave secure notes that +;; only the intended recipient can read in a shared-org-mode-files +;; scenario. +;; If the key is not set, org-crypt will default to symmetric encryption. +;; +;; 3. To later decrypt an entry, use `org-decrypt-entries' or +;; `org-decrypt-entry'. It might be useful to bind this to a key, +;; like C-c C-/. I hope that in the future, C-c C-r can be might +;; overloaded to also decrypt an entry if it's encrypted, since +;; that fits nicely with the meaning of "reveal". +;; +;; 4. To automatically encrypt all necessary entries when saving a +;; file, call `org-crypt-use-before-save-magic' after loading +;; org-crypt.el. + +;;; Thanks: + +;; - Carsten Dominik +;; - Vitaly Ostanin + +(require 'org) + +;;; Code: + +(declare-function epg-decrypt-string "epg" (context cipher)) +(declare-function epg-list-keys "epg" (context &optional name mode)) +(declare-function epg-make-context "epg" + (&optional protocol armor textmode include-certs + cipher-algorithm digest-algorithm + compress-algorithm)) +(declare-function epg-encrypt-string "epg" + (context plain recipients &optional sign always-trust)) +(defvar epg-context) + + +(defgroup org-crypt nil + "Org Crypt." + :tag "Org Crypt" + :group 'org) + +(defcustom org-crypt-tag-matcher "crypt" + "The tag matcher used to find headings whose contents should be encrypted. + +See the \"Match syntax\" section of the org manual for more details." + :type 'string + :group 'org-crypt) + +(defcustom org-crypt-key "" + "The default key to use when encrypting the contents of a heading. + +This setting can also be overridden in the CRYPTKEY property." + :type 'string + :group 'org-crypt) + +(defcustom org-crypt-disable-auto-save 'ask + "What org-decrypt should do if `auto-save-mode' is enabled. + +t : Disable auto-save-mode for the current buffer + prior to decrypting an entry. + +nil : Leave auto-save-mode enabled. + This may cause data to be written to disk unencrypted! + +'ask : Ask user whether or not to disable auto-save-mode + for the current buffer. + +'encrypt : Leave auto-save-mode enabled for the current buffer, + but automatically re-encrypt all decrypted entries + *before* auto-saving. + NOTE: This only works for entries which have a tag + that matches `org-crypt-tag-matcher'." + :group 'org-crypt + :version "24.1" + :type '(choice (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "Ask" ask) + (const :tag "Encrypt" encrypt))) + +(defun org-crypt-check-auto-save () + "Check whether auto-save-mode is enabled for the current buffer. + +`auto-save-mode' may cause leakage when decrypting entries, so +check whether it's enabled, and decide what to do about it. + +See `org-crypt-disable-auto-save'." + (when buffer-auto-save-file-name + (cond + ((or + (eq org-crypt-disable-auto-save t) + (and + (eq org-crypt-disable-auto-save 'ask) + (y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? "))) + (message (concat "org-decrypt: Disabling auto-save-mode for " (or (buffer-file-name) (current-buffer)))) + ; The argument to auto-save-mode has to be "-1", since + ; giving a "nil" argument toggles instead of disabling. + (auto-save-mode -1)) + ((eq org-crypt-disable-auto-save nil) + (message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage.")) + ((eq org-crypt-disable-auto-save 'encrypt) + (message "org-decrypt: Enabling re-encryption on auto-save.") + (org-add-hook 'auto-save-hook + (lambda () + (message "org-crypt: Re-encrypting all decrypted entries due to auto-save.") + (org-encrypt-entries)) + nil t)) + (t nil)))) + +(defun org-crypt-key-for-heading () + "Return the encryption key for the current heading." + (save-excursion + (org-back-to-heading t) + (or (org-entry-get nil "CRYPTKEY" 'selective) + org-crypt-key + (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to) + (message "No crypt key set, using symmetric encryption.")))) + +(defun org-encrypt-string (str crypt-key) + "Return STR encrypted with CRYPT-KEY." + ;; Text and key have to be identical, otherwise we re-crypt. + (if (and (string= crypt-key (get-text-property 0 'org-crypt-key str)) + (string= (sha1 str) (get-text-property 0 'org-crypt-checksum str))) + (get-text-property 0 'org-crypt-text str) + (set (make-local-variable 'epg-context) (epg-make-context nil t t)) + (epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key)))) + +(defun org-encrypt-entry () + "Encrypt the content of the current headline." + (interactive) + (require 'epg) + (save-excursion + (org-back-to-heading t) + (set (make-local-variable 'epg-context) (epg-make-context nil t t)) + (let ((start-heading (point))) + (forward-line) + (when (not (looking-at "-----BEGIN PGP MESSAGE-----")) + (let ((folded (outline-invisible-p)) + (crypt-key (org-crypt-key-for-heading)) + (beg (point)) + end encrypted-text) + (goto-char start-heading) + (org-end-of-subtree t t) + (org-back-over-empty-lines) + (setq end (point) + encrypted-text + (org-encrypt-string (buffer-substring beg end) crypt-key)) + (delete-region beg end) + (insert encrypted-text) + (when folded + (goto-char start-heading) + (hide-subtree)) + nil))))) + +(defun org-decrypt-entry () + "Decrypt the content of the current headline." + (interactive) + (require 'epg) + (unless (org-before-first-heading-p) + (save-excursion + (org-back-to-heading t) + (let ((heading-point (point)) + (heading-was-invisible-p + (save-excursion + (outline-end-of-heading) + (outline-invisible-p)))) + (forward-line) + (when (looking-at "-----BEGIN PGP MESSAGE-----") + (org-crypt-check-auto-save) + (set (make-local-variable 'epg-context) (epg-make-context nil t t)) + (let* ((end (save-excursion + (search-forward "-----END PGP MESSAGE-----") + (forward-line) + (point))) + (encrypted-text (buffer-substring-no-properties (point) end)) + (decrypted-text + (decode-coding-string + (epg-decrypt-string + epg-context + encrypted-text) + 'utf-8))) + ;; Delete region starting just before point, because the + ;; outline property starts at the \n of the heading. + (delete-region (1- (point)) end) + ;; Store a checksum of the decrypted and the encrypted + ;; text value. This allow to reuse the same encrypted text + ;; if the text does not change, and therefore avoid a + ;; re-encryption process. + (insert "\n" (propertize decrypted-text + 'org-crypt-checksum (sha1 decrypted-text) + 'org-crypt-key (org-crypt-key-for-heading) + 'org-crypt-text encrypted-text)) + (when heading-was-invisible-p + (goto-char heading-point) + (org-flag-subtree t)) + nil)))))) + +(defun org-encrypt-entries () + "Encrypt all top-level entries in the current buffer." + (interactive) + (let (todo-only) + (org-scan-tags + 'org-encrypt-entry + (cdr (org-make-tags-matcher org-crypt-tag-matcher)) + todo-only))) + +(defun org-decrypt-entries () + "Decrypt all entries in the current buffer." + (interactive) + (let (todo-only) + (org-scan-tags + 'org-decrypt-entry + (cdr (org-make-tags-matcher org-crypt-tag-matcher)) + todo-only))) + +(defun org-at-encrypted-entry-p () + "Is the current entry encrypted?" + (unless (org-before-first-heading-p) + (save-excursion + (org-back-to-heading t) + (search-forward "-----BEGIN PGP MESSAGE-----" + (save-excursion (outline-next-heading)) t)))) + +(defun org-crypt-use-before-save-magic () + "Add a hook to automatically encrypt entries before a file is saved to disk." + (add-hook + 'org-mode-hook + (lambda () (org-add-hook 'before-save-hook 'org-encrypt-entries nil t)))) + +(add-hook 'org-reveal-start-hook 'org-decrypt-entry) + +(provide 'org-crypt) + +;;; org-crypt.el ends here diff --git a/elpa/org-20150427/org-ctags.el b/elpa/org-20150427/org-ctags.el new file mode 100644 index 00000000..41775bda --- /dev/null +++ b/elpa/org-20150427/org-ctags.el @@ -0,0 +1,541 @@ +;;; org-ctags.el - Integrate Emacs "tags" facility with org mode. +;; +;; Copyright (C) 2007-2014 Free Software Foundation, Inc. + +;; Author: Paul Sexton + + +;; Keywords: org, wp +;; +;; 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 . + +;; +;; Synopsis +;; ======== +;; +;; Allows org-mode to make use of the Emacs `etags' system. Defines tag +;; destinations in org-mode files as any text between <>. This allows the tags-generation program `exuberant ctags' to +;; parse these files and create tag tables that record where these +;; destinations are found. Plain [[links]] in org mode files which do not have +;; <> within the same file will then be interpreted as +;; links to these 'tagged' destinations, allowing seamless navigation between +;; multiple org-mode files. Topics can be created in any org mode file and +;; will always be found by plain links from other files. Other file types +;; recognized by ctags (source code files, latex files, etc) will also be +;; available as destinations for plain links, and similarly, org-mode links +;; will be available as tags from source files. Finally, the function +;; `org-ctags-find-tag-interactive' lets you choose any known tag, using +;; autocompletion, and quickly jump to it. +;; +;; Installation +;; ============ +;; +;; Install org mode +;; Ensure org-ctags.el is somewhere in your emacs load path. +;; Download and install Exuberant ctags -- "http://ctags.sourceforge.net/" +;; Edit your .emacs file (see next section) and load emacs. + +;; To put in your init file (.emacs): +;; ================================== +;; +;; Assuming you already have org mode installed and set up: +;; +;; (setq org-ctags-path-to-ctags "/path/to/ctags/executable") +;; (add-hook 'org-mode-hook +;; (lambda () +;; (define-key org-mode-map "\C-co" 'org-ctags-find-tag-interactive))) +;; +;; By default, with org-ctags loaded, org will first try and visit the tag +;; with the same name as the link; then, if unsuccessful, ask the user if +;; he/she wants to rebuild the 'TAGS' database and try again; then ask if +;; the user wishes to append 'tag' as a new toplevel heading at the end of +;; the buffer; and finally, defer to org's default behaviour which is to +;; search the entire text of the current buffer for 'tag'. +;; +;; This behaviour can be modified by changing the value of +;; ORG-CTAGS-OPEN-LINK-FUNCTIONS. For example I have the following in my +;; .emacs, which describes the same behaviour as the above paragraph with +;; one difference: +;; +;; (setq org-ctags-open-link-functions +;; '(org-ctags-find-tag +;; org-ctags-ask-rebuild-tags-file-then-find-tag +;; org-ctags-ask-append-topic +;; org-ctags-fail-silently)) ; <-- prevents org default behaviour +;; +;; +;; Usage +;; ===== +;; +;; When you click on a link "[[foo]]" and org cannot find a matching "<>" +;; in the current buffer, the tags facility will take over. The file TAGS in +;; the active directory is examined to see if the tags facility knows about +;; "<>" in any other files. If it does, the matching file will be opened +;; and the cursor will jump to the position of "<>" in that file. +;; +;; User-visible functions: +;; - `org-ctags-find-tag-interactive': type a tag (plain link) name and visit +;; it. With autocompletion. Bound to ctrl-O in the above setup. +;; - All the etags functions should work. These include: +;; +;; M-. `find-tag' -- finds the tag at point +;; +;; C-M-. find-tag based on regular expression +;; +;; M-x tags-search RET -- like C-M-. but searches through ENTIRE TEXT +;; of ALL the files referenced in the TAGS file. A quick way to +;; search through an entire 'project'. +;; +;; M-* "go back" from a tag jump. Like `org-mark-ring-goto'. +;; You may need to bind this key yourself with (eg) +;; (global-set-key (kbd "") 'pop-tag-mark) +;; +;; (see etags chapter in Emacs manual for more) +;; +;; +;; Keeping the TAGS file up to date +;; ================================ +;; +;; Tags mode has no way of knowing that you have created new tags by typing in +;; your org-mode buffer. New tags make it into the TAGS file in 3 ways: +;; +;; 1. You re-run (org-ctags-create-tags "directory") to rebuild the file. +;; 2. You put the function `org-ctags-ask-rebuild-tags-file-then-find-tag' in +;; your `org-open-link-functions' list, as is done in the setup +;; above. This will cause the TAGS file to be rebuilt whenever a link +;; cannot be found. This may be slow with large file collections however. +;; 3. You run the following from the command line (all 1 line): +;; +;; ctags --langdef=orgmode --langmap=orgmode:.org +;; --regex-orgmode="/<<([^>]+)>>/\1/d,definition/" +;; -f /your/path/TAGS -e -R /your/path/*.org +;; +;; If you are paranoid, you might want to run (org-ctags-create-tags +;; "/path/to/org/files") at startup, by including the following toplevel form +;; in .emacs. However this can cause a pause of several seconds if ctags has +;; to scan lots of files. +;; +;; (progn +;; (message "-- rebuilding tags tables...") +;; (mapc 'org-ctags-create-tags tags-table-list)) + +;;; Code: + +(eval-when-compile (require 'cl)) + +(require 'org) + +(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) + +(defgroup org-ctags nil + "Options concerning use of ctags within org mode." + :tag "Org-Ctags" + :group 'org-link) + +(defvar org-ctags-enabled-p t + "Activate ctags support in org mode?") + +(defvar org-ctags-tag-regexp "/<<([^>]+)>>/\\1/d,definition/" + "Regexp expression used by ctags external program. +The regexp matches tag destinations in org-mode files. +Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/ +See the ctags documentation for more information.") + +(defcustom org-ctags-path-to-ctags + (if (executable-find "ctags-exuberant") "ctags-exuberant" "ctags") + "Name of the ctags executable file." + :group 'org-ctags + :version "24.1" + :type 'file) + +(defcustom org-ctags-open-link-functions + '(org-ctags-find-tag + org-ctags-ask-rebuild-tags-file-then-find-tag + org-ctags-ask-append-topic) + "List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS when ORG-CTAGS is active." + :group 'org-ctags + :version "24.1" + :type 'hook + :options '(org-ctags-find-tag + org-ctags-ask-rebuild-tags-file-then-find-tag + org-ctags-rebuild-tags-file-then-find-tag + org-ctags-ask-append-topic + org-ctags-append-topic + org-ctags-ask-visit-buffer-or-file + org-ctags-visit-buffer-or-file + org-ctags-fail-silently)) + + +(defvar org-ctags-tag-list nil + "List of all tags in the active TAGS file. +Created as a local variable in each buffer.") + +(defcustom org-ctags-new-topic-template + "* <<%t>>\n\n\n\n\n\n" + "Text to insert when creating a new org file via opening a hyperlink. +The following patterns are replaced in the string: + `%t' - replaced with the capitalized title of the hyperlink" + :group 'org-ctags + :version "24.1" + :type 'string) + + +(add-hook 'org-mode-hook + (lambda () + (when (and org-ctags-enabled-p + (buffer-file-name)) + ;; Make sure this file's directory is added to default + ;; directories in which to search for tags. + (let ((tags-filename + (expand-file-name + (concat (file-name-directory (buffer-file-name)) + "/TAGS")))) + (when (file-exists-p tags-filename) + (visit-tags-table tags-filename)))))) + + +(defadvice visit-tags-table (after org-ctags-load-tag-list activate compile) + (when (and org-ctags-enabled-p tags-file-name) + (set (make-local-variable 'org-ctags-tag-list) + (org-ctags-all-tags-in-current-tags-table)))) + + +(defun org-ctags-enable () + (put 'org-mode 'find-tag-default-function 'org-ctags-find-tag-at-point) + (setq org-ctags-enabled-p t) + (dolist (fn org-ctags-open-link-functions) + (add-hook 'org-open-link-functions fn t))) + + +;;; General utility functions. =============================================== +;; These work outside org-ctags mode. + +(defun org-ctags-get-filename-for-tag (tag) + "TAG is a string. Search the active TAGS file for a matching tag. +If the tag is found, return a list containing the filename, line number, and +buffer position where the tag is found." + (interactive "sTag: ") + (unless tags-file-name + (call-interactively (visit-tags-table))) + (save-excursion + (visit-tags-table-buffer 'same) + (when tags-file-name + (with-current-buffer (get-file-buffer tags-file-name) + (goto-char (point-min)) + (cond + ((re-search-forward (format "^.*%s\\([0-9]+\\),\\([0-9]+\\)$" + (regexp-quote tag)) nil t) + (let ((line (string-to-number (match-string 1))) + (pos (string-to-number (match-string 2)))) + (cond + ((re-search-backward " \n\\(.*\\),[0-9]+\n") + (list (match-string 1) line pos)) + (t ; can't find a file name preceding the matched + ; tag?? + (error "Malformed TAGS file: %s" (buffer-name)))))) + (t ; tag not found + nil)))))) + + +(defun org-ctags-all-tags-in-current-tags-table () + "Read all tags defined in the active TAGS file, into a list of strings. +Return the list." + (interactive) + (let ((taglist nil)) + (unless tags-file-name + (call-interactively (visit-tags-table))) + (save-excursion + (visit-tags-table-buffer 'same) + (with-current-buffer (get-file-buffer tags-file-name) + (goto-char (point-min)) + (while (re-search-forward "^.*\\(.*\\)\\([0-9]+\\),\\([0-9]+\\)$" + nil t) + (push (substring-no-properties (match-string 1)) taglist))) + taglist))) + + +(defun org-ctags-string-search-and-replace (search replace string) + "Replace all instances of SEARCH with REPLACE in STRING." + (replace-regexp-in-string (regexp-quote search) replace string t t)) + + +(defun y-or-n-minibuffer (prompt) + (let ((use-dialog-box nil)) + (y-or-n-p prompt))) + + +;;; Internal functions ======================================================= + + +(defun org-ctags-open-file (name &optional title) + "Visit or create a file called `NAME.org', and insert a new topic. +The new topic will be titled NAME (or TITLE if supplied)." + (interactive "sFile name: ") + (let ((filename (substitute-in-file-name (expand-file-name name)))) + (condition-case v + (progn + (org-open-file name t) + (message "Opened file OK") + (goto-char (point-max)) + (insert (org-ctags-string-search-and-replace + "%t" (capitalize (or title name)) + org-ctags-new-topic-template)) + (message "Inserted new file text OK") + (org-mode-restart)) + (error (error "Error %S in org-ctags-open-file" v))))) + + +;;;; Misc interoperability with etags system ================================= + + +(defadvice find-tag (before org-ctags-set-org-mark-before-finding-tag + activate compile) + "Before trying to find a tag, save our current position on org mark ring." + (save-excursion + (if (and (derived-mode-p 'org-mode) org-ctags-enabled-p) + (org-mark-ring-push)))) + + + +(defun org-ctags-find-tag-at-point () + "Determine default tag to search for, based on text at point. +If there is no plausible default, return nil." + (let (from to bound) + (when (or (ignore-errors + ;; Look for hyperlink around `point'. + (save-excursion + (search-backward "[[") (setq from (+ 2 (point)))) + (save-excursion + (goto-char from) + (search-forward "]") (setq to (- (point) 1))) + (and (> to from) (>= (point) from) (<= (point) to))) + (progn + ;; Look at text around `point'. + (save-excursion + (skip-syntax-backward "w_") (setq from (point))) + (save-excursion + (skip-syntax-forward "w_") (setq to (point))) + (> to from)) + ;; Look between `line-beginning-position' and `point'. + (save-excursion + (and (setq bound (line-beginning-position)) + (skip-syntax-backward "^w_" bound) + (> (setq to (point)) bound) + (skip-syntax-backward "w_") + (setq from (point)))) + ;; Look between `point' and `line-end-position'. + (save-excursion + (and (setq bound (line-end-position)) + (skip-syntax-forward "^w_" bound) + (< (setq from (point)) bound) + (skip-syntax-forward "w_") + (setq to (point))))) + (buffer-substring-no-properties from to)))) + + +;;; Functions for use with 'org-open-link-functions' hook ================= + + +(defun org-ctags-find-tag (name) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Look for a tag called `NAME' in the current TAGS table. If it is found, +visit the file and location where the tag is found." + (interactive "sTag: ") + (let ((old-buf (current-buffer)) + (old-pnt (point-marker)) + (old-mark (copy-marker (mark-marker)))) + (condition-case nil + (progn (find-tag name) + t) + (error + ;; only restore old location if find-tag raises error + (set-buffer old-buf) + (goto-char old-pnt) + (set-marker (mark-marker) old-mark) + nil)))) + + +(defun org-ctags-visit-buffer-or-file (name &optional create) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Visit buffer named `NAME.org'. If there is no such buffer, visit the file +with the same name if it exists. If the file does not exist, then behavior +depends on the value of CREATE. + +If CREATE is nil (default), then return nil. Do not create a new file. +If CREATE is t, create the new file and visit it. +If CREATE is the symbol `ask', then ask the user if they wish to create +the new file." + (interactive) + (let ((filename (concat (substitute-in-file-name + (expand-file-name name)) + ".org"))) + (cond + ((get-buffer (concat name ".org")) + ;; Buffer is already open + (org-pop-to-buffer-same-window (get-buffer (concat name ".org")))) + ((file-exists-p filename) + ;; File exists but is not open --> open it + (message "Opening existing org file `%S'..." + filename) + (org-open-file filename t)) + ((or (eql create t) + (and (eql create 'ask) + (y-or-n-p (format "File `%s.org' not found; create?" name)))) + (org-ctags-open-file filename name)) + (t ;; File does not exist, and we don't want to create it. + nil)))) + + +(defun org-ctags-ask-visit-buffer-or-file (name) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Wrapper for org-ctags-visit-buffer-or-file, which ensures the user is +asked before creating a new file." + (org-ctags-visit-buffer-or-file name 'ask)) + + +(defun org-ctags-append-topic (name &optional narrowp) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Append a new toplevel heading to the end of the current buffer. The +heading contains NAME surrounded by <>, thus making +the heading a destination for the tag `NAME'." + (interactive "sTopic: ") + (widen) + (goto-char (point-max)) + (newline 2) + (message "Adding topic in buffer %s" (buffer-name)) + (insert (org-ctags-string-search-and-replace + "%t" (capitalize name) org-ctags-new-topic-template)) + (backward-char 4) + (org-update-radio-target-regexp) + (end-of-line) + (forward-line 2) + (when narrowp + ;;(org-tree-to-indirect-buffer 1) ;; opens new frame + (org-narrow-to-subtree)) + t) + + +(defun org-ctags-ask-append-topic (name &optional narrowp) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Wrapper for org-ctags-append-topic, which first asks the user if they want +to append a new topic." + (if (y-or-n-p (format "Topic `%s' not found; append to end of buffer?" + name)) + (org-ctags-append-topic name narrowp) + nil)) + + +(defun org-ctags-rebuild-tags-file-then-find-tag (name) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Like ORG-CTAGS-FIND-TAG, but calls the external ctags program first, +to rebuild (update) the TAGS file." + (unless tags-file-name + (call-interactively (visit-tags-table))) + (when (buffer-file-name) + (org-ctags-create-tags)) + (org-ctags-find-tag name)) + + +(defun org-ctags-ask-rebuild-tags-file-then-find-tag (name) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Wrapper for org-ctags-rebuild-tags-file-then-find-tag." + (if (and (buffer-file-name) + (y-or-n-p + (format + "Tag `%s' not found. Rebuild table `%s/TAGS' and look again?" + name + (file-name-directory (buffer-file-name))))) + (org-ctags-rebuild-tags-file-then-find-tag name) + nil)) + + +(defun org-ctags-fail-silently (name) + "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. +Put as the last function in the list if you want to prevent org's default +behavior of free text search." + t) + + +;;; User-visible functions =================================================== + + +(defun org-ctags-create-tags (&optional directory-name) + "(Re)create tags file in the directory of the active buffer. +The file will contain tag definitions for all the files in the +directory and its subdirectories which are recognized by ctags. +This will include files ending in `.org' as well as most other +source files (.C, .H, .EL, .LISP, etc). All the resulting tags +end up in one file, called TAGS, located in the directory. This +function may take several seconds to finish if the directory or +its subdirectories contain large numbers of taggable files." + (interactive) + (assert (buffer-file-name)) + (let ((dir-name (or directory-name + (file-name-directory (buffer-file-name)))) + (exitcode nil)) + (save-excursion + (setq exitcode + (shell-command + (format (concat "%s --langdef=orgmode --langmap=orgmode:.org " + "--regex-orgmode=\"%s\" -f \"%s\" -e -R \"%s\"") + org-ctags-path-to-ctags + org-ctags-tag-regexp + (expand-file-name (concat dir-name "/TAGS")) + (expand-file-name (concat dir-name "/*"))))) + (cond + ((eql 0 exitcode) + (set (make-local-variable 'org-ctags-tag-list) + (org-ctags-all-tags-in-current-tags-table))) + (t + ;; This seems to behave differently on Linux, so just ignore + ;; error codes for now + ;;(error "Calling ctags executable resulted in error code: %s" + ;; exitcode) + nil))))) + + +(defvar org-ctags-find-tag-history nil + "History of tags visited by org-ctags-find-tag-interactive.") + +(defun org-ctags-find-tag-interactive () + "Prompt for the name of a tag, with autocompletion, then visit the named tag. +Uses `ido-mode' if available. +If the user enters a string that does not match an existing tag, create +a new topic." + (interactive) + (let* ((completing-read-fn (if (fboundp 'ido-completing-read) + 'ido-completing-read + 'completing-read)) + (tag (funcall completing-read-fn "Topic: " org-ctags-tag-list + nil 'confirm nil 'org-ctags-find-tag-history))) + (when tag + (cond + ((member tag org-ctags-tag-list) + ;; Existing tag + (push tag org-ctags-find-tag-history) + (find-tag tag)) + (t + ;; New tag + (run-hook-with-args-until-success + 'org-open-link-functions tag)))))) + + +(org-ctags-enable) + +(provide 'org-ctags) + +;;; org-ctags.el ends here diff --git a/elpa/org-20150427/org-datetree.el b/elpa/org-20150427/org-datetree.el new file mode 100644 index 00000000..0646c3b5 --- /dev/null +++ b/elpa/org-20150427/org-datetree.el @@ -0,0 +1,217 @@ +;;; org-datetree.el --- Create date entries in a tree + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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 . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains code to create entries in a tree where the top-level +;; nodes represent years, the level 2 nodes represent the months, and the +;; level 1 entries days. + +;;; Code: + +(require 'org) + +(defvar org-datetree-base-level 1 + "The level at which years should be placed in the date tree. +This is normally one, but if the buffer has an entry with a DATE_TREE +property (any value), the date tree will become a subtree under that entry, +so the base level will be properly adjusted.") + +(defcustom org-datetree-add-timestamp nil + "When non-nil, add a time stamp when create a datetree entry." + :group 'org-capture + :version "24.3" + :type '(choice + (const :tag "Do not add a time stamp" nil) + (const :tag "Add an inactive time stamp" inactive) + (const :tag "Add an active time stamp" active))) + +;;;###autoload +(defun org-datetree-find-date-create (date &optional keep-restriction) + "Find or create an entry for DATE. +If KEEP-RESTRICTION is non-nil, do not widen the buffer. +When it is nil, the buffer will be widened to make sure an existing date +tree can be found." + (let ((year (nth 2 date)) + (month (car date)) + (day (nth 1 date))) + (org-set-local 'org-datetree-base-level 1) + (or keep-restriction (widen)) + (goto-char (point-min)) + (save-restriction + (when (re-search-forward "^[ \t]*:DATE_TREE:[ \t]+\\S-" nil t) + (org-back-to-heading t) + (org-set-local 'org-datetree-base-level + (org-get-valid-level (funcall outline-level) 1)) + (org-narrow-to-subtree)) + (goto-char (point-min)) + (org-datetree-find-year-create year) + (org-datetree-find-month-create year month) + (org-datetree-find-day-create year month day) + (goto-char (prog1 (point) (widen)))))) + +(defun org-datetree-find-year-create (year) + "Find the YEAR datetree or create it." + (let ((re "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\\([ \t]:[[:alnum:]:_@#%]+:\\)?\\s-*$\\)") + match) + (goto-char (point-min)) + (while (and (setq match (re-search-forward re nil t)) + (goto-char (match-beginning 1)) + (< (string-to-number (match-string 1)) year))) + (cond + ((not match) + (goto-char (point-max)) + (or (bolp) (newline)) + (org-datetree-insert-line year)) + ((= (string-to-number (match-string 1)) year) + (goto-char (point-at-bol))) + (t + (beginning-of-line 1) + (org-datetree-insert-line year))))) + +(defun org-datetree-find-month-create (year month) + "Find the datetree for YEAR and MONTH or create it." + (org-narrow-to-subtree) + (let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" year)) + match) + (goto-char (point-min)) + (while (and (setq match (re-search-forward re nil t)) + (goto-char (match-beginning 1)) + (< (string-to-number (match-string 1)) month))) + (cond + ((not match) + (goto-char (point-max)) + (or (bolp) (newline)) + (org-datetree-insert-line year month)) + ((= (string-to-number (match-string 1)) month) + (goto-char (point-at-bol))) + (t + (beginning-of-line 1) + (org-datetree-insert-line year month))))) + +(defun org-datetree-find-day-create (year month day) + "Find the datetree for YEAR, MONTH and DAY or create it." + (org-narrow-to-subtree) + (let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" year month)) + match) + (goto-char (point-min)) + (while (and (setq match (re-search-forward re nil t)) + (goto-char (match-beginning 1)) + (< (string-to-number (match-string 1)) day))) + (cond + ((not match) + (goto-char (point-max)) + (or (bolp) (newline)) + (org-datetree-insert-line year month day)) + ((= (string-to-number (match-string 1)) day) + (goto-char (point-at-bol))) + (t + (beginning-of-line 1) + (org-datetree-insert-line year month day))))) + +(defun org-datetree-insert-line (year &optional month day) + (let ((pos (point)) ts-type) + (skip-chars-backward " \t\n") + (delete-region (point) pos) + (insert "\n" (make-string org-datetree-base-level ?*) " \n") + (backward-char 1) + (if month (org-do-demote)) + (if day (org-do-demote)) + (insert (format "%d" year)) + (when month + (insert (format "-%02d" month)) + (if day + (insert (format "-%02d %s" + day (format-time-string + "%A" (encode-time 0 0 0 day month year)))) + (insert (format " %s" + (format-time-string + "%B" (encode-time 0 0 0 1 month year)))))) + (when (and day (setq ts-type org-datetree-add-timestamp)) + (insert "\n") + (org-indent-line) + (org-insert-time-stamp (encode-time 0 0 0 day month year) nil ts-type)) + (beginning-of-line 1))) + +(defun org-datetree-file-entry-under (txt date) + "Insert a node TXT into the date tree under DATE." + (org-datetree-find-date-create date) + (let ((level (org-get-valid-level (funcall outline-level) 1))) + (org-end-of-subtree t t) + (org-back-over-empty-lines) + (org-paste-subtree level txt))) + +(defun org-datetree-cleanup () + "Make sure all entries in the current tree are under the correct date. +It may be useful to restrict the buffer to the applicable portion +before running this command, even though the command tries to be smart." + (interactive) + (goto-char (point-min)) + (let ((dre (concat "\\<" org-deadline-string "\\>[ \t]*\\'")) + (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'")) + dct ts tmp date year month day pos hdl-pos) + (while (re-search-forward org-ts-regexp nil t) + (catch 'next + (setq ts (match-string 0)) + (setq tmp (buffer-substring + (max (point-at-bol) (- (match-beginning 0) + org-ds-keyword-length)) + (match-beginning 0))) + (if (or (string-match "-\\'" tmp) + (string-match dre tmp) + (string-match sre tmp)) + (throw 'next nil)) + (setq dct (decode-time (org-time-string-to-time (match-string 0))) + date (list (nth 4 dct) (nth 3 dct) (nth 5 dct)) + year (nth 2 date) + month (car date) + day (nth 1 date) + pos (point)) + (org-back-to-heading t) + (setq hdl-pos (point)) + (unless (org-up-heading-safe) + ;; No parent, we are not in a date tree + (goto-char pos) + (throw 'next nil)) + (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]") + ;; Parent looks wrong, we are not in a date tree + (goto-char pos) + (throw 'next nil)) + (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day)) + ;; At correct date already, do nothing + (progn (goto-char pos) (throw 'next nil))) + ;; OK, we need to refile this entry + (goto-char hdl-pos) + (org-cut-subtree) + (save-excursion + (save-restriction + (org-datetree-file-entry-under (current-kill 0) date))))))) + +(provide 'org-datetree) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-datetree.el ends here diff --git a/elpa/org-20150427/org-docview.el b/elpa/org-20150427/org-docview.el new file mode 100644 index 00000000..d2db6855 --- /dev/null +++ b/elpa/org-20150427/org-docview.el @@ -0,0 +1,101 @@ +;;; org-docview.el --- support for links to doc-view-mode buffers + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: Jan Böcker +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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 . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file implements links to open files in doc-view-mode. +;; Org-mode loads this module by default - if this is not what you want, +;; configure the variable `org-modules'. + +;; The links take the form +;; +;; docview::: +;; +;; for example: [[docview:~/.elisp/org/doc/org.pdf::1][Org-Mode Manual]] +;; +;; Autocompletion for inserting links is supported; you will be +;; prompted for a file and a page number. +;; +;; If you use org-store-link in a doc-view mode buffer, the stored +;; link will point to the current page. + +;;; Code: + + +(require 'org) +(require 'doc-view) + +(declare-function doc-view-goto-page "doc-view" (page)) +(declare-function image-mode-window-get "image-mode" (prop &optional winprops)) + +(org-add-link-type "docview" 'org-docview-open 'org-docview-export) +(add-hook 'org-store-link-functions 'org-docview-store-link) + +(defun org-docview-export (link description format) + "Export a docview link from Org files." + (let* ((path (when (string-match "\\(.+\\)::.+" link) + (match-string 1 link))) + (desc (or description link))) + (when (stringp path) + (setq path (org-link-escape (expand-file-name path))) + (cond + ((eq format 'html) (format "%s" path desc)) + ((eq format 'latex) (format "\href{%s}{%s}" path desc)) + ((eq format 'ascii) (format "%s (%s)" desc path)) + (t path))))) + +(defun org-docview-open (link) + (when (string-match "\\(.*\\)::\\([0-9]+\\)$" link) + (let* ((path (match-string 1 link)) + (page (string-to-number (match-string 2 link)))) + (org-open-file path 1) ;; let org-mode open the file (in-emacs = 1) + ;; to ensure org-link-frame-setup is respected + (doc-view-goto-page page) + ))) + +(defun org-docview-store-link () + "Store a link to a docview buffer." + (when (eq major-mode 'doc-view-mode) + ;; This buffer is in doc-view-mode + (let* ((path buffer-file-name) + (page (image-mode-window-get 'page)) + (link (concat "docview:" path "::" (number-to-string page))) + (description "")) + (org-store-link-props + :type "docview" + :link link + :description path)))) + +(defun org-docview-complete-link () + "Use the existing file name completion for file. +Links to get the file name, then ask the user for the page number +and append it." + (concat (replace-regexp-in-string "^file:" "docview:" (org-file-complete-link)) + "::" + (read-from-minibuffer "Page:" "1"))) + + +(provide 'org-docview) + +;;; org-docview.el ends here diff --git a/elpa/org-20150427/org-element.el b/elpa/org-20150427/org-element.el new file mode 100644 index 00000000..0ec86cfa --- /dev/null +++ b/elpa/org-20150427/org-element.el @@ -0,0 +1,5024 @@ +;;; org-element.el --- Parser And Applications for Org syntax + +;; Copyright (C) 2012-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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 . + +;;; Commentary: +;; +;; Org syntax can be divided into three categories: "Greater +;; elements", "Elements" and "Objects". +;; +;; Elements are related to the structure of the document. Indeed, all +;; elements are a cover for the document: each position within belongs +;; to at least one element. +;; +;; An element always starts and ends at the beginning of a line. With +;; a few exceptions (`clock', `headline', `inlinetask', `item', +;; `planning', `node-property', `quote-section' `section' and +;; `table-row' types), it can also accept a fixed set of keywords as +;; attributes. Those are called "affiliated keywords" to distinguish +;; them from other keywords, which are full-fledged elements. Almost +;; all affiliated keywords are referenced in +;; `org-element-affiliated-keywords'; the others are export attributes +;; and start with "ATTR_" prefix. +;; +;; Element containing other elements (and only elements) are called +;; greater elements. Concerned types are: `center-block', `drawer', +;; `dynamic-block', `footnote-definition', `headline', `inlinetask', +;; `item', `plain-list', `property-drawer', `quote-block', `section' +;; and `special-block'. +;; +;; Other element types are: `babel-call', `clock', `comment', +;; `comment-block', `diary-sexp', `example-block', `export-block', +;; `fixed-width', `horizontal-rule', `keyword', `latex-environment', +;; `node-property', `paragraph', `planning', `quote-section', +;; `src-block', `table', `table-row' and `verse-block'. Among them, +;; `paragraph' and `verse-block' types can contain Org objects and +;; plain text. +;; +;; Objects are related to document's contents. Some of them are +;; recursive. Associated types are of the following: `bold', `code', +;; `entity', `export-snippet', `footnote-reference', +;; `inline-babel-call', `inline-src-block', `italic', +;; `latex-fragment', `line-break', `link', `macro', `radio-target', +;; `statistics-cookie', `strike-through', `subscript', `superscript', +;; `table-cell', `target', `timestamp', `underline' and `verbatim'. +;; +;; Some elements also have special properties whose value can hold +;; objects themselves (e.g. an item tag or a headline name). Such +;; values are called "secondary strings". Any object belongs to +;; either an element or a secondary string. +;; +;; Notwithstanding affiliated keywords, each greater element, element +;; and object has a fixed set of properties attached to it. Among +;; them, four are shared by all types: `:begin' and `:end', which +;; refer to the beginning and ending buffer positions of the +;; considered element or object, `:post-blank', which holds the number +;; of blank lines, or white spaces, at its end and `:parent' which +;; refers to the element or object containing it. Greater elements, +;; elements and objects containing objects will also have +;; `:contents-begin' and `:contents-end' properties to delimit +;; contents. Eventually, greater elements and elements accepting +;; affiliated keywords will have a `:post-affiliated' property, +;; referring to the buffer position after all such keywords. +;; +;; At the lowest level, a `:parent' property is also attached to any +;; string, as a text property. +;; +;; Lisp-wise, an element or an object can be represented as a list. +;; It follows the pattern (TYPE PROPERTIES CONTENTS), where: +;; TYPE is a symbol describing the Org element or object. +;; PROPERTIES is the property list attached to it. See docstring of +;; appropriate parsing function to get an exhaustive +;; list. +;; CONTENTS is a list of elements, objects or raw strings contained +;; in the current element or object, when applicable. +;; +;; An Org buffer is a nested list of such elements and objects, whose +;; type is `org-data' and properties is nil. +;; +;; The first part of this file defines Org syntax, while the second +;; one provide accessors and setters functions. +;; +;; The next part implements a parser and an interpreter for each +;; element and object type in Org syntax. +;; +;; The following part creates a fully recursive buffer parser. It +;; also provides a tool to map a function to elements or objects +;; matching some criteria in the parse tree. Functions of interest +;; are `org-element-parse-buffer', `org-element-map' and, to a lesser +;; extent, `org-element-parse-secondary-string'. +;; +;; The penultimate part is the cradle of an interpreter for the +;; obtained parse tree: `org-element-interpret-data'. +;; +;; The library ends by furnishing `org-element-at-point' function, and +;; a way to give information about document structure around point +;; with `org-element-context'. + + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'org) + + + +;;; Definitions And Rules +;; +;; Define elements, greater elements and specify recursive objects, +;; along with the affiliated keywords recognized. Also set up +;; restrictions on recursive objects combinations. +;; +;; These variables really act as a control center for the parsing +;; process. + +(defconst org-element-paragraph-separate + (concat "^\\(?:" + ;; Headlines, inlinetasks. + org-outline-regexp "\\|" + ;; Footnote definitions. + "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|" + ;; Diary sexps. + "%%(" "\\|" + "[ \t]*\\(?:" + ;; Empty lines. + "$" "\\|" + ;; Tables (any type). + "\\(?:|\\|\\+-[-+]\\)" "\\|" + ;; Blocks (any type), Babel calls and keywords. Note: this + ;; is only an indication and need some thorough check. + "#\\(?:[+ ]\\|$\\)" "\\|" + ;; Drawers (any type) and fixed-width areas. This is also + ;; only an indication. + ":" "\\|" + ;; Horizontal rules. + "-\\{5,\\}[ \t]*$" "\\|" + ;; LaTeX environments. + "\\\\begin{\\([A-Za-z0-9]+\\*?\\)}" "\\|" + ;; Planning and Clock lines. + (regexp-opt (list org-scheduled-string + org-deadline-string + org-closed-string + org-clock-string)) + "\\|" + ;; Lists. + (let ((term (case org-plain-list-ordered-item-terminator + (?\) ")") (?. "\\.") (otherwise "[.)]"))) + (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]"))) + (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)" + "\\(?:[ \t]\\|$\\)")) + "\\)\\)") + "Regexp to separate paragraphs in an Org buffer. +In the case of lines starting with \"#\" and \":\", this regexp +is not sufficient to know if point is at a paragraph ending. See +`org-element-paragraph-parser' for more information.") + +(defconst org-element-all-elements + '(babel-call center-block clock comment comment-block diary-sexp drawer + dynamic-block example-block export-block fixed-width + footnote-definition headline horizontal-rule inlinetask item + keyword latex-environment node-property paragraph plain-list + planning property-drawer quote-block quote-section section + special-block src-block table table-row verse-block) + "Complete list of element types.") + +(defconst org-element-greater-elements + '(center-block drawer dynamic-block footnote-definition headline inlinetask + item plain-list property-drawer quote-block section + special-block table) + "List of recursive element types aka Greater Elements.") + +(defconst org-element-all-successors + '(link export-snippet footnote-reference inline-babel-call + inline-src-block latex-or-entity line-break macro plain-link + radio-target statistics-cookie sub/superscript table-cell target + text-markup timestamp) + "Complete list of successors.") + +(defconst org-element-object-successor-alist + '((subscript . sub/superscript) (superscript . sub/superscript) + (bold . text-markup) (code . text-markup) (italic . text-markup) + (strike-through . text-markup) (underline . text-markup) + (verbatim . text-markup) (entity . latex-or-entity) + (latex-fragment . latex-or-entity)) + "Alist of translations between object type and successor name. +Sharing the same successor comes handy when, for example, the +regexp matching one object can also match the other object.") + +(defconst org-element-all-objects + '(bold code entity export-snippet footnote-reference inline-babel-call + inline-src-block italic line-break latex-fragment link macro + radio-target statistics-cookie strike-through subscript superscript + table-cell target timestamp underline verbatim) + "Complete list of object types.") + +(defconst org-element-recursive-objects + '(bold italic link subscript radio-target strike-through superscript + table-cell underline) + "List of recursive object types.") + +(defvar org-element-block-name-alist + '(("CENTER" . org-element-center-block-parser) + ("COMMENT" . org-element-comment-block-parser) + ("EXAMPLE" . org-element-example-block-parser) + ("QUOTE" . org-element-quote-block-parser) + ("SRC" . org-element-src-block-parser) + ("VERSE" . org-element-verse-block-parser)) + "Alist between block names and the associated parsing function. +Names must be uppercase. Any block whose name has no association +is parsed with `org-element-special-block-parser'.") + +(defconst org-element-link-type-is-file + '("file" "file+emacs" "file+sys" "docview") + "List of link types equivalent to \"file\". +Only these types can accept search options and an explicit +application to open them.") + +(defconst org-element-affiliated-keywords + '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT" + "RESULTS" "SOURCE" "SRCNAME" "TBLNAME") + "List of affiliated keywords as strings. +By default, all keywords setting attributes (e.g., \"ATTR_LATEX\") +are affiliated keywords and need not to be in this list.") + +(defconst org-element-keyword-translation-alist + '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME") + ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME") + ("RESULT" . "RESULTS") ("HEADERS" . "HEADER")) + "Alist of usual translations for keywords. +The key is the old name and the value the new one. The property +holding their value will be named after the translated name.") + +(defconst org-element-multiple-keywords '("CAPTION" "HEADER") + "List of affiliated keywords that can occur more than once in an element. + +Their value will be consed into a list of strings, which will be +returned as the value of the property. + +This list is checked after translations have been applied. See +`org-element-keyword-translation-alist'. + +By default, all keywords setting attributes (e.g., \"ATTR_LATEX\") +allow multiple occurrences and need not to be in this list.") + +(defconst org-element-parsed-keywords '("CAPTION") + "List of affiliated keywords whose value can be parsed. + +Their value will be stored as a secondary string: a list of +strings and objects. + +This list is checked after translations have been applied. See +`org-element-keyword-translation-alist'.") + +(defconst org-element-dual-keywords '("CAPTION" "RESULTS") + "List of affiliated keywords which can have a secondary value. + +In Org syntax, they can be written with optional square brackets +before the colons. For example, RESULTS keyword can be +associated to a hash value with the following: + + #+RESULTS[hash-string]: some-source + +This list is checked after translations have been applied. See +`org-element-keyword-translation-alist'.") + +(defconst org-element-document-properties '("AUTHOR" "DATE" "TITLE") + "List of properties associated to the whole document. +Any keyword in this list will have its value parsed and stored as +a secondary string.") + +(defconst org-element--affiliated-re + (format "[ \t]*#\\+\\(?:%s\\):\\(?: \\|$\\)" + (concat + ;; Dual affiliated keywords. + (format "\\(?1:%s\\)\\(?:\\[\\(.*\\)\\]\\)?" + (regexp-opt org-element-dual-keywords)) + "\\|" + ;; Regular affiliated keywords. + (format "\\(?1:%s\\)" + (regexp-opt + (org-remove-if + #'(lambda (keyword) + (member keyword org-element-dual-keywords)) + org-element-affiliated-keywords))) + "\\|" + ;; Export attributes. + "\\(?1:ATTR_[-_A-Za-z0-9]+\\)")) + "Regexp matching any affiliated keyword. + +Keyword name is put in match group 1. Moreover, if keyword +belongs to `org-element-dual-keywords', put the dual value in +match group 2. + +Don't modify it, set `org-element-affiliated-keywords' instead.") + +(defconst org-element-object-restrictions + (let* ((standard-set + (remq 'plain-link (remq 'table-cell org-element-all-successors))) + (standard-set-no-line-break (remq 'line-break standard-set))) + `((bold ,@standard-set) + (footnote-reference ,@standard-set) + (headline ,@standard-set-no-line-break) + (inlinetask ,@standard-set-no-line-break) + (italic ,@standard-set) + (item ,@standard-set-no-line-break) + (keyword ,@standard-set) + ;; Ignore all links excepted plain links in a link description. + ;; Also ignore radio-targets and line breaks. + (link export-snippet inline-babel-call inline-src-block latex-or-entity + macro plain-link statistics-cookie sub/superscript text-markup) + (paragraph ,@standard-set) + ;; Remove any variable object from radio target as it would + ;; prevent it from being properly recognized. + (radio-target latex-or-entity sub/superscript text-markup) + (strike-through ,@standard-set) + (subscript ,@standard-set) + (superscript ,@standard-set) + ;; Ignore inline babel call and inline src block as formulas are + ;; possible. Also ignore line breaks and statistics cookies. + (table-cell link export-snippet footnote-reference latex-or-entity macro + radio-target sub/superscript target text-markup timestamp) + (table-row table-cell) + (underline ,@standard-set) + (verse-block ,@standard-set))) + "Alist of objects restrictions. + +CAR is an element or object type containing objects and CDR is +a list of successors that will be called within an element or +object of such type. + +For example, in a `radio-target' object, one can only find +entities, latex-fragments, subscript, superscript and text +markup. + +This alist also applies to secondary string. For example, an +`headline' type element doesn't directly contain objects, but +still has an entry since one of its properties (`:title') does.") + +(defconst org-element-secondary-value-alist + '((headline . :title) + (inlinetask . :title) + (item . :tag) + (footnote-reference . :inline-definition)) + "Alist between element types and location of secondary value.") + + + +;;; Accessors and Setters +;; +;; Provide four accessors: `org-element-type', `org-element-property' +;; `org-element-contents' and `org-element-restriction'. +;; +;; Setter functions allow to modify elements by side effect. There is +;; `org-element-put-property', `org-element-set-contents', +;; `org-element-set-element' and `org-element-adopt-element'. Note +;; that `org-element-set-element' and `org-element-adopt-elements' are +;; higher level functions since also update `:parent' property. + +(defsubst org-element-type (element) + "Return type of ELEMENT. + +The function returns the type of the element or object provided. +It can also return the following special value: + `plain-text' for a string + `org-data' for a complete document + nil in any other case." + (cond + ((not (consp element)) (and (stringp element) 'plain-text)) + ((symbolp (car element)) (car element)))) + +(defsubst org-element-property (property element) + "Extract the value from the PROPERTY of an ELEMENT." + (if (stringp element) (get-text-property 0 property element) + (plist-get (nth 1 element) property))) + +(defsubst org-element-contents (element) + "Extract contents from an ELEMENT." + (cond ((not (consp element)) nil) + ((symbolp (car element)) (nthcdr 2 element)) + (t element))) + +(defsubst org-element-restriction (element) + "Return restriction associated to ELEMENT. +ELEMENT can be an element, an object or a symbol representing an +element or object type." + (cdr (assq (if (symbolp element) element (org-element-type element)) + org-element-object-restrictions))) + +(defsubst org-element-put-property (element property value) + "In ELEMENT set PROPERTY to VALUE. +Return modified element." + (if (stringp element) (org-add-props element nil property value) + (setcar (cdr element) (plist-put (nth 1 element) property value)) + element)) + +(defsubst org-element-set-contents (element &rest contents) + "Set ELEMENT contents to CONTENTS. +Return modified element." + (cond ((not element) (list contents)) + ((not (symbolp (car element))) contents) + ((cdr element) (setcdr (cdr element) contents)) + (t (nconc element contents)))) + +(defsubst org-element-set-element (old new) + "Replace element or object OLD with element or object NEW. +The function takes care of setting `:parent' property for NEW." + ;; Since OLD is going to be changed into NEW by side-effect, first + ;; make sure that every element or object within NEW has OLD as + ;; parent. + (mapc (lambda (blob) (org-element-put-property blob :parent old)) + (org-element-contents new)) + ;; Transfer contents. + (apply 'org-element-set-contents old (org-element-contents new)) + ;; Ensure NEW has same parent as OLD, then overwrite OLD properties + ;; with NEW's. + (org-element-put-property new :parent (org-element-property :parent old)) + (setcar (cdr old) (nth 1 new)) + ;; Transfer type. + (setcar old (car new))) + +(defsubst org-element-adopt-elements (parent &rest children) + "Append elements to the contents of another element. + +PARENT is an element or object. CHILDREN can be elements, +objects, or a strings. + +The function takes care of setting `:parent' property for CHILD. +Return parent element." + ;; Link every child to PARENT. If PARENT is nil, it is a secondary + ;; string: parent is the list itself. + (mapc (lambda (child) + (org-element-put-property child :parent (or parent children))) + children) + ;; Add CHILDREN at the end of PARENT contents. + (when parent + (apply 'org-element-set-contents + parent + (nconc (org-element-contents parent) children))) + ;; Return modified PARENT element. + (or parent children)) + + + +;;; Greater elements +;; +;; For each greater element type, we define a parser and an +;; interpreter. +;; +;; A parser returns the element or object as the list described above. +;; Most of them accepts no argument. Though, exceptions exist. Hence +;; every element containing a secondary string (see +;; `org-element-secondary-value-alist') will accept an optional +;; argument to toggle parsing of that secondary string. Moreover, +;; `item' parser requires current list's structure as its first +;; element. +;; +;; An interpreter accepts two arguments: the list representation of +;; the element or object, and its contents. The latter may be nil, +;; depending on the element or object considered. It returns the +;; appropriate Org syntax, as a string. +;; +;; Parsing functions must follow the naming convention: +;; org-element-TYPE-parser, where TYPE is greater element's type, as +;; defined in `org-element-greater-elements'. +;; +;; Similarly, interpreting functions must follow the naming +;; convention: org-element-TYPE-interpreter. +;; +;; With the exception of `headline' and `item' types, greater elements +;; cannot contain other greater elements of their own type. +;; +;; Beside implementing a parser and an interpreter, adding a new +;; greater element requires to tweak `org-element--current-element'. +;; Moreover, the newly defined type must be added to both +;; `org-element-all-elements' and `org-element-greater-elements'. + + +;;;; Center Block + +(defun org-element-center-block-parser (limit affiliated) + "Parse a center block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `center-block' and CDR is a plist +containing `:begin', `:end', `:hiddenp', `:contents-begin', +`:contents-end', `:post-blank' and `:post-affiliated' keywords. + +Assume point is at the beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_CENTER[ \t]*$" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((block-end-line (match-beginning 0))) + (let* ((begin (car affiliated)) + (post-affiliated (point)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (save-excursion + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'center-block + (nconc + (list :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))))) + +(defun org-element-center-block-interpreter (center-block contents) + "Interpret CENTER-BLOCK element as Org syntax. +CONTENTS is the contents of the element." + (format "#+BEGIN_CENTER\n%s#+END_CENTER" contents)) + + +;;;; Drawer + +(defun org-element-drawer-parser (limit affiliated) + "Parse a drawer. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `drawer' and CDR is a plist containing +`:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin', +`:contents-end', `:post-blank' and `:post-affiliated' keywords. + +Assume point is at beginning of drawer." + (let ((case-fold-search t)) + (if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) + ;; Incomplete drawer: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (save-excursion + (let* ((drawer-end-line (match-beginning 0)) + (name (progn (looking-at org-drawer-regexp) + (org-match-string-no-properties 1))) + (begin (car affiliated)) + (post-affiliated (point)) + ;; Empty drawers have no contents. + (contents-begin (progn (forward-line) + (and (< (point) drawer-end-line) + (point)))) + (contents-end (and contents-begin drawer-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char drawer-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'drawer + (nconc + (list :begin begin + :end end + :drawer-name name + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))))) + +(defun org-element-drawer-interpreter (drawer contents) + "Interpret DRAWER element as Org syntax. +CONTENTS is the contents of the element." + (format ":%s:\n%s:END:" + (org-element-property :drawer-name drawer) + contents)) + + +;;;; Dynamic Block + +(defun org-element-dynamic-block-parser (limit affiliated) + "Parse a dynamic block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `dynamic-block' and CDR is a plist +containing `:block-name', `:begin', `:end', `:hiddenp', +`:contents-begin', `:contents-end', `:arguments', `:post-blank' +and `:post-affiliated' keywords. + +Assume point is at beginning of dynamic block." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((block-end-line (match-beginning 0))) + (save-excursion + (let* ((name (progn (looking-at org-dblock-start-re) + (org-match-string-no-properties 1))) + (arguments (org-match-string-no-properties 3)) + (begin (car affiliated)) + (post-affiliated (point)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'dynamic-block + (nconc + (list :begin begin + :end end + :block-name name + :arguments arguments + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-dynamic-block-interpreter (dynamic-block contents) + "Interpret DYNAMIC-BLOCK element as Org syntax. +CONTENTS is the contents of the element." + (format "#+BEGIN: %s%s\n%s#+END:" + (org-element-property :block-name dynamic-block) + (let ((args (org-element-property :arguments dynamic-block))) + (and args (concat " " args))) + contents)) + + +;;;; Footnote Definition + +(defun org-element-footnote-definition-parser (limit affiliated) + "Parse a footnote definition. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `footnote-definition' and CDR is +a plist containing `:label', `:begin' `:end', `:contents-begin', +`:contents-end', `:post-blank' and `:post-affiliated' keywords. + +Assume point is at the beginning of the footnote definition." + (save-excursion + (let* ((label (progn (looking-at org-footnote-definition-re) + (org-match-string-no-properties 1))) + (begin (car affiliated)) + (post-affiliated (point)) + (ending (save-excursion + (if (progn + (end-of-line) + (re-search-forward + (concat org-outline-regexp-bol "\\|" + org-footnote-definition-re "\\|" + "^\\([ \t]*\n\\)\\{2,\\}") limit 'move)) + (match-beginning 0) + (point)))) + (contents-begin (progn + (search-forward "]") + (skip-chars-forward " \r\t\n" ending) + (cond ((= (point) ending) nil) + ((= (line-beginning-position) begin) (point)) + (t (line-beginning-position))))) + (contents-end (and contents-begin ending)) + (end (progn (goto-char ending) + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'footnote-definition + (nconc + (list :label label + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines ending end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) + +(defun org-element-footnote-definition-interpreter (footnote-definition contents) + "Interpret FOOTNOTE-DEFINITION element as Org syntax. +CONTENTS is the contents of the footnote-definition." + (concat (format "[%s]" (org-element-property :label footnote-definition)) + " " + contents)) + + +;;;; Headline + +(defun org-element-headline-parser (limit &optional raw-secondary-p) + "Parse a headline. + +Return a list whose CAR is `headline' and CDR is a plist +containing `:raw-value', `:title', `:alt-title', `:begin', +`:end', `:pre-blank', `:hiddenp', `:contents-begin', +`:contents-end', `:level', `:priority', `:tags', +`:todo-keyword',`:todo-type', `:scheduled', `:deadline', +`:closed', `:quotedp', `:archivedp', `:commentedp', +`:footnote-section-p' and `:post-blank' keywords. + +The plist also contains any property set in the property drawer, +with its name in upper cases and colons added at the +beginning (e.g., `:CUSTOM_ID'). + +LIMIT is a buffer position bounding the search. + +When RAW-SECONDARY-P is non-nil, headline's title will not be +parsed as a secondary string, but as a plain string instead. + +Assume point is at beginning of the headline." + (save-excursion + (let* ((components (org-heading-components)) + (level (nth 1 components)) + (todo (nth 2 components)) + (todo-type + (and todo (if (member todo org-done-keywords) 'done 'todo))) + (tags (let ((raw-tags (nth 5 components))) + (and raw-tags (org-split-string raw-tags ":")))) + (raw-value (or (nth 4 components) "")) + (quotedp + (let ((case-fold-search nil)) + (string-match (format "^%s\\( \\|$\\)" org-quote-string) + raw-value))) + (commentedp + (let ((case-fold-search nil)) + (string-match (format "^%s\\( \\|$\\)" org-comment-string) + raw-value))) + (archivedp (member org-archive-tag tags)) + (footnote-section-p (and org-footnote-section + (string= org-footnote-section raw-value))) + ;; Upcase property names. It avoids confusion between + ;; properties obtained through property drawer and default + ;; properties from the parser (e.g. `:end' and :END:) + (standard-props + (let (plist) + (mapc + (lambda (p) + (setq plist + (plist-put plist + (intern (concat ":" (upcase (car p)))) + (cdr p)))) + (org-entry-properties nil 'standard)) + plist)) + (time-props + ;; Read time properties on the line below the headline. + (save-excursion + (when (progn (forward-line) + (looking-at org-planning-or-clock-line-re)) + (let ((end (line-end-position)) plist) + (while (re-search-forward + org-keyword-time-not-clock-regexp end t) + (goto-char (match-end 1)) + (skip-chars-forward " \t") + (let ((keyword (match-string 1)) + (time (org-element-timestamp-parser))) + (cond ((equal keyword org-scheduled-string) + (setq plist (plist-put plist :scheduled time))) + ((equal keyword org-deadline-string) + (setq plist (plist-put plist :deadline time))) + (t (setq plist (plist-put plist :closed time)))))) + plist)))) + (begin (point)) + (end (min (save-excursion (org-end-of-subtree t t)) limit)) + (pos-after-head (progn (forward-line) (point))) + (contents-begin (save-excursion + (skip-chars-forward " \r\t\n" end) + (and (/= (point) end) (line-beginning-position)))) + (hidden (org-invisible-p2)) + (contents-end (and contents-begin + (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (forward-line) + (point))))) + ;; Clean RAW-VALUE from any quote or comment string. + (when (or quotedp commentedp) + (let ((case-fold-search nil)) + (setq raw-value + (replace-regexp-in-string + (concat + (regexp-opt (list org-quote-string org-comment-string)) + "\\(?: \\|$\\)") + "" + raw-value)))) + ;; Clean TAGS from archive tag, if any. + (when archivedp (setq tags (delete org-archive-tag tags))) + (let ((headline + (list 'headline + (nconc + (list :raw-value raw-value + :begin begin + :end end + :pre-blank + (if (not contents-begin) 0 + (count-lines pos-after-head contents-begin)) + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :level level + :priority (nth 3 components) + :tags tags + :todo-keyword todo + :todo-type todo-type + :post-blank (count-lines + (or contents-end pos-after-head) + end) + :footnote-section-p footnote-section-p + :archivedp archivedp + :commentedp commentedp + :quotedp quotedp) + time-props + standard-props)))) + (let ((alt-title (org-element-property :ALT_TITLE headline))) + (when alt-title + (org-element-put-property + headline :alt-title + (if raw-secondary-p alt-title + (org-element-parse-secondary-string + alt-title (org-element-restriction 'headline) headline))))) + (org-element-put-property + headline :title + (if raw-secondary-p raw-value + (org-element-parse-secondary-string + raw-value (org-element-restriction 'headline) headline))))))) + +(defun org-element-headline-interpreter (headline contents) + "Interpret HEADLINE element as Org syntax. +CONTENTS is the contents of the element." + (let* ((level (org-element-property :level headline)) + (todo (org-element-property :todo-keyword headline)) + (priority (org-element-property :priority headline)) + (title (org-element-interpret-data + (org-element-property :title headline))) + (tags (let ((tag-list (if (org-element-property :archivedp headline) + (cons org-archive-tag + (org-element-property :tags headline)) + (org-element-property :tags headline)))) + (and tag-list + (format ":%s:" (mapconcat #'identity tag-list ":"))))) + (commentedp (org-element-property :commentedp headline)) + (quotedp (org-element-property :quotedp headline)) + (pre-blank (or (org-element-property :pre-blank headline) 0)) + (heading + (concat (make-string (if org-odd-levels-only (1- (* level 2)) level) + ?*) + (and todo (concat " " todo)) + (and quotedp (concat " " org-quote-string)) + (and commentedp (concat " " org-comment-string)) + (and priority (format " [#%s]" (char-to-string priority))) + " " + (if (and org-footnote-section + (org-element-property :footnote-section-p headline)) + org-footnote-section + title)))) + (concat + heading + ;; Align tags. + (when tags + (cond + ((zerop org-tags-column) (format " %s" tags)) + ((< org-tags-column 0) + (concat + (make-string + (max (- (+ org-tags-column (length heading) (length tags))) 1) + ?\s) + tags)) + (t + (concat + (make-string (max (- org-tags-column (length heading)) 1) ?\s) + tags)))) + (make-string (1+ pre-blank) ?\n) + contents))) + + +;;;; Inlinetask + +(defun org-element-inlinetask-parser (limit &optional raw-secondary-p) + "Parse an inline task. + +Return a list whose CAR is `inlinetask' and CDR is a plist +containing `:title', `:begin', `:end', `:hiddenp', +`:contents-begin' and `:contents-end', `:level', `:priority', +`:raw-value', `:tags', `:todo-keyword', `:todo-type', +`:scheduled', `:deadline', `:closed' and `:post-blank' keywords. + +The plist also contains any property set in the property drawer, +with its name in upper cases and colons added at the +beginning (e.g., `:CUSTOM_ID'). + +When optional argument RAW-SECONDARY-P is non-nil, inline-task's +title will not be parsed as a secondary string, but as a plain +string instead. + +Assume point is at beginning of the inline task." + (save-excursion + (let* ((begin (point)) + (components (org-heading-components)) + (todo (nth 2 components)) + (todo-type (and todo + (if (member todo org-done-keywords) 'done 'todo))) + (tags (let ((raw-tags (nth 5 components))) + (and raw-tags (org-split-string raw-tags ":")))) + (raw-value (or (nth 4 components) "")) + ;; Upcase property names. It avoids confusion between + ;; properties obtained through property drawer and default + ;; properties from the parser (e.g. `:end' and :END:) + (standard-props + (let (plist) + (mapc + (lambda (p) + (setq plist + (plist-put plist + (intern (concat ":" (upcase (car p)))) + (cdr p)))) + (org-entry-properties nil 'standard)) + plist)) + (time-props + ;; Read time properties on the line below the inlinetask + ;; opening string. + (save-excursion + (when (progn (forward-line) + (looking-at org-planning-or-clock-line-re)) + (let ((end (line-end-position)) plist) + (while (re-search-forward + org-keyword-time-not-clock-regexp end t) + (goto-char (match-end 1)) + (skip-chars-forward " \t") + (let ((keyword (match-string 1)) + (time (org-element-timestamp-parser))) + (cond ((equal keyword org-scheduled-string) + (setq plist (plist-put plist :scheduled time))) + ((equal keyword org-deadline-string) + (setq plist (plist-put plist :deadline time))) + (t (setq plist (plist-put plist :closed time)))))) + plist)))) + (task-end (save-excursion + (end-of-line) + (and (re-search-forward org-outline-regexp-bol limit t) + (org-looking-at-p "END[ \t]*$") + (line-beginning-position)))) + (contents-begin (progn (forward-line) + (and task-end (< (point) task-end) (point)))) + (hidden (and contents-begin (org-invisible-p2))) + (contents-end (and contents-begin task-end)) + (before-blank (if (not task-end) (point) + (goto-char task-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position)))) + (inlinetask + (list 'inlinetask + (nconc + (list :raw-value raw-value + :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :level (nth 1 components) + :priority (nth 3 components) + :tags tags + :todo-keyword todo + :todo-type todo-type + :post-blank (count-lines before-blank end)) + time-props + standard-props)))) + (org-element-put-property + inlinetask :title + (if raw-secondary-p raw-value + (org-element-parse-secondary-string + raw-value + (org-element-restriction 'inlinetask) + inlinetask)))))) + +(defun org-element-inlinetask-interpreter (inlinetask contents) + "Interpret INLINETASK element as Org syntax. +CONTENTS is the contents of inlinetask." + (let* ((level (org-element-property :level inlinetask)) + (todo (org-element-property :todo-keyword inlinetask)) + (priority (org-element-property :priority inlinetask)) + (title (org-element-interpret-data + (org-element-property :title inlinetask))) + (tags (let ((tag-list (org-element-property :tags inlinetask))) + (and tag-list + (format ":%s:" (mapconcat 'identity tag-list ":"))))) + (task (concat (make-string level ?*) + (and todo (concat " " todo)) + (and priority + (format " [#%s]" (char-to-string priority))) + (and title (concat " " title))))) + (concat task + ;; Align tags. + (when tags + (cond + ((zerop org-tags-column) (format " %s" tags)) + ((< org-tags-column 0) + (concat + (make-string + (max (- (+ org-tags-column (length task) (length tags))) 1) + ? ) + tags)) + (t + (concat + (make-string (max (- org-tags-column (length task)) 1) ? ) + tags)))) + ;; Prefer degenerate inlinetasks when there are no + ;; contents. + (when contents + (concat "\n" + contents + (make-string level ?*) " END"))))) + + +;;;; Item + +(defun org-element-item-parser (limit struct &optional raw-secondary-p) + "Parse an item. + +STRUCT is the structure of the plain list. + +Return a list whose CAR is `item' and CDR is a plist containing +`:bullet', `:begin', `:end', `:contents-begin', `:contents-end', +`:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and +`:post-blank' keywords. + +When optional argument RAW-SECONDARY-P is non-nil, item's tag, if +any, will not be parsed as a secondary string, but as a plain +string instead. + +Assume point is at the beginning of the item." + (save-excursion + (beginning-of-line) + (looking-at org-list-full-item-re) + (let* ((begin (point)) + (bullet (org-match-string-no-properties 1)) + (checkbox (let ((box (org-match-string-no-properties 3))) + (cond ((equal "[ ]" box) 'off) + ((equal "[X]" box) 'on) + ((equal "[-]" box) 'trans)))) + (counter (let ((c (org-match-string-no-properties 2))) + (save-match-data + (cond + ((not c) nil) + ((string-match "[A-Za-z]" c) + (- (string-to-char (upcase (match-string 0 c))) + 64)) + ((string-match "[0-9]+" c) + (string-to-number (match-string 0 c))))))) + (end (save-excursion (goto-char (org-list-get-item-end begin struct)) + (unless (bolp) (forward-line)) + (point))) + (contents-begin + (progn (goto-char + ;; Ignore tags in un-ordered lists: they are just + ;; a part of item's body. + (if (and (match-beginning 4) + (save-match-data (string-match "[.)]" bullet))) + (match-beginning 4) + (match-end 0))) + (skip-chars-forward " \r\t\n" limit) + ;; If first line isn't empty, contents really start + ;; at the text after item's meta-data. + (if (= (point-at-bol) begin) (point) (point-at-bol)))) + (hidden (progn (forward-line) + (and (not (= (point) end)) (org-invisible-p2)))) + (contents-end (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (forward-line) + (point))) + (item + (list 'item + (list :bullet bullet + :begin begin + :end end + ;; CONTENTS-BEGIN and CONTENTS-END may be + ;; mixed up in the case of an empty item + ;; separated from the next by a blank line. + ;; Thus ensure the former is always the + ;; smallest. + :contents-begin (min contents-begin contents-end) + :contents-end (max contents-begin contents-end) + :checkbox checkbox + :counter counter + :hiddenp hidden + :structure struct + :post-blank (count-lines contents-end end))))) + (org-element-put-property + item :tag + (let ((raw-tag (org-list-get-tag begin struct))) + (and raw-tag + (if raw-secondary-p raw-tag + (org-element-parse-secondary-string + raw-tag (org-element-restriction 'item) item)))))))) + +(defun org-element-item-interpreter (item contents) + "Interpret ITEM element as Org syntax. +CONTENTS is the contents of the element." + (let* ((bullet (let ((bullet (org-element-property :bullet item))) + (org-list-bullet-string + (cond ((not (string-match "[0-9a-zA-Z]" bullet)) "- ") + ((eq org-plain-list-ordered-item-terminator ?\)) "1)") + (t "1."))))) + (checkbox (org-element-property :checkbox item)) + (counter (org-element-property :counter item)) + (tag (let ((tag (org-element-property :tag item))) + (and tag (org-element-interpret-data tag)))) + ;; Compute indentation. + (ind (make-string (length bullet) 32)) + (item-starts-with-par-p + (eq (org-element-type (car (org-element-contents item))) + 'paragraph))) + ;; Indent contents. + (concat + bullet + (and counter (format "[@%d] " counter)) + (case checkbox + (on "[X] ") + (off "[ ] ") + (trans "[-] ")) + (and tag (format "%s :: " tag)) + (when contents + (let ((contents (replace-regexp-in-string + "\\(^\\)[ \t]*\\S-" ind contents nil nil 1))) + (if item-starts-with-par-p (org-trim contents) + (concat "\n" contents))))))) + + +;;;; Plain List + +(defun org-element--list-struct (limit) + ;; Return structure of list at point. Internal function. See + ;; `org-list-struct' for details. + (let ((case-fold-search t) + (top-ind limit) + (item-re (org-item-re)) + (drawers-re (concat ":\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$")) + (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ ")) + items struct) + (save-excursion + (catch 'exit + (while t + (cond + ;; At limit: end all items. + ((>= (point) limit) + (throw 'exit + (let ((end (progn (skip-chars-backward " \r\t\n") + (forward-line) + (point)))) + (dolist (item items (sort (nconc items struct) + 'car-less-than-car)) + (setcar (nthcdr 6 item) end))))) + ;; At list end: end all items. + ((looking-at org-list-end-re) + (throw 'exit (dolist (item items (sort (nconc items struct) + 'car-less-than-car)) + (setcar (nthcdr 6 item) (point))))) + ;; At a new item: end previous sibling. + ((looking-at item-re) + (let ((ind (save-excursion (skip-chars-forward " \t") + (current-column)))) + (setq top-ind (min top-ind ind)) + (while (and items (<= ind (nth 1 (car items)))) + (let ((item (pop items))) + (setcar (nthcdr 6 item) (point)) + (push item struct))) + (push (progn (looking-at org-list-full-item-re) + (let ((bullet (match-string-no-properties 1))) + (list (point) + ind + bullet + (match-string-no-properties 2) ; counter + (match-string-no-properties 3) ; checkbox + ;; Description tag. + (and (save-match-data + (string-match "[-+*]" bullet)) + (match-string-no-properties 4)) + ;; Ending position, unknown so far. + nil))) + items)) + (forward-line 1)) + ;; Skip empty lines. + ((looking-at "^[ \t]*$") (forward-line)) + ;; Skip inline tasks and blank lines along the way. + ((and inlinetask-re (looking-at inlinetask-re)) + (forward-line) + (let ((origin (point))) + (when (re-search-forward inlinetask-re limit t) + (if (org-looking-at-p "END[ \t]*$") (forward-line) + (goto-char origin))))) + ;; At some text line. Check if it ends any previous item. + (t + (let ((ind (progn (skip-chars-forward " \t") (current-column)))) + (when (<= ind top-ind) + (skip-chars-backward " \r\t\n") + (forward-line)) + (while (<= ind (nth 1 (car items))) + (let ((item (pop items))) + (setcar (nthcdr 6 item) (line-beginning-position)) + (push item struct) + (unless items + (throw 'exit (sort struct 'car-less-than-car)))))) + ;; Skip blocks (any type) and drawers contents. + (cond + ((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)") + (re-search-forward + (format "^[ \t]*#\\+END%s[ \t]*$" + (org-match-string-no-properties 1)) + limit t))) + ((and (looking-at drawers-re) + (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))) + (forward-line)))))))) + +(defun org-element-plain-list-parser (limit affiliated structure) + "Parse a plain list. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. STRUCTURE is the structure of the plain list being +parsed. + +Return a list whose CAR is `plain-list' and CDR is a plist +containing `:type', `:begin', `:end', `:contents-begin' and +`:contents-end', `:structure', `:post-blank' and +`:post-affiliated' keywords. + +Assume point is at the beginning of the list." + (save-excursion + (let* ((struct (or structure (org-element--list-struct limit))) + (prevs (org-list-prevs-alist struct)) + (type (org-list-get-list-type (point) struct prevs)) + (contents-begin (point)) + (begin (car affiliated)) + (contents-end + (progn (goto-char (org-list-get-list-end (point) struct prevs)) + (unless (bolp) (forward-line)) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (= (point) limit) limit (line-beginning-position))))) + ;; Return value. + (list 'plain-list + (nconc + (list :type type + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :structure struct + :post-blank (count-lines contents-end end) + :post-affiliated contents-begin) + (cdr affiliated)))))) + +(defun org-element-plain-list-interpreter (plain-list contents) + "Interpret PLAIN-LIST element as Org syntax. +CONTENTS is the contents of the element." + (with-temp-buffer + (insert contents) + (goto-char (point-min)) + (org-list-repair) + (buffer-string))) + + +;;;; Property Drawer + +(defun org-element-property-drawer-parser (limit affiliated) + "Parse a property drawer. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `property-drawer' and CDR is a plist +containing `:begin', `:end', `:hiddenp', `:contents-begin', +`:contents-end', `:post-blank' and `:post-affiliated' keywords. + +Assume point is at the beginning of the property drawer." + (let ((case-fold-search t)) + (if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) + ;; Incomplete drawer: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (save-excursion + (let* ((drawer-end-line (match-beginning 0)) + (begin (car affiliated)) + (post-affiliated (point)) + (contents-begin + (progn + (forward-line) + (and (re-search-forward org-property-re drawer-end-line t) + (line-beginning-position)))) + (contents-end (and contents-begin drawer-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char drawer-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'property-drawer + (nconc + (list :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))))) + +(defun org-element-property-drawer-interpreter (property-drawer contents) + "Interpret PROPERTY-DRAWER element as Org syntax. +CONTENTS is the properties within the drawer." + (format ":PROPERTIES:\n%s:END:" contents)) + + +;;;; Quote Block + +(defun org-element-quote-block-parser (limit affiliated) + "Parse a quote block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `quote-block' and CDR is a plist +containing `:begin', `:end', `:hiddenp', `:contents-begin', +`:contents-end', `:post-blank' and `:post-affiliated' keywords. + +Assume point is at the beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*$" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((block-end-line (match-beginning 0))) + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'quote-block + (nconc + (list :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-quote-block-interpreter (quote-block contents) + "Interpret QUOTE-BLOCK element as Org syntax. +CONTENTS is the contents of the element." + (format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents)) + + +;;;; Section + +(defun org-element-section-parser (limit) + "Parse a section. + +LIMIT bounds the search. + +Return a list whose CAR is `section' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `contents-end' +and `:post-blank' keywords." + (save-excursion + ;; Beginning of section is the beginning of the first non-blank + ;; line after previous headline. + (let ((begin (point)) + (end (progn (org-with-limited-levels (outline-next-heading)) + (point))) + (pos-before-blank (progn (skip-chars-backward " \r\t\n") + (forward-line) + (point)))) + (list 'section + (list :begin begin + :end end + :contents-begin begin + :contents-end pos-before-blank + :post-blank (count-lines pos-before-blank end)))))) + +(defun org-element-section-interpreter (section contents) + "Interpret SECTION element as Org syntax. +CONTENTS is the contents of the element." + contents) + + +;;;; Special Block + +(defun org-element-special-block-parser (limit affiliated) + "Parse a special block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `special-block' and CDR is a plist +containing `:type', `:begin', `:end', `:hiddenp', +`:contents-begin', `:contents-end', `:post-blank' and +`:post-affiliated' keywords. + +Assume point is at the beginning of the block." + (let* ((case-fold-search t) + (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") + (upcase (match-string-no-properties 1))))) + (if (not (save-excursion + (re-search-forward + (format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type)) + limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((block-end-line (match-beginning 0))) + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'special-block + (nconc + (list :type type + :begin begin + :end end + :hiddenp hidden + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-special-block-interpreter (special-block contents) + "Interpret SPECIAL-BLOCK element as Org syntax. +CONTENTS is the contents of the element." + (let ((block-type (org-element-property :type special-block))) + (format "#+BEGIN_%s\n%s#+END_%s" block-type contents block-type))) + + + +;;; Elements +;; +;; For each element, a parser and an interpreter are also defined. +;; Both follow the same naming convention used for greater elements. +;; +;; Also, as for greater elements, adding a new element type is done +;; through the following steps: implement a parser and an interpreter, +;; tweak `org-element--current-element' so that it recognizes the new +;; type and add that new type to `org-element-all-elements'. +;; +;; As a special case, when the newly defined type is a block type, +;; `org-element-block-name-alist' has to be modified accordingly. + + +;;;; Babel Call + +(defun org-element-babel-call-parser (limit affiliated) + "Parse a babel call. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `babel-call' and CDR is a plist +containing `:begin', `:end', `:info', `:post-blank' and +`:post-affiliated' as keywords." + (save-excursion + (let ((case-fold-search t) + (info (progn (looking-at org-babel-block-lob-one-liner-regexp) + (org-babel-lob-get-info))) + (begin (car affiliated)) + (post-affiliated (point)) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'babel-call + (nconc + (list :begin begin + :end end + :info info + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) + +(defun org-element-babel-call-interpreter (babel-call contents) + "Interpret BABEL-CALL element as Org syntax. +CONTENTS is nil." + (let* ((babel-info (org-element-property :info babel-call)) + (main (car babel-info)) + (post-options (nth 1 babel-info))) + (concat "#+CALL: " + (if (not (string-match "\\[\\(\\[.*?\\]\\)\\]" main)) main + ;; Remove redundant square brackets. + (replace-match (match-string 1 main) nil nil main)) + (and post-options (format "[%s]" post-options))))) + + +;;;; Clock + +(defun org-element-clock-parser (limit) + "Parse a clock. + +LIMIT bounds the search. + +Return a list whose CAR is `clock' and CDR is a plist containing +`:status', `:value', `:time', `:begin', `:end' and `:post-blank' +as keywords." + (save-excursion + (let* ((case-fold-search nil) + (begin (point)) + (value (progn (search-forward org-clock-string (line-end-position) t) + (skip-chars-forward " \t") + (org-element-timestamp-parser))) + (duration (and (search-forward " => " (line-end-position) t) + (progn (skip-chars-forward " \t") + (looking-at "\\(\\S-+\\)[ \t]*$")) + (org-match-string-no-properties 1))) + (status (if duration 'closed 'running)) + (post-blank (let ((before-blank (progn (forward-line) (point)))) + (skip-chars-forward " \r\t\n" limit) + (skip-chars-backward " \t") + (unless (bolp) (end-of-line)) + (count-lines before-blank (point)))) + (end (point))) + (list 'clock + (list :status status + :value value + :duration duration + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-clock-interpreter (clock contents) + "Interpret CLOCK element as Org syntax. +CONTENTS is nil." + (concat org-clock-string " " + (org-element-timestamp-interpreter + (org-element-property :value clock) nil) + (let ((duration (org-element-property :duration clock))) + (and duration + (concat " => " + (apply 'format + "%2s:%02s" + (org-split-string duration ":"))))))) + + +;;;; Comment + +(defun org-element-comment-parser (limit affiliated) + "Parse a comment. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `comment' and CDR is a plist +containing `:begin', `:end', `:value', `:post-blank', +`:post-affiliated' keywords. + +Assume point is at comment beginning." + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + (value (prog2 (looking-at "[ \t]*# ?") + (buffer-substring-no-properties + (match-end 0) (line-end-position)) + (forward-line))) + (com-end + ;; Get comments ending. + (progn + (while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)")) + ;; Accumulate lines without leading hash and first + ;; whitespace. + (setq value + (concat value + "\n" + (buffer-substring-no-properties + (match-end 0) (line-end-position)))) + (forward-line)) + (point))) + (end (progn (goto-char com-end) + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'comment + (nconc + (list :begin begin + :end end + :value value + :post-blank (count-lines com-end end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) + +(defun org-element-comment-interpreter (comment contents) + "Interpret COMMENT element as Org syntax. +CONTENTS is nil." + (replace-regexp-in-string "^" "# " (org-element-property :value comment))) + + +;;;; Comment Block + +(defun org-element-comment-block-parser (limit affiliated) + "Parse an export block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `comment-block' and CDR is a plist +containing `:begin', `:end', `:hiddenp', `:value', `:post-blank' +and `:post-affiliated' keywords. + +Assume point is at comment block beginning." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position)))) + (value (buffer-substring-no-properties + contents-begin contents-end))) + (list 'comment-block + (nconc + (list :begin begin + :end end + :value value + :hiddenp hidden + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-comment-block-interpreter (comment-block contents) + "Interpret COMMENT-BLOCK element as Org syntax. +CONTENTS is nil." + (format "#+BEGIN_COMMENT\n%s#+END_COMMENT" + (org-remove-indentation (org-element-property :value comment-block)))) + + +;;;; Diary Sexp + +(defun org-element-diary-sexp-parser (limit affiliated) + "Parse a diary sexp. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `diary-sexp' and CDR is a plist +containing `:begin', `:end', `:value', `:post-blank' and +`:post-affiliated' keywords." + (save-excursion + (let ((begin (car affiliated)) + (post-affiliated (point)) + (value (progn (looking-at "\\(%%(.*\\)[ \t]*$") + (org-match-string-no-properties 1))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'diary-sexp + (nconc + (list :value value + :begin begin + :end end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) + +(defun org-element-diary-sexp-interpreter (diary-sexp contents) + "Interpret DIARY-SEXP as Org syntax. +CONTENTS is nil." + (org-element-property :value diary-sexp)) + + +;;;; Example Block + +(defun org-element--remove-indentation (s &optional n) + "Remove maximum common indentation in string S and return it. +When optional argument N is a positive integer, remove exactly +that much characters from indentation, if possible, or return +S as-is otherwise. Unlike to `org-remove-indentation', this +function doesn't call `untabify' on S." + (catch 'exit + (with-temp-buffer + (insert s) + (goto-char (point-min)) + ;; Find maximum common indentation, if not specified. + (setq n (or n + (let ((min-ind (point-max))) + (save-excursion + (while (re-search-forward "^[ \t]*\\S-" nil t) + (let ((ind (1- (current-column)))) + (if (zerop ind) (throw 'exit s) + (setq min-ind (min min-ind ind)))))) + min-ind))) + (if (zerop n) s + ;; Remove exactly N indentation, but give up if not possible. + (while (not (eobp)) + (let ((ind (progn (skip-chars-forward " \t") (current-column)))) + (cond ((eolp) (delete-region (line-beginning-position) (point))) + ((< ind n) (throw 'exit s)) + (t (org-indent-line-to (- ind n)))) + (forward-line))) + (buffer-string))))) + +(defun org-element-example-block-parser (limit affiliated) + "Parse an example block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `example-block' and CDR is a plist +containing `:begin', `:end', `:number-lines', `:preserve-indent', +`:retain-labels', `:use-labels', `:label-fmt', `:hiddenp', +`:switches', `:value', `:post-blank' and `:post-affiliated' +keywords." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((switches + (progn + (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?") + (org-match-string-no-properties 1))) + ;; Switches analysis + (number-lines + (cond ((not switches) nil) + ((string-match "-n\\>" switches) 'new) + ((string-match "+n\\>" switches) 'continued))) + (preserve-indent + (or org-src-preserve-indentation + (and switches (string-match "-i\\>" switches)))) + ;; Should labels be retained in (or stripped from) example + ;; blocks? + (retain-labels + (or (not switches) + (not (string-match "-r\\>" switches)) + (and number-lines (string-match "-k\\>" switches)))) + ;; What should code-references use - labels or + ;; line-numbers? + (use-labels + (or (not switches) + (and retain-labels + (not (string-match "-k\\>" switches))))) + (label-fmt + (and switches + (string-match "-l +\"\\([^\"\n]+\\)\"" switches) + (match-string 1 switches))) + ;; Standard block parsing. + (begin (car affiliated)) + (post-affiliated (point)) + (block-ind (progn (skip-chars-forward " \t") (current-column))) + (contents-begin (progn (forward-line) (point))) + (hidden (org-invisible-p2)) + (value (org-element--remove-indentation + (org-unescape-code-in-string + (buffer-substring-no-properties + contents-begin contents-end)) + (and preserve-indent block-ind))) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'example-block + (nconc + (list :begin begin + :end end + :value value + :switches switches + :number-lines number-lines + :preserve-indent preserve-indent + :retain-labels retain-labels + :use-labels use-labels + :label-fmt label-fmt + :hiddenp hidden + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-example-block-interpreter (example-block contents) + "Interpret EXAMPLE-BLOCK element as Org syntax. +CONTENTS is nil." + (let ((switches (org-element-property :switches example-block))) + (concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n" + (org-escape-code-in-string + (org-element-property :value example-block)) + "#+END_EXAMPLE"))) + + +;;;; Export Block + +(defun org-element-export-block-parser (limit affiliated) + "Parse an export block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `export-block' and CDR is a plist +containing `:begin', `:end', `:type', `:hiddenp', `:value', +`:post-blank' and `:post-affiliated' keywords. + +Assume point is at export-block beginning." + (let* ((case-fold-search t) + (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") + (upcase (org-match-string-no-properties 1))))) + (if (not (save-excursion + (re-search-forward + (format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + (contents-begin (progn (forward-line) (point))) + (hidden (org-invisible-p2)) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position)))) + (value (buffer-substring-no-properties contents-begin + contents-end))) + (list 'export-block + (nconc + (list :begin begin + :end end + :type type + :value value + :hiddenp hidden + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-export-block-interpreter (export-block contents) + "Interpret EXPORT-BLOCK element as Org syntax. +CONTENTS is nil." + (let ((type (org-element-property :type export-block))) + (concat (format "#+BEGIN_%s\n" type) + (org-element-property :value export-block) + (format "#+END_%s" type)))) + + +;;;; Fixed-width + +(defun org-element-fixed-width-parser (limit affiliated) + "Parse a fixed-width section. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `fixed-width' and CDR is a plist +containing `:begin', `:end', `:value', `:post-blank' and +`:post-affiliated' keywords. + +Assume point is at the beginning of the fixed-width area." + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + value + (end-area + (progn + (while (and (< (point) limit) + (looking-at "[ \t]*:\\( \\|$\\)")) + ;; Accumulate text without starting colons. + (setq value + (concat value + (buffer-substring-no-properties + (match-end 0) (point-at-eol)) + "\n")) + (forward-line)) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'fixed-width + (nconc + (list :begin begin + :end end + :value value + :post-blank (count-lines end-area end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) + +(defun org-element-fixed-width-interpreter (fixed-width contents) + "Interpret FIXED-WIDTH element as Org syntax. +CONTENTS is nil." + (let ((value (org-element-property :value fixed-width))) + (and value + (replace-regexp-in-string + "^" ": " + (if (string-match "\n\\'" value) (substring value 0 -1) value))))) + + +;;;; Horizontal Rule + +(defun org-element-horizontal-rule-parser (limit affiliated) + "Parse an horizontal rule. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `horizontal-rule' and CDR is a plist +containing `:begin', `:end', `:post-blank' and `:post-affiliated' +keywords." + (save-excursion + (let ((begin (car affiliated)) + (post-affiliated (point)) + (post-hr (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'horizontal-rule + (nconc + (list :begin begin + :end end + :post-blank (count-lines post-hr end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) + +(defun org-element-horizontal-rule-interpreter (horizontal-rule contents) + "Interpret HORIZONTAL-RULE element as Org syntax. +CONTENTS is nil." + "-----") + + +;;;; Keyword + +(defun org-element-keyword-parser (limit affiliated) + "Parse a keyword at point. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `keyword' and CDR is a plist +containing `:key', `:value', `:begin', `:end', `:post-blank' and +`:post-affiliated' keywords." + (save-excursion + (let ((begin (car affiliated)) + (post-affiliated (point)) + (key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):") + (upcase (org-match-string-no-properties 1)))) + (value (org-trim (buffer-substring-no-properties + (match-end 0) (point-at-eol)))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'keyword + (nconc + (list :key key + :value value + :begin begin + :end end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) + +(defun org-element-keyword-interpreter (keyword contents) + "Interpret KEYWORD element as Org syntax. +CONTENTS is nil." + (format "#+%s: %s" + (org-element-property :key keyword) + (org-element-property :value keyword))) + + +;;;; Latex Environment + +(defun org-element-latex-environment-parser (limit affiliated) + "Parse a LaTeX environment. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `latex-environment' and CDR is a plist +containing `:begin', `:end', `:value', `:post-blank' and +`:post-affiliated' keywords. + +Assume point is at the beginning of the latex environment." + (save-excursion + (let ((case-fold-search t) + (code-begin (point))) + (looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}") + (if (not (re-search-forward (format "^[ \t]*\\\\end{%s}[ \t]*$" + (regexp-quote (match-string 1))) + limit t)) + ;; Incomplete latex environment: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let* ((code-end (progn (forward-line) (point))) + (begin (car affiliated)) + (value (buffer-substring-no-properties code-begin code-end)) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'latex-environment + (nconc + (list :begin begin + :end end + :value value + :post-blank (count-lines code-end end) + :post-affiliated code-begin) + (cdr affiliated)))))))) + +(defun org-element-latex-environment-interpreter (latex-environment contents) + "Interpret LATEX-ENVIRONMENT element as Org syntax. +CONTENTS is nil." + (org-element-property :value latex-environment)) + + +;;;; Node Property + +(defun org-element-node-property-parser (limit) + "Parse a node-property at point. + +LIMIT bounds the search. + +Return a list whose CAR is `node-property' and CDR is a plist +containing `:key', `:value', `:begin', `:end' and `:post-blank' +keywords." + (looking-at org-property-re) + (let ((begin (point)) + (key (org-match-string-no-properties 2)) + (value (org-match-string-no-properties 3)) + (end (save-excursion + (end-of-line) + (if (re-search-forward org-property-re limit t) + (line-beginning-position) + limit)))) + (list 'node-property + (list :key key + :value value + :begin begin + :end end + :post-blank 0)))) + +(defun org-element-node-property-interpreter (node-property contents) + "Interpret NODE-PROPERTY element as Org syntax. +CONTENTS is nil." + (format org-property-format + (format ":%s:" (org-element-property :key node-property)) + (or (org-element-property :value node-property) ""))) + + +;;;; Paragraph + +(defun org-element-paragraph-parser (limit affiliated) + "Parse a paragraph. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `paragraph' and CDR is a plist +containing `:begin', `:end', `:contents-begin' and +`:contents-end', `:post-blank' and `:post-affiliated' keywords. + +Assume point is at the beginning of the paragraph." + (save-excursion + (let* ((begin (car affiliated)) + (contents-begin (point)) + (before-blank + (let ((case-fold-search t)) + (end-of-line) + (if (not (re-search-forward + org-element-paragraph-separate limit 'm)) + limit + ;; A matching `org-element-paragraph-separate' is not + ;; necessarily the end of the paragraph. In + ;; particular, lines starting with # or : as a first + ;; non-space character are ambiguous. We have to + ;; check if they are valid Org syntax (e.g., not an + ;; incomplete keyword). + (beginning-of-line) + (while (not + (or + ;; There's no ambiguity for other symbols or + ;; empty lines: stop here. + (looking-at "[ \t]*\\(?:[^:#]\\|$\\)") + ;; Stop at valid fixed-width areas. + (looking-at "[ \t]*:\\(?: \\|$\\)") + ;; Stop at drawers. + (and (looking-at org-drawer-regexp) + (save-excursion + (re-search-forward + "^[ \t]*:END:[ \t]*$" limit t))) + ;; Stop at valid comments. + (looking-at "[ \t]*#\\(?: \\|$\\)") + ;; Stop at valid dynamic blocks. + (and (looking-at org-dblock-start-re) + (save-excursion + (re-search-forward + "^[ \t]*#\\+END:?[ \t]*$" limit t))) + ;; Stop at valid blocks. + (and (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") + (save-excursion + (re-search-forward + (format "^[ \t]*#\\+END_%s[ \t]*$" + (regexp-quote + (org-match-string-no-properties 1))) + limit t))) + ;; Stop at valid latex environments. + (and (looking-at + "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}") + (save-excursion + (re-search-forward + (format "^[ \t]*\\\\end{%s}[ \t]*$" + (regexp-quote + (org-match-string-no-properties 1))) + limit t))) + ;; Stop at valid keywords. + (looking-at "[ \t]*#\\+\\S-+:") + ;; Skip everything else. + (not + (progn + (end-of-line) + (re-search-forward org-element-paragraph-separate + limit 'm))))) + (beginning-of-line))) + (if (= (point) limit) limit + (goto-char (line-beginning-position))))) + (contents-end (progn (skip-chars-backward " \r\t\n" contents-begin) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'paragraph + (nconc + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines before-blank end) + :post-affiliated contents-begin) + (cdr affiliated)))))) + +(defun org-element-paragraph-interpreter (paragraph contents) + "Interpret PARAGRAPH element as Org syntax. +CONTENTS is the contents of the element." + contents) + + +;;;; Planning + +(defun org-element-planning-parser (limit) + "Parse a planning. + +LIMIT bounds the search. + +Return a list whose CAR is `planning' and CDR is a plist +containing `:closed', `:deadline', `:scheduled', `:begin', `:end' +and `:post-blank' keywords." + (save-excursion + (let* ((case-fold-search nil) + (begin (point)) + (post-blank (let ((before-blank (progn (forward-line) (point)))) + (skip-chars-forward " \r\t\n" limit) + (skip-chars-backward " \t") + (unless (bolp) (end-of-line)) + (count-lines before-blank (point)))) + (end (point)) + closed deadline scheduled) + (goto-char begin) + (while (re-search-forward org-keyword-time-not-clock-regexp end t) + (goto-char (match-end 1)) + (skip-chars-forward " \t" end) + (let ((keyword (match-string 1)) + (time (org-element-timestamp-parser))) + (cond ((equal keyword org-closed-string) (setq closed time)) + ((equal keyword org-deadline-string) (setq deadline time)) + (t (setq scheduled time))))) + (list 'planning + (list :closed closed + :deadline deadline + :scheduled scheduled + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-planning-interpreter (planning contents) + "Interpret PLANNING element as Org syntax. +CONTENTS is nil." + (mapconcat + 'identity + (delq nil + (list (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat org-deadline-string " " + (org-element-timestamp-interpreter deadline nil)))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat org-scheduled-string " " + (org-element-timestamp-interpreter scheduled nil)))) + (let ((closed (org-element-property :closed planning))) + (when closed + (concat org-closed-string " " + (org-element-timestamp-interpreter closed nil)))))) + " ")) + + +;;;; Quote Section + +(defun org-element-quote-section-parser (limit) + "Parse a quote section. + +LIMIT bounds the search. + +Return a list whose CAR is `quote-section' and CDR is a plist +containing `:begin', `:end', `:value' and `:post-blank' keywords. + +Assume point is at beginning of the section." + (save-excursion + (let* ((begin (point)) + (end (progn (org-with-limited-levels (outline-next-heading)) + (point))) + (pos-before-blank (progn (skip-chars-backward " \r\t\n") + (forward-line) + (point))) + (value (buffer-substring-no-properties begin pos-before-blank))) + (list 'quote-section + (list :begin begin + :end end + :value value + :post-blank (count-lines pos-before-blank end)))))) + +(defun org-element-quote-section-interpreter (quote-section contents) + "Interpret QUOTE-SECTION element as Org syntax. +CONTENTS is nil." + (org-element-property :value quote-section)) + + +;;;; Src Block + +(defun org-element-src-block-parser (limit affiliated) + "Parse a src block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `src-block' and CDR is a plist +containing `:language', `:switches', `:parameters', `:begin', +`:end', `:hiddenp', `:number-lines', `:retain-labels', +`:use-labels', `:label-fmt', `:preserve-indent', `:value', +`:post-blank' and `:post-affiliated' keywords. + +Assume point is at the beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC[ \t]*$" + limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + ;; Get language as a string. + (language + (progn + (looking-at + (concat "^[ \t]*#\\+BEGIN_SRC" + "\\(?: +\\(\\S-+\\)\\)?" + "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?" + "\\(.*\\)[ \t]*$")) + (org-match-string-no-properties 1))) + ;; Get switches. + (switches (org-match-string-no-properties 2)) + ;; Get parameters. + (parameters (org-match-string-no-properties 3)) + ;; Switches analysis + (number-lines + (cond ((not switches) nil) + ((string-match "-n\\>" switches) 'new) + ((string-match "+n\\>" switches) 'continued))) + (preserve-indent (or org-src-preserve-indentation + (and switches + (string-match "-i\\>" switches)))) + (label-fmt + (and switches + (string-match "-l +\"\\([^\"\n]+\\)\"" switches) + (match-string 1 switches))) + ;; Should labels be retained in (or stripped from) + ;; src blocks? + (retain-labels + (or (not switches) + (not (string-match "-r\\>" switches)) + (and number-lines (string-match "-k\\>" switches)))) + ;; What should code-references use - labels or + ;; line-numbers? + (use-labels + (or (not switches) + (and retain-labels + (not (string-match "-k\\>" switches))))) + ;; Indentation. + (block-ind (progn (skip-chars-forward " \t") (current-column))) + ;; Get visibility status. + (hidden (progn (forward-line) (org-invisible-p2))) + ;; Retrieve code. + (value (org-element--remove-indentation + (org-unescape-code-in-string + (buffer-substring-no-properties + (point) contents-end)) + (and preserve-indent block-ind))) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + ;; Get position after ending blank lines. + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'src-block + (nconc + (list :language language + :switches (and (org-string-nw-p switches) + (org-trim switches)) + :parameters (and (org-string-nw-p parameters) + (org-trim parameters)) + :begin begin + :end end + :number-lines number-lines + :preserve-indent preserve-indent + :retain-labels retain-labels + :use-labels use-labels + :label-fmt label-fmt + :hiddenp hidden + :value value + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-src-block-interpreter (src-block contents) + "Interpret SRC-BLOCK element as Org syntax. +CONTENTS is nil." + (let ((lang (org-element-property :language src-block)) + (switches (org-element-property :switches src-block)) + (params (org-element-property :parameters src-block)) + (value (let ((val (org-element-property :value src-block))) + (cond + ((org-element-property :preserve-indent src-block) val) + ((zerop org-edit-src-content-indentation) val) + (t + (let ((ind (make-string + org-edit-src-content-indentation 32))) + (replace-regexp-in-string + "\\(^\\)[ \t]*\\S-" ind val nil nil 1))))))) + (concat (format "#+BEGIN_SRC%s\n" + (concat (and lang (concat " " lang)) + (and switches (concat " " switches)) + (and params (concat " " params)))) + (org-escape-code-in-string value) + "#+END_SRC"))) + + +;;;; Table + +(defun org-element-table-parser (limit affiliated) + "Parse a table at point. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `table' and CDR is a plist containing +`:begin', `:end', `:tblfm', `:type', `:contents-begin', +`:contents-end', `:value', `:post-blank' and `:post-affiliated' +keywords. + +Assume point is at the beginning of the table." + (save-excursion + (let* ((case-fold-search t) + (table-begin (point)) + (type (if (org-at-table.el-p) 'table.el 'org)) + (begin (car affiliated)) + (table-end + (if (re-search-forward org-table-any-border-regexp limit 'm) + (goto-char (match-beginning 0)) + (point))) + (tblfm (let (acc) + (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$") + (push (org-match-string-no-properties 1) acc) + (forward-line)) + acc)) + (pos-before-blank (point)) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'table + (nconc + (list :begin begin + :end end + :type type + :tblfm tblfm + ;; Only `org' tables have contents. `table.el' tables + ;; use a `:value' property to store raw table as + ;; a string. + :contents-begin (and (eq type 'org) table-begin) + :contents-end (and (eq type 'org) table-end) + :value (and (eq type 'table.el) + (buffer-substring-no-properties + table-begin table-end)) + :post-blank (count-lines pos-before-blank end) + :post-affiliated table-begin) + (cdr affiliated)))))) + +(defun org-element-table-interpreter (table contents) + "Interpret TABLE element as Org syntax. +CONTENTS is a string, if table's type is `org', or nil." + (if (eq (org-element-property :type table) 'table.el) + (org-remove-indentation (org-element-property :value table)) + (concat (with-temp-buffer (insert contents) + (org-table-align) + (buffer-string)) + (mapconcat (lambda (fm) (concat "#+TBLFM: " fm)) + (reverse (org-element-property :tblfm table)) + "\n")))) + + +;;;; Table Row + +(defun org-element-table-row-parser (limit) + "Parse table row at point. + +LIMIT bounds the search. + +Return a list whose CAR is `table-row' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end', +`:type' and `:post-blank' keywords." + (save-excursion + (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard)) + (begin (point)) + ;; A table rule has no contents. In that case, ensure + ;; CONTENTS-BEGIN matches CONTENTS-END. + (contents-begin (and (eq type 'standard) + (search-forward "|") + (point))) + (contents-end (and (eq type 'standard) + (progn + (end-of-line) + (skip-chars-backward " \t") + (point)))) + (end (progn (forward-line) (point)))) + (list 'table-row + (list :type type + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank 0))))) + +(defun org-element-table-row-interpreter (table-row contents) + "Interpret TABLE-ROW element as Org syntax. +CONTENTS is the contents of the table row." + (if (eq (org-element-property :type table-row) 'rule) "|-" + (concat "| " contents))) + + +;;;; Verse Block + +(defun org-element-verse-block-parser (limit affiliated) + "Parse a verse block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `verse-block' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end', +`:hiddenp', `:post-blank' and `:post-affiliated' keywords. + +Assume point is at beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + (hidden (progn (forward-line) (org-invisible-p2))) + (contents-begin (point)) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'verse-block + (nconc + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :hiddenp hidden + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-verse-block-interpreter (verse-block contents) + "Interpret VERSE-BLOCK element as Org syntax. +CONTENTS is verse block contents." + (format "#+BEGIN_VERSE\n%s#+END_VERSE" contents)) + + + +;;; Objects +;; +;; Unlike to elements, interstices can be found between objects. +;; That's why, along with the parser, successor functions are provided +;; for each object. Some objects share the same successor (e.g., +;; `code' and `verbatim' objects). +;; +;; A successor must accept a single argument bounding the search. It +;; will return either a cons cell whose CAR is the object's type, as +;; a symbol, and CDR the position of its next occurrence, or nil. +;; +;; Successors follow the naming convention: +;; org-element-NAME-successor, where NAME is the name of the +;; successor, as defined in `org-element-all-successors'. +;; +;; Some object types (e.g., `italic') are recursive. Restrictions on +;; object types they can contain will be specified in +;; `org-element-object-restrictions'. +;; +;; Adding a new type of object is simple. Implement a successor, +;; a parser, and an interpreter for it, all following the naming +;; convention. Register type in `org-element-all-objects' and +;; successor in `org-element-all-successors'. Maybe tweak +;; restrictions about it, and that's it. + + +;;;; Bold + +(defun org-element-bold-parser () + "Parse bold object at point. + +Return a list whose CAR is `bold' and CDR is a plist with +`:begin', `:end', `:contents-begin' and `:contents-end' and +`:post-blank' keywords. + +Assume point is at the first star marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'bold + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-bold-interpreter (bold contents) + "Interpret BOLD object as Org syntax. +CONTENTS is the contents of the object." + (format "*%s*" contents)) + +(defun org-element-text-markup-successor () + "Search for the next text-markup object. + +Return value is a cons cell whose CAR is a symbol among `bold', +`italic', `underline', `strike-through', `code' and `verbatim' +and CDR is beginning position." + (save-excursion + (unless (bolp) (backward-char)) + (when (re-search-forward org-emph-re nil t) + (let ((marker (match-string 3))) + (cons (cond + ((equal marker "*") 'bold) + ((equal marker "/") 'italic) + ((equal marker "_") 'underline) + ((equal marker "+") 'strike-through) + ((equal marker "~") 'code) + ((equal marker "=") 'verbatim) + (t (error "Unknown marker at %d" (match-beginning 3)))) + (match-beginning 2)))))) + + +;;;; Code + +(defun org-element-code-parser () + "Parse code object at point. + +Return a list whose CAR is `code' and CDR is a plist with +`:value', `:begin', `:end' and `:post-blank' keywords. + +Assume point is at the first tilde marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (value (org-match-string-no-properties 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'code + (list :value value + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-code-interpreter (code contents) + "Interpret CODE object as Org syntax. +CONTENTS is nil." + (format "~%s~" (org-element-property :value code))) + + +;;;; Entity + +(defun org-element-entity-parser () + "Parse entity at point. + +Return a list whose CAR is `entity' and CDR a plist with +`:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1', +`:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as +keywords. + +Assume point is at the beginning of the entity." + (save-excursion + (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)") + (let* ((value (org-entity-get (match-string 1))) + (begin (match-beginning 0)) + (bracketsp (string= (match-string 2) "{}")) + (post-blank (progn (goto-char (match-end 1)) + (when bracketsp (forward-char 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'entity + (list :name (car value) + :latex (nth 1 value) + :latex-math-p (nth 2 value) + :html (nth 3 value) + :ascii (nth 4 value) + :latin1 (nth 5 value) + :utf-8 (nth 6 value) + :begin begin + :end end + :use-brackets-p bracketsp + :post-blank post-blank))))) + +(defun org-element-entity-interpreter (entity contents) + "Interpret ENTITY object as Org syntax. +CONTENTS is nil." + (concat "\\" + (org-element-property :name entity) + (when (org-element-property :use-brackets-p entity) "{}"))) + +(defun org-element-latex-or-entity-successor () + "Search for the next latex-fragment or entity object. + +Return value is a cons cell whose CAR is `entity' or +`latex-fragment' and CDR is beginning position." + (save-excursion + (unless (bolp) (backward-char)) + (let ((matchers (cdr org-latex-regexps)) + ;; ENTITY-RE matches both LaTeX commands and Org entities. + (entity-re + "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")) + (when (re-search-forward + (concat (mapconcat #'cadr matchers "\\|") "\\|" entity-re) nil t) + (goto-char (match-beginning 0)) + (if (looking-at entity-re) + ;; Determine if it's a real entity or a LaTeX command. + (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment) + (match-beginning 0)) + ;; No entity nor command: point is at a LaTeX fragment. + ;; Determine its type to get the correct beginning position. + (cons 'latex-fragment + (catch 'return + (dolist (e matchers) + (when (looking-at (nth 1 e)) + (throw 'return (match-beginning (nth 2 e))))) + (point)))))))) + + +;;;; Export Snippet + +(defun org-element-export-snippet-parser () + "Parse export snippet at point. + +Return a list whose CAR is `export-snippet' and CDR a plist with +`:begin', `:end', `:back-end', `:value' and `:post-blank' as +keywords. + +Assume point is at the beginning of the snippet." + (save-excursion + (re-search-forward "@@\\([-A-Za-z0-9]+\\):" nil t) + (let* ((begin (match-beginning 0)) + (back-end (org-match-string-no-properties 1)) + (value (buffer-substring-no-properties + (point) + (progn (re-search-forward "@@" nil t) (match-beginning 0)))) + (post-blank (skip-chars-forward " \t")) + (end (point))) + (list 'export-snippet + (list :back-end back-end + :value value + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-export-snippet-interpreter (export-snippet contents) + "Interpret EXPORT-SNIPPET object as Org syntax. +CONTENTS is nil." + (format "@@%s:%s@@" + (org-element-property :back-end export-snippet) + (org-element-property :value export-snippet))) + +(defun org-element-export-snippet-successor () + "Search for the next export-snippet object. + +Return value is a cons cell whose CAR is `export-snippet' and CDR +its beginning position." + (save-excursion + (let (beg) + (when (and (re-search-forward "@@[-A-Za-z0-9]+:" nil t) + (setq beg (match-beginning 0)) + (search-forward "@@" nil t)) + (cons 'export-snippet beg))))) + + +;;;; Footnote Reference + +(defun org-element-footnote-reference-parser () + "Parse footnote reference at point. + +Return a list whose CAR is `footnote-reference' and CDR a plist +with `:label', `:type', `:inline-definition', `:begin', `:end' +and `:post-blank' as keywords." + (save-excursion + (looking-at org-footnote-re) + (let* ((begin (point)) + (label (or (org-match-string-no-properties 2) + (org-match-string-no-properties 3) + (and (match-string 1) + (concat "fn:" (org-match-string-no-properties 1))))) + (type (if (or (not label) (match-string 1)) 'inline 'standard)) + (inner-begin (match-end 0)) + (inner-end + (let ((count 1)) + (forward-char) + (while (and (> count 0) (re-search-forward "[][]" nil t)) + (if (equal (match-string 0) "[") (incf count) (decf count))) + (1- (point)))) + (post-blank (progn (goto-char (1+ inner-end)) + (skip-chars-forward " \t"))) + (end (point)) + (footnote-reference + (list 'footnote-reference + (list :label label + :type type + :begin begin + :end end + :post-blank post-blank)))) + (org-element-put-property + footnote-reference :inline-definition + (and (eq type 'inline) + (org-element-parse-secondary-string + (buffer-substring inner-begin inner-end) + (org-element-restriction 'footnote-reference) + footnote-reference)))))) + +(defun org-element-footnote-reference-interpreter (footnote-reference contents) + "Interpret FOOTNOTE-REFERENCE object as Org syntax. +CONTENTS is nil." + (let ((label (or (org-element-property :label footnote-reference) "fn:")) + (def + (let ((inline-def + (org-element-property :inline-definition footnote-reference))) + (if (not inline-def) "" + (concat ":" (org-element-interpret-data inline-def)))))) + (format "[%s]" (concat label def)))) + +(defun org-element-footnote-reference-successor () + "Search for the next footnote-reference object. + +Return value is a cons cell whose CAR is `footnote-reference' and +CDR is beginning position." + (save-excursion + (catch 'exit + (while (re-search-forward org-footnote-re nil t) + (save-excursion + (let ((beg (match-beginning 0)) + (count 1)) + (backward-char) + (while (re-search-forward "[][]" nil t) + (if (equal (match-string 0) "[") (incf count) (decf count)) + (when (zerop count) + (throw 'exit (cons 'footnote-reference beg)))))))))) + + +;;;; Inline Babel Call + +(defun org-element-inline-babel-call-parser () + "Parse inline babel call at point. + +Return a list whose CAR is `inline-babel-call' and CDR a plist +with `:begin', `:end', `:info' and `:post-blank' as keywords. + +Assume point is at the beginning of the babel call." + (save-excursion + (unless (bolp) (backward-char)) + (looking-at org-babel-inline-lob-one-liner-regexp) + (let ((info (save-match-data (org-babel-lob-get-info))) + (begin (match-end 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'inline-babel-call + (list :begin begin + :end end + :info info + :post-blank post-blank))))) + +(defun org-element-inline-babel-call-interpreter (inline-babel-call contents) + "Interpret INLINE-BABEL-CALL object as Org syntax. +CONTENTS is nil." + (let* ((babel-info (org-element-property :info inline-babel-call)) + (main-source (car babel-info)) + (post-options (nth 1 babel-info))) + (concat "call_" + (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source) + ;; Remove redundant square brackets. + (replace-match + (match-string 1 main-source) nil nil main-source) + main-source) + (and post-options (format "[%s]" post-options))))) + +(defun org-element-inline-babel-call-successor () + "Search for the next inline-babel-call object. + +Return value is a cons cell whose CAR is `inline-babel-call' and +CDR is beginning position." + (save-excursion + (when (re-search-forward org-babel-inline-lob-one-liner-regexp nil t) + (cons 'inline-babel-call (match-end 1))))) + + +;;;; Inline Src Block + +(defun org-element-inline-src-block-parser () + "Parse inline source block at point. + +Return a list whose CAR is `inline-src-block' and CDR a plist +with `:begin', `:end', `:language', `:value', `:parameters' and +`:post-blank' as keywords. + +Assume point is at the beginning of the inline src block." + (save-excursion + (unless (bolp) (backward-char)) + (looking-at org-babel-inline-src-block-regexp) + (let ((begin (match-beginning 1)) + (language (org-match-string-no-properties 2)) + (parameters (org-match-string-no-properties 4)) + (value (org-match-string-no-properties 5)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'inline-src-block + (list :language language + :value value + :parameters parameters + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-inline-src-block-interpreter (inline-src-block contents) + "Interpret INLINE-SRC-BLOCK object as Org syntax. +CONTENTS is nil." + (let ((language (org-element-property :language inline-src-block)) + (arguments (org-element-property :parameters inline-src-block)) + (body (org-element-property :value inline-src-block))) + (format "src_%s%s{%s}" + language + (if arguments (format "[%s]" arguments) "") + body))) + +(defun org-element-inline-src-block-successor () + "Search for the next inline-babel-call element. + +Return value is a cons cell whose CAR is `inline-babel-call' and +CDR is beginning position." + (save-excursion + (unless (bolp) (backward-char)) + (when (re-search-forward org-babel-inline-src-block-regexp nil t) + (cons 'inline-src-block (match-beginning 1))))) + +;;;; Italic + +(defun org-element-italic-parser () + "Parse italic object at point. + +Return a list whose CAR is `italic' and CDR is a plist with +`:begin', `:end', `:contents-begin' and `:contents-end' and +`:post-blank' keywords. + +Assume point is at the first slash marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'italic + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-italic-interpreter (italic contents) + "Interpret ITALIC object as Org syntax. +CONTENTS is the contents of the object." + (format "/%s/" contents)) + + +;;;; Latex Fragment + +(defun org-element-latex-fragment-parser () + "Parse LaTeX fragment at point. + +Return a list whose CAR is `latex-fragment' and CDR a plist with +`:value', `:begin', `:end', and `:post-blank' as keywords. + +Assume point is at the beginning of the LaTeX fragment." + (save-excursion + (let* ((begin (point)) + (substring-match + (catch 'exit + (dolist (e (cdr org-latex-regexps)) + (let ((latex-regexp (nth 1 e))) + (when (or (looking-at latex-regexp) + (and (not (bobp)) + (save-excursion + (backward-char) + (looking-at latex-regexp)))) + (throw 'exit (nth 2 e))))) + ;; None found: it's a macro. + (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*") + 0)) + (value (org-match-string-no-properties substring-match)) + (post-blank (progn (goto-char (match-end substring-match)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'latex-fragment + (list :value value + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-latex-fragment-interpreter (latex-fragment contents) + "Interpret LATEX-FRAGMENT object as Org syntax. +CONTENTS is nil." + (org-element-property :value latex-fragment)) + +;;;; Line Break + +(defun org-element-line-break-parser () + "Parse line break at point. + +Return a list whose CAR is `line-break', and CDR a plist with +`:begin', `:end' and `:post-blank' keywords. + +Assume point is at the beginning of the line break." + (list 'line-break + (list :begin (point) + :end (progn (forward-line) (point)) + :post-blank 0))) + +(defun org-element-line-break-interpreter (line-break contents) + "Interpret LINE-BREAK object as Org syntax. +CONTENTS is nil." + "\\\\\n") + +(defun org-element-line-break-successor () + "Search for the next line-break object. + +Return value is a cons cell whose CAR is `line-break' and CDR is +beginning position." + (save-excursion + (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" nil t) + (goto-char (match-beginning 1))))) + ;; A line break can only happen on a non-empty line. + (when (and beg (re-search-backward "\\S-" (point-at-bol) t)) + (cons 'line-break beg))))) + + +;;;; Link + +(defun org-element-link-parser () + "Parse link at point. + +Return a list whose CAR is `link' and CDR a plist with `:type', +`:path', `:raw-link', `:application', `:search-option', `:begin', +`:end', `:contents-begin', `:contents-end' and `:post-blank' as +keywords. + +Assume point is at the beginning of the link." + (save-excursion + (let ((begin (point)) + end contents-begin contents-end link-end post-blank path type + raw-link link search-option application) + (cond + ;; Type 1: Text targeted from a radio target. + ((and org-target-link-regexp (looking-at org-target-link-regexp)) + (setq type "radio" + link-end (match-end 0) + path (org-match-string-no-properties 0) + contents-begin (match-beginning 0) + contents-end (match-end 0))) + ;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]] + ((looking-at org-bracket-link-regexp) + (setq contents-begin (match-beginning 3) + contents-end (match-end 3) + link-end (match-end 0) + ;; RAW-LINK is the original link. Expand any + ;; abbreviation in it. + raw-link (org-translate-link + (org-link-expand-abbrev + (org-match-string-no-properties 1)))) + ;; Determine TYPE of link and set PATH accordingly. + (cond + ;; File type. + ((or (file-name-absolute-p raw-link) + (string-match "\\`\\.\\.?/" raw-link)) + (setq type "file" path raw-link)) + ;; Explicit type (http, irc, bbdb...). See `org-link-types'. + ((string-match org-link-types-re raw-link) + (setq type (match-string 1 raw-link) + ;; According to RFC 3986, extra whitespace should be + ;; ignored when a URI is extracted. + path (replace-regexp-in-string + "[ \t]*\n[ \t]*" "" (substring raw-link (match-end 0))))) + ;; Id type: PATH is the id. + ((string-match "\\`id:\\([-a-f0-9]+\\)" raw-link) + (setq type "id" path (match-string 1 raw-link))) + ;; Code-ref type: PATH is the name of the reference. + ((string-match "\\`(\\(.*\\))\\'" raw-link) + (setq type "coderef" path (match-string 1 raw-link))) + ;; Custom-id type: PATH is the name of the custom id. + ((= (aref raw-link 0) ?#) + (setq type "custom-id" path (substring raw-link 1))) + ;; Fuzzy type: Internal link either matches a target, an + ;; headline name or nothing. PATH is the target or + ;; headline's name. + (t (setq type "fuzzy" path raw-link)))) + ;; Type 3: Plain link, e.g., http://orgmode.org + ((looking-at org-plain-link-re) + (setq raw-link (org-match-string-no-properties 0) + type (org-match-string-no-properties 1) + link-end (match-end 0) + path (org-match-string-no-properties 2))) + ;; Type 4: Angular link, e.g., + ((looking-at org-angle-link-re) + (setq raw-link (buffer-substring-no-properties + (match-beginning 1) (match-end 2)) + type (org-match-string-no-properties 1) + link-end (match-end 0) + path (org-match-string-no-properties 2)))) + ;; In any case, deduce end point after trailing white space from + ;; LINK-END variable. + (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t")) + end (point)) + ;; Special "file" type link processing. + (when (member type org-element-link-type-is-file) + ;; Extract opening application and search option. + (cond ((string-match "^file\\+\\(.*\\)$" type) + (setq application (match-string 1 type))) + ((not (string-match "^file" type)) + (setq application type))) + (when (string-match "::\\(.*\\)\\'" path) + (setq search-option (match-string 1 path) + path (replace-match "" nil nil path))) + ;; Normalize URI. + (when (and (not (org-string-match-p "\\`//" path)) + (file-name-absolute-p path)) + (setq path (concat "//" (expand-file-name path)))) + ;; Make sure TYPE always reports "file". + (setq type "file")) + (list 'link + (list :type type + :path path + :raw-link (or raw-link path) + :application application + :search-option search-option + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-link-interpreter (link contents) + "Interpret LINK object as Org syntax. +CONTENTS is the contents of the object, or nil." + (let ((type (org-element-property :type link)) + (raw-link (org-element-property :raw-link link))) + (if (string= type "radio") raw-link + (format "[[%s]%s]" + raw-link + (if contents (format "[%s]" contents) ""))))) + +(defun org-element-link-successor () + "Search for the next link object. + +Return value is a cons cell whose CAR is `link' and CDR is +beginning position." + (save-excursion + (let ((link-regexp + (if (not org-target-link-regexp) org-any-link-re + (concat org-any-link-re "\\|" org-target-link-regexp)))) + (when (re-search-forward link-regexp nil t) + (cons 'link (match-beginning 0)))))) + +(defun org-element-plain-link-successor () + "Search for the next plain link object. + +Return value is a cons cell whose CAR is `link' and CDR is +beginning position." + (and (save-excursion (re-search-forward org-plain-link-re nil t)) + (cons 'link (match-beginning 0)))) + + +;;;; Macro + +(defun org-element-macro-parser () + "Parse macro at point. + +Return a list whose CAR is `macro' and CDR a plist with `:key', +`:args', `:begin', `:end', `:value' and `:post-blank' as +keywords. + +Assume point is at the macro." + (save-excursion + (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}") + (let ((begin (point)) + (key (downcase (org-match-string-no-properties 1))) + (value (org-match-string-no-properties 0)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point)) + (args (let ((args (org-match-string-no-properties 3))) + (when args + ;; Do not use `org-split-string' since empty + ;; strings are meaningful here. + (split-string + (replace-regexp-in-string + "\\(\\\\*\\)\\(,\\)" + (lambda (str) + (let ((len (length (match-string 1 str)))) + (concat (make-string (/ len 2) ?\\) + (if (zerop (mod len 2)) "\000" ",")))) + args nil t) + "\000"))))) + (list 'macro + (list :key key + :value value + :args args + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-macro-interpreter (macro contents) + "Interpret MACRO object as Org syntax. +CONTENTS is nil." + (org-element-property :value macro)) + +(defun org-element-macro-successor () + "Search for the next macro object. + +Return value is cons cell whose CAR is `macro' and CDR is +beginning position." + (save-excursion + (when (re-search-forward + "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}" + nil t) + (cons 'macro (match-beginning 0))))) + + +;;;; Radio-target + +(defun org-element-radio-target-parser () + "Parse radio target at point. + +Return a list whose CAR is `radio-target' and CDR a plist with +`:begin', `:end', `:contents-begin', `:contents-end', `:value' +and `:post-blank' as keywords. + +Assume point is at the radio target." + (save-excursion + (looking-at org-radio-target-regexp) + (let ((begin (point)) + (contents-begin (match-beginning 1)) + (contents-end (match-end 1)) + (value (org-match-string-no-properties 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'radio-target + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank + :value value))))) + +(defun org-element-radio-target-interpreter (target contents) + "Interpret TARGET object as Org syntax. +CONTENTS is the contents of the object." + (concat "<<<" contents ">>>")) + +(defun org-element-radio-target-successor () + "Search for the next radio-target object. + +Return value is a cons cell whose CAR is `radio-target' and CDR +is beginning position." + (save-excursion + (when (re-search-forward org-radio-target-regexp nil t) + (cons 'radio-target (match-beginning 0))))) + + +;;;; Statistics Cookie + +(defun org-element-statistics-cookie-parser () + "Parse statistics cookie at point. + +Return a list whose CAR is `statistics-cookie', and CDR a plist +with `:begin', `:end', `:value' and `:post-blank' keywords. + +Assume point is at the beginning of the statistics-cookie." + (save-excursion + (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]") + (let* ((begin (point)) + (value (buffer-substring-no-properties + (match-beginning 0) (match-end 0))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'statistics-cookie + (list :begin begin + :end end + :value value + :post-blank post-blank))))) + +(defun org-element-statistics-cookie-interpreter (statistics-cookie contents) + "Interpret STATISTICS-COOKIE object as Org syntax. +CONTENTS is nil." + (org-element-property :value statistics-cookie)) + +(defun org-element-statistics-cookie-successor () + "Search for the next statistics cookie object. + +Return value is a cons cell whose CAR is `statistics-cookie' and +CDR is beginning position." + (save-excursion + (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" nil t) + (cons 'statistics-cookie (match-beginning 0))))) + + +;;;; Strike-Through + +(defun org-element-strike-through-parser () + "Parse strike-through object at point. + +Return a list whose CAR is `strike-through' and CDR is a plist +with `:begin', `:end', `:contents-begin' and `:contents-end' and +`:post-blank' keywords. + +Assume point is at the first plus sign marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'strike-through + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-strike-through-interpreter (strike-through contents) + "Interpret STRIKE-THROUGH object as Org syntax. +CONTENTS is the contents of the object." + (format "+%s+" contents)) + + +;;;; Subscript + +(defun org-element-subscript-parser () + "Parse subscript at point. + +Return a list whose CAR is `subscript' and CDR a plist with +`:begin', `:end', `:contents-begin', `:contents-end', +`:use-brackets-p' and `:post-blank' as keywords. + +Assume point is at the underscore." + (save-excursion + (unless (bolp) (backward-char)) + (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) + t + (not (looking-at org-match-substring-regexp)))) + (begin (match-beginning 2)) + (contents-begin (or (match-beginning 5) + (match-beginning 3))) + (contents-end (or (match-end 5) (match-end 3))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'subscript + (list :begin begin + :end end + :use-brackets-p bracketsp + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-subscript-interpreter (subscript contents) + "Interpret SUBSCRIPT object as Org syntax. +CONTENTS is the contents of the object." + (format + (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s") + contents)) + +(defun org-element-sub/superscript-successor () + "Search for the next sub/superscript object. + +Return value is a cons cell whose CAR is either `subscript' or +`superscript' and CDR is beginning position." + (save-excursion + (unless (bolp) (backward-char)) + (when (re-search-forward org-match-substring-regexp nil t) + (cons (if (string= (match-string 2) "_") 'subscript 'superscript) + (match-beginning 2))))) + + +;;;; Superscript + +(defun org-element-superscript-parser () + "Parse superscript at point. + +Return a list whose CAR is `superscript' and CDR a plist with +`:begin', `:end', `:contents-begin', `:contents-end', +`:use-brackets-p' and `:post-blank' as keywords. + +Assume point is at the caret." + (save-excursion + (unless (bolp) (backward-char)) + (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) t + (not (looking-at org-match-substring-regexp)))) + (begin (match-beginning 2)) + (contents-begin (or (match-beginning 5) + (match-beginning 3))) + (contents-end (or (match-end 5) (match-end 3))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'superscript + (list :begin begin + :end end + :use-brackets-p bracketsp + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-superscript-interpreter (superscript contents) + "Interpret SUPERSCRIPT object as Org syntax. +CONTENTS is the contents of the object." + (format + (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s") + contents)) + + +;;;; Table Cell + +(defun org-element-table-cell-parser () + "Parse table cell at point. + +Return a list whose CAR is `table-cell' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end' +and `:post-blank' keywords." + (looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)") + (let* ((begin (match-beginning 0)) + (end (match-end 0)) + (contents-begin (match-beginning 1)) + (contents-end (match-end 1))) + (list 'table-cell + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank 0)))) + +(defun org-element-table-cell-interpreter (table-cell contents) + "Interpret TABLE-CELL element as Org syntax. +CONTENTS is the contents of the cell, or nil." + (concat " " contents " |")) + +(defun org-element-table-cell-successor () + "Search for the next table-cell object. + +Return value is a cons cell whose CAR is `table-cell' and CDR is +beginning position." + (when (looking-at "[ \t]*.*?[ \t]*\\(|\\|$\\)") (cons 'table-cell (point)))) + + +;;;; Target + +(defun org-element-target-parser () + "Parse target at point. + +Return a list whose CAR is `target' and CDR a plist with +`:begin', `:end', `:value' and `:post-blank' as keywords. + +Assume point is at the target." + (save-excursion + (looking-at org-target-regexp) + (let ((begin (point)) + (value (org-match-string-no-properties 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'target + (list :begin begin + :end end + :value value + :post-blank post-blank))))) + +(defun org-element-target-interpreter (target contents) + "Interpret TARGET object as Org syntax. +CONTENTS is nil." + (format "<<%s>>" (org-element-property :value target))) + +(defun org-element-target-successor () + "Search for the next target object. + +Return value is a cons cell whose CAR is `target' and CDR is +beginning position." + (save-excursion + (when (re-search-forward org-target-regexp nil t) + (cons 'target (match-beginning 0))))) + + +;;;; Timestamp + +(defun org-element-timestamp-parser () + "Parse time stamp at point. + +Return a list whose CAR is `timestamp', and CDR a plist with +`:type', `:raw-value', `:year-start', `:month-start', +`:day-start', `:hour-start', `:minute-start', `:year-end', +`:month-end', `:day-end', `:hour-end', `:minute-end', +`:repeater-type', `:repeater-value', `:repeater-unit', +`:warning-type', `:warning-value', `:warning-unit', `:begin', +`:end' and `:post-blank' keywords. + +Assume point is at the beginning of the timestamp." + (save-excursion + (let* ((begin (point)) + (activep (eq (char-after) ?<)) + (raw-value + (progn + (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?") + (match-string-no-properties 0))) + (date-start (match-string-no-properties 1)) + (date-end (match-string 3)) + (diaryp (match-beginning 2)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point)) + (time-range + (and (not diaryp) + (string-match + "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)" + date-start) + (cons (string-to-number (match-string 2 date-start)) + (string-to-number (match-string 3 date-start))))) + (type (cond (diaryp 'diary) + ((and activep (or date-end time-range)) 'active-range) + (activep 'active) + ((or date-end time-range) 'inactive-range) + (t 'inactive))) + (repeater-props + (and (not diaryp) + (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)" + raw-value) + (list + :repeater-type + (let ((type (match-string 1 raw-value))) + (cond ((equal "++" type) 'catch-up) + ((equal ".+" type) 'restart) + (t 'cumulate))) + :repeater-value (string-to-number (match-string 2 raw-value)) + :repeater-unit + (case (string-to-char (match-string 3 raw-value)) + (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year))))) + (warning-props + (and (not diaryp) + (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value) + (list + :warning-type (if (match-string 1 raw-value) 'first 'all) + :warning-value (string-to-number (match-string 2 raw-value)) + :warning-unit + (case (string-to-char (match-string 3 raw-value)) + (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year))))) + year-start month-start day-start hour-start minute-start year-end + month-end day-end hour-end minute-end) + ;; Parse date-start. + (unless diaryp + (let ((date (org-parse-time-string date-start t))) + (setq year-start (nth 5 date) + month-start (nth 4 date) + day-start (nth 3 date) + hour-start (nth 2 date) + minute-start (nth 1 date)))) + ;; Compute date-end. It can be provided directly in time-stamp, + ;; or extracted from time range. Otherwise, it defaults to the + ;; same values as date-start. + (unless diaryp + (let ((date (and date-end (org-parse-time-string date-end t)))) + (setq year-end (or (nth 5 date) year-start) + month-end (or (nth 4 date) month-start) + day-end (or (nth 3 date) day-start) + hour-end (or (nth 2 date) (car time-range) hour-start) + minute-end (or (nth 1 date) (cdr time-range) minute-start)))) + (list 'timestamp + (nconc (list :type type + :raw-value raw-value + :year-start year-start + :month-start month-start + :day-start day-start + :hour-start hour-start + :minute-start minute-start + :year-end year-end + :month-end month-end + :day-end day-end + :hour-end hour-end + :minute-end minute-end + :begin begin + :end end + :post-blank post-blank) + repeater-props + warning-props))))) + +(defun org-element-timestamp-interpreter (timestamp contents) + "Interpret TIMESTAMP object as Org syntax. +CONTENTS is nil." + ;; Use `:raw-value' if specified. + (or (org-element-property :raw-value timestamp) + ;; Otherwise, build timestamp string. + (let* ((repeat-string + (concat + (case (org-element-property :repeater-type timestamp) + (cumulate "+") (catch-up "++") (restart ".+")) + (let ((val (org-element-property :repeater-value timestamp))) + (and val (number-to-string val))) + (case (org-element-property :repeater-unit timestamp) + (hour "h") (day "d") (week "w") (month "m") (year "y")))) + (warning-string + (concat + (case (org-element-property :warning-type timestamp) + (first "--") + (all "-")) + (let ((val (org-element-property :warning-value timestamp))) + (and val (number-to-string val))) + (case (org-element-property :warning-unit timestamp) + (hour "h") (day "d") (week "w") (month "m") (year "y")))) + (build-ts-string + ;; Build an Org timestamp string from TIME. ACTIVEP is + ;; non-nil when time stamp is active. If WITH-TIME-P is + ;; non-nil, add a time part. HOUR-END and MINUTE-END + ;; specify a time range in the timestamp. REPEAT-STRING + ;; is the repeater string, if any. + (lambda (time activep &optional with-time-p hour-end minute-end) + (let ((ts (format-time-string + (funcall (if with-time-p 'cdr 'car) + org-time-stamp-formats) + time))) + (when (and hour-end minute-end) + (string-match "[012]?[0-9]:[0-5][0-9]" ts) + (setq ts + (replace-match + (format "\\&-%02d:%02d" hour-end minute-end) + nil nil ts))) + (unless activep (setq ts (format "[%s]" (substring ts 1 -1)))) + (dolist (s (list repeat-string warning-string)) + (when (org-string-nw-p s) + (setq ts (concat (substring ts 0 -1) + " " + s + (substring ts -1))))) + ;; Return value. + ts))) + (type (org-element-property :type timestamp))) + (case type + ((active inactive) + (let* ((minute-start (org-element-property :minute-start timestamp)) + (minute-end (org-element-property :minute-end timestamp)) + (hour-start (org-element-property :hour-start timestamp)) + (hour-end (org-element-property :hour-end timestamp)) + (time-range-p (and hour-start hour-end minute-start minute-end + (or (/= hour-start hour-end) + (/= minute-start minute-end))))) + (funcall + build-ts-string + (encode-time 0 + (or minute-start 0) + (or hour-start 0) + (org-element-property :day-start timestamp) + (org-element-property :month-start timestamp) + (org-element-property :year-start timestamp)) + (eq type 'active) + (and hour-start minute-start) + (and time-range-p hour-end) + (and time-range-p minute-end)))) + ((active-range inactive-range) + (let ((minute-start (org-element-property :minute-start timestamp)) + (minute-end (org-element-property :minute-end timestamp)) + (hour-start (org-element-property :hour-start timestamp)) + (hour-end (org-element-property :hour-end timestamp))) + (concat + (funcall + build-ts-string (encode-time + 0 + (or minute-start 0) + (or hour-start 0) + (org-element-property :day-start timestamp) + (org-element-property :month-start timestamp) + (org-element-property :year-start timestamp)) + (eq type 'active-range) + (and hour-start minute-start)) + "--" + (funcall build-ts-string + (encode-time 0 + (or minute-end 0) + (or hour-end 0) + (org-element-property :day-end timestamp) + (org-element-property :month-end timestamp) + (org-element-property :year-end timestamp)) + (eq type 'active-range) + (and hour-end minute-end))))))))) + +(defun org-element-timestamp-successor () + "Search for the next timestamp object. + +Return value is a cons cell whose CAR is `timestamp' and CDR is +beginning position." + (save-excursion + (when (re-search-forward + (concat org-ts-regexp-both + "\\|" + "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" + "\\|" + "\\(?:<%%\\(?:([^>\n]+)\\)>\\)") + nil t) + (cons 'timestamp (match-beginning 0))))) + + +;;;; Underline + +(defun org-element-underline-parser () + "Parse underline object at point. + +Return a list whose CAR is `underline' and CDR is a plist with +`:begin', `:end', `:contents-begin' and `:contents-end' and +`:post-blank' keywords. + +Assume point is at the first underscore marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'underline + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-underline-interpreter (underline contents) + "Interpret UNDERLINE object as Org syntax. +CONTENTS is the contents of the object." + (format "_%s_" contents)) + + +;;;; Verbatim + +(defun org-element-verbatim-parser () + "Parse verbatim object at point. + +Return a list whose CAR is `verbatim' and CDR is a plist with +`:value', `:begin', `:end' and `:post-blank' keywords. + +Assume point is at the first equal sign marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (value (org-match-string-no-properties 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'verbatim + (list :value value + :begin begin + :end end + :post-blank post-blank))))) + +(defun org-element-verbatim-interpreter (verbatim contents) + "Interpret VERBATIM object as Org syntax. +CONTENTS is nil." + (format "=%s=" (org-element-property :value verbatim))) + + + +;;; Parsing Element Starting At Point +;; +;; `org-element--current-element' is the core function of this section. +;; It returns the Lisp representation of the element starting at +;; point. +;; +;; `org-element--current-element' makes use of special modes. They +;; are activated for fixed element chaining (e.g., `plain-list' > +;; `item') or fixed conditional element chaining (e.g., `headline' > +;; `section'). Special modes are: `first-section', `item', +;; `node-property', `quote-section', `section' and `table-row'. + +(defun org-element--current-element + (limit &optional granularity special structure) + "Parse the element starting at point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element and PROPS a plist of properties associated to the +element. + +Possible types are defined in `org-element-all-elements'. + +LIMIT bounds the search. + +Optional argument GRANULARITY determines the depth of the +recursion. Allowed values are `headline', `greater-element', +`element', `object' or nil. When it is broader than `object' (or +nil), secondary values will not be parsed, since they only +contain objects. + +Optional argument SPECIAL, when non-nil, can be either +`first-section', `item', `node-property', `quote-section', +`section', and `table-row'. + +If STRUCTURE isn't provided but SPECIAL is set to `item', it will +be computed. + +This function assumes point is always at the beginning of the +element it has to parse." + (save-excursion + (let ((case-fold-search t) + ;; Determine if parsing depth allows for secondary strings + ;; parsing. It only applies to elements referenced in + ;; `org-element-secondary-value-alist'. + (raw-secondary-p (and granularity (not (eq granularity 'object))))) + (cond + ;; Item. + ((eq special 'item) + (org-element-item-parser limit structure raw-secondary-p)) + ;; Table Row. + ((eq special 'table-row) (org-element-table-row-parser limit)) + ;; Node Property. + ((eq special 'node-property) (org-element-node-property-parser limit)) + ;; Headline. + ((org-with-limited-levels (org-at-heading-p)) + (org-element-headline-parser limit raw-secondary-p)) + ;; Sections (must be checked after headline). + ((eq special 'section) (org-element-section-parser limit)) + ((eq special 'quote-section) (org-element-quote-section-parser limit)) + ((eq special 'first-section) + (org-element-section-parser + (or (save-excursion (org-with-limited-levels (outline-next-heading))) + limit))) + ;; When not at bol, point is at the beginning of an item or + ;; a footnote definition: next item is always a paragraph. + ((not (bolp)) (org-element-paragraph-parser limit (list (point)))) + ;; Planning and Clock. + ((looking-at org-planning-or-clock-line-re) + (if (equal (match-string 1) org-clock-string) + (org-element-clock-parser limit) + (org-element-planning-parser limit))) + ;; Inlinetask. + ((org-at-heading-p) + (org-element-inlinetask-parser limit raw-secondary-p)) + ;; From there, elements can have affiliated keywords. + (t (let ((affiliated (org-element--collect-affiliated-keywords limit))) + (cond + ;; Jumping over affiliated keywords put point off-limits. + ;; Parse them as regular keywords. + ((and (cdr affiliated) (>= (point) limit)) + (goto-char (car affiliated)) + (org-element-keyword-parser limit nil)) + ;; LaTeX Environment. + ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}\\(\\[.*?\\]\\|{.*?}\\)*[ \t]*$") + (org-element-latex-environment-parser limit affiliated)) + ;; Drawer and Property Drawer. + ((looking-at org-drawer-regexp) + (if (equal (match-string 1) "PROPERTIES") + (org-element-property-drawer-parser limit affiliated) + (org-element-drawer-parser limit affiliated))) + ;; Fixed Width + ((looking-at "[ \t]*:\\( \\|$\\)") + (org-element-fixed-width-parser limit affiliated)) + ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and + ;; Keywords. + ((looking-at "[ \t]*#") + (goto-char (match-end 0)) + (cond ((looking-at "\\(?: \\|$\\)") + (beginning-of-line) + (org-element-comment-parser limit affiliated)) + ((looking-at "\\+BEGIN_\\(\\S-+\\)") + (beginning-of-line) + (let ((parser (assoc (upcase (match-string 1)) + org-element-block-name-alist))) + (if parser (funcall (cdr parser) limit affiliated) + (org-element-special-block-parser limit affiliated)))) + ((looking-at "\\+CALL:") + (beginning-of-line) + (org-element-babel-call-parser limit affiliated)) + ((looking-at "\\+BEGIN:? ") + (beginning-of-line) + (org-element-dynamic-block-parser limit affiliated)) + ((looking-at "\\+\\S-+:") + (beginning-of-line) + (org-element-keyword-parser limit affiliated)) + (t + (beginning-of-line) + (org-element-paragraph-parser limit affiliated)))) + ;; Footnote Definition. + ((looking-at org-footnote-definition-re) + (org-element-footnote-definition-parser limit affiliated)) + ;; Horizontal Rule. + ((looking-at "[ \t]*-\\{5,\\}[ \t]*$") + (org-element-horizontal-rule-parser limit affiliated)) + ;; Diary Sexp. + ((looking-at "%%(") + (org-element-diary-sexp-parser limit affiliated)) + ;; Table. + ((org-at-table-p t) (org-element-table-parser limit affiliated)) + ;; List. + ((looking-at (org-item-re)) + (org-element-plain-list-parser + limit affiliated + (or structure (org-element--list-struct limit)))) + ;; Default element: Paragraph. + (t (org-element-paragraph-parser limit affiliated))))))))) + + +;; Most elements can have affiliated keywords. When looking for an +;; element beginning, we want to move before them, as they belong to +;; that element, and, in the meantime, collect information they give +;; into appropriate properties. Hence the following function. + +(defun org-element--collect-affiliated-keywords (limit) + "Collect affiliated keywords from point down to LIMIT. + +Return a list whose CAR is the position at the first of them and +CDR a plist of keywords and values and move point to the +beginning of the first line after them. + +As a special case, if element doesn't start at the beginning of +the line (e.g., a paragraph starting an item), CAR is current +position of point and CDR is nil." + (if (not (bolp)) (list (point)) + (let ((case-fold-search t) + (origin (point)) + ;; RESTRICT is the list of objects allowed in parsed + ;; keywords value. + (restrict (org-element-restriction 'keyword)) + output) + (while (and (< (point) limit) (looking-at org-element--affiliated-re)) + (let* ((raw-kwd (upcase (match-string 1))) + ;; Apply translation to RAW-KWD. From there, KWD is + ;; the official keyword. + (kwd (or (cdr (assoc raw-kwd + org-element-keyword-translation-alist)) + raw-kwd)) + ;; Find main value for any keyword. + (value + (save-match-data + (org-trim + (buffer-substring-no-properties + (match-end 0) (point-at-eol))))) + ;; PARSEDP is non-nil when keyword should have its + ;; value parsed. + (parsedp (member kwd org-element-parsed-keywords)) + ;; If KWD is a dual keyword, find its secondary + ;; value. Maybe parse it. + (dualp (member kwd org-element-dual-keywords)) + (dual-value + (and dualp + (let ((sec (org-match-string-no-properties 2))) + (if (or (not sec) (not parsedp)) sec + (org-element-parse-secondary-string sec restrict))))) + ;; Attribute a property name to KWD. + (kwd-sym (and kwd (intern (concat ":" (downcase kwd)))))) + ;; Now set final shape for VALUE. + (when parsedp + (setq value (org-element-parse-secondary-string value restrict))) + (when dualp + (setq value (and (or value dual-value) (cons value dual-value)))) + (when (or (member kwd org-element-multiple-keywords) + ;; Attributes can always appear on multiple lines. + (string-match "^ATTR_" kwd)) + (setq value (cons value (plist-get output kwd-sym)))) + ;; Eventually store the new value in OUTPUT. + (setq output (plist-put output kwd-sym value)) + ;; Move to next keyword. + (forward-line))) + ;; If affiliated keywords are orphaned: move back to first one. + ;; They will be parsed as a paragraph. + (when (looking-at "[ \t]*$") (goto-char origin) (setq output nil)) + ;; Return value. + (cons origin output)))) + + + +;;; The Org Parser +;; +;; The two major functions here are `org-element-parse-buffer', which +;; parses Org syntax inside the current buffer, taking into account +;; region, narrowing, or even visibility if specified, and +;; `org-element-parse-secondary-string', which parses objects within +;; a given string. +;; +;; The (almost) almighty `org-element-map' allows to apply a function +;; on elements or objects matching some type, and accumulate the +;; resulting values. In an export situation, it also skips unneeded +;; parts of the parse tree. + +(defun org-element-parse-buffer (&optional granularity visible-only) + "Recursively parse the buffer and return structure. +If narrowing is in effect, only parse the visible part of the +buffer. + +Optional argument GRANULARITY determines the depth of the +recursion. It can be set to the following symbols: + +`headline' Only parse headlines. +`greater-element' Don't recurse into greater elements excepted + headlines and sections. Thus, elements + parsed are the top-level ones. +`element' Parse everything but objects and plain text. +`object' Parse the complete buffer (default). + +When VISIBLE-ONLY is non-nil, don't parse contents of hidden +elements. + +An element or an objects is represented as a list with the +pattern (TYPE PROPERTIES CONTENTS), where : + + TYPE is a symbol describing the element or object. See + `org-element-all-elements' and `org-element-all-objects' for an + exhaustive list of such symbols. One can retrieve it with + `org-element-type' function. + + PROPERTIES is the list of attributes attached to the element or + object, as a plist. Although most of them are specific to the + element or object type, all types share `:begin', `:end', + `:post-blank' and `:parent' properties, which respectively + refer to buffer position where the element or object starts, + ends, the number of white spaces or blank lines after it, and + the element or object containing it. Properties values can be + obtained by using `org-element-property' function. + + CONTENTS is a list of elements, objects or raw strings + contained in the current element or object, when applicable. + One can access them with `org-element-contents' function. + +The Org buffer has `org-data' as type and nil as properties. +`org-element-map' function can be used to find specific elements +or objects within the parse tree. + +This function assumes that current major mode is `org-mode'." + (save-excursion + (goto-char (point-min)) + (org-skip-whitespace) + (org-element--parse-elements + (point-at-bol) (point-max) + ;; Start in `first-section' mode so text before the first + ;; headline belongs to a section. + 'first-section nil granularity visible-only (list 'org-data nil)))) + +(defun org-element-parse-secondary-string (string restriction &optional parent) + "Recursively parse objects in STRING and return structure. + +RESTRICTION is a symbol limiting the object types that will be +looked after. + +Optional argument PARENT, when non-nil, is the element or object +containing the secondary string. It is used to set correctly +`:parent' property within the string." + (let ((local-variables (buffer-local-variables))) + (with-temp-buffer + (dolist (v local-variables) + (ignore-errors + (if (symbolp v) (makunbound v) + (org-set-local (car v) (cdr v))))) + (insert string) + (restore-buffer-modified-p nil) + (let ((secondary (org-element--parse-objects + (point-min) (point-max) nil restriction))) + (when parent + (dolist (o secondary) (org-element-put-property o :parent parent))) + secondary)))) + +(defun org-element-map + (data types fun &optional info first-match no-recursion with-affiliated) + "Map a function on selected elements or objects. + +DATA is a parse tree, an element, an object, a string, or a list +of such constructs. TYPES is a symbol or list of symbols of +elements or objects types (see `org-element-all-elements' and +`org-element-all-objects' for a complete list of types). FUN is +the function called on the matching element or object. It has to +accept one argument: the element or object itself. + +When optional argument INFO is non-nil, it should be a plist +holding export options. In that case, parts of the parse tree +not exportable according to that property list will be skipped. + +When optional argument FIRST-MATCH is non-nil, stop at the first +match for which FUN doesn't return nil, and return that value. + +Optional argument NO-RECURSION is a symbol or a list of symbols +representing elements or objects types. `org-element-map' won't +enter any recursive element or object whose type belongs to that +list. Though, FUN can still be applied on them. + +When optional argument WITH-AFFILIATED is non-nil, FUN will also +apply to matching objects within parsed affiliated keywords (see +`org-element-parsed-keywords'). + +Nil values returned from FUN do not appear in the results. + + +Examples: +--------- + +Assuming TREE is a variable containing an Org buffer parse tree, +the following example will return a flat list of all `src-block' +and `example-block' elements in it: + + \(org-element-map tree '(example-block src-block) 'identity) + +The following snippet will find the first headline with a level +of 1 and a \"phone\" tag, and will return its beginning position: + + \(org-element-map tree 'headline + \(lambda (hl) + \(and (= (org-element-property :level hl) 1) + \(member \"phone\" (org-element-property :tags hl)) + \(org-element-property :begin hl))) + nil t) + +The next example will return a flat list of all `plain-list' type +elements in TREE that are not a sub-list themselves: + + \(org-element-map tree 'plain-list 'identity nil nil 'plain-list) + +Eventually, this example will return a flat list of all `bold' +type objects containing a `latex-snippet' type object, even +looking into captions: + + \(org-element-map tree 'bold + \(lambda (b) + \(and (org-element-map b 'latex-snippet 'identity nil t) b)) + nil nil nil t)" + ;; Ensure TYPES and NO-RECURSION are a list, even of one element. + (unless (listp types) (setq types (list types))) + (unless (listp no-recursion) (setq no-recursion (list no-recursion))) + ;; Recursion depth is determined by --CATEGORY. + (let* ((--category + (catch 'found + (let ((category 'greater-elements)) + (mapc (lambda (type) + (cond ((or (memq type org-element-all-objects) + (eq type 'plain-text)) + ;; If one object is found, the function + ;; has to recurse into every object. + (throw 'found 'objects)) + ((not (memq type org-element-greater-elements)) + ;; If one regular element is found, the + ;; function has to recurse, at least, + ;; into every element it encounters. + (and (not (eq category 'elements)) + (setq category 'elements))))) + types) + category))) + ;; Compute properties for affiliated keywords if necessary. + (--affiliated-alist + (and with-affiliated + (mapcar (lambda (kwd) + (cons kwd (intern (concat ":" (downcase kwd))))) + org-element-affiliated-keywords))) + --acc + --walk-tree + (--walk-tree + (function + (lambda (--data) + ;; Recursively walk DATA. INFO, if non-nil, is a plist + ;; holding contextual information. + (let ((--type (org-element-type --data))) + (cond + ((not --data)) + ;; Ignored element in an export context. + ((and info (memq --data (plist-get info :ignore-list)))) + ;; List of elements or objects. + ((not --type) (mapc --walk-tree --data)) + ;; Unconditionally enter parse trees. + ((eq --type 'org-data) + (mapc --walk-tree (org-element-contents --data))) + (t + ;; Check if TYPE is matching among TYPES. If so, + ;; apply FUN to --DATA and accumulate return value + ;; into --ACC (or exit if FIRST-MATCH is non-nil). + (when (memq --type types) + (let ((result (funcall fun --data))) + (cond ((not result)) + (first-match (throw '--map-first-match result)) + (t (push result --acc))))) + ;; If --DATA has a secondary string that can contain + ;; objects with their type among TYPES, look into it. + (when (and (eq --category 'objects) (not (stringp --data))) + (let ((sec-prop + (assq --type org-element-secondary-value-alist))) + (when sec-prop + (funcall --walk-tree + (org-element-property (cdr sec-prop) --data))))) + ;; If --DATA has any affiliated keywords and + ;; WITH-AFFILIATED is non-nil, look for objects in + ;; them. + (when (and with-affiliated + (eq --category 'objects) + (memq --type org-element-all-elements)) + (mapc (lambda (kwd-pair) + (let ((kwd (car kwd-pair)) + (value (org-element-property + (cdr kwd-pair) --data))) + ;; Pay attention to the type of value. + ;; Preserve order for multiple keywords. + (cond + ((not value)) + ((and (member kwd org-element-multiple-keywords) + (member kwd org-element-dual-keywords)) + (mapc (lambda (line) + (funcall --walk-tree (cdr line)) + (funcall --walk-tree (car line))) + (reverse value))) + ((member kwd org-element-multiple-keywords) + (mapc (lambda (line) (funcall --walk-tree line)) + (reverse value))) + ((member kwd org-element-dual-keywords) + (funcall --walk-tree (cdr value)) + (funcall --walk-tree (car value))) + (t (funcall --walk-tree value))))) + --affiliated-alist)) + ;; Determine if a recursion into --DATA is possible. + (cond + ;; --TYPE is explicitly removed from recursion. + ((memq --type no-recursion)) + ;; --DATA has no contents. + ((not (org-element-contents --data))) + ;; Looking for greater elements but --DATA is simply + ;; an element or an object. + ((and (eq --category 'greater-elements) + (not (memq --type org-element-greater-elements)))) + ;; Looking for elements but --DATA is an object. + ((and (eq --category 'elements) + (memq --type org-element-all-objects))) + ;; In any other case, map contents. + (t (mapc --walk-tree (org-element-contents --data))))))))))) + (catch '--map-first-match + (funcall --walk-tree data) + ;; Return value in a proper order. + (nreverse --acc)))) +(put 'org-element-map 'lisp-indent-function 2) + +;; The following functions are internal parts of the parser. +;; +;; The first one, `org-element--parse-elements' acts at the element's +;; level. +;; +;; The second one, `org-element--parse-objects' applies on all objects +;; of a paragraph or a secondary string. It uses +;; `org-element--get-next-object-candidates' to optimize the search of +;; the next object in the buffer. +;; +;; More precisely, that function looks for every allowed object type +;; first. Then, it discards failed searches, keeps further matches, +;; and searches again types matched behind point, for subsequent +;; calls. Thus, searching for a given type fails only once, and every +;; object is searched only once at top level (but sometimes more for +;; nested types). + +(defun org-element--parse-elements + (beg end special structure granularity visible-only acc) + "Parse elements between BEG and END positions. + +SPECIAL prioritize some elements over the others. It can be set +to `first-section', `quote-section', `section' `item' or +`table-row'. + +When value is `item', STRUCTURE will be used as the current list +structure. + +GRANULARITY determines the depth of the recursion. See +`org-element-parse-buffer' for more information. + +When VISIBLE-ONLY is non-nil, don't parse contents of hidden +elements. + +Elements are accumulated into ACC." + (save-excursion + (goto-char beg) + ;; Visible only: skip invisible parts at the beginning of the + ;; element. + (when (and visible-only (org-invisible-p2)) + (goto-char (min (1+ (org-find-visible)) end))) + ;; When parsing only headlines, skip any text before first one. + (when (and (eq granularity 'headline) (not (org-at-heading-p))) + (org-with-limited-levels (outline-next-heading))) + ;; Main loop start. + (while (< (point) end) + ;; Find current element's type and parse it accordingly to + ;; its category. + (let* ((element (org-element--current-element + end granularity special structure)) + (type (org-element-type element)) + (cbeg (org-element-property :contents-begin element))) + (goto-char (org-element-property :end element)) + ;; Visible only: skip invisible parts between siblings. + (when (and visible-only (org-invisible-p2)) + (goto-char (min (1+ (org-find-visible)) end))) + ;; Fill ELEMENT contents by side-effect. + (cond + ;; If element has no contents, don't modify it. + ((not cbeg)) + ;; Greater element: parse it between `contents-begin' and + ;; `contents-end'. Make sure GRANULARITY allows the + ;; recursion, or ELEMENT is a headline, in which case going + ;; inside is mandatory, in order to get sub-level headings. + ((and (memq type org-element-greater-elements) + (or (memq granularity '(element object nil)) + (and (eq granularity 'greater-element) + (eq type 'section)) + (eq type 'headline))) + (org-element--parse-elements + cbeg (org-element-property :contents-end element) + ;; Possibly switch to a special mode. + (case type + (headline + (if (org-element-property :quotedp element) 'quote-section + 'section)) + (plain-list 'item) + (property-drawer 'node-property) + (table 'table-row)) + (and (memq type '(item plain-list)) + (org-element-property :structure element)) + granularity visible-only element)) + ;; ELEMENT has contents. Parse objects inside, if + ;; GRANULARITY allows it. + ((memq granularity '(object nil)) + (org-element--parse-objects + cbeg (org-element-property :contents-end element) element + (org-element-restriction type)))) + (org-element-adopt-elements acc element))) + ;; Return result. + acc)) + +(defun org-element--parse-objects (beg end acc restriction) + "Parse objects between BEG and END and return recursive structure. + +Objects are accumulated in ACC. + +RESTRICTION is a list of object successors which are allowed in +the current object." + (let ((candidates 'initial)) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (while (and (not (eobp)) + (setq candidates + (org-element--get-next-object-candidates + restriction candidates))) + (let ((next-object + (let ((pos (apply 'min (mapcar 'cdr candidates)))) + (save-excursion + (goto-char pos) + (funcall (intern (format "org-element-%s-parser" + (car (rassq pos candidates))))))))) + ;; 1. Text before any object. Untabify it. + (let ((obj-beg (org-element-property :begin next-object))) + (unless (= (point) obj-beg) + (setq acc + (org-element-adopt-elements + acc + (replace-regexp-in-string + "\t" (make-string tab-width ? ) + (buffer-substring-no-properties (point) obj-beg)))))) + ;; 2. Object... + (let ((obj-end (org-element-property :end next-object)) + (cont-beg (org-element-property :contents-begin next-object))) + ;; Fill contents of NEXT-OBJECT by side-effect, if it has + ;; a recursive type. + (when (and cont-beg + (memq (car next-object) org-element-recursive-objects)) + (org-element--parse-objects + cont-beg (org-element-property :contents-end next-object) + next-object (org-element-restriction next-object))) + (setq acc (org-element-adopt-elements acc next-object)) + (goto-char obj-end)))) + ;; 3. Text after last object. Untabify it. + (unless (eobp) + (setq acc + (org-element-adopt-elements + acc + (replace-regexp-in-string + "\t" (make-string tab-width ? ) + (buffer-substring-no-properties (point) end))))) + ;; Result. + acc)))) + +(defun org-element--get-next-object-candidates (restriction objects) + "Return an alist of candidates for the next object. + +RESTRICTION is a list of object types, as symbols. Only +candidates with such types are looked after. + +OBJECTS is the previous candidates alist. If it is set to +`initial', no search has been done before, and all symbols in +RESTRICTION should be looked after. + +Return value is an alist whose CAR is the object type and CDR its +beginning position." + (delq + nil + (if (eq objects 'initial) + ;; When searching for the first time, look for every successor + ;; allowed in RESTRICTION. + (mapcar + (lambda (res) + (funcall (intern (format "org-element-%s-successor" res)))) + restriction) + ;; Focus on objects returned during last search. Keep those + ;; still after point. Search again objects before it. + (mapcar + (lambda (obj) + (if (>= (cdr obj) (point)) obj + (let* ((type (car obj)) + (succ (or (cdr (assq type org-element-object-successor-alist)) + type))) + (and succ + (funcall (intern (format "org-element-%s-successor" succ))))))) + objects)))) + + + +;;; Towards A Bijective Process +;; +;; The parse tree obtained with `org-element-parse-buffer' is really +;; a snapshot of the corresponding Org buffer. Therefore, it can be +;; interpreted and expanded into a string with canonical Org syntax. +;; Hence `org-element-interpret-data'. +;; +;; The function relies internally on +;; `org-element--interpret-affiliated-keywords'. + +;;;###autoload +(defun org-element-interpret-data (data &optional parent) + "Interpret DATA as Org syntax. + +DATA is a parse tree, an element, an object or a secondary string +to interpret. + +Optional argument PARENT is used for recursive calls. It contains +the element or object containing data, or nil. + +Return Org syntax as a string." + (let* ((type (org-element-type data)) + (results + (cond + ;; Secondary string. + ((not type) + (mapconcat + (lambda (obj) (org-element-interpret-data obj parent)) + data "")) + ;; Full Org document. + ((eq type 'org-data) + (mapconcat + (lambda (obj) (org-element-interpret-data obj parent)) + (org-element-contents data) "")) + ;; Plain text: return it. + ((stringp data) data) + ;; Element/Object without contents. + ((not (org-element-contents data)) + (funcall (intern (format "org-element-%s-interpreter" type)) + data nil)) + ;; Element/Object with contents. + (t + (let* ((greaterp (memq type org-element-greater-elements)) + (objectp (and (not greaterp) + (memq type org-element-recursive-objects))) + (contents + (mapconcat + (lambda (obj) (org-element-interpret-data obj data)) + (org-element-contents + (if (or greaterp objectp) data + ;; Elements directly containing objects must + ;; have their indentation normalized first. + (org-element-normalize-contents + data + ;; When normalizing first paragraph of an + ;; item or a footnote-definition, ignore + ;; first line's indentation. + (and (eq type 'paragraph) + (equal data (car (org-element-contents parent))) + (memq (org-element-type parent) + '(footnote-definition item)))))) + ""))) + (funcall (intern (format "org-element-%s-interpreter" type)) + data + (if greaterp (org-element-normalize-contents contents) + contents))))))) + (if (memq type '(org-data plain-text nil)) results + ;; Build white spaces. If no `:post-blank' property is + ;; specified, assume its value is 0. + (let ((post-blank (or (org-element-property :post-blank data) 0))) + (if (memq type org-element-all-objects) + (concat results (make-string post-blank 32)) + (concat + (org-element--interpret-affiliated-keywords data) + (org-element-normalize-string results) + (make-string post-blank 10))))))) + +(defun org-element--interpret-affiliated-keywords (element) + "Return ELEMENT's affiliated keywords as Org syntax. +If there is no affiliated keyword, return the empty string." + (let ((keyword-to-org + (function + (lambda (key value) + (let (dual) + (when (member key org-element-dual-keywords) + (setq dual (cdr value) value (car value))) + (concat "#+" key + (and dual + (format "[%s]" (org-element-interpret-data dual))) + ": " + (if (member key org-element-parsed-keywords) + (org-element-interpret-data value) + value) + "\n")))))) + (mapconcat + (lambda (prop) + (let ((value (org-element-property prop element)) + (keyword (upcase (substring (symbol-name prop) 1)))) + (when value + (if (or (member keyword org-element-multiple-keywords) + ;; All attribute keywords can have multiple lines. + (string-match "^ATTR_" keyword)) + (mapconcat (lambda (line) (funcall keyword-to-org keyword line)) + (reverse value) + "") + (funcall keyword-to-org keyword value))))) + ;; List all ELEMENT's properties matching an attribute line or an + ;; affiliated keyword, but ignore translated keywords since they + ;; cannot belong to the property list. + (loop for prop in (nth 1 element) by 'cddr + when (let ((keyword (upcase (substring (symbol-name prop) 1)))) + (or (string-match "^ATTR_" keyword) + (and + (member keyword org-element-affiliated-keywords) + (not (assoc keyword + org-element-keyword-translation-alist))))) + collect prop) + ""))) + +;; Because interpretation of the parse tree must return the same +;; number of blank lines between elements and the same number of white +;; space after objects, some special care must be given to white +;; spaces. +;; +;; The first function, `org-element-normalize-string', ensures any +;; string different from the empty string will end with a single +;; newline character. +;; +;; The second function, `org-element-normalize-contents', removes +;; global indentation from the contents of the current element. + +(defun org-element-normalize-string (s) + "Ensure string S ends with a single newline character. + +If S isn't a string return it unchanged. If S is the empty +string, return it. Otherwise, return a new string with a single +newline character at its end." + (cond + ((not (stringp s)) s) + ((string= "" s) "") + (t (and (string-match "\\(\n[ \t]*\\)*\\'" s) + (replace-match "\n" nil nil s))))) + +(defun org-element-normalize-contents (element &optional ignore-first) + "Normalize plain text in ELEMENT's contents. + +ELEMENT must only contain plain text and objects. + +If optional argument IGNORE-FIRST is non-nil, ignore first line's +indentation to compute maximal common indentation. + +Return the normalized element that is element with global +indentation removed from its contents. The function assumes that +indentation is not done with TAB characters." + (let* ((min-ind most-positive-fixnum) + find-min-ind ; For byte-compiler. + (find-min-ind + ;; Return minimal common indentation within BLOB. This is + ;; done by walking recursively BLOB and updating MIN-IND + ;; along the way. FIRST-FLAG is non-nil when the first + ;; string hasn't been seen yet. It is required as this + ;; string is the only one whose indentation doesn't happen + ;; after a newline character. + (lambda (blob first-flag) + (dolist (object (org-element-contents blob)) + (when (and first-flag (stringp object)) + (setq first-flag nil) + (string-match "\\` *" object) + (let ((len (match-end 0))) + ;; An indentation of zero means no string will be + ;; modified. Quit the process. + (if (zerop len) (throw 'zero (setq min-ind 0)) + (setq min-ind (min len min-ind))))) + (cond + ((stringp object) + (dolist (line (cdr (org-split-string object " *\n"))) + (unless (string= line "") + (setq min-ind (min (org-get-indentation line) min-ind))))) + ((memq (org-element-type object) org-element-recursive-objects) + (funcall find-min-ind object first-flag))))))) + ;; Find minimal indentation in ELEMENT. + (catch 'zero (funcall find-min-ind element (not ignore-first))) + (if (or (zerop min-ind) (= min-ind most-positive-fixnum)) element + ;; Build ELEMENT back, replacing each string with the same + ;; string minus common indentation. + (let* (build ; For byte compiler. + (build + (function + (lambda (blob first-flag) + ;; Return BLOB with all its strings indentation + ;; shortened from MIN-IND white spaces. FIRST-FLAG + ;; is non-nil when the first string hasn't been seen + ;; yet. + (setcdr (cdr blob) + (mapcar + #'(lambda (object) + (when (and first-flag (stringp object)) + (setq first-flag nil) + (setq object + (replace-regexp-in-string + (format "\\` \\{%d\\}" min-ind) + "" object))) + (cond + ((stringp object) + (replace-regexp-in-string + (format "\n \\{%d\\}" min-ind) "\n" object)) + ((memq (org-element-type object) + org-element-recursive-objects) + (funcall build object first-flag)) + (t object))) + (org-element-contents blob))) + blob)))) + (funcall build element (not ignore-first)))))) + + + +;;; The Toolbox +;; +;; The first move is to implement a way to obtain the smallest element +;; containing point. This is the job of `org-element-at-point'. It +;; basically jumps back to the beginning of section containing point +;; and moves, element after element, with +;; `org-element--current-element' until the container is found. Note: +;; When using `org-element-at-point', secondary values are never +;; parsed since the function focuses on elements, not on objects. +;; +;; At a deeper level, `org-element-context' lists all elements and +;; objects containing point. +;; +;; `org-element-nested-p' and `org-element-swap-A-B' may be used +;; internally by navigation and manipulation tools. + +;;;###autoload +(defun org-element-at-point (&optional keep-trail) + "Determine closest element around point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element and PROPS a plist of properties associated to the +element. + +Possible types are defined in `org-element-all-elements'. +Properties depend on element or object type, but always include +`:begin', `:end', `:parent' and `:post-blank' properties. + +As a special case, if point is at the very beginning of a list or +sub-list, returned element will be that list instead of the first +item. In the same way, if point is at the beginning of the first +row of a table, returned element will be the table instead of the +first row. + +If optional argument KEEP-TRAIL is non-nil, the function returns +a list of elements leading to element at point. The list's CAR +is always the element at point. The following positions contain +element's siblings, then parents, siblings of parents, until the +first element of current section." + (org-with-wide-buffer + ;; If at a headline, parse it. It is the sole element that + ;; doesn't require to know about context. Be sure to disallow + ;; secondary string parsing, though. + (if (org-with-limited-levels (org-at-heading-p)) + (progn + (beginning-of-line) + (if (not keep-trail) (org-element-headline-parser (point-max) t) + (list (org-element-headline-parser (point-max) t)))) + ;; Otherwise move at the beginning of the section containing + ;; point. + (catch 'exit + (let ((origin (point)) + (end (save-excursion + (org-with-limited-levels (outline-next-heading)) (point))) + element type special-flag trail struct prevs parent) + (org-with-limited-levels + (if (org-before-first-heading-p) + ;; In empty lines at buffer's beginning, return nil. + (progn (goto-char (point-min)) + (org-skip-whitespace) + (when (or (eobp) (> (line-beginning-position) origin)) + (throw 'exit nil))) + (org-back-to-heading) + (forward-line) + (org-skip-whitespace) + (when (or (eobp) (> (line-beginning-position) origin)) + ;; In blank lines just after the headline, point still + ;; belongs to the headline. + (throw 'exit + (progn (skip-chars-backward " \r\t\n") + (beginning-of-line) + (if (not keep-trail) + (org-element-headline-parser (point-max) t) + (list (org-element-headline-parser + (point-max) t)))))))) + (beginning-of-line) + ;; Parse successively each element, skipping those ending + ;; before original position. + (while t + (setq element + (org-element--current-element end 'element special-flag struct) + type (car element)) + (org-element-put-property element :parent parent) + (when keep-trail (push element trail)) + (cond + ;; 1. Skip any element ending before point. Also skip + ;; element ending at point when we're sure that another + ;; element has started. + ((let ((elem-end (org-element-property :end element))) + (when (or (< elem-end origin) + (and (= elem-end origin) (/= elem-end end))) + (goto-char elem-end)))) + ;; 2. An element containing point is always the element at + ;; point. + ((not (memq type org-element-greater-elements)) + (throw 'exit (if keep-trail trail element))) + ;; 3. At any other greater element type, if point is + ;; within contents, move into it. + (t + (let ((cbeg (org-element-property :contents-begin element)) + (cend (org-element-property :contents-end element))) + (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin) + ;; Create an anchor for tables and plain lists: + ;; when point is at the very beginning of these + ;; elements, ignoring affiliated keywords, + ;; target them instead of their contents. + (and (= cbeg origin) (memq type '(plain-list table))) + ;; When point is at contents end, do not move + ;; into elements with an explicit ending, but + ;; return that element instead. + (and (= cend origin) + (or (memq type + '(center-block + drawer dynamic-block inlinetask + property-drawer quote-block + special-block)) + ;; Corner case: if a list ends at the + ;; end of a buffer without a final new + ;; line, return last element in last + ;; item instead. + (and (memq type '(item plain-list)) + (progn (goto-char cend) + (or (bolp) (not (eobp)))))))) + (throw 'exit (if keep-trail trail element)) + (setq parent element) + (case type + (plain-list + (setq special-flag 'item + struct (org-element-property :structure element))) + (item (setq special-flag nil)) + (property-drawer + (setq special-flag 'node-property struct nil)) + (table (setq special-flag 'table-row struct nil)) + (otherwise (setq special-flag nil struct nil))) + (setq end cend) + (goto-char cbeg))))))))))) + +;;;###autoload +(defun org-element-context (&optional element) + "Return closest element or object around point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element or object and PROPS a plist of properties +associated to it. + +Possible types are defined in `org-element-all-elements' and +`org-element-all-objects'. Properties depend on element or +object type, but always include `:begin', `:end', `:parent' and +`:post-blank'. + +Optional argument ELEMENT, when non-nil, is the closest element +containing point, as returned by `org-element-at-point'. +Providing it allows for quicker computation." + (catch 'objects-forbidden + (org-with-wide-buffer + (let* ((origin (point)) + (element (or element (org-element-at-point))) + (type (org-element-type element)) + context) + ;; Check if point is inside an element containing objects or at + ;; a secondary string. In that case, narrow buffer to the + ;; containing area. Otherwise, return ELEMENT. + (cond + ;; At a parsed affiliated keyword, check if we're inside main + ;; or dual value. + ((let ((post (org-element-property :post-affiliated element))) + (and post (< origin post))) + (beginning-of-line) + (let ((case-fold-search t)) (looking-at org-element--affiliated-re)) + (cond + ((not (member-ignore-case (match-string 1) + org-element-parsed-keywords)) + (throw 'objects-forbidden element)) + ((< (match-end 0) origin) + (narrow-to-region (match-end 0) (line-end-position))) + ((and (match-beginning 2) + (>= origin (match-beginning 2)) + (< origin (match-end 2))) + (narrow-to-region (match-beginning 2) (match-end 2))) + (t (throw 'objects-forbidden element))) + ;; Also change type to retrieve correct restrictions. + (setq type 'keyword)) + ;; At an item, objects can only be located within tag, if any. + ((eq type 'item) + (let ((tag (org-element-property :tag element))) + (if (not tag) (throw 'objects-forbidden element) + (beginning-of-line) + (search-forward tag (line-end-position)) + (goto-char (match-beginning 0)) + (if (and (>= origin (point)) (< origin (match-end 0))) + (narrow-to-region (point) (match-end 0)) + (throw 'objects-forbidden element))))) + ;; At an headline or inlinetask, objects are located within + ;; their title. + ((memq type '(headline inlinetask)) + (goto-char (org-element-property :begin element)) + (skip-chars-forward "*") + (if (and (> origin (point)) (< origin (line-end-position))) + (narrow-to-region (point) (line-end-position)) + (throw 'objects-forbidden element))) + ;; At a paragraph, a table-row or a verse block, objects are + ;; located within their contents. + ((memq type '(paragraph table-row verse-block)) + (let ((cbeg (org-element-property :contents-begin element)) + (cend (org-element-property :contents-end element))) + ;; CBEG is nil for table rules. + (if (and cbeg cend (>= origin cbeg) (< origin cend)) + (narrow-to-region cbeg cend) + (throw 'objects-forbidden element)))) + ;; At a parsed keyword, objects are located within value. + ((eq type 'keyword) + (if (not (member (org-element-property :key element) + org-element-document-properties)) + (throw 'objects-forbidden element) + (goto-char (org-element-property :begin element)) + (search-forward ":") + (if (and (>= origin (point)) (< origin (line-end-position))) + (narrow-to-region (point) (line-end-position)) + (throw 'objects-forbidden element)))) + ;; At a planning line, if point is at a timestamp, return it, + ;; otherwise, return element. + ((eq type 'planning) + (dolist (p '(:closed :deadline :scheduled)) + (let ((timestamp (org-element-property p element))) + (when (and timestamp + (<= (org-element-property :begin timestamp) origin) + (> (org-element-property :end timestamp) origin)) + (throw 'objects-forbidden timestamp)))) + (throw 'objects-forbidden element)) + (t (throw 'objects-forbidden element))) + (goto-char (point-min)) + (let ((restriction (org-element-restriction type)) + (parent element) + (candidates 'initial)) + (catch 'exit + (while (setq candidates + (org-element--get-next-object-candidates + restriction candidates)) + (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates)) + candidates))) + ;; If ORIGIN is before next object in element, there's + ;; no point in looking further. + (if (> (cdr closest-cand) origin) (throw 'exit parent) + (let* ((object + (progn (goto-char (cdr closest-cand)) + (funcall (intern (format "org-element-%s-parser" + (car closest-cand)))))) + (cbeg (org-element-property :contents-begin object)) + (cend (org-element-property :contents-end object)) + (obj-end (org-element-property :end object))) + (cond + ;; ORIGIN is after OBJECT, so skip it. + ((<= obj-end origin) (goto-char obj-end)) + ;; ORIGIN is within a non-recursive object or at + ;; an object boundaries: Return that object. + ((or (not cbeg) (< origin cbeg) (>= origin cend)) + (throw 'exit + (org-element-put-property object :parent parent))) + ;; Otherwise, move within current object and + ;; restrict search to the end of its contents. + (t (goto-char cbeg) + (narrow-to-region (point) cend) + (org-element-put-property object :parent parent) + (setq parent object + restriction (org-element-restriction object) + candidates 'initial))))))) + parent)))))) + +(defun org-element-nested-p (elem-A elem-B) + "Non-nil when elements ELEM-A and ELEM-B are nested." + (let ((beg-A (org-element-property :begin elem-A)) + (beg-B (org-element-property :begin elem-B)) + (end-A (org-element-property :end elem-A)) + (end-B (org-element-property :end elem-B))) + (or (and (>= beg-A beg-B) (<= end-A end-B)) + (and (>= beg-B beg-A) (<= end-B end-A))))) + +(defun org-element-swap-A-B (elem-A elem-B) + "Swap elements ELEM-A and ELEM-B. +Assume ELEM-B is after ELEM-A in the buffer. Leave point at the +end of ELEM-A." + (goto-char (org-element-property :begin elem-A)) + ;; There are two special cases when an element doesn't start at bol: + ;; the first paragraph in an item or in a footnote definition. + (let ((specialp (not (bolp)))) + ;; Only a paragraph without any affiliated keyword can be moved at + ;; ELEM-A position in such a situation. Note that the case of + ;; a footnote definition is impossible: it cannot contain two + ;; paragraphs in a row because it cannot contain a blank line. + (if (and specialp + (or (not (eq (org-element-type elem-B) 'paragraph)) + (/= (org-element-property :begin elem-B) + (org-element-property :contents-begin elem-B)))) + (error "Cannot swap elements")) + ;; In a special situation, ELEM-A will have no indentation. We'll + ;; give it ELEM-B's (which will in, in turn, have no indentation). + (let* ((ind-B (when specialp + (goto-char (org-element-property :begin elem-B)) + (org-get-indentation))) + (beg-A (org-element-property :begin elem-A)) + (end-A (save-excursion + (goto-char (org-element-property :end elem-A)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + (beg-B (org-element-property :begin elem-B)) + (end-B (save-excursion + (goto-char (org-element-property :end elem-B)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + ;; Store overlays responsible for visibility status. We + ;; also need to store their boundaries as they will be + ;; removed from buffer. + (overlays + (cons + (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov))) + (overlays-in beg-A end-A)) + (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov))) + (overlays-in beg-B end-B)))) + ;; Get contents. + (body-A (buffer-substring beg-A end-A)) + (body-B (delete-and-extract-region beg-B end-B))) + (goto-char beg-B) + (when specialp + (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B)) + (org-indent-to-column ind-B)) + (insert body-A) + ;; Restore ex ELEM-A overlays. + (let ((offset (- beg-B beg-A))) + (mapc (lambda (ov) + (move-overlay + (car ov) (+ (nth 1 ov) offset) (+ (nth 2 ov) offset))) + (car overlays)) + (goto-char beg-A) + (delete-region beg-A end-A) + (insert body-B) + ;; Restore ex ELEM-B overlays. + (mapc (lambda (ov) + (move-overlay + (car ov) (- (nth 1 ov) offset) (- (nth 2 ov) offset))) + (cdr overlays))) + (goto-char (org-element-property :end elem-B))))) + +(provide 'org-element) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-element.el ends here diff --git a/elpa/org-20150427/org-entities.el b/elpa/org-20150427/org-entities.el new file mode 100644 index 00000000..6324a625 --- /dev/null +++ b/elpa/org-20150427/org-entities.el @@ -0,0 +1,619 @@ +;;; org-entities.el --- Support for special entities in Org-mode + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik , +;; Ulf Stegemann +;; Keywords: outlines, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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 . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;;; Code: + +(declare-function org-toggle-pretty-entities "org" ()) +(declare-function org-table-align "org-table" ()) + +(eval-when-compile + (require 'cl)) + +(defgroup org-entities nil + "Options concerning entities in Org-mode." + :tag "Org Entities" + :group 'org) + +(defcustom org-entities-ascii-explanatory nil + "Non-nil means replace special entities in ASCII. +For example, this will replace \"\\nsup\" with \"[not a superset of]\" +in backends where the corresponding character is not available." + :group 'org-entities + :version "24.1" + :type 'boolean) + +(defcustom org-entities-user nil + "User-defined entities used in Org-mode to produce special characters. +Each entry in this list is a list of strings. It associates the name +of the entity that can be inserted into an Org file as \\name with the +appropriate replacements for the different export backends. The order +of the fields is the following + +name As a string, without the leading backslash +LaTeX replacement In ready LaTeX, no further processing will take place +LaTeX mathp A Boolean, either t or nil. t if this entity needs + to be in math mode. +HTML replacement In ready HTML, no further processing will take place. + Usually this will be an &...; entity. +ASCII replacement Plain ASCII, no extensions. Symbols that cannot be + represented will be left as they are, but see the. + variable `org-entities-ascii-explanatory'. +Latin1 replacement Use the special characters available in latin1. +utf-8 replacement Use the special characters available in utf-8. + +If you define new entities here that require specific LaTeX +packages to be loaded, add these packages to `org-latex-packages-alist'." + :group 'org-entities + :version "24.1" + :type '(repeat + (list + (string :tag "name ") + (string :tag "LaTeX ") + (boolean :tag "Require LaTeX math?") + (string :tag "HTML ") + (string :tag "ASCII ") + (string :tag "Latin1") + (string :tag "utf-8 ")))) + +(defconst org-entities + '( + "* Letters" + "** Latin" + ("Agrave" "\\`{A}" nil "À" "A" "À" "À") + ("agrave" "\\`{a}" nil "à" "a" "à" "à") + ("Aacute" "\\'{A}" nil "Á" "A" "Á" "Á") + ("aacute" "\\'{a}" nil "á" "a" "á" "á") + ("Acirc" "\\^{A}" nil "Â" "A" "Â" "Â") + ("acirc" "\\^{a}" nil "â" "a" "â" "â") + ("Atilde" "\\~{A}" nil "Ã" "A" "Ã" "Ã") + ("atilde" "\\~{a}" nil "ã" "a" "ã" "ã") + ("Auml" "\\\"{A}" nil "Ä" "Ae" "Ä" "Ä") + ("auml" "\\\"{a}" nil "ä" "ae" "ä" "ä") + ("Aring" "\\AA{}" nil "Å" "A" "Å" "Å") + ("AA" "\\AA{}" nil "Å" "A" "Å" "Å") + ("aring" "\\aa{}" nil "å" "a" "Ã¥" "Ã¥") + ("AElig" "\\AE{}" nil "Æ" "AE" "Æ" "Æ") + ("aelig" "\\ae{}" nil "æ" "ae" "æ" "æ") + ("Ccedil" "\\c{C}" nil "Ç" "C" "Ç" "Ç") + ("ccedil" "\\c{c}" nil "ç" "c" "ç" "ç") + ("Egrave" "\\`{E}" nil "È" "E" "È" "È") + ("egrave" "\\`{e}" nil "è" "e" "è" "è") + ("Eacute" "\\'{E}" nil "É" "E" "É" "É") + ("eacute" "\\'{e}" nil "é" "e" "é" "é") + ("Ecirc" "\\^{E}" nil "Ê" "E" "Ê" "Ê") + ("ecirc" "\\^{e}" nil "ê" "e" "ê" "ê") + ("Euml" "\\\"{E}" nil "Ë" "E" "Ë" "Ë") + ("euml" "\\\"{e}" nil "ë" "e" "ë" "ë") + ("Igrave" "\\`{I}" nil "Ì" "I" "Ì" "Ì") + ("igrave" "\\`{i}" nil "ì" "i" "ì" "ì") + ("Iacute" "\\'{I}" nil "Í" "I" "Í" "Í") + ("iacute" "\\'{i}" nil "í" "i" "í" "í") + ("Icirc" "\\^{I}" nil "Î" "I" "Î" "Î") + ("icirc" "\\^{i}" nil "î" "i" "î" "î") + ("Iuml" "\\\"{I}" nil "Ï" "I" "Ï" "Ï") + ("iuml" "\\\"{i}" nil "ï" "i" "ï" "ï") + ("Ntilde" "\\~{N}" nil "Ñ" "N" "Ñ" "Ñ") + ("ntilde" "\\~{n}" nil "ñ" "n" "ñ" "ñ") + ("Ograve" "\\`{O}" nil "Ò" "O" "Ò" "Ò") + ("ograve" "\\`{o}" nil "ò" "o" "ò" "ò") + ("Oacute" "\\'{O}" nil "Ó" "O" "Ó" "Ó") + ("oacute" "\\'{o}" nil "ó" "o" "ó" "ó") + ("Ocirc" "\\^{O}" nil "Ô" "O" "Ô" "Ô") + ("ocirc" "\\^{o}" nil "ô" "o" "ô" "ô") + ("Otilde" "\\~{O}" nil "Õ" "O" "Õ" "Õ") + ("otilde" "\\~{o}" nil "õ" "o" "õ" "õ") + ("Ouml" "\\\"{O}" nil "Ö" "Oe" "Ö" "Ö") + ("ouml" "\\\"{o}" nil "ö" "oe" "ö" "ö") + ("Oslash" "\\O" nil "Ø" "O" "Ø" "Ø") + ("oslash" "\\o{}" nil "ø" "o" "ø" "ø") + ("OElig" "\\OE{}" nil "Œ" "OE" "OE" "Œ") + ("oelig" "\\oe{}" nil "œ" "oe" "oe" "œ") + ("Scaron" "\\v{S}" nil "Š" "S" "S" "Å ") + ("scaron" "\\v{s}" nil "š" "s" "s" "Å¡") + ("szlig" "\\ss{}" nil "ß" "ss" "ß" "ß") + ("Ugrave" "\\`{U}" nil "Ù" "U" "Ù" "Ù") + ("ugrave" "\\`{u}" nil "ù" "u" "ù" "ù") + ("Uacute" "\\'{U}" nil "Ú" "U" "Ú" "Ú") + ("uacute" "\\'{u}" nil "ú" "u" "ú" "ú") + ("Ucirc" "\\^{U}" nil "Û" "U" "Û" "Û") + ("ucirc" "\\^{u}" nil "û" "u" "û" "û") + ("Uuml" "\\\"{U}" nil "Ü" "Ue" "Ü" "Ü") + ("uuml" "\\\"{u}" nil "ü" "ue" "ü" "ü") + ("Yacute" "\\'{Y}" nil "Ý" "Y" "Ý" "Ý") + ("yacute" "\\'{y}" nil "ý" "y" "ý" "ý") + ("Yuml" "\\\"{Y}" nil "Ÿ" "Y" "Y" "Ÿ") + ("yuml" "\\\"{y}" nil "ÿ" "y" "ÿ" "ÿ") + + "** Latin (special face)" + ("fnof" "\\textit{f}" nil "ƒ" "f" "f" "ƒ") + ("real" "\\Re" t "ℜ" "R" "R" "ℜ") + ("image" "\\Im" t "ℑ" "I" "I" "ℑ") + ("weierp" "\\wp" t "℘" "P" "P" "℘") + ("ell" "\\ell" t "ℓ" "ell" "ell" "ℓ") + ("imath" "\\imath" t "ı" "[dotless i]" "dotless i" "ı") + ("jmath" "\\jmath" t "ȷ" "[dotless j]" "dotless j" "È·") + + "** Greek" + ("Alpha" "A" nil "Α" "Alpha" "Alpha" "Α") + ("alpha" "\\alpha" t "α" "alpha" "alpha" "α") + ("Beta" "B" nil "Β" "Beta" "Beta" "Β") + ("beta" "\\beta" t "β" "beta" "beta" "β") + ("Gamma" "\\Gamma" t "Γ" "Gamma" "Gamma" "Γ") + ("gamma" "\\gamma" t "γ" "gamma" "gamma" "γ") + ("Delta" "\\Delta" t "Δ" "Delta" "Gamma" "Δ") + ("delta" "\\delta" t "δ" "delta" "delta" "δ") + ("Epsilon" "E" nil "Ε" "Epsilon" "Epsilon" "Ε") + ("epsilon" "\\epsilon" t "ε" "epsilon" "epsilon" "ε") + ("varepsilon" "\\varepsilon" t "ε" "varepsilon" "varepsilon" "ε") + ("Zeta" "Z" nil "Ζ" "Zeta" "Zeta" "Ζ") + ("zeta" "\\zeta" t "ζ" "zeta" "zeta" "ζ") + ("Eta" "H" nil "Η" "Eta" "Eta" "Η") + ("eta" "\\eta" t "η" "eta" "eta" "η") + ("Theta" "\\Theta" t "Θ" "Theta" "Theta" "Θ") + ("theta" "\\theta" t "θ" "theta" "theta" "θ") + ("thetasym" "\\vartheta" t "ϑ" "theta" "theta" "ϑ") + ("vartheta" "\\vartheta" t "ϑ" "theta" "theta" "ϑ") + ("Iota" "I" nil "Ι" "Iota" "Iota" "Ι") + ("iota" "\\iota" t "ι" "iota" "iota" "ι") + ("Kappa" "K" nil "Κ" "Kappa" "Kappa" "Κ") + ("kappa" "\\kappa" t "κ" "kappa" "kappa" "κ") + ("Lambda" "\\Lambda" t "Λ" "Lambda" "Lambda" "Λ") + ("lambda" "\\lambda" t "λ" "lambda" "lambda" "λ") + ("Mu" "M" nil "Μ" "Mu" "Mu" "Μ") + ("mu" "\\mu" t "μ" "mu" "mu" "μ") + ("nu" "\\nu" t "ν" "nu" "nu" "ν") + ("Nu" "N" nil "Ν" "Nu" "Nu" "Ν") + ("Xi" "\\Xi" t "Ξ" "Xi" "Xi" "Ξ") + ("xi" "\\xi" t "ξ" "xi" "xi" "ξ") + ("Omicron" "O" nil "Ο" "Omicron" "Omicron" "Ο") + ("omicron" "\\textit{o}" nil "ο" "omicron" "omicron" "ο") + ("Pi" "\\Pi" t "Π" "Pi" "Pi" "Π") + ("pi" "\\pi" t "π" "pi" "pi" "π") + ("Rho" "P" nil "Ρ" "Rho" "Rho" "Ρ") + ("rho" "\\rho" t "ρ" "rho" "rho" "ρ") + ("Sigma" "\\Sigma" t "Σ" "Sigma" "Sigma" "Σ") + ("sigma" "\\sigma" t "σ" "sigma" "sigma" "σ") + ("sigmaf" "\\varsigma" t "ς" "sigmaf" "sigmaf" "ς") + ("varsigma" "\\varsigma" t "ς" "varsigma" "varsigma" "ς") + ("Tau" "T" nil "Τ" "Tau" "Tau" "Τ") + ("Upsilon" "\\Upsilon" t "Υ" "Upsilon" "Upsilon" "Î¥") + ("upsih" "\\Upsilon" t "ϒ" "upsilon" "upsilon" "ϒ") + ("upsilon" "\\upsilon" t "υ" "upsilon" "upsilon" "υ") + ("Phi" "\\Phi" t "Φ" "Phi" "Phi" "Φ") + ("phi" "\\phi" t "φ" "phi" "phi" "φ") + ("varphi" "\\varphi" t "ϕ" "varphi" "varphi" "ɸ") + ("Chi" "X" nil "Χ" "Chi" "Chi" "Χ") + ("chi" "\\chi" t "χ" "chi" "chi" "χ") + ("acutex" "\\acute x" t "´x" "'x" "'x" "𝑥́") + ("Psi" "\\Psi" t "Ψ" "Psi" "Psi" "Ψ") + ("psi" "\\psi" t "ψ" "psi" "psi" "ψ") + ("tau" "\\tau" t "τ" "tau" "tau" "τ") + ("Omega" "\\Omega" t "Ω" "Omega" "Omega" "Ω") + ("omega" "\\omega" t "ω" "omega" "omega" "ω") + ("piv" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "ϖ") + ("varpi" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "ϖ") + ("partial" "\\partial" t "∂" "[partial differential]" "[partial differential]" "∂") + + "** Hebrew" + ("alefsym" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") + ("aleph" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") + ("gimel" "\\gimel" t "ℷ" "gimel" "gimel" "ℷ") + ("beth" "\\beth" t "ℶ" "beth" "beth" "ב") + ("dalet" "\\daleth" t "ℸ" "dalet" "dalet" "ד") + + "** Dead languages" + ("ETH" "\\DH{}" nil "Ð" "D" "Ð" "Ð") + ("eth" "\\dh{}" nil "ð" "dh" "ð" "ð") + ("THORN" "\\TH{}" nil "Þ" "TH" "Þ" "Þ") + ("thorn" "\\th{}" nil "þ" "th" "þ" "þ") + + "* Punctuation" + "** Dots and Marks" + ("dots" "\\dots{}" nil "…" "..." "..." "…") + ("cdots" "\\cdots{}" t "⋯" "..." "..." "⋯") + ("hellip" "\\dots{}" nil "…" "..." "..." "…") + ("middot" "\\textperiodcentered{}" nil "·" "." "·" "·") + ("iexcl" "!`" nil "¡" "!" "¡" "¡") + ("iquest" "?`" nil "¿" "?" "¿" "¿") + + "** Dash-like" + ("shy" "\\-" nil "­" "" "" "") + ("ndash" "--" nil "–" "-" "-" "–") + ("mdash" "---" nil "—" "--" "--" "—") + + "** Quotations" + ("quot" "\\textquotedbl{}" nil """ "\"" "\"" "\"") + ("acute" "\\textasciiacute{}" nil "´" "'" "´" "´") + ("ldquo" "\\textquotedblleft{}" nil "“" "\"" "\"" "“") + ("rdquo" "\\textquotedblright{}" nil "”" "\"" "\"" "”") + ("bdquo" "\\quotedblbase{}" nil "„" "\"" "\"" "„") + ("lsquo" "\\textquoteleft{}" nil "‘" "`" "`" "‘") + ("rsquo" "\\textquoteright{}" nil "’" "'" "'" "’") + ("sbquo" "\\quotesinglbase{}" nil "‚" "," "," "‚") + ("laquo" "\\guillemotleft{}" nil "«" "<<" "«" "«") + ("raquo" "\\guillemotright{}" nil "»" ">>" "»" "»") + ("lsaquo" "\\guilsinglleft{}" nil "‹" "<" "<" "‹") + ("rsaquo" "\\guilsinglright{}" nil "›" ">" ">" "›") + + "* Other" + "** Misc. (often used)" + ("circ" "\\^{}" nil "ˆ" "^" "^" "ˆ") + ("vert" "\\vert{}" t "|" "|" "|" "|") + ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") + ("S" "\\S" nil "§" "paragraph" "§" "§") + ("sect" "\\S" nil "§" "paragraph" "§" "§") + ("amp" "\\&" nil "&" "&" "&" "&") + ("lt" "\\textless{}" nil "<" "<" "<" "<") + ("gt" "\\textgreater{}" nil ">" ">" ">" ">") + ("tilde" "\\textasciitilde{}" nil "~" "~" "~" "~") + ("slash" "/" nil "/" "/" "/" "/") + ("plus" "+" nil "+" "+" "+" "+") + ("under" "\\_" nil "_" "_" "_" "_") + ("equal" "=" nil "=" "=" "=" "=") + ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^") + ("dagger" "\\textdagger{}" nil "†" "[dagger]" "[dagger]" "†") + ("dag" "\\dag{}" nil "†" "[dagger]" "[dagger]" "†") + ("Dagger" "\\textdaggerdbl{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") + ("ddag" "\\ddag{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") + + "** Whitespace" + ("nbsp" "~" nil " " " " " " " ") + ("ensp" "\\hspace*{.5em}" nil " " " " " " " ") + ("emsp" "\\hspace*{1em}" nil " " " " " " " ") + ("thinsp" "\\hspace*{.2em}" nil " " " " " " " ") + + "** Currency" + ("curren" "\\textcurrency{}" nil "¤" "curr." "¤" "¤") + ("cent" "\\textcent{}" nil "¢" "cent" "¢" "¢") + ("pound" "\\pounds{}" nil "£" "pound" "£" "£") + ("yen" "\\textyen{}" nil "¥" "yen" "Â¥" "Â¥") + ("euro" "\\texteuro{}" nil "€" "EUR" "EUR" "€") + ("EUR" "\\EUR{}" nil "€" "EUR" "EUR" "€") + ("EURdig" "\\EURdig{}" nil "€" "EUR" "EUR" "€") + ("EURhv" "\\EURhv{}" nil "€" "EUR" "EUR" "€") + ("EURcr" "\\EURcr{}" nil "€" "EUR" "EUR" "€") + ("EURtm" "\\EURtm{}" nil "€" "EUR" "EUR" "€") + + "** Property Marks" + ("copy" "\\textcopyright{}" nil "©" "(c)" "©" "©") + ("reg" "\\textregistered{}" nil "®" "(r)" "®" "®") + ("trade" "\\texttrademark{}" nil "™" "TM" "TM" "™") + + "** Science et al." + ("minus" "\\minus" t "−" "-" "-" "−") + ("pm" "\\textpm{}" nil "±" "+-" "±" "±") + ("plusmn" "\\textpm{}" nil "±" "+-" "±" "±") + ("times" "\\texttimes{}" nil "×" "*" "×" "×") + ("frasl" "/" nil "⁄" "/" "/" "⁄") + ("colon" "\\colon" t ":" ":" ":" ":") + ("div" "\\textdiv{}" nil "÷" "/" "÷" "÷") + ("frac12" "\\textonehalf{}" nil "½" "1/2" "½" "½") + ("frac14" "\\textonequarter{}" nil "¼" "1/4" "¼" "¼") + ("frac34" "\\textthreequarters{}" nil "¾" "3/4" "¾" "¾") + ("permil" "\\textperthousand{}" nil "‰" "per thousand" "per thousand" "‰") + ("sup1" "\\textonesuperior{}" nil "¹" "^1" "¹" "¹") + ("sup2" "\\texttwosuperior{}" nil "²" "^2" "²" "²") + ("sup3" "\\textthreesuperior{}" nil "³" "^3" "³" "³") + ("radic" "\\sqrt{\\,}" t "√" "[square root]" "[square root]" "√") + ("sum" "\\sum" t "∑" "[sum]" "[sum]" "∑") + ("prod" "\\prod" t "∏" "[product]" "[n-ary product]" "∏") + ("micro" "\\textmu{}" nil "µ" "micro" "µ" "µ") + ("macr" "\\textasciimacron{}" nil "¯" "[macron]" "¯" "¯") + ("deg" "\\textdegree{}" nil "°" "degree" "°" "°") + ("prime" "\\prime" t "′" "'" "'" "′") + ("Prime" "\\prime{}\\prime" t "″" "''" "''" "″") + ("infin" "\\propto" t "∞" "[infinity]" "[infinity]" "∞") + ("infty" "\\infty" t "∞" "[infinity]" "[infinity]" "∞") + ("prop" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") + ("propto" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") + ("not" "\\textlnot{}" nil "¬" "[angled dash]" "¬" "¬") + ("neg" "\\neg{}" t "¬" "[angled dash]" "¬" "¬") + ("land" "\\land" t "∧" "[logical and]" "[logical and]" "∧") + ("wedge" "\\wedge" t "∧" "[logical and]" "[logical and]" "∧") + ("lor" "\\lor" t "∨" "[logical or]" "[logical or]" "∨") + ("vee" "\\vee" t "∨" "[logical or]" "[logical or]" "∨") + ("cap" "\\cap" t "∩" "[intersection]" "[intersection]" "∩") + ("cup" "\\cup" t "∪" "[union]" "[union]" "∪") + ("int" "\\int" t "∫" "[integral]" "[integral]" "∫") + ("therefore" "\\therefore" t "∴" "[therefore]" "[therefore]" "∴") + ("there4" "\\therefore" t "∴" "[therefore]" "[therefore]" "∴") + ("because" "\\because" t "∵" "[because]" "[because]" "∵") + ("sim" "\\sim" t "∼" "~" "~" "∼") + ("cong" "\\cong" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") + ("simeq" "\\simeq" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") + ("asymp" "\\asymp" t "≈" "[almost equal to]" "[almost equal to]" "≈") + ("approx" "\\approx" t "≈" "[almost equal to]" "[almost equal to]" "≈") + ("ne" "\\ne" t "≠" "[not equal to]" "[not equal to]" "≠") + ("neq" "\\neq" t "≠" "[not equal to]" "[not equal to]" "≠") + ("equiv" "\\equiv" t "≡" "[identical to]" "[identical to]" "≡") + + ("triangleq" "\\triangleq" t "≜" "[defined to]" "[defined to]" "≜") + ("le" "\\le" t "≤" "<=" "<=" "≤") + ("leq" "\\le" t "≤" "<=" "<=" "≤") + ("ge" "\\ge" t "≥" ">=" ">=" "≥") + ("geq" "\\ge" t "≥" ">=" ">=" "≥") + ("lessgtr" "\\lessgtr" t "≶" "[less than or greater than]" "[less than or greater than]" "≶") + ("lesseqgtr" "\\lesseqgtr" t "⋚" "[less than or equal or greater than or equal]" "[less than or equal or greater than or equal]" "⋚") + ("ll" "\\ll" t "≪" "<<" "<<" "≪") + ("Ll" "\lll" t "⋘" "<<<" "<<<" "⋘") + ("lll" "\lll" t "⋘" "<<<" "<<<" "⋘") + ("gg" "\\gg" t "≫" ">>" ">>" "≫") + ("Gg" "\\ggg" t "⋙" ">>>" ">>>" "⋙") + ("ggg" "\\ggg" t "⋙" ">>>" ">>>" "⋙") + ("prec" "\\prec" t "≺" "[precedes]" "[precedes]" "≺") + ("preceq" "\\preceq" t "≼" "[precedes or equal]" "[precedes or equal]" "≼") + ("preccurlyeq" "\\preccurlyeq" t "≼" "[precedes or equal]" "[precedes or equal]" "≼") + ("succ" "\\succ" t "≻" "[succeeds]" "[succeeds]" "≻") + ("succeq" "\\succeq" t "≽" "[succeeds or equal]" "[succeeds or equal]" "≽") + ("succcurlyeq" "\\succcurlyeq" t "≽" "[succeeds or equal]" "[succeeds or equal]" "≽") + ("sub" "\\subset" t "⊂" "[subset of]" "[subset of]" "⊂") + ("subset" "\\subset" t "⊂" "[subset of]" "[subset of]" "⊂") + ("sup" "\\supset" t "⊃" "[superset of]" "[superset of]" "⊃") + ("supset" "\\supset" t "⊃" "[superset of]" "[superset of]" "⊃") + ("nsub" "\\not\\subset" t "⊄" "[not a subset of]" "[not a subset of" "⊄") + ("sube" "\\subseteq" t "⊆" "[subset of or equal to]" "[subset of or equal to]" "⊆") + ("nsup" "\\not\\supset" t "⊅" "[not a superset of]" "[not a superset of]" "⊅") + ("supe" "\\supseteq" t "⊇" "[superset of or equal to]" "[superset of or equal to]" "⊇") + ("setminus" "\\setminus" t "∖" "\" "\" "â§µ") + ("forall" "\\forall" t "∀" "[for all]" "[for all]" "∀") + ("exist" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") + ("exists" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") + ("nexist" "\\nexists" t "∃" "[there does not exists]" "[there does not exists]" "∄") + ("nexists" "\\nexists" t "∃" "[there does not exists]" "[there does not exists]" "∄") + ("empty" "\\empty" t "∅" "[empty set]" "[empty set]" "∅") + ("emptyset" "\\emptyset" t "∅" "[empty set]" "[empty set]" "∅") + ("isin" "\\in" t "∈" "[element of]" "[element of]" "∈") + ("in" "\\in" t "∈" "[element of]" "[element of]" "∈") + ("notin" "\\notin" t "∉" "[not an element of]" "[not an element of]" "∉") + ("ni" "\\ni" t "∋" "[contains as member]" "[contains as member]" "∋") + ("nabla" "\\nabla" t "∇" "[nabla]" "[nabla]" "∇") + ("ang" "\\angle" t "∠" "[angle]" "[angle]" "∠") + ("angle" "\\angle" t "∠" "[angle]" "[angle]" "∠") + ("perp" "\\perp" t "⊥" "[up tack]" "[up tack]" "⊥") + ("sdot" "\\cdot" t "⋅" "[dot]" "[dot]" "⋅") + ("cdot" "\\cdot" t "⋅" "[dot]" "[dot]" "⋅") + ("lceil" "\\lceil" t "⌈" "[left ceiling]" "[left ceiling]" "⌈") + ("rceil" "\\rceil" t "⌉" "[right ceiling]" "[right ceiling]" "⌉") + ("lfloor" "\\lfloor" t "⌊" "[left floor]" "[left floor]" "⌊") + ("rfloor" "\\rfloor" t "⌋" "[right floor]" "[right floor]" "⌋") + ("lang" "\\langle" t "⟨" "<" "<" "⟨") + ("rang" "\\rangle" t "⟩" ">" ">" "⟩") + ("hbar" "\\hbar" t "ℏ" "hbar" "hbar" "ℏ") + ("mho" "\\mho" t "℧" "mho" "mho" "℧") + + "** Arrows" + ("larr" "\\leftarrow" t "←" "<-" "<-" "←") + ("leftarrow" "\\leftarrow" t "←" "<-" "<-" "←") + ("gets" "\\gets" t "←" "<-" "<-" "←") + ("lArr" "\\Leftarrow" t "⇐" "<=" "<=" "⇐") + ("Leftarrow" "\\Leftarrow" t "⇐" "<=" "<=" "⇐") + ("uarr" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") + ("uparrow" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") + ("uArr" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") + ("Uparrow" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") + ("rarr" "\\rightarrow" t "→" "->" "->" "→") + ("to" "\\to" t "→" "->" "->" "→") + ("rightarrow" "\\rightarrow" t "→" "->" "->" "→") + ("rArr" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") + ("Rightarrow" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") + ("darr" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") + ("downarrow" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") + ("dArr" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") + ("Downarrow" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") + ("harr" "\\leftrightarrow" t "↔" "<->" "<->" "↔") + ("leftrightarrow" "\\leftrightarrow" t "↔" "<->" "<->" "↔") + ("hArr" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") + ("Leftrightarrow" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") + ("crarr" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") + ("hookleftarrow" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") + + "** Function names" + ("arccos" "\\arccos" t "arccos" "arccos" "arccos" "arccos") + ("arcsin" "\\arcsin" t "arcsin" "arcsin" "arcsin" "arcsin") + ("arctan" "\\arctan" t "arctan" "arctan" "arctan" "arctan") + ("arg" "\\arg" t "arg" "arg" "arg" "arg") + ("cos" "\\cos" t "cos" "cos" "cos" "cos") + ("cosh" "\\cosh" t "cosh" "cosh" "cosh" "cosh") + ("cot" "\\cot" t "cot" "cot" "cot" "cot") + ("coth" "\\coth" t "coth" "coth" "coth" "coth") + ("csc" "\\csc" t "csc" "csc" "csc" "csc") + ("deg" "\\deg" t "°" "deg" "deg" "deg") + ("det" "\\det" t "det" "det" "det" "det") + ("dim" "\\dim" t "dim" "dim" "dim" "dim") + ("exp" "\\exp" t "exp" "exp" "exp" "exp") + ("gcd" "\\gcd" t "gcd" "gcd" "gcd" "gcd") + ("hom" "\\hom" t "hom" "hom" "hom" "hom") + ("inf" "\\inf" t "inf" "inf" "inf" "inf") + ("ker" "\\ker" t "ker" "ker" "ker" "ker") + ("lg" "\\lg" t "lg" "lg" "lg" "lg") + ("lim" "\\lim" t "lim" "lim" "lim" "lim") + ("liminf" "\\liminf" t "liminf" "liminf" "liminf" "liminf") + ("limsup" "\\limsup" t "limsup" "limsup" "limsup" "limsup") + ("ln" "\\ln" t "ln" "ln" "ln" "ln") + ("log" "\\log" t "log" "log" "log" "log") + ("max" "\\max" t "max" "max" "max" "max") + ("min" "\\min" t "min" "min" "min" "min") + ("Pr" "\\Pr" t "Pr" "Pr" "Pr" "Pr") + ("sec" "\\sec" t "sec" "sec" "sec" "sec") + ("sin" "\\sin" t "sin" "sin" "sin" "sin") + ("sinh" "\\sinh" t "sinh" "sinh" "sinh" "sinh") + ("sup" "\\sup" t "⊃" "sup" "sup" "sup") + ("tan" "\\tan" t "tan" "tan" "tan" "tan") + ("tanh" "\\tanh" t "tanh" "tanh" "tanh" "tanh") + + "** Signs & Symbols" + ("bull" "\\textbullet{}" nil "•" "*" "*" "•") + ("bullet" "\\textbullet{}" nil "•" "*" "*" "•") + ("star" "\\star" t "*" "*" "*" "⋆") + ("lowast" "\\ast" t "∗" "*" "*" "∗") + ("ast" "\\ast" t "∗" "*" "*" "*") + ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ") + ("oplus" "\\oplus" t "⊕" "[circled plus]" "[circled plus]" "⊕") + ("otimes" "\\otimes" t "⊗" "[circled times]" "[circled times]" "⊗") + ("check" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") + ("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") + + "** Miscellaneous (seldom used)" + ("para" "\\P{}" nil "¶" "[pilcrow]" "¶" "¶") + ("ordf" "\\textordfeminine{}" nil "ª" "_a_" "ª" "ª") + ("ordm" "\\textordmasculine{}" nil "º" "_o_" "º" "º") + ("cedil" "\\c{}" nil "¸" "[cedilla]" "¸" "¸") + ("oline" "\\overline{~}" t "‾" "[overline]" "¯" "‾") + ("uml" "\\textasciidieresis{}" nil "¨" "[diaeresis]" "¨" "¨") + ("zwnj" "\\/{}" nil "‌" "" "" "‌") + ("zwj" "" nil "‍" "" "" "‍") + ("lrm" "" nil "‎" "" "" "‎") + ("rlm" "" nil "‏" "" "" "‏") + + "** Smilies" + ("smile" "\\smile" t "⌣" ":-)" ":-)" "⌣") + ("frown" "\\frown" t "⌢" ":-(" ":-(" "⌢") + ("smiley" "\\smiley{}" nil "☺" ":-)" ":-)" "☺") + ("blacksmile" "\\blacksmiley{}" nil "☻" ":-)" ":-)" "☻") + ("sad" "\\frownie{}" nil "☹" ":-(" ":-(" "☹") + + "** Suits" + ("clubs" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") + ("clubsuit" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") + ("spades" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") + ("spadesuit" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") + ("hearts" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") + ("heartsuit" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") + ("diams" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "◆") + ("diamondsuit" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "◆") + ("diamond" "\\diamondsuit" t "⋄" "[diamond]" "[diamond]" "◆") + ("Diamond" "\\diamondsuit" t "⋄" "[diamond]" "[diamond]" "◆") + ("loz" "\\lozenge" t "◊" "[lozenge]" "[lozenge]" "â§«") + ) + "Default entities used in Org-mode to produce special characters. +For details see `org-entities-user'.") + +(defsubst org-entity-get (name) + "Get the proper association for NAME from the entity lists. +This first checks the user list, then the built-in list." + (or (assoc name org-entities-user) + (assoc name org-entities))) + +(defun org-entity-get-representation (name kind) + "Get the correct representation of entity NAME for export type KIND. +Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'." + (let* ((e (org-entity-get name)) + (n (cdr (assq kind '((latex . 1) (html . 3) (ascii . 4) + (latin1 . 5) (utf8 . 6))))) + (r (and e n (nth n e)))) + (if (and e r + (not org-entities-ascii-explanatory) + (memq kind '(ascii latin1 utf8)) + (= (string-to-char r) ?\[)) + (concat "\\" name) + r))) + +(defsubst org-entity-latex-math-p (name) + "Does entity NAME require math mode in LaTeX?" + (nth 2 (org-entity-get name))) + +;; Helpfunctions to create a table for orgmode.org/worg/org-symbols.org + +(defun org-entities-create-table () + "Create an Org mode table with all entities." + (interactive) + (let ((pos (point)) e latex mathp html latin utf8 name ascii) + (insert "|Name|LaTeX code|LaTeX|HTML code |HTML|ASCII|Latin1|UTF-8\n|-\n") + (mapc (lambda (e) (when (listp e) + (setq name (car e) + latex (nth 1 e) + mathp (nth 2 e) + html (nth 3 e) + ascii (nth 4 e) + latin (nth 5 e) + utf8 (nth 6 e)) + (if (equal ascii "|") (setq ascii "\\vert")) + (if (equal latin "|") (setq latin "\\vert")) + (if (equal utf8 "|") (setq utf8 "\\vert")) + (if (equal ascii "=>") (setq ascii "= >")) + (if (equal latin "=>") (setq latin "= >")) + (insert "|" name + "|" (format "=%s=" latex) + "|" (format (if mathp "$%s$" "$\\mbox{%s}$") + latex) + "|" (format "=%s=" html) "|" html + "|" ascii "|" latin "|" utf8 + "|\n"))) + org-entities) + (goto-char pos) + (org-table-align))) + +(defvar org-pretty-entities) ;; declare defcustom from org +(defun org-entities-help () + "Create a Help buffer with all available entities." + (interactive) + (with-output-to-temp-buffer "*Org Entity Help*" + (princ "Org-mode entities\n=================\n\n") + (let ((ll (append '("* User-defined additions (variable org-entities-user)") + org-entities-user + org-entities)) + e latex mathp html latin utf8 name ascii + (lastwasstring t) + (head (concat + "\n" + " Symbol Org entity LaTeX code HTML code\n" + " -----------------------------------------------------------\n"))) + (while ll + (setq e (pop ll)) + (if (stringp e) + (progn + (princ e) + (princ "\n") + (setq lastwasstring t)) + (if lastwasstring (princ head)) + (setq lastwasstring nil) + (setq name (car e) + latex (nth 1 e) + html (nth 3 e) + utf8 (nth 6 e)) + (princ (format " %-8s \\%-16s %-22s %-13s\n" + utf8 name latex html)))))) + (with-current-buffer "*Org Entity Help*" + (org-mode) + (when org-pretty-entities + (org-toggle-pretty-entities))) + (select-window (get-buffer-window "*Org Entity Help*"))) + + +(defun replace-amp () + "Postprocess HTML file to unescape the ampersand." + (interactive) + (while (re-search-forward "&\\([^<;]+;\\)" nil t) + (replace-match (concat "&" (match-string 1)) t t))) + +(provide 'org-entities) + +;; Local variables: +;; coding: utf-8 +;; End: + +;;; org-entities.el ends here diff --git a/elpa/org-20150427/org-eshell.el b/elpa/org-20150427/org-eshell.el new file mode 100644 index 00000000..1256bc37 --- /dev/null +++ b/elpa/org-20150427/org-eshell.el @@ -0,0 +1,65 @@ +;;; org-eshell.el - Support for links to working directories in eshell + +;; Copyright (C) 2011-2014 Free Software Foundation, Inc. + +;; Author: Konrad Hinsen + +;; 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 . + +;;; Commentary: + +;;; Code: + +(require 'org) +(require 'eshell) +(require 'esh-mode) + +(org-add-link-type "eshell" 'org-eshell-open) +(add-hook 'org-store-link-functions 'org-eshell-store-link) + +(defun org-eshell-open (link) + "Switch to am eshell buffer and execute a command line. + The link can be just a command line (executed in the default + eshell buffer) or a command line prefixed by a buffer name + followed by a colon." + (let* ((buffer-and-command + (if (string-match "\\([A-Za-z0-9-+*]+\\):\\(.*\\)" link) + (list (match-string 1 link) + (match-string 2 link)) + (list eshell-buffer-name link))) + (eshell-buffer-name (car buffer-and-command)) + (command (cadr buffer-and-command))) + (if (get-buffer eshell-buffer-name) + (org-pop-to-buffer-same-window eshell-buffer-name) + (eshell)) + (goto-char (point-max)) + (eshell-kill-input) + (insert command) + (eshell-send-input))) + +(defun org-eshell-store-link () + "Store a link that, when opened, switches back to the current eshell buffer + and the current working directory." + (when (eq major-mode 'eshell-mode) + (let* ((command (concat "cd " dired-directory)) + (link (concat (buffer-name) ":" command))) + (org-store-link-props + :link (concat "eshell:" link) + :description command)))) + +(provide 'org-eshell) + +;;; org-eshell.el ends here diff --git a/elpa/org-20150427/org-faces.el b/elpa/org-20150427/org-faces.el new file mode 100644 index 00000000..f8625f12 --- /dev/null +++ b/elpa/org-20150427/org-faces.el @@ -0,0 +1,802 @@ +;;; org-faces.el --- Face definitions for Org-mode. + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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 . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file contains the face definitions for Org. + +;;; Code: + +(require 'org-macs) +(require 'org-compat) + +(defun org-copy-face (old-face new-face docstring &rest attributes) + (unless (facep new-face) + (if (fboundp 'set-face-attribute) + (progn + (make-face new-face) + (set-face-attribute new-face nil :inherit old-face) + (apply 'set-face-attribute new-face nil attributes) + (set-face-doc-string new-face docstring)) + (copy-face old-face new-face) + (if (fboundp 'set-face-doc-string) + (set-face-doc-string new-face docstring))))) +(put 'org-copy-face 'lisp-indent-function 2) + +(when (featurep 'xemacs) + (put 'mode-line 'face-alias 'modeline)) + +(defgroup org-faces nil + "Faces in Org-mode." + :tag "Org Faces" + :group 'org-appearance) + +(defface org-default + (org-compatible-face 'default nil) + "Face used for default text." + :group 'org-faces) + +(defface org-hide + '((((background light)) (:foreground "white")) + (((background dark)) (:foreground "black"))) + "Face used to hide leading stars in headlines. +The foreground color of this face should be equal to the background +color of the frame." + :group 'org-faces) + +(defface org-level-1 ;; originally copied from font-lock-function-name-face + (org-compatible-face 'outline-1 + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :bold t)) + (t (:bold t)))) + "Face used for level 1 headlines." + :group 'org-faces) + +(defface org-level-2 ;; originally copied from font-lock-variable-name-face + (org-compatible-face 'outline-2 + '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) + (((class color) (min-colors 8) (background light)) (:foreground "yellow")) + (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) + (t (:bold t)))) + "Face used for level 2 headlines." + :group 'org-faces) + +(defface org-level-3 ;; originally copied from font-lock-keyword-face + (org-compatible-face 'outline-3 + '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) + (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) + (((class color) (min-colors 16) (background light)) (:foreground "Purple")) + (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) + (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) + (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) + (t (:bold t)))) + "Face used for level 3 headlines." + :group 'org-faces) + +(defface org-level-4 ;; originally copied from font-lock-comment-face + (org-compatible-face 'outline-4 + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 16) (background light)) (:foreground "red")) + (((class color) (min-colors 16) (background dark)) (:foreground "red1")) + (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t)))) + "Face used for level 4 headlines." + :group 'org-faces) + +(defface org-level-5 ;; originally copied from font-lock-type-face + (org-compatible-face 'outline-5 + '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) + (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")))) + "Face used for level 5 headlines." + :group 'org-faces) + +(defface org-level-6 ;; originally copied from font-lock-constant-face + (org-compatible-face 'outline-6 + '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) + (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) + (((class color) (min-colors 8)) (:foreground "magenta")))) + "Face used for level 6 headlines." + :group 'org-faces) + +(defface org-level-7 ;; originally copied from font-lock-builtin-face + (org-compatible-face 'outline-7 + '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) + (((class color) (min-colors 8)) (:foreground "blue")))) + "Face used for level 7 headlines." + :group 'org-faces) + +(defface org-level-8 ;; originally copied from font-lock-string-face + (org-compatible-face 'outline-8 + '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (((class color) (min-colors 8)) (:foreground "green")))) + "Face used for level 8 headlines." + :group 'org-faces) + +(defface org-special-keyword ;; originally copied from font-lock-string-face + (org-compatible-face 'font-lock-keyword-face + '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (t (:italic t)))) + "Face used for special keywords." + :group 'org-faces) + +(defface org-drawer ;; originally copied from font-lock-function-name-face + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :bold t)) + (t (:bold t)))) + "Face used for drawers." + :group 'org-faces) + +(defface org-property-value nil + "Face used for the value of a property." + :group 'org-faces) + +(defface org-column + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) + (:background "grey90" :weight normal :slant normal :strike-through nil + :underline nil)) + (((class color) (min-colors 16) (background dark)) + (:background "grey30" :weight normal :slant normal :strike-through nil + :underline nil)) + (((class color) (min-colors 8)) + (:background "cyan" :foreground "black" + :weight normal :slant normal :strike-through nil + :underline nil)) + (t (:inverse-video t)))) + "Face for column display of entry properties. +This is actually only part of the face definition for the text in column view. +The following faces apply, with this priority. + +1. The color of the reference face. This is normally the level fact that + is used in the outline. In agenda-mode, it will be the face of the + first character in the line. The color is explicitly retained to + make sure that the column line still looks a bit like the structure + line it is masking. + +2. The `org-column' face. + +3. The remaining properties of the reference face. + +Since column view works by putting overlays with a display property +over individual characters in the buffer, the face of the underlining +character (this might for example be the a TODO keyword) might still +shine through in some properties. So when your column view looks +funny, with \"random\" colors, weight, strike-through, try to explicitly +set the properties in the `org-column' face. For example, set +:underline to nil, or the :slant to `normal'. + +Under XEmacs, the rules are simpler, because the XEmacs version of +column view defines special faces for each outline level. See the file +`org-colview-xemacs.el' in Org's contrib/ directory for details." + :group 'org-faces) + +(defface org-column-title + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) + (:background "grey90" :underline t :weight bold)) + (((class color) (min-colors 16) (background dark)) + (:background "grey30" :underline t :weight bold)) + (((class color) (min-colors 8)) + (:background "cyan" :foreground "black" :underline t :weight bold)) + (t (:inverse-video t)))) + "Face for column display of entry properties." + :group 'org-faces) + +(defface org-agenda-column-dateline + (org-compatible-face 'org-column + '((t nil))) + "Face used in agenda column view for datelines with summaries." + :group 'org-faces) + +(defface org-warning + (org-compatible-face 'font-lock-warning-face + '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) + (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t)))) + "Face for deadlines and TODO keywords." + :group 'org-faces) + +(defface org-archived ; 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 headline with the ARCHIVE tag." + :group 'org-faces) + +(defface org-link + (org-compatible-face 'link + '((((class color) (background light)) (:foreground "Purple" :underline t)) + (((class color) (background dark)) (:foreground "Cyan" :underline t)) + (t (:underline t)))) + "Face for links." + :group 'org-faces) + +(defface org-footnote + '((((class color) (background light)) (:foreground "Purple" :underline t)) + (((class color) (background dark)) (:foreground "Cyan" :underline t)) + (t (:underline t))) + "Face for footnotes." + :group 'org-faces) + +(defface org-ellipsis + '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) + (((class color) (background dark)) (:foreground "LightGoldenrod" :underline t)) + (t (:strike-through t))) + "Face for the ellipsis in folded text." + :group 'org-faces) + +(defface org-target + '((((class color) (background light)) (:underline t)) + (((class color) (background dark)) (:underline t)) + (t (:underline t))) + "Face for link targets." + :group 'org-faces) + +(defface org-date + '((((class color) (background light)) (:foreground "Purple" :underline t)) + (((class color) (background dark)) (:foreground "Cyan" :underline t)) + (t (:underline t))) + "Face for date/time stamps." + :group 'org-faces) + +(defface org-date-selected + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t)) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t)) + (((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t)) + (t (:inverse-video t)))) + "Face for highlighting the calendar day when using `org-read-date'. +Using a bold face here might cause discrepancies while displaying the +calendar." + :group 'org-faces) + +(defface org-sexp-date + '((((class color) (background light)) (:foreground "Purple")) + (((class color) (background dark)) (:foreground "Cyan")) + (t (:underline t))) + "Face for diary-like sexp date specifications." + :group 'org-faces) + +(defface org-tag + '((t (:bold t))) + "Default face for tags. +Note that the variable `org-tag-faces' can be used to overrule this face for +specific tags." + :group 'org-faces) + +(defface org-list-dt + '((t (:bold t))) + "Default face for definition terms in lists." + :group 'org-faces) + +(defface org-todo ; font-lock-warning-face + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) + (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) + (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:inverse-video t :bold t)))) + "Face for TODO keywords." + :group 'org-faces) + +(defface org-done ;; originally copied from font-lock-type-face + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) + (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold t)))) + "Face used for todo keywords that indicate DONE items." + :group 'org-faces) + +(defface org-agenda-done ;; originally copied from font-lock-type-face + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) + (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold nil)))) + "Face used in agenda, to indicate lines switched to DONE. +This face is used to de-emphasize items that where brightly colored in the +agenda because they were things to do, or overdue. The DONE state itself +is of course immediately visible, but for example a passed deadline is +\(by default) very bright read. This face could be simply the default face +of the frame, for example." + :group 'org-faces) + +(defface org-headline-done ;; originally copied from font-lock-string-face + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (((class color) (min-colors 8) (background light)) (:bold nil)))) + "Face used to indicate that a headline is DONE. +This face is only used if `org-fontify-done-headline' is set. If applies +to the part of the headline after the DONE keyword." + :group 'org-faces) + +(defcustom org-faces-easy-properties + '((todo . :foreground) (tag . :foreground) (priority . :foreground)) + "The property changes by easy faces. +This is an alist, the keys show the area of application, the values +can be `:foreground' or `:background'. A color string for special +keywords will then be interpreted as either foreground or background +color." + :group 'org-faces + :group 'org-todo + :version "24.1" + :type '(repeat + (cons (choice (const todo) (const tag) (const priority)) + (choice (const :foreground) (const :background))))) + +(defcustom org-todo-keyword-faces nil + "Faces for specific TODO keywords. +This is a list of cons cells, with TODO keywords in the car +and faces in the cdr. The face can be a symbol, a color +as a string (in which case the rest is inherited from the `org-todo' face), +or a property list of attributes, like + (:foreground \"blue\" :weight bold :underline t). +If it is a color string, the variable `org-faces-easy-properties' +determines if it is a foreground or a background color." + :group 'org-faces + :group 'org-todo + :type '(repeat + (cons + (string :tag "Keyword") + (choice :tag "Face " + (string :tag "Color") + (sexp :tag "Face"))))) + +(defface org-priority ;; originally copied from font-lock-string-face + (org-compatible-face 'font-lock-keyword-face + '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) + (t (:italic t)))) + "Face used for priority cookies." + :group 'org-faces) + +(defcustom org-priority-faces nil + "Faces for specific Priorities. +This is a list of cons cells, with priority character in the car +and faces in the cdr. The face can be a symbol, a color as +as a string, or a property list of attributes, like + (:foreground \"blue\" :weight bold :underline t). +If it is a color string, the variable `org-faces-easy-properties' +determines if it is a foreground or a background color." + :group 'org-faces + :group 'org-todo + :type '(repeat + (cons + (character :tag "Priority") + (choice :tag "Face " + (string :tag "Color") + (sexp :tag "Face"))))) + +(defvar org-tags-special-faces-re nil) +(defun org-set-tag-faces (var value) + (set var value) + (if (not value) + (setq org-tags-special-faces-re nil) + (setq org-tags-special-faces-re + (concat ":\\(" (mapconcat 'car value "\\|") "\\):")))) + +(defface org-checkbox + (org-compatible-face 'bold + '((t (:bold t)))) + "Face for checkboxes." + :group 'org-faces) + + +(org-copy-face 'org-todo 'org-checkbox-statistics-todo + "Face used for unfinished checkbox statistics.") + +(org-copy-face 'org-done 'org-checkbox-statistics-done + "Face used for finished checkbox statistics.") + +(defcustom org-tag-faces nil + "Faces for specific tags. +This is a list of cons cells, with tags in the car and faces in the cdr. +The face can be a symbol, a foreground color (in which case the rest is +inherited from the `org-tag' face) or a property list of attributes, +like (:foreground \"blue\" :weight bold :underline t). +If you set this variable through customize, it will immediately be effective +in new buffers and in modified lines. +If you set it with Lisp, a restart of Emacs is required to activate the +changes." + :group 'org-faces + :group 'org-tags + :set 'org-set-tag-faces + :type '(repeat + (cons + (string :tag "Tag ") + (choice :tag "Face" + (string :tag "Foreground color") + (sexp :tag "Face"))))) + +(defface org-table ;; originally copied from font-lock-function-name-face + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8) (background light)) (:foreground "blue")) + (((class color) (min-colors 8) (background dark))))) + "Face used for tables." + :group 'org-faces) + +(defface org-formula + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red")) + (t (:bold t :italic t)))) + "Face for formulas." + :group 'org-faces) + +(defface org-code + (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 fixed-width text like code snippets." + :group 'org-faces + :version "22.1") + +(defface org-meta-line + (org-compatible-face 'font-lock-comment-face nil) + "Face for meta lines startin with \"#+\"." + :group 'org-faces + :version "22.1") + +(defface org-document-title + '((((class color) (background light)) (:foreground "midnight blue" :weight bold)) + (((class color) (background dark)) (:foreground "pale turquoise" :weight bold)) + (t (:weight bold))) + "Face for document title, i.e. that which follows the #+TITLE: keyword." + :group 'org-faces) + +(defface org-document-info + '((((class color) (background light)) (:foreground "midnight blue")) + (((class color) (background dark)) (:foreground "pale turquoise")) + (t nil)) + "Face for document date, author and email; i.e. that which +follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword." + :group 'org-faces) + +(defface org-document-info-keyword + (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 #+TITLE:, #+AUTHOR:, #+EMAIL: and #+DATE: keywords." + :group 'org-faces) + +(defface org-block + (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 text in #+begin ... #+end blocks." + :group 'org-faces + :version "22.1") + +(defface org-block-background '((t ())) + "Face used for the source block background.") + +(org-copy-face 'org-meta-line 'org-block-begin-line + "Face used for the line delimiting the begin of source blocks.") + +(org-copy-face 'org-meta-line 'org-block-end-line + "Face used for the line delimiting the end of source blocks.") + +(defface org-verbatim + (org-compatible-face 'shadow + '((((class color grayscale) (min-colors 88) (background light)) + (:foreground "grey50" :underline t)) + (((class color grayscale) (min-colors 88) (background dark)) + (:foreground "grey70" :underline t)) + (((class color) (min-colors 8) (background light)) + (:foreground "green" :underline t)) + (((class color) (min-colors 8) (background dark)) + (:foreground "yellow" :underline t)))) + "Face for fixed-with text like code snippets." + :group 'org-faces + :version "22.1") + +(org-copy-face 'org-block 'org-quote + "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.") +(org-copy-face 'org-block 'org-verse + "Face for #+BEGIN_VERSE ... #+END_VERSE blocks.") + +(defcustom org-fontify-quote-and-verse-blocks nil + "Non-nil means, add a special face to #+begin_quote and #+begin_verse block. +When nil, format these as normal Org. This is the default, because the +content of these blocks will still be treated as Org syntax." + :group 'org-faces + :version "24.1" + :type 'boolean) + +(defface org-clock-overlay ;; copied from secondary-selection + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) + (:background "yellow1")) + (((class color) (min-colors 88) (background dark)) + (:background "SkyBlue4")) + (((class color) (min-colors 16) (background light)) + (:background "yellow")) + (((class color) (min-colors 16) (background dark)) + (:background "SkyBlue4")) + (((class color) (min-colors 8)) + (:background "cyan" :foreground "black")) + (t (:inverse-video t)))) + "Basic face for displaying the secondary selection." + :group 'org-faces) + +(defface org-agenda-structure ;; originally copied from font-lock-function-name-face + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 16) (background light)) (:foreground "Blue")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) + (((class color) (min-colors 8)) (:foreground "blue" :bold t)) + (t (:bold t)))) + "Face used in agenda for captions and dates." + :group 'org-faces) + +(org-copy-face 'org-agenda-structure 'org-agenda-date + "Face used in agenda for normal days.") + +(org-copy-face 'org-agenda-date 'org-agenda-date-today + "Face used in agenda for today." + :weight 'bold :italic 't) + +(org-copy-face 'secondary-selection 'org-agenda-clocking + "Face marking the current clock item in the agenda.") + +(org-copy-face 'org-agenda-date 'org-agenda-date-weekend + "Face used in agenda for weekend days. +See the variable `org-agenda-weekend-days' for a definition of which days +belong to the weekend." + :weight 'bold) + +(defface org-scheduled + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) + (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold t :italic t)))) + "Face for items scheduled for a certain day." + :group 'org-faces) + +(defface org-scheduled-today + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) + (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) + (((class color) (min-colors 8)) (:foreground "green")) + (t (:bold t :italic t)))) + "Face for items scheduled for a certain day." + :group 'org-faces) + +(defface org-agenda-dimmed-todo-face + '((((background light)) (:foreground "grey50")) + (((background dark)) (:foreground "grey50"))) + "Face used to dim blocked tasks in the agenda." + :group 'org-faces) + +(defface org-scheduled-previously + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t)))) + "Face for items scheduled previously, and not yet done." + :group 'org-faces) + +(defface org-upcoming-deadline + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) + (((class color) (min-colors 8) (background light)) (:foreground "red")) + (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) + (t (:bold t)))) + "Face for items scheduled previously, and not yet done." + :group 'org-faces) + +(defcustom org-agenda-deadline-faces + '((1.0 . org-warning) + (0.5 . org-upcoming-deadline) + (0.0 . default)) + "Faces for showing deadlines in the agenda. +This is a list of cons cells. The cdr of each cell is a face to be used, +and it can also just be like '(:foreground \"yellow\"). +Each car is a fraction of the head-warning time that must have passed for +this the face in the cdr to be used for display. The numbers must be +given in descending order. The head-warning time is normally taken +from `org-deadline-warning-days', but can also be specified in the deadline +timestamp itself, like this: + + DEADLINE: <2007-08-13 Mon -8d> + +You may use d for days, w for weeks, m for months and y for years. Months +and years will only be treated in an approximate fashion (30.4 days for a +month and 365.24 days for a year)." + :group 'org-faces + :group 'org-agenda-daily/weekly + :type '(repeat + (cons + (number :tag "Fraction of head-warning time passed") + (sexp :tag "Face")))) + +(defface org-agenda-restriction-lock + (org-compatible-face nil + '((((class color) (min-colors 88) (background light)) (:background "#eeeeee")) + (((class color) (min-colors 88) (background dark)) (:background "#1C1C1C")) + (((class color) (min-colors 16) (background light)) (:background "#eeeeee")) + (((class color) (min-colors 16) (background dark)) (:background "#1C1C1C")) + (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) + (t (:inverse-video t)))) + "Face for showing the agenda restriction lock." + :group 'org-faces) + +(defface org-agenda-filter-tags + (org-compatible-face 'mode-line nil) + "Face for tag(s) in the mode-line when filtering the agenda." + :group 'org-faces) + +(defface org-agenda-filter-regexp + (org-compatible-face 'mode-line nil) + "Face for regexp(s) in the mode-line when filtering the agenda." + :group 'org-faces) + +(defface org-agenda-filter-category + (org-compatible-face 'mode-line nil) + "Face for categories(s) in the mode-line when filtering the agenda." + :group 'org-faces) + +(defface org-time-grid ;; originally copied from font-lock-variable-name-face + (org-compatible-face nil + '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) + (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) + (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) + "Face used for time grids." + :group 'org-faces) + +(org-copy-face 'org-time-grid 'org-agenda-current-time + "Face used to show the current time in the time grid.") + +(defface org-agenda-diary + (org-compatible-face 'default nil) + "Face used for agenda entries that come from the Emacs diary." + :group 'org-faces) + +(defface org-agenda-calendar-event + (org-compatible-face 'default nil) + "Face used to show events and appointments in the agenda." + :group 'org-faces) + +(defface org-agenda-calendar-sexp + (org-compatible-face 'default nil) + "Face used to show events computed from a S-expression." + :group 'org-faces) + +(defconst org-level-faces + '(org-level-1 org-level-2 org-level-3 org-level-4 + org-level-5 org-level-6 org-level-7 org-level-8 + )) + +(defcustom org-n-level-faces (length org-level-faces) + "The number of different faces to be used for headlines. +Org-mode defines 8 different headline faces, so this can be at most 8. +If it is less than 8, the level-1 face gets re-used for level N+1 etc." + :type 'integer + :group 'org-faces) + +(defcustom org-cycle-level-faces t + "Non-nil means level styles cycle after level `org-n-level-faces'. +Then so level org-n-level-faces+1 is styled like level 1. +If nil, then all levels >=org-n-level-faces are styled like +level org-n-level-faces" + :group 'org-appearance + :group 'org-faces + :version "24.1" + :type 'boolean) + +(defface org-latex-and-related + (let ((font (cond ((assq :inherit custom-face-attributes) + '(:inherit underline)) + (t '(:underline t))))) + `((((class grayscale) (background light)) + (:foreground "DimGray" ,@font)) + (((class grayscale) (background dark)) + (:foreground "LightGray" ,@font)) + (((class color) (background light)) + (:foreground "SaddleBrown")) + (((class color) (background dark)) + (:foreground "burlywood")) + (t (,@font)))) + "Face used to highlight LaTeX data, entities and sub/superscript." + :group 'org-faces + :version "24.4" + :package-version '(Org . "8.0")) + +(defface org-macro + (org-compatible-face 'org-latex-and-related nil) + "Face for macros." + :group 'org-faces + :version "24.4" + :package-version '(Org . "8.0")) + +(defface org-tag-group + (org-compatible-face 'org-tag nil) + "Face for group tags." + :group 'org-faces + :version "24.4" + :package-version '(Org . "8.0")) + +(org-copy-face 'mode-line 'org-mode-line-clock + "Face used for clock display in mode line.") +(org-copy-face 'mode-line 'org-mode-line-clock-overrun + "Face used for clock display for overrun tasks in mode line." + :background "red") + +(provide 'org-faces) + +;;; org-faces.el ends here diff --git a/elpa/org-20150427/org-feed.el b/elpa/org-20150427/org-feed.el new file mode 100644 index 00000000..6e680718 --- /dev/null +++ b/elpa/org-20150427/org-feed.el @@ -0,0 +1,702 @@ +;;; org-feed.el --- Add RSS feed items to Org files +;; +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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 . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: +;; +;; This module allows to create and change entries in an Org-mode +;; file triggered by items in an RSS feed. The basic functionality is +;; geared toward simply adding new items found in a feed as outline nodes +;; to an Org file. Using hooks, arbitrary actions can be triggered for +;; new or changed items. +;; +;; Selecting feeds and target locations +;; ------------------------------------ +;; +;; This module is configured through a single variable, `org-feed-alist'. +;; Here is an example, using a notes/tasks feed from reQall.com. +;; +;; (setq org-feed-alist +;; '(("ReQall" +;; "http://www.reqall.com/user/feeds/rss/a1b2c3....." +;; "~/org/feeds.org" "ReQall Entries") +;; +;; With this setup, the command `M-x org-feed-update-all' will +;; collect new entries in the feed at the given URL and create +;; entries as subheadings under the "ReQall Entries" heading in the +;; file "~/org/feeds.org". Each feed should normally have its own +;; heading - however see the `:drawer' parameter. +;; +;; Besides these standard elements that need to be specified for each +;; feed, keyword-value pairs can set additional options. For example, +;; to de-select transitional entries with a title containing +;; +;; "reQall is typing what you said", +;; +;; you could use the `:filter' argument: +;; +;; (setq org-feed-alist +;; '(("ReQall" +;; "http://www.reqall.com/user/feeds/rss/a1b2c3....." +;; "~/org/feeds.org" "ReQall Entries" +;; :filter my-reqall-filter))) +;; +;; (defun my-reqall-filter (e) +;; (if (string-match "reQall is typing what you said" +;; (plist-get e :title)) +;; nil +;; e)) +;; +;; See the docstring for `org-feed-alist' for more details. +;; +;; +;; Keeping track of previously added entries +;; ----------------------------------------- +;; +;; Since Org allows you to delete, archive, or move outline nodes, +;; org-feed.el needs to keep track of which feed items have been handled +;; before, so that they will not be handled again. For this, org-feed.el +;; stores information in a special drawer, FEEDSTATUS, under the heading +;; that received the input of the feed. You should add FEEDSTATUS +;; to your list of drawers in the files that receive feed input: +;; +;; #+DRAWERS: PROPERTIES CLOCK LOGBOOK RESULTS FEEDSTATUS +;; +;; Acknowledgments +;; --------------- +;; +;; org-feed.el is based on ideas by Brad Bozarth who implemented a +;; similar mechanism using shell and awk scripts. + +;;; Code: + +(require 'org) +(require 'sha1) + +(declare-function url-retrieve-synchronously "url" (url)) +(declare-function xml-node-children "xml" (node)) +(declare-function xml-get-children "xml" (node child-name)) +(declare-function xml-get-attribute "xml" (node attribute)) +(declare-function xml-get-attribute-or-nil "xml" (node attribute)) +(declare-function xml-substitute-special "xml" (string)) + +(declare-function org-capture-escaped-% "org-capture" ()) +(declare-function org-capture-inside-embedded-elisp-p "org-capture" ()) +(declare-function org-capture-expand-embedded-elisp "org-capture" ()) + +(defgroup org-feed nil + "Options concerning RSS feeds as inputs for Org files." + :tag "Org Feed" + :group 'org) + +(defcustom org-feed-alist nil + "Alist specifying RSS feeds that should create inputs for Org. +Each entry in this list specified an RSS feed tat should be queried +to create inbox items in Org. Each entry is a list with the following items: + +name a custom name for this feed +URL the Feed URL +file the target Org file where entries should be listed +headline the headline under which entries should be listed + +Additional arguments can be given using keyword-value pairs. Many of these +specify functions that receive one or a list of \"entries\" as their single +argument. An entry is a property list that describes a feed item. The +property list has properties for each field in the item, for example `:title' +for the `' field and `:pubDate' for the publication date. In addition, +it contains the following properties: + +`:item-full-text' the full text in the <item> tag +`:guid-permalink' t when the guid property is a permalink + +Here are the keyword-value pair allows in `org-feed-alist'. + +:drawer drawer-name + The name of the drawer for storing feed information. The default is + \"FEEDSTATUS\". Using different drawers for different feeds allows + several feeds to target the same inbox heading. + +:filter filter-function + A function to select interesting entries in the feed. It gets a single + entry as parameter. It should return the entry if it is relevant, or + nil if it is not. + +:template template-string + The default action on new items in the feed is to add them as children + under the headline for the feed. The template describes how the entry + should be formatted. If not given, it defaults to + `org-feed-default-template'. + +:formatter formatter-function + Instead of relying on a template, you may specify a function to format + the outline node to be inserted as a child. This function gets passed + a property list describing a single feed item, and it should return a + string that is a properly formatted Org outline node of level 1. + +:new-handler function + If adding new items as children to the outline is not what you want + to do with new items, define a handler function that is called with + a list of all new items in the feed, each one represented as a property + list. The handler should do what needs to be done, and org-feed will + mark all items given to this handler as \"handled\", i.e. they will not + be passed to this handler again in future readings of the feed. + When the handler is called, point will be at the feed headline. + +:changed-handler function + This function gets passed a list of all entries that have been + handled before, but are now still in the feed and have *changed* + since last handled (as evidenced by a different sha1 hash). + When the handler is called, point will be at the feed headline. + +:parse-feed function + This function gets passed a buffer, and should return a list + of entries, each being a property list containing the + `:guid' and `:item-full-text' keys. The default is + `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed' is an + alternative. + +:parse-entry function + This function gets passed an entry as returned by the parse-feed + function, and should return the entry with interesting properties added. + The default is `org-feed-parse-rss-entry'; `org-feed-parse-atom-entry' + is an alternative." + :group 'org-feed + :type '(repeat + (list :value ("" "http://" "" "") + (string :tag "Name") + (string :tag "Feed URL") + (file :tag "File for inbox") + (string :tag "Headline for inbox") + (repeat :inline t + (choice + (list :inline t :tag "Filter" + (const :filter) + (symbol :tag "Filter Function")) + (list :inline t :tag "Template" + (const :template) + (string :tag "Template")) + (list :inline t :tag "Formatter" + (const :formatter) + (symbol :tag "Formatter Function")) + (list :inline t :tag "New items handler" + (const :new-handler) + (symbol :tag "Handler Function")) + (list :inline t :tag "Changed items" + (const :changed-handler) + (symbol :tag "Handler Function")) + (list :inline t :tag "Parse Feed" + (const :parse-feed) + (symbol :tag "Parse Feed Function")) + (list :inline t :tag "Parse Entry" + (const :parse-entry) + (symbol :tag "Parse Entry Function")) + ))))) + +(defcustom org-feed-drawer "FEEDSTATUS" + "The name of the drawer for feed status information. +Each feed may also specify its own drawer name using the `:drawer' +parameter in `org-feed-alist'. +Note that in order to make these drawers behave like drawers, they must +be added to the variable `org-drawers' or configured with a #+DRAWERS +line." + :group 'org-feed + :type '(string :tag "Drawer Name")) + +(defcustom org-feed-default-template "\n* %h\n %U\n %description\n %a\n" + "Template for the Org node created from RSS feed items. +This is just the default, each feed can specify its own. +Any fields from the feed item can be interpolated into the template with +%name, for example %title, %description, %pubDate etc. In addition, the +following special escapes are valid as well: + +%h The title, or the first line of the description +%t The date as a stamp, either from <pubDate> (if present), or + the current date +%T Date and time +%u,%U Like %t,%T, but inactive time stamps +%a A link, from <guid> if that is a permalink, else from <link> +%(sexp) Evaluate elisp `(sexp)' and replace with the result, the simple + %-escapes above can be used as arguments, e.g. %(capitalize \\\"%h\\\")" + :group 'org-feed + :type '(string :tag "Template")) + +(defcustom org-feed-save-after-adding t + "Non-nil means save buffer after adding new feed items." + :group 'org-feed + :type 'boolean) + +(defcustom org-feed-retrieve-method 'url-retrieve-synchronously + "The method to be used to retrieve a feed URL. +This can be `curl' or `wget' to call these external programs, or it can be +an Emacs Lisp function that will return a buffer containing the content +of the file pointed to by the URL." + :group 'org-feed + :type '(choice + (const :tag "Internally with url.el" url-retrieve-synchronously) + (const :tag "Externally with curl" curl) + (const :tag "Externally with wget" wget) + (function :tag "Function"))) + +(defcustom org-feed-before-adding-hook nil + "Hook that is run before adding new feed items to a file. +You might want to commit the file in its current state to version control, +for example." + :group 'org-feed + :type 'hook) + +(defcustom org-feed-after-adding-hook nil + "Hook that is run after new items have been added to a file. +Depending on `org-feed-save-after-adding', the buffer will already +have been saved." + :group 'org-feed + :type 'hook) + +(defvar org-feed-buffer "*Org feed*" + "The buffer used to retrieve a feed.") + +;;;###autoload +(defun org-feed-update-all () + "Get inbox items from all feeds in `org-feed-alist'." + (interactive) + (let ((nfeeds (length org-feed-alist)) + (nnew (apply '+ (mapcar 'org-feed-update org-feed-alist)))) + (message "%s from %d %s" + (cond ((= nnew 0) "No new entries") + ((= nnew 1) "1 new entry") + (t (format "%d new entries" nnew))) + nfeeds + (if (= nfeeds 1) "feed" "feeds")))) + +;;;###autoload +(defun org-feed-update (feed &optional retrieve-only) + "Get inbox items from FEED. +FEED can be a string with an association in `org-feed-alist', or +it can be a list structured like an entry in `org-feed-alist'." + (interactive (list (org-completing-read "Feed name: " org-feed-alist))) + (if (stringp feed) (setq feed (assoc feed org-feed-alist))) + (unless feed + (error "No such feed in `org-feed-alist")) + (catch 'exit + (let ((name (car feed)) + (url (nth 1 feed)) + (file (nth 2 feed)) + (headline (nth 3 feed)) + (filter (nth 1 (memq :filter feed))) + (formatter (nth 1 (memq :formatter feed))) + (new-handler (nth 1 (memq :new-handler feed))) + (changed-handler (nth 1 (memq :changed-handler feed))) + (template (or (nth 1 (memq :template feed)) + org-feed-default-template)) + (drawer (or (nth 1 (memq :drawer feed)) + org-feed-drawer)) + (parse-feed (or (nth 1 (memq :parse-feed feed)) + 'org-feed-parse-rss-feed)) + (parse-entry (or (nth 1 (memq :parse-entry feed)) + 'org-feed-parse-rss-entry)) + feed-buffer inbox-pos new-formatted + entries old-status status new changed guid-alist e guid olds) + (setq feed-buffer (org-feed-get-feed url)) + (unless (and feed-buffer (bufferp (get-buffer feed-buffer))) + (error "Cannot get feed %s" name)) + (when retrieve-only + (throw 'exit feed-buffer)) + (setq entries (funcall parse-feed feed-buffer)) + (ignore-errors (kill-buffer feed-buffer)) + (save-excursion + (save-window-excursion + (setq inbox-pos (org-feed-goto-inbox-internal file headline)) + (setq old-status (org-feed-read-previous-status inbox-pos drawer)) + ;; Add the "handled" status to the appropriate entries + (setq entries (mapcar (lambda (e) + (setq e + (plist-put e :handled + (nth 1 (assoc + (plist-get e :guid) + old-status))))) + entries)) + ;; Find out which entries are new and which are changed + (dolist (e entries) + (if (not (plist-get e :handled)) + (push e new) + (setq olds (nth 2 (assoc (plist-get e :guid) old-status))) + (if (and olds + (not (string= (sha1 + (plist-get e :item-full-text)) + olds))) + (push e changed)))) + + ;; Parse the relevant entries fully + (setq new (mapcar parse-entry new) + changed (mapcar parse-entry changed)) + + ;; Run the filter + (when filter + (setq new (delq nil (mapcar filter new)) + changed (delq nil (mapcar filter new)))) + + (when (not (or new changed)) + (message "No new items in feed %s" name) + (throw 'exit 0)) + + ;; Get alist based on guid, to look up entries + (setq guid-alist + (append + (mapcar (lambda (e) (list (plist-get e :guid) e)) new) + (mapcar (lambda (e) (list (plist-get e :guid) e)) changed))) + + ;; Construct the new status + (setq status + (mapcar + (lambda (e) + (setq guid (plist-get e :guid)) + (list guid + ;; things count as handled if we handle them now, + ;; or if they were handled previously + (if (assoc guid guid-alist) t (plist-get e :handled)) + ;; A hash, to detect changes + (sha1 (plist-get e :item-full-text)))) + entries)) + + ;; Handle new items in the feed + (when new + (if new-handler + (progn + (goto-char inbox-pos) + (funcall new-handler new)) + ;; No custom handler, do the default adding + ;; Format the new entries into an alist with GUIDs in the car + (setq new-formatted + (mapcar + (lambda (e) (org-feed-format-entry e template formatter)) + new))) + + ;; Insert the new items + (org-feed-add-items inbox-pos new-formatted)) + + ;; Handle changed items in the feed + (when (and changed-handler changed) + (goto-char inbox-pos) + (funcall changed-handler changed)) + + ;; Write the new status + ;; We do this only now, in case something goes wrong above, so + ;; that would would end up with a status that does not reflect + ;; which items truely have been handled + (org-feed-write-status inbox-pos drawer status) + + ;; Normalize the visibility of the inbox tree + (goto-char inbox-pos) + (hide-subtree) + (show-children) + (org-cycle-hide-drawers 'children) + + ;; Hooks and messages + (when org-feed-save-after-adding (save-buffer)) + (message "Added %d new item%s from feed %s to file %s, heading %s" + (length new) (if (> (length new) 1) "s" "") + name + (file-name-nondirectory file) headline) + (run-hooks 'org-feed-after-adding-hook) + (length new)))))) + +;;;###autoload +(defun org-feed-goto-inbox (feed) + "Go to the inbox that captures the feed named FEED." + (interactive + (list (if (= (length org-feed-alist) 1) + (car org-feed-alist) + (org-completing-read "Feed name: " org-feed-alist)))) + (if (stringp feed) (setq feed (assoc feed org-feed-alist))) + (unless feed + (error "No such feed in `org-feed-alist")) + (org-feed-goto-inbox-internal (nth 2 feed) (nth 3 feed))) + +;;;###autoload +(defun org-feed-show-raw-feed (feed) + "Show the raw feed buffer of a feed." + (interactive + (list (if (= (length org-feed-alist) 1) + (car org-feed-alist) + (org-completing-read "Feed name: " org-feed-alist)))) + (if (stringp feed) (setq feed (assoc feed org-feed-alist))) + (unless feed + (error "No such feed in `org-feed-alist")) + (org-pop-to-buffer-same-window + (org-feed-update feed 'retrieve-only)) + (goto-char (point-min))) + +(defun org-feed-goto-inbox-internal (file heading) + "Find or create HEADING in FILE. +Switch to that buffer, and return the position of that headline." + (find-file file) + (widen) + (goto-char (point-min)) + (if (re-search-forward + (concat "^\\*+[ \t]+" heading "[ \t]*\\(:.*?:[ \t]*\\)?$") + nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max)) + (insert "\n\n* " heading "\n\n") + (org-back-to-heading t)) + (point)) + +(defun org-feed-read-previous-status (pos drawer) + "Get the alist of old GUIDs from the entry at POS. +This will find DRAWER and extract the alist." + (save-excursion + (goto-char pos) + (let ((end (save-excursion (org-end-of-subtree t t)))) + (if (re-search-forward + (concat "^[ \t]*:" drawer ":[ \t]*\n\\([^\000]*?\\)\n[ \t]*:END:") + end t) + (read (match-string 1)) + nil)))) + +(defun org-feed-write-status (pos drawer status) + "Write the feed STATUS to DRAWER in entry at POS." + (save-excursion + (goto-char pos) + (let ((end (save-excursion (org-end-of-subtree t t))) + guid) + (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*\n") + end t) + (progn + (goto-char (match-end 0)) + (delete-region (point) + (save-excursion + (and (re-search-forward "^[ \t]*:END:" nil t) + (match-beginning 0))))) + (outline-next-heading) + (insert " :" drawer ":\n :END:\n") + (beginning-of-line 0)) + (insert (pp-to-string status))))) + +(defun org-feed-add-items (pos entries) + "Add the formatted items to the headline as POS." + (let (entry level) + (save-excursion + (goto-char pos) + (unless (looking-at org-complex-heading-regexp) + (error "Wrong position")) + (setq level (org-get-valid-level (length (match-string 1)) 1)) + (org-end-of-subtree t t) + (skip-chars-backward " \t\n") + (beginning-of-line 2) + (setq pos (point)) + (while (setq entry (pop entries)) + (org-paste-subtree level entry 'yank)) + (org-mark-ring-push pos)))) + +(defun org-feed-format-entry (entry template formatter) + "Format ENTRY so that it can be inserted into an Org file. +ENTRY is a property list. This function adds a `:formatted-for-org' property +and returns the full property list. +If that property is already present, nothing changes." + (require 'org-capture) + (if formatter + (funcall formatter entry) + (let (dlines time escape name tmp + v-h v-t v-T v-u v-U v-a) + (setq dlines (org-split-string (or (plist-get entry :description) "???") + "\n") + v-h (or (plist-get entry :title) (car dlines) "???") + time (or (if (plist-get entry :pubDate) + (org-read-date t t (plist-get entry :pubDate))) + (current-time)) + v-t (format-time-string (org-time-stamp-format nil nil) time) + v-T (format-time-string (org-time-stamp-format t nil) time) + v-u (format-time-string (org-time-stamp-format nil t) time) + v-U (format-time-string (org-time-stamp-format t t) time) + v-a (if (setq tmp (or (and (plist-get entry :guid-permalink) + (plist-get entry :guid)) + (plist-get entry :link))) + (concat "[[" tmp "]]\n") + "")) + (with-temp-buffer + (insert template) + + ;; Simple %-escapes + ;; before embedded elisp to support simple %-escapes as + ;; arguments for embedded elisp + (goto-char (point-min)) + (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t) + (unless (org-capture-escaped-%) + (setq name (match-string 1) + escape (org-capture-inside-embedded-elisp-p)) + (cond + ((member name '("h" "t" "T" "u" "U" "a")) + (setq tmp (symbol-value (intern (concat "v-" name))))) + ((setq tmp (plist-get entry (intern (concat ":" name)))) + (save-excursion + (save-match-data + (beginning-of-line 1) + (when (looking-at + (concat "^\\([ \t]*\\)%" name "[ \t]*$")) + (setq tmp (org-feed-make-indented-block + tmp (org-get-indentation)))))))) + (when tmp + ;; escape string delimiters `"' when inside %() embedded lisp + (when escape + (setq tmp (replace-regexp-in-string "\"" "\\\\\"" tmp))) + (replace-match tmp t t)))) + + ;; %() embedded elisp + (org-capture-expand-embedded-elisp) + + (decode-coding-string + (buffer-string) (detect-coding-region (point-min) (point-max) t)))))) + +(defun org-feed-make-indented-block (s n) + "Add indentation of N spaces to a multiline string S." + (if (not (string-match "\n" s)) + s + (mapconcat 'identity + (org-split-string s "\n") + (concat "\n" (make-string n ?\ ))))) + +(defun org-feed-skip-http-headers (buffer) + "Remove HTTP headers from BUFFER, and return it. +Assumes headers are indeed present!" + (with-current-buffer buffer + (widen) + (goto-char (point-min)) + (search-forward "\n\n") + (delete-region (point-min) (point)) + buffer)) + +(defun org-feed-get-feed (url) + "Get the RSS feed file at URL and return the buffer." + (cond + ((eq org-feed-retrieve-method 'url-retrieve-synchronously) + (org-feed-skip-http-headers (url-retrieve-synchronously url))) + ((eq org-feed-retrieve-method 'curl) + (ignore-errors (kill-buffer org-feed-buffer)) + (call-process "curl" nil org-feed-buffer nil "--silent" url) + org-feed-buffer) + ((eq org-feed-retrieve-method 'wget) + (ignore-errors (kill-buffer org-feed-buffer)) + (call-process "wget" nil org-feed-buffer nil "-q" "-O" "-" url) + org-feed-buffer) + ((functionp org-feed-retrieve-method) + (funcall org-feed-retrieve-method url)))) + +(defun org-feed-parse-rss-feed (buffer) + "Parse BUFFER for RSS feed entries. +Returns a list of entries, with each entry a property list, +containing the properties `:guid' and `:item-full-text'." + (let ((case-fold-search t) + entries beg end item guid entry) + (with-current-buffer buffer + (widen) + (goto-char (point-min)) + (while (re-search-forward "<item\\>.*?>" nil t) + (setq beg (point) + end (and (re-search-forward "</item>" nil t) + (match-beginning 0))) + (setq item (buffer-substring beg end) + guid (if (string-match "<guid\\>.*?>\\(.*?\\)</guid>" item) + (org-match-string-no-properties 1 item))) + (setq entry (list :guid guid :item-full-text item)) + (push entry entries) + (widen) + (goto-char end)) + (nreverse entries)))) + +(defun org-feed-parse-rss-entry (entry) + "Parse the `:item-full-text' field for xml tags and create new properties." + (require 'xml) + (with-temp-buffer + (insert (plist-get entry :item-full-text)) + (goto-char (point-min)) + (while (re-search-forward "<\\([a-zA-Z]+\\>\\).*?>\\([^\000]*?\\)</\\1>" + nil t) + (setq entry (plist-put entry + (intern (concat ":" (match-string 1))) + (xml-substitute-special (match-string 2))))) + (goto-char (point-min)) + (unless (re-search-forward "isPermaLink[ \t]*=[ \t]*\"false\"" nil t) + (setq entry (plist-put entry :guid-permalink t)))) + entry) + +(defun org-feed-parse-atom-feed (buffer) + "Parse BUFFER for Atom feed entries. +Returns a list of entries, with each entry a property list, +containing the properties `:guid' and `:item-full-text'. + +The `:item-full-text' property actually contains the sexp +formatted as a string, not the original XML data." + (require 'xml) + (with-current-buffer buffer + (widen) + (let ((feed (car (xml-parse-region (point-min) (point-max))))) + (mapcar + (lambda (entry) + (list + :guid (car (xml-node-children (car (xml-get-children entry 'id)))) + :item-full-text (prin1-to-string entry))) + (xml-get-children feed 'entry))))) + +(defun org-feed-parse-atom-entry (entry) + "Parse the `:item-full-text' as a sexp and create new properties." + (let ((xml (car (read-from-string (plist-get entry :item-full-text))))) + ;; Get first <link href='foo'/>. + (setq entry (plist-put entry :link + (xml-get-attribute + (car (xml-get-children xml 'link)) + 'href))) + ;; Add <title/> as :title. + (setq entry (plist-put entry :title + (xml-substitute-special + (car (xml-node-children + (car (xml-get-children xml 'title))))))) + (let* ((content (car (xml-get-children xml 'content))) + (type (xml-get-attribute-or-nil content 'type))) + (when content + (cond + ((string= type "text") + ;; We like plain text. + (setq entry (plist-put entry :description + (xml-substitute-special + (car (xml-node-children content)))))) + ((string= type "html") + ;; TODO: convert HTML to Org markup. + (setq entry (plist-put entry :description + (xml-substitute-special + (car (xml-node-children content)))))) + ((string= type "xhtml") + ;; TODO: convert XHTML to Org markup. + (setq entry (plist-put entry :description + (prin1-to-string + (xml-node-children content))))) + (t + (setq entry (plist-put entry :description + (format "Unknown '%s' content." type))))))) + entry)) + +(provide 'org-feed) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-feed.el ends here diff --git a/elpa/org-20150427/org-footnote.el b/elpa/org-20150427/org-footnote.el new file mode 100644 index 00000000..c8b8c2ea --- /dev/null +++ b/elpa/org-20150427/org-footnote.el @@ -0,0 +1,885 @@ +;;; org-footnote.el --- Footnote support in Org and elsewhere +;; +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: + +;; This file contains the code dealing with footnotes in Org-mode. +;; The code can also be used in arbitrary text modes to provide +;; footnotes. Compared to Steven L Baur's footnote.el it provides +;; better support for resuming editing. It is less configurable than +;; Steve's code, though. + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'org-macs) +(require 'org-compat) + +(declare-function message-point-in-header-p "message" ()) +(declare-function org-back-over-empty-lines "org" ()) +(declare-function org-back-to-heading "org" (&optional invisible-ok)) +(declare-function org-combine-plists "org" (&rest plists)) +(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) +(declare-function org-fill-paragraph "org" (&optional justify)) +(declare-function org-icompleting-read "org" (&rest args)) +(declare-function org-id-uuid "org-id" ()) +(declare-function org-in-block-p "org" (names)) +(declare-function org-in-commented-line "org" ()) +(declare-function org-in-indented-comment-line "org" ()) +(declare-function org-in-regexp "org" (re &optional nlines visually)) +(declare-function org-in-verbatim-emphasis "org" ()) +(declare-function org-inside-LaTeX-fragment-p "org" ()) +(declare-function org-inside-latex-macro-p "org" ()) +(declare-function org-mark-ring-push "org" (&optional pos buffer)) +(declare-function org-show-context "org" (&optional key)) +(declare-function org-trim "org" (s)) +(declare-function org-skip-whitespace "org" ()) +(declare-function outline-next-heading "outline") +(declare-function org-skip-whitespace "org" ()) + +(defvar org-outline-regexp-bol) ; defined in org.el +(defvar org-odd-levels-only) ; defined in org.el +(defvar org-bracket-link-regexp) ; defined in org.el +(defvar message-cite-prefix-regexp) ; defined in message.el +(defvar message-signature-separator) ; defined in message.el + +(defconst org-footnote-re + ;; Only [1]-like footnotes are closed in this regexp, as footnotes + ;; from other types might contain square brackets (i.e. links) in + ;; their definition. + ;; + ;; `org-re' is used for regexp compatibility with XEmacs. + (concat "\\[\\(?:" + ;; Match inline footnotes. + (org-re "fn:\\([-_[:word:]]+\\)?:\\|") + ;; Match other footnotes. + "\\(?:\\([0-9]+\\)\\]\\)\\|" + (org-re "\\(fn:[-_[:word:]]+\\)") + "\\)") + "Regular expression for matching footnotes.") + +(defconst org-footnote-definition-re + (org-re "^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]") + "Regular expression matching the definition of a footnote.") + +(defconst org-footnote-forbidden-blocks + '("ascii" "beamer" "comment" "example" "html" "latex" "odt" "src") + "Names of blocks where footnotes are not allowed.") + +(defgroup org-footnote nil + "Footnotes in Org-mode." + :tag "Org Footnote" + :group 'org) + +(defcustom org-footnote-section "Footnotes" + "Outline heading containing footnote definitions. + +This can be nil, to place footnotes locally at the end of the +current outline node. If can also be the name of a special +outline heading under which footnotes should be put. + +This variable defines the place where Org puts the definition +automatically, i.e. when creating the footnote, and when sorting +the notes. However, by hand you may place definitions +*anywhere*. + +If this is a string, during export, all subtrees starting with +this heading will be ignored." + :group 'org-footnote + :type '(choice + (string :tag "Collect footnotes under heading") + (const :tag "Define footnotes locally" nil))) + +(defcustom org-footnote-tag-for-non-org-mode-files "Footnotes:" + "Tag marking the beginning of footnote section. +The Org footnote engine can be used in arbitrary text files as well +as in Org-mode. Outside Org mode, new footnotes are always placed at +the end of the file. When you normalize the notes, any line containing +only this tag will be removed, a new one will be inserted at the end +of the file, followed by the collected and normalized footnotes. + +If you don't want any tag in such buffers, set this variable to nil." + :group 'org-footnote + :type '(choice + (string :tag "Collect footnotes under tag") + (const :tag "Don't use a tag" nil))) + +(defcustom org-footnote-define-inline nil + "Non-nil means define footnotes inline, at reference location. +When nil, footnotes will be defined in a special section near +the end of the document. When t, the [fn:label:definition] notation +will be used to define the footnote at the reference position." + :group 'org-footnote + :type 'boolean) + +(defcustom org-footnote-auto-label t + "Non-nil means define automatically new labels for footnotes. +Possible values are: + +nil Prompt the user for each label. +t Create unique labels of the form [fn:1], [fn:2], etc. +confirm Like t, but let the user edit the created value. + The label can be removed from the minibuffer to create + an anonymous footnote. +random Automatically generate a unique, random label. +plain Automatically create plain number labels like [1]." + :group 'org-footnote + :type '(choice + (const :tag "Prompt for label" nil) + (const :tag "Create automatic [fn:N]" t) + (const :tag "Offer automatic [fn:N] for editing" confirm) + (const :tag "Create a random label" random) + (const :tag "Create automatic [N]" plain))) + +(defcustom org-footnote-auto-adjust nil + "Non-nil means automatically adjust footnotes after insert/delete. +When this is t, after each insertion or deletion of a footnote, +simple fn:N footnotes will be renumbered, and all footnotes will be sorted. +If you want to have just sorting or just renumbering, set this variable +to `sort' or `renumber'. + +The main values of this variable can be set with in-buffer options: + +#+STARTUP: fnadjust +#+STARTUP: nofnadjust" + :group 'org-footnote + :type '(choice + (const :tag "No adjustment" nil) + (const :tag "Renumber" renumber) + (const :tag "Sort" sort) + (const :tag "Renumber and Sort" t))) + +(defcustom org-footnote-fill-after-inline-note-extraction nil + "Non-nil means fill paragraphs after extracting footnotes. +When extracting inline footnotes, the lengths of lines can change a lot. +When this option is set, paragraphs from which an inline footnote has been +extracted will be filled again." + :group 'org-footnote + :type 'boolean) + +(defun org-footnote-in-valid-context-p () + "Is point in a context where footnotes are allowed?" + (save-match-data + (not (or (org-in-commented-line) + (org-in-indented-comment-line) + (org-inside-LaTeX-fragment-p) + ;; Avoid literal example. + (org-in-verbatim-emphasis) + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*:[ \t]+")) + ;; Avoid cited text and headers in message-mode. + (and (derived-mode-p 'message-mode) + (or (save-excursion + (beginning-of-line) + (looking-at message-cite-prefix-regexp)) + (message-point-in-header-p))) + ;; Avoid forbidden blocks. + (org-in-block-p org-footnote-forbidden-blocks))))) + +(defun org-footnote-at-reference-p () + "Is the cursor at a footnote reference? + +If so, return a list containing its label, beginning and ending +positions, and the definition, when inlined." + (when (and (org-footnote-in-valid-context-p) + (or (looking-at org-footnote-re) + (org-in-regexp org-footnote-re) + (save-excursion (re-search-backward org-footnote-re nil t))) + (/= (match-beginning 0) (point-at-bol))) + (let* ((beg (match-beginning 0)) + (label (or (org-match-string-no-properties 2) + (org-match-string-no-properties 3) + ;; Anonymous footnotes don't have labels + (and (match-string 1) + (concat "fn:" (org-match-string-no-properties 1))))) + ;; Inline footnotes don't end at (match-end 0) as + ;; `org-footnote-re' stops just after the second colon. + ;; Find the real ending with `scan-sexps', so Org doesn't + ;; get fooled by unrelated closing square brackets. + (end (ignore-errors (scan-sexps beg 1)))) + ;; Point is really at a reference if it's located before true + ;; ending of the footnote. + (when (and end (< (point) end) + ;; Verify match isn't a part of a link. + (not (save-excursion + (goto-char beg) + (let ((linkp + (save-match-data + (org-in-regexp org-bracket-link-regexp)))) + (and linkp (< (point) (cdr linkp)))))) + ;; Verify point doesn't belong to a LaTeX macro. + (not (org-inside-latex-macro-p))) + (list label beg end + ;; Definition: ensure this is an inline footnote first. + (and (or (not label) (match-string 1)) + (org-trim (buffer-substring-no-properties + (match-end 0) (1- end))))))))) + +(defun org-footnote-at-definition-p () + "Is point within a footnote definition? + +This matches only pure definitions like [1] or [fn:name] at the +beginning of a line. It does not match references like +\[fn:name:definition], where the footnote text is included and +defined locally. + +The return value will be nil if not at a footnote definition, and +a list with label, start, end and definition of the footnote +otherwise." + (when (save-excursion (beginning-of-line) (org-footnote-in-valid-context-p)) + (save-excursion + (end-of-line) + ;; Footnotes definitions are separated by new headlines, another + ;; footnote definition or 2 blank lines. + (let ((lim (save-excursion + (re-search-backward + (concat org-outline-regexp-bol + "\\|^\\([ \t]*\n\\)\\{2,\\}") nil t)))) + (when (re-search-backward org-footnote-definition-re lim t) + (let ((label (org-match-string-no-properties 1)) + (beg (match-beginning 0)) + (beg-def (match-end 0)) + ;; In message-mode, do not search after signature. + (end (let ((bound (and (derived-mode-p 'message-mode) + (save-excursion + (goto-char (point-max)) + (re-search-backward + message-signature-separator nil t))))) + (if (progn + (end-of-line) + (re-search-forward + (concat org-outline-regexp-bol "\\|" + org-footnote-definition-re "\\|" + "^\\([ \t]*\n\\)\\{2,\\}") bound 'move)) + (match-beginning 0) + (point))))) + (list label beg end + (org-trim (buffer-substring-no-properties beg-def end))))))))) + +(defun org-footnote-get-next-reference (&optional label backward limit) + "Return complete reference of the next footnote. + +If LABEL is provided, get the next reference of that footnote. If +BACKWARD is non-nil, find previous reference instead. LIMIT is +the buffer position bounding the search. + +Return value is a list like those provided by `org-footnote-at-reference-p'. +If no footnote is found, return nil." + (save-excursion + (let* ((label-fmt (if label (format "\\[%s[]:]" label) org-footnote-re))) + (catch 'exit + (while t + (unless (funcall (if backward #'re-search-backward #'re-search-forward) + label-fmt limit t) + (throw 'exit nil)) + (unless backward (backward-char)) + (let ((ref (org-footnote-at-reference-p))) + (when ref (throw 'exit ref)))))))) + +(defun org-footnote-next-reference-or-definition (limit) + "Move point to next footnote reference or definition. + +LIMIT is the buffer position bounding the search. + +Return value is a list like those provided by +`org-footnote-at-reference-p' or `org-footnote-at-definition-p'. +If no footnote is found, return nil." + (let* (ref (origin (point))) + (catch 'exit + (while t + (unless (re-search-forward org-footnote-re limit t) + (goto-char origin) + (throw 'exit nil)) + ;; Beware: with [1]-like footnotes point will be just after + ;; the closing square bracket. + (backward-char) + (cond + ((setq ref (org-footnote-at-reference-p)) + (throw 'exit ref)) + ;; Definition: also grab the last square bracket, only + ;; matched in `org-footnote-re' for [1]-like footnotes. + ((save-match-data (org-footnote-at-definition-p)) + (let ((end (match-end 0))) + (throw 'exit + (list nil (match-beginning 0) + (if (eq (char-before end) 93) end (1+ end))))))))))) + +(defun org-footnote-get-definition (label) + "Return label, boundaries and definition of the footnote LABEL." + (let* ((label (regexp-quote (org-footnote-normalize-label label))) + (re (format "^\\[%s\\]\\|.\\[%s:" label label)) + pos) + (save-excursion + (save-restriction + (when (or (re-search-forward re nil t) + (and (goto-char (point-min)) + (re-search-forward re nil t)) + (and (progn (widen) t) + (goto-char (point-min)) + (re-search-forward re nil t))) + (let ((refp (org-footnote-at-reference-p))) + (cond + ((and (nth 3 refp) refp)) + ((org-footnote-at-definition-p))))))))) + +(defun org-footnote-goto-definition (label) + "Move point to the definition of the footnote LABEL. +Return a non-nil value when a definition has been found." + (interactive "sLabel: ") + (org-mark-ring-push) + (let ((def (org-footnote-get-definition label))) + (if (not def) + (error "Cannot find definition of footnote %s" label) + (goto-char (nth 1 def)) + (looking-at (format "\\[%s\\]\\|\\[%s:" label label)) + (goto-char (match-end 0)) + (org-show-context 'link-search) + (when (derived-mode-p 'org-mode) + (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")) + t))) + +(defun org-footnote-goto-previous-reference (label) + "Find the first closest (to point) reference of footnote with label LABEL." + (interactive "sLabel: ") + (org-mark-ring-push) + (let* ((label (org-footnote-normalize-label label)) ref) + (save-excursion + (setq ref (or (org-footnote-get-next-reference label t) + (org-footnote-get-next-reference label) + (save-restriction + (widen) + (or + (org-footnote-get-next-reference label t) + (org-footnote-get-next-reference label)))))) + (if (not ref) + (error "Cannot find reference of footnote %s" label) + (goto-char (nth 1 ref)) + (org-show-context 'link-search)))) + +(defun org-footnote-normalize-label (label) + "Return LABEL as an appropriate string." + (cond + ((numberp label) (number-to-string label)) + ((equal "" label) nil) + ((not (string-match "^[0-9]+$\\|^fn:" label)) + (concat "fn:" label)) + (t label))) + +(defun org-footnote-all-labels (&optional with-defs) + "Return list with all defined foot labels used in the buffer. + +If WITH-DEFS is non-nil, also associate the definition to each +label. The function will then return an alist whose key is label +and value definition." + (let* (rtn + (push-to-rtn + (function + ;; Depending on WITH-DEFS, store label or (label . def) of + ;; footnote reference/definition given as argument in RTN. + (lambda (el) + (let ((lbl (car el))) + (push (if with-defs (cons lbl (nth 3 el)) lbl) rtn)))))) + (save-excursion + (save-restriction + (widen) + ;; Find all labels found in definitions. + (goto-char (point-min)) + (let (def) + (while (re-search-forward org-footnote-definition-re nil t) + (when (setq def (org-footnote-at-definition-p)) + (funcall push-to-rtn def)))) + ;; Find all labels found in references. + (goto-char (point-min)) + (let (ref) + (while (setq ref (org-footnote-get-next-reference)) + (goto-char (nth 2 ref)) + (and (car ref) ; ignore anonymous footnotes + (not (funcall (if with-defs #'assoc #'member) (car ref) rtn)) + (funcall push-to-rtn ref)))))) + rtn)) + +(defun org-footnote-unique-label (&optional current) + "Return a new unique footnote label. + +The function returns the first \"fn:N\" or \"N\" label that is +currently not used. + +Optional argument CURRENT is the list of labels active in the +buffer." + (unless current (setq current (org-footnote-all-labels))) + (let ((fmt (if (eq org-footnote-auto-label 'plain) "%d" "fn:%d")) + (cnt 1)) + (while (member (format fmt cnt) current) + (incf cnt)) + (format fmt cnt))) + +(defun org-footnote-new () + "Insert a new footnote. +This command prompts for a label. If this is a label referencing an +existing label, only insert the label. If the footnote label is empty +or new, let the user edit the definition of the footnote." + (interactive) + (unless (org-footnote-in-valid-context-p) + (error "Cannot insert a footnote here")) + (let* ((lbls (and (not (equal org-footnote-auto-label 'random)) + (org-footnote-all-labels))) + (propose (and (not (equal org-footnote-auto-label 'random)) + (org-footnote-unique-label lbls))) + (label + (org-footnote-normalize-label + (cond + ((member org-footnote-auto-label '(t plain)) + propose) + ((equal org-footnote-auto-label 'random) + (require 'org-id) + (substring (org-id-uuid) 0 8)) + (t + (org-icompleting-read + "Label (leave empty for anonymous): " + (mapcar 'list lbls) nil nil + (if (eq org-footnote-auto-label 'confirm) propose nil))))))) + (cond + ((bolp) (error "Cannot create a footnote reference at left margin")) + ((not label) + (insert "[fn:: ]") + (backward-char 1)) + ((member label lbls) + (insert "[" label "]") + (message "New reference to existing note")) + (org-footnote-define-inline + (insert "[" label ": ]") + (backward-char 1) + (org-footnote-auto-adjust-maybe)) + (t + (insert "[" label "]") + (org-footnote-create-definition label) + (org-footnote-auto-adjust-maybe))))) + +(defvar org-blank-before-new-entry) ; silence byte-compiler +(defun org-footnote-create-definition (label) + "Start the definition of a footnote with label LABEL." + (interactive "sLabel: ") + (let ((label (org-footnote-normalize-label label)) + electric-indent-mode) ;; Prevent wrong indentation + (cond + ;; In an Org file. + ((derived-mode-p 'org-mode) + ;; If `org-footnote-section' is defined, find it, or create it + ;; at the end of the buffer. + (when org-footnote-section + (goto-char (point-min)) + (let ((re (concat "^\\*+[ \t]+" org-footnote-section "[ \t]*$"))) + (unless (or (re-search-forward re nil t) + (and (progn (widen) t) + (re-search-forward re nil t))) + (goto-char (point-max)) + (skip-chars-backward " \t\r\n") + (unless (bolp) (newline)) + ;; Insert new section. Separate it from the previous one + ;; with a blank line, unless `org-blank-before-new-entry' + ;; explicitly says no. + (when (and (cdr (assq 'heading org-blank-before-new-entry)) + (zerop (save-excursion (org-back-over-empty-lines)))) + (insert "\n")) + (insert "* " org-footnote-section "\n")))) + ;; Move to the end of this entry (which may be + ;; `org-footnote-section' or the current one). + (org-footnote-goto-local-insertion-point) + (org-show-context 'link-search)) + (t + ;; In a non-Org file. Search for footnote tag, or create it if + ;; specified (at the end of buffer, or before signature if in + ;; Message mode). Set point after any definition already there. + (let ((tag (and org-footnote-tag-for-non-org-mode-files + (concat "^" (regexp-quote + org-footnote-tag-for-non-org-mode-files) + "[ \t]*$"))) + (max (if (and (derived-mode-p 'message-mode) + (goto-char (point-max)) + (re-search-backward + message-signature-separator nil t)) + (progn + ;; Ensure one blank line separates last + ;; footnote from signature. + (beginning-of-line) + (open-line 2) + (point-marker)) + (point-max-marker)))) + (set-marker-insertion-type max t) + (goto-char max) + ;; Check if the footnote tag is defined but missing. In this + ;; case, insert it, before any footnote or one blank line + ;; after any previous text. + (when (and tag (not (re-search-backward tag nil t))) + (skip-chars-backward " \t\r\n") + (while (re-search-backward org-footnote-definition-re nil t)) + (unless (bolp) (newline 2)) + (insert org-footnote-tag-for-non-org-mode-files "\n\n")) + ;; Remove superfluous white space and clear marker. + (goto-char max) + (skip-chars-backward " \t\r\n") + (delete-region (point) max) + (unless (bolp) (newline)) + (set-marker max nil)))) + ;; Insert footnote label. + (when (zerop (org-back-over-empty-lines)) (newline)) + (insert "[" label "] \n") + (backward-char) + ;; Only notify user about next possible action when in an Org + ;; buffer, as the bindings may have different meanings otherwise. + (when (derived-mode-p 'org-mode) + (message + "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))) + +;;;###autoload +(defun org-footnote-action (&optional special) + "Do the right thing for footnotes. + +When at a footnote reference, jump to the definition. + +When at a definition, jump to the references if they exist, offer +to create them otherwise. + +When neither at definition or reference, create a new footnote, +interactively. + +With prefix arg SPECIAL, offer additional commands in a menu." + (interactive "P") + (let (tmp c) + (cond + (special + (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s |->[n]umeric | [d]elete") + (setq c (read-char-exclusive)) + (cond + ((eq c ?s) (org-footnote-normalize 'sort)) + ((eq c ?r) (org-footnote-renumber-fn:N)) + ((eq c ?S) + (org-footnote-renumber-fn:N) + (org-footnote-normalize 'sort)) + ((eq c ?n) (org-footnote-normalize)) + ((eq c ?d) (org-footnote-delete)) + (t (error "No such footnote command %c" c)))) + ((setq tmp (org-footnote-at-reference-p)) + (cond + ;; Anonymous footnote: move point at the beginning of its + ;; definition. + ((not (car tmp)) + (goto-char (nth 1 tmp)) + (forward-char 5)) + ;; A definition exists: move to it. + ((ignore-errors (org-footnote-goto-definition (car tmp)))) + ;; No definition exists: offer to create it. + ((yes-or-no-p (format "No definition for %s. Create one? " (car tmp))) + (org-footnote-create-definition (car tmp))))) + ((setq tmp (org-footnote-at-definition-p)) + (org-footnote-goto-previous-reference (car tmp))) + (t (org-footnote-new))))) + +;;;###autoload +(defun org-footnote-normalize (&optional sort-only) + "Collect the footnotes in various formats and normalize them. + +This finds the different sorts of footnotes allowed in Org, and +normalizes them to the usual [N] format. + +When SORT-ONLY is set, only sort the footnote definitions into the +referenced sequence." + ;; This is based on Paul's function, but rewritten. + ;; + ;; Re-create `org-with-limited-levels', but not limited to Org + ;; buffers. + (let* ((limit-level + (and (boundp 'org-inlinetask-min-level) + org-inlinetask-min-level + (1- org-inlinetask-min-level))) + (nstars (and limit-level + (if org-odd-levels-only (1- (* limit-level 2)) + limit-level))) + (org-outline-regexp + (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))) + (count 0) + ins-point ref ref-table) + (save-excursion + ;; 1. Find every footnote reference, extract the definition, and + ;; collect that data in REF-TABLE. If SORT-ONLY is nil, also + ;; normalize references. + (goto-char (point-min)) + (while (setq ref (org-footnote-get-next-reference)) + (let* ((lbl (car ref)) + (pos (nth 1 ref)) + ;; When footnote isn't anonymous, check if it's label + ;; (REF) is already stored in REF-TABLE. In that case, + ;; extract number used to identify it (MARKER). If + ;; footnote is unknown, increment the global counter + ;; (COUNT) to create an unused identifier. + (a (and lbl (assoc lbl ref-table))) + (marker (or (nth 1 a) (incf count))) + ;; Is the reference inline or pointing to an inline + ;; footnote? + (inlinep (or (stringp (nth 3 ref)) (nth 3 a)))) + ;; Replace footnote reference with [MARKER]. Maybe fill + ;; paragraph once done. If SORT-ONLY is non-nil, only move + ;; to the end of reference found to avoid matching it twice. + (if sort-only (goto-char (nth 2 ref)) + (delete-region (nth 1 ref) (nth 2 ref)) + (goto-char (nth 1 ref)) + (insert (format "[%d]" marker)) + (and inlinep + org-footnote-fill-after-inline-note-extraction + (org-fill-paragraph))) + ;; Add label (REF), identifier (MARKER), definition (DEF) + ;; type (INLINEP) and position (POS) to REF-TABLE if data + ;; was unknown. + (unless a + (let ((def (or (nth 3 ref) ; Inline definition. + (nth 3 (org-footnote-get-definition lbl))))) + (push (list lbl marker def + ;; Reference beginning position is a marker + ;; to preserve it during further buffer + ;; modifications. + inlinep (copy-marker pos)) ref-table))))) + ;; 2. Find and remove the footnote section, if any. Also + ;; determine where footnotes shall be inserted (INS-POINT). + (cond + ((and org-footnote-section (derived-mode-p 'org-mode)) + (goto-char (point-min)) + (if (re-search-forward + (concat "^\\*[ \t]+" (regexp-quote org-footnote-section) + "[ \t]*$") nil t) + (delete-region (match-beginning 0) (org-end-of-subtree t t))) + ;; A new footnote section is inserted by default at the end of + ;; the buffer. + (goto-char (point-max)) + (skip-chars-backward " \r\t\n") + (forward-line) + (unless (bolp) (newline))) + ;; No footnote section set: Footnotes will be added at the end + ;; of the section containing their first reference. + ((derived-mode-p 'org-mode)) + (t + ;; Remove any left-over tag in the buffer, if one is set up. + (when org-footnote-tag-for-non-org-mode-files + (let ((tag (concat "^" (regexp-quote + org-footnote-tag-for-non-org-mode-files) + "[ \t]*$"))) + (goto-char (point-min)) + (while (re-search-forward tag nil t) + (replace-match "") + (delete-region (point) (progn (forward-line) (point)))))) + ;; In Message mode, ensure footnotes are inserted before the + ;; signature. + (if (and (derived-mode-p 'message-mode) + (goto-char (point-max)) + (re-search-backward message-signature-separator nil t)) + (beginning-of-line) + (goto-char (point-max))))) + (setq ins-point (point-marker)) + ;; 3. Clean-up REF-TABLE. + (setq ref-table + (delq nil + (mapcar + (lambda (x) + (cond + ;; When only sorting, ignore inline footnotes. + ;; Also clear position marker. + ((and sort-only (nth 3 x)) + (set-marker (nth 4 x) nil) nil) + ;; No definition available: provide one. + ((not (nth 2 x)) + (append + (list (car x) (nth 1 x) + (format "DEFINITION NOT FOUND: %s" (car x))) + (nthcdr 3 x))) + (t x))) + ref-table))) + (setq ref-table (nreverse ref-table)) + ;; 4. Remove left-over definitions in the buffer. + (mapc (lambda (x) + (unless (nth 3 x) (org-footnote-delete-definitions (car x)))) + ref-table) + ;; 5. Insert the footnotes again in the buffer, at the + ;; appropriate spot. + (goto-char ins-point) + (cond + ;; No footnote: exit. + ((not ref-table)) + ;; Cases when footnotes should be inserted in one place. + ((or (not (derived-mode-p 'org-mode)) org-footnote-section) + ;; Insert again the section title, if any. Ensure that title, + ;; or the subsequent footnotes, will be separated by a blank + ;; lines from the rest of the document. In an Org buffer, + ;; separate section with a blank line, unless explicitly + ;; stated in `org-blank-before-new-entry'. + (if (not (derived-mode-p 'org-mode)) + (progn (skip-chars-backward " \t\n\r") + (delete-region (point) ins-point) + (unless (bolp) (newline)) + (when org-footnote-tag-for-non-org-mode-files + (insert "\n" org-footnote-tag-for-non-org-mode-files "\n"))) + (when (and (cdr (assq 'heading org-blank-before-new-entry)) + (zerop (save-excursion (org-back-over-empty-lines)))) + (insert "\n")) + (insert "* " org-footnote-section "\n")) + (set-marker ins-point nil) + ;; Insert the footnotes, separated by a blank line. + (insert + (mapconcat + (lambda (x) + ;; Clean markers. + (set-marker (nth 4 x) nil) + (format "\n[%s] %s" (nth (if sort-only 0 1) x) (nth 2 x))) + ref-table "\n")) + (unless (eobp) (insert "\n\n"))) + ;; Each footnote definition has to be inserted at the end of + ;; the section where its first reference belongs. + (t + (mapc + (lambda (x) + (let ((pos (nth 4 x))) + (goto-char pos) + ;; Clean marker. + (set-marker pos nil)) + (org-footnote-goto-local-insertion-point) + (insert (format "\n[%s] %s\n" + (if sort-only (car x) (nth 1 x)) + (nth 2 x)))) + ref-table)))))) + +(defun org-footnote-goto-local-insertion-point () + "Find insertion point for footnote, just before next outline heading." + (org-with-limited-levels (outline-next-heading)) + (or (bolp) (newline)) + (beginning-of-line 0) + (while (and (not (bobp)) (= (char-after) ?#)) + (beginning-of-line 0)) + (if (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) (beginning-of-line 2)) + (end-of-line 1) + (skip-chars-backward "\n\r\t ") + (forward-line)) + +(defun org-footnote-delete-references (label) + "Delete every reference to footnote LABEL. +Return the number of footnotes removed." + (save-excursion + (goto-char (point-min)) + (let (ref (nref 0)) + (while (setq ref (org-footnote-get-next-reference label)) + (goto-char (nth 1 ref)) + (delete-region (nth 1 ref) (nth 2 ref)) + (incf nref)) + nref))) + +(defun org-footnote-delete-definitions (label) + "Delete every definition of the footnote LABEL. +Return the number of footnotes removed." + (save-excursion + (goto-char (point-min)) + (let ((def-re (concat "^\\[" (regexp-quote label) "\\]")) + (ndef 0)) + (while (re-search-forward def-re nil t) + (let ((full-def (org-footnote-at-definition-p))) + (when full-def + ;; Remove the footnote, and all blank lines before it. + (goto-char (nth 1 full-def)) + (skip-chars-backward " \r\t\n") + (unless (bolp) (forward-line)) + (delete-region (point) (nth 2 full-def)) + (incf ndef)))) + ndef))) + +(defun org-footnote-delete (&optional label) + "Delete the footnote at point. +This will remove the definition (even multiple definitions if they exist) +and all references of a footnote label. + +If LABEL is non-nil, delete that footnote instead." + (catch 'done + (let* ((nref 0) (ndef 0) x + ;; 1. Determine LABEL of footnote at point. + (label (cond + ;; LABEL is provided as argument. + (label) + ;; Footnote reference at point. If the footnote is + ;; anonymous, delete it and exit instead. + ((setq x (org-footnote-at-reference-p)) + (or (car x) + (progn + (delete-region (nth 1 x) (nth 2 x)) + (message "Anonymous footnote removed") + (throw 'done t)))) + ;; Footnote definition at point. + ((setq x (org-footnote-at-definition-p)) + (car x)) + (t (error "Don't know which footnote to remove"))))) + ;; 2. Now that LABEL is non-nil, find every reference and every + ;; definition, and delete them. + (setq nref (org-footnote-delete-references label) + ndef (org-footnote-delete-definitions label)) + ;; 3. Verify consistency of footnotes and notify user. + (org-footnote-auto-adjust-maybe) + (message "%d definition(s) of and %d reference(s) of footnote %s removed" + ndef nref label)))) + +(defun org-footnote-renumber-fn:N () + "Renumber the simple footnotes like fn:17 into a sequence in the document." + (interactive) + (let (map (n 0)) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward "\\[fn:\\([0-9]+\\)[]:]" nil t) + (save-excursion + (goto-char (match-beginning 0)) + ;; Ensure match is a footnote reference or definition. + (when (save-match-data (if (bolp) + (org-footnote-at-definition-p) + (org-footnote-at-reference-p))) + (let ((new-val (or (cdr (assoc (match-string 1) map)) + (number-to-string (incf n))))) + (unless (assoc (match-string 1) map) + (push (cons (match-string 1) new-val) map)) + (replace-match new-val nil nil nil 1)))))))) + +(defun org-footnote-auto-adjust-maybe () + "Renumber and/or sort footnotes according to user settings." + (when (memq org-footnote-auto-adjust '(t renumber)) + (org-footnote-renumber-fn:N)) + (when (memq org-footnote-auto-adjust '(t sort)) + (let ((label (car (org-footnote-at-definition-p)))) + (org-footnote-normalize 'sort) + (when label + (goto-char (point-min)) + (and (re-search-forward (concat "^\\[" (regexp-quote label) "\\]") + nil t) + (progn (insert " ") + (just-one-space))))))) + +(provide 'org-footnote) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-footnote.el ends here diff --git a/elpa/org-20150427/org-gnus.el b/elpa/org-20150427/org-gnus.el new file mode 100644 index 00000000..785b577f --- /dev/null +++ b/elpa/org-20150427/org-gnus.el @@ -0,0 +1,300 @@ +;;; org-gnus.el --- Support for links to Gnus groups and messages from within Org-mode + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Tassilo Horn <tassilo at member dot fsf dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: + +;; This file implements links to Gnus groups and messages from within Org-mode. +;; Org-mode loads this module by default - if this is not what you want, +;; configure the variable `org-modules'. + +;;; Code: + +(require 'org) +(require 'gnus-util) +(eval-when-compile (require 'gnus-sum)) + +;; Declare external functions and variables +(declare-function message-fetch-field "message" (header &optional not-all)) +(declare-function message-narrow-to-head-1 "message" nil) +(declare-function nnimap-group-overview-filename "nnimap" (group server)) +;; The following line suppresses a compiler warning stemming from gnus-sum.el +(declare-function gnus-summary-last-subject "gnus-sum" nil) +;; Customization variables + +(org-defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links) + +(defcustom org-gnus-prefer-web-links nil + "If non-nil, `org-store-link' creates web links to Google groups or Gmane. +When nil, Gnus will be used for such links. +Using a prefix arg to the command \\[org-store-link] (`org-store-link') +negates this setting for the duration of the command." + :group 'org-link-store + :type 'boolean) + +(defcustom org-gnus-nnimap-query-article-no-from-file nil + "If non-nil, `org-gnus-follow-link' will try to translate +Message-Ids to article numbers by querying the .overview file. +Normally, this translation is done by querying the IMAP server, +which is usually very fast. Unfortunately, some (maybe badly +configured) IMAP servers don't support this operation quickly. +So if following a link to a Gnus article takes ages, try setting +this variable to `t'." + :group 'org-link-store + :version "24.1" + :type 'boolean) + +(defcustom org-gnus-no-server nil + "Should Gnus be started using `gnus-no-server'?" + :group 'org-gnus + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +;; Install the link type +(org-add-link-type "gnus" 'org-gnus-open) +(add-hook 'org-store-link-functions 'org-gnus-store-link) + +;; Implementation + +(defun org-gnus-nnimap-cached-article-number (group server message-id) + "Return cached article number (uid) of message in GROUP on SERVER. +MESSAGE-ID is the message-id header field that identifies the +message. If the uid is not cached, return nil." + (with-temp-buffer + (let ((nov (nnimap-group-overview-filename group server))) + (when (file-exists-p nov) + (mm-insert-file-contents nov) + (set-buffer-modified-p nil) + (goto-char (point-min)) + (catch 'found + (while (search-forward message-id nil t) + (let ((hdr (split-string (thing-at-point 'line) "\t"))) + (if (string= (nth 4 hdr) message-id) + (throw 'found (nth 0 hdr)))))))))) + +(defun org-gnus-group-link (group) + "Create a link to the Gnus group GROUP. +If GROUP is a newsgroup and `org-gnus-prefer-web-links' is +non-nil, create a link to groups.google.com or gmane.org. +Otherwise create a link to the group inside Gnus. + +If `org-store-link' was called with a prefix arg the meaning of +`org-gnus-prefer-web-links' is reversed." + (let ((unprefixed-group (replace-regexp-in-string "^[^:]+:" "" group))) + (if (and (string-match "^nntp" group) ;; Only for nntp groups + (org-xor current-prefix-arg + org-gnus-prefer-web-links)) + (concat (if (string-match "gmane" unprefixed-group) + "http://news.gmane.org/" + "http://groups.google.com/group/") + unprefixed-group) + (concat "gnus:" group)))) + +(defun org-gnus-article-link (group newsgroups message-id x-no-archive) + "Create a link to a Gnus article. +The article is specified by its MESSAGE-ID. Additional +parameters are the Gnus GROUP, the NEWSGROUPS the article was +posted to and the X-NO-ARCHIVE header value of that article. + +If GROUP is a newsgroup and `org-gnus-prefer-web-links' is +non-nil, create a link to groups.google.com or gmane.org. +Otherwise create a link to the article inside Gnus. + +If `org-store-link' was called with a prefix arg the meaning of +`org-gnus-prefer-web-links' is reversed." + (if (and (org-xor current-prefix-arg org-gnus-prefer-web-links) + newsgroups ;; Make web links only for nntp groups + (not x-no-archive)) ;; and if X-No-Archive isn't set. + (format (if (string-match "gmane\\." newsgroups) + "http://mid.gmane.org/%s" + "http://groups.google.com/groups/search?as_umsgid=%s") + (org-fixup-message-id-for-http message-id)) + (concat "gnus:" group "#" message-id))) + +(defun org-gnus-store-link () + "Store a link to a Gnus folder or message." + (cond + ((eq major-mode 'gnus-group-mode) + (let* ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus + (gnus-group-group-name)) ; version + ((fboundp 'gnus-group-name) + (gnus-group-name)) + (t "???"))) + desc link) + (when group + (org-store-link-props :type "gnus" :group group) + (setq desc (org-gnus-group-link group) + link desc) + (org-add-link-props :link link :description desc) + link))) + + ((memq major-mode '(gnus-summary-mode gnus-article-mode)) + (let* ((group gnus-newsgroup-name) + (header (with-current-buffer gnus-summary-buffer + (gnus-summary-article-header))) + (from (mail-header-from header)) + (message-id (org-remove-angle-brackets (mail-header-id header))) + (date (org-trim (mail-header-date header))) + (date-ts (and date + (ignore-errors + (format-time-string + (org-time-stamp-format t) + (date-to-time date))))) + (date-ts-ia (and date + (ignore-errors + (format-time-string + (org-time-stamp-format t t) + (date-to-time date))))) + (subject (copy-sequence (mail-header-subject header))) + (to (cdr (assq 'To (mail-header-extra header)))) + newsgroups x-no-archive desc link) + ;; Remove text properties of subject string to avoid Emacs bug + ;; #3506 + (set-text-properties 0 (length subject) nil subject) + + ;; Fetching an article is an expensive operation; newsgroup and + ;; x-no-archive are only needed for web links. + (when (org-xor current-prefix-arg org-gnus-prefer-web-links) + ;; Make sure the original article buffer is up-to-date + (save-window-excursion (gnus-summary-select-article)) + (setq to (or to (gnus-fetch-original-field "To")) + newsgroups (gnus-fetch-original-field "Newsgroups") + x-no-archive (gnus-fetch-original-field "x-no-archive"))) + (org-store-link-props :type "gnus" :from from :subject subject + :message-id message-id :group group :to to) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) + (setq desc (org-email-link-description) + link (org-gnus-article-link + group newsgroups message-id x-no-archive)) + (org-add-link-props :link link :description desc) + link)) + ((eq major-mode 'message-mode) + (setq org-store-link-plist nil) ; reset + (save-excursion + (save-restriction + (message-narrow-to-headers) + (and (not (message-fetch-field "Message-ID")) + (message-generate-headers '(Message-ID))) + (goto-char (point-min)) + (re-search-forward "^Message-ID: *.*$" nil t) + (put-text-property (match-beginning 0) (match-end 0) 'message-deletable nil) + (let ((gcc (car (last + (message-unquote-tokens + (message-tokenize-header (mail-fetch-field "gcc" nil t) " ,"))))) + (id (org-remove-angle-brackets (mail-fetch-field "Message-ID"))) + (to (mail-fetch-field "To")) + (from (mail-fetch-field "From")) + (subject (mail-fetch-field "Subject")) + desc link + newsgroup xarchive) ; those are always nil for gcc + (and (not gcc) + (error "Can not create link: No Gcc header found")) + (org-store-link-props :type "gnus" :from from :subject subject + :message-id id :group gcc :to to) + (setq desc (org-email-link-description) + link (org-gnus-article-link + gcc newsgroup id xarchive)) + (org-add-link-props :link link :description desc) + link)))))) + +(defun org-gnus-open-nntp (path) + "Follow the nntp: link specified by PATH." + (let* ((spec (split-string path "/")) + (server (split-string (nth 2 spec) "@")) + (group (nth 3 spec)) + (article (nth 4 spec))) + (org-gnus-follow-link + (format "nntp+%s:%s" (or (cdr server) (car server)) group) + article))) + +(defun org-gnus-open (path) + "Follow the Gnus message or folder link specified by PATH." + (let (group article) + (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) + (error "Error in Gnus link")) + (setq group (match-string 1 path) + article (match-string 3 path)) + (when group + (setq group (org-no-properties group))) + (when article + (setq article (org-no-properties article))) + (org-gnus-follow-link group article))) + +(defun org-gnus-follow-link (&optional group article) + "Follow a Gnus link to GROUP and ARTICLE." + (require 'gnus) + (funcall (cdr (assq 'gnus org-link-frame-setup))) + (if gnus-other-frame-object (select-frame gnus-other-frame-object)) + (when group + (setq group (org-no-properties group))) + (when article + (setq article (org-no-properties article))) + (cond ((and group article) + (gnus-activate-group group) + (condition-case nil + (let* ((method (gnus-find-method-for-group group)) + (backend (car method)) + (server (cadr method))) + (cond + ((eq backend 'nndoc) + (if (gnus-group-read-group t nil group) + (gnus-summary-goto-article article nil t) + (message "Couldn't follow gnus link. %s" + "The summary couldn't be opened."))) + (t + (let ((articles 1) + group-opened) + (when (and (eq backend 'nnimap) + org-gnus-nnimap-query-article-no-from-file) + (setq article + (or (org-gnus-nnimap-cached-article-number + (nth 1 (split-string group ":")) + server (concat "<" article ">")) article))) + (while (and (not group-opened) + ;; stop on integer overflows + (> articles 0)) + (setq group-opened (gnus-group-read-group + articles t group) + articles (if (< articles 16) + (1+ articles) + (* articles 2)))) + (if group-opened + (gnus-summary-goto-article article nil t) + (message "Couldn't follow gnus link. %s" + "The summary couldn't be opened.")))))) + (quit (message "Couldn't follow gnus link. %s" + "The linked group is empty.")))) + (group (gnus-group-jump-to-group group)))) + +(defun org-gnus-no-new-news () + "Like `M-x gnus' but doesn't check for new news." + (if (not (gnus-alive-p)) (if org-gnus-no-server (gnus-no-server) (gnus)))) + +(provide 'org-gnus) + + +;;; org-gnus.el ends here diff --git a/elpa/org-20150427/org-habit.el b/elpa/org-20150427/org-habit.el new file mode 100644 index 00000000..60137568 --- /dev/null +++ b/elpa/org-20150427/org-habit.el @@ -0,0 +1,386 @@ +;;; org-habit.el --- The habit tracking code for Org-mode + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. + +;; Author: John Wiegley <johnw at gnu dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: + +;; This file contains the habit tracking code for Org-mode + +;;; Code: + +(require 'org) +(require 'org-agenda) + +(eval-when-compile + (require 'cl)) + +(defgroup org-habit nil + "Options concerning habit tracking in Org-mode." + :tag "Org Habit" + :group 'org-progress) + +(defcustom org-habit-graph-column 40 + "The absolute column at which to insert habit consistency graphs. +Note that consistency graphs will overwrite anything else in the buffer." + :group 'org-habit + :type 'integer) + +(defcustom org-habit-preceding-days 21 + "Number of days before today to appear in consistency graphs." + :group 'org-habit + :type 'integer) + +(defcustom org-habit-following-days 7 + "Number of days after today to appear in consistency graphs." + :group 'org-habit + :type 'integer) + +(defcustom org-habit-show-habits t + "If non-nil, show habits in agenda buffers." + :group 'org-habit + :type 'boolean) + +(defcustom org-habit-show-habits-only-for-today t + "If non-nil, only show habits on today's agenda, and not for future days. +Note that even when shown for future days, the graph is always +relative to the current effective date." + :group 'org-habit + :type 'boolean) + +(defcustom org-habit-show-all-today nil + "If non-nil, will show the consistency graph of all habits on +today's agenda, even if they are not scheduled." + :group 'org-habit + :type 'boolean) + +(defcustom org-habit-today-glyph ?! + "Glyph character used to identify today." + :group 'org-habit + :version "24.1" + :type 'character) + +(defcustom org-habit-completed-glyph ?* + "Glyph character used to show completed days on which a task was done." + :group 'org-habit + :version "24.1" + :type 'character) + +(defcustom org-habit-show-done-always-green nil + "Non-nil means DONE days will always be green in the consistency graph. +It will be green even if it was done after the deadline." + :group 'org-habit + :type 'boolean) + +(defface org-habit-clear-face + '((((background light)) (:background "#8270f9")) + (((background dark)) (:background "blue"))) + "Face for days on which a task shouldn't be done yet." + :group 'org-habit + :group 'org-faces) +(defface org-habit-clear-future-face + '((((background light)) (:background "#d6e4fc")) + (((background dark)) (:background "midnightblue"))) + "Face for future days on which a task shouldn't be done yet." + :group 'org-habit + :group 'org-faces) + +(defface org-habit-ready-face + '((((background light)) (:background "#4df946")) + (((background dark)) (:background "forestgreen"))) + "Face for days on which a task should start to be done." + :group 'org-habit + :group 'org-faces) +(defface org-habit-ready-future-face + '((((background light)) (:background "#acfca9")) + (((background dark)) (:background "darkgreen"))) + "Face for days on which a task should start to be done." + :group 'org-habit + :group 'org-faces) + +(defface org-habit-alert-face + '((((background light)) (:background "#f5f946")) + (((background dark)) (:background "gold"))) + "Face for days on which a task is due." + :group 'org-habit + :group 'org-faces) +(defface org-habit-alert-future-face + '((((background light)) (:background "#fafca9")) + (((background dark)) (:background "darkgoldenrod"))) + "Face for days on which a task is due." + :group 'org-habit + :group 'org-faces) + +(defface org-habit-overdue-face + '((((background light)) (:background "#f9372d")) + (((background dark)) (:background "firebrick"))) + "Face for days on which a task is overdue." + :group 'org-habit + :group 'org-faces) +(defface org-habit-overdue-future-face + '((((background light)) (:background "#fc9590")) + (((background dark)) (:background "darkred"))) + "Face for days on which a task is overdue." + :group 'org-habit + :group 'org-faces) + +(defun org-habit-duration-to-days (ts) + (if (string-match "\\([0-9]+\\)\\([dwmy]\\)" ts) + ;; lead time is specified. + (floor (* (string-to-number (match-string 1 ts)) + (cdr (assoc (match-string 2 ts) + '(("d" . 1) ("w" . 7) + ("m" . 30.4) ("y" . 365.25)))))) + (error "Invalid duration string: %s" ts))) + +(defun org-is-habit-p (&optional pom) + "Is the task at POM or point a habit?" + (string= "habit" (org-entry-get (or pom (point)) "STYLE"))) + +(defun org-habit-parse-todo (&optional pom) + "Parse the TODO surrounding point for its habit-related data. +Returns a list with the following elements: + + 0: Scheduled date for the habit (may be in the past) + 1: \".+\"-style repeater for the schedule, in days + 2: Optional deadline (nil if not present) + 3: If deadline, the repeater for the deadline, otherwise nil + 4: A list of all the past dates this todo was mark closed + +This list represents a \"habit\" for the rest of this module." + (save-excursion + (if pom (goto-char pom)) + (assert (org-is-habit-p (point))) + (let* ((scheduled (org-get-scheduled-time (point))) + (scheduled-repeat (org-get-repeat org-scheduled-string)) + (end (org-entry-end-position)) + (habit-entry (org-no-properties (nth 4 (org-heading-components)))) + closed-dates deadline dr-days sr-days) + (if scheduled + (setq scheduled (time-to-days scheduled)) + (error "Habit %s has no scheduled date" habit-entry)) + (unless scheduled-repeat + (error + "Habit '%s' has no scheduled repeat period or has an incorrect one" + habit-entry)) + (setq sr-days (org-habit-duration-to-days scheduled-repeat)) + (unless (> sr-days 0) + (error "Habit %s scheduled repeat period is less than 1d" habit-entry)) + (when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat) + (setq dr-days (org-habit-duration-to-days + (match-string-no-properties 1 scheduled-repeat))) + (if (<= dr-days sr-days) + (error "Habit %s deadline repeat period is less than or equal to scheduled (%s)" + habit-entry scheduled-repeat)) + (setq deadline (+ scheduled (- dr-days sr-days)))) + (org-back-to-heading t) + (let* ((maxdays (+ org-habit-preceding-days org-habit-following-days)) + (reversed org-log-states-order-reversed) + (search (if reversed 're-search-forward 're-search-backward)) + (limit (if reversed end (point))) + (count 0)) + (unless reversed (goto-char end)) + (while (and (< count maxdays) + (funcall search (format "- State \"%s\".*\\[\\([^]]+\\)\\]" + (regexp-opt org-done-keywords)) + limit t)) + (push (time-to-days + (org-time-string-to-time (match-string-no-properties 1))) + closed-dates) + (setq count (1+ count)))) + (list scheduled sr-days deadline dr-days closed-dates)))) + +(defsubst org-habit-scheduled (habit) + (nth 0 habit)) +(defsubst org-habit-scheduled-repeat (habit) + (nth 1 habit)) +(defsubst org-habit-deadline (habit) + (let ((deadline (nth 2 habit))) + (or deadline + (if (nth 3 habit) + (+ (org-habit-scheduled habit) + (1- (org-habit-scheduled-repeat habit))) + (org-habit-scheduled habit))))) +(defsubst org-habit-deadline-repeat (habit) + (or (nth 3 habit) + (org-habit-scheduled-repeat habit))) +(defsubst org-habit-done-dates (habit) + (nth 4 habit)) + +(defsubst org-habit-get-priority (habit &optional moment) + "Determine the relative priority of a habit. +This must take into account not just urgency, but consistency as well." + (let ((pri 1000) + (now (if moment (time-to-days moment) (org-today))) + (scheduled (org-habit-scheduled habit)) + (deadline (org-habit-deadline habit))) + ;; add 10 for every day past the scheduled date, and subtract for every + ;; day before it + (setq pri (+ pri (* (- now scheduled) 10))) + ;; add 50 if the deadline is today + (if (and (/= scheduled deadline) + (= now deadline)) + (setq pri (+ pri 50))) + ;; add 100 for every day beyond the deadline date, and subtract 10 for + ;; every day before it + (let ((slip (- now (1- deadline)))) + (if (> slip 0) + (setq pri (+ pri (* slip 100))) + (setq pri (+ pri (* slip 10))))) + pri)) + +(defun org-habit-get-faces (habit &optional now-days scheduled-days donep) + "Return faces for HABIT relative to NOW-DAYS and SCHEDULED-DAYS. +NOW-DAYS defaults to the current time's days-past-the-epoch if nil. +SCHEDULED-DAYS defaults to the habit's actual scheduled days if nil. + +Habits are assigned colors on the following basis: + Blue Task is before the scheduled date. + Green Task is on or after scheduled date, but before the + end of the schedule's repeat period. + Yellow If the task has a deadline, then it is after schedule's + repeat period, but before the deadline. + Orange The task has reached the deadline day, or if there is + no deadline, the end of the schedule's repeat period. + Red The task has gone beyond the deadline day or the + schedule's repeat period." + (let* ((scheduled (or scheduled-days (org-habit-scheduled habit))) + (s-repeat (org-habit-scheduled-repeat habit)) + (scheduled-end (+ scheduled (1- s-repeat))) + (d-repeat (org-habit-deadline-repeat habit)) + (deadline (if scheduled-days + (+ scheduled-days (- d-repeat s-repeat)) + (org-habit-deadline habit))) + (m-days (or now-days (time-to-days (current-time))))) + (cond + ((< m-days scheduled) + '(org-habit-clear-face . org-habit-clear-future-face)) + ((< m-days deadline) + '(org-habit-ready-face . org-habit-ready-future-face)) + ((= m-days deadline) + (if donep + '(org-habit-ready-face . org-habit-ready-future-face) + '(org-habit-alert-face . org-habit-alert-future-face))) + ((and org-habit-show-done-always-green donep) + '(org-habit-ready-face . org-habit-ready-future-face)) + (t '(org-habit-overdue-face . org-habit-overdue-future-face))))) + +(defun org-habit-build-graph (habit starting current ending) + "Build a graph for the given HABIT, from STARTING to ENDING. +CURRENT gives the current time between STARTING and ENDING, for +the purpose of drawing the graph. It need not be the actual +current time." + (let* ((done-dates (sort (org-habit-done-dates habit) '<)) + (scheduled (org-habit-scheduled habit)) + (s-repeat (org-habit-scheduled-repeat habit)) + (start (time-to-days starting)) + (now (time-to-days current)) + (end (time-to-days ending)) + (graph (make-string (1+ (- end start)) ?\ )) + (index 0) + last-done-date) + (while (and done-dates (< (car done-dates) start)) + (setq last-done-date (car done-dates) + done-dates (cdr done-dates))) + (while (< start end) + (let* ((in-the-past-p (< start now)) + (todayp (= start now)) + (donep (and done-dates + (= start (car done-dates)))) + (faces (if (and in-the-past-p + (not last-done-date) + (not (< scheduled now))) + '(org-habit-clear-face . org-habit-clear-future-face) + (org-habit-get-faces + habit start (and in-the-past-p + (if last-done-date + (+ last-done-date s-repeat) + scheduled)) + donep))) + markedp face) + (if donep + (let ((done-time (time-add + starting + (days-to-time + (- start (time-to-days starting)))))) + + (aset graph index org-habit-completed-glyph) + (setq markedp t) + (put-text-property + index (1+ index) 'help-echo + (format-time-string (org-time-stamp-format) done-time) graph) + (while (and done-dates + (= start (car done-dates))) + (setq last-done-date (car done-dates) + done-dates (cdr done-dates)))) + (if todayp + (aset graph index org-habit-today-glyph))) + (setq face (if (or in-the-past-p todayp) + (car faces) + (cdr faces))) + (if (and in-the-past-p + (not (eq face 'org-habit-overdue-face)) + (not markedp)) + (setq face (cdr faces))) + (put-text-property index (1+ index) 'face face graph)) + (setq start (1+ start) + index (1+ index))) + graph)) + +(defun org-habit-insert-consistency-graphs (&optional line) + "Insert consistency graph for any habitual tasks." + (let ((inhibit-read-only t) l c + (buffer-invisibility-spec '(org-link)) + (moment (time-subtract (current-time) + (list 0 (* 3600 org-extend-today-until) 0)))) + (save-excursion + (goto-char (if line (point-at-bol) (point-min))) + (while (not (eobp)) + (let ((habit (get-text-property (point) 'org-habit-p))) + (when habit + (move-to-column org-habit-graph-column t) + (delete-char (min (+ 1 org-habit-preceding-days + org-habit-following-days) + (- (line-end-position) (point)))) + (insert-before-markers + (org-habit-build-graph + habit + (time-subtract moment (days-to-time org-habit-preceding-days)) + moment + (time-add moment (days-to-time org-habit-following-days)))))) + (forward-line))))) + +(defun org-habit-toggle-habits () + "Toggle display of habits in an agenda buffer." + (interactive) + (org-agenda-check-type t 'agenda) + (setq org-habit-show-habits (not org-habit-show-habits)) + (org-agenda-redo) + (org-agenda-set-mode-name) + (message "Habits turned %s" + (if org-habit-show-habits "on" "off"))) + +(org-defkey org-agenda-mode-map "K" 'org-habit-toggle-habits) + +(provide 'org-habit) + +;;; org-habit.el ends here diff --git a/elpa/org-20150427/org-id.el b/elpa/org-20150427/org-id.el new file mode 100644 index 00000000..fdd0ff00 --- /dev/null +++ b/elpa/org-20150427/org-id.el @@ -0,0 +1,689 @@ +;;; org-id.el --- Global identifiers for Org-mode entries +;; +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: + +;; This file implements globally unique identifiers for Org-mode entries. +;; Identifiers are stored in the entry as an :ID: property. Functions +;; are provided that create and retrieve such identifiers, and that find +;; entries based on the identifier. + +;; Identifiers consist of a prefix (default "Org" given by the variable +;; `org-id-prefix') and a unique part that can be created by a number +;; of different methods, see the variable `org-id-method'. +;; Org has a builtin method that uses a compact encoding of the creation +;; time of the ID, with microsecond accuracy. This virtually +;; guarantees globally unique identifiers, even if several people are +;; creating IDs at the same time in files that will eventually be used +;; together. +;; +;; By default Org uses UUIDs as global unique identifiers. +;; +;; This file defines the following API: +;; +;; org-id-get-create +;; Create an ID for the entry at point if it does not yet have one. +;; Returns the ID (old or new). This function can be used +;; interactively, with prefix argument the creation of a new ID is +;; forced, even if there was an old one. +;; +;; org-id-get +;; Get the ID property of an entry. Using appropriate arguments +;; to the function, it can also create the ID for this entry. +;; +;; org-id-goto +;; Command to go to a specific ID, this command can be used +;; interactively. +;; +;; org-id-get-with-outline-path-completion +;; Retrieve the ID of an entry, using outline path completion. +;; This function can work for multiple files. +;; +;; org-id-get-with-outline-drilling +;; Retrieve the ID of an entry, using outline path completion. +;; This function only works for the current file. +;; +;; org-id-find +;; Find the location of an entry with specific id. +;; + +;;; Code: + +(require 'org) + +(declare-function message-make-fqdn "message" ()) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) + +;;; Customization + +(defgroup org-id nil + "Options concerning global entry identifiers in Org-mode." + :tag "Org ID" + :group 'org) + +(define-obsolete-variable-alias + 'org-link-to-org-use-id 'org-id-link-to-org-use-id "24.3") +(defcustom org-id-link-to-org-use-id nil + "Non-nil means storing a link to an Org file will use entry IDs. + +The variable can have the following values: + +t Create an ID if needed to make a link to the current entry. + +create-if-interactive + If `org-store-link' is called directly (interactively, as a user + command), do create an ID to support the link. But when doing the + job for capture, only use the ID if it already exists. The + purpose of this setting is to avoid proliferation of unwanted + IDs, just because you happen to be in an Org file when you + call `org-capture' that automatically and preemptively creates a + link. If you do want to get an ID link in a capture template to + an entry not having an ID, create it first by explicitly creating + a link to it, using `C-c C-l' first. + +create-if-interactive-and-no-custom-id + Like create-if-interactive, but do not create an ID if there is + a CUSTOM_ID property defined in the entry. + +use-existing + Use existing ID, do not create one. + +nil Never use an ID to make a link, instead link using a text search for + the headline text." + :group 'org-link-store + :group 'org-id + :version "24.3" + :type '(choice + (const :tag "Create ID to make link" t) + (const :tag "Create if storing link interactively" + create-if-interactive) + (const :tag "Create if storing link interactively and no CUSTOM_ID is present" + create-if-interactive-and-no-custom-id) + (const :tag "Only use existing" use-existing) + (const :tag "Do not use ID to create link" nil))) + +(defcustom org-id-uuid-program "uuidgen" + "The uuidgen program." + :group 'org-id + :type 'string) + +(defcustom org-id-method 'uuid + "The method that should be used to create new IDs. + +An ID will consist of the optional prefix specified in `org-id-prefix', +and a unique part created by the method this variable specifies. + +Allowed values are: + +org Org's own internal method, using an encoding of the current time to + microsecond accuracy, and optionally the current domain of the + computer. See the variable `org-id-include-domain'. + +uuid Create random (version 4) UUIDs. If the program defined in + `org-id-uuid-program' is available it is used to create the ID. + Otherwise an internal functions is used." + :group 'org-id + :type '(choice + (const :tag "Org's internal method" org) + (const :tag "external: uuidgen" uuid))) + +(defcustom org-id-prefix nil + "The prefix for IDs. + +This may be a string, or it can be nil to indicate that no prefix is required. +When a string, the string should have no space characters as IDs are expected +to have no space characters in them." + :group 'org-id + :type '(choice + (const :tag "No prefix") + (string :tag "Prefix"))) + +(defcustom org-id-include-domain nil + "Non-nil means add the domain name to new IDs. +This ensures global uniqueness of IDs, and is also suggested by +RFC 2445 in combination with RFC 822. This is only relevant if +`org-id-method' is `org'. When uuidgen is used, the domain will never +be added. +The default is to not use this because we have no really good way to get +the true domain, and Org entries will normally not be shared with enough +people to make this necessary." + :group 'org-id + :type 'boolean) + +(defcustom org-id-track-globally t + "Non-nil means track IDs through files, so that links work globally. +This work by maintaining a hash table for IDs and writing this table +to disk when exiting Emacs. Because of this, it works best if you use +a single Emacs process, not many. + +When nil, IDs are not tracked. Links to IDs will still work within +a buffer, but not if the entry is located in another file. +IDs can still be used if the entry with the id is in the same file as +the link." + :group 'org-id + :type 'boolean) + +(defcustom org-id-locations-file (convert-standard-filename + (concat user-emacs-directory ".org-id-locations")) + "The file for remembering in which file an ID was defined. +This variable is only relevant when `org-id-track-globally' is set." + :group 'org-id + :type 'file) + +(defvar org-id-locations nil + "List of files with IDs in those files.") + +(defvar org-id-files nil + "List of files that contain IDs.") + +(defcustom org-id-extra-files 'org-agenda-text-search-extra-files + "Files to be searched for IDs, besides the agenda files. +When Org reparses files to remake the list of files and IDs it is tracking, +it will normally scan the agenda files, the archives related to agenda files, +any files that are listed as ID containing in the current register, and +any Org-mode files currently visited by Emacs. +You can list additional files here. +This variable is only relevant when `org-id-track-globally' is set." + :group 'org-id + :type + '(choice + (symbol :tag "Variable") + (repeat :tag "List of files" + (file)))) + +(defcustom org-id-search-archives t + "Non-nil means search also the archive files of agenda files for entries. +This is a possibility to reduce overhead, but it means that entries moved +to the archives can no longer be found by ID. +This variable is only relevant when `org-id-track-globally' is set." + :group 'org-id + :type 'boolean) + +;;; The API functions + +;;;###autoload +(defun org-id-get-create (&optional force) + "Create an ID for the current entry and return it. +If the entry already has an ID, just return it. +With optional argument FORCE, force the creation of a new ID." + (interactive "P") + (when force + (org-entry-put (point) "ID" nil)) + (org-id-get (point) 'create)) + +;;;###autoload +(defun org-id-copy () + "Copy the ID of the entry at point to the kill ring. +Create an ID if necessary." + (interactive) + (org-kill-new (org-id-get nil 'create))) + +;;;###autoload +(defun org-id-get (&optional pom create prefix) + "Get the ID property of the entry at point-or-marker POM. +If POM is nil, refer to the entry at point. +If the entry does not have an ID, the function returns nil. +However, when CREATE is non nil, create an ID if none is present already. +PREFIX will be passed through to `org-id-new'. +In any case, the ID of the entry is returned." + (org-with-point-at pom + (let ((id (org-entry-get nil "ID"))) + (cond + ((and id (stringp id) (string-match "\\S-" id)) + id) + (create + (setq id (org-id-new prefix)) + (org-entry-put pom "ID" id) + (org-id-add-location id (buffer-file-name (buffer-base-buffer))) + id))))) + +;;;###autoload +(defun org-id-get-with-outline-path-completion (&optional targets) + "Use `outline-path-completion' to retrieve the ID of an entry. +TARGETS may be a setting for `org-refile-targets' to define +eligible headlines. When omitted, all headlines in the current +file are eligible. This function returns the ID of the entry. +If necessary, the ID is created." + (let* ((org-refile-targets (or targets '((nil . (:maxlevel . 10))))) + (org-refile-use-outline-path + (if (caar org-refile-targets) 'file t)) + (org-refile-target-verify-function nil) + (spos (org-refile-get-location "Entry")) + (pom (and spos (move-marker (make-marker) (nth 3 spos) + (get-file-buffer (nth 1 spos)))))) + (prog1 (org-id-get pom 'create) + (move-marker pom nil)))) + +;;;###autoload +(defun org-id-get-with-outline-drilling (&optional targets) + "Use an outline-cycling interface to retrieve the ID of an entry. +This only finds entries in the current buffer, using `org-get-location'. +It returns the ID of the entry. If necessary, the ID is created." + (let* ((spos (org-get-location (current-buffer) org-goto-help)) + (pom (and spos (move-marker (make-marker) (car spos))))) + (prog1 (org-id-get pom 'create) + (move-marker pom nil)))) + +;;;###autoload +(defun org-id-goto (id) + "Switch to the buffer containing the entry with id ID. +Move the cursor to that entry in that buffer." + (interactive "sID: ") + (let ((m (org-id-find id 'marker))) + (unless m + (error "Cannot find entry with ID \"%s\"" id)) + (org-pop-to-buffer-same-window (marker-buffer m)) + (goto-char m) + (move-marker m nil) + (org-show-context))) + +;;;###autoload +(defun org-id-find (id &optional markerp) + "Return the location of the entry with the id ID. +The return value is a cons cell (file-name . position), or nil +if there is no entry with that ID. +With optional argument MARKERP, return the position as a new marker." + (cond + ((symbolp id) (setq id (symbol-name id))) + ((numberp id) (setq id (number-to-string id)))) + (let ((file (org-id-find-id-file id)) + org-agenda-new-buffers where) + (when file + (setq where (org-id-find-id-in-file id file markerp))) + (unless where + (org-id-update-id-locations nil t) + (setq file (org-id-find-id-file id)) + (when file + (setq where (org-id-find-id-in-file id file markerp)))) + where)) + +;;; Internal functions + +;; Creating new IDs + +;;;###autoload +(defun org-id-new (&optional prefix) + "Create a new globally unique ID. + +An ID consists of two parts separated by a colon: +- a prefix +- a unique part that will be created according to `org-id-method'. + +PREFIX can specify the prefix, the default is given by the variable +`org-id-prefix'. However, if PREFIX is the symbol `none', don't use any +prefix even if `org-id-prefix' specifies one. + +So a typical ID could look like \"Org:4nd91V40HI\"." + (let* ((prefix (if (eq prefix 'none) + "" + (concat (or prefix org-id-prefix) ":"))) + unique) + (if (equal prefix ":") (setq prefix "")) + (cond + ((memq org-id-method '(uuidgen uuid)) + (setq unique (org-trim (shell-command-to-string org-id-uuid-program))) + (unless (org-uuidgen-p unique) + (setq unique (org-id-uuid)))) + ((eq org-id-method 'org) + (let* ((etime (org-reverse-string (org-id-time-to-b36))) + (postfix (if org-id-include-domain + (progn + (require 'message) + (concat "@" (message-make-fqdn)))))) + (setq unique (concat etime postfix)))) + (t (error "Invalid `org-id-method'"))) + (concat prefix unique))) + +(defun org-id-uuid () + "Return string with random (version 4) UUID." + (let ((rnd (md5 (format "%s%s%s%s%s%s%s" + (random) + (current-time) + (user-uid) + (emacs-pid) + (user-full-name) + user-mail-address + (recent-keys))))) + (format "%s-%s-4%s-%s%s-%s" + (substring rnd 0 8) + (substring rnd 8 12) + (substring rnd 13 16) + (format "%x" + (logior + #b10000000 + (logand + #b10111111 + (string-to-number + (substring rnd 16 18) 16)))) + (substring rnd 18 20) + (substring rnd 20 32)))) + +(defun org-id-int-to-b36-one-digit (i) + "Turn an integer between 0 and 61 into a single character 0..9, A..Z, a..z." + (cond + ((< i 10) (+ ?0 i)) + ((< i 36) (+ ?a i -10)) + (t (error "Larger that 35")))) + +(defun org-id-b36-to-int-one-digit (i) + "Turn a character 0..9, A..Z, a..z into a number 0..61. +The input I may be a character, or a single-letter string." + (and (stringp i) (setq i (string-to-char i))) + (cond + ((and (>= i ?0) (<= i ?9)) (- i ?0)) + ((and (>= i ?a) (<= i ?z)) (+ (- i ?a) 10)) + (t (error "Invalid b36 letter")))) + +(defun org-id-int-to-b36 (i &optional length) + "Convert an integer to a base-36 number represented as a string." + (let ((s "")) + (while (> i 0) + (setq s (concat (char-to-string + (org-id-int-to-b36-one-digit (mod i 36))) s) + i (/ i 36))) + (setq length (max 1 (or length 1))) + (if (< (length s) length) + (setq s (concat (make-string (- length (length s)) ?0) s))) + s)) + +(defun org-id-b36-to-int (s) + "Convert a base-36 string into the corresponding integer." + (let ((r 0)) + (mapc (lambda (i) (setq r (+ (* r 36) (org-id-b36-to-int-one-digit i)))) + s) + r)) + +(defun org-id-time-to-b36 (&optional time) + "Encode TIME as a 10-digit string. +This string holds the time to micro-second accuracy, and can be decoded +using `org-id-decode'." + (setq time (or time (current-time))) + (concat (org-id-int-to-b36 (nth 0 time) 4) + (org-id-int-to-b36 (nth 1 time) 4) + (org-id-int-to-b36 (or (nth 2 time) 0) 4))) + +(defun org-id-decode (id) + "Split ID into the prefix and the time value that was used to create it. +The return value is (prefix . time) where PREFIX is nil or a string, +and time is the usual three-integer representation of time." + (let (prefix time parts) + (setq parts (org-split-string id ":")) + (if (= 2 (length parts)) + (setq prefix (car parts) time (nth 1 parts)) + (setq prefix nil time (nth 0 parts))) + (setq time (org-reverse-string time)) + (setq time (list (org-id-b36-to-int (substring time 0 4)) + (org-id-b36-to-int (substring time 4 8)) + (org-id-b36-to-int (substring time 8 12)))) + (cons prefix time))) + +;; Storing ID locations (files) + +;;;###autoload +(defun org-id-update-id-locations (&optional files silent) + "Scan relevant files for IDs. +Store the relation between files and corresponding IDs. +This will scan all agenda files, all associated archives, and all +files currently mentioned in `org-id-locations'. +When FILES is given, scan these files instead. +When CHECK is given, prepare detailed information about duplicate IDs." + (interactive) + (if (not org-id-track-globally) + (error "Please turn on `org-id-track-globally' if you want to track IDs") + (let* ((org-id-search-archives + (or org-id-search-archives + (and (symbolp org-id-extra-files) + (symbol-value org-id-extra-files) + (member 'agenda-archives org-id-extra-files)))) + (files + (or files + (append + ;; Agenda files and all associated archives + (org-agenda-files t org-id-search-archives) + ;; Explicit extra files + (if (symbolp org-id-extra-files) + (symbol-value org-id-extra-files) + org-id-extra-files) + ;; Files associated with live org-mode buffers + (delq nil + (mapcar (lambda (b) + (with-current-buffer b + (and (derived-mode-p 'org-mode) (buffer-file-name)))) + (buffer-list))) + ;; All files known to have IDs + org-id-files))) + org-agenda-new-buffers + file nfiles tfile ids reg found id seen (ndup 0)) + (when (member 'agenda-archives files) + (setq files (delq 'agenda-archives (copy-sequence files)))) + (setq nfiles (length files)) + (while (setq file (pop files)) + (unless silent + (message "Finding ID locations (%d/%d files): %s" + (- nfiles (length files)) nfiles file)) + (setq tfile (file-truename file)) + (when (and (file-exists-p file) (not (member tfile seen))) + (push tfile seen) + (setq ids nil) + (with-current-buffer (org-get-agenda-file-buffer file) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)[ \t]*$" + nil t) + (setq id (org-match-string-no-properties 1)) + (if (member id found) + (progn + (message "Duplicate ID \"%s\", also in file %s" + id (or (car (delq + nil + (mapcar + (lambda (x) + (if (member id (cdr x)) + (car x))) + reg))) + (buffer-file-name))) + (when (= ndup 0) + (ding) + (sit-for 2)) + (setq ndup (1+ ndup))) + (push id found) + (push id ids))) + (push (cons (abbreviate-file-name file) ids) reg)))))) + (org-release-buffers org-agenda-new-buffers) + (setq org-agenda-new-buffers nil) + (setq org-id-locations reg) + (setq org-id-files (mapcar 'car org-id-locations)) + (org-id-locations-save) ;; this function can also handle the alist form + ;; now convert to a hash + (setq org-id-locations (org-id-alist-to-hash org-id-locations)) + (if (> ndup 0) + (message "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup) + (message "%d unique files scanned for IDs" (length org-id-files))) + org-id-locations))) + +(defun org-id-locations-save () + "Save `org-id-locations' in `org-id-locations-file'." + (when (and org-id-track-globally org-id-locations) + (let ((out (if (hash-table-p org-id-locations) + (org-id-hash-to-alist org-id-locations) + org-id-locations))) + (with-temp-file org-id-locations-file + (let ((print-level nil) + (print-length nil)) + (print out (current-buffer))))))) + +(defun org-id-locations-load () + "Read the data from `org-id-locations-file'." + (setq org-id-locations nil) + (when org-id-track-globally + (with-temp-buffer + (condition-case nil + (progn + (insert-file-contents-literally org-id-locations-file) + (goto-char (point-min)) + (setq org-id-locations (read (current-buffer)))) + (error + (message "Could not read org-id-values from %s. Setting it to nil." + org-id-locations-file)))) + (setq org-id-files (mapcar 'car org-id-locations)) + (setq org-id-locations (org-id-alist-to-hash org-id-locations)))) + +(defun org-id-add-location (id file) + "Add the ID with location FILE to the database of ID locations." + ;; Only if global tracking is on, and when the buffer has a file + (when (and org-id-track-globally id file) + (unless org-id-locations (org-id-locations-load)) + (puthash id (abbreviate-file-name file) org-id-locations) + (add-to-list 'org-id-files (abbreviate-file-name file)))) + +(unless noninteractive + (add-hook 'kill-emacs-hook 'org-id-locations-save)) + +(defun org-id-hash-to-alist (hash) + "Turn an org-id hash into an alist, so that it can be written to a file." + (let (res x) + (maphash + (lambda (k v) + (if (setq x (member v res)) + (setcdr x (cons k (cdr x))) + (push (list v k) res))) + hash) + res)) + +(defun org-id-alist-to-hash (list) + "Turn an org-id location list into a hash table." + (let ((res (make-hash-table + :test 'equal + :size (apply '+ (mapcar 'length list)))) + f) + (mapc + (lambda (x) + (setq f (car x)) + (mapc (lambda (i) (puthash i f res)) (cdr x))) + list) + res)) + +(defun org-id-paste-tracker (txt &optional buffer-or-file) + "Update any IDs in TXT and assign BUFFER-OR-FILE to them." + (when org-id-track-globally + (save-match-data + (setq buffer-or-file (or buffer-or-file (current-buffer))) + (when (bufferp buffer-or-file) + (setq buffer-or-file (or (buffer-base-buffer buffer-or-file) + buffer-or-file)) + (setq buffer-or-file (buffer-file-name buffer-or-file))) + (when buffer-or-file + (let ((fname (abbreviate-file-name buffer-or-file)) + (s 0)) + (while (string-match "^[ \t]*:ID:[ \t]+\\([^ \t\n\r]+\\)" txt s) + (setq s (match-end 0)) + (org-id-add-location (match-string 1 txt) fname))))))) + +;; Finding entries with specified id + +;;;###autoload +(defun org-id-find-id-file (id) + "Query the id database for the file in which this ID is located." + (unless org-id-locations (org-id-locations-load)) + (or (and org-id-locations + (hash-table-p org-id-locations) + (gethash id org-id-locations)) + ;; ball back on current buffer + (buffer-file-name (or (buffer-base-buffer (current-buffer)) + (current-buffer))))) + +(defun org-id-find-id-in-file (id file &optional markerp) + "Return the position of the entry ID in FILE. +If that files does not exist, or if it does not contain this ID, +return nil. +The position is returned as a cons cell (file-name . position). With +optional argument MARKERP, return the position as a new marker." + (let (org-agenda-new-buffers buf pos) + (cond + ((not file) nil) + ((not (file-exists-p file)) nil) + (t (with-current-buffer (setq buf (org-get-agenda-file-buffer file)) + (setq pos (org-find-entry-with-id id)) + (when pos + (if markerp + (move-marker (make-marker) pos buf) + (cons file pos)))))))) + +;; id link type + +;; Calling the following function is hard-coded into `org-store-link', +;; so we do have to add it to `org-store-link-functions'. + +;;;###autoload +(defun org-id-store-link () + "Store a link to the current entry, using its ID." + (interactive) + (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) + (let* ((link (concat "id:" (org-id-get-create))) + (case-fold-search nil) + (desc (save-excursion + (org-back-to-heading t) + (or (and (looking-at org-complex-heading-regexp) + (if (match-end 4) + (match-string 4) + (match-string 0))) + link)))) + (org-store-link-props :link link :description desc :type "id") + link))) + +(defun org-id-open (id) + "Go to the entry with id ID." + (org-mark-ring-push) + (let ((m (org-id-find id 'marker)) + cmd) + (unless m + (error "Cannot find entry with ID \"%s\"" id)) + ;; Use a buffer-switching command in analogy to finding files + (setq cmd + (or + (cdr + (assq + (cdr (assq 'file org-link-frame-setup)) + '((find-file . switch-to-buffer) + (find-file-other-window . switch-to-buffer-other-window) + (find-file-other-frame . switch-to-buffer-other-frame)))) + 'switch-to-buffer-other-window)) + (if (not (equal (current-buffer) (marker-buffer m))) + (funcall cmd (marker-buffer m))) + (goto-char m) + (move-marker m nil) + (org-show-context))) + +(org-add-link-type "id" 'org-id-open) + +(provide 'org-id) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-id.el ends here diff --git a/elpa/org-20150427/org-indent.el b/elpa/org-20150427/org-indent.el new file mode 100644 index 00000000..fa5f0608 --- /dev/null +++ b/elpa/org-20150427/org-indent.el @@ -0,0 +1,437 @@ +;;; org-indent.el --- Dynamic indentation for Org-mode +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: + +;; This is an implementation of dynamic virtual indentation. It works +;; by adding text properties to a buffer to make sure lines are +;; indented according to outline structure. +;; +;; The process is synchronous, toggled at every buffer modification. +;; Though, the initialization (indentation of text already in the +;; buffer), which can take a few seconds in large buffers, happens on +;; idle time. +;; +;;; Code: + +(require 'org-macs) +(require 'org-compat) +(require 'org) + +(eval-when-compile + (require 'cl)) + +(declare-function org-inlinetask-get-task-level "org-inlinetask" ()) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-list-item-body-column "org-list" (item)) +(defvar org-inlinetask-show-first-star) + +(defgroup org-indent nil + "Options concerning dynamic virtual outline indentation." + :tag "Org Indent" + :group 'org) + +(defconst org-indent-max 40 + "Maximum indentation in characters.") +(defconst org-indent-max-levels 20 + "Maximum added level through virtual indentation, in characters. + +It is computed by multiplying `org-indent-indentation-per-level' +minus one by actual level of the headline minus one.") + +(defvar org-indent-strings nil + "Vector with all indentation strings. +It will be set in `org-indent-initialize'.") +(defvar org-indent-stars nil + "Vector with all indentation star strings. +It will be set in `org-indent-initialize'.") +(defvar org-indent-inlinetask-first-star (org-add-props "*" '(face org-warning)) + "First star of inline tasks, with correct face.") +(defvar org-indent-agent-timer nil + "Timer running the initialize agent.") +(defvar org-indent-agentized-buffers nil + "List of buffers watched by the initialize agent.") +(defvar org-indent-agent-resume-timer nil + "Timer to reschedule agent after switching to other idle processes.") +(defvar org-indent-agent-active-delay '(0 2 0) + "Time to run agent before switching to other idle processes. +Delay used when the buffer to initialize is current.") +(defvar org-indent-agent-passive-delay '(0 0 400000) + "Time to run agent before switching to other idle processes. +Delay used when the buffer to initialize isn't current.") +(defvar org-indent-agent-resume-delay '(0 0 100000) + "Minimal time for other idle processes before switching back to agent.") +(defvar org-indent-initial-marker nil + "Position of initialization before interrupt. +This is used locally in each buffer being initialized.") +(defvar org-hide-leading-stars-before-indent-mode nil + "Used locally.") +(defvar org-indent-modified-headline-flag nil + "Non-nil means the last deletion operated on a headline. +It is modified by `org-indent-notify-modified-headline'.") + + +(defcustom org-indent-boundary-char ?\ ; comment to protect space char + "The end of the virtual indentation strings, a single-character string. +The default is just a space, but if you wish, you can use \"|\" or so. +This can be useful on a terminal window - under a windowing system, +it may be prettier to customize the org-indent face." + :group 'org-indent + :set (lambda (var val) + (set var val) + (and org-indent-strings (org-indent-initialize))) + :type 'character) + +(defcustom org-indent-mode-turns-off-org-adapt-indentation t + "Non-nil means setting the variable `org-indent-mode' will \ +turn off indentation adaptation. +For details see the variable `org-adapt-indentation'." + :group 'org-indent + :type 'boolean) + +(defcustom org-indent-mode-turns-on-hiding-stars t + "Non-nil means setting the variable `org-indent-mode' will \ +turn on `org-hide-leading-stars'." + :group 'org-indent + :type 'boolean) + +(defcustom org-indent-indentation-per-level 2 + "Indentation per level in number of characters." + :group 'org-indent + :type 'integer) + +(defface org-indent + (org-compatible-face nil nil) + "Face for outline indentation. +The default is to make it look like whitespace. But you may find it +useful to make it ever so slightly different." + :group 'org-faces) + +(defun org-indent-initialize () + "Initialize the indentation strings." + (setq org-indent-strings (make-vector (1+ org-indent-max) nil)) + (setq org-indent-stars (make-vector (1+ org-indent-max) nil)) + (aset org-indent-strings 0 nil) + (aset org-indent-stars 0 nil) + (loop for i from 1 to org-indent-max do + (aset org-indent-strings i + (org-add-props + (concat (make-string (1- i) ?\ ) + (char-to-string org-indent-boundary-char)) + nil 'face 'org-indent))) + (loop for i from 1 to org-indent-max-levels do + (aset org-indent-stars i + (org-add-props (make-string i ?*) + nil 'face 'org-hide)))) + +(defsubst org-indent-remove-properties (beg end) + "Remove indentations between BEG and END." + (org-with-silent-modifications + (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))) + +;;;###autoload +(define-minor-mode org-indent-mode + "When active, indent text according to outline structure. + +Internally this works by adding `line-prefix' and `wrap-prefix' +properties, after each buffer modification, on the modified zone. + +The process is synchronous. Though, initial indentation of +buffer, which can take a few seconds on large buffers, is done +during idle time." + nil " Ind" nil + (cond + ((and org-indent-mode (featurep 'xemacs)) + (message "org-indent-mode does not work in XEmacs - refusing to turn it on") + (setq org-indent-mode nil)) + ((and org-indent-mode + (not (org-version-check "23.1.50" "Org Indent mode" :predicate))) + (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!") + (ding) + (sit-for 1) + (setq org-indent-mode nil)) + (org-indent-mode + ;; mode was turned on. + (org-set-local 'indent-tabs-mode nil) + (or org-indent-strings (org-indent-initialize)) + (org-set-local 'org-indent-initial-marker (copy-marker 1)) + (when org-indent-mode-turns-off-org-adapt-indentation + (org-set-local 'org-adapt-indentation nil)) + (when org-indent-mode-turns-on-hiding-stars + (org-set-local 'org-hide-leading-stars-before-indent-mode + org-hide-leading-stars) + (org-set-local 'org-hide-leading-stars t)) + (org-add-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (org-indent-remove-properties-from-string + (funcall fun start end delete))) + nil t) + (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) + (org-add-hook 'before-change-functions + 'org-indent-notify-modified-headline nil 'local) + (and font-lock-mode (org-restart-font-lock)) + (org-indent-remove-properties (point-min) (point-max)) + ;; Submit current buffer to initialize agent. If it's the first + ;; buffer submitted, also start the agent. Current buffer is + ;; pushed in both cases to avoid a race condition. + (if org-indent-agentized-buffers + (push (current-buffer) org-indent-agentized-buffers) + (push (current-buffer) org-indent-agentized-buffers) + (setq org-indent-agent-timer + (run-with-idle-timer 0.2 t #'org-indent-initialize-agent)))) + (t + ;; mode was turned off (or we refused to turn it on) + (kill-local-variable 'org-adapt-indentation) + (setq org-indent-agentized-buffers + (delq (current-buffer) org-indent-agentized-buffers)) + (when (markerp org-indent-initial-marker) + (set-marker org-indent-initial-marker nil)) + (when (boundp 'org-hide-leading-stars-before-indent-mode) + (org-set-local 'org-hide-leading-stars + org-hide-leading-stars-before-indent-mode)) + (remove-hook 'filter-buffer-substring-functions + (lambda (fun start end delete) + (org-indent-remove-properties-from-string + (funcall fun start end delete)))) + (remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local) + (remove-hook 'before-change-functions + 'org-indent-notify-modified-headline 'local) + (org-with-wide-buffer + (org-indent-remove-properties (point-min) (point-max))) + (and font-lock-mode (org-restart-font-lock)) + (redraw-display)))) + +(defun org-indent-indent-buffer () + "Add indentation properties to the accessible part of the buffer." + (interactive) + (if (not (derived-mode-p 'org-mode)) + (error "Not in Org mode") + (message "Setting buffer indentation. It may take a few seconds...") + (org-indent-remove-properties (point-min) (point-max)) + (org-indent-add-properties (point-min) (point-max)) + (message "Indentation of buffer set."))) + +(defun org-indent-remove-properties-from-string (string) + "Remove indentation properties from STRING." + (remove-text-properties 0 (length string) + '(line-prefix nil wrap-prefix nil) string) + string) + +(defun org-indent-initialize-agent () + "Start or resume current buffer initialization. +Only buffers in `org-indent-agentized-buffers' trigger an action. +When no more buffer is being watched, the agent suppress itself." + (when org-indent-agent-resume-timer + (cancel-timer org-indent-agent-resume-timer)) + (setq org-indent-agentized-buffers + (org-remove-if-not #'buffer-live-p org-indent-agentized-buffers)) + (cond + ;; Job done: kill agent. + ((not org-indent-agentized-buffers) (cancel-timer org-indent-agent-timer)) + ;; Current buffer is agentized: start/resume initialization + ;; somewhat aggressively. + ((memq (current-buffer) org-indent-agentized-buffers) + (org-indent-initialize-buffer (current-buffer) + org-indent-agent-active-delay)) + ;; Else, start/resume initialization of the last agentized buffer, + ;; softly. + (t (org-indent-initialize-buffer (car org-indent-agentized-buffers) + org-indent-agent-passive-delay)))) + +(defun org-indent-initialize-buffer (buffer delay) + "Set virtual indentation for the buffer BUFFER, asynchronously. +Give hand to other idle processes if it takes longer than DELAY, +a time value." + (with-current-buffer buffer + (when org-indent-mode + (org-with-wide-buffer + (let ((interruptp + ;; Always nil unless interrupted. + (catch 'interrupt + (and org-indent-initial-marker + (marker-position org-indent-initial-marker) + (org-indent-add-properties org-indent-initial-marker + (point-max) + delay) + nil)))) + (move-marker org-indent-initial-marker interruptp) + ;; Job is complete: un-agentize buffer. + (unless interruptp + (setq org-indent-agentized-buffers + (delq buffer org-indent-agentized-buffers)))))))) + +(defsubst org-indent-set-line-properties (l w h) + "Set prefix properties on current line an move to next one. + +Prefix properties `line-prefix' and `wrap-prefix' in current line +are set to, respectively, length L and W. + +If H is non-nil, `line-prefix' will be starred. If H is +`inline', the first star will have `org-warning' face. + +Assume point is at beginning of line." + (let ((line (cond + ((eq 'inline h) + (let ((stars (aref org-indent-stars + (min l org-indent-max-levels)))) + (and stars + (if (org-bound-and-true-p org-inlinetask-show-first-star) + (concat org-indent-inlinetask-first-star + (substring stars 1)) + stars)))) + (h (aref org-indent-stars + (min l org-indent-max-levels))) + (t (aref org-indent-strings + (min l org-indent-max))))) + (wrap (aref org-indent-strings (min w org-indent-max)))) + ;; Add properties down to the next line to indent empty lines. + (add-text-properties (point) (min (1+ (point-at-eol)) (point-max)) + `(line-prefix ,line wrap-prefix ,wrap))) + (forward-line 1)) + +(defun org-indent-add-properties (beg end &optional delay) + "Add indentation properties between BEG and END. + +When DELAY is non-nil, it must be a time value. In that case, +the process is asynchronous and can be interrupted, either by +user request, or after DELAY. This is done by throwing the +`interrupt' tag along with the buffer position where the process +stopped." + (save-match-data + (org-with-wide-buffer + (goto-char beg) + (beginning-of-line) + ;; 1. Initialize prefix at BEG. This is done by storing two + ;; variables: INLINE-PF and PF, representing respectively + ;; length of current `line-prefix' when line is inside an + ;; inline task or not. + (let* ((case-fold-search t) + (limited-re (org-get-limited-outline-regexp)) + (added-ind-per-lvl (abs (1- org-indent-indentation-per-level))) + (pf (save-excursion + (and (ignore-errors (let ((outline-regexp limited-re)) + (org-back-to-heading t))) + (+ (* org-indent-indentation-per-level + (- (match-end 0) (match-beginning 0) 2)) 2)))) + (pf-inline (and (featurep 'org-inlinetask) + (org-inlinetask-in-task-p) + (+ (* org-indent-indentation-per-level + (1- (org-inlinetask-get-task-level))) 2))) + (time-limit (and delay (time-add (current-time) delay)))) + ;; 2. For each line, set `line-prefix' and `wrap-prefix' + ;; properties depending on the type of line (headline, + ;; inline task, item or other). + (org-with-silent-modifications + (while (and (<= (point) end) (not (eobp))) + (cond + ;; When in asynchronous mode, check if interrupt is + ;; required. + ((and delay (input-pending-p)) (throw 'interrupt (point))) + ;; In asynchronous mode, take a break of + ;; `org-indent-agent-resume-delay' every DELAY to avoid + ;; blocking any other idle timer or process output. + ((and delay (time-less-p time-limit (current-time))) + (setq org-indent-agent-resume-timer + (run-with-idle-timer + (time-add (current-idle-time) + org-indent-agent-resume-delay) + nil #'org-indent-initialize-agent)) + (throw 'interrupt (point))) + ;; Headline or inline task. + ((looking-at org-outline-regexp) + (let* ((nstars (- (match-end 0) (match-beginning 0) 1)) + (line (* added-ind-per-lvl (1- nstars))) + (wrap (+ line (1+ nstars)))) + (cond + ;; Headline: new value for PF. + ((looking-at limited-re) + (org-indent-set-line-properties line wrap t) + (setq pf wrap)) + ;; End of inline task: PF-INLINE is now nil. + ((looking-at "\\*+ end[ \t]*$") + (org-indent-set-line-properties line wrap 'inline) + (setq pf-inline nil)) + ;; Start of inline task. Determine if it contains + ;; text, or if it is only one line long. Set + ;; PF-INLINE accordingly. + (t (org-indent-set-line-properties line wrap 'inline) + (setq pf-inline (and (org-inlinetask-in-task-p) wrap)))))) + ;; List item: `wrap-prefix' is set where body starts. + ((org-at-item-p) + (let* ((line (or pf-inline pf 0)) + (wrap (+ (org-list-item-body-column (point)) line))) + (org-indent-set-line-properties line wrap nil))) + ;; Normal line: use PF-INLINE, PF or nil as prefixes. + (t (let* ((line (or pf-inline pf 0)) + (wrap (+ line (org-get-indentation)))) + (org-indent-set-line-properties line wrap nil)))))))))) + +(defun org-indent-notify-modified-headline (beg end) + "Set `org-indent-modified-headline-flag' depending on context. + +BEG and END are the positions of the beginning and end of the +range of deleted text. + +This function is meant to be called by `before-change-functions'. +Flag will be non-nil if command is going to modify or delete an +headline." + (when org-indent-mode + (setq org-indent-modified-headline-flag + (save-excursion + (goto-char beg) + (save-match-data + (or (and (org-at-heading-p) (< beg (match-end 0))) + (re-search-forward org-outline-regexp-bol end t))))))) + +(defun org-indent-refresh-maybe (beg end dummy) + "Refresh indentation properties in an adequate portion of buffer. +BEG and END are the positions of the beginning and end of the +range of inserted text. DUMMY is an unused argument. + +This function is meant to be called by `after-change-functions'." + (when org-indent-mode + (save-match-data + ;; If a headline was modified or inserted, set properties until + ;; next headline. + (if (or org-indent-modified-headline-flag + (save-excursion + (goto-char beg) + (beginning-of-line) + (re-search-forward org-outline-regexp-bol end t))) + (let ((end (save-excursion + (goto-char end) + (org-with-limited-levels (outline-next-heading)) + (point)))) + (setq org-indent-modified-headline-flag nil) + (org-indent-add-properties beg end)) + ;; Otherwise, only set properties on modified area. + (org-indent-add-properties beg end))))) + +(provide 'org-indent) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-indent.el ends here diff --git a/elpa/org-20150427/org-info.el b/elpa/org-20150427/org-info.el new file mode 100644 index 00000000..8a2d7176 --- /dev/null +++ b/elpa/org-20150427/org-info.el @@ -0,0 +1,79 @@ +;;; org-info.el --- Support for links to Info nodes from within Org-Mode + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: + +;; This file implements links to Info nodes from within Org-mode. +;; Org-mode loads this module by default - if this is not what you want, +;; configure the variable `org-modules'. + +;;; Code: + +(require 'org) + +;; Declare external functions and variables + +(declare-function Info-find-node "info" (filename nodename + &optional no-going-back)) +(defvar Info-current-file) +(defvar Info-current-node) + +;; Install the link type +(org-add-link-type "info" 'org-info-open) +(add-hook 'org-store-link-functions 'org-info-store-link) + +;; Implementation +(defun org-info-store-link () + "Store a link to an Info file and node." + (when (eq major-mode 'Info-mode) + (let (link desc) + (setq link (concat "info:" + (file-name-nondirectory Info-current-file) + "#" Info-current-node)) + (setq desc (concat (file-name-nondirectory Info-current-file) + "#" Info-current-node)) + (org-store-link-props :type "info" :file Info-current-file + :node Info-current-node + :link link :desc desc) + link))) + +(defun org-info-open (path) + "Follow an Info file and node link specified by PATH." + (org-info-follow-link path)) + + +(defun org-info-follow-link (name) + "Follow an Info file and node link specified by NAME." + (if (or (string-match "\\(.*\\)[#:]:?\\(.*\\)" name) + (string-match "\\(.*\\)" name)) + (progn + (require 'info) + (if (match-string 2 name) ; If there isn't a node, choose "Top" + (Info-find-node (match-string 1 name) (match-string 2 name)) + (Info-find-node (match-string 1 name) "Top"))) + (message "Could not open: %s" name))) + +(provide 'org-info) + +;;; org-info.el ends here diff --git a/elpa/org-20150427/org-inlinetask.el b/elpa/org-20150427/org-inlinetask.el new file mode 100644 index 00000000..de4267c8 --- /dev/null +++ b/elpa/org-20150427/org-inlinetask.el @@ -0,0 +1,334 @@ +;;; org-inlinetask.el --- Tasks independent of outline hierarchy + +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org + +;; 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: +;; +;; This module implements inline tasks in Org-mode. Inline tasks are +;; tasks that have all the properties of normal outline nodes, +;; including the ability to store meta data like scheduling dates, +;; TODO state, tags and properties. However, these nodes are treated +;; specially by the visibility cycling. +;; +;; Visibility cycling exempts these nodes from cycling. So whenever +;; their parent is opened, so are these tasks. This will only work +;; with `org-cycle', so if you are also using other commands to +;; show/hide entries, you will occasionally find these tasks to behave +;; like all other outline nodes, seemingly splitting the text of the +;; parent into children. +;; +;; Special fontification of inline tasks, so that they can be +;; immediately recognized. From the stars of the headline, only the +;; first and the last two will be visible, the others will be hidden +;; using the `org-hide' face. +;; +;; An inline task is identified solely by a minimum outline level, +;; given by the variable `org-inlinetask-min-level', default 15. +;; +;; If you need to have a time planning line (DEADLINE etc), drawers, +;; for example LOGBOOK of PROPERTIES, or even normal text as part of +;; the inline task, you must add an "END" headline with the same +;; number of stars. +;; +;; As an example, here are two valid inline tasks: +;; +;; **************** TODO a small task +;; +;; and +;; +;; **************** TODO another small task +;; DEADLINE: <2009-03-30 Mon> +;; :PROPERTIES: +;; :SOMETHING: or other +;; :END: +;; And here is some extra text +;; **************** END +;; +;; Also, if you want to use refiling and archiving for inline tasks, +;; The END line must be present to make things work properly. +;; +;; Note that you should not try to use inline tasks within plain list, +;; visibility cycling is known to be problematic when doing so. +;; +;; This package installs one new command: +;; +;; C-c C-x t Insert a new inline task with END line + +;;; Code: + +(require 'org) + +(defgroup org-inlinetask nil + "Options concerning inline tasks in Org mode." + :tag "Org Inline Tasks" + :group 'org-structure) + +(defcustom org-inlinetask-min-level 15 + "Minimum level a headline must have before it is treated as an inline task. +Don't set it to something higher than `29' or clocking will break since this +is the hardcoded maximum number of stars `org-clock-sum' will work with. + +It is strongly recommended that you set `org-cycle-max-level' not at all, +or to a number smaller than this one. In fact, when `org-cycle-max-level' is +not set, it will be assumed to be one less than the value of smaller than +the value of this variable." + :group 'org-inlinetask + :type '(choice + (const :tag "Off" nil) + (integer))) + +(defcustom org-inlinetask-show-first-star nil + "Non-nil means display the first star of an inline task as additional marker. +When nil, the first star is not shown." + :tag "Org Inline Tasks" + :group 'org-structure + :type 'boolean) + +(defvar org-odd-levels-only) +(defvar org-keyword-time-regexp) +(defvar org-drawer-regexp) +(defvar org-complex-heading-regexp) +(defvar org-property-end-re) + +(defcustom org-inlinetask-default-state nil + "Non-nil means make inline tasks have a TODO keyword initially. +This should be the state `org-inlinetask-insert-task' should use by +default, or nil of no state should be assigned." + :group 'org-inlinetask + :version "24.1" + :type '(choice + (const :tag "No state" nil) + (string :tag "Specific state"))) + +(defun org-inlinetask-insert-task (&optional no-state) + "Insert an inline task. +If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'." + (interactive "P") + ;; Error when inside an inline task, except if point was at its very + ;; beginning, in which case the new inline task will be inserted + ;; before this one. + (when (and (org-inlinetask-in-task-p) + (not (and (org-inlinetask-at-task-p) (bolp)))) + (error "Cannot nest inline tasks")) + (or (bolp) (newline)) + (let* ((indent (if org-odd-levels-only + (1- (* 2 org-inlinetask-min-level)) + org-inlinetask-min-level)) + (indent-string (concat (make-string indent ?*) " "))) + (insert indent-string + (if (or no-state (not org-inlinetask-default-state)) + "\n" + (concat org-inlinetask-default-state " \n")) + indent-string "END\n")) + (end-of-line -1)) +(define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task) + +(defun org-inlinetask-outline-regexp () + "Return string matching an inline task heading. +The number of levels is controlled by `org-inlinetask-min-level'." + (let ((nstars (if org-odd-levels-only + (1- (* org-inlinetask-min-level 2)) + org-inlinetask-min-level))) + (format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars))) + +(defun org-inlinetask-at-task-p () + "Return true if point is at beginning of an inline task." + (save-excursion + (beginning-of-line) + (and (looking-at (concat (org-inlinetask-outline-regexp) "\\(.*\\)")) + (not (string-match "^end[ \t]*$" (downcase (match-string 2))))))) + +(defun org-inlinetask-in-task-p () + "Return true if point is inside an inline task." + (save-excursion + (beginning-of-line) + (let* ((case-fold-search t) + (stars-re (org-inlinetask-outline-regexp)) + (task-beg-re (concat stars-re "\\(?:.*\\)")) + (task-end-re (concat stars-re "END[ \t]*$"))) + (or (org-looking-at-p task-beg-re) + (and (re-search-forward "^\\*+[ \t]+" nil t) + (progn (beginning-of-line) (org-looking-at-p task-end-re))))))) + +(defun org-inlinetask-goto-beginning () + "Go to the beginning of the inline task at point." + (end-of-line) + (let ((case-fold-search t) + (inlinetask-re (org-inlinetask-outline-regexp))) + (re-search-backward inlinetask-re nil t) + (when (org-looking-at-p (concat inlinetask-re "END[ \t]*$")) + (re-search-backward inlinetask-re nil t)))) + +(defun org-inlinetask-goto-end () + "Go to the end of the inline task at point. +Return point." + (save-match-data + (beginning-of-line) + (let* ((case-fold-search t) + (inlinetask-re (org-inlinetask-outline-regexp)) + (task-end-re (concat inlinetask-re "END[ \t]*$"))) + (cond + ((looking-at task-end-re) (forward-line)) + ((looking-at inlinetask-re) + (forward-line) + (cond + ((looking-at task-end-re) (forward-line)) + ((looking-at inlinetask-re)) + ((org-inlinetask-in-task-p) + (re-search-forward inlinetask-re nil t) + (forward-line)))) + (t (re-search-forward inlinetask-re nil t) + (forward-line))) + (point)))) + +(defun org-inlinetask-get-task-level () + "Get the level of the inline task around. +This assumes the point is inside an inline task." + (save-excursion + (end-of-line) + (re-search-backward (org-inlinetask-outline-regexp) nil t) + (- (match-end 1) (match-beginning 1)))) + +(defun org-inlinetask-promote () + "Promote the inline task at point. +If the task has an end part, promote it. Also, prevents level from +going below `org-inlinetask-min-level'." + (interactive) + (if (not (org-inlinetask-in-task-p)) + (error "Not in an inline task") + (save-excursion + (let* ((lvl (org-inlinetask-get-task-level)) + (next-lvl (org-get-valid-level lvl -1)) + (diff (- next-lvl lvl)) + (down-task (concat (make-string next-lvl ?*))) + beg) + (if (< next-lvl org-inlinetask-min-level) + (error "Cannot promote an inline task at minimum level") + (org-inlinetask-goto-beginning) + (setq beg (point)) + (replace-match down-task nil t nil 1) + (org-inlinetask-goto-end) + (if (eobp) (beginning-of-line) (forward-line -1)) + (unless (= (point) beg) + (replace-match down-task nil t nil 1) + (when org-adapt-indentation + (goto-char beg) + (org-fixup-indentation diff)))))))) + +(defun org-inlinetask-demote () + "Demote the inline task at point. +If the task has an end part, also demote it." + (interactive) + (if (not (org-inlinetask-in-task-p)) + (error "Not in an inline task") + (save-excursion + (let* ((lvl (org-inlinetask-get-task-level)) + (next-lvl (org-get-valid-level lvl 1)) + (diff (- next-lvl lvl)) + (down-task (concat (make-string next-lvl ?*))) + beg) + (org-inlinetask-goto-beginning) + (setq beg (point)) + (replace-match down-task nil t nil 1) + (org-inlinetask-goto-end) + (if (eobp) (beginning-of-line) (forward-line -1)) + (unless (= (point) beg) + (replace-match down-task nil t nil 1) + (when org-adapt-indentation + (goto-char beg) + (org-fixup-indentation diff))))))) + +(defun org-inlinetask-get-current-indentation () + "Get the indentation of the last non-while line above this one." + (save-excursion + (beginning-of-line 1) + (skip-chars-backward " \t\n") + (beginning-of-line 1) + (or (org-at-item-p) + (looking-at "[ \t]*")) + (goto-char (match-end 0)) + (current-column))) + +(defvar org-indent-indentation-per-level) ; defined in org-indent.el + +(defface org-inlinetask + (org-compatible-face 'shadow '((t (:bold t)))) + "Face for inlinetask headlines." + :group 'org-faces) + +(defun org-inlinetask-fontify (limit) + "Fontify the inline tasks down to LIMIT." + (let* ((nstars (if org-odd-levels-only + (1- (* 2 (or org-inlinetask-min-level 200))) + (or org-inlinetask-min-level 200))) + (re (concat "^\\(\\*\\)\\(\\*\\{" + (format "%d" (- nstars 3)) + ",\\}\\)\\(\\*\\* .*\\)")) + ;; Virtual indentation will add the warning face on the first + ;; star. Thus, in that case, only hide it. + (start-face (if (and (org-bound-and-true-p org-indent-mode) + (> org-indent-indentation-per-level 1)) + 'org-hide + 'org-warning))) + (while (re-search-forward re limit t) + (if org-inlinetask-show-first-star + (add-text-properties (match-beginning 1) (match-end 1) + `(face ,start-face font-lock-fontified t))) + (add-text-properties (match-beginning + (if org-inlinetask-show-first-star 2 1)) + (match-end 2) + '(face org-hide font-lock-fontified t)) + (add-text-properties (match-beginning 3) (match-end 3) + '(face org-inlinetask font-lock-fontified t))))) + +(defun org-inlinetask-toggle-visibility () + "Toggle visibility of inline task at point." + (let ((end (save-excursion + (org-inlinetask-goto-end) + (if (bolp) (1- (point)) (point)))) + (start (save-excursion + (org-inlinetask-goto-beginning) + (point-at-eol)))) + (cond + ;; Nothing to show/hide. + ((= end start)) + ;; Inlinetask was folded: expand it. + ((get-char-property (1+ start) 'invisible) + (outline-flag-region start end nil) + (org-cycle-hide-drawers 'children)) + (t (outline-flag-region start end t))))) + +(defun org-inlinetask-remove-END-maybe () + "Remove an END line when present." + (when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$" + org-inlinetask-min-level)) + (replace-match ""))) + +(eval-after-load "org" + '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify)) + +(provide 'org-inlinetask) + +;;; org-inlinetask.el ends here diff --git a/elpa/org-20150427/org-install.el b/elpa/org-20150427/org-install.el new file mode 100644 index 00000000..58359597 --- /dev/null +++ b/elpa/org-20150427/org-install.el @@ -0,0 +1,17 @@ +;;; org-install.el --- backward compatibility file for obsolete configuration +;; +;;; Code: +;; +;; The file org-install is obsolete. +;; +;; It is provided here so that (require 'org-install) does not +;; trigger an error for users with obsolete Emacs configuration. +;; You can safely remove (require 'org-install) from your config." + +(provide 'org-install) + +;; Local Variables: +;; no-byte-compile: t +;; coding: utf-8 +;; End: +;;; org-install.el ends here diff --git a/elpa/org-20150427/org-irc.el b/elpa/org-20150427/org-irc.el new file mode 100644 index 00000000..8f9761b3 --- /dev/null +++ b/elpa/org-20150427/org-irc.el @@ -0,0 +1,259 @@ +;;; org-irc.el --- Store links to IRC sessions +;; +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. +;; +;; Author: Philip Jackson <emacs@shellarchive.co.uk> +;; Keywords: erc, irc, link, org +;; +;; 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: + +;; This file implements links to an IRC session from within Org-mode. +;; Org-mode loads this module by default - if this is not what you want, +;; configure the variable `org-modules'. +;; +;; Please customize the variable `org-modules' to select +;; extensions you would like to use, and to deselect those which you don't +;; want. +;; +;; Please note that at the moment only ERC is supported. Other clients +;; shouldn't be difficult to add though. +;; +;; Then set `org-irc-link-to-logs' to non-nil if you would like a +;; file:/ type link to be created to the current line in the logs or +;; to t if you would like to create an irc:/ style link. +;; +;; Links within an org buffer might look like this: +;; +;; [[irc:/irc.freenode.net/#emacs/bob][chat with bob in #emacs on freenode]] +;; [[irc:/irc.freenode.net/#emacs][#emacs on freenode]] +;; [[irc:/irc.freenode.net/]] +;; +;; If, when the resulting link is visited, there is no connection to a +;; requested server then one will be created. + +;;; Code: + +(require 'org) + +;; Declare the function form ERC that we use. +(declare-function erc-current-logfile "erc-log" (&optional buffer)) +(declare-function erc-prompt "erc" ()) +(declare-function erc-default-target "erc" ()) +(declare-function erc-channel-p "erc" (channel)) +(declare-function erc-buffer-filter "erc" (predicate &optional proc)) +(declare-function erc-server-buffer "erc" ()) +(declare-function erc-get-server-nickname-list "erc" ()) +(declare-function erc-cmd-JOIN "erc" (channel &optional key)) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) + +(defvar org-irc-client 'erc + "The IRC client to act on.") +(defvar org-irc-link-to-logs nil + "Non-nil will store a link to the logs, nil will store an irc: style link.") + +(defvar erc-default-port) ; dynamically scoped from erc.el +(defvar erc-session-port) ; dynamically scoped form erc-backend.el +(defvar erc-session-server) ; dynamically scoped form erc-backend.el + +;; Generic functions/config (extend these for other clients) + +(add-to-list 'org-store-link-functions 'org-irc-store-link) + +(org-add-link-type "irc" 'org-irc-visit nil) + +(defun org-irc-visit (link) + "Parse LINK and dispatch to the correct function based on the client found." + (let ((link (org-irc-parse-link link))) + (cond + ((eq org-irc-client 'erc) + (org-irc-visit-erc link)) + (t + (error "ERC only known client"))))) + +(defun org-irc-parse-link (link) + "Parse an IRC LINK and return the attributes found. +Parse a LINK that looks like server:port/chan/user (port, chan +and user being optional) and return any of the port, channel or user +attributes that are found." + (let* ((parts (split-string link "/" t)) + (len (length parts))) + (when (or (< len 1) (> len 3)) + (error "Failed to parse link needed 1-3 parts, got %d" len)) + (setcar parts (split-string (car parts) ":" t)) + parts)) + +;;;###autoload +(defun org-irc-store-link () + "Dispatch to the appropriate function to store a link to an IRC session." + (cond + ((eq major-mode 'erc-mode) + (org-irc-erc-store-link)))) + +(defun org-irc-ellipsify-description (string &optional after) + "Remove unnecessary white space from STRING and add ellipses if necessary. +Strip starting and ending white space from STRING and replace any +chars that the value 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)) + +;; ERC specific functions + +(defun org-irc-erc-get-line-from-log (erc-line) + "Find the best line to link to from the ERC logs given ERC-LINE as a start. +If the user is on the ERC-prompt then search backward for the +first non-blank line, otherwise return the current line. The +result is a cons of the filename and search string." + (erc-save-buffer-in-logs) + (require 'erc-log) + (with-current-buffer (find-file-noselect (erc-current-logfile)) + (goto-char (point-max)) + (list + (abbreviate-file-name buffer-file-name) + ;; can we get a '::' part? + (if (string= erc-line (erc-prompt)) + (progn + (goto-char (point-at-bol)) + (when (search-backward-regexp "^[^ ]" nil t) + (buffer-substring-no-properties (point-at-bol) + (point-at-eol)))) + (when (search-backward erc-line nil t) + (buffer-substring-no-properties (point-at-bol) + (point-at-eol))))))) + +(defun org-irc-erc-store-link () + "Store a link to the IRC log file or the session itself. +Depending on the variable `org-irc-link-to-logs' store either a +link to the log file for the current session or an irc: link to +the session itself." + (require 'erc-log) + (if org-irc-link-to-logs + (let* ((erc-line (buffer-substring-no-properties + (point-at-bol) (point-at-eol))) + (parsed-line (org-irc-erc-get-line-from-log erc-line))) + (if (erc-logging-enabled nil) + (progn + (org-store-link-props + :type "file" + :description (concat "'" (org-irc-ellipsify-description + (cadr parsed-line) 20) + "' from an IRC conversation") + :link (concat "file:" (car parsed-line) "::" + (cadr parsed-line))) + t) + (error "This ERC session is not being logged"))) + (let* ((link-text (org-irc-get-erc-link)) + (link (org-irc-parse-link link-text))) + (if link-text + (progn + (org-store-link-props + :type "irc" + :link (concat "irc:/" link-text) + :description (concat "irc session '" link-text "'") + :server (car (car link)) + :port (or (string-to-number (cadr (pop link))) erc-default-port) + :nick (pop link)) + t) + (error "Failed to create ('irc:/' style) ERC link"))))) + +(defun org-irc-get-erc-link () + "Return an org compatible irc:/ link from an ERC buffer." + (let* ((session-port (if (numberp erc-session-port) + (number-to-string erc-session-port) + erc-session-port)) + (link (concat erc-session-server ":" session-port))) + (concat link "/" + (if (and (erc-default-target) + (erc-channel-p (erc-default-target)) + (car (get-text-property (point) 'erc-data))) + ;; we can get a nick + (let ((nick (car (get-text-property (point) 'erc-data)))) + (concat (erc-default-target) "/" nick)) + (erc-default-target))))) + +(defun org-irc-get-current-erc-port () + "Return the current port as a number. +Return the current port number or, if none is set, return the ERC +default." + (cond + ((stringp erc-session-port) + (string-to-number erc-session-port)) + ((numberp erc-session-port) + erc-session-port) + (t + erc-default-port))) + +(defun org-irc-visit-erc (link) + "Visit an ERC buffer based on criteria found in LINK." + (require 'erc) + (require 'erc-log) + (let* ((server (car (car link))) + (port (or (string-to-number (cadr (pop link))) erc-default-port)) + (server-buffer) + (buffer-list + (erc-buffer-filter + (lambda nil + (let ((tmp-server-buf (erc-server-buffer))) + (and tmp-server-buf + (with-current-buffer tmp-server-buf + (and + (eq (org-irc-get-current-erc-port) port) + (string= erc-session-server server) + (setq server-buffer tmp-server-buf))))))))) + (if buffer-list + (let ((chan-name (pop link))) + ;; if we got a channel name then switch to it or join it + (if chan-name + (let ((chan-buf (catch 'found + (dolist (x buffer-list) + (if (string= (buffer-name x) chan-name) + (throw 'found x)))))) + (if chan-buf + (progn + (org-pop-to-buffer-same-window chan-buf) + ;; if we got a nick, and they're in the chan, + ;; then start a chat with them + (let ((nick (pop link))) + (when nick + (if (member nick (erc-get-server-nickname-list)) + (progn + (goto-char (point-max)) + (insert (concat nick ": "))) + (error "%s not found in %s" nick chan-name))))) + (progn + (org-pop-to-buffer-same-window server-buffer) + (erc-cmd-JOIN chan-name)))) + (org-pop-to-buffer-same-window server-buffer))) + ;; no server match, make new connection + (erc-select :server server :port port)))) + +(provide 'org-irc) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-irc.el ends here diff --git a/elpa/org-20150427/org-list.el b/elpa/org-20150427/org-list.el new file mode 100644 index 00000000..a00e5573 --- /dev/null +++ b/elpa/org-20150427/org-list.el @@ -0,0 +1,3290 @@ +;;; org-list.el --- Plain lists for Org-mode +;; +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Bastien Guerry <bzg@gnu.org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: + +;; This file contains the code dealing with plain lists in Org-mode. + +;; The core concept behind lists is their structure. A structure is +;; a snapshot of the list, in the shape of a data tree (see +;; `org-list-struct'). + +;; Once the list structure is stored, it is possible to make changes +;; on it that will be mirrored to the real list or to get information +;; about the list, using accessors and methods provided in the +;; library. Most of them require the use of one or two helper +;; functions, namely `org-list-parents-alist' and +;; `org-list-prevs-alist'. + +;; Structure is eventually applied to the buffer with +;; `org-list-write-struct'. This function repairs (bullets, +;; indentation, checkboxes) the list in the process. It should be +;; called near the end of any function working on structures. + +;; Thus, a function applying to lists should usually follow this +;; template: + +;; 1. Verify point is in a list and grab item beginning (with the same +;; function `org-in-item-p'). If the function requires the cursor +;; to be at item's bullet, `org-at-item-p' is more selective. It +;; is also possible to move point to the closest item with +;; `org-list-search-backward', or `org-list-search-forward', +;; applied to the function `org-item-beginning-re'. + +;; 2. Get list structure with `org-list-struct'. + +;; 3. Compute one, or both, helper functions, +;; (`org-list-parents-alist', `org-list-prevs-alist') depending on +;; needed accessors. + +;; 4. Proceed with the modifications, using methods and accessors. + +;; 5. Verify and apply structure to buffer, using +;; `org-list-write-struct'. + +;; 6. If changes made to the list might have modified check-boxes, +;; call `org-update-checkbox-count-maybe'. + +;; Computing a structure can be a costly operation on huge lists (a +;; few thousand lines long). Thus, code should follow the rule: +;; "collect once, use many". As a corollary, it is usually a bad idea +;; to use directly an interactive function inside the code, as those, +;; being independent entities, read the whole list structure another +;; time. + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'org-macs) +(require 'org-compat) + +(defvar org-M-RET-may-split-line) +(defvar org-auto-align-tags) +(defvar org-blank-before-new-entry) +(defvar org-clock-string) +(defvar org-closed-string) +(defvar org-deadline-string) +(defvar org-description-max-indent) +(defvar org-drawers) +(defvar org-odd-levels-only) +(defvar org-scheduled-string) +(defvar org-ts-regexp) +(defvar org-ts-regexp-both) + +(declare-function outline-invisible-p "outline" (&optional pos)) +(declare-function outline-flag-region "outline" (from to flag)) +(declare-function outline-next-heading "outline" ()) +(declare-function outline-previous-heading "outline" ()) + +(declare-function org-at-heading-p "org" (&optional ignored)) +(declare-function org-before-first-heading-p "org" ()) +(declare-function org-back-to-heading "org" (&optional invisible-ok)) +(declare-function org-combine-plists "org" (&rest plists)) +(declare-function org-count "org" (cl-item cl-seq)) +(declare-function org-current-level "org" ()) +(declare-function org-entry-get "org" + (pom property &optional inherit literal-nil)) +(declare-function org-fix-tags-on-the-fly "org" ()) +(declare-function org-get-indentation "org" (&optional line)) +(declare-function org-icompleting-read "org" (&rest args)) +(declare-function org-in-block-p "org" (names)) +(declare-function org-in-regexp "org" (re &optional nlines visually)) +(declare-function org-level-increment "org" ()) +(declare-function org-narrow-to-subtree "org" ()) +(declare-function org-at-heading-p "org" (&optional invisible-ok)) +(declare-function org-previous-line-empty-p "org" ()) +(declare-function org-remove-if "org" (predicate seq)) +(declare-function org-reduced-level "org" (L)) +(declare-function org-show-subtree "org" ()) +(declare-function org-sort-remove-invisible "org" (S)) +(declare-function org-time-string-to-seconds "org" (s)) +(declare-function org-timer-hms-to-secs "org-timer" (hms)) +(declare-function org-timer-item "org-timer" (&optional arg)) +(declare-function org-trim "org" (s)) +(declare-function org-uniquify "org" (list)) + +(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) +(declare-function org-inlinetask-goto-end "org-inlinetask" ()) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) + +(declare-function org-export-string-as "ox" + (string backend &optional body-only ext-plist)) + + + + +;;; Configuration variables + +(defgroup org-plain-lists nil + "Options concerning plain lists in Org-mode." + :tag "Org Plain lists" + :group 'org-structure) + +(defcustom org-cycle-include-plain-lists t + "When t, make TAB cycle visibility on plain list items. +Cycling plain lists works only when the cursor is on a plain list +item. When the cursor is on an outline heading, plain lists are +treated as text. This is the most stable way of handling this, +which is why it is the default. + +When this is the symbol `integrate', then integrate plain list +items when cycling, as if they were children of outline headings. + +This setting can lead to strange effects when switching visibility +to `children', because the first \"child\" in a subtree decides +what children should be listed. If that first \"child\" is a +plain list item with an implied large level number, all true +children and grand children of the outline heading will be +exposed in a children' view." + :group 'org-plain-lists + :group 'org-cycle + :type '(choice + (const :tag "Never" nil) + (const :tag "With cursor in plain list (recommended)" t) + (const :tag "As children of outline headings" integrate))) + +(defcustom org-list-demote-modify-bullet nil + "Default bullet type installed when demoting an item. +This is an association list, for each bullet type, this alist will point +to the bullet that should be used when this item is demoted. +For example, + + (setq org-list-demote-modify-bullet + '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\"))) + +will make + + + Movies + + Silence of the Lambs + + My Cousin Vinny + + Books + + The Hunt for Red October + + The Road to Omaha + +into + + + Movies + - Silence of the Lambs + - My Cousin Vinny + + Books + - The Hunt for Red October + - The Road to Omaha" + :group 'org-plain-lists + :type '(repeat + (cons + (choice :tag "If the current bullet is " + (const "-") + (const "+") + (const "*") + (const "1.") + (const "1)")) + (choice :tag "demotion will change it to" + (const "-") + (const "+") + (const "*") + (const "1.") + (const "1)"))))) + +(defcustom org-plain-list-ordered-item-terminator t + "The character that makes a line with leading number an ordered list item. +Valid values are ?. and ?\). To get both terminators, use t." + :group 'org-plain-lists + :type '(choice (const :tag "dot like in \"2.\"" ?.) + (const :tag "paren like in \"2)\"" ?\)) + (const :tag "both" t))) + +(define-obsolete-variable-alias 'org-alphabetical-lists + 'org-list-allow-alphabetical "24.4") ; Since 8.0 +(defcustom org-list-allow-alphabetical nil + "Non-nil means single character alphabetical bullets are allowed. + +Both uppercase and lowercase are handled. Lists with more than +26 items will fallback to standard numbering. Alphabetical +counters like \"[@c]\" will be recognized. + +This variable needs to be set before org.el is loaded. If you +need to make a change while Emacs is running, use the customize +interface or run the following code after updating it: + + \(when (featurep 'org-element) (load \"org-element\" t t))" + :group 'org-plain-lists + :version "24.1" + :type 'boolean + :set (lambda (var val) + (when (featurep 'org-element) (load "org-element" t t)) + (set var val))) + +(defcustom org-list-two-spaces-after-bullet-regexp nil + "A regular expression matching bullets that should have 2 spaces after them. +When nil, no bullet will have two spaces after them. When +a string, it will be used as a regular expression. When the +bullet type of a list is changed, the new bullet type will be +matched against this regexp. If it matches, there will be two +spaces instead of one after the bullet in each item of the list." + :group 'org-plain-lists + :type '(choice + (const :tag "never" nil) + (regexp))) + +(define-obsolete-variable-alias 'org-empty-line-terminates-plain-lists + 'org-list-empty-line-terminates-plain-lists "24.4") ;; Since 8.0 +(defcustom org-list-empty-line-terminates-plain-lists nil + "Non-nil means an empty line ends all plain list levels. +Otherwise, two of them will be necessary." + :group 'org-plain-lists + :type 'boolean) + +(defcustom org-list-automatic-rules '((checkbox . t) + (indent . t)) + "Non-nil means apply set of rules when acting on lists. +By default, automatic actions are taken when using + \\[org-meta-return], \\[org-metaright], \\[org-metaleft], + \\[org-shiftmetaright], \\[org-shiftmetaleft], + \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or + \\[org-insert-todo-heading]. You can disable individually these + rules by setting them to nil. Valid rules are: + +checkbox when non-nil, checkbox statistics is updated each time + you either insert a new checkbox or toggle a checkbox. +indent when non-nil, indenting or outdenting list top-item + with its subtree will move the whole list and + outdenting a list whose bullet is * to column 0 will + change that bullet to \"-\"." + :group 'org-plain-lists + :version "24.1" + :type '(alist :tag "Sets of rules" + :key-type + (choice + (const :tag "Checkbox" checkbox) + (const :tag "Indent" indent)) + :value-type + (boolean :tag "Activate" :value t))) + +(defcustom org-list-use-circular-motion nil + "Non-nil means commands implying motion in lists should be cyclic. + +In that case, the item following the last item is the first one, +and the item preceding the first item is the last one. + +This affects the behavior of \\[org-move-item-up], + \\[org-move-item-down], \\[org-next-item] and + \\[org-previous-item]." + :group 'org-plain-lists + :version "24.1" + :type 'boolean) + +(defvar org-checkbox-statistics-hook nil + "Hook that is run whenever Org thinks checkbox statistics should be updated. +This hook runs even if checkbox rule in +`org-list-automatic-rules' does not apply, so it can be used to +implement alternative ways of collecting statistics +information.") + +(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics + 'org-checkbox-hierarchical-statistics "24.4") ;; Since 8.0 +(defcustom org-checkbox-hierarchical-statistics t + "Non-nil means checkbox statistics counts only the state of direct children. +When nil, all boxes below the cookie are counted. +This can be set to nil on a per-node basis using a COOKIE_DATA property +with the word \"recursive\" in the value." + :group 'org-plain-lists + :type 'boolean) + +(org-defvaralias 'org-description-max-indent + 'org-list-description-max-indent) ;; Since 8.0 +(defcustom org-list-description-max-indent 20 + "Maximum indentation for the second line of a description list. +When the indentation would be larger than this, it will become +5 characters instead." + :group 'org-plain-lists + :type 'integer) + +(defcustom org-list-indent-offset 0 + "Additional indentation for sub-items in a list. +By setting this to a small number, usually 1 or 2, one can more +clearly distinguish sub-items in a list." + :group 'org-plain-lists + :version "24.1" + :type 'integer) + +(defcustom org-list-radio-list-templates + '((latex-mode "% BEGIN RECEIVE ORGLST %n +% END RECEIVE ORGLST %n +\\begin{comment} +#+ORGLST: SEND %n org-list-to-latex +- +\\end{comment}\n") + (texinfo-mode "@c BEGIN RECEIVE ORGLST %n +@c END RECEIVE ORGLST %n +@ignore +#+ORGLST: SEND %n org-list-to-texinfo +- +@end ignore\n") + (html-mode "<!-- BEGIN RECEIVE ORGLST %n --> +<!-- END RECEIVE ORGLST %n --> +<!-- +#+ORGLST: SEND %n org-list-to-html +- +-->\n")) + "Templates for radio lists in different major modes. +All occurrences of %n in a template will be replaced with the name of the +list, obtained by prompting the user." + :group 'org-plain-lists + :type '(repeat + (list (symbol :tag "Major mode") + (string :tag "Format")))) + +(defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer" + "html" "latex" "odt") + "Names of blocks where lists are not allowed. +Names must be in lower case.") + +(defvar org-list-export-context '(block inlinetask) + "Context types where lists will be interpreted during export. + +Valid types are `drawer', `inlinetask' and `block'. More +specifically, type `block' is determined by the variable +`org-list-forbidden-blocks'.") + + + +;;; Predicates and regexps + +(defconst org-list-end-re (if org-list-empty-line-terminates-plain-lists "^[ \t]*\n" + "^[ \t]*\n[ \t]*\n") + "Regex corresponding to the end of a list. +It depends on `org-list-empty-line-terminates-plain-lists'.") + +(defconst org-list-full-item-re + (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)" + "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" + "\\(?:\\(\\[[ X-]\\]\\)\\(?:[ \t]+\\|$\\)\\)?" + "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?") + "Matches a list item and puts everything into groups: +group 1: bullet +group 2: counter +group 3: checkbox +group 4: description tag") + +(defun org-item-re () + "Return the correct regular expression for plain lists." + (let ((term (cond + ((eq org-plain-list-ordered-item-terminator t) "[.)]") + ((= org-plain-list-ordered-item-terminator ?\)) ")") + ((= org-plain-list-ordered-item-terminator ?.) "\\.") + (t "[.)]"))) + (alpha (if org-list-allow-alphabetical "\\|[A-Za-z]" ""))) + (concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term + "\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)"))) + +(defsubst org-item-beginning-re () + "Regexp matching the beginning of a plain list item." + (concat "^" (org-item-re))) + +(defun org-list-at-regexp-after-bullet-p (regexp) + "Is point at a list item with REGEXP after bullet?" + (and (org-at-item-p) + (save-excursion + (goto-char (match-end 0)) + (let ((counter-re (concat "\\(?:\\[@\\(?:start:\\)?" + (if org-list-allow-alphabetical + "\\([0-9]+\\|[A-Za-z]\\)" + "[0-9]+") + "\\][ \t]*\\)"))) + ;; Ignore counter if any + (when (looking-at counter-re) (goto-char (match-end 0)))) + (looking-at regexp)))) + +(defun org-list-in-valid-context-p () + "Is point in a context where lists are allowed?" + (not (org-in-block-p org-list-forbidden-blocks))) + +(defun org-in-item-p () + "Return item beginning position when in a plain list, nil otherwise." + (save-excursion + (beginning-of-line) + (let* ((case-fold-search t) + (context (org-list-context)) + (lim-up (car context)) + (drawers-re (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$")) + (inlinetask-re (and (featurep 'org-inlinetask) + (org-inlinetask-outline-regexp))) + (item-re (org-item-re)) + ;; Indentation isn't meaningful when point starts at an empty + ;; line or an inline task. + (ind-ref (if (or (looking-at "^[ \t]*$") + (and inlinetask-re (looking-at inlinetask-re))) + 10000 + (org-get-indentation)))) + (cond + ((eq (nth 2 context) 'invalid) nil) + ((looking-at item-re) (point)) + (t + ;; Detect if cursor in amidst `org-list-end-re'. First, count + ;; number HL of hard lines it takes, then call `org-in-regexp' + ;; to compute its boundaries END-BOUNDS. When point is + ;; in-between, move cursor before regexp beginning. + (let ((hl 0) (i -1) end-bounds) + (when (and (progn + (while (setq i (string-match + "[\r\n]" org-list-end-re (1+ i))) + (setq hl (1+ hl))) + (setq end-bounds (org-in-regexp org-list-end-re hl))) + (>= (point) (car end-bounds)) + (< (point) (cdr end-bounds))) + (goto-char (car end-bounds)) + (forward-line -1))) + ;; Look for an item, less indented that reference line. + (catch 'exit + (while t + (let ((ind (org-get-indentation))) + (cond + ;; This is exactly what we want. + ((and (looking-at item-re) (< ind ind-ref)) + (throw 'exit (point))) + ;; At upper bound of search or looking at the end of a + ;; previous list: search is over. + ((<= (point) lim-up) (throw 'exit nil)) + ((looking-at org-list-end-re) (throw 'exit nil)) + ;; Skip blocks, drawers, inline-tasks, blank lines + ((and (looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) + ((and (looking-at "^[ \t]*:END:") + (re-search-backward drawers-re lim-up t)) + (beginning-of-line)) + ((and inlinetask-re (looking-at inlinetask-re)) + (org-inlinetask-goto-beginning) + (forward-line -1)) + ((looking-at "^[ \t]*$") (forward-line -1)) + ;; Text at column 0 cannot belong to a list: stop. + ((zerop ind) (throw 'exit nil)) + ;; Normal text less indented than reference line, take + ;; it as new reference. + ((< ind ind-ref) + (setq ind-ref ind) + (forward-line -1)) + (t (forward-line -1))))))))))) + +(defun org-at-item-p () + "Is point in a line starting a hand-formatted item?" + (save-excursion + (beginning-of-line) + (and (looking-at (org-item-re)) (org-list-in-valid-context-p)))) + +(defun org-at-item-bullet-p () + "Is point at the bullet of a plain list item?" + (and (org-at-item-p) + (not (member (char-after) '(?\ ?\t))) + (< (point) (match-end 0)))) + +(defun org-at-item-timer-p () + "Is point at a line starting a plain list item with a timer?" + (org-list-at-regexp-after-bullet-p + "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+")) + +(defun org-at-item-description-p () + "Is point at a description list item?" + (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::\\([ \t]+\\|$\\)")) + +(defun org-at-item-checkbox-p () + "Is point at a line starting a plain-list item with a checklet?" + (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) + +(defun org-at-item-counter-p () + "Is point at a line starting a plain-list item with a counter?" + (and (org-at-item-p) + (looking-at org-list-full-item-re) + (match-string 2))) + + + +;;; Structures and helper functions + +(defun org-list-context () + "Determine context, and its boundaries, around point. + +Context will be a cell like (MIN MAX CONTEXT) where MIN and MAX +are boundaries and CONTEXT is a symbol among `drawer', `block', +`invalid', `inlinetask' and nil. + +Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." + (save-match-data + (save-excursion + (org-with-limited-levels + (beginning-of-line) + (let ((case-fold-search t) (pos (point)) beg end context-type + ;; Get positions of surrounding headings. This is the + ;; default context. + (lim-up (or (save-excursion (and (ignore-errors (org-back-to-heading t)) + (point))) + (point-min))) + (lim-down (or (save-excursion (outline-next-heading)) (point-max)))) + ;; Is point inside a drawer? + (let ((end-re "^[ \t]*:END:") + ;; Can't use org-drawers-regexp as this function might + ;; be called in buffers not in Org mode. + (beg-re (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$"))) + (when (save-excursion + (and (not (looking-at beg-re)) + (not (looking-at end-re)) + (setq beg (and (re-search-backward beg-re lim-up t) + (1+ (point-at-eol)))) + (setq end (or (and (re-search-forward end-re lim-down t) + (1- (match-beginning 0))) + lim-down)) + (>= end pos))) + (setq lim-up beg lim-down end context-type 'drawer))) + ;; Is point strictly in a block, and of which type? + (let ((block-re "^[ \t]*#\\+\\(begin\\|end\\)_") type) + (when (save-excursion + (and (not (looking-at block-re)) + (setq beg (and (re-search-backward block-re lim-up t) + (1+ (point-at-eol)))) + (looking-at "^[ \t]*#\\+begin_\\(\\S-+\\)") + (setq type (downcase (match-string 1))) + (goto-char beg) + (setq end (or (and (re-search-forward block-re lim-down t) + (1- (point-at-bol))) + lim-down)) + (>= end pos) + (equal (downcase (match-string 1)) "end"))) + (setq lim-up beg lim-down end + context-type (if (member type org-list-forbidden-blocks) + 'invalid 'block)))) + ;; Is point in an inlinetask? + (when (and (featurep 'org-inlinetask) + (save-excursion + (let* ((beg-re (org-inlinetask-outline-regexp)) + (end-re (concat beg-re "END[ \t]*$"))) + (and (not (looking-at "^\\*+")) + (setq beg (and (re-search-backward beg-re lim-up t) + (1+ (point-at-eol)))) + (not (looking-at end-re)) + (setq end (and (re-search-forward end-re lim-down t) + (1- (match-beginning 0)))) + (> (point) pos))))) + (setq lim-up beg lim-down end context-type 'inlinetask)) + ;; Return context boundaries and type. + (list lim-up lim-down context-type)))))) + +(defun org-list-struct () + "Return structure of list at point. + +A list structure is an alist where key is point at item, and +values are: +1. indentation, +2. bullet with trailing whitespace, +3. bullet counter, if any, +4. checkbox, if any, +5. description tag, if any, +6. position at item end. + +Thus the following list, where numbers in parens are +point-at-bol: + +- [X] first item (1) + 1. sub-item 1 (18) + 5. [@5] sub-item 2 (34) + some other text belonging to first item (55) +- last item (97) + + tag :: description (109) + (131) + +will get the following structure: + +\(\(1 0 \"- \" nil \"[X]\" nil 97\) + \(18 2 \"1. \" nil nil nil 34\) + \(34 2 \"5. \" \"5\" nil nil 55\) + \(97 0 \"- \" nil nil nil 131\) + \(109 2 \"+ \" nil nil \"tag\" 131\) + +Assume point is at an item." + (save-excursion + (beginning-of-line) + (let* ((case-fold-search t) + (context (org-list-context)) + (lim-up (car context)) + (lim-down (nth 1 context)) + (text-min-ind 10000) + (item-re (org-item-re)) + (drawers-re (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$")) + (inlinetask-re (and (featurep 'org-inlinetask) + (org-inlinetask-outline-regexp))) + (beg-cell (cons (point) (org-get-indentation))) + ind itm-lst itm-lst-2 end-lst end-lst-2 struct + (assoc-at-point + (function + ;; Return association at point. + (lambda (ind) + (looking-at org-list-full-item-re) + (let ((bullet (match-string-no-properties 1))) + (list (point) + ind + bullet + (match-string-no-properties 2) ; counter + (match-string-no-properties 3) ; checkbox + ;; Description tag. + (and (save-match-data (string-match "[-+*]" bullet)) + (match-string-no-properties 4))))))) + (end-before-blank + (function + ;; Ensure list ends at the first blank line. + (lambda () + (skip-chars-backward " \r\t\n") + (min (1+ (point-at-eol)) lim-down))))) + ;; 1. Read list from starting item to its beginning, and save + ;; top item position and indentation in BEG-CELL. Also store + ;; ending position of items in END-LST. + (save-excursion + (catch 'exit + (while t + (let ((ind (org-get-indentation))) + (cond + ((<= (point) lim-up) + ;; At upward limit: if we ended at an item, store it, + ;; else dismiss useless data recorded above BEG-CELL. + ;; Jump to part 2. + (throw 'exit + (setq itm-lst + (if (not (looking-at item-re)) + (memq (assq (car beg-cell) itm-lst) itm-lst) + (setq beg-cell (cons (point) ind)) + (cons (funcall assoc-at-point ind) itm-lst))))) + ;; Looking at a list ending regexp. Dismiss useless + ;; data recorded above BEG-CELL. Jump to part 2. + ((looking-at org-list-end-re) + (throw 'exit + (setq itm-lst + (memq (assq (car beg-cell) itm-lst) itm-lst)))) + ;; Point is at an item. Add data to ITM-LST. It may + ;; also end a previous item: save it in END-LST. If + ;; ind is less or equal than BEG-CELL and there is no + ;; end at this ind or lesser, this item becomes the new + ;; BEG-CELL. + ((looking-at item-re) + (push (funcall assoc-at-point ind) itm-lst) + (push (cons ind (point)) end-lst) + (when (< ind text-min-ind) (setq beg-cell (cons (point) ind))) + (forward-line -1)) + ;; Skip blocks, drawers, inline tasks, blank lines. + ((and (looking-at "^[ \t]*#\\+end_") + (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) + ((and (looking-at "^[ \t]*:END:") + (re-search-backward drawers-re lim-up t)) + (beginning-of-line)) + ((and inlinetask-re (looking-at inlinetask-re)) + (org-inlinetask-goto-beginning) + (forward-line -1)) + ((looking-at "^[ \t]*$") + (forward-line -1)) + ;; From there, point is not at an item. Interpret + ;; line's indentation: + ;; - text at column 0 is necessarily out of any list. + ;; Dismiss data recorded above BEG-CELL. Jump to + ;; part 2. + ;; - any other case may be an ending position for an + ;; hypothetical item above. Store it and proceed. + ((zerop ind) + (throw 'exit + (setq itm-lst + (memq (assq (car beg-cell) itm-lst) itm-lst)))) + (t + (when (< ind text-min-ind) (setq text-min-ind ind)) + (push (cons ind (point)) end-lst) + (forward-line -1))))))) + ;; 2. Read list from starting point to its end, that is until we + ;; get out of context, or that a non-item line is less or + ;; equally indented than BEG-CELL's cdr. Also, store ending + ;; position of items in END-LST-2. + (catch 'exit + (while t + (let ((ind (org-get-indentation))) + (cond + ((>= (point) lim-down) + ;; At downward limit: this is de facto the end of the + ;; list. Save point as an ending position, and jump to + ;; part 3. + (throw 'exit + (push (cons 0 (funcall end-before-blank)) end-lst-2))) + ;; Looking at a list ending regexp. Save point as an + ;; ending position and jump to part 3. + ((looking-at org-list-end-re) + (throw 'exit (push (cons 0 (point)) end-lst-2))) + ((looking-at item-re) + ;; Point is at an item. Add data to ITM-LST-2. It may + ;; also end a previous item, so save it in END-LST-2. + (push (funcall assoc-at-point ind) itm-lst-2) + (push (cons ind (point)) end-lst-2) + (forward-line 1)) + ;; Skip inline tasks and blank lines along the way + ((and inlinetask-re (looking-at inlinetask-re)) + (org-inlinetask-goto-end)) + ((looking-at "^[ \t]*$") + (forward-line 1)) + ;; Ind is lesser or equal than BEG-CELL's. The list is + ;; over: store point as an ending position and jump to + ;; part 3. + ((<= ind (cdr beg-cell)) + (throw 'exit + (push (cons 0 (funcall end-before-blank)) end-lst-2))) + ;; Else, if ind is lesser or equal than previous item's, + ;; this is an ending position: store it. In any case, + ;; skip block or drawer at point, and move to next line. + (t + (when (<= ind (nth 1 (car itm-lst-2))) + (push (cons ind (point)) end-lst-2)) + (cond + ((and (looking-at "^[ \t]*#\\+begin_") + (re-search-forward "^[ \t]*#\\+end_" lim-down t))) + ((and (looking-at drawers-re) + (re-search-forward "^[ \t]*:END:" lim-down t)))) + (forward-line 1)))))) + (setq struct (append itm-lst (cdr (nreverse itm-lst-2))) + end-lst (append end-lst (cdr (nreverse end-lst-2)))) + ;; 3. Associate each item to its end position. + (org-list-struct-assoc-end struct end-lst) + ;; 4. Return STRUCT + struct))) + +(defun org-list-struct-assoc-end (struct end-list) + "Associate proper ending point to items in STRUCT. + +END-LIST is a pseudo-alist where car is indentation and cdr is +ending position. + +This function modifies STRUCT." + (let ((endings end-list)) + (mapc + (lambda (elt) + (let ((pos (car elt)) + (ind (nth 1 elt))) + ;; Remove end candidates behind current item. + (while (or (<= (cdar endings) pos)) + (pop endings)) + ;; Add end position to item assoc. + (let ((old-end (nthcdr 6 elt)) + (new-end (assoc-default ind endings '<=))) + (if old-end + (setcar old-end new-end) + (setcdr elt (append (cdr elt) (list new-end))))))) + struct))) + +(defun org-list-prevs-alist (struct) + "Return alist between item and previous item in STRUCT." + (let ((item-end-alist (mapcar (lambda (e) (cons (car e) (nth 6 e))) + struct))) + (mapcar (lambda (e) + (let ((prev (car (rassq (car e) item-end-alist)))) + (cons (car e) prev))) + struct))) + +(defun org-list-parents-alist (struct) + "Return alist between item and parent in STRUCT." + (let* ((ind-to-ori (list (list (nth 1 (car struct))))) + (top-item (org-list-get-top-point struct)) + (prev-pos (list top-item))) + (cons prev-pos + (mapcar (lambda (item) + (let ((pos (car item)) + (ind (nth 1 item)) + (prev-ind (caar ind-to-ori))) + (push pos prev-pos) + (cond + ((> prev-ind ind) + ;; A sub-list is over. Find the associated + ;; origin in IND-TO-ORI. If it cannot be + ;; found (ill-formed list), set its parent as + ;; the first item less indented. If there is + ;; none, make it a top-level item. + (setq ind-to-ori + (or (member (assq ind ind-to-ori) ind-to-ori) + (catch 'exit + (mapc + (lambda (e) + (when (< (car e) ind) + (throw 'exit (member e ind-to-ori)))) + ind-to-ori) + (list (list ind))))) + (cons pos (cdar ind-to-ori))) + ;; A sub-list starts. Every item at IND will + ;; have previous item as its parent. + ((< prev-ind ind) + (let ((origin (nth 1 prev-pos))) + (push (cons ind origin) ind-to-ori) + (cons pos origin))) + ;; Another item in the same sub-list: it shares + ;; the same parent as the previous item. + (t (cons pos (cdar ind-to-ori)))))) + (cdr struct))))) + + + +;;; Accessors + +(defsubst org-list-get-nth (n key struct) + "Return the Nth value of KEY in STRUCT." + (nth n (assq key struct))) + +(defun org-list-set-nth (n key struct new) + "Set the Nth value of KEY in STRUCT to NEW. +\nThis function modifies STRUCT." + (setcar (nthcdr n (assq key struct)) new)) + +(defsubst org-list-get-ind (item struct) + "Return indentation of ITEM in STRUCT." + (org-list-get-nth 1 item struct)) + +(defun org-list-set-ind (item struct ind) + "Set indentation of ITEM in STRUCT to IND. +\nThis function modifies STRUCT." + (org-list-set-nth 1 item struct ind)) + +(defsubst org-list-get-bullet (item struct) + "Return bullet of ITEM in STRUCT." + (org-list-get-nth 2 item struct)) + +(defun org-list-set-bullet (item struct bullet) + "Set bullet of ITEM in STRUCT to BULLET. +\nThis function modifies STRUCT." + (org-list-set-nth 2 item struct bullet)) + +(defsubst org-list-get-counter (item struct) + "Return counter of ITEM in STRUCT." + (org-list-get-nth 3 item struct)) + +(defsubst org-list-get-checkbox (item struct) + "Return checkbox of ITEM in STRUCT or nil." + (org-list-get-nth 4 item struct)) + +(defun org-list-set-checkbox (item struct checkbox) + "Set checkbox of ITEM in STRUCT to CHECKBOX. +\nThis function modifies STRUCT." + (org-list-set-nth 4 item struct checkbox)) + +(defsubst org-list-get-tag (item struct) + "Return end position of ITEM in STRUCT." + (org-list-get-nth 5 item struct)) + +(defun org-list-get-item-end (item struct) + "Return end position of ITEM in STRUCT." + (org-list-get-nth 6 item struct)) + +(defun org-list-get-item-end-before-blank (item struct) + "Return point at end of ITEM in STRUCT, before any blank line. +Point returned is at end of line." + (save-excursion + (goto-char (org-list-get-item-end item struct)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + +(defun org-list-get-parent (item struct parents) + "Return parent of ITEM or nil. +STRUCT is the list structure. PARENTS is the alist of parents, +as returned by `org-list-parents-alist'." + (let ((parents (or parents (org-list-parents-alist struct)))) + (cdr (assq item parents)))) + +(defun org-list-has-child-p (item struct) + "Non-nil if ITEM has a child. + +STRUCT is the list structure. + +Value returned is the position of the first child of ITEM." + (let ((ind (org-list-get-ind item struct)) + (child-maybe (car (nth 1 (member (assq item struct) struct))))) + (when (and child-maybe + (< ind (org-list-get-ind child-maybe struct))) + child-maybe))) + +(defun org-list-get-next-item (item struct prevs) + "Return next item in same sub-list as ITEM, or nil. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." + (car (rassq item prevs))) + +(defun org-list-get-prev-item (item struct prevs) + "Return previous item in same sub-list as ITEM, or nil. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." + (cdr (assq item prevs))) + +(defun org-list-get-subtree (item struct) + "List all items having ITEM as a common ancestor, or nil. +STRUCT is the list structure." + (let* ((item-end (org-list-get-item-end item struct)) + (sub-struct (cdr (member (assq item struct) struct))) + subtree) + (catch 'exit + (mapc (lambda (e) + (let ((pos (car e))) + (if (< pos item-end) (push pos subtree) (throw 'exit nil)))) + sub-struct)) + (nreverse subtree))) + +(defun org-list-get-all-items (item struct prevs) + "List all items in the same sub-list as ITEM. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." + (let ((prev-item item) + (next-item item) + before-item after-item) + (while (setq prev-item (org-list-get-prev-item prev-item struct prevs)) + (push prev-item before-item)) + (while (setq next-item (org-list-get-next-item next-item struct prevs)) + (push next-item after-item)) + (append before-item (list item) (nreverse after-item)))) + +(defun org-list-get-children (item struct parents) + "List all children of ITEM, or nil. +STRUCT is the list structure. PARENTS is the alist of parents, +as returned by `org-list-parents-alist'." + (let (all child) + (while (setq child (car (rassq item parents))) + (setq parents (cdr (member (assq child parents) parents))) + (push child all)) + (nreverse all))) + +(defun org-list-get-top-point (struct) + "Return point at beginning of list. +STRUCT is the list structure." + (caar struct)) + +(defun org-list-get-bottom-point (struct) + "Return point at bottom of list. +STRUCT is the list structure." + (apply 'max + (mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct))) + +(defun org-list-get-list-begin (item struct prevs) + "Return point at beginning of sub-list ITEM belongs. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." + (let ((first-item item) prev-item) + (while (setq prev-item (org-list-get-prev-item first-item struct prevs)) + (setq first-item prev-item)) + first-item)) + +(defalias 'org-list-get-first-item 'org-list-get-list-begin) + +(defun org-list-get-last-item (item struct prevs) + "Return point at last item of sub-list ITEM belongs. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." + (let ((last-item item) next-item) + (while (setq next-item (org-list-get-next-item last-item struct prevs)) + (setq last-item next-item)) + last-item)) + +(defun org-list-get-list-end (item struct prevs) + "Return point at end of sub-list ITEM belongs. +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'." + (org-list-get-item-end (org-list-get-last-item item struct prevs) struct)) + +(defun org-list-get-list-type (item struct prevs) + "Return the type of the list containing ITEM, as a symbol. + +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'. + +Possible types are `descriptive', `ordered' and `unordered'. The +type is determined by the first item of the list." + (let ((first (org-list-get-list-begin item struct prevs))) + (cond + ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered) + ((org-list-get-tag first struct) 'descriptive) + (t 'unordered)))) + +(defun org-list-get-item-number (item struct prevs parents) + "Return ITEM's sequence number. + +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'. PARENTS is the +alist of ancestors, as returned by `org-list-parents-alist'. + +Return value is a list of integers. Counters have an impact on +that value." + (let ((get-relative-number + (function + (lambda (item struct prevs) + ;; Return relative sequence number of ITEM in the sub-list + ;; it belongs. STRUCT is the list structure. PREVS is + ;; the alist of previous items. + (let ((seq 0) (pos item) counter) + (while (and (not (setq counter (org-list-get-counter pos struct))) + (setq pos (org-list-get-prev-item pos struct prevs))) + (incf seq)) + (if (not counter) (1+ seq) + (cond + ((string-match "[A-Za-z]" counter) + (+ (- (string-to-char (upcase (match-string 0 counter))) 64) + seq)) + ((string-match "[0-9]+" counter) + (+ (string-to-number (match-string 0 counter)) seq)) + (t (1+ seq))))))))) + ;; Cons each parent relative number into return value (OUT). + (let ((out (list (funcall get-relative-number item struct prevs))) + (parent item)) + (while (setq parent (org-list-get-parent parent struct parents)) + (push (funcall get-relative-number parent struct prevs) out)) + ;; Return value. + out))) + + + +;;; Searching + +(defun org-list-search-generic (search re bound noerr) + "Search a string in valid contexts for lists. +Arguments SEARCH, RE, BOUND and NOERR are similar to those used +in `re-search-forward'." + (catch 'exit + (let ((origin (point))) + (while t + ;; 1. No match: return to origin or bound, depending on NOERR. + (unless (funcall search re bound noerr) + (throw 'exit (and (goto-char (if (memq noerr '(t nil)) origin bound)) + nil))) + ;; 2. Match in valid context: return point. Else, continue + ;; searching. + (when (org-list-in-valid-context-p) (throw 'exit (point))))))) + +(defun org-list-search-backward (regexp &optional bound noerror) + "Like `re-search-backward' but stop only where lists are recognized. +Arguments REGEXP, BOUND and NOERROR are similar to those used in +`re-search-backward'." + (org-list-search-generic #'re-search-backward + regexp (or bound (point-min)) noerror)) + +(defun org-list-search-forward (regexp &optional bound noerror) + "Like `re-search-forward' but stop only where lists are recognized. +Arguments REGEXP, BOUND and NOERROR are similar to those used in +`re-search-forward'." + (org-list-search-generic #'re-search-forward + regexp (or bound (point-max)) noerror)) + + + +;;; Methods on structures + +(defsubst org-list-bullet-string (bullet) + "Return BULLET with the correct number of whitespaces. +It determines the number of whitespaces to append by looking at +`org-list-two-spaces-after-bullet-regexp'." + (save-match-data + (let ((spaces (if (and org-list-two-spaces-after-bullet-regexp + (string-match + org-list-two-spaces-after-bullet-regexp bullet)) + " " + " "))) + (if (string-match "\\S-+\\([ \t]*\\)" bullet) + (replace-match spaces nil nil bullet 1) + bullet)))) + +(defun org-list-swap-items (beg-A beg-B struct) + "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. + +Blank lines at the end of items are left in place. Item +visibility is preserved. Return the new structure after the +changes. + +Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong +to the same sub-list. + +This function modifies STRUCT." + (save-excursion + (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct)) + (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct)) + (end-A (org-list-get-item-end beg-A struct)) + (end-B (org-list-get-item-end beg-B struct)) + (size-A (- end-A-no-blank beg-A)) + (size-B (- end-B-no-blank beg-B)) + (body-A (buffer-substring beg-A end-A-no-blank)) + (body-B (buffer-substring beg-B end-B-no-blank)) + (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)) + (sub-A (cons beg-A (org-list-get-subtree beg-A struct))) + (sub-B (cons beg-B (org-list-get-subtree beg-B struct))) + ;; Store overlays responsible for visibility status. We + ;; also need to store their boundaries as they will be + ;; removed from buffer. + (overlays (cons + (mapcar (lambda (ov) + (list ov (overlay-start ov) (overlay-end ov))) + (overlays-in beg-A end-A)) + (mapcar (lambda (ov) + (list ov (overlay-start ov) (overlay-end ov))) + (overlays-in beg-B end-B))))) + ;; 1. Move effectively items in buffer. + (goto-char beg-A) + (delete-region beg-A end-B-no-blank) + (insert (concat body-B between-A-no-blank-and-B body-A)) + ;; 2. Now modify struct. No need to re-read the list, the + ;; transformation is just a shift of positions. Some special + ;; attention is required for items ending at END-A and END-B + ;; as empty spaces are not moved there. In others words, + ;; item BEG-A will end with whitespaces that were at the end + ;; of BEG-B and the same applies to BEG-B. + (mapc (lambda (e) + (let ((pos (car e))) + (cond + ((< pos beg-A)) + ((memq pos sub-A) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) + (setcar (nthcdr 6 e) + (+ end-e (- end-B-no-blank end-A-no-blank))) + (when (= end-e end-A) (setcar (nthcdr 6 e) end-B)))) + ((memq pos sub-B) + (let ((end-e (nth 6 e))) + (setcar e (- (+ pos beg-A) beg-B)) + (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) + (when (= end-e end-B) + (setcar (nthcdr 6 e) + (+ beg-A size-B (- end-A end-A-no-blank)))))) + ((< pos beg-B) + (let ((end-e (nth 6 e))) + (setcar e (+ pos (- size-B size-A))) + (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) + struct) + (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2))))) + ;; Restore visibility status, by moving overlays to their new + ;; position. + (mapc (lambda (ov) + (move-overlay + (car ov) + (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A)) + (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A)))) + (car overlays)) + (mapc (lambda (ov) + (move-overlay (car ov) + (+ (nth 1 ov) (- beg-A beg-B)) + (+ (nth 2 ov) (- beg-A beg-B)))) + (cdr overlays)) + ;; Return structure. + struct))) + +(defun org-list-separating-blank-lines-number (pos struct prevs) + "Return number of blank lines that should separate items in list. + +POS is the position of point where `org-list-insert-item' was called. + +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'. + +Assume point is at item's beginning. If the item is alone, apply +some heuristics to guess the result." + (save-excursion + (let ((item (point)) + (insert-blank-p + (cdr (assq 'plain-list-item org-blank-before-new-entry))) + usr-blank + (count-blanks + (function + (lambda () + ;; Count blank lines above beginning of line. + (save-excursion + (count-lines (goto-char (point-at-bol)) + (progn (skip-chars-backward " \r\t\n") + (forward-line) + (point)))))))) + (cond + ;; Trivial cases where there should be none. + ((or org-list-empty-line-terminates-plain-lists (not insert-blank-p)) 0) + ;; When `org-blank-before-new-entry' says so, it is 1. + ((eq insert-blank-p t) 1) + ;; `plain-list-item' is 'auto. Count blank lines separating + ;; neighbors' items in list. + (t (let ((next-p (org-list-get-next-item item struct prevs))) + (cond + ;; Is there a next item? + (next-p (goto-char next-p) + (funcall count-blanks)) + ;; Is there a previous item? + ((org-list-get-prev-item item struct prevs) + (funcall count-blanks)) + ;; User inserted blank lines, trust him. + ((and (> pos (org-list-get-item-end-before-blank item struct)) + (> (save-excursion (goto-char pos) + (setq usr-blank (funcall count-blanks))) + 0)) + usr-blank) + ;; Are there blank lines inside the list so far? + ((save-excursion + (goto-char (org-list-get-top-point struct)) + ;; Do not use `org-list-search-forward' so blank lines + ;; in blocks can be counted in. + (re-search-forward + "^[ \t]*$" (org-list-get-item-end-before-blank item struct) t)) + 1) + ;; Default choice: no blank line. + (t 0)))))))) + +(defun org-list-insert-item (pos struct prevs &optional checkbox after-bullet) + "Insert a new list item at POS and return the new structure. +If POS is before first character after bullet of the item, the +new item will be created before the current one. + +STRUCT is the list structure. PREVS is the alist of previous +items, as returned by `org-list-prevs-alist'. + +Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET +after the bullet. Cursor will be after this text once the +function ends. + +This function modifies STRUCT." + (let ((case-fold-search t)) + ;; 1. Get information about list: position of point with regards + ;; to item start (BEFOREP), blank lines number separating items + ;; (BLANK-NB), if we're allowed to (SPLIT-LINE-P). + (let* ((item (progn (goto-char pos) (goto-char (org-list-get-item-begin)))) + (item-end (org-list-get-item-end item struct)) + (item-end-no-blank (org-list-get-item-end-before-blank item struct)) + (beforep + (progn + (looking-at org-list-full-item-re) + ;; Do not count tag in a non-descriptive list. + (<= pos (if (and (match-beginning 4) + (save-match-data + (string-match "[.)]" (match-string 1)))) + (match-beginning 4) + (match-end 0))))) + (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item)) + (blank-nb (org-list-separating-blank-lines-number + pos struct prevs)) + ;; 2. Build the new item to be created. Concatenate same + ;; bullet as item, checkbox, text AFTER-BULLET if + ;; provided, and text cut from point to end of item + ;; (TEXT-CUT) to form item's BODY. TEXT-CUT depends on + ;; BEFOREP and SPLIT-LINE-P. The difference of size + ;; between what was cut and what was inserted in buffer + ;; is stored in SIZE-OFFSET. + (ind (org-list-get-ind item struct)) + (ind-size (if indent-tabs-mode + (+ (/ ind tab-width) (mod ind tab-width)) + ind)) + (bullet (org-list-bullet-string (org-list-get-bullet item struct))) + (box (when checkbox "[ ]")) + (text-cut + (and (not beforep) split-line-p + (progn + (goto-char pos) + ;; If POS is greater than ITEM-END, then point is + ;; in some white lines after the end of the list. + ;; Those must be removed, or they will be left, + ;; stacking up after the list. + (when (< item-end pos) + (delete-region (1- item-end) (point-at-eol))) + (skip-chars-backward " \r\t\n") + (setq pos (point)) + (delete-and-extract-region pos item-end-no-blank)))) + (body (concat bullet (when box (concat box " ")) after-bullet + (and text-cut + (if (string-match "\\`[ \t]+" text-cut) + (replace-match "" t t text-cut) + text-cut)))) + (item-sep (make-string (1+ blank-nb) ?\n)) + (item-size (+ ind-size (length body) (length item-sep))) + (size-offset (- item-size (length text-cut)))) + ;; 4. Insert effectively item into buffer. + (goto-char item) + (org-indent-to-column ind) + (insert body item-sep) + ;; 5. Add new item to STRUCT. + (mapc (lambda (e) + (let ((p (car e)) (end (nth 6 e))) + (cond + ;; Before inserted item, positions don't change but + ;; an item ending after insertion has its end shifted + ;; by SIZE-OFFSET. + ((< p item) + (when (> end item) (setcar (nthcdr 6 e) (+ end size-offset)))) + ;; Trivial cases where current item isn't split in + ;; two. Just shift every item after new one by + ;; ITEM-SIZE. + ((or beforep (not split-line-p)) + (setcar e (+ p item-size)) + (setcar (nthcdr 6 e) (+ end item-size))) + ;; Item is split in two: elements before POS are just + ;; shifted by ITEM-SIZE. In the case item would end + ;; after split POS, ending is only shifted by + ;; SIZE-OFFSET. + ((< p pos) + (setcar e (+ p item-size)) + (if (< end pos) + (setcar (nthcdr 6 e) (+ end item-size)) + (setcar (nthcdr 6 e) (+ end size-offset)))) + ;; Elements after POS are moved into new item. + ;; Length of ITEM-SEP has to be removed as ITEM-SEP + ;; doesn't appear in buffer yet. + ((< p item-end) + (setcar e (+ p size-offset (- item pos (length item-sep)))) + (if (= end item-end) + (setcar (nthcdr 6 e) (+ item item-size)) + (setcar (nthcdr 6 e) + (+ end size-offset + (- item pos (length item-sep)))))) + ;; Elements at ITEM-END or after are only shifted by + ;; SIZE-OFFSET. + (t (setcar e (+ p size-offset)) + (setcar (nthcdr 6 e) (+ end size-offset)))))) + struct) + (push (list item ind bullet nil box nil (+ item item-size)) struct) + (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2))))) + ;; 6. If not BEFOREP, new item must appear after ITEM, so + ;; exchange ITEM with the next item in list. Position cursor + ;; after bullet, counter, checkbox, and label. + (if beforep + (goto-char item) + (setq struct (org-list-swap-items item (+ item item-size) struct)) + (goto-char (org-list-get-next-item + item struct (org-list-prevs-alist struct)))) + struct))) + +(defun org-list-delete-item (item struct) + "Remove ITEM from the list and return the new structure. + +STRUCT is the list structure." + (let* ((end (org-list-get-item-end item struct)) + (beg (if (= (org-list-get-bottom-point struct) end) + ;; If ITEM ends with the list, delete blank lines + ;; before it. + (save-excursion + (goto-char item) + (skip-chars-backward " \r\t\n") + (min (1+ (point-at-eol)) (point-max))) + item))) + ;; Remove item from buffer. + (delete-region beg end) + ;; Remove item from structure and shift others items accordingly. + ;; Don't forget to shift also ending position when appropriate. + (let ((size (- end beg))) + (delq nil (mapcar (lambda (e) + (let ((pos (car e))) + (cond + ((< pos item) + (let ((end-e (nth 6 e))) + (cond + ((< end-e item) e) + ((= end-e item) + (append (butlast e) (list beg))) + (t + (append (butlast e) (list (- end-e size))))))) + ((< pos end) nil) + (t + (cons (- pos size) + (append (butlast (cdr e)) + (list (- (nth 6 e) size)))))))) + struct))))) + +(defun org-list-send-item (item dest struct) + "Send ITEM to destination DEST. + +STRUCT is the list structure. + +DEST can have various values. + +If DEST is a buffer position, the function will assume it points +to another item in the same list as ITEM, and will move the +latter just before the former. + +If DEST is `begin' (respectively `end'), ITEM will be moved at +the beginning (respectively end) of the list it belongs to. + +If DEST is a string like \"N\", where N is an integer, ITEM will +be moved at the Nth position in the list. + +If DEST is `kill', ITEM will be deleted and its body will be +added to the kill-ring. + +If DEST is `delete', ITEM will be deleted. + +Visibility of item is preserved. + +This function returns, destructively, the new list structure." + (let* ((prevs (org-list-prevs-alist struct)) + (item-end (org-list-get-item-end item struct)) + ;; Grab full item body minus its bullet. + (body (org-trim + (buffer-substring + (save-excursion + (goto-char item) + (looking-at + (concat "[ \t]*" + (regexp-quote (org-list-get-bullet item struct)))) + (match-end 0)) + item-end))) + ;; Change DEST into a buffer position. A trick is needed + ;; when ITEM is meant to be sent at the end of the list. + ;; Indeed, by setting locally `org-M-RET-may-split-line' to + ;; nil and insertion point (INS-POINT) to the first line's + ;; end of the last item, we ensure the new item will be + ;; inserted after the last item, and not after any of its + ;; hypothetical sub-items. + (ins-point (cond + ((or (eq dest 'kill) (eq dest 'delete))) + ((eq dest 'begin) + (setq dest (org-list-get-list-begin item struct prevs))) + ((eq dest 'end) + (setq dest (org-list-get-list-end item struct prevs)) + (save-excursion + (goto-char (org-list-get-last-item item struct prevs)) + (point-at-eol))) + ((string-match "\\`[0-9]+\\'" dest) + (let* ((all (org-list-get-all-items item struct prevs)) + (len (length all)) + (index (mod (string-to-number dest) len))) + (if (not (zerop index)) + (setq dest (nth (1- index) all)) + ;; Send ITEM at the end of the list. + (setq dest (org-list-get-list-end item struct prevs)) + (save-excursion + (goto-char + (org-list-get-last-item item struct prevs)) + (point-at-eol))))) + (t dest))) + (org-M-RET-may-split-line nil) + ;; Store visibility. + (visibility (overlays-in item item-end))) + (cond + ((eq dest 'delete) (org-list-delete-item item struct)) + ((eq dest 'kill) + (kill-new body) + (org-list-delete-item item struct)) + ((and (integerp dest) (/= item ins-point)) + (setq item (copy-marker item)) + (setq struct (org-list-insert-item ins-point struct prevs nil body)) + ;; 1. Structure returned by `org-list-insert-item' may not be + ;; accurate, as it cannot see sub-items included in BODY. + ;; Thus, first compute the real structure so far. + (let ((moved-items + (cons (marker-position item) + (org-list-get-subtree (marker-position item) struct))) + (new-end (org-list-get-item-end (point) struct)) + (old-end (org-list-get-item-end (marker-position item) struct)) + (new-item (point)) + (shift (- (point) item))) + ;; 1.1. Remove the item just created in structure. + (setq struct (delete (assq new-item struct) struct)) + ;; 1.2. Copy ITEM and any of its sub-items at NEW-ITEM. + (setq struct (sort + (append + struct + (mapcar (lambda (e) + (let* ((cell (assq e struct)) + (pos (car cell)) + (end (nth 6 cell))) + (cons (+ pos shift) + (append (butlast (cdr cell)) + (list (if (= end old-end) + new-end + (+ end shift))))))) + moved-items)) + (lambda (e1 e2) (< (car e1) (car e2)))))) + ;; 2. Restore visibility. + (mapc (lambda (ov) + (move-overlay ov + (+ (overlay-start ov) (- (point) item)) + (+ (overlay-end ov) (- (point) item)))) + visibility) + ;; 3. Eventually delete extra copy of the item and clean marker. + (prog1 (org-list-delete-item (marker-position item) struct) + (move-marker item nil))) + (t struct)))) + +(defun org-list-struct-outdent (start end struct parents) + "Outdent items between positions START and END. + +STRUCT is the list structure. PARENTS is the alist of items' +parents, as returned by `org-list-parents-alist'. + +START is included, END excluded." + (let* (acc + (out (lambda (cell) + (let* ((item (car cell)) + (parent (cdr cell))) + (cond + ;; Item not yet in zone: keep association. + ((< item start) cell) + ;; Item out of zone: follow associations in ACC. + ((>= item end) + (let ((convert (and parent (assq parent acc)))) + (if convert (cons item (cdr convert)) cell))) + ;; Item has no parent: error + ((not parent) + (error "Cannot outdent top-level items")) + ;; Parent is outdented: keep association. + ((>= parent start) + (push (cons parent item) acc) cell) + (t + ;; Parent isn't outdented: reparent to grand-parent. + (let ((grand-parent (org-list-get-parent + parent struct parents))) + (push (cons parent item) acc) + (cons item grand-parent)))))))) + (mapcar out parents))) + +(defun org-list-struct-indent (start end struct parents prevs) + "Indent items between positions START and END. + +STRUCT is the list structure. PARENTS is the alist of parents +and PREVS is the alist of previous items, returned by, +respectively, `org-list-parents-alist' and +`org-list-prevs-alist'. + +START is included and END excluded. + +STRUCT may be modified if `org-list-demote-modify-bullet' matches +bullets between START and END." + (let* (acc + (set-assoc (lambda (cell) (push cell acc) cell)) + (change-bullet-maybe + (function + (lambda (item) + (let ((new-bul-p + (cdr (assoc + ;; Normalize ordered bullets. + (let ((bul (org-trim + (org-list-get-bullet item struct)))) + (cond ((string-match "[A-Z]\\." bul) "A.") + ((string-match "[A-Z])" bul) "A)") + ((string-match "[a-z]\\." bul) "a.") + ((string-match "[a-z])" bul) "a)") + ((string-match "[0-9]\\." bul) "1.") + ((string-match "[0-9])" bul) "1)") + (t bul))) + org-list-demote-modify-bullet)))) + (when new-bul-p (org-list-set-bullet item struct new-bul-p)))))) + (ind + (lambda (cell) + (let* ((item (car cell)) + (parent (cdr cell))) + (cond + ;; Item not yet in zone: keep association. + ((< item start) cell) + ((>= item end) + ;; Item out of zone: follow associations in ACC. + (let ((convert (assq parent acc))) + (if convert (cons item (cdr convert)) cell))) + (t + ;; Item is in zone... + (let ((prev (org-list-get-prev-item item struct prevs))) + ;; Check if bullet needs to be changed. + (funcall change-bullet-maybe item) + (cond + ;; First item indented but not parent: error + ((and (not prev) (< parent start)) + (error "Cannot indent the first item of a list")) + ;; First item and parent indented: keep same + ;; parent. + ((not prev) (funcall set-assoc cell)) + ;; Previous item not indented: reparent to it. + ((< prev start) (funcall set-assoc (cons item prev))) + ;; Previous item indented: reparent like it. + (t + (funcall set-assoc + (cons item (cdr (assq prev acc))))))))))))) + (mapcar ind parents))) + + + +;;; Repairing structures + +(defun org-list-use-alpha-bul-p (first struct prevs) + "Non-nil if list starting at FIRST can have alphabetical bullets. + +STRUCT is list structure. PREVS is the alist of previous items, +as returned by `org-list-prevs-alist'." + (and org-list-allow-alphabetical + (catch 'exit + (let ((item first) (ascii 64) (case-fold-search nil)) + ;; Pretend that bullets are uppercase and check if alphabet + ;; is sufficient, taking counters into account. + (while item + (let ((bul (org-list-get-bullet item struct)) + (count (org-list-get-counter item struct))) + ;; Virtually determine current bullet + (if (and count (string-match "[a-zA-Z]" count)) + ;; Counters are not case-sensitive. + (setq ascii (string-to-char (upcase count))) + (setq ascii (1+ ascii))) + ;; Test if bullet would be over z or Z. + (if (> ascii 90) + (throw 'exit nil) + (setq item (org-list-get-next-item item struct prevs))))) + ;; All items checked. All good. + t)))) + +(defun org-list-inc-bullet-maybe (bullet) + "Increment BULLET if applicable." + (let ((case-fold-search nil)) + (cond + ;; Num bullet: increment it. + ((string-match "[0-9]+" bullet) + (replace-match + (number-to-string (1+ (string-to-number (match-string 0 bullet)))) + nil nil bullet)) + ;; Alpha bullet: increment it. + ((string-match "[A-Za-z]" bullet) + (replace-match + (char-to-string (1+ (string-to-char (match-string 0 bullet)))) + nil nil bullet)) + ;; Unordered bullet: leave it. + (t bullet)))) + +(defun org-list-struct-fix-bul (struct prevs) + "Verify and correct bullets in STRUCT. +PREVS is the alist of previous items, as returned by +`org-list-prevs-alist'. + +This function modifies STRUCT." + (let ((case-fold-search nil) + (fix-bul + (function + ;; Set bullet of ITEM in STRUCT, depending on the type of + ;; first item of the list, the previous bullet and counter + ;; if any. + (lambda (item) + (let* ((prev (org-list-get-prev-item item struct prevs)) + (prev-bul (and prev (org-list-get-bullet prev struct))) + (counter (org-list-get-counter item struct)) + (bullet (org-list-get-bullet item struct)) + (alphap (and (not prev) + (org-list-use-alpha-bul-p item struct prevs)))) + (org-list-set-bullet + item struct + (org-list-bullet-string + (cond + ;; Alpha counter in alpha list: use counter. + ((and prev counter + (string-match "[a-zA-Z]" counter) + (string-match "[a-zA-Z]" prev-bul)) + ;; Use cond to be sure `string-match' is used in + ;; both cases. + (let ((real-count + (cond + ((string-match "[a-z]" prev-bul) (downcase counter)) + ((string-match "[A-Z]" prev-bul) (upcase counter))))) + (replace-match real-count nil nil prev-bul))) + ;; Num counter in a num list: use counter. + ((and prev counter + (string-match "[0-9]+" counter) + (string-match "[0-9]+" prev-bul)) + (replace-match counter nil nil prev-bul)) + ;; No counter: increase, if needed, previous bullet. + (prev + (org-list-inc-bullet-maybe (org-list-get-bullet prev struct))) + ;; Alpha counter at first item: use counter. + ((and counter (org-list-use-alpha-bul-p item struct prevs) + (string-match "[A-Za-z]" counter) + (string-match "[A-Za-z]" bullet)) + (let ((real-count + (cond + ((string-match "[a-z]" bullet) (downcase counter)) + ((string-match "[A-Z]" bullet) (upcase counter))))) + (replace-match real-count nil nil bullet))) + ;; Num counter at first item: use counter. + ((and counter + (string-match "[0-9]+" counter) + (string-match "[0-9]+" bullet)) + (replace-match counter nil nil bullet)) + ;; First bullet is alpha uppercase: use "A". + ((and alphap (string-match "[A-Z]" bullet)) + (replace-match "A" nil nil bullet)) + ;; First bullet is alpha lowercase: use "a". + ((and alphap (string-match "[a-z]" bullet)) + (replace-match "a" nil nil bullet)) + ;; First bullet is num: use "1". + ((string-match "\\([0-9]+\\|[A-Za-z]\\)" bullet) + (replace-match "1" nil nil bullet)) + ;; Not an ordered list: keep bullet. + (t bullet))))))))) + (mapc fix-bul (mapcar 'car struct)))) + +(defun org-list-struct-fix-ind (struct parents &optional bullet-size) + "Verify and correct indentation in STRUCT. + +PARENTS is the alist of parents, as returned by +`org-list-parents-alist'. + +If numeric optional argument BULLET-SIZE is set, assume all +bullets in list have this length to determine new indentation. + +This function modifies STRUCT." + (let* ((ancestor (org-list-get-top-point struct)) + (top-ind (org-list-get-ind ancestor struct)) + (new-ind + (lambda (item) + (let ((parent (org-list-get-parent item struct parents))) + (if parent + ;; Indent like parent + length of parent's bullet + + ;; sub-list offset. + (org-list-set-ind + item struct (+ (or bullet-size + (length + (org-list-get-bullet parent struct))) + (org-list-get-ind parent struct) + org-list-indent-offset)) + ;; If no parent, indent like top-point. + (org-list-set-ind item struct top-ind)))))) + (mapc new-ind (mapcar 'car (cdr struct))))) + +(defun org-list-struct-fix-box (struct parents prevs &optional ordered) + "Verify and correct checkboxes in STRUCT. + +PARENTS is the alist of parents and PREVS is the alist of +previous items, as returned by, respectively, +`org-list-parents-alist' and `org-list-prevs-alist'. + +If ORDERED is non-nil, a checkbox can only be checked when every +checkbox before it is checked too. If there was an attempt to +break this rule, the function will return the blocking item. In +all others cases, the return value will be nil. + +This function modifies STRUCT." + (let ((all-items (mapcar 'car struct)) + (set-parent-box + (function + (lambda (item) + (let* ((box-list + (mapcar (lambda (child) + (org-list-get-checkbox child struct)) + (org-list-get-children item struct parents)))) + (org-list-set-checkbox + item struct + (cond + ((and (member "[ ]" box-list) (member "[X]" box-list)) "[-]") + ((member "[-]" box-list) "[-]") + ((member "[X]" box-list) "[X]") + ((member "[ ]" box-list) "[ ]") + ;; Parent has no boxed child: leave box as-is. + (t (org-list-get-checkbox item struct)))))))) + parent-list) + ;; 1. List all parents with a checkbox. + (mapc + (lambda (e) + (let* ((parent (org-list-get-parent e struct parents)) + (parent-box-p (org-list-get-checkbox parent struct))) + (when (and parent-box-p (not (memq parent parent-list))) + (push parent parent-list)))) + all-items) + ;; 2. Sort those parents by decreasing indentation. + (setq parent-list (sort parent-list + (lambda (e1 e2) + (> (org-list-get-ind e1 struct) + (org-list-get-ind e2 struct))))) + ;; 3. For each parent, get all children's checkboxes to determine + ;; and set its checkbox accordingly. + (mapc set-parent-box parent-list) + ;; 4. If ORDERED is set, see if we need to uncheck some boxes. + (when ordered + (let* ((box-list + (mapcar (lambda (e) (org-list-get-checkbox e struct)) all-items)) + (after-unchecked (member "[ ]" box-list))) + ;; There are boxes checked after an unchecked one: fix that. + (when (member "[X]" after-unchecked) + (let ((index (- (length struct) (length after-unchecked)))) + (mapc (lambda (e) + (when (org-list-get-checkbox e struct) + (org-list-set-checkbox e struct "[ ]"))) + (nthcdr index all-items)) + ;; Verify once again the structure, without ORDERED. + (org-list-struct-fix-box struct parents prevs nil) + ;; Return blocking item. + (nth index all-items))))))) + +(defun org-list-struct-fix-item-end (struct) + "Verify and correct each item end position in STRUCT. + +This function modifies STRUCT." + (let (end-list acc-end) + (mapc (lambda (e) + (let* ((pos (car e)) + (ind-pos (org-list-get-ind pos struct)) + (end-pos (org-list-get-item-end pos struct))) + (unless (assq end-pos struct) + ;; To determine real ind of an ending position that is + ;; not at an item, we have to find the item it belongs + ;; to: it is the last item (ITEM-UP), whose ending is + ;; further than the position we're interested in. + (let ((item-up (assoc-default end-pos acc-end '>))) + (push (cons + ;; Else part is for the bottom point. + (if item-up (+ (org-list-get-ind item-up struct) 2) 0) + end-pos) + end-list))) + (push (cons ind-pos pos) end-list) + (push (cons end-pos pos) acc-end))) + struct) + (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2))))) + (org-list-struct-assoc-end struct end-list))) + +(defun org-list-struct-apply-struct (struct old-struct) + "Apply set difference between STRUCT and OLD-STRUCT to the buffer. + +OLD-STRUCT is the structure before any modifications, and STRUCT +the structure to be applied. The function will only modify parts +of the list which have changed. + +Initial position of cursor is restored after the changes." + (let* ((origin (point-marker)) + (inlinetask-re (and (featurep 'org-inlinetask) + (org-inlinetask-outline-regexp))) + (item-re (org-item-re)) + (shift-body-ind + (function + ;; Shift the indentation between END and BEG by DELTA. If + ;; MAX-IND is non-nil, ensure that no line will be indented + ;; more than that number. Start from the line before END. + (lambda (end beg delta max-ind) + (goto-char end) + (skip-chars-backward " \r\t\n") + (beginning-of-line) + (while (or (> (point) beg) + (and (= (point) beg) + (not (looking-at item-re)))) + (cond + ;; Skip inline tasks. + ((and inlinetask-re (looking-at inlinetask-re)) + (org-inlinetask-goto-beginning)) + ;; Shift only non-empty lines. + ((org-looking-at-p "^[ \t]*\\S-") + (let ((i (org-get-indentation))) + (org-indent-line-to + (if max-ind (min (+ i delta) max-ind) (+ i delta)))))) + (forward-line -1))))) + (modify-item + (function + ;; Replace ITEM first line elements with new elements from + ;; STRUCT, if appropriate. + (lambda (item) + (goto-char item) + (let* ((new-ind (org-list-get-ind item struct)) + (old-ind (org-get-indentation)) + (new-bul (org-list-bullet-string + (org-list-get-bullet item struct))) + (old-bul (org-list-get-bullet item old-struct)) + (new-box (org-list-get-checkbox item struct))) + (looking-at org-list-full-item-re) + ;; a. Replace bullet + (unless (equal old-bul new-bul) + (replace-match new-bul nil nil nil 1)) + ;; b. Replace checkbox. + (cond + ((equal (match-string 3) new-box)) + ((and (match-string 3) new-box) + (replace-match new-box nil nil nil 3)) + ((match-string 3) + (looking-at ".*?\\([ \t]*\\[[ X-]\\]\\)") + (replace-match "" nil nil nil 1)) + (t (let ((counterp (match-end 2))) + (goto-char (if counterp (1+ counterp) (match-end 1))) + (insert (concat new-box (unless counterp " ")))))) + ;; c. Indent item to appropriate column. + (unless (= new-ind old-ind) + (delete-region (goto-char (point-at-bol)) + (progn (skip-chars-forward " \t") (point))) + (indent-to new-ind))))))) + ;; 1. First get list of items and position endings. We maintain + ;; two alists: ITM-SHIFT, determining indentation shift needed + ;; at item, and END-LIST, a pseudo-alist where key is ending + ;; position and value point. + (let (end-list acc-end itm-shift all-ends sliced-struct) + (dolist (e old-struct) + (let* ((pos (car e)) + (ind-pos (org-list-get-ind pos struct)) + (ind-old (org-list-get-ind pos old-struct)) + (bul-pos (org-list-get-bullet pos struct)) + (bul-old (org-list-get-bullet pos old-struct)) + (ind-shift (- (+ ind-pos (length bul-pos)) + (+ ind-old (length bul-old)))) + (end-pos (org-list-get-item-end pos old-struct))) + (push (cons pos ind-shift) itm-shift) + (unless (assq end-pos old-struct) + ;; To determine real ind of an ending position that + ;; is not at an item, we have to find the item it + ;; belongs to: it is the last item (ITEM-UP), whose + ;; ending is further than the position we're + ;; interested in. + (let ((item-up (assoc-default end-pos acc-end '>))) + (push (cons end-pos item-up) end-list))) + (push (cons end-pos pos) acc-end))) + ;; 2. Slice the items into parts that should be shifted by the + ;; same amount of indentation. Each slice follow the pattern + ;; (END BEG DELTA MAX-IND-OR-NIL). Slices are returned in + ;; reverse order. + (setq all-ends (sort (append (mapcar 'car itm-shift) + (org-uniquify (mapcar 'car end-list))) + '<)) + (while (cdr all-ends) + (let* ((up (pop all-ends)) + (down (car all-ends)) + (itemp (assq up struct)) + (item (if itemp up (cdr (assq up end-list)))) + (ind (cdr (assq item itm-shift))) + ;; If we're not at an item, there's a child of the item + ;; point belongs to above. Make sure this slice isn't + ;; moved within that child by specifying a maximum + ;; indentation. + (max-ind (and (not itemp) + (+ (org-list-get-ind item struct) + (length (org-list-get-bullet item struct)) + org-list-indent-offset)))) + (push (list down up ind max-ind) sliced-struct))) + ;; 3. Shift each slice in buffer, provided delta isn't 0, from + ;; end to beginning. Take a special action when beginning is + ;; at item bullet. + (dolist (e sliced-struct) + (unless (and (zerop (nth 2 e)) (not (nth 3 e))) + (apply shift-body-ind e)) + (let* ((beg (nth 1 e)) + (cell (assq beg struct))) + (unless (or (not cell) (equal cell (assq beg old-struct))) + (funcall modify-item beg))))) + ;; 4. Go back to initial position and clean marker. + (goto-char origin) + (move-marker origin nil))) + +(defun org-list-write-struct (struct parents &optional old-struct) + "Correct bullets, checkboxes and indentation in list at point. + +STRUCT is the list structure. PARENTS is the alist of parents, +as returned by `org-list-parents-alist'. + +When non-nil, optional argument OLD-STRUCT is the reference +structure of the list. It should be provided whenever STRUCT +doesn't correspond anymore to the real list in buffer." + ;; Order of functions matters here: checkboxes and endings need + ;; correct indentation to be set, and indentation needs correct + ;; bullets. + ;; + ;; 0. Save a copy of structure before modifications + (let ((old-struct (or old-struct (copy-tree struct)))) + ;; 1. Set a temporary, but coherent with PARENTS, indentation in + ;; order to get items endings and bullets properly + (org-list-struct-fix-ind struct parents 2) + ;; 2. Fix each item end to get correct prevs alist. + (org-list-struct-fix-item-end struct) + ;; 3. Get bullets right. + (let ((prevs (org-list-prevs-alist struct))) + (org-list-struct-fix-bul struct prevs) + ;; 4. Now get real indentation. + (org-list-struct-fix-ind struct parents) + ;; 5. Eventually fix checkboxes. + (org-list-struct-fix-box struct parents prevs)) + ;; 6. Apply structure modifications to buffer. + (org-list-struct-apply-struct struct old-struct))) + + + +;;; Misc Tools + +(defun org-apply-on-list (function init-value &rest args) + "Call FUNCTION on each item of the list at point. +FUNCTION must be called with at least one argument: INIT-VALUE, +that will contain the value returned by the function at the +previous item, plus ARGS extra arguments. + +FUNCTION is applied on items in reverse order. + +As an example, \(org-apply-on-list \(lambda \(result\) \(1+ result\)\) 0\) +will return the number of items in the current list. + +Sublists of the list are skipped. Cursor is always at the +beginning of the item." + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (item (copy-marker (point-at-bol))) + (all (org-list-get-all-items (marker-position item) struct prevs)) + (value init-value)) + (mapc (lambda (e) + (goto-char e) + (setq value (apply function value args))) + (nreverse all)) + (goto-char item) + (move-marker item nil) + value)) + +(defun org-list-set-item-visibility (item struct view) + "Set visibility of ITEM in STRUCT to VIEW. + +Possible values are: `folded', `children' or `subtree'. See +`org-cycle' for more information." + (cond + ((eq view 'folded) + (let ((item-end (org-list-get-item-end-before-blank item struct))) + ;; Hide from eol + (outline-flag-region (save-excursion (goto-char item) (point-at-eol)) + item-end t))) + ((eq view 'children) + ;; First show everything. + (org-list-set-item-visibility item struct 'subtree) + ;; Then fold every child. + (let* ((parents (org-list-parents-alist struct)) + (children (org-list-get-children item struct parents))) + (mapc (lambda (e) + (org-list-set-item-visibility e struct 'folded)) + children))) + ((eq view 'subtree) + ;; Show everything + (let ((item-end (org-list-get-item-end item struct))) + (outline-flag-region item item-end nil))))) + +(defun org-list-item-body-column (item) + "Return column at which body of ITEM should start." + (let (bpos bcol tpos tcol) + (save-excursion + (goto-char item) + (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)") + (setq bpos (match-beginning 1) tpos (match-end 0) + bcol (progn (goto-char bpos) (current-column)) + tcol (progn (goto-char tpos) (current-column))) + (when (> tcol (+ bcol org-description-max-indent)) + (setq tcol (+ bcol 5)))) + tcol)) + + + +;;; Interactive functions + +(defalias 'org-list-get-item-begin 'org-in-item-p) + +(defun org-beginning-of-item () + "Go to the beginning of the current item. +Throw an error when not in a list." + (interactive) + (let ((begin (org-in-item-p))) + (if begin (goto-char begin) (error "Not in an item")))) + +(defun org-beginning-of-item-list () + "Go to the beginning item of the current list or sublist. +Throw an error when not in a list." + (interactive) + (let ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct))) + (goto-char (org-list-get-list-begin begin struct prevs)))))) + +(defun org-end-of-item-list () + "Go to the end of the current list or sublist. +Throw an error when not in a list." + (interactive) + (let ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct))) + (goto-char (org-list-get-list-end begin struct prevs)))))) + +(defun org-end-of-item () + "Go to the end of the current item. +Throw an error when not in a list." + (interactive) + (let ((begin (org-in-item-p))) + (if (not begin) + (error "Not in an item") + (goto-char begin) + (let ((struct (org-list-struct))) + (goto-char (org-list-get-item-end begin struct)))))) + +(defun org-previous-item () + "Move to the beginning of the previous item. +Throw an error when not in a list. Also throw an error when at +first item, unless `org-list-use-circular-motion' is non-nil." + (interactive) + (let ((item (org-in-item-p))) + (if (not item) + (error "Not in an item") + (goto-char item) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (prevp (org-list-get-prev-item item struct prevs))) + (cond + (prevp (goto-char prevp)) + (org-list-use-circular-motion + (goto-char (org-list-get-last-item item struct prevs))) + (t (error "On first item"))))))) + +(defun org-next-item () + "Move to the beginning of the next item. +Throw an error when not in a list. Also throw an error when at +last item, unless `org-list-use-circular-motion' is non-nil." + (interactive) + (let ((item (org-in-item-p))) + (if (not item) + (error "Not in an item") + (goto-char item) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (prevp (org-list-get-next-item item struct prevs))) + (cond + (prevp (goto-char prevp)) + (org-list-use-circular-motion + (goto-char (org-list-get-first-item item struct prevs))) + (t (error "On last item"))))))) + +(defun org-move-item-down () + "Move the item at point down, i.e. swap with following item. +Sub-items (items with larger indentation) are considered part of +the item, so this really moves item trees." + (interactive) + (unless (org-at-item-p) (error "Not at an item")) + (let* ((col (current-column)) + (item (point-at-bol)) + (struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (next-item (org-list-get-next-item (point-at-bol) struct prevs))) + (unless (or next-item org-list-use-circular-motion) + (user-error "Cannot move this item further down")) + (if (not next-item) + (setq struct (org-list-send-item item 'begin struct)) + (setq struct (org-list-swap-items item next-item struct)) + (goto-char + (org-list-get-next-item item struct (org-list-prevs-alist struct)))) + (org-list-write-struct struct (org-list-parents-alist struct)) + (org-move-to-column col))) + +(defun org-move-item-up () + "Move the item at point up, i.e. swap with previous item. +Sub-items (items with larger indentation) are considered part of +the item, so this really moves item trees." + (interactive) + (unless (org-at-item-p) (error "Not at an item")) + (let* ((col (current-column)) + (item (point-at-bol)) + (struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (prev-item (org-list-get-prev-item (point-at-bol) struct prevs))) + (unless (or prev-item org-list-use-circular-motion) + (user-error "Cannot move this item further up")) + (if (not prev-item) + (setq struct (org-list-send-item item 'end struct)) + (setq struct (org-list-swap-items prev-item item struct))) + (org-list-write-struct struct (org-list-parents-alist struct)) + (org-move-to-column col))) + +(defun org-insert-item (&optional checkbox) + "Insert a new item at the current level. +If cursor is before first character after bullet of the item, the +new item will be created before the current one. + +If CHECKBOX is non-nil, add a checkbox next to the bullet. + +Return t when things worked, nil when we are not in an item, or +item is invisible." + (let ((itemp (org-in-item-p)) + (pos (point))) + ;; If cursor isn't is a list or if list is invisible, return nil. + (unless (or (not itemp) + (save-excursion + (goto-char itemp) + (outline-invisible-p))) + (if (save-excursion + (goto-char itemp) + (org-at-item-timer-p)) + ;; Timer list: delegate to `org-timer-item'. + (progn (org-timer-item) t) + (let* ((struct (save-excursion (goto-char itemp) + (org-list-struct))) + (prevs (org-list-prevs-alist struct)) + ;; If we're in a description list, ask for the new term. + (desc (when (eq (org-list-get-list-type itemp struct prevs) + 'descriptive) + " :: "))) + (setq struct (org-list-insert-item pos struct prevs checkbox desc)) + (org-list-write-struct struct (org-list-parents-alist struct)) + (when checkbox (org-update-checkbox-count-maybe)) + (looking-at org-list-full-item-re) + (goto-char (if (and (match-beginning 4) + (save-match-data + (string-match "[.)]" (match-string 1)))) + (match-beginning 4) + (match-end 0))) + (if desc (backward-char 1)) + t))))) + +(defun org-list-repair () + "Fix indentation, bullets and checkboxes in the list at point." + (interactive) + (unless (org-at-item-p) (error "This is not a list")) + (let* ((struct (org-list-struct)) + (parents (org-list-parents-alist struct))) + (org-list-write-struct struct parents))) + +(defun org-cycle-list-bullet (&optional which) + "Cycle through the different itemize/enumerate bullets. +This cycle the entire list level through the sequence: + + `-' -> `+' -> `*' -> `1.' -> `1)' + +If WHICH is a valid string, use that as the new bullet. If WHICH +is an integer, 0 means `-', 1 means `+' etc. If WHICH is +`previous', cycle backwards." + (interactive "P") + (unless (org-at-item-p) (error "Not at an item")) + (save-excursion + (beginning-of-line) + (let* ((struct (org-list-struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + (list-beg (org-list-get-first-item (point) struct prevs)) + (bullet (org-list-get-bullet list-beg struct)) + (alpha-p (org-list-use-alpha-bul-p list-beg struct prevs)) + (case-fold-search nil) + (current (cond + ((string-match "[a-z]\\." bullet) "a.") + ((string-match "[a-z])" bullet) "a)") + ((string-match "[A-Z]\\." bullet) "A.") + ((string-match "[A-Z])" bullet) "A)") + ((string-match "\\." bullet) "1.") + ((string-match ")" bullet) "1)") + (t (org-trim bullet)))) + ;; Compute list of possible bullets, depending on context. + (bullet-list + (append '("-" "+" ) + ;; *-bullets are not allowed at column 0. + (unless (looking-at "\\S-") '("*")) + ;; Description items cannot be numbered. + (unless (or (eq org-plain-list-ordered-item-terminator ?\)) + (org-at-item-description-p)) + '("1.")) + (unless (or (eq org-plain-list-ordered-item-terminator ?.) + (org-at-item-description-p)) + '("1)")) + (unless (or (not alpha-p) + (eq org-plain-list-ordered-item-terminator ?\)) + (org-at-item-description-p)) + '("a." "A.")) + (unless (or (not alpha-p) + (eq org-plain-list-ordered-item-terminator ?.) + (org-at-item-description-p)) + '("a)" "A)")))) + (len (length bullet-list)) + (item-index (- len (length (member current bullet-list)))) + (get-value (lambda (index) (nth (mod index len) bullet-list))) + (new (cond + ((member which bullet-list) which) + ((numberp which) (funcall get-value which)) + ((eq 'previous which) (funcall get-value (1- item-index))) + (t (funcall get-value (1+ item-index)))))) + ;; Use a short variation of `org-list-write-struct' as there's + ;; no need to go through all the steps. + (let ((old-struct (copy-tree struct))) + (org-list-set-bullet list-beg struct (org-list-bullet-string new)) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-fix-ind struct parents) + (org-list-struct-apply-struct struct old-struct))))) + +(defun org-toggle-checkbox (&optional toggle-presence) + "Toggle the checkbox in the current line. +With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With +double prefix, set checkbox to [-]. + +When there is an active region, toggle status or presence of the +first checkbox there, and make every item inside have the same +status or presence, respectively. + +If the cursor is in a headline, apply this to all checkbox items +in the text below the heading, taking as reference the first item +in subtree, ignoring drawers." + (interactive "P") + (save-excursion + (let* (singlep + block-item + lim-up + lim-down + (drawer-re (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$")) + (keyword-re (concat "^[ \t]*\\<\\(" org-scheduled-string + "\\|" org-deadline-string + "\\|" org-closed-string + "\\|" org-clock-string "\\)" + " *[[<]\\([^]>]+\\)[]>]")) + (orderedp (org-entry-get nil "ORDERED")) + (bounds + ;; In a region, start at first item in region. + (cond + ((org-region-active-p) + (let ((limit (region-end))) + (goto-char (region-beginning)) + (if (org-list-search-forward (org-item-beginning-re) limit t) + (setq lim-up (point-at-bol)) + (error "No item in region")) + (setq lim-down (copy-marker limit)))) + ((org-at-heading-p) + ;; On an heading, start at first item after drawers and + ;; time-stamps (scheduled, etc.). + (let ((limit (save-excursion (outline-next-heading) (point)))) + (forward-line 1) + (while (or (looking-at drawer-re) (looking-at keyword-re)) + (if (looking-at keyword-re) + (forward-line 1) + (re-search-forward "^[ \t]*:END:" limit nil))) + (if (org-list-search-forward (org-item-beginning-re) limit t) + (setq lim-up (point-at-bol)) + (error "No item in subtree")) + (setq lim-down (copy-marker limit)))) + ;; Just one item: set SINGLEP flag. + ((org-at-item-p) + (setq singlep t) + (setq lim-up (point-at-bol) + lim-down (copy-marker (point-at-eol)))) + (t (error "Not at an item or heading, and no active region")))) + ;; Determine the checkbox going to be applied to all items + ;; within bounds. + (ref-checkbox + (progn + (goto-char lim-up) + (let ((cbox (and (org-at-item-checkbox-p) (match-string 1)))) + (cond + ((equal toggle-presence '(16)) "[-]") + ((equal toggle-presence '(4)) + (unless cbox "[ ]")) + ((equal "[X]" cbox) "[ ]") + (t "[X]")))))) + ;; When an item is found within bounds, grab the full list at + ;; point structure, then: (1) set check-box of all its items + ;; within bounds to REF-CHECKBOX, (2) fix check-boxes of the + ;; whole list, (3) move point after the list. + (goto-char lim-up) + (while (and (< (point) lim-down) + (org-list-search-forward (org-item-beginning-re) + lim-down 'move)) + (let* ((struct (org-list-struct)) + (struct-copy (copy-tree struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + (bottom (copy-marker (org-list-get-bottom-point struct))) + (items-to-toggle (org-remove-if + (lambda (e) (or (< e lim-up) (> e lim-down))) + (mapcar 'car struct)))) + (mapc (lambda (e) (org-list-set-checkbox + e struct + ;; If there is no box at item, leave as-is + ;; unless function was called with C-u prefix. + (let ((cur-box (org-list-get-checkbox e struct))) + (if (or cur-box (equal toggle-presence '(4))) + ref-checkbox + cur-box)))) + items-to-toggle) + (setq block-item (org-list-struct-fix-box + struct parents prevs orderedp)) + ;; Report some problems due to ORDERED status of subtree. + ;; If only one box was being checked, throw an error, else, + ;; only signal problems. + (cond + ((and singlep block-item (> lim-up block-item)) + (error + "Checkbox blocked because of unchecked box at line %d" + (org-current-line block-item))) + (block-item + (message + "Checkboxes were removed due to unchecked box at line %d" + (org-current-line block-item)))) + (goto-char bottom) + (move-marker bottom nil) + (org-list-struct-apply-struct struct struct-copy))) + (move-marker lim-down nil))) + (org-update-checkbox-count-maybe)) + +(defun org-reset-checkbox-state-subtree () + "Reset all checkboxes in an entry subtree." + (interactive "*") + (if (org-before-first-heading-p) + (error "Not inside a tree") + (save-restriction + (save-excursion + (org-narrow-to-subtree) + (org-show-subtree) + (goto-char (point-min)) + (let ((end (point-max))) + (while (< (point) end) + (when (org-at-item-checkbox-p) + (replace-match "[ ]" t t nil 1)) + (beginning-of-line 2))) + (org-update-checkbox-count-maybe 'all))))) + +(defun org-update-checkbox-count (&optional all) + "Update the checkbox statistics in the current section. +This will find all statistic cookies like [57%] and [6/12] and +update them with the current numbers. + +With optional prefix argument ALL, do this for the whole buffer." + (interactive "P") + (save-excursion + (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") + (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)") + (recursivep + (or (not org-checkbox-hierarchical-statistics) + (string-match "\\<recursive\\>" + (or (org-entry-get nil "COOKIE_DATA") "")))) + (bounds (if all + (cons (point-min) (point-max)) + (cons (or (ignore-errors (org-back-to-heading t) (point)) + (point-min)) + (save-excursion (outline-next-heading) (point))))) + (count-boxes + (function + ;; Return number of checked boxes and boxes of all types + ;; in all structures in STRUCTS. If RECURSIVEP is + ;; non-nil, also count boxes in sub-lists. If ITEM is + ;; nil, count across the whole structure, else count only + ;; across subtree whose ancestor is ITEM. + (lambda (item structs recursivep) + (let ((c-on 0) (c-all 0)) + (mapc + (lambda (s) + (let* ((pre (org-list-prevs-alist s)) + (par (org-list-parents-alist s)) + (items + (cond + ((and recursivep item) (org-list-get-subtree item s)) + (recursivep (mapcar 'car s)) + (item (org-list-get-children item s par)) + (t (org-list-get-all-items + (org-list-get-top-point s) s pre)))) + (cookies (delq nil (mapcar + (lambda (e) + (org-list-get-checkbox e s)) + items)))) + (setq c-all (+ (length cookies) c-all) + c-on (+ (org-count "[X]" cookies) c-on)))) + structs) + (cons c-on c-all))))) + (backup-end 1) + cookies-list structs-bak box-num) + (goto-char (car bounds)) + ;; 1. Build an alist for each cookie found within BOUNDS. The + ;; key will be position at beginning of cookie and values + ;; ending position, format of cookie, and a cell whose car is + ;; number of checked boxes to report, and cdr total number of + ;; boxes. + (while (re-search-forward cookie-re (cdr bounds) t) + (catch 'skip + (save-excursion + (push + (list + (match-beginning 1) ; cookie start + (match-end 1) ; cookie end + (match-string 2) ; percent? + (cond ; boxes count + ;; Cookie is at an heading, but specifically for todo, + ;; not for checkboxes: skip it. + ((and (org-at-heading-p) + (string-match "\\<todo\\>" + (downcase + (or (org-entry-get nil "COOKIE_DATA") "")))) + (throw 'skip nil)) + ;; Cookie is at an heading, but all lists before next + ;; heading already have been read. Use data collected + ;; in STRUCTS-BAK. This should only happen when + ;; heading has more than one cookie on it. + ((and (org-at-heading-p) + (<= (save-excursion (outline-next-heading) (point)) + backup-end)) + (funcall count-boxes nil structs-bak recursivep)) + ;; Cookie is at a fresh heading. Grab structure of + ;; every list containing a checkbox between point and + ;; next headline, and save them in STRUCTS-BAK. + ((org-at-heading-p) + (setq backup-end (save-excursion + (outline-next-heading) (point)) + structs-bak nil) + (while (org-list-search-forward box-re backup-end 'move) + (let* ((struct (org-list-struct)) + (bottom (org-list-get-bottom-point struct))) + (push struct structs-bak) + (goto-char bottom))) + (funcall count-boxes nil structs-bak recursivep)) + ;; Cookie is at an item, and we already have list + ;; structure stored in STRUCTS-BAK. + ((and (org-at-item-p) + (< (point-at-bol) backup-end) + ;; Only lists in no special context are stored. + (not (nth 2 (org-list-context)))) + (funcall count-boxes (point-at-bol) structs-bak recursivep)) + ;; Cookie is at an item, but we need to compute list + ;; structure. + ((org-at-item-p) + (let ((struct (org-list-struct))) + (setq backup-end (org-list-get-bottom-point struct) + structs-bak (list struct))) + (funcall count-boxes (point-at-bol) structs-bak recursivep)) + ;; Else, cookie found is at a wrong place. Skip it. + (t (throw 'skip nil)))) + cookies-list)))) + ;; 2. Apply alist to buffer, in reverse order so positions stay + ;; unchanged after cookie modifications. + (mapc (lambda (cookie) + (let* ((beg (car cookie)) + (end (nth 1 cookie)) + (percentp (nth 2 cookie)) + (checked (car (nth 3 cookie))) + (total (cdr (nth 3 cookie))) + (new (if percentp + (format "[%d%%]" (/ (* 100 checked) + (max 1 total))) + (format "[%d/%d]" checked total)))) + (goto-char beg) + (insert new) + (delete-region (point) (+ (point) (- end beg))) + (when org-auto-align-tags (org-fix-tags-on-the-fly)))) + cookies-list)))) + +(defun org-get-checkbox-statistics-face () + "Select the face for checkbox statistics. +The face will be `org-done' when all relevant boxes are checked. +Otherwise it will be `org-todo'." + (if (match-end 1) + (if (equal (match-string 1) "100%") + 'org-checkbox-statistics-done + 'org-checkbox-statistics-todo) + (if (and (> (match-end 2) (match-beginning 2)) + (equal (match-string 2) (match-string 3))) + 'org-checkbox-statistics-done + 'org-checkbox-statistics-todo))) + +(defun org-update-checkbox-count-maybe (&optional all) + "Update checkbox statistics unless turned off by user. +With an optional argument ALL, update them in the whole buffer." + (when (cdr (assq 'checkbox org-list-automatic-rules)) + (org-update-checkbox-count all)) + (run-hooks 'org-checkbox-statistics-hook)) + +(defvar org-last-indent-begin-marker (make-marker)) +(defvar org-last-indent-end-marker (make-marker)) +(defun org-list-indent-item-generic (arg no-subtree struct) + "Indent a local list item including its children. +When number ARG is a negative, item will be outdented, otherwise +it will be indented. + +If a region is active, all items inside will be moved. + +If NO-SUBTREE is non-nil, only indent the item itself, not its +children. + +STRUCT is the list structure. + +Return t if successful." + (save-excursion + (let* ((regionp (org-region-active-p)) + (rbeg (and regionp (region-beginning))) + (rend (and regionp (region-end))) + (top (org-list-get-top-point struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + ;; Are we going to move the whole list? + (specialp + (and (not regionp) + (= top (point-at-bol)) + (cdr (assq 'indent org-list-automatic-rules)) + (if no-subtree + (error + "First item of list cannot move without its subtree") + t)))) + ;; Determine begin and end points of zone to indent. If moving + ;; more than one item, save them for subsequent moves. + (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) + (memq this-command '(org-shiftmetaright org-shiftmetaleft))) + (if regionp + (progn + (set-marker org-last-indent-begin-marker rbeg) + (set-marker org-last-indent-end-marker rend)) + (set-marker org-last-indent-begin-marker (point-at-bol)) + (set-marker org-last-indent-end-marker + (cond + (specialp (org-list-get-bottom-point struct)) + (no-subtree (1+ (point-at-bol))) + (t (org-list-get-item-end (point-at-bol) struct)))))) + (let* ((beg (marker-position org-last-indent-begin-marker)) + (end (marker-position org-last-indent-end-marker))) + (cond + ;; Special case: moving top-item with indent rule. + (specialp + (let* ((level-skip (org-level-increment)) + (offset (if (< arg 0) (- level-skip) level-skip)) + (top-ind (org-list-get-ind beg struct)) + (old-struct (copy-tree struct))) + (if (< (+ top-ind offset) 0) + (error "Cannot outdent beyond margin") + ;; Change bullet if necessary. + (when (and (= (+ top-ind offset) 0) + (string-match "*" + (org-list-get-bullet beg struct))) + (org-list-set-bullet beg struct + (org-list-bullet-string "-"))) + ;; Shift every item by OFFSET and fix bullets. Then + ;; apply changes to buffer. + (mapc (lambda (e) + (let ((ind (org-list-get-ind (car e) struct))) + (org-list-set-ind (car e) struct (+ ind offset)))) + struct) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-apply-struct struct old-struct)))) + ;; Forbidden move: + ((and (< arg 0) + ;; If only one item is moved, it mustn't have a child. + (or (and no-subtree + (not regionp) + (org-list-has-child-p beg struct)) + ;; If a subtree or region is moved, the last item + ;; of the subtree mustn't have a child. + (let ((last-item (caar + (reverse + (org-remove-if + (lambda (e) (>= (car e) end)) + struct))))) + (org-list-has-child-p last-item struct)))) + (error "Cannot outdent an item without its children")) + ;; Normal shifting + (t + (let* ((new-parents + (if (< arg 0) + (org-list-struct-outdent beg end struct parents) + (org-list-struct-indent beg end struct parents prevs)))) + (org-list-write-struct struct new-parents)) + (org-update-checkbox-count-maybe)))))) + t) + +(defun org-outdent-item () + "Outdent a local list item, but not its children. +If a region is active, all items inside will be moved." + (interactive) + (let ((regionp (org-region-active-p))) + (cond + ((or (org-at-item-p) + (and regionp + (save-excursion (goto-char (region-beginning)) + (org-at-item-p)))) + (let ((struct (if (not regionp) (org-list-struct) + (save-excursion (goto-char (region-beginning)) + (org-list-struct))))) + (org-list-indent-item-generic -1 t struct))) + (regionp (error "Region not starting at an item")) + (t (error "Not at an item"))))) + +(defun org-indent-item () + "Indent a local list item, but not its children. +If a region is active, all items inside will be moved." + (interactive) + (let ((regionp (org-region-active-p))) + (cond + ((or (org-at-item-p) + (and regionp + (save-excursion (goto-char (region-beginning)) + (org-at-item-p)))) + (let ((struct (if (not regionp) (org-list-struct) + (save-excursion (goto-char (region-beginning)) + (org-list-struct))))) + (org-list-indent-item-generic 1 t struct))) + (regionp (error "Region not starting at an item")) + (t (error "Not at an item"))))) + +(defun org-outdent-item-tree () + "Outdent a local list item including its children. +If a region is active, all items inside will be moved." + (interactive) + (let ((regionp (org-region-active-p))) + (cond + ((or (org-at-item-p) + (and regionp + (save-excursion (goto-char (region-beginning)) + (org-at-item-p)))) + (let ((struct (if (not regionp) (org-list-struct) + (save-excursion (goto-char (region-beginning)) + (org-list-struct))))) + (org-list-indent-item-generic -1 nil struct))) + (regionp (error "Region not starting at an item")) + (t (error "Not at an item"))))) + +(defun org-indent-item-tree () + "Indent a local list item including its children. +If a region is active, all items inside will be moved." + (interactive) + (let ((regionp (org-region-active-p))) + (cond + ((or (org-at-item-p) + (and regionp + (save-excursion (goto-char (region-beginning)) + (org-at-item-p)))) + (let ((struct (if (not regionp) (org-list-struct) + (save-excursion (goto-char (region-beginning)) + (org-list-struct))))) + (org-list-indent-item-generic 1 nil struct))) + (regionp (error "Region not starting at an item")) + (t (error "Not at an item"))))) + +(defvar org-tab-ind-state) +(defun org-cycle-item-indentation () + "Cycle levels of indentation of an empty item. +The first run indents the item, if applicable. Subsequent runs +outdent it at meaningful levels in the list. When done, item is +put back at its original position with its original bullet. + +Return t at each successful move." + (when (org-at-item-p) + (let* ((org-adapt-indentation nil) + (struct (org-list-struct)) + (ind (org-list-get-ind (point-at-bol) struct)) + (bullet (org-trim (buffer-substring (point-at-bol) (point-at-eol))))) + ;; Accept empty items or if cycle has already started. + (when (or (eq last-command 'org-cycle-item-indentation) + (and (save-excursion + (beginning-of-line) + (looking-at org-list-full-item-re)) + (>= (match-end 0) (save-excursion + (goto-char (org-list-get-item-end + (point-at-bol) struct)) + (skip-chars-backward " \r\t\n") + (point))))) + (setq this-command 'org-cycle-item-indentation) + ;; When in the middle of the cycle, try to outdent first. If + ;; it fails, and point is still at initial position, indent. + ;; Else, re-create it at its original position. + (if (eq last-command 'org-cycle-item-indentation) + (cond + ((ignore-errors (org-list-indent-item-generic -1 t struct))) + ((and (= ind (car org-tab-ind-state)) + (ignore-errors (org-list-indent-item-generic 1 t struct)))) + (t (delete-region (point-at-bol) (point-at-eol)) + (org-indent-to-column (car org-tab-ind-state)) + (insert (cdr org-tab-ind-state) " ") + ;; Break cycle + (setq this-command 'identity))) + ;; If a cycle is starting, remember indentation and bullet, + ;; then try to indent. If it fails, try to outdent. + (setq org-tab-ind-state (cons ind bullet)) + (cond + ((ignore-errors (org-list-indent-item-generic 1 t struct))) + ((ignore-errors (org-list-indent-item-generic -1 t struct))) + (t (user-error "Cannot move item")))) + t)))) + +(defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) + "Sort list items. +The cursor may be at any item of the list that should be sorted. +Sublists are not sorted. Checkboxes, if any, are ignored. + +Sorting can be alphabetically, numerically, by date/time as given +by a time stamp, by a property or by priority. + +Comparing entries ignores case by default. However, with an +optional argument WITH-CASE, the sorting considers case as well. + +The command prompts for the sorting type unless it has been given +to the function through the SORTING-TYPE argument, which needs to +be a character, \(?n ?N ?a ?A ?t ?T ?f ?F ?x ?X). Here is the +detailed meaning of each character: + +n Numerically, by converting the beginning of the item to a number. +a Alphabetically. Only the first line of item is checked. +t By date/time, either the first active time stamp in the entry, if + any, or by the first inactive one. In a timer list, sort the timers. +x By \"checked\" status of a check list. + +Capital letters will reverse the sort order. + +If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies +a function to be called with point at the beginning of the +record. It must return either a string or a number that should +serve as the sorting key for that record. It will then use +COMPARE-FUNC to compare entries. + +Sorting is done against the visible part of the headlines, it +ignores hidden links." + (interactive "P") + (let* ((case-func (if with-case 'identity 'downcase)) + (struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (start (org-list-get-list-begin (point-at-bol) struct prevs)) + (end (org-list-get-list-end (point-at-bol) struct prevs)) + (sorting-type + (or sorting-type + (progn + (message + "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc [x]checked A/N/T/F/X means reversed:") + (read-char-exclusive)))) + (getkey-func + (or getkey-func + (and (= (downcase sorting-type) ?f) + (intern (org-icompleting-read "Sort using function: " + obarray 'fboundp t nil nil)))))) + (message "Sorting items...") + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (let* ((dcst (downcase sorting-type)) + (case-fold-search nil) + (now (current-time)) + (sort-func (cond + ((= dcst ?a) 'string<) + ((= dcst ?f) compare-func) + ((= dcst ?t) '<) + ((= dcst ?x) 'string<))) + (next-record (lambda () + (skip-chars-forward " \r\t\n") + (or (eobp) (beginning-of-line)))) + (end-record (lambda () + (goto-char (org-list-get-item-end-before-blank + (point) struct)))) + (value-to-sort + (lambda () + (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") + (cond + ((= dcst ?n) + (string-to-number + (org-sort-remove-invisible + (buffer-substring (match-end 0) (point-at-eol))))) + ((= dcst ?a) + (funcall case-func + (org-sort-remove-invisible + (buffer-substring + (match-end 0) (point-at-eol))))) + ((= dcst ?t) + (cond + ;; If it is a timer list, convert timer to seconds + ((org-at-item-timer-p) + (org-timer-hms-to-secs (match-string 1))) + ((or (save-excursion + (re-search-forward org-ts-regexp (point-at-eol) t)) + (save-excursion (re-search-forward org-ts-regexp-both + (point-at-eol) t))) + (org-time-string-to-seconds (match-string 0))) + (t (org-float-time now)))) + ((= dcst ?x) (or (and (stringp (match-string 1)) + (match-string 1)) + "")) + ((= dcst ?f) + (if getkey-func + (let ((value (funcall getkey-func))) + (if (stringp value) + (funcall case-func value) + value)) + (error "Invalid key function `%s'" getkey-func))) + (t (error "Invalid sorting type `%c'" sorting-type))))))) + (sort-subr (/= dcst sorting-type) + next-record + end-record + value-to-sort + nil + sort-func) + ;; Read and fix list again, as `sort-subr' probably destroyed + ;; its structure. + (org-list-repair) + (run-hooks 'org-after-sorting-entries-or-items-hook) + (message "Sorting items...done"))))) + + + +;;; Send and receive lists + +(defun org-list-parse-list (&optional delete) + "Parse the list at point and maybe DELETE it. + +Return a list whose car is a symbol of list type, among +`ordered', `unordered' and `descriptive'. Then, each item is +a list whose car is counter, and cdr are strings and other +sub-lists. Inside strings, check-boxes are replaced by +\"[CBON]\", \"[CBOFF]\" and \"[CBTRANS]\". + +For example, the following list: + +1. first item + + sub-item one + + [X] sub-item two + more text in first item +2. [@3] last item + +will be parsed as: + +\(ordered + \(nil \"first item\" + \(unordered + \(nil \"sub-item one\"\) + \(nil \"[CBON] sub-item two\"\)\) + \"more text in first item\"\) + \(3 \"last item\"\)\) + +Point is left at list end." + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (parents (org-list-parents-alist struct)) + (top (org-list-get-top-point struct)) + (bottom (org-list-get-bottom-point struct)) + out + parse-item ; for byte-compiler + (get-text + (function + ;; Return text between BEG and END, trimmed, with + ;; checkboxes replaced. + (lambda (beg end) + (let ((text (org-trim (buffer-substring beg end)))) + (if (string-match "\\`\\[\\([-X ]\\)\\]" text) + (replace-match + (let ((box (match-string 1 text))) + (cond + ((equal box " ") "CBOFF") + ((equal box "-") "CBTRANS") + (t "CBON"))) + t nil text 1) + text))))) + (parse-sublist + (function + ;; Return a list whose car is list type and cdr a list of + ;; items' body. + (lambda (e) + (cons (org-list-get-list-type (car e) struct prevs) + (mapcar parse-item e))))) + (parse-item + (function + ;; Return a list containing counter of item, if any, text + ;; and any sublist inside it. + (lambda (e) + (let ((start (save-excursion + (goto-char e) + (looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*") + (match-end 0))) + ;; Get counter number. For alphabetic counter, get + ;; its position in the alphabet. + (counter (let ((c (org-list-get-counter e struct))) + (cond + ((not c) nil) + ((string-match "[A-Za-z]" c) + (- (string-to-char (upcase (match-string 0 c))) + 64)) + ((string-match "[0-9]+" c) + (string-to-number (match-string 0 c)))))) + (childp (org-list-has-child-p e struct)) + (end (org-list-get-item-end e struct))) + ;; If item has a child, store text between bullet and + ;; next child, then recursively parse all sublists. At + ;; the end of each sublist, check for the presence of + ;; text belonging to the original item. + (if childp + (let* ((children (org-list-get-children e struct parents)) + (body (list (funcall get-text start childp)))) + (while children + (let* ((first (car children)) + (sub (org-list-get-all-items first struct prevs)) + (last-c (car (last sub))) + (last-end (org-list-get-item-end last-c struct))) + (push (funcall parse-sublist sub) body) + ;; Remove children from the list just parsed. + (setq children (cdr (member last-c children))) + ;; There is a chunk of text belonging to the + ;; item if last child doesn't end where next + ;; child starts or where item ends. + (unless (= (or (car children) end) last-end) + (push (funcall get-text + last-end (or (car children) end)) + body)))) + (cons counter (nreverse body))) + (list counter (funcall get-text start end)))))))) + ;; Store output, take care of cursor position and deletion of + ;; list, then return output. + (setq out (funcall parse-sublist (org-list-get-all-items top struct prevs))) + (goto-char top) + (when delete + (delete-region top bottom) + (when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re)) + (replace-match ""))) + out)) + +(defun org-list-make-subtree () + "Convert the plain list at point into a subtree." + (interactive) + (if (not (ignore-errors (goto-char (org-in-item-p)))) + (error "Not in a list") + (let ((list (save-excursion (org-list-parse-list t)))) + (insert (org-list-to-subtree list))))) + +(defun org-list-insert-radio-list () + "Insert a radio list template appropriate for this major mode." + (interactive) + (let* ((e (assq major-mode org-list-radio-list-templates)) + (txt (nth 1 e)) + name pos) + (unless e (error "No radio list setup defined for %s" major-mode)) + (setq name (read-string "List name: ")) + (while (string-match "%n" txt) + (setq txt (replace-match name t t txt))) + (or (bolp) (insert "\n")) + (setq pos (point)) + (insert txt) + (goto-char pos))) + +(defun org-list-send-list (&optional maybe) + "Send a transformed version of this list to the receiver position. +With argument MAYBE, fail quietly if no transformation is defined +for this list." + (interactive) + (catch 'exit + (unless (org-at-item-p) (error "Not at a list item")) + (save-excursion + (re-search-backward "#\\+ORGLST" nil t) + (unless (looking-at "#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)") + (if maybe (throw 'exit nil) + (error "Don't know how to transform this list")))) + (let* ((name (match-string 1)) + (transform (intern (match-string 2))) + (bottom-point + (save-excursion + (re-search-forward + "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t) + (match-beginning 0))) + (top-point + (progn + (re-search-backward "#\\+ORGLST" nil t) + (re-search-forward (org-item-beginning-re) bottom-point t) + (match-beginning 0))) + (plain-list (buffer-substring-no-properties top-point bottom-point)) + beg txt) + (unless (fboundp transform) + (error "No such transformation function %s" transform)) + (let ((txt (funcall transform plain-list))) + ;; Find the insertion place + (save-excursion + (goto-char (point-min)) + (unless (re-search-forward + (concat "BEGIN RECEIVE ORGLST +" + name + "\\([ \t]\\|$\\)") nil t) + (error "Don't know where to insert translated list")) + (goto-char (match-beginning 0)) + (beginning-of-line 2) + (setq beg (point)) + (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) + (error "Cannot find end of insertion region")) + (delete-region beg (point-at-bol)) + (goto-char beg) + (insert txt "\n"))) + (message "List converted and installed at receiver location")))) + +(defsubst org-list-item-trim-br (item) + "Trim line breaks in a list ITEM." + (setq item (replace-regexp-in-string "\n +" " " item))) + +(defun org-list-to-generic (list params) + "Convert a LIST parsed through `org-list-parse-list' to other formats. +Valid parameters PARAMS are: + +:ustart String to start an unordered list +:uend String to end an unordered list + +:ostart String to start an ordered list +:oend String to end an ordered list + +:dstart String to start a descriptive list +:dend String to end a descriptive list +:dtstart String to start a descriptive term +:dtend String to end a descriptive term +:ddstart String to start a description +:ddend String to end a description + +:splice When set to t, return only list body lines, don't wrap + them into :[u/o]start and :[u/o]end. Default is nil. + +:istart String to start a list item. +:icount String to start an item with a counter. +:iend String to end a list item +:isep String to separate items +:lsep String to separate sublists +:csep String to separate text from a sub-list + +:cboff String to insert for an unchecked check-box +:cbon String to insert for a checked check-box +:cbtrans String to insert for a check-box in transitional state + +:nobr Non-nil means remove line breaks in lists items. + +Alternatively, each parameter can also be a form returning +a string. These sexp can use keywords `counter' and `depth', +representing respectively counter associated to the current +item, and depth of the current sub-list, starting at 0. +Obviously, `counter' is only available for parameters applying to +items." + (interactive) + (let* ((p params) + (splicep (plist-get p :splice)) + (ostart (plist-get p :ostart)) + (oend (plist-get p :oend)) + (ustart (plist-get p :ustart)) + (uend (plist-get p :uend)) + (dstart (plist-get p :dstart)) + (dend (plist-get p :dend)) + (dtstart (plist-get p :dtstart)) + (dtend (plist-get p :dtend)) + (ddstart (plist-get p :ddstart)) + (ddend (plist-get p :ddend)) + (istart (plist-get p :istart)) + (icount (plist-get p :icount)) + (iend (plist-get p :iend)) + (isep (plist-get p :isep)) + (lsep (plist-get p :lsep)) + (csep (plist-get p :csep)) + (cbon (plist-get p :cbon)) + (cboff (plist-get p :cboff)) + (cbtrans (plist-get p :cbtrans)) + (nobr (plist-get p :nobr)) + export-sublist ; for byte-compiler + (export-item + (function + ;; Export an item ITEM of type TYPE, at DEPTH. First + ;; string in item is treated in a special way as it can + ;; bring extra information that needs to be processed. + (lambda (item type depth) + (let* ((counter (pop item)) + (fmt (concat + (cond + ((eq type 'descriptive) + ;; Stick DTSTART to ISTART by + ;; left-trimming the latter. + (concat (let ((s (eval istart))) + (or (and (string-match "[ \t\n\r]+\\'" s) + (replace-match "" t t s)) + istart)) + "%s" (eval ddend))) + ((and counter (eq type 'ordered)) + (concat (eval icount) "%s")) + (t (concat (eval istart) "%s"))) + (eval iend))) + (first (car item))) + ;; Replace checkbox if any is found. + (cond + ((string-match "\\[CBON\\]" first) + (setq first (replace-match cbon t t first))) + ((string-match "\\[CBOFF\\]" first) + (setq first (replace-match cboff t t first))) + ((string-match "\\[CBTRANS\\]" first) + (setq first (replace-match cbtrans t t first)))) + ;; Replace line breaks if required + (when nobr (setq first (org-list-item-trim-br first))) + ;; Insert descriptive term if TYPE is `descriptive'. + (when (eq type 'descriptive) + (let* ((complete (string-match "^\\(.*\\)[ \t]+::" first)) + (term (if complete + (save-match-data + (org-trim (match-string 1 first))) + "???")) + (desc (if complete + (org-trim (substring first (match-end 0))) + first))) + (setq first (concat (eval dtstart) term (eval dtend) + (eval ddstart) desc)))) + (setcar item first) + (format fmt + (mapconcat (lambda (e) + (if (stringp e) e + (funcall export-sublist e (1+ depth)))) + item (or (eval csep) ""))))))) + (export-sublist + (function + ;; Export sublist SUB at DEPTH. + (lambda (sub depth) + (let* ((type (car sub)) + (items (cdr sub)) + (fmt (concat (cond + (splicep "%s") + ((eq type 'ordered) + (concat (eval ostart) "%s" (eval oend))) + ((eq type 'descriptive) + (concat (eval dstart) "%s" (eval dend))) + (t (concat (eval ustart) "%s" (eval uend)))) + (eval lsep)))) + (format fmt (mapconcat (lambda (e) + (funcall export-item e type depth)) + items (or (eval isep) "")))))))) + (concat (funcall export-sublist list 0) "\n"))) + +(defun org-list-to-latex (list &optional params) + "Convert LIST into a LaTeX list. +LIST is as string representing the list to transform, as Org +syntax. Return converted list as a string." + (require 'ox-latex) + (org-export-string-as list 'latex t)) + +(defun org-list-to-html (list) + "Convert LIST into a HTML list. +LIST is as string representing the list to transform, as Org +syntax. Return converted list as a string." + (require 'ox-html) + (org-export-string-as list 'html t)) + +(defun org-list-to-texinfo (list &optional params) + "Convert LIST into a Texinfo list. +LIST is as string representing the list to transform, as Org +syntax. Return converted list as a string." + (require 'ox-texinfo) + (org-export-string-as list 'texinfo t)) + +(defun org-list-to-subtree (list &optional params) + "Convert LIST into an Org subtree. +LIST is as returned by `org-list-parse-list'. PARAMS is a property list +with overruling parameters for `org-list-to-generic'." + (let* ((rule (cdr (assq 'heading org-blank-before-new-entry))) + (level (org-reduced-level (or (org-current-level) 0))) + (blankp (or (eq rule t) + (and (eq rule 'auto) + (save-excursion + (outline-previous-heading) + (org-previous-line-empty-p))))) + (get-stars + (function + ;; Return the string for the heading, depending on depth D + ;; of current sub-list. + (lambda (d) + (let ((oddeven-level (+ level d 1))) + (concat (make-string (if org-odd-levels-only + (1- (* 2 oddeven-level)) + oddeven-level) + ?*) + " ")))))) + (org-list-to-generic + list + (org-combine-plists + '(:splice t + :dtstart " " :dtend " " + :istart (funcall get-stars depth) + :icount (funcall get-stars depth) + :isep (if blankp "\n\n" "\n") + :csep (if blankp "\n\n" "\n") + :cbon "DONE" :cboff "TODO" :cbtrans "TODO") + params)))) + +(provide 'org-list) + +;;; org-list.el ends here diff --git a/elpa/org-20150427/org-loaddefs.el b/elpa/org-20150427/org-loaddefs.el new file mode 100644 index 00000000..a2719df7 --- /dev/null +++ b/elpa/org-20150427/org-loaddefs.el @@ -0,0 +1,3283 @@ +;;; org-loaddefs.el --- autogenerated file, do not edit +;; +;;; Code: + +;;;### (autoloads (org-babel-mark-block org-babel-previous-src-block +;;;;;; org-babel-next-src-block org-babel-goto-named-result org-babel-goto-named-src-block +;;;;;; org-babel-goto-src-block-head org-babel-hide-result-toggle-maybe +;;;;;; org-babel-sha1-hash org-babel-execute-subtree org-babel-execute-buffer +;;;;;; org-babel-map-executables org-babel-map-call-lines org-babel-map-inline-src-blocks +;;;;;; org-babel-map-src-blocks org-babel-open-src-block-result +;;;;;; org-babel-switch-to-session-with-code org-babel-switch-to-session +;;;;;; org-babel-initiate-session org-babel-load-in-session org-babel-insert-header-arg +;;;;;; org-babel-check-src-block org-babel-expand-src-block org-babel-execute-src-block +;;;;;; org-babel-pop-to-session-maybe org-babel-load-in-session-maybe +;;;;;; org-babel-expand-src-block-maybe org-babel-view-src-block-info +;;;;;; org-babel-execute-maybe org-babel-execute-safely-maybe) "ob-core" +;;;;;; "ob-core.el" "09a8853df17caadea177348cda6471b9") +;;; Generated autoloads from ob-core.el + +(autoload 'org-babel-execute-safely-maybe "ob-core" "\ +Not documented + +\(fn)" nil nil) + +(autoload 'org-babel-execute-maybe "ob-core" "\ +Not documented + +\(fn)" t nil) + +(autoload 'org-babel-view-src-block-info "ob-core" "\ +Display information on the current source block. +This includes header arguments, language and name, and is largely +a window into the `org-babel-get-src-block-info' function. + +\(fn)" t nil) + +(autoload 'org-babel-expand-src-block-maybe "ob-core" "\ +Conditionally expand a source block. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-expand-src-block'. + +\(fn)" t nil) + +(autoload 'org-babel-load-in-session-maybe "ob-core" "\ +Conditionally load a source block in a session. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-load-in-session'. + +\(fn)" t nil) + +(autoload 'org-babel-pop-to-session-maybe "ob-core" "\ +Conditionally pop to a session. +Detect if this is context for a org-babel src-block and if so +then run `org-babel-switch-to-session'. + +\(fn)" t nil) + +(autoload 'org-babel-execute-src-block "ob-core" "\ +Execute the current source code block. +Insert the results of execution into the buffer. Source code +execution and the collection and formatting of results can be +controlled through a variety of header arguments. + +With prefix argument ARG, force re-execution even if an existing +result cached in the buffer would otherwise have been returned. + +Optionally supply a value for INFO in the form returned by +`org-babel-get-src-block-info'. + +Optionally supply a value for PARAMS which will be merged with +the header arguments specified at the front of the source code +block. + +\(fn &optional ARG INFO PARAMS)" t nil) + +(autoload 'org-babel-expand-src-block "ob-core" "\ +Expand the current source code block. +Expand according to the source code block's header +arguments and pop open the results in a preview buffer. + +\(fn &optional ARG INFO PARAMS)" t nil) + +(autoload 'org-babel-check-src-block "ob-core" "\ +Check for misspelled header arguments in the current code block. + +\(fn)" t nil) + +(autoload 'org-babel-insert-header-arg "ob-core" "\ +Insert a header argument selecting from lists of common args and values. + +\(fn)" t nil) + +(autoload 'org-babel-load-in-session "ob-core" "\ +Load the body of the current source-code block. +Evaluate the header arguments for the source block before +entering the session. After loading the body this pops open the +session. + +\(fn &optional ARG INFO)" t nil) + +(autoload 'org-babel-initiate-session "ob-core" "\ +Initiate session for current code block. +If called with a prefix argument then resolve any variable +references in the header arguments and assign these variables in +the session. Copy the body of the code block to the kill ring. + +\(fn &optional ARG INFO)" t nil) + +(autoload 'org-babel-switch-to-session "ob-core" "\ +Switch to the session of the current code block. +Uses `org-babel-initiate-session' to start the session. If called +with a prefix argument then this is passed on to +`org-babel-initiate-session'. + +\(fn &optional ARG INFO)" t nil) + +(autoload 'org-babel-switch-to-session-with-code "ob-core" "\ +Switch to code buffer and display session. + +\(fn &optional ARG INFO)" t nil) + +(autoload 'org-babel-open-src-block-result "ob-core" "\ +If `point' is on a src block then open the results of the +source code block, otherwise return nil. With optional prefix +argument RE-RUN the source-code block is evaluated even if +results already exist. + +\(fn &optional RE-RUN)" t nil) + +(autoload 'org-babel-map-src-blocks "ob-core" "\ +Evaluate BODY forms on each source-block in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer. During evaluation of BODY the following local variables +are set relative to the currently matched code block. + +full-block ------- string holding the entirety of the code block +beg-block -------- point at the beginning of the code block +end-block -------- point at the end of the matched code block +lang ------------- string holding the language of the code block +beg-lang --------- point at the beginning of the lang +end-lang --------- point at the end of the lang +switches --------- string holding the switches +beg-switches ----- point at the beginning of the switches +end-switches ----- point at the end of the switches +header-args ------ string holding the header-args +beg-header-args -- point at the beginning of the header-args +end-header-args -- point at the end of the header-args +body ------------- string holding the body of the code block +beg-body --------- point at the beginning of the body +end-body --------- point at the end of the body + +\(fn FILE &rest BODY)" nil (quote macro)) + +(autoload 'org-babel-map-inline-src-blocks "ob-core" "\ +Evaluate BODY forms on each inline source-block in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer. + +\(fn FILE &rest BODY)" nil (quote macro)) + +(autoload 'org-babel-map-call-lines "ob-core" "\ +Evaluate BODY forms on each call line in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer. + +\(fn FILE &rest BODY)" nil (quote macro)) + +(autoload 'org-babel-map-executables "ob-core" "\ +Not documented + +\(fn FILE &rest BODY)" nil (quote macro)) + +(autoload 'org-babel-execute-buffer "ob-core" "\ +Execute source code blocks in a buffer. +Call `org-babel-execute-src-block' on every source block in +the current buffer. + +\(fn &optional ARG)" t nil) + +(autoload 'org-babel-execute-subtree "ob-core" "\ +Execute source code blocks in a subtree. +Call `org-babel-execute-src-block' on every source block in +the current subtree. + +\(fn &optional ARG)" t nil) + +(autoload 'org-babel-sha1-hash "ob-core" "\ +Generate an sha1 hash based on the value of info. + +\(fn &optional INFO)" t nil) + +(autoload 'org-babel-hide-result-toggle-maybe "ob-core" "\ +Toggle visibility of result at point. + +\(fn)" t nil) + +(autoload 'org-babel-goto-src-block-head "ob-core" "\ +Go to the beginning of the current code block. + +\(fn)" t nil) + +(autoload 'org-babel-goto-named-src-block "ob-core" "\ +Go to a named source-code block. + +\(fn NAME)" t nil) + +(autoload 'org-babel-goto-named-result "ob-core" "\ +Go to a named result. + +\(fn NAME)" t nil) + +(autoload 'org-babel-next-src-block "ob-core" "\ +Jump to the next source block. +With optional prefix argument ARG, jump forward ARG many source blocks. + +\(fn &optional ARG)" t nil) + +(autoload 'org-babel-previous-src-block "ob-core" "\ +Jump to the previous source block. +With optional prefix argument ARG, jump backward ARG many source blocks. + +\(fn &optional ARG)" t nil) + +(autoload 'org-babel-mark-block "ob-core" "\ +Mark current src block. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (org-babel-describe-bindings) "ob-keys" "ob-keys.el" +;;;;;; "25a1e7a65f088c34d9576789abaaebc6") +;;; Generated autoloads from ob-keys.el + +(autoload 'org-babel-describe-bindings "ob-keys" "\ +Describe all keybindings behind `org-babel-key-prefix'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe) +;;;;;; "ob-lob" "ob-lob.el" "6452edf7fff14c5ebb5c1cece08ba833") +;;; Generated autoloads from ob-lob.el + +(autoload 'org-babel-lob-execute-maybe "ob-lob" "\ +Execute a Library of Babel source block, if appropriate. +Detect if this is context for a Library Of Babel source block and +if so then run the appropriate source block from the Library. + +\(fn)" t nil) + +(autoload 'org-babel-lob-get-info "ob-lob" "\ +Return a Library of Babel function call as a string. + +\(fn)" nil nil) + +;;;*** + +;;;### (autoloads (org-babel-tangle org-babel-tangle-file) "ob-tangle" +;;;;;; "ob-tangle.el" "1fc39a5a416a66ab63a506ccc0a122ff") +;;; Generated autoloads from ob-tangle.el + +(autoload 'org-babel-tangle-file "ob-tangle" "\ +Extract the bodies of source code blocks in FILE. +Source code blocks are extracted with `org-babel-tangle'. +Optional argument TARGET-FILE can be used to specify a default +export file for all source blocks. Optional argument LANG can be +used to limit the exported source code blocks by language. +Return a list whose CAR is the tangled file name. + +\(fn FILE &optional TARGET-FILE LANG)" t nil) + +(autoload 'org-babel-tangle "ob-tangle" "\ +Write code blocks to source-specific files. +Extract the bodies of all source code blocks from the current +file into their own source-specific files. +With one universal prefix argument, only tangle the block at point. +When two universal prefix arguments, only tangle blocks for the +tangle file of the block at point. +Optional argument TARGET-FILE can be used to specify a default +export file for all source blocks. Optional argument LANG can be +used to limit the exported source code blocks by language. + +\(fn &optional ARG TARGET-FILE LANG)" t nil) + +;;;*** + +;;;### (autoloads (org-agenda-to-appt org-calendar-goto-agenda org-agenda-set-restriction-lock +;;;;;; org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item +;;;;;; org-diary org-agenda-list-stuck-projects org-tags-view org-todo-list +;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views +;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda +;;;;;; org-agenda org-toggle-sticky-agenda) "org-agenda" "org-agenda.el" +;;;;;; (21820 29495)) +;;; Generated autoloads from org-agenda.el + +(autoload 'org-toggle-sticky-agenda "org-agenda" "\ +Toggle `org-agenda-sticky'. + +\(fn &optional ARG)" t nil) + +(autoload 'org-agenda "org-agenda" "\ +Dispatch agenda commands to collect entries to the agenda buffer. +Prompts for a command to execute. Any prefix arg will be passed +on to the selected command. The default selections are: + +a Call `org-agenda-list' to display the agenda for current day or week. +t Call `org-todo-list' to display the global todo list. +T Call `org-todo-list' to display the global todo list, select only + entries with a specific TODO keyword (the user gets a prompt). +m Call `org-tags-view' to display headlines with tags matching + a condition (the user is prompted for the condition). +M Like `m', but select only TODO entries, no ordinary headlines. +L Create a timeline for the current buffer. +e Export views to associated files. +s Search entries for keywords. +S Search entries for keywords, only with TODO keywords. +/ Multi occur across all agenda files and also files listed + in `org-agenda-text-search-extra-files'. +< Restrict agenda commands to buffer, subtree, or region. + Press several times to get the desired effect. +> Remove a previous restriction. +# List \"stuck\" projects. +! Configure what \"stuck\" means. +C Configure custom agenda commands. + +More commands can be added by configuring the variable +`org-agenda-custom-commands'. In particular, specific tags and TODO keyword +searches can be pre-defined in this way. + +If the current buffer is in Org-mode and visiting a file, you can also +first press `<' once to indicate that the agenda should be temporarily +\(until the next use of \\[org-agenda]) restricted to the current file. +Pressing `<' twice means to restrict to the current subtree or region +\(if active). + +\(fn &optional ARG ORG-KEYS RESTRICTION)" t nil) + +(autoload 'org-batch-agenda "org-agenda" "\ +Run an agenda command in batch mode and send the result to STDOUT. +If CMD-KEY is a string of length 1, it is used as a key in +`org-agenda-custom-commands' and triggers this command. If it is a +longer string it is used as a tags/todo match string. +Parameters are alternating variable names and values that will be bound +before running the agenda command. + +\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro)) + +(autoload 'org-batch-agenda-csv "org-agenda" "\ +Run an agenda command in batch mode and send the result to STDOUT. +If CMD-KEY is a string of length 1, it is used as a key in +`org-agenda-custom-commands' and triggers this command. If it is a +longer string it is used as a tags/todo match string. +Parameters are alternating variable names and values that will be bound +before running the agenda command. + +The output gives a line for each selected agenda item. Each +item is a list of comma-separated values, like this: + +category,head,type,todo,tags,date,time,extra,priority-l,priority-n + +category The category of the item +head The headline, without TODO kwd, TAGS and PRIORITY +type The type of the agenda entry, can be + todo selected in TODO match + tagsmatch selected in tags match + diary imported from diary + deadline a deadline on given date + scheduled scheduled on given date + timestamp entry has timestamp on given date + closed entry was closed on given date + upcoming-deadline warning about deadline + past-scheduled forwarded scheduled item + block entry has date block including g. date +todo The todo keyword, if any +tags All tags including inherited ones, separated by colons +date The relevant date, like 2007-2-14 +time The time, like 15:00-16:50 +extra Sting with extra planning info +priority-l The priority letter if any was given +priority-n The computed numerical priority +agenda-day The day in the agenda where this is listed + +\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro)) + +(autoload 'org-store-agenda-views "org-agenda" "\ +Store agenda views. + +\(fn &rest PARAMETERS)" t nil) + +(autoload 'org-batch-store-agenda-views "org-agenda" "\ +Run all custom agenda commands that have a file argument. + +\(fn &rest PARAMETERS)" nil (quote macro)) + +(autoload 'org-agenda-list "org-agenda" "\ +Produce a daily/weekly view from all files in variable `org-agenda-files'. +The view will be for the current day or week, but from the overview buffer +you will be able to go to other days/weeks. + +With a numeric prefix argument in an interactive call, the agenda will +span ARG days. Lisp programs should instead specify SPAN to change +the number of days. SPAN defaults to `org-agenda-span'. + +START-DAY defaults to TODAY, or to the most recent match for the weekday +given in `org-agenda-start-on-weekday'. + +When WITH-HOUR is non-nil, only include scheduled and deadline +items if they have an hour specification like [h]h:mm. + +\(fn &optional ARG START-DAY SPAN WITH-HOUR)" t nil) + +(autoload 'org-search-view "org-agenda" "\ +Show all entries that contain a phrase or words or regular expressions. + +With optional prefix argument TODO-ONLY, only consider entries that are +TODO entries. The argument STRING can be used to pass a default search +string into this function. If EDIT-AT is non-nil, it means that the +user should get a chance to edit this string, with cursor at position +EDIT-AT. + +The search string can be viewed either as a phrase that should be found as +is, or it can be broken into a number of snippets, each of which must match +in a Boolean way to select an entry. The default depends on the variable +`org-agenda-search-view-always-boolean'. +Even if this is turned off (the default) you can always switch to +Boolean search dynamically by preceding the first word with \"+\" or \"-\". + +The default is a direct search of the whole phrase, where each space in +the search string can expand to an arbitrary amount of whitespace, +including newlines. + +If using a Boolean search, the search string is split on whitespace and +each snippet is searched separately, with logical AND to select an entry. +Words prefixed with a minus must *not* occur in the entry. Words without +a prefix or prefixed with a plus must occur in the entry. Matching is +case-insensitive. Words are enclosed by word delimiters (i.e. they must +match whole words, not parts of a word) if +`org-agenda-search-view-force-full-words' is set (default is nil). + +Boolean search snippets enclosed by curly braces are interpreted as +regular expressions that must or (when preceded with \"-\") must not +match in the entry. Snippets enclosed into double quotes will be taken +as a whole, to include whitespace. + +- If the search string starts with an asterisk, search only in headlines. +- If (possibly after the leading star) the search string starts with an + exclamation mark, this also means to look at TODO entries only, an effect + that can also be achieved with a prefix argument. +- If (possibly after star and exclamation mark) the search string starts + with a colon, this will mean that the (non-regexp) snippets of the + Boolean search must match as full words. + +This command searches the agenda files, and in addition the files listed +in `org-agenda-text-search-extra-files'. + +\(fn &optional TODO-ONLY STRING EDIT-AT)" t nil) + +(autoload 'org-todo-list "org-agenda" "\ +Show all (not done) TODO entries from all agenda file in a single list. +The prefix arg can be used to select a specific TODO keyword and limit +the list to these. When using \\[universal-argument], you will be prompted +for a keyword. A numeric prefix directly selects the Nth keyword in +`org-todo-keywords-1'. + +\(fn &optional ARG)" t nil) + +(autoload 'org-tags-view "org-agenda" "\ +Show all headlines for all `org-agenda-files' matching a TAGS criterion. +The prefix arg TODO-ONLY limits the search to TODO entries. + +\(fn &optional TODO-ONLY MATCH)" t nil) + +(autoload 'org-agenda-list-stuck-projects "org-agenda" "\ +Create agenda view for projects that are stuck. +Stuck projects are project that have no next actions. For the definitions +of what a project is and how to check if it stuck, customize the variable +`org-stuck-projects'. + +\(fn &rest IGNORE)" t nil) + +(autoload 'org-diary "org-agenda" "\ +Return diary information from org files. +This function can be used in a \"sexp\" diary entry in the Emacs calendar. +It accesses org files and extracts information from those files to be +listed in the diary. The function accepts arguments specifying what +items should be listed. For a list of arguments allowed here, see the +variable `org-agenda-entry-types'. + +The call in the diary file should look like this: + + &%%(org-diary) ~/path/to/some/orgfile.org + +Use a separate line for each org file to check. Or, if you omit the file name, +all files listed in `org-agenda-files' will be checked automatically: + + &%%(org-diary) + +If you don't give any arguments (as in the example above), the default value +of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp). +So the example above may also be written as + + &%%(org-diary :deadline :timestamp :sexp :scheduled) + +The function expects the lisp variables `entry' and `date' to be provided +by the caller, because this is how the calendar works. Don't use this +function from a program - use `org-agenda-get-day-entries' instead. + +\(fn &rest ARGS)" nil nil) + +(autoload 'org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item "org-agenda" "\ +Do we have a reason to ignore this TODO entry because it has a time stamp? + +\(fn &optional END)" nil nil) + +(autoload 'org-agenda-set-restriction-lock "org-agenda" "\ +Set restriction lock for agenda, to current subtree or file. +Restriction will be the file if TYPE is `file', or if type is the +universal prefix '(4), or if the cursor is before the first headline +in the file. Otherwise, restriction will be to the current subtree. + +\(fn &optional TYPE)" t nil) + +(autoload 'org-calendar-goto-agenda "org-agenda" "\ +Compute the Org-mode agenda for the calendar date displayed at the cursor. +This is a command that has to be installed in `calendar-mode-map'. + +\(fn)" t nil) + +(autoload 'org-agenda-to-appt "org-agenda" "\ +Activate appointments found in `org-agenda-files'. +With a \\[universal-argument] prefix, refresh the list of +appointments. + +If FILTER is t, interactively prompt the user for a regular +expression, and filter out entries that don't match it. + +If FILTER is a string, use this string as a regular expression +for filtering entries out. + +If FILTER is a function, filter out entries against which +calling the function returns nil. This function takes one +argument: an entry from `org-agenda-get-day-entries'. + +FILTER can also be an alist with the car of each cell being +either 'headline or 'category. For example: + + '((headline \"IMPORTANT\") + (category \"Work\")) + +will only add headlines containing IMPORTANT or headlines +belonging to the \"Work\" category. + +ARGS are symbols indicating what kind of entries to consider. +By default `org-agenda-to-appt' will use :deadline*, :scheduled* +\(i.e., deadlines and scheduled items with a hh:mm specification) +and :timestamp entries. See the docstring of `org-diary' for +details and examples. + +If an entry has a APPT_WARNTIME property, its value will be used +to override `appt-message-warning-time'. + +\(fn &optional REFRESH FILTER &rest ARGS)" t nil) + +;;;*** + +;;;### (autoloads (org-archive-subtree-default-with-confirmation +;;;;;; org-archive-subtree-default org-toggle-archive-tag org-archive-to-archive-sibling +;;;;;; org-archive-subtree org-add-archive-files) "org-archive" +;;;;;; "org-archive.el" "9a54b246691497eb10c911c2c12f9742") +;;; Generated autoloads from org-archive.el + +(autoload 'org-add-archive-files "org-archive" "\ +Splice the archive files into the list of files. +This implies visiting all these files and finding out what the +archive file is. + +\(fn FILES)" nil nil) + +(autoload 'org-archive-subtree "org-archive" "\ +Move the current subtree to the archive. +The archive can be a certain top-level heading in the current file, or in +a different file. The tree will be moved to that location, the subtree +heading be marked DONE, and the current time will be added. + +When called with prefix argument FIND-DONE, find whole trees without any +open TODO items and archive them (after getting confirmation from the user). +If the cursor is not at a headline when this command is called, try all level +1 trees. If the cursor is on a headline, only try the direct children of +this heading. + +\(fn &optional FIND-DONE)" t nil) + +(autoload 'org-archive-to-archive-sibling "org-archive" "\ +Archive the current heading by moving it under the archive sibling. +The archive sibling is a sibling of the heading with the heading name +`org-archive-sibling-heading' and an `org-archive-tag' tag. If this +sibling does not exist, it will be created at the end of the subtree. + +\(fn)" t nil) + +(autoload 'org-toggle-archive-tag "org-archive" "\ +Toggle the archive tag for the current headline. +With prefix ARG, check all children of current headline and offer tagging +the children that do not contain any open TODO items. + +\(fn &optional FIND-DONE)" t nil) + +(autoload 'org-archive-subtree-default "org-archive" "\ +Archive the current subtree with the default command. +This command is set with the variable `org-archive-default-command'. + +\(fn)" t nil) + +(autoload 'org-archive-subtree-default-with-confirmation "org-archive" "\ +Archive the current subtree with the default command. +This command is set with the variable `org-archive-default-command'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (org-attach) "org-attach" "org-attach.el" "5ca6eaa6ba7fa7c7eddc8d339f2a2170") +;;; Generated autoloads from org-attach.el + +(autoload 'org-attach "org-attach" "\ +The dispatcher for attachment commands. +Shows a list of commands and prompts for another key to execute a command. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (org-bbdb-anniversaries) "org-bbdb" "org-bbdb.el" +;;;;;; "5fed335fd36cec704d37da4b5f5d54a7") +;;; Generated autoloads from org-bbdb.el + +(autoload 'org-bbdb-anniversaries "org-bbdb" "\ +Extract anniversaries from BBDB for display in the agenda. + +\(fn)" nil nil) + +;;;*** + +;;;### (autoloads (org-capture-import-remember-templates org-capture +;;;;;; org-capture-string) "org-capture" "org-capture.el" (21820 +;;;;;; 29495)) +;;; Generated autoloads from org-capture.el + +(autoload 'org-capture-string "org-capture" "\ +Capture STRING with the template selected by KEYS. + +\(fn STRING &optional KEYS)" t nil) + +(autoload 'org-capture "org-capture" "\ +Capture something. +\\<org-capture-mode-map> +This will let you select a template from `org-capture-templates', and then +file the newly captured information. The text is immediately inserted +at the target location, and an indirect buffer is shown where you can +edit it. Pressing \\[org-capture-finalize] brings you back to the previous state +of Emacs, so that you can continue your work. + +When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture +anything, just go to the file/headline where the selected template +stores its notes. With a double prefix argument \\[universal-argument] \\[universal-argument], go to the last note +stored. + +When called with a `C-0' (zero) prefix, insert a template at point. + +ELisp programs can set KEYS to a string associated with a template +in `org-capture-templates'. In this case, interactive selection +will be bypassed. + +If `org-capture-use-agenda-date' is non-nil, capturing from the +agenda will use the date at point as the default date. Then, a +`C-1' prefix will tell the capture process to use the HH:MM time +of the day at point (if any) or the current HH:MM time. + +\(fn &optional GOTO KEYS)" t nil) + +(autoload 'org-capture-import-remember-templates "org-capture" "\ +Set `org-capture-templates' to be similar to `org-remember-templates'. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (org-clock-update-time-maybe org-dblock-write:clocktable +;;;;;; org-clocktable-shift org-clock-report org-clock-get-clocktable +;;;;;; org-clock-remove-overlays org-clock-display org-clock-sum +;;;;;; org-clock-goto org-clock-cancel org-clock-out org-clock-in-last +;;;;;; org-clock-in org-resolve-clocks) "org-clock" "org-clock.el" +;;;;;; "dd849ac89f30ddd981c37863a1b35e00") +;;; Generated autoloads from org-clock.el + +(autoload 'org-resolve-clocks "org-clock" "\ +Resolve all currently open org-mode clocks. +If `only-dangling-p' is non-nil, only ask to resolve dangling +\(i.e., not currently open and valid) clocks. + +\(fn &optional ONLY-DANGLING-P PROMPT-FN LAST-VALID)" t nil) + +(autoload 'org-clock-in "org-clock" "\ +Start the clock on the current item. +If necessary, clock-out of the currently active clock. +With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked +tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task +and mark it as the default task, a special task that will always be offered +in the clocking selection, associated with the letter `d'. +When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], clock in by using the last clock-out +time as the start time (see `org-clock-continuously' to +make this the default behavior.) + +\(fn &optional SELECT START-TIME)" t nil) + +(autoload 'org-clock-in-last "org-clock" "\ +Clock in the last closed clocked item. +When already clocking in, send an warning. +With a universal prefix argument, select the task you want to +clock in from the last clocked in tasks. +With two universal prefix arguments, start clocking using the +last clock-out time, if any. +With three universal prefix arguments, interactively prompt +for a todo state to switch to, overriding the existing value +`org-clock-in-switch-to-state'. + +\(fn &optional ARG)" t nil) + +(autoload 'org-clock-out "org-clock" "\ +Stop the currently running clock. +Throw an error if there is no running clock and FAIL-QUIETLY is nil. +With a universal prefix, prompt for a state to switch the clocked out task +to, overriding the existing value of `org-clock-out-switch-to-state'. + +\(fn &optional SWITCH-TO-STATE FAIL-QUIETLY AT-TIME)" t nil) + +(autoload 'org-clock-cancel "org-clock" "\ +Cancel the running clock by removing the start timestamp. + +\(fn)" t nil) + +(autoload 'org-clock-goto "org-clock" "\ +Go to the currently clocked-in entry, or to the most recently clocked one. +With prefix arg SELECT, offer recently clocked tasks for selection. + +\(fn &optional SELECT)" t nil) + +(autoload 'org-clock-sum "org-clock" "\ +Sum the times for each subtree. +Puts the resulting times in minutes as a text property on each headline. +TSTART and TEND can mark a time range to be considered. +HEADLINE-FILTER is a zero-arg function that, if specified, is called for +each headline in the time range with point at the headline. Headlines for +which HEADLINE-FILTER returns nil are excluded from the clock summation. +PROPNAME lets you set a custom text property instead of :org-clock-minutes. + +\(fn &optional TSTART TEND HEADLINE-FILTER PROPNAME)" t nil) + +(autoload 'org-clock-display "org-clock" "\ +Show subtree times in the entire buffer. +If TOTAL-ONLY is non-nil, only show the total time for the entire file +in the echo area. + +Use \\[org-clock-remove-overlays] to remove the subtree times. + +\(fn &optional TOTAL-ONLY)" t nil) + +(autoload 'org-clock-remove-overlays "org-clock" "\ +Remove the occur highlights from the buffer. +BEG and END are ignored. If NOREMOVE is nil, remove this function +from the `before-change-functions' in the current buffer. + +\(fn &optional BEG END NOREMOVE)" t nil) + +(autoload 'org-clock-get-clocktable "org-clock" "\ +Get a formatted clocktable with parameters according to PROPS. +The table is created in a temporary buffer, fully formatted and +fontified, and then returned. + +\(fn &rest PROPS)" nil nil) + +(autoload 'org-clock-report "org-clock" "\ +Create a table containing a report about clocked time. +If the cursor is inside an existing clocktable block, then the table +will be updated. If not, a new clocktable will be inserted. The scope +of the new clock will be subtree when called from within a subtree, and +file elsewhere. + +When called with a prefix argument, move to the first clock table in the +buffer and update it. + +\(fn &optional ARG)" t nil) + +(autoload 'org-clocktable-shift "org-clock" "\ +Try to shift the :block date of the clocktable at point. +Point must be in the #+BEGIN: line of a clocktable, or this function +will throw an error. +DIR is a direction, a symbol `left', `right', `up', or `down'. +Both `left' and `down' shift the block toward the past, `up' and `right' +push it toward the future. +N is the number of shift steps to take. The size of the step depends on +the currently selected interval size. + +\(fn DIR N)" nil nil) + +(autoload 'org-dblock-write:clocktable "org-clock" "\ +Write the standard clocktable. + +\(fn PARAMS)" nil nil) + +(autoload 'org-clock-update-time-maybe "org-clock" "\ +If this is a CLOCK line, update it and return t. +Otherwise, return nil. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (org-agenda-columns org-insert-columns-dblock org-dblock-write:columnview +;;;;;; org-columns-number-to-string org-columns-compute org-columns +;;;;;; org-columns-get-format-and-top-level org-columns-remove-overlays) +;;;;;; "org-colview" "org-colview.el" (21820 29495)) +;;; Generated autoloads from org-colview.el + +(autoload 'org-columns-remove-overlays "org-colview" "\ +Remove all currently active column overlays. + +\(fn)" t nil) + +(autoload 'org-columns-get-format-and-top-level "org-colview" "\ +Not documented + +\(fn)" nil nil) + +(autoload 'org-columns "org-colview" "\ +Turn on column view on an org-mode file. +When COLUMNS-FMT-STRING is non-nil, use it as the column format. + +\(fn &optional COLUMNS-FMT-STRING)" t nil) + +(autoload 'org-columns-compute "org-colview" "\ +Sum the values of property PROPERTY hierarchically, for the entire buffer. + +\(fn PROPERTY)" t nil) + +(autoload 'org-columns-number-to-string "org-colview" "\ +Convert a computed column number to a string value, according to FMT. + +\(fn N FMT &optional PRINTF)" nil nil) + +(autoload 'org-dblock-write:columnview "org-colview" "\ +Write the column view table. +PARAMS is a property list of parameters: + +:width enforce same column widths with <N> specifiers. +:id the :ID: property of the entry where the columns view + should be built. When the symbol `local', call locally. + When `global' call column view with the cursor at the beginning + of the buffer (usually this means that the whole buffer switches + to column view). When \"file:path/to/file.org\", invoke column + view at the start of that file. Otherwise, the ID is located + using `org-id-find'. +:hlines When t, insert a hline before each item. When a number, insert + a hline before each level <= that number. +:vlines When t, make each column a colgroup to enforce vertical lines. +:maxlevel When set to a number, don't capture headlines below this level. +:skip-empty-rows + When t, skip rows where all specifiers other than ITEM are empty. +:format When non-nil, specify the column view format to use. + +\(fn PARAMS)" nil nil) + +(autoload 'org-insert-columns-dblock "org-colview" "\ +Create a dynamic block capturing a column view table. + +\(fn)" t nil) + +(autoload 'org-agenda-columns "org-colview" "\ +Turn on or update column view in the agenda. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (org-check-version) "org-compat" "org-compat.el" +;;;;;; (21820 29495)) +;;; Generated autoloads from org-compat.el + +(autoload 'org-check-version "org-compat" "\ +Try very hard to provide sensible version strings. + +\(fn)" nil (quote macro)) + +;;;*** + +;;;### (autoloads (org-datetree-find-date-create) "org-datetree" +;;;;;; "org-datetree.el" "448ccbc2749a60a5e276fc3c9a9c5605") +;;; Generated autoloads from org-datetree.el + +(autoload 'org-datetree-find-date-create "org-datetree" "\ +Find or create an entry for DATE. +If KEEP-RESTRICTION is non-nil, do not widen the buffer. +When it is nil, the buffer will be widened to make sure an existing date +tree can be found. + +\(fn DATE &optional KEEP-RESTRICTION)" nil nil) + +;;;*** + +;;;### (autoloads (org-element-context org-element-at-point org-element-interpret-data) +;;;;;; "org-element" "org-element.el" "e30bb4fe00f0e82056941112ae076340") +;;; Generated autoloads from org-element.el + +(autoload 'org-element-interpret-data "org-element" "\ +Interpret DATA as Org syntax. + +DATA is a parse tree, an element, an object or a secondary string +to interpret. + +Optional argument PARENT is used for recursive calls. It contains +the element or object containing data, or nil. + +Return Org syntax as a string. + +\(fn DATA &optional PARENT)" nil nil) + +(autoload 'org-element-at-point "org-element" "\ +Determine closest element around point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element and PROPS a plist of properties associated to the +element. + +Possible types are defined in `org-element-all-elements'. +Properties depend on element or object type, but always include +`:begin', `:end', `:parent' and `:post-blank' properties. + +As a special case, if point is at the very beginning of a list or +sub-list, returned element will be that list instead of the first +item. In the same way, if point is at the beginning of the first +row of a table, returned element will be the table instead of the +first row. + +If optional argument KEEP-TRAIL is non-nil, the function returns +a list of elements leading to element at point. The list's CAR +is always the element at point. The following positions contain +element's siblings, then parents, siblings of parents, until the +first element of current section. + +\(fn &optional KEEP-TRAIL)" nil nil) + +(autoload 'org-element-context "org-element" "\ +Return closest element or object around point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element or object and PROPS a plist of properties +associated to it. + +Possible types are defined in `org-element-all-elements' and +`org-element-all-objects'. Properties depend on element or +object type, but always include `:begin', `:end', `:parent' and +`:post-blank'. + +Optional argument ELEMENT, when non-nil, is the closest element +containing point, as returned by `org-element-at-point'. +Providing it allows for quicker computation. + +\(fn &optional ELEMENT)" nil nil) + +;;;*** + +;;;### (autoloads (org-feed-show-raw-feed org-feed-goto-inbox org-feed-update +;;;;;; org-feed-update-all) "org-feed" "org-feed.el" "d29a33e181e81cddc70543c0ba8fdbe4") +;;; Generated autoloads from org-feed.el + +(autoload 'org-feed-update-all "org-feed" "\ +Get inbox items from all feeds in `org-feed-alist'. + +\(fn)" t nil) + +(autoload 'org-feed-update "org-feed" "\ +Get inbox items from FEED. +FEED can be a string with an association in `org-feed-alist', or +it can be a list structured like an entry in `org-feed-alist'. + +\(fn FEED &optional RETRIEVE-ONLY)" t nil) + +(autoload 'org-feed-goto-inbox "org-feed" "\ +Go to the inbox that captures the feed named FEED. + +\(fn FEED)" t nil) + +(autoload 'org-feed-show-raw-feed "org-feed" "\ +Show the raw feed buffer of a feed. + +\(fn FEED)" t nil) + +;;;*** + +;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote" +;;;;;; "org-footnote.el" "9906c2a4ea425a7c96d7c1371b2e35f9") +;;; Generated autoloads from org-footnote.el + +(autoload 'org-footnote-action "org-footnote" "\ +Do the right thing for footnotes. + +When at a footnote reference, jump to the definition. + +When at a definition, jump to the references if they exist, offer +to create them otherwise. + +When neither at definition or reference, create a new footnote, +interactively. + +With prefix arg SPECIAL, offer additional commands in a menu. + +\(fn &optional SPECIAL)" t nil) + +(autoload 'org-footnote-normalize "org-footnote" "\ +Collect the footnotes in various formats and normalize them. + +This finds the different sorts of footnotes allowed in Org, and +normalizes them to the usual [N] format. + +When SORT-ONLY is set, only sort the footnote definitions into the +referenced sequence. + +\(fn &optional SORT-ONLY)" nil nil) + +;;;*** + +;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-update-id-locations +;;;;;; org-id-new org-id-find org-id-goto org-id-get-with-outline-drilling +;;;;;; org-id-get-with-outline-path-completion org-id-get org-id-copy +;;;;;; org-id-get-create) "org-id" "org-id.el" "82e762bd5cca2e3d24252745fca306d7") +;;; Generated autoloads from org-id.el + +(autoload 'org-id-get-create "org-id" "\ +Create an ID for the current entry and return it. +If the entry already has an ID, just return it. +With optional argument FORCE, force the creation of a new ID. + +\(fn &optional FORCE)" t nil) + +(autoload 'org-id-copy "org-id" "\ +Copy the ID of the entry at point to the kill ring. +Create an ID if necessary. + +\(fn)" t nil) + +(autoload 'org-id-get "org-id" "\ +Get the ID property of the entry at point-or-marker POM. +If POM is nil, refer to the entry at point. +If the entry does not have an ID, the function returns nil. +However, when CREATE is non nil, create an ID if none is present already. +PREFIX will be passed through to `org-id-new'. +In any case, the ID of the entry is returned. + +\(fn &optional POM CREATE PREFIX)" nil nil) + +(autoload 'org-id-get-with-outline-path-completion "org-id" "\ +Use `outline-path-completion' to retrieve the ID of an entry. +TARGETS may be a setting for `org-refile-targets' to define +eligible headlines. When omitted, all headlines in the current +file are eligible. This function returns the ID of the entry. +If necessary, the ID is created. + +\(fn &optional TARGETS)" nil nil) + +(autoload 'org-id-get-with-outline-drilling "org-id" "\ +Use an outline-cycling interface to retrieve the ID of an entry. +This only finds entries in the current buffer, using `org-get-location'. +It returns the ID of the entry. If necessary, the ID is created. + +\(fn &optional TARGETS)" nil nil) + +(autoload 'org-id-goto "org-id" "\ +Switch to the buffer containing the entry with id ID. +Move the cursor to that entry in that buffer. + +\(fn ID)" t nil) + +(autoload 'org-id-find "org-id" "\ +Return the location of the entry with the id ID. +The return value is a cons cell (file-name . position), or nil +if there is no entry with that ID. +With optional argument MARKERP, return the position as a new marker. + +\(fn ID &optional MARKERP)" nil nil) + +(autoload 'org-id-new "org-id" "\ +Create a new globally unique ID. + +An ID consists of two parts separated by a colon: +- a prefix +- a unique part that will be created according to `org-id-method'. + +PREFIX can specify the prefix, the default is given by the variable +`org-id-prefix'. However, if PREFIX is the symbol `none', don't use any +prefix even if `org-id-prefix' specifies one. + +So a typical ID could look like \"Org:4nd91V40HI\". + +\(fn &optional PREFIX)" nil nil) + +(autoload 'org-id-update-id-locations "org-id" "\ +Scan relevant files for IDs. +Store the relation between files and corresponding IDs. +This will scan all agenda files, all associated archives, and all +files currently mentioned in `org-id-locations'. +When FILES is given, scan these files instead. +When CHECK is given, prepare detailed information about duplicate IDs. + +\(fn &optional FILES SILENT)" t nil) + +(autoload 'org-id-find-id-file "org-id" "\ +Query the id database for the file in which this ID is located. + +\(fn ID)" nil nil) + +(autoload 'org-id-store-link "org-id" "\ +Store a link to the current entry, using its ID. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (org-indent-mode) "org-indent" "org-indent.el" +;;;;;; "3d658901e4f096f04688498e4a709eb5") +;;; Generated autoloads from org-indent.el + +(autoload 'org-indent-mode "org-indent" "\ +When active, indent text according to outline structure. + +Internally this works by adding `line-prefix' and `wrap-prefix' +properties, after each buffer modification, on the modified zone. + +The process is synchronous. Though, initial indentation of +buffer, which can take a few seconds on large buffers, is done +during idle time. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads (org-irc-store-link) "org-irc" "org-irc.el" "2432d5cd8271c05b0e8778cd26bf11ab") +;;; Generated autoloads from org-irc.el + +(autoload 'org-irc-store-link "org-irc" "\ +Dispatch to the appropriate function to store a link to an IRC session. + +\(fn)" nil nil) + +;;;*** + +;;;### (autoloads (org-load-noerror-mustsuffix) "org-macs" "org-macs.el" +;;;;;; (21820 29495)) +;;; Generated autoloads from org-macs.el + +(autoload 'org-load-noerror-mustsuffix "org-macs" "\ +Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it. + +\(fn FILE)" nil (quote macro)) + +;;;*** + +;;;### (autoloads (org-mobile-pull org-mobile-push) "org-mobile" +;;;;;; "org-mobile.el" "13cb59aeb0c907454cbd127597d96ea2") +;;; Generated autoloads from org-mobile.el + +(autoload 'org-mobile-push "org-mobile" "\ +Push the current state of Org affairs to the target directory. +This will create the index file, copy all agenda files there, and also +create all custom agenda views, for upload to the mobile phone. + +\(fn)" t nil) + +(autoload 'org-mobile-pull "org-mobile" "\ +Pull the contents of `org-mobile-capture-file' and integrate them. +Apply all flagged actions, flag entries to be flagged and then call an +agenda view showing the flagged items. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (org-plot/gnuplot) "org-plot" "org-plot.el" "5fae0ed29ffaee8526d31b4634c56692") +;;; Generated autoloads from org-plot.el + +(autoload 'org-plot/gnuplot "org-plot" "\ +Plot table using gnuplot. Gnuplot options can be specified with PARAMS. +If not given options will be taken from the +PLOT +line directly before or after the table. + +\(fn &optional PARAMS)" t nil) + +;;;*** + +;;;### (autoloads (orgtbl-to-orgtbl orgtbl-to-texinfo orgtbl-to-html +;;;;;; orgtbl-to-latex orgtbl-to-csv orgtbl-to-tsv orgtbl-to-generic +;;;;;; org-table-to-lisp orgtbl-mode org-table-toggle-formula-debugger +;;;;;; org-table-toggle-coordinate-overlays org-table-edit-formulas +;;;;;; org-table-iterate-buffer-tables org-table-recalculate-buffer-tables +;;;;;; org-table-iterate org-table-recalculate org-table-set-constants +;;;;;; org-table-eval-formula org-table-maybe-recalculate-line org-table-rotate-recalc-marks +;;;;;; org-table-maybe-eval-formula org-table-get-stored-formulas +;;;;;; org-table-sum org-table-edit-field org-table-wrap-region +;;;;;; org-table-convert org-table-paste-rectangle org-table-copy-region +;;;;;; org-table-cut-region org-table-sort-lines org-table-kill-row +;;;;;; org-table-hline-and-move org-table-insert-hline org-table-insert-row +;;;;;; org-table-move-row org-table-move-row-up org-table-move-row-down +;;;;;; org-table-move-column org-table-move-column-left org-table-move-column-right +;;;;;; org-table-delete-column org-table-insert-column org-table-goto-column +;;;;;; org-table-current-dline org-table-field-info org-table-blank-field +;;;;;; org-table-copy-down org-table-next-row org-table-previous-field +;;;;;; org-table-next-field org-table-justify-field-maybe org-table-end +;;;;;; org-table-begin org-table-align org-table-export org-table-import +;;;;;; org-table-convert-region org-table-create org-table-create-or-convert-from-region +;;;;;; org-table-create-with-table\.el) "org-table" "org-table.el" +;;;;;; "9b6e8818ec6951cc97eba4e5d0822cef") +;;; Generated autoloads from org-table.el + +(autoload 'org-table-create-with-table\.el "org-table" "\ +Use the table.el package to insert a new table. +If there is already a table at point, convert between Org-mode tables +and table.el tables. + +\(fn)" t nil) + +(autoload 'org-table-create-or-convert-from-region "org-table" "\ +Convert region to table, or create an empty table. +If there is an active region, convert it to a table, using the function +`org-table-convert-region'. See the documentation of that function +to learn how the prefix argument is interpreted to determine the field +separator. +If there is no such region, create an empty table with `org-table-create'. + +\(fn ARG)" t nil) + +(autoload 'org-table-create "org-table" "\ +Query for a size and insert a table skeleton. +SIZE is a string Columns x Rows like for example \"3x2\". + +\(fn &optional SIZE)" t nil) + +(autoload 'org-table-convert-region "org-table" "\ +Convert region to a table. +The region goes from BEG0 to END0, but these borders will be moved +slightly, to make sure a beginning of line in the first line is included. + +SEPARATOR specifies the field separator in the lines. It can have the +following values: + +'(4) Use the comma as a field separator +'(16) Use a TAB as field separator +integer When a number, use that many spaces as field separator +nil When nil, the command tries to be smart and figure out the + separator in the following way: + - when each line contains a TAB, assume TAB-separated material + - when each line contains a comma, assume CSV material + - else, assume one or more SPACE characters as separator. + +\(fn BEG0 END0 &optional SEPARATOR)" t nil) + +(autoload 'org-table-import "org-table" "\ +Import FILE as a table. +The file is assumed to be tab-separated. Such files can be produced by most +spreadsheet and database applications. If no tabs (at least one per line) +are found, lines will be split on whitespace into fields. + +\(fn FILE ARG)" t nil) + +(autoload 'org-table-export "org-table" "\ +Export table to a file, with configurable format. +Such a file can be imported into usual spreadsheet programs. + +FILE can be the output file name. If not given, it will be taken +from a TABLE_EXPORT_FILE property in the current entry or higher +up in the hierarchy, or the user will be prompted for a file +name. FORMAT can be an export format, of the same kind as it +used when `orgtbl-mode' sends a table in a different format. + +The command suggests a format depending on TABLE_EXPORT_FORMAT, +whether it is set locally or up in the hierarchy, then on the +extension of the given file name, and finally on the variable +`org-table-export-default-format'. + +\(fn &optional FILE FORMAT)" t nil) + +(autoload 'org-table-align "org-table" "\ +Align the table at point by aligning all vertical bars. + +\(fn)" t nil) + +(autoload 'org-table-begin "org-table" "\ +Find the beginning of the table and return its position. +With argument TABLE-TYPE, go to the beginning of a table.el-type table. + +\(fn &optional TABLE-TYPE)" nil nil) + +(autoload 'org-table-end "org-table" "\ +Find the end of the table and return its position. +With argument TABLE-TYPE, go to the end of a table.el-type table. + +\(fn &optional TABLE-TYPE)" nil nil) + +(autoload 'org-table-justify-field-maybe "org-table" "\ +Justify the current field, text to left, number to right. +Optional argument NEW may specify text to replace the current field content. + +\(fn &optional NEW)" nil nil) + +(autoload 'org-table-next-field "org-table" "\ +Go to the next field in the current table, creating new lines as needed. +Before doing so, re-align the table if necessary. + +\(fn)" t nil) + +(autoload 'org-table-previous-field "org-table" "\ +Go to the previous field in the table. +Before doing so, re-align the table if necessary. + +\(fn)" t nil) + +(autoload 'org-table-next-row "org-table" "\ +Go to the next row (same column) in the current table. +Before doing so, re-align the table if necessary. + +\(fn)" t nil) + +(autoload 'org-table-copy-down "org-table" "\ +Copy a field down in the current column. +If the field at the cursor is empty, copy into it the content of +the nearest non-empty field above. With argument N, use the Nth +non-empty field. If the current field is not empty, it is copied +down to the next row, and the cursor is moved with it. +Therefore, repeating this command causes the column to be filled +row-by-row. +If the variable `org-table-copy-increment' is non-nil and the +field is an integer or a timestamp, it will be incremented while +copying. In the case of a timestamp, increment by one day. + +\(fn N)" t nil) + +(autoload 'org-table-blank-field "org-table" "\ +Blank the current table field or active region. + +\(fn)" t nil) + +(autoload 'org-table-field-info "org-table" "\ +Show info about the current field, and highlight any reference at point. + +\(fn ARG)" t nil) + +(autoload 'org-table-current-dline "org-table" "\ +Find out what table data line we are in. +Only data lines count for this. + +\(fn)" t nil) + +(autoload 'org-table-goto-column "org-table" "\ +Move the cursor to the Nth column in the current table line. +With optional argument ON-DELIM, stop with point before the left delimiter +of the field. +If there are less than N fields, just go to after the last delimiter. +However, when FORCE is non-nil, create new columns if necessary. + +\(fn N &optional ON-DELIM FORCE)" t nil) + +(autoload 'org-table-insert-column "org-table" "\ +Insert a new column into the table. + +\(fn)" t nil) + +(autoload 'org-table-delete-column "org-table" "\ +Delete a column from the table. + +\(fn)" t nil) + +(autoload 'org-table-move-column-right "org-table" "\ +Move column to the right. + +\(fn)" t nil) + +(autoload 'org-table-move-column-left "org-table" "\ +Move column to the left. + +\(fn)" t nil) + +(autoload 'org-table-move-column "org-table" "\ +Move the current column to the right. With arg LEFT, move to the left. + +\(fn &optional LEFT)" t nil) + +(autoload 'org-table-move-row-down "org-table" "\ +Move table row down. + +\(fn)" t nil) + +(autoload 'org-table-move-row-up "org-table" "\ +Move table row up. + +\(fn)" t nil) + +(autoload 'org-table-move-row "org-table" "\ +Move the current table line down. With arg UP, move it up. + +\(fn &optional UP)" t nil) + +(autoload 'org-table-insert-row "org-table" "\ +Insert a new row above the current line into the table. +With prefix ARG, insert below the current line. + +\(fn &optional ARG)" t nil) + +(autoload 'org-table-insert-hline "org-table" "\ +Insert a horizontal-line below the current line into the table. +With prefix ABOVE, insert above the current line. + +\(fn &optional ABOVE)" t nil) + +(autoload 'org-table-hline-and-move "org-table" "\ +Insert a hline and move to the row below that line. + +\(fn &optional SAME-COLUMN)" t nil) + +(autoload 'org-table-kill-row "org-table" "\ +Delete the current row or horizontal line from the table. + +\(fn)" t nil) + +(autoload 'org-table-sort-lines "org-table" "\ +Sort table lines according to the column at point. + +The position of point indicates the column to be used for +sorting, and the range of lines is the range between the nearest +horizontal separator lines, or the entire table of no such lines +exist. If point is before the first column, you will be prompted +for the sorting column. If there is an active region, the mark +specifies the first line and the sorting column, while point +should be in the last line to be included into the sorting. + +The command then prompts for the sorting type which can be +alphabetically, numerically, or by time (as given in a time stamp +in the field). Sorting in reverse order is also possible. + +With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive. + +If SORTING-TYPE is specified when this function is called from a Lisp +program, no prompting will take place. SORTING-TYPE must be a character, +any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting +should be done in reverse order. + +\(fn WITH-CASE &optional SORTING-TYPE)" t nil) + +(autoload 'org-table-cut-region "org-table" "\ +Copy region in table to the clipboard and blank all relevant fields. +If there is no active region, use just the field at point. + +\(fn BEG END)" t nil) + +(autoload 'org-table-copy-region "org-table" "\ +Copy rectangular region in table to clipboard. +A special clipboard is used which can only be accessed +with `org-table-paste-rectangle'. + +\(fn BEG END &optional CUT)" t nil) + +(autoload 'org-table-paste-rectangle "org-table" "\ +Paste a rectangular region into a table. +The upper right corner ends up in the current field. All involved fields +will be overwritten. If the rectangle does not fit into the present table, +the table is enlarged as needed. The process ignores horizontal separator +lines. + +\(fn)" t nil) + +(autoload 'org-table-convert "org-table" "\ +Convert from `org-mode' table to table.el and back. +Obviously, this only works within limits. When an Org-mode table is +converted to table.el, all horizontal separator lines get lost, because +table.el uses these as cell boundaries and has no notion of horizontal lines. +A table.el table can be converted to an Org-mode table only if it does not +do row or column spanning. Multiline cells will become multiple cells. +Beware, Org-mode does not test if the table can be successfully converted - it +blindly applies a recipe that works for simple tables. + +\(fn)" t nil) + +(autoload 'org-table-wrap-region "org-table" "\ +Wrap several fields in a column like a paragraph. +This is useful if you'd like to spread the contents of a field over several +lines, in order to keep the table compact. + +If there is an active region, and both point and mark are in the same column, +the text in the column is wrapped to minimum width for the given number of +lines. Generally, this makes the table more compact. A prefix ARG may be +used to change the number of desired lines. For example, `C-2 \\[org-table-wrap]' +formats the selected text to two lines. If the region was longer than two +lines, the remaining lines remain empty. A negative prefix argument reduces +the current number of lines by that amount. The wrapped text is pasted back +into the table. If you formatted it to more lines than it was before, fields +further down in the table get overwritten - so you might need to make space in +the table first. + +If there is no region, the current field is split at the cursor position and +the text fragment to the right of the cursor is prepended to the field one +line down. + +If there is no region, but you specify a prefix ARG, the current field gets +blank, and the content is appended to the field above. + +\(fn ARG)" t nil) + +(autoload 'org-table-edit-field "org-table" "\ +Edit table field in a different window. +This is mainly useful for fields that contain hidden parts. +When called with a \\[universal-argument] prefix, just make the full field visible so that +it can be edited in place. + +\(fn ARG)" t nil) + +(autoload 'org-table-sum "org-table" "\ +Sum numbers in region of current table column. +The result will be displayed in the echo area, and will be available +as kill to be inserted with \\[yank]. + +If there is an active region, it is interpreted as a rectangle and all +numbers in that rectangle will be summed. If there is no active +region and point is located in a table column, sum all numbers in that +column. + +If at least one number looks like a time HH:MM or HH:MM:SS, all other +numbers are assumed to be times as well (in decimal hours) and the +numbers are added as such. + +If NLAST is a number, only the NLAST fields will actually be summed. + +\(fn &optional BEG END NLAST)" t nil) + +(autoload 'org-table-get-stored-formulas "org-table" "\ +Return an alist with the stored formulas directly after current table. + +\(fn &optional NOERROR)" t nil) + +(autoload 'org-table-maybe-eval-formula "org-table" "\ +Check if the current field starts with \"=\" or \":=\". +If yes, store the formula and apply it. + +\(fn)" nil nil) + +(autoload 'org-table-rotate-recalc-marks "org-table" "\ +Rotate the recalculation mark in the first column. +If in any row, the first field is not consistent with a mark, +insert a new column for the markers. +When there is an active region, change all the lines in the region, +after prompting for the marking character. +After each change, a message will be displayed indicating the meaning +of the new mark. + +\(fn &optional NEWCHAR)" t nil) + +(autoload 'org-table-maybe-recalculate-line "org-table" "\ +Recompute the current line if marked for it, and if we haven't just done it. + +\(fn)" t nil) + +(autoload 'org-table-eval-formula "org-table" "\ +Replace the table field value at the cursor by the result of a calculation. + +This function makes use of Dave Gillespie's Calc package, in my view the +most exciting program ever written for GNU Emacs. So you need to have Calc +installed in order to use this function. + +In a table, this command replaces the value in the current field with the +result of a formula. It also installs the formula as the \"current\" column +formula, by storing it in a special line below the table. When called +with a `C-u' prefix, the current field must be a named field, and the +formula is installed as valid in only this specific field. + +When called with two `C-u' prefixes, insert the active equation +for the field back into the current field, so that it can be +edited there. This is useful in order to use \\[org-table-show-reference] +to check the referenced fields. + +When called, the command first prompts for a formula, which is read in +the minibuffer. Previously entered formulas are available through the +history list, and the last used formula is offered as a default. +These stored formulas are adapted correctly when moving, inserting, or +deleting columns with the corresponding commands. + +The formula can be any algebraic expression understood by the Calc package. +For details, see the Org-mode manual. + +This function can also be called from Lisp programs and offers +additional arguments: EQUATION can be the formula to apply. If this +argument is given, the user will not be prompted. SUPPRESS-ALIGN is +used to speed-up recursive calls by by-passing unnecessary aligns. +SUPPRESS-CONST suppresses the interpretation of constants in the +formula, assuming that this has been done already outside the function. +SUPPRESS-STORE means the formula should not be stored, either because +it is already stored, or because it is a modified equation that should +not overwrite the stored one. + +\(fn &optional ARG EQUATION SUPPRESS-ALIGN SUPPRESS-CONST SUPPRESS-STORE SUPPRESS-ANALYSIS)" t nil) + +(autoload 'org-table-set-constants "org-table" "\ +Set `org-table-formula-constants-local' in the current buffer. + +\(fn)" nil nil) + +(autoload 'org-table-recalculate "org-table" "\ +Recalculate the current table line by applying all stored formulas. +With prefix arg ALL, do this for all lines in the table. +With the prefix argument ALL is `(16)' (a double \\[universal-prefix] \\[universal-prefix] prefix), or if +it is the symbol `iterate', recompute the table until it no longer changes. +If NOALIGN is not nil, do not re-align the table after the computations +are done. This is typically used internally to save time, if it is +known that the table will be realigned a little later anyway. + +\(fn &optional ALL NOALIGN)" t nil) + +(autoload 'org-table-iterate "org-table" "\ +Recalculate the table until it does not change anymore. +The maximum number of iterations is 10, but you can choose a different value +with the prefix ARG. + +\(fn &optional ARG)" t nil) + +(autoload 'org-table-recalculate-buffer-tables "org-table" "\ +Recalculate all tables in the current buffer. + +\(fn)" t nil) + +(autoload 'org-table-iterate-buffer-tables "org-table" "\ +Iterate all tables in the buffer, to converge inter-table dependencies. + +\(fn)" t nil) + +(autoload 'org-table-edit-formulas "org-table" "\ +Edit the formulas of the current table in a separate buffer. + +\(fn)" t nil) + +(autoload 'org-table-toggle-coordinate-overlays "org-table" "\ +Toggle the display of Row/Column numbers in tables. + +\(fn)" t nil) + +(autoload 'org-table-toggle-formula-debugger "org-table" "\ +Toggle the formula debugger in tables. + +\(fn)" t nil) + +(autoload 'orgtbl-mode "org-table" "\ +The `org-mode' table editor as a minor mode for use in other modes. + +\(fn &optional ARG)" t nil) + +(autoload 'org-table-to-lisp "org-table" "\ +Convert the table at point to a Lisp structure. +The structure will be a list. Each item is either the symbol `hline' +for a horizontal separator line, or a list of field values as strings. +The table is taken from the parameter TXT, or from the buffer at point. + +\(fn &optional TXT)" nil nil) + +(autoload 'orgtbl-to-generic "org-table" "\ +Convert the orgtbl-mode TABLE to some other format. +This generic routine can be used for many standard cases. +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. +A third optional argument BACKEND can be used to convert the content of +the cells using a specific export back-end. + +For the generic converter, some parameters are obligatory: you need to +specify either :lfmt, or all of (:lstart :lend :sep). + +Valid parameters are: + +:splice When set to t, return only table body lines, don't wrap + them into :tstart and :tend. Default is nil. When :splice + is non-nil, this also means that the exporter should not look + for and interpret header and footer sections. + +:hline String to be inserted on horizontal separation lines. + May be nil to ignore hlines. + +:sep Separator between two fields +:remove-nil-lines Do not include lines that evaluate to nil. + +Each in the following group may be either a string or a function +of no arguments returning a string: + +:tstart String to start the table. Ignored when :splice is t. +:tend String to end the table. Ignored when :splice is t. +:lstart String to start a new table line. +:llstart String to start the last table line, defaults to :lstart. +:lend String to end a table line +:llend String to end the last table line, defaults to :lend. + +Each in the following group may be a string, a function of one +argument (the field or line) returning a string, or a plist +mapping columns to either of the above: + +:lfmt Format for entire line, with enough %s to capture all fields. + If this is present, :lstart, :lend, and :sep are ignored. +:llfmt Format for the entire last line, defaults to :lfmt. +:fmt A format to be used to wrap the field, should contain + %s for the original field value. For example, to wrap + everything in dollars, you could use :fmt \"$%s$\". + This may also be a property list with column numbers and + formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\") +:hlstart :hllstart :hlend :hllend :hlsep :hlfmt :hllfmt :hfmt + Same as above, specific for the header lines in the table. + All lines before the first hline are treated as header. + If any of these is not present, the data line value is used. + +This may be either a string or a function of two arguments: + +:efmt Use this format to print numbers with exponentials. + The format should have %s twice for inserting mantissa + and exponent, for example \"%s\\\\times10^{%s}\". This + may also be a property list with column numbers and + formats. :fmt will still be applied after :efmt. + +In addition to this, the parameters :skip and :skipcols are always handled +directly by `orgtbl-send-table'. See manual. + +\(fn TABLE PARAMS &optional BACKEND)" nil nil) + +(autoload 'orgtbl-to-tsv "org-table" "\ +Convert the orgtbl-mode table to TAB separated material. + +\(fn TABLE PARAMS)" nil nil) + +(autoload 'orgtbl-to-csv "org-table" "\ +Convert the orgtbl-mode table to CSV material. +This does take care of the proper quoting of fields with comma or quotes. + +\(fn TABLE PARAMS)" nil nil) + +(autoload 'orgtbl-to-latex "org-table" "\ +Convert the orgtbl-mode TABLE to LaTeX. +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. +Supports all parameters from `orgtbl-to-generic'. Most important for +LaTeX are: + +:splice When set to t, return only table body lines, don't wrap + them into a tabular environment. Default is nil. + +:fmt A format to be used to wrap the field, should contain %s for the + original field value. For example, to wrap everything in dollars, + use :fmt \"$%s$\". This may also be a property list with column + numbers and formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\") + The format may also be a function that formats its one argument. + +:efmt Format for transforming numbers with exponentials. The format + should have %s twice for inserting mantissa and exponent, for + example \"%s\\\\times10^{%s}\". LaTeX default is \"%s\\\\,(%s)\". + This may also be a property list with column numbers and formats. + The format may also be a function that formats its two arguments. + +:llend If you find too much space below the last line of a table, + pass a value of \"\" for :llend to suppress the final \\\\. + +The general parameters :skip and :skipcols have already been applied when +this function is called. + +\(fn TABLE PARAMS)" nil nil) + +(autoload 'orgtbl-to-html "org-table" "\ +Convert the orgtbl-mode TABLE to HTML. +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. +Currently this function recognizes the following parameters: + +:splice When set to t, return only table body lines, don't wrap + them into a <table> environment. Default is nil. + +The general parameters :skip and :skipcols have already been applied when +this function is called. The function does *not* use `orgtbl-to-generic', +so you cannot specify parameters for it. + +\(fn TABLE PARAMS)" nil nil) + +(autoload 'orgtbl-to-texinfo "org-table" "\ +Convert the orgtbl-mode TABLE to TeXInfo. +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. +Supports all parameters from `orgtbl-to-generic'. Most important for +TeXInfo are: + +:splice nil/t When set to t, return only table body lines, don't wrap + them into a multitable environment. Default is nil. + +:fmt fmt A format to be used to wrap the field, should contain + %s for the original field value. For example, to wrap + everything in @kbd{}, you could use :fmt \"@kbd{%s}\". + This may also be a property list with column numbers and + formats. For example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). + Each format also may be a function that formats its one + argument. + +:cf \"f1 f2..\" The column fractions for the table. By default these + are computed automatically from the width of the columns + under org-mode. + +The general parameters :skip and :skipcols have already been applied when +this function is called. + +\(fn TABLE PARAMS)" nil nil) + +(autoload 'orgtbl-to-orgtbl "org-table" "\ +Convert the orgtbl-mode TABLE into another orgtbl-mode table. +Useful when slicing one table into many. The :hline, :sep, +:lstart, and :lend provide orgtbl framing. The default nil :tstart +and :tend suppress strings without splicing; they can be set to +provide ORGTBL directives for the generated table. + +\(fn TABLE PARAMS)" nil nil) + +;;;*** + +;;;### (autoloads (org-timer-set-timer org-timer-item org-timer-change-times-in-region +;;;;;; org-timer org-timer-start) "org-timer" "org-timer.el" "54b0453041fa05a477a9da6054ed8b31") +;;; Generated autoloads from org-timer.el + +(autoload 'org-timer-start "org-timer" "\ +Set the starting time for the relative timer to now. +When called with prefix argument OFFSET, prompt the user for an offset time, +with the default taken from a timer stamp at point, if any. +If OFFSET is a string or an integer, it is directly taken to be the offset +without user interaction. +When called with a double prefix arg, all timer strings in the active +region will be shifted by a specific amount. You will be prompted for +the amount, with the default to make the first timer string in +the region 0:00:00. + +\(fn &optional OFFSET)" t nil) + +(autoload 'org-timer "org-timer" "\ +Insert a H:MM:SS string from the timer into the buffer. +The first time this command is used, the timer is started. When used with +a \\[universal-argument] prefix, force restarting the timer. +When used with a double prefix argument \\[universal-argument], change all the timer string +in the region by a fixed amount. This can be used to recalibrate a timer +that was not started at the correct moment. + +If NO-INSERT-P is non-nil, return the string instead of inserting +it in the buffer. + +\(fn &optional RESTART NO-INSERT-P)" t nil) + +(autoload 'org-timer-change-times-in-region "org-timer" "\ +Change all h:mm:ss time in region by a DELTA. + +\(fn BEG END DELTA)" t nil) + +(autoload 'org-timer-item "org-timer" "\ +Insert a description-type item with the current timer value. + +\(fn &optional ARG)" t nil) + +(autoload 'org-timer-set-timer "org-timer" "\ +Prompt for a duration and set a timer. + +If `org-timer-default-timer' is not zero, suggest this value as +the default duration for the timer. If a timer is already set, +prompt the user if she wants to replace it. + +Called with a numeric prefix argument, use this numeric value as +the duration of the timer. + +Called with a `C-u' prefix arguments, use `org-timer-default-timer' +without prompting the user for a duration. + +With two `C-u' prefix arguments, use `org-timer-default-timer' +without prompting the user for a duration and automatically +replace any running timer. + +\(fn &optional OPT)" t nil) + +;;;*** + +;;;### (autoloads (org-git-version org-release) "org-version" "org-version.el" +;;;;;; (21821 49750)) +;;; Generated autoloads from org-version.el + +(autoload 'org-release "org-version" "\ +The release version of org-mode. + Inserted by installing org-mode or when a release is made. + +\(fn)" nil nil) + +(autoload 'org-git-version "org-version" "\ +The Git version of org-mode. + Inserted by installing org-mode or when a release is made. + +\(fn)" nil nil) + +(defvar org-odt-data-dir "/usr/share/emacs/etc/org" "\ +The location of ODT styles.") + +;;;*** + +;;;### (autoloads (org-customize org-reload org-submit-bug-report +;;;;;; org-cycle-agenda-files org-switchb org-open-link-from-string +;;;;;; org-open-at-point-global org-insert-link-global org-store-link +;;;;;; org-run-like-in-org-mode turn-on-orgstruct++ turn-on-orgstruct +;;;;;; orgstruct-mode org-global-cycle org-cycle org-mode org-clock-persistence-insinuate +;;;;;; turn-on-orgtbl org-version org-babel-load-file org-babel-do-load-languages) +;;;;;; "org" "org.el" (21820 29495)) +;;; Generated autoloads from org.el + +(autoload 'org-babel-do-load-languages "org" "\ +Load the languages defined in `org-babel-load-languages'. + +\(fn SYM VALUE)" nil nil) + +(autoload 'org-babel-load-file "org" "\ +Load Emacs Lisp source code blocks in the Org-mode FILE. +This function exports the source code using `org-babel-tangle' +and then loads the resulting file using `load-file'. With prefix +arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp +file to byte-code before it is loaded. + +\(fn FILE &optional COMPILE)" t nil) + +(autoload 'org-version "org" "\ +Show the org-mode version in the echo area. +With prefix argument HERE, insert it at point. +When FULL is non-nil, use a verbose version string. +When MESSAGE is non-nil, display a message with the version. + +\(fn &optional HERE FULL MESSAGE)" t nil) + +(autoload 'turn-on-orgtbl "org" "\ +Unconditionally turn on `orgtbl-mode'. + +\(fn)" nil nil) + +(autoload 'org-clock-persistence-insinuate "org" "\ +Set up hooks for clock persistence. + +\(fn)" nil nil) + +(autoload 'org-mode "org" "\ +Outline-based notes management and organizer, alias +\"Carsten's outline-mode for keeping track of everything.\" + +Org-mode develops organizational tasks around a NOTES file which +contains information about projects as plain text. Org-mode is +implemented on top of outline-mode, which is ideal to keep the content +of large files well structured. It supports ToDo items, deadlines and +time stamps, which magically appear in the diary listing of the Emacs +calendar. Tables are easily created with a built-in table editor. +Plain text URL-like links connect to websites, emails (VM), Usenet +messages (Gnus), BBDB entries, and any files related to the project. +For printing and sharing of notes, an Org-mode file (or a part of it) +can be exported as a structured ASCII or HTML file. + +The following commands are available: + +\\{org-mode-map} + +\(fn)" t nil) + +(autoload 'org-cycle "org" "\ +TAB-action and visibility cycling for Org-mode. + +This is the command invoked in Org-mode by the TAB key. Its main purpose +is outline visibility cycling, but it also invokes other actions +in special contexts. + +- When this function is called with a prefix argument, rotate the entire + buffer through 3 states (global cycling) + 1. OVERVIEW: Show only top-level headlines. + 2. CONTENTS: Show all headlines of all levels, but no body text. + 3. SHOW ALL: Show everything. + When called with two `C-u C-u' prefixes, switch to the startup visibility, + determined by the variable `org-startup-folded', and by any VISIBILITY + properties in the buffer. + When called with three `C-u C-u C-u' prefixed, show the entire buffer, + including any drawers. + +- When inside a table, re-align the table and move to the next field. + +- When point is at the beginning of a headline, rotate the subtree started + by this line through 3 different states (local cycling) + 1. FOLDED: Only the main headline is shown. + 2. CHILDREN: The main headline and the direct children are shown. + From this state, you can move to one of the children + and zoom in further. + 3. SUBTREE: Show the entire subtree, including body text. + If there is no subtree, switch directly from CHILDREN to FOLDED. + +- When point is at the beginning of an empty headline and the variable + `org-cycle-level-after-item/entry-creation' is set, cycle the level + of the headline by demoting and promoting it to likely levels. This + speeds up creation document structure by pressing TAB once or several + times right after creating a new headline. + +- When there is a numeric prefix, go up to a heading with level ARG, do + a `show-subtree' and return to the previous cursor position. If ARG + is negative, go up that many levels. + +- When point is not at the beginning of a headline, execute the global + binding for TAB, which is re-indenting the line. See the option + `org-cycle-emulate-tab' for details. + +- Special case: if point is at the beginning of the buffer and there is + no headline in line 1, this function will act as if called with prefix arg + (C-u TAB, same as S-TAB) also when called without prefix arg. + But only if also the variable `org-cycle-global-at-bob' is t. + +\(fn &optional ARG)" t nil) + +(autoload 'org-global-cycle "org" "\ +Cycle the global visibility. For details see `org-cycle'. +With \\[universal-argument] prefix arg, switch to startup visibility. +With a numeric prefix, show all headlines up to that level. + +\(fn &optional ARG)" t nil) +(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp) + +(autoload 'orgstruct-mode "org" "\ +Toggle the minor mode `orgstruct-mode'. +This mode is for using Org-mode structure commands in other +modes. The following keys behave as if Org-mode were active, if +the cursor is on a headline, or on a plain list item (both as +defined by Org-mode). + +\(fn &optional ARG)" t nil) + +(autoload 'turn-on-orgstruct "org" "\ +Unconditionally turn on `orgstruct-mode'. + +\(fn)" nil nil) + +(autoload 'turn-on-orgstruct++ "org" "\ +Unconditionally turn on `orgstruct++-mode'. + +\(fn)" nil nil) + +(autoload 'org-run-like-in-org-mode "org" "\ +Run a command, pretending that the current buffer is in Org-mode. +This will temporarily bind local variables that are typically bound in +Org-mode to the values they have in Org-mode, and then interactively +call CMD. + +\(fn CMD)" nil nil) + +(autoload 'org-store-link "org" "\ +\\<org-mode-map>Store an org-link to the current location. +This link is added to `org-stored-links' and can later be inserted +into an org-buffer with \\[org-insert-link]. + +For some link types, a prefix arg is interpreted. +For links to Usenet articles, arg negates `org-gnus-prefer-web-links'. +For file links, arg negates `org-context-in-file-links'. + +A double prefix arg force skipping storing functions that are not +part of Org's core. + +A triple prefix arg force storing a link for each line in the +active region. + +\(fn ARG)" t nil) + +(autoload 'org-insert-link-global "org" "\ +Insert a link like Org-mode does. +This command can be called in any mode to insert a link in Org-mode syntax. + +\(fn)" t nil) + +(autoload 'org-open-at-point-global "org" "\ +Follow a link like Org-mode does. +This command can be called in any mode to follow a link that has +Org-mode syntax. + +\(fn)" t nil) + +(autoload 'org-open-link-from-string "org" "\ +Open a link in the string S, as if it was in Org-mode. + +\(fn S &optional ARG REFERENCE-BUFFER)" t nil) + +(autoload 'org-switchb "org" "\ +Switch between Org buffers. +With one prefix argument, restrict available buffers to files. +With two prefix arguments, restrict available buffers to agenda files. + +Defaults to `iswitchb' for buffer name completion. +Set `org-completion-use-ido' to make it use ido instead. + +\(fn &optional ARG)" t nil) + +(defalias 'org-ido-switchb 'org-switchb) + +(defalias 'org-iswitchb 'org-switchb) + +(autoload 'org-cycle-agenda-files "org" "\ +Cycle through the files in `org-agenda-files'. +If the current buffer visits an agenda file, find the next one in the list. +If the current buffer does not, find the first agenda file. + +\(fn)" t nil) + +(autoload 'org-submit-bug-report "org" "\ +Submit a bug report on Org-mode via mail. + +Don't hesitate to report any problems or inaccurate documentation. + +If you don't have setup sending mail from (X)Emacs, please copy the +output buffer into your mail program, as it gives us important +information about your Org-mode version and configuration. + +\(fn)" t nil) + +(autoload 'org-reload "org" "\ +Reload all org lisp files. +With prefix arg UNCOMPILED, load the uncompiled versions. + +\(fn &optional UNCOMPILED)" t nil) + +(autoload 'org-customize "org" "\ +Call the customize function with org as argument. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "ox" "ox.el" "a3f90141f011b5f549828135c723de85") +;;; Generated autoloads from ox.el + +(autoload 'org-export-as "ox" "\ +Transcode current Org buffer into BACKEND code. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +If narrowing is active in the current buffer, only transcode its +narrowed part. + +If a region is active, transcode that region. + +When optional argument SUBTREEP is non-nil, transcode the +sub-tree at point, extracting information from the headline +properties first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only return body +code, without surrounding template. + +Optional argument EXT-PLIST, when provided, is a property list +with external parameters overriding Org default settings, but +still inferior to file-local settings. + +Return code as a string. + +\(fn BACKEND &optional SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" nil nil) + +(autoload 'org-export-string-as "ox" "\ +Transcode STRING into BACKEND code. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +When optional argument BODY-ONLY is non-nil, only return body +code, without preamble nor postamble. + +Optional argument EXT-PLIST, when provided, is a property list +with external parameters overriding Org default settings, but +still inferior to file-local settings. + +Return code as a string. + +\(fn STRING BACKEND &optional BODY-ONLY EXT-PLIST)" nil nil) + +(autoload 'org-export-replace-region-by "ox" "\ +Replace the active region by its export to BACKEND. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +\(fn BACKEND)" nil nil) + +(autoload 'org-export-insert-default-template "ox" "\ +Insert all export keywords with default values at beginning of line. + +BACKEND is a symbol referring to the name of a registered export +back-end, for which specific export options should be added to +the template, or `default' for default template. When it is nil, +the user will be prompted for a category. + +If SUBTREEP is non-nil, export configuration will be set up +locally for the subtree through node properties. + +\(fn &optional BACKEND SUBTREEP)" t nil) + +(autoload 'org-export-to-buffer "ox" "\ +Call `org-export-as' with output to a specified buffer. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +BUFFER is the name of the output buffer. If it already exists, +it will be erased first, otherwise, it will be created. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should then be accessible +through the `org-export-stack' interface. When ASYNC is nil, the +buffer is displayed if `org-export-show-temporary-export-buffer' +is non-nil. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which +see. + +Optional argument POST-PROCESS is a function which should accept +no argument. It is always called within the current process, +from BUFFER, with point at its beginning. Export back-ends can +use it to set a major mode there, e.g, + + (defun org-latex-export-as-latex + (&optional async subtreep visible-only body-only ext-plist) + (interactive) + (org-export-to-buffer 'latex \"*Org LATEX Export*\" + async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) + +This function returns BUFFER. + +\(fn BACKEND BUFFER &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST POST-PROCESS)" nil nil) + +(put 'org-export-to-buffer 'lisp-indent-function '2) + +(autoload 'org-export-to-file "ox" "\ +Call `org-export-as' with output to a specified file. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. FILE is the name of the output file, as +a string. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer will then be accessible +through the `org-export-stack' interface. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which +see. + +Optional argument POST-PROCESS is called with FILE as its +argument and happens asynchronously when ASYNC is non-nil. It +has to return a file name, or nil. Export back-ends can use this +to send the output file through additional processing, e.g, + + (defun org-latex-export-to-latex + (&optional async subtreep visible-only body-only ext-plist) + (interactive) + (let ((outfile (org-export-output-file-name \".tex\" subtreep))) + (org-export-to-file 'latex outfile + async subtreep visible-only body-only ext-plist + (lambda (file) (org-latex-compile file))) + +The function returns either a file name returned by POST-PROCESS, +or FILE. + +\(fn BACKEND FILE &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST POST-PROCESS)" nil nil) + +(put 'org-export-to-file 'lisp-indent-function '2) + +(autoload 'org-export-dispatch "ox" "\ +Export dispatcher for Org mode. + +It provides an access to common export related tasks in a buffer. +Its interface comes in two flavors: standard and expert. + +While both share the same set of bindings, only the former +displays the valid keys associations in a dedicated buffer. +Scrolling (resp. line-wise motion) in this buffer is done with +SPC and DEL (resp. C-n and C-p) keys. + +Set variable `org-export-dispatch-use-expert-ui' to switch to one +flavor or the other. + +When ARG is \\[universal-argument], repeat the last export action, with the same set +of options used back then, on the current buffer. + +When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack. + +\(fn &optional ARG)" t nil) + +;;;*** + +;;;### (autoloads (org-ascii-publish-to-utf8 org-ascii-publish-to-latin1 +;;;;;; org-ascii-publish-to-ascii org-ascii-export-to-ascii org-ascii-export-as-ascii) +;;;;;; "ox-ascii" "ox-ascii.el" "8bba507846964285c7ecb40e66b6afe3") +;;; Generated autoloads from ox-ascii.el + +(autoload 'org-ascii-export-as-ascii "ox-ascii" "\ +Export current buffer to a text buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, strip title and +table of contents from output. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org ASCII Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) + +(autoload 'org-ascii-export-to-ascii "ox-ascii" "\ +Export current buffer to a text file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, strip title and +table of contents from output. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) + +(autoload 'org-ascii-publish-to-ascii "ox-ascii" "\ +Publish an Org file to ASCII. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name. + +\(fn PLIST FILENAME PUB-DIR)" nil nil) + +(autoload 'org-ascii-publish-to-latin1 "ox-ascii" "\ +Publish an Org file to Latin-1. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name. + +\(fn PLIST FILENAME PUB-DIR)" nil nil) + +(autoload 'org-ascii-publish-to-utf8 "ox-ascii" "\ +Publish an org file to UTF-8. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name. + +\(fn PLIST FILENAME PUB-DIR)" nil nil) + +;;;*** + +;;;### (autoloads (org-beamer-publish-to-pdf org-beamer-publish-to-latex +;;;;;; org-beamer-insert-options-template org-beamer-select-environment +;;;;;; org-beamer-export-to-pdf org-beamer-export-to-latex org-beamer-export-as-latex +;;;;;; org-beamer-mode) "ox-beamer" "ox-beamer.el" "bb0ba558b851a54fc6394a24106c4bb4") +;;; Generated autoloads from ox-beamer.el + +(autoload 'org-beamer-mode "ox-beamer" "\ +Support for editing Beamer oriented Org mode files. + +\(fn &optional ARG)" t nil) + +(autoload 'org-beamer-export-as-latex "ox-beamer" "\ +Export current buffer as a Beamer buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org BEAMER Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) + +(autoload 'org-beamer-export-to-latex "ox-beamer" "\ +Export current buffer as a Beamer presentation (tex). + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) + +(autoload 'org-beamer-export-to-pdf "ox-beamer" "\ +Export current buffer as a Beamer presentation (PDF). + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return PDF file's name. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) + +(autoload 'org-beamer-select-environment "ox-beamer" "\ +Select the environment to be used by beamer for this entry. +While this uses (for convenience) a tag selection interface, the +result of this command will be that the BEAMER_env *property* of +the entry is set. + +In addition to this, the command will also set a tag as a visual +aid, but the tag does not have any semantic meaning. + +\(fn)" t nil) + +(autoload 'org-beamer-insert-options-template "ox-beamer" "\ +Insert a settings template, to make sure users do this right. + +\(fn &optional KIND)" t nil) + +(autoload 'org-beamer-publish-to-latex "ox-beamer" "\ +Publish an Org file to a Beamer presentation (LaTeX). + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name. + +\(fn PLIST FILENAME PUB-DIR)" nil nil) + +(autoload 'org-beamer-publish-to-pdf "ox-beamer" "\ +Publish an Org file to a Beamer presentation (PDF, via LaTeX). + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name. + +\(fn PLIST FILENAME PUB-DIR)" nil nil) + +;;;*** + +;;;### (autoloads (org-html-publish-to-html org-html-export-to-html +;;;;;; org-html-convert-region-to-html org-html-export-as-html org-html-htmlize-generate-css) +;;;;;; "ox-html" "ox-html.el" "65604b7a2a80c70979b37eb44119d6f9") +;;; Generated autoloads from ox-html.el + +(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp) + +(put 'org-html-head 'safe-local-variable 'stringp) + +(put 'org-html-head-extra 'safe-local-variable 'stringp) + +(autoload 'org-html-htmlize-generate-css "ox-html" "\ +Create the CSS for all font definitions in the current Emacs session. +Use this to create face definitions in your CSS style file that can then +be used by code snippets transformed by htmlize. +This command just produces a buffer that contains class definitions for all +faces used in the current Emacs session. You can copy and paste the ones you +need into your CSS file. + +If you then set `org-html-htmlize-output-type' to `css', calls +to the function `org-html-htmlize-region-for-paste' will +produce code that uses these same face definitions. + +\(fn)" t nil) + +(autoload 'org-html-export-as-html "ox-html" "\ +Export current buffer to an HTML buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"<body>\" and \"</body>\" tags. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org HTML Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) + +(autoload 'org-html-convert-region-to-html "ox-html" "\ +Assume the current region has org-mode syntax, and convert it to HTML. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in an HTML buffer and use this +command to convert it. + +\(fn)" t nil) + +(autoload 'org-html-export-to-html "ox-html" "\ +Export current buffer to a HTML file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"<body>\" and \"</body>\" tags. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) + +(autoload 'org-html-publish-to-html "ox-html" "\ +Publish an org file to HTML. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name. + +\(fn PLIST FILENAME PUB-DIR)" nil nil) + +;;;*** + +;;;### (autoloads (org-icalendar-combine-agenda-files org-icalendar-export-agenda-files +;;;;;; org-icalendar-export-to-ics) "ox-icalendar" "ox-icalendar.el" +;;;;;; "74a493ca40404cb8fd648526fd898b6f") +;;; Generated autoloads from ox-icalendar.el + +(autoload 'org-icalendar-export-to-ics "ox-icalendar" "\ +Export current buffer to an iCalendar file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"BEGIN:VCALENDAR\" and \"END:VCALENDAR\". + +Return ICS file name. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY)" t nil) + +(autoload 'org-icalendar-export-agenda-files "ox-icalendar" "\ +Export all agenda files to iCalendar files. +When optional argument ASYNC is non-nil, export happens in an +external process. + +\(fn &optional ASYNC)" t nil) + +(autoload 'org-icalendar-combine-agenda-files "ox-icalendar" "\ +Combine all agenda files into a single iCalendar file. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +The file is stored under the name chosen in +`org-icalendar-combined-agenda-file'. + +\(fn &optional ASYNC)" t nil) + +;;;*** + +;;;### (autoloads (org-latex-publish-to-pdf org-latex-publish-to-latex +;;;;;; org-latex-export-to-pdf org-latex-export-to-latex org-latex-convert-region-to-latex +;;;;;; org-latex-export-as-latex) "ox-latex" "ox-latex.el" "6277aa86c5275b5aae6c2c2d578a04fb") +;;; Generated autoloads from ox-latex.el + +(autoload 'org-latex-export-as-latex "ox-latex" "\ +Export current buffer as a LaTeX buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org LATEX Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) + +(autoload 'org-latex-convert-region-to-latex "ox-latex" "\ +Assume the current region has org-mode syntax, and convert it to LaTeX. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in an LaTeX buffer and use this +command to convert it. + +\(fn)" t nil) + +(autoload 'org-latex-export-to-latex "ox-latex" "\ +Export current buffer to a LaTeX file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) + +(autoload 'org-latex-export-to-pdf "ox-latex" "\ +Export current buffer to LaTeX then process through to PDF. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return PDF file's name. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) + +(autoload 'org-latex-publish-to-latex "ox-latex" "\ +Publish an Org file to LaTeX. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name. + +\(fn PLIST FILENAME PUB-DIR)" nil nil) + +(autoload 'org-latex-publish-to-pdf "ox-latex" "\ +Publish an Org file to PDF (via LaTeX). + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name. + +\(fn PLIST FILENAME PUB-DIR)" nil nil) + +;;;*** + +;;;### (autoloads (org-md-export-to-markdown org-md-convert-region-to-md +;;;;;; org-md-export-as-markdown) "ox-md" "ox-md.el" "33f62cc6c4fd2d0ee63030f60bc3c5d3") +;;; Generated autoloads from ox-md.el + +(autoload 'org-md-export-as-markdown "ox-md" "\ +Export current buffer to a Markdown buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +Export is done in a buffer named \"*Org MD Export*\", which will +be displayed when `org-export-show-temporary-export-buffer' is +non-nil. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY)" t nil) + +(autoload 'org-md-convert-region-to-md "ox-md" "\ +Assume the current region has org-mode syntax, and convert it to Markdown. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in a Markdown buffer and use +this command to convert it. + +\(fn)" t nil) + +(autoload 'org-md-export-to-markdown "ox-md" "\ +Export current buffer to a Markdown file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +Return output file's name. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY)" t nil) + +;;;*** + +;;;### (autoloads (org-odt-convert org-odt-export-to-odt org-odt-export-as-odf-and-open +;;;;;; org-odt-export-as-odf) "ox-odt" "ox-odt.el" "74b69feba31202aef277a075e012a392") +;;; Generated autoloads from ox-odt.el + +(put 'org-odt-preferred-output-format 'safe-local-variable 'stringp) + +(autoload 'org-odt-export-as-odf "ox-odt" "\ +Export LATEX-FRAG as OpenDocument formula file ODF-FILE. +Use `org-create-math-formula' to convert LATEX-FRAG first to +MathML. When invoked as an interactive command, use +`org-latex-regexps' to infer LATEX-FRAG from currently active +region. If no LaTeX fragments are found, prompt for it. Push +MathML source to kill ring depending on the value of +`org-export-copy-to-kill-ring'. + +\(fn LATEX-FRAG &optional ODF-FILE)" t nil) + +(autoload 'org-odt-export-as-odf-and-open "ox-odt" "\ +Export LaTeX fragment as OpenDocument formula and immediately open it. +Use `org-odt-export-as-odf' to read LaTeX fragment and OpenDocument +formula file. + +\(fn)" t nil) + +(autoload 'org-odt-export-to-odt "ox-odt" "\ +Export current buffer to a ODT file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY EXT-PLIST)" t nil) + +(autoload 'org-odt-convert "ox-odt" "\ +Convert IN-FILE to format OUT-FMT using a command line converter. +IN-FILE is the file to be converted. If unspecified, it defaults +to variable `buffer-file-name'. OUT-FMT is the desired output +format. Use `org-odt-convert-process' as the converter. +If PREFIX-ARG is non-nil then the newly converted file is opened +using `org-open-file'. + +\(fn &optional IN-FILE OUT-FMT PREFIX-ARG)" t nil) + +;;;*** + +;;;### (autoloads (org-org-publish-to-org org-org-export-to-org org-org-export-as-org) +;;;;;; "ox-org" "ox-org.el" "952b4282cdf7bddd86e2e7660934888f") +;;; Generated autoloads from ox-org.el + +(autoload 'org-org-export-as-org "ox-org" "\ +Export current buffer to an Org buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org ORG Export*\", which will +be displayed when `org-export-show-temporary-export-buffer' is +non-nil. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY EXT-PLIST)" t nil) + +(autoload 'org-org-export-to-org "ox-org" "\ +Export current buffer to an org file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file name. + +\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY EXT-PLIST)" t nil) + +(autoload 'org-org-publish-to-org "ox-org" "\ +Publish an org file to org. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name. + +\(fn PLIST FILENAME PUB-DIR)" nil nil) + +;;;*** + +;;;### (autoloads (org-publish-current-project org-publish-current-file +;;;;;; org-publish-all org-publish) "ox-publish" "ox-publish.el" +;;;;;; "20cfd65a07e6275687d28df1d264b407") +;;; Generated autoloads from ox-publish.el + +(defalias 'org-publish-project 'org-publish) + +(autoload 'org-publish "ox-publish" "\ +Publish PROJECT. + +PROJECT is either a project name, as a string, or a project +alist (see `org-publish-project-alist' variable). + +When optional argument FORCE is non-nil, force publishing all +files in PROJECT. With a non-nil optional argument ASYNC, +publishing will be done asynchronously, in another process. + +\(fn PROJECT &optional FORCE ASYNC)" t nil) + +(autoload 'org-publish-all "ox-publish" "\ +Publish all projects. +With prefix argument FORCE, remove all files in the timestamp +directory and force publishing all projects. With a non-nil +optional argument ASYNC, publishing will be done asynchronously, +in another process. + +\(fn &optional FORCE ASYNC)" t nil) + +(autoload 'org-publish-current-file "ox-publish" "\ +Publish the current file. +With prefix argument FORCE, force publish the file. When +optional argument ASYNC is non-nil, publishing will be done +asynchronously, in another process. + +\(fn &optional FORCE ASYNC)" t nil) + +(autoload 'org-publish-current-project "ox-publish" "\ +Publish the project associated with the current file. +With a prefix argument, force publishing of all files in +the project. + +\(fn &optional FORCE ASYNC)" t nil) + +;;;*** + +;;;### (autoloads (org-texinfo-convert-region-to-texinfo org-texinfo-publish-to-texinfo) +;;;;;; "ox-texinfo" "ox-texinfo.el" "ae3f8dd17715c8093138512ae3c347cc") +;;; Generated autoloads from ox-texinfo.el + +(autoload 'org-texinfo-publish-to-texinfo "ox-texinfo" "\ +Publish an org file to Texinfo. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name. + +\(fn PLIST FILENAME PUB-DIR)" nil nil) + +(autoload 'org-texinfo-convert-region-to-texinfo "ox-texinfo" "\ +Assume the current region has org-mode syntax, and convert it to Texinfo. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in an Texinfo buffer and use +this command to convert it. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (org-export-dispatch org-export-to-file org-export-to-buffer +;;;;;; org-export-insert-default-template org-export-replace-region-by +;;;;;; org-export-string-as org-export-as) "ox" "ox.el" "a3f90141f011b5f549828135c723de85") +;;; Generated autoloads from ox.el + +(autoload 'org-export-as "ox" "\ +Transcode current Org buffer into BACKEND code. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +If narrowing is active in the current buffer, only transcode its +narrowed part. + +If a region is active, transcode that region. + +When optional argument SUBTREEP is non-nil, transcode the +sub-tree at point, extracting information from the headline +properties first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only return body +code, without surrounding template. + +Optional argument EXT-PLIST, when provided, is a property list +with external parameters overriding Org default settings, but +still inferior to file-local settings. + +Return code as a string. + +\(fn BACKEND &optional SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" nil nil) + +(autoload 'org-export-string-as "ox" "\ +Transcode STRING into BACKEND code. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +When optional argument BODY-ONLY is non-nil, only return body +code, without preamble nor postamble. + +Optional argument EXT-PLIST, when provided, is a property list +with external parameters overriding Org default settings, but +still inferior to file-local settings. + +Return code as a string. + +\(fn STRING BACKEND &optional BODY-ONLY EXT-PLIST)" nil nil) + +(autoload 'org-export-replace-region-by "ox" "\ +Replace the active region by its export to BACKEND. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +\(fn BACKEND)" nil nil) + +(autoload 'org-export-insert-default-template "ox" "\ +Insert all export keywords with default values at beginning of line. + +BACKEND is a symbol referring to the name of a registered export +back-end, for which specific export options should be added to +the template, or `default' for default template. When it is nil, +the user will be prompted for a category. + +If SUBTREEP is non-nil, export configuration will be set up +locally for the subtree through node properties. + +\(fn &optional BACKEND SUBTREEP)" t nil) + +(autoload 'org-export-to-buffer "ox" "\ +Call `org-export-as' with output to a specified buffer. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +BUFFER is the name of the output buffer. If it already exists, +it will be erased first, otherwise, it will be created. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should then be accessible +through the `org-export-stack' interface. When ASYNC is nil, the +buffer is displayed if `org-export-show-temporary-export-buffer' +is non-nil. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which +see. + +Optional argument POST-PROCESS is a function which should accept +no argument. It is always called within the current process, +from BUFFER, with point at its beginning. Export back-ends can +use it to set a major mode there, e.g, + + (defun org-latex-export-as-latex + (&optional async subtreep visible-only body-only ext-plist) + (interactive) + (org-export-to-buffer 'latex \"*Org LATEX Export*\" + async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) + +This function returns BUFFER. + +\(fn BACKEND BUFFER &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST POST-PROCESS)" nil nil) + +(autoload 'org-export-to-file "ox" "\ +Call `org-export-as' with output to a specified file. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. FILE is the name of the output file, as +a string. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer will then be accessible +through the `org-export-stack' interface. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which +see. + +Optional argument POST-PROCESS is called with FILE as its +argument and happens asynchronously when ASYNC is non-nil. It +has to return a file name, or nil. Export back-ends can use this +to send the output file through additional processing, e.g, + + (defun org-latex-export-to-latex + (&optional async subtreep visible-only body-only ext-plist) + (interactive) + (let ((outfile (org-export-output-file-name \".tex\" subtreep))) + (org-export-to-file 'latex outfile + async subtreep visible-only body-only ext-plist + (lambda (file) (org-latex-compile file))) + +The function returns either a file name returned by POST-PROCESS, +or FILE. + +\(fn BACKEND FILE &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST POST-PROCESS)" nil nil) + +(autoload 'org-export-dispatch "ox" "\ +Export dispatcher for Org mode. + +It provides an access to common export related tasks in a buffer. +Its interface comes in two flavors: standard and expert. + +While both share the same set of bindings, only the former +displays the valid keys associations in a dedicated buffer. +Scrolling (resp. line-wise motion) in this buffer is done with +SPC and DEL (resp. C-n and C-p) keys. + +Set variable `org-export-dispatch-use-expert-ui' to switch to one +flavor or the other. + +When ARG is \\[universal-argument], repeat the last export action, with the same set +of options used back then, on the current buffer. + +When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack. + +\(fn &optional ARG)" t nil) + +;;;*** + +(provide 'org-loaddefs) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; org-loaddefs.el ends here diff --git a/elpa/org-20150427/org-macro.el b/elpa/org-20150427/org-macro.el new file mode 100644 index 00000000..5b890346 --- /dev/null +++ b/elpa/org-20150427/org-macro.el @@ -0,0 +1,193 @@ +;;; org-macro.el --- Macro Replacement Code for Org Mode + +;; Copyright (C) 2013-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou <n.goaziou@gmail.com> +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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: + +;; Macros are expanded with `org-macro-replace-all', which relies +;; internally on `org-macro-expand'. + +;; Default templates for expansion are stored in the buffer-local +;; variable `org-macro-templates'. This variable is updated by +;; `org-macro-initialize-templates', which recursively calls +;; `org-macro--collect-macros' in order to read setup files. + +;; Along with macros defined through #+MACRO: keyword, default +;; templates include the following hard-coded macros: +;; {{{time(format-string)}}}, {{{property(node-property)}}}, +;; {{{input-file}}} and {{{modification-time(format-string)}}}. + +;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}}, +;; {{{email}}} and {{{title}}} macros. + +;;; Code: +(require 'org-macs) + +(declare-function org-element-at-point "org-element" (&optional keep-trail)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) +(declare-function org-remove-double-quotes "org" (s)) +(declare-function org-mode "org" ()) +(declare-function org-file-contents "org" (file &optional noerror)) +(declare-function org-with-wide-buffer "org-macs" (&rest body)) + +;;; Variables + +(defvar org-macro-templates nil + "Alist containing all macro templates in current buffer. +Associations are in the shape of (NAME . TEMPLATE) where NAME +stands for macro's name and template for its replacement value, +both as strings. This is an internal variable. Do not set it +directly, use instead: + + #+MACRO: name template") +(make-variable-buffer-local 'org-macro-templates) + + +;;; Functions + +(defun org-macro--collect-macros () + "Collect macro definitions in current buffer and setup files. +Return an alist containing all macro templates found." + (let* (collect-macros ; For byte-compiler. + (collect-macros + (lambda (files templates) + ;; Return an alist of macro templates. FILES is a list of + ;; setup files names read so far, used to avoid circular + ;; dependencies. TEMPLATES is the alist collected so far. + (let ((case-fold-search t)) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((val (org-element-property :value element))) + (if (equal (org-element-property :key element) "MACRO") + ;; Install macro in TEMPLATES. + (when (string-match + "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val) + (let* ((name (match-string 1 val)) + (template (or (match-string 2 val) "")) + (old-cell (assoc name templates))) + (if old-cell (setcdr old-cell template) + (push (cons name template) templates)))) + ;; Enter setup file. + (let ((file (expand-file-name + (org-remove-double-quotes val)))) + (unless (member file files) + (with-temp-buffer + (org-mode) + (insert (org-file-contents file 'noerror)) + (setq templates + (funcall collect-macros (cons file files) + templates))))))))))) + templates)))) + (funcall collect-macros nil nil))) + +(defun org-macro-initialize-templates () + "Collect macro templates defined in current buffer. +Templates are stored in buffer-local variable +`org-macro-templates'. In addition to buffer-defined macros, the +function installs the following ones: \"property\", +\"time\". and, if the buffer is associated to a file, +\"input-file\" and \"modification-time\"." + (let* ((templates (org-macro--collect-macros)) + (update-templates + (lambda (cell) + (let ((old-template (assoc (car cell) templates))) + (if old-template (setcdr old-template (cdr cell)) + (push cell templates)))))) + ;; Install hard-coded macros. + (mapc (lambda (cell) (funcall update-templates cell)) + (list (cons "property" "(eval (org-entry-get nil \"$1\" 'selective))") + (cons "time" "(eval (format-time-string \"$1\"))"))) + (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (when (and visited-file (file-exists-p visited-file)) + (mapc (lambda (cell) (funcall update-templates cell)) + (list (cons "input-file" (file-name-nondirectory visited-file)) + (cons "modification-time" + (format "(eval (format-time-string \"$1\" '%s))" + (prin1-to-string + (nth 5 (file-attributes visited-file))))))))) + (setq org-macro-templates templates))) + +(defun org-macro-expand (macro templates) + "Return expanded MACRO, as a string. +MACRO is an object, obtained, for example, with +`org-element-context'. TEMPLATES is an alist of templates used +for expansion. See `org-macro-templates' for a buffer-local +default value. Return nil if no template was found." + (let ((template + ;; Macro names are case-insensitive. + (cdr (assoc-string (org-element-property :key macro) templates t)))) + (when template + (let ((value (replace-regexp-in-string + "\\$[0-9]+" + (lambda (arg) + (or (nth (1- (string-to-number (substring arg 1))) + (org-element-property :args macro)) + ;; No argument: remove place-holder. + "")) + template nil 'literal))) + ;; VALUE starts with "(eval": it is a s-exp, `eval' it. + (when (string-match "\\`(eval\\>" value) + (setq value (eval (read value)))) + ;; Return string. + (format "%s" (or value "")))))) + +(defun org-macro-replace-all (templates) + "Replace all macros in current buffer by their expansion. +TEMPLATES is an alist of templates used for expansion. See +`org-macro-templates' for a buffer-local default value." + (save-excursion + (goto-char (point-min)) + (let (record) + (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) + (let ((object (org-element-context))) + (when (eq (org-element-type object) 'macro) + (let* ((value (org-macro-expand object templates)) + (begin (org-element-property :begin object)) + (signature (list begin + object + (org-element-property :args object)))) + ;; Avoid circular dependencies by checking if the same + ;; macro with the same arguments is expanded at the same + ;; position twice. + (if (member signature record) + (error "Circular macro expansion: %s" + (org-element-property :key object)) + (when value + (push signature record) + (delete-region + begin + ;; Preserve white spaces after the macro. + (progn (goto-char (org-element-property :end object)) + (skip-chars-backward " \t") + (point))) + ;; Leave point before replacement in case of recursive + ;; expansions. + (save-excursion (insert value))))))))))) + + +(provide 'org-macro) +;;; org-macro.el ends here diff --git a/elpa/org-20150427/org-macs.el b/elpa/org-20150427/org-macs.el new file mode 100644 index 00000000..96265ec0 --- /dev/null +++ b/elpa/org-20150427/org-macs.el @@ -0,0 +1,390 @@ +;;; org-macs.el --- Top-level definitions for Org-mode + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: + +;; This file contains macro definitions, defsubst definitions, other +;; stuff needed for compilation and top-level forms in Org-mode, as well +;; lots of small functions that are not org-mode specific but simply +;; generally useful stuff. + +;;; Code: + +(eval-and-compile + (unless (fboundp 'declare-function) + (defmacro declare-function (fn file &optional arglist fileonly) + `(autoload ',fn ,file))) + + (if (>= emacs-major-version 23) + (defsubst org-char-to-string(c) + "Defsubst to decode UTF-8 character values in emacs 23 and beyond." + (char-to-string c)) + (defsubst org-char-to-string (c) + "Defsubst to decode UTF-8 character values in emacs 22." + (string (decode-char 'ucs c))))) + +(declare-function org-add-props "org-compat" (string plist &rest props)) +(declare-function org-string-match-p "org-compat" (&rest args)) + +(defmacro org-with-gensyms (symbols &rest body) + `(let ,(mapcar (lambda (s) + `(,s (make-symbol (concat "--" (symbol-name ',s))))) symbols) + ,@body)) +(def-edebug-spec org-with-gensyms (sexp body)) +(put 'org-with-gensyms 'lisp-indent-function 1) + +(defmacro org-called-interactively-p (&optional kind) + (if (featurep 'xemacs) + `(interactive-p) + (if (or (> emacs-major-version 23) + (and (>= emacs-major-version 23) + (>= emacs-minor-version 2))) + ;; defined with no argument in <=23.1 + `(with-no-warnings (called-interactively-p ,kind)) + `(interactive-p)))) +(def-edebug-spec org-called-interactively-p (&optional ("quote" symbolp))) + +(defmacro org-bound-and-true-p (var) + "Return the value of symbol VAR if it is bound, else nil." + `(and (boundp (quote ,var)) ,var)) +(def-edebug-spec org-bound-and-true-p (symbolp)) + +(defun org-string-nw-p (s) + "Is S a string with a non-white character?" + (and (stringp s) + (org-string-match-p "\\S-" s) + s)) + +(defun org-not-nil (v) + "If V not nil, and also not the string \"nil\", then return V. +Otherwise return nil." + (and v (not (equal v "nil")) v)) + +(defun org-substitute-posix-classes (re) + "Substitute posix classes in regular expression RE." + (let ((ss re)) + (save-match-data + (while (string-match "\\[:alnum:\\]" ss) + (setq ss (replace-match "a-zA-Z0-9" t t ss))) + (while (string-match "\\[:word:\\]" ss) + (setq ss (replace-match "a-zA-Z0-9" t t ss))) + (while (string-match "\\[:alpha:\\]" ss) + (setq ss (replace-match "a-zA-Z" t t ss))) + (while (string-match "\\[:punct:\\]" ss) + (setq ss (replace-match "\001-@[-`{-~" t t ss))) + ss))) + +(defmacro org-re (s) + "Replace posix classes in regular expression." + (if (featurep 'xemacs) `(org-substitute-posix-classes ,s) s)) +(def-edebug-spec org-re (form)) + +(defmacro org-preserve-lc (&rest body) + (org-with-gensyms (line col) + `(let ((,line (org-current-line)) + (,col (current-column))) + (unwind-protect + (progn ,@body) + (org-goto-line ,line) + (org-move-to-column ,col))))) +(def-edebug-spec org-preserve-lc (body)) + +;; Use `org-with-silent-modifications' to ignore cosmetic changes and +;; `org-unmodified' to ignore real text modifications +(defmacro org-unmodified (&rest body) + "Run BODY while preserving the buffer's `buffer-modified-p' state." + (org-with-gensyms (was-modified) + `(let ((,was-modified (buffer-modified-p))) + (unwind-protect + (let ((buffer-undo-list t) + (inhibit-modification-hooks t)) + ,@body) + (set-buffer-modified-p ,was-modified))))) +(def-edebug-spec org-unmodified (body)) + +(defmacro org-without-partial-completion (&rest body) + `(if (and (boundp 'partial-completion-mode) + partial-completion-mode + (fboundp 'partial-completion-mode)) + (unwind-protect + (progn + (partial-completion-mode -1) + ,@body) + (partial-completion-mode 1)) + ,@body)) +(def-edebug-spec org-without-partial-completion (body)) + +;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22 +(defmacro org-maybe-intangible (props) + "Add '(intangible t) to PROPS if Emacs version is earlier than Emacs 22. +In Emacs 21, invisible text is not avoided by the command loop, so the +intangible property is needed to make sure point skips this text. +In Emacs 22, this is not necessary. The intangible text property has +led to problems with flyspell. These problems are fixed in flyspell.el, +but we still avoid setting the property in Emacs 22 and later. +We use a macro so that the test can happen at compilation time." + (if (< emacs-major-version 22) + `(append '(intangible t) ,props) + props)) + +(defmacro org-with-point-at (pom &rest body) + "Move to buffer and point of point-or-marker POM for the duration of BODY." + (org-with-gensyms (mpom) + `(let ((,mpom ,pom)) + (save-excursion + (if (markerp ,mpom) (set-buffer (marker-buffer ,mpom))) + (org-with-wide-buffer + (goto-char (or ,mpom (point))) + ,@body))))) +(def-edebug-spec org-with-point-at (form body)) +(put 'org-with-point-at 'lisp-indent-function 1) + +(defmacro org-no-warnings (&rest body) + (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body)) +(def-edebug-spec org-no-warnings (body)) + +(defmacro org-with-remote-undo (buffer &rest body) + "Execute BODY while recording undo information in two buffers." + (org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2) + `(let ((,cline (org-current-line)) + (,cmd this-command) + (,buf1 (current-buffer)) + (,buf2 ,buffer) + (,undo1 buffer-undo-list) + (,undo2 (with-current-buffer ,buffer buffer-undo-list)) + ,c1 ,c2) + ,@body + (when org-agenda-allow-remote-undo + (setq ,c1 (org-verify-change-for-undo + ,undo1 (with-current-buffer ,buf1 buffer-undo-list)) + ,c2 (org-verify-change-for-undo + ,undo2 (with-current-buffer ,buf2 buffer-undo-list))) + (when (or ,c1 ,c2) + ;; make sure there are undo boundaries + (and ,c1 (with-current-buffer ,buf1 (undo-boundary))) + (and ,c2 (with-current-buffer ,buf2 (undo-boundary))) + ;; remember which buffer to undo + (push (list ,cmd ,cline ,buf1 ,c1 ,buf2 ,c2) + org-agenda-undo-list)))))) +(def-edebug-spec org-with-remote-undo (form body)) +(put 'org-with-remote-undo 'lisp-indent-function 1) + +(defmacro org-no-read-only (&rest body) + "Inhibit read-only for BODY." + `(let ((inhibit-read-only t)) ,@body)) +(def-edebug-spec org-no-read-only (body)) + +(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t + rear-nonsticky t mouse-map t fontified t + org-emphasis t) + "Properties to remove when a string without properties is wanted.") + +(defsubst org-match-string-no-properties (num &optional string) + (if (featurep 'xemacs) + (let ((s (match-string num string))) + (and s (remove-text-properties 0 (length s) org-rm-props s)) + s) + (match-string-no-properties num string))) + +(defsubst org-no-properties (s &optional restricted) + "Remove all text properties from string S. +When RESTRICTED is non-nil, only remove the properties listed +in `org-rm-props'." + (if (fboundp 'set-text-properties) + (set-text-properties 0 (length s) nil s) + (if restricted + (remove-text-properties 0 (length s) org-rm-props s) + (set-text-properties 0 (length s) nil s))) + s) + +(defsubst org-get-alist-option (option key) + (cond ((eq key t) t) + ((eq option t) t) + ((assoc key option) (cdr (assoc key option))) + (t (let ((r (cdr (assq 'default option)))) + (if (listp r) (delq nil r) r))))) + +(defsubst org-check-external-command (cmd &optional use no-error) + "Check if external program CMD for USE exists, error if not. +When the program does exist, return its path. +When it does not exist and NO-ERROR is set, return nil. +Otherwise, throw an error. The optional argument USE can describe what this +program is needed for, so that the error message can be more informative." + (or (executable-find cmd) + (if no-error + nil + (error "Can't find `%s'%s" cmd + (if use (format " (%s)" use) ""))))) + +(defsubst org-inhibit-invisibility () + "Modified `buffer-invisibility-spec' for Emacs 21. +Some ops with invisible text do not work correctly on Emacs 21. For these +we turn off invisibility temporarily. Use this in a `let' form." + (if (< emacs-major-version 22) nil buffer-invisibility-spec)) + +(defsubst org-set-local (var value) + "Make VAR local in current buffer and set it to VALUE." + (set (make-local-variable var) value)) + +(defsubst org-last (list) + "Return the last element of LIST." + (car (last list))) + +(defun org-let (list &rest body) + (eval (cons 'let (cons list body)))) +(put 'org-let 'lisp-indent-function 1) + +(defun org-let2 (list1 list2 &rest body) + (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) +(put 'org-let2 'lisp-indent-function 2) + +(defsubst org-call-with-arg (command arg) + "Call COMMAND interactively, but pretend prefix arg was ARG." + (let ((current-prefix-arg arg)) (call-interactively command))) + +(defsubst org-current-line (&optional pos) + (save-excursion + (and pos (goto-char pos)) + ;; works also in narrowed buffer, because we start at 1, not point-min + (+ (if (bolp) 1 0) (count-lines 1 (point))))) + +(defsubst org-goto-line (N) + (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- N)))) + +(defsubst org-current-line-string (&optional to-here) + (buffer-substring (point-at-bol) (if to-here (point) (point-at-eol)))) + +(defsubst org-pos-in-match-range (pos n) + (and (match-beginning n) + (<= (match-beginning n) pos) + (>= (match-end n) pos))) + +(defun org-match-line (re) + "Looking-at at the beginning of the current line." + (save-excursion + (goto-char (point-at-bol)) + (looking-at re))) + +(defun org-plist-delete (plist property) + "Delete PROPERTY from PLIST. +This is in contrast to merely setting it to 0." + (let (p) + (while plist + (if (not (eq property (car plist))) + (setq p (plist-put p (car plist) (nth 1 plist)))) + (setq plist (cddr plist))) + p)) + +(defun org-replace-match-keep-properties (newtext &optional fixedcase + literal string) + "Like `replace-match', but add the text properties found original text." + (setq newtext (org-add-props newtext (text-properties-at + (match-beginning 0) string))) + (replace-match newtext fixedcase literal string)) + +(defmacro org-save-outline-visibility (use-markers &rest body) + "Save and restore outline visibility around BODY. +If USE-MARKERS is non-nil, use markers for the positions. +This means that the buffer may change while running BODY, +but it also means that the buffer should stay alive +during the operation, because otherwise all these markers will +point nowhere." + (declare (indent 1)) + (org-with-gensyms (data rtn) + `(let ((,data (org-outline-overlay-data ,use-markers)) + ,rtn) + (unwind-protect + (progn + (setq ,rtn (progn ,@body)) + (org-set-outline-overlay-data ,data)) + (when ,use-markers + (mapc (lambda (c) + (and (markerp (car c)) (move-marker (car c) nil)) + (and (markerp (cdr c)) (move-marker (cdr c) nil))) + ,data))) + ,rtn))) +(def-edebug-spec org-save-outline-visibility (form body)) + +(defmacro org-with-wide-buffer (&rest body) + "Execute body while temporarily widening the buffer." + `(save-excursion + (save-restriction + (widen) + ,@body))) +(def-edebug-spec org-with-wide-buffer (body)) + +(defmacro org-with-limited-levels (&rest body) + "Execute BODY with limited number of outline levels." + `(let* ((org-called-with-limited-levels t) + (org-outline-regexp (org-get-limited-outline-regexp)) + (outline-regexp org-outline-regexp) + (org-outline-regexp-bol (concat "^" org-outline-regexp))) + ,@body)) +(def-edebug-spec org-with-limited-levels (body)) + +(defvar org-outline-regexp) ; defined in org.el +(defvar org-odd-levels-only) ; defined in org.el +(defvar org-inlinetask-min-level) ; defined in org-inlinetask.el +(defun org-get-limited-outline-regexp () + "Return outline-regexp with limited number of levels. +The number of levels is controlled by `org-inlinetask-min-level'" + (if (or (not (derived-mode-p 'org-mode)) (not (featurep 'org-inlinetask))) + org-outline-regexp + (let* ((limit-level (1- org-inlinetask-min-level)) + (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level))) + (format "\\*\\{1,%d\\} " nstars)))) + +(defun org-format-seconds (string seconds) + "Compatibility function replacing format-seconds." + (if (fboundp 'format-seconds) + (format-seconds string seconds) + (format-time-string string (seconds-to-time seconds)))) + +(defmacro org-eval-in-environment (environment form) + `(eval (list 'let ,environment ',form))) +(def-edebug-spec org-eval-in-environment (form form)) +(put 'org-eval-in-environment 'lisp-indent-function 1) + +(defun org-make-parameter-alist (flat) + "Return alist based on FLAT. +FLAT is a list with alternating symbol names and values. The +returned alist is a list of lists with the symbol name in car and +the value in cdr." + (when flat + (cons (list (car flat) (cadr flat)) + (org-make-parameter-alist (cddr flat))))) + +;;;###autoload +(defmacro org-load-noerror-mustsuffix (file) + "Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it." + (if (featurep 'xemacs) + `(load ,file 'noerror) + `(load ,file 'noerror nil nil 'mustsuffix))) + +(provide 'org-macs) + +;;; org-macs.el ends here diff --git a/elpa/org-20150427/org-mhe.el b/elpa/org-20150427/org-mhe.el new file mode 100644 index 00000000..bdd6e150 --- /dev/null +++ b/elpa/org-20150427/org-mhe.el @@ -0,0 +1,228 @@ +;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: + +;; This file implements links to MH-E messages from within Org-mode. +;; Org-mode loads this module by default - if this is not what you want, +;; configure the variable `org-modules'. + +;;; Code: + +(require 'org-macs) +(require 'org) + +;; Customization variables + +(defcustom org-mhe-search-all-folders nil + "Non-nil means the search for the mh-message may extend to all folders. +When non-nil, the search for a message will extend to all other +folders if it cannot be found in the folder given in the link. +Searching all folders may be slow with the default pick based +search but is very efficient with one of the other search engines +supported by MH-E." + :group 'org-link-follow + :type 'boolean) + +;; Declare external functions and variables +(declare-function mh-display-msg "mh-show" (msg-num folder-name)) +(declare-function mh-find-path "mh-utils" ()) +(declare-function mh-get-header-field "mh-utils" (field)) +(declare-function mh-get-msg-num "mh-utils" (error-if-no-message)) +(declare-function mh-header-display "mh-show" ()) +(declare-function mh-index-previous-folder "mh-search" ()) +(declare-function mh-normalize-folder-name "mh-utils" + (folder &optional empty-string-okay dont-remove-trailing-slash + return-nil-if-folder-empty)) +(declare-function mh-search "mh-search" + (folder search-regexp &optional redo-search-flag + window-config)) +(declare-function mh-search-choose "mh-search" (&optional searcher)) +(declare-function mh-show "mh-show" (&optional message redisplay-flag)) +(declare-function mh-show-buffer-message-number "mh-comp" (&optional buffer)) +(declare-function mh-show-header-display "mh-show" t t) +(declare-function mh-show-msg "mh-show" (msg)) +(declare-function mh-show-show "mh-show" t t) +(declare-function mh-visit-folder "mh-folder" (folder &optional + range index-data)) +(defvar mh-progs) +(defvar mh-current-folder) +(defvar mh-show-folder-buffer) +(defvar mh-index-folder) +(defvar mh-searcher) +(defvar mh-search-regexp-builder) + +;; Install the link type +(org-add-link-type "mhe" 'org-mhe-open) +(add-hook 'org-store-link-functions 'org-mhe-store-link) + +;; Implementation +(defun org-mhe-store-link () + "Store a link to an MH-E folder or message." + (when (or (equal major-mode 'mh-folder-mode) + (equal major-mode 'mh-show-mode)) + (save-window-excursion + (let* ((from (org-mhe-get-header "From:")) + (to (org-mhe-get-header "To:")) + (message-id (org-mhe-get-header "Message-Id:")) + (subject (org-mhe-get-header "Subject:")) + (date (org-mhe-get-header "Date:")) + (date-ts (and date (format-time-string + (org-time-stamp-format t) (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) + link desc) + (org-store-link-props :type "mh" :from from :to to + :subject subject :message-id message-id) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) + (setq desc (org-email-link-description)) + (setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#" + (org-remove-angle-brackets message-id))) + (org-add-link-props :link link :description desc) + link)))) + +(defun org-mhe-open (path) + "Follow an MH-E message link specified by PATH." + (let (folder article) + (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) + (error "Error in MH-E link")) + (setq folder (match-string 1 path) + article (match-string 3 path)) + (org-mhe-follow-link folder article))) + +;;; mh-e integration based on planner-mode +(defun org-mhe-get-message-real-folder () + "Return the name of the real folder for the current message. +So if you use sequences, it will now work." + (save-excursion + (let* ((folder + (if (equal major-mode 'mh-folder-mode) + mh-current-folder + ;; Refer to the show buffer + mh-show-folder-buffer)) + (end-index + (if (boundp 'mh-index-folder) + (min (length mh-index-folder) (length folder)))) + ) + ;; a simple test on mh-index-data does not work, because + ;; mh-index-data is always nil in a show buffer. + (if (and (boundp 'mh-index-folder) + (string= mh-index-folder (substring folder 0 end-index))) + (if (equal major-mode 'mh-show-mode) + (save-window-excursion + (let (pop-up-frames) + (when (buffer-live-p (get-buffer folder)) + (progn + (pop-to-buffer folder) + (org-mhe-get-message-folder-from-index) + ) + ))) + (org-mhe-get-message-folder-from-index) + ) + folder + ) + ))) + +(defun org-mhe-get-message-folder-from-index () + "Return the name of the message folder in an index folder buffer." + (save-excursion + (mh-index-previous-folder) + (if (re-search-forward "^\\(+.*\\)$" nil t) + (message "%s" (match-string 1))))) + +(defun org-mhe-get-message-folder () + "Return the name of the current message folder. +Be careful if you use sequences." + (save-excursion + (if (equal major-mode 'mh-folder-mode) + mh-current-folder + ;; Refer to the show buffer + mh-show-folder-buffer))) + +(defun org-mhe-get-message-num () + "Return the number of the current message. +Be careful if you use sequences." + (save-excursion + (if (equal major-mode 'mh-folder-mode) + (mh-get-msg-num nil) + ;; Refer to the show buffer + (mh-show-buffer-message-number)))) + +(defun org-mhe-get-header (header) + "Return the field for HEADER of the message in folder mode. +This will create a show buffer for the corresponding message. If +you have a better idea of how to do this then please let us know." + (let* ((folder (org-mhe-get-message-folder)) + (num (org-mhe-get-message-num)) + (buffer (get-buffer-create (concat "show-" folder))) + (header-field)) + (with-current-buffer buffer + (mh-display-msg num folder) + (if (equal major-mode 'mh-folder-mode) + (mh-header-display) + (mh-show-header-display)) + (set-buffer buffer) + (setq header-field (mh-get-header-field header)) + (if (equal major-mode 'mh-folder-mode) + (mh-show) + (mh-show-show)) + (org-trim header-field)))) + +(defun org-mhe-follow-link (folder article) + "Follow an MH-E link to FOLDER and ARTICLE. +If ARTICLE is nil FOLDER is shown. If the configuration variable +`org-mhe-search-all-folders' is t and `mh-searcher' is pick, +ARTICLE is searched in all folders. Indexed searches (swish++, +namazu, and others supported by MH-E) will always search in all +folders." + (require 'mh-e) + (require 'mh-search) + (require 'mh-utils) + (mh-find-path) + (if (not article) + (mh-visit-folder (mh-normalize-folder-name folder)) + (mh-search-choose) + (if (equal mh-searcher 'pick) + (progn + (setq article (org-add-angle-brackets article)) + (mh-search folder (list "--message-id" article)) + (when (and org-mhe-search-all-folders + (not (org-mhe-get-message-real-folder))) + (kill-this-buffer) + (mh-search "+" (list "--message-id" article)))) + (if mh-search-regexp-builder + (mh-search "+" (funcall mh-search-regexp-builder + (list (cons 'message-id article)))) + (mh-search "+" article))) + (if (org-mhe-get-message-real-folder) + (mh-show-msg 1) + (kill-this-buffer) + (error "Message not found")))) + +(provide 'org-mhe) + +;;; org-mhe.el ends here diff --git a/elpa/org-20150427/org-mobile.el b/elpa/org-20150427/org-mobile.el new file mode 100644 index 00000000..9c87791a --- /dev/null +++ b/elpa/org-20150427/org-mobile.el @@ -0,0 +1,1149 @@ +;;; org-mobile.el --- Code for asymmetric sync with a mobile device +;; Copyright (C) 2009-2014 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: +;; +;; This file contains the code to interact with Richard Moreland's iPhone +;; application MobileOrg, as well as with the Android version by Matthew Jones. +;; This code is documented in Appendix B of the Org-mode manual. The code is +;; not specific for the iPhone and Android - any external +;; viewer/flagging/editing application that uses the same conventions could +;; be used. + +(require 'org) +(require 'org-agenda) +;;; Code: + +(eval-when-compile (require 'cl)) + +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) + +(defgroup org-mobile nil + "Options concerning support for a viewer/editor on a mobile device." + :tag "Org Mobile" + :group 'org) + +(defcustom org-mobile-files '(org-agenda-files) + "Files to be staged for MobileOrg. +This is basically a list of files and directories. Files will be staged +directly. Directories will be search for files with the extension `.org'. +In addition to this, the list may also contain the following symbols: + +org-agenda-files + This means include the complete, unrestricted list of files given in + the variable `org-agenda-files'. +org-agenda-text-search-extra-files + Include the files given in the variable + `org-agenda-text-search-extra-files'" + :group 'org-mobile + :type '(list :greedy t + (option (const :tag "org-agenda-files" org-agenda-files)) + (option (const :tag "org-agenda-text-search-extra-files" + org-agenda-text-search-extra-files)) + (repeat :inline t :tag "Additional files" + (file)))) + +(defcustom org-mobile-files-exclude-regexp "" + "A regexp to exclude files from `org-mobile-files'." + :group 'org-mobile + :version "24.1" + :type 'regexp) + +(defcustom org-mobile-directory "" + "The WebDAV directory where the interaction with the mobile takes place." + :group 'org-mobile + :type 'directory) + +(defcustom org-mobile-allpriorities "A B C" + "Default set of priority cookies for the index file." + :version "24.4" + :package-version '(Org . "8.0") + :type 'string + :group 'org-mobile) + +(defcustom org-mobile-use-encryption nil + "Non-nil means keep only encrypted files on the WebDAV server. +Encryption uses AES-256, with a password given in +`org-mobile-encryption-password'. +When nil, plain files are kept on the server. +Turning on encryption requires to set the same password in the MobileOrg +application. Before turning this on, check of MobileOrg does already +support it - at the time of this writing it did not yet." + :group 'org-mobile + :version "24.1" + :type 'boolean) + +(defcustom org-mobile-encryption-tempfile "~/orgtmpcrypt" + "File that is being used as a temporary file for encryption. +This must be local file on your local machine (not on the WebDAV server). +You might want to put this file into a directory where only you have access." + :group 'org-mobile + :version "24.1" + :type 'directory) + +(defcustom org-mobile-encryption-password "" + "Password for encrypting files uploaded to the server. +This is a single password which is used for AES-256 encryption. The same +password must also be set in the MobileOrg application. All Org files, +including mobileorg.org will be encrypted using this password. + +SECURITY CONSIDERATIONS: + +Note that, when Org runs the encryption commands, the password could +be visible briefly on your system with the `ps' command. So this method is +only intended to keep the files secure on the server, not on your own machine. + +Also, if you set this variable in an init file (.emacs or .emacs.d/init.el +or custom.el...) and if that file is stored in a way so that other can read +it, this also limits the security of this approach. You can also leave +this variable empty - Org will then ask for the password once per Emacs +session." + :group 'org-mobile + :version "24.1" + :type '(string :tag "Password")) + +(defvar org-mobile-encryption-password-session nil) + +(defun org-mobile-encryption-password () + (or (org-string-nw-p org-mobile-encryption-password) + (org-string-nw-p org-mobile-encryption-password-session) + (setq org-mobile-encryption-password-session + (read-passwd "Password for MobileOrg: " t)))) + +(defcustom org-mobile-inbox-for-pull "~/org/from-mobile.org" + "The file where captured notes and flags will be appended to. +During the execution of `org-mobile-pull', the file +`org-mobile-capture-file' will be emptied it's contents have +been appended to the file given here. This file should be in +`org-directory', and not in the staging area or on the web server." + :group 'org-mobile + :type 'file) + +(defconst org-mobile-capture-file "mobileorg.org" + "The capture file where the mobile stores captured notes and flags. +This should not be changed, because MobileOrg assumes this name.") + +(defcustom org-mobile-index-file "index.org" + "The index file with links to all Org files that should be loaded by MobileOrg. +Relative to `org-mobile-directory'. The Address field in the MobileOrg setup +should point to this file." + :group 'org-mobile + :type 'file) + +(defcustom org-mobile-agendas 'all + "The agendas that should be pushed to MobileOrg. +Allowed values: + +default the weekly agenda and the global TODO list +custom all custom agendas defined by the user +all the custom agendas and the default ones +list a list of selection key(s) as string." + :group 'org-mobile + :version "24.1" + :type '(choice + (const :tag "Default Agendas" default) + (const :tag "Custom Agendas" custom) + (const :tag "Default and Custom Agendas" all) + (repeat :tag "Selected" + (string :tag "Selection Keys")))) + +(defcustom org-mobile-force-id-on-agenda-items t + "Non-nil means make all agenda items carry an ID." + :group 'org-mobile + :type 'boolean) + +(defcustom org-mobile-force-mobile-change nil + "Non-nil means force the change made on the mobile device. +So even if there have been changes to the computer version of the entry, +force the new value set on the mobile. +When nil, mark the entry from the mobile with an error message. +Instead of nil or t, this variable can also be a list of symbols, indicating +the editing types for which the mobile version should always dominate." + :group 'org-mobile + :type '(choice + (const :tag "Always" t) + (const :tag "Never" nil) + (set :greedy t :tag "Specify" + (const todo) + (const tags) + (const priority) + (const heading) + (const body)))) + +(defcustom org-mobile-action-alist + '(("edit" . (org-mobile-edit data old new))) + "Alist with flags and actions for mobile sync. +When flagging an entry, MobileOrg will create entries that look like + + * F(action:data) [[id:entry-id][entry title]] + +This alist defines that the ACTION in the parentheses of F() should mean, +i.e. what action should be taken. The :data part in the parenthesis is +optional. If present, the string after the colon will be passed to the +action form as the `data' variable. +The car of each elements of the alist is an actions string. The cdr is +an Emacs Lisp form that will be evaluated with the cursor on the headline +of that entry. + +For now, it is not recommended to change this variable." + :group 'org-mobile + :type '(repeat + (cons (string :tag "Action flag") + (sexp :tag "Action form")))) + +(defcustom org-mobile-checksum-binary (or (executable-find "shasum") + (executable-find "sha1sum") + (executable-find "md5sum") + (executable-find "md5")) + "Executable used for computing checksums of agenda files." + :group 'org-mobile + :type 'string) + +(defvar org-mobile-pre-push-hook nil + "Hook run before running `org-mobile-push'. +This could be used to clean up `org-mobile-directory', for example to +remove files that used to be included in the agenda but no longer are. +The presence of such files would not really be a problem, but after time +they may accumulate.") + +(defvar org-mobile-post-push-hook nil + "Hook run after running `org-mobile-push'. +If Emacs does not have direct write access to the WebDAV directory used +by the mobile device, this hook should be used to copy all files from the +local staging directory `org-mobile-directory' to the WebDAV directory, +for example using `rsync' or `scp'.") + +(defvar org-mobile-pre-pull-hook nil + "Hook run before executing `org-mobile-pull'. +If Emacs does not have direct write access to the WebDAV directory used +by the mobile device, this hook should be used to copy the capture file +`mobileorg.org' from the WebDAV location to the local staging +directory `org-mobile-directory'.") + +(defvar org-mobile-post-pull-hook nil + "Hook run after running `org-mobile-pull', only if new items were found. +If Emacs does not have direct write access to the WebDAV directory used +by the mobile device, this hook should be used to copy the emptied +capture file `mobileorg.org' back to the WebDAV directory, for example +using `rsync' or `scp'.") + +(defvar org-mobile-last-flagged-files nil + "List of files containing entries flagged in the latest pull.") + +(defvar org-mobile-files-alist nil) +(defvar org-mobile-checksum-files nil) + +(defun org-mobile-prepare-file-lists () + (setq org-mobile-files-alist (org-mobile-files-alist)) + (setq org-mobile-checksum-files nil)) + +(defun org-mobile-files-alist () + "Expand the list in `org-mobile-files' to a list of existing files. +Also exclude files matching `org-mobile-files-exclude-regexp'." + (let* ((include-archives + (and (member 'org-agenda-text-search-extra-files org-mobile-files) + (member 'agenda-archives org-agenda-text-search-extra-files) + t)) + (files + (apply 'append + (mapcar + (lambda (f) + (cond + ((eq f 'org-agenda-files) + (org-agenda-files t include-archives)) + ((eq f 'org-agenda-text-search-extra-files) + (delq 'agenda-archives + (copy-sequence + org-agenda-text-search-extra-files))) + ((and (stringp f) (file-directory-p f)) + (directory-files f 'full "\\.org\\'")) + ((and (stringp f) (file-exists-p f)) + (list f)) + (t nil))) + org-mobile-files))) + (files (delq + nil + (mapcar (lambda (f) + (unless (and (not (string= org-mobile-files-exclude-regexp "")) + (string-match org-mobile-files-exclude-regexp f)) + (identity f))) + files))) + (orgdir-uname (file-name-as-directory (file-truename org-directory))) + (orgdir-re (concat "\\`" (regexp-quote orgdir-uname))) + uname seen rtn file link-name) + ;; Make the files unique, and determine the name under which they will + ;; be listed. + (while (setq file (pop files)) + (if (not (file-name-absolute-p file)) + (setq file (expand-file-name file org-directory))) + (setq uname (file-truename file)) + (unless (member uname seen) + (push uname seen) + (if (string-match orgdir-re uname) + (setq link-name (substring uname (match-end 0))) + (setq link-name (file-name-nondirectory uname))) + (push (cons file link-name) rtn))) + (nreverse rtn))) + +;;;###autoload +(defun org-mobile-push () + "Push the current state of Org affairs to the target directory. +This will create the index file, copy all agenda files there, and also +create all custom agenda views, for upload to the mobile phone." + (interactive) + (let ((a-buffer (get-buffer org-agenda-buffer-name))) + (let ((org-agenda-curbuf-name org-agenda-buffer-name) + (org-agenda-buffer-name "*SUMO*") + (org-agenda-tag-filter org-agenda-tag-filter) + (org-agenda-redo-command org-agenda-redo-command)) + (save-excursion + (save-restriction + (save-window-excursion + (run-hooks 'org-mobile-pre-push-hook) + (org-mobile-check-setup) + (org-mobile-prepare-file-lists) + (message "Creating agendas...") + (let ((inhibit-redisplay t) + (org-agenda-files (mapcar 'car org-mobile-files-alist))) + (org-mobile-create-sumo-agenda)) + (message "Creating agendas...done") + (org-save-all-org-buffers) ; to save any IDs created by this process + (message "Copying files...") + (org-mobile-copy-agenda-files) + (message "Writing index file...") + (org-mobile-create-index-file) + (message "Writing checksums...") + (org-mobile-write-checksums) + (run-hooks 'org-mobile-post-push-hook)))) + (setq org-agenda-buffer-name org-agenda-curbuf-name + org-agenda-this-buffer-name org-agenda-curbuf-name)) + (redraw-display) + (when (buffer-live-p a-buffer) + (if (not (get-buffer-window a-buffer)) + (kill-buffer a-buffer) + (let ((cw (selected-window))) + (select-window (get-buffer-window a-buffer)) + (org-agenda-redo) + (select-window cw))))) + (message "Files for mobile viewer staged")) + +(defvar org-mobile-before-process-capture-hook nil + "Hook that is run after content was moved to `org-mobile-inbox-for-pull'. +The inbox file is visited by the current buffer, and the buffer is +narrowed to the newly captured data.") + +;;;###autoload +(defun org-mobile-pull () + "Pull the contents of `org-mobile-capture-file' and integrate them. +Apply all flagged actions, flag entries to be flagged and then call an +agenda view showing the flagged items." + (interactive) + (org-mobile-check-setup) + (run-hooks 'org-mobile-pre-pull-hook) + (let ((insertion-marker (org-mobile-move-capture))) + (if (not (markerp insertion-marker)) + (message "No new items") + (org-with-point-at insertion-marker + (save-restriction + (narrow-to-region (point) (point-max)) + (run-hooks 'org-mobile-before-process-capture-hook))) + (org-with-point-at insertion-marker + (org-mobile-apply (point) (point-max))) + (move-marker insertion-marker nil) + (run-hooks 'org-mobile-post-pull-hook) + (when org-mobile-last-flagged-files + ;; Make an agenda view of flagged entries, but only in the files + ;; where stuff has been added. + (put 'org-agenda-files 'org-restrict org-mobile-last-flagged-files) + (let ((org-agenda-keep-restricted-file-list t)) + (org-agenda nil "?")))))) + +(defun org-mobile-check-setup () + "Check if org-mobile-directory has been set up." + (org-mobile-cleanup-encryption-tempfile) + (unless (and org-directory + (stringp org-directory) + (string-match "\\S-" org-directory) + (file-exists-p org-directory) + (file-directory-p org-directory)) + (error + "Please set `org-directory' to the directory where your org files live")) + (unless (and org-mobile-directory + (stringp org-mobile-directory) + (string-match "\\S-" org-mobile-directory) + (file-exists-p org-mobile-directory) + (file-directory-p org-mobile-directory)) + (error + "Variable `org-mobile-directory' must point to an existing directory")) + (unless (and org-mobile-inbox-for-pull + (stringp org-mobile-inbox-for-pull) + (string-match "\\S-" org-mobile-inbox-for-pull) + (file-exists-p + (file-name-directory org-mobile-inbox-for-pull))) + (error + "Variable `org-mobile-inbox-for-pull' must point to a file in an existing directory")) + (unless (and org-mobile-checksum-binary + (string-match "\\S-" org-mobile-checksum-binary)) + (error "No executable found to compute checksums")) + (when org-mobile-use-encryption + (unless (string-match "\\S-" (org-mobile-encryption-password)) + (error + "To use encryption, you must set `org-mobile-encryption-password'")) + (unless (file-writable-p org-mobile-encryption-tempfile) + (error "Cannot write to encryption tempfile %s" + org-mobile-encryption-tempfile)) + (unless (executable-find "openssl") + (error "OpenSSL is needed to encrypt files")))) + +(defun org-mobile-create-index-file () + "Write the index file in the WebDAV directory." + (let ((files-alist (sort (copy-sequence org-mobile-files-alist) + (lambda (a b) (string< (cdr a) (cdr b))))) + (def-todo (default-value 'org-todo-keywords)) + (def-tags (default-value 'org-tag-alist)) + (target-file (expand-file-name org-mobile-index-file + org-mobile-directory)) + file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds) + (when (stringp (car def-todo)) + (setq def-todo (list (cons 'sequence def-todo)))) + (org-agenda-prepare-buffers (mapcar 'car files-alist)) + (setq done-kwds (org-uniquify org-done-keywords-for-agenda)) + (setq todo-kwds (org-delete-all + done-kwds + (org-uniquify org-todo-keywords-for-agenda))) + (setq drawers (org-uniquify org-drawers-for-agenda)) + (setq tags (mapcar 'car (org-global-tags-completion-table + (mapcar 'car files-alist)))) + (with-temp-file + (if org-mobile-use-encryption + org-mobile-encryption-tempfile + target-file) + (while (setq entry (pop def-todo)) + (insert "#+READONLY\n") + (setq kwds (mapcar (lambda (x) (if (string-match "(" x) + (substring x 0 (match-beginning 0)) + x)) + (cdr entry))) + (insert "#+TODO: " (mapconcat 'identity kwds " ") "\n") + (setq dwds (member "|" kwds) + twds (org-delete-all dwds kwds) + todo-kwds (org-delete-all twds todo-kwds) + done-kwds (org-delete-all dwds done-kwds))) + (when (or todo-kwds done-kwds) + (insert "#+TODO: " (mapconcat 'identity todo-kwds " ") " | " + (mapconcat 'identity done-kwds " ") "\n")) + (setq def-tags (mapcar + (lambda (x) + (cond ((null x) nil) + ((stringp x) x) + ((eq (car x) :startgroup) "{") + ((eq (car x) :endgroup) "}") + ((eq (car x) :grouptags) nil) + ((eq (car x) :newline) nil) + ((listp x) (car x)))) + def-tags)) + (setq def-tags (delq nil def-tags)) + (setq tags (org-delete-all def-tags tags)) + (setq tags (sort tags (lambda (a b) (string< (downcase a) (downcase b))))) + (setq tags (append def-tags tags nil)) + (insert "#+TAGS: " (mapconcat 'identity tags " ") "\n") + (insert "#+DRAWERS: " (mapconcat 'identity drawers " ") "\n") + (insert "#+ALLPRIORITIES: " org-mobile-allpriorities "\n") + (when (file-exists-p (expand-file-name + org-mobile-directory "agendas.org")) + (insert "* [[file:agendas.org][Agenda Views]]\n")) + (while (setq entry (pop files-alist)) + (setq file (car entry) + link-name (cdr entry)) + (insert (format "* [[file:%s][%s]]\n" + link-name link-name))) + (push (cons org-mobile-index-file (md5 (buffer-string))) + org-mobile-checksum-files)) + (when org-mobile-use-encryption + (org-mobile-encrypt-and-move org-mobile-encryption-tempfile + target-file) + (org-mobile-cleanup-encryption-tempfile)))) + +(defun org-mobile-copy-agenda-files () + "Copy all agenda files to the stage or WebDAV directory." + (let ((files-alist org-mobile-files-alist) + file buf entry link-name target-path target-dir check) + (while (setq entry (pop files-alist)) + (setq file (car entry) link-name (cdr entry)) + (when (file-exists-p file) + (setq target-path (expand-file-name link-name org-mobile-directory) + target-dir (file-name-directory target-path)) + (unless (file-directory-p target-dir) + (make-directory target-dir 'parents)) + (if org-mobile-use-encryption + (org-mobile-encrypt-and-move file target-path) + (copy-file file target-path 'ok-if-exists)) + (setq check (shell-command-to-string + (concat (shell-quote-argument org-mobile-checksum-binary) + " " + (shell-quote-argument (expand-file-name file))))) + (when (string-match "[a-fA-F0-9]\\{30,40\\}" check) + (push (cons link-name (match-string 0 check)) + org-mobile-checksum-files)))) + + (setq file (expand-file-name org-mobile-capture-file + org-mobile-directory)) + (save-excursion + (setq buf (find-file file)) + (when (and (= (point-min) (point-max))) + (insert "\n") + (save-buffer) + (when org-mobile-use-encryption + (write-file org-mobile-encryption-tempfile) + (org-mobile-encrypt-and-move org-mobile-encryption-tempfile file))) + (push (cons org-mobile-capture-file (md5 (buffer-string))) + org-mobile-checksum-files)) + (org-mobile-cleanup-encryption-tempfile) + (kill-buffer buf))) + +(defun org-mobile-write-checksums () + "Create checksums for all files in `org-mobile-directory'. +The table of checksums is written to the file mobile-checksums." + (let ((sumfile (expand-file-name "checksums.dat" org-mobile-directory)) + (files org-mobile-checksum-files) + entry file sum) + (with-temp-file sumfile + (set-buffer-file-coding-system 'undecided-unix nil) + (while (setq entry (pop files)) + (setq file (car entry) sum (cdr entry)) + (insert (format "%s %s\n" sum file)))))) + +(defun org-mobile-sumo-agenda-command () + "Return an agenda custom command that comprises all custom commands." + (let ((custom-list + ;; normalize different versions + (delq nil + (mapcar + (lambda (x) + (cond ((stringp (cdr x)) nil) + ((stringp (nth 1 x)) x) + ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) + (t (cons (car x) (cons "" (cdr x)))))) + org-agenda-custom-commands))) + (default-list '(("a" "Agenda" agenda) ("t" "All TODO" alltodo))) + thelist atitle new e key desc type match settings cmds gkey gdesc gsettings cnt) + (cond + ((eq org-mobile-agendas 'custom) + (setq thelist custom-list)) + ((eq org-mobile-agendas 'default) + (setq thelist default-list)) + ((eq org-mobile-agendas 'all) + (setq thelist custom-list) + (unless (assoc "t" thelist) (push '("t" "ALL TODO" alltodo) thelist)) + (unless (assoc "a" thelist) (push '("a" "Agenda" agenda) thelist))) + ((listp org-mobile-agendas) + (setq thelist (append custom-list default-list)) + (setq thelist (delq nil (mapcar (lambda (k) (assoc k thelist)) + org-mobile-agendas))))) + (while (setq e (pop thelist)) + (cond + ((stringp (cdr e)) + ;; this is a description entry - skip it + ) + ((eq (nth 2 e) 'search) + ;; Search view is interactive, skip + ) + ((memq (nth 2 e) '(todo-tree tags-tree occur-tree)) + ;; These are trees, not really agenda commands + ) + ((and (memq (nth 2 e) '(todo tags tags-todo)) + (or (null (nth 3 e)) + (not (string-match "\\S-" (nth 3 e))))) + ;; These would be interactive because the match string is empty + ) + ((memq (nth 2 e) '(agenda alltodo todo tags tags-todo)) + ;; a normal command + (setq key (car e) desc (nth 1 e) type (nth 2 e) match (nth 3 e) + settings (nth 4 e)) + (setq settings + (cons (list 'org-agenda-title-append + (concat "<after>KEYS=" key " TITLE: " + (if (and (stringp desc) (> (length desc) 0)) + desc (symbol-name type)) + "</after>")) + settings)) + (push (list type match settings) new)) + ((or (functionp (nth 2 e)) (symbolp (nth 2 e))) + ;; A user-defined function, which can do anything, so simply + ;; ignore it. + ) + (t + ;; a block agenda + (setq gkey (car e) gdesc (nth 1 e) gsettings (nth 3 e) cmds (nth 2 e)) + (setq cnt 0) + (while (setq e (pop cmds)) + (setq type (car e) match (nth 1 e) settings (nth 2 e)) + (setq atitle (if (string= "" gdesc) match gdesc)) + (setq settings (append gsettings settings)) + (setq settings + (cons (list 'org-agenda-title-append + (concat "<after>KEYS=" gkey "#" (number-to-string + (setq cnt (1+ cnt))) + " TITLE: " atitle "</after>")) + settings)) + (push (list type match settings) new))))) + (and new (list "X" "SUMO" (reverse new) + '((org-agenda-compact-blocks nil)))))) + +(defvar org-mobile-creating-agendas nil) +(defun org-mobile-write-agenda-for-mobile (file) + (let ((all (buffer-string)) in-date id pl prefix line app short m sexp) + (with-temp-file file + (org-mode) + (insert "#+READONLY\n") + (insert all) + (goto-char (point-min)) + (while (not (eobp)) + (cond + ((looking-at "[ \t]*$")) ; keep empty lines + ((looking-at "=+$") + ;; remove underlining + (delete-region (point) (point-at-eol))) + ((get-text-property (point) 'org-agenda-structural-header) + (setq in-date nil) + (setq app (get-text-property (point) 'org-agenda-title-append)) + (setq short (get-text-property (point) 'short-heading)) + (when (and short (looking-at ".+")) + (replace-match short nil t) + (beginning-of-line 1)) + (when app + (end-of-line 1) + (insert app) + (beginning-of-line 1)) + (insert "* ")) + ((get-text-property (point) 'org-agenda-date-header) + (setq in-date t) + (insert "** ")) + ((setq m (or (get-text-property (point) 'org-hd-marker) + (get-text-property (point) 'org-marker))) + (setq sexp (member (get-text-property (point) 'type) + '("diary" "sexp"))) + (if (setq pl (text-property-any (point) (point-at-eol) 'org-heading t)) + (progn + (setq prefix (org-trim (buffer-substring + (point) pl)) + line (org-trim (buffer-substring + pl + (point-at-eol)))) + (delete-region (point-at-bol) (point-at-eol)) + (insert line "<before>" prefix "</before>") + (beginning-of-line 1)) + (and (looking-at "[ \t]+") (replace-match ""))) + (insert (if in-date "*** " "** ")) + (end-of-line 1) + (insert "\n") + (unless sexp + (insert (org-agenda-get-some-entry-text + m 10 " " 'planning) + "\n") + (when (setq id + (if (org-bound-and-true-p + org-mobile-force-id-on-agenda-items) + (org-id-get m 'create) + (or (org-entry-get m "ID") + (org-mobile-get-outline-path-link m)))) + (insert " :PROPERTIES:\n :ORIGINAL_ID: " id + "\n :END:\n"))))) + (beginning-of-line 2)) + (push (cons "agendas.org" (md5 (buffer-string))) + org-mobile-checksum-files)) + (message "Agenda written to Org file %s" file))) + +(defun org-mobile-get-outline-path-link (pom) + (org-with-point-at pom + (concat "olp:" + (org-mobile-escape-olp (file-name-nondirectory buffer-file-name)) + "/" + (mapconcat 'org-mobile-escape-olp + (org-get-outline-path) + "/") + "/" + (org-mobile-escape-olp (nth 4 (org-heading-components)))))) + +(defun org-mobile-escape-olp (s) + (let ((table '(?: ?/))) + (org-link-escape s table))) + +(defun org-mobile-create-sumo-agenda () + "Create a file that contains all custom agenda views." + (interactive) + (let* ((file (expand-file-name "agendas.org" + org-mobile-directory)) + (file1 (if org-mobile-use-encryption + org-mobile-encryption-tempfile + file)) + (sumo (org-mobile-sumo-agenda-command)) + (org-agenda-custom-commands + (list (append sumo (list (list file1))))) + (org-mobile-creating-agendas t)) + (unless (file-writable-p file1) + (error "Cannot write to file %s" file1)) + (when sumo + (org-store-agenda-views)) + (when org-mobile-use-encryption + (org-mobile-encrypt-and-move file1 file) + (delete-file file1) + (org-mobile-cleanup-encryption-tempfile)))) + +(defun org-mobile-encrypt-and-move (infile outfile) + "Encrypt INFILE locally to INFILE_enc, then move it to OUTFILE. +We do this in two steps so that remote paths will work, even if the +encryption program does not understand them." + (let ((encfile (concat infile "_enc"))) + (org-mobile-encrypt-file infile encfile) + (when outfile + (copy-file encfile outfile 'ok-if-exists) + (delete-file encfile)))) + +(defun org-mobile-encrypt-file (infile outfile) + "Encrypt INFILE to OUTFILE, using `org-mobile-encryption-password'." + (shell-command + (format "openssl enc -aes-256-cbc -salt -pass %s -in %s -out %s" + (shell-quote-argument (concat "pass:" + (org-mobile-encryption-password))) + (shell-quote-argument (expand-file-name infile)) + (shell-quote-argument (expand-file-name outfile))))) + +(defun org-mobile-decrypt-file (infile outfile) + "Decrypt INFILE to OUTFILE, using `org-mobile-encryption-password'." + (shell-command + (format "openssl enc -d -aes-256-cbc -salt -pass %s -in %s -out %s" + (shell-quote-argument (concat "pass:" + (org-mobile-encryption-password))) + (shell-quote-argument (expand-file-name infile)) + (shell-quote-argument (expand-file-name outfile))))) + +(defun org-mobile-cleanup-encryption-tempfile () + "Remove the encryption tempfile if it exists." + (and (stringp org-mobile-encryption-tempfile) + (file-exists-p org-mobile-encryption-tempfile) + (delete-file org-mobile-encryption-tempfile))) + +(defun org-mobile-move-capture () + "Move the contents of the capture file to the inbox file. +Return a marker to the location where the new content has been added. +If nothing new has been added, return nil." + (interactive) + (let* ((encfile nil) + (capture-file (expand-file-name org-mobile-capture-file + org-mobile-directory)) + (inbox-buffer (find-file-noselect org-mobile-inbox-for-pull)) + (capture-buffer + (if (not org-mobile-use-encryption) + (find-file-noselect capture-file) + (org-mobile-cleanup-encryption-tempfile) + (setq encfile (concat org-mobile-encryption-tempfile "_enc")) + (copy-file capture-file encfile) + (org-mobile-decrypt-file encfile org-mobile-encryption-tempfile) + (find-file-noselect org-mobile-encryption-tempfile))) + (insertion-point (make-marker)) + not-empty content) + (with-current-buffer capture-buffer + (setq content (buffer-string)) + (setq not-empty (string-match "\\S-" content)) + (when not-empty + (set-buffer inbox-buffer) + (widen) + (goto-char (point-max)) + (or (bolp) (newline)) + (move-marker insertion-point + (prog1 (point) (insert content))) + (save-buffer) + (set-buffer capture-buffer) + (erase-buffer) + (save-buffer) + (org-mobile-update-checksum-for-capture-file (buffer-string)))) + (kill-buffer capture-buffer) + (when org-mobile-use-encryption + (org-mobile-encrypt-and-move org-mobile-encryption-tempfile + capture-file) + (org-mobile-cleanup-encryption-tempfile)) + (if not-empty insertion-point))) + +(defun org-mobile-update-checksum-for-capture-file (buffer-string) + "Find the checksum line and modify it to match BUFFER-STRING." + (let* ((file (expand-file-name "checksums.dat" org-mobile-directory)) + (buffer (find-file-noselect file))) + (when buffer + (with-current-buffer buffer + (when (re-search-forward (concat "\\([0-9a-fA-F]\\{30,\\}\\).*?" + (regexp-quote org-mobile-capture-file) + "[ \t]*$") nil t) + (goto-char (match-beginning 1)) + (delete-region (match-beginning 1) (match-end 1)) + (insert (md5 buffer-string)) + (save-buffer))) + (kill-buffer buffer)))) + +(defun org-mobile-apply (&optional beg end) + "Apply all change requests in the current buffer. +If BEG and END are given, only do this in that region." + (interactive) + (require 'org-archive) + (setq org-mobile-last-flagged-files nil) + (setq beg (or beg (point-min)) end (or end (point-max))) + + ;; Remove all Note IDs + (goto-char beg) + (while (re-search-forward "^\\*\\* Note ID: [-0-9A-F]+[ \t]*\n" end t) + (replace-match "")) + + ;; Find all the referenced entries, without making any changes yet + (let ((marker (make-marker)) + (bos-marker (make-marker)) + (end (move-marker (make-marker) end)) + (cnt-new 0) + (cnt-edit 0) + (cnt-flag 0) + (cnt-error 0) + buf-list + id-pos org-mobile-error) + + ;; Count the new captures + (goto-char beg) + (while (re-search-forward "^\\* \\(.*\\)" end t) + (and (>= (- (match-end 1) (match-beginning 1)) 2) + (not (equal (downcase (substring (match-string 1) 0 2)) "f(")) + (incf cnt-new))) + + ;; Find and apply the edits + (goto-char beg) + (while (re-search-forward + "^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)[ \t]+\\[\\[\\(\\(id\\|olp\\):\\([^]\n]+\\)\\)" end t) + (catch 'next + (let* ((action (match-string 1)) + (data (and (match-end 3) (match-string 3))) + (id-pos (condition-case msg + (org-mobile-locate-entry (match-string 4)) + (error (nth 1 msg)))) + (bos (point-at-bol)) + (eos (save-excursion (org-end-of-subtree t t))) + (cmd (if (equal action "") + '(progn + (incf cnt-flag) + (org-toggle-tag "FLAGGED" 'on) + (and note + (org-entry-put nil "THEFLAGGINGNOTE" note))) + (incf cnt-edit) + (cdr (assoc action org-mobile-action-alist)))) + (note (and (equal action "") + (buffer-substring (1+ (point-at-eol)) eos))) + (org-inhibit-logging 'note) ;; Do not take notes interactively + old new) + + (goto-char bos) + (when (and (markerp id-pos) + (not (member (marker-buffer id-pos) buf-list))) + (org-mobile-timestamp-buffer (marker-buffer id-pos)) + (push (marker-buffer id-pos) buf-list)) + (unless (markerp id-pos) + (goto-char (+ 2 (point-at-bol))) + (if (stringp id-pos) + (insert id-pos " ") + (insert "BAD REFERENCE ")) + (incf cnt-error) + (throw 'next t)) + (unless cmd + (insert "BAD FLAG ") + (incf cnt-error) + (throw 'next t)) + (move-marker bos-marker (point)) + (if (re-search-forward "^** Old value[ \t]*$" eos t) + (setq old (buffer-substring + (1+ (match-end 0)) + (progn (outline-next-heading) (point))))) + (if (re-search-forward "^** New value[ \t]*$" eos t) + (setq new (buffer-substring + (1+ (match-end 0)) + (progn (outline-next-heading) + (if (eobp) (org-back-over-empty-lines)) + (point))))) + (setq old (and old (if (string-match "\\S-" old) old nil))) + (setq new (and new (if (string-match "\\S-" new) new nil))) + (if (and note (> (length note) 0)) + ;; Make Note into a single line, to fit into a property + (setq note (mapconcat 'identity + (org-split-string (org-trim note) "\n") + "\\n"))) + (unless (equal data "body") + (setq new (and new (org-trim new)) + old (and old (org-trim old)))) + (goto-char (+ 2 bos-marker)) + ;; Remember this place so that we can return + (move-marker marker (point)) + (setq org-mobile-error nil) + (save-excursion + (condition-case msg + (org-with-point-at id-pos + (progn + (eval cmd) + (unless (member data (list "delete" "archive" "archive-sibling" "addheading")) + (if (member "FLAGGED" (org-get-tags)) + (add-to-list 'org-mobile-last-flagged-files + (buffer-file-name (current-buffer))))))) + (error (setq org-mobile-error msg)))) + (when org-mobile-error + (org-pop-to-buffer-same-window (marker-buffer marker)) + (goto-char marker) + (incf cnt-error) + (insert (if (stringp (nth 1 org-mobile-error)) + (nth 1 org-mobile-error) + "EXECUTION FAILED") + " ") + (throw 'next t)) + ;; If we get here, the action has been applied successfully + ;; So remove the entry + (goto-char bos-marker) + (delete-region (point) (org-end-of-subtree t t))))) + (save-buffer) + (move-marker marker nil) + (move-marker end nil) + (message "%d new, %d edits, %d flags, %d errors" cnt-new + cnt-edit cnt-flag cnt-error) + (sit-for 1))) + +(defun org-mobile-timestamp-buffer (buf) + "Time stamp buffer BUF, just to make sure its checksum will change." + (with-current-buffer buf + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (if (re-search-forward + "^\\([ \t]*\\)#\\+LAST_MOBILE_CHANGE:.*\n?" nil t) + (progn + (goto-char (match-end 1)) + (delete-region (point) (match-end 0))) + (if (looking-at ".*?-\\*-.*-\\*-") + (forward-line 1))) + (insert "#+LAST_MOBILE_CHANGE: " + (format-time-string "%Y-%m-%d %T") "\n"))))) + +(defun org-mobile-smart-read () + "Parse the entry at point for shortcuts and expand them. +These shortcuts are meant for fast and easy typing on the limited +keyboards of a mobile device. Below we show a list of the shortcuts +currently implemented. + +The entry is expected to contain an inactive time stamp indicating when +the entry was created. When setting dates and +times (for example for deadlines), the time strings are interpreted +relative to that creation date. +Abbreviations are expected to take up entire lines, just because it is so +easy to type RET on a mobile device. Abbreviations start with one or two +letters, followed immediately by a dot and then additional information. +Generally the entire shortcut line is removed after action have been taken. +Time stamps will be constructed using `org-read-date'. So for example a +line \"dd. 2tue\" will set a deadline on the second Tuesday after the +creation date. + +Here are the shortcuts currently implemented: + +dd. string set deadline +ss. string set scheduling +tt. string set time tamp, here. +ti. string set inactive time + +tg. tag1 tag2 tag3 set all these tags, change case where necessary +td. kwd set this todo keyword, change case where necessary + +FIXME: Hmmm, not sure if we can make his work against the +auto-correction feature. Needs a bit more thinking. So this function +is currently a noop.") + +(defun org-mobile-locate-entry (link) + (if (string-match "\\`id:\\(.*\\)$" link) + (org-id-find (match-string 1 link) 'marker) + (if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link)) + ; not found with path, but maybe it is to be inserted + ; in top level of the file? + (if (not (string-match "\\`olp:\\(.*?\\)$" link)) + nil + (let ((file (match-string 1 link))) + (setq file (org-link-unescape file)) + (setq file (expand-file-name file org-directory)) + (save-excursion + (find-file file) + (goto-char (point-max)) + (newline) + (goto-char (point-max)) + (point-marker)))) + (let ((file (match-string 1 link)) + (path (match-string 2 link))) + (setq file (org-link-unescape file)) + (setq file (expand-file-name file org-directory)) + (setq path (mapcar 'org-link-unescape + (org-split-string path "/"))) + (org-find-olp (cons file path)))))) + +(defun org-mobile-edit (what old new) + "Edit item WHAT in the current entry by replacing OLD with NEW. +WHAT can be \"heading\", \"todo\", \"tags\", \"priority\", or \"body\". +The edit only takes place if the current value is equal (except for +white space) the OLD. If this is so, OLD will be replace by NEW +and the command will return t. If something goes wrong, a string will +be returned that indicates what went wrong." + (let (current old1 new1 level) + (if (stringp what) (setq what (intern what))) + + (cond + + ((memq what '(todo todostate)) + (setq current (org-get-todo-state)) + (cond + ((equal new "DONEARCHIVE") + (org-todo 'done) + (org-archive-subtree-default)) + ((equal new current) t) ; nothing needs to be done + ((or (equal current old) + (eq org-mobile-force-mobile-change t) + (memq 'todo org-mobile-force-mobile-change)) + (org-todo (or new 'none)) t) + (t (error "State before change was expected as \"%s\", but is \"%s\"" + old current)))) + + ((eq what 'tags) + (setq current (org-get-tags) + new1 (and new (org-split-string new ":+")) + old1 (and old (org-split-string old ":+"))) + (cond + ((org-mobile-tags-same-p current new1) t) ; no change needed + ((or (org-mobile-tags-same-p current old1) + (eq org-mobile-force-mobile-change t) + (memq 'tags org-mobile-force-mobile-change)) + (org-set-tags-to new1) t) + (t (error "Tags before change were expected as \"%s\", but are \"%s\"" + (or old "") (or current ""))))) + + ((eq what 'priority) + (when (looking-at org-complex-heading-regexp) + (setq current (and (match-end 3) (substring (match-string 3) 2 3))) + (cond + ((equal current new) t) ; no action required + ((or (equal current old) + (eq org-mobile-force-mobile-change t) + (memq 'tags org-mobile-force-mobile-change)) + (org-priority (and new (string-to-char new)))) + (t (error "Priority was expected to be %s, but is %s" + old current))))) + + ((eq what 'heading) + (when (looking-at org-complex-heading-regexp) + (setq current (match-string 4)) + (cond + ((equal current new) t) ; no action required + ((or (equal current old) + (eq org-mobile-force-mobile-change t) + (memq 'heading org-mobile-force-mobile-change)) + (goto-char (match-beginning 4)) + (insert new) + (delete-region (point) (+ (point) (length current))) + (org-set-tags nil 'align)) + (t (error "Heading changed in MobileOrg and on the computer"))))) + + ((eq what 'addheading) + (if (org-at-heading-p) ; if false we are in top-level of file + (progn + ;; Workaround a `org-insert-heading-respect-content' bug + ;; which prevents correct insertion when point is invisible + (org-show-subtree) + (end-of-line 1) + (org-insert-heading-respect-content t) + (org-demote)) + (beginning-of-line) + (insert "* ")) + (insert new)) + + ((eq what 'refile) + (org-copy-subtree) + (org-with-point-at (org-mobile-locate-entry new) + (if (org-at-heading-p) ; if false we are in top-level of file + (progn + (setq level (org-get-valid-level (funcall outline-level) 1)) + (org-end-of-subtree t t) + (org-paste-subtree level)) + (org-paste-subtree 1))) + (org-cut-subtree)) + + ((eq what 'delete) + (org-cut-subtree)) + + ((eq what 'archive) + (org-archive-subtree)) + + ((eq what 'archive-sibling) + (org-archive-to-archive-sibling)) + + ((eq what 'body) + (setq current (buffer-substring (min (1+ (point-at-eol)) (point-max)) + (save-excursion (outline-next-heading) + (point)))) + (if (not (string-match "\\S-" current)) (setq current nil)) + (cond + ((org-mobile-bodies-same-p current new) t) ; no action necessary + ((or (org-mobile-bodies-same-p current old) + (eq org-mobile-force-mobile-change t) + (memq 'body org-mobile-force-mobile-change)) + (save-excursion + (end-of-line 1) + (insert "\n" new) + (or (bolp) (insert "\n")) + (delete-region (point) (progn (org-back-to-heading t) + (outline-next-heading) + (point)))) + t) + (t (error "Body was changed in MobileOrg and on the computer"))))))) + +(defun org-mobile-tags-same-p (list1 list2) + "Are the two tag lists the same?" + (not (or (org-delete-all list1 list2) + (org-delete-all list2 list1)))) + +(defun org-mobile-bodies-same-p (a b) + "Compare if A and B are visually equal strings. +We first remove leading and trailing white space from the entire strings. +Then we split the strings into lines and remove leading/trailing whitespace +from each line. Then we compare. +A and B must be strings or nil." + (cond + ((and (not a) (not b)) t) + ((or (not a) (not b)) nil) + (t (setq a (org-trim a) b (org-trim b)) + (setq a (mapconcat 'identity (org-split-string a "[ \t]*\n[ \t]*") "\n")) + (setq b (mapconcat 'identity (org-split-string b "[ \t]*\n[ \t]*") "\n")) + (equal a b)))) + +(provide 'org-mobile) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-mobile.el ends here diff --git a/elpa/org-20150427/org-mouse.el b/elpa/org-20150427/org-mouse.el new file mode 100644 index 00000000..74046c73 --- /dev/null +++ b/elpa/org-20150427/org-mouse.el @@ -0,0 +1,1110 @@ +;;; org-mouse.el --- Better mouse support for org-mode + +;; Copyright (C) 2006-2014 Free Software Foundation, Inc. + +;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> +;; Maintainer: Carsten Dominik <carsten at orgmode dot org> + +;; 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: +;; +;; Org-mouse provides mouse support for org-mode. +;; +;; http://orgmode.org +;; +;; Org-mouse implements the following features: +;; * following links with the left mouse button (in Emacs 22) +;; * subtree expansion/collapse (org-cycle) with the left mouse button +;; * several context menus on the right mouse button: +;; + general text +;; + headlines +;; + timestamps +;; + priorities +;; + links +;; + tags +;; * promoting/demoting/moving subtrees with mouse-3 +;; + if the drag starts and ends in the same line then promote/demote +;; + otherwise move the subtree +;; +;; Use +;; --- +;; +;; To use this package, put the following line in your .emacs: +;; +;; (require 'org-mouse) +;; + +;; FIXME: +;; + deal with folding / unfolding issues + +;; TODO (This list is only theoretical, if you'd like to have some +;; feature implemented or a bug fix please send me an email, even if +;; something similar appears in the list below. This will help me get +;; the priorities right.): +;; +;; + org-store-link, insert link +;; + org tables +;; + occur with the current word/tag (same menu item) +;; + ctrl-c ctrl-c, for example, renumber the current list +;; + internal links + +;; Please email the maintainer with new feature suggestions / bugs + +;; History: +;; +;; Since version 5.10: Changes are listed in the general org-mode docs. +;; +;; Version 5.09;; + Version number synchronization with Org-mode. +;; +;; Version 0.25 +;; + made compatible with org-mode 4.70 (thanks to Carsten for the patch) +;; +;; Version 0.24 +;; + minor changes to the table menu +;; +;; Version 0.23 +;; + preliminary support for tables and calculation marks +;; + context menu support for org-agenda-undo & org-sort-entries +;; +;; Version 0.22 +;; + handles undo support for the agenda buffer (requires org-mode >=4.58) +;; +;; Version 0.21 +;; + selected text activates its context menu +;; + shift-middleclick or right-drag inserts the text from the clipboard in the form of a link +;; +;; Version 0.20 +;; + the new "TODO Status" submenu replaces the "Cycle TODO" menu item +;; + the TODO menu can now list occurrences of a specific TODO keyword +;; + #+STARTUP line is now recognized +;; +;; Version 0.19 +;; + added support for dragging URLs to the org-buffer +;; +;; Version 0.18 +;; + added support for agenda blocks +;; +;; Version 0.17 +;; + toggle checkboxes with a single click +;; +;; Version 0.16 +;; + added support for checkboxes +;; +;; Version 0.15 +;; + org-mode now works with the Agenda buffer as well +;; +;; Version 0.14 +;; + added a menu option that converts plain list items to outline items +;; +;; Version 0.13 +;; + "Insert Heading" now inserts a sibling heading if the point is +;; on "***" and a child heading otherwise +;; +;; Version 0.12 +;; + compatible with Emacs 21 +;; + custom agenda commands added to the main menu +;; + moving trees should now work between windows in the same frame +;; +;; Version 0.11 +;; + fixed org-mouse-at-link (thanks to Carsten) +;; + removed [follow-link] bindings +;; +;; Version 0.10 +;; + added a menu option to remove highlights +;; + compatible with org-mode 4.21 now +;; +;; Version 0.08: +;; + trees can be moved/promoted/demoted by dragging with the right +;; mouse button (mouse-3) +;; + small changes in the above function +;; +;; Versions 0.01 -- 0.07: (I don't remember) + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'org) + +(defvar org-agenda-allow-remote-undo) +(defvar org-agenda-undo-list) +(defvar org-agenda-custom-commands) +(declare-function org-agenda-change-all-lines "org-agenda" + (newhead hdmarker &optional fixface just-this)) +(declare-function org-verify-change-for-undo "org-agenda" (l1 l2)) +(declare-function org-apply-on-list "org-list" (function init-value &rest args)) +(declare-function org-agenda-earlier "org-agenda" (arg)) +(declare-function org-agenda-later "org-agenda" (arg)) + +(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " + "Regular expression that matches a plain list.") +(defvar org-mouse-direct t + "Internal variable indicating whether the current action is direct. + +If t, then the current action has been invoked directly through the buffer +it is intended to operate on. If nil, then the action has been invoked +indirectly, for example, through the agenda buffer.") + +(defgroup org-mouse nil + "Mouse support for org-mode." + :tag "Org Mouse" + :group 'org) + +(defcustom org-mouse-punctuation ":" + "Punctuation used when inserting text by drag and drop." + :group 'org-mouse + :type 'string) + +(defcustom org-mouse-features + '(context-menu yank-link activate-stars activate-bullets activate-checkboxes) + "The features of org-mouse that should be activated. +Changing this variable requires a restart of Emacs to get activated." + :group 'org-mouse + :type '(set :greedy t + (const :tag "Mouse-3 shows context menu" context-menu) + (const :tag "C-mouse-1 and mouse-3 move trees" move-tree) + (const :tag "S-mouse-2 and drag-mouse-3 yank link" yank-link) + (const :tag "Activate headline stars" activate-stars) + (const :tag "Activate item bullets" activate-bullets) + (const :tag "Activate checkboxes" activate-checkboxes))) + +(defun org-mouse-re-search-line (regexp) + "Search the current line for a given regular expression." + (beginning-of-line) + (re-search-forward regexp (point-at-eol) t)) + +(defun org-mouse-end-headline () + "Go to the end of current headline (ignoring tags)." + (interactive) + (end-of-line) + (skip-chars-backward "\t ") + (when (org-looking-back ":[A-Za-z]+:") + (skip-chars-backward ":A-Za-z") + (skip-chars-backward "\t "))) + +(defvar org-mouse-context-menu-function nil + "Function to create the context menu. +The value of this variable is the function invoked by +`org-mouse-context-menu' as the context menu.") +(make-variable-buffer-local 'org-mouse-context-menu-function) + +(defun org-mouse-show-context-menu (event prefix) + "Invoke the context menu. + +If the value of `org-mouse-context-menu-function' is a function, then +this function is called. Otherwise, the current major mode menu is used." + (interactive "@e \nP") + (if (and (= (event-click-count event) 1) + (or (not mark-active) + (sit-for (/ double-click-time 1000.0)))) + (progn + (select-window (posn-window (event-start event))) + (when (not (org-mouse-mark-active)) + (goto-char (posn-point (event-start event))) + (when (not (eolp)) (save-excursion (run-hooks 'post-command-hook))) + (let ((redisplay-dont-pause t)) + (sit-for 0))) + (if (functionp org-mouse-context-menu-function) + (funcall org-mouse-context-menu-function event) + (if (fboundp 'mouse-menu-major-mode-map) + (popup-menu (mouse-menu-major-mode-map) event prefix) + (org-no-warnings ; don't warn about fallback, obsolete since 23.1 + (mouse-major-mode-menu event prefix))))) + (setq this-command 'mouse-save-then-kill) + (mouse-save-then-kill event))) + +(defun org-mouse-line-position () + "Return `:beginning' or `:middle' or `:end', depending on the point position. + +If the point is at the end of the line, return `:end'. +If the point is separated from the beginning of the line only by white +space and *'s (`org-mouse-bolp'), return `:beginning'. Otherwise, +return `:middle'." + (cond + ((eolp) :end) + ((org-mouse-bolp) :beginning) + (t :middle))) + +(defun org-mouse-empty-line () + "Return non-nil iff the line contains only white space." + (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))) + +(defun org-mouse-next-heading () + "Go to the next heading. +If there is none, ensure that the point is at the beginning of an empty line." + (unless (outline-next-heading) + (beginning-of-line) + (unless (org-mouse-empty-line) + (end-of-line) + (newline)))) + +(defun org-mouse-insert-heading () + "Insert a new heading, as `org-insert-heading'. + +If the point is at the :beginning (`org-mouse-line-position') of the line, +insert the new heading before the current line. Otherwise, insert it +after the current heading." + (interactive) + (case (org-mouse-line-position) + (:beginning (beginning-of-line) + (org-insert-heading)) + (t (org-mouse-next-heading) + (org-insert-heading)))) + +(defun org-mouse-timestamp-today (&optional shift units) + "Change the timestamp into SHIFT UNITS in the future. + +For the acceptable UNITS, see `org-timestamp-change'." + (interactive) + (org-time-stamp nil) + (when shift (org-timestamp-change shift units))) + +(defun org-mouse-keyword-menu (keywords function &optional selected itemformat) + "A helper function. + +Returns a menu fragment consisting of KEYWORDS. When a keyword +is selected by the user, FUNCTION is called with the selected +keyword as the only argument. + +If SELECTED is nil, then all items are normal menu items. If +SELECTED is a function, then each item is a checkbox, which is +enabled for a given keyword iff (funcall SELECTED keyword) return +non-nil. If SELECTED is neither nil nor a function, then the +items are radio buttons. A radio button is enabled for the +keyword `equal' to SELECTED. + +ITEMFORMAT governs formatting of the elements of KEYWORDS. If it +is a function, it is invoked with the keyword as the only +argument. If it is a string, it is interpreted as the format +string to (format ITEMFORMAT keyword). If it is neither a string +nor a function, elements of KEYWORDS are used directly." + (mapcar + `(lambda (keyword) + (vector (cond + ((functionp ,itemformat) (funcall ,itemformat keyword)) + ((stringp ,itemformat) (format ,itemformat keyword)) + (t keyword)) + (list 'funcall ,function keyword) + :style (cond + ((null ,selected) t) + ((functionp ,selected) 'toggle) + (t 'radio)) + :selected (if (functionp ,selected) + (and (funcall ,selected keyword) t) + (equal ,selected keyword)))) + keywords)) + +(defun org-mouse-remove-match-and-spaces () + "Remove the match, make just one space around the point." + (interactive) + (replace-match "") + (just-one-space)) + +(defvar org-mouse-rest) +(defun org-mouse-replace-match-and-surround (newtext &optional fixedcase + literal string subexp) + "The same as `replace-match', but surrounds the replacement with spaces." + (apply 'replace-match org-mouse-rest) + (save-excursion + (goto-char (match-beginning (or subexp 0))) + (just-one-space) + (goto-char (match-end (or subexp 0))) + (just-one-space))) + +(defun org-mouse-keyword-replace-menu (keywords &optional group itemformat + nosurround) + "A helper function. + +Returns a menu fragment consisting of KEYWORDS. When a keyword +is selected, group GROUP of the current match is replaced by the +keyword. The method ensures that both ends of the replacement +are separated from the rest of the text in the buffer by +individual spaces (unless NOSURROUND is non-nil). + +The final entry of the menu is always \"None\", which removes the +match. + +ITEMFORMAT governs formatting of the elements of KEYWORDS. If it +is a function, it is invoked with the keyword as the only +argument. If it is a string, it is interpreted as the format +string to (format ITEMFORMAT keyword). If it is neither a string +nor a function, elements of KEYWORDS are used directly." + (setq group (or group 0)) + (let ((replace (org-mouse-match-closure + (if nosurround 'replace-match + 'org-mouse-replace-match-and-surround)))) + (append + (org-mouse-keyword-menu + keywords + `(lambda (keyword) (funcall ,replace keyword t t nil ,group)) + (match-string group) + itemformat) + `(["None" org-mouse-remove-match-and-spaces + :style radio + :selected ,(not (member (match-string group) keywords))])))) + +(defun org-mouse-show-headlines () + "Change the visibility of the current org buffer to only show headlines." + (interactive) + (let ((this-command 'org-cycle) + (last-command 'org-cycle) + (org-cycle-global-status nil)) + (org-cycle '(4)) + (org-cycle '(4)))) + +(defun org-mouse-show-overview () + "Change visibility of current org buffer to first-level headlines only." + (interactive) + (let ((org-cycle-global-status nil)) + (org-cycle '(4)))) + +(defun org-mouse-set-priority (priority) + "Set the priority of the current headline to PRIORITY." + (org-priority priority)) + +(defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]" + "Regular expression matching the priority indicator. +Differs from `org-priority-regexp' in that it doesn't contain the +leading '.*?'.") + +(defun org-mouse-get-priority (&optional default) + "Return the priority of the current headline. +DEFAULT is returned if no priority is given in the headline." + (save-excursion + (if (org-mouse-re-search-line org-mouse-priority-regexp) + (match-string 1) + (when default (char-to-string org-default-priority))))) + +(defun org-mouse-delete-timestamp () + "Deletes the current timestamp as well as the preceding keyword. +SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" + (when (or (org-at-date-range-p) (org-at-timestamp-p)) + (replace-match "") ; delete the timestamp + (skip-chars-backward " :A-Z") + (when (looking-at " *[A-Z][A-Z]+:") + (replace-match "")))) + +(defun org-mouse-looking-at (regexp skipchars &optional movechars) + (save-excursion + (let ((point (point))) + (if (looking-at regexp) t + (skip-chars-backward skipchars) + (forward-char (or movechars 0)) + (when (looking-at regexp) + (> (match-end 0) point)))))) + +(defun org-mouse-priority-list () + (loop for priority from ?A to org-lowest-priority + collect (char-to-string priority))) + +(defun org-mouse-todo-menu (state) + "Create the menu with TODO keywords." + (append + (let ((kwds org-todo-keywords-1)) + (org-mouse-keyword-menu + kwds + `(lambda (kwd) (org-todo kwd)) + (lambda (kwd) (equal state kwd)))))) + +(defun org-mouse-tag-menu () ;todo + "Create the tags menu." + (append + (let ((tags (org-get-tags))) + (org-mouse-keyword-menu + (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) + `(lambda (tag) + (org-mouse-set-tags + (sort (if (member tag (quote ,tags)) + (delete tag (quote ,tags)) + (cons tag (quote ,tags))) + 'string-lessp))) + `(lambda (tag) (member tag (quote ,tags))) + )) + '("--" + ["Align Tags Here" (org-set-tags nil t) t] + ["Align Tags in Buffer" (org-set-tags t t) t] + ["Set Tags ..." (org-set-tags) t]))) + +(defun org-mouse-set-tags (tags) + (save-excursion + ;; remove existing tags first + (beginning-of-line) + (when (org-mouse-re-search-line ":\\(\\([A-Za-z_]+:\\)+\\)") + (replace-match "")) + + ;; set new tags if any + (when tags + (end-of-line) + (insert " :" (mapconcat 'identity tags ":") ":") + (org-set-tags nil t)))) + +(defun org-mouse-insert-checkbox () + (interactive) + (and (org-at-item-p) + (goto-char (match-end 0)) + (unless (org-at-item-checkbox-p) + (delete-horizontal-space) + (insert " [ ] ")))) + +(defun org-mouse-agenda-type (type) + (case type + ('tags "Tags: ") + ('todo "TODO: ") + ('tags-tree "Tags tree: ") + ('todo-tree "TODO tree: ") + ('occur-tree "Occur tree: ") + (t "Agenda command ???"))) + +(defun org-mouse-list-options-menu (alloptions &optional function) + (let ((options (save-match-data + (split-string (match-string-no-properties 1))))) + (print options) + (loop for name in alloptions + collect + (vector name + `(progn + (replace-match + (mapconcat 'identity + (sort (if (member ',name ',options) + (delete ',name ',options) + (cons ',name ',options)) + 'string-lessp) + " ") + nil nil nil 1) + (when (functionp ',function) (funcall ',function))) + :style 'toggle + :selected (and (member name options) t))))) + +(defun org-mouse-clip-text (text maxlength) + (if (> (length text) maxlength) + (concat (substring text 0 (- maxlength 3)) "...") + text)) + +(defun org-mouse-popup-global-menu () + (popup-menu + `("Main Menu" + ["Show Overview" org-mouse-show-overview t] + ["Show Headlines" org-mouse-show-headlines t] + ["Show All" show-all t] + ["Remove Highlights" org-remove-occur-highlights + :visible org-occur-highlights] + "--" + ["Check Deadlines" + (if (functionp 'org-check-deadlines-and-todos) + (org-check-deadlines-and-todos org-deadline-warning-days) + (org-check-deadlines org-deadline-warning-days)) t] + ["Check TODOs" org-show-todo-tree t] + ("Check Tags" + ,@(org-mouse-keyword-menu + (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) + #'(lambda (tag) (org-tags-sparse-tree nil tag))) + "--" + ["Custom Tag ..." org-tags-sparse-tree t]) + ["Check Phrase ..." org-occur] + "--" + ["Display Agenda" org-agenda-list t] + ["Display Timeline" org-timeline t] + ["Display TODO List" org-todo-list t] + ("Display Tags" + ,@(org-mouse-keyword-menu + (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) + #'(lambda (tag) (org-tags-view nil tag))) + "--" + ["Custom Tag ..." org-tags-view t]) + ["Display Calendar" org-goto-calendar t] + "--" + ,@(org-mouse-keyword-menu + (mapcar 'car org-agenda-custom-commands) + #'(lambda (key) + (eval `(org-agenda nil (string-to-char ,key)))) + nil + #'(lambda (key) + (let ((entry (assoc key org-agenda-custom-commands))) + (org-mouse-clip-text + (cond + ((stringp (nth 1 entry)) (nth 1 entry)) + ((stringp (nth 2 entry)) + (concat (org-mouse-agenda-type (nth 1 entry)) + (nth 2 entry))) + (t "Agenda Command '%s'")) + 30)))) + "--" + ["Delete Blank Lines" delete-blank-lines + :visible (org-mouse-empty-line)] + ["Insert Checkbox" org-mouse-insert-checkbox + :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))] + ["Insert Checkboxes" + (org-mouse-for-each-item 'org-mouse-insert-checkbox) + :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))] + ["Plain List to Outline" org-mouse-transform-to-outline + :visible (org-at-item-p)]))) + +(defun org-mouse-get-context (contextlist context) + (let ((contextdata (assq context contextlist))) + (when contextdata + (save-excursion + (goto-char (second contextdata)) + (re-search-forward ".*" (third contextdata)))))) + +(defun org-mouse-for-each-item (funct) + ;; Functions called by `org-apply-on-list' need an argument + (let ((wrap-fun (lambda (c) (funcall funct)))) + (when (ignore-errors (goto-char (org-in-item-p))) + (save-excursion (org-apply-on-list wrap-fun nil))))) + +(defun org-mouse-bolp () + "Return true if there only spaces, tabs, and '*' before point. +This means, between the beginning of line and the point." + (save-excursion + (skip-chars-backward " \t*") (bolp))) + +(defun org-mouse-insert-item (text) + (case (org-mouse-line-position) + (:beginning ; insert before + (beginning-of-line) + (looking-at "[ \t]*") + (open-line 1) + (org-indent-to-column (- (match-end 0) (match-beginning 0))) + (insert "+ ")) + (:middle ; insert after + (end-of-line) + (newline t) + (indent-relative) + (insert "+ ")) + (:end ; insert text here + (skip-chars-backward " \t") + (kill-region (point) (point-at-eol)) + (unless (org-looking-back org-mouse-punctuation) + (insert (concat org-mouse-punctuation " "))))) + (insert text) + (beginning-of-line)) + +(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate) + (if (derived-mode-p 'org-mode) + (org-mouse-insert-item text) + ad-do-it)) + +(defadvice dnd-open-file (around org-mouse-dnd-open-file activate) + (if (derived-mode-p 'org-mode) + (org-mouse-insert-item uri) + ad-do-it)) + +(defun org-mouse-match-closure (function) + (let ((match (match-data t))) + `(lambda (&rest rest) + (save-match-data + (set-match-data ',match) + (apply ',function rest))))) + +(defun org-mouse-yank-link (click) + (interactive "e") + ;; Give temporary modes such as isearch a chance to turn off. + (run-hooks 'mouse-leave-buffer-hook) + (mouse-set-point click) + (setq mouse-selection-click-count 0) + (delete-horizontal-space) + (insert-for-yank (concat " [[" (current-kill 0) "]] "))) + +(defun org-mouse-context-menu (&optional event) + (let* ((stamp-prefixes (list org-deadline-string org-scheduled-string)) + (contextlist (org-context)) + (get-context (lambda (context) (org-mouse-get-context contextlist context)))) + (cond + ((org-mouse-mark-active) + (let ((region-string (buffer-substring (region-beginning) (region-end)))) + (popup-menu + `(nil + ["Sparse Tree" (org-occur ',region-string)] + ["Find in Buffer" (occur ',region-string)] + ["Grep in Current Dir" + (grep (format "grep -rnH -e '%s' *" ',region-string))] + ["Grep in Parent Dir" + (grep (format "grep -rnH -e '%s' ../*" ',region-string))] + "--" + ["Convert to Link" + (progn (save-excursion (goto-char (region-beginning)) (insert "[[")) + (save-excursion (goto-char (region-end)) (insert "]]")))] + ["Insert Link Here" (org-mouse-yank-link ',event)])))) + ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)")) + (popup-menu + `(nil + ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options) + 'org-mode-restart)))) + ((or (eolp) + (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$") + (org-looking-back " \\|\t"))) + (org-mouse-popup-global-menu)) + ((funcall get-context :checkbox) + (popup-menu + '(nil + ["Toggle" org-toggle-checkbox t] + ["Remove" org-mouse-remove-match-and-spaces t] + "" + ["All Clear" (org-mouse-for-each-item + (lambda () + (when (save-excursion (org-at-item-checkbox-p)) + (replace-match "[ ] "))))] + ["All Set" (org-mouse-for-each-item + (lambda () + (when (save-excursion (org-at-item-checkbox-p)) + (replace-match "[X] "))))] + ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t] + ["All Remove" (org-mouse-for-each-item + (lambda () + (when (save-excursion (org-at-item-checkbox-p)) + (org-mouse-remove-match-and-spaces))))] + ))) + ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_") + (member (match-string 0) org-todo-keywords-1)) + (popup-menu + `(nil + ,@(org-mouse-todo-menu (match-string 0)) + "--" + ["Check TODOs" org-show-todo-tree t] + ["List all TODO keywords" org-todo-list t] + [,(format "List only %s" (match-string 0)) + (org-todo-list (match-string 0)) t] + ))) + ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z") + (member (match-string 0) stamp-prefixes)) + (popup-menu + `(nil + ,@(org-mouse-keyword-replace-menu stamp-prefixes) + "--" + ["Check Deadlines" org-check-deadlines t] + ))) + ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority + (popup-menu `(nil ,@(org-mouse-keyword-replace-menu + (org-mouse-priority-list) 1 "Priority %s" t)))) + ((funcall get-context :link) + (popup-menu + '(nil + ["Open" org-open-at-point t] + ["Open in Emacs" (org-open-at-point t) t] + "--" + ["Copy link" (org-kill-new (match-string 0))] + ["Cut link" + (progn + (kill-region (match-beginning 0) (match-end 0)) + (just-one-space))] + "--" + ["Grep for TODOs" + (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))] + ; ["Paste file link" ((insert "file:") (yank))] + ))) + ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags + (popup-menu + `(nil + [,(format "Display '%s'" (match-string 1)) + (org-tags-view nil ,(match-string 1))] + [,(format "Sparse Tree '%s'" (match-string 1)) + (org-tags-sparse-tree nil ,(match-string 1))] + "--" + ,@(org-mouse-tag-menu)))) + ((org-at-timestamp-p) + (popup-menu + '(nil + ["Show Day" org-open-at-point t] + ["Change Timestamp" org-time-stamp t] + ["Delete Timestamp" (org-mouse-delete-timestamp) t] + ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)] + "--" + ["Set for Today" org-mouse-timestamp-today] + ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)] + ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)] + ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)] + ["Set in a Month" (org-mouse-timestamp-today 1 'month)] + "--" + ["+ 1 Day" (org-timestamp-change 1 'day)] + ["+ 1 Week" (org-timestamp-change 7 'day)] + ["+ 1 Month" (org-timestamp-change 1 'month)] + "--" + ["- 1 Day" (org-timestamp-change -1 'day)] + ["- 1 Week" (org-timestamp-change -7 'day)] + ["- 1 Month" (org-timestamp-change -1 'month)]))) + ((funcall get-context :table-special) + (let ((mdata (match-data))) + (incf (car mdata) 2) + (store-match-data mdata)) + (message "match: %S" (match-string 0)) + (popup-menu `(nil ,@(org-mouse-keyword-replace-menu + '(" " "!" "^" "_" "$" "#" "*" "'") 0 + (lambda (mark) + (case (string-to-char mark) + (? "( ) Nothing Special") + (?! "(!) Column Names") + (?^ "(^) Field Names Above") + (?_ "(^) Field Names Below") + (?$ "($) Formula Parameters") + (?# "(#) Recalculation: Auto") + (?* "(*) Recalculation: Manual") + (?' "(') Recalculation: None"))) t)))) + ((assq :table contextlist) + (popup-menu + '(nil + ["Align Table" org-ctrl-c-ctrl-c] + ["Blank Field" org-table-blank-field] + ["Edit Field" org-table-edit-field] + "--" + ("Column" + ["Move Column Left" org-metaleft] + ["Move Column Right" org-metaright] + ["Delete Column" org-shiftmetaleft] + ["Insert Column" org-shiftmetaright] + "--" + ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle]) + ("Row" + ["Move Row Up" org-metaup] + ["Move Row Down" org-metadown] + ["Delete Row" org-shiftmetaup] + ["Insert Row" org-shiftmetadown] + ["Sort lines in region" org-table-sort-lines (org-at-table-p)] + "--" + ["Insert Hline" org-table-insert-hline]) + ("Rectangle" + ["Copy Rectangle" org-copy-special] + ["Cut Rectangle" org-cut-special] + ["Paste Rectangle" org-paste-special] + ["Fill Rectangle" org-table-wrap-region]) + "--" + ["Set Column Formula" org-table-eval-formula] + ["Set Field Formula" (org-table-eval-formula '(4))] + ["Edit Formulas" org-table-edit-formulas] + "--" + ["Recalculate Line" org-table-recalculate] + ["Recalculate All" (org-table-recalculate '(4))] + ["Iterate All" (org-table-recalculate '(16))] + "--" + ["Toggle Recalculate Mark" org-table-rotate-recalc-marks] + ["Sum Column/Rectangle" org-table-sum + :active (or (org-at-table-p) (org-region-active-p))] + ["Field Info" org-table-field-info] + ["Debug Formulas" + (setq org-table-formula-debug (not org-table-formula-debug)) + :style toggle :selected org-table-formula-debug] + ))) + ((and (assq :headline contextlist) (not (eolp))) + (let ((priority (org-mouse-get-priority t))) + (popup-menu + `("Headline Menu" + ("Tags and Priorities" + ,@(org-mouse-keyword-menu + (org-mouse-priority-list) + #'(lambda (keyword) + (org-mouse-set-priority (string-to-char keyword))) + priority "Priority %s") + "--" + ,@(org-mouse-tag-menu)) + ("TODO Status" + ,@(org-mouse-todo-menu (org-get-todo-state))) + ["Show Tags" + (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags)) + :visible (not org-mouse-direct)] + ["Show Priority" + (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority)) + :visible (not org-mouse-direct)] + ,@(if org-mouse-direct '("--") nil) + ["New Heading" org-mouse-insert-heading :visible org-mouse-direct] + ["Set Deadline" + (progn (org-mouse-end-headline) (insert " ") (org-deadline)) + :active (not (save-excursion + (org-mouse-re-search-line org-deadline-regexp)))] + ["Schedule Task" + (progn (org-mouse-end-headline) (insert " ") (org-schedule)) + :active (not (save-excursion + (org-mouse-re-search-line org-scheduled-regexp)))] + ["Insert Timestamp" + (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t] + ; ["Timestamp (inactive)" org-time-stamp-inactive t] + "--" + ["Archive Subtree" org-archive-subtree] + ["Cut Subtree" org-cut-special] + ["Copy Subtree" org-copy-special] + ["Paste Subtree" org-paste-special :visible org-mouse-direct] + ("Sort Children" + ["Alphabetically" (org-sort-entries nil ?a)] + ["Numerically" (org-sort-entries nil ?n)] + ["By Time/Date" (org-sort-entries nil ?t)] + "--" + ["Reverse Alphabetically" (org-sort-entries nil ?A)] + ["Reverse Numerically" (org-sort-entries nil ?N)] + ["Reverse By Time/Date" (org-sort-entries nil ?T)]) + "--" + ["Move Trees" org-mouse-move-tree :active nil] + )))) + (t + (org-mouse-popup-global-menu))))) + +(defun org-mouse-mark-active () + (and mark-active transient-mark-mode)) + +(defun org-mouse-in-region-p (pos) + (and (org-mouse-mark-active) + (>= pos (region-beginning)) + (< pos (region-end)))) + +(defun org-mouse-down-mouse (event) + (interactive "e") + (setq this-command last-command) + (unless (and (= 1 (event-click-count event)) + (org-mouse-in-region-p (posn-point (event-start event)))) + (mouse-drag-region event))) + +(add-hook 'org-mode-hook + #'(lambda () + (setq org-mouse-context-menu-function 'org-mouse-context-menu) + + (when (memq 'context-menu org-mouse-features) + (org-defkey org-mouse-map [mouse-3] nil) + (org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu)) + (org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse) + (when (memq 'context-menu org-mouse-features) + (org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree) + (org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)) + (when (memq 'yank-link org-mouse-features) + (org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link) + (org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link)) + (when (memq 'move-tree org-mouse-features) + (org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree) + (org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)) + + (when (memq 'activate-stars org-mouse-features) + (font-lock-add-keywords + nil + `((,org-outline-regexp + 0 `(face org-link mouse-face highlight keymap ,org-mouse-map) + 'prepend)) + t)) + + (when (memq 'activate-bullets org-mouse-features) + (font-lock-add-keywords + nil + `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +" + (1 `(face org-link keymap ,org-mouse-map mouse-face highlight) + 'prepend))) + t)) + + (when (memq 'activate-checkboxes org-mouse-features) + (font-lock-add-keywords + nil + `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)" + (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t))) + t)) + + (defadvice org-open-at-point (around org-mouse-open-at-point activate) + (let ((context (org-context))) + (cond + ((assq :headline-stars context) (org-cycle)) + ((assq :checkbox context) (org-toggle-checkbox)) + ((assq :item-bullet context) + (let ((org-cycle-include-plain-lists t)) (org-cycle))) + ((org-footnote-at-reference-p) nil) + (t ad-do-it)))))) + +(defun org-mouse-move-tree-start (event) + (interactive "e") + (message "Same line: promote/demote, (***):move before, (text): make a child")) + + +(defun org-mouse-make-marker (position) + (with-current-buffer (window-buffer (posn-window position)) + (copy-marker (posn-point position)))) + +(defun org-mouse-move-tree (event) + ;; todo: handle movements between different buffers + (interactive "e") + (save-excursion + (let* ((start (org-mouse-make-marker (event-start event))) + (end (org-mouse-make-marker (event-end event))) + (sbuf (marker-buffer start)) + (ebuf (marker-buffer end))) + + (when (and sbuf ebuf) + (set-buffer sbuf) + (goto-char start) + (org-back-to-heading) + (if (and (eq sbuf ebuf) + (equal + (point) + (save-excursion (goto-char end) (org-back-to-heading) (point)))) + ;; if the same line then promote/demote + (if (>= end start) (org-demote-subtree) (org-promote-subtree)) + ;; if different lines then move + (org-cut-subtree) + + (set-buffer ebuf) + (goto-char end) + (org-back-to-heading) + (when (and (eq sbuf ebuf) + (equal + (point) + (save-excursion (goto-char start) + (org-back-to-heading) (point)))) + (progn (org-end-of-subtree nil t) + (unless (eobp) (backward-char))) + (end-of-line) + (if (eobp) (newline) (forward-char))) + + (when (looking-at org-outline-regexp) + (let ((level (- (match-end 0) (match-beginning 0)))) + (when (> end (match-end 0)) + (progn (org-end-of-subtree nil t) + (unless (eobp) (backward-char))) + (end-of-line) + (if (eobp) (newline) (forward-char)) + (setq level (1+ level))) + (org-paste-subtree level) + (save-excursion + (progn (org-end-of-subtree nil t) + (unless (eobp) (backward-char))) + (when (bolp) (delete-char -1)))))))))) + + +(defun org-mouse-transform-to-outline () + (interactive) + (org-back-to-heading) + (let ((minlevel 1000) + (replace-text (concat (match-string 0) "* "))) + (beginning-of-line 2) + (save-excursion + (while (not (or (eobp) (looking-at org-outline-regexp))) + (when (looking-at org-mouse-plain-list-regexp) + (setq minlevel (min minlevel (- (match-end 1) (match-beginning 1))))) + (forward-line))) + (while (not (or (eobp) (looking-at org-outline-regexp))) + (when (and (looking-at org-mouse-plain-list-regexp) + (eq minlevel (- (match-end 1) (match-beginning 1)))) + (replace-match replace-text)) + (forward-line)))) + +(defvar org-mouse-cmd) ;dynamically scoped from `org-with-remote-undo'. + +(defun org-mouse-do-remotely (command) + ; (org-agenda-check-no-diary) + (when (get-text-property (point) 'org-marker) + (let* ((anticol (- (point-at-eol) (point))) + (marker (get-text-property (point) 'org-marker)) + (buffer (marker-buffer marker)) + (pos (marker-position marker)) + (hdmarker (get-text-property (point) 'org-hd-marker)) + (buffer-read-only nil) + (newhead "--- removed ---") + (org-mouse-direct nil) + (org-mouse-main-buffer (current-buffer))) + (when (eq (with-current-buffer buffer major-mode) 'org-mode) + (let ((endmarker (with-current-buffer buffer + (org-end-of-subtree nil t) + (unless (eobp) (forward-char 1)) + (copy-marker (point))))) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-hidden-entry) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil))) ; show the next heading + (org-back-to-heading) + (setq marker (copy-marker (point))) + (goto-char (max (point-at-bol) (- (point-at-eol) anticol))) + (funcall command) + (message "_cmd: %S" org-mouse-cmd) + (message "this-command: %S" this-command) + (unless (eq (marker-position marker) (marker-position endmarker)) + (setq newhead (org-get-heading)))) + + (beginning-of-line 1) + (save-excursion + (org-agenda-change-all-lines newhead hdmarker 'fixface)))) + t)))) + +(defun org-mouse-agenda-context-menu (&optional event) + (or (org-mouse-do-remotely 'org-mouse-context-menu) + (popup-menu + '("Agenda" + ("Agenda Files") + "--" + ["Undo" (progn (message "last command: %S" last-command) (setq this-command 'org-agenda-undo) (org-agenda-undo)) + :visible (if (eq last-command 'org-agenda-undo) + org-agenda-pending-undo-list + org-agenda-undo-list)] + ["Rebuild Buffer" org-agenda-redo t] + ["New Diary Entry" + org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline) t] + "--" + ["Goto Today" org-agenda-goto-today + (org-agenda-check-type nil 'agenda 'timeline) t] + ["Display Calendar" org-agenda-goto-calendar + (org-agenda-check-type nil 'agenda 'timeline) t] + ("Calendar Commands" + ["Phases of the Moon" org-agenda-phases-of-moon + (org-agenda-check-type nil 'agenda 'timeline)] + ["Sunrise/Sunset" org-agenda-sunrise-sunset + (org-agenda-check-type nil 'agenda 'timeline)] + ["Holidays" org-agenda-holidays + (org-agenda-check-type nil 'agenda 'timeline)] + ["Convert" org-agenda-convert-date + (org-agenda-check-type nil 'agenda 'timeline)] + "--" + ["Create iCalendar file" org-icalendar-combine-agenda-files t]) + "--" + ["Day View" org-agenda-day-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (eq org-agenda-current-span 'day)] + ["Week View" org-agenda-week-view + :active (org-agenda-check-type nil 'agenda) + :style radio :selected (eq org-agenda-current-span 'week)] + "--" + ["Show Logbook entries" org-agenda-log-mode + :style toggle :selected org-agenda-show-log + :active (org-agenda-check-type nil 'agenda 'timeline)] + ["Include Diary" org-agenda-toggle-diary + :style toggle :selected org-agenda-include-diary + :active (org-agenda-check-type nil 'agenda)] + ["Use Time Grid" org-agenda-toggle-time-grid + :style toggle :selected org-agenda-use-time-grid + :active (org-agenda-check-type nil 'agenda)] + ["Follow Mode" org-agenda-follow-mode + :style toggle :selected org-agenda-follow-mode] + "--" + ["Quit" org-agenda-quit t] + ["Exit and Release Buffers" org-agenda-exit t] + )))) + +(defun org-mouse-get-gesture (event) + (let ((startxy (posn-x-y (event-start event))) + (endxy (posn-x-y (event-end event)))) + (if (< (car startxy) (car endxy)) :right :left))) + + + ; (setq org-agenda-mode-hook nil) +(defvar org-agenda-mode-map) +(add-hook 'org-agenda-mode-hook + #'(lambda () + (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) + (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu) + (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) + (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier) + (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later) + (org-defkey org-agenda-mode-map [drag-mouse-3] + #'(lambda (event) (interactive "e") + (case (org-mouse-get-gesture event) + (:left (org-agenda-earlier 1)) + (:right (org-agenda-later 1))))))) + +(provide 'org-mouse) + +;;; org-mouse.el ends here diff --git a/elpa/org-20150427/org-pcomplete.el b/elpa/org-20150427/org-pcomplete.el new file mode 100644 index 00000000..32dcaa68 --- /dev/null +++ b/elpa/org-20150427/org-pcomplete.el @@ -0,0 +1,421 @@ +;;; org-pcomplete.el --- In-buffer completion code + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; John Wiegley <johnw at gnu dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Code: + +;;;; Require other packages + +(eval-when-compile + (require 'cl)) + +(require 'org-macs) +(require 'org-compat) +(require 'pcomplete) + +(declare-function org-split-string "org" (string &optional separators)) +(declare-function org-make-org-heading-search-string "org" + (&optional string)) +(declare-function org-get-buffer-tags "org" ()) +(declare-function org-get-tags "org" ()) +(declare-function org-buffer-property-keys "org" + (&optional include-specials include-defaults include-columns)) +(declare-function org-entry-properties "org" (&optional pom which specific)) + +;;;; Customization variables + +(defgroup org-complete nil + "Outline-based notes management and organizer." + :tag "Org" + :group 'org) + +(defvar org-drawer-regexp) +(defvar org-property-re) + +(defun org-thing-at-point () + "Examine the thing at point and let the caller know what it is. +The return value is a string naming the thing at point." + (let ((beg1 (save-excursion + (skip-chars-backward (org-re "[:alnum:]-_@")) + (point))) + (beg (save-excursion + (skip-chars-backward "a-zA-Z0-9-_:$") + (point))) + (line-to-here (buffer-substring (point-at-bol) (point)))) + (cond + ((string-match "\\`[ \t]*#\\+begin: clocktable[ \t]+" line-to-here) + (cons "block-option" "clocktable")) + ((string-match "\\`[ \t]*#\\+begin_src[ \t]+" line-to-here) + (cons "block-option" "src")) + ((save-excursion + (re-search-backward "^[ \t]*#\\+\\([A-Z_]+\\):.*" + (line-beginning-position) t)) + (cons "file-option" (match-string-no-properties 1))) + ((string-match "\\`[ \t]*#\\+[a-zA-Z_]*\\'" line-to-here) + (cons "file-option" nil)) + ((equal (char-before beg) ?\[) + (cons "link" nil)) + ((equal (char-before beg) ?\\) + (cons "tex" nil)) + ((string-match "\\`\\*+[ \t]+\\'" + (buffer-substring (point-at-bol) beg)) + (cons "todo" nil)) + ((equal (char-before beg) ?*) + (cons "searchhead" nil)) + ((and (equal (char-before beg1) ?:) + (equal (char-after (point-at-bol)) ?*)) + (cons "tag" nil)) + ((and (equal (char-before beg1) ?:) + (not (equal (char-after (point-at-bol)) ?*)) + (save-excursion + (move-beginning-of-line 1) + (skip-chars-backward "[ \t\n]") + ;; org-drawer-regexp matches a whole line but while + ;; looking-back, we just ignore trailing whitespaces + (or (org-looking-back (substring org-drawer-regexp 0 -1)) + (org-looking-back org-property-re)))) + (cons "prop" nil)) + ((and (equal (char-before beg1) ?:) + (not (equal (char-after (point-at-bol)) ?*))) + (cons "drawer" nil)) + (t nil)))) + +(defun org-command-at-point () + "Return the qualified name of the Org completion entity at point. +When completing for #+STARTUP, for example, this function returns +\"file-option/startup\"." + (let ((thing (org-thing-at-point))) + (cond + ((string= "file-option" (car thing)) + (concat (car thing) + (and (cdr thing) (concat "/" (downcase (cdr thing)))))) + ((string= "block-option" (car thing)) + (concat (car thing) "/" (downcase (cdr thing)))) + (t (car thing))))) + +(defun org-parse-arguments () + "Parse whitespace separated arguments in the current region." + (let ((begin (line-beginning-position)) + (end (line-end-position)) + begins args) + (save-restriction + (narrow-to-region begin end) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward " \t\n[") + (setq begins (cons (point) begins)) + (skip-chars-forward "^ \t\n[") + (setq args (cons (buffer-substring-no-properties + (car begins) (point)) + args))) + (cons (reverse args) (reverse begins)))))) + +(defun org-pcomplete-initial () + "Calls the right completion function for first argument completions." + (ignore + (funcall (or (pcomplete-find-completion-function + (car (org-thing-at-point))) + pcomplete-default-completion-function)))) + +(defvar org-options-keywords) ; From org.el +(defvar org-element-block-name-alist) ; From org-element.el +(defvar org-element-affiliated-keywords) ; From org-element.el +(declare-function org-get-export-keywords "org" ()) +(defun pcomplete/org-mode/file-option () + "Complete against all valid file options." + (require 'org-element) + (pcomplete-here + (org-pcomplete-case-double + (append (mapcar (lambda (keyword) (concat keyword " ")) + org-options-keywords) + (mapcar (lambda (keyword) (concat keyword ": ")) + org-element-affiliated-keywords) + (let (block-names) + (dolist (block-info org-element-block-name-alist block-names) + (let ((name (car block-info))) + (push (format "END_%s" name) block-names) + (push (concat "BEGIN_" + name + ;; Since language is compulsory in + ;; source blocks, add a space. + (and (equal name "SRC") " ")) + block-names) + (push (format "ATTR_%s: " name) block-names)))) + (mapcar (lambda (keyword) (concat keyword ": ")) + (org-get-export-keywords)))) + (substring pcomplete-stub 2))) + +(defun pcomplete/org-mode/file-option/author () + "Complete arguments for the #+AUTHOR file option." + (pcomplete-here (list user-full-name))) + +(defvar org-time-stamp-formats) +(defun pcomplete/org-mode/file-option/date () + "Complete arguments for the #+DATE file option." + (pcomplete-here (list (format-time-string (car org-time-stamp-formats))))) + +(defun pcomplete/org-mode/file-option/email () + "Complete arguments for the #+EMAIL file option." + (pcomplete-here (list user-mail-address))) + +(defvar org-export-exclude-tags) +(defun pcomplete/org-mode/file-option/exclude_tags () + "Complete arguments for the #+EXCLUDE_TAGS file option." + (require 'ox) + (pcomplete-here + (and org-export-exclude-tags + (list (mapconcat 'identity org-export-exclude-tags " "))))) + +(defvar org-file-tags) +(defun pcomplete/org-mode/file-option/filetags () + "Complete arguments for the #+FILETAGS file option." + (pcomplete-here (and org-file-tags (mapconcat 'identity org-file-tags " ")))) + +(defvar org-export-default-language) +(defun pcomplete/org-mode/file-option/language () + "Complete arguments for the #+LANGUAGE file option." + (require 'ox) + (pcomplete-here + (pcomplete-uniqify-list + (list org-export-default-language "en")))) + +(defvar org-default-priority) +(defvar org-highest-priority) +(defvar org-lowest-priority) +(defun pcomplete/org-mode/file-option/priorities () + "Complete arguments for the #+PRIORITIES file option." + (pcomplete-here (list (format "%c %c %c" + org-highest-priority + org-lowest-priority + org-default-priority)))) + +(defvar org-export-select-tags) +(defun pcomplete/org-mode/file-option/select_tags () + "Complete arguments for the #+SELECT_TAGS file option." + (require 'ox) + (pcomplete-here + (and org-export-select-tags + (list (mapconcat 'identity org-export-select-tags " "))))) + +(defvar org-startup-options) +(defun pcomplete/org-mode/file-option/startup () + "Complete arguments for the #+STARTUP file option." + (while (pcomplete-here + (let ((opts (pcomplete-uniqify-list + (mapcar 'car org-startup-options)))) + ;; Some options are mutually exclusive, and shouldn't be completed + ;; against if certain other options have already been seen. + (dolist (arg pcomplete-args) + (cond + ((string= arg "hidestars") + (setq opts (delete "showstars" opts))))) + opts)))) + +(defvar org-tag-alist) +(defun pcomplete/org-mode/file-option/tags () + "Complete arguments for the #+TAGS file option." + (pcomplete-here + (list + (mapconcat (lambda (x) + (cond + ((eq :startgroup (car x)) "{") + ((eq :endgroup (car x)) "}") + ((eq :grouptags (car x)) ":") + ((eq :newline (car x)) "\\n") + ((cdr x) (format "%s(%c)" (car x) (cdr x))) + (t (car x)))) + org-tag-alist " ")))) + +(defun pcomplete/org-mode/file-option/title () + "Complete arguments for the #+TITLE file option." + (pcomplete-here + (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (list (or (and visited-file + (file-name-sans-extension + (file-name-nondirectory visited-file))) + (buffer-name (buffer-base-buffer))))))) + + +(declare-function org-export-backend-options "org-export" (cl-x)) +(defun pcomplete/org-mode/file-option/options () + "Complete arguments for the #+OPTIONS file option." + (while (pcomplete-here + (pcomplete-uniqify-list + (append + ;; Hard-coded OPTION items always available. + '("H:" "\\n:" "num:" "timestamp:" "arch:" "author:" "c:" + "creator:" "date:" "d:" "email:" "*:" "e:" "::" "f:" + "inline:" "tex:" "p:" "pri:" "':" "-:" "stat:" "^:" "toc:" + "|:" "tags:" "tasks:" "<:" "todo:") + ;; OPTION items from registered back-ends. + (let (items) + (dolist (backend (org-bound-and-true-p + org-export--registered-backends)) + (dolist (option (org-export-backend-options backend)) + (let ((item (nth 2 option))) + (when item (push (concat item ":") items))))) + items)))))) + +(defun pcomplete/org-mode/file-option/infojs_opt () + "Complete arguments for the #+INFOJS_OPT file option." + (while (pcomplete-here + (pcomplete-uniqify-list + (mapcar (lambda (item) (format "%s:" (car item))) + (org-bound-and-true-p org-html-infojs-opts-table)))))) + +(defun pcomplete/org-mode/file-option/bind () + "Complete arguments for the #+BIND file option, which are variable names." + (let (vars) + (mapatoms + (lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars))))) + (pcomplete-here vars))) + +(defvar org-link-abbrev-alist-local) +(defvar org-link-abbrev-alist) +(defun pcomplete/org-mode/link () + "Complete against defined #+LINK patterns." + (pcomplete-here + (pcomplete-uniqify-list + (copy-sequence + (append (mapcar 'car org-link-abbrev-alist-local) + (mapcar 'car org-link-abbrev-alist)))))) + +(defvar org-entities) +(defun pcomplete/org-mode/tex () + "Complete against TeX-style HTML entity names." + (require 'org-entities) + (while (pcomplete-here + (pcomplete-uniqify-list (remove nil (mapcar 'car-safe org-entities))) + (substring pcomplete-stub 1)))) + +(defvar org-todo-keywords-1) +(defun pcomplete/org-mode/todo () + "Complete against known TODO keywords." + (pcomplete-here (pcomplete-uniqify-list (copy-sequence org-todo-keywords-1)))) + +(defvar org-todo-line-regexp) +(defun pcomplete/org-mode/searchhead () + "Complete against all headings. +This needs more work, to handle headings with lots of spaces in them." + (while + (pcomplete-here + (save-excursion + (goto-char (point-min)) + (let (tbl) + (while (re-search-forward org-todo-line-regexp nil t) + (push (org-make-org-heading-search-string + (match-string-no-properties 3)) + tbl)) + (pcomplete-uniqify-list tbl))) + (substring pcomplete-stub 1)))) + +(defvar org-tag-alist) +(defun pcomplete/org-mode/tag () + "Complete a tag name. Omit tags already set." + (while (pcomplete-here + (mapcar (lambda (x) + (concat x ":")) + (let ((lst (pcomplete-uniqify-list + (or (remove + nil + (mapcar (lambda (x) + (and (stringp (car x)) (car x))) + org-tag-alist)) + (mapcar 'car (org-get-buffer-tags)))))) + (dolist (tag (org-get-tags)) + (setq lst (delete tag lst))) + lst)) + (and (string-match ".*:" pcomplete-stub) + (substring pcomplete-stub (match-end 0)))))) + +(defun pcomplete/org-mode/prop () + "Complete a property name. Omit properties already set." + (pcomplete-here + (mapcar (lambda (x) + (concat x ": ")) + (let ((lst (pcomplete-uniqify-list + (copy-sequence + (org-buffer-property-keys nil t t))))) + (dolist (prop (org-entry-properties)) + (setq lst (delete (car prop) lst))) + lst)) + (substring pcomplete-stub 1))) + +(defvar org-drawers) + +(defun pcomplete/org-mode/drawer () + "Complete a drawer name." + (let ((spc (save-excursion + (move-beginning-of-line 1) + (looking-at "^\\([ \t]*\\):") + (match-string 1))) + (cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers))) + (pcomplete-here cpllist + (substring pcomplete-stub 1) + (unless (or (not (delq + nil + (mapcar (lambda(x) + (string-match (substring pcomplete-stub 1) x)) + cpllist))) + (looking-at "[ \t]*\n.*:END:")) + (save-excursion (insert "\n" spc ":END:")))))) + +(defun pcomplete/org-mode/block-option/src () + "Complete the arguments of a begin_src block. +Complete a language in the first field, the header arguments and switches." + (pcomplete-here + (mapcar + (lambda(x) (symbol-name (nth 3 x))) + (cdr (car (cdr (memq :key-type (plist-get + (symbol-plist + 'org-babel-load-languages) + 'custom-type))))))) + (while (pcomplete-here + '("-n" "-r" "-l" + ":cache" ":colnames" ":comments" ":dir" ":eval" ":exports" + ":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames" + ":session" ":shebang" ":tangle" ":tangle-mode" ":var")))) + +(defun pcomplete/org-mode/block-option/clocktable () + "Complete keywords in a clocktable line." + (while (pcomplete-here '(":maxlevel" ":scope" ":lang" + ":tstart" ":tend" ":block" ":step" + ":stepskip0" ":fileskip0" + ":emphasize" ":link" ":narrow" ":indent" + ":tcolumns" ":level" ":compact" ":timestamp" + ":formula" ":formatter" ":wstart" ":mstart")))) + +(defun org-pcomplete-case-double (list) + "Return list with both upcase and downcase version of all strings in LIST." + (let (e res) + (while (setq e (pop list)) + (setq res (cons (downcase e) (cons (upcase e) res)))) + (nreverse res))) + +;;;; Finish up + +(provide 'org-pcomplete) + +;;; org-pcomplete.el ends here diff --git a/elpa/org-20150427/org-pkg.el b/elpa/org-20150427/org-pkg.el new file mode 100644 index 00000000..6150f3cf --- /dev/null +++ b/elpa/org-20150427/org-pkg.el @@ -0,0 +1,3 @@ +(define-package "org" + "20150427" "Outline-based notes management and organizer" ( )) +;; no-byte-compile: t diff --git a/elpa/org-20150427/org-plot.el b/elpa/org-20150427/org-plot.el new file mode 100644 index 00000000..faa34fc3 --- /dev/null +++ b/elpa/org-20150427/org-plot.el @@ -0,0 +1,356 @@ +;;; org-plot.el --- Support for plotting from Org-mode + +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. +;; +;; Author: Eric Schulte <schulte dot eric at gmail dot com> +;; Keywords: tables, plotting +;; Homepage: http://orgmode.org +;; +;; 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: + +;; Borrows ideas and a couple of lines of code from org-exp.el. + +;; Thanks to the org-mode mailing list for testing and implementation +;; and feature suggestions + +;;; Code: +(require 'org) +(require 'org-table) +(eval-when-compile + (require 'cl)) + +(declare-function gnuplot-delchar-or-maybe-eof "ext:gnuplot" (arg)) +(declare-function gnuplot-mode "ext:gnuplot" ()) +(declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot" ()) + +(defvar org-plot/gnuplot-default-options + '((:plot-type . 2d) + (:with . lines) + (:ind . 0)) + "Default options to gnuplot used by `org-plot/gnuplot'.") + +(defvar org-plot-timestamp-fmt nil) + +(defun org-plot/add-options-to-plist (p options) + "Parse an OPTIONS line and set values in the property list P. +Returns the resulting property list." + (let (o) + (when options + (let ((op '(("type" . :plot-type) + ("script" . :script) + ("line" . :line) + ("set" . :set) + ("title" . :title) + ("ind" . :ind) + ("deps" . :deps) + ("with" . :with) + ("file" . :file) + ("labels" . :labels) + ("map" . :map) + ("timeind" . :timeind) + ("timefmt" . :timefmt))) + (multiples '("set" "line")) + (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)") + (start 0) + o) + (while (setq o (pop op)) + (if (member (car o) multiples) ;; keys with multiple values + (while (string-match + (concat (regexp-quote (car o)) regexp) + options start) + (setq start (match-end 0)) + (setq p (plist-put p (cdr o) + (cons (car (read-from-string + (match-string 1 options))) + (plist-get p (cdr o))))) + p) + (if (string-match (concat (regexp-quote (car o)) regexp) + options) + (setq p (plist-put p (cdr o) + (car (read-from-string + (match-string 1 options))))))))))) + p) + +(defun org-plot/goto-nearest-table () + "Move the point forward to the beginning of nearest table. +Return value is the point at the beginning of the table." + (interactive) (move-beginning-of-line 1) + (while (not (or (org-at-table-p) (< 0 (forward-line 1))))) + (goto-char (org-table-begin))) + +(defun org-plot/collect-options (&optional params) + "Collect options from an org-plot '#+Plot:' line. +Accepts an optional property list PARAMS, to which the options +will be added. Returns the resulting property list." + (interactive) + (let ((line (thing-at-point 'line))) + (if (string-match "#\\+PLOT: +\\(.*\\)$" line) + (org-plot/add-options-to-plist params (match-string 1 line)) + params))) + +(defun org-plot-quote-timestamp-field (s) + "Convert field S from timestamp to Unix time and export to gnuplot." + (format-time-string org-plot-timestamp-fmt (org-time-string-to-time s))) + +(defun org-plot-quote-tsv-field (s) + "Quote field S for export to gnuplot." + (if (string-match org-table-number-regexp s) s + (if (string-match org-ts-regexp3 s) + (org-plot-quote-timestamp-field s) + (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")))) + +(defun org-plot/gnuplot-to-data (table data-file params) + "Export TABLE to DATA-FILE in a format readable by gnuplot. +Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." + (with-temp-file + data-file + (make-local-variable 'org-plot-timestamp-fmt) + (setq org-plot-timestamp-fmt (or + (plist-get params :timefmt) + "%Y-%m-%d-%H:%M:%S")) + (insert (orgtbl-to-generic + table + (org-combine-plists + '(:sep "\t" :fmt org-plot-quote-tsv-field) + params)))) + nil) + +(defun org-plot/gnuplot-to-grid-data (table data-file params) + "Export the data in TABLE to DATA-FILE for gnuplot. +This means in a format appropriate for grid plotting by gnuplot. +PARAMS specifies which columns of TABLE should be plotted as independent +and dependant variables." + (interactive) + (let* ((ind (- (plist-get params :ind) 1)) + (deps (if (plist-member params :deps) + (mapcar (lambda (val) (- val 1)) (plist-get params :deps)) + (let (collector) + (dotimes (col (length (first table))) + (setf collector (cons col collector))) + collector))) + (counter 0) + row-vals) + (when (>= ind 0) ;; collect values of ind col + (setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter)) + (cons counter (nth ind row))) table))) + (when (or deps (>= ind 0)) ;; remove non-plotting columns + (setf deps (delq ind deps)) + (setf table (mapcar (lambda (row) + (dotimes (col (length row)) + (unless (memq col deps) + (setf (nth col row) nil))) + (delq nil row)) + table))) + ;; write table to gnuplot grid datafile format + (with-temp-file data-file + (let ((num-rows (length table)) (num-cols (length (first table))) + (gnuplot-row (lambda (col row value) + (setf col (+ 1 col)) (setf row (+ 1 row)) + (format "%f %f %f\n%f %f %f\n" + col (- row 0.5) value ;; lower edge + col (+ row 0.5) value))) ;; upper edge + front-edge back-edge) + (dotimes (col num-cols) + (dotimes (row num-rows) + (setf back-edge + (concat back-edge + (funcall gnuplot-row (- col 1) row + (string-to-number (nth col (nth row table)))))) + (setf front-edge + (concat front-edge + (funcall gnuplot-row col row + (string-to-number (nth col (nth row table))))))) + ;; only insert once per row + (insert back-edge) (insert "\n") ;; back edge + (insert front-edge) (insert "\n") ;; front edge + (setf back-edge "") (setf front-edge "")))) + row-vals)) + +(defun org-plot/gnuplot-script (data-file num-cols params &optional preface) + "Write a gnuplot script to DATA-FILE respecting the options set in PARAMS. +NUM-COLS controls the number of columns plotted in a 2-d plot. +Optional argument PREFACE returns only option parameters in a +manner suitable for prepending to a user-specified script." + (let* ((type (plist-get params :plot-type)) + (with (if (equal type 'grid) + 'pm3d + (plist-get params :with))) + (sets (plist-get params :set)) + (lines (plist-get params :line)) + (map (plist-get params :map)) + (title (plist-get params :title)) + (file (plist-get params :file)) + (ind (plist-get params :ind)) + (time-ind (plist-get params :timeind)) + (timefmt (plist-get params :timefmt)) + (text-ind (plist-get params :textind)) + (deps (if (plist-member params :deps) (plist-get params :deps))) + (col-labels (plist-get params :labels)) + (x-labels (plist-get params :xlabels)) + (y-labels (plist-get params :ylabels)) + (plot-str "'%s' using %s%d%s with %s title '%s'") + (plot-cmd (case type + ('2d "plot") + ('3d "splot") + ('grid "splot"))) + (script "reset") + ; ats = add-to-script + (ats (lambda (line) (setf script (format "%s\n%s" script line)))) + plot-lines) + (when file ;; output file + (funcall ats (format "set term %s" (file-name-extension file))) + (funcall ats (format "set output '%s'" file))) + (case type ;; type + ('2d ()) + ('3d (if map (funcall ats "set map"))) + ('grid (if map (funcall ats "set pm3d map") + (funcall ats "set pm3d")))) + (when title (funcall ats (format "set title '%s'" title))) ;; title + (when lines (mapc (lambda (el) (funcall ats el)) lines)) ;; line + (when sets ;; set + (mapc (lambda (el) (funcall ats (format "set %s" el))) sets)) + (when x-labels ;; x labels (xtics) + (funcall ats + (format "set xtics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" (cdr pair) (car pair))) + x-labels ", ")))) + (when y-labels ;; y labels (ytics) + (funcall ats + (format "set ytics (%s)" + (mapconcat (lambda (pair) + (format "\"%s\" %d" (cdr pair) (car pair))) + y-labels ", ")))) + (when time-ind ;; timestamp index + (funcall ats "set xdata time") + (funcall ats (concat "set timefmt \"" + (or timefmt ;; timefmt passed to gnuplot + "%Y-%m-%d-%H:%M:%S") "\""))) + (unless preface + (case type ;; plot command + ('2d (dotimes (col num-cols) + (unless (and (equal type '2d) + (or (and ind (equal (+ 1 col) ind)) + (and deps (not (member (+ 1 col) deps))))) + (setf plot-lines + (cons + (format plot-str data-file + (or (and ind (> ind 0) + (not text-ind) + (format "%d:" ind)) "") + (+ 1 col) + (if text-ind (format ":xticlabel(%d)" ind) "") + with + (or (nth col col-labels) (format "%d" (+ 1 col)))) + plot-lines))))) + ('3d + (setq plot-lines (list (format "'%s' matrix with %s title ''" + data-file with)))) + ('grid + (setq plot-lines (list (format "'%s' with %s title ''" + data-file with))))) + (funcall ats + (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n ")))) + script)) + +;;----------------------------------------------------------------------------- +;; facade functions +;;;###autoload +(defun org-plot/gnuplot (&optional params) + "Plot table using gnuplot. Gnuplot options can be specified with PARAMS. +If not given options will be taken from the +PLOT +line directly before or after the table." + (interactive) + (require 'gnuplot) + (save-window-excursion + (delete-other-windows) + (when (get-buffer "*gnuplot*") ;; reset *gnuplot* if it already running + (with-current-buffer "*gnuplot*" + (goto-char (point-max)))) + (org-plot/goto-nearest-table) + ;; set default options + (mapc + (lambda (pair) + (unless (plist-member params (car pair)) + (setf params (plist-put params (car pair) (cdr pair))))) + org-plot/gnuplot-default-options) + ;; collect table and table information + (let* ((data-file (make-temp-file "org-plot")) + (table (org-table-to-lisp)) + (num-cols (length (if (eq (first table) 'hline) (second table) + (first table))))) + (run-with-idle-timer 0.1 nil #'delete-file data-file) + (while (equal 'hline (first table)) (setf table (cdr table))) + (when (equal (second table) 'hline) + (setf params (plist-put params :labels (first table))) ;; headers to labels + (setf table (delq 'hline (cdr table)))) ;; clean non-data from table + ;; collect options + (save-excursion (while (and (equal 0 (forward-line -1)) + (looking-at "[[:space:]]*#\\+")) + (setf params (org-plot/collect-options params)))) + ;; dump table to datafile (very different for grid) + (case (plist-get params :plot-type) + ('2d (org-plot/gnuplot-to-data table data-file params)) + ('3d (org-plot/gnuplot-to-data table data-file params)) + ('grid (let ((y-labels (org-plot/gnuplot-to-grid-data + table data-file params))) + (when y-labels (plist-put params :ylabels y-labels))))) + ;; check for timestamp ind column + (let ((ind (- (plist-get params :ind) 1))) + (when (and (>= ind 0) (equal '2d (plist-get params :plot-type))) + (if (= (length + (delq 0 (mapcar + (lambda (el) + (if (string-match org-ts-regexp3 el) + 0 1)) + (mapcar (lambda (row) (nth ind row)) table)))) 0) + (plist-put params :timeind t) + ;; check for text ind column + (if (or (string= (plist-get params :with) "hist") + (> (length + (delq 0 (mapcar + (lambda (el) + (if (string-match org-table-number-regexp el) + 0 1)) + (mapcar (lambda (row) (nth ind row)) table)))) 0)) + (plist-put params :textind t))))) + ;; write script + (with-temp-buffer + (if (plist-get params :script) ;; user script + (progn (insert + (org-plot/gnuplot-script data-file num-cols params t)) + (insert "\n") + (insert-file-contents (plist-get params :script)) + (goto-char (point-min)) + (while (re-search-forward "$datafile" nil t) + (replace-match data-file nil nil))) + (insert + (org-plot/gnuplot-script data-file num-cols params))) + ;; graph table + (gnuplot-mode) + (gnuplot-send-buffer-to-gnuplot)) + ;; cleanup + (bury-buffer (get-buffer "*gnuplot*"))))) + +(provide 'org-plot) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-plot.el ends here diff --git a/elpa/org-20150427/org-protocol.el b/elpa/org-20150427/org-protocol.el new file mode 100644 index 00000000..0c6f2de3 --- /dev/null +++ b/elpa/org-20150427/org-protocol.el @@ -0,0 +1,638 @@ +;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions. +;; +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. +;; +;; Authors: Bastien Guerry <bzg@gnu.org> +;; Daniel M German <dmg AT uvic DOT org> +;; Sebastian Rose <sebastian_rose AT gmx DOT de> +;; Ross Patterson <me AT rpatterson DOT net> +;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de> +;; Keywords: org, emacsclient, wp + +;; 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: +;; +;; Intercept calls from emacsclient to trigger custom actions. +;; +;; This is done by advising `server-visit-files' to scan the list of filenames +;; for `org-protocol-the-protocol' and sub-protocols defined in +;; `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'. +;; +;; Any application that supports calling external programs with an URL +;; as argument may be used with this functionality. +;; +;; +;; Usage: +;; ------ +;; +;; 1.) Add this to your init file (.emacs probably): +;; +;; (add-to-list 'load-path "/path/to/org-protocol/") +;; (require 'org-protocol) +;; +;; 3.) Ensure emacs-server is up and running. +;; 4.) Try this from the command line (adjust the URL as needed): +;; +;; $ emacsclient \ +;; org-protocol://store-link://http:%2F%2Flocalhost%2Findex.html/The%20title +;; +;; 5.) Optionally add custom sub-protocols and handlers: +;; +;; (setq org-protocol-protocol-alist +;; '(("my-protocol" +;; :protocol "my-protocol" +;; :function my-protocol-handler-function))) +;; +;; A "sub-protocol" will be found in URLs like this: +;; +;; org-protocol://sub-protocol://data +;; +;; If it works, you can now setup other applications for using this feature. +;; +;; +;; As of March 2009 Firefox users follow the steps documented on +;; http://kb.mozillazine.org/Register_protocol, Opera setup is described here: +;; http://www.opera.com/support/kb/view/535/ +;; +;; +;; Documentation +;; ------------- +;; +;; org-protocol.el comes with and installs handlers to open sources of published +;; online content, store and insert the browser's URLs and cite online content +;; by clicking on a bookmark in Firefox, Opera and probably other browsers and +;; applications: +;; +;; * `org-protocol-open-source' uses the sub-protocol \"open-source\" and maps +;; URLs to local filenames defined in `org-protocol-project-alist'. +;; +;; * `org-protocol-store-link' stores an Org-link (if Org-mode is present) and +;; pushes the browsers URL to the `kill-ring' for yanking. This handler is +;; triggered through the sub-protocol \"store-link\". +;; +;; * Call `org-protocol-capture' by using the sub-protocol \"capture\". If +;; Org-mode is loaded, Emacs will pop-up a capture buffer and fill the +;; template with the data provided. I.e. the browser's URL is inserted as an +;; Org-link of which the page title will be the description part. If text +;; was select in the browser, that text will be the body of the entry. +;; +;; You may use the same bookmark URL for all those standard handlers and just +;; adjust the sub-protocol used: +;; +;; location.href='org-protocol://sub-protocol://'+ +;; encodeURIComponent(location.href)+'/'+ +;; encodeURIComponent(document.title)+'/'+ +;; encodeURIComponent(window.getSelection()) +;; +;; The handler for the sub-protocol \"capture\" detects an optional template +;; char that, if present, triggers the use of a special template. +;; Example: +;; +;; location.href='org-protocol://sub-protocol://x/'+ ... +;; +;; use template ?x. +;; +;; Note, that using double slashes is optional from org-protocol.el's point of +;; view because emacsclient squashes the slashes to one. +;; +;; +;; provides: 'org-protocol +;; +;;; Code: + +(require 'org) +(eval-when-compile + (require 'cl)) + +(declare-function org-publish-get-project-from-filename "org-publish" + (filename &optional up)) +(declare-function server-edit "server" (&optional arg)) + +(define-obsolete-function-alias + 'org-protocol-unhex-compound 'org-link-unescape-compound + "2011-02-17") + +(define-obsolete-function-alias + 'org-protocol-unhex-string 'org-link-unescape + "2011-02-17") + +(define-obsolete-function-alias + 'org-protocol-unhex-single-byte-sequence + 'org-link-unescape-single-byte-sequence + "2011-02-17") + +(defgroup org-protocol nil + "Intercept calls from emacsclient to trigger custom actions. + +This is done by advising `server-visit-files' to scan the list of filenames +for `org-protocol-the-protocol' and sub-protocols defined in +`org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'." + :version "22.1" + :group 'convenience + :group 'org) + + +;;; Variables: + +(defconst org-protocol-protocol-alist-default + '(("org-capture" :protocol "capture" :function org-protocol-capture :kill-client t) + ("org-store-link" :protocol "store-link" :function org-protocol-store-link) + ("org-open-source" :protocol "open-source" :function org-protocol-open-source)) + "Default protocols to use. +See `org-protocol-protocol-alist' for a description of this variable.") + +(defconst org-protocol-the-protocol "org-protocol" + "This is the protocol to detect if org-protocol.el is loaded. +`org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold +the sub-protocols that trigger the required action. You will have to define +just one protocol handler OS-wide (MS-Windows) or per application (Linux). +That protocol handler should call emacsclient.") + +;;; User variables: + +(defcustom org-protocol-reverse-list-of-files t + "Non-nil means re-reverse the list of filenames passed on the command line. +The filenames passed on the command line are passed to the emacs-server in +reverse order. Set to t (default) to re-reverse the list, i.e. use the +sequence on the command line. If nil, the sequence of the filenames is +unchanged." + :group 'org-protocol + :type 'boolean) + +(defcustom org-protocol-project-alist nil + "Map URLs to local filenames for `org-protocol-open-source' (open-source). + +Each element of this list must be of the form: + + (module-name :property value property: value ...) + +where module-name is an arbitrary name. All the values are strings. + +Possible properties are: + + :online-suffix - the suffix to strip from the published URLs + :working-suffix - the replacement for online-suffix + :base-url - the base URL, e.g. http://www.example.com/project/ + Last slash required. + :working-directory - the local working directory. This is, what base-url will + be replaced with. + :redirects - A list of cons cells, each of which maps a regular + expression to match to a path relative to :working-directory. + +Example: + + (setq org-protocol-project-alist + '((\"http://orgmode.org/worg/\" + :online-suffix \".php\" + :working-suffix \".org\" + :base-url \"http://orgmode.org/worg/\" + :working-directory \"/home/user/org/Worg/\") + (\"http://localhost/org-notes/\" + :online-suffix \".html\" + :working-suffix \".org\" + :base-url \"http://localhost/org/\" + :working-directory \"/home/user/org/\" + :rewrites ((\"org/?$\" . \"index.php\"))))) + + The last line tells `org-protocol-open-source' to open + /home/user/org/index.php, if the URL cannot be mapped to an existing + file, and ends with either \"org\" or \"org/\". + +Consider using the interactive functions `org-protocol-create' and +`org-protocol-create-for-org' to help you filling this variable with valid contents." + :group 'org-protocol + :type 'alist) + +(defcustom org-protocol-protocol-alist nil + "Register custom handlers for org-protocol. + +Each element of this list must be of the form: + + (module-name :protocol protocol :function func :kill-client nil) + +protocol - protocol to detect in a filename without trailing colon and slashes. + See rfc1738 section 2.1 for more on this. + If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol' + will search filenames for \"org-protocol:/my-protocol:/\" + and trigger your action for every match. `org-protocol' is defined in + `org-protocol-the-protocol'. Double and triple slashes are compressed + to one by emacsclient. + +function - function that handles requests with protocol and takes exactly one + argument: the filename with all protocols stripped. If the function + returns nil, emacsclient and -server do nothing. Any non-nil return + value is considered a valid filename and thus passed to the server. + + `org-protocol.el provides some support for handling those filenames, + if you stay with the conventions used for the standard handlers in + `org-protocol-protocol-alist-default'. See `org-protocol-split-data'. + +kill-client - If t, kill the client immediately, once the sub-protocol is + detected. This is necessary for actions that can be interrupted by + `C-g' to avoid dangling emacsclients. Note, that all other command + line arguments but the this one will be discarded, greedy handlers + still receive the whole list of arguments though. + +Here is an example: + + (setq org-protocol-protocol-alist + '((\"my-protocol\" + :protocol \"my-protocol\" + :function my-protocol-handler-function) + (\"your-protocol\" + :protocol \"your-protocol\" + :function your-protocol-handler-function)))" + :group 'org-protocol + :type '(alist)) + +(defcustom org-protocol-default-template-key nil + "The default template key to use. +This is usually a single character string but can also be a +string with two characters." + :group 'org-protocol + :type '(choice (const nil) (string))) + +(defcustom org-protocol-data-separator "/+\\|\\?" + "The default data separator to use. + This should be a single regexp string." + :group 'org-protocol + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +;;; Helper functions: + +(defun org-protocol-sanitize-uri (uri) + "emacsclient compresses double and triple slashes. +Slashes are sanitized to double slashes here." + (when (string-match "^\\([a-z]+\\):/" uri) + (let* ((splitparts (split-string uri "/+"))) + (setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/"))))) + uri) + +(defun org-protocol-split-data (data &optional unhexify separator) + "Split what an org-protocol handler function gets as only argument. +DATA is that one argument. DATA is split at each occurrence of +SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is +nil, assume \"/+\". The results of that splitting are returned +as a list. If UNHEXIFY is non-nil, hex-decode each split part. +If UNHEXIFY is a function, use that function to decode each split +part." + (let* ((sep (or separator "/+\\|\\?")) + (split-parts (split-string data sep))) + (if unhexify + (if (fboundp unhexify) + (mapcar unhexify split-parts) + (mapcar 'org-link-unescape split-parts)) + split-parts))) + +(defun org-protocol-flatten-greedy (param-list &optional strip-path replacement) + "Greedy handlers might receive a list like this from emacsclient: + '((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") +where \"/dir/\" is the absolute path to emacsclients working directory. This +function transforms it into a flat list using `org-protocol-flatten' and +transforms the elements of that list as follows: + +If strip-path is non-nil, remove the \"/dir/\" prefix from all members of +param-list. + +If replacement is string, replace the \"/dir/\" prefix with it. + +The first parameter, the one that contains the protocols, is always changed. +Everything up to the end of the protocols is stripped. + +Note, that this function will always behave as if +`org-protocol-reverse-list-of-files' was set to t and the returned list will +reflect that. I.e. emacsclients first parameter will be the first one in the +returned list." + (let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files + param-list + (reverse param-list)))) + (trigger (car l)) + (len 0) + dir + ret) + (when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger) + (setq dir (match-string 1 trigger)) + (setq len (length dir)) + (setcar l (concat dir (match-string 3 trigger)))) + (if strip-path + (progn + (dolist (e l ret) + (setq ret + (append ret + (list + (if (stringp e) + (if (stringp replacement) + (setq e (concat replacement (substring e len))) + (setq e (substring e len))) + e))))) + ret) + l))) + +(defun org-protocol-flatten (l) + "Greedy handlers might receive a list like this from emacsclient: + '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") +where \"/dir/\" is the absolute path to emacsclients working directory. +This function transforms it into a flat list." + (if (null l) () + (if (listp l) + (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l))) + (list l)))) + + +;;; Standard protocol handlers: + +(defun org-protocol-store-link (fname) + "Process an org-protocol://store-link:// style url. +Additionally store a browser URL as an org link. Also pushes the +link's URL to the `kill-ring'. + +The location for a browser's bookmark has to look like this: + + javascript:location.href='org-protocol://store-link://'+ \\ + encodeURIComponent(location.href) + encodeURIComponent(document.title)+'/'+ \\ + +Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page +could contain slashes and the location definitely will. + +The sub-protocol used to reach this function is set in +`org-protocol-protocol-alist'." + (let* ((splitparts (org-protocol-split-data fname t org-protocol-data-separator)) + (uri (org-protocol-sanitize-uri (car splitparts))) + (title (cadr splitparts)) + orglink) + (if (boundp 'org-stored-links) + (setq org-stored-links (cons (list uri title) org-stored-links))) + (kill-new uri) + (message "`%s' to insert new org-link, `%s' to insert `%s'" + (substitute-command-keys"\\[org-insert-link]") + (substitute-command-keys"\\[yank]") + uri)) + nil) + +(defun org-protocol-capture (info) + "Process an org-protocol://capture:// style url. + +The sub-protocol used to reach this function is set in +`org-protocol-protocol-alist'. + +This function detects an URL, title and optional text, separated +by '/'. The location for a browser's bookmark looks like this: + + javascript:location.href='org-protocol://capture://'+ \\ + encodeURIComponent(location.href)+'/' \\ + encodeURIComponent(document.title)+'/'+ \\ + encodeURIComponent(window.getSelection()) + +By default, it uses the character `org-protocol-default-template-key', +which should be associated with a template in `org-capture-templates'. +But you may prepend the encoded URL with a character and a slash like so: + + javascript:location.href='org-protocol://capture://b/'+ ... + +Now template ?b will be used." + (if (and (boundp 'org-stored-links) + (org-protocol-do-capture info)) + (message "Item captured.")) + nil) + +(defun org-protocol-convert-query-to-plist (query) + "Convert query string that is part of url to property list." + (if query + (apply 'append (mapcar (lambda (x) + (let ((c (split-string x "="))) + (list (intern (concat ":" (car c))) (cadr c)))) + (split-string query "&"))))) + +(defun org-protocol-do-capture (info) + "Support `org-capture'." + (let* ((parts (org-protocol-split-data info t org-protocol-data-separator)) + (template (or (and (>= 2 (length (car parts))) (pop parts)) + org-protocol-default-template-key)) + (url (org-protocol-sanitize-uri (car parts))) + (type (if (string-match "^\\([a-z]+\\):" url) + (match-string 1 url))) + (title (or (cadr parts) "")) + (region (or (caddr parts) "")) + (orglink (org-make-link-string + url (if (string-match "[^[:space:]]" title) title url))) + (query (or (org-protocol-convert-query-to-plist (cadddr parts)) "")) + (org-capture-link-is-already-stored t)) ;; avoid call to org-store-link + (setq org-stored-links + (cons (list url title) org-stored-links)) + (kill-new orglink) + (org-store-link-props :type type + :link url + :description title + :annotation orglink + :initial region + :query query) + (raise-frame) + (funcall 'org-capture nil template))) + +(defun org-protocol-open-source (fname) + "Process an org-protocol://open-source:// style url. + +Change a filename by mapping URLs to local filenames as set +in `org-protocol-project-alist'. + +The location for a browser's bookmark should look like this: + + javascript:location.href='org-protocol://open-source://'+ \\ + encodeURIComponent(location.href)" + ;; As we enter this function for a match on our protocol, the return value + ;; defaults to nil. + (let ((result nil) + (f (org-link-unescape fname))) + (catch 'result + (dolist (prolist org-protocol-project-alist) + (let* ((base-url (plist-get (cdr prolist) :base-url)) + (wsearch (regexp-quote base-url))) + + (when (string-match wsearch f) + (let* ((wdir (plist-get (cdr prolist) :working-directory)) + (strip-suffix (plist-get (cdr prolist) :online-suffix)) + (add-suffix (plist-get (cdr prolist) :working-suffix)) + ;; Strip "[?#].*$" if `f' is a redirect with another + ;; ending than strip-suffix here: + (f1 (substring f 0 (string-match "\\([\\?#].*\\)?$" f))) + (start-pos (+ (string-match wsearch f1) (length base-url))) + (end-pos (string-match + (regexp-quote strip-suffix) f1)) + ;; We have to compare redirects without suffix below: + (f2 (concat wdir (substring f1 start-pos end-pos))) + (the-file (concat f2 add-suffix))) + + ;; Note: the-file may still contain `%C3' et al here because browsers + ;; tend to encode `ä' in URLs to `%25C3' - `%25' being `%'. + ;; So the results may vary. + + ;; -- start redirects -- + (unless (file-exists-p the-file) + (message "File %s does not exist.\nTesting for rewritten URLs." the-file) + (let ((rewrites (plist-get (cdr prolist) :rewrites))) + (when rewrites + (message "Rewrites found: %S" rewrites) + (mapc + (lambda (rewrite) + "Try to match a rewritten URL and map it to a real file." + ;; Compare redirects without suffix: + (if (string-match (car rewrite) f2) + (throw 'result (concat wdir (cdr rewrite))))) + rewrites)))) + ;; -- end of redirects -- + + (if (file-readable-p the-file) + (throw 'result the-file)) + (if (file-exists-p the-file) + (message "%s: permission denied!" the-file) + (message "%s: no such file or directory." the-file)))))) + result))) + + +;;; Core functions: + +(defun org-protocol-check-filename-for-protocol (fname restoffiles client) + "Detect if `org-protocol-the-protocol' and a known sub-protocol is used in fname. +Sub-protocols are registered in `org-protocol-protocol-alist' and +`org-protocol-protocol-alist-default'. +This is, how the matching is done: + + (string-match \"protocol:/+sub-protocol:/+\" ...) + +protocol and sub-protocol are regexp-quoted. + +If a matching protocol is found, the protocol is stripped from fname and the +result is passed to the protocols function as the only parameter. If the +function returns nil, the filename is removed from the list of filenames +passed from emacsclient to the server. +If the function returns a non nil value, that value is passed to the server +as filename." + (let ((sub-protocols (append org-protocol-protocol-alist + org-protocol-protocol-alist-default))) + (catch 'fname + (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+"))) + (when (string-match the-protocol fname) + (dolist (prolist sub-protocols) + (let ((proto (concat the-protocol + (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+"))) + (when (string-match proto fname) + (let* ((func (plist-get (cdr prolist) :function)) + (greedy (plist-get (cdr prolist) :greedy)) + (split (split-string fname proto)) + (result (if greedy restoffiles (cadr split)))) + (when (plist-get (cdr prolist) :kill-client) + (message "Greedy org-protocol handler. Killing client.") + (server-edit)) + (when (fboundp func) + (unless greedy + (throw 'fname (funcall func result))) + (funcall func result) + (throw 'fname t)))))))) + ;; (message "fname: %s" fname) + fname))) + +(defadvice server-visit-files (before org-protocol-detect-protocol-server activate) + "Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'." + (let ((flist (if org-protocol-reverse-list-of-files + (reverse (ad-get-arg 0)) + (ad-get-arg 0))) + (client (ad-get-arg 1))) + (catch 'greedy + (dolist (var flist) + ;; `\' to `/' on windows. FIXME: could this be done any better? + (let ((fname (expand-file-name (car var)))) + (setq fname (org-protocol-check-filename-for-protocol + fname (member var flist) client)) + (if (eq fname t) ;; greedy? We need the `t' return value. + (progn + (ad-set-arg 0 nil) + (throw 'greedy t)) + (if (stringp fname) ;; probably filename + (setcar var fname) + (ad-set-arg 0 (delq var (ad-get-arg 0)))))))))) + +;;; Org specific functions: + +(defun org-protocol-create-for-org () + "Create a org-protocol project for the current file's Org-mode project. +The visited file needs to be part of a publishing project in +`org-publish-project-alist' for this to work. The function +delegates most of the work to `org-protocol-create'." + (interactive) + (require 'org-publish) + (let ((all (or (org-publish-get-project-from-filename buffer-file-name)))) + (if all (org-protocol-create (cdr all)) + (message "Not in an org-project. Did mean %s?" + (substitute-command-keys"\\[org-protocol-create]"))))) + +(defun org-protocol-create (&optional project-plist) + "Create a new org-protocol project interactively. +An org-protocol project is an entry in +`org-protocol-project-alist' which is used by +`org-protocol-open-source'. Optionally use PROJECT-PLIST to +initialize the defaults for this project. If PROJECT-PLIST is +the cdr of an element in `org-publish-project-alist', reuse +:base-directory, :html-extension and :base-extension." + (interactive) + (let ((working-dir (expand-file-name + (or (plist-get project-plist :base-directory) + default-directory))) + (base-url "http://orgmode.org/worg/") + (strip-suffix (or (plist-get project-plist :html-extension) ".html")) + (working-suffix (if (plist-get project-plist :base-extension) + (concat "." (plist-get project-plist :base-extension)) + ".org")) + (worglet-buffer nil) + (insert-default-directory t) + (minibuffer-allow-text-properties nil)) + + (setq base-url (read-string "Base URL of published content: " base-url nil base-url t)) + (if (not (string-match "\\/$" base-url)) + (setq base-url (concat base-url "/"))) + + (setq working-dir + (expand-file-name + (read-directory-name "Local working directory: " working-dir working-dir t))) + (if (not (string-match "\\/$" working-dir)) + (setq working-dir (concat working-dir "/"))) + + (setq strip-suffix + (read-string + (concat "Extension to strip from published URLs (" strip-suffix "): ") + strip-suffix nil strip-suffix t)) + + (setq working-suffix + (read-string + (concat "Extension of editable files (" working-suffix "): ") + working-suffix nil working-suffix t)) + + (when (yes-or-no-p "Save the new org-protocol-project to your init file? ") + (setq org-protocol-project-alist + (cons `(,base-url . (:base-url ,base-url + :working-directory ,working-dir + :online-suffix ,strip-suffix + :working-suffix ,working-suffix)) + org-protocol-project-alist)) + (customize-save-variable 'org-protocol-project-alist org-protocol-project-alist)))) + +(provide 'org-protocol) + +;;; org-protocol.el ends here diff --git a/elpa/org-20150427/org-rmail.el b/elpa/org-20150427/org-rmail.el new file mode 100644 index 00000000..6859b659 --- /dev/null +++ b/elpa/org-20150427/org-rmail.el @@ -0,0 +1,123 @@ +;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: + +;; This file implements links to Rmail messages from within Org-mode. +;; Org-mode loads this module by default - if this is not what you want, +;; configure the variable `org-modules'. + +;;; Code: + +(require 'org) + +;; Declare external functions and variables +(declare-function rmail-show-message "rmail" (&optional n no-summary)) +(declare-function rmail-what-message "rmail" (&optional pos)) +(declare-function rmail-toggle-header "rmail" (&optional arg)) +(declare-function rmail-widen "rmail" ()) +(defvar rmail-current-message) ; From rmail.el +(defvar rmail-header-style) ; From rmail.el + +;; Install the link type +(org-add-link-type "rmail" 'org-rmail-open) +(add-hook 'org-store-link-functions 'org-rmail-store-link) + +;; Implementation +(defun org-rmail-store-link () + "Store a link to an Rmail folder or message." + (when (or (eq major-mode 'rmail-mode) + (eq major-mode 'rmail-summary-mode)) + (save-window-excursion + (save-restriction + (when (eq major-mode 'rmail-summary-mode) + (rmail-show-message rmail-current-message)) + (when (fboundp 'rmail-narrow-to-non-pruned-header) + (rmail-narrow-to-non-pruned-header)) + (when (eq rmail-header-style 'normal) + (rmail-toggle-header -1)) + (let* ((folder buffer-file-name) + (message-id (mail-fetch-field "message-id")) + (from (mail-fetch-field "from")) + (to (mail-fetch-field "to")) + (subject (mail-fetch-field "subject")) + (date (mail-fetch-field "date")) + (date-ts (and date (format-time-string + (org-time-stamp-format t) + (date-to-time date)))) + (date-ts-ia (and date (format-time-string + (org-time-stamp-format t t) + (date-to-time date)))) + desc link) + (org-store-link-props + :type "rmail" :from from :to to + :subject subject :message-id message-id) + (when date + (org-add-link-props :date date :date-timestamp date-ts + :date-timestamp-inactive date-ts-ia)) + (setq message-id (org-remove-angle-brackets message-id)) + (setq desc (org-email-link-description)) + (setq link (concat "rmail:" folder "#" message-id)) + (org-add-link-props :link link :description desc) + (rmail-show-message rmail-current-message) + link))))) + +(defun org-rmail-open (path) + "Follow an Rmail message link to the specified PATH." + (let (folder article) + (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) + (error "Error in Rmail link")) + (setq folder (match-string 1 path) + article (match-string 3 path)) + (org-rmail-follow-link folder article))) + +(defun org-rmail-follow-link (folder article) + "Follow an Rmail link to FOLDER and ARTICLE." + (require 'rmail) + (cond ((null article) (setq article "")) + ((stringp article) + (setq article (org-add-angle-brackets article))) + (t (user-error "Wrong RMAIL link format"))) + (let (message-number) + (save-excursion + (save-window-excursion + (rmail (if (string= folder "RMAIL") rmail-file-name folder)) + (setq message-number + (save-restriction + (rmail-widen) + (goto-char (point-max)) + (if (re-search-backward + (concat "^Message-ID:\\s-+" (regexp-quote article)) + nil t) + (rmail-what-message)))))) + (if message-number + (progn + (rmail (if (string= folder "RMAIL") rmail-file-name folder)) + (rmail-show-message message-number) + message-number) + (error "Message not found")))) + +(provide 'org-rmail) + +;;; org-rmail.el ends here diff --git a/elpa/org-20150427/org-src.el b/elpa/org-20150427/org-src.el new file mode 100644 index 00000000..618ed9fb --- /dev/null +++ b/elpa/org-20150427/org-src.el @@ -0,0 +1,961 @@ +;;; org-src.el --- Source code examples in Org +;; +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Bastien Guerry <bzg@gnu.org> +;; Dan Davison <davison at stats dot ox dot ac dot uk> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: + +;; This file contains the code dealing with source code examples in Org-mode. + +;;; Code: + +(require 'org-macs) +(require 'org-compat) +(require 'ob-keys) +(require 'ob-comint) +(eval-when-compile + (require 'cl)) + +(declare-function org-do-remove-indentation "org" (&optional n)) +(declare-function org-at-table.el-p "org" ()) +(declare-function org-in-src-block-p "org" (&optional inside)) +(declare-function org-in-block-p "org" (names)) +(declare-function org-get-indentation "org" (&optional line)) +(declare-function org-switch-to-buffer-other-window "org" (&rest args)) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) +(declare-function org-base-buffer "org" (buffer)) + +(defcustom org-edit-src-region-extra nil + "Additional regexps to identify regions for editing with `org-edit-src-code'. +For examples see the function `org-edit-src-find-region-and-lang'. +The regular expression identifying the begin marker should end with a newline, +and the regexp marking the end line should start with a newline, to make sure +there are kept outside the narrowed region." + :group 'org-edit-structure + :type '(repeat + (list + (regexp :tag "begin regexp") + (regexp :tag "end regexp") + (choice :tag "language" + (string :tag "specify") + (integer :tag "from match group") + (const :tag "from `lang' element") + (const :tag "from `style' element"))))) + +(defcustom org-edit-src-turn-on-auto-save nil + "Non-nil means turn `auto-save-mode' on when editing a source block. +This will save the content of the source code editing buffer into +a newly created file, not the base buffer for this source block. + +If you want to regularly save the base buffer instead of the source +code editing buffer, see `org-edit-src-auto-save-idle-delay' instead." + :group 'org-edit-structure + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-edit-src-auto-save-idle-delay 0 + "Delay before saving a source code buffer back into its base buffer. +When a positive integer N, save after N seconds of idle time. +When 0 (the default), don't auto-save. + +If you want to save the source code buffer itself, don't use this. +Check `org-edit-src-turn-on-auto-save' instead." + :group 'org-edit-structure + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +(defcustom org-coderef-label-format "(ref:%s)" + "The default coderef format. +This format string will be used to search for coderef labels in literal +examples (EXAMPLE and SRC blocks). The format can be overwritten in +an individual literal example with the -l option, like + +#+BEGIN_SRC pascal +n -r -l \"((%s))\" +... +#+END_SRC + +If you want to use this for HTML export, make sure that the format does +not introduce special font-locking, and avoid the HTML special +characters `<', `>', and `&'. The reason for this restriction is that +the labels are searched for only after htmlize has done its job." + :group 'org-edit-structure ; FIXME this is not in the right group + :type 'string) + +(defcustom org-edit-fixed-width-region-mode 'artist-mode + "The mode that should be used to edit fixed-width regions. +These are the regions where each line starts with a colon." + :group 'org-edit-structure + :type '(choice + (const artist-mode) + (const picture-mode) + (const fundamental-mode) + (function :tag "Other (specify)"))) + +(defcustom org-src-preserve-indentation nil + "If non-nil preserve leading whitespace characters on export. +If non-nil leading whitespace characters in source code blocks +are preserved on export, and when switching between the org +buffer and the language mode edit buffer. If this variable is nil +then, after editing with \\[org-edit-src-code], the +minimum (across-lines) number of leading whitespace characters +are removed from all lines, and the code block is uniformly +indented according to the value of `org-edit-src-content-indentation'." + :group 'org-edit-structure + :type 'boolean) + +(defcustom org-edit-src-content-indentation 2 + "Indentation for the content of a source code block. +This should be the number of spaces added to the indentation of the #+begin +line in order to compute the indentation of the block content after +editing it with \\[org-edit-src-code]. Has no effect if +`org-src-preserve-indentation' is non-nil." + :group 'org-edit-structure + :type 'integer) + +(defvar org-src-strip-leading-and-trailing-blank-lines nil + "If non-nil, blank lines are removed when exiting the code edit buffer.") + +(defcustom org-edit-src-persistent-message t + "Non-nil means show persistent exit help message while editing src examples. +The message is shown in the header-line, which will be created in the +first line of the window showing the editing buffer." + :group 'org-edit-structure + :type 'boolean) + +(defcustom org-src-window-setup 'reorganize-frame + "How the source code edit buffer should be displayed. +Possible values for this option are: + +current-window Show edit buffer in the current window, keeping all other + windows. +other-window Use `switch-to-buffer-other-window' to display edit buffer. +reorganize-frame Show only two windows on the current frame, the current + window and the edit buffer. When exiting the edit buffer, + return to one window. +other-frame Use `switch-to-buffer-other-frame' to display edit buffer. + Also, when exiting the edit buffer, kill that frame." + :group 'org-edit-structure + :type '(choice + (const current-window) + (const other-frame) + (const other-window) + (const reorganize-frame))) + +(defvar org-src-mode-hook nil + "Hook run after Org switched a source code snippet to its Emacs mode. +This hook will run + +- when editing a source code snippet with \"C-c '\". +- When formatting a source code snippet for export with htmlize. + +You may want to use this hook for example to turn off `outline-minor-mode' +or similar things which you want to have when editing a source code file, +but which mess up the display of a snippet in Org exported files.") + +(defcustom org-src-lang-modes + '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist) + ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql) + ("calc" . fundamental) ("C" . c) ("cpp" . c++) ("C++" . c++) + ("screen" . shell-script)) + "Alist mapping languages to their major mode. +The key is the language name, the value is the string that should +be inserted as the name of the major mode. For many languages this is +simple, but for language where this is not the case, this variable +provides a way to simplify things on the user side. +For example, there is no ocaml-mode in Emacs, but the mode to use is +`tuareg-mode'." + :group 'org-edit-structure + :type '(repeat + (cons + (string "Language name") + (symbol "Major mode")))) + +;;; Editing source examples + +(defvar org-src-mode-map (make-sparse-keymap)) +(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) +(define-key org-src-mode-map "\C-c\C-k" 'org-edit-src-abort) +(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save) + +(defvar org-edit-src-force-single-line nil) +(defvar org-edit-src-from-org-mode nil) +(defvar org-edit-src-allow-write-back-p t) +(defvar org-edit-src-picture nil) +(defvar org-edit-src-beg-marker nil) +(defvar org-edit-src-end-marker nil) +(defvar org-edit-src-overlay nil) +(defvar org-edit-src-block-indentation nil) +(defvar org-edit-src-saved-temp-window-config nil) + +(defcustom org-src-ask-before-returning-to-edit-buffer t + "If nil, when org-edit-src code is used on a block that already +has an active edit buffer, it will switch to that edit buffer +immediately; otherwise it will ask whether you want to return to +the existing edit buffer." + :group 'org-edit-structure + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defvar org-src-babel-info nil) + +(define-minor-mode org-src-mode + "Minor mode for language major mode buffers generated by org. +This minor mode is turned on in two situations: +- when editing a source code snippet with \"C-c '\". +- When formatting a source code snippet for export with htmlize. +There is a mode hook, and keybindings for `org-edit-src-exit' and +`org-edit-src-save'") + +(defvar org-edit-src-code-timer nil) +(defun org-edit-src-code (&optional context code edit-buffer-name) + "Edit the source CODE block at point. +The code is copied to a separate buffer and the appropriate mode +is turned on. When done, exit with \\[org-edit-src-exit]. This will +remove the original code in the Org buffer, and replace it with the +edited version. An optional argument CONTEXT is used by \\[org-edit-src-save] +when calling this function. See `org-src-window-setup' to configure +the display of windows containing the Org buffer and the code buffer." + (interactive) + (if (not (or (org-in-block-p '("src" "example" "latex" "html")) + (org-at-table.el-p))) + (user-error "Not in a source code or example block") + (unless (eq context 'save) + (setq org-edit-src-saved-temp-window-config (current-window-configuration))) + (let* ((mark (and (org-region-active-p) (mark))) + (case-fold-search t) + (info + ;; If the src region consists in no lines, we insert a blank + ;; line. + (let* ((temp (org-edit-src-find-region-and-lang)) + (beg (nth 0 temp)) + (end (nth 1 temp))) + (if (>= end beg) temp + (goto-char beg) + (insert "\n") + (org-edit-src-find-region-and-lang)))) + (full-info (org-babel-get-src-block-info 'light)) + (org-mode-p (derived-mode-p 'org-mode)) ;; derived-mode-p is reflexive + (beg (make-marker)) + ;; Move marker with inserted text for case when src block is + ;; just one empty line, i.e. beg == end. + (end (copy-marker (make-marker) t)) + (allow-write-back-p (null code)) + block-nindent total-nindent ovl lang lang-f single lfmt buffer msg + begline markline markcol line col transmitted-variables) + (setq beg (move-marker beg (nth 0 info)) + end (move-marker end (nth 1 info)) + msg (if allow-write-back-p + (substitute-command-keys + "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort") + "Exit with C-c ' (C-c and single quote) -- C-c C-k to abort") + code (or code (buffer-substring-no-properties beg end)) + lang (or (cdr (assoc (nth 2 info) org-src-lang-modes)) + (nth 2 info)) + lang (if (symbolp lang) (symbol-name lang) lang) + single (nth 3 info) + block-nindent (nth 5 info) + lang-f (intern (concat lang "-mode")) + begline (save-excursion (goto-char beg) (org-current-line)) + transmitted-variables + `((org-edit-src-content-indentation + ,org-edit-src-content-indentation) + (org-edit-src-force-single-line ,single) + (org-edit-src-from-org-mode ,org-mode-p) + (org-edit-src-allow-write-back-p ,allow-write-back-p) + (org-src-preserve-indentation ,org-src-preserve-indentation) + (org-src-babel-info ,(org-babel-get-src-block-info 'light)) + (org-coderef-label-format + ,(or (nth 4 info) org-coderef-label-format)) + (org-edit-src-beg-marker ,beg) + (org-edit-src-end-marker ,end) + (org-edit-src-block-indentation ,block-nindent))) + (if (and mark (>= mark beg) (<= mark (1+ end))) + (save-excursion (goto-char (min mark end)) + (setq markline (org-current-line) + markcol (current-column)))) + (if (equal lang-f 'table.el-mode) + (setq lang-f (lambda () + (text-mode) + (if (org-bound-and-true-p flyspell-mode) + (flyspell-mode -1)) + (table-recognize) + (org-set-local 'org-edit-src-content-indentation 0)))) + (unless (functionp lang-f) + (error "No such language mode: %s" lang-f)) + (save-excursion + (if (> (point) end) (goto-char end)) + (setq line (org-current-line) + col (current-column))) + (if (and (setq buffer (org-edit-src-find-buffer beg end)) + (or (eq context 'save) + (if org-src-ask-before-returning-to-edit-buffer + (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ") t))) + (org-src-switch-to-buffer buffer 'return) + (when buffer + (with-current-buffer buffer + (if (boundp 'org-edit-src-overlay) + (delete-overlay org-edit-src-overlay))) + (kill-buffer buffer)) + (setq buffer (generate-new-buffer + (or edit-buffer-name + (org-src-construct-edit-buffer-name (buffer-name) lang)))) + (setq ovl (make-overlay beg end)) + (overlay-put ovl 'edit-buffer buffer) + (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") + (overlay-put ovl 'face 'secondary-selection) + (overlay-put ovl + 'keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'org-edit-src-continue) + map)) + (overlay-put ovl :read-only "Leave me alone") + (setq transmitted-variables + (append transmitted-variables `((org-edit-src-overlay ,ovl)))) + (org-src-switch-to-buffer buffer 'edit) + (if (eq single 'macro-definition) + (setq code (replace-regexp-in-string "\\\\n" "\n" code t t))) + (insert code) + (remove-text-properties (point-min) (point-max) + '(display nil invisible nil intangible nil)) + (unless (cadr (assq 'org-src-preserve-indentation transmitted-variables)) + (setq total-nindent (or (org-do-remove-indentation) 0))) + (let ((org-inhibit-startup t)) + (condition-case e + (funcall lang-f) + (error + (message "Language mode `%s' fails with: %S" lang-f (nth 1 e))))) + (dolist (pair transmitted-variables) + (org-set-local (car pair) (cadr pair))) + ;; Remove protecting commas from visible part of buffer. + (org-unescape-code-in-region (point-min) (point-max)) + (when markline + (org-goto-line (1+ (- markline begline))) + (org-move-to-column + (if org-src-preserve-indentation markcol + (max 0 (- markcol total-nindent)))) + (push-mark (point) 'no-message t) + (setq deactivate-mark nil)) + (org-goto-line (1+ (- line begline))) + (org-move-to-column + (if org-src-preserve-indentation col (max 0 (- col total-nindent)))) + (org-src-mode) + (set-buffer-modified-p nil) + (setq buffer-file-name nil) + (when org-edit-src-turn-on-auto-save + (setq buffer-auto-save-file-name + (concat (make-temp-name "org-src-") + (format-time-string "-%Y-%d-%m") ".txt"))) + (and org-edit-src-persistent-message + (org-set-local 'header-line-format msg)) + (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) + (when (fboundp edit-prep-func) + (funcall edit-prep-func full-info))) + (or org-edit-src-code-timer + (zerop org-edit-src-auto-save-idle-delay) + (setq org-edit-src-code-timer + (run-with-idle-timer + org-edit-src-auto-save-idle-delay t + (lambda () + (cond + ((org-string-match-p "\\`\\*Org Src" (buffer-name)) + (when (buffer-modified-p) (org-edit-src-save))) + ((not (org-some (lambda (b) + (org-string-match-p "\\`\\*Org Src" + (buffer-name b))) + (buffer-list))) + (cancel-timer org-edit-src-code-timer) + (setq org-edit-src-code-timer nil)))))))) + t))) + +(defun org-edit-src-continue (e) + "Continue editing source blocks." ;; Fixme: be more accurate + (interactive "e") + (mouse-set-point e) + (let ((buf (get-char-property (point) 'edit-buffer))) + (if buf (org-src-switch-to-buffer buf 'continue) + (error "Something is wrong here")))) + +(defun org-src-switch-to-buffer (buffer context) + (case org-src-window-setup + ('current-window + (org-pop-to-buffer-same-window buffer)) + ('other-window + (switch-to-buffer-other-window buffer)) + ('other-frame + (case context + ('exit + (let ((frame (selected-frame))) + (switch-to-buffer-other-frame buffer) + (delete-frame frame))) + ('save + (kill-buffer (current-buffer)) + (org-pop-to-buffer-same-window buffer)) + (t + (switch-to-buffer-other-frame buffer)))) + ('reorganize-frame + (if (eq context 'edit) (delete-other-windows)) + (org-switch-to-buffer-other-window buffer) + (if (eq context 'exit) (delete-other-windows))) + ('switch-invisibly + (set-buffer buffer)) + (t + (message "Invalid value %s for org-src-window-setup" + (symbol-name org-src-window-setup)) + (org-pop-to-buffer-same-window buffer)))) + +(defun org-src-construct-edit-buffer-name (org-buffer-name lang) + "Construct the buffer name for a source editing buffer." + (concat "*Org Src " org-buffer-name "[ " lang " ]*")) + +(defun org-src-edit-buffer-p (&optional buffer) + "Test whether BUFFER (or the current buffer if BUFFER is nil) +is a source block editing buffer." + (let ((buffer (org-base-buffer (or buffer (current-buffer))))) + (and (buffer-name buffer) + (string-match "\\`*Org Src " (buffer-name buffer)) + (local-variable-p 'org-edit-src-beg-marker buffer) + (local-variable-p 'org-edit-src-end-marker buffer)))) + +(defun org-edit-src-find-buffer (beg end) + "Find a source editing buffer that is already editing the region BEG to END." + (catch 'exit + (mapc + (lambda (b) + (with-current-buffer b + (if (and (string-match "\\`*Org Src " (buffer-name)) + (local-variable-p 'org-edit-src-beg-marker (current-buffer)) + (local-variable-p 'org-edit-src-end-marker (current-buffer)) + (equal beg org-edit-src-beg-marker) + (equal end org-edit-src-end-marker)) + (throw 'exit (current-buffer))))) + (buffer-list)) + nil)) + +(defun org-edit-fixed-width-region () + "Edit the fixed-width ascii drawing at point. +This must be a region where each line starts with a colon followed by +a space character. +An new buffer is created and the fixed-width region is copied into it, +and the buffer is switched into `artist-mode' for editing. When done, +exit with \\[org-edit-src-exit]. The edited text will then replace +the fragment in the Org-mode buffer." + (interactive) + (let ((line (org-current-line)) + (col (current-column)) + (case-fold-search t) + (msg (substitute-command-keys + "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort")) + (org-mode-p (derived-mode-p 'org-mode)) + (beg (make-marker)) + (end (make-marker)) + (preserve-indentation org-src-preserve-indentation) + block-nindent ovl beg1 end1 code begline buffer) + (beginning-of-line 1) + (if (looking-at "[ \t]*[^:\n \t]") + nil + (if (looking-at "[ \t]*\\(\n\\|\\'\\)") + (setq beg1 (point) end1 beg1) + (save-excursion + (if (re-search-backward "^[ \t]*[^: \t]" nil 'move) + (setq beg1 (point-at-bol 2)) + (setq beg1 (point)))) + (save-excursion + (if (re-search-forward "^[ \t]*[^: \t]" nil 'move) + (setq end1 (1- (match-beginning 0))) + (setq end1 (point)))) + (org-goto-line line)) + (setq beg (move-marker beg beg1) + end (move-marker end end1) + code (buffer-substring-no-properties beg end) + begline (save-excursion (goto-char beg) (org-current-line))) + (if (and (setq buffer (org-edit-src-find-buffer beg end)) + (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ")) + (org-pop-to-buffer-same-window buffer) + (when buffer + (with-current-buffer buffer + (if (boundp 'org-edit-src-overlay) + (delete-overlay org-edit-src-overlay))) + (kill-buffer buffer)) + (setq buffer (generate-new-buffer + (org-src-construct-edit-buffer-name + (buffer-name) "Fixed Width"))) + (setq ovl (make-overlay beg end)) + (overlay-put ovl 'face 'secondary-selection) + (overlay-put ovl 'edit-buffer buffer) + (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") + (overlay-put ovl 'face 'secondary-selection) + (overlay-put ovl + 'keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-1] 'org-edit-src-continue) + map)) + (overlay-put ovl :read-only "Leave me alone") + (org-pop-to-buffer-same-window buffer) + (insert code) + (remove-text-properties (point-min) (point-max) + '(display nil invisible nil intangible nil)) + (setq block-nindent (or (org-do-remove-indentation) 0)) + (cond + ((eq org-edit-fixed-width-region-mode 'artist-mode) + (fundamental-mode) + (artist-mode 1)) + (t (funcall org-edit-fixed-width-region-mode))) + (set (make-local-variable 'org-edit-src-force-single-line) nil) + (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) + (set (make-local-variable 'org-edit-src-picture) t) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*: ?" nil t) + (replace-match "")) + (org-goto-line (1+ (- line begline))) + (org-move-to-column (max 0 (- col block-nindent 2))) + (org-set-local 'org-edit-src-beg-marker beg) + (org-set-local 'org-edit-src-end-marker end) + (org-set-local 'org-edit-src-overlay ovl) + (org-set-local 'org-edit-src-block-indentation block-nindent) + (org-set-local 'org-edit-src-content-indentation 0) + (org-set-local 'org-src-preserve-indentation nil) + (org-src-mode) + (set-buffer-modified-p nil) + (and org-edit-src-persistent-message + (org-set-local 'header-line-format msg))) + (message "%s" msg) + t))) + +(defun org-edit-src-find-region-and-lang () + "Find the region and language for a local edit. +Return a list with beginning and end of the region, a string representing +the language, a switch telling if the content should be in a single line." + (let ((re-list + (append + org-edit-src-region-extra + '( + ("<src\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</src>" lang) + ("<literal\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</literal>" style) + ("<example>[ \t]*\n?" "\n?[ \t]*</example>" "fundamental") + ("<lisp>[ \t]*\n?" "\n?[ \t]*</lisp>" "emacs-lisp") + ("<perl>[ \t]*\n?" "\n?[ \t]*</perl>" "perl") + ("<python>[ \t]*\n?" "\n?[ \t]*</python>" "python") + ("<ruby>[ \t]*\n?" "\n?[ \t]*</ruby>" "ruby") + ("^[ \t]*#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n" "\n[ \t]*#\\+end_src" 2) + ("^[ \t]*#\\+begin_example.*\n" "\n[ \t]*#\\+end_example" "fundamental") + ("^[ \t]*#\\+html:" "\n" "html" single-line) + ("^[ \t]*#\\+begin_html.*\n" "\n[ \t]*#\\+end_html" "html") + ("^[ \t]*#\\+latex:" "\n" "latex" single-line) + ("^[ \t]*#\\+begin_latex.*\n" "\n[ \t]*#\\+end_latex" "latex") + ("^[ \t]*#\\+ascii:" "\n" "fundamental" single-line) + ("^[ \t]*#\\+begin_ascii.*\n" "\n[ \t]*#\\+end_ascii" "fundamental") + ("^[ \t]*#\\+macro:[ \t]+\\S-+\\( \\|$\\)" + "\n" "fundamental" macro-definition) + ))) + (pos (point)) + re1 re2 single beg end lang lfmt match-re1 ind entry) + (catch 'exit + (while (setq entry (pop re-list)) + (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry) + single (nth 3 entry)) + (save-excursion + (if (or (looking-at re1) + (re-search-backward re1 nil t)) + (progn + (setq match-re1 (match-string 0)) + (setq beg (match-end 0) + lang (org-edit-src-get-lang lang) + lfmt (org-edit-src-get-label-format match-re1) + ind (org-edit-src-get-indentation (match-beginning 0))) + (if (and (re-search-forward re2 nil t) + (>= (match-end 0) pos)) + (throw 'exit (list beg (match-beginning 0) + lang single lfmt ind)))) + (if (or (looking-at re2) + (re-search-forward re2 nil t)) + (progn + (setq end (match-beginning 0)) + (if (and (re-search-backward re1 nil t) + (<= (match-beginning 0) pos)) + (progn + (setq lfmt (org-edit-src-get-label-format + (match-string 0)) + ind (org-edit-src-get-indentation + (match-beginning 0))) + (throw 'exit + (list (match-end 0) end + (org-edit-src-get-lang lang) + single lfmt ind))))))))) + (when (org-at-table.el-p) + (re-search-backward "^[\t]*[^ \t|\\+]" nil t) + (setq beg (1+ (point-at-eol))) + (goto-char beg) + (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t) + (progn (goto-char (point-max)) (newline))) + (setq end (1- (point-at-bol))) + (throw 'exit (list beg end 'table.el nil nil 0)))))) + +(defun org-edit-src-get-lang (lang) + "Extract the src language." + (let ((m (match-string 0))) + (cond + ((stringp lang) lang) + ((integerp lang) (match-string lang)) + ((and (eq lang 'lang) + (string-match "\\<lang=\"\\([^ \t\n\"]+\\)\"" m)) + (match-string 1 m)) + ((and (eq lang 'style) + (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m)) + (match-string 1 m)) + (t "fundamental")))) + +(defun org-edit-src-get-label-format (s) + "Extract the label format." + (save-match-data + (if (string-match "-l[ \t]+\\\\?\"\\([^\t\r\n\"]+\\)\\\\?\"" s) + (match-string 1 s)))) + +(defun org-edit-src-get-indentation (pos) + "Count leading whitespace characters on line." + (save-match-data + (goto-char pos) + (org-get-indentation))) + +(defun org-escape-code-in-region (beg end) + "Escape lines between BEG and END. +Escaping happens when a line starts with \"*\", \"#+\", \",*\" or +\",#+\" by appending a comma to it." + (interactive "r") + (save-excursion + (goto-char beg) + (while (re-search-forward "^[ \t]*,?\\(\\*\\|#\\+\\)" end t) + (replace-match ",\\1" nil nil nil 1)))) + +(defun org-escape-code-in-string (s) + "Escape lines in string S. +Escaping happens when a line starts with \"*\", \"#+\", \",*\" or +\",#+\" by appending a comma to it." + (replace-regexp-in-string "^[ \t]*,?\\(\\*\\|#\\+\\)" ",\\1" s nil nil 1)) + +(defun org-unescape-code-in-region (beg end) + "Un-escape lines between BEG and END. +Un-escaping happens by removing the first comma on lines starting +with \",*\", \",#+\", \",,*\" and \",,#+\"." + (interactive "r") + (save-excursion + (goto-char beg) + (while (re-search-forward "^[ \t]*,?\\(,\\)\\(?:\\*\\|#\\+\\)" end t) + (replace-match "" nil nil nil 1)))) + +(defun org-unescape-code-in-string (s) + "Un-escape lines in string S. +Un-escaping happens by removing the first comma on lines starting +with \",*\", \",#+\", \",,*\" and \",,#+\"." + (replace-regexp-in-string + "^[ \t]*,?\\(,\\)\\(?:\\*\\|#\\+\\)" "" s nil nil 1)) + +(defun org-edit-src-exit (&optional context) + "Exit special edit and protect problematic lines." + (interactive) + (unless (org-bound-and-true-p org-edit-src-from-org-mode) + (error "This is not a sub-editing buffer, something is wrong")) + (widen) + (let* ((fixed-width-p (string-match "Fixed Width" (buffer-name))) + (beg org-edit-src-beg-marker) + (end org-edit-src-end-marker) + (ovl org-edit-src-overlay) + (bufstr (buffer-string)) + (buffer (current-buffer)) + (single (org-bound-and-true-p org-edit-src-force-single-line)) + (macro (eq single 'macro-definition)) + (total-nindent (+ (or org-edit-src-block-indentation 0) + org-edit-src-content-indentation)) + (preserve-indentation org-src-preserve-indentation) + (allow-write-back-p (org-bound-and-true-p org-edit-src-allow-write-back-p)) + (delta 0) code line col indent) + (when allow-write-back-p + (unless preserve-indentation (untabify (point-min) (point-max))) + (if org-src-strip-leading-and-trailing-blank-lines + (save-excursion + (goto-char (point-min)) + (if (looking-at "[ \t\n]*\n") (replace-match "")) + (unless macro + (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match "")))))) + (setq line (if (org-bound-and-true-p org-edit-src-force-single-line) + 1 + (org-current-line)) + col (current-column)) + (when allow-write-back-p + (when single + (goto-char (point-min)) + (if (re-search-forward "\\s-+\\'" nil t) (replace-match "")) + (goto-char (point-min)) + (let ((cnt 0)) + (while (re-search-forward "\n" nil t) + (setq cnt (1+ cnt)) + (replace-match (if macro "\\n" " ") t t)) + (when (and macro (> cnt 0)) + (goto-char (point-max)) (insert "\\n"))) + (goto-char (point-min)) + (if (looking-at "\\s-*") (replace-match " "))) + (when (and (org-bound-and-true-p org-edit-src-from-org-mode) + (not fixed-width-p)) + (org-escape-code-in-region (point-min) (point-max)) + (setq delta (+ delta + (save-excursion + (org-goto-line line) + (if (looking-at "[ \t]*\\(,,\\)?\\(\\*\\|#+\\)") 1 + 0))))) + (when (org-bound-and-true-p org-edit-src-picture) + (setq preserve-indentation nil) + (untabify (point-min) (point-max)) + (goto-char (point-min)) + (while (re-search-forward "^" nil t) + (replace-match ": "))) + (unless (or single preserve-indentation (= total-nindent 0)) + (setq indent (make-string total-nindent ?\ )) + (goto-char (point-min)) + (while (re-search-forward "\\(^\\).+" nil t) + (replace-match indent nil nil nil 1))) + (if (org-bound-and-true-p org-edit-src-picture) + (setq total-nindent (+ total-nindent 2))) + (setq code (buffer-string)) + (when (eq context 'save) + (erase-buffer) + (insert bufstr)) + (set-buffer-modified-p nil)) + (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit)) + (if (eq context 'save) (save-buffer) + (with-current-buffer buffer + (set-buffer-modified-p nil)) + (kill-buffer buffer)) + (goto-char beg) + (when allow-write-back-p + (undo-boundary) + (delete-region beg (max beg end)) + (unless (string-match "\\`[ \t]*\\'" code) + (insert code)) + ;; Make sure the overlay stays in place + (when (eq context 'save) (move-overlay ovl beg (point))) + (goto-char beg) + (if single (just-one-space))) + (if (memq t (mapcar (lambda (overlay) + (eq (overlay-get overlay 'invisible) + 'org-hide-block)) + (overlays-at (point)))) + ;; Block is hidden; put point at start of block + (beginning-of-line 0) + ;; Block is visible, put point where it was in the code buffer + (when allow-write-back-p + (org-goto-line (1- (+ (org-current-line) line))) + (org-move-to-column (if preserve-indentation col (+ col total-nindent delta))))) + (unless (eq context 'save) + (move-marker beg nil) + (move-marker end nil))) + (unless (eq context 'save) + (when org-edit-src-saved-temp-window-config + (set-window-configuration org-edit-src-saved-temp-window-config) + (setq org-edit-src-saved-temp-window-config nil)))) + +(defun org-edit-src-abort () + "Abort editing of the src code and return to the Org buffer." + (interactive) + (let (org-edit-src-allow-write-back-p) + (org-edit-src-exit 'exit))) + +(defmacro org-src-in-org-buffer (&rest body) + `(let ((p (point)) (m (mark)) (ul buffer-undo-list) msg) + (save-window-excursion + (org-edit-src-exit 'save) + ,@body + (setq msg (current-message)) + (if (eq org-src-window-setup 'other-frame) + (let ((org-src-window-setup 'current-window)) + (org-edit-src-code 'save)) + (org-edit-src-code 'save))) + (setq buffer-undo-list ul) + (push-mark m 'nomessage) + (goto-char (min p (point-max))) + (message (or msg "")))) +(def-edebug-spec org-src-in-org-buffer (body)) + +(defun org-edit-src-save () + "Save parent buffer with current state source-code buffer." + (interactive) + (if (string-match "Fixed Width" (buffer-name)) + (user-error "Use C-c ' to save and exit, C-c C-k to abort editing") + (org-src-in-org-buffer (save-buffer)))) + +(declare-function org-babel-tangle "ob-tangle" (&optional arg target-file lang)) + +(defun org-src-tangle (arg) + "Tangle the parent buffer." + (interactive) + (org-src-in-org-buffer (org-babel-tangle arg))) + +(defun org-src-mode-configure-edit-buffer () + (when (org-bound-and-true-p org-edit-src-from-org-mode) + (org-add-hook 'kill-buffer-hook + (lambda () + (when (overlayp org-edit-src-overlay) + (delete-overlay org-edit-src-overlay))) + nil 'local) + (if (org-bound-and-true-p org-edit-src-allow-write-back-p) + (progn + (setq buffer-offer-save t) + (setq buffer-file-name + (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker)) + "[" (buffer-name) "]")) + (if (featurep 'xemacs) + (progn + (make-variable-buffer-local 'write-contents-hooks) ; needed only for 21.4 + (setq write-contents-hooks '(org-edit-src-save))) + (setq write-contents-functions '(org-edit-src-save)))) + (setq buffer-read-only t)))) + +(org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer) + + +(defun org-src-associate-babel-session (info) + "Associate edit buffer with comint session." + (interactive) + (let ((session (cdr (assoc :session (nth 2 info))))) + (and session (not (string= session "none")) + (org-babel-comint-buffer-livep session) + (let ((f (intern (format "org-babel-%s-associate-session" + (nth 0 info))))) + (and (fboundp f) (funcall f session)))))) + +(defun org-src-babel-configure-edit-buffer () + (when org-src-babel-info + (org-src-associate-babel-session org-src-babel-info))) + +(org-add-hook 'org-src-mode-hook 'org-src-babel-configure-edit-buffer) +(defmacro org-src-do-at-code-block (&rest body) + "Execute a command from an edit buffer in the Org-mode buffer." + `(let ((beg-marker org-edit-src-beg-marker)) + (if beg-marker + (with-current-buffer (marker-buffer beg-marker) + (goto-char (marker-position beg-marker)) + ,@body)))) +(def-edebug-spec org-src-do-at-code-block (body)) + +(defun org-src-do-key-sequence-at-code-block (&optional key) + "Execute key sequence at code block in the source Org buffer. +The command bound to KEY in the Org-babel key map is executed +remotely with point temporarily at the start of the code block in +the Org buffer. + +This command is not bound to a key by default, to avoid conflicts +with language major mode bindings. To bind it to C-c @ in all +language major modes, you could use + + (add-hook 'org-src-mode-hook + (lambda () (define-key org-src-mode-map \"\\C-c@\" + 'org-src-do-key-sequence-at-code-block))) + +In that case, for example, C-c @ t issued in code edit buffers +would tangle the current Org code block, C-c @ e would execute +the block and C-c @ h would display the other available +Org-babel commands." + (interactive "kOrg-babel key: ") + (if (equal key (kbd "C-g")) (keyboard-quit) + (org-edit-src-save) + (org-src-do-at-code-block + (call-interactively + (lookup-key org-babel-map key))))) + +(defcustom org-src-tab-acts-natively nil + "If non-nil, the effect of TAB in a code block is as if it were +issued in the language major mode buffer." + :type 'boolean + :version "24.1" + :group 'org-babel) + +(defun org-src-native-tab-command-maybe () + "Perform language-specific TAB action. +Alter code block according to what TAB does in the language major mode." + (and org-src-tab-acts-natively + (org-in-src-block-p) + (not (equal this-command 'org-shifttab)) + (let ((org-src-strip-leading-and-trailing-blank-lines nil)) + (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB"))))) + +(add-hook 'org-tab-first-hook 'org-src-native-tab-command-maybe) + +(defun org-src-font-lock-fontify-block (lang start end) + "Fontify code block. +This function is called by emacs automatic fontification, as long +as `org-src-fontify-natively' is non-nil. For manual +fontification of code blocks see `org-src-fontify-block' and +`org-src-fontify-buffer'" + (let ((lang-mode (org-src-get-lang-mode lang))) + (if (fboundp lang-mode) + (let ((string (buffer-substring-no-properties start end)) + (modified (buffer-modified-p)) + (org-buffer (current-buffer)) pos next) + (remove-text-properties start end '(face nil)) + (with-current-buffer + (get-buffer-create + (concat " org-src-fontification:" (symbol-name lang-mode))) + (delete-region (point-min) (point-max)) + (insert string " ") ;; so there's a final property change + (unless (eq major-mode lang-mode) (funcall lang-mode)) + (font-lock-fontify-buffer) + (setq pos (point-min)) + (while (setq next (next-single-property-change pos 'face)) + (put-text-property + (+ start (1- pos)) (1- (+ start next)) 'face + (get-text-property pos 'face) org-buffer) + (setq pos next))) + (add-text-properties + start end + '(font-lock-fontified t fontified t font-lock-multiline t)) + (set-buffer-modified-p modified))))) + +(defun org-src-fontify-block () + "Fontify code block at point." + (interactive) + (save-excursion + (let ((org-src-fontify-natively t) + (info (org-edit-src-find-region-and-lang))) + (font-lock-fontify-region (nth 0 info) (nth 1 info))))) + +(defun org-src-fontify-buffer () + "Fontify all code blocks in the current buffer." + (interactive) + (org-babel-map-src-blocks nil + (org-src-fontify-block))) + +(defun org-src-get-lang-mode (lang) + "Return major mode that should be used for LANG. +LANG is a string, and the returned major mode is a symbol." + (intern + (concat + (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang))) + (if (symbolp l) (symbol-name l) l)) + "-mode"))) + +(provide 'org-src) + +;;; org-src.el ends here diff --git a/elpa/org-20150427/org-table.el b/elpa/org-20150427/org-table.el new file mode 100644 index 00000000..30a66c9c --- /dev/null +++ b/elpa/org-20150427/org-table.el @@ -0,0 +1,5037 @@ +;;; org-table.el --- The table editor for Org-mode + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: + +;; This file contains the table editor and spreadsheet for Org-mode. + +;; Watch out: Here we are talking about two different kind of tables. +;; Most of the code is for the tables created with the Org-mode table editor. +;; Sometimes, we talk about tables created and edited with the table.el +;; Emacs package. We call the former org-type tables, and the latter +;; table.el-type tables. + +;;; Code: + +(eval-when-compile + (require 'cl)) +(require 'org) + +(declare-function org-export-string-as "ox" + (string backend &optional body-only ext-plist)) +(declare-function aa2u "ext:ascii-art-to-unicode" ()) +(defvar orgtbl-mode) ; defined below +(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized +(defvar constants-unit-system) +(defvar org-table-follow-field-mode) + +(defvar orgtbl-after-send-table-hook nil + "Hook for functions attaching to `C-c C-c', if the table is sent. +This can be used to add additional functionality after the table is sent +to the receiver position, otherwise, if table is not sent, the functions +are not run.") + +(defvar org-table-TBLFM-begin-regexp "|\n[ \t]*#\\+TBLFM: ") + +(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) + "Non-nil means use the optimized table editor version for `orgtbl-mode'. +In the optimized version, the table editor takes over all simple keys that +normally just insert a character. In tables, the characters are inserted +in a way to minimize disturbing the table structure (i.e. in overwrite mode +for empty fields). Outside tables, the correct binding of the keys is +restored. + +The default for this option is t if the optimized version is also used in +Org-mode. See the variable `org-enable-table-editor' for details. Changing +this variable requires a restart of Emacs to become effective." + :group 'org-table + :type 'boolean) + +(defcustom orgtbl-radio-table-templates + '((latex-mode "% BEGIN RECEIVE ORGTBL %n +% END RECEIVE ORGTBL %n +\\begin{comment} +#+ORGTBL: SEND %n orgtbl-to-latex :splice nil :skip 0 +| | | +\\end{comment}\n") + (texinfo-mode "@c BEGIN RECEIVE ORGTBL %n +@c END RECEIVE ORGTBL %n +@ignore +#+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0 +| | | +@end ignore\n") + (html-mode "<!-- BEGIN RECEIVE ORGTBL %n --> +<!-- END RECEIVE ORGTBL %n --> +<!-- +#+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0 +| | | +-->\n") + (org-mode "#+ BEGIN RECEIVE ORGTBL %n +#+ END RECEIVE ORGTBL %n + +#+ORGTBL: SEND %n orgtbl-to-orgtbl :splice nil :skip 0 +| | | +")) + "Templates for radio tables in different major modes. +Each template must define lines that will be treated as a comment and that +must contain the \"BEGIN RECEIVE ORGTBL %n\" and \"END RECEIVE ORGTBL\" +lines where \"%n\" will be replaced with the name of the table during +insertion of the template. The transformed table will later be inserted +between these lines. + +The template should also contain a minimal table in a multiline comment. +If multiline comments are not possible in the buffer language, +you can pack it into a string that will not be used when the code +is compiled or executed. Above the table will you need a line with +the fixed string \"#+ORGTBL: SEND\", followed by instruction on how to +convert the table into a data structure useful in the +language of the buffer. Check the manual for the section on +\"Translator functions\", and more generally check out +http://orgmode.org/manual/Tables-in-arbitrary-syntax.html#Tables-in-arbitrary-syntax + +All occurrences of %n in a template will be replaced with the name of the +table, obtained by prompting the user." + :group 'org-table + :type '(repeat + (list (symbol :tag "Major mode") + (string :tag "Format")))) + +(defgroup org-table-settings nil + "Settings for tables in Org-mode." + :tag "Org Table Settings" + :group 'org-table) + +(defcustom org-table-default-size "5x2" + "The default size for newly created tables, Columns x Rows." + :group 'org-table-settings + :type 'string) + +(defcustom org-table-number-regexp + "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$" + "Regular expression for recognizing numbers in table columns. +If a table column contains mostly numbers, it will be aligned to the +right. If not, it will be aligned to the left. + +The default value of this option is a regular expression which allows +anything which looks remotely like a number as used in scientific +context. For example, all of the following will be considered a +number: + 12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5 + +Other options offered by the customize interface are more restrictive." + :group 'org-table-settings + :type '(choice + (const :tag "Positive Integers" + "^[0-9]+$") + (const :tag "Integers" + "^[-+]?[0-9]+$") + (const :tag "Floating Point Numbers" + "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$") + (const :tag "Floating Point Number or Integer" + "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$") + (const :tag "Exponential, Floating point, Integer" + "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") + (const :tag "Very General Number-Like, including hex and Calc radix" + "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") + (const :tag "Very General Number-Like, including hex and Calc radix, allows comma as decimal mark" + "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") + (string :tag "Regexp:"))) + +(defcustom org-table-number-fraction 0.5 + "Fraction of numbers in a column required to make the column align right. +In a column all non-white fields are considered. If at least +this fraction of fields is matched by `org-table-number-regexp', +alignment to the right border applies." + :group 'org-table-settings + :type 'number) + +(defgroup org-table-editing nil + "Behavior of tables during editing in Org-mode." + :tag "Org Table Editing" + :group 'org-table) + +(defcustom org-table-automatic-realign t + "Non-nil means automatically re-align table when pressing TAB or RETURN. +When nil, aligning is only done with \\[org-table-align], or after column +removal/insertion." + :group 'org-table-editing + :type 'boolean) + +(defcustom org-table-auto-blank-field t + "Non-nil means automatically blank table field when starting to type into it. +This only happens when typing immediately after a field motion +command (TAB, S-TAB or RET). +Only relevant when `org-enable-table-editor' is equal to `optimized'." + :group 'org-table-editing + :type 'boolean) + +(defcustom org-table-exit-follow-field-mode-when-leaving-table t + "Non-nil means automatically exit the follow mode. +When nil, the follow mode will stay on and be active in any table +the cursor enters. Since the table follow filed mode messes with the +window configuration, it is not recommended to set this variable to nil, +except maybe locally in a special file that has mostly tables with long +fields." + :group 'org-table + :version "24.1" + :type 'boolean) + +(defcustom org-table-fix-formulas-confirm nil + "Whether the user should confirm when Org fixes formulas." + :group 'org-table-editing + :version "24.1" + :type '(choice + (const :tag "with yes-or-no" yes-or-no-p) + (const :tag "with y-or-n" y-or-n-p) + (const :tag "no confirmation" nil))) +(put 'org-table-fix-formulas-confirm + 'safe-local-variable + #'(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) + +(defcustom org-table-tab-jumps-over-hlines t + "Non-nil means tab in the last column of a table with jump over a hline. +If a horizontal separator line is following the current line, +`org-table-next-field' can either create a new row before that line, or jump +over the line. When this option is nil, a new line will be created before +this line." + :group 'org-table-editing + :type 'boolean) + +(defgroup org-table-calculation nil + "Options concerning tables in Org-mode." + :tag "Org Table Calculation" + :group 'org-table) + +(defcustom org-table-use-standard-references 'from + "Should org-mode work with table references like B3 instead of @3$2? +Possible values are: +nil never use them +from accept as input, do not present for editing +t accept as input and present for editing" + :group 'org-table-calculation + :type '(choice + (const :tag "Never, don't even check user input for them" nil) + (const :tag "Always, both as user input, and when editing" t) + (const :tag "Convert user input, don't offer during editing" from))) + +(defcustom org-table-copy-increment t + "Non-nil means increment when copying current field with \\[org-table-copy-down]." + :group 'org-table-calculation + :type 'boolean) + +(defcustom org-calc-default-modes + '(calc-internal-prec 12 + calc-float-format (float 8) + calc-angle-mode deg + calc-prefer-frac nil + calc-symbolic-mode nil + calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm)) + calc-display-working-message t + ) + "List with Calc mode settings for use in `calc-eval' for table formulas. +The list must contain alternating symbols (Calc modes variables and values). +Don't remove any of the default settings, just change the values. Org-mode +relies on the variables to be present in the list." + :group 'org-table-calculation + :type 'plist) + +(defcustom org-table-duration-custom-format 'hours + "Format for the output of calc computations like $1+$2;t. +The default value is 'hours, and will output the results as a +number of hours. Other allowed values are 'seconds, 'minutes and +'days, and the output will be a fraction of seconds, minutes or +days." + :group 'org-table-calculation + :version "24.1" + :type '(choice (symbol :tag "Seconds" 'seconds) + (symbol :tag "Minutes" 'minutes) + (symbol :tag "Hours " 'hours) + (symbol :tag "Days " 'days))) + +(defcustom org-table-formula-field-format "%s" + "Format for fields which contain the result of a formula. +For example, using \"~%s~\" will display the result within tilde +characters. Beware that modifying the display can prevent the +field from being used in another formula." + :group 'org-table-settings + :version "24.1" + :type 'string) + +(defcustom org-table-formula-evaluate-inline t + "Non-nil means TAB and RET evaluate a formula in current table field. +If the current field starts with an equal sign, it is assumed to be a formula +which should be evaluated as described in the manual and in the documentation +string of the command `org-table-eval-formula'. This feature requires the +Emacs calc package. +When this variable is nil, formula calculation is only available through +the command \\[org-table-eval-formula]." + :group 'org-table-calculation + :type 'boolean) + +(defcustom org-table-formula-use-constants t + "Non-nil means interpret constants in formulas in tables. +A constant looks like `$c' or `$Grav' and will be replaced before evaluation +by the value given in `org-table-formula-constants', or by a value obtained +from the `constants.el' package." + :group 'org-table-calculation + :type 'boolean) + +(defcustom org-table-formula-constants nil + "Alist with constant names and values, for use in table formulas. +The car of each element is a name of a constant, without the `$' before it. +The cdr is the value as a string. For example, if you'd like to use the +speed of light in a formula, you would configure + + (setq org-table-formula-constants '((\"c\" . \"299792458.\"))) + +and then use it in an equation like `$1*$c'. + +Constants can also be defined on a per-file basis using a line like + +#+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6" + :group 'org-table-calculation + :type '(repeat + (cons (string :tag "name") + (string :tag "value")))) + +(defcustom org-table-allow-automatic-line-recalculation t + "Non-nil means lines marked with |#| or |*| will be recomputed automatically. +Automatically means when TAB or RET or C-c C-c are pressed in the line." + :group 'org-table-calculation + :type 'boolean) + +(defcustom org-table-error-on-row-ref-crossing-hline t + "OBSOLETE VARIABLE, please see `org-table-relative-ref-may-cross-hline'." + :group 'org-table + :type 'boolean) + +(defcustom org-table-relative-ref-may-cross-hline t + "Non-nil means relative formula references may cross hlines. +Here are the allowed values: + +nil Relative references may not cross hlines. They will reference the + field next to the hline instead. Coming from below, the reference + will be to the field below the hline. Coming from above, it will be + to the field above. +t Relative references may cross hlines. +error An attempt to cross a hline will throw an error. + +It is probably good to never set this variable to nil, for the sake of +portability of tables." + :group 'org-table-calculation + :type '(choice + (const :tag "Allow to cross" t) + (const :tag "Stick to hline" nil) + (const :tag "Error on attempt to cross" error))) + +(defgroup org-table-import-export nil + "Options concerning table import and export in Org-mode." + :tag "Org Table Import Export" + :group 'org-table) + +(defcustom org-table-export-default-format "orgtbl-to-tsv" + "Default export parameters for `org-table-export'. +These can be overridden for a specific table by setting the +TABLE_EXPORT_FORMAT property. See the manual section on orgtbl +radio tables for the different export transformations and +available parameters." + :group 'org-table-import-export + :type 'string) + +(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)" + "Detects a table line marked for automatic recalculation.") +(defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)" + "Detects a table line marked for automatic recalculation.") +(defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)" + "Detects a table line marked for automatic recalculation.") +(defconst org-table-border-regexp "^[ \t]*[^| \t]" + "Searching from within a table (any type) this finds the first line outside the table.") +(defvar org-table-last-highlighted-reference nil) +(defvar org-table-formula-history nil) + +(defvar org-table-column-names nil + "Alist with column names, derived from the `!' line.") +(defvar org-table-column-name-regexp nil + "Regular expression matching the current column names.") +(defvar org-table-local-parameters nil + "Alist with parameter names, derived from the `$' line.") +(defvar org-table-named-field-locations nil + "Alist with locations of named fields.") + +(defvar org-table-current-line-types nil + "Table row types, non-nil only for the duration of a command.") +(defvar org-table-current-begin-line nil + "Table begin line, non-nil only for the duration of a command.") +(defvar org-table-current-begin-pos nil + "Table begin position, non-nil only for the duration of a command.") +(defvar org-table-current-ncol nil + "Number of columns in table, non-nil only for the duration of a command.") +(defvar org-table-dlines nil + "Vector of data line line numbers in the current table.") +(defvar org-table-hlines nil + "Vector of hline line numbers in the current table.") + +(defconst org-table-range-regexp + "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?" + ;; 1 2 3 4 5 + "Regular expression for matching ranges in formulas.") + +(defconst org-table-range-regexp2 + (concat + "\\(" "@[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)" + "\\.\\." + "\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)") + "Match a range for reference display.") + +(defun org-table-colgroup-line-p (line) + "Is this a table line colgroup information?" + (save-match-data + (and (string-match "[<>]\\|&[lg]t;" line) + (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'" + line) + (not (delq + nil + (mapcar + (lambda (s) + (not (member s '("" "<" ">" "<>" "<" ">" "<>")))) + (org-split-string (match-string 1 line) "[ \t]*|[ \t]*"))))))) + +(defun org-table-cookie-line-p (line) + "Is this a table line with only alignment/width cookies?" + (save-match-data + (and (string-match "[<>]\\|&[lg]t;" line) + (or (string-match + "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lrcgt&;]+\\)\\'" line) + (string-match "\\(\\`[ \t<>lrc0-9|gt&;]+\\'\\)" line)) + (not (delq nil (mapcar + (lambda (s) + (not (or (equal s "") + (string-match + "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" s) + (string-match + "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" + s)))) + (org-split-string (match-string 1 line) + "[ \t]*|[ \t]*"))))))) + +(defvar org-table-clean-did-remove-column nil) ; dynamically scoped +(defun org-table-clean-before-export (lines &optional maybe-quoted) + "Check if the table has a marking column. +If yes remove the column and the special lines." + (let ((special (if maybe-quoted + "^[ \t]*| *\\\\?[\#!$*_^/ ] *|" + "^[ \t]*| *[\#!$*_^/ ] *|")) + (ignore (if maybe-quoted + "^[ \t]*| *\\\\?[!$_^/] *|" + "^[ \t]*| *[!$_^/] *|"))) + (setq org-table-clean-did-remove-column + (not (memq nil + (mapcar + (lambda (line) + (or (string-match org-table-hline-regexp line) + (string-match special line))) + lines)))) + (delq nil + (mapcar + (lambda (line) + (cond + ((or (org-table-colgroup-line-p line) ;; colgroup info + (org-table-cookie-line-p line) ;; formatting cookies + (and org-table-clean-did-remove-column + (string-match ignore line))) ;; non-exportable data + nil) + ((and org-table-clean-did-remove-column + (or (string-match "^\\([ \t]*\\)|-+\\+" line) + (string-match "^\\([ \t]*\\)|[^|]*|" line))) + ;; remove the first column + (replace-match "\\1|" t nil line)) + (t line))) + lines)))) + +(defconst org-table-translate-regexp + (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") + "Match a reference that needs translation, for reference display.") + +;;;###autoload +(defun org-table-create-with-table.el () + "Use the table.el package to insert a new table. +If there is already a table at point, convert between Org-mode tables +and table.el tables." + (interactive) + (require 'table) + (cond + ((org-at-table.el-p) + (if (y-or-n-p "Convert table to Org-mode table? ") + (org-table-convert))) + ((org-at-table-p) + (when (y-or-n-p "Convert table to table.el table? ") + (org-table-align) + (org-table-convert))) + (t (call-interactively 'table-insert)))) + +;;;###autoload +(defun org-table-create-or-convert-from-region (arg) + "Convert region to table, or create an empty table. +If there is an active region, convert it to a table, using the function +`org-table-convert-region'. See the documentation of that function +to learn how the prefix argument is interpreted to determine the field +separator. +If there is no such region, create an empty table with `org-table-create'." + (interactive "P") + (if (org-region-active-p) + (org-table-convert-region (region-beginning) (region-end) arg) + (org-table-create arg))) + +;;;###autoload +(defun org-table-create (&optional size) + "Query for a size and insert a table skeleton. +SIZE is a string Columns x Rows like for example \"3x2\"." + (interactive "P") + (unless size + (setq size (read-string + (concat "Table size Columns x Rows [e.g. " + org-table-default-size "]: ") + "" nil org-table-default-size))) + + (let* ((pos (point)) + (indent (make-string (current-column) ?\ )) + (split (org-split-string size " *x *")) + (rows (string-to-number (nth 1 split))) + (columns (string-to-number (car split))) + (line (concat (apply 'concat indent "|" (make-list columns " |")) + "\n"))) + (if (string-match "^[ \t]*$" (buffer-substring-no-properties + (point-at-bol) (point))) + (beginning-of-line 1) + (newline)) + ;; (mapcar (lambda (x) (insert line)) (make-list rows t)) + (dotimes (i rows) (insert line)) + (goto-char pos) + (if (> rows 1) + ;; Insert a hline after the first row. + (progn + (end-of-line 1) + (insert "\n|-") + (goto-char pos))) + (org-table-align))) + +;;;###autoload +(defun org-table-convert-region (beg0 end0 &optional separator) + "Convert region to a table. +The region goes from BEG0 to END0, but these borders will be moved +slightly, to make sure a beginning of line in the first line is included. + +SEPARATOR specifies the field separator in the lines. It can have the +following values: + +'(4) Use the comma as a field separator +'(16) Use a TAB as field separator +integer When a number, use that many spaces as field separator +nil When nil, the command tries to be smart and figure out the + separator in the following way: + - when each line contains a TAB, assume TAB-separated material + - when each line contains a comma, assume CSV material + - else, assume one or more SPACE characters as separator." + (interactive "r\nP") + (let* ((beg (min beg0 end0)) + (end (max beg0 end0)) + re) + (goto-char beg) + (beginning-of-line 1) + (setq beg (point-marker)) + (goto-char end) + (if (bolp) (backward-char 1) (end-of-line 1)) + (setq end (point-marker)) + ;; Get the right field separator + (unless separator + (goto-char beg) + (setq separator + (cond + ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) + ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) + (t 1)))) + (goto-char beg) + (if (equal separator '(4)) + (while (< (point) end) + ;; parse the csv stuff + (cond + ((looking-at "^") (insert "| ")) + ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) + ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") + (replace-match "\\1") + (if (looking-at "\"") (insert "\""))) + ((looking-at "[^,\n]+") (goto-char (match-end 0))) + ((looking-at "[ \t]*,") (replace-match " | ")) + (t (beginning-of-line 2)))) + (setq re (cond + ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") + ((equal separator '(16)) "^\\|\t") + ((integerp separator) + (if (< separator 1) + (user-error "Number of spaces in separator must be >= 1") + (format "^ *\\| *\t *\\| \\{%d,\\}" separator))) + (t (error "This should not happen")))) + (while (re-search-forward re end t) + (replace-match "| " t t))) + (goto-char beg) + (org-table-align))) + +;;;###autoload +(defun org-table-import (file arg) + "Import FILE as a table. +The file is assumed to be tab-separated. Such files can be produced by most +spreadsheet and database applications. If no tabs (at least one per line) +are found, lines will be split on whitespace into fields." + (interactive "f\nP") + (or (bolp) (newline)) + (let ((beg (point)) + (pm (point-max))) + (insert-file-contents file) + (org-table-convert-region beg (+ (point) (- (point-max) pm)) arg))) + + +(defvar org-table-last-alignment) +(defvar org-table-last-column-widths) +;;;###autoload +(defun org-table-export (&optional file format) + "Export table to a file, with configurable format. +Such a file can be imported into usual spreadsheet programs. + +FILE can be the output file name. If not given, it will be taken +from a TABLE_EXPORT_FILE property in the current entry or higher +up in the hierarchy, or the user will be prompted for a file +name. FORMAT can be an export format, of the same kind as it +used when `orgtbl-mode' sends a table in a different format. + +The command suggests a format depending on TABLE_EXPORT_FORMAT, +whether it is set locally or up in the hierarchy, then on the +extension of the given file name, and finally on the variable +`org-table-export-default-format'." + (interactive) + (unless (org-at-table-p) (user-error "No table at point")) + (org-table-align) ;; make sure we have everything we need + (let* ((beg (org-table-begin)) + (end (org-table-end)) + (txt (buffer-substring-no-properties beg end)) + (file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t))) + (formats '("orgtbl-to-tsv" "orgtbl-to-csv" + "orgtbl-to-latex" "orgtbl-to-html" + "orgtbl-to-generic" "orgtbl-to-texinfo" + "orgtbl-to-orgtbl")) + (format (or format + (org-entry-get beg "TABLE_EXPORT_FORMAT" t))) + buf deffmt-readable fileext) + (unless file + (setq file (read-file-name "Export table to: ")) + (unless (or (not (file-exists-p file)) + (y-or-n-p (format "Overwrite file %s? " file))) + (user-error "File not written"))) + (if (file-directory-p file) + (user-error "This is a directory path, not a file")) + (if (and (buffer-file-name) + (equal (file-truename file) + (file-truename (buffer-file-name)))) + (user-error "Please specify a file name that is different from current")) + (setq fileext (concat (file-name-extension file) "$")) + (unless format + (setq deffmt-readable + (or (car (delq nil (mapcar (lambda(f) (if (string-match fileext f) f)) formats))) + org-table-export-default-format)) + (while (string-match "\t" deffmt-readable) + (setq deffmt-readable (replace-match "\\t" t t deffmt-readable))) + (while (string-match "\n" deffmt-readable) + (setq deffmt-readable (replace-match "\\n" t t deffmt-readable))) + (setq format (org-completing-read "Format: " formats nil nil deffmt-readable))) + (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format) + (let* ((transform (intern (match-string 1 format))) + (params (if (match-end 2) + (read (concat "(" (match-string 2 format) ")")))) + (skip (plist-get params :skip)) + (skipcols (plist-get params :skipcols)) + (lines (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[ \t]*"))) + (lines (org-table-clean-before-export lines)) + (i0 (if org-table-clean-did-remove-column 2 1)) + (table (mapcar + (lambda (x) + (if (string-match org-table-hline-regexp x) + 'hline + (org-remove-by-index + (org-split-string (org-trim x) "\\s-*|\\s-*") + skipcols i0))) + lines)) + (fun (if (= i0 2) 'cdr 'identity)) + (org-table-last-alignment + (org-remove-by-index (funcall fun org-table-last-alignment) + skipcols i0)) + (org-table-last-column-widths + (org-remove-by-index (funcall fun org-table-last-column-widths) + skipcols i0))) + + (unless (fboundp transform) + (user-error "No such transformation function %s" transform)) + (setq txt (funcall transform table params)) + + (with-current-buffer (find-file-noselect file) + (setq buf (current-buffer)) + (erase-buffer) + (fundamental-mode) + (insert txt "\n") + (save-buffer)) + (kill-buffer buf) + (message "Export done.")) + (user-error "TABLE_EXPORT_FORMAT invalid")))) + +(defvar org-table-aligned-begin-marker (make-marker) + "Marker at the beginning of the table last aligned. +Used to check if cursor still is in that table, to minimize realignment.") +(defvar org-table-aligned-end-marker (make-marker) + "Marker at the end of the table last aligned. +Used to check if cursor still is in that table, to minimize realignment.") +(defvar org-table-last-alignment nil + "List of flags for flushright alignment, from the last re-alignment. +This is being used to correctly align a single field after TAB or RET.") +(defvar org-table-last-column-widths nil + "List of max width of fields in each column. +This is being used to correctly align a single field after TAB or RET.") +(defvar org-table-formula-debug nil + "Non-nil means debug table formulas. +When nil, simply write \"#ERROR\" in corrupted fields.") +(make-variable-buffer-local 'org-table-formula-debug) +(defvar org-table-overlay-coordinates nil + "Overlay coordinates after each align of a table.") +(make-variable-buffer-local 'org-table-overlay-coordinates) + +(defvar org-last-recalc-line nil) +(defvar org-table-do-narrow t) ; for dynamic scoping +(defconst org-narrow-column-arrow "=>" + "Used as display property in narrowed table columns.") + +;;;###autoload +(defun org-table-align () + "Align the table at point by aligning all vertical bars." + (interactive) + (let* ( + ;; Limits of table + (beg (org-table-begin)) + (end (org-table-end)) + ;; Current cursor position + (linepos (org-current-line)) + (colpos (org-table-current-column)) + (winstart (window-start)) + (winstartline (org-current-line (min winstart (1- (point-max))))) + lines (new "") lengths l typenums ty fields maxfields i + column + (indent "") cnt frac + rfmt hfmt + (spaces '(1 . 1)) + (sp1 (car spaces)) + (sp2 (cdr spaces)) + (rfmt1 (concat + (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) + (hfmt1 (concat + (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) + emptystrings links dates emph raise narrow + falign falign1 fmax f1 len c e space) + (untabify beg end) + (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) + ;; Check if we have links or dates + (goto-char beg) + (setq links (re-search-forward org-bracket-link-regexp end t)) + (goto-char beg) + (setq emph (and org-hide-emphasis-markers + (re-search-forward org-emph-re end t))) + (goto-char beg) + (setq raise (and org-use-sub-superscripts + (re-search-forward org-match-substring-regexp end t))) + (goto-char beg) + (setq dates (and org-display-custom-times + (re-search-forward org-ts-regexp-both end t))) + ;; Make sure the link properties are right + (when links (goto-char beg) (while (org-activate-bracket-links end))) + ;; Make sure the date properties are right + (when dates (goto-char beg) (while (org-activate-dates end))) + (when emph (goto-char beg) (while (org-do-emphasis-faces end))) + (when raise (goto-char beg) (while (org-raise-scripts end))) + + ;; Check if we are narrowing any columns + (goto-char beg) + (setq narrow (and org-table-do-narrow + org-format-transports-properties-p + (re-search-forward "<[lrc]?[0-9]+>" end t))) + (goto-char beg) + (setq falign (re-search-forward "<[lrc][0-9]*>" end t)) + (goto-char beg) + ;; Get the rows + (setq lines (org-split-string + (buffer-substring beg end) "\n")) + ;; Store the indentation of the first line + (if (string-match "^ *" (car lines)) + (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) + ;; Mark the hlines by setting the corresponding element to nil + ;; At the same time, we remove trailing space. + (setq lines (mapcar (lambda (l) + (if (string-match "^ *|-" l) + nil + (if (string-match "[ \t]+$" l) + (substring l 0 (match-beginning 0)) + l))) + lines)) + ;; Get the data fields by splitting the lines. + (setq fields (mapcar + (lambda (l) + (org-split-string l " *| *")) + (delq nil (copy-sequence lines)))) + ;; How many fields in the longest line? + (condition-case nil + (setq maxfields (apply 'max (mapcar 'length fields))) + (error + (kill-region beg end) + (org-table-create org-table-default-size) + (user-error "Empty table - created default table"))) + ;; A list of empty strings to fill any short rows on output + (setq emptystrings (make-list maxfields "")) + ;; Check for special formatting. + (setq i -1) + (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns + (setq column (mapcar (lambda (x) (or (nth i x) "")) fields)) + ;; Check if there is an explicit width specified + (setq fmax nil) + (when (or narrow falign) + (setq c column fmax nil falign1 nil) + (while c + (setq e (pop c)) + (when (and (stringp e) (string-match "^<\\([lrc]\\)?\\([0-9]+\\)?>$" e)) + (if (match-end 1) (setq falign1 (match-string 1 e))) + (if (and org-table-do-narrow (match-end 2)) + (setq fmax (string-to-number (match-string 2 e)) c nil)))) + ;; Find fields that are wider than fmax, and shorten them + (when fmax + (loop for xx in column do + (when (and (stringp xx) + (> (org-string-width xx) fmax)) + (org-add-props xx nil + 'help-echo + (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) + (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax))) + (unless (> f1 1) + (user-error "Cannot narrow field starting with wide link \"%s\"" + (match-string 0 xx))) + (add-text-properties f1 (length xx) (list 'org-cwidth t) xx) + (add-text-properties (- f1 2) f1 + (list 'display org-narrow-column-arrow) + xx))))) + ;; Get the maximum width for each column + (push (apply 'max (or fmax 1) 1 (mapcar 'org-string-width column)) + lengths) + ;; Get the fraction of numbers, to decide about alignment of the column + (if falign1 + (push (equal (downcase falign1) "r") typenums) + (setq cnt 0 frac 0.0) + (loop for x in column do + (if (equal x "") + nil + (setq frac ( / (+ (* frac cnt) + (if (string-match org-table-number-regexp x) 1 0)) + (setq cnt (1+ cnt)))))) + (push (>= frac org-table-number-fraction) typenums))) + (setq lengths (nreverse lengths) typenums (nreverse typenums)) + + ;; Store the alignment of this table, for later editing of single fields + (setq org-table-last-alignment typenums + org-table-last-column-widths lengths) + + ;; With invisible characters, `format' does not get the field width right + ;; So we need to make these fields wide by hand. + (when (or links emph raise) + (loop for i from 0 upto (1- maxfields) do + (setq len (nth i lengths)) + (loop for j from 0 upto (1- (length fields)) do + (setq c (nthcdr i (car (nthcdr j fields)))) + (if (and (stringp (car c)) + (or (text-property-any 0 (length (car c)) + 'invisible 'org-link (car c)) + (text-property-any 0 (length (car c)) + 'org-dwidth t (car c))) + (< (org-string-width (car c)) len)) + (progn + (setq space (make-string (- len (org-string-width (car c))) ?\ )) + (setcar c (if (nth i typenums) + (concat space (car c)) + (concat (car c) space)))))))) + + ;; Compute the formats needed for output of the table + (setq rfmt (concat indent "|") hfmt (concat indent "|")) + (while (setq l (pop lengths)) + (setq ty (if (pop typenums) "" "-")) ; number types flushright + (setq rfmt (concat rfmt (format rfmt1 ty l)) + hfmt (concat hfmt (format hfmt1 (make-string l ?-))))) + (setq rfmt (concat rfmt "\n") + hfmt (concat (substring hfmt 0 -1) "|\n")) + + (setq new (mapconcat + (lambda (l) + (if l (apply 'format rfmt + (append (pop fields) emptystrings)) + hfmt)) + lines "")) + (move-marker org-table-aligned-begin-marker (point)) + (insert new) + ;; Replace the old one + (delete-region (point) end) + (move-marker end nil) + (move-marker org-table-aligned-end-marker (point)) + (when (and orgtbl-mode (not (derived-mode-p 'org-mode))) + (goto-char org-table-aligned-begin-marker) + (while (org-hide-wide-columns org-table-aligned-end-marker))) + ;; Try to move to the old location + (org-goto-line winstartline) + (setq winstart (point-at-bol)) + (org-goto-line linepos) + (when (eq (window-buffer (selected-window)) (current-buffer)) + (set-window-start (selected-window) winstart 'noforce)) + (org-table-goto-column colpos) + (and org-table-overlay-coordinates (org-table-overlay-coordinates)) + (setq org-table-may-need-update nil) + )) + +;;;###autoload +(defun org-table-begin (&optional table-type) + "Find the beginning of the table and return its position. +With argument TABLE-TYPE, go to the beginning of a table.el-type table." + (save-excursion + (if (not (re-search-backward + (if table-type org-table-any-border-regexp + org-table-border-regexp) + nil t)) + (progn (goto-char (point-min)) (point)) + (goto-char (match-beginning 0)) + (beginning-of-line 2) + (point)))) + +;;;###autoload +(defun org-table-end (&optional table-type) + "Find the end of the table and return its position. +With argument TABLE-TYPE, go to the end of a table.el-type table." + (save-excursion + (if (not (re-search-forward + (if table-type org-table-any-border-regexp + org-table-border-regexp) + nil t)) + (goto-char (point-max)) + (goto-char (match-beginning 0))) + (point-marker))) + +;;;###autoload +(defun org-table-justify-field-maybe (&optional new) + "Justify the current field, text to left, number to right. +Optional argument NEW may specify text to replace the current field content." + (cond + ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway + ((org-at-table-hline-p)) + ((and (not new) + (or (not (equal (marker-buffer org-table-aligned-begin-marker) + (current-buffer))) + (< (point) org-table-aligned-begin-marker) + (>= (point) org-table-aligned-end-marker))) + ;; This is not the same table, force a full re-align + (setq org-table-may-need-update t)) + (t ;; realign the current field, based on previous full realign + (let* ((pos (point)) s + (col (org-table-current-column)) + (num (if (> col 0) (nth (1- col) org-table-last-alignment))) + l f n o e) + (when (> col 0) + (skip-chars-backward "^|\n") + (if (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)") + (progn + (setq s (match-string 1) + o (match-string 0) + l (max 1 (- (match-end 0) (match-beginning 0) 3)) + e (not (= (match-beginning 2) (match-end 2)))) + (setq f (format (if num " %%%ds %s" " %%-%ds %s") + l (if e "|" (setq org-table-may-need-update t) "")) + n (format f s)) + (if new + (if (<= (length new) l) ;; FIXME: length -> str-width? + (setq n (format f new)) + (setq n (concat new "|") org-table-may-need-update t))) + (if (equal (string-to-char n) ?-) (setq n (concat " " n))) + (or (equal n o) + (let (org-table-may-need-update) + (replace-match n t t)))) + (setq org-table-may-need-update t)) + (goto-char pos)))))) + +;;;###autoload +(defun org-table-next-field () + "Go to the next field in the current table, creating new lines as needed. +Before doing so, re-align the table if necessary." + (interactive) + (org-table-maybe-eval-formula) + (org-table-maybe-recalculate-line) + (if (and org-table-automatic-realign + org-table-may-need-update) + (org-table-align)) + (let ((end (org-table-end))) + (if (org-at-table-hline-p) + (end-of-line 1)) + (condition-case nil + (progn + (re-search-forward "|" end) + (if (looking-at "[ \t]*$") + (re-search-forward "|" end)) + (if (and (looking-at "-") + org-table-tab-jumps-over-hlines + (re-search-forward "^[ \t]*|\\([^-]\\)" end t)) + (goto-char (match-beginning 1))) + (if (looking-at "-") + (progn + (beginning-of-line 0) + (org-table-insert-row 'below)) + (if (looking-at " ") (forward-char 1)))) + (error + (org-table-insert-row 'below))))) + +;;;###autoload +(defun org-table-previous-field () + "Go to the previous field in the table. +Before doing so, re-align the table if necessary." + (interactive) + (org-table-justify-field-maybe) + (org-table-maybe-recalculate-line) + (if (and org-table-automatic-realign + org-table-may-need-update) + (org-table-align)) + (if (org-at-table-hline-p) + (end-of-line 1)) + (condition-case nil + (progn + (re-search-backward "|" (org-table-begin)) + (re-search-backward "|" (org-table-begin))) + (error (user-error "Cannot move to previous table field"))) + (while (looking-at "|\\(-\\|[ \t]*$\\)") + (re-search-backward "|" (org-table-begin))) + (if (looking-at "| ?") + (goto-char (match-end 0)))) + +(defun org-table-beginning-of-field (&optional n) + "Move to the end of the current table field. +If already at or after the end, move to the end of the next table field. +With numeric argument N, move N-1 fields forward first." + (interactive "p") + (let ((pos (point))) + (while (> n 1) + (setq n (1- n)) + (org-table-previous-field)) + (if (not (re-search-backward "|" (point-at-bol 0) t)) + (user-error "No more table fields before the current") + (goto-char (match-end 0)) + (and (looking-at " ") (forward-char 1))) + (if (>= (point) pos) (org-table-beginning-of-field 2)))) + +(defun org-table-end-of-field (&optional n) + "Move to the beginning of the current table field. +If already at or before the beginning, move to the beginning of the +previous field. +With numeric argument N, move N-1 fields backward first." + (interactive "p") + (let ((pos (point))) + (while (> n 1) + (setq n (1- n)) + (org-table-next-field)) + (when (re-search-forward "|" (point-at-eol 1) t) + (backward-char 1) + (skip-chars-backward " ") + (if (and (equal (char-before (point)) ?|) (looking-at " ")) + (forward-char 1))) + (if (<= (point) pos) (org-table-end-of-field 2)))) + +;;;###autoload +(defun org-table-next-row () + "Go to the next row (same column) in the current table. +Before doing so, re-align the table if necessary." + (interactive) + (org-table-maybe-eval-formula) + (org-table-maybe-recalculate-line) + (if (or (looking-at "[ \t]*$") + (save-excursion (skip-chars-backward " \t") (bolp))) + (newline) + (if (and org-table-automatic-realign + org-table-may-need-update) + (org-table-align)) + (let ((col (org-table-current-column))) + (beginning-of-line 2) + (if (or (not (org-at-table-p)) + (org-at-table-hline-p)) + (progn + (beginning-of-line 0) + (org-table-insert-row 'below))) + (org-table-goto-column col) + (skip-chars-backward "^|\n\r") + (if (looking-at " ") (forward-char 1))))) + +;;;###autoload +(defun org-table-copy-down (n) + "Copy a field down in the current column. +If the field at the cursor is empty, copy into it the content of +the nearest non-empty field above. With argument N, use the Nth +non-empty field. If the current field is not empty, it is copied +down to the next row, and the cursor is moved with it. +Therefore, repeating this command causes the column to be filled +row-by-row. +If the variable `org-table-copy-increment' is non-nil and the +field is an integer or a timestamp, it will be incremented while +copying. In the case of a timestamp, increment by one day." + (interactive "p") + (let* ((colpos (org-table-current-column)) + (col (current-column)) + (field (save-excursion (org-table-get-field))) + (non-empty (string-match "[^ \t]" field)) + (beg (org-table-begin)) + (orig-n n) + txt) + (org-table-check-inside-data-field) + (if non-empty + (progn + (setq txt (org-trim field)) + (org-table-next-row) + (org-table-blank-field)) + (save-excursion + (setq txt + (catch 'exit + (while (progn (beginning-of-line 1) + (re-search-backward org-table-dataline-regexp + beg t)) + (org-table-goto-column colpos t) + (if (and (looking-at + "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") + (<= (setq n (1- n)) 0)) + (throw 'exit (match-string 1)))))))) + (if txt + (progn + (if (and org-table-copy-increment + (not (equal orig-n 0)) + (string-match "^[0-9]+$" txt) + (< (string-to-number txt) 100000000)) + (setq txt (format "%d" (+ (string-to-number txt) 1)))) + (insert txt) + (org-move-to-column col) + (if (and org-table-copy-increment (org-at-timestamp-p t)) + (org-timestamp-up-day) + (org-table-maybe-recalculate-line)) + (org-table-align) + (org-move-to-column col)) + (user-error "No non-empty field found")))) + +(defun org-table-check-inside-data-field (&optional noerror) + "Is point inside a table data field? +I.e. not on a hline or before the first or after the last column? +This actually throws an error, so it aborts the current command." + (if (or (not (org-at-table-p)) + (= (org-table-current-column) 0) + (org-at-table-hline-p) + (looking-at "[ \t]*$")) + (if noerror + nil + (user-error "Not in table data field")) + t)) + +(defvar org-table-clip nil + "Clipboard for table regions.") + +(defun org-table-get (line column) + "Get the field in table line LINE, column COLUMN. +If LINE is larger than the number of data lines in the table, the function +returns nil. However, if COLUMN is too large, we will simply return an +empty string. +If LINE is nil, use the current line. +If column is nil, use the current column." + (setq column (or column (org-table-current-column))) + (save-excursion + (and (or (not line) (org-table-goto-line line)) + (org-trim (org-table-get-field column))))) + +(defun org-table-put (line column value &optional align) + "Put VALUE into line LINE, column COLUMN. +When ALIGN is set, also realign the table." + (setq column (or column (org-table-current-column))) + (prog1 (save-excursion + (and (or (not line) (org-table-goto-line line)) + (progn (org-table-goto-column column nil 'force) t) + (org-table-get-field column value))) + (and align (org-table-align)))) + +(defun org-table-current-line () + "Return the index of the current data line." + (let ((pos (point)) (end (org-table-end)) (cnt 0)) + (save-excursion + (goto-char (org-table-begin)) + (while (and (re-search-forward org-table-dataline-regexp end t) + (setq cnt (1+ cnt)) + (< (point-at-eol) pos)))) + cnt)) + +(defun org-table-goto-line (N) + "Go to the Nth data line in the current table. +Return t when the line exists, nil if it does not exist." + (goto-char (org-table-begin)) + (let ((end (org-table-end)) (cnt 0)) + (while (and (re-search-forward org-table-dataline-regexp end t) + (< (setq cnt (1+ cnt)) N))) + (= cnt N))) + +;;;###autoload +(defun org-table-blank-field () + "Blank the current table field or active region." + (interactive) + (org-table-check-inside-data-field) + (if (and (org-called-interactively-p 'any) (org-region-active-p)) + (let (org-table-clip) + (org-table-cut-region (region-beginning) (region-end))) + (skip-chars-backward "^|") + (backward-char 1) + (if (looking-at "|[^|\n]+") + (let* ((pos (match-beginning 0)) + (match (match-string 0)) + (len (org-string-width match))) + (replace-match (concat "|" (make-string (1- len) ?\ ))) + (goto-char (+ 2 pos)) + (substring match 1))))) + +(defun org-table-get-field (&optional n replace) + "Return the value of the field in column N of current row. +N defaults to current field. +If REPLACE is a string, replace field with this value. The return value +is always the old value." + (and n (org-table-goto-column n)) + (skip-chars-backward "^|\n") + (backward-char 1) + (if (looking-at "|[^|\r\n]*") + (let* ((pos (match-beginning 0)) + (val (buffer-substring (1+ pos) (match-end 0)))) + (if replace + (replace-match (concat "|" (if (equal replace "") " " replace)) + t t)) + (goto-char (min (point-at-eol) (+ 2 pos))) + val) + (forward-char 1) "")) + +;;;###autoload +(defun org-table-field-info (arg) + "Show info about the current field, and highlight any reference at point." + (interactive "P") + (unless (org-at-table-p) (user-error "Not at a table")) + (org-table-get-specials) + (save-excursion + (let* ((pos (point)) + (col (org-table-current-column)) + (cname (car (rassoc (int-to-string col) org-table-column-names))) + (name (car (rassoc (list (org-current-line) col) + org-table-named-field-locations))) + (eql (org-table-expand-lhs-ranges + (mapcar + (lambda (e) + (cons (org-table-formula-handle-first/last-rc + (car e)) (cdr e))) + (org-table-get-stored-formulas)))) + (dline (org-table-current-dline)) + (ref (format "@%d$%d" dline col)) + (ref1 (org-table-convert-refs-to-an ref)) + (fequation (or (assoc name eql) (assoc ref eql))) + (cequation (assoc (int-to-string col) eql)) + (eqn (or fequation cequation))) + (if (and eqn (get-text-property 0 :orig-eqn (car eqn))) + (setq eqn (get-text-property 0 :orig-eqn (car eqn)))) + (goto-char pos) + (condition-case nil + (org-table-show-reference 'local) + (error nil)) + (message "line @%d, col $%s%s, ref @%d$%d or %s%s%s" + dline col + (if cname (concat " or $" cname) "") + dline col ref1 + (if name (concat " or $" name) "") + ;; FIXME: formula info not correct if special table line + (if eqn + (concat ", formula: " + (org-table-formula-to-user + (concat + (if (string-match "^[$@]"(car eqn)) "" "$") + (car eqn) "=" (cdr eqn)))) + ""))))) + +(defun org-table-current-column () + "Find out which column we are in." + (interactive) + (if (org-called-interactively-p 'any) (org-table-check-inside-data-field)) + (save-excursion + (let ((cnt 0) (pos (point))) + (beginning-of-line 1) + (while (search-forward "|" pos t) + (setq cnt (1+ cnt))) + (when (org-called-interactively-p 'interactive) + (message "In table column %d" cnt)) + cnt))) + +;;;###autoload +(defun org-table-current-dline () + "Find out what table data line we are in. +Only data lines count for this." + (interactive) + (when (org-called-interactively-p 'any) + (org-table-check-inside-data-field)) + (save-excursion + (let ((cnt 0) (pos (point))) + (goto-char (org-table-begin)) + (while (<= (point) pos) + (if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt))) + (beginning-of-line 2)) + (when (org-called-interactively-p 'any) + (message "This is table line %d" cnt)) + cnt))) + +;;;###autoload +(defun org-table-goto-column (n &optional on-delim force) + "Move the cursor to the Nth column in the current table line. +With optional argument ON-DELIM, stop with point before the left delimiter +of the field. +If there are less than N fields, just go to after the last delimiter. +However, when FORCE is non-nil, create new columns if necessary." + (interactive "p") + (beginning-of-line 1) + (when (> n 0) + (while (and (> (setq n (1- n)) -1) + (or (search-forward "|" (point-at-eol) t) + (and force + (progn (end-of-line 1) + (skip-chars-backward "^|") + (insert " | ") + t))))) + (when (and force (not (looking-at ".*|"))) + (save-excursion (end-of-line 1) (insert " | "))) + (if on-delim + (backward-char 1) + (if (looking-at " ") (forward-char 1))))) + +;;;###autoload +(defun org-table-insert-column () + "Insert a new column into the table." + (interactive) + (if (not (org-at-table-p)) + (user-error "Not at a table")) + (org-table-find-dataline) + (let* ((col (max 1 (org-table-current-column))) + (beg (org-table-begin)) + (end (org-table-end)) + ;; Current cursor position + (linepos (org-current-line)) + (colpos col)) + (goto-char beg) + (while (< (point) end) + (if (org-at-table-hline-p) + nil + (org-table-goto-column col t) + (insert "| ")) + (beginning-of-line 2)) + (move-marker end nil) + (org-goto-line linepos) + (org-table-goto-column colpos) + (org-table-align) + (when (or (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm "Fix formulas? ")) + (org-table-fix-formulas "$" nil (1- col) 1) + (org-table-fix-formulas "$LR" nil (1- col) 1)))) + +(defun org-table-find-dataline () + "Find a data line in the current table, which is needed for column commands." + (if (and (org-at-table-p) + (not (org-at-table-hline-p))) + t + (let ((col (current-column)) + (end (org-table-end))) + (org-move-to-column col) + (while (and (< (point) end) + (or (not (= (current-column) col)) + (org-at-table-hline-p))) + (beginning-of-line 2) + (org-move-to-column col)) + (if (and (org-at-table-p) + (not (org-at-table-hline-p))) + t + (user-error + "Please position cursor in a data line for column operations"))))) + +(defun org-table-line-to-dline (line &optional above) + "Turn a buffer line number into a data line number. +If there is no data line in this line, return nil. +If there is no matching dline (most likely te reference was a hline), the +first dline below it is used. When ABOVE is non-nil, the one above is used." + (catch 'exit + (let ((ll (length org-table-dlines)) + i) + (if above + (progn + (setq i (1- ll)) + (while (> i 0) + (if (<= (aref org-table-dlines i) line) + (throw 'exit i)) + (setq i (1- i)))) + (setq i 1) + (while (< i ll) + (if (>= (aref org-table-dlines i) line) + (throw 'exit i)) + (setq i (1+ i))))) + nil)) + +;;;###autoload +(defun org-table-delete-column () + "Delete a column from the table." + (interactive) + (if (not (org-at-table-p)) + (user-error "Not at a table")) + (org-table-find-dataline) + (org-table-check-inside-data-field) + (let* ((col (org-table-current-column)) + (beg (org-table-begin)) + (end (org-table-end)) + ;; Current cursor position + (linepos (org-current-line)) + (colpos col)) + (goto-char beg) + (while (< (point) end) + (if (org-at-table-hline-p) + nil + (org-table-goto-column col t) + (and (looking-at "|[^|\n]+|") + (replace-match "|"))) + (beginning-of-line 2)) + (move-marker end nil) + (org-goto-line linepos) + (org-table-goto-column colpos) + (org-table-align) + (when (or (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm "Fix formulas? ")) + (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID")) + col -1 col) + (org-table-fix-formulas "$LR" (list (cons (number-to-string col) "INVALID")) + col -1 col)))) + +;;;###autoload +(defun org-table-move-column-right () + "Move column to the right." + (interactive) + (org-table-move-column nil)) +;;;###autoload +(defun org-table-move-column-left () + "Move column to the left." + (interactive) + (org-table-move-column 'left)) + +;;;###autoload +(defun org-table-move-column (&optional left) + "Move the current column to the right. With arg LEFT, move to the left." + (interactive "P") + (if (not (org-at-table-p)) + (user-error "Not at a table")) + (org-table-find-dataline) + (org-table-check-inside-data-field) + (let* ((col (org-table-current-column)) + (col1 (if left (1- col) col)) + (beg (org-table-begin)) + (end (org-table-end)) + ;; Current cursor position + (linepos (org-current-line)) + (colpos (if left (1- col) (1+ col)))) + (if (and left (= col 1)) + (user-error "Cannot move column further left")) + (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) + (user-error "Cannot move column further right")) + (goto-char beg) + (while (< (point) end) + (if (org-at-table-hline-p) + nil + (org-table-goto-column col1 t) + (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") + (replace-match "|\\2|\\1|"))) + (beginning-of-line 2)) + (move-marker end nil) + (org-goto-line linepos) + (org-table-goto-column colpos) + (org-table-align) + (when (or (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm "Fix formulas? ")) + (org-table-fix-formulas + "$" (list (cons (number-to-string col) (number-to-string colpos)) + (cons (number-to-string colpos) (number-to-string col)))) + (org-table-fix-formulas + "$LR" (list (cons (number-to-string col) (number-to-string colpos)) + (cons (number-to-string colpos) (number-to-string col))))))) + +;;;###autoload +(defun org-table-move-row-down () + "Move table row down." + (interactive) + (org-table-move-row nil)) +;;;###autoload +(defun org-table-move-row-up () + "Move table row up." + (interactive) + (org-table-move-row 'up)) + +;;;###autoload +(defun org-table-move-row (&optional up) + "Move the current table line down. With arg UP, move it up." + (interactive "P") + (let* ((col (current-column)) + (pos (point)) + (hline1p (save-excursion (beginning-of-line 1) + (looking-at org-table-hline-regexp))) + (dline1 (org-table-current-dline)) + (dline2 (+ dline1 (if up -1 1))) + (tonew (if up 0 2)) + txt hline2p) + (beginning-of-line tonew) + (unless (org-at-table-p) + (goto-char pos) + (user-error "Cannot move row further")) + (setq hline2p (looking-at org-table-hline-regexp)) + (goto-char pos) + (beginning-of-line 1) + (setq pos (point)) + (setq txt (buffer-substring (point) (1+ (point-at-eol)))) + (delete-region (point) (1+ (point-at-eol))) + (beginning-of-line tonew) + (insert txt) + (beginning-of-line 0) + (org-move-to-column col) + (unless (or hline1p hline2p + (not (or (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm + "Fix formulas? ")))) + (org-table-fix-formulas + "@" (list (cons (number-to-string dline1) (number-to-string dline2)) + (cons (number-to-string dline2) (number-to-string dline1))))))) + +;;;###autoload +(defun org-table-insert-row (&optional arg) + "Insert a new row above the current line into the table. +With prefix ARG, insert below the current line." + (interactive "P") + (if (not (org-at-table-p)) + (user-error "Not at a table")) + (let* ((line (buffer-substring (point-at-bol) (point-at-eol))) + (new (org-table-clean-line line))) + ;; Fix the first field if necessary + (if (string-match "^[ \t]*| *[#$] *|" line) + (setq new (replace-match (match-string 0 line) t t new))) + (beginning-of-line (if arg 2 1)) + (let (org-table-may-need-update) (insert-before-markers new "\n")) + (beginning-of-line 0) + (re-search-forward "| ?" (point-at-eol) t) + (and (or org-table-may-need-update org-table-overlay-coordinates) + (org-table-align)) + (when (or (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm "Fix formulas? ")) + (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1)))) + +;;;###autoload +(defun org-table-insert-hline (&optional above) + "Insert a horizontal-line below the current line into the table. +With prefix ABOVE, insert above the current line." + (interactive "P") + (if (not (org-at-table-p)) + (user-error "Not at a table")) + (when (eobp) (insert "\n") (backward-char 1)) + (if (not (string-match "|[ \t]*$" (org-current-line-string))) + (org-table-align)) + (let ((line (org-table-clean-line + (buffer-substring (point-at-bol) (point-at-eol)))) + (col (current-column))) + (while (string-match "|\\( +\\)|" line) + (setq line (replace-match + (concat "+" (make-string (- (match-end 1) (match-beginning 1)) + ?-) "|") t t line))) + (and (string-match "\\+" line) (setq line (replace-match "|" t t line))) + (beginning-of-line (if above 1 2)) + (insert line "\n") + (beginning-of-line (if above 1 -1)) + (org-move-to-column col) + (and org-table-overlay-coordinates (org-table-align)))) + +;;;###autoload +(defun org-table-hline-and-move (&optional same-column) + "Insert a hline and move to the row below that line." + (interactive "P") + (let ((col (org-table-current-column))) + (org-table-maybe-eval-formula) + (org-table-maybe-recalculate-line) + (org-table-insert-hline) + (end-of-line 2) + (if (looking-at "\n[ \t]*|-") + (progn (insert "\n|") (org-table-align)) + (org-table-next-field)) + (if same-column (org-table-goto-column col)))) + +(defun org-table-clean-line (s) + "Convert a table line S into a string with only \"|\" and space. +In particular, this does handle wide and invisible characters." + (if (string-match "^[ \t]*|-" s) + ;; It's a hline, just map the characters + (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s "")) + (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s) + (setq s (replace-match + (concat "|" (make-string (org-string-width (match-string 1 s)) + ?\ ) "|") + t t s))) + s)) + +;;;###autoload +(defun org-table-kill-row () + "Delete the current row or horizontal line from the table." + (interactive) + (if (not (org-at-table-p)) + (user-error "Not at a table")) + (let ((col (current-column)) + (dline (org-table-current-dline))) + (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) + (if (not (org-at-table-p)) (beginning-of-line 0)) + (org-move-to-column col) + (when (or (not org-table-fix-formulas-confirm) + (funcall org-table-fix-formulas-confirm "Fix formulas? ")) + (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID")) + dline -1 dline)))) + +;;;###autoload +(defun org-table-sort-lines (with-case &optional sorting-type) + "Sort table lines according to the column at point. + +The position of point indicates the column to be used for +sorting, and the range of lines is the range between the nearest +horizontal separator lines, or the entire table of no such lines +exist. If point is before the first column, you will be prompted +for the sorting column. If there is an active region, the mark +specifies the first line and the sorting column, while point +should be in the last line to be included into the sorting. + +The command then prompts for the sorting type which can be +alphabetically, numerically, or by time (as given in a time stamp +in the field). Sorting in reverse order is also possible. + +With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive. + +If SORTING-TYPE is specified when this function is called from a Lisp +program, no prompting will take place. SORTING-TYPE must be a character, +any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting +should be done in reverse order." + (interactive "P") + (let* ((thisline (org-current-line)) + (thiscol (org-table-current-column)) + (otc org-table-overlay-coordinates) + beg end bcol ecol tend tbeg column lns pos) + (when (equal thiscol 0) + (if (org-called-interactively-p 'any) + (setq thiscol + (string-to-number + (read-string "Use column N for sorting: "))) + (setq thiscol 1)) + (org-table-goto-column thiscol)) + (org-table-check-inside-data-field) + (if (org-region-active-p) + (progn + (setq beg (region-beginning) end (region-end)) + (goto-char beg) + (setq column (org-table-current-column) + beg (point-at-bol)) + (goto-char end) + (setq end (point-at-bol 2))) + (setq column (org-table-current-column) + pos (point) + tbeg (org-table-begin) + tend (org-table-end)) + (if (re-search-backward org-table-hline-regexp tbeg t) + (setq beg (point-at-bol 2)) + (goto-char tbeg) + (setq beg (point-at-bol 1))) + (goto-char pos) + (if (re-search-forward org-table-hline-regexp tend t) + (setq end (point-at-bol 1)) + (goto-char tend) + (setq end (point-at-bol)))) + (setq beg (move-marker (make-marker) beg) + end (move-marker (make-marker) end)) + (untabify beg end) + (goto-char beg) + (org-table-goto-column column) + (skip-chars-backward "^|") + (setq bcol (current-column)) + (org-table-goto-column (1+ column)) + (skip-chars-backward "^|") + (setq ecol (1- (current-column))) + (org-table-goto-column column) + (setq lns (mapcar (lambda(x) (cons + (org-sort-remove-invisible + (nth (1- column) + (org-split-string x "[ \t]*|[ \t]*"))) + x)) + (org-split-string (buffer-substring beg end) "\n"))) + (setq lns (org-do-sort lns "Table" with-case sorting-type)) + (when org-table-overlay-coordinates + (org-table-toggle-coordinate-overlays)) + (delete-region beg end) + (move-marker beg nil) + (move-marker end nil) + (insert (mapconcat 'cdr lns "\n") "\n") + (org-goto-line thisline) + (org-table-goto-column thiscol) + (when otc (org-table-toggle-coordinate-overlays)) + (message "%d lines sorted, based on column %d" (length lns) column))) + +;;;###autoload +(defun org-table-cut-region (beg end) + "Copy region in table to the clipboard and blank all relevant fields. +If there is no active region, use just the field at point." + (interactive (list + (if (org-region-active-p) (region-beginning) (point)) + (if (org-region-active-p) (region-end) (point)))) + (org-table-copy-region beg end 'cut)) + +;;;###autoload +(defun org-table-copy-region (beg end &optional cut) + "Copy rectangular region in table to clipboard. +A special clipboard is used which can only be accessed +with `org-table-paste-rectangle'." + (interactive (list + (if (org-region-active-p) (region-beginning) (point)) + (if (org-region-active-p) (region-end) (point)) + current-prefix-arg)) + (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 + region cols + (rpl (if cut " " nil))) + (goto-char beg) + (org-table-check-inside-data-field) + (setq l01 (org-current-line) + c01 (org-table-current-column)) + (goto-char end) + (org-table-check-inside-data-field) + (setq l02 (org-current-line) + c02 (org-table-current-column)) + (setq l1 (min l01 l02) l2 (max l01 l02) + c1 (min c01 c02) c2 (max c01 c02)) + (catch 'exit + (while t + (catch 'nextline + (if (> l1 l2) (throw 'exit t)) + (org-goto-line l1) + (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1)))) + (setq cols nil ic1 c1 ic2 c2) + (while (< ic1 (1+ ic2)) + (push (org-table-get-field ic1 rpl) cols) + (setq ic1 (1+ ic1))) + (push (nreverse cols) region) + (setq l1 (1+ l1))))) + (setq org-table-clip (nreverse region)) + (if cut (org-table-align)) + org-table-clip)) + +;;;###autoload +(defun org-table-paste-rectangle () + "Paste a rectangular region into a table. +The upper right corner ends up in the current field. All involved fields +will be overwritten. If the rectangle does not fit into the present table, +the table is enlarged as needed. The process ignores horizontal separator +lines." + (interactive) + (unless (and org-table-clip (listp org-table-clip)) + (user-error "First cut/copy a region to paste!")) + (org-table-check-inside-data-field) + (let* ((clip org-table-clip) + (line (org-current-line)) + (col (org-table-current-column)) + (org-enable-table-editor t) + (org-table-automatic-realign nil) + c cols field) + (while (setq cols (pop clip)) + (while (org-at-table-hline-p) (beginning-of-line 2)) + (if (not (org-at-table-p)) + (progn (end-of-line 0) (org-table-next-field))) + (setq c col) + (while (setq field (pop cols)) + (org-table-goto-column c nil 'force) + (org-table-get-field nil field) + (setq c (1+ c))) + (beginning-of-line 2)) + (org-goto-line line) + (org-table-goto-column col) + (org-table-align))) + +;;;###autoload +(defun org-table-convert () + "Convert from `org-mode' table to table.el and back. +Obviously, this only works within limits. When an Org-mode table is +converted to table.el, all horizontal separator lines get lost, because +table.el uses these as cell boundaries and has no notion of horizontal lines. +A table.el table can be converted to an Org-mode table only if it does not +do row or column spanning. Multiline cells will become multiple cells. +Beware, Org-mode does not test if the table can be successfully converted - it +blindly applies a recipe that works for simple tables." + (interactive) + (require 'table) + (if (org-at-table.el-p) + ;; convert to Org-mode table + (let ((beg (move-marker (make-marker) (org-table-begin t))) + (end (move-marker (make-marker) (org-table-end t)))) + (table-unrecognize-region beg end) + (goto-char beg) + (while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t) + (replace-match "")) + (goto-char beg)) + (if (org-at-table-p) + ;; convert to table.el table + (let ((beg (move-marker (make-marker) (org-table-begin))) + (end (move-marker (make-marker) (org-table-end)))) + ;; first, get rid of all horizontal lines + (goto-char beg) + (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t) + (replace-match "")) + ;; insert a hline before first + (goto-char beg) + (org-table-insert-hline 'above) + (beginning-of-line -1) + ;; insert a hline after each line + (while (progn (beginning-of-line 3) (< (point) end)) + (org-table-insert-hline)) + (goto-char beg) + (setq end (move-marker end (org-table-end))) + ;; replace "+" at beginning and ending of hlines + (while (re-search-forward "^\\([ \t]*\\)|-" end t) + (replace-match "\\1+-")) + (goto-char beg) + (while (re-search-forward "-|[ \t]*$" end t) + (replace-match "-+")) + (goto-char beg))))) + +(defun org-table-transpose-table-at-point () + "Transpose orgmode table at point and eliminate hlines. +So a table like + +| 1 | 2 | 4 | 5 | +|---+---+---+---| +| a | b | c | d | +| e | f | g | h | + +will be transposed as + +| 1 | a | e | +| 2 | b | f | +| 4 | c | g | +| 5 | d | h | + +Note that horizontal lines disappeared." + (interactive) + (let* ((table (delete 'hline (org-table-to-lisp))) + (contents (mapcar (lambda (p) + (let ((tp table)) + (mapcar + (lambda (rown) + (prog1 + (pop (car tp)) + (setq tp (cdr tp)))) + table))) + (car table)))) + (delete-region (org-table-begin) (org-table-end)) + (insert (mapconcat (lambda(x) (concat "| " (mapconcat 'identity x " | " ) " |\n" )) + contents "")) + (org-table-align))) + +;;;###autoload +(defun org-table-wrap-region (arg) + "Wrap several fields in a column like a paragraph. +This is useful if you'd like to spread the contents of a field over several +lines, in order to keep the table compact. + +If there is an active region, and both point and mark are in the same column, +the text in the column is wrapped to minimum width for the given number of +lines. Generally, this makes the table more compact. A prefix ARG may be +used to change the number of desired lines. For example, `C-2 \\[org-table-wrap]' +formats the selected text to two lines. If the region was longer than two +lines, the remaining lines remain empty. A negative prefix argument reduces +the current number of lines by that amount. The wrapped text is pasted back +into the table. If you formatted it to more lines than it was before, fields +further down in the table get overwritten - so you might need to make space in +the table first. + +If there is no region, the current field is split at the cursor position and +the text fragment to the right of the cursor is prepended to the field one +line down. + +If there is no region, but you specify a prefix ARG, the current field gets +blank, and the content is appended to the field above." + (interactive "P") + (org-table-check-inside-data-field) + (if (org-region-active-p) + ;; There is a region: fill as a paragraph + (let* ((beg (region-beginning)) + (cline (save-excursion (goto-char beg) (org-current-line))) + (ccol (save-excursion (goto-char beg) (org-table-current-column))) + nlines) + (org-table-cut-region (region-beginning) (region-end)) + (if (> (length (car org-table-clip)) 1) + (user-error "Region must be limited to single column")) + (setq nlines (if arg + (if (< arg 1) + (+ (length org-table-clip) arg) + arg) + (length org-table-clip))) + (setq org-table-clip + (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") + nil nlines))) + (org-goto-line cline) + (org-table-goto-column ccol) + (org-table-paste-rectangle)) + ;; No region, split the current field at point + (unless (org-get-alist-option org-M-RET-may-split-line 'table) + (skip-chars-forward "^\r\n|")) + (if arg + ;; combine with field above + (let ((s (org-table-blank-field)) + (col (org-table-current-column))) + (beginning-of-line 0) + (while (org-at-table-hline-p) (beginning-of-line 0)) + (org-table-goto-column col) + (skip-chars-forward "^|") + (skip-chars-backward " ") + (insert " " (org-trim s)) + (org-table-align)) + ;; split field + (if (looking-at "\\([^|]+\\)+|") + (let ((s (match-string 1))) + (replace-match " |") + (goto-char (match-beginning 0)) + (org-table-next-row) + (insert (org-trim s) " ") + (org-table-align)) + (org-table-next-row))))) + +(defvar org-field-marker nil) + +;;;###autoload +(defun org-table-edit-field (arg) + "Edit table field in a different window. +This is mainly useful for fields that contain hidden parts. +When called with a \\[universal-argument] prefix, just make the full field visible so that +it can be edited in place." + (interactive "P") + (cond + ((equal arg '(16)) + (org-table-follow-field-mode (if org-table-follow-field-mode -1 1))) + (arg + (let ((b (save-excursion (skip-chars-backward "^|") (point))) + (e (save-excursion (skip-chars-forward "^|\r\n") (point)))) + (remove-text-properties b e '(org-cwidth t invisible t + display t intangible t)) + (if (and (boundp 'font-lock-mode) font-lock-mode) + (font-lock-fontify-block)))) + (t + (let ((pos (point-marker)) + (coord + (if (eq org-table-use-standard-references t) + (concat (org-number-to-letters (org-table-current-column)) + (int-to-string (org-table-current-dline))) + (concat "@" (int-to-string (org-table-current-dline)) + "$" (int-to-string (org-table-current-column))))) + (field (org-table-get-field)) + (cw (current-window-configuration)) + p) + (goto-char pos) + (org-switch-to-buffer-other-window "*Org Table Edit Field*") + (when (and (local-variable-p 'org-field-marker) + (markerp org-field-marker)) + (move-marker org-field-marker nil)) + (erase-buffer) + (insert "#\n# Edit field " coord " and finish with C-c C-c\n#\n") + (let ((org-inhibit-startup t)) (org-mode)) + (auto-fill-mode -1) + (setq truncate-lines nil) + (setq word-wrap t) + (goto-char (setq p (point-max))) + (insert (org-trim field)) + (remove-text-properties p (point-max) + '(invisible t org-cwidth t display t + intangible t)) + (goto-char p) + (org-set-local 'org-finish-function 'org-table-finish-edit-field) + (org-set-local 'org-window-configuration cw) + (org-set-local 'org-field-marker pos) + (message "Edit and finish with C-c C-c"))))) + +(defun org-table-finish-edit-field () + "Finish editing a table data field. +Remove all newline characters, insert the result into the table, realign +the table and kill the editing buffer." + (let ((pos org-field-marker) + (cw org-window-configuration) + (cb (current-buffer)) + text) + (goto-char (point-min)) + (while (re-search-forward "^#.*\n?" nil t) (replace-match "")) + (while (re-search-forward "\\([ \t]*\n[ \t]*\\)+" nil t) + (replace-match " ")) + (setq text (org-trim (buffer-string))) + (set-window-configuration cw) + (kill-buffer cb) + (select-window (get-buffer-window (marker-buffer pos))) + (goto-char pos) + (move-marker pos nil) + (org-table-check-inside-data-field) + (org-table-get-field nil text) + (org-table-align) + (message "New field value inserted"))) + +(define-minor-mode org-table-follow-field-mode + "Minor mode to make the table field editor window follow the cursor. +When this mode is active, the field editor window will always show the +current field. The mode exits automatically when the cursor leaves the +table (but see `org-table-exit-follow-field-mode-when-leaving-table')." + nil " TblFollow" nil + (if org-table-follow-field-mode + (org-add-hook 'post-command-hook 'org-table-follow-fields-with-editor + 'append 'local) + (remove-hook 'post-command-hook 'org-table-follow-fields-with-editor 'local) + (let* ((buf (get-buffer "*Org Table Edit Field*")) + (win (and buf (get-buffer-window buf)))) + (when win (delete-window win)) + (when buf + (with-current-buffer buf + (move-marker org-field-marker nil)) + (kill-buffer buf))))) + +(defun org-table-follow-fields-with-editor () + (if (and org-table-exit-follow-field-mode-when-leaving-table + (not (org-at-table-p))) + ;; We have left the table, exit the follow mode + (org-table-follow-field-mode -1) + (when (org-table-check-inside-data-field 'noerror) + (let ((win (selected-window))) + (org-table-edit-field nil) + (org-fit-window-to-buffer) + (select-window win))))) + +(defvar org-timecnt) ; dynamically scoped parameter + +;;;###autoload +(defun org-table-sum (&optional beg end nlast) + "Sum numbers in region of current table column. +The result will be displayed in the echo area, and will be available +as kill to be inserted with \\[yank]. + +If there is an active region, it is interpreted as a rectangle and all +numbers in that rectangle will be summed. If there is no active +region and point is located in a table column, sum all numbers in that +column. + +If at least one number looks like a time HH:MM or HH:MM:SS, all other +numbers are assumed to be times as well (in decimal hours) and the +numbers are added as such. + +If NLAST is a number, only the NLAST fields will actually be summed." + (interactive) + (save-excursion + (let (col (org-timecnt 0) diff h m s org-table-clip) + (cond + ((and beg end)) ; beg and end given explicitly + ((org-region-active-p) + (setq beg (region-beginning) end (region-end))) + (t + (setq col (org-table-current-column)) + (goto-char (org-table-begin)) + (unless (re-search-forward "^[ \t]*|[^-]" nil t) + (user-error "No table data")) + (org-table-goto-column col) + (setq beg (point)) + (goto-char (org-table-end)) + (unless (re-search-backward "^[ \t]*|[^-]" nil t) + (user-error "No table data")) + (org-table-goto-column col) + (setq end (point)))) + (let* ((items (apply 'append (org-table-copy-region beg end))) + (items1 (cond ((not nlast) items) + ((>= nlast (length items)) items) + (t (setq items (reverse items)) + (setcdr (nthcdr (1- nlast) items) nil) + (nreverse items)))) + (numbers (delq nil (mapcar 'org-table-get-number-for-summing + items1))) + (res (apply '+ numbers)) + (sres (if (= org-timecnt 0) + (number-to-string res) + (setq diff (* 3600 res) + h (floor (/ diff 3600)) diff (mod diff 3600) + m (floor (/ diff 60)) diff (mod diff 60) + s diff) + (format "%.0f:%02.0f:%02.0f" h m s)))) + (kill-new sres) + (if (org-called-interactively-p 'interactive) + (message "%s" + (substitute-command-keys + (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" + (length numbers) sres)))) + sres)))) + +(defun org-table-get-number-for-summing (s) + (let (n) + (if (string-match "^ *|? *" s) + (setq s (replace-match "" nil nil s))) + (if (string-match " *|? *$" s) + (setq s (replace-match "" nil nil s))) + (setq n (string-to-number s)) + (cond + ((and (string-match "0" s) + (string-match "\\`[-+ \t0.edED]+\\'" s)) 0) + ((string-match "\\`[ \t]+\\'" s) nil) + ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s) + (let ((h (string-to-number (or (match-string 1 s) "0"))) + (m (string-to-number (or (match-string 2 s) "0"))) + (s (string-to-number (or (match-string 4 s) "0")))) + (if (boundp 'org-timecnt) (setq org-timecnt (1+ org-timecnt))) + (* 1.0 (+ h (/ m 60.0) (/ s 3600.0))))) + ((equal n 0) nil) + (t n)))) + +(defun org-table-current-field-formula (&optional key noerror) + "Return the formula active for the current field. +Assumes that specials are in place. +If KEY is given, return the key to this formula. +Otherwise return the formula preceded with \"=\" or \":=\"." + (let* ((name (car (rassoc (list (org-current-line) + (org-table-current-column)) + org-table-named-field-locations))) + (col (org-table-current-column)) + (scol (int-to-string col)) + (ref (format "@%d$%d" (org-table-current-dline) col)) + (stored-list (org-table-get-stored-formulas noerror)) + (ass (or (assoc name stored-list) + (assoc ref stored-list) + (assoc scol stored-list)))) + (if key + (car ass) + (if ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=") + (cdr ass)))))) + +(defun org-table-get-formula (&optional equation named) + "Read a formula from the minibuffer, offer stored formula as default. +When NAMED is non-nil, look for a named equation." + (let* ((stored-list (org-table-get-stored-formulas)) + (name (car (rassoc (list (org-current-line) + (org-table-current-column)) + org-table-named-field-locations))) + (ref (format "@%d$%d" (org-table-current-dline) + (org-table-current-column))) + (refass (assoc ref stored-list)) + (nameass (assoc name stored-list)) + (scol (if named + (if (and name (not (string-match "^LR[0-9]+$" name))) + name + ref) + (int-to-string (org-table-current-column)))) + (dummy (and (or nameass refass) (not named) + (not (y-or-n-p "Replace existing field formula with column formula? " )) + (message "Formula not replaced"))) + (name (or name ref)) + (org-table-may-need-update nil) + (stored (cdr (assoc scol stored-list))) + (eq (cond + ((and stored equation (string-match "^ *=? *$" equation)) + stored) + ((stringp equation) + equation) + (t (org-table-formula-from-user + (read-string + (org-table-formula-to-user + (format "%s formula %s%s=" + (if named "Field" "Column") + (if (member (string-to-char scol) '(?$ ?@)) "" "$") + scol)) + (if stored (org-table-formula-to-user stored) "") + 'org-table-formula-history + ))))) + mustsave) + (when (not (string-match "\\S-" eq)) + ;; remove formula + (setq stored-list (delq (assoc scol stored-list) stored-list)) + (org-table-store-formulas stored-list) + (user-error "Formula removed")) + (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq))) + (if (string-match " *$" eq) (setq eq (replace-match "" t t eq))) + (if (and name (not named)) + ;; We set the column equation, delete the named one. + (setq stored-list (delq (assoc name stored-list) stored-list) + mustsave t)) + (if stored + (setcdr (assoc scol stored-list) eq) + (setq stored-list (cons (cons scol eq) stored-list))) + (if (or mustsave (not (equal stored eq))) + (org-table-store-formulas stored-list)) + eq)) + +(defun org-table-store-formulas (alist) + "Store the list of formulas below the current table." + (setq alist (sort alist 'org-table-formula-less-p)) + (let ((case-fold-search t)) + (save-excursion + (goto-char (org-table-end)) + (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)") + (progn + ;; don't overwrite TBLFM, we might use text properties to store stuff + (goto-char (match-beginning 3)) + (delete-region (match-beginning 3) (match-end 0))) + (org-indent-line) + (insert (or (match-string 2) "#+TBLFM:"))) + (insert " " + (mapconcat (lambda (x) + (concat + (if (equal (string-to-char (car x)) ?@) "" "$") + (car x) "=" (cdr x))) + alist "::") + "\n")))) + +(defsubst org-table-formula-make-cmp-string (a) + (when (string-match "\\`$[<>]" a) + (let ((arrow (string-to-char (substring a 1)))) + ;; Fake a high number to make sure this is sorted at the end. + (setq a (org-table-formula-handle-first/last-rc a)) + (setq a (format "$%d" (+ 10000 + (if (= arrow ?<) -1000 0) + (string-to-number (substring a 1))))))) + (when (string-match + "^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?" + a) + (concat + (if (match-end 2) + (format "@%05d" (string-to-number (match-string 2 a))) "") + (if (match-end 4) + (format "$%05d" (string-to-number (match-string 4 a))) "") + (if (match-end 5) + (concat "@@" (match-string 5 a)))))) + +(defun org-table-formula-less-p (a b) + "Compare two formulas for sorting." + (let ((as (org-table-formula-make-cmp-string (car a))) + (bs (org-table-formula-make-cmp-string (car b)))) + (and as bs (string< as bs)))) + +;;;###autoload +(defun org-table-get-stored-formulas (&optional noerror) + "Return an alist with the stored formulas directly after current table." + (interactive) ;; FIXME interactive? + (let ((case-fold-search t) scol eq eq-alist strings string seen) + (save-excursion + (goto-char (org-table-end)) + (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+tblfm: *\\(.*\\)") + (setq strings (org-split-string (org-match-string-no-properties 2) + " *:: *")) + (while (setq string (pop strings)) + (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*[^ \t]\\)" string) + (setq scol (if (match-end 2) + (match-string 2 string) + (match-string 1 string)) + scol (if (member (string-to-char scol) '(?< ?>)) + (concat "$" scol) scol) + eq (match-string 3 string) + eq-alist (cons (cons scol eq) eq-alist)) + (if (member scol seen) + (if noerror + (progn + (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol) + (ding) + (sit-for 2)) + (user-error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)) + (push scol seen)))))) + (nreverse eq-alist))) + +(defun org-table-fix-formulas (key replace &optional limit delta remove) + "Modify the equations after the table structure has been edited. +KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace. +For all numbers larger than LIMIT, shift them by DELTA." + (save-excursion + (goto-char (org-table-end)) + (while (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) + (let ((msg "The formulas in #+TBLFM have been updated") + (re (concat key "\\([0-9]+\\)")) + (re2 + (when remove + (if (or (equal key "$") (equal key "$LR")) + (format "\\(@[0-9]+\\)?%s%d=.*?\\(::\\|$\\)" + (regexp-quote key) remove) + (format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove)))) + s n a) + (when remove + (while (re-search-forward re2 (point-at-eol) t) + (unless (save-match-data (org-in-regexp "remote([^)]+?)")) + (if (equal (char-before (match-beginning 0)) ?.) + (user-error + "Change makes TBLFM term %s invalid, use undo to recover" + (match-string 0)) + (replace-match ""))))) + (while (re-search-forward re (point-at-eol) t) + (unless (save-match-data (org-in-regexp "remote([^)]+?)")) + (setq s (match-string 1) n (string-to-number s)) + (cond + ((setq a (assoc s replace)) + (replace-match (concat key (cdr a)) t t) + (message msg)) + ((and limit (> n limit)) + (replace-match (concat key (int-to-string (+ n delta))) t t) + (message msg)))))) + (forward-line)))) + +(defun org-table-get-specials () + "Get the column names and local parameters for this table." + (save-excursion + (let ((beg (org-table-begin)) (end (org-table-end)) + names name fields fields1 field cnt + c v l line col types dlines hlines last-dline) + (setq org-table-column-names nil + org-table-local-parameters nil + org-table-named-field-locations nil + org-table-current-begin-line nil + org-table-current-begin-pos nil + org-table-current-line-types nil + org-table-current-ncol 0) + (goto-char beg) + (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t) + (setq names (org-split-string (match-string 1) " *| *") + cnt 1) + (while (setq name (pop names)) + (setq cnt (1+ cnt)) + (if (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" name) + (push (cons name (int-to-string cnt)) org-table-column-names)))) + (setq org-table-column-names (nreverse org-table-column-names)) + (setq org-table-column-name-regexp + (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>")) + (goto-char beg) + (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t) + (setq fields (org-split-string (match-string 1) " *| *")) + (while (setq field (pop fields)) + (if (string-match "^\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field) + (push (cons (match-string 1 field) (match-string 2 field)) + org-table-local-parameters)))) + (goto-char beg) + (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t) + (setq c (match-string 1) + fields (org-split-string (match-string 2) " *| *")) + (save-excursion + (beginning-of-line (if (equal c "_") 2 0)) + (setq line (org-current-line) col 1) + (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)") + (setq fields1 (org-split-string (match-string 1) " *| *")))) + (while (and fields1 (setq field (pop fields))) + (setq v (pop fields1) col (1+ col)) + (when (and (stringp field) (stringp v) + (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" field)) + (push (cons field v) org-table-local-parameters) + (push (list field line col) org-table-named-field-locations)))) + ;; Analyse the line types + (goto-char beg) + (setq org-table-current-begin-line (org-current-line) + org-table-current-begin-pos (point) + l org-table-current-begin-line) + (while (looking-at "[ \t]*|\\(-\\)?") + (push (if (match-end 1) 'hline 'dline) types) + (if (match-end 1) (push l hlines) (push l dlines)) + (beginning-of-line 2) + (setq l (1+ l))) + (push 'hline types) ;; add an imaginary extra hline to the end + (setq org-table-current-line-types (apply 'vector (nreverse types)) + last-dline (car dlines) + org-table-dlines (apply 'vector (cons nil (nreverse dlines))) + org-table-hlines (apply 'vector (cons nil (nreverse hlines)))) + (org-goto-line last-dline) + (let* ((l last-dline) + (fields (org-split-string + (buffer-substring (point-at-bol) (point-at-eol)) + "[ \t]*|[ \t]*")) + (nfields (length fields)) + al al2) + (setq org-table-current-ncol nfields) + (loop for i from 1 to nfields do + (push (list (format "LR%d" i) l i) al) + (push (cons (format "LR%d" i) (nth (1- i) fields)) al2)) + (setq org-table-named-field-locations + (append org-table-named-field-locations al)) + (setq org-table-local-parameters + (append org-table-local-parameters al2)))))) + +;;;###autoload +(defun org-table-maybe-eval-formula () + "Check if the current field starts with \"=\" or \":=\". +If yes, store the formula and apply it." + ;; We already know we are in a table. Get field will only return a formula + ;; when appropriate. It might return a separator line, but no problem. + (when org-table-formula-evaluate-inline + (let* ((field (org-trim (or (org-table-get-field) ""))) + named eq) + (when (string-match "^:?=\\(.*[^=]\\)$" field) + (setq named (equal (string-to-char field) ?:) + eq (match-string 1 field)) + (if (or (fboundp 'calc-eval) + (equal (substring eq 0 (min 2 (length eq))) "'(")) + (org-table-eval-formula (if named '(4) nil) + (org-table-formula-from-user eq)) + (user-error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) + +(defvar org-recalc-commands nil + "List of commands triggering the recalculation of a line. +Will be filled automatically during use.") + +(defvar org-recalc-marks + '((" " . "Unmarked: no special line, no automatic recalculation") + ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line") + ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'") + ("!" . "Column name definition line. Reference in formula as $name.") + ("$" . "Parameter definition line name=value. Reference in formula as $name.") + ("_" . "Names for values in row below this one.") + ("^" . "Names for values in row above this one."))) + +;;;###autoload +(defun org-table-rotate-recalc-marks (&optional newchar) + "Rotate the recalculation mark in the first column. +If in any row, the first field is not consistent with a mark, +insert a new column for the markers. +When there is an active region, change all the lines in the region, +after prompting for the marking character. +After each change, a message will be displayed indicating the meaning +of the new mark." + (interactive) + (unless (org-at-table-p) (user-error "Not at a table")) + (let* ((marks (append (mapcar 'car org-recalc-marks) '(" "))) + (beg (org-table-begin)) + (end (org-table-end)) + (l (org-current-line)) + (l1 (if (org-region-active-p) (org-current-line (region-beginning)))) + (l2 (if (org-region-active-p) (org-current-line (region-end)))) + (have-col + (save-excursion + (goto-char beg) + (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" end t)))) + (col (org-table-current-column)) + (forcenew (car (assoc newchar org-recalc-marks))) + epos new) + (when l1 + (message "Change region to what mark? Type # * ! $ or SPC: ") + (setq newchar (char-to-string (read-char-exclusive)) + forcenew (car (assoc newchar org-recalc-marks)))) + (if (and newchar (not forcenew)) + (user-error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" + newchar)) + (if l1 (org-goto-line l1)) + (save-excursion + (beginning-of-line 1) + (unless (looking-at org-table-dataline-regexp) + (user-error "Not at a table data line"))) + (unless have-col + (org-table-goto-column 1) + (org-table-insert-column) + (org-table-goto-column (1+ col))) + (setq epos (point-at-eol)) + (save-excursion + (beginning-of-line 1) + (org-table-get-field + 1 (if (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|") + (concat " " + (setq new (or forcenew + (cadr (member (match-string 1) marks)))) + " ") + " # "))) + (if (and l1 l2) + (progn + (org-goto-line l1) + (while (progn (beginning-of-line 2) (not (= (org-current-line) l2))) + (and (looking-at org-table-dataline-regexp) + (org-table-get-field 1 (concat " " new " ")))) + (org-goto-line l1))) + (if (not (= epos (point-at-eol))) (org-table-align)) + (org-goto-line l) + (and (org-called-interactively-p 'interactive) + (message "%s" (cdr (assoc new org-recalc-marks)))))) + +;;;###autoload +(defun org-table-maybe-recalculate-line () + "Recompute the current line if marked for it, and if we haven't just done it." + (interactive) + (and org-table-allow-automatic-line-recalculation + (not (and (memq last-command org-recalc-commands) + (equal org-last-recalc-line (org-current-line)))) + (save-excursion (beginning-of-line 1) + (looking-at org-table-auto-recalculate-regexp)) + (org-table-recalculate) t)) + +(defvar org-tbl-calc-modes) ;; Dynamically bound in `org-table-eval-formula' +(defsubst org-set-calc-mode (var &optional value) + (if (stringp var) + (setq var (assoc var '(("D" calc-angle-mode deg) + ("R" calc-angle-mode rad) + ("F" calc-prefer-frac t) + ("S" calc-symbolic-mode t))) + value (nth 2 var) var (nth 1 var))) + (if (memq var org-tbl-calc-modes) + (setcar (cdr (memq var org-tbl-calc-modes)) value) + (cons var (cons value org-tbl-calc-modes))) + org-tbl-calc-modes) + +;;;###autoload +(defun org-table-eval-formula (&optional arg equation + suppress-align suppress-const + suppress-store suppress-analysis) + "Replace the table field value at the cursor by the result of a calculation. + +This function makes use of Dave Gillespie's Calc package, in my view the +most exciting program ever written for GNU Emacs. So you need to have Calc +installed in order to use this function. + +In a table, this command replaces the value in the current field with the +result of a formula. It also installs the formula as the \"current\" column +formula, by storing it in a special line below the table. When called +with a `C-u' prefix, the current field must be a named field, and the +formula is installed as valid in only this specific field. + +When called with two `C-u' prefixes, insert the active equation +for the field back into the current field, so that it can be +edited there. This is useful in order to use \\[org-table-show-reference] +to check the referenced fields. + +When called, the command first prompts for a formula, which is read in +the minibuffer. Previously entered formulas are available through the +history list, and the last used formula is offered as a default. +These stored formulas are adapted correctly when moving, inserting, or +deleting columns with the corresponding commands. + +The formula can be any algebraic expression understood by the Calc package. +For details, see the Org-mode manual. + +This function can also be called from Lisp programs and offers +additional arguments: EQUATION can be the formula to apply. If this +argument is given, the user will not be prompted. SUPPRESS-ALIGN is +used to speed-up recursive calls by by-passing unnecessary aligns. +SUPPRESS-CONST suppresses the interpretation of constants in the +formula, assuming that this has been done already outside the function. +SUPPRESS-STORE means the formula should not be stored, either because +it is already stored, or because it is a modified equation that should +not overwrite the stored one." + (interactive "P") + (org-table-check-inside-data-field) + (or suppress-analysis (org-table-get-specials)) + (if (equal arg '(16)) + (let ((eq (org-table-current-field-formula))) + (or eq (user-error "No equation active for current field")) + (org-table-get-field nil eq) + (org-table-align) + (setq org-table-may-need-update t)) + (let* (fields + (ndown (if (integerp arg) arg 1)) + (org-table-automatic-realign nil) + (case-fold-search nil) + (down (> ndown 1)) + (formula (if (and equation suppress-store) + equation + (org-table-get-formula equation (equal arg '(4))))) + (n0 (org-table-current-column)) + (org-tbl-calc-modes (copy-sequence org-calc-default-modes)) + (numbers nil) ; was a variable, now fixed default + (keep-empty nil) + n form form0 formrpl formrg bw fmt x ev orig c lispp literal + duration duration-output-format) + ;; Parse the format string. Since we have a lot of modes, this is + ;; a lot of work. However, I think calc still uses most of the time. + (if (string-match ";" formula) + (let ((tmp (org-split-string formula ";"))) + (setq formula (car tmp) + fmt (concat (cdr (assoc "%" org-table-local-parameters)) + (nth 1 tmp))) + (while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt) + (setq c (string-to-char (match-string 1 fmt)) + n (string-to-number (match-string 2 fmt))) + (if (= c ?p) + (setq org-tbl-calc-modes (org-set-calc-mode 'calc-internal-prec n)) + (setq org-tbl-calc-modes + (org-set-calc-mode + 'calc-float-format + (list (cdr (assoc c '((?n . float) (?f . fix) + (?s . sci) (?e . eng)))) + n)))) + (setq fmt (replace-match "" t t fmt))) + (if (string-match "T" fmt) + (setq duration t numbers t + duration-output-format nil + fmt (replace-match "" t t fmt))) + (if (string-match "t" fmt) + (setq duration t + duration-output-format org-table-duration-custom-format + numbers t + fmt (replace-match "" t t fmt))) + (if (string-match "N" fmt) + (setq numbers t + fmt (replace-match "" t t fmt))) + (if (string-match "L" fmt) + (setq literal t + fmt (replace-match "" t t fmt))) + (if (string-match "E" fmt) + (setq keep-empty t + fmt (replace-match "" t t fmt))) + (while (string-match "[DRFS]" fmt) + (setq org-tbl-calc-modes (org-set-calc-mode (match-string 0 fmt))) + (setq fmt (replace-match "" t t fmt))) + (unless (string-match "\\S-" fmt) + (setq fmt nil)))) + (if (and (not suppress-const) org-table-formula-use-constants) + (setq formula (org-table-formula-substitute-names formula))) + (setq orig (or (get-text-property 1 :orig-formula formula) "?")) + (while (> ndown 0) + (setq fields (org-split-string + (buffer-substring-no-properties (point-at-bol) (point-at-eol)) + " *| *")) + ;; replace fields with duration values if relevant + (if duration + (setq fields + (mapcar (lambda (x) (org-table-time-string-to-seconds x)) + fields))) + (if (eq numbers t) + (setq fields (mapcar + (lambda (x) + (if (string-match "\\S-" x) + (number-to-string (string-to-number x)) + x)) + fields))) + (setq ndown (1- ndown)) + (setq form (copy-sequence formula) + lispp (and (> (length form) 2) (equal (substring form 0 2) "'("))) + (if (and lispp literal) (setq lispp 'literal)) + + ;; Insert row and column number of formula result field + (while (string-match "[@$]#" form) + (setq form + (replace-match + (format "%d" + (save-match-data + (if (equal (substring form (match-beginning 0) + (1+ (match-beginning 0))) + "@") + (org-table-current-dline) + (org-table-current-column)))) + t t form))) + + ;; Check for old vertical references + (setq form (org-table-rewrite-old-row-references form)) + ;; Insert remote references + (while (string-match "\\<remote([ \t]*\\([-_a-zA-Z0-9]+\\)[ \t]*,[ \t]*\\([^\n)]+\\))" form) + (setq form + (replace-match + (save-match-data + (org-table-make-reference + (let ((rmtrng (org-table-get-remote-range + (match-string 1 form) (match-string 2 form)))) + (if duration + (if (listp rmtrng) + (mapcar (lambda(x) (org-table-time-string-to-seconds x)) rmtrng) + (org-table-time-string-to-seconds rmtrng)) + rmtrng)) + keep-empty numbers lispp)) + t t form))) + ;; Insert complex ranges + (while (and (string-match org-table-range-regexp form) + (> (length (match-string 0 form)) 1)) + (setq formrg (save-match-data + (org-table-get-range (match-string 0 form) nil n0))) + (setq formrpl + (save-match-data + (org-table-make-reference + ;; possibly handle durations + (if duration + (if (listp formrg) + (mapcar (lambda(x) (org-table-time-string-to-seconds x)) formrg) + (org-table-time-string-to-seconds formrg)) + formrg) + keep-empty numbers lispp))) + (if (not (save-match-data + (string-match (regexp-quote form) formrpl))) + (setq form (replace-match formrpl t t form)) + (user-error "Spreadsheet error: invalid reference \"%s\"" form))) + ;; Insert simple ranges + (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form) + (setq form + (replace-match + (save-match-data + (org-table-make-reference + (org-sublist + fields (string-to-number (match-string 1 form)) + (string-to-number (match-string 2 form))) + keep-empty numbers lispp)) + t t form))) + (setq form0 form) + ;; Insert the references to fields in same row + (while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form) + (setq n (+ (string-to-number (match-string 1 form)) + (if (match-end 2) n0 0)) + x (nth (1- (if (= n 0) n0 (max n 1))) fields)) + (unless x (user-error "Invalid field specifier \"%s\"" + (match-string 0 form))) + (setq form (replace-match + (save-match-data + (org-table-make-reference + x keep-empty numbers lispp)) + t t form))) + + (if lispp + (setq ev (condition-case nil + (eval (eval (read form))) + (error "#ERROR")) + ev (if (numberp ev) (number-to-string ev) ev) + ev (if duration (org-table-time-seconds-to-string + (string-to-number ev) + duration-output-format) ev)) + (or (fboundp 'calc-eval) + (user-error "Calc does not seem to be installed, and is needed to evaluate the formula")) + ;; Use <...> time-stamps so that Calc can handle them + (while (string-match (concat "\\[" org-ts-regexp1 "\\]") form) + (setq form (replace-match "<\\1>" nil nil form))) + ;; I18n-ize local time-stamps by setting (system-time-locale "C") + (when (string-match org-ts-regexp2 form) + (let* ((ts (match-string 0 form)) + (tsp (apply 'encode-time (save-match-data (org-parse-time-string ts)))) + (system-time-locale "C") + (tf (or (and (save-match-data (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)) + (cdr org-time-stamp-formats)) + (car org-time-stamp-formats)))) + (setq form (replace-match (format-time-string tf tsp) t t form)))) + + (setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form)) + form + (calc-eval (cons form org-tbl-calc-modes) + (when (and (not keep-empty) numbers) 'num))) + ev (if duration (org-table-time-seconds-to-string + (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev) + (string-to-number (org-table-time-string-to-seconds ev)) + (string-to-number ev)) + duration-output-format) + ev))) + + (when org-table-formula-debug + (with-output-to-temp-buffer "*Substitution History*" + (princ (format "Substitution history of formula +Orig: %s +$xyz-> %s +@r$c-> %s +$1-> %s\n" orig formula form0 form)) + (if (listp ev) + (princ (format " %s^\nError: %s" + (make-string (car ev) ?\-) (nth 1 ev))) + (princ (format "Result: %s\nFormat: %s\nFinal: %s" + ev (or fmt "NONE") + (if fmt (format fmt (string-to-number ev)) ev))))) + (setq bw (get-buffer-window "*Substitution History*")) + (org-fit-window-to-buffer bw) + (unless (and (org-called-interactively-p 'any) (not ndown)) + (unless (let (inhibit-redisplay) + (y-or-n-p "Debugging Formula. Continue to next? ")) + (org-table-align) + (user-error "Abort")) + (delete-window bw) + (message ""))) + (if (listp ev) (setq fmt nil ev "#ERROR")) + (org-table-justify-field-maybe + (format org-table-formula-field-format + (if fmt (format fmt (string-to-number ev)) ev))) + (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) + (call-interactively 'org-return) + (setq ndown 0))) + (and down (org-table-maybe-recalculate-line)) + (or suppress-align (and org-table-may-need-update + (org-table-align)))))) + +(defun org-table-put-field-property (prop value) + (save-excursion + (put-text-property (progn (skip-chars-backward "^|") (point)) + (progn (skip-chars-forward "^|") (point)) + prop value))) + +(defun org-table-get-range (desc &optional tbeg col highlight corners-only) + "Get a calc vector from a column, according to descriptor DESC. +Optional arguments TBEG and COL can give the beginning of the table and +the current column, to avoid unnecessary parsing. + +HIGHLIGHT means just highlight the range. + +When CORNERS-ONLY is set, only return the corners of the range as +a list (line1 column1 line2 column2) where line1 and line2 are line numbers +in the buffer and column1 and column2 are table column numbers." + (if (not (equal (string-to-char desc) ?@)) + (setq desc (concat "@" desc))) + (save-excursion + (or tbeg (setq tbeg (org-table-begin))) + (or col (setq col (org-table-current-column))) + (let ((thisline (org-current-line)) + beg end c1 c2 r1 r2 rangep tmp) + (unless (string-match org-table-range-regexp desc) + (user-error "Invalid table range specifier `%s'" desc)) + (setq rangep (match-end 3) + r1 (and (match-end 1) (match-string 1 desc)) + r2 (and (match-end 4) (match-string 4 desc)) + c1 (and (match-end 2) (substring (match-string 2 desc) 1)) + c2 (and (match-end 5) (substring (match-string 5 desc) 1))) + + (and c1 (setq c1 (+ (string-to-number c1) + (if (memq (string-to-char c1) '(?- ?+)) col 0)))) + (and c2 (setq c2 (+ (string-to-number c2) + (if (memq (string-to-char c2) '(?- ?+)) col 0)))) + (if (equal r1 "") (setq r1 nil)) + (if (equal r2 "") (setq r2 nil)) + (if r1 (setq r1 (org-table-get-descriptor-line r1))) + (if r2 (setq r2 (org-table-get-descriptor-line r2))) + ; (setq r2 (or r2 r1) c2 (or c2 c1)) + (if (not r1) (setq r1 thisline)) + (if (not r2) (setq r2 thisline)) + (if (or (not c1) (= 0 c1)) (setq c1 col)) + (if (or (not c2) (= 0 c2)) (setq c2 col)) + (if (and (not corners-only) + (or (not rangep) (and (= r1 r2) (= c1 c2)))) + ;; just one field + (progn + (org-goto-line r1) + (while (not (looking-at org-table-dataline-regexp)) + (beginning-of-line 2)) + (prog1 (org-trim (org-table-get-field c1)) + (if highlight (org-table-highlight-rectangle (point) (point))))) + ;; A range, return a vector + ;; First sort the numbers to get a regular rectangle + (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp)) + (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp)) + (if corners-only + ;; Only return the corners of the range + (list r1 c1 r2 c2) + ;; Copy the range values into a list + (org-goto-line r1) + (while (not (looking-at org-table-dataline-regexp)) + (beginning-of-line 2)) + (org-table-goto-column c1) + (setq beg (point)) + (org-goto-line r2) + (while (not (looking-at org-table-dataline-regexp)) + (beginning-of-line 0)) + (org-table-goto-column c2) + (setq end (point)) + (if highlight + (org-table-highlight-rectangle + beg (progn (skip-chars-forward "^|\n") (point)))) + ;; return string representation of calc vector + (mapcar 'org-trim + (apply 'append (org-table-copy-region beg end)))))))) + +(defun org-table-get-descriptor-line (desc &optional cline bline table) + "Analyze descriptor DESC and retrieve the corresponding line number. +The cursor is currently in line CLINE, the table begins in line BLINE, +and TABLE is a vector with line types." + (if (string-match "^[0-9]+$" desc) + (aref org-table-dlines (string-to-number desc)) + (setq cline (or cline (org-current-line)) + bline (or bline org-table-current-begin-line) + table (or table org-table-current-line-types)) + (if (or + (not (string-match "^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?" desc)) + ;; 1 2 3 4 5 6 + (and (not (match-end 3)) (not (match-end 6))) + (and (match-end 3) (match-end 6) (not (match-end 5)))) + (user-error "Invalid row descriptor `%s'" desc)) + (let* ((hdir (and (match-end 2) (match-string 2 desc))) + (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil)) + (odir (and (match-end 5) (match-string 5 desc))) + (on (if (match-end 6) (string-to-number (match-string 6 desc)))) + (i (- cline bline)) + (rel (and (match-end 6) + (or (and (match-end 1) (not (match-end 3))) + (match-end 5))))) + (if (and hn (not hdir)) + (progn + (setq i 0 hdir "+") + (if (eq (aref table 0) 'hline) (setq hn (1- hn))))) + (if (and (not hn) on (not odir)) + (user-error "Should never happen");;(aref org-table-dlines on) + (if (and hn (> hn 0)) + (setq i (org-table-find-row-type table i 'hline (equal hdir "-") + nil hn cline desc))) + (if on + (setq i (org-table-find-row-type table i 'dline (equal odir "-") + rel on cline desc))) + (+ bline i))))) + +(defun org-table-find-row-type (table i type backwards relative n cline desc) + "FIXME: Needs more documentation." + (let ((l (length table))) + (while (> n 0) + (while (and (setq i (+ i (if backwards -1 1))) + (>= i 0) (< i l) + (not (eq (aref table i) type)) + (if (and relative (eq (aref table i) 'hline)) + (cond + ((eq org-table-relative-ref-may-cross-hline t) t) + ((eq org-table-relative-ref-may-cross-hline 'error) + (user-error "Row descriptor %s used in line %d crosses hline" desc cline)) + (t (setq i (- i (if backwards -1 1)) + n 1) + nil)) + t))) + (setq n (1- n))) + (if (or (< i 0) (>= i l)) + (user-error "Row descriptor %s used in line %d leads outside table" + desc cline) + i))) + +(defun org-table-rewrite-old-row-references (s) + (if (string-match "&[-+0-9I]" s) + (user-error "Formula contains old &row reference, please rewrite using @-syntax") + s)) + +(defun org-table-make-reference (elements keep-empty numbers lispp) + "Convert list ELEMENTS to something appropriate to insert into formula. +KEEP-EMPTY indicated to keep empty fields, default is to skip them. +NUMBERS indicates that everything should be converted to numbers. +LISPP non-nil means to return something appropriate for a Lisp +list, 'literal is for the format specifier L." + ;; Calc nan (not a number) is used for the conversion of the empty + ;; field to a reference for several reasons: (i) It is accepted in a + ;; Calc formula (e. g. "" or "()" would result in a Calc error). + ;; (ii) In a single field (not in range) it can be distinguished + ;; from "(nan)" which is the reference made from a single field + ;; containing "nan". + (if (stringp elements) + ;; field reference + (if lispp + (if (eq lispp 'literal) + elements + (if (and (eq elements "") (not keep-empty)) + "" + (prin1-to-string + (if numbers (string-to-number elements) elements)))) + (if (string-match "\\S-" elements) + (progn + (when numbers (setq elements (number-to-string + (string-to-number elements)))) + (concat "(" elements ")")) + (if (or (not keep-empty) numbers) "(0)" "nan"))) + ;; range reference + (unless keep-empty + (setq elements + (delq nil + (mapcar (lambda (x) (if (string-match "\\S-" x) x nil)) + elements)))) + (setq elements (or elements '())) ; if delq returns nil then we need '() + (if lispp + (mapconcat + (lambda (x) + (if (eq lispp 'literal) + x + (prin1-to-string (if numbers (string-to-number x) x)))) + elements " ") + (concat "[" (mapconcat + (lambda (x) + (if (string-match "\\S-" x) + (if numbers + (number-to-string (string-to-number x)) + x) + (if (or (not keep-empty) numbers) "0" "nan"))) + elements + ",") "]")))) + +;;;###autoload +(defun org-table-set-constants () + "Set `org-table-formula-constants-local' in the current buffer." + (let (cst consts const-str) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t) + (setq const-str (substring-no-properties (match-string 1))) + (setq consts (append consts (org-split-string const-str "[ \t]+"))) + (when consts + (let (e) + (while (setq e (pop consts)) + (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) + (if (assoc-string (match-string 1 e) cst) + (setq cst (delete (assoc-string (match-string 1 e) cst) cst))) + (push (cons (match-string 1 e) (match-string 2 e)) cst))) + (setq org-table-formula-constants-local cst))))))) + +;;;###autoload +(defun org-table-recalculate (&optional all noalign) + "Recalculate the current table line by applying all stored formulas. +With prefix arg ALL, do this for all lines in the table. +With the prefix argument ALL is `(16)' \ +\(a double \\[universal-prefix] \\[universal-prefix] prefix), or if +it is the symbol `iterate', recompute the table until it no longer changes. +If NOALIGN is not nil, do not re-align the table after the computations +are done. This is typically used internally to save time, if it is +known that the table will be realigned a little later anyway." + (interactive "P") + (or (memq this-command org-recalc-commands) + (setq org-recalc-commands (cons this-command org-recalc-commands))) + (unless (org-at-table-p) (user-error "Not at a table")) + (if (or (eq all 'iterate) (equal all '(16))) + (org-table-iterate) + (org-table-get-specials) + (let* ((eqlist (sort (org-table-get-stored-formulas) + (lambda (a b) (string< (car a) (car b))))) + (eqlist1 (copy-sequence eqlist)) + (inhibit-redisplay (not debug-on-error)) + (line-re org-table-dataline-regexp) + (thisline (org-current-line)) + (thiscol (org-table-current-column)) + seen-fields lhs1 + beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1) + ;; Insert constants in all formulas + (setq eqlist + (mapcar (lambda (x) + (when (string-match "\\`$[<>]" (car x)) + (setq lhs1 (car x)) + (setq x (cons (substring + (org-table-formula-handle-first/last-rc + (car x)) 1) + (cdr x))) + (if (assoc (car x) eqlist1) + (user-error "\"%s=\" formula tries to overwrite existing formula for column %s" + lhs1 (car x)))) + (cons + (org-table-formula-handle-first/last-rc (car x)) + (org-table-formula-substitute-names + (org-table-formula-handle-first/last-rc (cdr x))))) + eqlist)) + ;; Split the equation list + (while (setq eq (pop eqlist)) + (if (<= (string-to-char (car eq)) ?9) + (push eq eqlnum) + (push eq eqlname))) + (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname)) + ;; Expand ranges in lhs of formulas + (setq eqlname (org-table-expand-lhs-ranges eqlname)) + + ;; Get the correct line range to process + (if all + (progn + (setq end (move-marker (make-marker) (1+ (org-table-end)))) + (goto-char (setq beg (org-table-begin))) + (if (re-search-forward org-table-calculate-mark-regexp end t) + ;; This is a table with marked lines, compute selected lines + (setq line-re org-table-recalculate-regexp) + ;; Move forward to the first non-header line + (if (and (re-search-forward org-table-dataline-regexp end t) + (re-search-forward org-table-hline-regexp end t) + (re-search-forward org-table-dataline-regexp end t)) + (setq beg (match-beginning 0)) + nil))) ;; just leave beg where it is + (setq beg (point-at-bol) + end (move-marker (make-marker) (1+ (point-at-eol))))) + (goto-char beg) + (and all (message "Re-applying formulas to full table...")) + + ;; First find the named fields, and mark them untouchable. + ;; Also check if several field/range formulas try to set the same field. + (remove-text-properties beg end '(org-untouchable t)) + (while (setq eq (pop eqlname)) + (setq name (car eq) + a (assoc name org-table-named-field-locations)) + (setq name1 name) + (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a)) + (nth 2 a)))) + (when (member name1 seen-fields) + (user-error "Several field/range formulas try to set %s" name1)) + (push name1 seen-fields) + + (and (not a) + (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name) + (setq a (list name + (condition-case nil + (aref org-table-dlines + (string-to-number (match-string 1 name))) + (error (user-error "Invalid row number in %s" + name))) + (string-to-number (match-string 2 name))))) + (when (and a (or all (equal (nth 1 a) thisline))) + (message "Re-applying formula to field: %s" name) + (org-goto-line (nth 1 a)) + (org-table-goto-column (nth 2 a)) + (push (append a (list (cdr eq))) eqlname1) + (org-table-put-field-property :org-untouchable t))) + (setq eqlname1 (nreverse eqlname1)) + + ;; Now evaluate the column formulas, but skip fields covered by + ;; field formulas + (goto-char beg) + (while (re-search-forward line-re end t) + (unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1)) + ;; Unprotected line, recalculate + (and all (message "Re-applying formulas to full table...(line %d)" + (setq cnt (1+ cnt)))) + (setq org-last-recalc-line (org-current-line)) + (setq eql eqlnum) + (while (setq entry (pop eql)) + (org-goto-line org-last-recalc-line) + (org-table-goto-column (string-to-number (car entry)) nil 'force) + (unless (get-text-property (point) :org-untouchable) + (org-table-eval-formula nil (cdr entry) + 'noalign 'nocst 'nostore 'noanalysis))))) + + ;; Now evaluate the field formulas + (while (setq eq (pop eqlname1)) + (message "Re-applying formula to field: %s" (car eq)) + (org-goto-line (nth 1 eq)) + (org-table-goto-column (nth 2 eq)) + (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst + 'nostore 'noanalysis)) + + (org-goto-line thisline) + (org-table-goto-column thiscol) + (remove-text-properties (point-min) (point-max) '(org-untouchable t)) + (or noalign (and org-table-may-need-update (org-table-align)) + (and all (message "Re-applying formulas to %d lines...done" cnt))) + + ;; back to initial position + (message "Re-applying formulas...done") + (org-goto-line thisline) + (org-table-goto-column thiscol) + (or noalign (and org-table-may-need-update (org-table-align)) + (and all (message "Re-applying formulas...done")))))) + +;;;###autoload +(defun org-table-iterate (&optional arg) + "Recalculate the table until it does not change anymore. +The maximum number of iterations is 10, but you can choose a different value +with the prefix ARG." + (interactive "P") + (let ((imax (if arg (prefix-numeric-value arg) 10)) + (i 0) + (lasttbl (buffer-substring (org-table-begin) (org-table-end))) + thistbl) + (catch 'exit + (while (< i imax) + (setq i (1+ i)) + (org-table-recalculate 'all) + (setq thistbl (buffer-substring (org-table-begin) (org-table-end))) + (if (not (string= lasttbl thistbl)) + (setq lasttbl thistbl) + (if (> i 1) + (message "Convergence after %d iterations" i) + (message "Table was already stable")) + (throw 'exit t))) + (user-error "No convergence after %d iterations" i)))) + +;;;###autoload +(defun org-table-recalculate-buffer-tables () + "Recalculate all tables in the current buffer." + (interactive) + (save-excursion + (save-restriction + (widen) + (org-table-map-tables (lambda () (org-table-recalculate t)) t)))) + +;;;###autoload +(defun org-table-iterate-buffer-tables () + "Iterate all tables in the buffer, to converge inter-table dependencies." + (interactive) + (let* ((imax 10) + (i imax) + (checksum (md5 (buffer-string))) + c1) + (save-excursion + (save-restriction + (widen) + (catch 'exit + (while (> i 0) + (setq i (1- i)) + (org-table-map-tables (lambda () (org-table-recalculate t)) t) + (if (equal checksum (setq c1 (md5 (buffer-string)))) + (progn + (message "Convergence after %d iterations" (- imax i)) + (throw 'exit t)) + (setq checksum c1))) + (user-error "No convergence after %d iterations" imax)))))) + +(defun org-table-calc-current-TBLFM (&optional arg) + "Apply the #+TBLFM in the line at point to the table." + (interactive "P") + (unless (org-at-TBLFM-p) (user-error "Not at a #+TBLFM line")) + (let ((formula (buffer-substring + (point-at-bol) + (point-at-eol))) + s e) + (save-excursion + ;; Insert a temporary formula at right after the table + (goto-char (org-table-TBLFM-begin)) + (setq s (set-marker (make-marker) (point))) + (insert (concat formula "\n")) + (setq e (set-marker (make-marker) (point))) + ;; Recalculate the table + (beginning-of-line 0) ; move to the inserted line + (skip-chars-backward " \r\n\t") + (if (org-at-table-p) + (unwind-protect + (org-call-with-arg 'org-table-recalculate (or arg t)) + ;; delete the formula inserted temporarily + (delete-region s e)))))) + +(defun org-table-TBLFM-begin () + "Find the beginning of the TBLFM lines and return its position. +Return nil when the beginning of TBLFM line was not found." + (save-excursion + (when (progn (forward-line 1) + (re-search-backward + org-table-TBLFM-begin-regexp + nil t)) + (point-at-bol 2)))) + +(defun org-table-expand-lhs-ranges (equations) + "Expand list of formulas. +If some of the RHS in the formulas are ranges or a row reference, expand +them to individual field equations for each field." + (let (e res lhs rhs range r1 r2 c1 c2) + (while (setq e (pop equations)) + (setq lhs (car e) rhs (cdr e)) + (cond + ((string-match "^@-?[-+0-9]+\\$-?[0-9]+$" lhs) + ;; This just refers to one fixed field + (push e res)) + ((string-match "^[a-zA-Z][_a-zA-Z0-9]*$" lhs) + ;; This just refers to one fixed named field + (push e res)) + ((string-match "^@[0-9]+$" lhs) + (loop for ic from 1 to org-table-current-ncol do + (push (cons (format "%s$%d" lhs ic) rhs) res) + (put-text-property 0 (length (caar res)) + :orig-eqn e (caar res)))) + (t + (setq range (org-table-get-range lhs org-table-current-begin-pos + 1 nil 'corners)) + (setq r1 (nth 0 range) c1 (nth 1 range) + r2 (nth 2 range) c2 (nth 3 range)) + (setq r1 (org-table-line-to-dline r1)) + (setq r2 (org-table-line-to-dline r2 'above)) + (loop for ir from r1 to r2 do + (loop for ic from c1 to c2 do + (push (cons (format "@%d$%d" ir ic) rhs) res) + (put-text-property 0 (length (caar res)) + :orig-eqn e (caar res))))))) + (nreverse res))) + +(defun org-table-formula-handle-first/last-rc (s) + "Replace @<, @>, $<, $> with first/last row/column of the table. +So @< and $< will always be replaced with @1 and $1, respectively. +The advantage of these special markers are that structure editing of +the table will not change them, while @1 and $1 will be modified +when a line/row is swapped out of that privileged position. So for +formulas that use a range of rows or columns, it may often be better +to anchor the formula with \"I\" row markers, or to offset from the +borders of the table using the @< @> $< $> makers." + (let (n nmax len char (start 0)) + (while (string-match "\\([@$]\\)\\(<+\\|>+\\)\\|\\(remote([^\)]+)\\)" + s start) + (if (match-end 3) + (setq start (match-end 3)) + (setq nmax (if (equal (match-string 1 s) "@") + (1- (length org-table-dlines)) + org-table-current-ncol) + len (- (match-end 2) (match-beginning 2)) + char (string-to-char (match-string 2 s)) + n (if (= char ?<) + len + (- nmax len -1))) + (if (or (< n 1) (> n nmax)) + (user-error "Reference \"%s\" in expression \"%s\" points outside table" + (match-string 0 s) s)) + (setq start (match-beginning 0)) + (setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s))))) + s) + +(defun org-table-formula-substitute-names (f) + "Replace $const with values in string F." + (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?'))) + ;; First, check for column names + (while (setq start (string-match org-table-column-name-regexp f start)) + (setq start (1+ start)) + (setq a (assoc (match-string 1 f) org-table-column-names)) + (setq f (replace-match (concat "$" (cdr a)) t t f))) + ;; Parameters and constants + (setq start 0) + (while (setq start (string-match "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\<remote([^)]*)\\)" f start)) + (if (match-end 2) + (setq start (match-end 2)) + (setq start (1+ start)) + (if (setq a (save-match-data + (org-table-get-constant (match-string 1 f)))) + (setq f (replace-match + (concat (if pp "(") a (if pp ")")) t t f))))) + (if org-table-formula-debug + (put-text-property 0 (length f) :orig-formula f1 f)) + f)) + +(defun org-table-get-constant (const) + "Find the value for a parameter or constant in a formula. +Parameters get priority." + (or (cdr (assoc const org-table-local-parameters)) + (cdr (assoc const org-table-formula-constants-local)) + (cdr (assoc const org-table-formula-constants)) + (and (fboundp 'constants-get) (constants-get const)) + (and (string= (substring const 0 (min 5 (length const))) "PROP_") + (org-entry-get nil (substring const 5) 'inherit)) + "#UNDEFINED_NAME")) + +(defvar org-table-fedit-map + (let ((map (make-sparse-keymap))) + (org-defkey map "\C-x\C-s" 'org-table-fedit-finish) + (org-defkey map "\C-c\C-s" 'org-table-fedit-finish) + (org-defkey map "\C-c\C-c" 'org-table-fedit-finish) + (org-defkey map "\C-c'" 'org-table-fedit-finish) + (org-defkey map "\C-c\C-q" 'org-table-fedit-abort) + (org-defkey map "\C-c?" 'org-table-show-reference) + (org-defkey map [(meta shift up)] 'org-table-fedit-line-up) + (org-defkey map [(meta shift down)] 'org-table-fedit-line-down) + (org-defkey map [(shift up)] 'org-table-fedit-ref-up) + (org-defkey map [(shift down)] 'org-table-fedit-ref-down) + (org-defkey map [(shift left)] 'org-table-fedit-ref-left) + (org-defkey map [(shift right)] 'org-table-fedit-ref-right) + (org-defkey map [(meta up)] 'org-table-fedit-scroll-down) + (org-defkey map [(meta down)] 'org-table-fedit-scroll) + (org-defkey map [(meta tab)] 'lisp-complete-symbol) + (org-defkey map "\M-\C-i" 'lisp-complete-symbol) + (org-defkey map [(tab)] 'org-table-fedit-lisp-indent) + (org-defkey map "\C-i" 'org-table-fedit-lisp-indent) + (org-defkey map "\C-c\C-r" 'org-table-fedit-toggle-ref-type) + (org-defkey map "\C-c}" 'org-table-fedit-toggle-coordinates) + map)) + +(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu" + '("Edit-Formulas" + ["Finish and Install" org-table-fedit-finish t] + ["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c C-c"] + ["Abort" org-table-fedit-abort t] + "--" + ["Pretty-Print Lisp Formula" org-table-fedit-lisp-indent t] + ["Complete Lisp Symbol" lisp-complete-symbol t] + "--" + "Shift Reference at Point" + ["Up" org-table-fedit-ref-up t] + ["Down" org-table-fedit-ref-down t] + ["Left" org-table-fedit-ref-left t] + ["Right" org-table-fedit-ref-right t] + "-" + "Change Test Row for Column Formulas" + ["Up" org-table-fedit-line-up t] + ["Down" org-table-fedit-line-down t] + "--" + ["Scroll Table Window" org-table-fedit-scroll t] + ["Scroll Table Window down" org-table-fedit-scroll-down t] + ["Show Table Grid" org-table-fedit-toggle-coordinates + :style toggle :selected (with-current-buffer (marker-buffer org-pos) + org-table-overlay-coordinates)] + "--" + ["Standard Refs (B3 instead of @3$2)" org-table-fedit-toggle-ref-type + :style toggle :selected org-table-buffer-is-an])) + +(defvar org-pos) + +;;;###autoload +(defun org-table-edit-formulas () + "Edit the formulas of the current table in a separate buffer." + (interactive) + (when (save-excursion (beginning-of-line 1) (let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM"))) + (beginning-of-line 0)) + (unless (org-at-table-p) (user-error "Not at a table")) + (org-table-get-specials) + (let ((key (org-table-current-field-formula 'key 'noerror)) + (eql (sort (org-table-get-stored-formulas 'noerror) + 'org-table-formula-less-p)) + (pos (point-marker)) + (startline 1) + (wc (current-window-configuration)) + (sel-win (selected-window)) + (titles '((column . "# Column Formulas\n") + (field . "# Field and Range Formulas\n") + (named . "# Named Field Formulas\n"))) + entry s type title) + (org-switch-to-buffer-other-window "*Edit Formulas*") + (erase-buffer) + ;; Keep global-font-lock-mode from turning on font-lock-mode + (let ((font-lock-global-modes '(not fundamental-mode))) + (fundamental-mode)) + (org-set-local 'font-lock-global-modes (list 'not major-mode)) + (org-set-local 'org-pos pos) + (org-set-local 'org-window-configuration wc) + (org-set-local 'org-selected-window sel-win) + (use-local-map org-table-fedit-map) + (org-add-hook 'post-command-hook 'org-table-fedit-post-command t t) + (easy-menu-add org-table-fedit-menu) + (setq startline (org-current-line)) + (while (setq entry (pop eql)) + (setq type (cond + ((string-match "\\`$[<>]" (car entry)) 'column) + ((equal (string-to-char (car entry)) ?@) 'field) + ((string-match "^[0-9]" (car entry)) 'column) + (t 'named))) + (when (setq title (assq type titles)) + (or (bobp) (insert "\n")) + (insert (org-add-props (cdr title) nil 'face font-lock-comment-face)) + (setq titles (remove title titles))) + (if (equal key (car entry)) (setq startline (org-current-line))) + (setq s (concat (if (member (string-to-char (car entry)) '(?@ ?$)) "" "$") + (car entry) " = " (cdr entry) "\n")) + (remove-text-properties 0 (length s) '(face nil) s) + (insert s)) + (if (eq org-table-use-standard-references t) + (org-table-fedit-toggle-ref-type)) + (org-goto-line startline) + (message "Edit formulas, finish with `C-c C-c' or `C-c ' '. See menu for more commands."))) + +(defun org-table-fedit-post-command () + (when (not (memq this-command '(lisp-complete-symbol))) + (let ((win (selected-window))) + (save-excursion + (condition-case nil + (org-table-show-reference) + (error nil)) + (select-window win))))) + +(defun org-table-formula-to-user (s) + "Convert a formula from internal to user representation." + (if (eq org-table-use-standard-references t) + (org-table-convert-refs-to-an s) + s)) + +(defun org-table-formula-from-user (s) + "Convert a formula from user to internal representation." + (if org-table-use-standard-references + (org-table-convert-refs-to-rc s) + s)) + +(defun org-table-convert-refs-to-rc (s) + "Convert spreadsheet references from A7 to @7$28. +Works for single references, but also for entire formulas and even the +full TBLFM line." + (let ((start 0)) + (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\|\\<remote([^,)]*)\\)" s start) + (cond + ((match-end 3) + ;; format match, just advance + (setq start (match-end 0))) + ((and (> (match-beginning 0) 0) + (equal ?. (aref s (max (1- (match-beginning 0)) 0))) + (not (equal ?. (aref s (max (- (match-beginning 0) 2) 0))))) + ;; 3.e5 or something like this. + (setq start (match-end 0))) + ((or (> (- (match-end 1) (match-beginning 1)) 2) + ;; (member (match-string 1 s) + ;; '("arctan" "exp" "expm" "lnp" "log" "stir")) + ) + ;; function name, just advance + (setq start (match-end 0))) + (t + (setq start (match-beginning 0) + s (replace-match + (if (equal (match-string 2 s) "&") + (format "$%d" (org-letters-to-number (match-string 1 s))) + (format "@%d$%d" + (string-to-number (match-string 2 s)) + (org-letters-to-number (match-string 1 s)))) + t t s))))) + s)) + +(defun org-table-convert-refs-to-an (s) + "Convert spreadsheet references from to @7$28 to AB7. +Works for single references, but also for entire formulas and even the +full TBLFM line." + (while (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" s) + (setq s (replace-match + (format "%s%d" + (org-number-to-letters + (string-to-number (match-string 2 s))) + (string-to-number (match-string 1 s))) + t t s))) + (while (string-match "\\(^\\|[^0-9a-zA-Z]\\)\\$\\([0-9]+\\)" s) + (setq s (replace-match (concat "\\1" + (org-number-to-letters + (string-to-number (match-string 2 s))) "&") + t nil s))) + s) + +(defun org-letters-to-number (s) + "Convert a base 26 number represented by letters into an integer. +For example: AB -> 28." + (let ((n 0)) + (setq s (upcase s)) + (while (> (length s) 0) + (setq n (+ (* n 26) (string-to-char s) (- ?A) 1) + s (substring s 1))) + n)) + +(defun org-number-to-letters (n) + "Convert an integer into a base 26 number represented by letters. +For example: 28 -> AB." + (let ((s "")) + (while (> n 0) + (setq s (concat (char-to-string (+ (mod (1- n) 26) ?A)) s) + n (/ (1- n) 26))) + s)) + +(defun org-table-time-string-to-seconds (s) + "Convert a time string into numerical duration in seconds. +S can be a string matching either -?HH:MM:SS or -?HH:MM. +If S is a string representing a number, keep this number." + (if (equal s "") + s + (let (hour minus min sec res) + (cond + ((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s)) + (setq minus (< 0 (length (match-string 1 s))) + hour (string-to-number (match-string 2 s)) + min (string-to-number (match-string 3 s)) + sec (string-to-number (match-string 4 s))) + (if minus + (setq res (- (+ (* hour 3600) (* min 60) sec))) + (setq res (+ (* hour 3600) (* min 60) sec)))) + ((and (not (string-match org-ts-regexp-both s)) + (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s)) + (setq minus (< 0 (length (match-string 1 s))) + hour (string-to-number (match-string 2 s)) + min (string-to-number (match-string 3 s))) + (if minus + (setq res (- (+ (* hour 3600) (* min 60)))) + (setq res (+ (* hour 3600) (* min 60))))) + (t (setq res (string-to-number s)))) + (number-to-string res)))) + +(defun org-table-time-seconds-to-string (secs &optional output-format) + "Convert a number of seconds to a time string. +If OUTPUT-FORMAT is non-nil, return a number of days, hours, +minutes or seconds." + (let* ((secs0 (abs secs)) + (res + (cond ((eq output-format 'days) + (format "%.3f" (/ (float secs0) 86400))) + ((eq output-format 'hours) + (format "%.2f" (/ (float secs0) 3600))) + ((eq output-format 'minutes) + (format "%.1f" (/ (float secs0) 60))) + ((eq output-format 'seconds) + (format "%d" secs0)) + (t (org-format-seconds "%.2h:%.2m:%.2s" secs0))))) + (if (< secs 0) (concat "-" res) res))) + +(defun org-table-fedit-convert-buffer (function) + "Convert all references in this buffer, using FUNCTION." + (let ((line (org-current-line))) + (goto-char (point-min)) + (while (not (eobp)) + (insert (funcall function (buffer-substring (point) (point-at-eol)))) + (delete-region (point) (point-at-eol)) + (or (eobp) (forward-char 1))) + (org-goto-line line))) + +(defun org-table-fedit-toggle-ref-type () + "Convert all references in the buffer from B3 to @3$2 and back." + (interactive) + (org-set-local 'org-table-buffer-is-an (not org-table-buffer-is-an)) + (org-table-fedit-convert-buffer + (if org-table-buffer-is-an + 'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc)) + (message "Reference type switched to %s" + (if org-table-buffer-is-an "A1 etc" "@row$column"))) + +(defun org-table-fedit-ref-up () + "Shift the reference at point one row/hline up." + (interactive) + (org-table-fedit-shift-reference 'up)) +(defun org-table-fedit-ref-down () + "Shift the reference at point one row/hline down." + (interactive) + (org-table-fedit-shift-reference 'down)) +(defun org-table-fedit-ref-left () + "Shift the reference at point one field to the left." + (interactive) + (org-table-fedit-shift-reference 'left)) +(defun org-table-fedit-ref-right () + "Shift the reference at point one field to the right." + (interactive) + (org-table-fedit-shift-reference 'right)) + +(defun org-table-fedit-shift-reference (dir) + (cond + ((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&") + (if (memq dir '(left right)) + (org-rematch-and-replace 1 (eq dir 'left)) + (user-error "Cannot shift reference in this direction"))) + ((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)") + ;; A B3-like reference + (if (memq dir '(up down)) + (org-rematch-and-replace 2 (eq dir 'up)) + (org-rematch-and-replace 1 (eq dir 'left)))) + ((org-at-regexp-p + "\\(@\\|\\.\\.\\)\\([-+]?\\(I+\\>\\|[0-9]+\\)\\)\\(\\$\\([-+]?[0-9]+\\)\\)?") + ;; An internal reference + (if (memq dir '(up down)) + (org-rematch-and-replace 2 (eq dir 'up) (match-end 3)) + (org-rematch-and-replace 5 (eq dir 'left)))))) + +(defun org-rematch-and-replace (n &optional decr hline) + "Re-match the group N, and replace it with the shifted reference." + (or (match-end n) (user-error "Cannot shift reference in this direction")) + (goto-char (match-beginning n)) + (and (looking-at (regexp-quote (match-string n))) + (replace-match (org-table-shift-refpart (match-string 0) decr hline) + t t))) + +(defun org-table-shift-refpart (ref &optional decr hline) + "Shift a reference part REF. +If DECR is set, decrease the references row/column, else increase. +If HLINE is set, this may be a hline reference, it certainly is not +a translation reference." + (save-match-data + (let* ((sign (string-match "^[-+]" ref)) n) + + (if sign (setq sign (substring ref 0 1) ref (substring ref 1))) + (cond + ((and hline (string-match "^I+" ref)) + (setq n (string-to-number (concat sign (number-to-string (length ref))))) + (setq n (+ n (if decr -1 1))) + (if (= n 0) (setq n (+ n (if decr -1 1)))) + (if sign + (setq sign (if (< n 0) "-" "+") n (abs n)) + (setq n (max 1 n))) + (concat sign (make-string n ?I))) + + ((string-match "^[0-9]+" ref) + (setq n (string-to-number (concat sign ref))) + (setq n (+ n (if decr -1 1))) + (if sign + (concat (if (< n 0) "-" "+") (number-to-string (abs n))) + (number-to-string (max 1 n)))) + + ((string-match "^[a-zA-Z]+" ref) + (org-number-to-letters + (max 1 (+ (org-letters-to-number ref) (if decr -1 1))))) + + (t (user-error "Cannot shift reference")))))) + +(defun org-table-fedit-toggle-coordinates () + "Toggle the display of coordinates in the referenced table." + (interactive) + (let ((pos (marker-position org-pos))) + (with-current-buffer (marker-buffer org-pos) + (save-excursion + (goto-char pos) + (org-table-toggle-coordinate-overlays))))) + +(defun org-table-fedit-finish (&optional arg) + "Parse the buffer for formula definitions and install them. +With prefix ARG, apply the new formulas to the table." + (interactive "P") + (org-table-remove-rectangle-highlight) + (if org-table-use-standard-references + (progn + (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc) + (setq org-table-buffer-is-an nil))) + (let ((pos org-pos) (sel-win org-selected-window) eql var form) + (goto-char (point-min)) + (while (re-search-forward + "^\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)" + nil t) + (setq var (if (match-end 2) (match-string 2) (match-string 1)) + form (match-string 3)) + (setq form (org-trim form)) + (when (not (equal form "")) + (while (string-match "[ \t]*\n[ \t]*" form) + (setq form (replace-match " " t t form))) + (when (assoc var eql) + (user-error "Double formulas for %s" var)) + (push (cons var form) eql))) + (setq org-pos nil) + (set-window-configuration org-window-configuration) + (select-window sel-win) + (goto-char pos) + (unless (org-at-table-p) + (user-error "Lost table position - cannot install formulas")) + (org-table-store-formulas eql) + (move-marker pos nil) + (kill-buffer "*Edit Formulas*") + (if arg + (org-table-recalculate 'all) + (message "New formulas installed - press C-u C-c C-c to apply.")))) + +(defun org-table-fedit-abort () + "Abort editing formulas, without installing the changes." + (interactive) + (org-table-remove-rectangle-highlight) + (let ((pos org-pos) (sel-win org-selected-window)) + (set-window-configuration org-window-configuration) + (select-window sel-win) + (goto-char pos) + (move-marker pos nil) + (message "Formula editing aborted without installing changes"))) + +(defun org-table-fedit-lisp-indent () + "Pretty-print and re-indent Lisp expressions in the Formula Editor." + (interactive) + (let ((pos (point)) beg end ind) + (beginning-of-line 1) + (cond + ((looking-at "[ \t]") + (goto-char pos) + (call-interactively 'lisp-indent-line)) + ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos)) + ((not (fboundp 'pp-buffer)) + (user-error "Cannot pretty-print. Command `pp-buffer' is not available")) + ((looking-at "[$&@0-9a-zA-Z]+ *= *'(") + (goto-char (- (match-end 0) 2)) + (setq beg (point)) + (setq ind (make-string (current-column) ?\ )) + (condition-case nil (forward-sexp 1) + (error + (user-error "Cannot pretty-print Lisp expression: Unbalanced parenthesis"))) + (setq end (point)) + (save-restriction + (narrow-to-region beg end) + (if (eq last-command this-command) + (progn + (goto-char (point-min)) + (setq this-command nil) + (while (re-search-forward "[ \t]*\n[ \t]*" nil t) + (replace-match " "))) + (pp-buffer) + (untabify (point-min) (point-max)) + (goto-char (1+ (point-min))) + (while (re-search-forward "^." nil t) + (beginning-of-line 1) + (insert ind)) + (goto-char (point-max)) + (org-delete-backward-char 1))) + (goto-char beg)) + (t nil)))) + +(defvar org-show-positions nil) + +(defun org-table-show-reference (&optional local) + "Show the location/value of the $ expression at point." + (interactive) + (org-table-remove-rectangle-highlight) + (catch 'exit + (let ((pos (if local (point) org-pos)) + (face2 'highlight) + (org-inhibit-highlight-removal t) + (win (selected-window)) + (org-show-positions nil) + var name e what match dest) + (if local (org-table-get-specials)) + (setq what (cond + ((org-at-regexp-p "^@[0-9]+[ \t=]") + (setq match (concat (substring (match-string 0) 0 -1) + "$1.." + (substring (match-string 0) 0 -1) + "$100")) + 'range) + ((or (org-at-regexp-p org-table-range-regexp2) + (org-at-regexp-p org-table-translate-regexp) + (org-at-regexp-p org-table-range-regexp)) + (setq match + (save-match-data + (org-table-convert-refs-to-rc (match-string 0)))) + 'range) + ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name) + ((org-at-regexp-p "\\$[0-9]+") 'column) + ((not local) nil) + (t (user-error "No reference at point"))) + match (and what (or match (match-string 0)))) + (when (and match (not (equal (match-beginning 0) (point-at-bol)))) + (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0) + 'secondary-selection)) + (org-add-hook 'before-change-functions + 'org-table-remove-rectangle-highlight) + (if (eq what 'name) (setq var (substring match 1))) + (when (eq what 'range) + (or (equal (string-to-char match) ?@) (setq match (concat "@" match))) + (setq match (org-table-formula-substitute-names match))) + (unless local + (save-excursion + (end-of-line 1) + (re-search-backward "^\\S-" nil t) + (beginning-of-line 1) + (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\\([0-9]+\\|&\\)\\) *=") + (setq dest + (save-match-data + (org-table-convert-refs-to-rc (match-string 1)))) + (org-table-add-rectangle-overlay + (match-beginning 1) (match-end 1) face2)))) + (if (and (markerp pos) (marker-buffer pos)) + (if (get-buffer-window (marker-buffer pos)) + (select-window (get-buffer-window (marker-buffer pos))) + (org-switch-to-buffer-other-window (get-buffer-window + (marker-buffer pos))))) + (goto-char pos) + (org-table-force-dataline) + (when dest + (setq name (substring dest 1)) + (cond + ((string-match "^\\$[a-zA-Z][a-zA-Z0-9]*" dest) + (setq e (assoc name org-table-named-field-locations)) + (org-goto-line (nth 1 e)) + (org-table-goto-column (nth 2 e))) + ((string-match "^@\\([0-9]+\\)\\$\\([0-9]+\\)" dest) + (let ((l (string-to-number (match-string 1 dest))) + (c (string-to-number (match-string 2 dest)))) + (org-goto-line (aref org-table-dlines l)) + (org-table-goto-column c))) + (t (org-table-goto-column (string-to-number name)))) + (move-marker pos (point)) + (org-table-highlight-rectangle nil nil face2)) + (cond + ((equal dest match)) + ((not match)) + ((eq what 'range) + (condition-case nil + (save-excursion + (org-table-get-range match nil nil 'highlight)) + (error nil))) + ((setq e (assoc var org-table-named-field-locations)) + (org-goto-line (nth 1 e)) + (org-table-goto-column (nth 2 e)) + (org-table-highlight-rectangle (point) (point)) + (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e))) + ((setq e (assoc var org-table-column-names)) + (org-table-goto-column (string-to-number (cdr e))) + (org-table-highlight-rectangle (point) (point)) + (goto-char (org-table-begin)) + (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|") + (org-table-end) t) + (progn + (goto-char (match-beginning 1)) + (org-table-highlight-rectangle) + (message "Named column (column %s)" (cdr e))) + (user-error "Column name not found"))) + ((eq what 'column) + ;; column number + (org-table-goto-column (string-to-number (substring match 1))) + (org-table-highlight-rectangle (point) (point)) + (message "Column %s" (substring match 1))) + ((setq e (assoc var org-table-local-parameters)) + (goto-char (org-table-begin)) + (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t) + (progn + (goto-char (match-beginning 1)) + (org-table-highlight-rectangle) + (message "Local parameter.")) + (user-error "Parameter not found"))) + (t + (cond + ((not var) (user-error "No reference at point")) + ((setq e (assoc var org-table-formula-constants-local)) + (message "Local Constant: $%s=%s in #+CONSTANTS line." + var (cdr e))) + ((setq e (assoc var org-table-formula-constants)) + (message "Constant: $%s=%s in `org-table-formula-constants'." + var (cdr e))) + ((setq e (and (fboundp 'constants-get) (constants-get var))) + (message "Constant: $%s=%s, from `constants.el'%s." + var e (format " (%s units)" constants-unit-system))) + (t (user-error "Undefined name $%s" var))))) + (goto-char pos) + (when (and org-show-positions + (not (memq this-command '(org-table-fedit-scroll + org-table-fedit-scroll-down)))) + (push pos org-show-positions) + (push org-table-current-begin-pos org-show-positions) + (let ((min (apply 'min org-show-positions)) + (max (apply 'max org-show-positions))) + (set-window-start (selected-window) min) + (goto-char max) + (or (pos-visible-in-window-p max) + (set-window-start (selected-window) max)))) + (select-window win)))) + +(defun org-table-force-dataline () + "Make sure the cursor is in a dataline in a table." + (unless (save-excursion + (beginning-of-line 1) + (looking-at org-table-dataline-regexp)) + (let* ((re org-table-dataline-regexp) + (p1 (save-excursion (re-search-forward re nil 'move))) + (p2 (save-excursion (re-search-backward re nil 'move)))) + (cond ((and p1 p2) + (goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point)))) + p1 p2))) + ((or p1 p2) (goto-char (or p1 p2))) + (t (user-error "No table dataline around here")))))) + +(defun org-table-fedit-line-up () + "Move cursor one line up in the window showing the table." + (interactive) + (org-table-fedit-move 'previous-line)) + +(defun org-table-fedit-line-down () + "Move cursor one line down in the window showing the table." + (interactive) + (org-table-fedit-move 'next-line)) + +(defun org-table-fedit-move (command) + "Move the cursor in the window showing the table. +Use COMMAND to do the motion, repeat if necessary to end up in a data line." + (let ((org-table-allow-automatic-line-recalculation nil) + (pos org-pos) (win (selected-window)) p) + (select-window (get-buffer-window (marker-buffer org-pos))) + (setq p (point)) + (call-interactively command) + (while (and (org-at-table-p) + (org-at-table-hline-p)) + (call-interactively command)) + (or (org-at-table-p) (goto-char p)) + (move-marker pos (point)) + (select-window win))) + +(defun org-table-fedit-scroll (N) + (interactive "p") + (let ((other-window-scroll-buffer (marker-buffer org-pos))) + (scroll-other-window N))) + +(defun org-table-fedit-scroll-down (N) + (interactive "p") + (org-table-fedit-scroll (- N))) + +(defvar org-table-rectangle-overlays nil) + +(defun org-table-add-rectangle-overlay (beg end &optional face) + "Add a new overlay." + (let ((ov (make-overlay beg end))) + (overlay-put ov 'face (or face 'secondary-selection)) + (push ov org-table-rectangle-overlays))) + +(defun org-table-highlight-rectangle (&optional beg end face) + "Highlight rectangular region in a table." + (setq beg (or beg (point)) end (or end (point))) + (let ((b (min beg end)) + (e (max beg end)) + l1 c1 l2 c2 tmp) + (and (boundp 'org-show-positions) + (setq org-show-positions (cons b (cons e org-show-positions)))) + (goto-char (min beg end)) + (setq l1 (org-current-line) + c1 (org-table-current-column)) + (goto-char (max beg end)) + (setq l2 (org-current-line) + c2 (org-table-current-column)) + (if (> c1 c2) (setq tmp c1 c1 c2 c2 tmp)) + (org-goto-line l1) + (beginning-of-line 1) + (loop for line from l1 to l2 do + (when (looking-at org-table-dataline-regexp) + (org-table-goto-column c1) + (skip-chars-backward "^|\n") (setq beg (point)) + (org-table-goto-column c2) + (skip-chars-forward "^|\n") (setq end (point)) + (org-table-add-rectangle-overlay beg end face)) + (beginning-of-line 2)) + (goto-char b)) + (add-hook 'before-change-functions 'org-table-remove-rectangle-highlight)) + +(defun org-table-remove-rectangle-highlight (&rest ignore) + "Remove the rectangle overlays." + (unless org-inhibit-highlight-removal + (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight) + (mapc 'delete-overlay org-table-rectangle-overlays) + (setq org-table-rectangle-overlays nil))) + +(defvar org-table-coordinate-overlays nil + "Collects the coordinate grid overlays, so that they can be removed.") +(make-variable-buffer-local 'org-table-coordinate-overlays) + +(defun org-table-overlay-coordinates () + "Add overlays to the table at point, to show row/column coordinates." + (interactive) + (mapc 'delete-overlay org-table-coordinate-overlays) + (setq org-table-coordinate-overlays nil) + (save-excursion + (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg) + (goto-char (org-table-begin)) + (while (org-at-table-p) + (setq eol (point-at-eol)) + (setq ov (make-overlay (point-at-bol) (1+ (point-at-bol)))) + (push ov org-table-coordinate-overlays) + (setq hline (looking-at org-table-hline-regexp)) + (setq str (if hline (format "I*%-2d" (setq ih (1+ ih))) + (format "%4d" (setq id (1+ id))))) + (org-overlay-before-string ov str 'org-special-keyword 'evaporate) + (when hline + (setq ic 0) + (while (re-search-forward "[+|]\\(-+\\)" eol t) + (setq beg (1+ (match-beginning 0)) + ic (1+ ic) + s1 (concat "$" (int-to-string ic)) + s2 (org-number-to-letters ic) + str (if (eq org-table-use-standard-references t) s2 s1)) + (setq ov (make-overlay beg (+ beg (length str)))) + (push ov org-table-coordinate-overlays) + (org-overlay-display ov str 'org-special-keyword 'evaporate))) + (beginning-of-line 2))))) + +;;;###autoload +(defun org-table-toggle-coordinate-overlays () + "Toggle the display of Row/Column numbers in tables." + (interactive) + (setq org-table-overlay-coordinates (not org-table-overlay-coordinates)) + (message "Tables Row/Column numbers display turned %s" + (if org-table-overlay-coordinates "on" "off")) + (if (and (org-at-table-p) org-table-overlay-coordinates) + (org-table-align)) + (unless org-table-overlay-coordinates + (mapc 'delete-overlay org-table-coordinate-overlays) + (setq org-table-coordinate-overlays nil))) + +;;;###autoload +(defun org-table-toggle-formula-debugger () + "Toggle the formula debugger in tables." + (interactive) + (setq org-table-formula-debug (not org-table-formula-debug)) + (message "Formula debugging has been turned %s" + (if org-table-formula-debug "on" "off"))) + +;;; The orgtbl minor mode + +;; Define a minor mode which can be used in other modes in order to +;; integrate the org-mode table editor. + +;; This is really a hack, because the org-mode table editor uses several +;; keys which normally belong to the major mode, for example the TAB and +;; RET keys. Here is how it works: The minor mode defines all the keys +;; necessary to operate the table editor, but wraps the commands into a +;; function which tests if the cursor is currently inside a table. If that +;; is the case, the table editor command is executed. However, when any of +;; those keys is used outside a table, the function uses `key-binding' to +;; look up if the key has an associated command in another currently active +;; keymap (minor modes, major mode, global), and executes that command. +;; There might be problems if any of the keys used by the table editor is +;; otherwise used as a prefix key. + +;; Another challenge is that the key binding for TAB can be tab or \C-i, +;; likewise the binding for RET can be return or \C-m. Orgtbl-mode +;; addresses this by checking explicitly for both bindings. + +;; The optimized version (see variable `orgtbl-optimized') takes over +;; all keys which are bound to `self-insert-command' in the *global map*. +;; Some modes bind other commands to simple characters, for example +;; AUCTeX binds the double quote to `Tex-insert-quote'. With orgtbl-mode +;; active, this binding is ignored inside tables and replaced with a +;; modified self-insert. + + +(defvar orgtbl-mode-map (make-keymap) + "Keymap for `orgtbl-mode'.") + +(defvar org-old-auto-fill-inhibit-regexp nil + "Local variable used by `orgtbl-mode'.") + +(defconst orgtbl-line-start-regexp + "[ \t]*\\(|\\|#\\+\\(tblfm\\|orgtbl\\|tblname\\):\\)" + "Matches a line belonging to an orgtbl.") + +(defconst orgtbl-extra-font-lock-keywords + (list (list (concat "^" orgtbl-line-start-regexp ".*") + 0 (quote 'org-table) 'prepend)) + "Extra `font-lock-keywords' to be added when `orgtbl-mode' is active.") + +;; Install it as a minor mode. +(put 'orgtbl-mode :included t) +(put 'orgtbl-mode :menu-tag "Org Table Mode") + +;;;###autoload +(define-minor-mode orgtbl-mode + "The `org-mode' table editor as a minor mode for use in other modes." + :lighter " OrgTbl" :keymap orgtbl-mode-map + (org-load-modules-maybe) + (cond + ((derived-mode-p 'org-mode) + ;; Exit without error, in case some hook functions calls this + ;; by accident in org-mode. + (message "Orgtbl-mode is not useful in org-mode, command ignored")) + (orgtbl-mode + (and (orgtbl-setup) (defun orgtbl-setup () nil)) ;; FIXME: Yuck!?! + ;; Make sure we are first in minor-mode-map-alist + (let ((c (assq 'orgtbl-mode minor-mode-map-alist))) + ;; FIXME: maybe it should use emulation-mode-map-alists? + (and c (setq minor-mode-map-alist + (cons c (delq c minor-mode-map-alist))))) + (org-set-local (quote org-table-may-need-update) t) + (org-add-hook 'before-change-functions 'org-before-change-function + nil 'local) + (org-set-local 'org-old-auto-fill-inhibit-regexp + auto-fill-inhibit-regexp) + (org-set-local 'auto-fill-inhibit-regexp + (if auto-fill-inhibit-regexp + (concat orgtbl-line-start-regexp "\\|" + auto-fill-inhibit-regexp) + orgtbl-line-start-regexp)) + (add-to-invisibility-spec '(org-cwidth)) + (when (fboundp 'font-lock-add-keywords) + (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) + (org-restart-font-lock)) + (easy-menu-add orgtbl-mode-menu)) + (t + (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) + (org-table-cleanup-narrow-column-properties) + (org-remove-from-invisibility-spec '(org-cwidth)) + (remove-hook 'before-change-functions 'org-before-change-function t) + (when (fboundp 'font-lock-remove-keywords) + (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords) + (org-restart-font-lock)) + (easy-menu-remove orgtbl-mode-menu) + (force-mode-line-update 'all)))) + +(defun org-table-cleanup-narrow-column-properties () + "Remove all properties related to narrow-column invisibility." + (let ((s (point-min))) + (while (setq s (text-property-any s (point-max) + 'display org-narrow-column-arrow)) + (remove-text-properties s (1+ s) '(display t))) + (setq s (point-min)) + (while (setq s (text-property-any s (point-max) 'org-cwidth 1)) + (remove-text-properties s (1+ s) '(org-cwidth t))) + (setq s (point-min)) + (while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth)) + (remove-text-properties s (1+ s) '(invisible t))))) + +(defun orgtbl-make-binding (fun n &rest keys) + "Create a function for binding in the table minor mode. +FUN is the command to call inside a table. N is used to create a unique +command name. KEYS are keys that should be checked in for a command +to execute outside of tables." + (eval + (list 'defun + (intern (concat "orgtbl-hijacker-command-" (int-to-string n))) + '(arg) + (concat "In tables, run `" (symbol-name fun) "'.\n" + "Outside of tables, run the binding of `" + (mapconcat #'key-description keys "' or `") + "'.") + '(interactive "p") + (list 'if + '(org-at-table-p) + (list 'call-interactively (list 'quote fun)) + (list 'let '(orgtbl-mode) + (list 'call-interactively + (append '(or) + (mapcar (lambda (k) + (list 'key-binding k)) + keys) + '('orgtbl-error)))))))) + +(defun orgtbl-error () + "Error when there is no default binding for a table key." + (interactive) + (user-error "This key has no function outside tables")) + +(defun orgtbl-setup () + "Setup orgtbl keymaps." + (let ((nfunc 0) + (bindings + '(([(meta shift left)] org-table-delete-column) + ([(meta left)] org-table-move-column-left) + ([(meta right)] org-table-move-column-right) + ([(meta shift right)] org-table-insert-column) + ([(meta shift up)] org-table-kill-row) + ([(meta shift down)] org-table-insert-row) + ([(meta up)] org-table-move-row-up) + ([(meta down)] org-table-move-row-down) + ("\C-c\C-w" org-table-cut-region) + ("\C-c\M-w" org-table-copy-region) + ("\C-c\C-y" org-table-paste-rectangle) + ("\C-c\C-w" org-table-wrap-region) + ("\C-c-" org-table-insert-hline) + ("\C-c}" org-table-toggle-coordinate-overlays) + ("\C-c{" org-table-toggle-formula-debugger) + ("\C-m" org-table-next-row) + ([(shift return)] org-table-copy-down) + ("\C-c?" org-table-field-info) + ("\C-c " org-table-blank-field) + ("\C-c+" org-table-sum) + ("\C-c=" org-table-eval-formula) + ("\C-c'" org-table-edit-formulas) + ("\C-c`" org-table-edit-field) + ("\C-c*" org-table-recalculate) + ("\C-c^" org-table-sort-lines) + ("\M-a" org-table-beginning-of-field) + ("\M-e" org-table-end-of-field) + ([(control ?#)] org-table-rotate-recalc-marks))) + elt key fun cmd) + (while (setq elt (pop bindings)) + (setq nfunc (1+ nfunc)) + (setq key (org-key (car elt)) + fun (nth 1 elt) + cmd (orgtbl-make-binding fun nfunc key)) + (org-defkey orgtbl-mode-map key cmd)) + + ;; Special treatment needed for TAB and RET + (org-defkey orgtbl-mode-map [(return)] + (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) + (org-defkey orgtbl-mode-map "\C-m" + (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) + + (org-defkey orgtbl-mode-map [(tab)] + (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) + (org-defkey orgtbl-mode-map "\C-i" + (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])) + + (org-defkey orgtbl-mode-map [(shift tab)] + (orgtbl-make-binding 'org-table-previous-field 104 + [(shift tab)] [(tab)] "\C-i")) + + + (unless (featurep 'xemacs) + (org-defkey orgtbl-mode-map [S-iso-lefttab] + (orgtbl-make-binding 'org-table-previous-field 107 + [S-iso-lefttab] [backtab] [(shift tab)] + [(tab)] "\C-i"))) + + (org-defkey orgtbl-mode-map [backtab] + (orgtbl-make-binding 'org-table-previous-field 108 + [backtab] [S-iso-lefttab] [(shift tab)] + [(tab)] "\C-i")) + + (org-defkey orgtbl-mode-map "\M-\C-m" + (orgtbl-make-binding 'org-table-wrap-region 105 + "\M-\C-m" [(meta return)])) + (org-defkey orgtbl-mode-map [(meta return)] + (orgtbl-make-binding 'org-table-wrap-region 106 + [(meta return)] "\M-\C-m")) + + (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c) + (org-defkey orgtbl-mode-map "\C-c|" 'orgtbl-create-or-convert-from-region) + + (when orgtbl-optimized + ;; If the user wants maximum table support, we need to hijack + ;; some standard editing functions + (org-remap orgtbl-mode-map + 'self-insert-command 'orgtbl-self-insert-command + 'delete-char 'org-delete-char + 'delete-backward-char 'org-delete-backward-char) + (org-defkey orgtbl-mode-map "|" 'org-force-self-insert)) + (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu" + '("OrgTbl" + ["Create or convert" org-table-create-or-convert-from-region + :active (not (org-at-table-p)) :keys "C-c |" ] + "--" + ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"] + ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"] + ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"] + ["Next Row" org-return :active (org-at-table-p) :keys "RET"] + "--" + ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] + ["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "] + ["Copy Field from Above" + org-table-copy-down :active (org-at-table-p) :keys "S-RET"] + "--" + ("Column" + ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"] + ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"] + ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"] + ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"]) + ("Row" + ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"] + ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"] + ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"] + ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"] + ["Sort lines in region" org-table-sort-lines :active (org-at-table-p) :keys "C-c ^"] + "--" + ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"]) + ("Rectangle" + ["Copy Rectangle" org-copy-special :active (org-at-table-p)] + ["Cut Rectangle" org-cut-special :active (org-at-table-p)] + ["Paste Rectangle" org-paste-special :active (org-at-table-p)] + ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)]) + "--" + ("Radio tables" + ["Insert table template" orgtbl-insert-radio-table + (assq major-mode orgtbl-radio-table-templates)] + ["Comment/uncomment table" orgtbl-toggle-comment t]) + "--" + ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] + ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] + ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"] + ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"] + ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"] + ["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"] + ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"] + ["Sum Column/Rectangle" org-table-sum + :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] + ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] + ["Debug Formulas" + org-table-toggle-formula-debugger :active (org-at-table-p) + :keys "C-c {" + :style toggle :selected org-table-formula-debug] + ["Show Col/Row Numbers" + org-table-toggle-coordinate-overlays :active (org-at-table-p) + :keys "C-c }" + :style toggle :selected org-table-overlay-coordinates] + )) + t)) + +(defun orgtbl-ctrl-c-ctrl-c (arg) + "If the cursor is inside a table, realign the table. +If it is a table to be sent away to a receiver, do it. +With prefix arg, also recompute table." + (interactive "P") + (let ((case-fold-search t) (pos (point)) action) + (save-excursion + (beginning-of-line 1) + (setq action (cond + ((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) + ((looking-at "[ \t]*|") pos) + ((looking-at "[ \t]*#\\+tblfm:") 'recalc)))) + (cond + ((integerp action) + (goto-char action) + (org-table-maybe-eval-formula) + (if arg + (call-interactively 'org-table-recalculate) + (org-table-maybe-recalculate-line)) + (call-interactively 'org-table-align) + (when (orgtbl-send-table 'maybe) + (run-hooks 'orgtbl-after-send-table-hook))) + ((eq action 'recalc) + (org-table-set-constants) + (save-excursion + (beginning-of-line 1) + (skip-chars-backward " \r\n\t") + (if (org-at-table-p) + (org-call-with-arg 'org-table-recalculate t)))) + (t (let (orgtbl-mode) + (call-interactively (key-binding "\C-c\C-c"))))))) + +(defun orgtbl-create-or-convert-from-region (arg) + "Create table or convert region to table, if no conflicting binding. +This installs the table binding `C-c |', but only if there is no +conflicting binding to this key outside orgtbl-mode." + (interactive "P") + (let* (orgtbl-mode (cmd (key-binding "\C-c|"))) + (if cmd + (call-interactively cmd) + (call-interactively 'org-table-create-or-convert-from-region)))) + +(defun orgtbl-tab (arg) + "Justification and field motion for `orgtbl-mode'." + (interactive "P") + (if arg (org-table-edit-field t) + (org-table-justify-field-maybe) + (org-table-next-field))) + +(defun orgtbl-ret () + "Justification and field motion for `orgtbl-mode'." + (interactive) + (if (bobp) + (newline) + (org-table-justify-field-maybe) + (org-table-next-row))) + +(defun orgtbl-self-insert-command (N) + "Like `self-insert-command', use overwrite-mode for whitespace in tables. +If the cursor is in a table looking at whitespace, the whitespace is +overwritten, and the table is not marked as requiring realignment." + (interactive "p") + (if (and (org-at-table-p) + (or + (and org-table-auto-blank-field + (member last-command + '(orgtbl-hijacker-command-100 + orgtbl-hijacker-command-101 + orgtbl-hijacker-command-102 + orgtbl-hijacker-command-103 + orgtbl-hijacker-command-104 + orgtbl-hijacker-command-105 + yas/expand)) + (org-table-blank-field)) + t) + (eq N 1) + (looking-at "[^|\n]* +|")) + (let (org-table-may-need-update) + (goto-char (1- (match-end 0))) + (org-delete-backward-char 1) + (goto-char (match-beginning 0)) + (self-insert-command N)) + (setq org-table-may-need-update t) + (let* (orgtbl-mode + a + (cmd (or (key-binding + (or (and (listp function-key-map) + (setq a (assoc last-input-event function-key-map)) + (cdr a)) + (vector last-input-event))) + 'self-insert-command))) + (call-interactively cmd) + (if (and org-self-insert-cluster-for-undo + (eq cmd 'self-insert-command)) + (if (not (eq last-command 'orgtbl-self-insert-command)) + (setq org-self-insert-command-undo-counter 1) + (if (>= org-self-insert-command-undo-counter 20) + (setq org-self-insert-command-undo-counter 1) + (and (> org-self-insert-command-undo-counter 0) + buffer-undo-list + (not (cadr buffer-undo-list)) ; remove nil entry + (setcdr buffer-undo-list (cddr buffer-undo-list))) + (setq org-self-insert-command-undo-counter + (1+ org-self-insert-command-undo-counter)))))))) + +(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" + "Regular expression matching exponentials as produced by calc.") + +(defun orgtbl-gather-send-defs () + "Gather a plist of :name, :transform, :params for each destination before +a radio table." + (save-excursion + (goto-char (org-table-begin)) + (let (rtn) + (beginning-of-line 0) + (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") + (let ((name (org-no-properties (match-string 1))) + (transform (intern (match-string 2))) + (params (if (match-end 3) + (read (concat "(" (match-string 3) ")"))))) + (push (list :name name :transform transform :params params) + rtn) + (beginning-of-line 0))) + rtn))) + +(defun orgtbl-send-replace-tbl (name txt) + "Find and replace table NAME with TXT." + (save-excursion + (goto-char (point-min)) + (unless (re-search-forward + (concat "BEGIN +RECEIVE +ORGTBL +" name "\\([ \t]\\|$\\)") nil t) + (user-error "Don't know where to insert translated table")) + (goto-char (match-beginning 0)) + (beginning-of-line 2) + (save-excursion + (let ((beg (point))) + (unless (re-search-forward + (concat "END +RECEIVE +ORGTBL +" name) nil t) + (user-error "Cannot find end of insertion region")) + (beginning-of-line 1) + (delete-region beg (point)))) + (insert txt "\n"))) + +;;;###autoload +(defun org-table-to-lisp (&optional txt) + "Convert the table at point to a Lisp structure. +The structure will be a list. Each item is either the symbol `hline' +for a horizontal separator line, or a list of field values as strings. +The table is taken from the parameter TXT, or from the buffer at point." + (unless txt + (unless (org-at-table-p) + (user-error "No table at point"))) + (let* ((txt (or txt + (buffer-substring-no-properties (org-table-begin) + (org-table-end)))) + (lines (org-split-string txt "[ \t]*\n[ \t]*"))) + + (mapcar + (lambda (x) + (if (string-match org-table-hline-regexp x) + 'hline + (org-split-string (org-trim x) "\\s-*|\\s-*"))) + lines))) + +(defun orgtbl-send-table (&optional maybe) + "Send a transformed version of this table to the receiver position. +With argument MAYBE, fail quietly if no transformation is defined for +this table." + (interactive) + (catch 'exit + (unless (org-at-table-p) (user-error "Not at a table")) + ;; when non-interactive, we assume align has just happened. + (when (org-called-interactively-p 'any) (org-table-align)) + (let ((dests (orgtbl-gather-send-defs)) + (txt (buffer-substring-no-properties (org-table-begin) + (org-table-end))) + (ntbl 0)) + (unless dests (if maybe (throw 'exit nil) + (user-error "Don't know how to transform this table"))) + (dolist (dest dests) + (let* ((name (plist-get dest :name)) + (transform (plist-get dest :transform)) + (params (plist-get dest :params)) + (skip (plist-get params :skip)) + (skipcols (plist-get params :skipcols)) + (no-escape (plist-get params :no-escape)) + beg + (lines (org-table-clean-before-export + (nthcdr (or skip 0) + (org-split-string txt "[ \t]*\n[ \t]*")))) + (i0 (if org-table-clean-did-remove-column 2 1)) + (lines (if no-escape lines + (mapcar (lambda(l) (replace-regexp-in-string + "\\([&%#_^]\\)" "\\\\\\1{}" l)) lines))) + (table (mapcar + (lambda (x) + (if (string-match org-table-hline-regexp x) + 'hline + (org-remove-by-index + (org-split-string (org-trim x) "\\s-*|\\s-*") + skipcols i0))) + lines)) + (fun (if (= i0 2) 'cdr 'identity)) + (org-table-last-alignment + (org-remove-by-index (funcall fun org-table-last-alignment) + skipcols i0)) + (org-table-last-column-widths + (org-remove-by-index (funcall fun org-table-last-column-widths) + skipcols i0)) + (txt (if (fboundp transform) + (funcall transform table params) + (user-error "No such transformation function %s" transform)))) + (orgtbl-send-replace-tbl name txt)) + (setq ntbl (1+ ntbl))) + (message "Table converted and installed at %d receiver location%s" + ntbl (if (> ntbl 1) "s" "")) + (if (> ntbl 0) + ntbl + nil)))) + +(defun org-remove-by-index (list indices &optional i0) + "Remove the elements in LIST with indices in INDICES. +First element has index 0, or I0 if given." + (if (not indices) + list + (if (integerp indices) (setq indices (list indices))) + (setq i0 (1- (or i0 0))) + (delq :rm (mapcar (lambda (x) + (setq i0 (1+ i0)) + (if (memq i0 indices) :rm x)) + list)))) + +(defun orgtbl-toggle-comment () + "Comment or uncomment the orgtbl at point." + (interactive) + (let* ((case-fold-search t) + (re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp)) + (re2 (concat "^" orgtbl-line-start-regexp)) + (commented (save-excursion (beginning-of-line 1) + (cond ((looking-at re1) t) + ((looking-at re2) nil) + (t (user-error "Not at an org table"))))) + (re (if commented re1 re2)) + beg end) + (save-excursion + (beginning-of-line 1) + (while (looking-at re) (beginning-of-line 0)) + (beginning-of-line 2) + (setq beg (point)) + (while (looking-at re) (beginning-of-line 2)) + (setq end (point))) + (comment-region beg end (if commented '(4) nil)))) + +(defun orgtbl-insert-radio-table () + "Insert a radio table template appropriate for this major mode." + (interactive) + (let* ((e (assq major-mode orgtbl-radio-table-templates)) + (txt (nth 1 e)) + name pos) + (unless e (user-error "No radio table setup defined for %s" major-mode)) + (setq name (read-string "Table name: ")) + (while (string-match "%n" txt) + (setq txt (replace-match name t t txt))) + (or (bolp) (insert "\n")) + (setq pos (point)) + (insert txt) + (goto-char pos))) + +;; Dynamically bound input and output for table formatting. +(defvar *orgtbl-table* nil + "Carries the current table through formatting routines.") +(defvar *orgtbl-rtn* nil + "Formatting routines push the output lines here.") +;; Formatting parameters for the current table section. +(defvar *orgtbl-hline* nil "Text used for horizontal lines.") +(defvar *orgtbl-sep* nil "Text used as a column separator.") +(defvar *orgtbl-default-fmt* nil "Default format for each entry.") +(defvar *orgtbl-fmt* nil "Format for each entry.") +(defvar *orgtbl-efmt* nil "Format for numbers.") +(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt.") +(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row.") +(defvar *orgtbl-lstart* nil "Text starting a row.") +(defvar *orgtbl-llstart* nil "Specializes lstart for the last row.") +(defvar *orgtbl-lend* nil "Text ending a row.") +(defvar *orgtbl-llend* nil "Specializes lend for the last row.") + +(defsubst orgtbl-get-fmt (fmt i) + "Retrieve the format from FMT corresponding to the Ith column." + (if (and (not (functionp fmt)) (consp fmt)) + (plist-get fmt i) + fmt)) + +(defsubst orgtbl-apply-fmt (fmt &rest args) + "Apply format FMT to arguments ARGS. +When FMT is nil, return the first argument from ARGS." + (cond ((functionp fmt) (apply fmt args)) + (fmt (apply 'format fmt args)) + (args (car args)) + (t args))) + +(defsubst orgtbl-eval-str (str) + "If STR is a function, evaluate it with no arguments." + (if (functionp str) + (funcall str) + str)) + +(defun orgtbl-format-line (line) + "Format LINE as a table row." + (if (eq line 'hline) (if *orgtbl-hline* (push *orgtbl-hline* *orgtbl-rtn*)) + (let* ((i 0) + (line + (mapcar + (lambda (f) + (setq i (1+ i)) + (let* ((efmt (orgtbl-get-fmt *orgtbl-efmt* i)) + (f (if (and efmt (string-match orgtbl-exp-regexp f)) + (orgtbl-apply-fmt efmt (match-string 1 f) + (match-string 2 f)) + f))) + (orgtbl-apply-fmt (or (orgtbl-get-fmt *orgtbl-fmt* i) + *orgtbl-default-fmt*) + f))) + line))) + (push (if *orgtbl-lfmt* + (apply #'orgtbl-apply-fmt *orgtbl-lfmt* line) + (concat (orgtbl-eval-str *orgtbl-lstart*) + (mapconcat 'identity line *orgtbl-sep*) + (orgtbl-eval-str *orgtbl-lend*))) + *orgtbl-rtn*)))) + +(defun orgtbl-format-section (section-stopper) + "Format lines until the first occurrence of SECTION-STOPPER." + (let (prevline) + (progn + (while (not (eq (car *orgtbl-table*) section-stopper)) + (if prevline (orgtbl-format-line prevline)) + (setq prevline (pop *orgtbl-table*))) + (if prevline (let ((*orgtbl-lstart* *orgtbl-llstart*) + (*orgtbl-lend* *orgtbl-llend*) + (*orgtbl-lfmt* *orgtbl-llfmt*)) + (orgtbl-format-line prevline)))))) + +;;;###autoload +(defun orgtbl-to-generic (table params &optional backend) + "Convert the orgtbl-mode TABLE to some other format. +This generic routine can be used for many standard cases. +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. +A third optional argument BACKEND can be used to convert the content of +the cells using a specific export back-end. + +For the generic converter, some parameters are obligatory: you need to +specify either :lfmt, or all of (:lstart :lend :sep). + +Valid parameters are: + +:splice When set to t, return only table body lines, don't wrap + them into :tstart and :tend. Default is nil. When :splice + is non-nil, this also means that the exporter should not look + for and interpret header and footer sections. + +:hline String to be inserted on horizontal separation lines. + May be nil to ignore hlines. + +:sep Separator between two fields +:remove-nil-lines Do not include lines that evaluate to nil. + +Each in the following group may be either a string or a function +of no arguments returning a string: + +:tstart String to start the table. Ignored when :splice is t. +:tend String to end the table. Ignored when :splice is t. +:lstart String to start a new table line. +:llstart String to start the last table line, defaults to :lstart. +:lend String to end a table line +:llend String to end the last table line, defaults to :lend. + +Each in the following group may be a string, a function of one +argument (the field or line) returning a string, or a plist +mapping columns to either of the above: + +:lfmt Format for entire line, with enough %s to capture all fields. + If this is present, :lstart, :lend, and :sep are ignored. +:llfmt Format for the entire last line, defaults to :lfmt. +:fmt A format to be used to wrap the field, should contain + %s for the original field value. For example, to wrap + everything in dollars, you could use :fmt \"$%s$\". + This may also be a property list with column numbers and + formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\") +:hlstart :hllstart :hlend :hllend :hlsep :hlfmt :hllfmt :hfmt + Same as above, specific for the header lines in the table. + All lines before the first hline are treated as header. + If any of these is not present, the data line value is used. + +This may be either a string or a function of two arguments: + +:efmt Use this format to print numbers with exponentials. + The format should have %s twice for inserting mantissa + and exponent, for example \"%s\\\\times10^{%s}\". This + may also be a property list with column numbers and + formats. :fmt will still be applied after :efmt. + +In addition to this, the parameters :skip and :skipcols are always handled +directly by `orgtbl-send-table'. See manual." + (let* ((splicep (plist-get params :splice)) + (hline (plist-get params :hline)) + (skipheadrule (plist-get params :skipheadrule)) + (remove-nil-linesp (plist-get params :remove-nil-lines)) + (remove-newlines (plist-get params :remove-newlines)) + (*orgtbl-hline* hline) + (*orgtbl-table* table) + (*orgtbl-sep* (plist-get params :sep)) + (*orgtbl-efmt* (plist-get params :efmt)) + (*orgtbl-lstart* (plist-get params :lstart)) + (*orgtbl-llstart* (or (plist-get params :llstart) *orgtbl-lstart*)) + (*orgtbl-lend* (plist-get params :lend)) + (*orgtbl-llend* (or (plist-get params :llend) *orgtbl-lend*)) + (*orgtbl-lfmt* (plist-get params :lfmt)) + (*orgtbl-llfmt* (or (plist-get params :llfmt) *orgtbl-lfmt*)) + (*orgtbl-fmt* (plist-get params :fmt)) + *orgtbl-rtn*) + ;; Convert cells content to backend BACKEND + (when backend + (setq *orgtbl-table* + (mapcar + (lambda(r) + (if (listp r) + (mapcar + (lambda (c) + (org-trim (org-export-string-as c backend t '(:with-tables t)))) + r) + r)) + *orgtbl-table*))) + ;; Put header + (unless splicep + (when (plist-member params :tstart) + (let ((tstart (orgtbl-eval-str (plist-get params :tstart)))) + (if tstart (push tstart *orgtbl-rtn*))))) + ;; If we have a heading, format it and handle the trailing hline. + (if (and (not splicep) + (or (consp (car *orgtbl-table*)) + (consp (nth 1 *orgtbl-table*))) + (memq 'hline (cdr *orgtbl-table*))) + (progn + (when (eq 'hline (car *orgtbl-table*)) + ;; There is a hline before the first data line + (and hline (push hline *orgtbl-rtn*)) + (pop *orgtbl-table*)) + (let* ((*orgtbl-lstart* (or (plist-get params :hlstart) + *orgtbl-lstart*)) + (*orgtbl-llstart* (or (plist-get params :hllstart) + *orgtbl-llstart*)) + (*orgtbl-lend* (or (plist-get params :hlend) *orgtbl-lend*)) + (*orgtbl-llend* (or (plist-get params :hllend) + (plist-get params :hlend) *orgtbl-llend*)) + (*orgtbl-lfmt* (or (plist-get params :hlfmt) *orgtbl-lfmt*)) + (*orgtbl-llfmt* (or (plist-get params :hllfmt) + (plist-get params :hlfmt) *orgtbl-llfmt*)) + (*orgtbl-sep* (or (plist-get params :hlsep) *orgtbl-sep*)) + (*orgtbl-fmt* (or (plist-get params :hfmt) *orgtbl-fmt*))) + (orgtbl-format-section 'hline)) + (if (and hline (not skipheadrule)) (push hline *orgtbl-rtn*)) + (pop *orgtbl-table*))) + ;; Now format the main section. + (orgtbl-format-section nil) + (unless splicep + (when (plist-member params :tend) + (let ((tend (orgtbl-eval-str (plist-get params :tend)))) + (if tend (push tend *orgtbl-rtn*))))) + (mapconcat (if remove-newlines + (lambda (tend) + (replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend)) + 'identity) + (nreverse (if remove-nil-linesp + (remq nil *orgtbl-rtn*) + *orgtbl-rtn*)) "\n"))) + +;;;###autoload +(defun orgtbl-to-tsv (table params) + "Convert the orgtbl-mode table to TAB separated material." + (orgtbl-to-generic table (org-combine-plists '(:sep "\t") params))) +;;;###autoload +(defun orgtbl-to-csv (table params) + "Convert the orgtbl-mode table to CSV material. +This does take care of the proper quoting of fields with comma or quotes." + (orgtbl-to-generic table (org-combine-plists + '(:sep "," :fmt org-quote-csv-field) + params))) + +;;;###autoload +(defun orgtbl-to-latex (table params) + "Convert the orgtbl-mode TABLE to LaTeX. +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. +Supports all parameters from `orgtbl-to-generic'. Most important for +LaTeX are: + +:splice When set to t, return only table body lines, don't wrap + them into a tabular environment. Default is nil. + +:fmt A format to be used to wrap the field, should contain %s for the + original field value. For example, to wrap everything in dollars, + use :fmt \"$%s$\". This may also be a property list with column + numbers and formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\") + The format may also be a function that formats its one argument. + +:efmt Format for transforming numbers with exponentials. The format + should have %s twice for inserting mantissa and exponent, for + example \"%s\\\\times10^{%s}\". LaTeX default is \"%s\\\\,(%s)\". + This may also be a property list with column numbers and formats. + The format may also be a function that formats its two arguments. + +:llend If you find too much space below the last line of a table, + pass a value of \"\" for :llend to suppress the final \\\\. + +The general parameters :skip and :skipcols have already been applied when +this function is called." + (let* ((alignment (mapconcat (lambda (x) (if x "r" "l")) + org-table-last-alignment "")) + (params2 + (list + :tstart (concat "\\begin{tabular}{" alignment "}") + :tend "\\end{tabular}" + :lstart "" :lend " \\\\" :sep " & " + :efmt "%s\\,(%s)" :hline "\\hline"))) + (require 'ox-latex) + (orgtbl-to-generic table (org-combine-plists params2 params) 'latex))) + +;;;###autoload +(defun orgtbl-to-html (table params) + "Convert the orgtbl-mode TABLE to HTML. +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. +Currently this function recognizes the following parameters: + +:splice When set to t, return only table body lines, don't wrap + them into a <table> environment. Default is nil. + +The general parameters :skip and :skipcols have already been applied when +this function is called. The function does *not* use `orgtbl-to-generic', +so you cannot specify parameters for it." + (require 'ox-html) + (let ((output (org-export-string-as + (orgtbl-to-orgtbl table nil) 'html t '(:with-tables t)))) + (if (not (plist-get params :splice)) output + (org-trim + (replace-regexp-in-string + "\\`<table .*>\n" "" + (replace-regexp-in-string "</table>\n*\\'" "" output)))))) + +;;;###autoload +(defun orgtbl-to-texinfo (table params) + "Convert the orgtbl-mode TABLE to TeXInfo. +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. +Supports all parameters from `orgtbl-to-generic'. Most important for +TeXInfo are: + +:splice nil/t When set to t, return only table body lines, don't wrap + them into a multitable environment. Default is nil. + +:fmt fmt A format to be used to wrap the field, should contain + %s for the original field value. For example, to wrap + everything in @kbd{}, you could use :fmt \"@kbd{%s}\". + This may also be a property list with column numbers and + formats. For example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). + Each format also may be a function that formats its one + argument. + +:cf \"f1 f2..\" The column fractions for the table. By default these + are computed automatically from the width of the columns + under org-mode. + +The general parameters :skip and :skipcols have already been applied when +this function is called." + (let* ((total (float (apply '+ org-table-last-column-widths))) + (colfrac (or (plist-get params :cf) + (mapconcat + (lambda (x) (format "%.3f" (/ (float x) total))) + org-table-last-column-widths " "))) + (params2 + (list + :tstart (concat "@multitable @columnfractions " colfrac) + :tend "@end multitable" + :lstart "@item " :lend "" :sep " @tab " + :hlstart "@headitem "))) + (require 'ox-texinfo) + (orgtbl-to-generic table (org-combine-plists params2 params) 'texinfo))) + +;;;###autoload +(defun orgtbl-to-orgtbl (table params) + "Convert the orgtbl-mode TABLE into another orgtbl-mode table. +Useful when slicing one table into many. The :hline, :sep, +:lstart, and :lend provide orgtbl framing. The default nil :tstart +and :tend suppress strings without splicing; they can be set to +provide ORGTBL directives for the generated table." + (let* ((params2 + (list + :remove-newlines t + :tstart nil :tend nil + :hline "|---" + :sep " | " + :lstart "| " + :lend " |")) + (params (org-combine-plists params2 params))) + (with-temp-buffer + (insert (orgtbl-to-generic table params)) + (goto-char (point-min)) + (while (re-search-forward org-table-hline-regexp nil t) + (org-table-align)) + (buffer-substring 1 (buffer-size))))) + +(defun orgtbl-to-table.el (table params) + "Convert the orgtbl-mode TABLE into a table.el table." + (with-temp-buffer + (insert (orgtbl-to-orgtbl table params)) + (org-table-align) + (replace-regexp-in-string + "-|" "-+" + (replace-regexp-in-string "|-" "+-" (buffer-substring 1 (buffer-size)))))) + +(defun orgtbl-to-unicode (table params) + "Convert the orgtbl-mode TABLE into a table with unicode characters. +You need the ascii-art-to-unicode.el package for this. You can download +it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el." + (with-temp-buffer + (insert (orgtbl-to-table.el table params)) + (goto-char (point-min)) + (if (or (featurep 'ascii-art-to-unicode) + (require 'ascii-art-to-unicode nil t)) + (aa2u) + (unless (delq nil (mapcar (lambda (l) (string-match "aa2u" (car l))) org-stored-links)) + (push '("http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el" + "Link to ascii-art-to-unicode.el") org-stored-links)) + (user-error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)")) + (buffer-string))) + +(defun org-table-get-remote-range (name-or-id form) + "Get a field value or a list of values in a range from table at ID. + +NAME-OR-ID may be the name of a table in the current file as set +by a \"#+NAME:\" directive. The first table following this line +will then be used. Alternatively, it may be an ID referring to +any entry, also in a different file. In this case, the first +table in that entry will be referenced. +FORM is a field or range descriptor like \"@2$3\" or \"B3\" or +\"@I$2..@II$2\". All the references must be absolute, not relative. + +The return value is either a single string for a single field, or a +list of the fields in the rectangle." + (save-match-data + (let ((case-fold-search t) (id-loc nil) + ;; Protect a bunch of variables from being overwritten + ;; by the context of the remote table + org-table-column-names org-table-column-name-regexp + org-table-local-parameters org-table-named-field-locations + org-table-current-line-types org-table-current-begin-line + org-table-current-begin-pos org-table-dlines + org-table-current-ncol + org-table-hlines org-table-last-alignment + org-table-last-column-widths org-table-last-alignment + org-table-last-column-widths tbeg + buffer loc) + (setq form (org-table-convert-refs-to-rc form)) + (save-excursion + (save-restriction + (widen) + (save-excursion + (goto-char (point-min)) + (if (re-search-forward + (concat "^[ \t]*#\\+\\(tbl\\)?name:[ \t]*" + (regexp-quote name-or-id) "[ \t]*$") + nil t) + (setq buffer (current-buffer) loc (match-beginning 0)) + (setq id-loc (org-id-find name-or-id 'marker)) + (unless (and id-loc (markerp id-loc)) + (user-error "Can't find remote table \"%s\"" name-or-id)) + (setq buffer (marker-buffer id-loc) + loc (marker-position id-loc)) + (move-marker id-loc nil))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char loc) + (forward-char 1) + (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t) + (not (match-beginning 1))) + (user-error "Cannot find a table at NAME or ID %s" name-or-id)) + (setq tbeg (point-at-bol)) + (org-table-get-specials) + (setq form (org-table-formula-substitute-names + (org-table-formula-handle-first/last-rc form))) + (if (and (string-match org-table-range-regexp form) + (> (length (match-string 0 form)) 1)) + (save-match-data + (org-table-get-range (match-string 0 form) tbeg 1)) + form))))))))) + +(defmacro org-define-lookup-function (mode) + (let ((mode-str (symbol-name mode)) + (first-p (equal mode 'first)) + (all-p (equal mode 'all))) + (let ((plural-str (if all-p "s" ""))) + `(defun ,(intern (format "org-lookup-%s" mode-str)) (val s-list r-list &optional predicate) + ,(format "Find %s occurrence%s of VAL in S-LIST; return corresponding element%s of R-LIST. +If R-LIST is nil, return matching element%s of S-LIST. +If PREDICATE is not nil, use it instead of `equal' to match VAL. +Matching is done by (PREDICATE VAL S), where S is an element of S-LIST. +This function is generated by a call to the macro `org-define-lookup-function'." + mode-str plural-str plural-str plural-str) + (let ,(let ((lvars '((p (or predicate 'equal)) + (sl s-list) + (rl (or r-list s-list)) + (ret nil)))) + (if first-p (add-to-list 'lvars '(match-p nil))) + lvars) + (while ,(if first-p '(and (not match-p) sl) 'sl) + (progn + (if (funcall p val (car sl)) + (progn + ,(if first-p '(setq match-p t)) + (let ((rval (car rl))) + (setq ret ,(if all-p '(append ret (list rval)) 'rval))))) + (setq sl (cdr sl) rl (cdr rl)))) + ret))))) + +(org-define-lookup-function first) +(org-define-lookup-function last) +(org-define-lookup-function all) + +(provide 'org-table) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-table.el ends here diff --git a/elpa/org-20150427/org-timer.el b/elpa/org-20150427/org-timer.el new file mode 100644 index 00000000..8161699f --- /dev/null +++ b/elpa/org-20150427/org-timer.el @@ -0,0 +1,455 @@ +;;; org-timer.el --- The relative timer code for Org-mode + +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: + +;; This file contains the relative timer code for Org-mode + +;;; Code: + +(require 'org) + +(declare-function org-notify "org-clock" (notification &optional play-sound)) +(declare-function org-agenda-error "org-agenda" ()) + +(defvar org-timer-start-time nil + "t=0 for the running timer.") + +(defvar org-timer-pause-time nil + "Time when the timer was paused.") + +(defconst org-timer-re "\\([-+]?[0-9]+\\):\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)" + "Regular expression used to match timer stamps.") + +(defcustom org-timer-format "%s " + "The format to insert the time of the timer. +This format must contain one instance of \"%s\" which will be replaced by +the value of the relative timer." + :group 'org-time + :type 'string) + +(defcustom org-timer-default-timer 0 + "The default timer when a timer is set. +When 0, the user is prompted for a value." + :group 'org-time + :version "24.1" + :type 'number) + +(defcustom org-timer-display 'mode-line + "When a timer is running, org-mode can display it in the mode +line and/or frame title. +Allowed values are: + +both displays in both mode line and frame title +mode-line displays only in mode line (default) +frame-title displays only in frame title +nil current timer is not displayed" + :group 'org-time + :type '(choice + (const :tag "Mode line" mode-line) + (const :tag "Frame title" frame-title) + (const :tag "Both" both) + (const :tag "None" nil))) + +(defvar org-timer-start-hook nil + "Hook run after relative timer is started.") + +(defvar org-timer-stop-hook nil + "Hook run before relative timer is stopped.") + +(defvar org-timer-pause-hook nil + "Hook run before relative timer is paused.") + +(defvar org-timer-continue-hook nil + "Hook run after relative timer is continued.") + +(defvar org-timer-set-hook nil + "Hook run after countdown timer is set.") + +(defvar org-timer-done-hook nil + "Hook run after countdown timer reaches zero.") + +(defvar org-timer-cancel-hook nil + "Hook run before countdown timer is canceled.") + +;;;###autoload +(defun org-timer-start (&optional offset) + "Set the starting time for the relative timer to now. +When called with prefix argument OFFSET, prompt the user for an offset time, +with the default taken from a timer stamp at point, if any. +If OFFSET is a string or an integer, it is directly taken to be the offset +without user interaction. +When called with a double prefix arg, all timer strings in the active +region will be shifted by a specific amount. You will be prompted for +the amount, with the default to make the first timer string in +the region 0:00:00." + (interactive "P") + (if (equal offset '(16)) + (call-interactively 'org-timer-change-times-in-region) + (let (delta def s) + (if (not offset) + (setq org-timer-start-time (current-time)) + (cond + ((integerp offset) (setq delta offset)) + ((stringp offset) (setq delta (org-timer-hms-to-secs offset))) + (t + (setq def (if (org-in-regexp org-timer-re) + (match-string 0) + "0:00:00") + s (read-string + (format "Restart timer with offset [%s]: " def))) + (unless (string-match "\\S-" s) (setq s def)) + (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s))))) + (setq org-timer-start-time + (seconds-to-time + (- (org-float-time) delta)))) + (org-timer-set-mode-line 'on) + (message "Timer start time set to %s, current value is %s" + (format-time-string "%T" org-timer-start-time) + (org-timer-secs-to-hms (or delta 0))) + (run-hooks 'org-timer-start-hook)))) + +(defun org-timer-pause-or-continue (&optional stop) + "Pause or continue the relative timer. +With prefix arg STOP, stop it entirely." + (interactive "P") + (cond + (stop (org-timer-stop)) + ((not org-timer-start-time) (error "No timer is running")) + (org-timer-pause-time + ;; timer is paused, continue + (setq org-timer-start-time + (seconds-to-time + (- + (org-float-time) + (- (org-float-time org-timer-pause-time) + (org-float-time org-timer-start-time)))) + org-timer-pause-time nil) + (org-timer-set-mode-line 'on) + (run-hooks 'org-timer-continue-hook) + (message "Timer continues at %s" (org-timer-value-string))) + (t + ;; pause timer + (run-hooks 'org-timer-pause-hook) + (setq org-timer-pause-time (current-time)) + (org-timer-set-mode-line 'pause) + (message "Timer paused at %s" (org-timer-value-string))))) + +(defvar org-timer-current-timer nil) +(defun org-timer-stop () + "Stop the relative timer." + (interactive) + (run-hooks 'org-timer-stop-hook) + (setq org-timer-start-time nil + org-timer-pause-time nil + org-timer-current-timer nil) + (org-timer-set-mode-line 'off) + (message "Timer stopped")) + +;;;###autoload +(defun org-timer (&optional restart no-insert-p) + "Insert a H:MM:SS string from the timer into the buffer. +The first time this command is used, the timer is started. When used with +a \\[universal-argument] prefix, force restarting the timer. +When used with a double prefix argument \\[universal-argument], change all the timer string +in the region by a fixed amount. This can be used to recalibrate a timer +that was not started at the correct moment. + +If NO-INSERT-P is non-nil, return the string instead of inserting +it in the buffer." + (interactive "P") + (when (or (equal restart '(4)) (not org-timer-start-time)) + (org-timer-start)) + (if no-insert-p + (org-timer-value-string) + (insert (org-timer-value-string)))) + +(defun org-timer-value-string () + "Set the timer string." + (format org-timer-format + (org-timer-secs-to-hms + (abs (floor (org-timer-seconds)))))) + +(defvar org-timer-timer-is-countdown nil) +(defun org-timer-seconds () + (if org-timer-timer-is-countdown + (- (org-float-time org-timer-start-time) + (org-float-time (current-time))) + (- (org-float-time (or org-timer-pause-time (current-time))) + (org-float-time org-timer-start-time)))) + +;;;###autoload +(defun org-timer-change-times-in-region (beg end delta) + "Change all h:mm:ss time in region by a DELTA." + (interactive + "r\nsEnter time difference like \"-1:08:26\". Default is first time to zero: ") + (let ((re "[-+]?[0-9]+:[0-9]\\{2\\}:[0-9]\\{2\\}") p) + (unless (string-match "\\S-" delta) + (save-excursion + (goto-char beg) + (when (re-search-forward re end t) + (setq delta (match-string 0)) + (if (equal (string-to-char delta) ?-) + (setq delta (substring delta 1)) + (setq delta (concat "-" delta)))))) + (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete delta))) + (when (= delta 0) (error "No change")) + (save-excursion + (goto-char end) + (while (re-search-backward re beg t) + (setq p (point)) + (replace-match + (save-match-data + (org-timer-secs-to-hms (+ (org-timer-hms-to-secs (match-string 0)) delta))) + t t) + (goto-char p))))) + +;;;###autoload +(defun org-timer-item (&optional arg) + "Insert a description-type item with the current timer value." + (interactive "P") + (let ((itemp (org-in-item-p)) (pos (point))) + (cond + ;; In a timer list, insert with `org-list-insert-item', + ;; then fix the list. + ((and itemp (goto-char itemp) (org-at-item-timer-p)) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (s (concat (org-timer (when arg '(4)) t) ":: "))) + (setq struct (org-list-insert-item pos struct prevs nil s)) + (org-list-write-struct struct (org-list-parents-alist struct)) + (looking-at org-list-full-item-re) + (goto-char (match-end 0)))) + ;; In a list of another type, don't break anything: throw an error. + (itemp (goto-char pos) (error "This is not a timer list")) + ;; Else, start a new list. + (t + (beginning-of-line) + (org-indent-line) + (insert "- ") + (org-timer (when arg '(4))) + (insert ":: "))))) + +(defun org-timer-fix-incomplete (hms) + "If hms is a H:MM:SS string with missing hour or hour and minute, fix it." + (if (string-match "\\(?:\\([0-9]+:\\)?\\([0-9]+:\\)\\)?\\([0-9]+\\)" hms) + (replace-match + (format "%d:%02d:%02d" + (if (match-end 1) (string-to-number (match-string 1 hms)) 0) + (if (match-end 2) (string-to-number (match-string 2 hms)) 0) + (string-to-number (match-string 3 hms))) + t t hms) + (error "Cannot parse HMS string \"%s\"" hms))) + +(defun org-timer-hms-to-secs (hms) + "Convert h:mm:ss string to an integer time. +If the string starts with a minus sign, the integer will be negative." + (if (not (string-match + "\\([-+]?[0-9]+\\):\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)" + hms)) + 0 + (let* ((h (string-to-number (match-string 1 hms))) + (m (string-to-number (match-string 2 hms))) + (s (string-to-number (match-string 3 hms))) + (sign (equal (substring (match-string 1 hms) 0 1) "-"))) + (setq h (abs h)) + (* (if sign -1 1) (+ s (* 60 (+ m (* 60 h)))))))) + +(defun org-timer-secs-to-hms (s) + "Convert integer S into h:mm:ss. +If the integer is negative, the string will start with \"-\"." + (let (sign m h) + (setq sign (if (< s 0) "-" "") + s (abs s) + m (/ s 60) s (- s (* 60 m)) + h (/ m 60) m (- m (* 60 h))) + (format "%s%d:%02d:%02d" sign h m s))) + +(defvar org-timer-mode-line-timer nil) +(defvar org-timer-mode-line-string nil) + +(defun org-timer-set-mode-line (value) + "Set the mode-line display of the relative timer. +VALUE can be `on', `off', or `pause'." + (when (or (eq org-timer-display 'mode-line) + (eq org-timer-display 'both)) + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'org-timer-mode-line-string global-mode-string) + (setq global-mode-string + (append global-mode-string '(org-timer-mode-line-string))))) + (when (or (eq org-timer-display 'frame-title) + (eq org-timer-display 'both)) + (or (memq 'org-timer-mode-line-string frame-title-format) + (setq frame-title-format + (append frame-title-format '(org-timer-mode-line-string))))) + (cond + ((equal value 'off) + (when org-timer-mode-line-timer + (cancel-timer org-timer-mode-line-timer) + (setq org-timer-mode-line-timer nil)) + (when (or (eq org-timer-display 'mode-line) + (eq org-timer-display 'both)) + (setq global-mode-string + (delq 'org-timer-mode-line-string global-mode-string))) + (when (or (eq org-timer-display 'frame-title) + (eq org-timer-display 'both)) + (setq frame-title-format + (delq 'org-timer-mode-line-string frame-title-format))) + (force-mode-line-update)) + ((equal value 'pause) + (when org-timer-mode-line-timer + (cancel-timer org-timer-mode-line-timer) + (setq org-timer-mode-line-timer nil))) + ((equal value 'on) + (when (or (eq org-timer-display 'mode-line) + (eq org-timer-display 'both)) + (or global-mode-string (setq global-mode-string '(""))) + (or (memq 'org-timer-mode-line-string global-mode-string) + (setq global-mode-string + (append global-mode-string '(org-timer-mode-line-string))))) + (when (or (eq org-timer-display 'frame-title) + (eq org-timer-display 'both)) + (or (memq 'org-timer-mode-line-string frame-title-format) + (setq frame-title-format + (append frame-title-format '(org-timer-mode-line-string))))) + (org-timer-update-mode-line) + (when org-timer-mode-line-timer + (cancel-timer org-timer-mode-line-timer) + (setq org-timer-mode-line-timer nil)) + (when org-timer-display + (setq org-timer-mode-line-timer + (run-with-timer 1 1 'org-timer-update-mode-line)))))) + +(defun org-timer-update-mode-line () + "Update the timer time in the mode line." + (if org-timer-pause-time + nil + (setq org-timer-mode-line-string + (concat " <" (substring (org-timer-value-string) 0 -1) ">")) + (force-mode-line-update))) + +(defun org-timer-cancel-timer () + "Cancel the current timer." + (interactive) + (when (eval org-timer-current-timer) + (run-hooks 'org-timer-cancel-hook) + (cancel-timer org-timer-current-timer) + (setq org-timer-current-timer nil) + (setq org-timer-timer-is-countdown nil) + (org-timer-set-mode-line 'off)) + (message "Last timer canceled")) + +(defun org-timer-show-remaining-time () + "Display the remaining time before the timer ends." + (interactive) + (require 'time) + (if (not org-timer-current-timer) + (message "No timer set") + (let* ((rtime (decode-time + (time-subtract (timer--time org-timer-current-timer) + (current-time)))) + (rsecs (nth 0 rtime)) + (rmins (nth 1 rtime))) + (message "%d minute(s) %d seconds left before next time out" + rmins rsecs)))) + +(defvar org-clock-sound) + +;;;###autoload +(defun org-timer-set-timer (&optional opt) + "Prompt for a duration and set a timer. + +If `org-timer-default-timer' is not zero, suggest this value as +the default duration for the timer. If a timer is already set, +prompt the user if she wants to replace it. + +Called with a numeric prefix argument, use this numeric value as +the duration of the timer. + +Called with a `C-u' prefix arguments, use `org-timer-default-timer' +without prompting the user for a duration. + +With two `C-u' prefix arguments, use `org-timer-default-timer' +without prompting the user for a duration and automatically +replace any running timer." + (interactive "P") + (let ((minutes (or (and (numberp opt) (number-to-string opt)) + (and (listp opt) (not (null opt)) + (number-to-string org-timer-default-timer)) + (read-from-minibuffer + "How many minutes left? " + (if (not (eq org-timer-default-timer 0)) + (number-to-string org-timer-default-timer)))))) + (if (not (string-match "[0-9]+" minutes)) + (org-timer-show-remaining-time) + (let* ((mins (string-to-number (match-string 0 minutes))) + (secs (* mins 60)) + (hl (cond + ((string-match "Org Agenda" (buffer-name)) + (let* ((marker (or (get-text-property (point) 'org-marker) + (org-agenda-error))) + (hdmarker (or (get-text-property (point) 'org-hd-marker) + marker)) + (pos (marker-position marker))) + (with-current-buffer (marker-buffer marker) + (widen) + (goto-char pos) + (org-show-entry) + (or (ignore-errors (org-get-heading)) + (concat "File:" (file-name-nondirectory (buffer-file-name))))))) + ((derived-mode-p 'org-mode) + (or (ignore-errors (org-get-heading)) + (concat "File:" (file-name-nondirectory (buffer-file-name))))) + (t (error "Not in an Org buffer")))) + timer-set) + (if (or (and org-timer-current-timer + (or (equal opt '(16)) + (y-or-n-p "Replace current timer? "))) + (not org-timer-current-timer)) + (progn + (require 'org-clock) + (when org-timer-current-timer + (cancel-timer org-timer-current-timer)) + (setq org-timer-current-timer + (run-with-timer + secs nil `(lambda () + (setq org-timer-current-timer nil) + (org-notify ,(format "%s: time out" hl) ,org-clock-sound) + (setq org-timer-timer-is-countdown nil) + (org-timer-set-mode-line 'off) + (run-hooks 'org-timer-done-hook)))) + (run-hooks 'org-timer-set-hook) + (setq org-timer-timer-is-countdown t + org-timer-start-time + (time-add (current-time) (seconds-to-time (* mins 60)))) + (org-timer-set-mode-line 'on)) + (message "No timer set")))))) + +(provide 'org-timer) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-timer.el ends here diff --git a/elpa/org-20150427/org-version.el b/elpa/org-20150427/org-version.el new file mode 100644 index 00000000..b2cb29f0 --- /dev/null +++ b/elpa/org-20150427/org-version.el @@ -0,0 +1,27 @@ +;;; org-version.el --- autogenerated file, do not edit +;; +;;; Code: +;;;###autoload +(defun org-release () + "The release version of org-mode. + Inserted by installing org-mode or when a release is made." + (let ((org-release "8.2.10")) + org-release)) +;;;###autoload +(defun org-git-version () + "The Git version of org-mode. + Inserted by installing org-mode or when a release is made." + (let ((org-git-version "8.2.10-37-gc000e8-elpa")) + org-git-version)) +;;;###autoload +(defvar org-odt-data-dir "/usr/share/emacs/etc/org" + "The location of ODT styles.") + +(provide 'org-version) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; coding: utf-8 +;; End: +;;; org-version.el ends here diff --git a/elpa/org-20150427/org-w3m.el b/elpa/org-20150427/org-w3m.el new file mode 100644 index 00000000..c8ddc82d --- /dev/null +++ b/elpa/org-20150427/org-w3m.el @@ -0,0 +1,183 @@ +;;; org-w3m.el --- Support from copy and paste from w3m to Org-mode + +;; Copyright (C) 2008-2014 Free Software Foundation, Inc. + +;; Author: Andy Stewart <lazycat dot manatee at gmail dot com> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; This file is 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 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Commentary: + +;; This file implements copying HTML content from a w3m buffer and +;; transforming the text on the fly so that it can be pasted into +;; an org-mode buffer with hot links. It will also work for regions +;; in gnus buffers that have been washed with w3m. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Acknowledgments: + +;; Richard Riley <rileyrgdev at googlemail dot com> +;; +;; The idea of transforming the HTML content with org-mode style is +;; proposed by Richard, I'm just coding it. +;; + +;;; Code: + +(require 'org) + +(defvar w3m-current-url) +(defvar w3m-current-title) + +(add-hook 'org-store-link-functions 'org-w3m-store-link) +(defun org-w3m-store-link () + "Store a link to a w3m buffer." + (when (eq major-mode 'w3m-mode) + (org-store-link-props + :type "w3m" + :link w3m-current-url + :url (url-view-url t) + :description (or w3m-current-title w3m-current-url)))) + +(defun org-w3m-copy-for-org-mode () + "Copy current buffer content or active region with `org-mode' style links. +This will encode `link-title' and `link-location' with +`org-make-link-string', and insert the transformed test into the kill ring, +so that it can be yanked into an Org-mode buffer with links working correctly." + (interactive) + (let* ((regionp (org-region-active-p)) + (transform-start (point-min)) + (transform-end (point-max)) + return-content + link-location link-title + temp-position out-bound) + (when regionp + (setq transform-start (region-beginning)) + (setq transform-end (region-end)) + ;; Deactivate mark if current mark is activate. + (if (fboundp 'deactivate-mark) (deactivate-mark))) + (message "Transforming links...") + (save-excursion + (goto-char transform-start) + (while (and (not out-bound) ; still inside region to copy + (not (org-w3m-no-next-link-p))) ; no next link current buffer + ;; store current point before jump next anchor + (setq temp-position (point)) + ;; move to next anchor when current point is not at anchor + (or (get-text-property (point) 'w3m-href-anchor) (org-w3m-get-next-link-start)) + (if (<= (point) transform-end) ; if point is inside transform bound + (progn + ;; get content between two links. + (if (> (point) temp-position) + (setq return-content (concat return-content + (buffer-substring + temp-position (point))))) + ;; get link location at current point. + (setq link-location (get-text-property (point) 'w3m-href-anchor)) + ;; get link title at current point. + (setq link-title (buffer-substring (point) + (org-w3m-get-anchor-end))) + ;; concat `org-mode' style url to `return-content'. + (setq return-content (concat return-content + (org-make-link-string + link-location link-title)))) + (goto-char temp-position) ; reset point before jump next anchor + (setq out-bound t) ; for break out `while' loop + )) + ;; add the rest until end of the region to be copied + (if (< (point) transform-end) + (setq return-content + (concat return-content + (buffer-substring (point) transform-end)))) + (org-kill-new return-content) + (message "Transforming links...done, use C-y to insert text into Org-mode file") + (message "Copy with link transformation complete.")))) + +(defun org-w3m-get-anchor-start () + "Move cursor to the start of current anchor. Return point." + ;; get start position of anchor or current point + (goto-char (or (previous-single-property-change (point) 'w3m-anchor-sequence) + (point)))) + +(defun org-w3m-get-anchor-end () + "Move cursor to the end of current anchor. Return point." + ;; get end position of anchor or point + (goto-char (or (next-single-property-change (point) 'w3m-anchor-sequence) + (point)))) + +(defun org-w3m-get-next-link-start () + "Move cursor to the start of next link. Return point." + (catch 'reach + (while (next-single-property-change (point) 'w3m-anchor-sequence) + ;; jump to next anchor + (goto-char (next-single-property-change (point) 'w3m-anchor-sequence)) + (when (get-text-property (point) 'w3m-href-anchor) + ;; return point when current is valid link + (throw 'reach nil)))) + (point)) + +(defun org-w3m-get-prev-link-start () + "Move cursor to the start of previous link. Return point." + (catch 'reach + (while (previous-single-property-change (point) 'w3m-anchor-sequence) + ;; jump to previous anchor + (goto-char (previous-single-property-change (point) 'w3m-anchor-sequence)) + (when (get-text-property (point) 'w3m-href-anchor) + ;; return point when current is valid link + (throw 'reach nil)))) + (point)) + +(defun org-w3m-no-next-link-p () + "Whether there is no next link after the cursor. +Return t if there is no next link; otherwise, return nil." + (save-excursion + (equal (point) (org-w3m-get-next-link-start)))) + +(defun org-w3m-no-prev-link-p () + "Whether there is no previous link after the cursor. +Return t if there is no previous link; otherwise, return nil." + (save-excursion + (equal (point) (org-w3m-get-prev-link-start)))) + +;; Install keys into the w3m keymap +(defvar w3m-mode-map) +(defvar w3m-minor-mode-map) +(when (and (boundp 'w3m-mode-map) + (keymapp w3m-mode-map)) + (define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode) + (define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)) +(when (and (boundp 'w3m-minor-mode-map) + (keymapp w3m-minor-mode-map)) + (define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode) + (define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)) +(add-hook + 'w3m-mode-hook + (lambda () + (define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode) + (define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))) +(add-hook + 'w3m-minor-mode-hook + (lambda () + (define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode) + (define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))) + +(provide 'org-w3m) + +;;; org-w3m.el ends here diff --git a/elpa/org-20150427/org.el b/elpa/org-20150427/org.el new file mode 100644 index 00000000..4636830d --- /dev/null +++ b/elpa/org-20150427/org.el @@ -0,0 +1,24016 @@ +;;; org.el --- Outline-based notes management and organizer + +;; Carstens outline-mode for keeping track of everything. +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Maintainer: Carsten Dominik <carsten at orgmode dot org> +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; +;; 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: +;; +;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing +;; project planning with a fast and effective plain-text system. +;; +;; Org-mode develops organizational tasks around NOTES files that contain +;; information about projects as plain text. Org-mode is implemented on +;; top of outline-mode, which makes it possible to keep the content of +;; large files well structured. Visibility cycling and structure editing +;; help to work with the tree. Tables are easily created with a built-in +;; table editor. Org-mode supports ToDo items, deadlines, time stamps, +;; and scheduling. It dynamically compiles entries into an agenda that +;; utilizes and smoothly integrates much of the Emacs calendar and diary. +;; Plain text URL-like links connect to websites, emails, Usenet +;; messages, BBDB entries, and any files related to the projects. For +;; printing and sharing of notes, an Org-mode file can be exported as a +;; structured ASCII file, as HTML, or (todo and agenda items only) as an +;; iCalendar file. It can also serve as a publishing tool for a set of +;; linked webpages. +;; +;; Installation and Activation +;; --------------------------- +;; See the corresponding sections in the manual at +;; +;; http://orgmode.org/org.html#Installation +;; +;; Documentation +;; ------------- +;; The documentation of Org-mode can be found in the TeXInfo file. The +;; distribution also contains a PDF version of it. At the homepage of +;; Org-mode, you can read the same text online as HTML. There is also an +;; excellent reference card made by Philip Rooke. This card can be found +;; in the etc/ directory of Emacs 22. +;; +;; A list of recent changes can be found at +;; http://orgmode.org/Changes.html +;; +;;; Code: + +(defvar org-inhibit-highlight-removal nil) ; dynamically scoped param +(defvar org-table-formula-constants-local nil + "Local version of `org-table-formula-constants'.") +(make-variable-buffer-local 'org-table-formula-constants-local) + +;;;; Require other packages + +(eval-when-compile + (require 'cl) + (require 'gnus-sum)) + +(require 'calendar) +(require 'find-func) +(require 'format-spec) + +(load "org-loaddefs.el" t t t) + +(require 'org-macs) +(require 'org-compat) + +;; `org-outline-regexp' ought to be a defconst but is let-bound in +;; some places -- e.g. see the macro `org-with-limited-levels'. +;; +;; In Org buffers, the value of `outline-regexp' is that of +;; `org-outline-regexp'. The only function still directly relying on +;; `outline-regexp' is `org-overview' so that `org-cycle' can do its +;; job when `orgstruct-mode' is active. +(defvar org-outline-regexp "\\*+ " + "Regexp to match Org headlines.") + +(defvar org-outline-regexp-bol "^\\*+ " + "Regexp to match Org headlines. +This is similar to `org-outline-regexp' but additionally makes +sure that we are at the beginning of the line.") + +(defvar org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" + "Matches a headline, putting stars and text into groups. +Stars are put in group 1 and the trimmed body in group 2.") + +;; Emacs 22 calendar compatibility: Make sure the new variables are available +(unless (boundp 'calendar-view-holidays-initially-flag) + (org-defvaralias 'calendar-view-holidays-initially-flag + 'view-calendar-holidays-initially)) +(unless (boundp 'calendar-view-diary-initially-flag) + (org-defvaralias 'calendar-view-diary-initially-flag + 'view-diary-entries-initially)) +(unless (boundp 'diary-fancy-buffer) + (org-defvaralias 'diary-fancy-buffer 'fancy-diary-buffer)) + +(declare-function org-add-archive-files "org-archive" (files)) + +(declare-function org-inlinetask-at-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) +(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) +(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) +(declare-function org-clock-get-last-clock-out-time "org-clock" ()) +(declare-function org-clock-timestamps-up "org-clock" (&optional n)) +(declare-function org-clock-timestamps-down "org-clock" (&optional n)) +(declare-function org-clock-remove-overlays "org-clock" (&optional beg end noremove)) +(declare-function org-clock-sum-current-item "org-clock" (&optional tstart)) +(declare-function org-clock-update-time-maybe "org-clock" ()) +(declare-function org-clocktable-shift "org-clock" (dir n)) + +(declare-function orgtbl-mode "org-table" (&optional arg)) +(declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time)) +(declare-function org-beamer-mode "ox-beamer" ()) +(declare-function org-table-edit-field "org-table" (arg)) +(declare-function org-table-justify-field-maybe "org-table" (&optional new)) +(declare-function org-table-set-constants "org-table" ()) +(declare-function org-table-calc-current-TBLFM "org-table" (&optional arg)) +(declare-function org-id-get-create "org-id" (&optional force)) +(declare-function org-id-find-id-file "org-id" (id)) +(declare-function org-tags-view "org-agenda" (&optional todo-only match)) +(declare-function org-agenda-list "org-agenda" (&optional arg start-day span)) +(declare-function org-agenda-redo "org-agenda" (&optional all)) +(declare-function org-table-align "org-table" ()) +(declare-function org-table-begin "org-table" (&optional table-type)) +(declare-function org-table-blank-field "org-table" ()) +(declare-function org-table-end "org-table" (&optional table-type)) +(declare-function org-table-insert-row "org-table" (&optional arg)) +(declare-function org-table-paste-rectangle "org-table" ()) +(declare-function org-table-maybe-eval-formula "org-table" ()) +(declare-function org-table-maybe-recalculate-line "org-table" ()) + +(declare-function org-element--parse-objects "org-element" + (beg end acc restriction)) +(declare-function org-element-at-point "org-element" (&optional keep-trail)) +(declare-function org-element-contents "org-element" (element)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-interpret-data "org-element" + (data &optional parent)) +(declare-function org-element-map "org-element" + (data types fun &optional info first-match no-recursion)) +(declare-function org-element-nested-p "org-element" (elem-a elem-b)) +(declare-function org-element-parse-buffer "org-element" + (&optional granularity visible-only)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-put-property "org-element" + (element property value)) +(declare-function org-element-swap-A-B "org-element" (elem-a elem-b)) +(declare-function org-element--parse-objects "org-element" + (beg end acc restriction)) +(declare-function org-element-parse-buffer "org-element" + (&optional granularity visible-only)) +(declare-function org-element-restriction "org-element" (element)) +(declare-function org-element-type "org-element" (element)) + +;; load languages based on value of `org-babel-load-languages' +(defvar org-babel-load-languages) + +;;;###autoload +(defun org-babel-do-load-languages (sym value) + "Load the languages defined in `org-babel-load-languages'." + (set-default sym value) + (mapc (lambda (pair) + (let ((active (cdr pair)) (lang (symbol-name (car pair)))) + (if active + (progn + (require (intern (concat "ob-" lang)))) + (progn + (funcall 'fmakunbound + (intern (concat "org-babel-execute:" lang))) + (funcall 'fmakunbound + (intern (concat "org-babel-expand-body:" lang))))))) + org-babel-load-languages)) + +(declare-function org-babel-tangle-file "ob-tangle" (file &optional target-file lang)) +;;;###autoload +(defun org-babel-load-file (file &optional compile) + "Load Emacs Lisp source code blocks in the Org-mode FILE. +This function exports the source code using `org-babel-tangle' +and then loads the resulting file using `load-file'. With prefix +arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp +file to byte-code before it is loaded." + (interactive "fFile to load: \nP") + (require 'ob-core) + (let* ((age (lambda (file) + (float-time + (time-subtract (current-time) + (nth 5 (or (file-attributes (file-truename file)) + (file-attributes file))))))) + (base-name (file-name-sans-extension file)) + (exported-file (concat base-name ".el"))) + ;; tangle if the org-mode file is newer than the elisp file + (unless (and (file-exists-p exported-file) + (> (funcall age file) (funcall age exported-file))) + (setq exported-file + (car (org-babel-tangle-file file exported-file "emacs-lisp")))) + (message "%s %s" + (if compile + (progn (byte-compile-file exported-file 'load) + "Compiled and loaded") + (progn (load-file exported-file) "Loaded")) + exported-file))) + +(defcustom org-babel-load-languages '((emacs-lisp . t)) + "Languages which can be evaluated in Org-mode buffers. +This list can be used to load support for any of the languages +below, note that each language will depend on a different set of +system executables and/or Emacs modes. When a language is +\"loaded\", then code blocks in that language can be evaluated +with `org-babel-execute-src-block' bound by default to C-c +C-c (note the `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can +be set to remove code block evaluation from the C-c C-c +keybinding. By default only Emacs Lisp (which has no +requirements) is loaded." + :group 'org-babel + :set 'org-babel-do-load-languages + :version "24.1" + :type '(alist :tag "Babel Languages" + :key-type + (choice + (const :tag "Awk" awk) + (const :tag "C" C) + (const :tag "R" R) + (const :tag "Asymptote" asymptote) + (const :tag "Calc" calc) + (const :tag "Clojure" clojure) + (const :tag "CSS" css) + (const :tag "Ditaa" ditaa) + (const :tag "Dot" dot) + (const :tag "Emacs Lisp" emacs-lisp) + (const :tag "Fortran" fortran) + (const :tag "Gnuplot" gnuplot) + (const :tag "Haskell" haskell) + (const :tag "IO" io) + (const :tag "Java" java) + (const :tag "Javascript" js) + (const :tag "LaTeX" latex) + (const :tag "Ledger" ledger) + (const :tag "Lilypond" lilypond) + (const :tag "Lisp" lisp) + (const :tag "Makefile" makefile) + (const :tag "Maxima" maxima) + (const :tag "Matlab" matlab) + (const :tag "Mscgen" mscgen) + (const :tag "Ocaml" ocaml) + (const :tag "Octave" octave) + (const :tag "Org" org) + (const :tag "Perl" perl) + (const :tag "Pico Lisp" picolisp) + (const :tag "PlantUML" plantuml) + (const :tag "Python" python) + (const :tag "Ruby" ruby) + (const :tag "Sass" sass) + (const :tag "Scala" scala) + (const :tag "Scheme" scheme) + (const :tag "Screen" screen) + (const :tag "Shell Script" sh) + (const :tag "Shen" shen) + (const :tag "Sql" sql) + (const :tag "Sqlite" sqlite)) + :value-type (boolean :tag "Activate" :value t))) + +;;;; Customization variables +(defcustom org-clone-delete-id nil + "Remove ID property of clones of a subtree. +When non-nil, clones of a subtree don't inherit the ID property. +Otherwise they inherit the ID property with a new unique +identifier." + :type 'boolean + :version "24.1" + :group 'org-id) + +;;; Version +(org-check-version) + +;;;###autoload +(defun org-version (&optional here full message) + "Show the org-mode version in the echo area. +With prefix argument HERE, insert it at point. +When FULL is non-nil, use a verbose version string. +When MESSAGE is non-nil, display a message with the version." + (interactive "P") + (let* ((org-dir (ignore-errors (org-find-library-dir "org"))) + (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes)) + (load-suffixes (list ".el")) + (org-install-dir (ignore-errors (org-find-library-dir "org-loaddefs"))) + (org-trash (or + (and (fboundp 'org-release) (fboundp 'org-git-version)) + (org-load-noerror-mustsuffix (concat org-dir "org-version")))) + (load-suffixes save-load-suffixes) + (org-version (org-release)) + (git-version (org-git-version)) + (version (format "Org-mode version %s (%s @ %s)" + org-version + git-version + (if org-install-dir + (if (string= org-dir org-install-dir) + org-install-dir + (concat "mixed installation! " org-install-dir " and " org-dir)) + "org-loaddefs.el can not be found!"))) + (version1 (if full version org-version))) + (if (org-called-interactively-p 'interactive) + (if here + (insert version) + (message version)) + (if message (message version1)) + version1))) + +(defconst org-version (org-version)) + +;;; Compatibility constants + +;;; The custom variables + +(defgroup org nil + "Outline-based notes management and organizer." + :tag "Org" + :group 'outlines + :group 'calendar) + +(defcustom org-mode-hook nil + "Mode hook for Org-mode, run after the mode was turned on." + :group 'org + :type 'hook) + +(defcustom org-load-hook nil + "Hook that is run after org.el has been loaded." + :group 'org + :type 'hook) + +(defcustom org-log-buffer-setup-hook nil + "Hook that is run after an Org log buffer is created." + :group 'org + :version "24.1" + :type 'hook) + +(defvar org-modules) ; defined below +(defvar org-modules-loaded nil + "Have the modules been loaded already?") + +(defun org-load-modules-maybe (&optional force) + "Load all extensions listed in `org-modules'." + (when (or force (not org-modules-loaded)) + (mapc (lambda (ext) + (condition-case nil (require ext) + (error (message "Problems while trying to load feature `%s'" ext)))) + org-modules) + (setq org-modules-loaded t))) + +(defun org-set-modules (var value) + "Set VAR to VALUE and call `org-load-modules-maybe' with the force flag." + (set var value) + (when (featurep 'org) + (org-load-modules-maybe 'force))) + +(defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail) + "Modules that should always be loaded together with org.el. + +If a description starts with <C>, the file is not part of Emacs +and loading it will require that you have downloaded and properly +installed the Org mode distribution. + +You can also use this system to load external packages (i.e. neither Org +core modules, nor modules from the CONTRIB directory). Just add symbols +to the end of the list. If the package is called org-xyz.el, then you need +to add the symbol `xyz', and the package must have a call to: + + \(provide 'org-xyz) + +For export specific modules, see also `org-export-backends'." + :group 'org + :set 'org-set-modules + :version "24.4" + :package-version '(Org . "8.0") + :type + '(set :greedy t + (const :tag " bbdb: Links to BBDB entries" org-bbdb) + (const :tag " bibtex: Links to BibTeX entries" org-bibtex) + (const :tag " crypt: Encryption of subtrees" org-crypt) + (const :tag " ctags: Access to Emacs tags with links" org-ctags) + (const :tag " docview: Links to doc-view buffers" org-docview) + (const :tag " gnus: Links to GNUS folders/messages" org-gnus) + (const :tag " habit: Track your consistency with habits" org-habit) + (const :tag " id: Global IDs for identifying entries" org-id) + (const :tag " info: Links to Info nodes" org-info) + (const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask) + (const :tag " irc: Links to IRC/ERC chat sessions" org-irc) + (const :tag " mhe: Links to MHE folders/messages" org-mhe) + (const :tag " mouse: Additional mouse support" org-mouse) + (const :tag " protocol: Intercept calls from emacsclient" org-protocol) + (const :tag " rmail: Links to RMAIL folders/messages" org-rmail) + (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m) + + (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) + (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark) + (const :tag "C bullets: Add overlays to headlines stars" org-bullets) + (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist) + (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose) + (const :tag "C collector: Collect properties into tables" org-collector) + (const :tag "C depend: TODO dependencies for Org-mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend) + (const :tag "C drill: Flashcards and spaced repetition for Org-mode" org-drill) + (const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol) + (const :tag "C eshell Support for links to working directories in eshell" org-eshell) + (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light) + (const :tag "C eval: Include command output as text" org-eval) + (const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry) + (const :tag "C favtable: Lookup table of favorite references and links" org-favtable) + (const :tag "C git-link: Provide org links to specific file version" org-git-link) + (const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query) + (const :tag "C invoice: Help manage client invoices in Org-mode" org-invoice) + (const :tag "C jira: Add a jira:ticket protocol to Org-mode" org-jira) + (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn) + (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal) + (const :tag "C mac-link: Grab links and url from various mac Applications" org-mac-link) + (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix) + (const :tag "C man: Support for links to manpages in Org-mode" org-man) + (const :tag "C mew: Links to Mew folders/messages" org-mew) + (const :tag "C mtags: Support for muse-like tags" org-mtags) + (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch) + (const :tag "C panel: Simple routines for us with bad memory" org-panel) + (const :tag "C registry: A registry for Org-mode links" org-registry) + (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen) + (const :tag "C secretary: Team management with org-mode" org-secretary) + (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) + (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) + (const :tag "C track: Keep up with Org-mode development" org-track) + (const :tag "C velocity Something like Notational Velocity for Org" org-velocity) + (const :tag "C vm: Links to VM folders/messages" org-vm) + (const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes) + (const :tag "C wl: Links to Wanderlust folders/messages" org-wl) + (repeat :tag "External packages" :inline t (symbol :tag "Package")))) + +(defvar org-export--registered-backends) ; From ox.el. +(declare-function org-export-derived-backend-p "ox" (backend &rest backends)) +(declare-function org-export-backend-name "ox" (backend)) +(defcustom org-export-backends '(ascii html icalendar latex) + "List of export back-ends that should be always available. + +If a description starts with <C>, the file is not part of Emacs +and loading it will require that you have downloaded and properly +installed the Org mode distribution. + +Unlike to `org-modules', libraries in this list will not be +loaded along with Org, but only once the export framework is +needed. + +This variable needs to be set before org.el is loaded. If you +need to make a change while Emacs is running, use the customize +interface or run the following code, where VAL stands for the new +value of the variable, after updating it: + + \(progn + \(setq org-export--registered-backends + \(org-remove-if-not + \(lambda (backend) + \(let ((name (org-export-backend-name backend))) + \(or (memq name val) + \(catch 'parentp + \(dolist (b val) + \(and (org-export-derived-backend-p b name) + \(throw 'parentp t))))))) + org-export--registered-backends)) + \(let ((new-list (mapcar 'org-export-backend-name + org-export--registered-backends))) + \(dolist (backend val) + \(cond + \((not (load (format \"ox-%s\" backend) t t)) + \(message \"Problems while trying to load export back-end `%s'\" + backend)) + \((not (memq backend new-list)) (push backend new-list)))) + \(set-default 'org-export-backends new-list))) + +Adding a back-end to this list will also pull the back-end it +depends on, if any." + :group 'org + :group 'org-export + :version "24.4" + :package-version '(Org . "8.0") + :initialize 'custom-initialize-set + :set (lambda (var val) + (if (not (featurep 'ox)) (set-default var val) + ;; Any back-end not required anymore (not present in VAL and not + ;; a parent of any back-end in the new value) is removed from the + ;; list of registered back-ends. + (setq org-export--registered-backends + (org-remove-if-not + (lambda (backend) + (let ((name (org-export-backend-name backend))) + (or (memq name val) + (catch 'parentp + (dolist (b val) + (and (org-export-derived-backend-p b name) + (throw 'parentp t))))))) + org-export--registered-backends)) + ;; Now build NEW-LIST of both new back-ends and required + ;; parents. + (let ((new-list (mapcar 'org-export-backend-name + org-export--registered-backends))) + (dolist (backend val) + (cond + ((not (load (format "ox-%s" backend) t t)) + (message "Problems while trying to load export back-end `%s'" + backend)) + ((not (memq backend new-list)) (push backend new-list)))) + ;; Set VAR to that list with fixed dependencies. + (set-default var new-list)))) + :type '(set :greedy t + (const :tag " ascii Export buffer to ASCII format" ascii) + (const :tag " beamer Export buffer to Beamer presentation" beamer) + (const :tag " html Export buffer to HTML format" html) + (const :tag " icalendar Export buffer to iCalendar format" icalendar) + (const :tag " latex Export buffer to LaTeX format" latex) + (const :tag " man Export buffer to MAN format" man) + (const :tag " md Export buffer to Markdown format" md) + (const :tag " odt Export buffer to ODT format" odt) + (const :tag " org Export buffer to Org format" org) + (const :tag " texinfo Export buffer to Texinfo format" texinfo) + (const :tag "C confluence Export buffer to Confluence Wiki format" confluence) + (const :tag "C deck Export buffer to deck.js presentations" deck) + (const :tag "C freemind Export buffer to Freemind mindmap format" freemind) + (const :tag "C groff Export buffer to Groff format" groff) + (const :tag "C koma-letter Export buffer to KOMA Scrlttrl2 format" koma-letter) + (const :tag "C RSS 2.0 Export buffer to RSS 2.0 format" rss) + (const :tag "C s5 Export buffer to s5 presentations" s5) + (const :tag "C taskjuggler Export buffer to TaskJuggler format" taskjuggler))) + +(eval-after-load 'ox + '(mapc + (lambda (backend) + (condition-case nil (require (intern (format "ox-%s" backend))) + (error (message "Problems while trying to load export back-end `%s'" + backend)))) + org-export-backends)) + +(defcustom org-support-shift-select nil + "Non-nil means make shift-cursor commands select text when possible. + +In Emacs 23, when `shift-select-mode' is on, shifted cursor keys +start selecting a region, or enlarge regions started in this way. +In Org-mode, in special contexts, these same keys are used for +other purposes, important enough to compete with shift selection. +Org tries to balance these needs by supporting `shift-select-mode' +outside these special contexts, under control of this variable. + +The default of this variable is nil, to avoid confusing behavior. Shifted +cursor keys will then execute Org commands in the following contexts: +- on a headline, changing TODO state (left/right) and priority (up/down) +- on a time stamp, changing the time +- in a plain list item, changing the bullet type +- in a property definition line, switching between allowed values +- in the BEGIN line of a clock table (changing the time block). +Outside these contexts, the commands will throw an error. + +When this variable is t and the cursor is not in a special +context, Org-mode will support shift-selection for making and +enlarging regions. To make this more effective, the bullet +cycling will no longer happen anywhere in an item line, but only +if the cursor is exactly on the bullet. + +If you set this variable to the symbol `always', then the keys +will not be special in headlines, property lines, and item lines, +to make shift selection work there as well. If this is what you +want, you can use the following alternative commands: `C-c C-t' +and `C-c ,' to change TODO state and priority, `C-u C-u C-c C-t' +can be used to switch TODO sets, `C-c -' to cycle item bullet +types, and properties can be edited by hand or in column view. + +However, when the cursor is on a timestamp, shift-cursor commands +will still edit the time stamp - this is just too good to give up. + +XEmacs user should have this variable set to nil, because +`shift-select-mode' is in Emacs 23 or later only." + :group 'org + :type '(choice + (const :tag "Never" nil) + (const :tag "When outside special context" t) + (const :tag "Everywhere except timestamps" always))) + +(defcustom org-loop-over-headlines-in-active-region nil + "Shall some commands act upon headlines in the active region? + +When set to `t', some commands will be performed in all headlines +within the active region. + +When set to `start-level', some commands will be performed in all +headlines within the active region, provided that these headlines +are of the same level than the first one. + +When set to a string, those commands will be performed on the +matching headlines within the active region. Such string must be +a tags/property/todo match as it is used in the agenda tags view. + +The list of commands is: `org-schedule', `org-deadline', +`org-todo', `org-archive-subtree', `org-archive-set-tag' and +`org-archive-to-archive-sibling'. The archiving commands skip +already archived entries." + :type '(choice (const :tag "Don't loop" nil) + (const :tag "All headlines in active region" t) + (const :tag "In active region, headlines at the same level than the first one" start-level) + (string :tag "Tags/Property/Todo matcher")) + :version "24.1" + :group 'org-todo + :group 'org-archive) + +(defgroup org-startup nil + "Options concerning startup of Org-mode." + :tag "Org Startup" + :group 'org) + +(defcustom org-startup-folded t + "Non-nil means entering Org-mode will switch to OVERVIEW. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + + #+STARTUP: fold (or `overview', this is equivalent) + #+STARTUP: nofold (or `showall', this is equivalent) + #+STARTUP: content + #+STARTUP: showeverything + +By default, this option is ignored when Org opens agenda files +for the first time. If you want the agenda to honor the startup +option, set `org-agenda-inhibit-startup' to nil." + :group 'org-startup + :type '(choice + (const :tag "nofold: show all" nil) + (const :tag "fold: overview" t) + (const :tag "content: all headlines" content) + (const :tag "show everything, even drawers" showeverything))) + +(defcustom org-startup-truncated t + "Non-nil means entering Org-mode will set `truncate-lines'. +This is useful since some lines containing links can be very long and +uninteresting. Also tables look terrible when wrapped." + :group 'org-startup + :type 'boolean) + +(defcustom org-startup-indented nil + "Non-nil means turn on `org-indent-mode' on startup. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + + #+STARTUP: indent + #+STARTUP: noindent" + :group 'org-structure + :type '(choice + (const :tag "Not" nil) + (const :tag "Globally (slow on startup in large files)" t))) + +(defcustom org-use-sub-superscripts t + "Non-nil means interpret \"_\" and \"^\" for display. + +If you want to control how Org exports those characters, see +`org-export-with-sub-superscripts'. `org-use-sub-superscripts' +used to be an alias for `org-export-with-sub-superscripts' in +Org <8.0, it is not anymore. + +When this option is turned on, you can use TeX-like syntax for +sub- and superscripts within the buffer. Several characters after +\"_\" or \"^\" will be considered as a single item - so grouping +with {} is normally not needed. For example, the following things +will be parsed as single sub- or superscripts: + + 10^24 or 10^tau several digits will be considered 1 item. + 10^-12 or 10^-tau a leading sign with digits or a word + x^2-y^3 will be read as x^2 - y^3, because items are + terminated by almost any nonword/nondigit char. + x_{i^2} or x^(2-i) braces or parenthesis do grouping. + +Still, ambiguity is possible. So when in doubt, use {} to enclose +the sub/superscript. If you set this variable to the symbol `{}', +the braces are *required* in order to trigger interpretations as +sub/superscript. This can be helpful in documents that need \"_\" +frequently in plain text." + :group 'org-startup + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Always interpret" t) + (const :tag "Only with braces" {}) + (const :tag "Never interpret" nil))) + +(defcustom org-startup-with-beamer-mode nil + "Non-nil means turn on `org-beamer-mode' on startup. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + + #+STARTUP: beamer" + :group 'org-startup + :version "24.1" + :type 'boolean) + +(defcustom org-startup-align-all-tables nil + "Non-nil means align all tables when visiting a file. +This is useful when the column width in tables is forced with <N> cookies +in table fields. Such tables will look correct only after the first re-align. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + #+STARTUP: align + #+STARTUP: noalign" + :group 'org-startup + :type 'boolean) + +(defcustom org-startup-with-inline-images nil + "Non-nil means show inline images when loading a new Org file. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + #+STARTUP: inlineimages + #+STARTUP: noinlineimages" + :group 'org-startup + :version "24.1" + :type 'boolean) + +(defcustom org-startup-with-latex-preview nil + "Non-nil means preview LaTeX fragments when loading a new Org file. + +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + #+STARTUP: latexpreview + #+STARTUP: nolatexpreview" + :group 'org-startup + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-insert-mode-line-in-empty-file nil + "Non-nil means insert the first line setting Org-mode in empty files. +When the function `org-mode' is called interactively in an empty file, this +normally means that the file name does not automatically trigger Org-mode. +To ensure that the file will always be in Org-mode in the future, a +line enforcing Org-mode will be inserted into the buffer, if this option +has been set." + :group 'org-startup + :type 'boolean) + +(defcustom org-replace-disputed-keys nil + "Non-nil means use alternative key bindings for some keys. +Org-mode uses S-<cursor> keys for changing timestamps and priorities. +These keys are also used by other packages like shift-selection-mode' +\(built into Emacs 23), `CUA-mode' or `windmove.el'. +If you want to use Org-mode together with one of these other modes, +or more generally if you would like to move some Org-mode commands to +other keys, set this variable and configure the keys with the variable +`org-disputed-keys'. + +This option is only relevant at load-time of Org-mode, and must be set +*before* org.el is loaded. Changing it requires a restart of Emacs to +become effective." + :group 'org-startup + :type 'boolean) + +(defcustom org-use-extra-keys nil + "Non-nil means use extra key sequence definitions for certain commands. +This happens automatically if you run XEmacs or if `window-system' +is nil. This variable lets you do the same manually. You must +set it before loading org. + +Example: on Carbon Emacs 22 running graphically, with an external +keyboard on a Powerbook, the default way of setting M-left might +not work for either Alt or ESC. Setting this variable will make +it work for ESC." + :group 'org-startup + :type 'boolean) + +(org-defvaralias 'org-CUA-compatible 'org-replace-disputed-keys) + +(defcustom org-disputed-keys + '(([(shift up)] . [(meta p)]) + ([(shift down)] . [(meta n)]) + ([(shift left)] . [(meta -)]) + ([(shift right)] . [(meta +)]) + ([(control shift right)] . [(meta shift +)]) + ([(control shift left)] . [(meta shift -)])) + "Keys for which Org-mode and other modes compete. +This is an alist, cars are the default keys, second element specifies +the alternative to use when `org-replace-disputed-keys' is t. + +Keys can be specified in any syntax supported by `define-key'. +The value of this option takes effect only at Org-mode's startup, +therefore you'll have to restart Emacs to apply it after changing." + :group 'org-startup + :type 'alist) + +(defun org-key (key) + "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'. +Or return the original if not disputed. +Also apply the translations defined in `org-xemacs-key-equivalents'." + (when org-replace-disputed-keys + (let* ((nkey (key-description key)) + (x (org-find-if (lambda (x) + (equal (key-description (car x)) nkey)) + org-disputed-keys))) + (setq key (if x (cdr x) key)))) + (when (featurep 'xemacs) + (setq key (or (cdr (assoc key org-xemacs-key-equivalents)) key))) + key) + +(defun org-find-if (predicate seq) + (catch 'exit + (while seq + (if (funcall predicate (car seq)) + (throw 'exit (car seq)) + (pop seq))))) + +(defun org-defkey (keymap key def) + "Define a key, possibly translated, as returned by `org-key'." + (define-key keymap (org-key key) def)) + +(defcustom org-ellipsis nil + "The ellipsis to use in the Org-mode outline. +When nil, just use the standard three dots. +When a string, use that string instead. +When a face, use the standard 3 dots, but with the specified face. +The change affects only Org-mode (which will then use its own display table). +Changing this requires executing `M-x org-mode RET' in a buffer to become +effective." + :group 'org-startup + :type '(choice (const :tag "Default" nil) + (face :tag "Face" :value org-warning) + (string :tag "String" :value "...#"))) + +(defvar org-display-table nil + "The display table for org-mode, in case `org-ellipsis' is non-nil.") + +(defgroup org-keywords nil + "Keywords in Org-mode." + :tag "Org Keywords" + :group 'org) + +(defcustom org-deadline-string "DEADLINE:" + "String to mark deadline entries. +A deadline is this string, followed by a time stamp. Should be a word, +terminated by a colon. You can insert a schedule keyword and +a timestamp with \\[org-deadline]. +Changes become only effective after restarting Emacs." + :group 'org-keywords + :type 'string) + +(defcustom org-scheduled-string "SCHEDULED:" + "String to mark scheduled TODO entries. +A schedule is this string, followed by a time stamp. Should be a word, +terminated by a colon. You can insert a schedule keyword and +a timestamp with \\[org-schedule]. +Changes become only effective after restarting Emacs." + :group 'org-keywords + :type 'string) + +(defcustom org-closed-string "CLOSED:" + "String used as the prefix for timestamps logging closing a TODO entry." + :group 'org-keywords + :type 'string) + +(defcustom org-clock-string "CLOCK:" + "String used as prefix for timestamps clocking work hours on an item." + :group 'org-keywords + :type 'string) + +(defcustom org-closed-keep-when-no-todo nil + "Remove CLOSED: time-stamp when switching back to a non-todo state?" + :group 'org-todo + :group 'org-keywords + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defconst org-planning-or-clock-line-re (concat "^[ \t]*\\(" + org-scheduled-string "\\|" + org-deadline-string "\\|" + org-closed-string "\\|" + org-clock-string "\\)") + "Matches a line with planning or clock info.") + +(defcustom org-comment-string "COMMENT" + "Entries starting with this keyword will never be exported. +An entry can be toggled between COMMENT and normal with +\\[org-toggle-comment]. +Changes become only effective after restarting Emacs." + :group 'org-keywords + :type 'string) + +(defcustom org-quote-string "QUOTE" + "Entries starting with this keyword will be exported in fixed-width font. +Quoting applies only to the text in the entry following the headline, and does +not extend beyond the next headline, even if that is lower level. +An entry can be toggled between QUOTE and normal with +\\[org-toggle-fixed-width-section]." + :group 'org-keywords + :type 'string) + +(defconst org-repeat-re + "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)" + "Regular expression for specifying repeated events. +After a match, group 1 contains the repeat expression.") + +(defgroup org-structure nil + "Options concerning the general structure of Org-mode files." + :tag "Org Structure" + :group 'org) + +(defgroup org-reveal-location nil + "Options about how to make context of a location visible." + :tag "Org Reveal Location" + :group 'org-structure) + +(defconst org-context-choice + '(choice + (const :tag "Always" t) + (const :tag "Never" nil) + (repeat :greedy t :tag "Individual contexts" + (cons + (choice :tag "Context" + (const agenda) + (const org-goto) + (const occur-tree) + (const tags-tree) + (const link-search) + (const mark-goto) + (const bookmark-jump) + (const isearch) + (const default)) + (boolean)))) + "Contexts for the reveal options.") + +(defcustom org-show-hierarchy-above '((default . t)) + "Non-nil means show full hierarchy when revealing a location. +Org-mode often shows locations in an org-mode file which might have +been invisible before. When this is set, the hierarchy of headings +above the exposed location is shown. +Turning this off for example for sparse trees makes them very compact. +Instead of t, this can also be an alist specifying this option for different +contexts. Valid contexts are + agenda when exposing an entry from the agenda + org-goto when using the command `org-goto' on key C-c C-j + occur-tree when using the command `org-occur' on key C-c / + tags-tree when constructing a sparse tree based on tags matches + link-search when exposing search matches associated with a link + mark-goto when exposing the jump goal of a mark + bookmark-jump when exposing a bookmark location + isearch when exiting from an incremental search + default default for all contexts not set explicitly" + :group 'org-reveal-location + :type org-context-choice) + +(defcustom org-show-following-heading '((default . nil)) + "Non-nil means show following heading when revealing a location. +Org-mode often shows locations in an org-mode file which might have +been invisible before. When this is set, the heading following the +match is shown. +Turning this off for example for sparse trees makes them very compact, +but makes it harder to edit the location of the match. In such a case, +use the command \\[org-reveal] to show more context. +Instead of t, this can also be an alist specifying this option for different +contexts. See `org-show-hierarchy-above' for valid contexts." + :group 'org-reveal-location + :type org-context-choice) + +(defcustom org-show-siblings '((default . nil) (isearch t) (bookmark-jump t)) + "Non-nil means show all sibling heading when revealing a location. +Org-mode often shows locations in an org-mode file which might have +been invisible before. When this is set, the sibling of the current entry +heading are all made visible. If `org-show-hierarchy-above' is t, +the same happens on each level of the hierarchy above the current entry. + +By default this is on for the isearch context, off for all other contexts. +Turning this off for example for sparse trees makes them very compact, +but makes it harder to edit the location of the match. In such a case, +use the command \\[org-reveal] to show more context. +Instead of t, this can also be an alist specifying this option for different +contexts. See `org-show-hierarchy-above' for valid contexts." + :group 'org-reveal-location + :type org-context-choice + :version "24.4" + :package-version '(Org . "8.0")) + +(defcustom org-show-entry-below '((default . nil)) + "Non-nil means show the entry below a headline when revealing a location. +Org-mode often shows locations in an org-mode file which might have +been invisible before. When this is set, the text below the headline that is +exposed is also shown. + +By default this is off for all contexts. +Instead of t, this can also be an alist specifying this option for different +contexts. See `org-show-hierarchy-above' for valid contexts." + :group 'org-reveal-location + :type org-context-choice) + +(defcustom org-indirect-buffer-display 'other-window + "How should indirect tree buffers be displayed? +This applies to indirect buffers created with the commands +\\[org-tree-to-indirect-buffer] and \\[org-agenda-tree-to-indirect-buffer]. +Valid values are: +current-window Display in the current window +other-window Just display in another window. +dedicated-frame Create one new frame, and re-use it each time. +new-frame Make a new frame each time. Note that in this case + previously-made indirect buffers are kept, and you need to + kill these buffers yourself." + :group 'org-structure + :group 'org-agenda-windows + :type '(choice + (const :tag "In current window" current-window) + (const :tag "In current frame, other window" other-window) + (const :tag "Each time a new frame" new-frame) + (const :tag "One dedicated frame" dedicated-frame))) + +(defcustom org-use-speed-commands nil + "Non-nil means activate single letter commands at beginning of a headline. +This may also be a function to test for appropriate locations where speed +commands should be active." + :group 'org-structure + :type '(choice + (const :tag "Never" nil) + (const :tag "At beginning of headline stars" t) + (function))) + +(defcustom org-speed-commands-user nil + "Alist of additional speed commands. +This list will be checked before `org-speed-commands-default' +when the variable `org-use-speed-commands' is non-nil +and when the cursor is at the beginning of a headline. +The car if each entry is a string with a single letter, which must +be assigned to `self-insert-command' in the global map. +The cdr is either a command to be called interactively, a function +to be called, or a form to be evaluated. +An entry that is just a list with a single string will be interpreted +as a descriptive headline that will be added when listing the speed +commands in the Help buffer using the `?' speed command." + :group 'org-structure + :type '(repeat :value ("k" . ignore) + (choice :value ("k" . ignore) + (list :tag "Descriptive Headline" (string :tag "Headline")) + (cons :tag "Letter and Command" + (string :tag "Command letter") + (choice + (function) + (sexp)))))) + +(defcustom org-bookmark-names-plist + '(:last-capture "org-capture-last-stored" + :last-refile "org-refile-last-stored" + :last-capture-marker "org-capture-last-stored-marker") + "Names for bookmarks automatically set by some Org commands. +This can provide strings as names for a number of bookmarks Org sets +automatically. The following keys are currently implemented: + :last-capture + :last-capture-marker + :last-refile +When a key does not show up in the property list, the corresponding bookmark +is not set." + :group 'org-structure + :type 'plist) + +(defgroup org-cycle nil + "Options concerning visibility cycling in Org-mode." + :tag "Org Cycle" + :group 'org-structure) + +(defcustom org-cycle-skip-children-state-if-no-children t + "Non-nil means skip CHILDREN state in entries that don't have any." + :group 'org-cycle + :type 'boolean) + +(defcustom org-cycle-max-level nil + "Maximum level which should still be subject to visibility cycling. +Levels higher than this will, for cycling, be treated as text, not a headline. +When `org-odd-levels-only' is set, a value of N in this variable actually +means 2N-1 stars as the limiting headline. +When nil, cycle all levels. +Note that the limiting level of cycling is also influenced by +`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but +`org-inlinetask-min-level' is, cycling will be limited to levels one less +than its value." + :group 'org-cycle + :type '(choice + (const :tag "No limit" nil) + (integer :tag "Maximum level"))) + +(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK" "RESULTS") + "Names of drawers. Drawers are not opened by cycling on the headline above. +Drawers only open with a TAB on the drawer line itself. A drawer looks like +this: + :DRAWERNAME: + ..... + :END: +The drawer \"PROPERTIES\" is special for capturing properties through +the property API. + +Drawers can be defined on the per-file basis with a line like: + +#+DRAWERS: HIDDEN STATE PROPERTIES" + :group 'org-structure + :group 'org-cycle + :type '(repeat (string :tag "Drawer Name"))) + +(defcustom org-hide-block-startup nil + "Non-nil means entering Org-mode will fold all blocks. +This can also be set in on a per-file basis with + +#+STARTUP: hideblocks +#+STARTUP: showblocks" + :group 'org-startup + :group 'org-cycle + :type 'boolean) + +(defcustom org-cycle-global-at-bob nil + "Cycle globally if cursor is at beginning of buffer and not at a headline. +This makes it possible to do global cycling without having to use S-TAB or +\\[universal-argument] TAB. For this special case to work, the first line +of the buffer must not be a headline -- it may be empty or some other text. +When used in this way, `org-cycle-hook' is disabled temporarily to make +sure the cursor stays at the beginning of the buffer. When this option is +nil, don't do anything special at the beginning of the buffer." + :group 'org-cycle + :type 'boolean) + +(defcustom org-cycle-level-after-item/entry-creation t + "Non-nil means cycle entry level or item indentation in new empty entries. + +When the cursor is at the end of an empty headline, i.e., with only stars +and maybe a TODO keyword, TAB will then switch the entry to become a child, +and then all possible ancestor states, before returning to the original state. +This makes data entry extremely fast: M-RET to create a new headline, +on TAB to make it a child, two or more tabs to make it a (grand-)uncle. + +When the cursor is at the end of an empty plain list item, one TAB will +make it a subitem, two or more tabs will back up to make this an item +higher up in the item hierarchy." + :group 'org-cycle + :type 'boolean) + +(defcustom org-cycle-emulate-tab t + "Where should `org-cycle' emulate TAB. +nil Never +white Only in completely white lines +whitestart Only at the beginning of lines, before the first non-white char +t Everywhere except in headlines +exc-hl-bol Everywhere except at the start of a headline +If TAB is used in a place where it does not emulate TAB, the current subtree +visibility is cycled." + :group 'org-cycle + :type '(choice (const :tag "Never" nil) + (const :tag "Only in completely white lines" white) + (const :tag "Before first char in a line" whitestart) + (const :tag "Everywhere except in headlines" t) + (const :tag "Everywhere except at bol in headlines" exc-hl-bol))) + +(defcustom org-cycle-separator-lines 2 + "Number of empty lines needed to keep an empty line between collapsed trees. +If you leave an empty line between the end of a subtree and the following +headline, this empty line is hidden when the subtree is folded. +Org-mode will leave (exactly) one empty line visible if the number of +empty lines is equal or larger to the number given in this variable. +So the default 2 means at least 2 empty lines after the end of a subtree +are needed to produce free space between a collapsed subtree and the +following headline. + +If the number is negative, and the number of empty lines is at least -N, +all empty lines are shown. + +Special case: when 0, never leave empty lines in collapsed view." + :group 'org-cycle + :type 'integer) +(put 'org-cycle-separator-lines 'safe-local-variable 'integerp) + +(defcustom org-pre-cycle-hook nil + "Hook that is run before visibility cycling is happening. +The function(s) in this hook must accept a single argument which indicates +the new state that will be set right after running this hook. The +argument is a symbol. Before a global state change, it can have the values +`overview', `content', or `all'. Before a local state change, it can have +the values `folded', `children', or `subtree'." + :group 'org-cycle + :type 'hook) + +(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees + org-cycle-hide-drawers + org-cycle-hide-inline-tasks + org-cycle-show-empty-lines + org-optimize-window-after-visibility-change) + "Hook that is run after `org-cycle' has changed the buffer visibility. +The function(s) in this hook must accept a single argument which indicates +the new state that was set by the most recent `org-cycle' command. The +argument is a symbol. After a global state change, it can have the values +`overview', `contents', or `all'. After a local state change, it can have +the values `folded', `children', or `subtree'." + :group 'org-cycle + :type 'hook) + +(defgroup org-edit-structure nil + "Options concerning structure editing in Org-mode." + :tag "Org Edit Structure" + :group 'org-structure) + +(defcustom org-odd-levels-only nil + "Non-nil means skip even levels and only use odd levels for the outline. +This has the effect that two stars are being added/taken away in +promotion/demotion commands. It also influences how levels are +handled by the exporters. +Changing it requires restart of `font-lock-mode' to become effective +for fontification also in regions already fontified. +You may also set this on a per-file basis by adding one of the following +lines to the buffer: + + #+STARTUP: odd + #+STARTUP: oddeven" + :group 'org-edit-structure + :group 'org-appearance + :type 'boolean) + +(defcustom org-adapt-indentation t + "Non-nil means adapt indentation to outline node level. + +When this variable is set, Org assumes that you write outlines by +indenting text in each node to align with the headline (after the stars). +The following issues are influenced by this variable: + +- When this is set and the *entire* text in an entry is indented, the + indentation is increased by one space in a demotion command, and + decreased by one in a promotion command. If any line in the entry + body starts with text at column 0, indentation is not changed at all. + +- Property drawers and planning information is inserted indented when + this variable is set. When nil, they will not be indented. + +- TAB indents a line relative to context. The lines below a headline + will be indented when this variable is set. + +Note that this is all about true indentation, by adding and removing +space characters. See also `org-indent.el' which does level-dependent +indentation in a virtual way, i.e. at display time in Emacs." + :group 'org-edit-structure + :type 'boolean) + +(defcustom org-special-ctrl-a/e nil + "Non-nil means `C-a' and `C-e' behave specially in headlines and items. + +When t, `C-a' will bring back the cursor to the beginning of the +headline text, i.e. after the stars and after a possible TODO +keyword. In an item, this will be the position after bullet and +check-box, if any. When the cursor is already at that position, +another `C-a' will bring it to the beginning of the line. + +`C-e' will jump to the end of the headline, ignoring the presence +of tags in the headline. A second `C-e' will then jump to the +true end of the line, after any tags. This also means that, when +this variable is non-nil, `C-e' also will never jump beyond the +end of the heading of a folded section, i.e. not after the +ellipses. + +When set to the symbol `reversed', the first `C-a' or `C-e' works +normally, going to the true line boundary first. Only a directly +following, identical keypress will bring the cursor to the +special positions. + +This may also be a cons cell where the behavior for `C-a' and +`C-e' is set separately." + :group 'org-edit-structure + :type '(choice + (const :tag "off" nil) + (const :tag "on: after stars/bullet and before tags first" t) + (const :tag "reversed: true line boundary first" reversed) + (cons :tag "Set C-a and C-e separately" + (choice :tag "Special C-a" + (const :tag "off" nil) + (const :tag "on: after stars/bullet first" t) + (const :tag "reversed: before stars/bullet first" reversed)) + (choice :tag "Special C-e" + (const :tag "off" nil) + (const :tag "on: before tags first" t) + (const :tag "reversed: after tags first" reversed))))) +(org-defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e) + +(defcustom org-special-ctrl-k nil + "Non-nil means `C-k' will behave specially in headlines. +When nil, `C-k' will call the default `kill-line' command. +When t, the following will happen while the cursor is in the headline: + +- When the cursor is at the beginning of a headline, kill the entire + line and possible the folded subtree below the line. +- When in the middle of the headline text, kill the headline up to the tags. +- When after the headline text, kill the tags." + :group 'org-edit-structure + :type 'boolean) + +(defcustom org-ctrl-k-protect-subtree nil + "Non-nil means, do not delete a hidden subtree with C-k. +When set to the symbol `error', simply throw an error when C-k is +used to kill (part-of) a headline that has hidden text behind it. +Any other non-nil value will result in a query to the user, if it is +OK to kill that hidden subtree. When nil, kill without remorse." + :group 'org-edit-structure + :version "24.1" + :type '(choice + (const :tag "Do not protect hidden subtrees" nil) + (const :tag "Protect hidden subtrees with a security query" t) + (const :tag "Never kill a hidden subtree with C-k" error))) + +(defcustom org-special-ctrl-o t + "Non-nil means, make `C-o' insert a row in tables." + :group 'org-edit-structure + :type 'boolean) + +(defcustom org-catch-invisible-edits nil + "Check if in invisible region before inserting or deleting a character. +Valid values are: + +nil Do not check, so just do invisible edits. +error Throw an error and do nothing. +show Make point visible, and do the requested edit. +show-and-error Make point visible, then throw an error and abort the edit. +smart Make point visible, and do insertion/deletion if it is + adjacent to visible text and the change feels predictable. + Never delete a previously invisible character or add in the + middle or right after an invisible region. Basically, this + allows insertion and backward-delete right before ellipses. + FIXME: maybe in this case we should not even show?" + :group 'org-edit-structure + :version "24.1" + :type '(choice + (const :tag "Do not check" nil) + (const :tag "Throw error when trying to edit" error) + (const :tag "Unhide, but do not do the edit" show-and-error) + (const :tag "Show invisible part and do the edit" show) + (const :tag "Be smart and do the right thing" smart))) + +(defcustom org-yank-folded-subtrees t + "Non-nil means when yanking subtrees, fold them. +If the kill is a single subtree, or a sequence of subtrees, i.e. if +it starts with a heading and all other headings in it are either children +or siblings, then fold all the subtrees. However, do this only if no +text after the yank would be swallowed into a folded tree by this action." + :group 'org-edit-structure + :type 'boolean) + +(defcustom org-yank-adjusted-subtrees nil + "Non-nil means when yanking subtrees, adjust the level. +With this setting, `org-paste-subtree' is used to insert the subtree, see +this function for details." + :group 'org-edit-structure + :type 'boolean) + +(defcustom org-M-RET-may-split-line '((default . t)) + "Non-nil means M-RET will split the line at the cursor position. +When nil, it will go to the end of the line before making a +new line. +You may also set this option in a different way for different +contexts. Valid contexts are: + +headline when creating a new headline +item when creating a new item +table in a table field +default the value to be used for all contexts not explicitly + customized" + :group 'org-structure + :group 'org-table + :type '(choice + (const :tag "Always" t) + (const :tag "Never" nil) + (repeat :greedy t :tag "Individual contexts" + (cons + (choice :tag "Context" + (const headline) + (const item) + (const table) + (const default)) + (boolean))))) + + +(defcustom org-insert-heading-respect-content nil + "Non-nil means insert new headings after the current subtree. +When nil, the new heading is created directly after the current line. +The commands \\[org-insert-heading-respect-content] and \\[org-insert-todo-heading-respect-content] turn +this variable on for the duration of the command." + :group 'org-structure + :type 'boolean) + +(defcustom org-blank-before-new-entry '((heading . auto) + (plain-list-item . auto)) + "Should `org-insert-heading' leave a blank line before new heading/item? +The value is an alist, with `heading' and `plain-list-item' as CAR, +and a boolean flag as CDR. The cdr may also be the symbol `auto', in +which case Org will look at the surrounding headings/items and try to +make an intelligent decision whether to insert a blank line or not. + +For plain lists, if `org-list-empty-line-terminates-plain-lists' is set, +the setting here is ignored and no empty line is inserted to avoid breaking +the list structure." + :group 'org-edit-structure + :type '(list + (cons (const heading) + (choice (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "Auto" auto))) + (cons (const plain-list-item) + (choice (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "Auto" auto))))) + +(defcustom org-insert-heading-hook nil + "Hook being run after inserting a new heading." + :group 'org-edit-structure + :type 'hook) + +(defcustom org-enable-fixed-width-editor t + "Non-nil means lines starting with \":\" are treated as fixed-width. +This currently only means they are never auto-wrapped. +When nil, such lines will be treated like ordinary lines. +See also the QUOTE keyword." + :group 'org-edit-structure + :type 'boolean) + +(defcustom org-goto-auto-isearch t + "Non-nil means typing characters in `org-goto' starts incremental search. +When nil, you can use these keybindings to navigate the buffer: + + q Quit the org-goto interface + n Go to the next visible heading + p Go to the previous visible heading + f Go one heading forward on same level + b Go one heading backward on same level + u Go one heading up" + :group 'org-edit-structure + :type 'boolean) + +(defgroup org-sparse-trees nil + "Options concerning sparse trees in Org-mode." + :tag "Org Sparse Trees" + :group 'org-structure) + +(defcustom org-highlight-sparse-tree-matches t + "Non-nil means highlight all matches that define a sparse tree. +The highlights will automatically disappear the next time the buffer is +changed by an edit command." + :group 'org-sparse-trees + :type 'boolean) + +(defcustom org-remove-highlights-with-change t + "Non-nil means any change to the buffer will remove temporary highlights. +Such highlights are created by `org-occur' and `org-clock-display'. +When nil, `C-c C-c needs to be used to get rid of the highlights. +The highlights created by `org-preview-latex-fragment' always need +`C-c C-c' to be removed." + :group 'org-sparse-trees + :group 'org-time + :type 'boolean) + + +(defcustom org-occur-hook '(org-first-headline-recenter) + "Hook that is run after `org-occur' has constructed a sparse tree. +This can be used to recenter the window to show as much of the structure +as possible." + :group 'org-sparse-trees + :type 'hook) + +(defgroup org-imenu-and-speedbar nil + "Options concerning imenu and speedbar in Org-mode." + :tag "Org Imenu and Speedbar" + :group 'org-structure) + +(defcustom org-imenu-depth 2 + "The maximum level for Imenu access to Org-mode headlines. +This also applied for speedbar access." + :group 'org-imenu-and-speedbar + :type 'integer) + +(defgroup org-table nil + "Options concerning tables in Org-mode." + :tag "Org Table" + :group 'org) + +(defcustom org-enable-table-editor 'optimized + "Non-nil means lines starting with \"|\" are handled by the table editor. +When nil, such lines will be treated like ordinary lines. + +When equal to the symbol `optimized', the table editor will be optimized to +do the following: +- Automatic overwrite mode in front of whitespace in table fields. + This makes the structure of the table stay in tact as long as the edited + field does not exceed the column width. +- Minimize the number of realigns. Normally, the table is aligned each time + TAB or RET are pressed to move to another field. With optimization this + happens only if changes to a field might have changed the column width. +Optimization requires replacing the functions `self-insert-command', +`delete-char', and `backward-delete-char' in Org-mode buffers, with a +slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is +very good at guessing when a re-align will be necessary, but you can always +force one with \\[org-ctrl-c-ctrl-c]. + +If you would like to use the optimized version in Org-mode, but the +un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'. + +This variable can be used to turn on and off the table editor during a session, +but in order to toggle optimization, a restart is required. + +See also the variable `org-table-auto-blank-field'." + :group 'org-table + :type '(choice + (const :tag "off" nil) + (const :tag "on" t) + (const :tag "on, optimized" optimized))) + +(defcustom org-self-insert-cluster-for-undo (or (featurep 'xemacs) + (version<= emacs-version "24.1")) + "Non-nil means cluster self-insert commands for undo when possible. +If this is set, then, like in the Emacs command loop, 20 consecutive +characters will be undone together. +This is configurable, because there is some impact on typing performance." + :group 'org-table + :type 'boolean) + +(defcustom org-table-tab-recognizes-table.el t + "Non-nil means TAB will automatically notice a table.el table. +When it sees such a table, it moves point into it and - if necessary - +calls `table-recognize-table'." + :group 'org-table-editing + :type 'boolean) + +(defgroup org-link nil + "Options concerning links in Org-mode." + :tag "Org Link" + :group 'org) + +(defvar org-link-abbrev-alist-local nil + "Buffer-local version of `org-link-abbrev-alist', which see. +The value of this is taken from the #+LINK lines.") +(make-variable-buffer-local 'org-link-abbrev-alist-local) + +(defcustom org-link-abbrev-alist nil + "Alist of link abbreviations. +The car of each element is a string, to be replaced at the start of a link. +The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated +links in Org-mode buffers can have an optional tag after a double colon, e.g. + + [[linkkey:tag][description]] + +The 'linkkey' must be a word word, starting with a letter, followed +by letters, numbers, '-' or '_'. + +If REPLACE is a string, the tag will simply be appended to create the link. +If the string contains \"%s\", the tag will be inserted there. If the string +contains \"%h\", it will cause a url-encoded version of the tag to be inserted +at that point (see the function `url-hexify-string'). If the string contains +the specifier \"%(my-function)\", then the custom function `my-function' will +be invoked: this function takes the tag as its only argument and must return +a string. + +REPLACE may also be a function that will be called with the tag as the +only argument to create the link, which should be returned as a string. + +See the manual for examples." + :group 'org-link + :type '(repeat + (cons + (string :tag "Protocol") + (choice + (string :tag "Format") + (function))))) + +(defcustom org-descriptive-links t + "Non-nil means Org will display descriptive links. +E.g. [[http://orgmode.org][Org website]] will be displayed as +\"Org Website\", hiding the link itself and just displaying its +description. When set to `nil', Org will display the full links +literally. + +You can interactively set the value of this variable by calling +`org-toggle-link-display' or from the menu Org>Hyperlinks menu." + :group 'org-link + :type 'boolean) + +(defcustom org-link-file-path-type 'adaptive + "How the path name in file links should be stored. +Valid values are: + +relative Relative to the current directory, i.e. the directory of the file + into which the link is being inserted. +absolute Absolute path, if possible with ~ for home directory. +noabbrev Absolute path, no abbreviation of home directory. +adaptive Use relative path for files in the current directory and sub- + directories of it. For other files, use an absolute path." + :group 'org-link + :type '(choice + (const relative) + (const absolute) + (const noabbrev) + (const adaptive))) + +(defcustom org-activate-links '(bracket angle plain radio tag date footnote) + "Types of links that should be activated in Org-mode files. +This is a list of symbols, each leading to the activation of a certain link +type. In principle, it does not hurt to turn on most link types - there may +be a small gain when turning off unused link types. The types are: + +bracket The recommended [[link][description]] or [[link]] links with hiding. +angle Links in angular brackets that may contain whitespace like + <bbdb:Carsten Dominik>. +plain Plain links in normal text, no whitespace, like http://google.com. +radio Text that is matched by a radio target, see manual for details. +tag Tag settings in a headline (link to tag search). +date Time stamps (link to calendar). +footnote Footnote labels. + +Changing this variable requires a restart of Emacs to become effective." + :group 'org-link + :type '(set :greedy t + (const :tag "Double bracket links" bracket) + (const :tag "Angular bracket links" angle) + (const :tag "Plain text links" plain) + (const :tag "Radio target matches" radio) + (const :tag "Tags" tag) + (const :tag "Timestamps" date) + (const :tag "Footnotes" footnote))) + +(defcustom org-make-link-description-function nil + "Function to use for generating link descriptions from links. +When nil, the link location will be used. This function must take +two parameters: the first one is the link, the second one is the +description generated by `org-insert-link'. The function should +return the description to use." + :group 'org-link + :type '(choice (const nil) (function))) + +(defgroup org-link-store nil + "Options concerning storing links in Org-mode." + :tag "Org Store Link" + :group 'org-link) + +(defcustom org-url-hexify-p t + "When non-nil, hexify URL when creating a link." + :type 'boolean + :version "24.3" + :group 'org-link-store) + +(defcustom org-email-link-description-format "Email %c: %.30s" + "Format of the description part of a link to an email or usenet message. +The following %-escapes will be replaced by corresponding information: + +%F full \"From\" field +%f name, taken from \"From\" field, address if no name +%T full \"To\" field +%t first name in \"To\" field, address if no name +%c correspondent. Usually \"from NAME\", but if you sent it yourself, it + will be \"to NAME\". See also the variable `org-from-is-user-regexp'. +%s subject +%d date +%m message-id. + +You may use normal field width specification between the % and the letter. +This is for example useful to limit the length of the subject. + +Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\"" + :group 'org-link-store + :type 'string) + +(defcustom org-from-is-user-regexp + (let (r1 r2) + (when (and user-mail-address (not (string= user-mail-address ""))) + (setq r1 (concat "\\<" (regexp-quote user-mail-address) "\\>"))) + (when (and user-full-name (not (string= user-full-name ""))) + (setq r2 (concat "\\<" (regexp-quote user-full-name) "\\>"))) + (if (and r1 r2) (concat r1 "\\|" r2) (or r1 r2))) + "Regexp matched against the \"From:\" header of an email or usenet message. +It should match if the message is from the user him/herself." + :group 'org-link-store + :type 'regexp) + +(defcustom org-context-in-file-links t + "Non-nil means file links from `org-store-link' contain context. +A search string will be added to the file name with :: as separator and +used to find the context when the link is activated by the command +`org-open-at-point'. When this option is t, the entire active region +will be placed in the search string of the file link. If set to a +positive integer, only the first n lines of context will be stored. + +Using a prefix arg to the command \\[org-store-link] (`org-store-link') +negates this setting for the duration of the command." + :group 'org-link-store + :type '(choice boolean integer)) + +(defcustom org-keep-stored-link-after-insertion nil + "Non-nil means keep link in list for entire session. + +The command `org-store-link' adds a link pointing to the current +location to an internal list. These links accumulate during a session. +The command `org-insert-link' can be used to insert links into any +Org-mode file (offering completion for all stored links). When this +option is nil, every link which has been inserted once using \\[org-insert-link] +will be removed from the list, to make completing the unused links +more efficient." + :group 'org-link-store + :type 'boolean) + +(defgroup org-link-follow nil + "Options concerning following links in Org-mode." + :tag "Org Follow Link" + :group 'org-link) + +(defcustom org-link-translation-function nil + "Function to translate links with different syntax to Org syntax. +This can be used to translate links created for example by the Planner +or emacs-wiki packages to Org syntax. +The function must accept two parameters, a TYPE containing the link +protocol name like \"rmail\" or \"gnus\" as a string, and the linked path, +which is everything after the link protocol. It should return a cons +with possibly modified values of type and path. +Org contains a function for this, so if you set this variable to +`org-translate-link-from-planner', you should be able follow many +links created by planner." + :group 'org-link-follow + :type '(choice (const nil) (function))) + +(defcustom org-follow-link-hook nil + "Hook that is run after a link has been followed." + :group 'org-link-follow + :type 'hook) + +(defcustom org-tab-follows-link nil + "Non-nil means on links TAB will follow the link. +Needs to be set before org.el is loaded. +This really should not be used, it does not make sense, and the +implementation is bad." + :group 'org-link-follow + :type 'boolean) + +(defcustom org-return-follows-link nil + "Non-nil means on links RET will follow the link. +In tables, the special behavior of RET has precedence." + :group 'org-link-follow + :type 'boolean) + +(defcustom org-mouse-1-follows-link + (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t) + "Non-nil means mouse-1 on a link will follow the link. +A longer mouse click will still set point. Does not work on XEmacs. +Needs to be set before org.el is loaded." + :group 'org-link-follow + :version "24.4" + :package-version '(Org . "8.3") + :type '(choice + (const :tag "A double click follows the link" double) + (const :tag "Unconditionally follow the link with mouse-1" t) + (integer :tag "mouse-1 click does not follow the link if longer than N ms" 450))) + +(defcustom org-mark-ring-length 4 + "Number of different positions to be recorded in the ring. +Changing this requires a restart of Emacs to work correctly." + :group 'org-link-follow + :type 'integer) + +(defcustom org-link-search-must-match-exact-headline 'query-to-create + "Non-nil means internal links in Org files must exactly match a headline. +When nil, the link search tries to match a phrase with all words +in the search text." + :group 'org-link-follow + :version "24.1" + :type '(choice + (const :tag "Use fuzzy text search" nil) + (const :tag "Match only exact headline" t) + (const :tag "Match exact headline or query to create it" + query-to-create))) + +(defcustom org-link-frame-setup + '((vm . vm-visit-folder-other-frame) + (vm-imap . vm-visit-imap-folder-other-frame) + (gnus . org-gnus-no-new-news) + (file . find-file-other-window) + (wl . wl-other-frame)) + "Setup the frame configuration for following links. +When following a link with Emacs, it may often be useful to display +this link in another window or frame. This variable can be used to +set this up for the different types of links. +For VM, use any of + `vm-visit-folder' + `vm-visit-folder-other-window' + `vm-visit-folder-other-frame' +For Gnus, use any of + `gnus' + `gnus-other-frame' + `org-gnus-no-new-news' +For FILE, use any of + `find-file' + `find-file-other-window' + `find-file-other-frame' +For Wanderlust use any of + `wl' + `wl-other-frame' +For the calendar, use the variable `calendar-setup'. +For BBDB, it is currently only possible to display the matches in +another window." + :group 'org-link-follow + :type '(list + (cons (const vm) + (choice + (const vm-visit-folder) + (const vm-visit-folder-other-window) + (const vm-visit-folder-other-frame))) + (cons (const vm-imap) + (choice + (const vm-visit-imap-folder) + (const vm-visit-imap-folder-other-window) + (const vm-visit-imap-folder-other-frame))) + (cons (const gnus) + (choice + (const gnus) + (const gnus-other-frame) + (const org-gnus-no-new-news))) + (cons (const file) + (choice + (const find-file) + (const find-file-other-window) + (const find-file-other-frame))) + (cons (const wl) + (choice + (const wl) + (const wl-other-frame))))) + +(defcustom org-display-internal-link-with-indirect-buffer nil + "Non-nil means use indirect buffer to display infile links. +Activating internal links (from one location in a file to another location +in the same file) normally just jumps to the location. When the link is +activated with a \\[universal-argument] prefix (or with mouse-3), the link \ +is displayed in +another window. When this option is set, the other window actually displays +an indirect buffer clone of the current buffer, to avoid any visibility +changes to the current buffer." + :group 'org-link-follow + :type 'boolean) + +(defcustom org-open-non-existing-files nil + "Non-nil means `org-open-file' will open non-existing files. +When nil, an error will be generated. +This variable applies only to external applications because they +might choke on non-existing files. If the link is to a file that +will be opened in Emacs, the variable is ignored." + :group 'org-link-follow + :type 'boolean) + +(defcustom org-open-directory-means-index-dot-org nil + "Non-nil means a link to a directory really means to index.org. +When nil, following a directory link will run dired or open a finder/explorer +window on that directory." + :group 'org-link-follow + :type 'boolean) + +(defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s") + "Function and arguments to call for following mailto links. +This is a list with the first element being a Lisp function, and the +remaining elements being arguments to the function. In string arguments, +%a will be replaced by the address, and %s will be replaced by the subject +if one was given like in <mailto:arthur@galaxy.org::this subject>." + :group 'org-link-follow + :type '(choice + (const :tag "browse-url" (browse-url-mail "mailto:%a?subject=%s")) + (const :tag "compose-mail" (compose-mail "%a" "%s")) + (const :tag "message-mail" (message-mail "%a" "%s")) + (cons :tag "other" (function) (repeat :tag "argument" sexp)))) + +(defcustom org-confirm-shell-link-function 'yes-or-no-p + "Non-nil means ask for confirmation before executing shell links. +Shell links can be dangerous: just think about a link + + [[shell:rm -rf ~/*][Google Search]] + +This link would show up in your Org-mode document as \"Google Search\", +but really it would remove your entire home directory. +Therefore we advise against setting this variable to nil. +Just change it to `y-or-n-p' if you want to confirm with a +single keystroke rather than having to type \"yes\"." + :group 'org-link-follow + :type '(choice + (const :tag "with yes-or-no (safer)" yes-or-no-p) + (const :tag "with y-or-n (faster)" y-or-n-p) + (const :tag "no confirmation (dangerous)" nil))) +(put 'org-confirm-shell-link-function + 'safe-local-variable + #'(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) + +(defcustom org-confirm-shell-link-not-regexp "" + "A regexp to skip confirmation for shell links." + :group 'org-link-follow + :version "24.1" + :type 'regexp) + +(defcustom org-confirm-elisp-link-function 'yes-or-no-p + "Non-nil means ask for confirmation before executing Emacs Lisp links. +Elisp links can be dangerous: just think about a link + + [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] + +This link would show up in your Org-mode document as \"Google Search\", +but really it would remove your entire home directory. +Therefore we advise against setting this variable to nil. +Just change it to `y-or-n-p' if you want to confirm with a +single keystroke rather than having to type \"yes\"." + :group 'org-link-follow + :type '(choice + (const :tag "with yes-or-no (safer)" yes-or-no-p) + (const :tag "with y-or-n (faster)" y-or-n-p) + (const :tag "no confirmation (dangerous)" nil))) +(put 'org-confirm-shell-link-function + 'safe-local-variable + #'(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) + +(defcustom org-confirm-elisp-link-not-regexp "" + "A regexp to skip confirmation for Elisp links." + :group 'org-link-follow + :version "24.1" + :type 'regexp) + +(defconst org-file-apps-defaults-gnu + '((remote . emacs) + (system . mailcap) + (t . mailcap)) + "Default file applications on a UNIX or GNU/Linux system. +See `org-file-apps'.") + +(defconst org-file-apps-defaults-macosx + '((remote . emacs) + (t . "open %s") + (system . "open %s") + ("ps.gz" . "gv %s") + ("eps.gz" . "gv %s") + ("dvi" . "xdvi %s") + ("fig" . "xfig %s")) + "Default file applications on a MacOS X system. +The system \"open\" is known as a default, but we use X11 applications +for some files for which the OS does not have a good default. +See `org-file-apps'.") + +(defconst org-file-apps-defaults-windowsnt + (list + '(remote . emacs) + (cons t + (list (if (featurep 'xemacs) + 'mswindows-shell-execute + 'w32-shell-execute) + "open" 'file)) + (cons 'system + (list (if (featurep 'xemacs) + 'mswindows-shell-execute + 'w32-shell-execute) + "open" 'file))) + "Default file applications on a Windows NT system. +The system \"open\" is used for most files. +See `org-file-apps'.") + +(defcustom org-file-apps + '((auto-mode . emacs) + ("\\.mm\\'" . default) + ("\\.x?html?\\'" . default) + ("\\.pdf\\'" . default)) + "External applications for opening `file:path' items in a document. +Org-mode uses system defaults for different file types, but +you can use this variable to set the application for a given file +extension. The entries in this list are cons cells where the car identifies +files and the cdr the corresponding command. Possible values for the +file identifier are + \"string\" A string as a file identifier can be interpreted in different + ways, depending on its contents: + + - Alphanumeric characters only: + Match links with this file extension. + Example: (\"pdf\" . \"evince %s\") + to open PDFs with evince. + + - Regular expression: Match links where the + filename matches the regexp. If you want to + use groups here, use shy groups. + + Example: (\"\\.x?html\\'\" . \"firefox %s\") + (\"\\(?:xhtml\\|html\\)\" . \"firefox %s\") + to open *.html and *.xhtml with firefox. + + - Regular expression which contains (non-shy) groups: + Match links where the whole link, including \"::\", and + anything after that, matches the regexp. + In a custom command string, %1, %2, etc. are replaced with + the parts of the link that were matched by the groups. + For backwards compatibility, if a command string is given + that does not use any of the group matches, this case is + handled identically to the second one (i.e. match against + file name only). + In a custom lisp form, you can access the group matches with + (match-string n link). + + Example: (\"\\.pdf::\\(\\d+\\)\\'\" . \"evince -p %1 %s\") + to open [[file:document.pdf::5]] with evince at page 5. + + `directory' Matches a directory + `remote' Matches a remote file, accessible through tramp or efs. + Remote files most likely should be visited through Emacs + because external applications cannot handle such paths. +`auto-mode' Matches files that are matched by any entry in `auto-mode-alist', + so all files Emacs knows how to handle. Using this with + command `emacs' will open most files in Emacs. Beware that this + will also open html files inside Emacs, unless you add + (\"html\" . default) to the list as well. + t Default for files not matched by any of the other options. + `system' The system command to open files, like `open' on Windows + and Mac OS X, and mailcap under GNU/Linux. This is the command + that will be selected if you call `C-c C-o' with a double + \\[universal-argument] \\[universal-argument] prefix. + +Possible values for the command are: + `emacs' The file will be visited by the current Emacs process. + `default' Use the default application for this file type, which is the + association for t in the list, most likely in the system-specific + part. + This can be used to overrule an unwanted setting in the + system-specific variable. + `system' Use the system command for opening files, like \"open\". + This command is specified by the entry whose car is `system'. + Most likely, the system-specific version of this variable + does define this command, but you can overrule/replace it + here. + string A command to be executed by a shell; %s will be replaced + by the path to the file. + sexp A Lisp form which will be evaluated. The file path will + be available in the Lisp variable `file'. +For more examples, see the system specific constants +`org-file-apps-defaults-macosx' +`org-file-apps-defaults-windowsnt' +`org-file-apps-defaults-gnu'." + :group 'org-link-follow + :type '(repeat + (cons (choice :value "" + (string :tag "Extension") + (const :tag "System command to open files" system) + (const :tag "Default for unrecognized files" t) + (const :tag "Remote file" remote) + (const :tag "Links to a directory" directory) + (const :tag "Any files that have Emacs modes" + auto-mode)) + (choice :value "" + (const :tag "Visit with Emacs" emacs) + (const :tag "Use default" default) + (const :tag "Use the system command" system) + (string :tag "Command") + (sexp :tag "Lisp form"))))) + +(defcustom org-doi-server-url "http://dx.doi.org/" + "The URL of the DOI server." + :type 'string + :version "24.3" + :group 'org-link-follow) + +(defgroup org-refile nil + "Options concerning refiling entries in Org-mode." + :tag "Org Refile" + :group 'org) + +(defcustom org-directory "~/org" + "Directory with org files. +This is just a default location to look for Org files. There is no need +at all to put your files into this directory. It is only used in the +following situations: + +1. When a capture template specifies a target file that is not an + absolute path. The path will then be interpreted relative to + `org-directory' +2. When a capture note is filed away in an interactive way (when exiting the + note buffer with `C-1 C-c C-c'. The user is prompted for an org file, + with `org-directory' as the default path." + :group 'org-refile + :group 'org-capture + :type 'directory) + +(defcustom org-default-notes-file (convert-standard-filename "~/.notes") + "Default target for storing notes. +Used as a fall back file for org-capture.el, for templates that +do not specify a target file." + :group 'org-refile + :group 'org-capture + :type '(choice + (const :tag "Default from remember-data-file" nil) + file)) + +(defcustom org-goto-interface 'outline + "The default interface to be used for `org-goto'. +Allowed values are: +outline The interface shows an outline of the relevant file + and the correct heading is found by moving through + the outline or by searching with incremental search. +outline-path-completion Headlines in the current buffer are offered via + completion. This is the interface also used by + the refile command." + :group 'org-refile + :type '(choice + (const :tag "Outline" outline) + (const :tag "Outline-path-completion" outline-path-completion))) + +(defcustom org-goto-max-level 5 + "Maximum target level when running `org-goto' with refile interface." + :group 'org-refile + :type 'integer) + +(defcustom org-reverse-note-order nil + "Non-nil means store new notes at the beginning of a file or entry. +When nil, new notes will be filed to the end of a file or entry. +This can also be a list with cons cells of regular expressions that +are matched against file names, and values." + :group 'org-capture + :group 'org-refile + :type '(choice + (const :tag "Reverse always" t) + (const :tag "Reverse never" nil) + (repeat :tag "By file name regexp" + (cons regexp boolean)))) + +(defcustom org-log-refile nil + "Information to record when a task is refiled. + +Possible values are: + +nil Don't add anything +time Add a time stamp to the task +note Prompt for a note and add it with template `org-log-note-headings' + +This option can also be set with on a per-file-basis with + + #+STARTUP: nologrefile + #+STARTUP: logrefile + #+STARTUP: lognoterefile + +You can have local logging settings for a subtree by setting the LOGGING +property to one or more of these keywords. + +When bulk-refiling from the agenda, the value `note' is forbidden and +will temporarily be changed to `time'." + :group 'org-refile + :group 'org-progress + :version "24.1" + :type '(choice + (const :tag "No logging" nil) + (const :tag "Record timestamp" time) + (const :tag "Record timestamp with note." note))) + +(defcustom org-refile-targets nil + "Targets for refiling entries with \\[org-refile]. +This is a list of cons cells. Each cell contains: +- a specification of the files to be considered, either a list of files, + or a symbol whose function or variable value will be used to retrieve + a file name or a list of file names. If you use `org-agenda-files' for + that, all agenda files will be scanned for targets. Nil means consider + headings in the current buffer. +- A specification of how to find candidate refile targets. This may be + any of: + - a cons cell (:tag . \"TAG\") to identify refile targets by a tag. + This tag has to be present in all target headlines, inheritance will + not be considered. + - a cons cell (:todo . \"KEYWORD\") to identify refile targets by + todo keyword. + - a cons cell (:regexp . \"REGEXP\") with a regular expression matching + headlines that are refiling targets. + - a cons cell (:level . N). Any headline of level N is considered a target. + Note that, when `org-odd-levels-only' is set, level corresponds to + order in hierarchy, not to the number of stars. + - a cons cell (:maxlevel . N). Any headline with level <= N is a target. + Note that, when `org-odd-levels-only' is set, level corresponds to + order in hierarchy, not to the number of stars. + +Each element of this list generates a set of possible targets. +The union of these sets is presented (with completion) to +the user by `org-refile'. + +You can set the variable `org-refile-target-verify-function' to a function +to verify each headline found by the simple criteria above. + +When this variable is nil, all top-level headlines in the current buffer +are used, equivalent to the value `((nil . (:level . 1))'." + :group 'org-refile + :type '(repeat + (cons + (choice :value org-agenda-files + (const :tag "All agenda files" org-agenda-files) + (const :tag "Current buffer" nil) + (function) (variable) (file)) + (choice :tag "Identify target headline by" + (cons :tag "Specific tag" (const :value :tag) (string)) + (cons :tag "TODO keyword" (const :value :todo) (string)) + (cons :tag "Regular expression" (const :value :regexp) (regexp)) + (cons :tag "Level number" (const :value :level) (integer)) + (cons :tag "Max Level number" (const :value :maxlevel) (integer)))))) + +(defcustom org-refile-target-verify-function nil + "Function to verify if the headline at point should be a refile target. +The function will be called without arguments, with point at the +beginning of the headline. It should return t and leave point +where it is if the headline is a valid target for refiling. + +If the target should not be selected, the function must return nil. +In addition to this, it may move point to a place from where the search +should be continued. For example, the function may decide that the entire +subtree of the current entry should be excluded and move point to the end +of the subtree." + :group 'org-refile + :type '(choice + (const nil) + (function))) + +(defcustom org-refile-use-cache nil + "Non-nil means cache refile targets to speed up the process. +The cache for a particular file will be updated automatically when +the buffer has been killed, or when any of the marker used for flagging +refile targets no longer points at a live buffer. +If you have added new entries to a buffer that might themselves be targets, +you need to clear the cache manually by pressing `C-0 C-c C-w' or, if you +find that easier, `C-u C-u C-u C-c C-w'." + :group 'org-refile + :version "24.1" + :type 'boolean) + +(defcustom org-refile-use-outline-path nil + "Non-nil means provide refile targets as paths. +So a level 3 headline will be available as level1/level2/level3. + +When the value is `file', also include the file name (without directory) +into the path. In this case, you can also stop the completion after +the file name, to get entries inserted as top level in the file. + +When `full-file-path', include the full file path." + :group 'org-refile + :type '(choice + (const :tag "Not" nil) + (const :tag "Yes" t) + (const :tag "Start with file name" file) + (const :tag "Start with full file path" full-file-path))) + +(defcustom org-outline-path-complete-in-steps t + "Non-nil means complete the outline path in hierarchical steps. +When Org-mode uses the refile interface to select an outline path +\(see variable `org-refile-use-outline-path'), the completion of +the path can be done is a single go, or if can be done in steps down +the headline hierarchy. Going in steps is probably the best if you +do not use a special completion package like `ido' or `icicles'. +However, when using these packages, going in one step can be very +fast, while still showing the whole path to the entry." + :group 'org-refile + :type 'boolean) + +(defcustom org-refile-allow-creating-parent-nodes nil + "Non-nil means allow to create new nodes as refile targets. +New nodes are then created by adding \"/new node name\" to the completion +of an existing node. When the value of this variable is `confirm', +new node creation must be confirmed by the user (recommended). +When nil, the completion must match an existing entry. + +Note that, if the new heading is not seen by the criteria +listed in `org-refile-targets', multiple instances of the same +heading would be created by trying again to file under the new +heading." + :group 'org-refile + :type '(choice + (const :tag "Never" nil) + (const :tag "Always" t) + (const :tag "Prompt for confirmation" confirm))) + +(defcustom org-refile-active-region-within-subtree nil + "Non-nil means also refile active region within a subtree. + +By default `org-refile' doesn't allow refiling regions if they +don't contain a set of subtrees, but it might be convenient to +do so sometimes: in that case, the first line of the region is +converted to a headline before refiling." + :group 'org-refile + :version "24.1" + :type 'boolean) + +(defgroup org-todo nil + "Options concerning TODO items in Org-mode." + :tag "Org TODO" + :group 'org) + +(defgroup org-progress nil + "Options concerning Progress logging in Org-mode." + :tag "Org Progress" + :group 'org-time) + +(defvar org-todo-interpretation-widgets + '((:tag "Sequence (cycling hits every state)" sequence) + (:tag "Type (cycling directly to DONE)" type)) + "The available interpretation symbols for customizing `org-todo-keywords'. +Interested libraries should add to this list.") + +(defcustom org-todo-keywords '((sequence "TODO" "DONE")) + "List of TODO entry keyword sequences and their interpretation. +\\<org-mode-map>This is a list of sequences. + +Each sequence starts with a symbol, either `sequence' or `type', +indicating if the keywords should be interpreted as a sequence of +action steps, or as different types of TODO items. The first +keywords are states requiring action - these states will select a headline +for inclusion into the global TODO list Org-mode produces. If one of +the \"keywords\" is the vertical bar, \"|\", the remaining keywords +signify that no further action is necessary. If \"|\" is not found, +the last keyword is treated as the only DONE state of the sequence. + +The command \\[org-todo] cycles an entry through these states, and one +additional state where no keyword is present. For details about this +cycling, see the manual. + +TODO keywords and interpretation can also be set on a per-file basis with +the special #+SEQ_TODO and #+TYP_TODO lines. + +Each keyword can optionally specify a character for fast state selection +\(in combination with the variable `org-use-fast-todo-selection') +and specifiers for state change logging, using the same syntax that +is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says that +the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" +indicates to record a time stamp each time this state is selected. + +Each keyword may also specify if a timestamp or a note should be +recorded when entering or leaving the state, by adding additional +characters in the parenthesis after the keyword. This looks like this: +\"WAIT(w@/!)\". \"@\" means to add a note (with time), \"!\" means to +record only the time of the state change. With X and Y being either +\"@\" or \"!\", \"X/Y\" means use X when entering the state, and use +Y when leaving the state if and only if the *target* state does not +define X. You may omit any of the fast-selection key or X or /Y, +so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid. + +For backward compatibility, this variable may also be just a list +of keywords. In this case the interpretation (sequence or type) will be +taken from the (otherwise obsolete) variable `org-todo-interpretation'." + :group 'org-todo + :group 'org-keywords + :type '(choice + (repeat :tag "Old syntax, just keywords" + (string :tag "Keyword")) + (repeat :tag "New syntax" + (cons + (choice + :tag "Interpretation" + ;;Quick and dirty way to see + ;;`org-todo-interpretations'. This takes the + ;;place of item arguments + :convert-widget + (lambda (widget) + (widget-put widget + :args (mapcar + #'(lambda (x) + (widget-convert + (cons 'const x))) + org-todo-interpretation-widgets)) + widget)) + (repeat + (string :tag "Keyword")))))) + +(defvar org-todo-keywords-1 nil + "All TODO and DONE keywords active in a buffer.") +(make-variable-buffer-local 'org-todo-keywords-1) +(defvar org-todo-keywords-for-agenda nil) +(defvar org-done-keywords-for-agenda nil) +(defvar org-drawers-for-agenda nil) +(defvar org-todo-keyword-alist-for-agenda nil) +(defvar org-tag-alist-for-agenda nil + "Alist of all tags from all agenda files.") +(defvar org-tag-groups-alist-for-agenda nil + "Alist of all groups tags from all current agenda files.") +(defvar org-tag-groups-alist nil) +(make-variable-buffer-local 'org-tag-groups-alist) +(defvar org-agenda-contributing-files nil) +(defvar org-not-done-keywords nil) +(make-variable-buffer-local 'org-not-done-keywords) +(defvar org-done-keywords nil) +(make-variable-buffer-local 'org-done-keywords) +(defvar org-todo-heads nil) +(make-variable-buffer-local 'org-todo-heads) +(defvar org-todo-sets nil) +(make-variable-buffer-local 'org-todo-sets) +(defvar org-todo-log-states nil) +(make-variable-buffer-local 'org-todo-log-states) +(defvar org-todo-kwd-alist nil) +(make-variable-buffer-local 'org-todo-kwd-alist) +(defvar org-todo-key-alist nil) +(make-variable-buffer-local 'org-todo-key-alist) +(defvar org-todo-key-trigger nil) +(make-variable-buffer-local 'org-todo-key-trigger) + +(defcustom org-todo-interpretation 'sequence + "Controls how TODO keywords are interpreted. +This variable is in principle obsolete and is only used for +backward compatibility, if the interpretation of todo keywords is +not given already in `org-todo-keywords'. See that variable for +more information." + :group 'org-todo + :group 'org-keywords + :type '(choice (const sequence) + (const type))) + +(defcustom org-use-fast-todo-selection t + "Non-nil means use the fast todo selection scheme with C-c C-t. +This variable describes if and under what circumstances the cycling +mechanism for TODO keywords will be replaced by a single-key, direct +selection scheme. + +When nil, fast selection is never used. + +When the symbol `prefix', it will be used when `org-todo' is called +with a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and +`C-u t' in an agenda buffer. + +When t, fast selection is used by default. In this case, the prefix +argument forces cycling instead. + +In all cases, the special interface is only used if access keys have +actually been assigned by the user, i.e. if keywords in the configuration +are followed by a letter in parenthesis, like TODO(t)." + :group 'org-todo + :type '(choice + (const :tag "Never" nil) + (const :tag "By default" t) + (const :tag "Only with C-u C-c C-t" prefix))) + +(defcustom org-provide-todo-statistics t + "Non-nil means update todo statistics after insert and toggle. +ALL-HEADLINES means update todo statistics by including headlines +with no TODO keyword as well, counting them as not done. +A list of TODO keywords means the same, but skip keywords that are +not in this list. + +When this is set, todo statistics is updated in the parent of the +current entry each time a todo state is changed." + :group 'org-todo + :type '(choice + (const :tag "Yes, only for TODO entries" t) + (const :tag "Yes, including all entries" all-headlines) + (repeat :tag "Yes, for TODOs in this list" + (string :tag "TODO keyword")) + (other :tag "No TODO statistics" nil))) + +(defcustom org-hierarchical-todo-statistics t + "Non-nil means TODO statistics covers just direct children. +When nil, all entries in the subtree are considered. +This has only an effect if `org-provide-todo-statistics' is set. +To set this to nil for only a single subtree, use a COOKIE_DATA +property and include the word \"recursive\" into the value." + :group 'org-todo + :type 'boolean) + +(defcustom org-after-todo-state-change-hook nil + "Hook which is run after the state of a TODO item was changed. +The new state (a string with a TODO keyword, or nil) is available in the +Lisp variable `org-state'." + :group 'org-todo + :type 'hook) + +(defvar org-blocker-hook nil + "Hook for functions that are allowed to block a state change. + +Functions in this hook should not modify the buffer. +Each function gets as its single argument a property list, +see `org-trigger-hook' for more information about this list. + +If any of the functions in this hook returns nil, the state change +is blocked.") + +(defvar org-trigger-hook nil + "Hook for functions that are triggered by a state change. + +Each function gets as its single argument a property list with at +least the following elements: + + (:type type-of-change :position pos-at-entry-start + :from old-state :to new-state) + +Depending on the type, more properties may be present. + +This mechanism is currently implemented for: + +TODO state changes +------------------ +:type todo-state-change +:from previous state (keyword as a string), or nil, or a symbol + 'todo' or 'done', to indicate the general type of state. +:to new state, like in :from") + +(defcustom org-enforce-todo-dependencies nil + "Non-nil means undone TODO entries will block switching the parent to DONE. +Also, if a parent has an :ORDERED: property, switching an entry to DONE will +be blocked if any prior sibling is not yet done. +Finally, if the parent is blocked because of ordered siblings of its own, +the child will also be blocked." + :set (lambda (var val) + (set var val) + (if val + (add-hook 'org-blocker-hook + 'org-block-todo-from-children-or-siblings-or-parent) + (remove-hook 'org-blocker-hook + 'org-block-todo-from-children-or-siblings-or-parent))) + :group 'org-todo + :type 'boolean) + +(defcustom org-enforce-todo-checkbox-dependencies nil + "Non-nil means unchecked boxes will block switching the parent to DONE. +When this is nil, checkboxes have no influence on switching TODO states. +When non-nil, you first need to check off all check boxes before the TODO +entry can be switched to DONE. +This variable needs to be set before org.el is loaded, and you need to +restart Emacs after a change to make the change effective. The only way +to change is while Emacs is running is through the customize interface." + :set (lambda (var val) + (set var val) + (if val + (add-hook 'org-blocker-hook + 'org-block-todo-from-checkboxes) + (remove-hook 'org-blocker-hook + 'org-block-todo-from-checkboxes))) + :group 'org-todo + :type 'boolean) + +(defcustom org-treat-insert-todo-heading-as-state-change nil + "Non-nil means inserting a TODO heading is treated as state change. +So when the command \\[org-insert-todo-heading] is used, state change +logging will apply if appropriate. When nil, the new TODO item will +be inserted directly, and no logging will take place." + :group 'org-todo + :type 'boolean) + +(defcustom org-treat-S-cursor-todo-selection-as-state-change t + "Non-nil means switching TODO states with S-cursor counts as state change. +This is the default behavior. However, setting this to nil allows a +convenient way to select a TODO state and bypass any logging associated +with that." + :group 'org-todo + :type 'boolean) + +(defcustom org-todo-state-tags-triggers nil + "Tag changes that should be triggered by TODO state changes. +This is a list. Each entry is + + (state-change (tag . flag) .......) + +State-change can be a string with a state, and empty string to indicate the +state that has no TODO keyword, or it can be one of the symbols `todo' +or `done', meaning any not-done or done state, respectively." + :group 'org-todo + :group 'org-tags + :type '(repeat + (cons (choice :tag "When changing to" + (const :tag "Not-done state" todo) + (const :tag "Done state" done) + (string :tag "State")) + (repeat + (cons :tag "Tag action" + (string :tag "Tag") + (choice (const :tag "Add" t) (const :tag "Remove" nil))))))) + +(defcustom org-log-done nil + "Information to record when a task moves to the DONE state. + +Possible values are: + +nil Don't add anything, just change the keyword +time Add a time stamp to the task +note Prompt for a note and add it with template `org-log-note-headings' + +This option can also be set with on a per-file-basis with + + #+STARTUP: nologdone + #+STARTUP: logdone + #+STARTUP: lognotedone + +You can have local logging settings for a subtree by setting the LOGGING +property to one or more of these keywords." + :group 'org-todo + :group 'org-progress + :type '(choice + (const :tag "No logging" nil) + (const :tag "Record CLOSED timestamp" time) + (const :tag "Record CLOSED timestamp with note." note))) + +;; Normalize old uses of org-log-done. +(cond + ((eq org-log-done t) (setq org-log-done 'time)) + ((and (listp org-log-done) (memq 'done org-log-done)) + (setq org-log-done 'note))) + +(defcustom org-log-reschedule nil + "Information to record when the scheduling date of a tasks is modified. + +Possible values are: + +nil Don't add anything, just change the date +time Add a time stamp to the task +note Prompt for a note and add it with template `org-log-note-headings' + +This option can also be set with on a per-file-basis with + + #+STARTUP: nologreschedule + #+STARTUP: logreschedule + #+STARTUP: lognotereschedule" + :group 'org-todo + :group 'org-progress + :type '(choice + (const :tag "No logging" nil) + (const :tag "Record timestamp" time) + (const :tag "Record timestamp with note." note))) + +(defcustom org-log-redeadline nil + "Information to record when the deadline date of a tasks is modified. + +Possible values are: + +nil Don't add anything, just change the date +time Add a time stamp to the task +note Prompt for a note and add it with template `org-log-note-headings' + +This option can also be set with on a per-file-basis with + + #+STARTUP: nologredeadline + #+STARTUP: logredeadline + #+STARTUP: lognoteredeadline + +You can have local logging settings for a subtree by setting the LOGGING +property to one or more of these keywords." + :group 'org-todo + :group 'org-progress + :type '(choice + (const :tag "No logging" nil) + (const :tag "Record timestamp" time) + (const :tag "Record timestamp with note." note))) + +(defcustom org-log-note-clock-out nil + "Non-nil means record a note when clocking out of an item. +This can also be configured on a per-file basis by adding one of +the following lines anywhere in the buffer: + + #+STARTUP: lognoteclock-out + #+STARTUP: nolognoteclock-out" + :group 'org-todo + :group 'org-progress + :type 'boolean) + +(defcustom org-log-done-with-time t + "Non-nil means the CLOSED time stamp will contain date and time. +When nil, only the date will be recorded." + :group 'org-progress + :type 'boolean) + +(defcustom org-log-note-headings + '((done . "CLOSING NOTE %t") + (state . "State %-12s from %-12S %t") + (note . "Note taken on %t") + (reschedule . "Rescheduled from %S on %t") + (delschedule . "Not scheduled, was %S on %t") + (redeadline . "New deadline from %S on %t") + (deldeadline . "Removed deadline, was %S on %t") + (refile . "Refiled on %t") + (clock-out . "")) + "Headings for notes added to entries. +The value is an alist, with the car being a symbol indicating the note +context, and the cdr is the heading to be used. The heading may also be the +empty string. +%t in the heading will be replaced by a time stamp. +%T will be an active time stamp instead the default inactive one +%d will be replaced by a short-format time stamp. +%D will be replaced by an active short-format time stamp. +%s will be replaced by the new TODO state, in double quotes. +%S will be replaced by the old TODO state, in double quotes. +%u will be replaced by the user name. +%U will be replaced by the full user name. + +In fact, it is not a good idea to change the `state' entry, because +agenda log mode depends on the format of these entries." + :group 'org-todo + :group 'org-progress + :type '(list :greedy t + (cons (const :tag "Heading when closing an item" done) string) + (cons (const :tag + "Heading when changing todo state (todo sequence only)" + state) string) + (cons (const :tag "Heading when just taking a note" note) string) + (cons (const :tag "Heading when rescheduling" reschedule) string) + (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string) + (cons (const :tag "Heading when changing deadline" redeadline) string) + (cons (const :tag "Heading when deleting a deadline" deldeadline) string) + (cons (const :tag "Heading when refiling" refile) string) + (cons (const :tag "Heading when clocking out" clock-out) string))) + +(unless (assq 'note org-log-note-headings) + (push '(note . "%t") org-log-note-headings)) + +(defcustom org-log-into-drawer nil + "Non-nil means insert state change notes and time stamps into a drawer. +When nil, state changes notes will be inserted after the headline and +any scheduling and clock lines, but not inside a drawer. + +The value of this variable should be the name of the drawer to use. +LOGBOOK is proposed as the default drawer for this purpose, you can +also set this to a string to define the drawer of your choice. + +A value of t is also allowed, representing \"LOGBOOK\". + +A value of t or nil can also be set with on a per-file-basis with + + #+STARTUP: logdrawer + #+STARTUP: nologdrawer + +If this variable is set, `org-log-state-notes-insert-after-drawers' +will be ignored. + +You can set the property LOG_INTO_DRAWER to overrule this setting for +a subtree." + :group 'org-todo + :group 'org-progress + :type '(choice + (const :tag "Not into a drawer" nil) + (const :tag "LOGBOOK" t) + (string :tag "Other"))) + +(org-defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer) + +(defun org-log-into-drawer () + "Return the value of `org-log-into-drawer', but let properties overrule. +If the current entry has or inherits a LOG_INTO_DRAWER property, it will be +used instead of the default value." + (let ((p (org-entry-get nil "LOG_INTO_DRAWER" 'inherit t))) + (cond + ((not p) org-log-into-drawer) + ((equal p "nil") nil) + ((equal p "t") "LOGBOOK") + (t p)))) + +(defcustom org-log-state-notes-insert-after-drawers nil + "Non-nil means insert state change notes after any drawers in entry. +Only the drawers that *immediately* follow the headline and the +deadline/scheduled line are skipped. +When nil, insert notes right after the heading and perhaps the line +with deadline/scheduling if present. + +This variable will have no effect if `org-log-into-drawer' is +set." + :group 'org-todo + :group 'org-progress + :type 'boolean) + +(defcustom org-log-states-order-reversed t + "Non-nil means the latest state note will be directly after heading. +When nil, the state change notes will be ordered according to time. + +This option can also be set with on a per-file-basis with + + #+STARTUP: logstatesreversed + #+STARTUP: nologstatesreversed" + :group 'org-todo + :group 'org-progress + :type 'boolean) + +(defcustom org-todo-repeat-to-state nil + "The TODO state to which a repeater should return the repeating task. +By default this is the first task in a TODO sequence, or the previous state +in a TODO_TYP set. But you can specify another task here. +alternatively, set the :REPEAT_TO_STATE: property of the entry." + :group 'org-todo + :version "24.1" + :type '(choice (const :tag "Head of sequence" nil) + (string :tag "Specific state"))) + +(defcustom org-log-repeat 'time + "Non-nil means record moving through the DONE state when triggering repeat. +An auto-repeating task is immediately switched back to TODO when +marked DONE. If you are not logging state changes (by adding \"@\" +or \"!\" to the TODO keyword definition), or set `org-log-done' to +record a closing note, there will be no record of the task moving +through DONE. This variable forces taking a note anyway. + +nil Don't force a record +time Record a time stamp +note Prompt for a note and add it with template `org-log-note-headings' + +This option can also be set with on a per-file-basis with + + #+STARTUP: nologrepeat + #+STARTUP: logrepeat + #+STARTUP: lognoterepeat + +You can have local logging settings for a subtree by setting the LOGGING +property to one or more of these keywords." + :group 'org-todo + :group 'org-progress + :type '(choice + (const :tag "Don't force a record" nil) + (const :tag "Force recording the DONE state" time) + (const :tag "Force recording a note with the DONE state" note))) + + +(defgroup org-priorities nil + "Priorities in Org-mode." + :tag "Org Priorities" + :group 'org-todo) + +(defcustom org-enable-priority-commands t + "Non-nil means priority commands are active. +When nil, these commands will be disabled, so that you never accidentally +set a priority." + :group 'org-priorities + :type 'boolean) + +(defcustom org-highest-priority ?A + "The highest priority of TODO items. A character like ?A, ?B etc. +Must have a smaller ASCII number than `org-lowest-priority'." + :group 'org-priorities + :type 'character) + +(defcustom org-lowest-priority ?C + "The lowest priority of TODO items. A character like ?A, ?B etc. +Must have a larger ASCII number than `org-highest-priority'." + :group 'org-priorities + :type 'character) + +(defcustom org-default-priority ?B + "The default priority of TODO items. +This is the priority an item gets if no explicit priority is given. +When starting to cycle on an empty priority the first step in the cycle +depends on `org-priority-start-cycle-with-default'. The resulting first +step priority must not exceed the range from `org-highest-priority' to +`org-lowest-priority' which means that `org-default-priority' has to be +in this range exclusive or inclusive the range boundaries. Else the +first step refuses to set the default and the second will fall back +to (depending on the command used) the highest or lowest priority." + :group 'org-priorities + :type 'character) + +(defcustom org-priority-start-cycle-with-default t + "Non-nil means start with default priority when starting to cycle. +When this is nil, the first step in the cycle will be (depending on the +command used) one higher or lower than the default priority. +See also `org-default-priority'." + :group 'org-priorities + :type 'boolean) + +(defcustom org-get-priority-function nil + "Function to extract the priority from a string. +The string is normally the headline. If this is nil Org computes the +priority from the priority cookie like [#A] in the headline. It returns +an integer, increasing by 1000 for each priority level. +The user can set a different function here, which should take a string +as an argument and return the numeric priority." + :group 'org-priorities + :version "24.1" + :type '(choice + (const nil) + (function))) + +(defgroup org-time nil + "Options concerning time stamps and deadlines in Org-mode." + :tag "Org Time" + :group 'org) + +(defcustom org-insert-labeled-timestamps-at-point nil + "Non-nil means SCHEDULED and DEADLINE timestamps are inserted at point. +When nil, these labeled time stamps are forces into the second line of an +entry, just after the headline. When scheduling from the global TODO list, +the time stamp will always be forced into the second line." + :group 'org-time + :type 'boolean) + +(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") + "Formats for `format-time-string' which are used for time stamps. +It is not recommended to change this constant.") + +(defcustom org-time-stamp-rounding-minutes '(0 5) + "Number of minutes to round time stamps to. +These are two values, the first applies when first creating a time stamp. +The second applies when changing it with the commands `S-up' and `S-down'. +When changing the time stamp, this means that it will change in steps +of N minutes, as given by the second value. + +When a setting is 0 or 1, insert the time unmodified. Useful rounding +numbers should be factors of 60, so for example 5, 10, 15. + +When this is larger than 1, you can still force an exact time stamp by using +a double prefix argument to a time stamp command like `C-c .' or `C-c !', +and by using a prefix arg to `S-up/down' to specify the exact number +of minutes to shift." + :group 'org-time + :get #'(lambda (var) ; Make sure both elements are there + (if (integerp (default-value var)) + (list (default-value var) 5) + (default-value var))) + :type '(list + (integer :tag "when inserting times") + (integer :tag "when modifying times"))) + +;; Normalize old customizations of this variable. +(when (integerp org-time-stamp-rounding-minutes) + (setq org-time-stamp-rounding-minutes + (list org-time-stamp-rounding-minutes + org-time-stamp-rounding-minutes))) + +(defcustom org-display-custom-times nil + "Non-nil means overlay custom formats over all time stamps. +The formats are defined through the variable `org-time-stamp-custom-formats'. +To turn this on on a per-file basis, insert anywhere in the file: + #+STARTUP: customtime" + :group 'org-time + :set 'set-default + :type 'sexp) +(make-variable-buffer-local 'org-display-custom-times) + +(defcustom org-time-stamp-custom-formats + '("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american + "Custom formats for time stamps. See `format-time-string' for the syntax. +These are overlaid over the default ISO format if the variable +`org-display-custom-times' is set. Time like %H:%M should be at the +end of the second format. The custom formats are also honored by export +commands, if custom time display is turned on at the time of export." + :group 'org-time + :type 'sexp) + +(defun org-time-stamp-format (&optional long inactive) + "Get the right format for a time string." + (let ((f (if long (cdr org-time-stamp-formats) + (car org-time-stamp-formats)))) + (if inactive + (concat "[" (substring f 1 -1) "]") + f))) + +(defcustom org-time-clocksum-format + '(:days "%dd " :hours "%d" :require-hours t :minutes ":%02d" :require-minutes t) + "The format string used when creating CLOCKSUM lines. +This is also used when Org mode generates a time duration. + +The value can be a single format string containing two +%-sequences, which will be filled with the number of hours and +minutes in that order. + +Alternatively, the value can be a plist associating any of the +keys :years, :months, :weeks, :days, :hours or :minutes with +format strings. The time duration is formatted using only the +time components that are needed and concatenating the results. +If a time unit in absent, it falls back to the next smallest +unit. + +The keys :require-years, :require-months, :require-days, +:require-weeks, :require-hours, :require-minutes are also +meaningful. A non-nil value for these keys indicates that the +corresponding time component should always be included, even if +its value is 0. + + +For example, + + \(:days \"%dd\" :hours \"%d\" :require-hours t :minutes \":%02d\" + :require-minutes t) + +means durations longer than a day will be expressed in days, +hours and minutes, and durations less than a day will always be +expressed in hours and minutes (even for durations less than an +hour). + +The value + + \(:days \"%dd\" :minutes \"%dm\") + +means durations longer than a day will be expressed in days and +minutes, and durations less than a day will be expressed entirely +in minutes (even for durations longer than an hour)." + :group 'org-time + :group 'org-clock + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice (string :tag "Format string") + (set :tag "Plist" + (group :inline t (const :tag "Years" :years) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show years" :require-years) + (const t)) + (group :inline t (const :tag "Months" :months) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show months" :require-months) + (const t)) + (group :inline t (const :tag "Weeks" :weeks) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show weeks" :require-weeks) + (const t)) + (group :inline t (const :tag "Days" :days) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show days" :require-days) + (const t)) + (group :inline t (const :tag "Hours" :hours) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show hours" :require-hours) + (const t)) + (group :inline t (const :tag "Minutes" :minutes) + (string :tag "Format string")) + (group :inline t + (const :tag "Always show minutes" :require-minutes) + (const t))))) + +(defcustom org-time-clocksum-use-fractional nil + "When non-nil, \\[org-clock-display] uses fractional times. +See `org-time-clocksum-format' for more on time clock formats." + :group 'org-time + :group 'org-clock + :version "24.3" + :type 'boolean) + +(defcustom org-time-clocksum-use-effort-durations nil + "When non-nil, \\[org-clock-display] uses effort durations. +E.g. by default, one day is considered to be a 8 hours effort, +so a task that has been clocked for 16 hours will be displayed +as during 2 days in the clock display or in the clocktable. + +See `org-effort-durations' on how to set effort durations +and `org-time-clocksum-format' for more on time clock formats." + :group 'org-time + :group 'org-clock + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-time-clocksum-fractional-format "%.2f" + "The format string used when creating CLOCKSUM lines, +or when Org mode generates a time duration, if +`org-time-clocksum-use-fractional' is enabled. + +The value can be a single format string containing one +%-sequence, which will be filled with the number of hours as +a float. + +Alternatively, the value can be a plist associating any of the +keys :years, :months, :weeks, :days, :hours or :minutes with +a format string. The time duration is formatted using the +largest time unit which gives a non-zero integer part. If all +specified formats have zero integer part, the smallest time unit +is used." + :group 'org-time + :type '(choice (string :tag "Format string") + (set (group :inline t (const :tag "Years" :years) + (string :tag "Format string")) + (group :inline t (const :tag "Months" :months) + (string :tag "Format string")) + (group :inline t (const :tag "Weeks" :weeks) + (string :tag "Format string")) + (group :inline t (const :tag "Days" :days) + (string :tag "Format string")) + (group :inline t (const :tag "Hours" :hours) + (string :tag "Format string")) + (group :inline t (const :tag "Minutes" :minutes) + (string :tag "Format string"))))) + +(defcustom org-deadline-warning-days 14 + "Number of days before expiration during which a deadline becomes active. +This variable governs the display in sparse trees and in the agenda. +When 0 or negative, it means use this number (the absolute value of it) +even if a deadline has a different individual lead time specified. + +Custom commands can set this variable in the options section." + :group 'org-time + :group 'org-agenda-daily/weekly + :type 'integer) + +(defcustom org-scheduled-delay-days 0 + "Number of days before a scheduled item becomes active. +This variable governs the display in sparse trees and in the agenda. +The default value (i.e. 0) means: don't delay scheduled item. +When negative, it means use this number (the absolute value of it) +even if a scheduled item has a different individual delay time +specified. + +Custom commands can set this variable in the options section." + :group 'org-time + :group 'org-agenda-daily/weekly + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +(defcustom org-read-date-prefer-future t + "Non-nil means assume future for incomplete date input from user. +This affects the following situations: +1. The user gives a month but not a year. + For example, if it is April and you enter \"feb 2\", this will be read + as Feb 2, *next* year. \"May 5\", however, will be this year. +2. The user gives a day, but no month. + For example, if today is the 15th, and you enter \"3\", Org-mode will + read this as the third of *next* month. However, if you enter \"17\", + it will be considered as *this* month. + +If you set this variable to the symbol `time', then also the following +will work: + +3. If the user gives a time. + If the time is before now, it will be interpreted as tomorrow. + +Currently none of this works for ISO week specifications. + +When this option is nil, the current day, month and year will always be +used as defaults. + +See also `org-agenda-jump-prefer-future'." + :group 'org-time + :type '(choice + (const :tag "Never" nil) + (const :tag "Check month and day" t) + (const :tag "Check month, day, and time" time))) + +(defcustom org-agenda-jump-prefer-future 'org-read-date-prefer-future + "Should the agenda jump command prefer the future for incomplete dates? +The default is to do the same as configured in `org-read-date-prefer-future'. +But you can also set a deviating value here. +This may t or nil, or the symbol `org-read-date-prefer-future'." + :group 'org-agenda + :group 'org-time + :version "24.1" + :type '(choice + (const :tag "Use org-read-date-prefer-future" + org-read-date-prefer-future) + (const :tag "Never" nil) + (const :tag "Always" t))) + +(defcustom org-read-date-force-compatible-dates t + "Should date/time prompt force dates that are guaranteed to work in Emacs? + +Depending on the system Emacs is running on, certain dates cannot +be represented with the type used internally to represent time. +Dates between 1970-1-1 and 2038-1-1 can always be represented +correctly. Some systems allow for earlier dates, some for later, +some for both. One way to find out it to insert any date into an +Org buffer, putting the cursor on the year and hitting S-up and +S-down to test the range. + +When this variable is set to t, the date/time prompt will not let +you specify dates outside the 1970-2037 range, so it is certain that +these dates will work in whatever version of Emacs you are +running, and also that you can move a file from one Emacs implementation +to another. WHenever Org is forcing the year for you, it will display +a message and beep. + +When this variable is nil, Org will check if the date is +representable in the specific Emacs implementation you are using. +If not, it will force a year, usually the current year, and beep +to remind you. Currently this setting is not recommended because +the likelihood that you will open your Org files in an Emacs that +has limited date range is not negligible. + +A workaround for this problem is to use diary sexp dates for time +stamps outside of this range." + :group 'org-time + :version "24.1" + :type 'boolean) + +(defcustom org-read-date-display-live t + "Non-nil means display current interpretation of date prompt live. +This display will be in an overlay, in the minibuffer." + :group 'org-time + :type 'boolean) + +(defcustom org-read-date-popup-calendar t + "Non-nil means pop up a calendar when prompting for a date. +In the calendar, the date can be selected with mouse-1. However, the +minibuffer will also be active, and you can simply enter the date as well. +When nil, only the minibuffer will be available." + :group 'org-time + :type 'boolean) +(org-defvaralias 'org-popup-calendar-for-date-prompt + 'org-read-date-popup-calendar) + +(make-obsolete-variable + 'org-read-date-minibuffer-setup-hook + "Set `org-read-date-minibuffer-local-map' instead." "24.4") +(defcustom org-read-date-minibuffer-setup-hook nil + "Hook to be used to set up keys for the date/time interface. +Add key definitions to `minibuffer-local-map', which will be a +temporary copy. + +WARNING: This option is obsolete, you should use +`org-read-date-minibuffer-local-map' to set up keys." + :group 'org-time + :type 'hook) + +(defcustom org-extend-today-until 0 + "The hour when your day really ends. Must be an integer. +This has influence for the following applications: +- When switching the agenda to \"today\". It it is still earlier than + the time given here, the day recognized as TODAY is actually yesterday. +- When a date is read from the user and it is still before the time given + here, the current date and time will be assumed to be yesterday, 23:59. + Also, timestamps inserted in capture templates follow this rule. + +IMPORTANT: This is a feature whose implementation is and likely will +remain incomplete. Really, it is only here because past midnight seems to +be the favorite working time of John Wiegley :-)" + :group 'org-time + :type 'integer) + +(defcustom org-use-effective-time nil + "If non-nil, consider `org-extend-today-until' when creating timestamps. +For example, if `org-extend-today-until' is 8, and it's 4am, then the +\"effective time\" of any timestamps between midnight and 8am will be +23:59 of the previous day." + :group 'org-time + :version "24.1" + :type 'boolean) + +(defcustom org-use-last-clock-out-time-as-effective-time nil + "When non-nil, use the last clock out time for `org-todo'. +Note that this option has precedence over the combined use of +`org-use-effective-time' and `org-extend-today-until'." + :group 'org-time + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-edit-timestamp-down-means-later nil + "Non-nil means S-down will increase the time in a time stamp. +When nil, S-up will increase." + :group 'org-time + :type 'boolean) + +(defcustom org-calendar-follow-timestamp-change t + "Non-nil means make the calendar window follow timestamp changes. +When a timestamp is modified and the calendar window is visible, it will be +moved to the new date." + :group 'org-time + :type 'boolean) + +(defgroup org-tags nil + "Options concerning tags in Org-mode." + :tag "Org Tags" + :group 'org) + +(defcustom org-tag-alist nil + "List of tags allowed in Org-mode files. +When this list is nil, Org-mode will base TAG input on what is already in the +buffer. +The value of this variable is an alist, the car of each entry must be a +keyword as a string, the cdr may be a character that is used to select +that tag through the fast-tag-selection interface. +See the manual for details." + :group 'org-tags + :type '(repeat + (choice + (cons (string :tag "Tag name") + (character :tag "Access char")) + (list :tag "Start radio group" + (const :startgroup) + (option (string :tag "Group description"))) + (list :tag "Group tags delimiter" + (const :grouptags)) + (list :tag "End radio group" + (const :endgroup) + (option (string :tag "Group description"))) + (const :tag "New line" (:newline))))) + +(defcustom org-tag-persistent-alist nil + "List of tags that will always appear in all Org-mode files. +This is in addition to any in buffer settings or customizations +of `org-tag-alist'. +When this list is nil, Org-mode will base TAG input on `org-tag-alist'. +The value of this variable is an alist, the car of each entry must be a +keyword as a string, the cdr may be a character that is used to select +that tag through the fast-tag-selection interface. +See the manual for details. +To disable these tags on a per-file basis, insert anywhere in the file: + #+STARTUP: noptag" + :group 'org-tags + :type '(repeat + (choice + (cons (string :tag "Tag name") + (character :tag "Access char")) + (const :tag "Start radio group" (:startgroup)) + (const :tag "Group tags delimiter" (:grouptags)) + (const :tag "End radio group" (:endgroup)) + (const :tag "New line" (:newline))))) + +(defcustom org-complete-tags-always-offer-all-agenda-tags nil + "If non-nil, always offer completion for all tags of all agenda files. +Instead of customizing this variable directly, you might want to +set it locally for capture buffers, because there no list of +tags in that file can be created dynamically (there are none). + + (add-hook 'org-capture-mode-hook + (lambda () + (set (make-local-variable + 'org-complete-tags-always-offer-all-agenda-tags) + t)))" + :group 'org-tags + :version "24.1" + :type 'boolean) + +(defvar org-file-tags nil + "List of tags that can be inherited by all entries in the file. +The tags will be inherited if the variable `org-use-tag-inheritance' +says they should be. +This variable is populated from #+FILETAGS lines.") + +(defcustom org-use-fast-tag-selection 'auto + "Non-nil means use fast tag selection scheme. +This is a special interface to select and deselect tags with single keys. +When nil, fast selection is never used. +When the symbol `auto', fast selection is used if and only if selection +characters for tags have been configured, either through the variable +`org-tag-alist' or through a #+TAGS line in the buffer. +When t, fast selection is always used and selection keys are assigned +automatically if necessary." + :group 'org-tags + :type '(choice + (const :tag "Always" t) + (const :tag "Never" nil) + (const :tag "When selection characters are configured" auto))) + +(defcustom org-fast-tag-selection-single-key nil + "Non-nil means fast tag selection exits after first change. +When nil, you have to press RET to exit it. +During fast tag 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-tags + :type '(choice + (const :tag "No" nil) + (const :tag "Yes" t) + (const :tag "Expert" expert))) + +(defvar org-fast-tag-selection-include-todo nil + "Non-nil means fast tags selection interface will also offer TODO states. +This is an undocumented feature, you should not rely on it.") + +(defcustom org-tags-column (if (featurep 'xemacs) -76 -77) + "The column to which tags should be indented in a headline. +If this number is positive, it specifies the column. If it is negative, +it means that the tags should be flushright to that column. For example, +-80 works well for a normal 80 character screen. +When 0, place tags directly after headline text, with only one space in +between." + :group 'org-tags + :type 'integer) + +(defcustom org-auto-align-tags t + "Non-nil keeps tags aligned when modifying headlines. +Some operations (i.e. demoting) change the length of a headline and +therefore shift the tags around. With this option turned on, after +each such operation the tags are again aligned to `org-tags-column'." + :group 'org-tags + :type 'boolean) + +(defcustom org-use-tag-inheritance t + "Non-nil means tags in levels apply also for sublevels. +When nil, only the tags directly given in a specific line apply there. +This may also be a list of tags that should be inherited, or a regexp that +matches tags that should be inherited. Additional control is possible +with the variable `org-tags-exclude-from-inheritance' which gives an +explicit list of tags to be excluded from inheritance, even if the value of +`org-use-tag-inheritance' would select it for inheritance. + +If this option is t, a match early-on in a tree can lead to a large +number of matches in the subtree when constructing the agenda or creating +a sparse tree. If you only want to see the first match in a tree during +a search, check out the variable `org-tags-match-list-sublevels'." + :group 'org-tags + :type '(choice + (const :tag "Not" nil) + (const :tag "Always" t) + (repeat :tag "Specific tags" (string :tag "Tag")) + (regexp :tag "Tags matched by regexp"))) + +(defcustom org-tags-exclude-from-inheritance nil + "List of tags that should never be inherited. +This is a way to exclude a few tags from inheritance. For way to do +the opposite, to actively allow inheritance for selected tags, +see the variable `org-use-tag-inheritance'." + :group 'org-tags + :type '(repeat (string :tag "Tag"))) + +(defun org-tag-inherit-p (tag) + "Check if TAG is one that should be inherited." + (cond + ((member tag org-tags-exclude-from-inheritance) nil) + ((eq org-use-tag-inheritance t) t) + ((not org-use-tag-inheritance) nil) + ((stringp org-use-tag-inheritance) + (string-match org-use-tag-inheritance tag)) + ((listp org-use-tag-inheritance) + (member tag org-use-tag-inheritance)) + (t (error "Invalid setting of `org-use-tag-inheritance'")))) + +(defcustom org-tags-match-list-sublevels t + "Non-nil means list also sublevels of headlines matching a search. +This variable applies to tags/property searches, and also to stuck +projects because this search is based on a tags match as well. + +When set to the symbol `indented', sublevels are indented with +leading dots. + +Because of tag inheritance (see variable `org-use-tag-inheritance'), +the sublevels of a headline matching a tag search often also match +the same search. Listing all of them can create very long lists. +Setting this variable to nil causes subtrees of a match to be skipped. + +This variable is semi-obsolete and probably should always be true. It +is better to limit inheritance to certain tags using the variables +`org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'." + :group 'org-tags + :type '(choice + (const :tag "No, don't list them" nil) + (const :tag "Yes, do list them" t) + (const :tag "List them, indented with leading dots" indented))) + +(defcustom org-tags-sort-function nil + "When set, tags are sorted using this function as a comparator." + :group 'org-tags + :type '(choice + (const :tag "No sorting" nil) + (const :tag "Alphabetical" string<) + (const :tag "Reverse alphabetical" string>) + (function :tag "Custom function" nil))) + +(defvar org-tags-history nil + "History of minibuffer reads for tags.") +(defvar org-last-tags-completion-table nil + "The last used completion table for tags.") +(defvar org-after-tags-change-hook nil + "Hook that is run after the tags in a line have changed.") + +(defgroup org-properties nil + "Options concerning properties in Org-mode." + :tag "Org Properties" + :group 'org) + +(defcustom org-property-format "%-10s %s" + "How property key/value pairs should be formatted by `indent-line'. +When `indent-line' hits a property definition, it will format the line +according to this format, mainly to make sure that the values are +lined-up with respect to each other." + :group 'org-properties + :type 'string) + +(defcustom org-properties-postprocess-alist nil + "Alist of properties and functions to adjust inserted values. +Elements of this alist must be of the form + + ([string] [function]) + +where [string] must be a property name and [function] must be a +lambda expression: this lambda expression must take one argument, +the value to adjust, and return the new value as a string. + +For example, this element will allow the property \"Remaining\" +to be updated wrt the relation between the \"Effort\" property +and the clock summary: + + ((\"Remaining\" (lambda(value) + (let ((clocksum (org-clock-sum-current-item)) + (effort (org-duration-string-to-minutes + (org-entry-get (point) \"Effort\")))) + (org-minutes-to-clocksum-string (- effort clocksum))))))" + :group 'org-properties + :version "24.1" + :type '(alist :key-type (string :tag "Property") + :value-type (function :tag "Function"))) + +(defcustom org-use-property-inheritance nil + "Non-nil means properties apply also for sublevels. + +This setting is chiefly used during property searches. Turning it on can +cause significant overhead when doing a search, which is why it is not +on by default. + +When nil, only the properties directly given in the current entry count. +When t, every property is inherited. The value may also be a list of +properties that should have inheritance, or a regular expression matching +properties that should be inherited. + +However, note that some special properties use inheritance under special +circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS, +and the properties ending in \"_ALL\" when they are used as descriptor +for valid values of a property. + +Note for programmers: +When querying an entry with `org-entry-get', you can control if inheritance +should be used. By default, `org-entry-get' looks only at the local +properties. You can request inheritance by setting the inherit argument +to t (to force inheritance) or to `selective' (to respect the setting +in this variable)." + :group 'org-properties + :type '(choice + (const :tag "Not" nil) + (const :tag "Always" t) + (repeat :tag "Specific properties" (string :tag "Property")) + (regexp :tag "Properties matched by regexp"))) + +(defun org-property-inherit-p (property) + "Check if PROPERTY is one that should be inherited." + (cond + ((eq org-use-property-inheritance t) t) + ((not org-use-property-inheritance) nil) + ((stringp org-use-property-inheritance) + (string-match org-use-property-inheritance property)) + ((listp org-use-property-inheritance) + (member property org-use-property-inheritance)) + (t (error "Invalid setting of `org-use-property-inheritance'")))) + +(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" + "The default column format, if no other format has been defined. +This variable can be set on the per-file basis by inserting a line + +#+COLUMNS: %25ITEM ....." + :group 'org-properties + :type 'string) + +(defcustom org-columns-ellipses ".." + "The ellipses to be used when a field in column view is truncated. +When this is the empty string, as many characters as possible are shown, +but then there will be no visual indication that the field has been truncated. +When this is a string of length N, the last N characters of a truncated +field are replaced by this string. If the column is narrower than the +ellipses string, only part of the ellipses string will be shown." + :group 'org-properties + :type 'string) + +(defcustom org-columns-modify-value-for-display-function nil + "Function that modifies values for display in column view. +For example, it can be used to cut out a certain part from a time stamp. +The function must take 2 arguments: + +column-title The title of the column (*not* the property name) +value The value that should be modified. + +The function should return the value that should be displayed, +or nil if the normal value should be used." + :group 'org-properties + :type '(choice (const nil) (function))) + +(defcustom org-effort-property "Effort" + "The property that is being used to keep track of effort estimates. +Effort estimates given in this property need to have the format H:MM." + :group 'org-properties + :group 'org-progress + :type '(string :tag "Property")) + +(defconst org-global-properties-fixed + '(("VISIBILITY_ALL" . "folded children content all") + ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto")) + "List of property/value pairs that can be inherited by any entry. + +These are fixed values, for the preset properties. The user variable +that can be used to add to this list is `org-global-properties'. + +The entries in this list are cons cells where the car is a property +name and cdr is a string with the value. If the value represents +multiple items like an \"_ALL\" property, separate the items by +spaces.") + +(defcustom org-global-properties nil + "List of property/value pairs that can be inherited by any entry. + +This list will be combined with the constant `org-global-properties-fixed'. + +The entries in this list are cons cells where the car is a property +name and cdr is a string with the value. + +You can set buffer-local values for the same purpose in the variable +`org-file-properties' this by adding lines like + +#+PROPERTY: NAME VALUE" + :group 'org-properties + :type '(repeat + (cons (string :tag "Property") + (string :tag "Value")))) + +(defvar org-file-properties nil + "List of property/value pairs that can be inherited by any entry. +Valid for the current buffer. +This variable is populated from #+PROPERTY lines.") +(make-variable-buffer-local 'org-file-properties) + +(defgroup org-agenda nil + "Options concerning agenda views in Org-mode." + :tag "Org Agenda" + :group 'org) + +(defvar org-category nil + "Variable used by org files to set a category for agenda display. +Such files should use a file variable to set it, for example + +# -*- mode: org; org-category: \"ELisp\" + +or contain a special line + +#+CATEGORY: ELisp + +If the file does not specify a category, then file's base name +is used instead.") +(make-variable-buffer-local 'org-category) +(put 'org-category 'safe-local-variable #'(lambda (x) (or (symbolp x) (stringp x)))) + +(defcustom org-agenda-files nil + "The files to be used for agenda display. +Entries may be added to this list with \\[org-agenda-file-to-front] and removed with +\\[org-remove-file]. You can also use customize to edit the list. + +If an entry is a directory, all files in that directory that are matched by +`org-agenda-file-regexp' will be part of the file list. + +If the value of the variable is not a list but a single file name, then +the list of agenda files is actually stored and maintained in that file, one +agenda file per line. In this file paths can be given relative to +`org-directory'. Tilde expansion and environment variable substitution +are also made." + :group 'org-agenda + :type '(choice + (repeat :tag "List of files and directories" file) + (file :tag "Store list in a file\n" :value "~/.agenda_files"))) + +(defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'" + "Regular expression to match files for `org-agenda-files'. +If any element in the list in that variable contains a directory instead +of a normal file, all files in that directory that are matched by this +regular expression will be included." + :group 'org-agenda + :type 'regexp) + +(defcustom org-agenda-text-search-extra-files nil + "List of extra files to be searched by text search commands. +These files will be searched in addition to the agenda files by the +commands `org-search-view' (`C-c a s') and `org-occur-in-agenda-files'. +Note that these files will only be searched for text search commands, +not for the other agenda views like todo lists, tag searches or the weekly +agenda. This variable is intended to list notes and possibly archive files +that should also be searched by these two commands. +In fact, if the first element in the list is the symbol `agenda-archives', +then all archive files of all agenda files will be added to the search +scope." + :group 'org-agenda + :type '(set :greedy t + (const :tag "Agenda Archives" agenda-archives) + (repeat :inline t (file)))) + +(org-defvaralias 'org-agenda-multi-occur-extra-files + 'org-agenda-text-search-extra-files) + +(defcustom org-agenda-skip-unavailable-files nil + "Non-nil means to just skip non-reachable files in `org-agenda-files'. +A nil value means to remove them, after a query, from the list." + :group 'org-agenda + :type 'boolean) + +(defcustom org-calendar-to-agenda-key [?c] + "The key to be installed in `calendar-mode-map' for switching to the agenda. +The command `org-calendar-goto-agenda' will be bound to this key. The +default is the character `c' because then `c' can be used to switch back and +forth between agenda and calendar." + :group 'org-agenda + :type 'sexp) + +(defcustom org-calendar-insert-diary-entry-key [?i] + "The key to be installed in `calendar-mode-map' for adding diary entries. +This option is irrelevant until `org-agenda-diary-file' has been configured +to point to an Org-mode file. When that is the case, the command +`org-agenda-diary-entry' will be bound to the key given here, by default +`i'. In the calendar, `i' normally adds entries to `diary-file'. So +if you want to continue doing this, you need to change this to a different +key." + :group 'org-agenda + :type 'sexp) + +(defcustom org-agenda-diary-file 'diary-file + "File to which to add new entries with the `i' key in agenda and calendar. +When this is the symbol `diary-file', the functionality in the Emacs +calendar will be used to add entries to the `diary-file'. But when this +points to a file, `org-agenda-diary-entry' will be used instead." + :group 'org-agenda + :type '(choice + (const :tag "The standard Emacs diary file" diary-file) + (file :tag "Special Org file diary entries"))) + +(eval-after-load "calendar" + '(progn + (org-defkey calendar-mode-map org-calendar-to-agenda-key + 'org-calendar-goto-agenda) + (add-hook 'calendar-mode-hook + (lambda () + (unless (eq org-agenda-diary-file 'diary-file) + (define-key calendar-mode-map + org-calendar-insert-diary-entry-key + 'org-agenda-diary-entry)))))) + +(defgroup org-latex nil + "Options for embedding LaTeX code into Org-mode." + :tag "Org LaTeX" + :group 'org) + +(defcustom org-format-latex-options + '(:foreground default :background default :scale 1.0 + :html-foreground "Black" :html-background "Transparent" + :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) + "Options for creating images from LaTeX fragments. +This is a property list with the following properties: +:foreground the foreground color for images embedded in Emacs, e.g. \"Black\". + `default' means use the foreground of the default face. + `auto' means use the foreground from the text face. +:background the background color, or \"Transparent\". + `default' means use the background of the default face. + `auto' means use the background from the text face. +:scale a scaling factor for the size of the images, to get more pixels +:html-foreground, :html-background, :html-scale + the same numbers for HTML export. +:matchers a list indicating which matchers should be used to + find LaTeX fragments. Valid members of this list are: + \"begin\" find environments + \"$1\" find single characters surrounded by $.$ + \"$\" find math expressions surrounded by $...$ + \"$$\" find math expressions surrounded by $$....$$ + \"\\(\" find math expressions surrounded by \\(...\\) + \"\\=\\[\" find math expressions surrounded by \\=\\[...\\]" + :group 'org-latex + :type 'plist) + +(defcustom org-format-latex-signal-error t + "Non-nil means signal an error when image creation of LaTeX snippets fails. +When nil, just push out a message." + :group 'org-latex + :version "24.1" + :type 'boolean) + +(defcustom org-latex-to-mathml-jar-file nil + "Value of\"%j\" in `org-latex-to-mathml-convert-command'. +Use this to specify additional executable file say a jar file. + +When using MathToWeb as the converter, specify the full-path to +your mathtoweb.jar file." + :group 'org-latex + :version "24.1" + :type '(choice + (const :tag "None" nil) + (file :tag "JAR file" :must-match t))) + +(defcustom org-latex-to-mathml-convert-command nil + "Command to convert LaTeX fragments to MathML. +Replace format-specifiers in the command as noted below and use +`shell-command' to convert LaTeX to MathML. +%j: Executable file in fully expanded form as specified by + `org-latex-to-mathml-jar-file'. +%I: Input LaTeX file in fully expanded form +%o: Output MathML file +This command is used by `org-create-math-formula'. + +When using MathToWeb as the converter, set this to +\"java -jar %j -unicode -force -df %o %I\"." + :group 'org-latex + :version "24.1" + :type '(choice + (const :tag "None" nil) + (string :tag "\nShell command"))) + +(defcustom org-latex-create-formula-image-program 'dvipng + "Program to convert LaTeX fragments with. + +dvipng Process the LaTeX fragments to dvi file, then convert + dvi files to png files using dvipng. + This will also include processing of non-math environments. +imagemagick Convert the LaTeX fragments to pdf files and use imagemagick + to convert pdf files to png files" + :group 'org-latex + :version "24.1" + :type '(choice + (const :tag "dvipng" dvipng) + (const :tag "imagemagick" imagemagick))) + +(defcustom org-latex-preview-ltxpng-directory "ltxpng/" + "Path to store latex preview images. +A relative path here creates many directories relative to the +processed org files paths. An absolute path puts all preview +images at the same place." + :group 'org-latex + :version "24.3" + :type 'string) + +(defun org-format-latex-mathml-available-p () + "Return t if `org-latex-to-mathml-convert-command' is usable." + (save-match-data + (when (and (boundp 'org-latex-to-mathml-convert-command) + org-latex-to-mathml-convert-command) + (let ((executable (car (split-string + org-latex-to-mathml-convert-command)))) + (when (executable-find executable) + (if (string-match + "%j" org-latex-to-mathml-convert-command) + (file-readable-p org-latex-to-mathml-jar-file) + t)))))) + +(defcustom org-format-latex-header "\\documentclass{article} +\\usepackage[usenames]{color} +\[PACKAGES] +\[DEFAULT-PACKAGES] +\\pagestyle{empty} % do not remove +% The settings below are copied from fullpage.sty +\\setlength{\\textwidth}{\\paperwidth} +\\addtolength{\\textwidth}{-3cm} +\\setlength{\\oddsidemargin}{1.5cm} +\\addtolength{\\oddsidemargin}{-2.54cm} +\\setlength{\\evensidemargin}{\\oddsidemargin} +\\setlength{\\textheight}{\\paperheight} +\\addtolength{\\textheight}{-\\headheight} +\\addtolength{\\textheight}{-\\headsep} +\\addtolength{\\textheight}{-\\footskip} +\\addtolength{\\textheight}{-3cm} +\\setlength{\\topmargin}{1.5cm} +\\addtolength{\\topmargin}{-2.54cm}" + "The document header used for processing LaTeX fragments. +It is imperative that this header make sure that no page number +appears on the page. The package defined in the variables +`org-latex-default-packages-alist' and `org-latex-packages-alist' +will either replace the placeholder \"[PACKAGES]\" in this +header, or they will be appended." + :group 'org-latex + :type 'string) + +(defun org-set-packages-alist (var val) + "Set the packages alist and make sure it has 3 elements per entry." + (set var (mapcar (lambda (x) + (if (and (consp x) (= (length x) 2)) + (list (car x) (nth 1 x) t) + x)) + val))) + +(defun org-get-packages-alist (var) + "Get the packages alist and make sure it has 3 elements per entry." + (mapcar (lambda (x) + (if (and (consp x) (= (length x) 2)) + (list (car x) (nth 1 x) t) + x)) + (default-value var))) + +(defcustom org-latex-default-packages-alist + '(("AUTO" "inputenc" t) + ("T1" "fontenc" t) + ("" "fixltx2e" nil) + ("" "graphicx" t) + ("" "longtable" nil) + ("" "float" nil) + ("" "wrapfig" nil) + ("" "rotating" nil) + ("normalem" "ulem" t) + ("" "amsmath" t) + ("" "textcomp" t) + ("" "marvosym" t) + ("" "wasysym" t) + ("" "amssymb" t) + ("" "hyperref" nil) + "\\tolerance=1000") + "Alist of default packages to be inserted in the header. + +Change this only if one of the packages here causes an +incompatibility with another package you are using. + +The packages in this list are needed by one part or another of +Org mode to function properly: + +- inputenc, fontenc: for basic font and character selection +- fixltx2e: Important patches of LaTeX itself +- graphicx: for including images +- longtable: For multipage tables +- float, wrapfig: for figure placement +- rotating: for sideways figures and tables +- ulem: for underline and strike-through +- amsmath: for subscript and superscript and math environments +- textcomp, marvosymb, wasysym, amssymb: for various symbols used + for interpreting the entities in `org-entities'. You can skip + some of these packages if you don't use any of their symbols. +- hyperref: for cross references + +Therefore you should not modify this variable unless you know +what you are doing. The one reason to change it anyway is that +you might be loading some other package that conflicts with one +of the default packages. Each element is either a cell or +a string. + +A cell is of the format: + + \( \"options\" \"package\" SNIPPET-FLAG). + +If SNIPPET-FLAG is non-nil, the package also needs to be included +when compiling LaTeX snippets into images for inclusion into +non-LaTeX output. + +A string will be inserted as-is in the header of the document." + :group 'org-latex + :group 'org-export-latex + :set 'org-set-packages-alist + :get 'org-get-packages-alist + :version "24.1" + :type '(repeat + (choice + (list :tag "options/package pair" + (string :tag "options") + (string :tag "package") + (boolean :tag "Snippet")) + (string :tag "A line of LaTeX")))) + +(defcustom org-latex-packages-alist nil + "Alist of packages to be inserted in every LaTeX header. + +These will be inserted after `org-latex-default-packages-alist'. +Each element is either a cell or a string. + +A cell is of the format: + + \(\"options\" \"package\" SNIPPET-FLAG) + +SNIPPET-FLAG, when non-nil, indicates that this package is also +needed when turning LaTeX snippets into images for inclusion into +non-LaTeX output. + +A string will be inserted as-is in the header of the document. + +Make sure that you only list packages here which: + + - you want in every file; + - do not conflict with the setup in `org-format-latex-header'; + - do not conflict with the default packages in + `org-latex-default-packages-alist'." + :group 'org-latex + :group 'org-export-latex + :set 'org-set-packages-alist + :get 'org-get-packages-alist + :type '(repeat + (choice + (list :tag "options/package pair" + (string :tag "options") + (string :tag "package") + (boolean :tag "Snippet")) + (string :tag "A line of LaTeX")))) + +(defgroup org-appearance nil + "Settings for Org-mode appearance." + :tag "Org Appearance" + :group 'org) + +(defcustom org-level-color-stars-only nil + "Non-nil means fontify only the stars in each headline. +When nil, the entire headline is fontified. +Changing it requires restart of `font-lock-mode' to become effective +also in regions already fontified." + :group 'org-appearance + :type 'boolean) + +(defcustom org-hide-leading-stars nil + "Non-nil means hide the first N-1 stars in a headline. +This works by using the face `org-hide' for these stars. This +face is white for a light background, and black for a dark +background. You may have to customize the face `org-hide' to +make this work. +Changing it requires restart of `font-lock-mode' to become effective +also in regions already fontified. +You may also set this on a per-file basis by adding one of the following +lines to the buffer: + + #+STARTUP: hidestars + #+STARTUP: showstars" + :group 'org-appearance + :type 'boolean) + +(defcustom org-hidden-keywords nil + "List of symbols corresponding to keywords to be hidden the org buffer. +For example, a value '(title) for this list will make the document's title +appear in the buffer without the initial #+TITLE: keyword." + :group 'org-appearance + :version "24.1" + :type '(set (const :tag "#+AUTHOR" author) + (const :tag "#+DATE" date) + (const :tag "#+EMAIL" email) + (const :tag "#+TITLE" title))) + +(defcustom org-custom-properties nil + "List of properties (as strings) with a special meaning. +The default use of these custom properties is to let the user +hide them with `org-toggle-custom-properties-visibility'." + :group 'org-properties + :group 'org-appearance + :version "24.3" + :type '(repeat (string :tag "Property Name"))) + +(defcustom org-fontify-done-headline nil + "Non-nil means change the face of a headline if it is marked DONE. +Normally, only the TODO/DONE keyword indicates the state of a headline. +When this is non-nil, the headline after the keyword is set to the +`org-headline-done' as an additional indication." + :group 'org-appearance + :type 'boolean) + +(defcustom org-fontify-emphasized-text t + "Non-nil means fontify *bold*, /italic/ and _underlined_ text. +Changing this variable requires a restart of Emacs to take effect." + :group 'org-appearance + :type 'boolean) + +(defcustom org-fontify-whole-heading-line nil + "Non-nil means fontify the whole line for headings. +This is useful when setting a background color for the +org-level-* faces." + :group 'org-appearance + :type 'boolean) + +(defcustom org-highlight-latex-and-related nil + "Non-nil means highlight LaTeX related syntax in the buffer. +When non nil, the value should be a list containing any of the +following symbols: + `latex' Highlight LaTeX snippets and environments. + `script' Highlight subscript and superscript. + `entities' Highlight entities." + :group 'org-appearance + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "No highlighting" nil) + (set :greedy t :tag "Highlight" + (const :tag "LaTeX snippets and environments" latex) + (const :tag "Subscript and superscript" script) + (const :tag "Entities" entities)))) + +(defcustom org-hide-emphasis-markers nil + "Non-nil mean font-lock should hide the emphasis marker characters." + :group 'org-appearance + :type 'boolean) + +(defcustom org-pretty-entities nil + "Non-nil means show entities as UTF8 characters. +When nil, the \\name form remains in the buffer." + :group 'org-appearance + :version "24.1" + :type 'boolean) + +(defcustom org-pretty-entities-include-sub-superscripts t + "Non-nil means, pretty entity display includes formatting sub/superscripts." + :group 'org-appearance + :version "24.1" + :type 'boolean) + +(defvar org-emph-re nil + "Regular expression for matching emphasis. +After a match, the match groups contain these elements: +0 The match of the full regular expression, including the characters + before and after the proper match +1 The character before the proper match, or empty at beginning of line +2 The proper match, including the leading and trailing markers +3 The leading marker like * or /, indicating the type of highlighting +4 The text between the emphasis markers, not including the markers +5 The character after the match, empty at the end of a line") +(defvar org-verbatim-re nil + "Regular expression for matching verbatim text.") +(defvar org-emphasis-regexp-components) ; defined just below +(defvar org-emphasis-alist) ; defined just below +(defun org-set-emph-re (var val) + "Set variable and compute the emphasis regular expression." + (set var val) + (when (and (boundp 'org-emphasis-alist) + (boundp 'org-emphasis-regexp-components) + org-emphasis-alist org-emphasis-regexp-components) + (let* ((e org-emphasis-regexp-components) + (pre (car e)) + (post (nth 1 e)) + (border (nth 2 e)) + (body (nth 3 e)) + (nl (nth 4 e)) + (body1 (concat body "*?")) + (markers (mapconcat 'car org-emphasis-alist "")) + (vmarkers (mapconcat + (lambda (x) (if (eq (nth 2 x) 'verbatim) (car x) "")) + org-emphasis-alist ""))) + ;; make sure special characters appear at the right position in the class + (if (string-match "\\^" markers) + (setq markers (concat (replace-match "" t t markers) "^"))) + (if (string-match "-" markers) + (setq markers (concat (replace-match "" t t markers) "-"))) + (if (string-match "\\^" vmarkers) + (setq vmarkers (concat (replace-match "" t t vmarkers) "^"))) + (if (string-match "-" vmarkers) + (setq vmarkers (concat (replace-match "" t t vmarkers) "-"))) + (if (> nl 0) + (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," + (int-to-string nl) "\\}"))) + ;; Make the regexp + (setq org-emph-re + (concat "\\([" pre "]\\|^\\)" + "\\(" + "\\([" markers "]\\)" + "\\(" + "[^" border "]\\|" + "[^" border "]" + body1 + "[^" border "]" + "\\)" + "\\3\\)" + "\\([" post "]\\|$\\)")) + (setq org-verbatim-re + (concat "\\([" pre "]\\|^\\)" + "\\(" + "\\([" vmarkers "]\\)" + "\\(" + "[^" border "]\\|" + "[^" border "]" + body1 + "[^" border "]" + "\\)" + "\\3\\)" + "\\([" post "]\\|$\\)"))))) + +;; This used to be a defcustom (Org <8.0) but allowing the users to +;; set this option proved cumbersome. See this message/thread: +;; http://article.gmane.org/gmane.emacs.orgmode/68681 +(defvar org-emphasis-regexp-components + '(" \t('\"{" "- \t.,:!?;'\")}\\" " \t\r\n,\"'" "." 1) + "Components used to build the regular expression for emphasis. +This is a list with five entries. Terminology: In an emphasis string +like \" *strong word* \", we call the initial space PREMATCH, the final +space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters +and \"trong wor\" is the body. The different components in this variable +specify what is allowed/forbidden in each part: + +pre Chars allowed as prematch. Beginning of line will be allowed too. +post Chars allowed as postmatch. End of line will be allowed too. +border The chars *forbidden* as border characters. +body-regexp A regexp like \".\" to match a body character. Don't use + non-shy groups here, and don't allow newline here. +newline The maximum number of newlines allowed in an emphasis exp. + +You need to reload Org or to restart Emacs after customizing this.") + +(defcustom org-emphasis-alist + `(("*" bold) + ("/" italic) + ("_" underline) + ("=" org-verbatim verbatim) + ("~" org-code verbatim) + ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t)))) + "Alist of characters and faces to emphasize text. +Text starting and ending with a special character will be emphasized, +for example *bold*, _underlined_ and /italic/. This variable sets the +marker characters and the face to be used by font-lock for highlighting +in Org-mode Emacs buffers. + +You need to reload Org or to restart Emacs after customizing this." + :group 'org-appearance + :set 'org-set-emph-re + :version "24.4" + :package-version '(Org . "8.0") + :type '(repeat + (list + (string :tag "Marker character") + (choice + (face :tag "Font-lock-face") + (plist :tag "Face property list")) + (option (const verbatim))))) + +(defvar org-protecting-blocks + '("src" "example" "latex" "ascii" "html" "ditaa" "dot" "r" "R") + "Blocks that contain text that is quoted, i.e. not processed as Org syntax. +This is needed for font-lock setup.") + +;;; Miscellaneous options + +(defgroup org-completion nil + "Completion in Org-mode." + :tag "Org Completion" + :group 'org) + +(defcustom org-completion-use-ido nil + "Non-nil means use ido completion wherever possible. +Note that `ido-mode' must be active for this variable to be relevant. +If you decide to turn this variable on, you might well want to turn off +`org-outline-path-complete-in-steps'. +See also `org-completion-use-iswitchb'." + :group 'org-completion + :type 'boolean) + +(defcustom org-completion-use-iswitchb nil + "Non-nil means use iswitchb completion wherever possible. +Note that `iswitchb-mode' must be active for this variable to be relevant. +If you decide to turn this variable on, you might well want to turn off +`org-outline-path-complete-in-steps'. +Note that this variable has only an effect if `org-completion-use-ido' is nil." + :group 'org-completion + :type 'boolean) + +(defcustom org-completion-fallback-command 'hippie-expand + "The expansion command called by \\[pcomplete] in normal context. +Normal means, no org-mode-specific context." + :group 'org-completion + :type 'function) + +;;; Functions and variables from their packages +;; Declared here to avoid compiler warnings + +;; XEmacs only +(defvar outline-mode-menu-heading) +(defvar outline-mode-menu-show) +(defvar outline-mode-menu-hide) +(defvar zmacs-regions) ; XEmacs regions + +;; Emacs only +(defvar mark-active) + +;; Various packages +(declare-function calendar-iso-to-absolute "cal-iso" (date)) +(declare-function calendar-forward-day "cal-move" (arg)) +(declare-function calendar-goto-date "cal-move" (date)) +(declare-function calendar-goto-today "cal-move" ()) +(declare-function calendar-iso-from-absolute "cal-iso" (date)) +(defvar calc-embedded-close-formula) +(defvar calc-embedded-open-formula) +(declare-function cdlatex-tab "ext:cdlatex" ()) +(declare-function cdlatex-compute-tables "ext:cdlatex" ()) +(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) +(defvar font-lock-unfontify-region-function) +(declare-function iswitchb-read-buffer "iswitchb" + (prompt &optional default require-match start matches-set)) +(defvar iswitchb-temp-buflist) +(declare-function org-gnus-follow-link "org-gnus" (&optional group article)) +(defvar org-agenda-tags-todo-honor-ignore-options) +(declare-function org-agenda-skip "org-agenda" ()) +(declare-function + org-agenda-format-item "org-agenda" + (extra txt &optional level category tags dotime noprefix remove-re habitp)) +(declare-function org-agenda-new-marker "org-agenda" (&optional pos)) +(declare-function org-agenda-change-all-lines "org-agenda" + (newhead hdmarker &optional fixface just-this)) +(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type)) +(declare-function org-agenda-maybe-redo "org-agenda" ()) +(declare-function org-agenda-save-markers-for-cut-and-paste "org-agenda" + (beg end)) +(declare-function org-agenda-copy-local-variable "org-agenda" (var)) +(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item + "org-agenda" (&optional end)) +(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) +(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) +(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) +(declare-function org-inlinetask-goto-end "org-inlinetask" ()) +(declare-function org-indent-mode "org-indent" (&optional arg)) +(declare-function parse-time-string "parse-time" (string)) +(declare-function org-attach-reveal "org-attach" (&optional if-exists)) +(declare-function orgtbl-send-table "org-table" (&optional maybe)) +(defvar remember-data-file) +(defvar texmathp-why) +(declare-function speedbar-line-directory "speedbar" (&optional depth)) +(declare-function table--at-cell-p "table" (position &optional object at-column)) + +(defvar org-latex-regexps) + +;;; Autoload and prepare some org modules + +;; Some table stuff that needs to be defined here, because it is used +;; by the functions setting up org-mode or checking for table context. + +(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" + "Detect an org-type or table-type table.") +(defconst org-table-line-regexp "^[ \t]*|" + "Detect an org-type table line.") +(defconst org-table-dataline-regexp "^[ \t]*|[^-]" + "Detect an org-type table line.") +(defconst org-table-hline-regexp "^[ \t]*|-" + "Detect an org-type table hline.") +(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" + "Detect a table-type table hline.") +(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" + "Detect the first line outside a table when searching from within it. +This works for both table types.") + +(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: " + "Detect a #+TBLFM line.") + +;;;###autoload +(defun turn-on-orgtbl () + "Unconditionally turn on `orgtbl-mode'." + (require 'org-table) + (orgtbl-mode 1)) + +(defun org-at-table-p (&optional table-type) + "Return t if the cursor is inside an org-type table. +If TABLE-TYPE is non-nil, also check for table.el-type tables." + (if org-enable-table-editor + (save-excursion + (beginning-of-line 1) + (looking-at (if table-type org-table-any-line-regexp + org-table-line-regexp))) + nil)) +(defsubst org-table-p () (org-at-table-p)) + +(defun org-at-table.el-p () + "Return t if and only if we are at a table.el table." + (and (org-at-table-p 'any) + (save-excursion + (goto-char (org-table-begin 'any)) + (looking-at org-table1-hline-regexp)))) + +(defun org-table-recognize-table.el () + "If there is a table.el table nearby, recognize it and move into it." + (if org-table-tab-recognizes-table.el + (if (org-at-table.el-p) + (progn + (beginning-of-line 1) + (if (looking-at org-table-dataline-regexp) + nil + (if (looking-at org-table1-hline-regexp) + (progn + (beginning-of-line 2) + (if (looking-at org-table-any-border-regexp) + (beginning-of-line -1))))) + (if (re-search-forward "|" (org-table-end t) t) + (progn + (require 'table) + (if (table--at-cell-p (point)) + t + (message "recognizing table.el table...") + (table-recognize-table) + (message "recognizing table.el table...done"))) + (error "This should not happen")) + t) + nil) + nil)) + +(defun org-at-table-hline-p () + "Return t if the cursor is inside a hline in a table." + (if org-enable-table-editor + (save-excursion + (beginning-of-line 1) + (looking-at org-table-hline-regexp)) + nil)) + +(defun org-table-map-tables (function &optional quietly) + "Apply FUNCTION to the start of all tables in the buffer." + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward org-table-any-line-regexp nil t) + (unless quietly + (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size)))) + (beginning-of-line 1) + (when (and (looking-at org-table-line-regexp) + ;; Exclude tables in src/example/verbatim/clocktable blocks + (not (org-in-block-p '("src" "example" "verbatim" "clocktable")))) + (save-excursion (funcall function)) + (or (looking-at org-table-line-regexp) + (forward-char 1))) + (re-search-forward org-table-any-border-regexp nil 1)))) + (unless quietly (message "Mapping tables: done"))) + +(declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end)) +(declare-function org-clock-update-mode-line "org-clock" ()) +(declare-function org-resolve-clocks "org-clock" + (&optional also-non-dangling-p prompt last-valid)) + +(defun org-at-TBLFM-p (&optional pos) + "Return t when point (or POS) is in #+TBLFM line." + (save-excursion + (let ((pos pos))) + (goto-char (or pos (point))) + (beginning-of-line 1) + (looking-at org-TBLFM-regexp))) + +(defvar org-clock-start-time) +(defvar org-clock-marker (make-marker) + "Marker recording the last clock-in.") +(defvar org-clock-hd-marker (make-marker) + "Marker recording the last clock-in, but the headline position.") +(defvar org-clock-heading "" + "The heading of the current clock entry.") +(defun org-clock-is-active () + "Return the buffer where the clock is currently running. +Return nil if no clock is running." + (marker-buffer org-clock-marker)) + +(defun org-check-running-clock () + "Check if the current buffer contains the running clock. +If yes, offer to stop it and to save the buffer with the changes." + (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) + (y-or-n-p (format "Clock-out in buffer %s before killing it? " + (buffer-name)))) + (org-clock-out) + (when (y-or-n-p "Save changed buffer?") + (save-buffer)))) + +(defun org-clocktable-try-shift (dir n) + "Check if this line starts a clock table, if yes, shift the time block." + (when (org-match-line "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>") + (org-clocktable-shift dir n))) + +;;;###autoload +(defun org-clock-persistence-insinuate () + "Set up hooks for clock persistence." + (require 'org-clock) + (add-hook 'org-mode-hook 'org-clock-load) + (add-hook 'kill-emacs-hook 'org-clock-save)) + +(defgroup org-archive nil + "Options concerning archiving in Org-mode." + :tag "Org Archive" + :group 'org-structure) + +(defcustom org-archive-location "%s_archive::" + "The location where subtrees should be archived. + +The value of this variable is a string, consisting of two parts, +separated by a double-colon. The first part is a filename and +the second part is a headline. + +When the filename is omitted, archiving happens in the same file. +%s in the filename will be replaced by the current file +name (without the directory part). Archiving to a different file +is useful to keep archived entries from contributing to the +Org-mode Agenda. + +The archived entries will be filed as subtrees of the specified +headline. When the headline is omitted, the subtrees are simply +filed away at the end of the file, as top-level entries. Also in +the heading you can use %s to represent the file name, this can be +useful when using the same archive for a number of different files. + +Here are a few examples: +\"%s_archive::\" + If the current file is Projects.org, archive in file + Projects.org_archive, as top-level trees. This is the default. + +\"::* Archived Tasks\" + Archive in the current file, under the top-level headline + \"* Archived Tasks\". + +\"~/org/archive.org::\" + Archive in file ~/org/archive.org (absolute path), as top-level trees. + +\"~/org/archive.org::* From %s\" + Archive in file ~/org/archive.org (absolute path), under headlines + \"From FILENAME\" where file name is the current file name. + +\"~/org/datetree.org::datetree/* Finished Tasks\" + The \"datetree/\" string is special, signifying to archive + items to the datetree. Items are placed in either the CLOSED + date of the item, or the current date if there is no CLOSED date. + The heading will be a subentry to the current date. There doesn't + need to be a heading, but there always needs to be a slash after + datetree. For example, to store archived items directly in the + datetree, use \"~/org/datetree.org::datetree/\". + +\"basement::** Finished Tasks\" + Archive in file ./basement (relative path), as level 3 trees + below the level 2 heading \"** Finished Tasks\". + +You may set this option on a per-file basis by adding to the buffer a +line like + +#+ARCHIVE: basement::** Finished Tasks + +You may also define it locally for a subtree by setting an ARCHIVE property +in the entry. If such a property is found in an entry, or anywhere up +the hierarchy, it will be used." + :group 'org-archive + :type 'string) + +(defcustom org-archive-tag "ARCHIVE" + "The tag that marks a subtree as archived. +An archived subtree does not open during visibility cycling, and does +not contribute to the agenda listings. +After changing this, font-lock must be restarted in the relevant buffers to +get the proper fontification." + :group 'org-archive + :group 'org-keywords + :type 'string) + +(defcustom org-agenda-skip-archived-trees t + "Non-nil means the agenda will skip any items located in archived trees. +An archived tree is a tree marked with the tag ARCHIVE. The use of this +variable is no longer recommended, you should leave it at the value t. +Instead, use the key `v' to cycle the archives-mode in the agenda." + :group 'org-archive + :group 'org-agenda-skip + :type 'boolean) + +(defcustom org-columns-skip-archived-trees t + "Non-nil means ignore archived trees when creating column view." + :group 'org-archive + :group 'org-properties + :type 'boolean) + +(defcustom org-cycle-open-archived-trees nil + "Non-nil means `org-cycle' will open archived trees. +An archived tree is a tree marked with the tag ARCHIVE. +When nil, archived trees will stay folded. You can still open them with +normal outline commands like `show-all', but not with the cycling commands." + :group 'org-archive + :group 'org-cycle + :type 'boolean) + +(defcustom org-sparse-tree-open-archived-trees nil + "Non-nil means sparse tree construction shows matches in archived trees. +When nil, matches in these trees are highlighted, but the trees are kept in +collapsed state." + :group 'org-archive + :group 'org-sparse-trees + :type 'boolean) + +(defcustom org-sparse-tree-default-date-type 'scheduled-or-deadline + "The default date type when building a sparse tree. +When this is nil, a date is a scheduled or a deadline timestamp. +Otherwise, these types are allowed: + + all: all timestamps + active: only active timestamps (<...>) + inactive: only inactive timestamps (<...) + scheduled: only scheduled timestamps + deadline: only deadline timestamps" + :type '(choice (const :tag "Scheduled or deadline" scheduled-or-deadline) + (const :tag "All timestamps" all) + (const :tag "Only active timestamps" active) + (const :tag "Only inactive timestamps" inactive) + (const :tag "Only scheduled timestamps" scheduled) + (const :tag "Only deadline timestamps" deadline) + (const :tag "Only closed timestamps" closed)) + :version "24.3" + :group 'org-sparse-trees) + +(defun org-cycle-hide-archived-subtrees (state) + "Re-hide all archived subtrees after a visibility state change." + (when (and (not org-cycle-open-archived-trees) + (not (memq state '(overview folded)))) + (save-excursion + (let* ((globalp (memq state '(contents all))) + (beg (if globalp (point-min) (point))) + (end (if globalp (point-max) (org-end-of-subtree t)))) + (org-hide-archived-subtrees beg end) + (goto-char beg) + (if (looking-at (concat ".*:" org-archive-tag ":")) + (message "%s" (substitute-command-keys + "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway."))))))) + +(defun org-force-cycle-archived () + "Cycle subtree even if it is archived." + (interactive) + (setq this-command 'org-cycle) + (let ((org-cycle-open-archived-trees t)) + (call-interactively 'org-cycle))) + +(defun org-hide-archived-subtrees (beg end) + "Re-hide all archived subtrees after a visibility state change." + (save-excursion + (let* ((re (concat ":" org-archive-tag ":"))) + (goto-char beg) + (while (re-search-forward re end t) + (when (org-at-heading-p) + (org-flag-subtree t) + (org-end-of-subtree t)))))) + +(declare-function outline-end-of-heading "outline" ()) +(declare-function outline-flag-region "outline" (from to flag)) +(defun org-flag-subtree (flag) + (save-excursion + (org-back-to-heading t) + (outline-end-of-heading) + (outline-flag-region (point) + (progn (org-end-of-subtree t) (point)) + flag))) + +(defalias 'org-advertized-archive-subtree 'org-archive-subtree) + +;; Declare Column View Code + +(declare-function org-columns-number-to-string "org-colview" (n fmt &optional printf)) +(declare-function org-columns-get-format-and-top-level "org-colview" ()) +(declare-function org-columns-compute "org-colview" (property)) + +;; Declare ID code + +(declare-function org-id-store-link "org-id") +(declare-function org-id-locations-load "org-id") +(declare-function org-id-locations-save "org-id") +(defvar org-id-track-globally) + +;;; Variables for pre-computed regular expressions, all buffer local + +(defvar org-drawer-regexp "^[ \t]*:PROPERTIES:[ \t]*$" + "Matches first line of a hidden block.") +(make-variable-buffer-local 'org-drawer-regexp) +(defvar org-todo-regexp nil + "Matches any of the TODO state keywords.") +(make-variable-buffer-local 'org-todo-regexp) +(defvar org-not-done-regexp nil + "Matches any of the TODO state keywords except the last one.") +(make-variable-buffer-local 'org-not-done-regexp) +(defvar org-not-done-heading-regexp nil + "Matches a TODO headline that is not done.") +(make-variable-buffer-local 'org-not-done-regexp) +(defvar org-todo-line-regexp nil + "Matches a headline and puts TODO state into group 2 if present.") +(make-variable-buffer-local 'org-todo-line-regexp) +(defvar org-complex-heading-regexp nil + "Matches a headline and puts everything into groups: +group 1: the stars +group 2: The todo keyword, maybe +group 3: Priority cookie +group 4: True headline +group 5: Tags") +(make-variable-buffer-local 'org-complex-heading-regexp) +(defvar org-complex-heading-regexp-format nil + "Printf format to make regexp to match an exact headline. +This regexp will match the headline of any node which has the +exact headline text that is put into the format, but may have any +TODO state, priority and tags.") +(make-variable-buffer-local 'org-complex-heading-regexp-format) +(defvar org-todo-line-tags-regexp nil + "Matches a headline and puts TODO state into group 2 if present. +Also put tags into group 4 if tags are present.") +(make-variable-buffer-local 'org-todo-line-tags-regexp) +(defvar org-ds-keyword-length 12 + "Maximum length of the DEADLINE and SCHEDULED keywords.") +(make-variable-buffer-local 'org-ds-keyword-length) +(defvar org-deadline-regexp nil + "Matches the DEADLINE keyword.") +(make-variable-buffer-local 'org-deadline-regexp) +(defvar org-deadline-time-regexp nil + "Matches the DEADLINE keyword together with a time stamp.") +(make-variable-buffer-local 'org-deadline-time-regexp) +(defvar org-deadline-time-hour-regexp nil + "Matches the DEADLINE keyword together with a time-and-hour stamp.") +(make-variable-buffer-local 'org-deadline-time-hour-regexp) +(defvar org-deadline-line-regexp nil + "Matches the DEADLINE keyword and the rest of the line.") +(make-variable-buffer-local 'org-deadline-line-regexp) +(defvar org-scheduled-regexp nil + "Matches the SCHEDULED keyword.") +(make-variable-buffer-local 'org-scheduled-regexp) +(defvar org-scheduled-time-regexp nil + "Matches the SCHEDULED keyword together with a time stamp.") +(make-variable-buffer-local 'org-scheduled-time-regexp) +(defvar org-scheduled-time-hour-regexp nil + "Matches the SCHEDULED keyword together with a time-and-hour stamp.") +(make-variable-buffer-local 'org-scheduled-time-hour-regexp) +(defvar org-closed-time-regexp nil + "Matches the CLOSED keyword together with a time stamp.") +(make-variable-buffer-local 'org-closed-time-regexp) + +(defvar org-keyword-time-regexp nil + "Matches any of the 4 keywords, together with the time stamp.") +(make-variable-buffer-local 'org-keyword-time-regexp) +(defvar org-keyword-time-not-clock-regexp nil + "Matches any of the 3 keywords, together with the time stamp.") +(make-variable-buffer-local 'org-keyword-time-not-clock-regexp) +(defvar org-maybe-keyword-time-regexp nil + "Matches a timestamp, possibly preceded by a keyword.") +(make-variable-buffer-local 'org-maybe-keyword-time-regexp) +(defvar org-all-time-keywords nil + "List of time keywords.") +(make-variable-buffer-local 'org-all-time-keywords) + +(defconst org-plain-time-of-day-regexp + (concat + "\\(\\<[012]?[0-9]" + "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" + "\\(--?" + "\\(\\<[012]?[0-9]" + "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" + "\\)?") + "Regular expression to match a plain time or time range. +Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following +groups carry important information: +0 the full match +1 the first time, range or not +8 the second time, if it is a range.") + +(defconst org-plain-time-extension-regexp + (concat + "\\(\\<[012]?[0-9]" + "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" + "\\+\\([0-9]+\\)\\(:\\([0-5][0-9]\\)\\)?") + "Regular expression to match a time range like 13:30+2:10 = 13:30-15:40. +Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following +groups carry important information: +0 the full match +7 hours of duration +9 minutes of duration") + +(defconst org-stamp-time-of-day-regexp + (concat + "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)" + "\\([012][0-9]:[0-5][0-9]\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?\\)>" + "\\(--?" + "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?") + "Regular expression to match a timestamp time or time range. +After a match, the following groups carry important information: +0 the full match +1 date plus weekday, for back referencing to make sure both times are on the same day +2 the first time, range or not +4 the second time, if it is a range.") + +(defconst org-startup-options + '(("fold" org-startup-folded t) + ("overview" org-startup-folded t) + ("nofold" org-startup-folded nil) + ("showall" org-startup-folded nil) + ("showeverything" org-startup-folded showeverything) + ("content" org-startup-folded content) + ("indent" org-startup-indented t) + ("noindent" org-startup-indented nil) + ("hidestars" org-hide-leading-stars t) + ("showstars" org-hide-leading-stars nil) + ("odd" org-odd-levels-only t) + ("oddeven" org-odd-levels-only nil) + ("align" org-startup-align-all-tables t) + ("noalign" org-startup-align-all-tables nil) + ("inlineimages" org-startup-with-inline-images t) + ("noinlineimages" org-startup-with-inline-images nil) + ("latexpreview" org-startup-with-latex-preview t) + ("nolatexpreview" org-startup-with-latex-preview nil) + ("customtime" org-display-custom-times t) + ("logdone" org-log-done time) + ("lognotedone" org-log-done note) + ("nologdone" org-log-done nil) + ("lognoteclock-out" org-log-note-clock-out t) + ("nolognoteclock-out" org-log-note-clock-out nil) + ("logrepeat" org-log-repeat state) + ("lognoterepeat" org-log-repeat note) + ("logdrawer" org-log-into-drawer t) + ("nologdrawer" org-log-into-drawer nil) + ("logstatesreversed" org-log-states-order-reversed t) + ("nologstatesreversed" org-log-states-order-reversed nil) + ("nologrepeat" org-log-repeat nil) + ("logreschedule" org-log-reschedule time) + ("lognotereschedule" org-log-reschedule note) + ("nologreschedule" org-log-reschedule nil) + ("logredeadline" org-log-redeadline time) + ("lognoteredeadline" org-log-redeadline note) + ("nologredeadline" org-log-redeadline nil) + ("logrefile" org-log-refile time) + ("lognoterefile" org-log-refile note) + ("nologrefile" org-log-refile nil) + ("fninline" org-footnote-define-inline t) + ("nofninline" org-footnote-define-inline nil) + ("fnlocal" org-footnote-section nil) + ("fnauto" org-footnote-auto-label t) + ("fnprompt" org-footnote-auto-label nil) + ("fnconfirm" org-footnote-auto-label confirm) + ("fnplain" org-footnote-auto-label plain) + ("fnadjust" org-footnote-auto-adjust t) + ("nofnadjust" org-footnote-auto-adjust nil) + ("constcgs" constants-unit-system cgs) + ("constSI" constants-unit-system SI) + ("noptag" org-tag-persistent-alist nil) + ("hideblocks" org-hide-block-startup t) + ("nohideblocks" org-hide-block-startup nil) + ("beamer" org-startup-with-beamer-mode t) + ("entitiespretty" org-pretty-entities t) + ("entitiesplain" org-pretty-entities nil)) + "Variable associated with STARTUP options for org-mode. +Each element is a list of three items: the startup options (as written +in the #+STARTUP line), the corresponding variable, and the value to set +this variable to if the option is found. An optional forth element PUSH +means to push this value onto the list in the variable.") + +(defun org-update-property-plist (key val props) + "Update PROPS with KEY and VAL." + (let* ((appending (string= "+" (substring key (- (length key) 1)))) + (key (if appending (substring key 0 (- (length key) 1)) key)) + (remainder (org-remove-if (lambda (p) (string= (car p) key)) props)) + (previous (cdr (assoc key props)))) + (if appending + (cons (cons key (if previous (concat previous " " val) val)) remainder) + (cons (cons key val) remainder)))) + +(defconst org-block-regexp + "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$" + "Regular expression for hiding blocks.") +(defconst org-heading-keyword-regexp-format + "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" + "Printf format for a regexp matching a headline with some keyword. +This regexp will match the headline of any node which has the +exact keyword that is put into the format. The keyword isn't in +any group by default, but the stars and the body are.") +(defconst org-heading-keyword-maybe-regexp-format + "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$" + "Printf format for a regexp matching a headline, possibly with some keyword. +This regexp can match any headline with the specified keyword, or +without a keyword. The keyword isn't in any group by default, +but the stars and the body are.") + +(defcustom org-group-tags t + "When non-nil (the default), use group tags. +This can be turned on/off through `org-toggle-tags-groups'." + :group 'org-tags + :group 'org-startup + :type 'boolean) + +(defvar org-inhibit-startup nil) ; Dynamically-scoped param. + +(defun org-toggle-tags-groups () + "Toggle support for group tags. +Support for group tags is controlled by the option +`org-group-tags', which is non-nil by default." + (interactive) + (setq org-group-tags (not org-group-tags)) + (cond ((and (derived-mode-p 'org-agenda-mode) + org-group-tags) + (org-agenda-redo)) + ((derived-mode-p 'org-mode) + (let ((org-inhibit-startup t)) (org-mode)))) + (message "Groups tags support has been turned %s" + (if org-group-tags "on" "off"))) + +(defun org-set-regexps-and-options-for-tags () + "Precompute variables used for tags." + (when (derived-mode-p 'org-mode) + (org-set-local 'org-file-tags nil) + (let ((re (org-make-options-regexp '("FILETAGS" "TAGS"))) + (splitre "[ \t]+") + (start 0) + tags ftags key value) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (setq key (upcase (org-match-string-no-properties 1)) + value (org-match-string-no-properties 2)) + (if (stringp value) (setq value (org-trim value))) + (cond + ((equal key "TAGS") + (setq tags (append tags (if tags '("\\n") nil) + (org-split-string value splitre)))) + ((equal key "FILETAGS") + (when (string-match "\\S-" value) + (setq ftags + (append + ftags + (apply 'append + (mapcar (lambda (x) (org-split-string x ":")) + (org-split-string value))))))))))) + ;; Process the file tags. + (and ftags (org-set-local 'org-file-tags + (mapcar 'org-add-prop-inherited ftags))) + (org-set-local 'org-tag-groups-alist nil) + ;; Process the tags. + (when (and (not tags) org-tag-alist) + (setq tags + (mapcar + (lambda (tg) (cond ((eq (car tg) :startgroup) "{") + ((eq (car tg) :endgroup) "}") + ((eq (car tg) :grouptags) ":") + ((eq (car tg) :newline) "\n") + (t (concat (car tg) + (if (characterp (cdr tg)) + (format "(%s)" (char-to-string (cdr tg))) ""))))) + org-tag-alist))) + (let (e tgs g) + (while (setq e (pop tags)) + (cond + ((equal e "{") + (progn (push '(:startgroup) tgs) + (when (equal (nth 1 tags) ":") + (push (list (replace-regexp-in-string + "(.+)$" "" (nth 0 tags))) + org-tag-groups-alist) + (setq g 0)))) + ((equal e ":") (push '(:grouptags) tgs)) + ((equal e "}") (push '(:endgroup) tgs) (if g (setq g nil))) + ((equal e "\\n") (push '(:newline) tgs)) + ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e) + (push (cons (match-string 1 e) + (string-to-char (match-string 2 e))) tgs) + (if (and g (> g 0)) + (setcar org-tag-groups-alist + (append (car org-tag-groups-alist) + (list (match-string 1 e))))) + (if g (setq g (1+ g)))) + (t (push (list e) tgs) + (if (and g (> g 0)) + (setcar org-tag-groups-alist + (append (car org-tag-groups-alist) (list e)))) + (if g (setq g (1+ g)))))) + (org-set-local 'org-tag-alist nil) + (while (setq e (pop tgs)) + (or (and (stringp (car e)) + (assoc (car e) org-tag-alist)) + (push e org-tag-alist))) + ;; Return a list with tag variables + (list org-file-tags org-tag-alist org-tag-groups-alist))))) + +(defvar org-ota nil) +(defun org-set-regexps-and-options () + "Precompute regular expressions used in the current buffer." + (when (derived-mode-p 'org-mode) + (org-set-local 'org-todo-kwd-alist nil) + (org-set-local 'org-todo-key-alist nil) + (org-set-local 'org-todo-key-trigger nil) + (org-set-local 'org-todo-keywords-1 nil) + (org-set-local 'org-done-keywords nil) + (org-set-local 'org-todo-heads nil) + (org-set-local 'org-todo-sets nil) + (org-set-local 'org-todo-log-states nil) + (org-set-local 'org-file-properties nil) + (let ((re (org-make-options-regexp + '("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE" + "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS" + "SETUPFILE" "OPTIONS") + "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)")) + (splitre "[ \t]+") + (scripts org-use-sub-superscripts) + kwds kws0 kwsa key log value cat arch const links hw dws + tail sep kws1 prio props drawers ext-setup-or-nil setup-contents + (start 0)) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while + (or (and + ext-setup-or-nil + (not org-ota) + (let (ret) + (with-temp-buffer + (insert ext-setup-or-nil) + (let ((major-mode 'org-mode) org-ota) + (setq ret (save-match-data + (org-set-regexps-and-options-for-tags))))) + ;; Append setupfile tags to existing tags + (setq org-ota t) + (setq org-file-tags + (delq nil (append org-file-tags (nth 0 ret))) + org-tag-alist + (delq nil (append org-tag-alist (nth 1 ret))) + org-tag-groups-alist + (delq nil (append org-tag-groups-alist (nth 2 ret)))))) + (and ext-setup-or-nil + (string-match re ext-setup-or-nil start) + (setq start (match-end 0))) + (and (setq ext-setup-or-nil nil start 0) + (re-search-forward re nil t))) + (setq key (upcase (match-string 1 ext-setup-or-nil)) + value (org-match-string-no-properties 2 ext-setup-or-nil)) + (if (stringp value) (setq value (org-trim value))) + (cond + ((equal key "CATEGORY") + (setq cat value)) + ((member key '("SEQ_TODO" "TODO")) + (push (cons 'sequence (org-split-string value splitre)) kwds)) + ((equal key "TYP_TODO") + (push (cons 'type (org-split-string value splitre)) kwds)) + ((string-match "\\`\\([a-zA-Z][0-9a-zA-Z_]*\\)_TODO\\'" key) + ;; general TODO-like setup + (push (cons (intern (downcase (match-string 1 key))) + (org-split-string value splitre)) kwds)) + ((equal key "COLUMNS") + (org-set-local 'org-columns-default-format value)) + ((equal key "LINK") + (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value) + (push (cons (match-string 1 value) + (org-trim (match-string 2 value))) + links))) + ((equal key "PRIORITIES") + (setq prio (org-split-string value " +"))) + ((equal key "PROPERTY") + (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) + (setq props (org-update-property-plist (match-string 1 value) + (match-string 2 value) + props)))) + ((equal key "DRAWERS") + (setq drawers (delete-dups (append org-drawers (org-split-string value splitre))))) + ((equal key "CONSTANTS") + (org-table-set-constants)) + ((equal key "STARTUP") + (let ((opts (org-split-string value splitre)) + l var val) + (while (setq l (pop opts)) + (when (setq l (assoc l org-startup-options)) + (setq var (nth 1 l) val (nth 2 l)) + (if (not (nth 3 l)) + (set (make-local-variable var) val) + (if (not (listp (symbol-value var))) + (set (make-local-variable var) nil)) + (set (make-local-variable var) (symbol-value var)) + (add-to-list var val)))))) + ((equal key "ARCHIVE") + (setq arch value) + (remove-text-properties 0 (length arch) + '(face t fontified t) arch)) + ((equal key "OPTIONS") + (if (string-match "\\([ \t]\\|\\`\\)\\^:\\(t\\|nil\\|{}\\)" value) + (setq scripts (read (match-string 2 value))))) + ((and (equal key "SETUPFILE") + ;; Prevent checking in Gnus messages + (not buffer-read-only)) + (setq setup-contents (org-file-contents + (expand-file-name + (org-remove-double-quotes value)) + 'noerror)) + (if (not ext-setup-or-nil) + (setq ext-setup-or-nil setup-contents start 0) + (setq ext-setup-or-nil + (concat (substring ext-setup-or-nil 0 start) + "\n" setup-contents "\n" + (substring ext-setup-or-nil start))))))) + ;; search for property blocks + (goto-char (point-min)) + (while (re-search-forward org-block-regexp nil t) + (when (equal "PROPERTY" (upcase (match-string 1))) + (setq value (replace-regexp-in-string + "[\n\r]" " " (match-string 4))) + (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) + (setq props (org-update-property-plist (match-string 1 value) + (match-string 2 value) + props))))))) + (org-set-local 'org-use-sub-superscripts scripts) + (when cat + (org-set-local 'org-category (intern cat)) + (push (cons "CATEGORY" cat) props)) + (when prio + (if (< (length prio) 3) (setq prio '("A" "C" "B"))) + (setq prio (mapcar 'string-to-char prio)) + (org-set-local 'org-highest-priority (nth 0 prio)) + (org-set-local 'org-lowest-priority (nth 1 prio)) + (org-set-local 'org-default-priority (nth 2 prio))) + (and props (org-set-local 'org-file-properties (nreverse props))) + (and drawers (org-set-local 'org-drawers drawers)) + (and arch (org-set-local 'org-archive-location arch)) + (and links (setq org-link-abbrev-alist-local (nreverse links))) + ;; Process the TODO keywords + (unless kwds + ;; Use the global values as if they had been given locally. + (setq kwds (default-value 'org-todo-keywords)) + (if (stringp (car kwds)) + (setq kwds (list (cons org-todo-interpretation + (default-value 'org-todo-keywords))))) + (setq kwds (reverse kwds))) + (setq kwds (nreverse kwds)) + (let (inter kws kw) + (while (setq kws (pop kwds)) + (let ((kws (or + (run-hook-with-args-until-success + 'org-todo-setup-filter-hook kws) + kws))) + (setq inter (pop kws) sep (member "|" kws) + kws0 (delete "|" (copy-sequence kws)) + kwsa nil + kws1 (mapcar + (lambda (x) + ;; 1 2 + (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x) + (progn + (setq kw (match-string 1 x) + key (and (match-end 2) (match-string 2 x)) + log (org-extract-log-state-settings x)) + (push (cons kw (and key (string-to-char key))) kwsa) + (and log (push log org-todo-log-states)) + kw) + (error "Invalid TODO keyword %s" x))) + kws0) + kwsa (if kwsa (append '((:startgroup)) + (nreverse kwsa) + '((:endgroup)))) + hw (car kws1) + dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) + tail (list inter hw (car dws) (org-last dws)))) + (add-to-list 'org-todo-heads hw 'append) + (push kws1 org-todo-sets) + (setq org-done-keywords (append org-done-keywords dws nil)) + (setq org-todo-key-alist (append org-todo-key-alist kwsa)) + (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1) + (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) + (setq org-todo-sets (nreverse org-todo-sets) + org-todo-kwd-alist (nreverse org-todo-kwd-alist) + org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist)) + org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))) + ;; Compute the regular expressions and other local variables. + ;; Using `org-outline-regexp-bol' would complicate them much, + ;; because of the fixed white space at the end of that string. + (if (not org-done-keywords) + (setq org-done-keywords (and org-todo-keywords-1 + (list (org-last org-todo-keywords-1))))) + (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string) + (length org-scheduled-string) + (length org-clock-string) + (length org-closed-string))) + org-drawer-regexp + (concat "^[ \t]*:\\(" + (mapconcat 'regexp-quote org-drawers "\\|") + "\\):[ \t]*$") + org-not-done-keywords + (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1)) + org-todo-regexp + (concat "\\(" + (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") + "\\)") + org-not-done-regexp + (concat "\\(" + (mapconcat 'regexp-quote org-not-done-keywords "\\|") + "\\)") + org-not-done-heading-regexp + (format org-heading-keyword-regexp-format org-not-done-regexp) + org-todo-line-regexp + (format org-heading-keyword-maybe-regexp-format org-todo-regexp) + org-complex-heading-regexp + (concat "^\\(\\*+\\)" + "\\(?: +" org-todo-regexp "\\)?" + "\\(?: +\\(\\[#.\\]\\)\\)?" + "\\(?: +\\(.*?\\)\\)??" + (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?") + "[ \t]*$") + org-complex-heading-regexp-format + (concat "^\\(\\*+\\)" + "\\(?: +" org-todo-regexp "\\)?" + "\\(?: +\\(\\[#.\\]\\)\\)?" + "\\(?: +" + ;; Stats cookies can be stuck to body. + "\\(?:\\[[0-9%%/]+\\] *\\)*" + "\\(%s\\)" + "\\(?: *\\[[0-9%%/]+\\]\\)*" + "\\)" + (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?") + "[ \t]*$") + org-todo-line-tags-regexp + (concat "^\\(\\*+\\)" + "\\(?: +" org-todo-regexp "\\)?" + "\\(?: +\\(.*?\\)\\)??" + (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?") + "[ \t]*$") + org-deadline-regexp (concat "\\<" org-deadline-string) + org-deadline-time-regexp + (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") + org-deadline-time-hour-regexp + (concat "\\<" org-deadline-string + " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>") + org-deadline-line-regexp + (concat "\\<\\(" org-deadline-string "\\).*") + org-scheduled-regexp + (concat "\\<" org-scheduled-string) + org-scheduled-time-regexp + (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") + org-scheduled-time-hour-regexp + (concat "\\<" org-scheduled-string + " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>") + org-closed-time-regexp + (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") + org-keyword-time-regexp + (concat "\\<\\(" org-scheduled-string + "\\|" org-deadline-string + "\\|" org-closed-string + "\\|" org-clock-string "\\)" + " *[[<]\\([^]>]+\\)[]>]") + org-keyword-time-not-clock-regexp + (concat "\\<\\(" org-scheduled-string + "\\|" org-deadline-string + "\\|" org-closed-string + "\\)" + " *[[<]\\([^]>]+\\)[]>]") + org-maybe-keyword-time-regexp + (concat "\\(\\<\\(" org-scheduled-string + "\\|" org-deadline-string + "\\|" org-closed-string + "\\|" org-clock-string "\\)\\)?" + " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)") + org-all-time-keywords + (mapcar (lambda (w) (substring w 0 -1)) + (list org-scheduled-string org-deadline-string + org-clock-string org-closed-string))) + (setq org-ota nil) + (org-compute-latex-and-related-regexp)))) + +(defun org-file-contents (file &optional noerror) + "Return the contents of FILE, as a string." + (if (or (not file) (not (file-readable-p file))) + (if (not noerror) + (error "Cannot read file \"%s\"" file) + (message "Cannot read file \"%s\"" file) + "") + (with-temp-buffer + (insert-file-contents file) + (buffer-string)))) + +(defun org-extract-log-state-settings (x) + "Extract the log state setting from a TODO keyword string. +This will extract info from a string like \"WAIT(w@/!)\"." + (let (kw key log1 log2) + (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x) + (setq kw (match-string 1 x) + key (and (match-end 2) (match-string 2 x)) + log1 (and (match-end 3) (match-string 3 x)) + log2 (and (match-end 4) (match-string 4 x))) + (and (or log1 log2) + (list kw + (and log1 (if (equal log1 "!") 'time 'note)) + (and log2 (if (equal log2 "!") 'time 'note))))))) + +(defun org-remove-keyword-keys (list) + "Remove a pair of parenthesis at the end of each string in LIST." + (mapcar (lambda (x) + (if (string-match "(.*)$" x) + (substring x 0 (match-beginning 0)) + x)) + list)) + +(defun org-assign-fast-keys (alist) + "Assign fast keys to a keyword-key alist. +Respect keys that are already there." + (let (new e (alt ?0)) + (while (setq e (pop alist)) + (if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup)) + (cdr e)) ;; Key already assigned. + (push e new) + (let ((clist (string-to-list (downcase (car e)))) + (used (append new alist))) + (when (= (car clist) ?@) + (pop clist)) + (while (and clist (rassoc (car clist) used)) + (pop clist)) + (unless clist + (while (rassoc alt used) + (incf alt))) + (push (cons (car e) (or (car clist) alt)) new)))) + (nreverse new))) + +;;; Some variables used in various places + +(defvar org-window-configuration nil + "Used in various places to store a window configuration.") +(defvar org-selected-window nil + "Used in various places to store a window configuration.") +(defvar org-finish-function nil + "Function to be called when `C-c C-c' is used. +This is for getting out of special buffers like capture.") + + +;; FIXME: Occasionally check by commenting these, to make sure +;; no other functions uses these, forgetting to let-bind them. +(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el +(defvar org-last-state) +(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el + +;; Defined somewhere in this file, but used before definition. +(defvar org-entities) ;; defined in org-entities.el +(defvar org-struct-menu) +(defvar org-org-menu) +(defvar org-tbl-menu) + +;;;; Define the Org-mode + +;; We use a before-change function to check if a table might need +;; an update. +(defvar org-table-may-need-update t + "Indicates that a table might need an update. +This variable is set by `org-before-change-function'. +`org-table-align' sets it back to nil.") +(defun org-before-change-function (beg end) + "Every change indicates that a table might need an update." + (setq org-table-may-need-update t)) +(defvar org-mode-map) +(defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param. +(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. +(defvar org-inhibit-logging nil) ; Dynamically-scoped param. +(defvar org-inhibit-blocking nil) ; Dynamically-scoped param. +(defvar org-table-buffer-is-an nil) + +(defvar bidi-paragraph-direction) +(defvar buffer-face-mode-face) + +(require 'outline) +(if (and (not (keymapp outline-mode-map)) (featurep 'allout)) + (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22")) +(require 'noutline "noutline" 'noerror) ;; stock XEmacs does not have it + +;; Other stuff we need. +(require 'time-date) +(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) +(require 'easymenu) +(require 'overlay) + +;; (require 'org-macs) moved higher up in the file before it is first used +(require 'org-entities) +;; (require 'org-compat) moved higher up in the file before it is first used +(require 'org-faces) +(require 'org-list) +(require 'org-pcomplete) +(require 'org-src) +(require 'org-footnote) +(require 'org-macro) + +;; babel +(require 'ob) + +;;;###autoload +(define-derived-mode org-mode outline-mode "Org" + "Outline-based notes management and organizer, alias +\"Carsten's outline-mode for keeping track of everything.\" + +Org-mode develops organizational tasks around a NOTES file which +contains information about projects as plain text. Org-mode is +implemented on top of outline-mode, which is ideal to keep the content +of large files well structured. It supports ToDo items, deadlines and +time stamps, which magically appear in the diary listing of the Emacs +calendar. Tables are easily created with a built-in table editor. +Plain text URL-like links connect to websites, emails (VM), Usenet +messages (Gnus), BBDB entries, and any files related to the project. +For printing and sharing of notes, an Org-mode file (or a part of it) +can be exported as a structured ASCII or HTML file. + +The following commands are available: + +\\{org-mode-map}" + + ;; Get rid of Outline menus, they are not needed + ;; Need to do this here because define-derived-mode sets up + ;; the keymap so late. Still, it is a waste to call this each time + ;; we switch another buffer into org-mode. + (if (featurep 'xemacs) + (when (boundp 'outline-mode-menu-heading) + ;; Assume this is Greg's port, it uses easymenu + (easy-menu-remove outline-mode-menu-heading) + (easy-menu-remove outline-mode-menu-show) + (easy-menu-remove outline-mode-menu-hide)) + (define-key org-mode-map [menu-bar headings] 'undefined) + (define-key org-mode-map [menu-bar hide] 'undefined) + (define-key org-mode-map [menu-bar show] 'undefined)) + + (org-load-modules-maybe) + (easy-menu-add org-org-menu) + (easy-menu-add org-tbl-menu) + (org-install-agenda-files-menu) + (if org-descriptive-links (add-to-invisibility-spec '(org-link))) + (add-to-invisibility-spec '(org-cwidth)) + (add-to-invisibility-spec '(org-hide-block . t)) + (when (featurep 'xemacs) + (org-set-local 'line-move-ignore-invisible t)) + (org-set-local 'outline-regexp org-outline-regexp) + (org-set-local 'outline-level 'org-outline-level) + (setq bidi-paragraph-direction 'left-to-right) + (when (and org-ellipsis + (fboundp 'set-display-table-slot) (boundp 'buffer-display-table) + (fboundp 'make-glyph-code)) + (unless org-display-table + (setq org-display-table (make-display-table))) + (set-display-table-slot + org-display-table 4 + (vconcat (mapcar + (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis)) + org-ellipsis))) + (if (stringp org-ellipsis) org-ellipsis "...")))) + (setq buffer-display-table org-display-table)) + (org-set-regexps-and-options-for-tags) + (org-set-regexps-and-options) + (org-set-font-lock-defaults) + (when (and org-tag-faces (not org-tags-special-faces-re)) + ;; tag faces set outside customize.... force initialization. + (org-set-tag-faces 'org-tag-faces org-tag-faces)) + ;; Calc embedded + (org-set-local 'calc-embedded-open-mode "# ") + ;; Modify a few syntax entries + (modify-syntax-entry ?@ "w") + (modify-syntax-entry ?\" "\"") + (modify-syntax-entry ?\\ "_") + (modify-syntax-entry ?~ "_") + (if org-startup-truncated (setq truncate-lines t)) + (when org-startup-indented (require 'org-indent) (org-indent-mode 1)) + (org-set-local 'font-lock-unfontify-region-function + 'org-unfontify-region) + ;; Activate before-change-function + (org-set-local 'org-table-may-need-update t) + (org-add-hook 'before-change-functions 'org-before-change-function nil + 'local) + ;; Check for running clock before killing a buffer + (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) + ;; Initialize macros templates. + (org-macro-initialize-templates) + ;; Initialize radio targets. + (org-update-radio-target-regexp) + ;; Indentation. + (org-set-local 'indent-line-function 'org-indent-line) + (org-set-local 'indent-region-function 'org-indent-region) + ;; Filling and auto-filling. + (org-setup-filling) + ;; Comments. + (org-setup-comments-handling) + ;; Beginning/end of defun + (org-set-local 'beginning-of-defun-function 'org-backward-element) + (org-set-local 'end-of-defun-function + (lambda () + (if (not (org-at-heading-p)) + (org-forward-element) + (org-forward-element) + (forward-char -1)))) + ;; Next error for sparse trees + (org-set-local 'next-error-function 'org-occur-next-match) + ;; Make sure dependence stuff works reliably, even for users who set it + ;; too late :-( + (if org-enforce-todo-dependencies + (add-hook 'org-blocker-hook + 'org-block-todo-from-children-or-siblings-or-parent) + (remove-hook 'org-blocker-hook + 'org-block-todo-from-children-or-siblings-or-parent)) + (if org-enforce-todo-checkbox-dependencies + (add-hook 'org-blocker-hook + 'org-block-todo-from-checkboxes) + (remove-hook 'org-blocker-hook + 'org-block-todo-from-checkboxes)) + + ;; Align options lines + (org-set-local + 'align-mode-rules-list + '((org-in-buffer-settings + (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") + (modes . '(org-mode))))) + + ;; Imenu + (org-set-local 'imenu-create-index-function + 'org-imenu-get-tree) + + ;; Make isearch reveal context + (if (or (featurep 'xemacs) + (not (boundp 'outline-isearch-open-invisible-function))) + ;; Emacs 21 and XEmacs make use of the hook + (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local) + ;; Emacs 22 deals with this through a special variable + (org-set-local 'outline-isearch-open-invisible-function + (lambda (&rest ignore) (org-show-context 'isearch)))) + + ;; Setup the pcomplete hooks + (set (make-local-variable 'pcomplete-command-completion-function) + 'org-pcomplete-initial) + (set (make-local-variable 'pcomplete-command-name-function) + 'org-command-at-point) + (set (make-local-variable 'pcomplete-default-completion-function) + 'ignore) + (set (make-local-variable 'pcomplete-parse-arguments-function) + 'org-parse-arguments) + (set (make-local-variable 'pcomplete-termination-string) "") + (when (>= emacs-major-version 23) + (set (make-local-variable 'buffer-face-mode-face) 'org-default)) + + ;; If empty file that did not turn on org-mode automatically, make it to. + (if (and org-insert-mode-line-in-empty-file + (org-called-interactively-p 'any) + (= (point-min) (point-max))) + (insert "# -*- mode: org -*-\n\n")) + (unless org-inhibit-startup + (org-unmodified + (and org-startup-with-beamer-mode (org-beamer-mode)) + (when org-startup-align-all-tables + (org-table-map-tables 'org-table-align 'quietly)) + (when org-startup-with-inline-images + (org-display-inline-images)) + (when org-startup-with-latex-preview + (org-preview-latex-fragment)) + (unless org-inhibit-startup-visibility-stuff + (org-set-startup-visibility)))) + ;; Try to set org-hide correctly + (let ((foreground (org-find-invisible-foreground))) + (if foreground + (set-face-foreground 'org-hide foreground)))) + +;; Update `customize-package-emacs-version-alist' +(add-to-list 'customize-package-emacs-version-alist + '(Org ("6.21b" . "23.1") ("6.33x" . "23.2") + ("7.8.11" . "24.1") ("7.9.4" . "24.3") + ("8.2.6" . "24.4"))) + +(defvar org-mode-transpose-word-syntax-table + (let ((st (make-syntax-table))) + (mapc (lambda(c) (modify-syntax-entry + (string-to-char (car c)) "w p" st)) + org-emphasis-alist) + st)) + +(when (fboundp 'abbrev-table-put) + (abbrev-table-put org-mode-abbrev-table + :parents (list text-mode-abbrev-table))) + +(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) + +(defun org-find-invisible-foreground () + (let ((candidates (remove + "unspecified-bg" + (nconc + (list (face-background 'default) + (face-background 'org-default)) + (mapcar + (lambda (alist) + (when (boundp alist) + (cdr (assoc 'background-color (symbol-value alist))))) + '(default-frame-alist initial-frame-alist window-system-default-frame-alist)) + (list (face-foreground 'org-hide)))))) + (car (remove nil candidates)))) + +(defun org-current-time (&optional rounding-minutes past) + "Current time, possibly rounded to ROUNDING-MINUTES. +When ROUNDING-MINUTES is not an integer, fall back on the car of +`org-time-stamp-rounding-minutes'. When PAST is non-nil, ensure +the rounding returns a past time." + (let ((r (or (and (integerp rounding-minutes) rounding-minutes) + (car org-time-stamp-rounding-minutes))) + (time (decode-time)) res) + (if (< r 1) + (current-time) + (setq res + (apply 'encode-time + (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) + (nthcdr 2 time)))) + (if (and past (< (org-float-time (time-subtract (current-time) res)) 0)) + (seconds-to-time (- (org-float-time res) (* r 60))) + res)))) + +(defun org-today () + "Return today date, considering `org-extend-today-until'." + (time-to-days + (time-subtract (current-time) + (list 0 (* 3600 org-extend-today-until) 0)))) + +;;;; Font-Lock stuff, including the activators + +(defvar org-mouse-map (make-sparse-keymap)) +(org-defkey org-mouse-map [mouse-2] 'org-open-at-mouse) +(org-defkey org-mouse-map [mouse-3] 'org-find-file-at-mouse) +(when org-mouse-1-follows-link + (org-defkey org-mouse-map [follow-link] 'mouse-face)) +(when org-tab-follows-link + (org-defkey org-mouse-map [(tab)] 'org-open-at-point) + (org-defkey org-mouse-map "\C-i" 'org-open-at-point)) + +(require 'font-lock) + +(defconst org-non-link-chars "]\t\n\r<>") +(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" + "shell" "elisp" "doi" "message")) +(defvar org-link-types-re nil + "Matches a link that has a url-like prefix like \"http:\"") +(defvar org-link-re-with-space nil + "Matches a link with spaces, optional angular brackets around it.") +(defvar org-link-re-with-space2 nil + "Matches a link with spaces, optional angular brackets around it.") +(defvar org-link-re-with-space3 nil + "Matches a link with spaces, only for internal part in bracket links.") +(defvar org-angle-link-re nil + "Matches link with angular brackets, spaces are allowed.") +(defvar org-plain-link-re nil + "Matches plain link, without spaces.") +(defvar org-bracket-link-regexp nil + "Matches a link in double brackets.") +(defvar org-bracket-link-analytic-regexp nil + "Regular expression used to analyze links. +Here is what the match groups contain after a match: +1: http: +2: http +3: path +4: [desc] +5: desc") +(defvar org-bracket-link-analytic-regexp++ nil + "Like `org-bracket-link-analytic-regexp', but include coderef internal type.") +(defvar org-any-link-re nil + "Regular expression matching any link.") + +(defconst org-match-sexp-depth 3 + "Number of stacked braces for sub/superscript matching.") + +(defun org-create-multibrace-regexp (left right n) + "Create a regular expression which will match a balanced sexp. +Opening delimiter is LEFT, and closing delimiter is RIGHT, both given +as single character strings. +The regexp returned will match the entire expression including the +delimiters. It will also define a single group which contains the +match except for the outermost delimiters. The maximum depth of +stacked delimiters is N. Escaping delimiters is not possible." + (let* ((nothing (concat "[^" left right "]*?")) + (or "\\|") + (re nothing) + (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) + (while (> n 1) + (setq n (1- n) + re (concat re or next) + next (concat "\\(?:" nothing left next right "\\)+" nothing))) + (concat left "\\(" re "\\)" right))) + +(defvar org-match-substring-regexp + (concat + "\\(\\S-\\)\\([_^]\\)\\(" + "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" + "\\|" + "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" + "\\|" + "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") + "The regular expression matching a sub- or superscript.") + +(defvar org-match-substring-with-braces-regexp + (concat + "\\(\\S-\\)\\([_^]\\)\\(" + "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" + "\\)") + "The regular expression matching a sub- or superscript, forcing braces.") + +(defun org-make-link-regexps () + "Update the link regular expressions. +This should be called after the variable `org-link-types' has changed." + (let ((types-re (regexp-opt org-link-types t))) + (setq org-link-types-re + (concat "\\`" types-re ":") + org-link-re-with-space + (concat "<?" types-re ":" + "\\([^" org-non-link-chars " ]" + "[^" org-non-link-chars "]*" + "[^" org-non-link-chars " ]\\)>?") + org-link-re-with-space2 + (concat "<?" types-re ":" + "\\([^" org-non-link-chars " ]" + "[^\t\n\r]*" + "[^" org-non-link-chars " ]\\)>?") + org-link-re-with-space3 + (concat "<?" types-re ":" + "\\([^" org-non-link-chars " ]" + "[^\t\n\r]*\\)") + org-angle-link-re + (concat "<" types-re ":" + "\\([^" org-non-link-chars " ]" + "[^" org-non-link-chars "]*" + "\\)>") + org-plain-link-re + (concat + "\\<" types-re ":" + (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")) + ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)") + org-bracket-link-regexp + "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" + org-bracket-link-analytic-regexp + (concat + "\\[\\[" + "\\(" types-re ":\\)?" + "\\([^]]+\\)" + "\\]" + "\\(\\[" "\\([^]]+\\)" "\\]\\)?" + "\\]") + org-bracket-link-analytic-regexp++ + (concat + "\\[\\[" + "\\(" (regexp-opt (cons "coderef" org-link-types) t) ":\\)?" + "\\([^]]+\\)" + "\\]" + "\\(\\[" "\\([^]]+\\)" "\\]\\)?" + "\\]") + org-any-link-re + (concat "\\(" org-bracket-link-regexp "\\)\\|\\(" + org-angle-link-re "\\)\\|\\(" + org-plain-link-re "\\)")))) + +(org-make-link-regexps) + +(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>" + "Regular expression for fast time stamp matching.") +(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]" + "Regular expression for fast time stamp matching.") +(defconst org-ts-regexp0 + "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" + "Regular expression matching time strings for analysis. +This one does not require the space after the date, so it can be used +on a string that terminates immediately after the date.") +(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" + "Regular expression matching time strings for analysis.") +(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>") + "Regular expression matching time stamps, with groups.") +(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]") + "Regular expression matching time stamps (also [..]), with groups.") +(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) + "Regular expression matching a time stamp range.") +(defconst org-tr-regexp-both + (concat org-ts-regexp-both "--?-?" org-ts-regexp-both) + "Regular expression matching a time stamp range.") +(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" + org-ts-regexp "\\)?") + "Regular expression matching a time stamp or time stamp range.") +(defconst org-tsr-regexp-both + (concat org-ts-regexp-both "\\(--?-?" + org-ts-regexp-both "\\)?") + "Regular expression matching a time stamp or time stamp range. +The time stamps may be either active or inactive.") + +(defvar org-emph-face nil) + +(defun org-do-emphasis-faces (limit) + "Run through the buffer and add overlays to emphasized strings." + (let (rtn a) + (while (and (not rtn) (re-search-forward org-emph-re limit t)) + (let* ((border (char-after (match-beginning 3))) + (bre (regexp-quote (char-to-string border)))) + (if (and (not (= border (char-after (match-beginning 4)))) + (not (save-match-data + (string-match (concat bre ".*" bre) + (replace-regexp-in-string + "\n" " " + (substring (match-string 2) 1 -1)))))) + (progn + (setq rtn t) + (setq a (assoc (match-string 3) org-emphasis-alist)) + (font-lock-prepend-text-property (match-beginning 2) (match-end 2) + 'face + (nth 1 a)) + (and (nth 2 a) + (org-remove-flyspell-overlays-in + (match-beginning 0) (match-end 0))) + (add-text-properties (match-beginning 2) (match-end 2) + '(font-lock-multiline t org-emphasis t)) + (when org-hide-emphasis-markers + (add-text-properties (match-end 4) (match-beginning 5) + '(invisible org-link)) + (add-text-properties (match-beginning 3) (match-end 3) + '(invisible org-link)))))) + (goto-char (1+ (match-beginning 0)))) + rtn)) + +(defun org-emphasize (&optional char) + "Insert or change an emphasis, i.e. a font like bold or italic. +If there is an active region, change that region to a new emphasis. +If there is no region, just insert the marker characters and position +the cursor between them. +CHAR should be the marker character. If it is a space, it means to +remove the emphasis of the selected region. +If CHAR is not given (for example in an interactive call) it will be +prompted for." + (interactive) + (let ((erc org-emphasis-regexp-components) + (prompt "") + (string "") beg end move c s) + (if (org-region-active-p) + (setq beg (region-beginning) end (region-end) + string (buffer-substring beg end)) + (setq move t)) + + (unless char + (message "Emphasis marker or tag: [%s]" + (mapconcat (lambda(e) (car e)) org-emphasis-alist "")) + (setq char (read-char-exclusive))) + (if (equal char ?\ ) + (setq s "" move nil) + (unless (assoc (char-to-string char) org-emphasis-alist) + (user-error "No such emphasis marker: \"%c\"" char)) + (setq s (char-to-string char))) + (while (and (> (length string) 1) + (equal (substring string 0 1) (substring string -1)) + (assoc (substring string 0 1) org-emphasis-alist)) + (setq string (substring string 1 -1))) + (setq string (concat s string s)) + (if beg (delete-region beg end)) + (unless (or (bolp) + (string-match (concat "[" (nth 0 erc) "\n]") + (char-to-string (char-before (point))))) + (insert " ")) + (unless (or (eobp) + (string-match (concat "[" (nth 1 erc) "\n]") + (char-to-string (char-after (point))))) + (insert " ") (backward-char 1)) + (insert string) + (and move (backward-char 1)))) + +(defconst org-nonsticky-props + '(mouse-face highlight keymap invisible intangible help-echo org-linked-text htmlize-link)) + +(defsubst org-rear-nonsticky-at (pos) + (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props))) + +(defun org-activate-plain-links (limit) + "Run through the buffer and add overlays to links." + (let (f hl) + (when (and (re-search-forward (concat org-plain-link-re) limit t) + (not (org-in-src-block-p))) + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (setq f (get-text-property (match-beginning 0) 'face)) + (setq hl (org-match-string-no-properties 0)) + (if (or (eq f 'org-tag) + (and (listp f) (memq 'org-tag f))) + nil + (add-text-properties (match-beginning 0) (match-end 0) + (list 'mouse-face 'highlight + 'face 'org-link + 'htmlize-link `(:uri ,hl) + 'keymap org-mouse-map)) + (org-rear-nonsticky-at (match-end 0))) + t))) + +(defun org-activate-code (limit) + (if (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) + (progn + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) + t))) + +(defcustom org-src-fontify-natively nil + "When non-nil, fontify code in code blocks." + :type 'boolean + :version "24.1" + :group 'org-appearance + :group 'org-babel) + +(defcustom org-allow-promoting-top-level-subtree nil + "When non-nil, allow promoting a top level subtree. +The leading star of the top level headline will be replaced +by a #." + :type 'boolean + :version "24.1" + :group 'org-appearance) + +(defun org-fontify-meta-lines-and-blocks (limit) + (condition-case nil + (org-fontify-meta-lines-and-blocks-1 limit) + (error (message "org-mode fontification error")))) + +(defun org-fontify-meta-lines-and-blocks-1 (limit) + "Fontify #+ lines and blocks." + (let ((case-fold-search t)) + (if (re-search-forward + "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" + limit t) + (let ((beg (match-beginning 0)) + (block-start (match-end 0)) + (block-end nil) + (lang (match-string 7)) + (beg1 (line-beginning-position 2)) + (dc1 (downcase (match-string 2))) + (dc3 (downcase (match-string 3))) + end end1 quoting block-type ovl) + (cond + ((member dc1 '("+html:" "+ascii:" "+latex:")) + ;; a single line of backend-specific content + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (remove-text-properties (match-beginning 0) (match-end 0) + '(display t invisible t intangible t)) + (add-text-properties (match-beginning 1) (match-end 3) + '(font-lock-fontified t face org-meta-line)) + (add-text-properties (match-beginning 6) (+ (match-end 6) 1) + '(font-lock-fontified t face org-block)) + ; for backend-specific code + t) + ((and (match-end 4) (equal dc3 "+begin")) + ;; Truly a block + (setq block-type (downcase (match-string 5)) + quoting (member block-type org-protecting-blocks)) + (when (re-search-forward + (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*") + nil t) ;; on purpose, we look further than LIMIT + (setq end (min (point-max) (match-end 0)) + end1 (min (point-max) (1- (match-beginning 0)))) + (setq block-end (match-beginning 0)) + (when quoting + (remove-text-properties beg end + '(display t invisible t intangible t))) + (add-text-properties + beg end + '(font-lock-fontified t font-lock-multiline t)) + (add-text-properties beg beg1 '(face org-meta-line)) + (add-text-properties end1 (min (point-max) (1+ end)) + '(face org-meta-line)) ; for end_src + (cond + ((and lang (not (string= lang "")) org-src-fontify-natively) + (org-src-font-lock-fontify-block lang block-start block-end) + ;; remove old background overlays + (mapc (lambda (ov) + (if (eq (overlay-get ov 'face) 'org-block-background) + (delete-overlay ov))) + (overlays-at (/ (+ beg1 block-end) 2))) + ;; add a background overlay + (setq ovl (make-overlay beg1 block-end)) + (overlay-put ovl 'face 'org-block-background) + (overlay-put ovl 'evaporate t)) ;; make it go away when empty + (quoting + (add-text-properties beg1 (min (point-max) (1+ end1)) + '(face org-block))) ; end of source block + ((not org-fontify-quote-and-verse-blocks)) + ((string= block-type "quote") + (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote))) + ((string= block-type "verse") + (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse)))) + (add-text-properties beg beg1 '(face org-block-begin-line)) + (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1)) + '(face org-block-end-line)) + t)) + ((member dc1 '("+title:" "+author:" "+email:" "+date:")) + (add-text-properties + beg (match-end 3) + (if (member (intern (substring dc1 1 -1)) org-hidden-keywords) + '(font-lock-fontified t invisible t) + '(font-lock-fontified t face org-document-info-keyword))) + (add-text-properties + (match-beginning 6) (min (point-max) (1+ (match-end 6))) + (if (string-equal dc1 "+title:") + '(font-lock-fontified t face org-document-title) + '(font-lock-fontified t face org-document-info)))) + ((or (equal dc1 "+results") + (member dc1 '("+begin:" "+end:" "+caption:" "+label:" + "+orgtbl:" "+tblfm:" "+tblname:" "+results:" + "+call:" "+header:" "+headers:" "+name:")) + (and (match-end 4) (equal dc3 "+attr"))) + (add-text-properties + beg (match-end 0) + '(font-lock-fontified t face org-meta-line)) + t) + ((member dc3 '(" " "")) + (add-text-properties + beg (match-end 0) + '(font-lock-fontified t face font-lock-comment-face))) + ((not (member (char-after beg) '(?\ ?\t))) + ;; just any other in-buffer setting, but not indented + (add-text-properties + beg (match-end 0) + '(font-lock-fontified t face org-meta-line)) + t) + (t nil)))))) + +(defun org-activate-angle-links (limit) + "Run through the buffer and add overlays to links." + (if (and (re-search-forward org-angle-link-re limit t) + (not (org-in-src-block-p))) + (progn + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (add-text-properties (match-beginning 0) (match-end 0) + (list 'mouse-face 'highlight + 'keymap org-mouse-map)) + (org-rear-nonsticky-at (match-end 0)) + t))) + +(defun org-activate-footnote-links (limit) + "Run through the buffer and add overlays to footnotes." + (let ((fn (org-footnote-next-reference-or-definition limit))) + (when fn + (let ((beg (nth 1 fn)) (end (nth 2 fn))) + (org-remove-flyspell-overlays-in beg end) + (add-text-properties beg end + (list 'mouse-face 'highlight + 'keymap org-mouse-map + 'help-echo + (if (= (point-at-bol) beg) + "Footnote definition" + "Footnote reference") + 'font-lock-fontified t + 'font-lock-multiline t + 'face 'org-footnote)))))) + +(defun org-activate-bracket-links (limit) + "Run through the buffer and add overlays to bracketed links." + (if (and (re-search-forward org-bracket-link-regexp limit t) + (not (org-in-src-block-p))) + (let* ((hl (org-match-string-no-properties 1)) + (help (concat "LINK: " (save-match-data (org-link-unescape hl)))) + (ip (org-maybe-intangible + (list 'invisible 'org-link + 'keymap org-mouse-map 'mouse-face 'highlight + 'font-lock-multiline t 'help-echo help + 'htmlize-link `(:uri ,hl)))) + (vp (list 'keymap org-mouse-map 'mouse-face 'highlight + 'font-lock-multiline t 'help-echo help + 'htmlize-link `(:uri ,hl)))) + ;; We need to remove the invisible property here. Table narrowing + ;; may have made some of this invisible. + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (remove-text-properties (match-beginning 0) (match-end 0) + '(invisible nil)) + (if (match-end 3) + (progn + (add-text-properties (match-beginning 0) (match-beginning 3) ip) + (org-rear-nonsticky-at (match-beginning 3)) + (add-text-properties (match-beginning 3) (match-end 3) vp) + (org-rear-nonsticky-at (match-end 3)) + (add-text-properties (match-end 3) (match-end 0) ip) + (org-rear-nonsticky-at (match-end 0))) + (add-text-properties (match-beginning 0) (match-beginning 1) ip) + (org-rear-nonsticky-at (match-beginning 1)) + (add-text-properties (match-beginning 1) (match-end 1) vp) + (org-rear-nonsticky-at (match-end 1)) + (add-text-properties (match-end 1) (match-end 0) ip) + (org-rear-nonsticky-at (match-end 0))) + t))) + +(defun org-activate-dates (limit) + "Run through the buffer and add overlays to dates." + (if (and (re-search-forward org-tsr-regexp-both limit t) + (not (equal (char-before (match-beginning 0)) 91))) + (progn + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (add-text-properties (match-beginning 0) (match-end 0) + (list 'mouse-face 'highlight + 'keymap org-mouse-map)) + (org-rear-nonsticky-at (match-end 0)) + (when org-display-custom-times + (if (match-end 3) + (org-display-custom-time (match-beginning 3) (match-end 3))) + (org-display-custom-time (match-beginning 1) (match-end 1))) + t))) + +(defvar org-target-link-regexp nil + "Regular expression matching radio targets in plain text.") +(make-variable-buffer-local 'org-target-link-regexp) +(defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>" + "Regular expression matching a link target.") +(defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>" + "Regular expression matching a radio target.") +(defvar org-any-target-regexp "<<<?\\([^<>\n\r]+\\)>>>?" ; FIXME, not exact, would match <<<aaa>> as a radio target. + "Regular expression matching any target.") + +(defun org-activate-target-links (limit) + "Run through the buffer and add overlays to target matches." + (when org-target-link-regexp + (let ((case-fold-search t)) + (if (re-search-forward org-target-link-regexp limit t) + (progn + (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) + (add-text-properties (match-beginning 0) (match-end 0) + (list 'mouse-face 'highlight + 'keymap org-mouse-map + 'help-echo "Radio target link" + 'org-linked-text t)) + (org-rear-nonsticky-at (match-end 0)) + t))))) + +(defun org-update-radio-target-regexp () + "Find all radio targets in this file and update the regular expression." + (interactive) + (when (memq 'radio org-activate-links) + (setq org-target-link-regexp + (org-make-target-link-regexp (org-all-targets 'radio))) + (org-restart-font-lock))) + +(defun org-hide-wide-columns (limit) + (let (s e) + (setq s (text-property-any (point) (or limit (point-max)) + 'org-cwidth t)) + (when s + (setq e (next-single-property-change s 'org-cwidth)) + (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth))) + (goto-char e) + t))) + +(defvar org-latex-and-related-regexp nil + "Regular expression for highlighting LaTeX, entities and sub/superscript.") +(defvar org-match-substring-regexp) +(defvar org-match-substring-with-braces-regexp) + +(defun org-compute-latex-and-related-regexp () + "Compute regular expression for LaTeX, entities and sub/superscript. +Result depends on variable `org-highlight-latex-and-related'." + (org-set-local + 'org-latex-and-related-regexp + (let* ((re-sub + (cond ((not (memq 'script org-highlight-latex-and-related)) nil) + ((eq org-use-sub-superscripts '{}) + (list org-match-substring-with-braces-regexp)) + (org-use-sub-superscripts (list org-match-substring-regexp)))) + (re-latex + (when (memq 'latex org-highlight-latex-and-related) + (let ((matchers (plist-get org-format-latex-options :matchers))) + (delq nil + (mapcar (lambda (x) + (and (member (car x) matchers) (nth 1 x))) + org-latex-regexps))))) + (re-entities + (when (memq 'entities org-highlight-latex-and-related) + (list "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")))) + (mapconcat 'identity (append re-latex re-entities re-sub) "\\|")))) + +(defun org-do-latex-and-related (limit) + "Highlight LaTeX snippets and environments, entities and sub/superscript. +LIMIT bounds the search for syntax to highlight. Stop at first +highlighted object, if any. Return t if some highlighting was +done, nil otherwise." + (when (org-string-nw-p org-latex-and-related-regexp) + (catch 'found + (while (re-search-forward org-latex-and-related-regexp limit t) + (unless (memq (car-safe (get-text-property (1+ (match-beginning 0)) + 'face)) + '(org-code org-verbatim underline)) + (let ((offset (if (memq (char-after (1+ (match-beginning 0))) + '(?_ ?^)) + 1 + 0))) + (font-lock-prepend-text-property + (+ offset (match-beginning 0)) (match-end 0) + 'face 'org-latex-and-related) + (add-text-properties (+ offset (match-beginning 0)) (match-end 0) + '(font-lock-multiline t))) + (throw 'found t))) + nil))) + +(defun org-restart-font-lock () + "Restart `font-lock-mode', to force refontification." + (when (and (boundp 'font-lock-mode) font-lock-mode) + (font-lock-mode -1) + (font-lock-mode 1))) + +(defun org-all-targets (&optional radio) + "Return a list of all targets in this file. +When optional argument RADIO is non-nil, only find radio +targets." + (let ((re (if radio org-radio-target-regexp org-target-regexp)) rtn) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward re nil t) + ;; Make sure point is really within the object. + (backward-char) + (let ((obj (org-element-context))) + (when (memq (org-element-type obj) '(radio-target target)) + (add-to-list 'rtn (downcase (org-element-property :value obj)))))) + rtn))) + +(defun org-make-target-link-regexp (targets) + "Make regular expression matching all strings in TARGETS. +The regular expression finds the targets also if there is a line break +between words." + (and targets + (concat + "\\_<\\(" + (mapconcat + (lambda (x) + (setq x (regexp-quote x)) + (while (string-match " +" x) + (setq x (replace-match "\\s-+" t t x))) + x) + targets + "\\|") + "\\)\\_>"))) + +(defun org-activate-tags (limit) + (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \r\n]") limit t) + (progn + (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) + (add-text-properties (match-beginning 1) (match-end 1) + (list 'mouse-face 'highlight + 'keymap org-mouse-map)) + (org-rear-nonsticky-at (match-end 1)) + t))) + +(defun org-outline-level () + "Compute the outline level of the heading at point. +If this is called at a normal headline, the level is the number of stars. +Use `org-reduced-level' to remove the effect of `org-odd-levels'." + (save-excursion + (if (not (condition-case nil + (org-back-to-heading t) + (error nil))) + 0 + (looking-at org-outline-regexp) + (1- (- (match-end 0) (match-beginning 0)))))) + +(defvar org-font-lock-keywords nil) + +(defsubst org-re-property (property &optional literal allow-null) + "Return a regexp matching a PROPERTY line. + +When optional argument LITERAL is non-nil, do not quote PROPERTY. +This is useful when PROPERTY is a regexp. When ALLOW-NULL is +non-nil, match properties even without a value. + +Match group 3 is set to the value when it exists. If there is no +value and ALLOW-NULL is non-nil, it is set to the empty string." + (concat + "^\\(?4:[ \t]*\\)" + (format "\\(?1::\\(?2:%s\\):\\)" + (if literal property (regexp-quote property))) + (if allow-null + "\\(?:\\(?3:$\\)\\|[ \t]+\\(?3:.*?\\)\\)\\(?5:[ \t]*\\)$" + "[ \t]+\\(?3:[^ \r\t\n]+.*?\\)\\(?5:[ \t]*\\)$"))) + +(defconst org-property-re + (org-re-property ".*?" 'literal t) + "Regular expression matching a property line. +There are four matching groups: +1: :PROPKEY: including the leading and trailing colon, +2: PROPKEY without the leading and trailing colon, +3: PROPVAL without leading or trailing spaces, +4: the indentation of the current line, +5: trailing whitespace.") + +(defvar org-font-lock-hook nil + "Functions to be called for special font lock stuff.") + +(defvar org-font-lock-set-keywords-hook nil + "Functions that can manipulate `org-font-lock-extra-keywords'. +This is called after `org-font-lock-extra-keywords' is defined, but before +it is installed to be used by font lock. This can be useful if something +needs to be inserted at a specific position in the font-lock sequence.") + +(defun org-font-lock-hook (limit) + "Run `org-font-lock-hook' within LIMIT." + (run-hook-with-args 'org-font-lock-hook limit)) + +(defun org-set-font-lock-defaults () + "Set font lock defaults for the current buffer." + (let* ((em org-fontify-emphasized-text) + (lk org-activate-links) + (org-font-lock-extra-keywords + (list + ;; Call the hook + '(org-font-lock-hook) + ;; Headlines + `(,(if org-fontify-whole-heading-line + "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)" + "^\\(\\**\\)\\(\\* \\)\\(.*\\)") + (1 (org-get-level-face 1)) + (2 (org-get-level-face 2)) + (3 (org-get-level-face 3))) + ;; Table lines + '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" + (1 'org-table t)) + ;; Table internals + '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t)) + '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) + '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) + '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t)) + ;; Drawers + (list org-drawer-regexp '(0 'org-special-keyword t)) + (list "^[ \t]*:END:" '(0 'org-special-keyword t)) + ;; Properties + (list org-property-re + '(1 'org-special-keyword t) + '(3 'org-property-value t)) + ;; Links + (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) + (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) + (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) + (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) + (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) + (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) + (if (memq 'footnote lk) '(org-activate-footnote-links)) + ;; Targets. + (list org-any-target-regexp '(0 'org-target t)) + ;; Diary sexps. + '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) + ;; Macro + '("{{{.+}}}" (0 'org-macro t)) + '(org-hide-wide-columns (0 nil append)) + ;; TODO keyword + (list (format org-heading-keyword-regexp-format + org-todo-regexp) + '(2 (org-get-todo-face 2) t)) + ;; DONE + (if org-fontify-done-headline + (list (format org-heading-keyword-regexp-format + (concat + "\\(?:" + (mapconcat 'regexp-quote org-done-keywords "\\|") + "\\)")) + '(2 'org-headline-done t)) + nil) + ;; Priorities + '(org-font-lock-add-priority-faces) + ;; Tags + '(org-font-lock-add-tag-faces) + ;; Tags groups + (if (and org-group-tags org-tag-groups-alist) + (list (concat org-outline-regexp-bol ".+\\(:" + (regexp-opt (mapcar 'car org-tag-groups-alist)) + ":\\).*$") + '(1 'org-tag-group prepend))) + ;; Special keywords + (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) + (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) + (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) + (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t)) + ;; Emphasis + (if em + (if (featurep 'xemacs) + '(org-do-emphasis-faces (0 nil append)) + '(org-do-emphasis-faces))) + ;; Checkboxes + '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)" + 1 'org-checkbox prepend) + (if (cdr (assq 'checkbox org-list-automatic-rules)) + '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" + (0 (org-get-checkbox-statistics-face) t))) + ;; Description list items + '("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)" + 1 'org-list-dt prepend) + ;; ARCHIVEd headings + (list (concat + org-outline-regexp-bol + "\\(.*:" org-archive-tag ":.*\\)") + '(1 'org-archived prepend)) + ;; Specials + '(org-do-latex-and-related) + '(org-fontify-entities) + '(org-raise-scripts) + ;; Code + '(org-activate-code (1 'org-code t)) + ;; COMMENT + (list (format org-heading-keyword-regexp-format + (concat "\\(" + org-comment-string "\\|" org-quote-string + "\\)")) + '(2 'org-special-keyword t)) + ;; Blocks and meta lines + '(org-fontify-meta-lines-and-blocks)))) + (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) + (run-hooks 'org-font-lock-set-keywords-hook) + ;; Now set the full font-lock-keywords + (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords) + (org-set-local 'font-lock-defaults + '(org-font-lock-keywords t nil nil backward-paragraph)) + (kill-local-variable 'font-lock-keywords) nil)) + +(defun org-toggle-pretty-entities () + "Toggle the composition display of entities as UTF8 characters." + (interactive) + (org-set-local 'org-pretty-entities (not org-pretty-entities)) + (org-restart-font-lock) + (if org-pretty-entities + (message "Entities are now displayed as UTF8 characters") + (save-restriction + (widen) + (org-decompose-region (point-min) (point-max)) + (message "Entities are now displayed as plain text")))) + +(defvar org-custom-properties-overlays nil + "List of overlays used for custom properties.") +(make-variable-buffer-local 'org-custom-properties-overlays) + +(defun org-toggle-custom-properties-visibility () + "Display or hide properties in `org-custom-properties'." + (interactive) + (if org-custom-properties-overlays + (progn (mapc 'delete-overlay org-custom-properties-overlays) + (setq org-custom-properties-overlays nil)) + (unless (not org-custom-properties) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward org-property-re nil t) + (mapc (lambda(p) + (when (equal p (substring (match-string 1) 1 -1)) + (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0))))) + (overlay-put o 'invisible t) + (overlay-put o 'org-custom-property t) + (push o org-custom-properties-overlays)))) + org-custom-properties))))))) + +(defun org-fontify-entities (limit) + "Find an entity to fontify." + (let (ee) + (when org-pretty-entities + (catch 'match + (while (re-search-forward + "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)" + limit t) + (if (and (not (org-in-indented-comment-line)) + (setq ee (org-entity-get (match-string 1))) + (= (length (nth 6 ee)) 1)) + (let* + ((end (if (equal (match-string 2) "{}") + (match-end 2) + (match-end 1)))) + (add-text-properties + (match-beginning 0) end + (list 'font-lock-fontified t)) + (compose-region (match-beginning 0) end + (nth 6 ee) nil) + (backward-char 1) + (throw 'match t)))) + nil)))) + +(defun org-fontify-like-in-org-mode (s &optional odd-levels) + "Fontify string S like in Org-mode." + (with-temp-buffer + (insert s) + (let ((org-odd-levels-only odd-levels)) + (org-mode) + (font-lock-fontify-buffer) + (buffer-string)))) + +(defvar org-m nil) +(defvar org-l nil) +(defvar org-f nil) +(defun org-get-level-face (n) + "Get the right face for match N in font-lock matching of headlines." + (setq org-l (- (match-end 2) (match-beginning 1) 1)) + (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) + (if org-cycle-level-faces + (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) + (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces))) + (cond + ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) + ((eq n 2) org-f) + (t (if org-level-color-stars-only nil org-f)))) + + +(defun org-get-todo-face (kwd) + "Get the right face for a TODO keyword KWD. +If KWD is a number, get the corresponding match group." + (if (numberp kwd) (setq kwd (match-string kwd))) + (or (org-face-from-face-or-color + 'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces))) + (and (member kwd org-done-keywords) 'org-done) + 'org-todo)) + +(defun org-face-from-face-or-color (context inherit face-or-color) + "Create a face list that inherits INHERIT, but sets the foreground color. +When FACE-OR-COLOR is not a string, just return it." + (if (stringp face-or-color) + (list :inherit inherit + (cdr (assoc context org-faces-easy-properties)) + face-or-color) + face-or-color)) + +(defun org-font-lock-add-tag-faces (limit) + "Add the special tag faces." + (when (and org-tag-faces org-tags-special-faces-re) + (while (re-search-forward org-tags-special-faces-re limit t) + (add-text-properties (match-beginning 1) (match-end 1) + (list 'face (org-get-tag-face 1) + 'font-lock-fontified t)) + (backward-char 1)))) + +(defun org-font-lock-add-priority-faces (limit) + "Add the special priority faces." + (while (re-search-forward "\\[#\\([A-Z0-9]\\)\\]" limit t) + (when (save-match-data (org-at-heading-p)) + (add-text-properties + (match-beginning 0) (match-end 0) + (list 'face (or (org-face-from-face-or-color + 'priority 'org-priority + (cdr (assoc (char-after (match-beginning 1)) + org-priority-faces))) + 'org-priority) + 'font-lock-fontified t))))) + +(defun org-get-tag-face (kwd) + "Get the right face for a TODO keyword KWD. +If KWD is a number, get the corresponding match group." + (if (numberp kwd) (setq kwd (match-string kwd))) + (or (org-face-from-face-or-color + 'tag 'org-tag (cdr (assoc kwd org-tag-faces))) + 'org-tag)) + +(defun org-unfontify-region (beg end &optional maybe_loudly) + "Remove fontification and activation overlays from links." + (font-lock-default-unfontify-region beg end) + (let* ((buffer-undo-list t) + (inhibit-read-only t) (inhibit-point-motion-hooks t) + (inhibit-modification-hooks t) + deactivate-mark buffer-file-name buffer-file-truename) + (org-decompose-region beg end) + (remove-text-properties beg end + '(mouse-face t keymap t org-linked-text t + invisible t intangible t + org-no-flyspell t org-emphasis t)) + (org-remove-font-lock-display-properties beg end))) + +(defconst org-script-display '(((raise -0.3) (height 0.7)) + ((raise 0.3) (height 0.7)) + ((raise -0.5)) + ((raise 0.5))) + "Display properties for showing superscripts and subscripts.") + +(defun org-remove-font-lock-display-properties (beg end) + "Remove specific display properties that have been added by font lock. +The will remove the raise properties that are used to show superscripts +and subscripts." + (let (next prop) + (while (< beg end) + (setq next (next-single-property-change beg 'display nil end) + prop (get-text-property beg 'display)) + (if (member prop org-script-display) + (put-text-property beg next 'display nil)) + (setq beg next)))) + +(defun org-raise-scripts (limit) + "Add raise properties to sub/superscripts." + (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts) + (if (re-search-forward + (if (eq org-use-sub-superscripts t) + org-match-substring-regexp + org-match-substring-with-braces-regexp) + limit t) + (let* ((pos (point)) table-p comment-p + (mpos (match-beginning 3)) + (emph-p (get-text-property mpos 'org-emphasis)) + (link-p (get-text-property mpos 'mouse-face)) + (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) + (goto-char (point-at-bol)) + (setq table-p (org-looking-at-p org-table-dataline-regexp) + comment-p (org-looking-at-p "^[ \t]*#[ +]")) + (goto-char pos) + ;; Handle a_b^c + (if (member (char-after) '(?_ ?^)) (goto-char (1- pos))) + (if (or comment-p emph-p link-p keyw-p) + t + (put-text-property (match-beginning 3) (match-end 0) + 'display + (if (equal (char-after (match-beginning 2)) ?^) + (nth (if table-p 3 1) org-script-display) + (nth (if table-p 2 0) org-script-display))) + (add-text-properties (match-beginning 2) (match-end 2) + (list 'invisible t + 'org-dwidth t 'org-dwidth-n 1)) + (if (and (eq (char-after (match-beginning 3)) ?{) + (eq (char-before (match-end 3)) ?})) + (progn + (add-text-properties + (match-beginning 3) (1+ (match-beginning 3)) + (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)) + (add-text-properties + (1- (match-end 3)) (match-end 3) + (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)))) + t))))) + +;;;; Visibility cycling, including org-goto and indirect buffer + +;;; Cycling + +(defvar org-cycle-global-status nil) +(make-variable-buffer-local 'org-cycle-global-status) +(put 'org-cycle-global-status 'org-state t) +(defvar org-cycle-subtree-status nil) +(make-variable-buffer-local 'org-cycle-subtree-status) +(put 'org-cycle-subtree-status 'org-state t) + +(defvar org-inlinetask-min-level) + +(defun org-unlogged-message (&rest args) + "Display a message, but avoid logging it in the *Messages* buffer." + (let ((message-log-max nil)) + (apply 'message args))) + +;;;###autoload +(defun org-cycle (&optional arg) + "TAB-action and visibility cycling for Org-mode. + +This is the command invoked in Org-mode by the TAB key. Its main purpose +is outline visibility cycling, but it also invokes other actions +in special contexts. + +- When this function is called with a prefix argument, rotate the entire + buffer through 3 states (global cycling) + 1. OVERVIEW: Show only top-level headlines. + 2. CONTENTS: Show all headlines of all levels, but no body text. + 3. SHOW ALL: Show everything. + When called with two `C-u C-u' prefixes, switch to the startup visibility, + determined by the variable `org-startup-folded', and by any VISIBILITY + properties in the buffer. + When called with three `C-u C-u C-u' prefixed, show the entire buffer, + including any drawers. + +- When inside a table, re-align the table and move to the next field. + +- When point is at the beginning of a headline, rotate the subtree started + by this line through 3 different states (local cycling) + 1. FOLDED: Only the main headline is shown. + 2. CHILDREN: The main headline and the direct children are shown. + From this state, you can move to one of the children + and zoom in further. + 3. SUBTREE: Show the entire subtree, including body text. + If there is no subtree, switch directly from CHILDREN to FOLDED. + +- When point is at the beginning of an empty headline and the variable + `org-cycle-level-after-item/entry-creation' is set, cycle the level + of the headline by demoting and promoting it to likely levels. This + speeds up creation document structure by pressing TAB once or several + times right after creating a new headline. + +- When there is a numeric prefix, go up to a heading with level ARG, do + a `show-subtree' and return to the previous cursor position. If ARG + is negative, go up that many levels. + +- When point is not at the beginning of a headline, execute the global + binding for TAB, which is re-indenting the line. See the option + `org-cycle-emulate-tab' for details. + +- Special case: if point is at the beginning of the buffer and there is + no headline in line 1, this function will act as if called with prefix arg + (C-u TAB, same as S-TAB) also when called without prefix arg. + But only if also the variable `org-cycle-global-at-bob' is t." + (interactive "P") + (org-load-modules-maybe) + (unless (or (run-hook-with-args-until-success 'org-tab-first-hook) + (and org-cycle-level-after-item/entry-creation + (or (org-cycle-level) + (org-cycle-item-indentation)))) + (let* ((limit-level + (or org-cycle-max-level + (and (boundp 'org-inlinetask-min-level) + org-inlinetask-min-level + (1- org-inlinetask-min-level)))) + (nstars (and limit-level + (if org-odd-levels-only + (and limit-level (1- (* limit-level 2))) + limit-level))) + (org-outline-regexp + (if (not (derived-mode-p 'org-mode)) + outline-regexp + (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))) + (bob-special (and org-cycle-global-at-bob (not arg) (bobp) + (not (looking-at org-outline-regexp)))) + (org-cycle-hook + (if bob-special + (delq 'org-optimize-window-after-visibility-change + (copy-sequence org-cycle-hook)) + org-cycle-hook)) + (pos (point))) + + (if (or bob-special (equal arg '(4))) + ;; special case: use global cycling + (setq arg t)) + + (cond + + ((equal arg '(16)) + (setq last-command 'dummy) + (org-set-startup-visibility) + (org-unlogged-message "Startup visibility, plus VISIBILITY properties")) + + ((equal arg '(64)) + (show-all) + (org-unlogged-message "Entire buffer visible, including drawers")) + + ;; Try cdlatex TAB completion + ((org-try-cdlatex-tab)) + + ;; Table: enter it or move to the next field. + ((org-at-table-p 'any) + (if (org-at-table.el-p) + (message "Use C-c ' to edit table.el tables") + (if arg (org-table-edit-field t) + (org-table-justify-field-maybe) + (call-interactively 'org-table-next-field)))) + + ((run-hook-with-args-until-success + 'org-tab-after-check-for-table-hook)) + + ;; Global cycling: delegate to `org-cycle-internal-global'. + ((eq arg t) (org-cycle-internal-global)) + + ;; Drawers: delegate to `org-flag-drawer'. + ((and org-drawers org-drawer-regexp + (save-excursion + (beginning-of-line 1) + (looking-at org-drawer-regexp))) + (org-flag-drawer ; toggle block visibility + (not (get-char-property (match-end 0) 'invisible)))) + + ;; Show-subtree, ARG levels up from here. + ((integerp arg) + (save-excursion + (org-back-to-heading) + (outline-up-heading (if (< arg 0) (- arg) + (- (funcall outline-level) arg))) + (org-show-subtree))) + + ;; Inline task: delegate to `org-inlinetask-toggle-visibility'. + ((and (featurep 'org-inlinetask) + (org-inlinetask-at-task-p) + (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) + (org-inlinetask-toggle-visibility)) + + ;; At an item/headline: delegate to `org-cycle-internal-local'. + ((and (or (and org-cycle-include-plain-lists (org-at-item-p)) + (save-excursion (beginning-of-line 1) + (looking-at org-outline-regexp))) + (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) + (org-cycle-internal-local)) + + ;; From there: TAB emulation and template completion. + (buffer-read-only (org-back-to-heading)) + + ((run-hook-with-args-until-success + 'org-tab-after-check-for-cycling-hook)) + + ((org-try-structure-completion)) + + ((run-hook-with-args-until-success + 'org-tab-before-tab-emulation-hook)) + + ((and (eq org-cycle-emulate-tab 'exc-hl-bol) + (or (not (bolp)) + (not (looking-at org-outline-regexp)))) + (call-interactively (global-key-binding "\t"))) + + ((if (and (memq org-cycle-emulate-tab '(white whitestart)) + (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) + (or (and (eq org-cycle-emulate-tab 'white) + (= (match-end 0) (point-at-eol))) + (and (eq org-cycle-emulate-tab 'whitestart) + (>= (match-end 0) pos)))) + t + (eq org-cycle-emulate-tab t)) + (call-interactively (global-key-binding "\t"))) + + (t (save-excursion + (org-back-to-heading) + (org-cycle))))))) + +(defun org-cycle-internal-global () + "Do the global cycling action." + ;; Hack to avoid display of messages for .org attachments in Gnus + (let ((ga (string-match "\\*fontification" (buffer-name)))) + (cond + ((and (eq last-command this-command) + (eq org-cycle-global-status 'overview)) + ;; We just created the overview - now do table of contents + ;; This can be slow in very large buffers, so indicate action + (run-hook-with-args 'org-pre-cycle-hook 'contents) + (unless ga (org-unlogged-message "CONTENTS...")) + (org-content) + (unless ga (org-unlogged-message "CONTENTS...done")) + (setq org-cycle-global-status 'contents) + (run-hook-with-args 'org-cycle-hook 'contents)) + + ((and (eq last-command this-command) + (eq org-cycle-global-status 'contents)) + ;; We just showed the table of contents - now show everything + (run-hook-with-args 'org-pre-cycle-hook 'all) + (show-all) + (unless ga (org-unlogged-message "SHOW ALL")) + (setq org-cycle-global-status 'all) + (run-hook-with-args 'org-cycle-hook 'all)) + + (t + ;; Default action: go to overview + (run-hook-with-args 'org-pre-cycle-hook 'overview) + (org-overview) + (unless ga (org-unlogged-message "OVERVIEW")) + (setq org-cycle-global-status 'overview) + (run-hook-with-args 'org-cycle-hook 'overview))))) + +(defvar org-called-with-limited-levels nil + "Non-nil when `org-with-limited-levels' is currently active.") + +(defun org-cycle-internal-local () + "Do the local cycling action." + (let ((goal-column 0) eoh eol eos has-children children-skipped struct) + ;; First, determine end of headline (EOH), end of subtree or item + ;; (EOS), and if item or heading has children (HAS-CHILDREN). + (save-excursion + (if (org-at-item-p) + (progn + (beginning-of-line) + (setq struct (org-list-struct)) + (setq eoh (point-at-eol)) + (setq eos (org-list-get-item-end-before-blank (point) struct)) + (setq has-children (org-list-has-child-p (point) struct))) + (org-back-to-heading) + (setq eoh (save-excursion (outline-end-of-heading) (point))) + (setq eos (save-excursion (org-end-of-subtree t t) + (when (bolp) (backward-char)) (point))) + (setq has-children + (or (save-excursion + (let ((level (funcall outline-level))) + (outline-next-heading) + (and (org-at-heading-p t) + (> (funcall outline-level) level)))) + (save-excursion + (org-list-search-forward (org-item-beginning-re) eos t))))) + ;; Determine end invisible part of buffer (EOL) + (beginning-of-line 2) + ;; XEmacs doesn't have `next-single-char-property-change' + (if (featurep 'xemacs) + (while (and (not (eobp)) ;; this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (beginning-of-line 2)) + (while (and (not (eobp)) ;; this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (goto-char (next-single-char-property-change (point) 'invisible)) + (and (eolp) (beginning-of-line 2)))) + (setq eol (point))) + ;; Find out what to do next and set `this-command' + (cond + ((= eos eoh) + ;; Nothing is hidden behind this heading + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-pre-cycle-hook 'empty)) + (org-unlogged-message "EMPTY ENTRY") + (setq org-cycle-subtree-status nil) + (save-excursion + (goto-char eos) + (outline-next-heading) + (if (outline-invisible-p) (org-flag-heading nil)))) + ((and (or (>= eol eos) + (not (string-match "\\S-" (buffer-substring eol eos)))) + (or has-children + (not (setq children-skipped + org-cycle-skip-children-state-if-no-children)))) + ;; Entire subtree is hidden in one line: children view + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-pre-cycle-hook 'children)) + (if (org-at-item-p) + (org-list-set-item-visibility (point-at-bol) struct 'children) + (org-show-entry) + (org-with-limited-levels (show-children)) + ;; FIXME: This slows down the func way too much. + ;; How keep drawers hidden in subtree anyway? + ;; (when (memq 'org-cycle-hide-drawers org-cycle-hook) + ;; (org-cycle-hide-drawers 'subtree)) + + ;; Fold every list in subtree to top-level items. + (when (eq org-cycle-include-plain-lists 'integrate) + (save-excursion + (org-back-to-heading) + (while (org-list-search-forward (org-item-beginning-re) eos t) + (beginning-of-line 1) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct)) + (end (org-list-get-bottom-point struct))) + (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded)) + (org-list-get-all-items (point) struct prevs)) + (goto-char (if (< end eos) end eos))))))) + (org-unlogged-message "CHILDREN") + (save-excursion + (goto-char eos) + (outline-next-heading) + (if (outline-invisible-p) (org-flag-heading nil))) + (setq org-cycle-subtree-status 'children) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-cycle-hook 'children))) + ((or children-skipped + (and (eq last-command this-command) + (eq org-cycle-subtree-status 'children))) + ;; We just showed the children, or no children are there, + ;; now show everything. + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-pre-cycle-hook 'subtree)) + (outline-flag-region eoh eos nil) + (org-unlogged-message + (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) + (setq org-cycle-subtree-status 'subtree) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-cycle-hook 'subtree))) + (t + ;; Default action: hide the subtree. + (run-hook-with-args 'org-pre-cycle-hook 'folded) + (outline-flag-region eoh eos t) + (org-unlogged-message "FOLDED") + (setq org-cycle-subtree-status 'folded) + (unless (org-before-first-heading-p) + (run-hook-with-args 'org-cycle-hook 'folded)))))) + +;;;###autoload +(defun org-global-cycle (&optional arg) + "Cycle the global visibility. For details see `org-cycle'. +With \\[universal-argument] prefix arg, switch to startup visibility. +With a numeric prefix, show all headlines up to that level." + (interactive "P") + (let ((org-cycle-include-plain-lists + (if (derived-mode-p 'org-mode) org-cycle-include-plain-lists nil))) + (cond + ((integerp arg) + (show-all) + (hide-sublevels arg) + (setq org-cycle-global-status 'contents)) + ((equal arg '(4)) + (org-set-startup-visibility) + (org-unlogged-message "Startup visibility, plus VISIBILITY properties.")) + (t + (org-cycle '(4)))))) + +(defun org-set-startup-visibility () + "Set the visibility required by startup options and properties." + (cond + ((eq org-startup-folded t) + (org-overview)) + ((eq org-startup-folded 'content) + (org-content)) + ((or (eq org-startup-folded 'showeverything) + (eq org-startup-folded nil)) + (show-all))) + (unless (eq org-startup-folded 'showeverything) + (if org-hide-block-startup (org-hide-block-all)) + (org-set-visibility-according-to-property 'no-cleanup) + (org-cycle-hide-archived-subtrees 'all) + (org-cycle-hide-drawers 'all) + (org-cycle-show-empty-lines t))) + +(defun org-set-visibility-according-to-property (&optional no-cleanup) + "Switch subtree visibilities according to :VISIBILITY: property." + (interactive) + (let (org-show-entry-below state) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*:VISIBILITY:[ \t]+\\([a-z]+\\)" + nil t) + (setq state (match-string 1)) + (save-excursion + (org-back-to-heading t) + (hide-subtree) + (org-reveal) + (cond + ((equal state '("fold" "folded")) + (hide-subtree)) + ((equal state "children") + (org-show-hidden-entry) + (show-children)) + ((equal state "content") + (save-excursion + (save-restriction + (org-narrow-to-subtree) + (org-content)))) + ((member state '("all" "showall")) + (show-subtree))))) + (unless no-cleanup + (org-cycle-hide-archived-subtrees 'all) + (org-cycle-hide-drawers 'all) + (org-cycle-show-empty-lines 'all))))) + +;; This function uses outline-regexp instead of the more fundamental +;; org-outline-regexp so that org-cycle-global works outside of Org +;; buffers, where outline-regexp is needed. +(defun org-overview () + "Switch to overview mode, showing only top-level headlines. +This shows all headlines with a level equal or greater than the level +of the first headline in the buffer. This is important, because if the +first headline is not level one, then (hide-sublevels 1) gives confusing +results." + (interactive) + (save-excursion + (let ((level + (save-excursion + (goto-char (point-min)) + (if (re-search-forward (concat "^" outline-regexp) nil t) + (progn + (goto-char (match-beginning 0)) + (funcall outline-level)))))) + (and level (hide-sublevels level))))) + +(defun org-content (&optional arg) + "Show all headlines in the buffer, like a table of contents. +With numerical argument N, show content up to level N." + (interactive "P") + (org-overview) + (save-excursion + ;; Visit all headings and show their offspring + (and (integerp arg) (org-overview)) + (goto-char (point-max)) + (catch 'exit + (while (and (progn (condition-case nil + (outline-previous-visible-heading 1) + (error (goto-char (point-min)))) + t) + (looking-at org-outline-regexp)) + (if (integerp arg) + (show-children (1- arg)) + (show-branches)) + (if (bobp) (throw 'exit nil)))))) + +(defun org-optimize-window-after-visibility-change (state) + "Adjust the window after a change in outline visibility. +This function is the default value of the hook `org-cycle-hook'." + (when (get-buffer-window (current-buffer)) + (cond + ((eq state 'content) nil) + ((eq state 'all) nil) + ((eq state 'folded) nil) + ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) + ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) + +(defun org-remove-empty-overlays-at (pos) + "Remove outline overlays that do not contain non-white stuff." + (mapc + (lambda (o) + (and (eq 'outline (overlay-get o 'invisible)) + (not (string-match "\\S-" (buffer-substring (overlay-start o) + (overlay-end o)))) + (delete-overlay o))) + (overlays-at pos))) + +(defun org-clean-visibility-after-subtree-move () + "Fix visibility issues after moving a subtree." + ;; First, find a reasonable region to look at: + ;; Start two siblings above, end three below + (let* ((beg (save-excursion + (and (org-get-last-sibling) + (org-get-last-sibling)) + (point))) + (end (save-excursion + (and (org-get-next-sibling) + (org-get-next-sibling) + (org-get-next-sibling)) + (if (org-at-heading-p) + (point-at-eol) + (point)))) + (level (looking-at "\\*+")) + (re (if level (concat "^" (regexp-quote (match-string 0)) " ")))) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (when re + ;; Properly fold already folded siblings + (goto-char (point-min)) + (while (re-search-forward re nil t) + (if (and (not (outline-invisible-p)) + (save-excursion + (goto-char (point-at-eol)) (outline-invisible-p))) + (hide-entry)))) + (org-cycle-show-empty-lines 'overview) + (org-cycle-hide-drawers 'overview))))) + +(defun org-cycle-show-empty-lines (state) + "Show empty lines above all visible headlines. +The region to be covered depends on STATE when called through +`org-cycle-hook'. Lisp program can use t for STATE to get the +entire buffer covered. Note that an empty line is only shown if there +are at least `org-cycle-separator-lines' empty lines before the headline." + (when (not (= org-cycle-separator-lines 0)) + (save-excursion + (let* ((n (abs org-cycle-separator-lines)) + (re (cond + ((= n 1) "\\(\n[ \t]*\n\\*+\\) ") + ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ") + (t (let ((ns (number-to-string (- n 2)))) + (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" + "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) + beg end b e) + (cond + ((memq state '(overview contents t)) + (setq beg (point-min) end (point-max))) + ((memq state '(children folded)) + (setq beg (point) end (progn (org-end-of-subtree t t) + (beginning-of-line 2) + (point))))) + (when beg + (goto-char beg) + (while (re-search-forward re end t) + (unless (get-char-property (match-end 1) 'invisible) + (setq e (match-end 1)) + (if (< org-cycle-separator-lines 0) + (setq b (save-excursion + (goto-char (match-beginning 0)) + (org-back-over-empty-lines) + (if (save-excursion + (goto-char (max (point-min) (1- (point)))) + (org-at-heading-p)) + (1- (point)) + (point)))) + (setq b (match-beginning 1))) + (outline-flag-region b e nil))))))) + ;; Never hide empty lines at the end of the file. + (save-excursion + (goto-char (point-max)) + (outline-previous-heading) + (outline-end-of-heading) + (if (and (looking-at "[ \t\n]+") + (= (match-end 0) (point-max))) + (outline-flag-region (point) (match-end 0) nil)))) + +(defun org-show-empty-lines-in-parent () + "Move to the parent and re-show empty lines before visible headlines." + (save-excursion + (let ((context (if (org-up-heading-safe) 'children 'overview))) + (org-cycle-show-empty-lines context)))) + +(defun org-files-list () + "Return `org-agenda-files' list, plus all open org-mode files. +This is useful for operations that need to scan all of a user's +open and agenda-wise Org files." + (let ((files (mapcar 'expand-file-name (org-agenda-files)))) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (if (and (derived-mode-p 'org-mode) (buffer-file-name)) + (let ((file (expand-file-name (buffer-file-name)))) + (unless (member file files) + (push file files)))))) + files)) + +(defsubst org-entry-beginning-position () + "Return the beginning position of the current entry." + (save-excursion (outline-back-to-heading t) (point))) + +(defsubst org-entry-end-position () + "Return the end position of the current entry." + (save-excursion (outline-next-heading) (point))) + +(defun org-cycle-hide-drawers (state) + "Re-hide all drawers after a visibility state change." + (when (and (derived-mode-p 'org-mode) + (not (memq state '(overview folded contents)))) + (save-excursion + (let* ((globalp (memq state '(contents all))) + (beg (if globalp (point-min) (point))) + (end (if globalp (point-max) + (if (eq state 'children) + (save-excursion (outline-next-heading) (point)) + (org-end-of-subtree t))))) + (goto-char beg) + (while (re-search-forward org-drawer-regexp end t) + (org-flag-drawer t)))))) + +(defun org-cycle-hide-inline-tasks (state) + "Re-hide inline tasks when switching to 'contents or 'children +visibility state." + (case state + (contents + (when (org-bound-and-true-p org-inlinetask-min-level) + (hide-sublevels (1- org-inlinetask-min-level)))) + (children + (when (featurep 'org-inlinetask) + (save-excursion + (while (and (outline-next-heading) + (org-inlinetask-at-task-p)) + (org-inlinetask-toggle-visibility) + (org-inlinetask-goto-end))))))) + +(defun org-flag-drawer (flag) + "When FLAG is non-nil, hide the drawer we are within. +Otherwise make it visible." + (save-excursion + (beginning-of-line 1) + (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") + (let ((b (match-end 0))) + (if (re-search-forward + "^[ \t]*:END:" + (save-excursion (outline-next-heading) (point)) t) + (outline-flag-region b (point-at-eol) flag) + (user-error ":END: line missing at position %s" b)))))) + +(defun org-subtree-end-visible-p () + "Is the end of the current subtree visible?" + (pos-visible-in-window-p + (save-excursion (org-end-of-subtree t) (point)))) + +(defun org-first-headline-recenter () + "Move cursor to the first headline and recenter the headline." + (goto-char (point-min)) + (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t) + (set-window-start (selected-window) (point-at-bol)))) + +;;; Saving and restoring visibility + +(defun org-outline-overlay-data (&optional use-markers) + "Return a list of the locations of all outline overlays. +These are overlays with the `invisible' property value `outline'. +The return value is a list of cons cells, with start and stop +positions for each overlay. +If USE-MARKERS is set, return the positions as markers." + (let (beg end) + (save-excursion + (save-restriction + (widen) + (delq nil + (mapcar (lambda (o) + (when (eq (overlay-get o 'invisible) 'outline) + (setq beg (overlay-start o) + end (overlay-end o)) + (and beg end (> end beg) + (if use-markers + (cons (move-marker (make-marker) beg) + (move-marker (make-marker) end)) + (cons beg end))))) + (overlays-in (point-min) (point-max)))))))) + +(defun org-set-outline-overlay-data (data) + "Create visibility overlays for all positions in DATA. +DATA should have been made by `org-outline-overlay-data'." + (let (o) + (save-excursion + (save-restriction + (widen) + (show-all) + (mapc (lambda (c) + (outline-flag-region (car c) (cdr c) t)) + data))))) + +;;; Folding of blocks + +(defvar org-hide-block-overlays nil + "Overlays hiding blocks.") +(make-variable-buffer-local 'org-hide-block-overlays) + +(defun org-block-map (function &optional start end) + "Call FUNCTION at the head of all source blocks in the current buffer. +Optional arguments START and END can be used to limit the range." + (let ((start (or start (point-min))) + (end (or end (point-max)))) + (save-excursion + (goto-char start) + (while (and (< (point) end) (re-search-forward org-block-regexp end t)) + (save-excursion + (save-match-data + (goto-char (match-beginning 0)) + (funcall function))))))) + +(defun org-hide-block-toggle-all () + "Toggle the visibility of all blocks in the current buffer." + (org-block-map #'org-hide-block-toggle)) + +(defun org-hide-block-all () + "Fold all blocks in the current buffer." + (interactive) + (org-show-block-all) + (org-block-map #'org-hide-block-toggle-maybe)) + +(defun org-show-block-all () + "Unfold all blocks in the current buffer." + (interactive) + (mapc 'delete-overlay org-hide-block-overlays) + (setq org-hide-block-overlays nil)) + +(defun org-hide-block-toggle-maybe () + "Toggle visibility of block at point." + (interactive) + (let ((case-fold-search t)) + (if (save-excursion + (beginning-of-line 1) + (looking-at org-block-regexp)) + (progn (org-hide-block-toggle) + t) ;; to signal that we took action + nil))) ;; to signal that we did not + +(defun org-hide-block-toggle (&optional force) + "Toggle the visibility of the current block." + (interactive) + (save-excursion + (beginning-of-line) + (if (re-search-forward org-block-regexp nil t) + (let ((start (- (match-beginning 4) 1)) ;; beginning of body + (end (match-end 0)) ;; end of entire body + ov) + (if (memq t (mapcar (lambda (overlay) + (eq (overlay-get overlay 'invisible) + 'org-hide-block)) + (overlays-at start))) + (if (or (not force) (eq force 'off)) + (mapc (lambda (ov) + (when (member ov org-hide-block-overlays) + (setq org-hide-block-overlays + (delq ov org-hide-block-overlays))) + (when (eq (overlay-get ov 'invisible) + 'org-hide-block) + (delete-overlay ov))) + (overlays-at start))) + (setq ov (make-overlay start end)) + (overlay-put ov 'invisible 'org-hide-block) + ;; make the block accessible to isearch + (overlay-put + ov 'isearch-open-invisible + (lambda (ov) + (when (member ov org-hide-block-overlays) + (setq org-hide-block-overlays + (delq ov org-hide-block-overlays))) + (when (eq (overlay-get ov 'invisible) + 'org-hide-block) + (delete-overlay ov)))) + (push ov org-hide-block-overlays))) + (user-error "Not looking at a source block")))) + +;; org-tab-after-check-for-cycling-hook +(add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe) +;; Remove overlays when changing major mode +(add-hook 'org-mode-hook + (lambda () (org-add-hook 'change-major-mode-hook + 'org-show-block-all 'append 'local))) + +;;; Org-goto + +(defvar org-goto-window-configuration nil) +(defvar org-goto-marker nil) +(defvar org-goto-map) +(defun org-goto-map () + "Set the keymap `org-goto'." + (setq org-goto-map + (let ((map (make-sparse-keymap))) + (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command + mouse-drag-region universal-argument org-occur)) + cmd) + (while (setq cmd (pop cmds)) + (substitute-key-definition cmd cmd map global-map))) + (suppress-keymap map) + (org-defkey map "\C-m" 'org-goto-ret) + (org-defkey map [(return)] 'org-goto-ret) + (org-defkey map [(left)] 'org-goto-left) + (org-defkey map [(right)] 'org-goto-right) + (org-defkey map [(control ?g)] 'org-goto-quit) + (org-defkey map "\C-i" 'org-cycle) + (org-defkey map [(tab)] 'org-cycle) + (org-defkey map [(down)] 'outline-next-visible-heading) + (org-defkey map [(up)] 'outline-previous-visible-heading) + (if org-goto-auto-isearch + (if (fboundp 'define-key-after) + (define-key-after map [t] 'org-goto-local-auto-isearch) + nil) + (org-defkey map "q" 'org-goto-quit) + (org-defkey map "n" 'outline-next-visible-heading) + (org-defkey map "p" 'outline-previous-visible-heading) + (org-defkey map "f" 'outline-forward-same-level) + (org-defkey map "b" 'outline-backward-same-level) + (org-defkey map "u" 'outline-up-heading)) + (org-defkey map "/" 'org-occur) + (org-defkey map "\C-c\C-n" 'outline-next-visible-heading) + (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading) + (org-defkey map "\C-c\C-f" 'outline-forward-same-level) + (org-defkey map "\C-c\C-b" 'outline-backward-same-level) + (org-defkey map "\C-c\C-u" 'outline-up-heading) + map))) + +(defconst org-goto-help + "Browse buffer copy, to find location or copy text.%s +RET=jump to location C-g=quit and return to previous location +\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur") + +(defvar org-goto-start-pos) ; dynamically scoped parameter + +(defun org-goto (&optional alternative-interface) + "Look up a different location in the current file, keeping current visibility. + +When you want look-up or go to a different location in a +document, the fastest way is often to fold the entire buffer and +then dive into the tree. This method has the disadvantage, that +the previous location will be folded, which may not be what you +want. + +This command works around this by showing a copy of the current +buffer in an indirect buffer, in overview mode. You can dive +into the tree in that copy, use org-occur and incremental search +to find a location. When pressing RET or `Q', the command +returns to the original buffer in which the visibility is still +unchanged. After RET it will also jump to the location selected +in the indirect buffer and expose the headline hierarchy above. + +With a prefix argument, use the alternative interface: e.g. if +`org-goto-interface' is 'outline use 'outline-path-completion." + (interactive "P") + (org-goto-map) + (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) + (org-refile-use-outline-path t) + (org-refile-target-verify-function nil) + (interface + (if (not alternative-interface) + org-goto-interface + (if (eq org-goto-interface 'outline) + 'outline-path-completion + 'outline))) + (org-goto-start-pos (point)) + (selected-point + (if (eq interface 'outline) + (car (org-get-location (current-buffer) org-goto-help)) + (let ((pa (org-refile-get-location "Goto" nil nil t))) + (org-refile-check-position pa) + (nth 3 pa))))) + (if selected-point + (progn + (org-mark-ring-push org-goto-start-pos) + (goto-char selected-point) + (if (or (outline-invisible-p) (org-invisible-p2)) + (org-show-context 'org-goto))) + (message "Quit")))) + +(defvar org-goto-selected-point nil) ; dynamically scoped parameter +(defvar org-goto-exit-command nil) ; dynamically scoped parameter +(defvar org-goto-local-auto-isearch-map) ; defined below + +(defun org-get-location (buf help) + "Let the user select a location in the Org-mode buffer BUF. +This function uses a recursive edit. It returns the selected position +or nil." + (org-no-popups + (let ((isearch-mode-map org-goto-local-auto-isearch-map) + (isearch-hide-immediately nil) + (isearch-search-fun-function + (lambda () 'org-goto-local-search-headings)) + (org-goto-selected-point org-goto-exit-command)) + (save-excursion + (save-window-excursion + (delete-other-windows) + (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) + (org-pop-to-buffer-same-window + (condition-case nil + (make-indirect-buffer (current-buffer) "*org-goto*") + (error (make-indirect-buffer (current-buffer) "*org-goto*")))) + (with-output-to-temp-buffer "*Org Help*" + (princ (format help (if org-goto-auto-isearch + " Just type for auto-isearch." + " n/p/f/b/u to navigate, q to quit.")))) + (org-fit-window-to-buffer (get-buffer-window "*Org Help*")) + (setq buffer-read-only nil) + (let ((org-startup-truncated t) + (org-startup-folded nil) + (org-startup-align-all-tables nil)) + (org-mode) + (org-overview)) + (setq buffer-read-only t) + (if (and (boundp 'org-goto-start-pos) + (integer-or-marker-p org-goto-start-pos)) + (let ((org-show-hierarchy-above t) + (org-show-siblings t) + (org-show-following-heading t)) + (goto-char org-goto-start-pos) + (and (outline-invisible-p) (org-show-context))) + (goto-char (point-min))) + (let (org-special-ctrl-a/e) (org-beginning-of-line)) + (message "Select location and press RET") + (use-local-map org-goto-map) + (recursive-edit))) + (kill-buffer "*org-goto*") + (cons org-goto-selected-point org-goto-exit-command)))) + +(defvar org-goto-local-auto-isearch-map (make-sparse-keymap)) +(set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map) +;; `isearch-other-control-char' was removed in Emacs 24.4. +(if (fboundp 'isearch-other-control-char) + (progn + (define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char) + (define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char)) + (define-key org-goto-local-auto-isearch-map "\C-i" nil) + (define-key org-goto-local-auto-isearch-map "\C-m" nil) + (define-key org-goto-local-auto-isearch-map [return] nil)) + +(defun org-goto-local-search-headings (string bound noerror) + "Search and make sure that any matches are in headlines." + (catch 'return + (while (if isearch-forward + (search-forward string bound noerror) + (search-backward string bound noerror)) + (when (let ((context (mapcar 'car (save-match-data (org-context))))) + (and (member :headline context) + (not (member :tags context)))) + (throw 'return (point)))))) + +(defun org-goto-local-auto-isearch () + "Start isearch." + (interactive) + (goto-char (point-min)) + (let ((keys (this-command-keys))) + (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char) + (isearch-mode t) + (isearch-process-search-char (string-to-char keys))))) + +(defun org-goto-ret (&optional arg) + "Finish `org-goto' by going to the new location." + (interactive "P") + (setq org-goto-selected-point (point) + org-goto-exit-command 'return) + (throw 'exit nil)) + +(defun org-goto-left () + "Finish `org-goto' by going to the new location." + (interactive) + (if (org-at-heading-p) + (progn + (beginning-of-line 1) + (setq org-goto-selected-point (point) + org-goto-exit-command 'left) + (throw 'exit nil)) + (user-error "Not on a heading"))) + +(defun org-goto-right () + "Finish `org-goto' by going to the new location." + (interactive) + (if (org-at-heading-p) + (progn + (setq org-goto-selected-point (point) + org-goto-exit-command 'right) + (throw 'exit nil)) + (user-error "Not on a heading"))) + +(defun org-goto-quit () + "Finish `org-goto' without cursor motion." + (interactive) + (setq org-goto-selected-point nil) + (setq org-goto-exit-command 'quit) + (throw 'exit nil)) + +;;; Indirect buffer display of subtrees + +(defvar org-indirect-dedicated-frame nil + "This is the frame being used for indirect tree display.") +(defvar org-last-indirect-buffer nil) + +(defun org-tree-to-indirect-buffer (&optional arg) + "Create indirect buffer and narrow it to current subtree. +With a numerical prefix ARG, go up to this level and then take that tree. +If ARG is negative, go up that many levels. + +If `org-indirect-buffer-display' is not `new-frame', the command removes the +indirect buffer previously made with this command, to avoid proliferation of +indirect buffers. However, when you call the command with a \ +\\[universal-argument] prefix, or +when `org-indirect-buffer-display' is `new-frame', the last buffer +is kept so that you can work with several indirect buffers at the same time. +If `org-indirect-buffer-display' is `dedicated-frame', the \ +\\[universal-argument] prefix also +requests that a new frame be made for the new buffer, so that the dedicated +frame is not changed." + (interactive "P") + (let ((cbuf (current-buffer)) + (cwin (selected-window)) + (pos (point)) + beg end level heading ibuf) + (save-excursion + (org-back-to-heading t) + (when (numberp arg) + (setq level (org-outline-level)) + (if (< arg 0) (setq arg (+ level arg))) + (while (> (setq level (org-outline-level)) arg) + (org-up-heading-safe))) + (setq beg (point) + heading (org-get-heading)) + (org-end-of-subtree t t) + (if (org-at-heading-p) (backward-char 1)) + (setq end (point))) + (if (and (buffer-live-p org-last-indirect-buffer) + (not (eq org-indirect-buffer-display 'new-frame)) + (not arg)) + (kill-buffer org-last-indirect-buffer)) + (setq ibuf (org-get-indirect-buffer cbuf) + org-last-indirect-buffer ibuf) + (cond + ((or (eq org-indirect-buffer-display 'new-frame) + (and arg (eq org-indirect-buffer-display 'dedicated-frame))) + (select-frame (make-frame)) + (delete-other-windows) + (org-pop-to-buffer-same-window ibuf) + (org-set-frame-title heading)) + ((eq org-indirect-buffer-display 'dedicated-frame) + (raise-frame + (select-frame (or (and org-indirect-dedicated-frame + (frame-live-p org-indirect-dedicated-frame) + org-indirect-dedicated-frame) + (setq org-indirect-dedicated-frame (make-frame))))) + (delete-other-windows) + (org-pop-to-buffer-same-window ibuf) + (org-set-frame-title (concat "Indirect: " heading))) + ((eq org-indirect-buffer-display 'current-window) + (org-pop-to-buffer-same-window ibuf)) + ((eq org-indirect-buffer-display 'other-window) + (pop-to-buffer ibuf)) + (t (error "Invalid value"))) + (if (featurep 'xemacs) + (save-excursion (org-mode) (turn-on-font-lock))) + (narrow-to-region beg end) + (show-all) + (goto-char pos) + (run-hook-with-args 'org-cycle-hook 'all) + (and (window-live-p cwin) (select-window cwin)))) + +(defun org-get-indirect-buffer (&optional buffer) + (setq buffer (or buffer (current-buffer))) + (let ((n 1) (base (buffer-name buffer)) bname) + (while (buffer-live-p + (get-buffer (setq bname (concat base "-" (number-to-string n))))) + (setq n (1+ n))) + (condition-case nil + (make-indirect-buffer buffer bname 'clone) + (error (make-indirect-buffer buffer bname))))) + +(defun org-set-frame-title (title) + "Set the title of the current frame to the string TITLE." + ;; FIXME: how to name a single frame in XEmacs??? + (unless (featurep 'xemacs) + (modify-frame-parameters (selected-frame) (list (cons 'name title))))) + +;;;; Structure editing + +;;; Inserting headlines + +(defun org-previous-line-empty-p (&optional next) + "Is the previous line a blank line? +When NEXT is non-nil, check the next line instead." + (save-excursion + (and (not (bobp)) + (or (beginning-of-line (if next 2 0)) t) + (save-match-data + (looking-at "[ \t]*$"))))) + +(defun org-insert-heading (&optional arg invisible-ok) + "Insert a new heading or an item with the same depth at point. + +If point is at the beginning of a heading or a list item, insert +a new heading or a new item above the current one. If point is +at the beginning of a normal line, turn the line into a heading. + +If point is in the middle of a headline or a list item, split the +headline or the item and create a new headline/item with the text +in the current line after point \(see `org-M-RET-may-split-line' +on how to modify this behavior). + +With one universal prefirx argument, set the user option +`org-insert-heading-respect-content' to t for the duration of +the command. This modifies the behavior described above in this +ways: on list items and at the beginning of normal lines, force +the insertion of a heading after the current subtree. + +With two universal prefix arguments, insert the heading at the +end of the grandparent subtree. For example, if point is within +a 2nd-level heading, then it will insert a 2nd-level heading at +the end of the 1st-level parent heading. + +When INVISIBLE-OK is set, stop at invisible headlines when going +back. This is important for non-interactive uses of the +command." + (interactive "P") + (if (org-called-interactively-p 'any) (org-reveal)) + (let ((itemp (org-in-item-p)) + (may-split (org-get-alist-option org-M-RET-may-split-line 'headline)) + (respect-content (or org-insert-heading-respect-content + (equal arg '(4)))) + (initial-content "") + (adjust-empty-lines t)) + + (cond + + ((or (= (buffer-size) 0) + (and (not (save-excursion + (and (ignore-errors (org-back-to-heading invisible-ok)) + (org-at-heading-p)))) + (or arg (not itemp)))) + ;; At beginning of buffer or so high up that only a heading + ;; makes sense. + (cond ((and (bolp) (not respect-content)) (insert "* ")) + ((not respect-content) + (unless may-split (end-of-line)) + (insert "\n* ")) + ((re-search-forward org-outline-regexp-bol nil t) + (beginning-of-line) + (insert "* \n") + (backward-char)) + (t (goto-char (point-max)) + (insert "\n* "))) + (run-hooks 'org-insert-heading-hook)) + + ((and itemp (not (member arg '((4) (16)))) (org-insert-item))) + + (t + ;; Maybe move at the end of the subtree + (when (equal arg '(16)) + (org-up-heading-safe) + (org-end-of-subtree t)) + ;; Insert a heading + (save-restriction + (widen) + (let* ((level nil) + (on-heading (org-at-heading-p)) + (empty-line-p (if on-heading + (org-previous-line-empty-p) + ;; We will decide later + nil)) + ;; Get a level string to fall back on + (fix-level + (if (org-before-first-heading-p) "*" + (save-excursion + (org-back-to-heading t) + (if (org-previous-line-empty-p) (setq empty-line-p t)) + (looking-at org-outline-regexp) + (make-string (1- (length (match-string 0))) ?*)))) + (stars + (save-excursion + (condition-case nil + (progn + (org-back-to-heading invisible-ok) + (when (and (not on-heading) + (featurep 'org-inlinetask) + (integerp org-inlinetask-min-level) + (>= (length (match-string 0)) + org-inlinetask-min-level)) + ;; Find a heading level before the inline task + (while (and (setq level (org-up-heading-safe)) + (>= level org-inlinetask-min-level))) + (if (org-at-heading-p) + (org-back-to-heading invisible-ok) + (error "This should not happen"))) + (unless (and (save-excursion + (save-match-data + (org-backward-heading-same-level + 1 invisible-ok)) + (= (point) (match-beginning 0))) + (not (org-previous-line-empty-p t))) + (setq empty-line-p (or empty-line-p + (org-previous-line-empty-p)))) + (match-string 0)) + (error (or fix-level "* "))))) + (blank-a (cdr (assq 'heading org-blank-before-new-entry))) + (blank (if (eq blank-a 'auto) empty-line-p blank-a)) + pos hide-previous previous-pos) + + ;; If we insert after content, move there and clean up whitespace + (when (and respect-content + (not (org-looking-at-p org-outline-regexp-bol))) + (if (not (org-before-first-heading-p)) + (org-end-of-subtree nil t) + (re-search-forward org-outline-regexp-bol) + (beginning-of-line 0)) + (skip-chars-backward " \r\n") + (and (not (looking-back "^\*+")) + (looking-at "[ \t]+") (replace-match "")) + (unless (eobp) (forward-char 1)) + (when (looking-at "^\\*") + (unless (bobp) (backward-char 1)) + (insert "\n"))) + + ;; If we are splitting, grab the text that should be moved to the new headline + (when may-split + (if (org-on-heading-p) + ;; This is a heading, we split intelligently (keeping tags) + (let ((pos (point))) + (goto-char (point-at-bol)) + (unless (looking-at org-complex-heading-regexp) + (error "This should not happen")) + (when (and (match-beginning 4) + (> pos (match-beginning 4)) + (< pos (match-end 4))) + (setq initial-content (buffer-substring pos (match-end 4))) + (goto-char pos) + (delete-region (point) (match-end 4)) + (if (looking-at "[ \t]*$") + (replace-match "") + (insert (make-string (length initial-content) ?\ ))) + (setq initial-content (org-trim initial-content))) + (goto-char pos)) + ;; a normal line + (setq initial-content + (org-trim (buffer-substring (point) (point-at-eol)))) + (delete-region (point) (point-at-eol)))) + + ;; If we are at the beginning of the line, insert before it. Else after + (cond + ((and (bolp) (looking-at "[ \t]*$"))) + ((and (bolp) (not (looking-at "[ \t]*$"))) + (open-line 1)) + (t + (goto-char (point-at-eol)) + (insert "\n"))) + + ;; Insert the new heading + (insert stars) + (just-one-space) + (insert initial-content) + (when adjust-empty-lines + (if (or (not blank) + (and blank (not (org-previous-line-empty-p)))) + (org-N-empty-lines-before-current (if blank 1 0)))) + (run-hooks 'org-insert-heading-hook))))))) + +(defun org-N-empty-lines-before-current (N) + "Make the number of empty lines before current exactly N. +So this will delete or add empty lines." + (save-excursion + (beginning-of-line) + (let ((p (point))) + (skip-chars-backward " \r\t\n") + (unless (bolp) (forward-line)) + (delete-region (point) p)) + (when (> N 0) (insert (make-string N ?\n))))) + +(defun org-get-heading (&optional no-tags no-todo) + "Return the heading of the current entry, without the stars. +When NO-TAGS is non-nil, don't include tags. +When NO-TODO is non-nil, don't include TODO keywords." + (save-excursion + (org-back-to-heading t) + (cond + ((and no-tags no-todo) + (looking-at org-complex-heading-regexp) + (match-string 4)) + (no-tags + (looking-at (concat org-outline-regexp + "\\(.*?\\)" + "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$")) + (match-string 1)) + (no-todo + (looking-at org-todo-line-regexp) + (match-string 3)) + (t (looking-at org-heading-regexp) + (match-string 2))))) + +(defvar orgstruct-mode) ; defined below + +(defun org-heading-components () + "Return the components of the current heading. +This is a list with the following elements: +- the level as an integer +- the reduced level, different if `org-odd-levels-only' is set. +- the TODO keyword, or nil +- the priority character, like ?A, or nil if no priority is given +- the headline text itself, or the tags string if no headline text +- the tags string, or nil." + (save-excursion + (org-back-to-heading t) + (if (let (case-fold-search) + (looking-at + (if orgstruct-mode + org-heading-regexp + org-complex-heading-regexp))) + (if orgstruct-mode + (list (length (match-string 1)) + (org-reduced-level (length (match-string 1))) + nil + nil + (match-string 2) + nil) + (list (length (match-string 1)) + (org-reduced-level (length (match-string 1))) + (org-match-string-no-properties 2) + (and (match-end 3) (aref (match-string 3) 2)) + (org-match-string-no-properties 4) + (org-match-string-no-properties 5)))))) + +(defun org-get-entry () + "Get the entry text, after heading, entire subtree." + (save-excursion + (org-back-to-heading t) + (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) + +(defun org-insert-heading-after-current () + "Insert a new heading with same level as current, after current subtree." + (interactive) + (org-back-to-heading) + (org-insert-heading) + (org-move-subtree-down) + (end-of-line 1)) + +(defun org-insert-heading-respect-content (&optional invisible-ok) + "Insert heading with `org-insert-heading-respect-content' set to t." + (interactive) + (org-insert-heading '(4) invisible-ok)) + +(defun org-insert-todo-heading-respect-content (&optional force-state) + "Insert TODO heading with `org-insert-heading-respect-content' set to t." + (interactive) + (org-insert-todo-heading force-state '(4))) + +(defun org-insert-todo-heading (arg &optional force-heading) + "Insert a new heading with the same level and TODO state as current heading. +If the heading has no TODO state, or if the state is DONE, use the first +state (TODO by default). Also with one prefix arg, force first state. With +two prefix args, force inserting at the end of the parent subtree." + (interactive "P") + (when (or force-heading (not (org-insert-item 'checkbox))) + (org-insert-heading (or (and (equal arg '(16)) '(16)) + force-heading)) + (save-excursion + (org-back-to-heading) + (outline-previous-heading) + (looking-at org-todo-line-regexp)) + (let* + ((new-mark-x + (if (or (equal arg '(4)) + (not (match-beginning 2)) + (member (match-string 2) org-done-keywords)) + (car org-todo-keywords-1) + (match-string 2))) + (new-mark + (or + (run-hook-with-args-until-success + 'org-todo-get-default-hook new-mark-x nil) + new-mark-x))) + (beginning-of-line 1) + (and (looking-at org-outline-regexp) (goto-char (match-end 0)) + (if org-treat-insert-todo-heading-as-state-change + (org-todo new-mark) + (insert new-mark " ")))) + (when org-provide-todo-statistics + (org-update-parent-todo-statistics)))) + +(defun org-insert-subheading (arg) + "Insert a new subheading and demote it. +Works for outline headings and for plain lists alike." + (interactive "P") + (org-insert-heading arg) + (cond + ((org-at-heading-p) (org-do-demote)) + ((org-at-item-p) (org-indent-item)))) + +(defun org-insert-todo-subheading (arg) + "Insert a new subheading with TODO keyword or checkbox and demote it. +Works for outline headings and for plain lists alike." + (interactive "P") + (org-insert-todo-heading arg) + (cond + ((org-at-heading-p) (org-do-demote)) + ((org-at-item-p) (org-indent-item)))) + +;;; Promotion and Demotion + +(defvar org-after-demote-entry-hook nil + "Hook run after an entry has been demoted. +The cursor will be at the beginning of the entry. +When a subtree is being demoted, the hook will be called for each node.") + +(defvar org-after-promote-entry-hook nil + "Hook run after an entry has been promoted. +The cursor will be at the beginning of the entry. +When a subtree is being promoted, the hook will be called for each node.") + +(defun org-promote-subtree () + "Promote the entire subtree. +See also `org-promote'." + (interactive) + (save-excursion + (org-with-limited-levels (org-map-tree 'org-promote))) + (org-fix-position-after-promote)) + +(defun org-demote-subtree () + "Demote the entire subtree. See `org-demote'. +See also `org-promote'." + (interactive) + (save-excursion + (org-with-limited-levels (org-map-tree 'org-demote))) + (org-fix-position-after-promote)) + + +(defun org-do-promote () + "Promote the current heading higher up the tree. +If the region is active in `transient-mark-mode', promote all headings +in the region." + (interactive) + (save-excursion + (if (org-region-active-p) + (org-map-region 'org-promote (region-beginning) (region-end)) + (org-promote))) + (org-fix-position-after-promote)) + +(defun org-do-demote () + "Demote the current heading lower down the tree. +If the region is active in `transient-mark-mode', demote all headings +in the region." + (interactive) + (save-excursion + (if (org-region-active-p) + (org-map-region 'org-demote (region-beginning) (region-end)) + (org-demote))) + (org-fix-position-after-promote)) + +(defun org-fix-position-after-promote () + "Make sure that after pro/demotion cursor position is right." + (let ((pos (point))) + (when (save-excursion + (beginning-of-line 1) + (looking-at org-todo-line-regexp) + (or (equal pos (match-end 1)) (equal pos (match-end 2)))) + (cond ((eobp) (insert " ")) + ((eolp) (insert " ")) + ((equal (char-after) ?\ ) (forward-char 1)))))) + +(defun org-current-level () + "Return the level of the current entry, or nil if before the first headline. +The level is the number of stars at the beginning of the headline." + (save-excursion + (org-with-limited-levels + (if (ignore-errors (org-back-to-heading t)) + (funcall outline-level))))) + +(defun org-get-previous-line-level () + "Return the outline depth of the last headline before the current line. +Returns 0 for the first headline in the buffer, and nil if before the +first headline." + (and (org-current-level) + (or (and (/= (line-beginning-position) (point-min)) + (save-excursion (beginning-of-line 0) (org-current-level))) + 0))) + +(defun org-reduced-level (l) + "Compute the effective level of a heading. +This takes into account the setting of `org-odd-levels-only'." + (cond + ((zerop l) 0) + (org-odd-levels-only (1+ (floor (/ l 2)))) + (t l))) + +(defun org-level-increment () + "Return the number of stars that will be added or removed at a +time to headlines when structure editing, based on the value of +`org-odd-levels-only'." + (if org-odd-levels-only 2 1)) + +(defun org-get-valid-level (level &optional change) + "Rectify a level change under the influence of `org-odd-levels-only' +LEVEL is a current level, CHANGE is by how much the level should be +modified. Even if CHANGE is nil, LEVEL may be returned modified because +even level numbers will become the next higher odd number." + (if org-odd-levels-only + (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2)))) + ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2)))) + ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) + (max 1 (+ level (or change 0))))) + +(if (boundp 'define-obsolete-function-alias) + (if (or (featurep 'xemacs) (< emacs-major-version 23)) + (define-obsolete-function-alias 'org-get-legal-level + 'org-get-valid-level) + (define-obsolete-function-alias 'org-get-legal-level + 'org-get-valid-level "23.1"))) + +(defun org-promote () + "Promote the current heading higher up the tree. +If the region is active in `transient-mark-mode', promote all headings +in the region." + (org-back-to-heading t) + (let* ((level (save-match-data (funcall outline-level))) + (after-change-functions (remove 'flyspell-after-change-function + after-change-functions)) + (up-head (concat (make-string (org-get-valid-level level -1) ?*) " ")) + (diff (abs (- level (length up-head) -1)))) + (cond ((and (= level 1) org-called-with-limited-levels + org-allow-promoting-top-level-subtree) + (replace-match "# " nil t)) + ((= level 1) + (user-error "Cannot promote to level 0. UNDO to recover if necessary")) + (t (replace-match up-head nil t))) + ;; Fixup tag positioning + (unless (= level 1) + (and org-auto-align-tags (org-set-tags nil 'ignore-column)) + (if org-adapt-indentation (org-fixup-indentation (- diff)))) + (run-hooks 'org-after-promote-entry-hook))) + +(defun org-demote () + "Demote the current heading lower down the tree. +If the region is active in `transient-mark-mode', demote all headings +in the region." + (org-back-to-heading t) + (let* ((level (save-match-data (funcall outline-level))) + (after-change-functions (remove 'flyspell-after-change-function + after-change-functions)) + (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) + (diff (abs (- level (length down-head) -1)))) + (replace-match down-head nil t) + ;; Fixup tag positioning + (and org-auto-align-tags (org-set-tags nil 'ignore-column)) + (if org-adapt-indentation (org-fixup-indentation diff)) + (run-hooks 'org-after-demote-entry-hook))) + +(defun org-cycle-level () + "Cycle the level of an empty headline through possible states. +This goes first to child, then to parent, level, then up the hierarchy. +After top level, it switches back to sibling level." + (interactive) + (let ((org-adapt-indentation nil)) + (when (org-point-at-end-of-empty-headline) + (setq this-command 'org-cycle-level) ; Only needed for caching + (let ((cur-level (org-current-level)) + (prev-level (org-get-previous-line-level))) + (cond + ;; If first headline in file, promote to top-level. + ((= prev-level 0) + (loop repeat (/ (- cur-level 1) (org-level-increment)) + do (org-do-promote))) + ;; If same level as prev, demote one. + ((= prev-level cur-level) + (org-do-demote)) + ;; If parent is top-level, promote to top level if not already. + ((= prev-level 1) + (loop repeat (/ (- cur-level 1) (org-level-increment)) + do (org-do-promote))) + ;; If top-level, return to prev-level. + ((= cur-level 1) + (loop repeat (/ (- prev-level 1) (org-level-increment)) + do (org-do-demote))) + ;; If less than prev-level, promote one. + ((< cur-level prev-level) + (org-do-promote)) + ;; If deeper than prev-level, promote until higher than + ;; prev-level. + ((> cur-level prev-level) + (loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment))) + do (org-do-promote)))) + t)))) + +(defun org-map-tree (fun) + "Call FUN for every heading underneath the current one." + (org-back-to-heading) + (let ((level (funcall outline-level))) + (save-excursion + (funcall fun) + (while (and (progn + (outline-next-heading) + (> (funcall outline-level) level)) + (not (eobp))) + (funcall fun))))) + +(defun org-map-region (fun beg end) + "Call FUN for every heading between BEG and END." + (let ((org-ignore-region t)) + (save-excursion + (setq end (copy-marker end)) + (goto-char beg) + (if (and (re-search-forward org-outline-regexp-bol nil t) + (< (point) end)) + (funcall fun)) + (while (and (progn + (outline-next-heading) + (< (point) end)) + (not (eobp))) + (funcall fun))))) + +(defvar org-property-end-re) ; silence byte-compiler +(defun org-fixup-indentation (diff) + "Change the indentation in the current entry by DIFF. +However, if any line in the current entry has no indentation, or if it +would end up with no indentation after the change, nothing at all is done." + (save-excursion + (let ((end (save-excursion (outline-next-heading) + (point-marker))) + (prohibit (if (> diff 0) + "^\\S-" + (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-"))) + col) + (unless (save-excursion (end-of-line 1) + (re-search-forward prohibit end t)) + (while (and (< (point) end) + (re-search-forward "^[ \t]+" end t)) + (goto-char (match-end 0)) + (setq col (current-column)) + (if (< diff 0) (replace-match "")) + (org-indent-to-column (+ diff col)))) + (move-marker end nil)))) + +(defun org-convert-to-odd-levels () + "Convert an org-mode file with all levels allowed to one with odd levels. +This will leave level 1 alone, convert level 2 to level 3, level 3 to +level 5 etc." + (interactive) + (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ") + (let ((outline-level 'org-outline-level) + (org-odd-levels-only nil) n) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^\\*\\*+ " nil t) + (setq n (- (length (match-string 0)) 2)) + (while (>= (setq n (1- n)) 0) + (org-demote)) + (end-of-line 1)))))) + +(defun org-convert-to-oddeven-levels () + "Convert an org-mode file with only odd levels to one with odd/even levels. +This promotes level 3 to level 2, level 5 to level 3 etc. If the +file contains a section with an even level, conversion would +destroy the structure of the file. An error is signaled in this +case." + (interactive) + (goto-char (point-min)) + ;; First check if there are no even levels + (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) + (org-show-context t) + (error "Not all levels are odd in this file. Conversion not possible")) + (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") + (let ((outline-regexp org-outline-regexp) + (outline-level 'org-outline-level) + (org-odd-levels-only nil) n) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^\\*\\*+ " nil t) + (setq n (/ (1- (length (match-string 0))) 2)) + (while (>= (setq n (1- n)) 0) + (org-promote)) + (end-of-line 1)))))) + +(defun org-tr-level (n) + "Make N odd if required." + (if org-odd-levels-only (1+ (/ n 2)) n)) + +;;; Vertical tree motion, cutting and pasting of subtrees + +(defun org-move-subtree-up (&optional arg) + "Move the current subtree up past ARG headlines of the same level." + (interactive "p") + (org-move-subtree-down (- (prefix-numeric-value arg)))) + +(defun org-move-subtree-down (&optional arg) + "Move the current subtree down past ARG headlines of the same level." + (interactive "p") + (setq arg (prefix-numeric-value arg)) + (let ((movfunc (if (> arg 0) 'org-get-next-sibling + 'org-get-last-sibling)) + (ins-point (make-marker)) + (cnt (abs arg)) + (col (current-column)) + beg beg0 end txt folded ne-beg ne-end ne-ins ins-end) + ;; Select the tree + (org-back-to-heading) + (setq beg0 (point)) + (save-excursion + (setq ne-beg (org-back-over-empty-lines)) + (setq beg (point))) + (save-match-data + (save-excursion (outline-end-of-heading) + (setq folded (outline-invisible-p))) + (progn (org-end-of-subtree nil t) + (unless (eobp) (backward-char)))) + (outline-next-heading) + (setq ne-end (org-back-over-empty-lines)) + (setq end (point)) + (goto-char beg0) + (when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg)) + ;; include less whitespace + (save-excursion + (goto-char beg) + (forward-line (- ne-beg ne-end)) + (setq beg (point)))) + ;; Find insertion point, with error handling + (while (> cnt 0) + (or (and (funcall movfunc) (looking-at org-outline-regexp)) + (progn (goto-char beg0) + (user-error "Cannot move past superior level or buffer limit"))) + (setq cnt (1- cnt))) + (if (> arg 0) + ;; Moving forward - still need to move over subtree + (progn (org-end-of-subtree t t) + (save-excursion + (org-back-over-empty-lines) + (or (bolp) (newline))))) + (setq ne-ins (org-back-over-empty-lines)) + (move-marker ins-point (point)) + (setq txt (buffer-substring beg end)) + (org-save-markers-in-region beg end) + (delete-region beg end) + (org-remove-empty-overlays-at beg) + (or (= beg (point-min)) (outline-flag-region (1- beg) beg nil)) + (or (bobp) (outline-flag-region (1- (point)) (point) nil)) + (and (not (bolp)) (looking-at "\n") (forward-char 1)) + (let ((bbb (point))) + (insert-before-markers txt) + (org-reinstall-markers-in-region bbb) + (move-marker ins-point bbb)) + (or (bolp) (insert "\n")) + (setq ins-end (point)) + (goto-char ins-point) + (org-skip-whitespace) + (when (and (< arg 0) + (org-first-sibling-p) + (> ne-ins ne-beg)) + ;; Move whitespace back to beginning + (save-excursion + (goto-char ins-end) + (let ((kill-whole-line t)) + (kill-line (- ne-ins ne-beg)) (point))) + (insert (make-string (- ne-ins ne-beg) ?\n))) + (move-marker ins-point nil) + (if folded + (hide-subtree) + (org-show-entry) + (show-children) + (org-cycle-hide-drawers 'children)) + (org-clean-visibility-after-subtree-move) + ;; move back to the initial column we were at + (move-to-column col))) + +(defvar org-subtree-clip "" + "Clipboard for cut and paste of subtrees. +This is actually only a copy of the kill, because we use the normal kill +ring. We need it to check if the kill was created by `org-copy-subtree'.") + +(defvar org-subtree-clip-folded nil + "Was the last copied subtree folded? +This is used to fold the tree back after pasting.") + +(defun org-cut-subtree (&optional n) + "Cut the current subtree into the clipboard. +With prefix arg N, cut this many sequential subtrees. +This is a short-hand for marking the subtree and then cutting it." + (interactive "p") + (org-copy-subtree n 'cut)) + +(defun org-copy-subtree (&optional n cut force-store-markers nosubtrees) + "Copy the current subtree it in the clipboard. +With prefix arg N, copy this many sequential subtrees. +This is a short-hand for marking the subtree and then copying it. +If CUT is non-nil, actually cut the subtree. +If FORCE-STORE-MARKERS is non-nil, store the relative locations +of some markers in the region, even if CUT is non-nil. This is +useful if the caller implements cut-and-paste as copy-then-paste-then-cut." + (interactive "p") + (let (beg end folded (beg0 (point))) + (if (org-called-interactively-p 'any) + (org-back-to-heading nil) ; take what looks like a subtree + (org-back-to-heading t)) ; take what is really there + (setq beg (point)) + (skip-chars-forward " \t\r\n") + (save-match-data + (if nosubtrees + (outline-next-heading) + (save-excursion (outline-end-of-heading) + (setq folded (outline-invisible-p))) + (condition-case nil + (org-forward-heading-same-level (1- n) t) + (error nil)) + (org-end-of-subtree t t))) + (setq end (point)) + (goto-char beg0) + (when (> end beg) + (setq org-subtree-clip-folded folded) + (when (or cut force-store-markers) + (org-save-markers-in-region beg end)) + (if cut (kill-region beg end) (copy-region-as-kill beg end)) + (setq org-subtree-clip (current-kill 0)) + (message "%s: Subtree(s) with %d characters" + (if cut "Cut" "Copied") + (length org-subtree-clip))))) + +(defun org-paste-subtree (&optional level tree for-yank) + "Paste the clipboard as a subtree, with modification of headline level. +The entire subtree is promoted or demoted in order to match a new headline +level. + +If the cursor is at the beginning of a headline, the same level as +that headline is used to paste the tree. + +If not, the new level is derived from the *visible* headings +before and after the insertion point, and taken to be the inferior headline +level of the two. So if the previous visible heading is level 3 and the +next is level 4 (or vice versa), level 4 will be used for insertion. +This makes sure that the subtree remains an independent subtree and does +not swallow low level entries. + +You can also force a different level, either by using a numeric prefix +argument, or by inserting the heading marker by hand. For example, if the +cursor is after \"*****\", then the tree will be shifted to level 5. + +If optional TREE is given, use this text instead of the kill ring. + +When FOR-YANK is set, this is called by `org-yank'. In this case, do not +move back over whitespace before inserting, and move point to the end of +the inserted text when done." + (interactive "P") + (setq tree (or tree (and kill-ring (current-kill 0)))) + (unless (org-kill-is-subtree-p tree) + (user-error "%s" + (substitute-command-keys + "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) + (org-with-limited-levels + (let* ((visp (not (outline-invisible-p))) + (txt tree) + (^re_ "\\(\\*+\\)[ \t]*") + (old-level (if (string-match org-outline-regexp-bol txt) + (- (match-end 0) (match-beginning 0) 1) + -1)) + (force-level (cond (level (prefix-numeric-value level)) + ((and (looking-at "[ \t]*$") + (string-match + "^\\*+$" (buffer-substring + (point-at-bol) (point)))) + (- (match-end 0) (match-beginning 0))) + ((and (bolp) + (looking-at org-outline-regexp)) + (- (match-end 0) (point) 1)))) + (previous-level (save-excursion + (condition-case nil + (progn + (outline-previous-visible-heading 1) + (if (looking-at ^re_) + (- (match-end 0) (match-beginning 0) 1) + 1)) + (error 1)))) + (next-level (save-excursion + (condition-case nil + (progn + (or (looking-at org-outline-regexp) + (outline-next-visible-heading 1)) + (if (looking-at ^re_) + (- (match-end 0) (match-beginning 0) 1) + 1)) + (error 1)))) + (new-level (or force-level (max previous-level next-level))) + (shift (if (or (= old-level -1) + (= new-level -1) + (= old-level new-level)) + 0 + (- new-level old-level))) + (delta (if (> shift 0) -1 1)) + (func (if (> shift 0) 'org-demote 'org-promote)) + (org-odd-levels-only nil) + beg end newend) + ;; Remove the forced level indicator + (if force-level + (delete-region (point-at-bol) (point))) + ;; Paste + (beginning-of-line (if (bolp) 1 2)) + (setq beg (point)) + (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) + (insert-before-markers txt) + (unless (string-match "\n\\'" txt) (insert "\n")) + (setq newend (point)) + (org-reinstall-markers-in-region beg) + (setq end (point)) + (goto-char beg) + (skip-chars-forward " \t\n\r") + (setq beg (point)) + (if (and (outline-invisible-p) visp) + (save-excursion (outline-show-heading))) + ;; Shift if necessary + (unless (= shift 0) + (save-restriction + (narrow-to-region beg end) + (while (not (= shift 0)) + (org-map-region func (point-min) (point-max)) + (setq shift (+ delta shift))) + (goto-char (point-min)) + (setq newend (point-max)))) + (when (or (org-called-interactively-p 'interactive) for-yank) + (message "Clipboard pasted as level %d subtree" new-level)) + (if (and (not for-yank) ; in this case, org-yank will decide about folding + kill-ring + (eq org-subtree-clip (current-kill 0)) + org-subtree-clip-folded) + ;; The tree was folded before it was killed/copied + (hide-subtree)) + (and for-yank (goto-char newend))))) + +(defun org-kill-is-subtree-p (&optional txt) + "Check if the current kill is an outline subtree, or a set of trees. +Returns nil if kill does not start with a headline, or if the first +headline level is not the largest headline level in the tree. +So this will actually accept several entries of equal levels as well, +which is OK for `org-paste-subtree'. +If optional TXT is given, check this string instead of the current kill." + (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) + (re (org-get-limited-outline-regexp)) + (^re (concat "^" re)) + (start-level (and kill + (string-match + (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" re "\\)") + kill) + (- (match-end 2) (match-beginning 2) 1))) + (start (1+ (or (match-beginning 2) -1)))) + (if (not start-level) + (progn + nil) ;; does not even start with a heading + (catch 'exit + (while (setq start (string-match ^re kill (1+ start))) + (when (< (- (match-end 0) (match-beginning 0) 1) start-level) + (throw 'exit nil))) + t)))) + +(defvar org-markers-to-move nil + "Markers that should be moved with a cut-and-paste operation. +Those markers are stored together with their positions relative to +the start of the region.") + +(defun org-save-markers-in-region (beg end) + "Check markers in region. +If these markers are between BEG and END, record their position relative +to BEG, so that after moving the block of text, we can put the markers back +into place. +This function gets called just before an entry or tree gets cut from the +buffer. After re-insertion, `org-reinstall-markers-in-region' must be +called immediately, to move the markers with the entries." + (setq org-markers-to-move nil) + (when (featurep 'org-clock) + (org-clock-save-markers-for-cut-and-paste beg end)) + (when (featurep 'org-agenda) + (org-agenda-save-markers-for-cut-and-paste beg end))) + +(defun org-check-and-save-marker (marker beg end) + "Check if MARKER is between BEG and END. +If yes, remember the marker and the distance to BEG." + (when (and (marker-buffer marker) + (equal (marker-buffer marker) (current-buffer))) + (if (and (>= marker beg) (< marker end)) + (push (cons marker (- marker beg)) org-markers-to-move)))) + +(defun org-reinstall-markers-in-region (beg) + "Move all remembered markers to their position relative to BEG." + (mapc (lambda (x) + (move-marker (car x) (+ beg (cdr x)))) + org-markers-to-move) + (setq org-markers-to-move nil)) + +(defun org-narrow-to-subtree () + "Narrow buffer to the current subtree." + (interactive) + (save-excursion + (save-match-data + (org-with-limited-levels + (narrow-to-region + (progn (org-back-to-heading t) (point)) + (progn (org-end-of-subtree t t) + (if (and (org-at-heading-p) (not (eobp))) (backward-char 1)) + (point))))))) + +(defun org-narrow-to-block () + "Narrow buffer to the current block." + (interactive) + (let* ((case-fold-search t) + (blockp (org-between-regexps-p "^[ \t]*#\\+begin_.*" + "^[ \t]*#\\+end_.*"))) + (if blockp + (narrow-to-region (car blockp) (cdr blockp)) + (user-error "Not in a block")))) + +(eval-when-compile + (defvar org-property-drawer-re)) + +(defvar org-property-start-re) ;; defined below +(defun org-clone-subtree-with-time-shift (n &optional shift) + "Clone the task (subtree) at point N times. +The clones will be inserted as siblings. + +In interactive use, the user will be prompted for the number of +clones to be produced. If the entry has a timestamp, the user +will also be prompted for a time shift, which may be a repeater +as used in time stamps, for example `+3d'. To disable this, +you can call the function with a universal prefix argument. + +When a valid repeater is given and the entry contains any time +stamps, the clones will become a sequence in time, with time +stamps in the subtree shifted for each clone produced. If SHIFT +is nil or the empty string, time stamps will be left alone. The +ID property of the original subtree is removed. + +If the original subtree did contain time stamps with a repeater, +the following will happen: +- the repeater will be removed in each clone +- an additional clone will be produced, with the current, unshifted + date(s) in the entry. +- the original entry will be placed *after* all the clones, with + repeater intact. +- the start days in the repeater in the original entry will be shifted + to past the last clone. +In this way you can spell out a number of instances of a repeating task, +and still retain the repeater to cover future instances of the task." + (interactive "nNumber of clones to produce: ") + (let ((shift + (or shift + (if (and (not (equal current-prefix-arg '(4))) + (save-excursion + (re-search-forward org-ts-regexp-both + (save-excursion + (org-end-of-subtree t) + (point)) t))) + (read-from-minibuffer + "Date shift per clone (e.g. +1w, empty to copy unchanged): ") + ""))) ;; No time shift + (n-no-remove -1) + (drawer-re org-drawer-regexp) + beg end template task idprop + shift-n shift-what doshift nmin nmax) + (if (not (and (integerp n) (> n 0))) + (error "Invalid number of replications %s" n)) + (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift))) + (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([hdwmy]\\)[ \t]*\\'" + shift))) + (error "Invalid shift specification %s" shift)) + (when doshift + (setq shift-n (string-to-number (match-string 1 shift)) + shift-what (cdr (assoc (match-string 2 shift) + '(("d" . day) ("w" . week) + ("m" . month) ("y" . year)))))) + (if (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day)) + (setq nmin 1 nmax n) + (org-back-to-heading t) + (setq beg (point)) + (setq idprop (org-entry-get nil "ID")) + (org-end-of-subtree t t) + (or (bolp) (insert "\n")) + (setq end (point)) + (setq template (buffer-substring beg end)) + (when (and doshift + (string-match "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" template)) + (delete-region beg end) + (setq end beg) + (setq nmin 0 nmax (1+ nmax) n-no-remove nmax)) + (goto-char end) + (loop for n from nmin to nmax do + ;; prepare clone + (with-temp-buffer + (insert template) + (org-mode) + (goto-char (point-min)) + (org-show-subtree) + (and idprop (if org-clone-delete-id + (org-entry-delete nil "ID") + (org-id-get-create t))) + (unless (= n 0) + (while (re-search-forward "^[ \t]*CLOCK:.*$" nil t) + (kill-whole-line)) + (goto-char (point-min)) + (while (re-search-forward drawer-re nil t) + (mapc (lambda (d) + (org-remove-empty-drawer-at d (point))) org-drawers))) + (goto-char (point-min)) + (when doshift + (while (re-search-forward org-ts-regexp-both nil t) + (org-timestamp-change (* n shift-n) shift-what)) + (unless (= n n-no-remove) + (goto-char (point-min)) + (while (re-search-forward org-ts-regexp nil t) + (save-excursion + (goto-char (match-beginning 0)) + (if (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)") + (delete-region (match-beginning 1) (match-end 1))))))) + (setq task (buffer-string))) + (insert task)) + (goto-char beg))) + +;;; Outline Sorting + +(defun org-sort (with-case) + "Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'. +Optional argument WITH-CASE means sort case-sensitively." + (interactive "P") + (cond + ((org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case)) + ((org-at-item-p) (org-call-with-arg 'org-sort-list with-case)) + (t + (org-call-with-arg 'org-sort-entries with-case)))) + +(defun org-sort-remove-invisible (s) + "Remove invisible links from string S." + (remove-text-properties 0 (length s) org-rm-props s) + (while (string-match org-bracket-link-regexp s) + (setq s (replace-match (if (match-end 2) + (match-string 3 s) + (match-string 1 s)) t t s))) + (let ((st (format " %s " s))) + (while (string-match org-emph-re st) + (setq st (replace-match (format " %s " (match-string 4 st)) t t st))) + (setq s (substring st 1 -1))) + s) + +(defvar org-priority-regexp) ; defined later in the file + +(defvar org-after-sorting-entries-or-items-hook nil + "Hook that is run after a bunch of entries or items have been sorted. +When children are sorted, the cursor is in the parent line when this +hook gets called. When a region or a plain list is sorted, the cursor +will be in the first entry of the sorted region/list.") + +(defun org-sort-entries + (&optional with-case sorting-type getkey-func compare-func property) + "Sort entries on a certain level of an outline tree. +If there is an active region, the entries in the region are sorted. +Else, if the cursor is before the first entry, sort the top-level items. +Else, the children of the entry at point are sorted. + +Sorting can be alphabetically, numerically, by date/time as given by +a time stamp, by a property, by priority order, or by a custom function. + +The command prompts for the sorting type unless it has been given to the +function through the SORTING-TYPE argument, which needs to be a character, +\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?o ?O ?r ?R ?f ?F). Here is the +precise meaning of each character: + +n Numerically, by converting the beginning of the entry/item to a number. +a Alphabetically, ignoring the TODO keyword and the priority, if any. +o By order of TODO keywords. +t By date/time, either the first active time stamp in the entry, or, if + none exist, by the first inactive one. +s By the scheduled date/time. +d By deadline date/time. +c By creation time, which is assumed to be the first inactive time stamp + at the beginning of a line. +p By priority according to the cookie. +r By the value of a property. + +Capital letters will reverse the sort order. + +If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be +called with point at the beginning of the record. It must return either +a string or a number that should serve as the sorting key for that record. + +Comparing entries ignores case by default. However, with an optional argument +WITH-CASE, the sorting considers case as well. + +Sorting is done against the visible part of the headlines, it ignores hidden +links." + (interactive "P") + (let ((case-func (if with-case 'identity 'downcase)) + (cmstr + ;; The clock marker is lost when using `sort-subr', let's + ;; store the clocking string. + (when (equal (marker-buffer org-clock-marker) (current-buffer)) + (save-excursion + (goto-char org-clock-marker) + (looking-back "^.*") (match-string-no-properties 0)))) + start beg end stars re re2 + txt what tmp) + ;; Find beginning and end of region to sort + (cond + ((org-region-active-p) + ;; we will sort the region + (setq end (region-end) + what "region") + (goto-char (region-beginning)) + (if (not (org-at-heading-p)) (outline-next-heading)) + (setq start (point))) + ((or (org-at-heading-p) + (condition-case nil (progn (org-back-to-heading) t) (error nil))) + ;; we will sort the children of the current headline + (org-back-to-heading) + (setq start (point) + end (progn (org-end-of-subtree t t) + (or (bolp) (insert "\n")) + (when (>= (org-back-over-empty-lines) 1) + (forward-line 1)) + (point)) + what "children") + (goto-char start) + (show-subtree) + (outline-next-heading)) + (t + ;; we will sort the top-level entries in this file + (goto-char (point-min)) + (or (org-at-heading-p) (outline-next-heading)) + (setq start (point)) + (goto-char (point-max)) + (beginning-of-line 1) + (when (looking-at ".*?\\S-") + ;; File ends in a non-white line + (end-of-line 1) + (insert "\n")) + (setq end (point-max)) + (setq what "top-level") + (goto-char start) + (show-all))) + + (setq beg (point)) + (when (>= beg end) (goto-char start) (user-error "Nothing to sort")) + + (looking-at "\\(\\*+\\)") + (setq stars (match-string 1) + re (concat "^" (regexp-quote stars) " +") + re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]") + txt (buffer-substring beg end)) + (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) + (if (and (not (equal stars "*")) (string-match re2 txt)) + (user-error "Region to sort contains a level above the first entry")) + + (unless sorting-type + (message + "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc + [t]ime [s]cheduled [d]eadline [c]reated + A/N/P/R/O/F/T/S/D/C means reversed:" + what) + (setq sorting-type (read-char-exclusive)) + + (unless getkey-func + (and (= (downcase sorting-type) ?f) + (setq getkey-func + (org-icompleting-read "Sort using function: " + obarray 'fboundp t nil nil)) + (setq getkey-func (intern getkey-func)))) + + (and (= (downcase sorting-type) ?r) + (not property) + (setq property + (org-icompleting-read "Property: " + (mapcar 'list (org-buffer-property-keys t)) + nil t)))) + + (message "Sorting entries...") + + (save-restriction + (narrow-to-region start end) + (let ((dcst (downcase sorting-type)) + (case-fold-search nil) + (now (current-time))) + (sort-subr + (/= dcst sorting-type) + ;; This function moves to the beginning character of the "record" to + ;; be sorted. + (lambda nil + (if (re-search-forward re nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max)))) + ;; This function moves to the last character of the "record" being + ;; sorted. + (lambda nil + (save-match-data + (condition-case nil + (outline-forward-same-level 1) + (error + (goto-char (point-max)))))) + ;; This function returns the value that gets sorted against. + (lambda nil + (cond + ((= dcst ?n) + (if (looking-at org-complex-heading-regexp) + (string-to-number (org-sort-remove-invisible (match-string 4))) + nil)) + ((= dcst ?a) + (if (looking-at org-complex-heading-regexp) + (funcall case-func (org-sort-remove-invisible (match-string 4))) + nil)) + ((= dcst ?t) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (or (re-search-forward org-ts-regexp end t) + (re-search-forward org-ts-regexp-both end t)) + (org-time-string-to-seconds (match-string 0)) + (org-float-time now)))) + ((= dcst ?c) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward + (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") + end t) + (org-time-string-to-seconds (match-string 0)) + (org-float-time now)))) + ((= dcst ?s) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward org-scheduled-time-regexp end t) + (org-time-string-to-seconds (match-string 1)) + (org-float-time now)))) + ((= dcst ?d) + (let ((end (save-excursion (outline-next-heading) (point)))) + (if (re-search-forward org-deadline-time-regexp end t) + (org-time-string-to-seconds (match-string 1)) + (org-float-time now)))) + ((= dcst ?p) + (if (re-search-forward org-priority-regexp (point-at-eol) t) + (string-to-char (match-string 2)) + org-default-priority)) + ((= dcst ?r) + (or (org-entry-get nil property) "")) + ((= dcst ?o) + (if (looking-at org-complex-heading-regexp) + (- 9999 (length (member (match-string 2) + org-todo-keywords-1))))) + ((= dcst ?f) + (if getkey-func + (progn + (setq tmp (funcall getkey-func)) + (if (stringp tmp) (setq tmp (funcall case-func tmp))) + tmp) + (error "Invalid key function `%s'" getkey-func))) + (t (error "Invalid sorting type `%c'" sorting-type)))) + nil + (cond + ((= dcst ?a) 'string<) + ((= dcst ?f) compare-func) + ((member dcst '(?p ?t ?s ?d ?c)) '<))))) + (run-hooks 'org-after-sorting-entries-or-items-hook) + ;; Reset the clock marker if needed + (when cmstr + (save-excursion + (goto-char start) + (search-forward cmstr nil t) + (move-marker org-clock-marker (point)))) + (message "Sorting entries...done"))) + +(defun org-do-sort (table what &optional with-case sorting-type) + "Sort TABLE of WHAT according to SORTING-TYPE. +The user will be prompted for the SORTING-TYPE if the call to this +function does not specify it. WHAT is only for the prompt, to indicate +what is being sorted. The sorting key will be extracted from +the car of the elements of the table. +If WITH-CASE is non-nil, the sorting will be case-sensitive." + (unless sorting-type + (message + "Sort %s: [a]lphabetic, [n]umeric, [t]ime. A/N/T means reversed:" + what) + (setq sorting-type (read-char-exclusive))) + (let ((dcst (downcase sorting-type)) + extractfun comparefun) + ;; Define the appropriate functions + (cond + ((= dcst ?n) + (setq extractfun 'string-to-number + comparefun (if (= dcst sorting-type) '< '>))) + ((= dcst ?a) + (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x)) + (lambda(x) (downcase (org-sort-remove-invisible x)))) + comparefun (if (= dcst sorting-type) + 'string< + (lambda (a b) (and (not (string< a b)) + (not (string= a b))))))) + ((= dcst ?t) + (setq extractfun + (lambda (x) + (if (or (string-match org-ts-regexp x) + (string-match org-ts-regexp-both x)) + (org-float-time + (org-time-string-to-time (match-string 0 x))) + 0)) + comparefun (if (= dcst sorting-type) '< '>))) + (t (error "Invalid sorting type `%c'" sorting-type))) + + (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x))) + table) + (lambda (a b) (funcall comparefun (car a) (car b)))))) + + +;;; The orgstruct minor mode + +;; Define a minor mode which can be used in other modes in order to +;; integrate the org-mode structure editing commands. + +;; This is really a hack, because the org-mode structure commands use +;; keys which normally belong to the major mode. Here is how it +;; works: The minor mode defines all the keys necessary to operate the +;; structure commands, but wraps the commands into a function which +;; tests if the cursor is currently at a headline or a plain list +;; item. If that is the case, the structure command is used, +;; temporarily setting many Org-mode variables like regular +;; expressions for filling etc. However, when any of those keys is +;; used at a different location, function uses `key-binding' to look +;; up if the key has an associated command in another currently active +;; keymap (minor modes, major mode, global), and executes that +;; command. There might be problems if any of the keys is otherwise +;; used as a prefix key. + +(defcustom orgstruct-heading-prefix-regexp "" + "Regexp that matches the custom prefix of Org headlines in +orgstruct(++)-mode." + :group 'org + :version "24.4" + :package-version '(Org . "8.3") + :type 'regexp) +;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp) + +(defcustom orgstruct-setup-hook nil + "Hook run after orgstruct-mode-map is filled." + :group 'org + :version "24.4" + :package-version '(Org . "8.0") + :type 'hook) + +(defvar orgstruct-initialized nil) + +(defvar org-local-vars nil + "List of local variables, for use by `orgstruct-mode'.") + +;;;###autoload +(define-minor-mode orgstruct-mode + "Toggle the minor mode `orgstruct-mode'. +This mode is for using Org-mode structure commands in other +modes. The following keys behave as if Org-mode were active, if +the cursor is on a headline, or on a plain list item (both as +defined by Org-mode)." + nil " OrgStruct" (make-sparse-keymap) + (funcall (if orgstruct-mode + 'add-to-invisibility-spec + 'remove-from-invisibility-spec) + '(outline . t)) + (when orgstruct-mode + (org-load-modules-maybe) + (unless orgstruct-initialized + (orgstruct-setup) + (setq orgstruct-initialized t)))) + +;;;###autoload +(defun turn-on-orgstruct () + "Unconditionally turn on `orgstruct-mode'." + (orgstruct-mode 1)) + +(defvar org-fb-vars nil) +(make-variable-buffer-local 'org-fb-vars) +(defun orgstruct++-mode (&optional arg) + "Toggle `orgstruct-mode', the enhanced version of it. +In addition to setting orgstruct-mode, this also exports all +indentation and autofilling variables from org-mode into the +buffer. It will also recognize item context in multiline items." + (interactive "P") + (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1)))) + (if (< arg 1) + (progn (orgstruct-mode -1) + (mapc (lambda(v) + (org-set-local (car v) + (if (eq (car-safe (cadr v)) 'quote) (cadadr v) (cadr v)))) + org-fb-vars)) + (orgstruct-mode 1) + (setq org-fb-vars nil) + (unless org-local-vars + (setq org-local-vars (org-get-local-variables))) + (let (var val) + (mapc + (lambda (x) + (when (string-match + "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|fill-prefix\\|indent-\\)" + (symbol-name (car x))) + (setq var (car x) val (nth 1 x)) + (push (list var `(quote ,(eval var))) org-fb-vars) + (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) + org-local-vars) + (org-set-local 'orgstruct-is-++ t)))) + +(defvar orgstruct-is-++ nil + "Is `orgstruct-mode' in ++ version in the current-buffer?") +(make-variable-buffer-local 'orgstruct-is-++) + +;;;###autoload +(defun turn-on-orgstruct++ () + "Unconditionally turn on `orgstruct++-mode'." + (orgstruct++-mode 1)) + +(defun orgstruct-error () + "Error when there is no default binding for a structure key." + (interactive) + (funcall (if (fboundp 'user-error) + 'user-error + 'error) + "This key has no function outside structure elements")) + +(defun orgstruct-setup () + "Setup orgstruct keymap." + (dolist (cell '((org-demote . t) + (org-metaleft . t) + (org-metaright . t) + (org-promote . t) + (org-shiftmetaleft . t) + (org-shiftmetaright . t) + org-backward-element + org-backward-heading-same-level + org-ctrl-c-ret + org-ctrl-c-minus + org-ctrl-c-star + org-cycle + org-forward-heading-same-level + org-insert-heading + org-insert-heading-respect-content + org-kill-note-or-show-branches + org-mark-subtree + org-meta-return + org-metadown + org-metaup + org-narrow-to-subtree + org-promote-subtree + org-reveal + org-shiftdown + org-shiftleft + org-shiftmetadown + org-shiftmetaup + org-shiftright + org-shifttab + org-shifttab + org-shiftup + org-show-subtree + org-sort + org-up-element + outline-demote + outline-next-visible-heading + outline-previous-visible-heading + outline-promote + outline-up-heading + show-children)) + (let ((f (or (car-safe cell) cell)) + (disable-when-heading-prefix (cdr-safe cell))) + (when (fboundp f) + (let ((new-bindings)) + (dolist (binding (nconc (where-is-internal f org-mode-map) + (where-is-internal f outline-mode-map))) + (push binding new-bindings) + ;; TODO use local-function-key-map + (dolist (rep '(("<tab>" . "TAB") + ("<return>" . "RET") + ("<escape>" . "ESC") + ("<delete>" . "DEL"))) + (setq binding (read-kbd-macro + (let ((case-fold-search)) + (replace-regexp-in-string + (regexp-quote (cdr rep)) + (car rep) + (key-description binding))))) + (pushnew binding new-bindings :test 'equal))) + (dolist (binding new-bindings) + (let ((key (lookup-key orgstruct-mode-map binding))) + (when (or (not key) (numberp key)) + (condition-case nil + (org-defkey orgstruct-mode-map + binding + (orgstruct-make-binding f binding disable-when-heading-prefix)) + (error nil))))))))) + (run-hooks 'orgstruct-setup-hook)) + +(defun orgstruct-make-binding (fun key disable-when-heading-prefix) + "Create a function for binding in the structure minor mode. +FUN is the command to call inside a table. KEY is the key that +should be checked in for a command to execute outside of tables. +Non-nil `disable-when-heading-prefix' means to disable the command +if `orgstruct-heading-prefix-regexp' is not empty." + (let ((name (concat "orgstruct-hijacker-" (symbol-name fun)))) + (let ((nname name) + (i 0)) + (while (fboundp (intern nname)) + (setq nname (format "%s-%d" name (setq i (1+ i))))) + (setq name (intern nname))) + (eval + (let ((bindings '((org-heading-regexp + (concat "^" + orgstruct-heading-prefix-regexp + "\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ ]*$")) + (org-outline-regexp + (concat orgstruct-heading-prefix-regexp "\\*+ ")) + (org-outline-regexp-bol + (concat "^" org-outline-regexp)) + (outline-regexp org-outline-regexp) + (outline-heading-end-regexp "\n") + (outline-level 'org-outline-level) + (outline-heading-alist)))) + `(defun ,name (arg) + ,(concat "In Structure, run `" (symbol-name fun) "'.\n" + "Outside of structure, run the binding of `" + (key-description key) "'." + (when disable-when-heading-prefix + (concat + "\nIf `orgstruct-heading-prefix-regexp' is not empty, this command will always fall\n" + "back to the default binding due to limitations of Org's implementation of\n" + "`" (symbol-name fun) "'."))) + (interactive "p") + (let* ((disable + ,(and disable-when-heading-prefix + '(not (string= orgstruct-heading-prefix-regexp "")))) + (fallback + (or disable + (not + (let* ,bindings + (org-context-p 'headline 'item + ,(when (memq fun + '(org-insert-heading + org-insert-heading-respect-content + org-meta-return)) + '(when orgstruct-is-++ + 'item-body)))))))) + (if fallback + (let* ((orgstruct-mode) + (binding + (let ((key ,key)) + (catch 'exit + (dolist + (rep + '(nil + ("<\\([^>]*\\)tab>" . "\\1TAB") + ("<\\([^>]*\\)return>" . "\\1RET") + ("<\\([^>]*\\)escape>" . "\\1ESC") + ("<\\([^>]*\\)delete>" . "\\1DEL")) + nil) + (when rep + (setq key (read-kbd-macro + (let ((case-fold-search)) + (replace-regexp-in-string + (car rep) + (cdr rep) + (key-description key)))))) + (when (key-binding key) + (throw 'exit (key-binding key)))))))) + (if (keymapp binding) + (org-set-transient-map binding) + (let ((func (or binding + (unless disable + 'orgstruct-error)))) + (when func + (call-interactively func))))) + (org-run-like-in-org-mode + (lambda () + (interactive) + (let* ,bindings + (call-interactively ',fun))))))))) + name)) + +(defun org-contextualize-keys (alist contexts) + "Return valid elements in ALIST depending on CONTEXTS. + +`org-agenda-custom-commands' or `org-capture-templates' are the +values used for ALIST, and `org-agenda-custom-commands-contexts' +or `org-capture-templates-contexts' are the associated contexts +definitions." + (let ((contexts + ;; normalize contexts + (mapcar + (lambda(c) (cond ((listp (cadr c)) + (list (car c) (car c) (cadr c))) + ((string= "" (cadr c)) + (list (car c) (car c) (caddr c))) + (t c))) contexts)) + (a alist) c r s) + ;; loop over all commands or templates + (while (setq c (pop a)) + (let (vrules repl) + (cond + ((not (assoc (car c) contexts)) + (push c r)) + ((and (assoc (car c) contexts) + (setq vrules (org-contextualize-validate-key + (car c) contexts))) + (mapc (lambda (vr) + (when (not (equal (car vr) (cadr vr))) + (setq repl vr))) vrules) + (if (not repl) (push c r) + (push (cadr repl) s) + (push + (cons (car c) + (cdr (or (assoc (cadr repl) alist) + (error "Undefined key `%s' as contextual replacement for `%s'" + (cadr repl) (car c))))) + r)))))) + ;; Return limited ALIST, possibly with keys modified, and deduplicated + (delq + nil + (delete-dups + (mapcar (lambda (x) + (let ((tpl (car x))) + (when (not (delq + nil + (mapcar (lambda(y) + (equal y tpl)) s))) x))) + (reverse r)))))) + +(defun org-contextualize-validate-key (key contexts) + "Check CONTEXTS for agenda or capture KEY." + (let (r rr res) + (while (setq r (pop contexts)) + (mapc + (lambda (rr) + (when + (and (equal key (car r)) + (if (functionp rr) (funcall rr) + (or (and (eq (car rr) 'in-file) + (buffer-file-name) + (string-match (cdr rr) (buffer-file-name))) + (and (eq (car rr) 'in-mode) + (string-match (cdr rr) (symbol-name major-mode))) + (and (eq (car rr) 'in-buffer) + (string-match (cdr rr) (buffer-name))) + (when (and (eq (car rr) 'not-in-file) + (buffer-file-name)) + (not (string-match (cdr rr) (buffer-file-name)))) + (when (eq (car rr) 'not-in-mode) + (not (string-match (cdr rr) (symbol-name major-mode)))) + (when (eq (car rr) 'not-in-buffer) + (not (string-match (cdr rr) (buffer-name))))))) + (push r res))) + (car (last r)))) + (delete-dups (delq nil res)))) + +(defun org-context-p (&rest contexts) + "Check if local context is any of CONTEXTS. +Possible values in the list of contexts are `table', `headline', and `item'." + (let ((pos (point))) + (goto-char (point-at-bol)) + (prog1 (or (and (memq 'table contexts) + (looking-at "[ \t]*|")) + (and (memq 'headline contexts) + (looking-at org-outline-regexp)) + (and (memq 'item contexts) + (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)")) + (and (memq 'item-body contexts) + (org-in-item-p))) + (goto-char pos)))) + +(defun org-get-local-variables () + "Return a list of all local variables in an Org mode buffer." + (let (varlist) + (with-current-buffer (get-buffer-create "*Org tmp*") + (erase-buffer) + (org-mode) + (setq varlist (buffer-local-variables))) + (kill-buffer "*Org tmp*") + (delq nil + (mapcar + (lambda (x) + (setq x + (if (symbolp x) + (list x) + (list (car x) (cdr x)))) + (if (and (not (get (car x) 'org-state)) + (string-match + "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" + (symbol-name (car x)))) + x nil)) + varlist)))) + +(defun org-clone-local-variables (from-buffer &optional regexp) + "Clone local variables from FROM-BUFFER. +Optional argument REGEXP selects variables to clone." + (mapc + (lambda (pair) + (and (symbolp (car pair)) + (or (null regexp) + (string-match regexp (symbol-name (car pair)))) + (set (make-local-variable (car pair)) + (cdr pair)))) + (buffer-local-variables from-buffer))) + +;;;###autoload +(defun org-run-like-in-org-mode (cmd) + "Run a command, pretending that the current buffer is in Org-mode. +This will temporarily bind local variables that are typically bound in +Org-mode to the values they have in Org-mode, and then interactively +call CMD." + (org-load-modules-maybe) + (unless org-local-vars + (setq org-local-vars (org-get-local-variables))) + (let (binds) + (dolist (var org-local-vars) + (when (or (not (boundp (car var))) + (eq (symbol-value (car var)) + (default-value (car var)))) + (push (list (car var) `(quote ,(cadr var))) binds))) + (eval `(let ,binds + (call-interactively (quote ,cmd)))))) + +;;;; Archiving + +(defun org-get-category (&optional pos force-refresh) + "Get the category applying to position POS." + (save-match-data + (if force-refresh (org-refresh-category-properties)) + (let ((pos (or pos (point)))) + (or (get-text-property pos 'org-category) + (progn (org-refresh-category-properties) + (get-text-property pos 'org-category)))))) + +(defun org-refresh-category-properties () + "Refresh category text properties in the buffer." + (let ((case-fold-search t) + (inhibit-read-only t) + (def-cat (cond + ((null org-category) + (if buffer-file-name + (file-name-sans-extension + (file-name-nondirectory buffer-file-name)) + "???")) + ((symbolp org-category) (symbol-name org-category)) + (t org-category))) + beg end cat pos optionp) + (org-with-silent-modifications + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (put-text-property (point) (point-max) 'org-category def-cat) + (while (re-search-forward + "^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t) + (setq pos (match-end 0) + optionp (equal (char-after (match-beginning 0)) ?#) + cat (org-trim (match-string 2))) + (if optionp + (setq beg (point-at-bol) end (point-max)) + (org-back-to-heading t) + (setq beg (point) end (org-end-of-subtree t t))) + (put-text-property beg end 'org-category cat) + (put-text-property beg end 'org-category-position beg) + (goto-char pos))))))) + +(defun org-refresh-properties (dprop tprop) + "Refresh buffer text properties. +DPROP is the drawer property and TPROP is the corresponding text +property to set." + (let ((case-fold-search t) + (inhibit-read-only t) p) + (org-with-silent-modifications + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t) + (setq p (org-match-string-no-properties 1)) + (save-excursion + (org-back-to-heading t) + (put-text-property + (point-at-bol) (or (outline-next-heading) (point-max)) tprop p)))))))) + + +;;;; Link Stuff + +;;; Link abbreviations + +(defun org-link-expand-abbrev (link) + "Apply replacements as defined in `org-link-abbrev-alist'." + (if (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link) + (let* ((key (match-string 1 link)) + (as (or (assoc key org-link-abbrev-alist-local) + (assoc key org-link-abbrev-alist))) + (tag (and (match-end 2) (match-string 3 link))) + rpl) + (if (not as) + link + (setq rpl (cdr as)) + (cond + ((symbolp rpl) (funcall rpl tag)) + ((string-match "%(\\([^)]+\\))" rpl) + (replace-match + (save-match-data + (funcall (intern-soft (match-string 1 rpl)) tag)) t t rpl)) + ((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) + ((string-match "%h" rpl) + (replace-match (url-hexify-string (or tag "")) t t rpl)) + (t (concat rpl tag))))) + link)) + +;;; Storing and inserting links + +(defvar org-insert-link-history nil + "Minibuffer history for links inserted with `org-insert-link'.") + +(defvar org-stored-links nil + "Contains the links stored with `org-store-link'.") + +(defvar org-store-link-plist nil + "Plist with info about the most recently link created with `org-store-link'.") + +(defvar org-link-protocols nil + "Link protocols added to Org-mode using `org-add-link-type'.") + +(defvar org-store-link-functions nil + "List of functions that are called to create and store a link. +Each function will be called in turn until one returns a non-nil +value. Each function should check if it is responsible for creating +this link (for example by looking at the major mode). +If not, it must exit and return nil. +If yes, it should return a non-nil value after a calling +`org-store-link-props' with a list of properties and values. +Special properties are: + +:type The link prefix, like \"http\". This must be given. +:link The link, like \"http://www.astro.uva.nl/~dominik\". + This is obligatory as well. +:description Optional default description for the second pair + of brackets in an Org-mode link. The user can still change + this when inserting this link into an Org-mode buffer. + +In addition to these, any additional properties can be specified +and then used in capture templates.") + +(defun org-add-link-type (type &optional follow export) + "Add TYPE to the list of `org-link-types'. +Re-compute all regular expressions depending on `org-link-types' + +FOLLOW and EXPORT are two functions. + +FOLLOW should take the link path as the single argument and do whatever +is necessary to follow the link, for example find a file or display +a mail message. + +EXPORT should format the link path for export to one of the export formats. +It should be a function accepting three arguments: + + path the path of the link, the text after the prefix (like \"http:\") + desc the description of the link, if any, or a description added by + org-export-normalize-links if there is none + format the export format, a symbol like `html' or `latex' or `ascii'.. + +The function may use the FORMAT information to return different values +depending on the format. The return value will be put literally into +the exported file. If the return value is nil, this means Org should +do what it normally does with links which do not have EXPORT defined. + +Org-mode has a built-in default for exporting links. If you are happy with +this default, there is no need to define an export function for the link +type. For a simple example of an export function, see `org-bbdb.el'." + (add-to-list 'org-link-types type t) + (org-make-link-regexps) + (if (assoc type org-link-protocols) + (setcdr (assoc type org-link-protocols) (list follow export)) + (push (list type follow export) org-link-protocols))) + +(defvar org-agenda-buffer-name) ; Defined in org-agenda.el +(defvar org-id-link-to-org-use-id) ; Defined in org-id.el + +;;;###autoload +(defun org-store-link (arg) + "\\<org-mode-map>Store an org-link to the current location. +This link is added to `org-stored-links' and can later be inserted +into an org-buffer with \\[org-insert-link]. + +For some link types, a prefix arg is interpreted. +For links to Usenet articles, arg negates `org-gnus-prefer-web-links'. +For file links, arg negates `org-context-in-file-links'. + +A double prefix arg force skipping storing functions that are not +part of Org's core. + +A triple prefix arg force storing a link for each line in the +active region." + (interactive "P") + (org-load-modules-maybe) + (if (and (equal arg '(64)) (org-region-active-p)) + (save-excursion + (let ((end (region-end))) + (goto-char (region-beginning)) + (set-mark (point)) + (while (< (point-at-eol) end) + (move-end-of-line 1) (activate-mark) + (let (current-prefix-arg) + (call-interactively 'org-store-link)) + (move-beginning-of-line 2) + (set-mark (point))))) + (org-with-limited-levels + (setq org-store-link-plist nil) + (let (link cpltxt desc description search + txt custom-id agenda-link sfuns sfunsn) + (cond + + ;; Store a link using an external link type + ((and (not (equal arg '(16))) + (setq sfuns + (delq + nil (mapcar (lambda (f) + (let (fs) (if (funcall f) (push f fs)))) + org-store-link-functions)) + sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns)) + (or (and (cdr sfuns) + (funcall (intern + (completing-read + "Which function for creating the link? " + sfunsn nil t (car sfunsn))))) + (funcall (caar sfuns))) + (setq link (plist-get org-store-link-plist :link) + desc (or (plist-get org-store-link-plist + :description) link)))) + + ;; Store a link from a source code buffer + ((org-src-edit-buffer-p) + (let (label gc) + (while (or (not label) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (re-search-forward + (regexp-quote (format org-coderef-label-format label)) + nil t)))) + (when label (message "Label exists already") (sit-for 2)) + (setq label (read-string "Code line label: " label))) + (end-of-line 1) + (setq link (format org-coderef-label-format label)) + (setq gc (- 79 (length link))) + (if (< (current-column) gc) (org-move-to-column gc t) (insert " ")) + (insert link) + (setq link (concat "(" label ")") desc nil))) + + ;; We are in the agenda, link to referenced location + ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name)) + (let ((m (or (get-text-property (point) 'org-hd-marker) + (get-text-property (point) 'org-marker)))) + (when m + (org-with-point-at m + (setq agenda-link + (if (org-called-interactively-p 'any) + (call-interactively 'org-store-link) + (org-store-link nil))))))) + + ((eq major-mode 'calendar-mode) + (let ((cd (calendar-cursor-to-date))) + (setq link + (format-time-string + (car org-time-stamp-formats) + (apply 'encode-time + (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) + nil nil nil)))) + (org-store-link-props :type "calendar" :date cd))) + + ((eq major-mode 'help-mode) + (setq link (concat "help:" (save-excursion + (goto-char (point-min)) + (looking-at "^[^ ]+") + (match-string 0)))) + (org-store-link-props :type "help")) + + ((eq major-mode 'w3-mode) + (setq cpltxt (if (and (buffer-name) + (not (string-match "Untitled" (buffer-name)))) + (buffer-name) + (url-view-url t)) + link (url-view-url t)) + (org-store-link-props :type "w3" :url (url-view-url t))) + + ((eq major-mode 'image-mode) + (setq cpltxt (concat "file:" + (abbreviate-file-name buffer-file-name)) + link cpltxt) + (org-store-link-props :type "image" :file buffer-file-name)) + + ;; In dired, store a link to the file of the current line + ((eq major-mode 'dired-mode) + (let ((file (dired-get-filename nil t))) + (setq file (if file + (abbreviate-file-name + (expand-file-name (dired-get-filename nil t))) + ;; otherwise, no file so use current directory. + default-directory)) + (setq cpltxt (concat "file:" file) + link cpltxt))) + + ((setq search (run-hook-with-args-until-success + 'org-create-file-search-functions)) + (setq link (concat "file:" (abbreviate-file-name buffer-file-name) + "::" search)) + (setq cpltxt (or description link))) + + ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) + (setq custom-id (org-entry-get nil "CUSTOM_ID")) + (cond + ;; Store a link using the target at point + ((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1) + (setq cpltxt + (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))) + "::" (match-string 1)) + link cpltxt)) + ((and (featurep 'org-id) + (or (eq org-id-link-to-org-use-id t) + (and (org-called-interactively-p 'any) + (or (eq org-id-link-to-org-use-id 'create-if-interactive) + (and (eq org-id-link-to-org-use-id + 'create-if-interactive-and-no-custom-id) + (not custom-id)))) + (and org-id-link-to-org-use-id (org-entry-get nil "ID")))) + ;; Store a link using the ID at point + (setq link (condition-case nil + (prog1 (org-id-store-link) + (setq desc (or (plist-get org-store-link-plist + :description) + ""))) + (error + ;; Probably before first headline, link only to file + (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer)))))))) + (t + ;; Just link to current headline + (setq cpltxt (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))))) + ;; Add a context search string + (when (org-xor org-context-in-file-links arg) + (let* ((ee (org-element-at-point)) + (et (org-element-type ee)) + (ev (plist-get (cadr ee) :value)) + (ek (plist-get (cadr ee) :key)) + (eok (and (stringp ek) (string-match "name" ek)))) + (setq txt (cond + ((org-at-heading-p) nil) + ((and (eq et 'keyword) eok) ev) + ((org-region-active-p) + (buffer-substring (region-beginning) (region-end))))) + (when (or (null txt) (string-match "\\S-" txt)) + (setq cpltxt + (concat cpltxt "::" + (condition-case nil + (org-make-org-heading-search-string txt) + (error ""))) + desc (or (and (eq et 'keyword) eok ev) + (nth 4 (ignore-errors (org-heading-components))) + "NONE"))))) + (if (string-match "::\\'" cpltxt) + (setq cpltxt (substring cpltxt 0 -2))) + (setq link cpltxt)))) + + ((buffer-file-name (buffer-base-buffer)) + ;; Just link to this file here. + (setq cpltxt (concat "file:" + (abbreviate-file-name + (buffer-file-name (buffer-base-buffer))))) + ;; Add a context string. + (when (org-xor org-context-in-file-links arg) + (setq txt (if (org-region-active-p) + (buffer-substring (region-beginning) (region-end)) + (buffer-substring (point-at-bol) (point-at-eol)))) + ;; Only use search option if there is some text. + (when (string-match "\\S-" txt) + (setq cpltxt + (concat cpltxt "::" (org-make-org-heading-search-string txt)) + desc "NONE"))) + (setq link cpltxt)) + + ((org-called-interactively-p 'interactive) + (user-error "No method for storing a link from this buffer")) + + (t (setq link nil))) + + ;; We're done setting link and desc, clean up + (if (consp link) (setq cpltxt (car link) link (cdr link))) + (setq link (or link cpltxt) + desc (or desc cpltxt)) + (cond ((equal desc "NONE") (setq desc nil)) + ((and desc (string-match org-bracket-link-analytic-regexp desc)) + (let ((d0 (match-string 3 desc)) + (p0 (match-string 5 desc))) + (setq desc + (replace-regexp-in-string + org-bracket-link-regexp + (concat (or p0 d0) + (if (equal (length (match-string 0 desc)) + (length desc)) "*" "")) desc))))) + + ;; Return the link + (if (not (and (or (org-called-interactively-p 'any) + executing-kbd-macro) link)) + (or agenda-link (and link (org-make-link-string link desc))) + (push (list link desc) org-stored-links) + (message "Stored: %s" (or desc link)) + (when custom-id + (setq link (concat "file:" (abbreviate-file-name + (buffer-file-name)) "::#" custom-id)) + (push (list link desc) org-stored-links)) + (car org-stored-links)))))) + +(defun org-store-link-props (&rest plist) + "Store link properties, extract names and addresses." + (let (x adr) + (when (setq x (plist-get plist :from)) + (setq adr (mail-extract-address-components x)) + (setq plist (plist-put plist :fromname (car adr))) + (setq plist (plist-put plist :fromaddress (nth 1 adr)))) + (when (setq x (plist-get plist :to)) + (setq adr (mail-extract-address-components x)) + (setq plist (plist-put plist :toname (car adr))) + (setq plist (plist-put plist :toaddress (nth 1 adr))))) + (let ((from (plist-get plist :from)) + (to (plist-get plist :to))) + (when (and from to org-from-is-user-regexp) + (setq plist + (plist-put plist :fromto + (if (string-match org-from-is-user-regexp from) + (concat "to %t") + (concat "from %f")))))) + (setq org-store-link-plist plist)) + +(defun org-add-link-props (&rest plist) + "Add these properties to the link property list." + (let (key value) + (while plist + (setq key (pop plist) value (pop plist)) + (setq org-store-link-plist + (plist-put org-store-link-plist key value))))) + +(defun org-email-link-description (&optional fmt) + "Return the description part of an email link. +This takes information from `org-store-link-plist' and formats it +according to FMT (default from `org-email-link-description-format')." + (setq fmt (or fmt org-email-link-description-format)) + (let* ((p org-store-link-plist) + (to (plist-get p :toaddress)) + (from (plist-get p :fromaddress)) + (table + (list + (cons "%c" (plist-get p :fromto)) + (cons "%F" (plist-get p :from)) + (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?")) + (cons "%T" (plist-get p :to)) + (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?")) + (cons "%s" (plist-get p :subject)) + (cons "%d" (plist-get p :date)) + (cons "%m" (plist-get p :message-id))))) + (when (string-match "%c" fmt) + ;; Check if the user wrote this message + (if (and org-from-is-user-regexp from to + (save-match-data (string-match org-from-is-user-regexp from))) + (setq fmt (replace-match "to %t" t t fmt)) + (setq fmt (replace-match "from %f" t t fmt)))) + (org-replace-escapes fmt table))) + +(defun org-make-org-heading-search-string (&optional string) + "Make search string for the current headline or STRING." + (let ((s (or string + (and (derived-mode-p 'org-mode) + (save-excursion + (org-back-to-heading t) + (org-element-property :raw-value (org-element-at-point)))))) + (lines org-context-in-file-links)) + (or string (setq s (concat "*" s))) ; Add * for headlines + (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s)) + (when (and string (integerp lines) (> lines 0)) + (let ((slines (org-split-string s "\n"))) + (when (< lines (length slines)) + (setq s (mapconcat + 'identity + (reverse (nthcdr (- (length slines) lines) + (reverse slines))) "\n"))))) + (mapconcat 'identity (org-split-string s "[ \t]+") " "))) + +(defun org-make-link-string (link &optional description) + "Make a link with brackets, consisting of LINK and DESCRIPTION." + (unless (string-match "\\S-" link) + (error "Empty link")) + (when (and description + (stringp description) + (not (string-match "\\S-" description))) + (setq description nil)) + (when (stringp description) + ;; Remove brackets from the description, they are fatal. + (while (string-match "\\[" description) + (setq description (replace-match "{" t t description))) + (while (string-match "\\]" description) + (setq description (replace-match "}" t t description)))) + (when (equal link description) + ;; No description needed, it is identical + (setq description nil)) + (when (and (not description) + (not (string-match (org-image-file-name-regexp) link)) + (not (equal link (org-link-escape link)))) + (setq description (org-extract-attributes link))) + (setq link + (cond ((string-match (org-image-file-name-regexp) link) link) + ((string-match org-link-types-re link) + (concat (match-string 1 link) + (org-link-escape (substring link (match-end 1))))) + (t (org-link-escape link)))) + (concat "[[" link "]" + (if description (concat "[" description "]") "") + "]")) + +(defconst org-link-escape-chars + '(?\ ?\[ ?\] ?\; ?\= ?\+) + "List of characters that should be escaped in link. +This is the list that is used for internal purposes.") + +(defconst org-link-escape-chars-browser + '(?\ ?\") + "List of escapes for characters that are problematic in links. +This is the list that is used before handing over to the browser.") + +(defun org-link-escape (text &optional table merge) + "Return percent escaped representation of TEXT. +TEXT is a string with the text to escape. +Optional argument TABLE is a list with characters that should be +escaped. When nil, `org-link-escape-chars' is used. +If optional argument MERGE is set, merge TABLE into +`org-link-escape-chars'." + (cond + ((and table merge) + (mapc (lambda (defchr) + (unless (member defchr table) + (setq table (cons defchr table)))) org-link-escape-chars)) + ((null table) + (setq table org-link-escape-chars))) + (mapconcat + (lambda (char) + (if (or (member char table) + (and (or (< char 32) (= char 37) (> char 126)) + org-url-hexify-p)) + (mapconcat (lambda (sequence-element) + (format "%%%.2X" sequence-element)) + (or (encode-coding-char char 'utf-8) + (error "Unable to percent escape character: %s" + (char-to-string char))) "") + (char-to-string char))) text "")) + +(defun org-link-unescape (str) + "Unhex hexified Unicode strings as returned from the JavaScript function +encodeURIComponent. E.g. `%C3%B6' is the german o-Umlaut." + (unless (and (null str) (string= "" str)) + (let ((pos 0) (case-fold-search t) unhexed) + (while (setq pos (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str pos)) + (setq unhexed (org-link-unescape-compound (match-string 0 str))) + (setq str (replace-match unhexed t t str)) + (setq pos (+ pos (length unhexed)))))) + str) + +(defun org-link-unescape-compound (hex) + "Unhexify Unicode hex-chars. E.g. `%C3%B6' is the German o-Umlaut. +Note: this function also decodes single byte encodings like +`%E1' (a-acute) if not followed by another `%[A-F0-9]{2}' group." + (save-match-data + (let* ((bytes (cdr (split-string hex "%"))) + (ret "") + (eat 0) + (sum 0)) + (while bytes + (let* ((val (string-to-number (pop bytes) 16)) + (shift-xor + (if (= 0 eat) + (cond + ((>= val 252) (cons 6 252)) + ((>= val 248) (cons 5 248)) + ((>= val 240) (cons 4 240)) + ((>= val 224) (cons 3 224)) + ((>= val 192) (cons 2 192)) + (t (cons 0 0))) + (cons 6 128)))) + (if (>= val 192) (setq eat (car shift-xor))) + (setq val (logxor val (cdr shift-xor))) + (setq sum (+ (lsh sum (car shift-xor)) val)) + (if (> eat 0) (setq eat (- eat 1))) + (cond + ((= 0 eat) ;multi byte + (setq ret (concat ret (org-char-to-string sum))) + (setq sum 0)) + ((not bytes) ; single byte(s) + (setq ret (org-link-unescape-single-byte-sequence hex)))) + )) ;; end (while bytes + ret ))) + +(defun org-link-unescape-single-byte-sequence (hex) + "Unhexify hex-encoded single byte character sequences." + (mapconcat (lambda (byte) + (char-to-string (string-to-number byte 16))) + (cdr (split-string hex "%")) "")) + +(defun org-xor (a b) + "Exclusive or." + (if a (not b) b)) + +(defun org-fixup-message-id-for-http (s) + "Replace special characters in a message id, so it can be used in an http query." + (when (string-match "%" s) + (setq s (mapconcat (lambda (c) + (if (eq c ?%) + "%25" + (char-to-string c))) + s ""))) + (while (string-match "<" s) + (setq s (replace-match "%3C" t t s))) + (while (string-match ">" s) + (setq s (replace-match "%3E" t t s))) + (while (string-match "@" s) + (setq s (replace-match "%40" t t s))) + s) + +(defun org-link-prettify (link) + "Return a human-readable representation of LINK. +The car of LINK must be a raw link the cdr of LINK must be either +a link description or nil." + (let ((desc (or (cadr link) "<no description>"))) + (concat (format "%-45s" (substring desc 0 (min (length desc) 40))) + "<" (car link) ">"))) + +;;;###autoload +(defun org-insert-link-global () + "Insert a link like Org-mode does. +This command can be called in any mode to insert a link in Org-mode syntax." + (interactive) + (org-load-modules-maybe) + (org-run-like-in-org-mode 'org-insert-link)) + +(defun org-insert-all-links (&optional keep) + "Insert all links in `org-stored-links'." + (interactive "P") + (let ((links (copy-sequence org-stored-links)) l) + (while (setq l (if keep (pop links) (pop org-stored-links))) + (insert "- ") + (org-insert-link nil (car l) (or (cadr l) "<no description>")) + (insert "\n")))) + +(defun org-link-fontify-links-to-this-file () + "Fontify links to the current file in `org-stored-links'." + (let ((f (buffer-file-name)) a b) + (setq a (mapcar (lambda(l) + (let ((ll (car l))) + (when (and (string-match "^file:\\(.+\\)::" ll) + (equal f (expand-file-name (match-string 1 ll)))) + ll))) + org-stored-links)) + (when (featurep 'org-id) + (setq b (mapcar (lambda(l) + (let ((ll (car l))) + (when (and (string-match "^id:\\(.+\\)$" ll) + (equal f (expand-file-name + (or (org-id-find-id-file + (match-string 1 ll)) "")))) + ll))) + org-stored-links))) + (mapcar (lambda(l) + (put-text-property 0 (length l) 'face 'font-lock-comment-face l)) + (delq nil (append a b))))) + +(defvar org-link-links-in-this-file nil) +(defun org-insert-link (&optional complete-file link-location default-description) + "Insert a link. At the prompt, enter the link. + +Completion can be used to insert any of the link protocol prefixes like +http or ftp in use. + +The history can be used to select a link previously stored with +`org-store-link'. When the empty string is entered (i.e. if you just +press RET at the prompt), the link defaults to the most recently +stored link. As SPC triggers completion in the minibuffer, you need to +use M-SPC or C-q SPC to force the insertion of a space character. + +You will also be prompted for a description, and if one is given, it will +be displayed in the buffer instead of the link. + +If there is already a link at point, this command will allow you to edit link +and description parts. + +With a \\[universal-argument] prefix, prompts for a file to link to. The file name can +be selected using completion. The path to the file will be relative to the +current directory if the file is in the current directory or a subdirectory. +Otherwise, the link will be the absolute path as completed in the minibuffer +\(i.e. normally ~/path/to/file). You can configure this behavior using the +option `org-link-file-path-type'. + +With two \\[universal-argument] prefixes, enforce an absolute path even if the file is in +the current directory or below. + +With three \\[universal-argument] prefixes, negate the meaning of +`org-keep-stored-link-after-insertion'. + +If `org-make-link-description-function' is non-nil, this function will be +called with the link target, and the result will be the default +link description. + +If the LINK-LOCATION parameter is non-nil, this value will be +used as the link location instead of reading one interactively. + +If the DEFAULT-DESCRIPTION parameter is non-nil, this value will +be used as the default description." + (interactive "P") + (let* ((wcf (current-window-configuration)) + (origbuf (current-buffer)) + (region (if (org-region-active-p) + (buffer-substring (region-beginning) (region-end)))) + (remove (and region (list (region-beginning) (region-end)))) + (desc region) + tmphist ; byte-compile incorrectly complains about this + (link link-location) + (abbrevs org-link-abbrev-alist-local) + entry file all-prefixes auto-desc) + (cond + (link-location) ; specified by arg, just use it. + ((org-in-regexp org-bracket-link-regexp 1) + ;; We do have a link at point, and we are going to edit it. + (setq remove (list (match-beginning 0) (match-end 0))) + (setq desc (if (match-end 3) (org-match-string-no-properties 3))) + (setq link (read-string "Link: " + (org-link-unescape + (org-match-string-no-properties 1))))) + ((or (org-in-regexp org-angle-link-re) + (org-in-regexp org-plain-link-re)) + ;; Convert to bracket link + (setq remove (list (match-beginning 0) (match-end 0)) + link (read-string "Link: " + (org-remove-angle-brackets (match-string 0))))) + ((member complete-file '((4) (16))) + ;; Completing read for file names. + (setq link (org-file-complete-link complete-file))) + (t + ;; Read link, with completion for stored links. + (org-link-fontify-links-to-this-file) + (org-switch-to-buffer-other-window "*Org Links*") + (with-current-buffer "*Org Links*" + (erase-buffer) + (insert "Insert a link. +Use TAB to complete link prefixes, then RET for type-specific completion support\n") + (when org-stored-links + (insert "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n") + (insert (mapconcat 'org-link-prettify + (reverse org-stored-links) "\n"))) + (goto-char (point-min))) + (let ((cw (selected-window))) + (select-window (get-buffer-window "*Org Links*" 'visible)) + (with-current-buffer "*Org Links*" (setq truncate-lines t)) + (unless (pos-visible-in-window-p (point-max)) + (org-fit-window-to-buffer)) + (and (window-live-p cw) (select-window cw))) + ;; Fake a link history, containing the stored links. + (setq tmphist (append (mapcar 'car org-stored-links) + org-insert-link-history)) + (setq all-prefixes (append (mapcar 'car abbrevs) + (mapcar 'car org-link-abbrev-alist) + org-link-types)) + (unwind-protect + (progn + (setq link + (org-completing-read + "Link: " + (append + (mapcar (lambda (x) (concat x ":")) + all-prefixes) + (mapcar 'car org-stored-links)) + nil nil nil + 'tmphist + (caar org-stored-links))) + (if (not (string-match "\\S-" link)) + (user-error "No link selected")) + (mapc (lambda(l) + (when (equal link (cadr l)) (setq link (car l) auto-desc t))) + org-stored-links) + (if (or (member link all-prefixes) + (and (equal ":" (substring link -1)) + (member (substring link 0 -1) all-prefixes) + (setq link (substring link 0 -1)))) + (setq link (with-current-buffer origbuf + (org-link-try-special-completion link))))) + (set-window-configuration wcf) + (kill-buffer "*Org Links*")) + (setq entry (assoc link org-stored-links)) + (or entry (push link org-insert-link-history)) + (setq desc (or desc (nth 1 entry))))) + + (if (funcall (if (equal complete-file '(64)) 'not 'identity) + (not org-keep-stored-link-after-insertion)) + (setq org-stored-links (delq (assoc link org-stored-links) + org-stored-links))) + + (if (and (string-match org-plain-link-re link) + (not (string-match org-ts-regexp link))) + ;; URL-like link, normalize the use of angular brackets. + (setq link (org-remove-angle-brackets link))) + + ;; Check if we are linking to the current file with a search + ;; option If yes, simplify the link by using only the search + ;; option. + (when (and buffer-file-name + (string-match "^file:\\(.+?\\)::\\(.+\\)" link)) + (let* ((path (match-string 1 link)) + (case-fold-search nil) + (search (match-string 2 link))) + (save-match-data + (if (equal (file-truename buffer-file-name) (file-truename path)) + ;; We are linking to this same file, with a search option + (setq link search))))) + + ;; Check if we can/should use a relative path. If yes, simplify the link + (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link) + (let* ((type (match-string 1 link)) + (path (match-string 2 link)) + (origpath path) + (case-fold-search nil)) + (cond + ((or (eq org-link-file-path-type 'absolute) + (equal complete-file '(16))) + (setq path (abbreviate-file-name (expand-file-name path)))) + ((eq org-link-file-path-type 'noabbrev) + (setq path (expand-file-name path))) + ((eq org-link-file-path-type 'relative) + (setq path (file-relative-name path))) + (t + (save-match-data + (if (string-match (concat "^" (regexp-quote + (expand-file-name + (file-name-as-directory + default-directory)))) + (expand-file-name path)) + ;; We are linking a file with relative path name. + (setq path (substring (expand-file-name path) + (match-end 0))) + (setq path (abbreviate-file-name (expand-file-name path))))))) + (setq link (concat type path)) + (if (equal desc origpath) + (setq desc path)))) + + (if org-make-link-description-function + (setq desc + (or (condition-case nil + (funcall org-make-link-description-function link desc) + (error (progn (message "Can't get link description from `%s'" + (symbol-name org-make-link-description-function)) + (sit-for 2) nil))) + (read-string "Description: " default-description))) + (if default-description (setq desc default-description) + (setq desc (or (and auto-desc desc) + (read-string "Description: " desc))))) + + (unless (string-match "\\S-" desc) (setq desc nil)) + (if remove (apply 'delete-region remove)) + (insert (org-make-link-string link desc)))) + +(defun org-link-try-special-completion (type) + "If there is completion support for link type TYPE, offer it." + (let ((fun (intern (concat "org-" type "-complete-link")))) + (if (functionp fun) + (funcall fun) + (read-string "Link (no completion support): " (concat type ":"))))) + +(defun org-file-complete-link (&optional arg) + "Create a file link using completion." + (let (file link) + (setq file (org-iread-file-name "File: ")) + (let ((pwd (file-name-as-directory (expand-file-name "."))) + (pwd1 (file-name-as-directory (abbreviate-file-name + (expand-file-name "."))))) + (cond + ((equal arg '(16)) + (setq link (concat + "file:" + (abbreviate-file-name (expand-file-name file))))) + ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) + (setq link (concat "file:" (match-string 1 file)))) + ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") + (expand-file-name file)) + (setq link (concat + "file:" (match-string 1 (expand-file-name file))))) + (t (setq link (concat "file:" file))))) + link)) + +(defun org-iread-file-name (&rest args) + "Read-file-name using `ido-mode' speedup if available. +ARGS are arguments that may be passed to `ido-read-file-name' or `read-file-name'. +See `read-file-name' for a description of parameters." + (org-without-partial-completion + (if (and org-completion-use-ido + (fboundp 'ido-read-file-name) + (boundp 'ido-mode) ido-mode + (listp (second args))) + (let ((ido-enter-matching-directory nil)) + (apply 'ido-read-file-name args)) + (apply 'read-file-name args)))) + +(defun org-completing-read (&rest args) + "Completing-read with SPACE being a normal character." + (let ((enable-recursive-minibuffers t) + (minibuffer-local-completion-map + (copy-keymap minibuffer-local-completion-map))) + (org-defkey minibuffer-local-completion-map " " 'self-insert-command) + (org-defkey minibuffer-local-completion-map "?" 'self-insert-command) + (org-defkey minibuffer-local-completion-map (kbd "C-c !") 'org-time-stamp-inactive) + (apply 'org-icompleting-read args))) + +(defun org-completing-read-no-i (&rest args) + (let (org-completion-use-ido org-completion-use-iswitchb) + (apply 'org-completing-read args))) + +(defun org-iswitchb-completing-read (prompt choices &rest args) + "Use iswitch as a completing-read replacement to choose from choices. +PROMPT is a string to prompt with. CHOICES is a list of strings to choose +from." + (let* ((iswitchb-use-virtual-buffers nil) + (iswitchb-make-buflist-hook + (lambda () + (setq iswitchb-temp-buflist choices)))) + (iswitchb-read-buffer prompt))) + +(defun org-icompleting-read (&rest args) + "Completing-read using `ido-mode' or `iswitchb' speedups if available." + (org-without-partial-completion + (if (and org-completion-use-ido + (fboundp 'ido-completing-read) + (boundp 'ido-mode) ido-mode + (listp (second args))) + (let ((ido-enter-matching-directory nil)) + (apply 'ido-completing-read (concat (car args)) + (if (consp (car (nth 1 args))) + (mapcar 'car (nth 1 args)) + (nth 1 args)) + (cddr args))) + (if (and org-completion-use-iswitchb + (boundp 'iswitchb-mode) iswitchb-mode + (listp (second args))) + (apply 'org-iswitchb-completing-read (concat (car args)) + (if (consp (car (nth 1 args))) + (mapcar 'car (nth 1 args)) + (nth 1 args)) + (cddr args)) + (apply 'completing-read args))))) + +(defun org-extract-attributes (s) + "Extract the attributes cookie from a string and set as text property." + (let (a attr (start 0) key value) + (save-match-data + (when (string-match "{{\\([^}]+\\)}}$" s) + (setq a (match-string 1 s) s (substring s 0 (match-beginning 0))) + (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"" a start) + (setq key (match-string 1 a) value (match-string 2 a) + start (match-end 0) + attr (plist-put attr (intern key) value)))) + (org-add-props s nil 'org-attr attr)) + s)) + +;;; Opening/following a link + +(defvar org-link-search-failed nil) + +(defvar org-open-link-functions nil + "Hook for functions finding a plain text link. +These functions must take a single argument, the link content. +They will be called for links that look like [[link text][description]] +when LINK TEXT does not have a protocol like \"http:\" and does not look +like a filename (e.g. \"./blue.png\"). + +These functions will be called *before* Org attempts to resolve the +link by doing text searches in the current buffer - so if you want a +link \"[[target]]\" to still find \"<<target>>\", your function should +handle this as a special case. + +When the function does handle the link, it must return a non-nil value. +If it decides that it is not responsible for this link, it must return +nil to indicate that that Org-mode can continue with other options +like exact and fuzzy text search.") + +(defun org-next-link (&optional search-backward) + "Move forward to the next link. +If the link is in hidden text, expose it." + (interactive "P") + (when (and org-link-search-failed (eq this-command last-command)) + (goto-char (point-min)) + (message "Link search wrapped back to beginning of buffer")) + (setq org-link-search-failed nil) + (let* ((pos (point)) + (ct (org-context)) + (a (assoc :link ct)) + (srch-fun (if search-backward 're-search-backward 're-search-forward))) + (cond (a (goto-char (nth (if search-backward 1 2) a))) + ((looking-at org-any-link-re) + ;; Don't stay stuck at link without an org-link face + (forward-char (if search-backward -1 1)))) + (if (funcall srch-fun org-any-link-re nil t) + (progn + (goto-char (match-beginning 0)) + (if (outline-invisible-p) (org-show-context))) + (goto-char pos) + (setq org-link-search-failed t) + (message "No further link found")))) + +(defun org-previous-link () + "Move backward to the previous link. +If the link is in hidden text, expose it." + (interactive) + (funcall 'org-next-link t)) + +(defun org-translate-link (s) + "Translate a link string if a translation function has been defined." + (if (and org-link-translation-function + (fboundp org-link-translation-function) + (string-match "\\([a-zA-Z0-9]+\\):\\(.*\\)" s)) + (progn + (setq s (funcall org-link-translation-function + (match-string 1 s) (match-string 2 s))) + (concat (car s) ":" (cdr s))) + s)) + +(defun org-translate-link-from-planner (type path) + "Translate a link from Emacs Planner syntax so that Org can follow it. +This is still an experimental function, your mileage may vary." + (cond + ((member type '("http" "https" "news" "ftp")) + ;; standard Internet links are the same. + nil) + ((and (equal type "irc") (string-match "^//" path)) + ;; Planner has two / at the beginning of an irc link, we have 1. + ;; We should have zero, actually.... + (setq path (substring path 1))) + ((and (equal type "lisp") (string-match "^/" path)) + ;; Planner has a slash, we do not. + (setq type "elisp" path (substring path 1))) + ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path) + ;; A typical message link. Planner has the id after the final slash, + ;; we separate it with a hash mark + (setq path (concat (match-string 1 path) "#" + (org-remove-angle-brackets (match-string 2 path)))))) + (cons type path)) + +(defun org-find-file-at-mouse (ev) + "Open file link or URL at mouse." + (interactive "e") + (mouse-set-point ev) + (org-open-at-point 'in-emacs)) + +(defun org-open-at-mouse (ev) + "Open file link or URL at mouse. +See the docstring of `org-open-file' for details." + (interactive "e") + (mouse-set-point ev) + (if (eq major-mode 'org-agenda-mode) + (org-agenda-copy-local-variable 'org-link-abbrev-alist-local)) + (org-open-at-point)) + +(defvar org-window-config-before-follow-link nil + "The window configuration before following a link. +This is saved in case the need arises to restore it.") + +(defvar org-open-link-marker (make-marker) + "Marker pointing to the location where `org-open-at-point' was called.") + +;;;###autoload +(defun org-open-at-point-global () + "Follow a link like Org-mode does. +This command can be called in any mode to follow a link that has +Org-mode syntax." + (interactive) + (org-run-like-in-org-mode 'org-open-at-point)) + +;;;###autoload +(defun org-open-link-from-string (s &optional arg reference-buffer) + "Open a link in the string S, as if it was in Org-mode." + (interactive "sLink: \nP") + (let ((reference-buffer (or reference-buffer (current-buffer)))) + (with-temp-buffer + (let ((org-inhibit-startup (not reference-buffer))) + (org-mode) + (insert s) + (goto-char (point-min)) + (when reference-buffer + (setq org-link-abbrev-alist-local + (with-current-buffer reference-buffer + org-link-abbrev-alist-local))) + (org-open-at-point arg reference-buffer))))) + +(defvar org-open-at-point-functions nil + "Hook that is run when following a link at point. + +Functions in this hook must return t if they identify and follow +a link at point. If they don't find anything interesting at point, +they must return nil.") + +(defvar org-link-search-inhibit-query nil) ;; dynamically scoped +(defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el +(defun org-open-at-point (&optional arg reference-buffer) + "Open link at or after point. +If there is no link at point, this function will search forward up to +the end of the current line. +Normally, files will be opened by an appropriate application. If the +optional prefix argument ARG is non-nil, Emacs will visit the file. +With a double prefix argument, try to open outside of Emacs, in the +application the system uses for this file type." + (interactive "P") + ;; if in a code block, then open the block's results + (unless (call-interactively #'org-babel-open-src-block-result) + (org-load-modules-maybe) + (move-marker org-open-link-marker (point)) + (setq org-window-config-before-follow-link (current-window-configuration)) + (org-remove-occur-highlights nil nil t) + (cond + ((and (org-at-heading-p) + (not (org-at-timestamp-p t)) + (not (org-in-regexp + (concat org-plain-link-re "\\|" + org-bracket-link-regexp "\\|" + org-angle-link-re "\\|" + "[ \t]:[^ \t\n]+:[ \t]*$"))) + (not (get-text-property (point) 'org-linked-text))) + (or (let* ((lkall (org-offer-links-in-entry (current-buffer) (point) arg)) + (lk0 (car lkall)) + (lk (if (stringp lk0) (list lk0) lk0)) + (lkend (cdr lkall))) + (mapcar (lambda(l) + (search-forward l nil lkend) + (goto-char (match-beginning 0)) + (org-open-at-point)) + lk)) + (progn (require 'org-attach) (org-attach-reveal 'if-exists)))) + ((run-hook-with-args-until-success 'org-open-at-point-functions)) + ((and (org-at-timestamp-p t) + (not (org-in-regexp org-bracket-link-regexp))) + (org-follow-timestamp-link)) + ((and (or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) + (not (org-in-regexp org-any-link-re))) + (org-footnote-action)) + (t + (let (type path link line search (pos (point))) + (catch 'match + (save-excursion + (or (org-in-regexp org-plain-link-re) + (skip-chars-forward "^]\n\r")) + (when (org-in-regexp org-bracket-link-regexp 1) + (setq link (org-extract-attributes + (org-link-unescape (org-match-string-no-properties 1)))) + (while (string-match " *\n *" link) + (setq link (replace-match " " t t link))) + (setq link (org-link-expand-abbrev link)) + (cond + ((or (file-name-absolute-p link) + (string-match "^\\.\\.?/" link)) + (setq type "file" path link)) + ((string-match org-link-re-with-space3 link) + (setq type (match-string 1 link) path (match-string 2 link))) + ((string-match "^help:+\\(.+\\)" link) + (setq type "help" path (match-string 1 link))) + (t (setq type "thisfile" path link))) + (throw 'match t))) + + (when (get-text-property (point) 'org-linked-text) + (setq type "thisfile" + pos (if (get-text-property (1+ (point)) 'org-linked-text) + (1+ (point)) (point)) + path (buffer-substring + (or (previous-single-property-change pos 'org-linked-text) + (point-min)) + (or (next-single-property-change pos 'org-linked-text) + (point-max))) + ;; Ensure we will search for a <<<radio>>> link, not + ;; a simple reference like <<ref>> + path (concat "<" path)) + (throw 'match t)) + + (save-excursion + (when (or (org-in-regexp org-angle-link-re) + (let ((match (org-in-regexp org-plain-link-re))) + ;; Check a plain link is not within a bracket link + (and match + (save-excursion + (save-match-data + (progn + (goto-char (car match)) + (not (org-in-regexp org-bracket-link-regexp))))))) + (let ((line_ending (save-excursion (end-of-line) (point)))) + ;; We are in a line before a plain or bracket link + (or (re-search-forward org-plain-link-re line_ending t) + (re-search-forward org-bracket-link-regexp line_ending t)))) + (setq type (match-string 1) + path (org-link-unescape (match-string 2))) + (throw 'match t))) + (save-excursion + (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$")) + (setq type "tags" + path (match-string 1)) + (while (string-match ":" path) + (setq path (replace-match "+" t t path))) + (throw 'match t))) + (when (org-in-regexp "<\\([^><\n]+\\)>") + (setq type "tree-match" + path (match-string 1)) + (throw 'match t))) + (unless path + (user-error "No link found")) + + ;; switch back to reference buffer + ;; needed when if called in a temporary buffer through + ;; org-open-link-from-string + (with-current-buffer (or reference-buffer (current-buffer)) + + ;; Remove any trailing spaces in path + (if (string-match " +\\'" path) + (setq path (replace-match "" t t path))) + (if (and org-link-translation-function + (fboundp org-link-translation-function)) + ;; Check if we need to translate the link + (let ((tmp (funcall org-link-translation-function type path))) + (setq type (car tmp) path (cdr tmp)))) + + (cond + + ((assoc type org-link-protocols) + (funcall (nth 1 (assoc type org-link-protocols)) path)) + + ((equal type "help") + (let ((f-or-v (intern path))) + (cond ((fboundp f-or-v) + (describe-function f-or-v)) + ((boundp f-or-v) + (describe-variable f-or-v)) + (t (error "Not a known function or variable"))))) + + ((equal type "mailto") + (let ((cmd (car org-link-mailto-program)) + (args (cdr org-link-mailto-program)) args1 + (address path) (subject "") a) + (if (string-match "\\(.*\\)::\\(.*\\)" path) + (setq address (match-string 1 path) + subject (org-link-escape (match-string 2 path)))) + (while args + (cond + ((not (stringp (car args))) (push (pop args) args1)) + (t (setq a (pop args)) + (if (string-match "%a" a) + (setq a (replace-match address t t a))) + (if (string-match "%s" a) + (setq a (replace-match subject t t a))) + (push a args1)))) + (apply cmd (nreverse args1)))) + + ((member type '("http" "https" "ftp" "news")) + (browse-url + (concat type ":" + (if (org-string-match-p + (concat "[[:nonascii:]" + org-link-escape-chars-browser "]") + path) + (org-link-escape path org-link-escape-chars-browser) + path)))) + + ((string= type "doi") + (browse-url + (concat org-doi-server-url + (if (org-string-match-p + (concat "[[:nonascii:]" + org-link-escape-chars-browser "]") + path) + (org-link-escape path org-link-escape-chars-browser) + path)))) + + ((member type '("message")) + (browse-url (concat type ":" path))) + + ((string= type "tags") + (org-tags-view arg path)) + + ((string= type "tree-match") + (org-occur (concat "\\[" (regexp-quote path) "\\]"))) + + ((string= type "file") + (if (string-match "::\\([0-9]+\\)\\'" path) + (setq line (string-to-number (match-string 1 path)) + path (substring path 0 (match-beginning 0))) + (if (string-match "::\\(.+\\)\\'" path) + (setq search (match-string 1 path) + path (substring path 0 (match-beginning 0))))) + (if (string-match "[*?{]" (file-name-nondirectory path)) + (dired path) + (org-open-file path arg line search))) + + ((string= type "shell") + (let ((buf (generate-new-buffer "*Org Shell Output")) + (cmd path)) + (if (or (and (not (string= org-confirm-shell-link-not-regexp "")) + (string-match org-confirm-shell-link-not-regexp cmd)) + (not org-confirm-shell-link-function) + (funcall org-confirm-shell-link-function + (format "Execute \"%s\" in shell? " + (org-add-props cmd nil + 'face 'org-warning)))) + (progn + (message "Executing %s" cmd) + (shell-command cmd buf) + (if (featurep 'midnight) + (setq clean-buffer-list-kill-buffer-names + (cons buf clean-buffer-list-kill-buffer-names)))) + (error "Abort")))) + + ((string= type "elisp") + (let ((cmd path)) + (if (or (and (not (string= org-confirm-elisp-link-not-regexp "")) + (string-match org-confirm-elisp-link-not-regexp cmd)) + (not org-confirm-elisp-link-function) + (funcall org-confirm-elisp-link-function + (format "Execute \"%s\" as elisp? " + (org-add-props cmd nil + 'face 'org-warning)))) + (message "%s => %s" cmd + (if (equal (string-to-char cmd) ?\() + (eval (read cmd)) + (call-interactively (read cmd)))) + (error "Abort")))) + + ((and (string= type "thisfile") + (or (run-hook-with-args-until-success + 'org-open-link-functions path) + (and link + (string-match "^id:" link) + (or (featurep 'org-id) (require 'org-id)) + (progn + (funcall (nth 1 (assoc "id" org-link-protocols)) + (substring path 3)) + t))))) + + ((string= type "thisfile") + (if arg + (switch-to-buffer-other-window + (org-get-buffer-for-internal-link (current-buffer))) + (org-mark-ring-push)) + (let ((cmd `(org-link-search + ,path + ,(cond ((equal arg '(4)) ''occur) + ((equal arg '(16)) ''org-occur)) + ,pos))) + (condition-case nil (let ((org-link-search-inhibit-query t)) + (eval cmd)) + (error (progn (widen) (eval cmd)))))) + + (t (browse-url-at-point))))))) + (move-marker org-open-link-marker nil) + (run-hook-with-args 'org-follow-link-hook))) + +(defsubst org-uniquify (list) + "Non-destructively remove duplicate elements from LIST." + (let ((res (copy-sequence list))) (delete-dups res))) + +(defun org-offer-links-in-entry (buffer marker &optional nth zero) + "Offer links in the current entry and return the selected link. +If there is only one link, return it. +If NTH is an integer, return the NTH link found. +If ZERO is a string, check also this string for a link, and if +there is one, return it." + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char marker) + (let ((re (concat "\\(" org-bracket-link-regexp "\\)\\|" + "\\(" org-angle-link-re "\\)\\|" + "\\(" org-plain-link-re "\\)")) + (cnt ?0) + (in-emacs (if (integerp nth) nil nth)) + have-zero end links link c) + (when (and (stringp zero) (string-match org-bracket-link-regexp zero)) + (push (match-string 0 zero) links) + (setq cnt (1- cnt) have-zero t)) + (save-excursion + (org-back-to-heading t) + (setq end (save-excursion (outline-next-heading) (point))) + (while (re-search-forward re end t) + (push (match-string 0) links)) + (setq links (org-uniquify (reverse links)))) + (cond + ((null links) + (message "No links")) + ((equal (length links) 1) + (setq link (car links))) + ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth))) + (setq link (nth (if have-zero nth (1- nth)) links))) + (t ; we have to select a link + (save-excursion + (save-window-excursion + (delete-other-windows) + (with-output-to-temp-buffer "*Select Link*" + (mapc (lambda (l) + (if (not (string-match org-bracket-link-regexp l)) + (princ (format "[%c] %s\n" (incf cnt) + (org-remove-angle-brackets l))) + (if (match-end 3) + (princ (format "[%c] %s (%s)\n" (incf cnt) + (match-string 3 l) (match-string 1 l))) + (princ (format "[%c] %s\n" (incf cnt) + (match-string 1 l)))))) + links)) + (org-fit-window-to-buffer (get-buffer-window "*Select Link*")) + (message "Select link to open, RET to open all:") + (setq c (read-char-exclusive)) + (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*")))) + (when (equal c ?q) (error "Abort")) + (if (equal c ?\C-m) + (setq link links) + (setq nth (- c ?0)) + (if have-zero (setq nth (1+ nth))) + (unless (and (integerp nth) (>= (length links) nth)) + (user-error "Invalid link selection")) + (setq link (nth (1- nth) links))))) + (cons link end)))))) + +;; Add special file links that specify the way of opening + +(org-add-link-type "file+sys" 'org-open-file-with-system) +(org-add-link-type "file+emacs" 'org-open-file-with-emacs) +(defun org-open-file-with-system (path) + "Open file at PATH using the system way of opening it." + (org-open-file path 'system)) +(defun org-open-file-with-emacs (path) + "Open file at PATH in Emacs." + (org-open-file path 'emacs)) + + +;;; File search + +(defvar org-create-file-search-functions nil + "List of functions to construct the right search string for a file link. +These functions are called in turn with point at the location to +which the link should point. + +A function in the hook should first test if it would like to +handle this file type, for example by checking the `major-mode' +or the file extension. If it decides not to handle this file, it +should just return nil to give other functions a chance. If it +does handle the file, it must return the search string to be used +when following the link. The search string will be part of the +file link, given after a double colon, and `org-open-at-point' +will automatically search for it. If special measures must be +taken to make the search successful, another function should be +added to the companion hook `org-execute-file-search-functions', +which see. + +A function in this hook may also use `setq' to set the variable +`description' to provide a suggestion for the descriptive text to +be used for this link when it gets inserted into an Org-mode +buffer with \\[org-insert-link].") + +(defvar org-execute-file-search-functions nil + "List of functions to execute a file search triggered by a link. + +Functions added to this hook must accept a single argument, the +search string that was part of the file link, the part after the +double colon. The function must first check if it would like to +handle this search, for example by checking the `major-mode' or +the file extension. If it decides not to handle this search, it +should just return nil to give other functions a chance. If it +does handle the search, it must return a non-nil value to keep +other functions from trying. + +Each function can access the current prefix argument through the +variable `current-prefix-arg'. Note that a single prefix is used +to force opening a link in Emacs, so it may be good to only use a +numeric or double prefix to guide the search function. + +In case this is needed, a function in this hook can also restore +the window configuration before `org-open-at-point' was called using: + + (set-window-configuration org-window-config-before-follow-link)") + +(defun org-link-search (s &optional type avoid-pos stealth) + "Search for a link search option. +If S is surrounded by forward slashes, it is interpreted as a +regular expression. In org-mode files, this will create an `org-occur' +sparse tree. In ordinary files, `occur' will be used to list matches. +If the current buffer is in `dired-mode', grep will be used to search +in all files. If AVOID-POS is given, ignore matches near that position. + +When optional argument STEALTH is non-nil, do not modify +visibility around point, thus ignoring +`org-show-hierarchy-above', `org-show-following-heading' and +`org-show-siblings' variables." + (let ((case-fold-search t) + (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " ")) + (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x))) + (append '(("") (" ") ("\t") ("\n")) + org-emphasis-alist) + "\\|") "\\)")) + (pos (point)) + (pre nil) (post nil) + words re0 re1 re2 re3 re4_ re4 re5 re2a re2a_ reall) + (cond + ;; First check if there are any special search functions + ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) + ;; Now try the builtin stuff + ((and (equal (string-to-char s0) ?#) + (> (length s0) 1) + (save-excursion + (goto-char (point-min)) + (and + (re-search-forward + (concat "^[ \t]*:CUSTOM_ID:[ \t]+" + (regexp-quote (substring s0 1)) "[ \t]*$") nil t) + (setq type 'dedicated + pos (match-beginning 0)))) + ;; There is an exact target for this + (goto-char pos) + (org-back-to-heading t))) + ((save-excursion + (goto-char (point-min)) + (and + (re-search-forward + (concat "<<" (regexp-quote s0) ">>") nil t) + (setq type 'dedicated + pos (match-beginning 0)))) + ;; There is an exact target for this + (goto-char pos)) + ((save-excursion + (goto-char (point-min)) + (and + (re-search-forward + (format "^[ \t]*#\\+NAME: %s" (regexp-quote s0)) nil t) + (setq type 'dedicated pos (match-beginning 0)))) + ;; Found an element with a matching #+name affiliated keyword. + (goto-char pos)) + ((and (string-match "^(\\(.*\\))$" s0) + (save-excursion + (goto-char (point-min)) + (and + (re-search-forward + (concat "[^[]" (regexp-quote + (format org-coderef-label-format + (match-string 1 s0)))) + nil t) + (setq type 'dedicated + pos (1+ (match-beginning 0)))))) + ;; There is a coderef target for this + (goto-char pos)) + ((string-match "^/\\(.*\\)/$" s) + ;; A regular expression + (cond + ((derived-mode-p 'org-mode) + (org-occur (match-string 1 s))) + (t (org-do-occur (match-string 1 s))))) + ((and (derived-mode-p 'org-mode) org-link-search-must-match-exact-headline) + (and (equal (string-to-char s) ?*) (setq s (substring s 1))) + (goto-char (point-min)) + (cond + ((let (case-fold-search) + (re-search-forward (format org-complex-heading-regexp-format + (regexp-quote s)) + nil t)) + ;; OK, found a match + (setq type 'dedicated) + (goto-char (match-beginning 0))) + ((and (not org-link-search-inhibit-query) + (eq org-link-search-must-match-exact-headline 'query-to-create) + (y-or-n-p "No match - create this as a new heading? ")) + (goto-char (point-max)) + (or (bolp) (newline)) + (insert "* " s "\n") + (beginning-of-line 0)) + (t + (goto-char pos) + (error "No match")))) + (t + ;; A normal search string + (when (equal (string-to-char s) ?*) + ;; Anchor on headlines, post may include tags. + (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*" + post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@#%:+]:[ \t]*\\)?$") + s (substring s 1))) + (remove-text-properties + 0 (length s) + '(face nil mouse-face nil keymap nil fontified nil) s) + ;; Make a series of regular expressions to find a match + (setq words (org-split-string s "[ \n\r\t]+") + + re0 (concat "\\(<<" (regexp-quote s0) ">>\\)") + re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+") + "\\)" markers) + re2a_ (concat "\\(" (mapconcat 'downcase words + "[ \t\r\n]+") "\\)[ \t\r\n]") + re2a (concat "[ \t\r\n]" re2a_) + re4_ (concat "\\(" (mapconcat 'downcase words + "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") + re4 (concat "[^a-zA-Z_]" re4_) + + re1 (concat pre re2 post) + re3 (concat pre (if pre re4_ re4) post) + re5 (concat pre ".*" re4) + re2 (concat pre re2) + re2a (concat pre (if pre re2a_ re2a)) + re4 (concat pre (if pre re4_ re4)) + reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 + "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" + re5 "\\)")) + (cond + ((eq type 'org-occur) (org-occur reall)) + ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) + (t (goto-char (point-min)) + (setq type 'fuzzy) + (if (or (and (org-search-not-self 1 re0 nil t) + (setq type 'dedicated)) + (org-search-not-self 1 re1 nil t) + (org-search-not-self 1 re2 nil t) + (org-search-not-self 1 re2a nil t) + (org-search-not-self 1 re3 nil t) + (org-search-not-self 1 re4 nil t) + (org-search-not-self 1 re5 nil t)) + (goto-char (match-beginning 1)) + (goto-char pos) + (error "No match")))))) + (and (derived-mode-p 'org-mode) + (not stealth) + (org-show-context 'link-search)) + type)) + +(defun org-search-not-self (group &rest args) + "Execute `re-search-forward', but only accept matches that do not +enclose the position of `org-open-link-marker'." + (let ((m org-open-link-marker)) + (catch 'exit + (while (apply 're-search-forward args) + (unless (get-text-property (match-end group) 'intangible) ; Emacs 21 + (goto-char (match-end group)) + (if (and (or (not (eq (marker-buffer m) (current-buffer))) + (> (match-beginning 0) (marker-position m)) + (< (match-end 0) (marker-position m))) + (save-match-data + (or (not (org-in-regexp + org-bracket-link-analytic-regexp 1)) + (not (match-end 4)) ; no description + (and (<= (match-beginning 4) (point)) + (>= (match-end 4) (point)))))) + (throw 'exit (point)))))))) + +(defun org-get-buffer-for-internal-link (buffer) + "Return a buffer to be used for displaying the link target of internal links." + (cond + ((not org-display-internal-link-with-indirect-buffer) + buffer) + ((string-match "(Clone)$" (buffer-name buffer)) + (message "Buffer is already a clone, not making another one") + ;; we also do not modify visibility in this case + buffer) + (t ; make a new indirect buffer for displaying the link + (let* ((bn (buffer-name buffer)) + (ibn (concat bn "(Clone)")) + (ib (or (get-buffer ibn) (make-indirect-buffer buffer ibn 'clone)))) + (with-current-buffer ib (org-overview)) + ib)))) + +(defun org-do-occur (regexp &optional cleanup) + "Call the Emacs command `occur'. +If CLEANUP is non-nil, remove the printout of the regular expression +in the *Occur* buffer. This is useful if the regex is long and not useful +to read." + (occur regexp) + (when cleanup + (let ((cwin (selected-window)) win beg end) + (when (setq win (get-buffer-window "*Occur*")) + (select-window win)) + (goto-char (point-min)) + (when (re-search-forward "match[a-z]+" nil t) + (setq beg (match-end 0)) + (if (re-search-forward "^[ \t]*[0-9]+" nil t) + (setq end (1- (match-beginning 0))))) + (and beg end (let ((inhibit-read-only t)) (delete-region beg end))) + (goto-char (point-min)) + (select-window cwin)))) + +;;; The mark ring for links jumps + +(defvar org-mark-ring nil + "Mark ring for positions before jumps in Org-mode.") +(defvar org-mark-ring-last-goto nil + "Last position in the mark ring used to go back.") +;; Fill and close the ring +(setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded +(loop for i from 1 to org-mark-ring-length do + (push (make-marker) org-mark-ring)) +(setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring) + org-mark-ring) + +(defun org-mark-ring-push (&optional pos buffer) + "Put the current position or POS into the mark ring and rotate it." + (interactive) + (setq pos (or pos (point))) + (setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring)) + (move-marker (car org-mark-ring) + (or pos (point)) + (or buffer (current-buffer))) + (message "%s" + (substitute-command-keys + "Position saved to mark ring, go back with \\[org-mark-ring-goto]."))) + +(defun org-mark-ring-goto (&optional n) + "Jump to the previous position in the mark ring. +With prefix arg N, jump back that many stored positions. When +called several times in succession, walk through the entire ring. +Org-mode commands jumping to a different position in the current file, +or to another Org-mode file, automatically push the old position +onto the ring." + (interactive "p") + (let (p m) + (if (eq last-command this-command) + (setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring))) + (setq p org-mark-ring)) + (setq org-mark-ring-last-goto p) + (setq m (car p)) + (org-pop-to-buffer-same-window (marker-buffer m)) + (goto-char m) + (if (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) + +(defun org-remove-angle-brackets (s) + (if (equal (substring s 0 1) "<") (setq s (substring s 1))) + (if (equal (substring s -1) ">") (setq s (substring s 0 -1))) + s) +(defun org-add-angle-brackets (s) + (if (equal (substring s 0 1) "<") nil (setq s (concat "<" s))) + (if (equal (substring s -1) ">") nil (setq s (concat s ">"))) + s) +(defun org-remove-double-quotes (s) + (if (equal (substring s 0 1) "\"") (setq s (substring s 1))) + (if (equal (substring s -1) "\"") (setq s (substring s 0 -1))) + s) + +;;; Following specific links + +(defun org-follow-timestamp-link () + "Open an agenda view for the time-stamp date/range at point." + (cond + ((org-at-date-range-p t) + (let ((org-agenda-start-on-weekday) + (t1 (match-string 1)) + (t2 (match-string 2)) tt1 tt2) + (setq tt1 (time-to-days (org-time-string-to-time t1)) + tt2 (time-to-days (org-time-string-to-time t2))) + (let ((org-agenda-buffer-tmp-name + (format "*Org Agenda(a:%s)" + (concat (substring t1 0 10) "--" (substring t2 0 10))))) + (org-agenda-list nil tt1 (1+ (- tt2 tt1)))))) + ((org-at-timestamp-p t) + (let ((org-agenda-buffer-tmp-name + (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10)))) + (org-agenda-list nil (time-to-days (org-time-string-to-time + (substring (match-string 1) 0 10))) + 1))) + (t (error "This should not happen")))) + + +;;; Following file links +(declare-function mailcap-parse-mailcaps "mailcap" (&optional path force)) +(declare-function mailcap-extension-to-mime "mailcap" (extn)) +(declare-function mailcap-mime-info + "mailcap" (string &optional request no-decode)) +(defvar org-wait nil) +(defun org-open-file (path &optional in-emacs line search) + "Open the file at PATH. +First, this expands any special file name abbreviations. Then the +configuration variable `org-file-apps' is checked if it contains an +entry for this file type, and if yes, the corresponding command is launched. + +If no application is found, Emacs simply visits the file. + +With optional prefix argument IN-EMACS, Emacs will visit the file. +With a double \\[universal-argument] \\[universal-argument] \ +prefix arg, Org tries to avoid opening in Emacs +and to use an external application to visit the file. + +Optional LINE specifies a line to go to, optional SEARCH a string +to search for. If LINE or SEARCH is given, the file will be +opened in Emacs, unless an entry from org-file-apps that makes +use of groups in a regexp matches. + +If you want to change the way frames are used when following a +link, please customize `org-link-frame-setup'. + +If the file does not exist, an error is thrown." + (let* ((file (if (equal path "") + buffer-file-name + (substitute-in-file-name (expand-file-name path)))) + (file-apps (append org-file-apps (org-default-apps))) + (apps (org-remove-if + 'org-file-apps-entry-match-against-dlink-p file-apps)) + (apps-dlink (org-remove-if-not + 'org-file-apps-entry-match-against-dlink-p file-apps)) + (remp (and (assq 'remote apps) (org-file-remote-p file))) + (dirp (if remp nil (file-directory-p file))) + (file (if (and dirp org-open-directory-means-index-dot-org) + (concat (file-name-as-directory file) "index.org") + file)) + (a-m-a-p (assq 'auto-mode apps)) + (dfile (downcase file)) + ;; reconstruct the original file: link from the PATH, LINE and SEARCH args + (link (cond ((and (eq line nil) + (eq search nil)) + file) + (line + (concat file "::" (number-to-string line))) + (search + (concat file "::" search)))) + (dlink (downcase link)) + (old-buffer (current-buffer)) + (old-pos (point)) + (old-mode major-mode) + ext cmd link-match-data) + (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile) + (setq ext (match-string 1 dfile)) + (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile) + (setq ext (match-string 1 dfile)))) + (cond + ((member in-emacs '((16) system)) + (setq cmd (cdr (assoc 'system apps)))) + (in-emacs (setq cmd 'emacs)) + (t + (setq cmd (or (and remp (cdr (assoc 'remote apps))) + (and dirp (cdr (assoc 'directory apps))) + ; first, try matching against apps-dlink + ; if we get a match here, store the match data for later + (let ((match (assoc-default dlink apps-dlink + 'string-match))) + (if match + (progn (setq link-match-data (match-data)) + match) + (progn (setq in-emacs (or in-emacs line search)) + nil))) ; if we have no match in apps-dlink, + ; always open the file in emacs if line or search + ; is given (for backwards compatibility) + (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p) + 'string-match) + (cdr (assoc ext apps)) + (cdr (assoc t apps)))))) + (when (eq cmd 'system) + (setq cmd (cdr (assoc 'system apps)))) + (when (eq cmd 'default) + (setq cmd (cdr (assoc t apps)))) + (when (eq cmd 'mailcap) + (require 'mailcap) + (mailcap-parse-mailcaps) + (let* ((mime-type (mailcap-extension-to-mime (or ext ""))) + (command (mailcap-mime-info mime-type))) + (if (stringp command) + (setq cmd command) + (setq cmd 'emacs)))) + (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files + (not (file-exists-p file)) + (not org-open-non-existing-files)) + (user-error "No such file: %s" file)) + (cond + ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) + ;; Remove quotes around the file name - we'll use shell-quote-argument. + (while (string-match "['\"]%s['\"]" cmd) + (setq cmd (replace-match "%s" t t cmd))) + (while (string-match "%s" cmd) + (setq cmd (replace-match + (save-match-data + (shell-quote-argument + (convert-standard-filename file))) + t t cmd))) + + ;; Replace "%1", "%2" etc. in command with group matches from regex + (save-match-data + (let ((match-index 1) + (number-of-groups (- (/ (length link-match-data) 2) 1))) + (set-match-data link-match-data) + (while (<= match-index number-of-groups) + (let ((regex (concat "%" (number-to-string match-index))) + (replace-with (match-string match-index dlink))) + (while (string-match regex cmd) + (setq cmd (replace-match replace-with t t cmd)))) + (setq match-index (+ match-index 1))))) + + (save-window-excursion + (message "Running %s...done" cmd) + (start-process-shell-command cmd nil cmd) + (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)))) + ((or (stringp cmd) + (eq cmd 'emacs)) + (funcall (cdr (assq 'file org-link-frame-setup)) file) + (widen) + (if line (org-goto-line line) + (if search (org-link-search search)))) + ((consp cmd) + (let ((file (convert-standard-filename file))) + (save-match-data + (set-match-data link-match-data) + (eval cmd)))) + (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) + (and (derived-mode-p 'org-mode) (eq old-mode 'org-mode) + (or (not (equal old-buffer (current-buffer))) + (not (equal old-pos (point)))) + (org-mark-ring-push old-pos old-buffer)))) + +(defun org-file-apps-entry-match-against-dlink-p (entry) + "This function returns non-nil if `entry' uses a regular +expression which should be matched against the whole link by +org-open-file. + +It assumes that is the case when the entry uses a regular +expression which has at least one grouping construct and the +action is either a lisp form or a command string containing +'%1', i.e. using at least one subexpression match as a +parameter." + (let ((selector (car entry)) + (action (cdr entry))) + (if (stringp selector) + (and (> (regexp-opt-depth selector) 0) + (or (and (stringp action) + (string-match "%[0-9]" action)) + (consp action))) + nil))) + +(defun org-default-apps () + "Return the default applications for this operating system." + (cond + ((eq system-type 'darwin) + org-file-apps-defaults-macosx) + ((eq system-type 'windows-nt) + org-file-apps-defaults-windowsnt) + (t org-file-apps-defaults-gnu))) + +(defun org-apps-regexp-alist (list &optional add-auto-mode) + "Convert extensions to regular expressions in the cars of LIST. +Also, weed out any non-string entries, because the return value is used +only for regexp matching. +When ADD-AUTO-MODE is set, make all matches in `auto-mode-alist' +point to the symbol `emacs', indicating that the file should +be opened in Emacs." + (append + (delq nil + (mapcar (lambda (x) + (if (not (stringp (car x))) + nil + (if (string-match "\\W" (car x)) + x + (cons (concat "\\." (car x) "\\'") (cdr x))))) + list)) + (if add-auto-mode + (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist)))) + +(defvar ange-ftp-name-format) ; to silence the XEmacs compiler. +(defun org-file-remote-p (file) + "Test whether FILE specifies a location on a remote system. +Return non-nil if the location is indeed remote. + +For example, the filename \"/user@host:/foo\" specifies a location +on the system \"/user@host:\"." + (cond ((fboundp 'file-remote-p) + (file-remote-p file)) + ((fboundp 'tramp-handle-file-remote-p) + (tramp-handle-file-remote-p file)) + ((and (boundp 'ange-ftp-name-format) + (string-match (car ange-ftp-name-format) file)) + t))) + + +;;;; Refiling + +(defun org-get-org-file () + "Read a filename, with default directory `org-directory'." + (let ((default (or org-default-notes-file remember-data-file))) + (read-file-name (format "File name [%s]: " default) + (file-name-as-directory org-directory) + default))) + +(defun org-notes-order-reversed-p () + "Check if the current file should receive notes in reversed order." + (cond + ((not org-reverse-note-order) nil) + ((eq t org-reverse-note-order) t) + ((not (listp org-reverse-note-order)) nil) + (t (catch 'exit + (let ((all org-reverse-note-order) + entry) + (while (setq entry (pop all)) + (if (string-match (car entry) buffer-file-name) + (throw 'exit (cdr entry)))) + nil))))) + +(defvar org-refile-target-table nil + "The list of refile targets, created by `org-refile'.") + +(defvar org-agenda-new-buffers nil + "Buffers created to visit agenda files.") + +(defvar org-refile-cache nil + "Cache for refile targets.") + +(defvar org-refile-markers nil + "All the markers used for caching refile locations.") + +(defun org-refile-marker (pos) + "Get a new refile marker, but only if caching is in use." + (if (not org-refile-use-cache) + pos + (let ((m (make-marker))) + (move-marker m pos) + (push m org-refile-markers) + m))) + +(defun org-refile-cache-clear () + "Clear the refile cache and disable all the markers." + (mapc (lambda (m) (move-marker m nil)) org-refile-markers) + (setq org-refile-markers nil) + (setq org-refile-cache nil) + (message "Refile cache has been cleared")) + +(defun org-refile-cache-check-set (set) + "Check if all the markers in the cache still have live buffers." + (let (marker) + (catch 'exit + (while (and set (setq marker (nth 3 (pop set)))) + ;; If `org-refile-use-outline-path' is 'file, marker may be nil + (when (and marker (null (marker-buffer marker))) + (message "Please regenerate the refile cache with `C-0 C-c C-w'") + (sit-for 3) + (throw 'exit nil))) + t))) + +(defun org-refile-cache-put (set &rest identifiers) + "Push the refile targets SET into the cache, under IDENTIFIERS." + (let* ((key (sha1 (prin1-to-string identifiers))) + (entry (assoc key org-refile-cache))) + (if entry + (setcdr entry set) + (push (cons key set) org-refile-cache)))) + +(defun org-refile-cache-get (&rest identifiers) + "Retrieve the cached value for refile targets given by IDENTIFIERS." + (cond + ((not org-refile-cache) nil) + ((not org-refile-use-cache) (org-refile-cache-clear) nil) + (t + (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers)) + org-refile-cache)))) + (and set (org-refile-cache-check-set set) set))))) + +(defun org-refile-get-targets (&optional default-buffer excluded-entries) + "Produce a table with refile targets." + (let ((case-fold-search nil) + ;; otherwise org confuses "TODO" as a kw and "Todo" as a word + (entries (or org-refile-targets '((nil . (:level . 1))))) + targets tgs txt re files f desc descre fast-path-p level pos0) + (message "Getting targets...") + (with-current-buffer (or default-buffer (current-buffer)) + (while (setq entry (pop entries)) + (setq files (car entry) desc (cdr entry)) + (setq fast-path-p nil) + (cond + ((null files) (setq files (list (current-buffer)))) + ((eq files 'org-agenda-files) + (setq files (org-agenda-files 'unrestricted))) + ((and (symbolp files) (fboundp files)) + (setq files (funcall files))) + ((and (symbolp files) (boundp files)) + (setq files (symbol-value files)))) + (if (stringp files) (setq files (list files))) + (cond + ((eq (car desc) :tag) + (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":"))) + ((eq (car desc) :todo) + (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]"))) + ((eq (car desc) :regexp) + (setq descre (cdr desc))) + ((eq (car desc) :level) + (setq descre (concat "^\\*\\{" (number-to-string + (if org-odd-levels-only + (1- (* 2 (cdr desc))) + (cdr desc))) + "\\}[ \t]"))) + ((eq (car desc) :maxlevel) + (setq fast-path-p t) + (setq descre (concat "^\\*\\{1," (number-to-string + (if org-odd-levels-only + (1- (* 2 (cdr desc))) + (cdr desc))) + "\\}[ \t]"))) + (t (error "Bad refiling target description %s" desc))) + (while (setq f (pop files)) + (with-current-buffer + (if (bufferp f) f (org-get-agenda-file-buffer f)) + (or + (setq tgs (org-refile-cache-get (buffer-file-name) descre)) + (progn + (if (bufferp f) (setq f (buffer-file-name + (buffer-base-buffer f)))) + (setq f (and f (expand-file-name f))) + (if (eq org-refile-use-outline-path 'file) + (push (list (file-name-nondirectory f) f nil nil) tgs)) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward descre nil t) + (goto-char (setq pos0 (point-at-bol))) + (catch 'next + (when org-refile-target-verify-function + (save-match-data + (or (funcall org-refile-target-verify-function) + (throw 'next t)))) + (when (and (looking-at org-complex-heading-regexp) + (not (member (match-string 4) excluded-entries)) + (match-string 4)) + (setq level (org-reduced-level + (- (match-end 1) (match-beginning 1))) + txt (org-link-display-format (match-string 4)) + txt (replace-regexp-in-string "\\( *\[[0-9]+/?[0-9]*%?\]\\)+$" "" txt) + re (format org-complex-heading-regexp-format + (regexp-quote (match-string 4)))) + (when org-refile-use-outline-path + (setq txt (mapconcat + 'org-protect-slash + (append + (if (eq org-refile-use-outline-path + 'file) + (list (file-name-nondirectory + (buffer-file-name + (buffer-base-buffer)))) + (if (eq org-refile-use-outline-path + 'full-file-path) + (list (buffer-file-name + (buffer-base-buffer))))) + (org-get-outline-path fast-path-p + level txt) + (list txt)) + "/"))) + (push (list txt f re (org-refile-marker (point))) + tgs))) + (when (= (point) pos0) + ;; verification function has not moved point + (goto-char (point-at-eol)))))))) + (when org-refile-use-cache + (org-refile-cache-put tgs (buffer-file-name) descre)) + (setq targets (append tgs targets)))))) + (message "Getting targets...done") + (nreverse targets))) + +(defun org-protect-slash (s) + (while (string-match "/" s) + (setq s (replace-match "\\" t t s))) + s) + +(defvar org-olpa (make-vector 20 nil)) + +(defun org-get-outline-path (&optional fastp level heading) + "Return the outline path to the current entry, as a list. + +The parameters FASTP, LEVEL, and HEADING are for use by a scanner +routine which makes outline path derivations for an entire file, +avoiding backtracing. Refile target collection makes use of that." + (if fastp + (progn + (if (> level 19) + (error "Outline path failure, more than 19 levels")) + (loop for i from level upto 19 do + (aset org-olpa i nil)) + (prog1 + (delq nil (append org-olpa nil)) + (aset org-olpa level heading))) + (let (rtn case-fold-search) + (save-excursion + (save-restriction + (widen) + (while (org-up-heading-safe) + (when (looking-at org-complex-heading-regexp) + (push (org-trim + (replace-regexp-in-string + ;; Remove statistical/checkboxes cookies + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + (org-match-string-no-properties 4))) + rtn))) + rtn))))) + +(defun org-format-outline-path (path &optional width prefix separator) + "Format the outline path PATH for display. +WIDTH is the maximum number of characters that is available. +PREFIX is a prefix to be included in the returned string, +such as the file name. +SEPARATOR is inserted between the different parts of the path, +the default is \"/\"." + (setq width (or width 79)) + (if prefix (setq width (- width (length prefix)))) + (if (not path) + (or prefix "") + (let* ((nsteps (length path)) + (total-width (+ nsteps (apply '+ (mapcar 'length path)))) + (maxwidth (if (<= total-width width) + 10000 ;; everything fits + ;; we need to shorten the level headings + (/ (- width nsteps) nsteps))) + (org-odd-levels-only nil) + (n 0) + (total (1+ (length prefix)))) + (setq maxwidth (max maxwidth 10)) + (concat prefix + (if prefix (or separator "/")) + (mapconcat + (lambda (h) + (setq n (1+ n)) + (if (and (= n nsteps) (< maxwidth 10000)) + (setq maxwidth (- total-width total))) + (if (< (length h) maxwidth) + (progn (setq total (+ total (length h) 1)) h) + (setq h (substring h 0 (- maxwidth 2)) + total (+ total maxwidth 1)) + (if (string-match "[ \t]+\\'" h) + (setq h (substring h 0 (match-beginning 0)))) + (setq h (concat h ".."))) + (org-add-props h nil 'face + (nth (% (1- n) org-n-level-faces) + org-level-faces)) + h) + path (or separator "/")))))) + +(defun org-display-outline-path (&optional file current separator just-return-string) + "Display the current outline path in the echo area. + +If FILE is non-nil, prepend the output with the file name. +If CURRENT is non-nil, append the current heading to the output. +SEPARATOR is passed through to `org-format-outline-path'. It separates +the different parts of the path and defaults to \"/\". +If JUST-RETURN-STRING is non-nil, return a string, don't display a message." + (interactive "P") + (let* (case-fold-search + (bfn (buffer-file-name (buffer-base-buffer))) + (path (and (derived-mode-p 'org-mode) (org-get-outline-path))) + res) + (if current (setq path (append path + (save-excursion + (org-back-to-heading t) + (if (looking-at org-complex-heading-regexp) + (list (match-string 4))))))) + (setq res + (org-format-outline-path + path + (1- (frame-width)) + (and file bfn (concat (file-name-nondirectory bfn) separator)) + separator)) + (if just-return-string + (org-no-properties res) + (org-unlogged-message "%s" res)))) + +(defvar org-refile-history nil + "History for refiling operations.") + +(defvar org-after-refile-insert-hook nil + "Hook run after `org-refile' has inserted its stuff at the new location. +Note that this is still *before* the stuff will be removed from +the *old* location.") + +(defvar org-capture-last-stored-marker) +(defvar org-refile-keep nil + "Non-nil means `org-refile' will copy instead of refile.") + +(defun org-copy () + "Like `org-refile', but copy." + (interactive) + (let ((org-refile-keep t)) + (funcall 'org-refile nil nil nil "Copy"))) + +(defun org-refile (&optional goto default-buffer rfloc msg) + "Move the entry or entries at point to another heading. +The list of target headings is compiled using the information in +`org-refile-targets', which see. + +At the target location, the entry is filed as a subitem of the target +heading. Depending on `org-reverse-note-order', the new subitem will +either be the first or the last subitem. + +If there is an active region, all entries in that region will be moved. +However, the region must fulfill the requirement that the first heading +is the first one sets the top-level of the moved text - at most siblings +below it are allowed. + +With prefix arg GOTO, the command will only visit the target location +and not actually move anything. + +With a double prefix arg \\[universal-argument] \\[universal-argument], \ +go to the location where the last refiling operation has put the subtree. + +With a numeric prefix argument of `2', refile to the running clock. + +With a numeric prefix argument of `3', emulate `org-refile-keep' +being set to `t' and copy to the target location, don't move it. +Beware that keeping refiled entries may result in duplicated ID +properties. + +RFLOC can be a refile location obtained in a different way. + +MSG is a string to replace \"Refile\" in the default prompt with +another verb. E.g. `org-copy' sets this parameter to \"Copy\". + +See also `org-refile-use-outline-path' and `org-completion-use-ido'. + +If you are using target caching (see `org-refile-use-cache'), +you have to clear the target cache in order to find new targets. +This can be done with a 0 prefix (`C-0 C-c C-w') or a triple +prefix argument (`C-u C-u C-u C-c C-w')." + + (interactive "P") + (if (member goto '(0 (64))) + (org-refile-cache-clear) + (let* ((actionmsg (cond (msg msg) + ((equal goto 3) "Refile (and keep)") + (t "Refile"))) + (cbuf (current-buffer)) + (regionp (org-region-active-p)) + (region-start (and regionp (region-beginning))) + (region-end (and regionp (region-end))) + (filename (buffer-file-name (buffer-base-buffer cbuf))) + (org-refile-keep (if (equal goto 3) t org-refile-keep)) + pos it nbuf file re level reversed) + (setq last-command nil) + (when regionp + (goto-char region-start) + (or (bolp) (goto-char (point-at-bol))) + (setq region-start (point)) + (unless (or (org-kill-is-subtree-p + (buffer-substring region-start region-end)) + (prog1 org-refile-active-region-within-subtree + (let ((s (point-at-eol))) + (org-toggle-heading) + (setq region-end (+ (- (point-at-eol) s) region-end))))) + (user-error "The region is not a (sequence of) subtree(s)"))) + (if (equal goto '(16)) + (org-refile-goto-last-stored) + (when (or + (and (equal goto 2) + org-clock-hd-marker (marker-buffer org-clock-hd-marker) + (prog1 + (setq it (list (or org-clock-heading "running clock") + (buffer-file-name + (marker-buffer org-clock-hd-marker)) + "" + (marker-position org-clock-hd-marker))) + (setq goto nil))) + (setq it (or rfloc + (let (heading-text) + (save-excursion + (unless (and goto (listp goto)) + (org-back-to-heading t) + (setq heading-text + (nth 4 (org-heading-components)))) + + (org-refile-get-location + (cond ((and goto (listp goto)) "Goto") + (regionp (concat actionmsg " region to")) + (t (concat actionmsg " subtree \"" + heading-text "\" to"))) + default-buffer + (and (not (equal '(4) goto)) + org-refile-allow-creating-parent-nodes) + goto)))))) + (setq file (nth 1 it) + re (nth 2 it) + pos (nth 3 it)) + (if (and (not goto) + pos + (equal (buffer-file-name) file) + (if regionp + (and (>= pos region-start) + (<= pos region-end)) + (and (>= pos (point)) + (< pos (save-excursion + (org-end-of-subtree t t)))))) + (error "Cannot refile to position inside the tree or region")) + + (setq nbuf (or (find-buffer-visiting file) + (find-file-noselect file))) + (if (and goto (not (equal goto 3))) + (progn + (org-pop-to-buffer-same-window nbuf) + (goto-char pos) + (org-show-context 'org-goto)) + (if regionp + (progn + (org-kill-new (buffer-substring region-start region-end)) + (org-save-markers-in-region region-start region-end)) + (org-copy-subtree 1 nil t)) + (with-current-buffer (setq nbuf (or (find-buffer-visiting file) + (find-file-noselect file))) + (setq reversed (org-notes-order-reversed-p)) + (save-excursion + (save-restriction + (widen) + (if pos + (progn + (goto-char pos) + (looking-at org-outline-regexp) + (setq level (org-get-valid-level (funcall outline-level) 1)) + (goto-char + (if reversed + (or (outline-next-heading) (point-max)) + (or (save-excursion (org-get-next-sibling)) + (org-end-of-subtree t t) + (point-max))))) + (setq level 1) + (if (not reversed) + (goto-char (point-max)) + (goto-char (point-min)) + (or (outline-next-heading) (goto-char (point-max))))) + (if (not (bolp)) (newline)) + (org-paste-subtree level) + (when org-log-refile + (org-add-log-setup 'refile nil nil 'findpos org-log-refile) + (unless (eq org-log-refile 'note) + (save-excursion (org-add-log-note)))) + (and org-auto-align-tags + (let ((org-loop-over-headlines-in-active-region nil)) + (org-set-tags nil t))) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-refile))) + (when bookmark-name + (with-demoted-errors + (bookmark-set bookmark-name)))) + ;; If we are refiling for capture, make sure that the + ;; last-capture pointers point here + (when (org-bound-and-true-p org-refile-for-capture) + (let ((bookmark-name (plist-get org-bookmark-names-plist + :last-capture-marker))) + (when bookmark-name + (with-demoted-errors + (bookmark-set bookmark-name)))) + (move-marker org-capture-last-stored-marker (point))) + (if (fboundp 'deactivate-mark) (deactivate-mark)) + (run-hooks 'org-after-refile-insert-hook)))) + (unless org-refile-keep + (if regionp + (delete-region (point) (+ (point) (- region-end region-start))) + (delete-region + (and (org-back-to-heading t) (point)) + (min (1+ (buffer-size)) (org-end-of-subtree t t) (point))))) + (when (featurep 'org-inlinetask) + (org-inlinetask-remove-END-maybe)) + (setq org-markers-to-move nil) + (message (concat actionmsg " to \"%s\" in file %s: done") (car it) file))))))) + +(defun org-refile-goto-last-stored () + "Go to the location where the last refile was stored." + (interactive) + (bookmark-jump "org-refile-last-stored") + (message "This is the location of the last refile")) + +(defun org-refile--get-location (refloc tbl) + "When user refile to REFLOC, find the associated target in TBL. +Also check `org-refile-target-table'." + (car (delq + nil + (mapcar + (lambda (r) (or (assoc r tbl) + (assoc r org-refile-target-table))) + (list (replace-regexp-in-string "/$" "" refloc) + (replace-regexp-in-string "\\([^/]\\)$" "\\1/" refloc)))))) + +(defun org-refile-get-location (&optional prompt default-buffer new-nodes + no-exclude) + "Prompt the user for a refile location, using PROMPT. +PROMPT should not be suffixed with a colon and a space, because +this function appends the default value from +`org-refile-history' automatically, if that is not empty. +When NO-EXCLUDE is set, do not exclude headlines in the current subtree, +this is used for the GOTO interface." + (let ((org-refile-targets org-refile-targets) + (org-refile-use-outline-path org-refile-use-outline-path) + excluded-entries) + (when (and (derived-mode-p 'org-mode) + (not org-refile-use-cache) + (not no-exclude)) + (org-map-tree + (lambda() + (setq excluded-entries + (append excluded-entries (list (org-get-heading t t))))))) + (setq org-refile-target-table + (org-refile-get-targets default-buffer excluded-entries))) + (unless org-refile-target-table + (user-error "No refile targets")) + (let* ((cbuf (current-buffer)) + (partial-completion-mode nil) + (cfn (buffer-file-name (buffer-base-buffer cbuf))) + (cfunc (if (and org-refile-use-outline-path + org-outline-path-complete-in-steps) + 'org-olpath-completing-read + 'org-icompleting-read)) + (extra (if org-refile-use-outline-path "/" "")) + (cbnex (concat (buffer-name) extra)) + (filename (and cfn (expand-file-name cfn))) + (tbl (mapcar + (lambda (x) + (if (and (not (member org-refile-use-outline-path + '(file full-file-path))) + (not (equal filename (nth 1 x)))) + (cons (concat (car x) extra " (" + (file-name-nondirectory (nth 1 x)) ")") + (cdr x)) + (cons (concat (car x) extra) (cdr x)))) + org-refile-target-table)) + (completion-ignore-case t) + cdef + (prompt (concat prompt + (or (and (car org-refile-history) + (concat " (default " (car org-refile-history) ")")) + (and (assoc cbnex tbl) (setq cdef cbnex) + (concat " (default " cbnex ")"))) ": ")) + pa answ parent-target child parent old-hist) + (setq old-hist org-refile-history) + (setq answ (funcall cfunc prompt tbl nil (not new-nodes) + nil 'org-refile-history (or cdef (car org-refile-history)))) + (if (setq pa (org-refile--get-location answ tbl)) + (progn + (org-refile-check-position pa) + (when (or (not org-refile-history) + (not (eq old-hist org-refile-history)) + (not (equal (car pa) (car org-refile-history)))) + (setq org-refile-history + (cons (car pa) (if (assoc (car org-refile-history) tbl) + org-refile-history + (cdr org-refile-history)))) + (if (equal (car org-refile-history) (nth 1 org-refile-history)) + (pop org-refile-history))) + pa) + (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ) + (progn + (setq parent (match-string 1 answ) + child (match-string 2 answ)) + (setq parent-target (org-refile--get-location parent tbl)) + (when (and parent-target + (or (eq new-nodes t) + (and (eq new-nodes 'confirm) + (y-or-n-p (format "Create new node \"%s\"? " + child))))) + (org-refile-new-child parent-target child))) + (user-error "Invalid target location"))))) + +(declare-function org-string-nw-p "org-macs" (s)) +(defun org-refile-check-position (refile-pointer) + "Check if the refile pointer matches the headline to which it points." + (let* ((file (nth 1 refile-pointer)) + (re (nth 2 refile-pointer)) + (pos (nth 3 refile-pointer)) + buffer) + (if (and (not (markerp pos)) (not file)) + (user-error "Please save the buffer to a file before refiling") + (when (org-string-nw-p re) + (setq buffer (if (markerp pos) + (marker-buffer pos) + (or (find-buffer-visiting file) + (find-file-noselect file)))) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (goto-char pos) + (beginning-of-line 1) + (unless (org-looking-at-p re) + (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))) + +(defun org-refile-new-child (parent-target child) + "Use refile target PARENT-TARGET to add new CHILD below it." + (unless parent-target + (error "Cannot find parent for new node")) + (let ((file (nth 1 parent-target)) + (pos (nth 3 parent-target)) + level) + (with-current-buffer (or (find-buffer-visiting file) + (find-file-noselect file)) + (save-excursion + (save-restriction + (widen) + (if pos + (goto-char pos) + (goto-char (point-max)) + (if (not (bolp)) (newline))) + (when (looking-at org-outline-regexp) + (setq level (funcall outline-level)) + (org-end-of-subtree t t)) + (org-back-over-empty-lines) + (insert "\n" (make-string + (if pos (org-get-valid-level level 1) 1) ?*) + " " child "\n") + (beginning-of-line 0) + (list (concat (car parent-target) "/" child) file "" (point))))))) + +(defun org-olpath-completing-read (prompt collection &rest args) + "Read an outline path like a file name." + (let ((thetable collection) + (org-completion-use-ido nil) ; does not work with ido. + (org-completion-use-iswitchb nil)) ; or iswitchb + (apply + 'org-icompleting-read prompt + (lambda (string predicate &optional flag) + (let (rtn r f (l (length string))) + (cond + ((eq flag nil) + ;; try completion + (try-completion string thetable)) + ((eq flag t) + ;; all-completions + (setq rtn (all-completions string thetable predicate)) + (mapcar + (lambda (x) + (setq r (substring x l)) + (if (string-match " ([^)]*)$" x) + (setq f (match-string 0 x)) + (setq f "")) + (if (string-match "/" r) + (concat string (substring r 0 (match-end 0)) f) + x)) + rtn)) + ((eq flag 'lambda) + ;; exact match? + (assoc string thetable))))) + args))) + +;;;; Dynamic blocks + +(defun org-find-dblock (name) + "Find the first dynamic block with name NAME in the buffer. +If not found, stay at current position and return nil." + (let ((case-fold-search t) pos) + (save-excursion + (goto-char (point-min)) + (setq pos (and (re-search-forward + (concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t) + (match-beginning 0)))) + (if pos (goto-char pos)) + pos)) + +(defconst org-dblock-start-re + "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" + "Matches the start line of a dynamic block, with parameters.") + +(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)" + "Matches the end of a dynamic block.") + +(defun org-create-dblock (plist) + "Create a dynamic block section, with parameters taken from PLIST. +PLIST must contain a :name entry which is used as name of the block." + (when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol))) + (end-of-line 1) + (newline)) + (let ((col (current-column)) + (name (plist-get plist :name))) + (insert "#+BEGIN: " name) + (while plist + (if (eq (car plist) :name) + (setq plist (cddr plist)) + (insert " " (prin1-to-string (pop plist))))) + (insert "\n\n" (make-string col ?\ ) "#+END:\n") + (beginning-of-line -2))) + +(defun org-prepare-dblock () + "Prepare dynamic block for refresh. +This empties the block, puts the cursor at the insert position and returns +the property list including an extra property :name with the block name." + (unless (looking-at org-dblock-start-re) + (user-error "Not at a dynamic block")) + (let* ((begdel (1+ (match-end 0))) + (name (org-no-properties (match-string 1))) + (params (append (list :name name) + (read (concat "(" (match-string 3) ")"))))) + (save-excursion + (beginning-of-line 1) + (skip-chars-forward " \t") + (setq params (plist-put params :indentation-column (current-column)))) + (unless (re-search-forward org-dblock-end-re nil t) + (error "Dynamic block not terminated")) + (setq params + (append params + (list :content (buffer-substring + begdel (match-beginning 0))))) + (delete-region begdel (match-beginning 0)) + (goto-char begdel) + (open-line 1) + params)) + +(defun org-map-dblocks (&optional command) + "Apply COMMAND to all dynamic blocks in the current buffer. +If COMMAND is not given, use `org-update-dblock'." + (let ((cmd (or command 'org-update-dblock))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward org-dblock-start-re nil t) + (goto-char (match-beginning 0)) + (save-excursion + (condition-case nil + (funcall cmd) + (error (message "Error during update of dynamic block")))) + (unless (re-search-forward org-dblock-end-re nil t) + (error "Dynamic block not terminated")))))) + +(defun org-dblock-update (&optional arg) + "User command for updating dynamic blocks. +Update the dynamic block at point. With prefix ARG, update all dynamic +blocks in the buffer." + (interactive "P") + (if arg + (org-update-all-dblocks) + (or (looking-at org-dblock-start-re) + (org-beginning-of-dblock)) + (org-update-dblock))) + +(defun org-update-dblock () + "Update the dynamic block at point. +This means to empty the block, parse for parameters and then call +the correct writing function." + (interactive) + (save-excursion + (let* ((win (selected-window)) + (pos (point)) + (line (org-current-line)) + (params (org-prepare-dblock)) + (name (plist-get params :name)) + (indent (plist-get params :indentation-column)) + (cmd (intern (concat "org-dblock-write:" name)))) + (message "Updating dynamic block `%s' at line %d..." name line) + (funcall cmd params) + (message "Updating dynamic block `%s' at line %d...done" name line) + (goto-char pos) + (when (and indent (> indent 0)) + (setq indent (make-string indent ?\ )) + (save-excursion + (select-window win) + (org-beginning-of-dblock) + (forward-line 1) + (while (not (looking-at org-dblock-end-re)) + (insert indent) + (beginning-of-line 2)) + (when (looking-at org-dblock-end-re) + (and (looking-at "[ \t]+") + (replace-match "")) + (insert indent))))))) + +(defun org-beginning-of-dblock () + "Find the beginning of the dynamic block at point. +Error if there is no such block at point." + (let ((pos (point)) + beg) + (end-of-line 1) + (if (and (re-search-backward org-dblock-start-re nil t) + (setq beg (match-beginning 0)) + (re-search-forward org-dblock-end-re nil t) + (> (match-end 0) pos)) + (goto-char beg) + (goto-char pos) + (error "Not in a dynamic block")))) + +(defun org-update-all-dblocks () + "Update all dynamic blocks in the buffer. +This function can be used in a hook." + (interactive) + (when (derived-mode-p 'org-mode) + (org-map-dblocks 'org-update-dblock))) + + +;;;; Completion + +(declare-function org-export-backend-name "org-export" (cl-x)) +(declare-function org-export-backend-options "org-export" (cl-x)) +(defun org-get-export-keywords () + "Return a list of all currently understood export keywords. +Export keywords include options, block names, attributes and +keywords relative to each registered export back-end." + (let (keywords) + (dolist (backend + (org-bound-and-true-p org-export--registered-backends) + (delq nil keywords)) + ;; Back-end name (for keywords, like #+LATEX:) + (push (upcase (symbol-name (org-export-backend-name backend))) keywords) + (dolist (option-entry (org-export-backend-options backend)) + ;; Back-end options. + (push (nth 1 option-entry) keywords))))) + +(defconst org-options-keywords + '("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:" + "DESCRIPTION:" "DRAWERS:" "EMAIL:" "EXCLUDE_TAGS:" "FILETAGS:" "INCLUDE:" + "INDEX:" "KEYWORDS:" "LANGUAGE:" "MACRO:" "OPTIONS:" "PROPERTY:" + "PRIORITIES:" "SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:" + "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:")) + +(defcustom org-structure-template-alist + '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC" "<src lang=\"?\">\n\n</src>") + ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE" "<example>\n?\n</example>") + ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE" "<quote>\n?\n</quote>") + ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE" "<verse>\n?\n</verse>") + ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM" "<verbatim>\n?\n</verbatim>") + ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER" "<center>\n?\n</center>") + ("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX" + "<literal style=\"latex\">\n?\n</literal>") + ("L" "#+LaTeX: " "<literal style=\"latex\">?</literal>") + ("h" "#+BEGIN_HTML\n?\n#+END_HTML" + "<literal style=\"html\">\n?\n</literal>") + ("H" "#+HTML: " "<literal style=\"html\">?</literal>") + ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII" "") + ("A" "#+ASCII: " "") + ("i" "#+INDEX: ?" "#+INDEX: ?") + ("I" "#+INCLUDE: %file ?" + "<include file=%file markup=\"?\">")) + "Structure completion elements. +This is a list of abbreviation keys and values. The value gets inserted +if you type `<' followed by the key and then press the completion key, +usually `M-TAB'. %file will be replaced by a file name after prompting +for the file using completion. The cursor will be placed at the position +of the `?` in the template. +There are two templates for each key, the first uses the original Org syntax, +the second uses Emacs Muse-like syntax tags. These Muse-like tags become +the default when the /org-mtags.el/ module has been loaded. See also the +variable `org-mtags-prefer-muse-templates'." + :group 'org-completion + :type '(repeat + (list + (string :tag "Key") + (string :tag "Template") + (string :tag "Muse Template")))) + +(defun org-try-structure-completion () + "Try to complete a structure template before point. +This looks for strings like \"<e\" on an otherwise empty line and +expands them." + (let ((l (buffer-substring (point-at-bol) (point))) + a) + (when (and (looking-at "[ \t]*$") + (string-match "^[ \t]*<\\([a-zA-Z]+\\)$" l) + (setq a (assoc (match-string 1 l) org-structure-template-alist))) + (org-complete-expand-structure-template (+ -1 (point-at-bol) + (match-beginning 1)) a) + t))) + +(defun org-complete-expand-structure-template (start cell) + "Expand a structure template." + (let* ((musep (org-bound-and-true-p org-mtags-prefer-muse-templates)) + (rpl (nth (if musep 2 1) cell)) + (ind "")) + (delete-region start (point)) + (when (string-match "\\`#\\+" rpl) + (cond + ((bolp)) + ((not (string-match "\\S-" (buffer-substring (point-at-bol) (point)))) + (setq ind (buffer-substring (point-at-bol) (point)))) + (t (newline)))) + (setq start (point)) + (if (string-match "%file" rpl) + (setq rpl (replace-match + (concat + "\"" + (save-match-data + (abbreviate-file-name (read-file-name "Include file: "))) + "\"") + t t rpl))) + (setq rpl (mapconcat 'identity (split-string rpl "\n") + (concat "\n" ind))) + (insert rpl) + (if (re-search-backward "\\?" start t) (delete-char 1)))) + +;;;; TODO, DEADLINE, Comments + +(defun org-toggle-comment () + "Change the COMMENT state of an entry." + (interactive) + (save-excursion + (org-back-to-heading) + (let (case-fold-search) + (cond + ((looking-at (format org-heading-keyword-regexp-format + org-comment-string)) + (goto-char (match-end 1)) + (looking-at (concat " +" org-comment-string)) + (replace-match "" t t) + (when (eolp) (insert " "))) + ((looking-at org-outline-regexp) + (goto-char (match-end 0)) + (insert org-comment-string " ")))))) + +(defvar org-last-todo-state-is-todo nil + "This is non-nil when the last TODO state change led to a TODO state. +If the last change removed the TODO tag or switched to DONE, then +this is nil.") + +(defvar org-setting-tags nil) ; dynamically skipped + +(defvar org-todo-setup-filter-hook nil + "Hook for functions that pre-filter todo specs. +Each function takes a todo spec and returns either nil or the spec +transformed into canonical form." ) + +(defvar org-todo-get-default-hook nil + "Hook for functions that get a default item for todo. +Each function takes arguments (NEW-MARK OLD-MARK) and returns either +nil or a string to be used for the todo mark." ) + +(defvar org-agenda-headline-snapshot-before-repeat) + +(defun org-current-effective-time () + "Return current time adjusted for `org-extend-today-until' variable." + (let* ((ct (org-current-time)) + (dct (decode-time ct)) + (ct1 + (cond + (org-use-last-clock-out-time-as-effective-time + (or (org-clock-get-last-clock-out-time) ct)) + ((and org-use-effective-time (< (nth 2 dct) org-extend-today-until)) + (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))) + (t ct)))) + ct1)) + +(defun org-todo-yesterday (&optional arg) + "Like `org-todo' but the time of change will be 23:59 of yesterday." + (interactive "P") + (if (eq major-mode 'org-agenda-mode) + (apply 'org-agenda-todo-yesterday arg) + (let* ((hour (third (decode-time + (org-current-time)))) + (org-extend-today-until (1+ hour))) + (org-todo arg)))) + +(defvar org-block-entry-blocking "" + "First entry preventing the TODO state change.") + +(defun org-todo (&optional arg) + "Change the TODO state of an item. +The state of an item is given by a keyword at the start of the heading, +like + *** TODO Write paper + *** DONE Call mom + +The different keywords are specified in the variable `org-todo-keywords'. +By default the available states are \"TODO\" and \"DONE\". +So for this example: when the item starts with TODO, it is changed to DONE. +When it starts with DONE, the DONE is removed. And when neither TODO nor +DONE are present, add TODO at the beginning of the heading. + +With \\[universal-argument] prefix arg, use completion to determine the new \ +state. +With numeric prefix arg, switch to that state. +With a double \\[universal-argument] prefix, switch to the next set of TODO \ +keywords (nextset). +With a triple \\[universal-argument] prefix, circumvent any state blocking. +With a numeric prefix arg of 0, inhibit note taking for the change. + +For calling through lisp, arg is also interpreted in the following way: +'none -> empty state +\"\"(empty string) -> switch to empty state +'done -> switch to DONE +'nextset -> switch to the next set of keywords +'previousset -> switch to the previous set of keywords +\"WAITING\" -> switch to the specified keyword, but only if it + really is a member of `org-todo-keywords'." + (interactive "P") + (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) + (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level 'region)) + org-loop-over-headlines-in-active-region) + (org-map-entries + `(org-todo ,arg) + org-loop-over-headlines-in-active-region + cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + (if (equal arg '(16)) (setq arg 'nextset)) + (let ((org-blocker-hook org-blocker-hook) + commentp + case-fold-search) + (when (equal arg '(64)) + (setq arg nil org-blocker-hook nil)) + (when (and org-blocker-hook + (or org-inhibit-blocking + (org-entry-get nil "NOBLOCKING"))) + (setq org-blocker-hook nil)) + (save-excursion + (catch 'exit + (org-back-to-heading t) + (when (looking-at (concat "^\\*+ " org-comment-string)) + (org-toggle-comment) + (setq commentp t)) + (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0)))) + (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)")) + (looking-at "\\(?: *\\|[ \t]*$\\)")) + (let* ((match-data (match-data)) + (startpos (point-at-bol)) + (logging (save-match-data (org-entry-get nil "LOGGING" t t))) + (org-log-done org-log-done) + (org-log-repeat org-log-repeat) + (org-todo-log-states org-todo-log-states) + (org-inhibit-logging + (if (equal arg 0) + (progn (setq arg nil) 'note) org-inhibit-logging)) + (this (match-string 1)) + (hl-pos (match-beginning 0)) + (head (org-get-todo-sequence-head this)) + (ass (assoc head org-todo-kwd-alist)) + (interpret (nth 1 ass)) + (done-word (nth 3 ass)) + (final-done-word (nth 4 ass)) + (org-last-state (or this "")) + (completion-ignore-case t) + (member (member this org-todo-keywords-1)) + (tail (cdr member)) + (org-state (cond + ((and org-todo-key-trigger + (or (and (equal arg '(4)) + (eq org-use-fast-todo-selection 'prefix)) + (and (not arg) org-use-fast-todo-selection + (not (eq org-use-fast-todo-selection + 'prefix))))) + ;; Use fast selection + (org-fast-todo-selection)) + ((and (equal arg '(4)) + (or (not org-use-fast-todo-selection) + (not org-todo-key-trigger))) + ;; Read a state with completion + (org-icompleting-read + "State: " (mapcar 'list org-todo-keywords-1) + nil t)) + ((eq arg 'right) + (if this + (if tail (car tail) nil) + (car org-todo-keywords-1))) + ((eq arg 'left) + (if (equal member org-todo-keywords-1) + nil + (if this + (nth (- (length org-todo-keywords-1) + (length tail) 2) + org-todo-keywords-1) + (org-last org-todo-keywords-1)))) + ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) + (setq arg nil))) ; hack to fall back to cycling + (arg + ;; user or caller requests a specific state + (cond + ((equal arg "") nil) + ((eq arg 'none) nil) + ((eq arg 'done) (or done-word (car org-done-keywords))) + ((eq arg 'nextset) + (or (car (cdr (member head org-todo-heads))) + (car org-todo-heads))) + ((eq arg 'previousset) + (let ((org-todo-heads (reverse org-todo-heads))) + (or (car (cdr (member head org-todo-heads))) + (car org-todo-heads)))) + ((car (member arg org-todo-keywords-1))) + ((stringp arg) + (user-error "State `%s' not valid in this file" arg)) + ((nth (1- (prefix-numeric-value arg)) + org-todo-keywords-1)))) + ((null member) (or head (car org-todo-keywords-1))) + ((equal this final-done-word) nil) ;; -> make empty + ((null tail) nil) ;; -> first entry + ((memq interpret '(type priority)) + (if (eq this-command last-command) + (car tail) + (if (> (length tail) 0) + (or done-word (car org-done-keywords)) + nil))) + (t + (car tail)))) + (org-state (or + (run-hook-with-args-until-success + 'org-todo-get-default-hook org-state org-last-state) + org-state)) + (next (if org-state (concat " " org-state " ") " ")) + (change-plist (list :type 'todo-state-change :from this :to org-state + :position startpos)) + dolog now-done-p) + (when org-blocker-hook + (setq org-last-todo-state-is-todo + (not (member this org-done-keywords))) + (unless (save-excursion + (save-match-data + (org-with-wide-buffer + (run-hook-with-args-until-failure + 'org-blocker-hook change-plist)))) + (if (org-called-interactively-p 'interactive) + (user-error "TODO state change from %s to %s blocked (by \"%s\")" + this org-state org-block-entry-blocking) + ;; fail silently + (message "TODO state change from %s to %s blocked (by \"%s\")" + this org-state org-block-entry-blocking) + (throw 'exit nil)))) + (store-match-data match-data) + (replace-match next t t) + (unless (pos-visible-in-window-p hl-pos) + (message "TODO state changed to %s" (org-trim next))) + (unless head + (setq head (org-get-todo-sequence-head org-state) + ass (assoc head org-todo-kwd-alist) + interpret (nth 1 ass) + done-word (nth 3 ass) + final-done-word (nth 4 ass))) + (when (memq arg '(nextset previousset)) + (message "Keyword-Set %d/%d: %s" + (- (length org-todo-sets) -1 + (length (memq (assoc org-state org-todo-sets) org-todo-sets))) + (length org-todo-sets) + (mapconcat 'identity (assoc org-state org-todo-sets) " "))) + (setq org-last-todo-state-is-todo + (not (member org-state org-done-keywords))) + (setq now-done-p (and (member org-state org-done-keywords) + (not (member this org-done-keywords)))) + (and logging (org-local-logging logging)) + (when (and (or org-todo-log-states org-log-done) + (not (eq org-inhibit-logging t)) + (not (memq arg '(nextset previousset)))) + ;; we need to look at recording a time and note + (setq dolog (or (nth 1 (assoc org-state org-todo-log-states)) + (nth 2 (assoc this org-todo-log-states)))) + (if (and (eq dolog 'note) (eq org-inhibit-logging 'note)) + (setq dolog 'time)) + (when (or (and (not org-state) (not org-closed-keep-when-no-todo)) + (and org-state + (member org-state org-not-done-keywords) + (not (member this org-not-done-keywords)))) + ;; This is now a todo state and was not one before + ;; If there was a CLOSED time stamp, get rid of it. + (org-add-planning-info nil nil 'closed)) + (when (and now-done-p org-log-done) + ;; It is now done, and it was not done before + (org-add-planning-info 'closed (org-current-effective-time)) + (if (and (not dolog) (eq 'note org-log-done)) + (org-add-log-setup 'done org-state this 'findpos 'note))) + (when (and org-state dolog) + ;; This is a non-nil state, and we need to log it + (org-add-log-setup 'state org-state this 'findpos dolog))) + ;; Fixup tag positioning + (org-todo-trigger-tag-changes org-state) + (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t)) + (when org-provide-todo-statistics + (org-update-parent-todo-statistics)) + (run-hooks 'org-after-todo-state-change-hook) + (if (and arg (not (member org-state org-done-keywords))) + (setq head (org-get-todo-sequence-head org-state))) + (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head) + ;; Do we need to trigger a repeat? + (when now-done-p + (when (boundp 'org-agenda-headline-snapshot-before-repeat) + ;; This is for the agenda, take a snapshot of the headline. + (save-match-data + (setq org-agenda-headline-snapshot-before-repeat + (org-get-heading)))) + (org-auto-repeat-maybe org-state)) + ;; Fixup cursor location if close to the keyword + (if (and (outline-on-heading-p) + (not (bolp)) + (save-excursion (beginning-of-line 1) + (looking-at org-todo-line-regexp)) + (< (point) (+ 2 (or (match-end 2) (match-end 1))))) + (progn + (goto-char (or (match-end 2) (match-end 1))) + (and (looking-at " ") (just-one-space)))) + (when org-trigger-hook + (save-excursion + (run-hook-with-args 'org-trigger-hook change-plist))) + (when commentp (org-toggle-comment)))))))) + +(defun org-block-todo-from-children-or-siblings-or-parent (change-plist) + "Block turning an entry into a TODO, using the hierarchy. +This checks whether the current task should be blocked from state +changes. Such blocking occurs when: + + 1. The task has children which are not all in a completed state. + + 2. A task has a parent with the property :ORDERED:, and there + are siblings prior to the current task with incomplete + status. + + 3. The parent of the task is blocked because it has siblings that should + be done first, or is child of a block grandparent TODO entry." + + (if (not org-enforce-todo-dependencies) + t ; if locally turned off don't block + (catch 'dont-block + ;; If this is not a todo state change, or if this entry is already DONE, + ;; do not block + (when (or (not (eq (plist-get change-plist :type) 'todo-state-change)) + (member (plist-get change-plist :from) + (cons 'done org-done-keywords)) + (member (plist-get change-plist :to) + (cons 'todo org-not-done-keywords)) + (not (plist-get change-plist :to))) + (throw 'dont-block t)) + ;; If this task has children, and any are undone, it's blocked + (save-excursion + (org-back-to-heading t) + (let ((this-level (funcall outline-level))) + (outline-next-heading) + (let ((child-level (funcall outline-level))) + (while (and (not (eobp)) + (> child-level this-level)) + ;; this todo has children, check whether they are all + ;; completed + (if (and (not (org-entry-is-done-p)) + (org-entry-is-todo-p)) + (progn (setq org-block-entry-blocking (org-get-heading)) + (throw 'dont-block nil))) + (outline-next-heading) + (setq child-level (funcall outline-level)))))) + ;; Otherwise, if the task's parent has the :ORDERED: property, and + ;; any previous siblings are undone, it's blocked + (save-excursion + (org-back-to-heading t) + (let* ((pos (point)) + (parent-pos (and (org-up-heading-safe) (point)))) + (if (not parent-pos) (throw 'dont-block t)) ; no parent + (when (and (org-not-nil (org-entry-get (point) "ORDERED")) + (forward-line 1) + (re-search-forward org-not-done-heading-regexp pos t)) + (setq org-block-entry-blocking (match-string 0)) + (throw 'dont-block nil)) ; block, there is an older sibling not done. + ;; Search further up the hierarchy, to see if an ancestor is blocked + (while t + (goto-char parent-pos) + (if (not (looking-at org-not-done-heading-regexp)) + (throw 'dont-block t)) ; do not block, parent is not a TODO + (setq pos (point)) + (setq parent-pos (and (org-up-heading-safe) (point))) + (if (not parent-pos) (throw 'dont-block t)) ; no parent + (when (and (org-not-nil (org-entry-get (point) "ORDERED")) + (forward-line 1) + (re-search-forward org-not-done-heading-regexp pos t) + (setq org-block-entry-blocking (org-get-heading))) + (throw 'dont-block nil)))))))) ; block, older sibling not done. + +(defcustom org-track-ordered-property-with-tag nil + "Should the ORDERED property also be shown as a tag? +The ORDERED property decides if an entry should require subtasks to be +completed in sequence. Since a property is not very visible, setting +this option means that toggling the ORDERED property with the command +`org-toggle-ordered-property' will also toggle a tag ORDERED. That tag is +not relevant for the behavior, but it makes things more visible. + +Note that toggling the tag with tags commands will not change the property +and therefore not influence behavior! + +This can be t, meaning the tag ORDERED should be used, It can also be a +string to select a different tag for this task." + :group 'org-todo + :type '(choice + (const :tag "No tracking" nil) + (const :tag "Track with ORDERED tag" t) + (string :tag "Use other tag"))) + +(defun org-toggle-ordered-property () + "Toggle the ORDERED property of the current entry. +For better visibility, you can track the value of this property with a tag. +See variable `org-track-ordered-property-with-tag'." + (interactive) + (let* ((t1 org-track-ordered-property-with-tag) + (tag (and t1 (if (stringp t1) t1 "ORDERED")))) + (save-excursion + (org-back-to-heading) + (if (org-entry-get nil "ORDERED") + (progn + (org-delete-property "ORDERED" "PROPERTIES") + (and tag (org-toggle-tag tag 'off)) + (message "Subtasks can be completed in arbitrary order")) + (org-entry-put nil "ORDERED" "t") + (and tag (org-toggle-tag tag 'on)) + (message "Subtasks must be completed in sequence"))))) + +(defvar org-blocked-by-checkboxes) ; dynamically scoped +(defun org-block-todo-from-checkboxes (change-plist) + "Block turning an entry into a TODO, using checkboxes. +This checks whether the current task should be blocked from state +changes because there are unchecked boxes in this entry." + (if (not org-enforce-todo-checkbox-dependencies) + t ; if locally turned off don't block + (catch 'dont-block + ;; If this is not a todo state change, or if this entry is already DONE, + ;; do not block + (when (or (not (eq (plist-get change-plist :type) 'todo-state-change)) + (member (plist-get change-plist :from) + (cons 'done org-done-keywords)) + (member (plist-get change-plist :to) + (cons 'todo org-not-done-keywords)) + (not (plist-get change-plist :to))) + (throw 'dont-block t)) + ;; If this task has checkboxes that are not checked, it's blocked + (save-excursion + (org-back-to-heading t) + (let ((beg (point)) end) + (outline-next-heading) + (setq end (point)) + (goto-char beg) + (if (org-list-search-forward + (concat (org-item-beginning-re) + "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" + "\\[[- ]\\]") + end t) + (progn + (if (boundp 'org-blocked-by-checkboxes) + (setq org-blocked-by-checkboxes t)) + (throw 'dont-block nil))))) + t))) ; do not block + +(defun org-entry-blocked-p () + "Is the current entry blocked?" + (org-with-silent-modifications + (if (org-entry-get nil "NOBLOCKING") + nil ;; Never block this entry + (not (run-hook-with-args-until-failure + 'org-blocker-hook + (list :type 'todo-state-change + :position (point) + :from 'todo + :to 'done)))))) + +(defun org-update-statistics-cookies (all) + "Update the statistics cookie, either from TODO or from checkboxes. +This should be called with the cursor in a line with a statistics cookie." + (interactive "P") + (if all + (progn + (org-update-checkbox-count 'all) + (org-map-entries 'org-update-parent-todo-statistics)) + (if (not (org-at-heading-p)) + (org-update-checkbox-count) + (let ((pos (point-marker)) + end l1 l2) + (ignore-errors (org-back-to-heading t)) + (if (not (org-at-heading-p)) + (org-update-checkbox-count) + (setq l1 (org-outline-level)) + (setq end (save-excursion + (outline-next-heading) + (if (org-at-heading-p) (setq l2 (org-outline-level))) + (point))) + (if (and (save-excursion + (re-search-forward + "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) \\[[- X]\\]" end t)) + (not (save-excursion (re-search-forward + ":COOKIE_DATA:.*\\<todo\\>" end t)))) + (org-update-checkbox-count) + (if (and l2 (> l2 l1)) + (progn + (goto-char end) + (org-update-parent-todo-statistics)) + (goto-char pos) + (beginning-of-line 1) + (while (re-search-forward + "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)" + (point-at-eol) t) + (replace-match (if (match-end 2) "[100%]" "[0/0]") t t))))) + (goto-char pos) + (move-marker pos nil))))) + +(defvar org-entry-property-inherited-from) ;; defined below +(defun org-update-parent-todo-statistics () + "Update any statistics cookie in the parent of the current headline. +When `org-hierarchical-todo-statistics' is nil, statistics will cover +the entire subtree and this will travel up the hierarchy and update +statistics everywhere." + (let* ((prop (save-excursion (org-up-heading-safe) + (org-entry-get nil "COOKIE_DATA" 'inherit))) + (recursive (or (not org-hierarchical-todo-statistics) + (and prop (string-match "\\<recursive\\>" prop)))) + (lim (or (and prop (marker-position org-entry-property-inherited-from)) + 0)) + (first t) + (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") + level ltoggle l1 new ndel + (cnt-all 0) (cnt-done 0) is-percent kwd + checkbox-beg ov ovs ove cookie-present) + (catch 'exit + (save-excursion + (beginning-of-line 1) + (setq ltoggle (funcall outline-level)) + ;; Three situations are to consider: + + ;; 1. if `org-hierarchical-todo-statistics' is nil, repeat up + ;; to the top-level ancestor on the headline; + + ;; 2. If parent has "recursive" property, repeat up to the + ;; headline setting that property, taking inheritance into + ;; account; + + ;; 3. Else, move up to direct parent and proceed only once. + (while (and (setq level (org-up-heading-safe)) + (or recursive first) + (>= (point) lim)) + (setq first nil cookie-present nil) + (unless (and level + (not (string-match + "\\<checkbox\\>" + (downcase (or (org-entry-get nil "COOKIE_DATA") + ""))))) + (throw 'exit nil)) + (while (re-search-forward box-re (point-at-eol) t) + (setq cnt-all 0 cnt-done 0 cookie-present t) + (setq is-percent (match-end 2) checkbox-beg (match-beginning 0)) + (save-match-data + (unless (outline-next-heading) (throw 'exit nil)) + (while (and (looking-at org-complex-heading-regexp) + (> (setq l1 (length (match-string 1))) level)) + (setq kwd (and (or recursive (= l1 ltoggle)) + (match-string 2))) + (if (or (eq org-provide-todo-statistics 'all-headlines) + (and (listp org-provide-todo-statistics) + (or (member kwd org-provide-todo-statistics) + (member kwd org-done-keywords)))) + (setq cnt-all (1+ cnt-all)) + (if (eq org-provide-todo-statistics t) + (and kwd (setq cnt-all (1+ cnt-all))))) + (and (member kwd org-done-keywords) + (setq cnt-done (1+ cnt-done))) + (outline-next-heading))) + (setq new + (if is-percent + (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all))) + (format "[%d/%d]" cnt-done cnt-all)) + ndel (- (match-end 0) checkbox-beg)) + ;; handle overlays when updating cookie from column view + (when (setq ov (car (overlays-at checkbox-beg))) + (setq ovs (overlay-start ov) ove (overlay-end ov)) + (delete-overlay ov)) + (goto-char checkbox-beg) + (insert new) + (delete-region (point) (+ (point) ndel)) + (when org-auto-align-tags (org-fix-tags-on-the-fly)) + (when ov (move-overlay ov ovs ove))) + (when cookie-present + (run-hook-with-args 'org-after-todo-statistics-hook + cnt-done (- cnt-all cnt-done)))))) + (run-hooks 'org-todo-statistics-hook))) + +(defvar org-after-todo-statistics-hook nil + "Hook that is called after a TODO statistics cookie has been updated. +Each function is called with two arguments: the number of not-done entries +and the number of done entries. + +For example, the following function, when added to this hook, will switch +an entry to DONE when all children are done, and back to TODO when new +entries are set to a TODO status. Note that this hook is only called +when there is a statistics cookie in the headline! + + (defun org-summary-todo (n-done n-not-done) + \"Switch entry to DONE when all subentries are done, to TODO otherwise.\" + (let (org-log-done org-log-states) ; turn off logging + (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\")))) +") + +(defvar org-todo-statistics-hook nil + "Hook that is run whenever Org thinks TODO statistics should be updated. +This hook runs even if there is no statistics cookie present, in which case +`org-after-todo-statistics-hook' would not run.") + +(defun org-todo-trigger-tag-changes (state) + "Apply the changes defined in `org-todo-state-tags-triggers'." + (let ((l org-todo-state-tags-triggers) + changes) + (when (or (not state) (equal state "")) + (setq changes (append changes (cdr (assoc "" l))))) + (when (and (stringp state) (> (length state) 0)) + (setq changes (append changes (cdr (assoc state l))))) + (when (member state org-not-done-keywords) + (setq changes (append changes (cdr (assoc 'todo l))))) + (when (member state org-done-keywords) + (setq changes (append changes (cdr (assoc 'done l))))) + (dolist (c changes) + (org-toggle-tag (car c) (if (cdr c) 'on 'off))))) + +(defun org-local-logging (value) + "Get logging settings from a property VALUE." + (let* (words w a) + ;; directly set the variables, they are already local. + (setq org-log-done nil + org-log-repeat nil + org-todo-log-states nil) + (setq words (org-split-string value)) + (while (setq w (pop words)) + (cond + ((setq a (assoc w org-startup-options)) + (and (member (nth 1 a) '(org-log-done org-log-repeat)) + (set (nth 1 a) (nth 2 a)))) + ((setq a (org-extract-log-state-settings w)) + (and (member (car a) org-todo-keywords-1) + (push a org-todo-log-states))))))) + +(defun org-get-todo-sequence-head (kwd) + "Return the head of the TODO sequence to which KWD belongs. +If KWD is not set, check if there is a text property remembering the +right sequence." + (let (p) + (cond + ((not kwd) + (or (get-text-property (point-at-bol) 'org-todo-head) + (progn + (setq p (next-single-property-change (point-at-bol) 'org-todo-head + nil (point-at-eol))) + (get-text-property p 'org-todo-head)))) + ((not (member kwd org-todo-keywords-1)) + (car org-todo-keywords-1)) + (t (nth 2 (assoc kwd org-todo-kwd-alist)))))) + +(defun org-fast-todo-selection () + "Fast TODO keyword selection with single keys. +Returns the new TODO keyword, or nil if no state change should occur." + (let* ((fulltable org-todo-key-alist) + (done-keywords org-done-keywords) ;; needed for the faces. + (maxlen (apply 'max (mapcar + (lambda (x) + (if (stringp (car x)) (string-width (car x)) 0)) + fulltable))) + (expert nil) + (fwidth (+ maxlen 3 1 3)) + (ncol (/ (- (window-width) 4) fwidth)) + tg cnt e c tbl + groups ingroup) + (save-excursion + (save-window-excursion + (if expert + (set-buffer (get-buffer-create " *Org todo*")) + (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*"))) + (erase-buffer) + (org-set-local 'org-done-keywords done-keywords) + (setq tbl fulltable 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")) + ((equal e '(:newline)) + (when (not (= cnt 0)) + (setq cnt 0) + (insert "\n") + (setq e (car tbl)) + (while (equal (car tbl) '(:newline)) + (insert "\n") + (setq tbl (cdr tbl))))) + (t + (setq tg (car e) c (cdr e)) + (if ingroup (push tg (car groups))) + (setq tg (org-add-props tg nil 'face + (org-get-todo-face tg))) + (if (and (= cnt 0) (not ingroup)) (insert " ")) + (insert "[" c "] " tg (make-string + (- fwidth 4 (length tg)) ?\ )) + (when (= (setq cnt (1+ cnt)) ncol) + (insert "\n") + (if ingroup (insert " ")) + (setq cnt 0))))) + (insert "\n") + (goto-char (point-min)) + (if (not expert) (org-fit-window-to-buffer)) + (message "[a-z..]:Set [SPC]:clear") + (setq c (let ((inhibit-quit t)) (read-char-exclusive))) + (cond + ((or (= c ?\C-g) + (and (= c ?q) (not (rassoc c fulltable)))) + (setq quit-flag t)) + ((= c ?\ ) nil) + ((setq e (rassoc c fulltable) tg (car e)) + tg) + (t (setq quit-flag t))))))) + +(defun org-entry-is-todo-p () + (member (org-get-todo-state) org-not-done-keywords)) + +(defun org-entry-is-done-p () + (member (org-get-todo-state) org-done-keywords)) + +(defun org-get-todo-state () + "Return the TODO keyword of the current subtree." + (save-excursion + (org-back-to-heading t) + (and (looking-at org-todo-line-regexp) + (match-end 2) + (match-string 2)))) + +(defun org-at-date-range-p (&optional inactive-ok) + "Is the cursor inside a date range?" + (interactive) + (save-excursion + (catch 'exit + (let ((pos (point))) + (skip-chars-backward "^[<\r\n") + (skip-chars-backward "<[") + (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp)) + (>= (match-end 0) pos) + (throw 'exit t)) + (skip-chars-backward "^<[\r\n") + (skip-chars-backward "<[") + (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp)) + (>= (match-end 0) pos) + (throw 'exit t))) + nil))) + +(defun org-get-repeat (&optional tagline) + "Check if there is a deadline/schedule with repeater in this entry." + (save-match-data + (save-excursion + (org-back-to-heading t) + (and (re-search-forward (if tagline + (concat tagline "\\s-*" org-repeat-re) + org-repeat-re) + (org-entry-end-position) t) + (match-string-no-properties 1))))) + +(defvar org-last-changed-timestamp) +(defvar org-last-inserted-timestamp) +(defvar org-log-post-message) +(defvar org-log-note-purpose) +(defvar org-log-note-how) +(defvar org-log-note-extra) +(defun org-auto-repeat-maybe (done-word) + "Check if the current headline contains a repeated deadline/schedule. +If yes, set TODO state back to what it was and change the base date +of repeating deadline/scheduled time stamps to new date. +This function is run automatically after each state change to a DONE state." + ;; last-state is dynamically scoped into this function + (let* ((repeat (org-get-repeat)) + (aa (assoc org-last-state org-todo-kwd-alist)) + (interpret (nth 1 aa)) + (head (nth 2 aa)) + (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year))) + (msg "Entry repeats: ") + (org-log-done nil) + (org-todo-log-states nil) + re type n what ts time to-state) + (when repeat + (if (eq org-log-repeat t) (setq org-log-repeat 'state)) + (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE") + org-todo-repeat-to-state)) + (unless (and to-state (member to-state org-todo-keywords-1)) + (setq to-state (if (eq interpret 'type) org-last-state head))) + (org-todo to-state) + (when (or org-log-repeat (org-entry-get nil "CLOCK")) + (org-entry-put nil "LAST_REPEAT" (format-time-string + (org-time-stamp-format t t)))) + (when org-log-repeat + (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) + (memq 'org-add-log-note post-command-hook)) + ;; OK, we are already setup for some record + (if (eq org-log-repeat 'note) + ;; make sure we take a note, not only a time stamp + (setq org-log-note-how 'note)) + ;; Set up for taking a record + (org-add-log-setup 'state (or done-word (car org-done-keywords)) + org-last-state + 'findpos org-log-repeat))) + (org-back-to-heading t) + (org-add-planning-info nil nil 'closed) + (setq re (concat "\\(" org-scheduled-time-regexp "\\)\\|\\(" + org-deadline-time-regexp "\\)\\|\\(" + org-ts-regexp "\\)")) + (while (re-search-forward + re (save-excursion (outline-next-heading) (point)) t) + (setq type (if (match-end 1) org-scheduled-string + (if (match-end 3) org-deadline-string "Plain:")) + ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0)))) + (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts) + (setq n (string-to-number (match-string 2 ts)) + what (match-string 3 ts)) + (if (equal what "w") (setq n (* n 7) what "d")) + (if (and (equal what "h") (not (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))) + (user-error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n)) + ;; Preparation, see if we need to modify the start date for the change + (when (match-end 1) + (setq time (save-match-data (org-time-string-to-time ts))) + (cond + ((equal (match-string 1 ts) ".") + ;; Shift starting date to today + (org-timestamp-change + (- (org-today) (time-to-days time)) + 'day)) + ((equal (match-string 1 ts) "+") + (let ((nshiftmax 10) (nshift 0)) + (while (or (= nshift 0) + (<= (time-to-days time) + (time-to-days (current-time)))) + (when (= (incf nshift) nshiftmax) + (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift)) + (error "Abort"))) + (org-timestamp-change n (cdr (assoc what whata))) + (org-at-timestamp-p t) + (setq ts (match-string 1)) + (setq time (save-match-data (org-time-string-to-time ts))))) + (org-timestamp-change (- n) (cdr (assoc what whata))) + ;; rematch, so that we have everything in place for the real shift + (org-at-timestamp-p t) + (setq ts (match-string 1)) + (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)))) + (save-excursion (org-timestamp-change n (cdr (assoc what whata)) nil t)) + (setq msg (concat msg type " " org-last-changed-timestamp " ")))) + (setq org-log-post-message msg) + (message "%s" msg)))) + +(defun org-show-todo-tree (arg) + "Make a compact tree which shows all headlines marked with TODO. +The tree will show the lines where the regexp matches, and all higher +headlines above the match. +With a \\[universal-argument] prefix, prompt for a regexp to match. +With a numeric prefix N, construct a sparse tree for the Nth element +of `org-todo-keywords-1'." + (interactive "P") + (let ((case-fold-search nil) + (kwd-re + (cond ((null arg) org-not-done-regexp) + ((equal arg '(4)) + (let ((kwd (org-icompleting-read "Keyword (or KWD1|KWD2|...): " + (mapcar 'list org-todo-keywords-1)))) + (concat "\\(" + (mapconcat 'identity (org-split-string kwd "|") "\\|") + "\\)\\>"))) + ((<= (prefix-numeric-value arg) (length org-todo-keywords-1)) + (regexp-quote (nth (1- (prefix-numeric-value arg)) + org-todo-keywords-1))) + (t (user-error "Invalid prefix argument: %s" arg))))) + (message "%d TODO entries found" + (org-occur (concat "^" org-outline-regexp " *" kwd-re ))))) + +(defun org-deadline (arg &optional time) + "Insert the \"DEADLINE:\" string with a timestamp to make a deadline. +With one universal prefix argument, remove any deadline from the item. +With two universal prefix arguments, prompt for a warning delay. +With argument TIME, set the deadline at the corresponding date. TIME +can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." + (interactive "P") + (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) + (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level 'region)) + org-loop-over-headlines-in-active-region) + (org-map-entries + `(org-deadline ',arg ,time) + org-loop-over-headlines-in-active-region + cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + (let* ((old-date (org-entry-get nil "DEADLINE")) + (old-date-time (if old-date (org-time-string-to-time old-date))) + (repeater (and old-date + (string-match + "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" + old-date) + (match-string 1 old-date)))) + (cond + ((equal arg '(4)) + (when (and old-date org-log-redeadline) + (org-add-log-setup 'deldeadline nil old-date 'findpos + org-log-redeadline)) + (org-remove-timestamp-with-keyword org-deadline-string) + (message "Item no longer has a deadline.")) + ((equal arg '(16)) + (save-excursion + (org-back-to-heading t) + (if (re-search-forward + org-deadline-time-regexp + (save-excursion (outline-next-heading) (point)) t) + (let* ((rpl0 (match-string 1)) + (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))) + (replace-match + (concat org-deadline-string + " <" rpl + (format " -%dd" + (abs + (- (time-to-days + (save-match-data + (org-read-date nil t nil "Warn starting from" old-date-time))) + (time-to-days old-date-time)))) + ">") t t)) + (user-error "No deadline information to update")))) + (t + (org-add-planning-info 'deadline time 'closed) + (when (and old-date org-log-redeadline + (not (equal old-date + (substring org-last-inserted-timestamp 1 -1)))) + (org-add-log-setup 'redeadline nil old-date 'findpos + org-log-redeadline)) + (when repeater + (save-excursion + (org-back-to-heading t) + (when (re-search-forward (concat org-deadline-string " " + org-last-inserted-timestamp) + (save-excursion + (outline-next-heading) (point)) t) + (goto-char (1- (match-end 0))) + (insert " " repeater) + (setq org-last-inserted-timestamp + (concat (substring org-last-inserted-timestamp 0 -1) + " " repeater + (substring org-last-inserted-timestamp -1)))))) + (message "Deadline on %s" org-last-inserted-timestamp)))))) + +(defun org-schedule (arg &optional time) + "Insert the SCHEDULED: string with a timestamp to schedule a TODO item. +With one universal prefix argument, remove any scheduling date from the item. +With two universal prefix arguments, prompt for a delay cookie. +With argument TIME, scheduled at the corresponding date. TIME can +either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." + (interactive "P") + (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) + (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level 'region)) + org-loop-over-headlines-in-active-region) + (org-map-entries + `(org-schedule ',arg ,time) + org-loop-over-headlines-in-active-region + cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + (let* ((old-date (org-entry-get nil "SCHEDULED")) + (old-date-time (if old-date (org-time-string-to-time old-date))) + (repeater (and old-date + (string-match + "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" + old-date) + (match-string 1 old-date)))) + (cond + ((equal arg '(4)) + (progn + (when (and old-date org-log-reschedule) + (org-add-log-setup 'delschedule nil old-date 'findpos + org-log-reschedule)) + (org-remove-timestamp-with-keyword org-scheduled-string) + (message "Item is no longer scheduled."))) + ((equal arg '(16)) + (save-excursion + (org-back-to-heading t) + (if (re-search-forward + org-scheduled-time-regexp + (save-excursion (outline-next-heading) (point)) t) + (let* ((rpl0 (match-string 1)) + (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))) + (replace-match + (concat org-scheduled-string + " <" rpl + (format " -%dd" + (abs + (- (time-to-days + (save-match-data + (org-read-date nil t nil "Delay until" old-date-time))) + (time-to-days old-date-time)))) + ">") t t)) + (user-error "No scheduled information to update")))) + (t + (org-add-planning-info 'scheduled time 'closed) + (when (and old-date org-log-reschedule + (not (equal old-date + (substring org-last-inserted-timestamp 1 -1)))) + (org-add-log-setup 'reschedule nil old-date 'findpos + org-log-reschedule)) + (when repeater + (save-excursion + (org-back-to-heading t) + (when (re-search-forward (concat org-scheduled-string " " + org-last-inserted-timestamp) + (save-excursion + (outline-next-heading) (point)) t) + (goto-char (1- (match-end 0))) + (insert " " repeater) + (setq org-last-inserted-timestamp + (concat (substring org-last-inserted-timestamp 0 -1) + " " repeater + (substring org-last-inserted-timestamp -1)))))) + (message "Scheduled to %s" org-last-inserted-timestamp)))))) + +(defun org-get-scheduled-time (pom &optional inherit) + "Get the scheduled time as a time tuple, of a format suitable +for calling org-schedule with, or if there is no scheduling, +returns nil." + (let ((time (org-entry-get pom "SCHEDULED" inherit))) + (when time + (apply 'encode-time (org-parse-time-string time))))) + +(defun org-get-deadline-time (pom &optional inherit) + "Get the deadline as a time tuple, of a format suitable for +calling org-deadline with, or if there is no scheduling, returns +nil." + (let ((time (org-entry-get pom "DEADLINE" inherit))) + (when time + (apply 'encode-time (org-parse-time-string time))))) + +(defun org-remove-timestamp-with-keyword (keyword) + "Remove all time stamps with KEYWORD in the current entry." + (let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*")) + beg) + (save-excursion + (org-back-to-heading t) + (setq beg (point)) + (outline-next-heading) + (while (re-search-backward re beg t) + (replace-match "") + (if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point))) + (equal (char-before) ?\ )) + (backward-delete-char 1) + (if (string-match "^[ \t]*$" (buffer-substring + (point-at-bol) (point-at-eol))) + (delete-region (point-at-bol) + (min (point-max) (1+ (point-at-eol)))))))))) + +(defvar org-time-was-given) ; dynamically scoped parameter +(defvar org-end-time-was-given) ; dynamically scoped parameter + +(defun org-add-planning-info (what &optional time &rest remove) + "Insert new timestamp with keyword in the line directly after the headline. +WHAT indicates what kind of time stamp to add. TIME indicates the time to use. +If non is given, the user is prompted for a date. +REMOVE indicates what kind of entries to remove. An old WHAT entry will also +be removed." + (interactive) + (let (org-time-was-given org-end-time-was-given ts + end default-time default-input) + + (catch 'exit + (when (and (memq what '(scheduled deadline)) + (or (not time) + (and (stringp time) + (string-match "^[-+]+[0-9]" time)))) + ;; Try to get a default date/time from existing timestamp + (save-excursion + (org-back-to-heading t) + (setq end (save-excursion (outline-next-heading) (point))) + (when (re-search-forward (if (eq what 'scheduled) + org-scheduled-time-regexp + org-deadline-time-regexp) + end t) + (setq ts (match-string 1) + default-time + (apply 'encode-time (org-parse-time-string ts)) + default-input (and ts (org-get-compact-tod ts)))))) + (when what + (setq time + (if (stringp time) + ;; This is a string (relative or absolute), set proper date + (apply 'encode-time + (org-read-date-analyze + time default-time (decode-time default-time))) + ;; If necessary, get the time from the user + (or time (org-read-date nil 'to-time nil nil + default-time default-input))))) + + (when (and org-insert-labeled-timestamps-at-point + (member what '(scheduled deadline))) + (insert + (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ") + (org-insert-time-stamp time org-time-was-given + nil nil nil (list org-end-time-was-given)) + (setq what nil)) + (save-excursion + (save-restriction + (let (col list elt ts buffer-invisibility-spec) + (org-back-to-heading t) + (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*")) + (goto-char (match-end 1)) + (setq col (current-column)) + (goto-char (match-end 0)) + (if (eobp) (insert "\n") (forward-char 1)) + (when (and (not what) + (not (looking-at + (concat "[ \t]*" + org-keyword-time-not-clock-regexp)))) + ;; Nothing to add, nothing to remove...... :-) + (throw 'exit nil)) + (if (and (not (looking-at org-outline-regexp)) + (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp + "[^\r\n]*")) + (not (equal (match-string 1) org-clock-string))) + (narrow-to-region (match-beginning 0) (match-end 0)) + (insert-before-markers "\n") + (backward-char 1) + (narrow-to-region (point) (point)) + (and org-adapt-indentation (org-indent-to-column col))) + ;; Check if we have to remove something. + (setq list (cons what remove)) + (while list + (setq elt (pop list)) + (when (or (and (eq elt 'scheduled) + (re-search-forward org-scheduled-time-regexp nil t)) + (and (eq elt 'deadline) + (re-search-forward org-deadline-time-regexp nil t)) + (and (eq elt 'closed) + (re-search-forward org-closed-time-regexp nil t))) + (replace-match "") + (if (looking-at "--+<[^>]+>") (replace-match "")))) + (and (looking-at "[ \t]+") (replace-match "")) + (and org-adapt-indentation (bolp) (org-indent-to-column col)) + (when what + (insert + (if (not (or (bolp) (eq (char-before) ?\ ))) " " "") + (cond ((eq what 'scheduled) org-scheduled-string) + ((eq what 'deadline) org-deadline-string) + ((eq what 'closed) org-closed-string)) + " ") + (setq ts (org-insert-time-stamp + time + (or org-time-was-given + (and (eq what 'closed) org-log-done-with-time)) + (eq what 'closed) + nil nil (list org-end-time-was-given))) + (insert + (if (not (or (bolp) (eq (char-before) ?\ ) + (memq (char-after) '(32 10)) + (eobp))) " " "")) + (end-of-line 1)) + (goto-char (point-min)) + (widen) + (if (and (looking-at "[ \t]*\n") + (equal (char-before) ?\n)) + (delete-region (1- (point)) (point-at-eol))) + ts)))))) + +(defvar org-log-note-marker (make-marker)) +(defvar org-log-note-purpose nil) +(defvar org-log-note-state nil) +(defvar org-log-note-previous-state nil) +(defvar org-log-note-how nil) +(defvar org-log-note-extra nil) +(defvar org-log-note-window-configuration nil) +(defvar org-log-note-return-to (make-marker)) +(defvar org-log-note-effective-time nil + "Remembered current time so that dynamically scoped +`org-extend-today-until' affects tha timestamps in state change +log") + +(defvar org-log-post-message nil + "Message to be displayed after a log note has been stored. +The auto-repeater uses this.") + +(defun org-add-note () + "Add a note to the current entry. +This is done in the same way as adding a state change note." + (interactive) + (org-add-log-setup 'note nil nil 'findpos nil)) + +(defvar org-property-end-re) +(defun org-add-log-setup (&optional purpose state prev-state + findpos how extra) + "Set up the post command hook to take a note. +If this is about to TODO state change, the new state is expected in STATE. +When FINDPOS is non-nil, find the correct position for the note in +the current entry. If not, assume that it can be inserted at point. +HOW is an indicator what kind of note should be created. +EXTRA is additional text that will be inserted into the notes buffer." + (let* ((org-log-into-drawer (org-log-into-drawer)) + (drawer (cond ((stringp org-log-into-drawer) + org-log-into-drawer) + (org-log-into-drawer "LOGBOOK")))) + (save-restriction + (save-excursion + (when findpos + (org-back-to-heading t) + (narrow-to-region (point) (save-excursion + (outline-next-heading) (point))) + (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*" + "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp + "[^\r\n]*\\)?")) + (goto-char (match-end 0)) + (cond + (drawer + (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*$") + nil t) + (progn + (goto-char (match-end 0)) + (or org-log-states-order-reversed + (and (re-search-forward org-property-end-re nil t) + (goto-char (1- (match-beginning 0)))))) + (insert "\n:" drawer ":\n:END:") + (beginning-of-line 0) + (org-indent-line) + (beginning-of-line 2) + (org-indent-line) + (end-of-line 0))) + ((and org-log-state-notes-insert-after-drawers + (save-excursion + (forward-line) (looking-at org-drawer-regexp))) + (forward-line) + (while (looking-at org-drawer-regexp) + (goto-char (match-end 0)) + (re-search-forward org-property-end-re (point-max) t) + (forward-line)) + (forward-line -1))) + (unless org-log-states-order-reversed + (and (= (char-after) ?\n) (forward-char 1)) + (org-skip-over-state-notes) + (skip-chars-backward " \t\n\r"))) + (move-marker org-log-note-marker (point)) + (setq org-log-note-purpose purpose + org-log-note-state state + org-log-note-previous-state prev-state + org-log-note-how how + org-log-note-extra extra + org-log-note-effective-time (org-current-effective-time)) + (add-hook 'post-command-hook 'org-add-log-note 'append))))) + +(defun org-skip-over-state-notes () + "Skip past the list of State notes in an entry." + (if (looking-at "\n[ \t]*- State") (forward-char 1)) + (when (ignore-errors (goto-char (org-in-item-p))) + (let* ((struct (org-list-struct)) + (prevs (org-list-prevs-alist struct))) + (while (looking-at "[ \t]*- State") + (goto-char (or (org-list-get-next-item (point) struct prevs) + (org-list-get-item-end (point) struct))))))) + +(defun org-add-log-note (&optional purpose) + "Pop up a window for taking a note, and add this note later at point." + (remove-hook 'post-command-hook 'org-add-log-note) + (setq org-log-note-window-configuration (current-window-configuration)) + (delete-other-windows) + (move-marker org-log-note-return-to (point)) + (org-pop-to-buffer-same-window (marker-buffer org-log-note-marker)) + (goto-char org-log-note-marker) + (org-switch-to-buffer-other-window "*Org Note*") + (erase-buffer) + (if (memq org-log-note-how '(time state)) + (let (current-prefix-arg) (org-store-log-note)) + (let ((org-inhibit-startup t)) (org-mode)) + (insert (format "# Insert note for %s. +# Finish with C-c C-c, or cancel with C-c C-k.\n\n" + (cond + ((eq org-log-note-purpose 'clock-out) "stopped clock") + ((eq org-log-note-purpose 'done) "closed todo item") + ((eq org-log-note-purpose 'state) + (format "state change from \"%s\" to \"%s\"" + (or org-log-note-previous-state "") + (or org-log-note-state ""))) + ((eq org-log-note-purpose 'reschedule) + "rescheduling") + ((eq org-log-note-purpose 'delschedule) + "no longer scheduled") + ((eq org-log-note-purpose 'redeadline) + "changing deadline") + ((eq org-log-note-purpose 'deldeadline) + "removing deadline") + ((eq org-log-note-purpose 'refile) + "refiling") + ((eq org-log-note-purpose 'note) + "this entry") + (t (error "This should not happen"))))) + (if org-log-note-extra (insert org-log-note-extra)) + (org-set-local 'org-finish-function 'org-store-log-note) + (run-hooks 'org-log-buffer-setup-hook))) + +(defvar org-note-abort nil) ; dynamically scoped +(defun org-store-log-note () + "Finish taking a log note, and insert it to where it belongs." + (let ((txt (buffer-string))) + (kill-buffer (current-buffer)) + (let ((note (cdr (assq org-log-note-purpose org-log-note-headings))) + lines ind bul) + (while (string-match "\\`# .*\n[ \t\n]*" txt) + (setq txt (replace-match "" t t txt))) + (if (string-match "\\s-+\\'" txt) + (setq txt (replace-match "" t t txt))) + (setq lines (org-split-string txt "\n")) + (when (and note (string-match "\\S-" note)) + (setq note + (org-replace-escapes + note + (list (cons "%u" (user-login-name)) + (cons "%U" user-full-name) + (cons "%t" (format-time-string + (org-time-stamp-format 'long 'inactive) + org-log-note-effective-time)) + (cons "%T" (format-time-string + (org-time-stamp-format 'long nil) + org-log-note-effective-time)) + (cons "%d" (format-time-string + (org-time-stamp-format nil 'inactive) + org-log-note-effective-time)) + (cons "%D" (format-time-string + (org-time-stamp-format nil nil) + org-log-note-effective-time)) + (cons "%s" (if org-log-note-state + (concat "\"" org-log-note-state "\"") + "")) + (cons "%S" (if org-log-note-previous-state + (concat "\"" org-log-note-previous-state "\"") + "\"\""))))) + (if lines (setq note (concat note " \\\\"))) + (push note lines)) + (when (or current-prefix-arg org-note-abort) + (when org-log-into-drawer + (org-remove-empty-drawer-at + (if (stringp org-log-into-drawer) org-log-into-drawer "LOGBOOK") + org-log-note-marker)) + (setq lines nil)) + (when lines + (with-current-buffer (marker-buffer org-log-note-marker) + (save-excursion + (goto-char org-log-note-marker) + (move-marker org-log-note-marker nil) + (end-of-line 1) + (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) + (setq ind (save-excursion + (if (ignore-errors (goto-char (org-in-item-p))) + (let ((struct (org-list-struct))) + (org-list-get-ind + (org-list-get-top-point struct) struct)) + (skip-chars-backward " \r\t\n") + (cond + ((and (org-at-heading-p) + org-adapt-indentation) + (1+ (org-current-level))) + ((org-at-heading-p) 0) + (t (org-get-indentation)))))) + (setq bul (org-list-bullet-string "-")) + (org-indent-line-to ind) + (insert bul (pop lines)) + (let ((ind-body (+ (length bul) ind))) + (while lines + (insert "\n") + (org-indent-line-to ind-body) + (insert (pop lines)))) + (message "Note stored") + (org-back-to-heading t) + (org-cycle-hide-drawers 'children)) + ;; Fix `buffer-undo-list' when `org-store-log-note' is called + ;; from within `org-add-log-note' because `buffer-undo-list' + ;; is then modified outside of `org-with-remote-undo'. + (when (eq this-command 'org-agenda-todo) + (setcdr buffer-undo-list (cddr buffer-undo-list))))))) + ;; Don't add undo information when called from `org-agenda-todo' + (let ((buffer-undo-list (eq this-command 'org-agenda-todo))) + (set-window-configuration org-log-note-window-configuration) + (with-current-buffer (marker-buffer org-log-note-return-to) + (goto-char org-log-note-return-to)) + (move-marker org-log-note-return-to nil) + (and org-log-post-message (message "%s" org-log-post-message)))) + +(defun org-remove-empty-drawer-at (drawer pos) + "Remove an empty drawer DRAWER at position POS. +POS may also be a marker." + (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer)) + (save-excursion + (save-restriction + (widen) + (goto-char pos) + (if (org-in-regexp + (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2) + (replace-match "")))))) + +(defvar org-ts-type nil) +(defun org-sparse-tree (&optional arg type) + "Create a sparse tree, prompt for the details. +This command can create sparse trees. You first need to select the type +of match used to create the tree: + +t Show all TODO entries. +T Show entries with a specific TODO keyword. +m Show entries selected by a tags/property match. +p Enter a property name and its value (both with completion on existing + names/values) and show entries with that property. +r Show entries matching a regular expression (`/' can be used as well). +b Show deadlines and scheduled items before a date. +a Show deadlines and scheduled items after a date. +d Show deadlines due within `org-deadline-warning-days'. +D Show deadlines and scheduled items between a date range." + (interactive "P") + (setq type (or type org-sparse-tree-default-date-type)) + (setq org-ts-type type) + (message "Sparse tree: [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty + [d]eadlines [b]efore-date [a]fter-date [D]ates range + [c]ycle through date types: %s" + (case type + (all "all timestamps") + (scheduled "only scheduled") + (deadline "only deadline") + (active "only active timestamps") + (inactive "only inactive timestamps") + (scheduled-or-deadline "scheduled/deadline") + (closed "with a closed time-stamp") + (otherwise "scheduled/deadline"))) + (let ((answer (read-char-exclusive))) + (case answer + (?c + (org-sparse-tree + arg + (cadr (memq type '(scheduled-or-deadline all scheduled deadline active + inactive closed))))) + (?d (call-interactively #'org-check-deadlines)) + (?b (call-interactively #'org-check-before-date)) + (?a (call-interactively #'org-check-after-date)) + (?D (call-interactively #'org-check-dates-range)) + (?t (call-interactively #'org-show-todo-tree)) + (?T (org-show-todo-tree '(4))) + (?m (call-interactively #'org-match-sparse-tree)) + ((?p ?P) + (let* ((kwd (org-icompleting-read + "Property: " (mapcar #'list (org-buffer-property-keys)))) + (value (org-icompleting-read + "Value: " (mapcar #'list (org-property-values kwd))))) + (unless (string-match "\\`{.*}\\'" value) + (setq value (concat "\"" value "\""))) + (org-match-sparse-tree arg (concat kwd "=" value)))) + ((?r ?R ?/) (call-interactively #'org-occur)) + (otherwise (user-error "No such sparse tree command \"%c\"" answer))))) + +(defvar org-occur-highlights nil + "List of overlays used for occur matches.") +(make-variable-buffer-local 'org-occur-highlights) +(defvar org-occur-parameters nil + "Parameters of the active org-occur calls. +This is a list, each call to org-occur pushes as cons cell, +containing the regular expression and the callback, onto the list. +The list can contain several entries if `org-occur' has been called +several time with the KEEP-PREVIOUS argument. Otherwise, this list +will only contain one set of parameters. When the highlights are +removed (for example with `C-c C-c', or with the next edit (depending +on `org-remove-highlights-with-change'), this variable is emptied +as well.") +(make-variable-buffer-local 'org-occur-parameters) + +(defun org-occur (regexp &optional keep-previous callback) + "Make a compact tree which shows all matches of REGEXP. +The tree will show the lines where the regexp matches, and all higher +headlines above the match. It will also show the heading after the match, +to make sure editing the matching entry is easy. +If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous +call to `org-occur' will be kept, to allow stacking of calls to this +command. +If CALLBACK is non-nil, it is a function which is called to confirm +that the match should indeed be shown." + (interactive "sRegexp: \nP") + (when (equal regexp "") + (user-error "Regexp cannot be empty")) + (unless keep-previous + (org-remove-occur-highlights nil nil t)) + (push (cons regexp callback) org-occur-parameters) + (let ((cnt 0)) + (save-excursion + (goto-char (point-min)) + (if (or (not keep-previous) ; do not want to keep + (not org-occur-highlights)) ; no previous matches + ;; hide everything + (org-overview)) + (while (re-search-forward regexp nil t) + (when (or (not callback) + (save-match-data (funcall callback))) + (setq cnt (1+ cnt)) + (when org-highlight-sparse-tree-matches + (org-highlight-new-match (match-beginning 0) (match-end 0))) + (org-show-context 'occur-tree)))) + (when org-remove-highlights-with-change + (org-add-hook 'before-change-functions 'org-remove-occur-highlights + nil 'local)) + (unless org-sparse-tree-open-archived-trees + (org-hide-archived-subtrees (point-min) (point-max))) + (run-hooks 'org-occur-hook) + (if (org-called-interactively-p 'interactive) + (message "%d match(es) for regexp %s" cnt regexp)) + cnt)) + +(defun org-occur-next-match (&optional n reset) + "Function for `next-error-function' to find sparse tree matches. +N is the number of matches to move, when negative move backwards. +RESET is entirely ignored - this function always goes back to the +starting point when no match is found." + (let* ((limit (if (< n 0) (point-min) (point-max))) + (search-func (if (< n 0) + 'previous-single-char-property-change + 'next-single-char-property-change)) + (n (abs n)) + (pos (point)) + p1) + (catch 'exit + (while (setq p1 (funcall search-func (point) 'org-type)) + (when (equal p1 limit) + (goto-char pos) + (error "No more matches")) + (when (equal (get-char-property p1 'org-type) 'org-occur) + (setq n (1- n)) + (when (= n 0) + (goto-char p1) + (throw 'exit (point)))) + (goto-char p1)) + (goto-char p1) + (error "No more matches")))) + +(defun org-show-context (&optional key) + "Make sure point and context are visible. +How much context is shown depends upon the variables +`org-show-hierarchy-above', `org-show-following-heading', +`org-show-entry-below' and `org-show-siblings'." + (let ((heading-p (org-at-heading-p t)) + (hierarchy-p (org-get-alist-option org-show-hierarchy-above key)) + (following-p (org-get-alist-option org-show-following-heading key)) + (entry-p (org-get-alist-option org-show-entry-below key)) + (siblings-p (org-get-alist-option org-show-siblings key))) + ;; Show heading or entry text + (if (and heading-p (not entry-p)) + (org-flag-heading nil) ; only show the heading + (and (or entry-p (outline-invisible-p) (org-invisible-p2)) + (org-show-hidden-entry))) ; show entire entry + (when following-p + ;; Show next sibling, or heading below text + (save-excursion + (and (if heading-p (org-goto-sibling) (outline-next-heading)) + (org-flag-heading nil)))) + (when siblings-p (org-show-siblings)) + (when hierarchy-p + ;; show all higher headings, possibly with siblings + (save-excursion + (while (and (condition-case nil + (progn (org-up-heading-all 1) t) + (error nil)) + (not (bobp))) + (org-flag-heading nil) + (when siblings-p (org-show-siblings))))))) + +(defvar org-reveal-start-hook nil + "Hook run before revealing a location.") + +(defun org-reveal (&optional siblings) + "Show current entry, hierarchy above it, and the following headline. +This can be used to show a consistent set of context around locations +exposed with `org-show-hierarchy-above' or `org-show-following-heading' +not t for the search context. + +With optional argument SIBLINGS, on each level of the hierarchy all +siblings are shown. This repairs the tree structure to what it would +look like when opened with hierarchical calls to `org-cycle'. +With double optional argument \\[universal-argument] \\[universal-argument], \ +go to the parent and show the +entire tree." + (interactive "P") + (run-hooks 'org-reveal-start-hook) + (let ((org-show-hierarchy-above t) + (org-show-following-heading t) + (org-show-siblings (if siblings t org-show-siblings))) + (org-show-context nil)) + (when (equal siblings '(16)) + (save-excursion + (when (org-up-heading-safe) + (org-show-subtree) + (run-hook-with-args 'org-cycle-hook 'subtree))))) + +(defun org-highlight-new-match (beg end) + "Highlight from BEG to END and mark the highlight is an occur headline." + (let ((ov (make-overlay beg end))) + (overlay-put ov 'face 'secondary-selection) + (overlay-put ov 'org-type 'org-occur) + (push ov org-occur-highlights))) + +(defun org-remove-occur-highlights (&optional beg end noremove) + "Remove the occur highlights from the buffer. +BEG and END are ignored. If NOREMOVE is nil, remove this function +from the `before-change-functions' in the current buffer." + (interactive) + (unless org-inhibit-highlight-removal + (mapc 'delete-overlay org-occur-highlights) + (setq org-occur-highlights nil) + (setq org-occur-parameters nil) + (unless noremove + (remove-hook 'before-change-functions + 'org-remove-occur-highlights 'local)))) + +;;;; Priorities + +(defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]\\)\\] ?\\)" + "Regular expression matching the priority indicator.") + +(defvar org-remove-priority-next-time nil) + +(defun org-priority-up () + "Increase the priority of the current item." + (interactive) + (org-priority 'up)) + +(defun org-priority-down () + "Decrease the priority of the current item." + (interactive) + (org-priority 'down)) + +(defun org-priority (&optional action show) + "Change the priority of an item. +ACTION can be `set', `up', `down', or a character." + (interactive "P") + (if (equal action '(4)) + (org-show-priority) + (unless org-enable-priority-commands + (user-error "Priority commands are disabled")) + (setq action (or action 'set)) + (let (current new news have remove) + (save-excursion + (org-back-to-heading t) + (if (looking-at org-priority-regexp) + (setq current (string-to-char (match-string 2)) + have t)) + (cond + ((eq action 'remove) + (setq remove t new ?\ )) + ((or (eq action 'set) + (if (featurep 'xemacs) (characterp action) (integerp action))) + (if (not (eq action 'set)) + (setq new action) + (message "Priority %c-%c, SPC to remove: " + org-highest-priority org-lowest-priority) + (save-match-data + (setq new (read-char-exclusive)))) + (if (and (= (upcase org-highest-priority) org-highest-priority) + (= (upcase org-lowest-priority) org-lowest-priority)) + (setq new (upcase new))) + (cond ((equal new ?\ ) (setq remove t)) + ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) + (user-error "Priority must be between `%c' and `%c'" + org-highest-priority org-lowest-priority)))) + ((eq action 'up) + (setq new (if have + (1- current) ; normal cycling + ;; last priority was empty + (if (eq last-command this-command) + org-lowest-priority ; wrap around empty to lowest + ;; default + (if org-priority-start-cycle-with-default + org-default-priority + (1- org-default-priority)))))) + ((eq action 'down) + (setq new (if have + (1+ current) ; normal cycling + ;; last priority was empty + (if (eq last-command this-command) + org-highest-priority ; wrap around empty to highest + ;; default + (if org-priority-start-cycle-with-default + org-default-priority + (1+ org-default-priority)))))) + (t (user-error "Invalid action"))) + (if (or (< (upcase new) org-highest-priority) + (> (upcase new) org-lowest-priority)) + (if (and (memq action '(up down)) + (not have) (not (eq last-command this-command))) + ;; `new' is from default priority + (error + "The default can not be set, see `org-default-priority' why") + ;; normal cycling: `new' is beyond highest/lowest priority + ;; and is wrapped around to the empty priority + (setq remove t))) + (setq news (format "%c" new)) + (if have + (if remove + (replace-match "" t t nil 1) + (replace-match news t t nil 2)) + (if remove + (user-error "No priority cookie found in line") + (let ((case-fold-search nil)) + (looking-at org-todo-line-regexp)) + (if (match-end 2) + (progn + (goto-char (match-end 2)) + (insert " [#" news "]")) + (goto-char (match-beginning 3)) + (insert "[#" news "] ")))) + (org-preserve-lc (org-set-tags nil 'align))) + (if remove + (message "Priority removed") + (message "Priority of current item set to %s" news))))) + +(defun org-show-priority () + "Show the priority of the current item. +This priority is composed of the main priority given with the [#A] cookies, +and by additional input from the age of a schedules or deadline entry." + (interactive) + (let ((pri (if (eq major-mode 'org-agenda-mode) + (org-get-at-bol 'priority) + (save-excursion + (save-match-data + (beginning-of-line) + (and (looking-at org-heading-regexp) + (org-get-priority (match-string 0)))))))) + (message "Priority is %d" (if pri pri -1000)))) + +(defun org-get-priority (s) + "Find priority cookie and return priority." + (save-match-data + (if (functionp org-get-priority-function) + (funcall org-get-priority-function) + (if (not (string-match org-priority-regexp s)) + (* 1000 (- org-lowest-priority org-default-priority)) + (* 1000 (- org-lowest-priority + (string-to-char (match-string 2 s)))))))) + +;;;; Tags + +(defvar org-agenda-archives-mode) +(defvar org-map-continue-from nil + "Position from where mapping should continue. +Can be set by the action argument to `org-scan-tags' and `org-map-entries'.") + +(defvar org-scanner-tags nil + "The current tag list while the tags scanner is running.") +(defvar org-trust-scanner-tags nil + "Should `org-get-tags-at' use the tags for the scanner. +This is for internal dynamical scoping only. +When this is non-nil, the function `org-get-tags-at' will return the value +of `org-scanner-tags' instead of building the list by itself. This +can lead to large speed-ups when the tags scanner is used in a file with +many entries, and when the list of tags is retrieved, for example to +obtain a list of properties. Building the tags list for each entry in such +a file becomes an N^2 operation - but with this variable set, it scales +as N.") + +(defun org-scan-tags (action matcher todo-only &optional start-level) + "Scan headline tags with inheritance and produce output ACTION. + +ACTION can be `sparse-tree' to produce a sparse tree in the current buffer, +or `agenda' to produce an entry list for an agenda view. It can also be +a Lisp form or a function that should be called at each matched headline, in +this case the return value is a list of all return values from these calls. + +MATCHER is a Lisp form to be evaluated, testing if a given set of tags +qualifies a headline for inclusion. When TODO-ONLY is non-nil, +only lines with a not-done TODO keyword are included in the output. +This should be the same variable that was scoped into +and set by `org-make-tags-matcher' when it constructed MATCHER. + +START-LEVEL can be a string with asterisks, reducing the scope to +headlines matching this string." + (require 'org-agenda) + (let* ((re (concat "^" + (if start-level + ;; Get the correct level to match + (concat "\\*\\{" (number-to-string start-level) "\\} ") + org-outline-regexp) + " *\\(\\<\\(" + (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") + (org-re "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))) + (props (list 'face 'default + 'done-face 'org-agenda-done + 'undone-face 'default + 'mouse-face 'highlight + 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'help-echo + (format "mouse-2 or RET jump to org file %s" + (abbreviate-file-name + (or (buffer-file-name (buffer-base-buffer)) + (buffer-name (buffer-base-buffer))))))) + (org-map-continue-from nil) + lspos tags tags-list + (tags-alist (list (cons 0 org-file-tags))) + (llast 0) rtn rtn1 level category i txt + todo marker entry priority) + (when (not (or (member action '(agenda sparse-tree)) (functionp action))) + (setq action (list 'lambda nil action))) + (save-excursion + (goto-char (point-min)) + (when (eq action 'sparse-tree) + (org-overview) + (org-remove-occur-highlights)) + (while (let (case-fold-search) + (re-search-forward re nil t)) + (setq org-map-continue-from nil) + (catch :skip + (setq todo (if (match-end 1) (org-match-string-no-properties 2)) + tags (if (match-end 4) (org-match-string-no-properties 4))) + (goto-char (setq lspos (match-beginning 0))) + (setq level (org-reduced-level (org-outline-level)) + category (org-get-category)) + (setq i llast llast level) + ;; remove tag lists from same and sublevels + (while (>= i level) + (when (setq entry (assoc i tags-alist)) + (setq tags-alist (delete entry tags-alist))) + (setq i (1- i))) + ;; add the next tags + (when tags + (setq tags (org-split-string tags ":") + tags-alist + (cons (cons level tags) tags-alist))) + ;; compile tags for current headline + (setq tags-list + (if org-use-tag-inheritance + (apply 'append (mapcar 'cdr (reverse tags-alist))) + tags) + org-scanner-tags tags-list) + (when org-use-tag-inheritance + (setcdr (car tags-alist) + (mapcar (lambda (x) + (setq x (copy-sequence x)) + (org-add-prop-inherited x)) + (cdar tags-alist)))) + (when (and tags org-use-tag-inheritance + (or (not (eq t org-use-tag-inheritance)) + org-tags-exclude-from-inheritance)) + ;; selective inheritance, remove uninherited ones + (setcdr (car tags-alist) + (org-remove-uninherited-tags (cdar tags-alist)))) + (when (and + + ;; eval matcher only when the todo condition is OK + (and (or (not todo-only) (member todo org-not-done-keywords)) + (let ((case-fold-search t) (org-trust-scanner-tags t)) + (eval matcher))) + + ;; Call the skipper, but return t if it does not skip, + ;; so that the `and' form continues evaluating + (progn + (unless (eq action 'sparse-tree) (org-agenda-skip)) + t) + + ;; Check if timestamps are deselecting this entry + (or (not todo-only) + (and (member todo org-not-done-keywords) + (or (not org-agenda-tags-todo-honor-ignore-options) + (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))))) + + ;; select this headline + (cond + ((eq action 'sparse-tree) + (and org-highlight-sparse-tree-matches + (org-get-heading) (match-end 0) + (org-highlight-new-match + (match-beginning 1) (match-end 1))) + (org-show-context 'tags-tree)) + ((eq action 'agenda) + (setq txt (org-agenda-format-item + "" + (concat + (if (eq org-tags-match-list-sublevels 'indented) + (make-string (1- level) ?.) "") + (org-get-heading)) + level category + tags-list) + priority (org-get-priority txt)) + (goto-char lspos) + (setq marker (org-agenda-new-marker)) + (org-add-props txt props + 'org-marker marker 'org-hd-marker marker 'org-category category + 'todo-state todo + 'priority priority 'type "tagsmatch") + (push txt rtn)) + ((functionp action) + (setq org-map-continue-from nil) + (save-excursion + (setq rtn1 (funcall action)) + (push rtn1 rtn))) + (t (user-error "Invalid action"))) + + ;; if we are to skip sublevels, jump to end of subtree + (unless org-tags-match-list-sublevels + (org-end-of-subtree t) + (backward-char 1)))) + ;; Get the correct position from where to continue + (if org-map-continue-from + (goto-char org-map-continue-from) + (and (= (point) lspos) (end-of-line 1))))) + (when (and (eq action 'sparse-tree) + (not org-sparse-tree-open-archived-trees)) + (org-hide-archived-subtrees (point-min) (point-max))) + (nreverse rtn))) + +(defun org-remove-uninherited-tags (tags) + "Remove all tags that are not inherited from the list TAGS." + (cond + ((eq org-use-tag-inheritance t) + (if org-tags-exclude-from-inheritance + (org-delete-all org-tags-exclude-from-inheritance tags) + tags)) + ((not org-use-tag-inheritance) nil) + ((stringp org-use-tag-inheritance) + (delq nil (mapcar + (lambda (x) + (if (and (string-match org-use-tag-inheritance x) + (not (member x org-tags-exclude-from-inheritance))) + x nil)) + tags))) + ((listp org-use-tag-inheritance) + (delq nil (mapcar + (lambda (x) + (if (member x org-use-tag-inheritance) x nil)) + tags))))) + +(defun org-match-sparse-tree (&optional todo-only match) + "Create a sparse tree according to tags string MATCH. +MATCH can contain positive and negative selection of tags, like +\"+WORK+URGENT-WITHBOSS\". +If optional argument TODO-ONLY is non-nil, only select lines that are +also TODO lines." + (interactive "P") + (org-agenda-prepare-buffers (list (current-buffer))) + (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) + +(defalias 'org-tags-sparse-tree 'org-match-sparse-tree) + +(defvar org-cached-props nil) +(defun org-cached-entry-get (pom property) + (if (or (eq t org-use-property-inheritance) + (and (stringp org-use-property-inheritance) + (string-match org-use-property-inheritance property)) + (and (listp org-use-property-inheritance) + (member property org-use-property-inheritance))) + ;; Caching is not possible, check it directly + (org-entry-get pom property 'inherit) + ;; Get all properties, so that we can do complicated checks easily + (cdr (assoc property (or org-cached-props + (setq org-cached-props + (org-entry-properties pom))))))) + +(defun org-global-tags-completion-table (&optional files) + "Return the list of all tags in all agenda buffer/files. +Optional FILES argument is a list of files which can be used +instead of the agenda files." + (save-excursion + (org-uniquify + (delq nil + (apply 'append + (mapcar + (lambda (file) + (set-buffer (find-file-noselect file)) + (append (org-get-buffer-tags) + (mapcar (lambda (x) (if (stringp (car-safe x)) + (list (car-safe x)) nil)) + org-tag-alist))) + (if (and files (car files)) + files + (org-agenda-files)))))))) + +(defun org-make-tags-matcher (match) + "Create the TAGS/TODO matcher form for the selection string MATCH. + +The variable `todo-only' is scoped dynamically into this function. +It will be set to t if the matcher restricts matching to TODO entries, +otherwise will not be touched. + +Returns a cons of the selection string MATCH and the constructed +lisp form implementing the matcher. The matcher is to be evaluated +at an Org entry, with point on the headline, and returns t if the +entry matches the selection string MATCH. The returned lisp form +references two variables with information about the entry, which +must be bound around the form's evaluation: todo, the TODO keyword +at the entry (or nil of none); and tags-list, the list of all tags +at the entry including inherited ones. Additionally, the category +of the entry (if any) must be specified as the text property +'org-category on the headline. + +See also `org-scan-tags'. +" + (declare (special todo-only)) + (unless (boundp 'todo-only) + (error "`org-make-tags-matcher' expects todo-only to be scoped in")) + (unless match + ;; Get a new match request, with completion against the global + ;; tags table and the local tags in current buffer + (let ((org-last-tags-completion-table + (org-uniquify + (delq nil (append (org-get-buffer-tags) + (org-global-tags-completion-table)))))) + (setq match (org-completing-read-no-i + "Match: " 'org-tags-completion-function nil nil nil + 'org-tags-history)))) + + ;; Parse the string and create a lisp form + (let ((match0 match) + (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")) + minus tag mm + tagsmatch todomatch tagsmatcher todomatcher kwd matcher + orterms term orlist re-p str-p level-p level-op time-p + prop-p pn pv po gv rest (start 0) (ss 0)) + ;; Expand group tags + (setq match (org-tags-expand match)) + + ;; Check if there is a TODO part of this match, which would be the + ;; part after a "/". TO make sure that this slash is not part of + ;; a property value to be matched against, we also check that there + ;; is no " after that slash. + ;; First, find the last slash + (while (string-match "/+" match ss) + (setq start (match-beginning 0) ss (match-end 0))) + (if (and (string-match "/+" match start) + (not (save-match-data (string-match "\"" match start)))) + ;; match contains also a todo-matching request + (progn + (setq tagsmatch (substring match 0 (match-beginning 0)) + todomatch (substring match (match-end 0))) + (if (string-match "^!" todomatch) + (setq todo-only t todomatch (substring todomatch 1))) + (if (string-match "^\\s-*$" todomatch) + (setq todomatch nil))) + ;; only matching tags + (setq tagsmatch match todomatch nil)) + + ;; Make the tags matcher + (if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch))) + (setq tagsmatcher t) + (setq orterms (org-split-string tagsmatch "|") orlist nil) + (while (setq term (pop orterms)) + (while (and (equal (substring term -1) "\\") orterms) + (setq term (concat term "|" (pop orterms)))) ; repair bad split + (while (string-match re term) + (setq rest (substring term (match-end 0)) + minus (and (match-end 1) + (equal (match-string 1 term) "-")) + tag (save-match-data (replace-regexp-in-string + "\\\\-" "-" + (match-string 2 term))) + re-p (equal (string-to-char tag) ?{) + level-p (match-end 4) + prop-p (match-end 5) + mm (cond + (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list)) + (level-p + (setq level-op (org-op-to-function (match-string 3 term))) + `(,level-op level ,(string-to-number + (match-string 4 term)))) + (prop-p + (setq pn (match-string 5 term) + po (match-string 6 term) + pv (match-string 7 term) + re-p (equal (string-to-char pv) ?{) + str-p (equal (string-to-char pv) ?\") + time-p (save-match-data + (string-match "^\"[[<].*[]>]\"$" pv)) + pv (if (or re-p str-p) (substring pv 1 -1) pv)) + (if time-p (setq pv (org-matcher-time pv))) + (setq po (org-op-to-function po (if time-p 'time str-p))) + (cond + ((equal pn "CATEGORY") + (setq gv '(get-text-property (point) 'org-category))) + ((equal pn "TODO") + (setq gv 'todo)) + (t + (setq gv `(org-cached-entry-get nil ,pn)))) + (if re-p + (if (eq po 'org<>) + `(not (string-match ,pv (or ,gv ""))) + `(string-match ,pv (or ,gv ""))) + (if str-p + `(,po (or ,gv "") ,pv) + `(,po (string-to-number (or ,gv "")) + ,(string-to-number pv) )))) + (t `(member ,tag tags-list))) + mm (if minus (list 'not mm) mm) + term rest) + (push mm tagsmatcher)) + (push (if (> (length tagsmatcher) 1) + (cons 'and tagsmatcher) + (car tagsmatcher)) + orlist) + (setq tagsmatcher nil)) + (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist))) + (setq tagsmatcher + (list 'progn '(setq org-cached-props nil) tagsmatcher))) + ;; Make the todo matcher + (if (or (not todomatch) (not (string-match "\\S-" todomatch))) + (setq todomatcher t) + (setq orterms (org-split-string todomatch "|") orlist nil) + (while (setq term (pop orterms)) + (while (string-match re term) + (setq minus (and (match-end 1) + (equal (match-string 1 term) "-")) + kwd (match-string 2 term) + re-p (equal (string-to-char kwd) ?{) + term (substring term (match-end 0)) + mm (if re-p + `(string-match ,(substring kwd 1 -1) todo) + (list 'equal 'todo kwd)) + mm (if minus (list 'not mm) mm)) + (push mm todomatcher)) + (push (if (> (length todomatcher) 1) + (cons 'and todomatcher) + (car todomatcher)) + orlist) + (setq todomatcher nil)) + (setq todomatcher (if (> (length orlist) 1) + (cons 'or orlist) (car orlist)))) + + ;; Return the string and lisp forms of the matcher + (setq matcher (if todomatcher + (list 'and tagsmatcher todomatcher) + tagsmatcher)) + (when todo-only + (setq matcher (list 'and '(member todo org-not-done-keywords) + matcher))) + (cons match0 matcher))) + +(defun org-tags-expand (match &optional single-as-list downcased) + "Expand group tags in MATCH. + +This replaces every group tag in MATCH with a regexp tag search. +For example, a group tag \"Work\" defined as { Work : Lab Conf } +will be replaced like this: + + Work => {\\(?:Work\\|Lab\\|Conf\\)} + +Work => +{\\(?:Work\\|Lab\\|Conf\\)} + -Work => -{\\(?:Work\\|Lab\\|Conf\\)} + +Replacing by a regexp preserves the structure of the match. +E.g., this expansion + + Work|Home => {\\(?:Work\\|Lab\\|Conf\\}|Home + +will match anything tagged with \"Lab\" and \"Home\", or tagged +with \"Conf\" and \"Home\" or tagged with \"Work\" and \"home\". + +When the optional argument SINGLE-AS-LIST is non-nil, MATCH is +assumed to be a single group tag, and the function will return +the list of tags in this group. + +When DOWNCASE is non-nil, expand downcased TAGS." + (if org-group-tags + (let* ((case-fold-search t) + (stable org-mode-syntax-table) + (tal (or org-tag-groups-alist-for-agenda + org-tag-groups-alist)) + (tal (if downcased + (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal)) + (tml (mapcar 'car tal)) + (rtnmatch match) rpl) + ;; @ and _ are allowed as word-components in tags + (modify-syntax-entry ?@ "w" stable) + (modify-syntax-entry ?_ "w" stable) + (while (and tml + (with-syntax-table stable + (string-match + (concat "\\(?1:[+-]?\\)\\(?2:\\<" + (regexp-opt tml) "\\>\\)") rtnmatch))) + (let* ((dir (match-string 1 rtnmatch)) + (tag (match-string 2 rtnmatch)) + (tag (if downcased (downcase tag) tag))) + (setq tml (delete tag tml)) + (when (not (get-text-property 0 'grouptag (match-string 2 rtnmatch))) + (setq rpl (append (org-uniquify rpl) (assoc tag tal))) + (setq rpl (concat dir "{\\<" (regexp-opt rpl) "\\>}")) + (if (stringp rpl) (org-add-props rpl '(grouptag t))) + (setq rtnmatch (replace-match rpl t t rtnmatch))))) + (if single-as-list + (or (reverse rpl) (list rtnmatch)) + rtnmatch)) + (if single-as-list (list (if downcased (downcase match) match)) + match))) + +(defun org-op-to-function (op &optional stringp) + "Turn an operator into the appropriate function." + (setq op + (cond + ((equal op "<" ) '(< string< org-time<)) + ((equal op ">" ) '(> org-string> org-time>)) + ((member op '("<=" "=<")) '(<= org-string<= org-time<=)) + ((member op '(">=" "=>")) '(>= org-string>= org-time>=)) + ((member op '("=" "==")) '(= string= org-time=)) + ((member op '("<>" "!=")) '(org<> org-string<> org-time<>)))) + (nth (if (eq stringp 'time) 2 (if stringp 1 0)) op)) + +(defun org<> (a b) (not (= a b))) +(defun org-string<= (a b) (or (string= a b) (string< a b))) +(defun org-string>= (a b) (not (string< a b))) +(defun org-string> (a b) (and (not (string= a b)) (not (string< a b)))) +(defun org-string<> (a b) (not (string= a b))) +(defun org-time= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (= a b))) +(defun org-time< (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (< a b))) +(defun org-time<= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (<= a b))) +(defun org-time> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (> a b))) +(defun org-time>= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (>= a b))) +(defun org-time<> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (org<> a b))) +(defun org-2ft (s) + "Convert S to a floating point time. +If S is already a number, just return it. If it is a string, parse +it as a time string and apply `float-time' to it. If S is nil, just return 0." + (cond + ((numberp s) s) + ((stringp s) + (condition-case nil + (float-time (apply 'encode-time (org-parse-time-string s))) + (error 0.))) + (t 0.))) + +(defun org-time-today () + "Time in seconds today at 0:00. +Returns the float number of seconds since the beginning of the +epoch to the beginning of today (00:00)." + (float-time (apply 'encode-time + (append '(0 0 0) (nthcdr 3 (decode-time)))))) + +(defun org-matcher-time (s) + "Interpret a time comparison value." + (save-match-data + (cond + ((string= s "<now>") (float-time)) + ((string= s "<today>") (org-time-today)) + ((string= s "<tomorrow>") (+ 86400.0 (org-time-today))) + ((string= s "<yesterday>") (- (org-time-today) 86400.0)) + ((string-match "^<\\([-+][0-9]+\\)\\([hdwmy]\\)>$" s) + (+ (org-time-today) + (* (string-to-number (match-string 1 s)) + (cdr (assoc (match-string 2 s) + '(("d" . 86400.0) ("w" . 604800.0) + ("m" . 2678400.0) ("y" . 31557600.0))))))) + (t (org-2ft s))))) + +(defun org-match-any-p (re list) + "Does re match any element of list?" + (setq list (mapcar (lambda (x) (string-match re x)) list)) + (delq nil list)) + +(defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param +(defvar org-tags-overlay (make-overlay 1 1)) +(org-detach-overlay org-tags-overlay) + +(defun org-get-local-tags-at (&optional pos) + "Get a list of tags defined in the current headline." + (org-get-tags-at pos 'local)) + +(defun org-get-local-tags () + "Get a list of tags defined in the current headline." + (org-get-tags-at nil 'local)) + +(defun org-get-tags-at (&optional pos local) + "Get a list of all headline tags applicable at POS. +POS defaults to point. If tags are inherited, the list contains +the targets in the same sequence as the headlines appear, i.e. +the tags of the current headline come last. +When LOCAL is non-nil, only return tags from the current headline, +ignore inherited ones." + (interactive) + (if (and org-trust-scanner-tags + (or (not pos) (equal pos (point))) + (not local)) + org-scanner-tags + (let (tags ltags lastpos parent) + (save-excursion + (save-restriction + (widen) + (goto-char (or pos (point))) + (save-match-data + (catch 'done + (condition-case nil + (progn + (org-back-to-heading t) + (while (not (equal lastpos (point))) + (setq lastpos (point)) + (when (looking-at + (org-re "[^\r\n]+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")) + (setq ltags (org-split-string + (org-match-string-no-properties 1) ":")) + (when parent + (setq ltags (mapcar 'org-add-prop-inherited ltags))) + (setq tags (append + (if parent + (org-remove-uninherited-tags ltags) + ltags) + tags))) + (or org-use-tag-inheritance (throw 'done t)) + (if local (throw 'done t)) + (or (org-up-heading-safe) (error nil)) + (setq parent t))) + (error nil))))) + (if local + tags + (reverse (delete-dups + (reverse (append + (org-remove-uninherited-tags + org-file-tags) tags))))))))) + +(defun org-add-prop-inherited (s) + (add-text-properties 0 (length s) '(inherited t) s) + s) + +(defun org-toggle-tag (tag &optional onoff) + "Toggle the tag TAG for the current line. +If ONOFF is `on' or `off', don't toggle but set to this state." + (let (res current) + (save-excursion + (org-back-to-heading t) + (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$") + (point-at-eol) t) + (progn + (setq current (match-string 1)) + (replace-match "")) + (setq current "")) + (setq current (nreverse (org-split-string current ":"))) + (cond + ((eq onoff 'on) + (setq res t) + (or (member tag current) (push tag current))) + ((eq onoff 'off) + (or (not (member tag current)) (setq current (delete tag current)))) + (t (if (member tag current) + (setq current (delete tag current)) + (setq res t) + (push tag current)))) + (end-of-line 1) + (if current + (progn + (insert " :" (mapconcat 'identity (nreverse current) ":") ":") + (org-set-tags nil t)) + (delete-horizontal-space)) + (run-hooks 'org-after-tags-change-hook)) + res)) + +(defun org-align-tags-here (to-col) + ;; Assumes that this is a headline + "Align tags on the current headline to TO-COL." + (let ((pos (point)) (col (current-column)) ncol tags-l p) + (beginning-of-line 1) + (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) + (< pos (match-beginning 2))) + (progn + (setq tags-l (- (match-end 2) (match-beginning 2))) + (goto-char (match-beginning 1)) + (insert " ") + (delete-region (point) (1+ (match-beginning 2))) + (setq ncol (max (current-column) + (1+ col) + (if (> to-col 0) + to-col + (- (abs to-col) tags-l)))) + (setq p (point)) + (insert (make-string (- ncol (current-column)) ?\ )) + (setq ncol (current-column)) + (when indent-tabs-mode (tabify p (point-at-eol))) + (org-move-to-column (min ncol col))) + (goto-char pos)))) + +(defun org-set-tags-command (&optional arg just-align) + "Call the set-tags command for the current entry." + (interactive "P") + (if (or (org-at-heading-p) (and arg (org-before-first-heading-p))) + (org-set-tags arg just-align) + (save-excursion + (unless (and (org-region-active-p) + org-loop-over-headlines-in-active-region) + (org-back-to-heading t)) + (org-set-tags arg just-align)))) + +(defun org-set-tags-to (data) + "Set the tags of the current entry to DATA, replacing the current tags. +DATA may be a tags string like :aa:bb:cc:, or a list of tags. +If DATA is nil or the empty string, any tags will be removed." + (interactive "sTags: ") + (setq data + (cond + ((eq data nil) "") + ((equal data "") "") + ((stringp data) + (concat ":" (mapconcat 'identity (org-split-string data ":+") ":") + ":")) + ((listp data) + (concat ":" (mapconcat 'identity data ":") ":")))) + (when data + (save-excursion + (org-back-to-heading t) + (when (looking-at org-complex-heading-regexp) + (if (match-end 5) + (progn + (goto-char (match-beginning 5)) + (insert data) + (delete-region (point) (point-at-eol)) + (org-set-tags nil 'align)) + (goto-char (point-at-eol)) + (insert " " data) + (org-set-tags nil 'align))) + (beginning-of-line 1) + (if (looking-at ".*?\\([ \t]+\\)$") + (delete-region (match-beginning 1) (match-end 1)))))) + +(defun org-align-all-tags () + "Align the tags i all headings." + (interactive) + (save-excursion + (or (ignore-errors (org-back-to-heading t)) + (outline-next-heading)) + (if (org-at-heading-p) + (org-set-tags t) + (message "No headings")))) + +(defvar org-indent-indentation-per-level) +(defun org-set-tags (&optional arg just-align) + "Set the tags for the current headline. +With prefix ARG, realign all tags in headings in the current buffer. +When JUST-ALIGN is non-nil, only align tags." + (interactive "P") + (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) + (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) + 'region-start-level 'region)) + org-loop-over-headlines-in-active-region) + (org-map-entries + ;; We don't use ARG and JUST-ALIGN here because these args + ;; are not useful when looping over headlines. + `(org-set-tags) + org-loop-over-headlines-in-active-region + cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) + (let* ((re org-outline-regexp-bol) + (current (unless arg (org-get-tags-string))) + (col (current-column)) + (org-setting-tags t) + table current-tags inherited-tags ; computed below when needed + tags p0 c0 c1 rpl di tc level) + (if arg + (save-excursion + (goto-char (point-min)) + (let ((buffer-invisibility-spec (org-inhibit-invisibility))) + (while (re-search-forward re nil t) + (org-set-tags nil t) + (end-of-line 1))) + (message "All tags realigned to column %d" org-tags-column)) + (if just-align + (setq tags current) + ;; Get a new set of tags from the user + (save-excursion + (setq table (append org-tag-persistent-alist + (or org-tag-alist (org-get-buffer-tags)) + (and + org-complete-tags-always-offer-all-agenda-tags + (org-global-tags-completion-table + (org-agenda-files)))) + org-last-tags-completion-table table + current-tags (org-split-string current ":") + inherited-tags (nreverse + (nthcdr (length current-tags) + (nreverse (org-get-tags-at)))) + tags + (if (or (eq t org-use-fast-tag-selection) + (and org-use-fast-tag-selection + (delq nil (mapcar 'cdr table)))) + (org-fast-tag-selection + current-tags inherited-tags table + (if org-fast-tag-selection-include-todo + org-todo-key-alist)) + (let ((org-add-colon-after-tag-completion (< 1 (length table)))) + (org-trim + (org-icompleting-read "Tags: " + 'org-tags-completion-function + nil nil current 'org-tags-history)))))) + (while (string-match "[-+&]+" tags) + ;; No boolean logic, just a list + (setq tags (replace-match ":" t t tags)))) + + (setq tags (replace-regexp-in-string "[,]" ":" tags)) + + (if org-tags-sort-function + (setq tags (mapconcat 'identity + (sort (org-split-string + tags (org-re "[^[:alnum:]_@#%]+")) + org-tags-sort-function) ":"))) + + (if (string-match "\\`[\t ]*\\'" tags) + (setq tags "") + (unless (string-match ":$" tags) (setq tags (concat tags ":"))) + (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) + + ;; Insert new tags at the correct column + (beginning-of-line 1) + (setq level (or (and (looking-at org-outline-regexp) + (- (match-end 0) (point) 1)) + 1)) + (cond + ((and (equal current "") (equal tags ""))) + ((re-search-forward + (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") + (point-at-eol) t) + (if (equal tags "") + (setq rpl "") + (goto-char (match-beginning 0)) + (setq c0 (current-column) + ;; compute offset for the case of org-indent-mode active + di (if (org-bound-and-true-p org-indent-mode) + (* (1- org-indent-indentation-per-level) (1- level)) + 0) + p0 (if (equal (char-before) ?*) (1+ (point)) (point)) + tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)) + c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags)))) + rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) + (replace-match rpl t t) + (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point))) + tags) + (t (error "Tags alignment failed"))) + (org-move-to-column col) + (unless just-align + (run-hooks 'org-after-tags-change-hook)))))) + +(defun org-change-tag-in-region (beg end tag off) + "Add or remove TAG for each entry in the region. +This works in the agenda, and also in an org-mode buffer." + (interactive + (list (region-beginning) (region-end) + (let ((org-last-tags-completion-table + (if (derived-mode-p 'org-mode) + (org-uniquify + (delq nil (append (org-get-buffer-tags) + (org-global-tags-completion-table)))) + (org-global-tags-completion-table)))) + (org-icompleting-read + "Tag: " 'org-tags-completion-function nil nil nil + 'org-tags-history)) + (progn + (message "[s]et or [r]emove? ") + (equal (read-char-exclusive) ?r)))) + (if (fboundp 'deactivate-mark) (deactivate-mark)) + (let ((agendap (equal major-mode 'org-agenda-mode)) + l1 l2 m buf pos newhead (cnt 0)) + (goto-char end) + (setq l2 (1- (org-current-line))) + (goto-char beg) + (setq l1 (org-current-line)) + (loop for l from l1 to l2 do + (org-goto-line l) + (setq m (get-text-property (point) 'org-hd-marker)) + (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p)) + (and agendap m)) + (setq buf (if agendap (marker-buffer m) (current-buffer)) + pos (if agendap m (point))) + (with-current-buffer buf + (save-excursion + (save-restriction + (goto-char pos) + (setq cnt (1+ cnt)) + (org-toggle-tag tag (if off 'off 'on)) + (setq newhead (org-get-heading))))) + (and agendap (org-agenda-change-all-lines newhead m)))) + (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt))) + +(defun org-tags-completion-function (string predicate &optional flag) + (let (s1 s2 rtn (ctable org-last-tags-completion-table) + (confirm (lambda (x) (stringp (car x))))) + (if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string) + (setq s1 (match-string 1 string) + s2 (match-string 2 string)) + (setq s1 "" s2 string)) + (cond + ((eq flag nil) + ;; try completion + (setq rtn (try-completion s2 ctable confirm)) + (if (stringp rtn) + (setq rtn + (concat s1 s2 (substring rtn (length s2)) + (if (and org-add-colon-after-tag-completion + (assoc rtn ctable)) + ":" "")))) + rtn) + ((eq flag t) + ;; all-completions + (all-completions s2 ctable confirm)) + ((eq flag 'lambda) + ;; exact match? + (assoc s2 ctable))))) + +(defun org-fast-tag-insert (kwd tags face &optional end) + "Insert KDW, and the TAGS, the latter with face FACE. +Also insert END." + (insert (format "%-12s" (concat kwd ":")) + (org-add-props (mapconcat 'identity tags " ") nil 'face face) + (or end ""))) + +(defun org-fast-tag-show-exit (flag) + (save-excursion + (org-goto-line 3) + (if (re-search-forward "[ \t]+Next change exits" (point-at-eol) t) + (replace-match "")) + (when flag + (end-of-line 1) + (org-move-to-column (- (window-width) 19) t) + (insert (org-add-props " Next change exits" nil 'face 'org-warning))))) + +(defun org-set-current-tags-overlay (current prefix) + "Add an overlay to CURRENT tag with PREFIX." + (let ((s (concat ":" (mapconcat 'identity current ":") ":"))) + (if (featurep 'xemacs) + (org-overlay-display org-tags-overlay (concat prefix s) + 'secondary-selection) + (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s) + (org-overlay-display org-tags-overlay (concat prefix s))))) + +(defvar org-last-tag-selection-key nil) +(defun org-fast-tag-selection (current inherited table &optional todo-table) + "Fast tag selection with single keys. +CURRENT is the current list of tags in the headline, INHERITED is the +list of inherited tags, and 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 tags string, or nil to not change the current settings." + (let* ((fulltable (append table todo-table)) + (maxlen (apply 'max (mapcar + (lambda (x) + (if (stringp (car x)) (string-width (car x)) 0)) + fulltable))) + (buf (current-buffer)) + (expert (eq org-fast-tag-selection-single-key 'expert)) + (buffer-tags nil) + (fwidth (+ maxlen 3 1 3)) + (ncol (/ (- (window-width) 4) fwidth)) + (i-face 'org-done) + (c-face 'org-todo) + tg cnt e c char c1 c2 ntable tbl rtn + ov-start ov-end ov-prefix + (exit-after-next org-fast-tag-selection-single-key) + (done-keywords org-done-keywords) + groups ingroup) + (save-excursion + (beginning-of-line 1) + (if (looking-at + (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) + (setq ov-start (match-beginning 1) + ov-end (match-end 1) + ov-prefix "") + (setq ov-start (1- (point-at-eol)) + ov-end (1+ ov-start)) + (skip-chars-forward "^\n\r") + (setq ov-prefix + (concat + (buffer-substring (1- (point)) (point)) + (if (> (current-column) org-tags-column) + " " + (make-string (- org-tags-column (current-column)) ?\ )))))) + (move-overlay org-tags-overlay ov-start ov-end) + (save-window-excursion + (if expert + (set-buffer (get-buffer-create " *Org tags*")) + (delete-other-windows) + (set-window-buffer (split-window-vertically) (get-buffer-create " *Org tags*")) + (org-switch-to-buffer-other-window " *Org tags*")) + (erase-buffer) + (org-set-local 'org-done-keywords done-keywords) + (org-fast-tag-insert "Inherited" inherited i-face "\n") + (org-fast-tag-insert "Current" current c-face "\n\n") + (org-fast-tag-show-exit exit-after-next) + (org-set-current-tags-overlay current ov-prefix) + (setq tbl fulltable char ?a cnt 0) + (while (setq e (pop tbl)) + (cond + ((equal (car e) :startgroup) + (push '() groups) (setq ingroup t) + (when (not (= cnt 0)) + (setq cnt 0) + (insert "\n")) + (insert (if (cdr e) (format "%s: " (cdr e)) "") "{ ")) + ((equal (car e) :endgroup) + (setq ingroup nil cnt 0) + (insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n")) + ((equal e '(:newline)) + (when (not (= cnt 0)) + (setq cnt 0) + (insert "\n") + (setq e (car tbl)) + (while (equal (car tbl) '(:newline)) + (insert "\n") + (setq tbl (cdr tbl))))) + ((equal e '(:grouptags)) nil) + (t + (setq tg (copy-sequence (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)) + ((member tg current) c-face) + ((member tg inherited) i-face)))) + (if (equal (caar tbl) :grouptags) + (org-add-props tg nil 'face 'org-tag-group)) + (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 (not expert) (org-fit-window-to-buffer)) + (setq rtn + (catch 'exit + (while t + (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s" + (if (not groups) "no " "") + (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) + (setq c (let ((inhibit-quit t)) (read-char-exclusive))) + (setq org-last-tag-selection-key c) + (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) + (set-window-buffer (split-window-vertically) " *Org tags*") + (org-switch-to-buffer-other-window " *Org tags*") + (org-fit-window-to-buffer))) + ((or (= c ?\C-g) + (and (= c ?q) (not (rassoc c ntable)))) + (org-detach-overlay org-tags-overlay) + (setq quit-flag t)) + ((= c ?\ ) + (setq current nil) + (if exit-after-next (setq exit-after-next 'now))) + ((= c ?\t) + (condition-case nil + (setq tg (org-icompleting-read + "Tag: " + (or buffer-tags + (with-current-buffer buf + (org-get-buffer-tags))))) + (quit (setq tg ""))) + (when (string-match "\\S-" tg) + (add-to-list 'buffer-tags (list tg)) + (if (member tg current) + (setq current (delete tg current)) + (push tg current))) + (if exit-after-next (setq exit-after-next 'now))) + ((setq e (rassoc c todo-table) tg (car e)) + (with-current-buffer buf + (save-excursion (org-todo tg))) + (if exit-after-next (setq exit-after-next 'now))) + ((setq e (rassoc c ntable) tg (car e)) + (if (member tg current) + (setq current (delete tg current)) + (loop for g in groups do + (if (member tg g) + (mapc (lambda (x) + (setq current (delete x current))) + g))) + (push tg current)) + (if exit-after-next (setq exit-after-next 'now)))) + + ;; Create a sorted list + (setq current + (sort current + (lambda (a b) + (assoc b (cdr (memq (assoc a ntable) ntable)))))) + (if (eq exit-after-next 'now) (throw 'exit t)) + (goto-char (point-min)) + (beginning-of-line 2) + (delete-region (point) (point-at-eol)) + (org-fast-tag-insert "Current" current c-face) + (org-set-current-tags-overlay current ov-prefix) + (while (re-search-forward + (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t) + (setq tg (match-string 1)) + (add-text-properties + (match-beginning 1) (match-end 1) + (list 'face + (cond + ((member tg current) c-face) + ((member tg inherited) i-face) + (t (get-text-property (match-beginning 1) 'face)))))) + (goto-char (point-min))))) + (org-detach-overlay org-tags-overlay) + (if rtn + (mapconcat 'identity current ":") + nil)))) + +(defun org-get-tags-string () + "Get the TAGS string in the current headline." + (unless (org-at-heading-p t) + (user-error "Not on a heading")) + (save-excursion + (beginning-of-line 1) + (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) + (org-match-string-no-properties 1) + ""))) + +(defun org-get-tags () + "Get the list of tags specified in the current headline." + (org-split-string (org-get-tags-string) ":")) + +(defun org-get-buffer-tags () + "Get a table of all tags used in the buffer, for completion." + (let (tags) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward + (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t\r\n]") nil t) + (when (equal (char-after (point-at-bol 0)) ?*) + (mapc (lambda (x) (add-to-list 'tags x)) + (org-split-string (org-match-string-no-properties 1) ":"))))) + (mapc (lambda (s) (add-to-list 'tags s)) org-file-tags) + (mapcar 'list tags))) + +;;;; The mapping API + +(defun org-map-entries (func &optional match scope &rest skip) + "Call FUNC at each headline selected by MATCH in SCOPE. + +FUNC is a function or a lisp form. The function will be called without +arguments, with the cursor positioned at the beginning of the headline. +The return values of all calls to the function will be collected and +returned as a list. + +The call to FUNC will be wrapped into a save-excursion form, so FUNC +does not need to preserve point. After evaluation, the cursor will be +moved to the end of the line (presumably of the headline of the +processed entry) and search continues from there. Under some +circumstances, this may not produce the wanted results. For example, +if you have removed (e.g. archived) the current (sub)tree it could +mean that the next entry will be skipped entirely. In such cases, you +can specify the position from where search should continue by making +FUNC set the variable `org-map-continue-from' to the desired buffer +position. + +MATCH is a tags/property/todo match as it is used in the agenda tags view. +Only headlines that are matched by this query will be considered during +the iteration. When MATCH is nil or t, all headlines will be +visited by the iteration. + +SCOPE determines the scope of this command. It can be any of: + +nil The current buffer, respecting the restriction if any +tree The subtree started with the entry at point +region The entries within the active region, if any +region-start-level + The entries within the active region, but only those at + the same level than the first one. +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 + +The remaining args are treated as settings for the skipping facilities of +the scanner. The following items can be given here: + + archive skip trees with the archive tag + comment skip trees with the COMMENT keyword + function or Emacs Lisp form: + will be used as value for `org-agenda-skip-function', so + whenever the function returns a position, FUNC will not be + called for that entry and search will continue from the + position returned + +If your function needs to retrieve the tags including inherited tags +at the *current* entry, you can use the value of the variable +`org-scanner-tags' which will be much faster than getting the value +with `org-get-tags-at'. If your function gets properties with +`org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags' +to t around the call to `org-entry-properties' to get the same speedup. +Note that if your function moves around to retrieve tags and properties at +a *different* entry, you cannot use these techniques." + (unless (and (or (eq scope 'region) (eq scope 'region-start-level)) + (not (org-region-active-p))) + (let* ((org-agenda-archives-mode nil) ; just to make sure + (org-agenda-skip-archived-trees (memq 'archive skip)) + (org-agenda-skip-comment-trees (memq 'comment skip)) + (org-agenda-skip-function + (car (org-delete-all '(comment archive) skip))) + (org-tags-match-list-sublevels t) + (start-level (eq scope 'region-start-level)) + matcher file res + org-todo-keywords-for-agenda + org-done-keywords-for-agenda + org-todo-keyword-alist-for-agenda + org-drawers-for-agenda + org-tag-alist-for-agenda + todo-only) + + (cond + ((eq match t) (setq matcher t)) + ((eq match nil) (setq matcher t)) + (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t)))) + + (save-excursion + (save-restriction + (cond ((eq scope 'tree) + (org-back-to-heading t) + (org-narrow-to-subtree) + (setq scope nil)) + ((and (or (eq scope 'region) (eq scope 'region-start-level)) + (org-region-active-p)) + ;; If needed, set start-level to a string like "2" + (when start-level + (save-excursion + (goto-char (region-beginning)) + (unless (org-at-heading-p) (outline-next-heading)) + (setq start-level (org-current-level)))) + (narrow-to-region (region-beginning) + (save-excursion + (goto-char (region-end)) + (unless (and (bolp) (org-at-heading-p)) + (outline-next-heading)) + (point))) + (setq scope nil))) + + (if (not scope) + (progn + (org-agenda-prepare-buffers + (list (buffer-file-name (current-buffer)))) + (setq res (org-scan-tags func matcher todo-only start-level))) + ;; Get the right scope + (cond + ((and scope (listp scope) (symbolp (car scope))) + (setq scope (eval scope))) + ((eq scope 'agenda) + (setq scope (org-agenda-files t))) + ((eq scope 'agenda-with-archives) + (setq scope (org-agenda-files t)) + (setq scope (org-add-archive-files scope))) + ((eq scope 'file) + (setq scope (list (buffer-file-name)))) + ((eq scope 'file-with-archives) + (setq scope (org-add-archive-files (list (buffer-file-name)))))) + (org-agenda-prepare-buffers scope) + (while (setq file (pop scope)) + (with-current-buffer (org-find-base-buffer-visiting file) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (setq res (append res (org-scan-tags func matcher todo-only)))))))))) + res))) + +;;;; Properties + +;;; Setting and retrieving properties + +(defconst org-special-properties + '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY" + "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM" "CLOCKSUM_T") + "The special properties valid in Org-mode. + +These are properties that are not defined in the property drawer, +but in some other way.") + +(defconst org-default-properties + '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID" + "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY" + "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE" + "EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME" + "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" + "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE" + "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS") + "Some properties that are used by Org-mode for various purposes. +Being in this list makes sure that they are offered for completion.") + +(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$" + "Regular expression matching the first line of a property drawer.") + +(defconst org-property-end-re "^[ \t]*:END:[ \t]*$" + "Regular expression matching the last line of a property drawer.") + +(defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$" + "Regular expression matching the first line of a property drawer.") + +(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$" + "Regular expression matching the first line of a property drawer.") + +(defconst org-property-drawer-re + (concat "\\(" org-property-start-re "\\)[^\000]*\\(" + org-property-end-re "\\)\n?") + "Matches an entire property drawer.") + +(defconst org-clock-drawer-re + (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*\\(" + org-property-end-re "\\)\n?") + "Matches an entire clock drawer.") + +(defun org-property-action () + "Do an action on properties." + (interactive) + (let (c) + (org-at-property-p) + (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute") + (setq c (read-char-exclusive)) + (cond + ((equal c ?s) + (call-interactively 'org-set-property)) + ((equal c ?d) + (call-interactively 'org-delete-property)) + ((equal c ?D) + (call-interactively 'org-delete-property-globally)) + ((equal c ?c) + (call-interactively 'org-compute-property-at-point)) + (t (user-error "No such property action %c" c))))) + +(defun org-inc-effort () + "Increment the value of the effort property in the current entry." + (interactive) + (org-set-effort nil t)) + +(defvar org-clock-effort) ;; Defined in org-clock.el +(defvar org-clock-current-task) ;; Defined in org-clock.el +(defun org-set-effort (&optional value increment) + "Set the effort property of the current entry. +With numerical prefix arg, use the nth allowed value, 0 stands for the +10th allowed value. + +When INCREMENT is non-nil, set the property to the next allowed value." + (interactive "P") + (if (equal value 0) (setq value 10)) + (let* ((completion-ignore-case t) + (prop org-effort-property) + (cur (org-entry-get nil prop)) + (allowed (org-property-get-allowed-values nil prop 'table)) + (existing (mapcar 'list (org-property-values prop))) + (heading (nth 4 (org-heading-components))) + rpl + (val (cond + ((stringp value) value) + ((and allowed (integerp value)) + (or (car (nth (1- value) allowed)) + (car (org-last allowed)))) + ((and allowed increment) + (or (caadr (member (list cur) allowed)) + (user-error "Allowed effort values are not set"))) + (allowed + (message "Select 1-9,0, [RET%s]: %s" + (if cur (concat "=" cur) "") + (mapconcat 'car allowed " ")) + (setq rpl (read-char-exclusive)) + (if (equal rpl ?\r) + cur + (setq rpl (- rpl ?0)) + (if (equal rpl 0) (setq rpl 10)) + (if (and (> rpl 0) (<= rpl (length allowed))) + (car (nth (1- rpl) allowed)) + (org-completing-read "Effort: " allowed nil)))) + (t + (let (org-completion-use-ido org-completion-use-iswitchb) + (org-completing-read + (concat "Effort " (if (and cur (string-match "\\S-" cur)) + (concat "[" cur "]") "") + ": ") + existing nil nil "" nil cur)))))) + (unless (equal (org-entry-get nil prop) val) + (org-entry-put nil prop val)) + (save-excursion + (org-back-to-heading t) + (put-text-property (point-at-bol) (point-at-eol) 'org-effort val)) + (when (string= heading org-clock-current-task) + (setq org-clock-effort (get-text-property (point-at-bol) 'org-effort)) + (org-clock-update-mode-line)) + (message "%s is now %s" prop val))) + +(defun org-at-property-p () + "Is cursor inside a property drawer?" + (save-excursion + (when (equal 'node-property (car (org-element-at-point))) + (beginning-of-line 1) + (looking-at org-property-re)))) + +(defun org-get-property-block (&optional beg end force) + "Return the (beg . end) range of the body of the property drawer. +BEG and END are the beginning and end of the current subtree, or of +the part before the first headline. If they are not given, they will +be found. If the drawer does not exist and FORCE is non-nil, create +the drawer." + (catch 'exit + (save-excursion + (let* ((beg (or beg (and (org-before-first-heading-p) (point-min)) + (progn (org-back-to-heading t) (point)))) + (end (or end (and (not (outline-next-heading)) (point-max)) + (point)))) + (goto-char beg) + (if (re-search-forward org-property-start-re end t) + (setq beg (1+ (match-end 0))) + (if force + (save-excursion + (org-insert-property-drawer) + (setq end (progn (outline-next-heading) (point)))) + (throw 'exit nil)) + (goto-char beg) + (if (re-search-forward org-property-start-re end t) + (setq beg (1+ (match-end 0))))) + (if (re-search-forward org-property-end-re end t) + (setq end (match-beginning 0)) + (or force (throw 'exit nil)) + (goto-char beg) + (setq end beg) + (org-indent-line) + (insert ":END:\n")) + (cons beg end))))) + +(defun org-entry-properties (&optional pom which specific) + "Get all properties of the entry at point-or-marker POM. +This includes the TODO keyword, the tags, time strings for deadline, +scheduled, and clocking, and any additional properties defined in the +entry. The return value is an alist, keys may occur multiple times +if the property key was used several times. +POM may also be nil, in which case the current entry is used. +If WHICH is nil or `all', get all properties. If WHICH is +`special' or `standard', only get that subclass. If WHICH +is a string only get exactly this property. SPECIFIC can be a string, the +specific property we are interested in. Specifying it can speed +things up because then unnecessary parsing is avoided." + (setq which (or which 'all)) + (org-with-wide-buffer + (org-with-point-at pom + (let ((clockstr (substring org-clock-string 0 -1)) + (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED")) + (case-fold-search nil) + beg end range props sum-props key key1 value string clocksum clocksumt) + (when (and (derived-mode-p 'org-mode) + (ignore-errors (org-back-to-heading t))) + (setq beg (point)) + (setq sum-props (get-text-property (point) 'org-summaries)) + (setq clocksum (get-text-property (point) :org-clock-minutes) + clocksumt (get-text-property (point) :org-clock-minutes-today)) + (outline-next-heading) + (setq end (point)) + (when (memq which '(all special)) + ;; Get the special properties, like TODO and tags + (goto-char beg) + (when (and (or (not specific) (string= specific "TODO")) + (looking-at org-todo-line-regexp) (match-end 2)) + (push (cons "TODO" (org-match-string-no-properties 2)) props)) + (when (and (or (not specific) (string= specific "PRIORITY")) + (looking-at org-priority-regexp)) + (push (cons "PRIORITY" (org-match-string-no-properties 2)) props)) + (when (or (not specific) (string= specific "FILE")) + (push (cons "FILE" buffer-file-name) props)) + (when (and (or (not specific) (string= specific "TAGS")) + (setq value (org-get-tags-string)) + (string-match "\\S-" value)) + (push (cons "TAGS" value) props)) + (when (and (or (not specific) (string= specific "ALLTAGS")) + (setq value (org-get-tags-at))) + (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") + ":")) + props)) + (when (or (not specific) (string= specific "BLOCKED")) + (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)) + (when (or (not specific) + (member specific + '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED" + "TIMESTAMP" "TIMESTAMP_IA"))) + (catch 'match + (while (and (re-search-forward org-maybe-keyword-time-regexp end t) + (not (text-property-any 0 (length (match-string 0)) + 'face 'font-lock-comment-face + (match-string 0)))) + (setq key (if (match-end 1) + (substring (org-match-string-no-properties 1) + 0 -1)) + string (if (equal key clockstr) + (org-trim + (buffer-substring-no-properties + (match-beginning 3) (goto-char + (point-at-eol)))) + (substring (org-match-string-no-properties 3) + 1 -1))) + ;; Get the correct property name from the key. This is + ;; necessary if the user has configured time keywords. + (setq key1 (concat key ":")) + (cond + ((not key) + (setq key + (if (= (char-after (match-beginning 3)) ?\[) + "TIMESTAMP_IA" "TIMESTAMP"))) + ((equal key1 org-scheduled-string) (setq key "SCHEDULED")) + ((equal key1 org-deadline-string) (setq key "DEADLINE")) + ((equal key1 org-closed-string) (setq key "CLOSED")) + ((equal key1 org-clock-string) (setq key "CLOCK"))) + (if (and specific (equal key specific) (not (equal key "CLOCK"))) + (progn + (push (cons key string) props) + ;; no need to search further if match is found + (throw 'match t)) + (when (or (equal key "CLOCK") (not (assoc key props))) + (push (cons key string) props))))))) + + (when (memq which '(all standard)) + ;; Get the standard properties, like :PROP: ... + (setq range (org-get-property-block beg end)) + (when range + (goto-char (car range)) + (while (re-search-forward org-property-re + (cdr range) t) + (setq key (org-match-string-no-properties 2) + value (org-trim (or (org-match-string-no-properties 3) ""))) + (unless (member key excluded) + (push (cons key (or value "")) props))))) + (if clocksum + (push (cons "CLOCKSUM" + (org-columns-number-to-string (/ (float clocksum) 60.) + 'add_times)) + props)) + (if clocksumt + (push (cons "CLOCKSUM_T" + (org-columns-number-to-string (/ (float clocksumt) 60.) + 'add_times)) + props)) + (unless (assoc "CATEGORY" props) + (push (cons "CATEGORY" (org-get-category)) props)) + (append sum-props (nreverse props))))))) + +(defun org-entry-get (pom property &optional inherit literal-nil) + "Get value of PROPERTY for entry or content at point-or-marker POM. +If INHERIT is non-nil and the entry does not have the property, +then also check higher levels of the hierarchy. +If INHERIT is the symbol `selective', use inheritance only if the setting +in `org-use-property-inheritance' selects PROPERTY for inheritance. +If the property is present but empty, the return value is the empty string. +If the property is not present at all, nil is returned. + +Return the value as a string. + +If LITERAL-NIL is set, return the string value \"nil\" as a string, +do not interpret it as the list atom nil. This is used for inheritance +when a \"nil\" value can supersede a non-nil value higher up the hierarchy." + (org-with-point-at pom + (if (and inherit (if (eq inherit 'selective) + (org-property-inherit-p property) + t)) + (org-entry-get-with-inheritance property literal-nil) + (if (member property org-special-properties) + ;; We need a special property. Use `org-entry-properties' + ;; to retrieve it, but specify the wanted property + (cdr (assoc property (org-entry-properties nil 'special property))) + (org-with-wide-buffer + (let ((range (org-get-property-block))) + (when (and range (not (eq (car range) (cdr range))) + (save-excursion + (goto-char (car range)) + (re-search-forward + (concat (org-re-property property) "\\|" + (org-re-property (concat property "+"))) + (cdr range) t))) + (let* ((props + (list (or (assoc property org-file-properties) + (assoc property org-global-properties) + (assoc property org-global-properties-fixed)))) + (ap (lambda (key) + (when (re-search-forward + (org-re-property key) (cdr range) t) + (setq props + (org-update-property-plist + key + (if (match-end 3) + (org-match-string-no-properties 3) "") + props))))) + val) + (goto-char (car range)) + (funcall ap property) + (goto-char (car range)) + (while (funcall ap (concat property "+"))) + (setq val (cdr (assoc property props))) + (when val (if literal-nil val (org-not-nil val))))))))))) + +(defun org-property-or-variable-value (var &optional inherit) + "Check if there is a property fixing the value of VAR. +If yes, return this value. If not, return the current value of the variable." + (let ((prop (org-entry-get nil (symbol-name var) inherit))) + (if (and prop (stringp prop) (string-match "\\S-" prop)) + (read prop) + (symbol-value var)))) + +(defun org-entry-delete (pom property &optional delete-empty-drawer) + "Delete the property PROPERTY from entry at point-or-marker POM. +When optional argument DELETE-EMPTY-DRAWER is a string, it defines +an empty drawer to delete." + (org-with-point-at pom + (if (member property org-special-properties) + nil ; cannot delete these properties. + (let ((range (org-get-property-block))) + (if (and range + (goto-char (car range)) + (re-search-forward + (org-re-property property nil t) + (cdr range) t)) + (progn + (delete-region (match-beginning 0) (1+ (point-at-eol))) + (and delete-empty-drawer + (org-remove-empty-drawer-at + delete-empty-drawer (car range))) + t) + nil))))) + +;; Multi-values properties are properties that contain multiple values +;; These values are assumed to be single words, separated by whitespace. +(defun org-entry-add-to-multivalued-property (pom property value) + "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM." + (let* ((old (org-entry-get pom property)) + (values (and old (org-split-string old "[ \t]")))) + (setq value (org-entry-protect-space value)) + (unless (member value values) + (setq values (append values (list value))) + (org-entry-put pom property + (mapconcat 'identity values " "))))) + +(defun org-entry-remove-from-multivalued-property (pom property value) + "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM." + (let* ((old (org-entry-get pom property)) + (values (and old (org-split-string old "[ \t]")))) + (setq value (org-entry-protect-space value)) + (when (member value values) + (setq values (delete value values)) + (org-entry-put pom property + (mapconcat 'identity values " "))))) + +(defun org-entry-member-in-multivalued-property (pom property value) + "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?" + (let* ((old (org-entry-get pom property)) + (values (and old (org-split-string old "[ \t]")))) + (setq value (org-entry-protect-space value)) + (member value values))) + +(defun org-entry-get-multivalued-property (pom property) + "Return a list of values in a multivalued property." + (let* ((value (org-entry-get pom property)) + (values (and value (org-split-string value "[ \t]")))) + (mapcar 'org-entry-restore-space values))) + +(defun org-entry-put-multivalued-property (pom property &rest values) + "Set multivalued PROPERTY at point-or-marker POM to VALUES. +VALUES should be a list of strings. Spaces will be protected." + (org-entry-put pom property + (mapconcat 'org-entry-protect-space values " ")) + (let* ((value (org-entry-get pom property)) + (values (and value (org-split-string value "[ \t]")))) + (mapcar 'org-entry-restore-space values))) + +(defun org-entry-protect-space (s) + "Protect spaces and newline in string S." + (while (string-match " " s) + (setq s (replace-match "%20" t t s))) + (while (string-match "\n" s) + (setq s (replace-match "%0A" t t s))) + s) + +(defun org-entry-restore-space (s) + "Restore spaces and newline in string S." + (while (string-match "%20" s) + (setq s (replace-match " " t t s))) + (while (string-match "%0A" s) + (setq s (replace-match "\n" t t s))) + s) + +(defvar org-entry-property-inherited-from (make-marker) + "Marker pointing to the entry from where a property was inherited. +Each call to `org-entry-get-with-inheritance' will set this marker to the +location of the entry where the inheritance search matched. If there was +no match, the marker will point nowhere. +Note that also `org-entry-get' calls this function, if the INHERIT flag +is set.") + +(defun org-entry-get-with-inheritance (property &optional literal-nil) + "Get PROPERTY of entry or content at point, search higher levels if needed. +The search will stop at the first ancestor which has the property defined. +If the value found is \"nil\", return nil to show that the property +should be considered as undefined (this is the meaning of nil here). +However, if LITERAL-NIL is set, return the string value \"nil\" instead." + (move-marker org-entry-property-inherited-from nil) + (let (tmp) + (save-excursion + (save-restriction + (widen) + (catch 'ex + (while t + (when (setq tmp (org-entry-get nil property nil literal-nil)) + (or (ignore-errors (org-back-to-heading t)) + (goto-char (point-min))) + (move-marker org-entry-property-inherited-from (point)) + (throw 'ex tmp)) + (or (ignore-errors (org-up-heading-safe)) + (throw 'ex nil)))))) + (setq tmp (or tmp + (cdr (assoc property org-file-properties)) + (cdr (assoc property org-global-properties)) + (cdr (assoc property org-global-properties-fixed)))) + (if literal-nil tmp (org-not-nil tmp)))) + +(defvar org-property-changed-functions nil + "Hook called when the value of a property has changed. +Each hook function should accept two arguments, the name of the property +and the new value.") + +(defun org-entry-put (pom property value) + "Set PROPERTY to VALUE for entry at point-or-marker POM. +If the value is `nil', it is converted to the empty string. +If it is not a string, an error is raised." + (cond ((null value) (setq value "")) + ((not (stringp value)) + (error "Properties values should be strings."))) + (org-with-point-at pom + (org-back-to-heading t) + (let ((beg (point)) (end (save-excursion (outline-next-heading) (point))) + range) + (cond + ((equal property "TODO") + (when (and (string-match "\\S-" value) + (not (member value org-todo-keywords-1))) + (user-error "\"%s\" is not a valid TODO state" value)) + (if (or (not value) + (not (string-match "\\S-" value))) + (setq value 'none)) + (org-todo value) + (org-set-tags nil 'align)) + ((equal property "PRIORITY") + (org-priority (if (and value (string-match "\\S-" value)) + (string-to-char value) ?\ )) + (org-set-tags nil 'align)) + ((equal property "CLOCKSUM") + (if (not (re-search-forward + (concat org-clock-string ".*\\]--\\(\\[[^]]+\\]\\)") nil t)) + (error "Cannot find a clock log") + (goto-char (- (match-end 1) 2)) + (cond + ((eq value 'earlier) (org-timestamp-down)) + ((eq value 'later) (org-timestamp-up))) + (org-clock-sum-current-item))) + ((equal property "SCHEDULED") + (if (re-search-forward org-scheduled-time-regexp end t) + (cond + ((eq value 'earlier) (org-timestamp-change -1 'day)) + ((eq value 'later) (org-timestamp-change 1 'day)) + (t (call-interactively 'org-schedule))) + (call-interactively 'org-schedule))) + ((equal property "DEADLINE") + (if (re-search-forward org-deadline-time-regexp end t) + (cond + ((eq value 'earlier) (org-timestamp-change -1 'day)) + ((eq value 'later) (org-timestamp-change 1 'day)) + (t (call-interactively 'org-deadline))) + (call-interactively 'org-deadline))) + ((member property org-special-properties) + (error "The %s property can not yet be set with `org-entry-put'" + property)) + (t ; a non-special property + (let ((buffer-invisibility-spec (org-inhibit-invisibility))) ; Emacs 21 + (setq range (org-get-property-block beg end 'force)) + (goto-char (car range)) + (if (re-search-forward + (org-re-property property nil t) (cdr range) t) + (progn + (delete-region (match-beginning 0) (match-end 0)) + (goto-char (match-beginning 0))) + (goto-char (cdr range)) + (insert "\n") + (backward-char 1) + (org-indent-line)) + (insert ":" property ":") + (and value (insert " " value)) + (org-indent-line))))) + (run-hook-with-args 'org-property-changed-functions property value))) + +(defun org-buffer-property-keys (&optional include-specials include-defaults include-columns) + "Get all property keys in the current buffer. +With INCLUDE-SPECIALS, also list the special properties that reflect things +like tags and TODO state. +With INCLUDE-DEFAULTS, also include properties that has special meaning +internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING +and others. +With INCLUDE-COLUMNS, also include property names given in COLUMN +formats in the current buffer." + (let (rtn range cfmt s p) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward org-property-start-re nil t) + (setq range (org-get-property-block)) + (goto-char (car range)) + (while (re-search-forward org-property-re + (cdr range) t) + (add-to-list 'rtn (org-match-string-no-properties 2))) + (outline-next-heading)))) + + (when include-specials + (setq rtn (append org-special-properties rtn))) + + (when include-defaults + (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties) + (add-to-list 'rtn org-effort-property)) + + (when include-columns + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward + "^\\(#\\+COLUMNS:\\|[ \t]*:COLUMNS:\\)[ \t]*\\(.*\\)" + nil t) + (setq cfmt (match-string 2) s 0) + (while (string-match (org-re "%[0-9]*\\([-[:alnum:]_]+\\)") + cfmt s) + (setq s (match-end 0) + p (match-string 1 cfmt)) + (unless (or (equal p "ITEM") + (member p org-special-properties)) + (add-to-list 'rtn (match-string 1 cfmt)))))))) + + (sort rtn (lambda (a b) (string< (upcase a) (upcase b)))))) + +(defun org-property-values (key) + "Return a list of all values of property KEY in the current buffer." + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let ((re (org-re-property key)) + values) + (while (re-search-forward re nil t) + (add-to-list 'values (org-trim (match-string 3)))) + (delete "" values))))) + +(defun org-insert-property-drawer () + "Insert a property drawer into the current entry." + (org-back-to-heading t) + (looking-at org-outline-regexp) + (let ((indent (if org-adapt-indentation + (- (match-end 0) (match-beginning 0)) + 0)) + (beg (point)) + (re (concat "^[ \t]*" org-keyword-time-regexp)) + end hiddenp) + (outline-next-heading) + (setq end (point)) + (goto-char beg) + (while (re-search-forward re end t)) + (setq hiddenp (outline-invisible-p)) + (end-of-line 1) + (and (equal (char-after) ?\n) (forward-char 1)) + (while (looking-at "^[ \t]*\\(:CLOCK:\\|:LOGBOOK:\\|CLOCK:\\|:END:\\)") + (if (member (match-string 1) '("CLOCK:" ":END:")) + ;; just skip this line + (beginning-of-line 2) + ;; Drawer start, find the end + (re-search-forward "^\\*+ \\|^[ \t]*:END:" nil t) + (beginning-of-line 1))) + (org-skip-over-state-notes) + (skip-chars-backward " \t\n\r") + (if (and (eq (char-before) ?*) (not (eq (char-after) ?\n))) + (forward-char 1)) + (goto-char (point-at-eol)) + (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:")) + (beginning-of-line 0) + (org-indent-to-column indent) + (beginning-of-line 2) + (org-indent-to-column indent) + (beginning-of-line 0) + (if hiddenp + (save-excursion + (org-back-to-heading t) + (hide-entry)) + (org-flag-drawer t)))) + +(defun org-insert-drawer (&optional arg drawer) + "Insert a drawer at point. + +Optional argument DRAWER, when non-nil, is a string representing +drawer's name. Otherwise, the user is prompted for a name. + +If a region is active, insert the drawer around that region +instead. + +Point is left between drawer's boundaries." + (interactive "P") + (let* ((logbook (if (stringp org-log-into-drawer) org-log-into-drawer + "LOGBOOK")) + ;; SYSTEM-DRAWERS is a list of drawer names that are used + ;; internally by Org. They are meant to be inserted + ;; automatically. + (system-drawers `("CLOCK" ,logbook "PROPERTIES")) + ;; Remove system drawers from list. Note: For some reason, + ;; `org-completing-read' ignores the predicate while + ;; `completing-read' handles it fine. + (drawer (if arg "PROPERTIES" + (or drawer + (completing-read + "Drawer: " org-drawers + (lambda (d) (not (member d system-drawers)))))))) + (cond + ;; With C-u, fall back on `org-insert-property-drawer' + (arg (org-insert-property-drawer)) + ;; With an active region, insert a drawer at point. + ((not (org-region-active-p)) + (progn + (unless (bolp) (insert "\n")) + (insert (format ":%s:\n\n:END:\n" drawer)) + (forward-line -2))) + ;; Otherwise, insert the drawer at point + (t + (let ((rbeg (region-beginning)) + (rend (copy-marker (region-end)))) + (unwind-protect + (progn + (goto-char rbeg) + (beginning-of-line) + (when (save-excursion + (re-search-forward org-outline-regexp-bol rend t)) + (user-error "Drawers cannot contain headlines")) + ;; Position point at the beginning of the first + ;; non-blank line in region. Insert drawer's opening + ;; there, then indent it. + (org-skip-whitespace) + (beginning-of-line) + (insert ":" drawer ":\n") + (forward-line -1) + (indent-for-tab-command) + ;; Move point to the beginning of the first blank line + ;; after the last non-blank line in region. Insert + ;; drawer's closing, then indent it. + (goto-char rend) + (skip-chars-backward " \r\t\n") + (insert "\n:END:") + (deactivate-mark t) + (indent-for-tab-command) + (unless (eolp) (insert "\n"))) + ;; Clear marker, whatever the outcome of insertion is. + (set-marker rend nil))))))) + +(defvar org-property-set-functions-alist nil + "Property set function alist. +Each entry should have the following format: + + (PROPERTY . READ-FUNCTION) + +The read function will be called with the same argument as +`org-completing-read'.") + +(defun org-set-property-function (property) + "Get the function that should be used to set PROPERTY. +This is computed according to `org-property-set-functions-alist'." + (or (cdr (assoc property org-property-set-functions-alist)) + 'org-completing-read)) + +(defun org-read-property-value (property) + "Read PROPERTY value from user." + (let* ((completion-ignore-case t) + (allowed (org-property-get-allowed-values nil property 'table)) + (cur (org-entry-get nil property)) + (prompt (concat property " value" + (if (and cur (string-match "\\S-" cur)) + (concat " [" cur "]") "") ": ")) + (set-function (org-set-property-function property)) + (val (if allowed + (funcall set-function prompt allowed nil + (not (get-text-property 0 'org-unrestricted + (caar allowed)))) + (let (org-completion-use-ido org-completion-use-iswitchb) + (funcall set-function prompt + (mapcar 'list (org-property-values property)) + nil nil "" nil cur))))) + (org-trim val))) + +(defvar org-last-set-property nil) +(defvar org-last-set-property-value nil) +(defun org-read-property-name () + "Read a property name." + (let* ((completion-ignore-case t) + (keys (org-buffer-property-keys nil t t)) + (default-prop (or (save-excursion + (save-match-data + (beginning-of-line) + (and (looking-at "^\\s-*:\\([^:\n]+\\):") + (null (string= (match-string 1) "END")) + (match-string 1)))) + org-last-set-property)) + (property (org-icompleting-read + (concat "Property" + (if default-prop (concat " [" default-prop "]") "") + ": ") + (mapcar 'list keys) + nil nil nil nil + default-prop))) + (if (member property keys) + property + (or (cdr (assoc (downcase property) + (mapcar (lambda (x) (cons (downcase x) x)) + keys))) + property)))) + +(defun org-set-property-and-value (use-last) + "Allow to set [PROPERTY]: [value] direction from prompt. +When use-default, don't even ask, just use the last +\"[PROPERTY]: [value]\" string from the history." + (interactive "P") + (let* ((completion-ignore-case t) + (pv (or (and use-last org-last-set-property-value) + (org-completing-read + "Enter a \"[Property]: [value]\" pair: " + nil nil nil nil nil + org-last-set-property-value))) + prop val) + (when (string-match "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*$" pv) + (setq prop (match-string 1 pv) + val (match-string 2 pv)) + (org-set-property prop val)))) + +(defun org-set-property (property value) + "In the current entry, set PROPERTY to VALUE. +When called interactively, this will prompt for a property name, offering +completion on existing and default properties. And then it will prompt +for a value, offering completion either on allowed values (via an inherited +xxx_ALL property) or on existing values in other instances of this property +in the current file." + (interactive (list nil nil)) + (let* ((property (or property (org-read-property-name))) + (value (or value (org-read-property-value property))) + (fn (cdr (assoc property org-properties-postprocess-alist)))) + (setq org-last-set-property property) + (setq org-last-set-property-value (concat property ": " value)) + ;; Possibly postprocess the inserted value: + (when fn (setq value (funcall fn value))) + (unless (equal (org-entry-get nil property) value) + (org-entry-put nil property value)))) + +(defun org-delete-property (property &optional delete-empty-drawer) + "In the current entry, delete PROPERTY. +When optional argument DELETE-EMPTY-DRAWER is a string, it defines +an empty drawer to delete." + (interactive + (let* ((completion-ignore-case t) + (cat (org-entry-get (point) "CATEGORY")) + (props0 (org-entry-properties nil 'standard)) + (props (if cat props0 + (delete `("CATEGORY" . ,(org-get-category)) props0))) + (prop (if (< 1 (length props)) + (org-icompleting-read "Property: " props nil t) + (caar props)))) + (list prop))) + (if (not property) + (message "No property to delete in this entry") + (org-entry-delete nil property delete-empty-drawer) + (message "Property \"%s\" deleted" property))) + +(defun org-delete-property-globally (property) + "Remove PROPERTY globally, from all entries." + (interactive + (let* ((completion-ignore-case t) + (prop (org-icompleting-read + "Globally remove property: " + (mapcar 'list (org-buffer-property-keys))))) + (list prop))) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let ((cnt 0)) + (while (re-search-forward + (org-re-property property) + nil t) + (setq cnt (1+ cnt)) + (delete-region (match-beginning 0) (1+ (point-at-eol)))) + (message "Property \"%s\" removed from %d entries" property cnt))))) + +(defvar org-columns-current-fmt-compiled) ; defined in org-colview.el + +(defun org-compute-property-at-point () + "Compute the property at point. +This looks for an enclosing column format, extracts the operator and +then applies it to the property in the column format's scope." + (interactive) + (unless (org-at-property-p) + (user-error "Not at a property")) + (let ((prop (org-match-string-no-properties 2))) + (org-columns-get-format-and-top-level) + (unless (nth 3 (assoc prop org-columns-current-fmt-compiled)) + (user-error "No operator defined for property %s" prop)) + (org-columns-compute prop))) + +(defvar org-property-allowed-value-functions nil + "Hook for functions supplying allowed values for a specific property. +The functions must take a single argument, the name of the property, and +return a flat list of allowed values. If \":ETC\" is one of +the values, this means that these values are intended as defaults for +completion, but that other values should be allowed too. +The functions must return nil if they are not responsible for this +property.") + +(defun org-property-get-allowed-values (pom property &optional table) + "Get allowed values for the property PROPERTY. +When TABLE is non-nil, return an alist that can directly be used for +completion." + (let (vals) + (cond + ((equal property "TODO") + (setq vals (org-with-point-at pom + (append org-todo-keywords-1 '(""))))) + ((equal property "PRIORITY") + (let ((n org-lowest-priority)) + (while (>= n org-highest-priority) + (push (char-to-string n) vals) + (setq n (1- n))))) + ((member property org-special-properties)) + ((setq vals (run-hook-with-args-until-success + 'org-property-allowed-value-functions property))) + (t + (setq vals (org-entry-get pom (concat property "_ALL") 'inherit)) + (when (and vals (string-match "\\S-" vals)) + (setq vals (car (read-from-string (concat "(" vals ")")))) + (setq vals (mapcar (lambda (x) + (cond ((stringp x) x) + ((numberp x) (number-to-string x)) + ((symbolp x) (symbol-name x)) + (t "???"))) + vals))))) + (when (member ":ETC" vals) + (setq vals (remove ":ETC" vals)) + (org-add-props (car vals) '(org-unrestricted t))) + (if table (mapcar 'list vals) vals))) + +(defun org-property-previous-allowed-value (&optional previous) + "Switch to the next allowed value for this property." + (interactive) + (org-property-next-allowed-value t)) + +(defun org-property-next-allowed-value (&optional previous) + "Switch to the next allowed value for this property." + (interactive) + (unless (org-at-property-p) + (user-error "Not at a property")) + (let* ((prop (car (save-match-data (org-split-string (match-string 1) ":")))) + (key (match-string 2)) + (value (match-string 3)) + (allowed (or (org-property-get-allowed-values (point) key) + (and (member value '("[ ]" "[-]" "[X]")) + '("[ ]" "[X]")))) + (heading (save-match-data (nth 4 (org-heading-components)))) + nval) + (unless allowed + (user-error "Allowed values for this property have not been defined")) + (if previous (setq allowed (reverse allowed))) + (if (member value allowed) + (setq nval (car (cdr (member value allowed))))) + (setq nval (or nval (car allowed))) + (if (equal nval value) + (user-error "Only one allowed value for this property")) + (org-at-property-p) + (replace-match (concat " :" key ": " nval) t t) + (org-indent-line) + (beginning-of-line 1) + (skip-chars-forward " \t") + (when (equal prop org-effort-property) + (save-excursion + (org-back-to-heading t) + (put-text-property (point-at-bol) (point-at-eol) 'org-effort nval)) + (when (string= org-clock-current-task heading) + (setq org-clock-effort nval) + (org-clock-update-mode-line))) + (run-hook-with-args 'org-property-changed-functions key nval))) + +(defun org-find-olp (path &optional this-buffer) + "Return a marker pointing to the entry at outline path OLP. +If anything goes wrong, throw an error. +You can wrap this call to catch the error like this: + + (condition-case msg + (org-mobile-locate-entry (match-string 4)) + (error (nth 1 msg))) + +The return value will then be either a string with the error message, +or a marker if everything is OK. + +If THIS-BUFFER is set, the outline path does not contain a file, +only headings." + (let* ((file (if this-buffer buffer-file-name (pop path))) + (buffer (if this-buffer (current-buffer) (find-file-noselect file))) + (level 1) + (lmin 1) + (lmax 1) + limit re end found pos heading cnt flevel) + (unless buffer (error "File not found :%s" file)) + (with-current-buffer buffer + (save-excursion + (save-restriction + (widen) + (setq limit (point-max)) + (goto-char (point-min)) + (while (setq heading (pop path)) + (setq re (format org-complex-heading-regexp-format + (regexp-quote heading))) + (setq cnt 0 pos (point)) + (while (re-search-forward re end t) + (setq level (- (match-end 1) (match-beginning 1))) + (if (and (>= level lmin) (<= level lmax)) + (setq found (match-beginning 0) flevel level cnt (1+ cnt)))) + (when (= cnt 0) (error "Heading not found on level %d: %s" + lmax heading)) + (when (> cnt 1) (error "Heading not unique on level %d: %s" + lmax heading)) + (goto-char found) + (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0))) + (setq end (save-excursion (org-end-of-subtree t t)))) + (when (org-at-heading-p) + (point-marker))))))) + +(defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only) + "Find node HEADING in BUFFER. +Return a marker to the heading if it was found, or nil if not. +If POS-ONLY is set, return just the position instead of a marker. + +The heading text must match exact, but it may have a TODO keyword, +a priority cookie and tags in the standard locations." + (with-current-buffer (or buffer (current-buffer)) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (let (case-fold-search) + (if (re-search-forward + (format org-complex-heading-regexp-format + (regexp-quote heading)) nil t) + (if pos-only + (match-beginning 0) + (move-marker (make-marker) (match-beginning 0))))))))) + +(defun org-find-exact-heading-in-directory (heading &optional dir) + "Find Org node headline HEADING in all .org files in directory DIR. +When the target headline is found, return a marker to this location." + (let ((files (directory-files (or dir default-directory) + nil "\\`[^.#].*\\.org\\'")) + file visiting m buffer) + (catch 'found + (while (setq file (pop files)) + (message "trying %s" file) + (setq visiting (org-find-base-buffer-visiting file)) + (setq buffer (or visiting (find-file-noselect file))) + (setq m (org-find-exact-headline-in-buffer + heading buffer)) + (when (and (not m) (not visiting)) (kill-buffer buffer)) + (and m (throw 'found m)))))) + +(defun org-find-entry-with-id (ident) + "Locate the entry that contains the ID property with exact value IDENT. +IDENT can be a string, a symbol or a number, this function will search for +the string representation of it. +Return the position where this entry starts, or nil if there is no such entry." + (interactive "sID: ") + (let ((id (cond + ((stringp ident) ident) + ((symbol-name ident) (symbol-name ident)) + ((numberp ident) (number-to-string ident)) + (t (error "IDENT %s must be a string, symbol or number" ident)))) + (case-fold-search nil)) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (when (re-search-forward + (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$") + nil t) + (org-back-to-heading t) + (point)))))) + +;;;; Timestamps + +(defvar org-last-changed-timestamp nil) +(defvar org-last-inserted-timestamp nil + "The last time stamp inserted with `org-insert-time-stamp'.") +(defvar org-ts-what) ; dynamically scoped parameter + +(defun org-time-stamp (arg &optional inactive) + "Prompt for a date/time and insert a time stamp. +If the user specifies a time like HH:MM or if this command is +called with at least one prefix argument, the time stamp contains +the date and the time. Otherwise, only the date is be included. + +All parts of a date not specified by the user is filled in from +the current date/time. So if you just press return without +typing anything, the time stamp will represent the current +date/time. + +If there is already a timestamp at the cursor, it will be +modified. + +With two universal prefix arguments, insert an active timestamp +with the current time without prompting the user. + +When called from lisp, the timestamp is inactive if INACTIVE is +non-nil." + (interactive "P") + (let* ((ts nil) + (default-time + ;; Default time is either today, or, when entering a range, + ;; the range start. + (if (or (and (org-at-timestamp-p t) (setq ts (match-string 0))) + (save-excursion + (re-search-backward + (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses + (- (point) 20) t))) + (apply 'encode-time (org-parse-time-string (match-string 1))) + (current-time))) + (default-input (and ts (org-get-compact-tod ts))) + (repeater (save-excursion + (save-match-data + (beginning-of-line) + (when (re-search-forward + "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" + (save-excursion (progn (end-of-line) (point))) t) + (match-string 0))))) + org-time-was-given org-end-time-was-given time) + (cond + ((and (org-at-timestamp-p t) + (memq last-command '(org-time-stamp org-time-stamp-inactive)) + (memq this-command '(org-time-stamp org-time-stamp-inactive))) + (insert "--") + (setq time (let ((this-command this-command)) + (org-read-date arg 'totime nil nil + default-time default-input inactive))) + (org-insert-time-stamp time (or org-time-was-given arg) inactive)) + ((org-at-timestamp-p t) + (setq time (let ((this-command this-command)) + (org-read-date arg 'totime nil nil default-time default-input inactive))) + (when (org-at-timestamp-p t) ; just to get the match data + ; (setq inactive (eq (char-after (match-beginning 0)) ?\[)) + (replace-match "") + (setq org-last-changed-timestamp + (org-insert-time-stamp + time (or org-time-was-given arg) + inactive nil nil (list org-end-time-was-given))) + (when repeater (goto-char (1- (point))) (insert " " repeater) + (setq org-last-changed-timestamp + (concat (substring org-last-inserted-timestamp 0 -1) + " " repeater ">")))) + (message "Timestamp updated")) + ((equal arg '(16)) + (org-insert-time-stamp (current-time) t inactive)) + (t + (setq time (let ((this-command this-command)) + (org-read-date arg 'totime nil nil default-time default-input inactive))) + (org-insert-time-stamp time (or org-time-was-given arg) inactive + nil nil (list org-end-time-was-given)))))) + +;; FIXME: can we use this for something else, like computing time differences? +(defun org-get-compact-tod (s) + (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s) + (let* ((t1 (match-string 1 s)) + (h1 (string-to-number (match-string 2 s))) + (m1 (string-to-number (match-string 3 s))) + (t2 (and (match-end 4) (match-string 5 s))) + (h2 (and t2 (string-to-number (match-string 6 s)))) + (m2 (and t2 (string-to-number (match-string 7 s)))) + dh dm) + (if (not t2) + t1 + (setq dh (- h2 h1) dm (- m2 m1)) + (if (< dm 0) (setq dm (+ dm 60) dh (1- dh))) + (concat t1 "+" (number-to-string dh) + (and (/= 0 dm) (format ":%02d" dm))))))) + +(defun org-time-stamp-inactive (&optional arg) + "Insert an inactive time stamp. +An inactive time stamp is enclosed in square brackets instead of angle +brackets. It is inactive in the sense that it does not trigger agenda entries, +does not link to the calendar and cannot be changed with the S-cursor keys. +So these are more for recording a certain time/date." + (interactive "P") + (org-time-stamp arg 'inactive)) + +(defvar org-date-ovl (make-overlay 1 1)) +(overlay-put org-date-ovl 'face 'org-date-selected) +(org-detach-overlay org-date-ovl) + +(defvar org-ans1) ; dynamically scoped parameter +(defvar org-ans2) ; dynamically scoped parameter + +(defvar org-plain-time-of-day-regexp) ; defined below + +(defvar org-overriding-default-time nil) ; dynamically scoped +(defvar org-read-date-overlay nil) +(defvar org-dcst nil) ; dynamically scoped +(defvar org-read-date-history nil) +(defvar org-read-date-final-answer nil) +(defvar org-read-date-analyze-futurep nil) +(defvar org-read-date-analyze-forced-year nil) +(defvar org-read-date-inactive) + +(defvar org-read-date-minibuffer-local-map + (let* ((org-replace-disputed-keys nil) + (map (make-sparse-keymap))) + (set-keymap-parent map minibuffer-local-map) + (org-defkey map (kbd ".") + (lambda () (interactive) + ;; Are we at the beginning of the prompt? + (if (looking-back "^[^:]+: ") + (org-eval-in-calendar '(calendar-goto-today)) + (insert ".")))) + (org-defkey map (kbd "C-.") + (lambda () (interactive) + (org-eval-in-calendar '(calendar-goto-today)))) + (org-defkey map [(meta shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-month 1)))) + (org-defkey map [(meta shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-month 1)))) + (org-defkey map [(meta shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-year 1)))) + (org-defkey map [(meta shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-year 1)))) + (org-defkey map [?\e (shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-month 1)))) + (org-defkey map [?\e (shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-month 1)))) + (org-defkey map [?\e (shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-year 1)))) + (org-defkey map [?\e (shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-year 1)))) + (org-defkey map [(shift up)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-week 1)))) + (org-defkey map [(shift down)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-week 1)))) + (org-defkey map [(shift left)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-day 1)))) + (org-defkey map [(shift right)] + (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-day 1)))) + (org-defkey map "!" + (lambda () (interactive) + (org-eval-in-calendar '(diary-view-entries)) + (message ""))) + (org-defkey map ">" + (lambda () (interactive) + (org-eval-in-calendar '(calendar-scroll-left 1)))) + (org-defkey map "<" + (lambda () (interactive) + (org-eval-in-calendar '(calendar-scroll-right 1)))) + (org-defkey map "\C-v" + (lambda () (interactive) + (org-eval-in-calendar + '(calendar-scroll-left-three-months 1)))) + (org-defkey map "\M-v" + (lambda () (interactive) + (org-eval-in-calendar + '(calendar-scroll-right-three-months 1)))) + map) + "Keymap for minibuffer commands when using `org-read-date'.") + +(defvar org-def) +(defvar org-defdecode) +(defvar org-with-time) + +(defun org-read-date (&optional org-with-time to-time from-string prompt + default-time default-input inactive) + "Read a date, possibly a time, and make things smooth for the user. +The prompt will suggest to enter an ISO date, but you can also enter anything +which will at least partially be understood by `parse-time-string'. +Unrecognized parts of the date will default to the current day, month, year, +hour and minute. If this command is called to replace a timestamp at point, +or to enter the second timestamp of a range, the default time is taken +from the existing stamp. Furthermore, the command prefers the future, +so if you are giving a date where the year is not given, and the day-month +combination is already past in the current year, it will assume you +mean next year. For details, see the manual. A few examples: + + 3-2-5 --> 2003-02-05 + feb 15 --> currentyear-02-15 + 2/15 --> currentyear-02-15 + sep 12 9 --> 2009-09-12 + 12:45 --> today 12:45 + 22 sept 0:34 --> currentyear-09-22 0:34 + 12 --> currentyear-currentmonth-12 + Fri --> nearest Friday after today + -Tue --> last Tuesday + etc. + +Furthermore you can specify a relative date by giving, as the *first* thing +in the input: a plus/minus sign, a number and a letter [hdwmy] to indicate +change in days weeks, months, years. +With a single plus or minus, the date is relative to today. With a double +plus or minus, it is relative to the date in DEFAULT-TIME. E.g. + +4d --> four days from today + +4 --> same as above + +2w --> two weeks from today + ++5 --> five days from default date + +The function understands only English month and weekday abbreviations. + +While prompting, a calendar is popped up - you can also select the +date with the mouse (button 1). The calendar shows a period of three +months. To scroll it to other months, use the keys `>' and `<'. +If you don't like the calendar, turn it off with + \(setq org-read-date-popup-calendar nil) + +With optional argument TO-TIME, the date will immediately be converted +to an internal time. +With an optional argument ORG-WITH-TIME, the prompt will suggest to +also insert a time. Note that when ORG-WITH-TIME is not set, you can +still enter a time, and this function will inform the calling routine +about this change. The calling routine may then choose to change the +format used to insert the time stamp into the buffer to include the time. +With optional argument FROM-STRING, read from this string instead from +the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is +the time/date that is used for everything that is not specified by the +user." + (require 'parse-time) + (let* ((org-time-stamp-rounding-minutes + (if (equal org-with-time '(16)) '(0 0) org-time-stamp-rounding-minutes)) + (org-dcst org-display-custom-times) + (ct (org-current-time)) + (org-def (or org-overriding-default-time default-time ct)) + (org-defdecode (decode-time org-def)) + (dummy (progn + (when (< (nth 2 org-defdecode) org-extend-today-until) + (setcar (nthcdr 2 org-defdecode) -1) + (setcar (nthcdr 1 org-defdecode) 59) + (setq org-def (apply 'encode-time org-defdecode) + org-defdecode (decode-time org-def))))) + (mouse-autoselect-window nil) ; Don't let the mouse jump + (calendar-frame-setup nil) + (calendar-setup nil) + (calendar-move-hook nil) + (calendar-view-diary-initially-flag nil) + (calendar-view-holidays-initially-flag nil) + (timestr (format-time-string + (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") org-def)) + (prompt (concat (if prompt (concat prompt " ") "") + (format "Date+time [%s]: " timestr))) + ans (org-ans0 "") org-ans1 org-ans2 final) + + (cond + (from-string (setq ans from-string)) + (org-read-date-popup-calendar + (save-excursion + (save-window-excursion + (calendar) + (org-eval-in-calendar '(setq cursor-type nil) t) + (unwind-protect + (progn + (calendar-forward-day (- (time-to-days org-def) + (calendar-absolute-from-gregorian + (calendar-current-date)))) + (org-eval-in-calendar nil t) + (let* ((old-map (current-local-map)) + (map (copy-keymap calendar-mode-map)) + (minibuffer-local-map + (copy-keymap org-read-date-minibuffer-local-map))) + (org-defkey map (kbd "RET") 'org-calendar-select) + (org-defkey map [mouse-1] 'org-calendar-select-mouse) + (org-defkey map [mouse-2] 'org-calendar-select-mouse) + (unwind-protect + (progn + (use-local-map map) + (setq org-read-date-inactive inactive) + (add-hook 'post-command-hook 'org-read-date-display) + (setq org-ans0 (read-string prompt default-input + 'org-read-date-history nil)) + ;; org-ans0: from prompt + ;; org-ans1: from mouse click + ;; org-ans2: from calendar motion + (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) + (remove-hook 'post-command-hook 'org-read-date-display) + (use-local-map old-map) + (when org-read-date-overlay + (delete-overlay org-read-date-overlay) + (setq org-read-date-overlay nil))))) + (bury-buffer "*Calendar*"))))) + + (t ; Naked prompt only + (unwind-protect + (setq ans (read-string prompt default-input + 'org-read-date-history timestr)) + (when org-read-date-overlay + (delete-overlay org-read-date-overlay) + (setq org-read-date-overlay nil))))) + + (setq final (org-read-date-analyze ans org-def org-defdecode)) + + (when org-read-date-analyze-forced-year + (message "Year was forced into %s" + (if org-read-date-force-compatible-dates + "compatible range (1970-2037)" + "range representable on this machine")) + (ding)) + + ;; One round trip to get rid of 34th of August and stuff like that.... + (setq final (decode-time (apply 'encode-time final))) + + (setq org-read-date-final-answer ans) + + (if to-time + (apply 'encode-time final) + (if (and (boundp 'org-time-was-given) org-time-was-given) + (format "%04d-%02d-%02d %02d:%02d" + (nth 5 final) (nth 4 final) (nth 3 final) + (nth 2 final) (nth 1 final)) + (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) + +(defun org-read-date-display () + "Display the current date prompt interpretation in the minibuffer." + (when org-read-date-display-live + (when org-read-date-overlay + (delete-overlay org-read-date-overlay)) + (when (minibufferp (current-buffer)) + (save-excursion + (end-of-line 1) + (while (not (equal (buffer-substring + (max (point-min) (- (point) 4)) (point)) + " ")) + (insert " "))) + (let* ((ans (concat (buffer-substring (point-at-bol) (point-max)) + " " (or org-ans1 org-ans2))) + (org-end-time-was-given nil) + (f (org-read-date-analyze ans org-def org-defdecode)) + (fmts (if org-dcst + org-time-stamp-custom-formats + org-time-stamp-formats)) + (fmt (if (or org-with-time + (and (boundp 'org-time-was-given) org-time-was-given)) + (cdr fmts) + (car fmts))) + (txt (format-time-string fmt (apply 'encode-time f))) + (txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt)) + (txt (concat "=> " txt))) + (when (and org-end-time-was-given + (string-match org-plain-time-of-day-regexp txt)) + (setq txt (concat (substring txt 0 (match-end 0)) "-" + org-end-time-was-given + (substring txt (match-end 0))))) + (when org-read-date-analyze-futurep + (setq txt (concat txt " (=>F)"))) + (setq org-read-date-overlay + (make-overlay (1- (point-at-eol)) (point-at-eol))) + (org-overlay-display org-read-date-overlay txt 'secondary-selection))))) + +(defun org-read-date-analyze (ans org-def org-defdecode) + "Analyze the combined answer of the date prompt." + ;; FIXME: cleanup and comment + (let ((nowdecode (decode-time (current-time))) + delta deltan deltaw deltadef year month day + hour minute second wday pm h2 m2 tl wday1 + iso-year iso-weekday iso-week iso-year iso-date futurep kill-year) + (setq org-read-date-analyze-futurep nil + org-read-date-analyze-forced-year nil) + (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans) + (setq ans "+0")) + + (when (setq delta (org-read-date-get-relative ans (current-time) org-def)) + (setq ans (replace-match "" t t ans) + deltan (car delta) + deltaw (nth 1 delta) + deltadef (nth 2 delta))) + + ;; Check if there is an iso week date in there. If yes, store the + ;; info and postpone interpreting it until the rest of the parsing + ;; is done. + (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans) + (setq iso-year (if (match-end 1) + (org-small-year-to-year + (string-to-number (match-string 1 ans)))) + iso-weekday (if (match-end 3) + (string-to-number (match-string 3 ans))) + iso-week (string-to-number (match-string 2 ans))) + (setq ans (replace-match "" t t ans))) + + ;; Help matching ISO dates with single digit month or day, like 2006-8-11. + (when (string-match + "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans) + (setq year (if (match-end 2) + (string-to-number (match-string 2 ans)) + (progn (setq kill-year t) + (string-to-number (format-time-string "%Y")))) + month (string-to-number (match-string 3 ans)) + day (string-to-number (match-string 4 ans))) + (if (< year 100) (setq year (+ 2000 year))) + (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) + t nil ans))) + + ;; Help matching dotted european dates + (when (string-match + "^ *\\(3[01]\\|0?[1-9]\\|[12][0-9]\\)\\. ?\\(0?[1-9]\\|1[012]\\)\\.\\( ?[1-9][0-9]\\{3\\}\\)?" ans) + (setq year (if (match-end 3) (string-to-number (match-string 3 ans)) + (setq kill-year t) + (string-to-number (format-time-string "%Y"))) + day (string-to-number (match-string 1 ans)) + month (string-to-number (match-string 2 ans)) + ans (replace-match (format "%04d-%02d-%02d" year month day) + t nil ans))) + + ;; Help matching american dates, like 5/30 or 5/30/7 + (when (string-match + "^ *\\(0?[1-9]\\|1[012]\\)/\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans) + (setq year (if (match-end 4) + (string-to-number (match-string 4 ans)) + (progn (setq kill-year t) + (string-to-number (format-time-string "%Y")))) + month (string-to-number (match-string 1 ans)) + day (string-to-number (match-string 2 ans))) + (if (< year 100) (setq year (+ 2000 year))) + (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) + t nil ans))) + ;; Help matching am/pm times, because `parse-time-string' does not do that. + ;; If there is a time with am/pm, and *no* time without it, we convert + ;; so that matching will be successful. + (loop for i from 1 to 2 do ; twice, for end time as well + (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) + (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) + (setq hour (string-to-number (match-string 1 ans)) + minute (if (match-end 3) + (string-to-number (match-string 3 ans)) + 0) + pm (equal ?p + (string-to-char (downcase (match-string 4 ans))))) + (if (and (= hour 12) (not pm)) + (setq hour 0) + (if (and pm (< hour 12)) (setq hour (+ 12 hour)))) + (setq ans (replace-match (format "%02d:%02d" hour minute) + t t ans)))) + + ;; Check if a time range is given as a duration + (when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans) + (setq hour (string-to-number (match-string 1 ans)) + h2 (+ hour (string-to-number (match-string 3 ans))) + minute (string-to-number (match-string 2 ans)) + m2 (+ minute (if (match-end 5) (string-to-number + (match-string 5 ans))0))) + (if (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60))) + (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) + t t ans))) + + ;; Check if there is a time range + (when (boundp 'org-end-time-was-given) + (setq org-time-was-given nil) + (when (and (string-match org-plain-time-of-day-regexp ans) + (match-end 8)) + (setq org-end-time-was-given (match-string 8 ans)) + (setq ans (concat (substring ans 0 (match-beginning 7)) + (substring ans (match-end 7)))))) + + (setq tl (parse-time-string ans) + day (or (nth 3 tl) (nth 3 org-defdecode)) + month (or (nth 4 tl) + (if (and org-read-date-prefer-future + (nth 3 tl) (< (nth 3 tl) (nth 3 nowdecode))) + (prog1 (1+ (nth 4 nowdecode)) (setq futurep t)) + (nth 4 org-defdecode))) + year (or (and (not kill-year) (nth 5 tl)) + (if (and org-read-date-prefer-future + (nth 4 tl) (< (nth 4 tl) (nth 4 nowdecode))) + (prog1 (1+ (nth 5 nowdecode)) (setq futurep t)) + (nth 5 org-defdecode))) + hour (or (nth 2 tl) (nth 2 org-defdecode)) + minute (or (nth 1 tl) (nth 1 org-defdecode)) + second (or (nth 0 tl) 0) + wday (nth 6 tl)) + + (when (and (eq org-read-date-prefer-future 'time) + (not (nth 3 tl)) (not (nth 4 tl)) (not (nth 5 tl)) + (equal day (nth 3 nowdecode)) + (equal month (nth 4 nowdecode)) + (equal year (nth 5 nowdecode)) + (nth 2 tl) + (or (< (nth 2 tl) (nth 2 nowdecode)) + (and (= (nth 2 tl) (nth 2 nowdecode)) + (nth 1 tl) + (< (nth 1 tl) (nth 1 nowdecode))))) + (setq day (1+ day) + futurep t)) + + ;; Special date definitions below + (cond + (iso-week + ;; There was an iso week + (require 'cal-iso) + (setq futurep nil) + (setq year (or iso-year year) + day (or iso-weekday wday 1) + wday nil ; to make sure that the trigger below does not match + iso-date (calendar-gregorian-from-absolute + (calendar-iso-to-absolute + (list iso-week day year)))) + ; FIXME: Should we also push ISO weeks into the future? + ; (when (and org-read-date-prefer-future + ; (not iso-year) + ; (< (calendar-absolute-from-gregorian iso-date) + ; (time-to-days (current-time)))) + ; (setq year (1+ year) + ; iso-date (calendar-gregorian-from-absolute + ; (calendar-iso-to-absolute + ; (list iso-week day year))))) + (setq month (car iso-date) + year (nth 2 iso-date) + day (nth 1 iso-date))) + (deltan + (setq futurep nil) + (unless deltadef + (let ((now (decode-time (current-time)))) + (setq day (nth 3 now) month (nth 4 now) year (nth 5 now)))) + (cond ((member deltaw '("d" "")) (setq day (+ day deltan))) + ((equal deltaw "w") (setq day (+ day (* 7 deltan)))) + ((equal deltaw "m") (setq month (+ month deltan))) + ((equal deltaw "y") (setq year (+ year deltan))))) + ((and wday (not (nth 3 tl))) + ;; Weekday was given, but no day, so pick that day in the week + ;; on or after the derived date. + (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year)))) + (unless (equal wday wday1) + (setq day (+ day (% (- wday wday1 -7) 7)))))) + (if (and (boundp 'org-time-was-given) + (nth 2 tl)) + (setq org-time-was-given t)) + (if (< year 100) (setq year (+ 2000 year))) + ;; Check of the date is representable + (if org-read-date-force-compatible-dates + (progn + (if (< year 1970) + (setq year 1970 org-read-date-analyze-forced-year t)) + (if (> year 2037) + (setq year 2037 org-read-date-analyze-forced-year t))) + (condition-case nil + (ignore (encode-time second minute hour day month year)) + (error + (setq year (nth 5 org-defdecode)) + (setq org-read-date-analyze-forced-year t)))) + (setq org-read-date-analyze-futurep futurep) + (list second minute hour day month year))) + +(defvar parse-time-weekdays) +(defun org-read-date-get-relative (s today default) + "Check string S for special relative date string. +TODAY and DEFAULT are internal times, for today and for a default. +Return shift list (N what def-flag) +WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year. +N is the number of WHATs to shift. +DEF-FLAG is t when a double ++ or -- indicates shift relative to + the DEFAULT date rather than TODAY." + (require 'parse-time) + (when (and + (string-match + (concat + "\\`[ \t]*\\([-+]\\{0,2\\}\\)" + "\\([0-9]+\\)?" + "\\([hdwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?" + "\\([ \t]\\|$\\)") s) + (or (> (match-end 1) (match-beginning 1)) (match-end 4))) + (let* ((dir (if (> (match-end 1) (match-beginning 1)) + (string-to-char (substring (match-string 1 s) -1)) + ?+)) + (rel (and (match-end 1) (= 2 (- (match-end 1) (match-beginning 1))))) + (n (if (match-end 2) (string-to-number (match-string 2 s)) 1)) + (what (if (match-end 3) (match-string 3 s) "d")) + (wday1 (cdr (assoc (downcase what) parse-time-weekdays))) + (date (if rel default today)) + (wday (nth 6 (decode-time date))) + delta) + (if wday1 + (progn + (setq delta (mod (+ 7 (- wday1 wday)) 7)) + (if (= delta 0) (setq delta 7)) + (if (= dir ?-) + (progn + (setq delta (- delta 7)) + (if (= delta 0) (setq delta -7)))) + (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7))))) + (list delta "d" rel)) + (list (* n (if (= dir ?-) -1 1)) what rel))))) + +(defun org-order-calendar-date-args (arg1 arg2 arg3) + "Turn a user-specified date into the internal representation. +The internal representation needed by the calendar is (month day year). +This is a wrapper to handle the brain-dead convention in calendar that +user function argument order change dependent on argument order." + (if (boundp 'calendar-date-style) + (cond + ((eq calendar-date-style 'american) + (list arg1 arg2 arg3)) + ((eq calendar-date-style 'european) + (list arg2 arg1 arg3)) + ((eq calendar-date-style 'iso) + (list arg2 arg3 arg1))) + (org-no-warnings ;; european-calendar-style is obsolete as of version 23.1 + (if (org-bound-and-true-p european-calendar-style) + (list arg2 arg1 arg3) + (list arg1 arg2 arg3))))) + +(defun org-eval-in-calendar (form &optional keepdate) + "Eval FORM in the calendar window and return to current window. +When KEEPDATE is non-nil, update `org-ans2' from the cursor date, +otherwise stick to the current value of `org-ans2'." + (let ((sf (selected-frame)) + (sw (selected-window))) + (select-window (get-buffer-window "*Calendar*" t)) + (eval form) + (when (and (not keepdate) (calendar-cursor-to-date)) + (let* ((date (calendar-cursor-to-date)) + (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) + (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) + (move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) + (select-window sw) + (org-select-frame-set-input-focus sf))) + +(defun org-calendar-select () + "Return to `org-read-date' with the date currently selected. +This is used by `org-read-date' in a temporary keymap for the calendar buffer." + (interactive) + (when (calendar-cursor-to-date) + (let* ((date (calendar-cursor-to-date)) + (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) + (setq org-ans1 (format-time-string "%Y-%m-%d" time))) + (if (active-minibuffer-window) (exit-minibuffer)))) + +(defun org-insert-time-stamp (time &optional with-hm inactive pre post extra) + "Insert a date stamp for the date given by the internal TIME. +WITH-HM means use the stamp format that includes the time of the day. +INACTIVE means use square brackets instead of angular ones, so that the +stamp will not contribute to the agenda. +PRE and POST are optional strings to be inserted before and after the +stamp. +The command returns the inserted time stamp." + (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) + stamp) + (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) + (insert-before-markers (or pre "")) + (when (listp extra) + (setq extra (car extra)) + (if (and (stringp extra) + (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) + (setq extra (format "-%02d:%02d" + (string-to-number (match-string 1 extra)) + (string-to-number (match-string 2 extra)))) + (setq extra nil))) + (when extra + (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) + (insert-before-markers (setq stamp (format-time-string fmt time))) + (insert-before-markers (or post "")) + (setq org-last-inserted-timestamp stamp))) + +(defun org-toggle-time-stamp-overlays () + "Toggle the use of custom time stamp formats." + (interactive) + (setq org-display-custom-times (not org-display-custom-times)) + (unless org-display-custom-times + (let ((p (point-min)) (bmp (buffer-modified-p))) + (while (setq p (next-single-property-change p 'display)) + (if (and (get-text-property p 'display) + (eq (get-text-property p 'face) 'org-date)) + (remove-text-properties + p (setq p (next-single-property-change p 'display)) + '(display t)))) + (set-buffer-modified-p bmp))) + (if (featurep 'xemacs) + (remove-text-properties (point-min) (point-max) '(end-glyph t))) + (org-restart-font-lock) + (setq org-table-may-need-update t) + (if org-display-custom-times + (message "Time stamps are overlaid with custom format") + (message "Time stamp overlays removed"))) + +(defun org-display-custom-time (beg end) + "Overlay modified time stamp format over timestamp between BEG and END." + (let* ((ts (buffer-substring beg end)) + t1 w1 with-hm tf time str w2 (off 0)) + (save-match-data + (setq t1 (org-parse-time-string ts t)) + (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts) + (setq off (- (match-end 0) (match-beginning 0))))) + (setq end (- end off)) + (setq w1 (- end beg) + with-hm (and (nth 1 t1) (nth 2 t1)) + tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats) + time (org-fix-decoded-time t1) + str (org-add-props + (format-time-string + (substring tf 1 -1) (apply 'encode-time time)) + nil 'mouse-face 'highlight) + w2 (length str)) + (if (not (= w2 w1)) + (add-text-properties (1+ beg) (+ 2 beg) + (list 'org-dwidth t 'org-dwidth-n (- w1 w2)))) + (if (featurep 'xemacs) + (progn + (put-text-property beg end 'invisible t) + (put-text-property beg end 'end-glyph (make-glyph str))) + (put-text-property beg end 'display str)))) + +(defun org-translate-time (string) + "Translate all timestamps in STRING to custom format. +But do this only if the variable `org-display-custom-times' is set." + (when org-display-custom-times + (save-match-data + (let* ((start 0) + (re org-ts-regexp-both) + t1 with-hm inactive tf time str beg end) + (while (setq start (string-match re string start)) + (setq beg (match-beginning 0) + end (match-end 0) + t1 (save-match-data + (org-parse-time-string (substring string beg end) t)) + with-hm (and (nth 1 t1) (nth 2 t1)) + inactive (equal (substring string beg (1+ beg)) "[") + tf (funcall (if with-hm 'cdr 'car) + org-time-stamp-custom-formats) + time (org-fix-decoded-time t1) + str (format-time-string + (concat + (if inactive "[" "<") (substring tf 1 -1) + (if inactive "]" ">")) + (apply 'encode-time time)) + string (replace-match str t t string) + start (+ start (length str))))))) + string) + +(defun org-fix-decoded-time (time) + "Set 0 instead of nil for the first 6 elements of time. +Don't touch the rest." + (let ((n 0)) + (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time))) + +(define-obsolete-function-alias 'org-days-to-time 'org-time-stamp-to-now "24.4") + +(defun org-time-stamp-to-now (timestamp-string &optional seconds) + "Difference between TIMESTAMP-STRING and now in days. +If SECONDS is non-nil, return the difference in seconds." + (let ((fdiff (if seconds 'org-float-time 'time-to-days))) + (- (funcall fdiff (org-time-string-to-time timestamp-string)) + (funcall fdiff (current-time))))) + +(defun org-deadline-close (timestamp-string &optional ndays) + "Is the time in TIMESTAMP-STRING close to the current date?" + (setq ndays (or ndays (org-get-wdays timestamp-string))) + (and (< (org-time-stamp-to-now timestamp-string) ndays) + (not (org-entry-is-done-p)))) + +(defun org-get-wdays (ts &optional delay zero-delay) + "Get the deadline lead time appropriate for timestring TS. +When DELAY is non-nil, get the delay time for scheduled items +instead of the deadline lead time. When ZERO-DELAY is non-nil +and `org-scheduled-delay-days' is 0, enforce 0 as the delay, +don't try to find the delay cookie in the scheduled timestamp." + (let ((tv (if delay org-scheduled-delay-days + org-deadline-warning-days))) + (cond + ((or (and delay (< tv 0)) + (and delay zero-delay (<= tv 0)) + (and (not delay) (<= tv 0))) + ;; Enforce this value no matter what + (- tv)) + ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts) + ;; lead time is specified. + (floor (* (string-to-number (match-string 1 ts)) + (cdr (assoc (match-string 2 ts) + '(("d" . 1) ("w" . 7) + ("m" . 30.4) ("y" . 365.25) + ("h" . 0.041667))))))) + ;; go for the default. + (t tv)))) + +(defun org-calendar-select-mouse (ev) + "Return to `org-read-date' with the date currently selected. +This is used by `org-read-date' in a temporary keymap for the calendar buffer." + (interactive "e") + (mouse-set-point ev) + (when (calendar-cursor-to-date) + (let* ((date (calendar-cursor-to-date)) + (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) + (setq org-ans1 (format-time-string "%Y-%m-%d" time))) + (if (active-minibuffer-window) (exit-minibuffer)))) + +(defun org-check-deadlines (ndays) + "Check if there are any deadlines due or past due. +A deadline is considered due if it happens within `org-deadline-warning-days' +days from today's date. If the deadline appears in an entry marked DONE, +it is not shown. The prefix arg NDAYS can be used to test that many +days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown." + (interactive "P") + (let* ((org-warn-days + (cond + ((equal ndays '(4)) 100000) + (ndays (prefix-numeric-value ndays)) + (t (abs org-deadline-warning-days)))) + (case-fold-search nil) + (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) + (callback + (lambda () (org-deadline-close (match-string 1) org-warn-days)))) + + (message "%d deadlines past-due or due within %d days" + (org-occur regexp nil callback) + org-warn-days))) + +(defsubst org-re-timestamp (type) + "Return a regexp for timestamp TYPE. +Allowed values for TYPE are: + + all: all timestamps + active: only active timestamps (<...>) + inactive: only inactive timestamps ([...]) + scheduled: only scheduled timestamps + deadline: only deadline timestamps + closed: only closed time-stamps + +When TYPE is nil, fall back on returning a regexp that matches +both scheduled and deadline timestamps." + (cond ((eq type 'all) "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\(?: +[^]+0-9> \n -]+\\)?\\(?: +[0-9]\\{1,2\\}:[0-9]\\{2\\}\\)?\\)") + ((eq type 'active) org-ts-regexp) + ((eq type 'inactive) "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^ \n>]*?\\)\\]") + ((eq type 'scheduled) (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) + ((eq type 'deadline) (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) + ((eq type 'closed) (concat org-closed-string " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^ \n>]*?\\)\\]")) + ((eq type 'scheduled-or-deadline) + (concat "\\<\\(?:" org-deadline-string "\\|" org-scheduled-string "\\) *<\\([^>]+\\)>")))) + +(defun org-check-before-date (date) + "Check if there are deadlines or scheduled entries before DATE." + (interactive (list (org-read-date))) + (let ((case-fold-search nil) + (regexp (org-re-timestamp org-ts-type)) + (callback + (lambda () (time-less-p + (org-time-string-to-time (match-string 1)) + (org-time-string-to-time date))))) + (message "%d entries before %s" + (org-occur regexp nil callback) date))) + +(defun org-check-after-date (date) + "Check if there are deadlines or scheduled entries after DATE." + (interactive (list (org-read-date))) + (let ((case-fold-search nil) + (regexp (org-re-timestamp org-ts-type)) + (callback + (lambda () (not + (time-less-p + (org-time-string-to-time (match-string 1)) + (org-time-string-to-time date)))))) + (message "%d entries after %s" + (org-occur regexp nil callback) date))) + +(defun org-check-dates-range (start-date end-date) + "Check for deadlines/scheduled entries between START-DATE and END-DATE." + (interactive (list (org-read-date nil nil nil "Range starts") + (org-read-date nil nil nil "Range end"))) + (let ((case-fold-search nil) + (regexp (org-re-timestamp org-ts-type)) + (callback + (lambda () + (let ((match (match-string 1))) + (and + (not (time-less-p + (org-time-string-to-time match) + (org-time-string-to-time start-date))) + (time-less-p + (org-time-string-to-time match) + (org-time-string-to-time end-date))))))) + (message "%d entries between %s and %s" + (org-occur regexp nil callback) start-date end-date))) + +(defun org-evaluate-time-range (&optional to-buffer) + "Evaluate a time range by computing the difference between start and end. +Normally the result is just printed in the echo area, but with prefix arg +TO-BUFFER, the result is inserted just after the date stamp into the buffer. +If the time range is actually in a table, the result is inserted into the +next column. +For time difference computation, a year is assumed to be exactly 365 +days in order to avoid rounding problems." + (interactive "P") + (or + (org-clock-update-time-maybe) + (save-excursion + (unless (org-at-date-range-p t) + (goto-char (point-at-bol)) + (re-search-forward org-tr-regexp-both (point-at-eol) t)) + (if (not (org-at-date-range-p t)) + (user-error "Not at a time-stamp range, and none found in current line"))) + (let* ((ts1 (match-string 1)) + (ts2 (match-string 2)) + (havetime (or (> (length ts1) 15) (> (length ts2) 15))) + (match-end (match-end 0)) + (time1 (org-time-string-to-time ts1)) + (time2 (org-time-string-to-time ts2)) + (t1 (org-float-time time1)) + (t2 (org-float-time time2)) + (diff (abs (- t2 t1))) + (negative (< (- t2 t1) 0)) + ;; (ys (floor (* 365 24 60 60))) + (ds (* 24 60 60)) + (hs (* 60 60)) + (fy "%dy %dd %02d:%02d") + (fy1 "%dy %dd") + (fd "%dd %02d:%02d") + (fd1 "%dd") + (fh "%02d:%02d") + y d h m align) + (if havetime + (setq ; y (floor (/ diff ys)) diff (mod diff ys) + y 0 + d (floor (/ diff ds)) diff (mod diff ds) + h (floor (/ diff hs)) diff (mod diff hs) + m (floor (/ diff 60))) + (setq ; y (floor (/ diff ys)) diff (mod diff ys) + y 0 + d (floor (+ (/ diff ds) 0.5)) + h 0 m 0)) + (if (not to-buffer) + (message "%s" (org-make-tdiff-string y d h m)) + (if (org-at-table-p) + (progn + (goto-char match-end) + (setq align t) + (and (looking-at " *|") (goto-char (match-end 0)))) + (goto-char match-end)) + (if (looking-at + "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") + (replace-match "")) + (if negative (insert " -")) + (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m)) + (if (> d 0) (insert " " (format (if havetime fd fd1) d h m)) + (insert " " (format fh h m)))) + (if align (org-table-align)) + (message "Time difference inserted"))))) + +(defun org-make-tdiff-string (y d h m) + (let ((fmt "") + (l nil)) + (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ") + l (push y l))) + (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ") + l (push d l))) + (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ") + l (push h l))) + (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ") + l (push m l))) + (apply 'format fmt (nreverse l)))) + +(defun org-time-string-to-time (s &optional buffer pos) + "Convert a timestamp string into internal time." + (condition-case errdata + (apply 'encode-time (org-parse-time-string s)) + (error (error "Bad timestamp `%s'%s\nError was: %s" + s (if (not (and buffer pos)) + "" + (format " at %d in buffer `%s'" pos buffer)) + (cdr errdata))))) + +(defun org-time-string-to-seconds (s) + "Convert a timestamp string to a number of seconds." + (org-float-time (org-time-string-to-time s))) + +(defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos) + "Convert a time stamp to an absolute day number. +If there is a specifier for a cyclic time stamp, get the closest +date to DAYNR. +PREFER and SHOW-ALL are passed through to `org-closest-date'. +The variable `date' is bound by the calendar when this is called." + (cond + ((and daynr (string-match "\\`%%\\((.*)\\)" s)) + (if (org-diary-sexp-entry (match-string 1 s) "" date) + daynr + (+ daynr 1000))) + ((and daynr (string-match "\\+[0-9]+[hdwmy]" s)) + (org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr + (time-to-days (current-time))) (match-string 0 s) + prefer show-all)) + (t (time-to-days + (condition-case errdata + (apply 'encode-time (org-parse-time-string s)) + (error (error "Bad timestamp `%s'%s\nError was: %s" + s (if (not (and buffer pos)) + "" + (format " at %d in buffer `%s'" pos buffer)) + (cdr errdata)))))))) + +(defun org-days-to-iso-week (days) + "Return the iso week number." + (require 'cal-iso) + (car (calendar-iso-from-absolute days))) + +(defun org-small-year-to-year (year) + "Convert 2-digit years into 4-digit years. +38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2037. +The year 2000 cannot be abbreviated. Any year larger than 99 +is returned unchanged." + (if (< year 38) + (setq year (+ 2000 year)) + (if (< year 100) + (setq year (+ 1900 year)))) + year) + +(defun org-time-from-absolute (d) + "Return the time corresponding to date D. +D may be an absolute day number, or a calendar-type list (month day year)." + (if (numberp d) (setq d (calendar-gregorian-from-absolute d))) + (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d))) + +(defun org-calendar-holiday () + "List of holidays, for Diary display in Org-mode." + (require 'holidays) + (let ((hl (funcall + (if (fboundp 'calendar-check-holidays) + 'calendar-check-holidays 'check-calendar-holidays) date))) + (if hl (mapconcat 'identity hl "; ")))) + +(defun org-diary-sexp-entry (sexp entry date) + "Process a SEXP diary ENTRY for DATE." + (require 'diary-lib) + (let ((result (if calendar-debug-sexp + (let ((stack-trace-on-error t)) + (eval (car (read-from-string sexp)))) + (condition-case nil + (eval (car (read-from-string sexp))) + (error + (beep) + (message "Bad sexp at line %d in %s: %s" + (org-current-line) + (buffer-file-name) sexp) + (sleep-for 2)))))) + (cond ((stringp result) (split-string result "; ")) + ((and (consp result) + (not (consp (cdr result))) + (stringp (cdr result))) (cdr result)) + ((and (consp result) + (stringp (car result))) result) + (result entry)))) + +(defun org-diary-to-ical-string (frombuf) + "Get iCalendar entries from diary entries in buffer FROMBUF. +This uses the icalendar.el library." + (let* ((tmpdir (if (featurep 'xemacs) + (temp-directory) + temporary-file-directory)) + (tmpfile (make-temp-name + (expand-file-name "orgics" tmpdir))) + buf rtn b e) + (with-current-buffer frombuf + (icalendar-export-region (point-min) (point-max) tmpfile) + (setq buf (find-buffer-visiting tmpfile)) + (set-buffer buf) + (goto-char (point-min)) + (if (re-search-forward "^BEGIN:VEVENT" nil t) + (setq b (match-beginning 0))) + (goto-char (point-max)) + (if (re-search-backward "^END:VEVENT" nil t) + (setq e (match-end 0))) + (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") ""))) + (kill-buffer buf) + (delete-file tmpfile) + rtn)) + +(defun org-closest-date (start current change prefer show-all) + "Find the date closest to CURRENT that is consistent with START and CHANGE. +When PREFER is `past', return a date that is either CURRENT or past. +When PREFER is `future', return a date that is either CURRENT or future. +When SHOW-ALL is nil, only return the current occurrence of a time stamp." + ;; Make the proper lists from the dates + (catch 'exit + (let ((a1 '(("h" . hour) + ("d" . day) + ("w" . week) + ("m" . month) + ("y" . year))) + (shour (nth 2 (org-parse-time-string start))) + dn dw sday cday n1 n2 n0 + d m y y1 y2 date1 date2 nmonths nm ny m2) + + (setq start (org-date-to-gregorian start) + current (org-date-to-gregorian + (if show-all + current + (time-to-days (current-time)))) + sday (calendar-absolute-from-gregorian start) + cday (calendar-absolute-from-gregorian current)) + + (if (<= cday sday) (throw 'exit sday)) + + (if (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change) + (setq dn (string-to-number (match-string 1 change)) + dw (cdr (assoc (match-string 2 change) a1))) + (user-error "Invalid change specifier: %s" change)) + (if (eq dw 'week) (setq dw 'day dn (* 7 dn))) + (cond + ((eq dw 'hour) + (let ((missing-hours + (mod (+ (- (* 24 (- cday sday)) shour) org-extend-today-until) + dn))) + (setq n1 (if (zerop missing-hours) cday + (- cday (1+ (floor (/ missing-hours 24))))) + n2 (+ cday (floor (/ (- dn missing-hours) 24)))))) + ((eq dw 'day) + (setq n1 (+ sday (* dn (floor (/ (- cday sday) dn)))) + n2 (+ n1 dn))) + ((eq dw 'year) + (setq d (nth 1 start) m (car start) y1 (nth 2 start) y2 (nth 2 current)) + (setq y1 (+ (* (floor (/ (- y2 y1) dn)) dn) y1)) + (setq date1 (list m d y1) + n1 (calendar-absolute-from-gregorian date1) + date2 (list m d (+ y1 (* (if (< n1 cday) 1 -1) dn))) + n2 (calendar-absolute-from-gregorian date2))) + ((eq dw 'month) + ;; approx number of month between the two dates + (setq nmonths (floor (/ (- cday sday) 30.436875))) + ;; How often does dn fit in there? + (setq d (nth 1 start) m (car start) y (nth 2 start) + nm (* dn (max 0 (1- (floor (/ nmonths dn))))) + m (+ m nm) + ny (floor (/ m 12)) + y (+ y ny) + m (- m (* ny 12))) + (while (> m 12) (setq m (- m 12) y (1+ y))) + (setq n1 (calendar-absolute-from-gregorian (list m d y))) + (setq m2 (+ m dn) y2 y) + (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) + (setq n2 (calendar-absolute-from-gregorian (list m2 d y2))) + (while (<= n2 cday) + (setq n1 n2 m m2 y y2) + (setq m2 (+ m dn) y2 y) + (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) + (setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))))) + ;; Make sure n1 is the earlier date + (setq n0 n1 n1 (min n1 n2) n2 (max n0 n2)) + (if show-all + (cond + ((eq prefer 'past) (if (= cday n2) n2 n1)) + ((eq prefer 'future) (if (= cday n1) n1 n2)) + (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1))) + (cond + ((eq prefer 'past) (if (= cday n2) n2 n1)) + ((eq prefer 'future) (if (= cday n1) n1 n2)) + (t (if (= cday n1) n1 n2))))))) + +(defun org-date-to-gregorian (date) + "Turn any specification of DATE into a Gregorian date for the calendar." + (cond ((integerp date) (calendar-gregorian-from-absolute date)) + ((and (listp date) (= (length date) 3)) date) + ((stringp date) + (setq date (org-parse-time-string date)) + (list (nth 4 date) (nth 3 date) (nth 5 date))) + ((listp date) + (list (nth 4 date) (nth 3 date) (nth 5 date))))) + +(defun org-parse-time-string (s &optional nodefault) + "Parse the standard Org-mode time string. +This should be a lot faster than the normal `parse-time-string'. +If time is not given, defaults to 0:00. However, with optional NODEFAULT, +hour and minute fields will be nil if not given." + (cond ((string-match org-ts-regexp0 s) + (list 0 + (if (or (match-beginning 8) (not nodefault)) + (string-to-number (or (match-string 8 s) "0"))) + (if (or (match-beginning 7) (not nodefault)) + (string-to-number (or (match-string 7 s) "0"))) + (string-to-number (match-string 4 s)) + (string-to-number (match-string 3 s)) + (string-to-number (match-string 2 s)) + nil nil nil)) + ((string-match "^<[^>]+>$" s) + (decode-time (seconds-to-time (org-matcher-time s)))) + (t (error "Not a standard Org-mode time string: %s" s)))) + +(defun org-timestamp-up (&optional arg) + "Increase the date item at the cursor by one. +If the cursor is on the year, change the year. If it is on the month, +the day or the time, change that. +With prefix ARG, change by that many units." + (interactive "p") + (org-timestamp-change (prefix-numeric-value arg) nil 'updown)) + +(defun org-timestamp-down (&optional arg) + "Decrease the date item at the cursor by one. +If the cursor is on the year, change the year. If it is on the month, +the day or the time, change that. +With prefix ARG, change by that many units." + (interactive "p") + (org-timestamp-change (- (prefix-numeric-value arg)) nil 'updown)) + +(defun org-timestamp-up-day (&optional arg) + "Increase the date in the time stamp by one day. +With prefix ARG, change that many days." + (interactive "p") + (if (and (not (org-at-timestamp-p t)) + (org-at-heading-p)) + (org-todo 'up) + (org-timestamp-change (prefix-numeric-value arg) 'day 'updown))) + +(defun org-timestamp-down-day (&optional arg) + "Decrease the date in the time stamp by one day. +With prefix ARG, change that many days." + (interactive "p") + (if (and (not (org-at-timestamp-p t)) + (org-at-heading-p)) + (org-todo 'down) + (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown)) + +(defun org-at-timestamp-p (&optional inactive-ok) + "Determine if the cursor is in or at a timestamp." + (interactive) + (let* ((tsr (if inactive-ok org-ts-regexp3 org-ts-regexp2)) + (pos (point)) + (ans (or (looking-at tsr) + (save-excursion + (skip-chars-backward "^[<\n\r\t") + (if (> (point) (point-min)) (backward-char 1)) + (and (looking-at tsr) + (> (- (match-end 0) pos) -1)))))) + (and ans + (boundp 'org-ts-what) + (setq org-ts-what + (cond + ((= pos (match-beginning 0)) 'bracket) + ;; Point is considered to be "on the bracket" whether + ;; it's really on it or right after it. + ((= pos (1- (match-end 0))) 'bracket) + ((= pos (match-end 0)) 'after) + ((org-pos-in-match-range pos 2) 'year) + ((org-pos-in-match-range pos 3) 'month) + ((org-pos-in-match-range pos 7) 'hour) + ((org-pos-in-match-range pos 8) 'minute) + ((or (org-pos-in-match-range pos 4) + (org-pos-in-match-range pos 5)) 'day) + ((and (> pos (or (match-end 8) (match-end 5))) + (< pos (match-end 0))) + (- pos (or (match-end 8) (match-end 5)))) + (t 'day)))) + ans)) + +(defun org-toggle-timestamp-type () + "Toggle the type (<active> or [inactive]) of a time stamp." + (interactive) + (when (org-at-timestamp-p t) + (let ((beg (match-beginning 0)) (end (match-end 0)) + (map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]")))) + (save-excursion + (goto-char beg) + (while (re-search-forward "[][<>]" end t) + (replace-match (cdr (assoc (char-after (match-beginning 0)) map)) + t t))) + (message "Timestamp is now %sactive" + (if (equal (char-after beg) ?<) "" "in"))))) + +(defun org-at-clock-log-p nil + "Is the cursor on the clock log line?" + (save-excursion + (move-beginning-of-line 1) + (looking-at "^[ \t]*CLOCK:"))) + +(defvar org-clock-history) ; defined in org-clock.el +(defvar org-clock-adjust-closest nil) ; defined in org-clock.el +(defun org-timestamp-change (n &optional what updown suppress-tmp-delay) + "Change the date in the time stamp at point. +The date will be changed by N times WHAT. WHAT can be `day', `month', +`year', `minute', `second'. If WHAT is not given, the cursor position +in the timestamp determines what will be changed. +When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." + (let ((origin (point)) origin-cat + with-hm inactive + (dm (max (nth 1 org-time-stamp-rounding-minutes) 1)) + org-ts-what + extra rem + ts time time0 fixnext clrgx) + (if (not (org-at-timestamp-p t)) + (user-error "Not at a timestamp")) + (if (and (not what) (eq org-ts-what 'bracket)) + (org-toggle-timestamp-type) + ;; Point isn't on brackets. Remember the part of the time-stamp + ;; the point was in. Indeed, size of time-stamps may change, + ;; but point must be kept in the same category nonetheless. + (setq origin-cat org-ts-what) + (if (and (not what) (not (eq org-ts-what 'day)) + org-display-custom-times + (get-text-property (point) 'display) + (not (get-text-property (1- (point)) 'display))) + (setq org-ts-what 'day)) + (setq org-ts-what (or what org-ts-what) + inactive (= (char-after (match-beginning 0)) ?\[) + ts (match-string 0)) + (replace-match "") + (when (string-match + "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]" + ts) + (setq extra (match-string 1 ts)) + (if suppress-tmp-delay + (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra)))) + (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) + (setq with-hm t)) + (setq time0 (org-parse-time-string ts)) + (when (and updown + (eq org-ts-what 'minute) + (not current-prefix-arg)) + ;; This looks like s-up and s-down. Change by one rounding step. + (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0)))) + (when (not (= 0 (setq rem (% (nth 1 time0) dm)))) + (setcar (cdr time0) (+ (nth 1 time0) + (if (> n 0) (- rem) (- dm rem)))))) + (setq time + (encode-time (or (car time0) 0) + (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0)) + (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)) + (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)) + (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)) + (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)) + (nthcdr 6 time0))) + (when (and (member org-ts-what '(hour minute)) + extra + (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra)) + (setq extra (org-modify-ts-extra + extra + (if (eq org-ts-what 'hour) 2 5) + n dm))) + (when (integerp org-ts-what) + (setq extra (org-modify-ts-extra extra org-ts-what n dm))) + (if (eq what 'calendar) + (let ((cal-date (org-get-date-from-calendar))) + (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month + (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day + (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year + (setcar time0 (or (car time0) 0)) + (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) + (setcar (nthcdr 2 time0) (or (nth 2 time0) 0)) + (setq time (apply 'encode-time time0)))) + ;; Insert the new time-stamp, and ensure point stays in the same + ;; category as before (i.e. not after the last position in that + ;; category). + (let ((pos (point))) + ;; Stay before inserted string. `save-excursion' is of no use. + (setq org-last-changed-timestamp + (org-insert-time-stamp time with-hm inactive nil nil extra)) + (goto-char pos)) + (save-match-data + (looking-at org-ts-regexp3) + (goto-char (cond + ;; `day' category ends before `hour' if any, or at + ;; the end of the day name. + ((eq origin-cat 'day) + (min (or (match-beginning 7) (1- (match-end 5))) origin)) + ((eq origin-cat 'hour) (min (match-end 7) origin)) + ((eq origin-cat 'minute) (min (1- (match-end 8)) origin)) + ((integerp origin-cat) (min (1- (match-end 0)) origin)) + ;; `year' and `month' have both fixed size: point + ;; couldn't have moved into another part. + (t origin)))) + ;; Update clock if on a CLOCK line. + (org-clock-update-time-maybe) + ;; Maybe adjust the closest clock in `org-clock-history' + (when org-clock-adjust-closest + (if (not (and (org-at-clock-log-p) + (< 1 (length (delq nil (mapcar 'marker-position + org-clock-history)))))) + (message "No clock to adjust") + (cond ((save-excursion ; fix previous clock? + (re-search-backward org-ts-regexp0 nil t) + (org-looking-back (concat org-clock-string " \\["))) + (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$"))) + ((save-excursion ; fix next clock? + (re-search-backward org-ts-regexp0 nil t) + (looking-at (concat org-ts-regexp0 "\\] =>"))) + (setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0)))) + (save-window-excursion + ;; Find closest clock to point, adjust the previous/next one in history + (let* ((p (save-excursion (org-back-to-heading t))) + (cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history)) + (clfixnth + (+ fixnext (- (length cl) (or (length (member (apply #'min cl) cl)) 100)))) + (clfixpos (if (> 0 clfixnth) nil (nth clfixnth org-clock-history)))) + (if (not clfixpos) + (message "No clock to adjust") + (save-excursion + (org-goto-marker-or-bmk clfixpos) + (org-show-subtree) + (when (re-search-forward clrgx nil t) + (goto-char (match-beginning 1)) + (let (org-clock-adjust-closest) + (org-timestamp-change n org-ts-what updown)) + (message "Clock adjusted in %s for heading: %s" + (file-name-nondirectory (buffer-file-name)) + (org-get-heading t t))))))))) + ;; Try to recenter the calendar window, if any. + (if (and org-calendar-follow-timestamp-change + (get-buffer-window "*Calendar*" t) + (memq org-ts-what '(day month year))) + (org-recenter-calendar (time-to-days time)))))) + +(defun org-modify-ts-extra (s pos n dm) + "Change the different parts of the lead-time and repeat fields in timestamp." + (let ((idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4))) + ng h m new rem) + (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( +\\+\\([0-9]+\\)\\([dmwy]\\)\\)?\\( +-\\([0-9]+\\)\\([dmwy]\\)\\)?" s) + (cond + ((or (org-pos-in-match-range pos 2) + (org-pos-in-match-range pos 3)) + (setq m (string-to-number (match-string 3 s)) + h (string-to-number (match-string 2 s))) + (if (org-pos-in-match-range pos 2) + (setq h (+ h n)) + (setq n (* dm (org-no-warnings (signum n)))) + (when (not (= 0 (setq rem (% m dm)))) + (setq m (+ m (if (> n 0) (- rem) (- dm rem))))) + (setq m (+ m n))) + (if (< m 0) (setq m (+ m 60) h (1- h))) + (if (> m 59) (setq m (- m 60) h (1+ h))) + (setq h (min 24 (max 0 h))) + (setq ng 1 new (format "-%02d:%02d" h m))) + ((org-pos-in-match-range pos 6) + (setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx)))) + ((org-pos-in-match-range pos 5) + (setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s))))))) + + ((org-pos-in-match-range pos 9) + (setq ng 9 new (car (rassoc (+ n (cdr (assoc (match-string 9 s) idx))) idx)))) + ((org-pos-in-match-range pos 8) + (setq ng 8 new (format "%d" (max 0 (+ n (string-to-number (match-string 8 s)))))))) + + (when ng + (setq s (concat + (substring s 0 (match-beginning ng)) + new + (substring s (match-end ng)))))) + s)) + +(defun org-recenter-calendar (date) + "If the calendar is visible, recenter it to DATE." + (let ((cwin (get-buffer-window "*Calendar*" t))) + (when cwin + (let ((calendar-move-hook nil)) + (with-selected-window cwin + (calendar-goto-date (if (listp date) date + (calendar-gregorian-from-absolute date)))))))) + +(defun org-goto-calendar (&optional arg) + "Go to the Emacs calendar at the current date. +If there is a time stamp in the current line, go to that date. +A prefix ARG can be used to force the current date." + (interactive "P") + (let ((tsr org-ts-regexp) diff + (calendar-move-hook nil) + (calendar-view-holidays-initially-flag nil) + (calendar-view-diary-initially-flag nil)) + (if (or (org-at-timestamp-p) + (save-excursion + (beginning-of-line 1) + (looking-at (concat ".*" tsr)))) + (let ((d1 (time-to-days (current-time))) + (d2 (time-to-days + (org-time-string-to-time (match-string 1))))) + (setq diff (- d2 d1)))) + (calendar) + (calendar-goto-today) + (if (and diff (not arg)) (calendar-forward-day diff)))) + +(defun org-get-date-from-calendar () + "Return a list (month day year) of date at point in calendar." + (with-current-buffer "*Calendar*" + (save-match-data + (calendar-cursor-to-date)))) + +(defun org-date-from-calendar () + "Insert time stamp corresponding to cursor date in *Calendar* buffer. +If there is already a time stamp at the cursor position, update it." + (interactive) + (if (org-at-timestamp-p t) + (org-timestamp-change 0 'calendar) + (let ((cal-date (org-get-date-from-calendar))) + (org-insert-time-stamp + (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date)))))) + +(defcustom org-effort-durations + `(("h" . 60) + ("d" . ,(* 60 8)) + ("w" . ,(* 60 8 5)) + ("m" . ,(* 60 8 5 4)) + ("y" . ,(* 60 8 5 40))) + "Conversion factor to minutes for an effort modifier. + +Each entry has the form (MODIFIER . MINUTES). + +In an effort string, a number followed by MODIFIER is multiplied +by the specified number of MINUTES to obtain an effort in +minutes. + +For example, if the value of this variable is ((\"hours\" . 60)), then an +effort string \"2hours\" is equivalent to 120 minutes." + :group 'org-agenda + :version "24.1" + :type '(alist :key-type (string :tag "Modifier") + :value-type (number :tag "Minutes"))) + +(defun org-minutes-to-clocksum-string (m) + "Format number of minutes as a clocksum string. +The format is determined by `org-time-clocksum-format', +`org-time-clocksum-use-fractional' and +`org-time-clocksum-fractional-format' and +`org-time-clocksum-use-effort-durations'." + (let ((clocksum "") + (m (round m)) ; Don't allow fractions of minutes + h d w mo y fmt n) + (setq h (if org-time-clocksum-use-effort-durations + (cdr (assoc "h" org-effort-durations)) 60) + d (if org-time-clocksum-use-effort-durations + (/ (cdr (assoc "d" org-effort-durations)) h) 24) + w (if org-time-clocksum-use-effort-durations + (/ (cdr (assoc "w" org-effort-durations)) (* d h)) 7) + mo (if org-time-clocksum-use-effort-durations + (/ (cdr (assoc "m" org-effort-durations)) (* d h)) 30) + y (if org-time-clocksum-use-effort-durations + (/ (cdr (assoc "y" org-effort-durations)) (* d h)) 365)) + ;; fractional format + (if org-time-clocksum-use-fractional + (cond + ;; single format string + ((stringp org-time-clocksum-fractional-format) + (format org-time-clocksum-fractional-format (/ m (float h)))) + ;; choice of fractional formats for different time units + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :years)) + (> (/ (truncate m) (* y d h)) 0)) + (format fmt (/ m (* y d (float h))))) + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :months)) + (> (/ (truncate m) (* mo d h)) 0)) + (format fmt (/ m (* mo d (float h))))) + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :weeks)) + (> (/ (truncate m) (* w d h)) 0)) + (format fmt (/ m (* w d (float h))))) + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :days)) + (> (/ (truncate m) (* d h)) 0)) + (format fmt (/ m (* d (float h))))) + ((and (setq fmt (plist-get org-time-clocksum-fractional-format :hours)) + (> (/ (truncate m) h) 0)) + (format fmt (/ m (float h)))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :minutes)) + (format fmt m)) + ;; fall back to smallest time unit with a format + ((setq fmt (plist-get org-time-clocksum-fractional-format :hours)) + (format fmt (/ m (float h)))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :days)) + (format fmt (/ m (* d (float h))))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :weeks)) + (format fmt (/ m (* w d (float h))))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :months)) + (format fmt (/ m (* mo d (float h))))) + ((setq fmt (plist-get org-time-clocksum-fractional-format :years)) + (format fmt (/ m (* y d (float h)))))) + ;; standard (non-fractional) format, with single format string + (if (stringp org-time-clocksum-format) + (format org-time-clocksum-format (setq n (/ m h)) (- m (* h n))) + ;; separate formats components + (and (setq fmt (plist-get org-time-clocksum-format :years)) + (or (> (setq n (/ (truncate m) (* y d h))) 0) + (plist-get org-time-clocksum-format :require-years)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n y d h)))) + (and (setq fmt (plist-get org-time-clocksum-format :months)) + (or (> (setq n (/ (truncate m) (* mo d h))) 0) + (plist-get org-time-clocksum-format :require-months)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n mo d h)))) + (and (setq fmt (plist-get org-time-clocksum-format :weeks)) + (or (> (setq n (/ (truncate m) (* w d h))) 0) + (plist-get org-time-clocksum-format :require-weeks)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n w d h)))) + (and (setq fmt (plist-get org-time-clocksum-format :days)) + (or (> (setq n (/ (truncate m) (* d h))) 0) + (plist-get org-time-clocksum-format :require-days)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n d h)))) + (and (setq fmt (plist-get org-time-clocksum-format :hours)) + (or (> (setq n (/ (truncate m) h)) 0) + (plist-get org-time-clocksum-format :require-hours)) + (setq clocksum (concat clocksum (format fmt n)) + m (- m (* n h)))) + (and (setq fmt (plist-get org-time-clocksum-format :minutes)) + (or (> m 0) (plist-get org-time-clocksum-format :require-minutes)) + (setq clocksum (concat clocksum (format fmt m)))) + ;; return formatted time duration + clocksum)))) + +(defalias 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string) +(make-obsolete 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string + "Org mode version 8.0") + +(defun org-hours-to-clocksum-string (n) + (org-minutes-to-clocksum-string (* n 60))) + +(defun org-hh:mm-string-to-minutes (s) + "Convert a string H:MM to a number of minutes. +If the string is just a number, interpret it as minutes. +In fact, the first hh:mm or number in the string will be taken, +there can be extra stuff in the string. +If no number is found, the return value is 0." + (cond + ((integerp s) s) + ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s) + (+ (* (string-to-number (match-string 1 s)) 60) + (string-to-number (match-string 2 s)))) + ((string-match "\\([0-9]+\\)" s) + (string-to-number (match-string 1 s))) + (t 0))) + +(defcustom org-image-actual-width t + "Should we use the actual width of images when inlining them? + +When set to `t', always use the image width. + +When set to a number, use imagemagick (when available) to set +the image's width to this value. + +When set to a number in a list, try to get the width from any +#+ATTR.* keyword if it matches a width specification like + + #+ATTR_HTML: :width 300px + +and fall back on that number if none is found. + +When set to nil, try to get the width from an #+ATTR.* keyword +and fall back on the original width if none is found. + +This requires Emacs >= 24.1, build with imagemagick support." + :group 'org-appearance + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Use the image width" t) + (integer :tag "Use a number of pixels") + (list :tag "Use #+ATTR* or a number of pixels" (integer)) + (const :tag "Use #+ATTR* or don't resize" nil))) + +(defcustom org-agenda-inhibit-startup nil + "Inhibit startup when preparing agenda buffers. +When this variable is `t', the initialization of the Org agenda +buffers is inhibited: e.g. the visibility state is not set, the +tables are not re-aligned, etc." + :type 'boolean + :version "24.3" + :group 'org-agenda) + +(defcustom org-agenda-ignore-drawer-properties nil + "Avoid updating text properties when building the agenda. +Properties are used to prepare buffers for effort estimates, appointments, +and subtree-local categories. +If you don't use these in the agenda, you can add them to this list and +agenda building will be a bit faster. +The value is a list, with zero or more of the symbols `effort', `appt', +or `category'." + :type '(set :greedy t + (const effort) + (const appt) + (const category)) + :version "24.3" + :group 'org-agenda) + +(defun org-duration-string-to-minutes (s &optional output-to-string) + "Convert a duration string S to minutes. + +A bare number is interpreted as minutes, modifiers can be set by +customizing `org-effort-durations' (which see). + +Entries containing a colon are interpreted as H:MM by +`org-hh:mm-string-to-minutes'." + (let ((result 0) + (re (concat "\\([0-9.]+\\) *\\(" + (regexp-opt (mapcar 'car org-effort-durations)) + "\\)"))) + (while (string-match re s) + (incf result (* (cdr (assoc (match-string 2 s) org-effort-durations)) + (string-to-number (match-string 1 s)))) + (setq s (replace-match "" nil t s))) + (setq result (floor result)) + (incf result (org-hh:mm-string-to-minutes s)) + (if output-to-string (number-to-string result) result))) + +;;;; Files + +(defun org-save-all-org-buffers () + "Save all Org-mode buffers without user confirmation." + (interactive) + (message "Saving all Org-mode buffers...") + (save-some-buffers t (lambda () (derived-mode-p 'org-mode))) + (when (featurep 'org-id) (org-id-locations-save)) + (message "Saving all Org-mode buffers... done")) + +(defun org-revert-all-org-buffers () + "Revert all Org-mode buffers. +Prompt for confirmation when there are unsaved changes. +Be sure you know what you are doing before letting this function +overwrite your changes. + +This function is useful in a setup where one tracks org files +with a version control system, to revert on one machine after pulling +changes from another. I believe the procedure must be like this: + +1. M-x org-save-all-org-buffers +2. Pull changes from the other machine, resolve conflicts +3. M-x org-revert-all-org-buffers" + (interactive) + (unless (yes-or-no-p "Revert all Org buffers from their files? ") + (user-error "Abort")) + (save-excursion + (save-window-excursion + (mapc + (lambda (b) + (when (and (with-current-buffer b (derived-mode-p 'org-mode)) + (with-current-buffer b buffer-file-name)) + (org-pop-to-buffer-same-window b) + (revert-buffer t 'no-confirm))) + (buffer-list)) + (when (and (featurep 'org-id) org-id-track-globally) + (org-id-locations-load))))) + +;;;; Agenda files + +;;;###autoload +(defun org-switchb (&optional arg) + "Switch between Org buffers. +With one prefix argument, restrict available buffers to files. +With two prefix arguments, restrict available buffers to agenda files. + +Defaults to `iswitchb' for buffer name completion. +Set `org-completion-use-ido' to make it use ido instead." + (interactive "P") + (let ((blist (cond ((equal arg '(4)) (org-buffer-list 'files)) + ((equal arg '(16)) (org-buffer-list 'agenda)) + (t (org-buffer-list)))) + (org-completion-use-iswitchb org-completion-use-iswitchb) + (org-completion-use-ido org-completion-use-ido)) + (unless (or org-completion-use-ido org-completion-use-iswitchb) + (setq org-completion-use-iswitchb t)) + (org-pop-to-buffer-same-window + (org-icompleting-read "Org buffer: " + (mapcar 'list (mapcar 'buffer-name blist)) + nil t)))) + +;;; Define some older names previously used for this functionality +;;;###autoload +(defalias 'org-ido-switchb 'org-switchb) +;;;###autoload +(defalias 'org-iswitchb 'org-switchb) + +(defun org-buffer-list (&optional predicate exclude-tmp) + "Return a list of Org buffers. +PREDICATE can be `export', `files' or `agenda'. + +export restrict the list to Export buffers. +files restrict the list to buffers visiting Org files. +agenda restrict the list to buffers visiting agenda files. + +If EXCLUDE-TMP is non-nil, ignore temporary buffers." + (let* ((bfn nil) + (agenda-files (and (eq predicate 'agenda) + (mapcar 'file-truename (org-agenda-files t)))) + (filter + (cond + ((eq predicate 'files) + (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode)))) + ((eq predicate 'export) + (lambda (b) (string-match "\*Org .*Export" (buffer-name b)))) + ((eq predicate 'agenda) + (lambda (b) + (with-current-buffer b + (and (derived-mode-p 'org-mode) + (setq bfn (buffer-file-name b)) + (member (file-truename bfn) agenda-files))))) + (t (lambda (b) (with-current-buffer b + (or (derived-mode-p 'org-mode) + (string-match "\*Org .*Export" + (buffer-name b))))))))) + (delq nil + (mapcar + (lambda(b) + (if (and (funcall filter b) + (or (not exclude-tmp) + (not (string-match "tmp" (buffer-name b))))) + b + nil)) + (buffer-list))))) + +(defun org-agenda-files (&optional unrestricted archives) + "Get the list of agenda files. +Optional UNRESTRICTED means return the full list even if a restriction +is currently in place. +When ARCHIVES is t, include all archive files that are really being +used by the agenda files. If ARCHIVE is `ifmode', do this only if +`org-agenda-archives-mode' is t." + (let ((files + (cond + ((and (not unrestricted) (get 'org-agenda-files 'org-restrict))) + ((stringp org-agenda-files) (org-read-agenda-file-list)) + ((listp org-agenda-files) org-agenda-files) + (t (error "Invalid value of `org-agenda-files'"))))) + (setq files (apply 'append + (mapcar (lambda (f) + (if (file-directory-p f) + (directory-files + f t org-agenda-file-regexp) + (list f))) + files))) + (when org-agenda-skip-unavailable-files + (setq files (delq nil + (mapcar (function + (lambda (file) + (and (file-readable-p file) file))) + files)))) + (when (or (eq archives t) + (and (eq archives 'ifmode) (eq org-agenda-archives-mode t))) + (setq files (org-add-archive-files files))) + files)) + +(defun org-agenda-file-p (&optional file) + "Return non-nil, if FILE is an agenda file. +If FILE is omitted, use the file associated with the current +buffer." + (member (or file (buffer-file-name)) + (org-agenda-files t))) + +(defun org-edit-agenda-file-list () + "Edit the list of agenda files. +Depending on setup, this either uses customize to edit the variable +`org-agenda-files', or it visits the file that is holding the list. In the +latter case, the buffer is set up in a way that saving it automatically kills +the buffer and restores the previous window configuration." + (interactive) + (if (stringp org-agenda-files) + (let ((cw (current-window-configuration))) + (find-file org-agenda-files) + (org-set-local 'org-window-configuration cw) + (org-add-hook 'after-save-hook + (lambda () + (set-window-configuration + (prog1 org-window-configuration + (kill-buffer (current-buffer)))) + (org-install-agenda-files-menu) + (message "New agenda file list installed")) + nil 'local) + (message "%s" (substitute-command-keys + "Edit list and finish with \\[save-buffer]"))) + (customize-variable 'org-agenda-files))) + +(defun org-store-new-agenda-file-list (list) + "Set new value for the agenda file list and save it correctly." + (if (stringp org-agenda-files) + (let ((fe (org-read-agenda-file-list t)) b u) + (while (setq b (find-buffer-visiting org-agenda-files)) + (kill-buffer b)) + (with-temp-file org-agenda-files + (insert + (mapconcat + (lambda (f) ;; Keep un-expanded entries. + (if (setq u (assoc f fe)) + (cdr u) + f)) + list "\n") + "\n"))) + (let ((org-mode-hook nil) (org-inhibit-startup t) + (org-insert-mode-line-in-empty-file nil)) + (setq org-agenda-files list) + (customize-save-variable 'org-agenda-files org-agenda-files)))) + +(defun org-read-agenda-file-list (&optional pair-with-expansion) + "Read the list of agenda files from a file. +If PAIR-WITH-EXPANSION is t return pairs with un-expanded +filenames, used by `org-store-new-agenda-file-list' to write back +un-expanded file names." + (when (file-directory-p org-agenda-files) + (error "`org-agenda-files' cannot be a single directory")) + (when (stringp org-agenda-files) + (with-temp-buffer + (insert-file-contents org-agenda-files) + (mapcar + (lambda (f) + (let ((e (expand-file-name (substitute-in-file-name f) + org-directory))) + (if pair-with-expansion + (cons e f) + e))) + (org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*"))))) + +;;;###autoload +(defun org-cycle-agenda-files () + "Cycle through the files in `org-agenda-files'. +If the current buffer visits an agenda file, find the next one in the list. +If the current buffer does not, find the first agenda file." + (interactive) + (let* ((fs (org-agenda-files t)) + (files (append fs (list (car fs)))) + (tcf (if buffer-file-name (file-truename buffer-file-name))) + file) + (unless files (user-error "No agenda files")) + (catch 'exit + (while (setq file (pop files)) + (if (equal (file-truename file) tcf) + (when (car files) + (find-file (car files)) + (throw 'exit t)))) + (find-file (car fs))) + (if (buffer-base-buffer) (org-pop-to-buffer-same-window (buffer-base-buffer))))) + +(defun org-agenda-file-to-front (&optional to-end) + "Move/add the current file to the top of the agenda file list. +If the file is not present in the list, it is added to the front. If it is +present, it is moved there. With optional argument TO-END, add/move to the +end of the list." + (interactive "P") + (let ((org-agenda-skip-unavailable-files nil) + (file-alist (mapcar (lambda (x) + (cons (file-truename x) x)) + (org-agenda-files t))) + (ctf (file-truename + (or buffer-file-name + (user-error "Please save the current buffer to a file")))) + x had) + (setq x (assoc ctf file-alist) had x) + + (if (not x) (setq x (cons ctf (abbreviate-file-name buffer-file-name)))) + (if to-end + (setq file-alist (append (delq x file-alist) (list x))) + (setq file-alist (cons x (delq x file-alist)))) + (org-store-new-agenda-file-list (mapcar 'cdr file-alist)) + (org-install-agenda-files-menu) + (message "File %s to %s of agenda file list" + (if had "moved" "added") (if to-end "end" "front")))) + +(defun org-remove-file (&optional file) + "Remove current file from the list of files in variable `org-agenda-files'. +These are the files which are being checked for agenda entries. +Optional argument FILE means use this file instead of the current." + (interactive) + (let* ((org-agenda-skip-unavailable-files nil) + (file (or file buffer-file-name + (user-error "Current buffer does not visit a file"))) + (true-file (file-truename file)) + (afile (abbreviate-file-name file)) + (files (delq nil (mapcar + (lambda (x) + (if (equal true-file + (file-truename x)) + nil x)) + (org-agenda-files t))))) + (if (not (= (length files) (length (org-agenda-files t)))) + (progn + (org-store-new-agenda-file-list files) + (org-install-agenda-files-menu) + (message "Removed from Org Agenda list: %s" afile)) + (message "File was not in list: %s (not removed)" afile)))) + +(defun org-file-menu-entry (file) + (vector file (list 'find-file file) t)) + +(defun org-check-agenda-file (file) + "Make sure FILE exists. If not, ask user what to do." + (when (not (file-exists-p file)) + (message "Non-existent agenda file %s. [R]emove from list or [A]bort?" + (abbreviate-file-name file)) + (let ((r (downcase (read-char-exclusive)))) + (cond + ((equal r ?r) + (org-remove-file file) + (throw 'nextfile t)) + (t (error "Abort")))))) + +(defun org-get-agenda-file-buffer (file) + "Get a buffer visiting FILE. If the buffer needs to be created, add +it to the list of buffers which might be released later." + (let ((buf (org-find-base-buffer-visiting file))) + (if buf + buf ; just return it + ;; Make a new buffer and remember it + (setq buf (find-file-noselect file)) + (if buf (push buf org-agenda-new-buffers)) + buf))) + +(defun org-release-buffers (blist) + "Release all buffers in list, asking the user for confirmation when needed. +When a buffer is unmodified, it is just killed. When modified, it is saved +\(if the user agrees) and then killed." + (let (buf file) + (while (setq buf (pop blist)) + (setq file (buffer-file-name buf)) + (when (and (buffer-modified-p buf) + file + (y-or-n-p (format "Save file %s? " file))) + (with-current-buffer buf (save-buffer))) + (kill-buffer buf)))) + +(defun org-agenda-prepare-buffers (files) + "Create buffers for all agenda files, protect archived trees and comments." + (interactive) + (let ((pa '(:org-archived t)) + (pc '(:org-comment t)) + (pall '(:org-archived t :org-comment t)) + (inhibit-read-only t) + (org-inhibit-startup org-agenda-inhibit-startup) + (rea (concat ":" org-archive-tag ":")) + file re pos) + (setq org-tag-alist-for-agenda nil + org-tag-groups-alist-for-agenda nil) + (save-excursion + (save-restriction + (while (setq file (pop files)) + (catch 'nextfile + (if (bufferp file) + (set-buffer file) + (org-check-agenda-file file) + (set-buffer (org-get-agenda-file-buffer file))) + (widen) + (org-set-regexps-and-options-for-tags) + (setq pos (point)) + (goto-char (point-min)) + (let ((case-fold-search t)) + (when (search-forward "#+setupfile" nil t) + ;; Don't set all regexps and options systematically as + ;; this is only run for setting agenda tags from setup + ;; file + (org-set-regexps-and-options))) + (or (memq 'category org-agenda-ignore-drawer-properties) + (org-refresh-category-properties)) + (or (memq 'effort org-agenda-ignore-drawer-properties) + (org-refresh-properties org-effort-property 'org-effort)) + (or (memq 'appt org-agenda-ignore-drawer-properties) + (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime)) + (setq org-todo-keywords-for-agenda + (append org-todo-keywords-for-agenda org-todo-keywords-1)) + (setq org-done-keywords-for-agenda + (append org-done-keywords-for-agenda org-done-keywords)) + (setq org-todo-keyword-alist-for-agenda + (append org-todo-keyword-alist-for-agenda org-todo-key-alist)) + (setq org-drawers-for-agenda + (append org-drawers-for-agenda org-drawers)) + (setq org-tag-alist-for-agenda + (org-uniquify + (append org-tag-alist-for-agenda + org-tag-alist + org-tag-persistent-alist))) + (if org-group-tags + (setq org-tag-groups-alist-for-agenda + (org-uniquify-alist + (append org-tag-groups-alist-for-agenda org-tag-groups-alist)))) + (org-with-silent-modifications + (save-excursion + (remove-text-properties (point-min) (point-max) pall) + (when org-agenda-skip-archived-trees + (goto-char (point-min)) + (while (re-search-forward rea nil t) + (if (org-at-heading-p t) + (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) + (goto-char (point-min)) + (setq re (format org-heading-keyword-regexp-format + org-comment-string)) + (while (re-search-forward re nil t) + (add-text-properties + (match-beginning 0) (org-end-of-subtree t) pc)))) + (goto-char pos))))) + (setq org-todo-keywords-for-agenda + (org-uniquify org-todo-keywords-for-agenda)) + (setq org-todo-keyword-alist-for-agenda + (org-uniquify org-todo-keyword-alist-for-agenda)))) + + +;;;; CDLaTeX minor mode + +(defvar org-cdlatex-mode-map (make-sparse-keymap) + "Keymap for the minor `org-cdlatex-mode'.") + +(org-defkey org-cdlatex-mode-map "_" 'org-cdlatex-underscore-caret) +(org-defkey org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret) +(org-defkey org-cdlatex-mode-map "`" 'cdlatex-math-symbol) +(org-defkey org-cdlatex-mode-map "'" 'org-cdlatex-math-modify) +(org-defkey org-cdlatex-mode-map "\C-c{" 'cdlatex-environment) + +(defvar org-cdlatex-texmathp-advice-is-done nil + "Flag remembering if we have applied the advice to texmathp already.") + +(define-minor-mode org-cdlatex-mode + "Toggle the minor `org-cdlatex-mode'. +This mode supports entering LaTeX environment and math in LaTeX fragments +in Org-mode. +\\{org-cdlatex-mode-map}" + nil " OCDL" nil + (when org-cdlatex-mode + (require 'cdlatex) + (run-hooks 'cdlatex-mode-hook) + (cdlatex-compute-tables)) + (unless org-cdlatex-texmathp-advice-is-done + (setq org-cdlatex-texmathp-advice-is-done t) + (defadvice texmathp (around org-math-always-on activate) + "Always return t in org-mode buffers. +This is because we want to insert math symbols without dollars even outside +the LaTeX math segments. If Orgmode thinks that point is actually inside +an embedded LaTeX fragment, let texmathp do its job. +\\[org-cdlatex-mode-map]" + (interactive) + (let (p) + (cond + ((not (derived-mode-p 'org-mode)) ad-do-it) + ((eq this-command 'cdlatex-math-symbol) + (setq ad-return-value t + texmathp-why '("cdlatex-math-symbol in org-mode" . 0))) + (t + (let ((p (org-inside-LaTeX-fragment-p))) + (if (and p (member (car p) (plist-get org-format-latex-options :matchers))) + (setq ad-return-value t + texmathp-why '("Org-mode embedded math" . 0)) + (if p ad-do-it))))))))) + +(defun turn-on-org-cdlatex () + "Unconditionally turn on `org-cdlatex-mode'." + (org-cdlatex-mode 1)) + +(defun org-try-cdlatex-tab () + "Check if it makes sense to execute `cdlatex-tab', and do it if yes. +It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is + - inside a LaTeX fragment, or + - after the first word in a line, where an abbreviation expansion could + insert a LaTeX environment." + (when org-cdlatex-mode + (cond + ;; Before any word on the line: No expansion possible. + ((save-excursion (skip-chars-backward " \t") (bolp)) nil) + ;; Just after first word on the line: Expand it. Make sure it + ;; cannot happen on headlines, though. + ((save-excursion + (skip-chars-backward "a-zA-Z0-9*") + (skip-chars-backward " \t") + (and (bolp) (not (org-at-heading-p)))) + (cdlatex-tab) t) + ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t)))) + +(defun org-cdlatex-underscore-caret (&optional arg) + "Execute `cdlatex-sub-superscript' in LaTeX fragments. +Revert to the normal definition outside of these fragments." + (interactive "P") + (if (org-inside-LaTeX-fragment-p) + (call-interactively 'cdlatex-sub-superscript) + (let (org-cdlatex-mode) + (call-interactively (key-binding (vector last-input-event)))))) + +(defun org-cdlatex-math-modify (&optional arg) + "Execute `cdlatex-math-modify' in LaTeX fragments. +Revert to the normal definition outside of these fragments." + (interactive "P") + (if (org-inside-LaTeX-fragment-p) + (call-interactively 'cdlatex-math-modify) + (let (org-cdlatex-mode) + (call-interactively (key-binding (vector last-input-event)))))) + + + +;;;; LaTeX fragments + +(defvar org-latex-regexps + '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) + ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil) + ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p + ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) + ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) + ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) + ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) + ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) + "Regular expressions for matching embedded LaTeX.") + +(defun org-inside-LaTeX-fragment-p () + "Test if point is inside a LaTeX fragment. +I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing +sequence appearing also before point. +Even though the matchers for math are configurable, this function assumes +that \\begin, \\(, \\[, and $$ are always used. Only the single dollar +delimiters are skipped when they have been removed by customization. +The return value is nil, or a cons cell with the delimiter and the +position of this delimiter. + +This function does a reasonably good job, but can locally be fooled by +for example currency specifications. For example it will assume being in +inline math after \"$22.34\". The LaTeX fragment formatter will only format +fragments that are properly closed, but during editing, we have to live +with the uncertainty caused by missing closing delimiters. This function +looks only before point, not after." + (catch 'exit + (let ((pos (point)) + (dodollar (member "$" (plist-get org-format-latex-options :matchers))) + (lim (progn + (re-search-backward (concat "^\\(" paragraph-start "\\)") nil t) + (point))) + dd-on str (start 0) m re) + (goto-char pos) + (when dodollar + (setq str (concat (buffer-substring lim (point)) "\000 X$.") + re (nth 1 (assoc "$" org-latex-regexps))) + (while (string-match re str start) + (cond + ((= (match-end 0) (length str)) + (throw 'exit (cons "$" (+ lim (match-beginning 0) 1)))) + ((= (match-end 0) (- (length str) 5)) + (throw 'exit nil)) + (t (setq start (match-end 0)))))) + (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t)) + (goto-char pos) + (and (match-beginning 1) (throw 'exit (cons (match-string 1) m))) + (and (match-beginning 2) (throw 'exit nil)) + ;; count $$ + (while (re-search-backward "\\$\\$" lim t) + (setq dd-on (not dd-on))) + (goto-char pos) + (if dd-on (cons "$$" m)))))) + +(defun org-inside-latex-macro-p () + "Is point inside a LaTeX macro or its arguments?" + (save-match-data + (org-in-regexp + "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*"))) + +(defvar org-latex-fragment-image-overlays nil + "List of overlays carrying the images of latex fragments.") +(make-variable-buffer-local 'org-latex-fragment-image-overlays) + +(defun org-remove-latex-fragment-image-overlays () + "Remove all overlays with LaTeX fragment images in current buffer." + (mapc 'delete-overlay org-latex-fragment-image-overlays) + (setq org-latex-fragment-image-overlays nil)) + +(defun org-preview-latex-fragment (&optional subtree) + "Preview the LaTeX fragment at point, or all locally or globally. +If the cursor is in a LaTeX fragment, create the image and overlay +it over the source code. If there is no fragment at point, display +all fragments in the current text, from one headline to the next. With +prefix SUBTREE, display all fragments in the current subtree. With a +double prefix arg \\[universal-argument] \\[universal-argument], or when \ +the cursor is before the first headline, +display all fragments in the buffer. +The images can be removed again with \\[org-ctrl-c-ctrl-c]." + (interactive "P") + (unless buffer-file-name + (user-error "Can't preview LaTeX fragment in a non-file buffer")) + (when (display-graphic-p) + (org-remove-latex-fragment-image-overlays) + (save-excursion + (save-restriction + (let (beg end at msg) + (cond + ((or (equal subtree '(16)) + (not (save-excursion + (re-search-backward org-outline-regexp-bol nil t)))) + (setq beg (point-min) end (point-max) + msg "Creating images for buffer...%s")) + ((equal subtree '(4)) + (org-back-to-heading) + (setq beg (point) end (org-end-of-subtree t) + msg "Creating images for subtree...%s")) + (t + (if (setq at (org-inside-LaTeX-fragment-p)) + (goto-char (max (point-min) (- (cdr at) 2))) + (org-back-to-heading)) + (setq beg (point) end (progn (outline-next-heading) (point)) + msg (if at "Creating image...%s" + "Creating images for entry...%s")))) + (message msg "") + (narrow-to-region beg end) + (goto-char beg) + (org-format-latex + (concat org-latex-preview-ltxpng-directory (file-name-sans-extension + (file-name-nondirectory + buffer-file-name))) + default-directory 'overlays msg at 'forbuffer + org-latex-create-formula-image-program) + (message msg "done. Use `C-c C-c' to remove images.")))))) + +(defun org-format-latex (prefix &optional dir overlays msg at + forbuffer processing-type) + "Replace LaTeX fragments with links to an image, and produce images. +Some of the options can be changed using the variable +`org-format-latex-options'." + (if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache)) + (let* ((prefixnodir (file-name-nondirectory prefix)) + (absprefix (expand-file-name prefix dir)) + (todir (file-name-directory absprefix)) + (opt org-format-latex-options) + (optnew org-format-latex-options) + (matchers (plist-get opt :matchers)) + (re-list org-latex-regexps) + (cnt 0) txt hash link beg end re e checkdir + string + m n block-type block linkfile movefile ov) + ;; Check the different regular expressions + (while (setq e (pop re-list)) + (setq m (car e) re (nth 1 e) n (nth 2 e) block-type (nth 3 e) + block (if block-type "\n\n" "")) + (when (member m matchers) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (when (and (or (not at) (equal (cdr at) (match-beginning n))) + (or (not overlays) + (not (eq (get-char-property (match-beginning n) + 'org-overlay-type) + 'org-latex-overlay)))) + (cond + ((eq processing-type 'verbatim)) + ((eq processing-type 'mathjax) + ;; Prepare for MathJax processing. + (setq string (match-string n)) + (when (member m '("$" "$1")) + (save-excursion + (delete-region (match-beginning n) (match-end n)) + (goto-char (match-beginning n)) + (insert (concat "\\(" (substring string 1 -1) "\\)"))))) + ((or (eq processing-type 'dvipng) + (eq processing-type 'imagemagick)) + ;; Process to an image. + (setq txt (match-string n) + beg (match-beginning n) end (match-end n) + cnt (1+ cnt)) + (let ((face (face-at-point)) + (fg (plist-get opt :foreground)) + (bg (plist-get opt :background)) + ;; Ensure full list is printed. + print-length print-level) + (when forbuffer + ;; Get the colors from the face at point. + (goto-char beg) + (when (eq fg 'auto) + (setq fg (face-attribute face :foreground nil 'default))) + (when (eq bg 'auto) + (setq bg (face-attribute face :background nil 'default))) + (setq optnew (copy-sequence opt)) + (plist-put optnew :foreground fg) + (plist-put optnew :background bg)) + (setq hash (sha1 (prin1-to-string + (list org-format-latex-header + org-latex-default-packages-alist + org-latex-packages-alist + org-format-latex-options + forbuffer txt fg bg))) + linkfile (format "%s_%s.png" prefix hash) + movefile (format "%s_%s.png" absprefix hash))) + (setq link (concat block "[[file:" linkfile "]]" block)) + (if msg (message msg cnt)) + (goto-char beg) + (unless checkdir ; Ensure the directory exists. + (setq checkdir t) + (or (file-directory-p todir) (make-directory todir t))) + (unless (file-exists-p movefile) + (org-create-formula-image + txt movefile optnew forbuffer processing-type)) + (if overlays + (progn + (mapc (lambda (o) + (if (eq (overlay-get o 'org-overlay-type) + 'org-latex-overlay) + (delete-overlay o))) + (overlays-in beg end)) + (setq ov (make-overlay beg end)) + (overlay-put ov 'org-overlay-type 'org-latex-overlay) + (if (featurep 'xemacs) + (progn + (overlay-put ov 'invisible t) + (overlay-put + ov 'end-glyph + (make-glyph (vector 'png :file movefile)))) + (overlay-put + ov 'display + (list 'image :type 'png :file movefile :ascent 'center))) + (push ov org-latex-fragment-image-overlays) + (goto-char end)) + (delete-region beg end) + (insert (org-add-props link + (list 'org-latex-src + (replace-regexp-in-string + "\"" "" txt) + 'org-latex-src-embed-type + (if block-type 'paragraph 'character)))))) + ((eq processing-type 'mathml) + ;; Process to MathML + (unless (save-match-data (org-format-latex-mathml-available-p)) + (user-error "LaTeX to MathML converter not configured")) + (setq txt (match-string n) + beg (match-beginning n) end (match-end n) + cnt (1+ cnt)) + (if msg (message msg cnt)) + (goto-char beg) + (delete-region beg end) + (insert (org-format-latex-as-mathml + txt block-type prefix dir))) + (t + (error "Unknown conversion type %s for LaTeX fragments" + processing-type))))))))) + +(defun org-create-math-formula (latex-frag &optional mathml-file) + "Convert LATEX-FRAG to MathML and store it in MATHML-FILE. +Use `org-latex-to-mathml-convert-command'. If the conversion is +sucessful, return the portion between \"<math...> </math>\" +elements otherwise return nil. When MATHML-FILE is specified, +write the results in to that file. When invoked as an +interactive command, prompt for LATEX-FRAG, with initial value +set to the current active region and echo the results for user +inspection." + (interactive (list (let ((frag (when (org-region-active-p) + (buffer-substring-no-properties + (region-beginning) (region-end))))) + (read-string "LaTeX Fragment: " frag nil frag)))) + (unless latex-frag (error "Invalid LaTeX fragment")) + (let* ((tmp-in-file (file-relative-name + (make-temp-name (expand-file-name "ltxmathml-in")))) + (ignore (write-region latex-frag nil tmp-in-file)) + (tmp-out-file (file-relative-name + (make-temp-name (expand-file-name "ltxmathml-out")))) + (cmd (format-spec + org-latex-to-mathml-convert-command + `((?j . ,(shell-quote-argument + (expand-file-name org-latex-to-mathml-jar-file))) + (?I . ,(shell-quote-argument tmp-in-file)) + (?o . ,(shell-quote-argument tmp-out-file))))) + mathml shell-command-output) + (when (org-called-interactively-p 'any) + (unless (org-format-latex-mathml-available-p) + (user-error "LaTeX to MathML converter not configured"))) + (message "Running %s" cmd) + (setq shell-command-output (shell-command-to-string cmd)) + (setq mathml + (when (file-readable-p tmp-out-file) + (with-current-buffer (find-file-noselect tmp-out-file t) + (goto-char (point-min)) + (when (re-search-forward + (concat + (regexp-quote + "<math xmlns=\"http://www.w3.org/1998/Math/MathML\">") + "\\(.\\|\n\\)*" + (regexp-quote "</math>")) nil t) + (prog1 (match-string 0) (kill-buffer)))))) + (cond + (mathml + (setq mathml + (concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" mathml)) + (when mathml-file + (write-region mathml nil mathml-file)) + (when (org-called-interactively-p 'any) + (message mathml))) + ((message "LaTeX to MathML conversion failed") + (message shell-command-output))) + (delete-file tmp-in-file) + (when (file-exists-p tmp-out-file) + (delete-file tmp-out-file)) + mathml)) + +(defun org-format-latex-as-mathml (latex-frag latex-frag-type + prefix &optional dir) + "Use `org-create-math-formula' but check local cache first." + (let* ((absprefix (expand-file-name prefix dir)) + (print-length nil) (print-level nil) + (formula-id (concat + "formula-" + (sha1 + (prin1-to-string + (list latex-frag + org-latex-to-mathml-convert-command))))) + (formula-cache (format "%s-%s.mathml" absprefix formula-id)) + (formula-cache-dir (file-name-directory formula-cache))) + + (unless (file-directory-p formula-cache-dir) + (make-directory formula-cache-dir t)) + + (unless (file-exists-p formula-cache) + (org-create-math-formula latex-frag formula-cache)) + + (if (file-exists-p formula-cache) + ;; Successful conversion. Return the link to MathML file. + (org-add-props + (format "[[file:%s]]" (file-relative-name formula-cache dir)) + (list 'org-latex-src (replace-regexp-in-string "\"" "" latex-frag) + 'org-latex-src-embed-type (if latex-frag-type + 'paragraph 'character))) + ;; Failed conversion. Return the LaTeX fragment verbatim + latex-frag))) + +(defun org-create-formula-image (string tofile options buffer &optional type) + "Create an image from LaTeX source using dvipng or convert. +This function calls either `org-create-formula-image-with-dvipng' +or `org-create-formula-image-with-imagemagick' depending on the +value of `org-latex-create-formula-image-program' or on the value +of the optional TYPE variable. + +Note: ultimately these two function should be combined as they +share a good deal of logic." + (org-check-external-command + "latex" "needed to convert LaTeX fragments to images") + (funcall + (case (or type org-latex-create-formula-image-program) + ('dvipng + (org-check-external-command + "dvipng" "needed to convert LaTeX fragments to images") + #'org-create-formula-image-with-dvipng) + ('imagemagick + (org-check-external-command + "convert" "you need to install imagemagick") + #'org-create-formula-image-with-imagemagick) + (t (error + "Invalid value of `org-latex-create-formula-image-program'"))) + string tofile options buffer)) + +(declare-function org-export-get-backend "ox" (name)) +(declare-function org-export--get-global-options "ox" (&optional backend)) +(declare-function org-export--get-inbuffer-options "ox" (&optional backend)) +(declare-function org-latex-guess-inputenc "ox-latex" (header)) +(declare-function org-latex-guess-babel-language "ox-latex" (header info)) +(defun org-create-formula--latex-header () + "Return LaTeX header appropriate for previewing a LaTeX snippet." + (let ((info (org-combine-plists (org-export--get-global-options + (org-export-get-backend 'latex)) + (org-export--get-inbuffer-options + (org-export-get-backend 'latex))))) + (org-latex-guess-babel-language + (org-latex-guess-inputenc + (org-splice-latex-header + org-format-latex-header + org-latex-default-packages-alist + org-latex-packages-alist t + (plist-get info :latex-header))) + info))) + +;; This function borrows from Ganesh Swami's latex2png.el +(defun org-create-formula-image-with-dvipng (string tofile options buffer) + "This calls dvipng." + (require 'ox-latex) + (let* ((tmpdir (if (featurep 'xemacs) + (temp-directory) + temporary-file-directory)) + (texfilebase (make-temp-name + (expand-file-name "orgtex" tmpdir))) + (texfile (concat texfilebase ".tex")) + (dvifile (concat texfilebase ".dvi")) + (pngfile (concat texfilebase ".png")) + (fnh (if (featurep 'xemacs) + (font-height (face-font 'default)) + (face-attribute 'default :height nil))) + (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) + (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.)))))) + (fg (or (plist-get options (if buffer :foreground :html-foreground)) + "Black")) + (bg (or (plist-get options (if buffer :background :html-background)) + "Transparent"))) + (if (eq fg 'default) (setq fg (org-dvipng-color :foreground)) + (unless (string= fg "Transparent") (setq fg (org-dvipng-color-format fg)))) + (if (eq bg 'default) (setq bg (org-dvipng-color :background)) + (unless (string= bg "Transparent") (setq bg (org-dvipng-color-format bg)))) + (let ((latex-header (org-create-formula--latex-header))) + (with-temp-file texfile + (insert latex-header) + (insert "\n\\begin{document}\n" string "\n\\end{document}\n"))) + (let ((dir default-directory)) + (condition-case nil + (progn + (cd tmpdir) + (call-process "latex" nil nil nil texfile)) + (error nil)) + (cd dir)) + (if (not (file-exists-p dvifile)) + (progn (message "Failed to create dvi file from %s" texfile) nil) + (condition-case nil + (if (featurep 'xemacs) + (call-process "dvipng" nil nil nil + "-fg" fg "-bg" bg + "-T" "tight" + "-o" pngfile + dvifile) + (call-process "dvipng" nil nil nil + "-fg" fg "-bg" bg + "-D" dpi + ;;"-x" scale "-y" scale + "-T" "tight" + "-o" pngfile + dvifile)) + (error nil)) + (if (not (file-exists-p pngfile)) + (if org-format-latex-signal-error + (error "Failed to create png file from %s" texfile) + (message "Failed to create png file from %s" texfile) + nil) + ;; Use the requested file name and clean up + (copy-file pngfile tofile 'replace) + (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png" ".out") do + (if (file-exists-p (concat texfilebase e)) + (delete-file (concat texfilebase e)))) + pngfile)))) + +(declare-function org-latex-compile "ox-latex" (texfile &optional snippet)) +(defun org-create-formula-image-with-imagemagick (string tofile options buffer) + "This calls convert, which is included into imagemagick." + (require 'ox-latex) + (let* ((tmpdir (if (featurep 'xemacs) + (temp-directory) + temporary-file-directory)) + (texfilebase (make-temp-name + (expand-file-name "orgtex" tmpdir))) + (texfile (concat texfilebase ".tex")) + (pdffile (concat texfilebase ".pdf")) + (pngfile (concat texfilebase ".png")) + (fnh (if (featurep 'xemacs) + (font-height (face-font 'default)) + (face-attribute 'default :height nil))) + (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) + (dpi (number-to-string (* scale (floor (if buffer fnh 120.))))) + (fg (or (plist-get options (if buffer :foreground :html-foreground)) + "black")) + (bg (or (plist-get options (if buffer :background :html-background)) + "white"))) + (if (eq fg 'default) (setq fg (org-latex-color :foreground)) + (setq fg (org-latex-color-format fg))) + (if (eq bg 'default) (setq bg (org-latex-color :background)) + (setq bg (org-latex-color-format + (if (string= bg "Transparent") "white" bg)))) + (let ((latex-header (org-create-formula--latex-header))) + (with-temp-file texfile + (insert latex-header) + (insert "\n\\begin{document}\n" + "\\definecolor{fg}{rgb}{" fg "}\n" + "\\definecolor{bg}{rgb}{" bg "}\n" + "\n\\pagecolor{bg}\n" + "\n{\\color{fg}\n" + string + "\n}\n" + "\n\\end{document}\n"))) + (org-latex-compile texfile t) + (if (not (file-exists-p pdffile)) + (progn (message "Failed to create pdf file from %s" texfile) nil) + (condition-case nil + (if (featurep 'xemacs) + (call-process "convert" nil nil nil + "-density" "96" + "-trim" + "-antialias" + pdffile + "-quality" "100" + ;; "-sharpen" "0x1.0" + pngfile) + (call-process "convert" nil nil nil + "-density" dpi + "-trim" + "-antialias" + pdffile + "-quality" "100" + ;; "-sharpen" "0x1.0" + pngfile)) + (error nil)) + (if (not (file-exists-p pngfile)) + (if org-format-latex-signal-error + (error "Failed to create png file from %s" texfile) + (message "Failed to create png file from %s" texfile) + nil) + ;; Use the requested file name and clean up + (copy-file pngfile tofile 'replace) + (loop for e in '(".pdf" ".tex" ".aux" ".log" ".png") do + (if (file-exists-p (concat texfilebase e)) + (delete-file (concat texfilebase e)))) + pngfile)))) + +(defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra) + "Fill a LaTeX header template TPL. +In the template, the following place holders will be recognized: + + [DEFAULT-PACKAGES] \\usepackage statements for DEF-PKG + [NO-DEFAULT-PACKAGES] do not include DEF-PKG + [PACKAGES] \\usepackage statements for PKG + [NO-PACKAGES] do not include PKG + [EXTRA] the string EXTRA + [NO-EXTRA] do not include EXTRA + +For backward compatibility, if both the positive and the negative place +holder is missing, the positive one (without the \"NO-\") will be +assumed to be present at the end of the template. +DEF-PKG and PKG are assumed to be alists of options/packagename lists. +EXTRA is a string. +SNIPPETS-P indicates if this is run to create snippet images for HTML." + (let (rpl (end "")) + (if (string-match "^[ \t]*\\[\\(NO-\\)?DEFAULT-PACKAGES\\][ \t]*\n?" tpl) + (setq rpl (if (or (match-end 1) (not def-pkg)) + "" (org-latex-packages-to-string def-pkg snippets-p t)) + tpl (replace-match rpl t t tpl)) + (if def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p)))) + + (if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl) + (setq rpl (if (or (match-end 1) (not pkg)) + "" (org-latex-packages-to-string pkg snippets-p t)) + tpl (replace-match rpl t t tpl)) + (if pkg (setq end + (concat end "\n" + (org-latex-packages-to-string pkg snippets-p))))) + + (if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl) + (setq rpl (if (or (match-end 1) (not extra)) + "" (concat extra "\n")) + tpl (replace-match rpl t t tpl)) + (if (and extra (string-match "\\S-" extra)) + (setq end (concat end "\n" extra)))) + + (if (string-match "\\S-" end) + (concat tpl "\n" end) + tpl))) + +(defun org-latex-packages-to-string (pkg &optional snippets-p newline) + "Turn an alist of packages into a string with the \\usepackage macros." + (setq pkg (mapconcat (lambda(p) + (cond + ((stringp p) p) + ((and snippets-p (>= (length p) 3) (not (nth 2 p))) + (format "%% Package %s omitted" (cadr p))) + ((equal "" (car p)) + (format "\\usepackage{%s}" (cadr p))) + (t + (format "\\usepackage[%s]{%s}" + (car p) (cadr p))))) + pkg + "\n")) + (if newline (concat pkg "\n") pkg)) + +(defun org-dvipng-color (attr) + "Return a RGB color specification for dvipng." + (apply 'format "rgb %s %s %s" + (mapcar 'org-normalize-color + (if (featurep 'xemacs) + (color-rgb-components + (face-property 'default + (cond ((eq attr :foreground) 'foreground) + ((eq attr :background) 'background)))) + (color-values (face-attribute 'default attr nil)))))) + +(defun org-dvipng-color-format (color-name) + "Convert COLOR-NAME to a RGB color value for dvipng." + (apply 'format "rgb %s %s %s" + (mapcar 'org-normalize-color + (color-values color-name)))) + +(defun org-latex-color (attr) + "Return a RGB color for the LaTeX color package." + (apply 'format "%s,%s,%s" + (mapcar 'org-normalize-color + (if (featurep 'xemacs) + (color-rgb-components + (face-property 'default + (cond ((eq attr :foreground) 'foreground) + ((eq attr :background) 'background)))) + (color-values (face-attribute 'default attr nil)))))) + +(defun org-latex-color-format (color-name) + "Convert COLOR-NAME to a RGB color value." + (apply 'format "%s,%s,%s" + (mapcar 'org-normalize-color + (color-values color-name)))) + +(defun org-normalize-color (value) + "Return string to be used as color value for an RGB component." + (format "%g" (/ value 65535.0))) + + + +;; Image display + +(defvar org-inline-image-overlays nil) +(make-variable-buffer-local 'org-inline-image-overlays) + +(defun org-toggle-inline-images (&optional include-linked) + "Toggle the display of inline images. +INCLUDE-LINKED is passed to `org-display-inline-images'." + (interactive "P") + (if org-inline-image-overlays + (progn + (org-remove-inline-images) + (message "Inline image display turned off")) + (org-display-inline-images include-linked) + (if (and (org-called-interactively-p) + org-inline-image-overlays) + (message "%d images displayed inline" + (length org-inline-image-overlays)) + (message "No images to display inline")))) + +(defun org-redisplay-inline-images () + "Refresh the display of inline images." + (interactive) + (if (not org-inline-image-overlays) + (org-toggle-inline-images) + (org-toggle-inline-images) + (org-toggle-inline-images))) + +(defun org-display-inline-images (&optional include-linked refresh beg end) + "Display inline images. +Normally only links without a description part are inlined, because this +is how it will work for export. When INCLUDE-LINKED is set, also links +with a description part will be inlined. This can be nice for a quick +look at those images, but it does not reflect what exported files will look +like. +When REFRESH is set, refresh existing images between BEG and END. +This will create new image displays only if necessary. +BEG and END default to the buffer boundaries." + (interactive "P") + (when (display-graphic-p) + (unless refresh + (org-remove-inline-images) + (if (fboundp 'clear-image-cache) (clear-image-cache))) + (save-excursion + (save-restriction + (widen) + (setq beg (or beg (point-min)) end (or end (point-max))) + (goto-char beg) + (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" + (substring (org-image-file-name-regexp) 0 -2) + "\\)\\]" (if include-linked "" "\\]"))) + (case-fold-search t) + old file ov img type attrwidth width) + (while (re-search-forward re end t) + (setq old (get-char-property-and-overlay (match-beginning 1) + 'org-image-overlay) + file (expand-file-name + (concat (or (match-string 3) "") (match-string 4)))) + (when (image-type-available-p 'imagemagick) + (setq attrwidth (if (or (listp org-image-actual-width) + (null org-image-actual-width)) + (save-excursion + (save-match-data + (when (re-search-backward + "#\\+attr.*:width[ \t]+\\([^ ]+\\)" + (save-excursion + (re-search-backward "^[ \t]*$\\|\\`" nil t)) t) + (string-to-number (match-string 1)))))) + width (cond ((eq org-image-actual-width t) nil) + ((null org-image-actual-width) attrwidth) + ((numberp org-image-actual-width) + org-image-actual-width) + ((listp org-image-actual-width) + (or attrwidth (car org-image-actual-width)))) + type (if width 'imagemagick))) + (when (file-exists-p file) + (if (and (car-safe old) refresh) + (image-refresh (overlay-get (cdr old) 'display)) + (setq img (save-match-data (create-image file type nil :width width))) + (when img + (setq ov (make-overlay (match-beginning 0) (match-end 0))) + (overlay-put ov 'display img) + (overlay-put ov 'face 'default) + (overlay-put ov 'org-image-overlay t) + (overlay-put ov 'modification-hooks + (list 'org-display-inline-remove-overlay)) + (push ov org-inline-image-overlays)))))))))) + +(define-obsolete-function-alias + 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3") + +(defun org-display-inline-remove-overlay (ov after beg end &optional len) + "Remove inline-display overlay if a corresponding region is modified." + (let ((inhibit-modification-hooks t)) + (when (and ov after) + (delete ov org-inline-image-overlays) + (delete-overlay ov)))) + +(defun org-remove-inline-images () + "Remove inline display of images." + (interactive) + (mapc 'delete-overlay org-inline-image-overlays) + (setq org-inline-image-overlays nil)) + +;;;; Key bindings + +;; Outline functions from `outline-mode-prefix-map' +;; that can be remapped in Org: +(define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree) +(define-key org-mode-map [remap show-subtree] 'org-show-subtree) +(define-key org-mode-map [remap outline-forward-same-level] + 'org-forward-heading-same-level) +(define-key org-mode-map [remap outline-backward-same-level] + 'org-backward-heading-same-level) +(define-key org-mode-map [remap show-branches] + 'org-kill-note-or-show-branches) +(define-key org-mode-map [remap outline-promote] 'org-promote-subtree) +(define-key org-mode-map [remap outline-demote] 'org-demote-subtree) +(define-key org-mode-map [remap outline-insert-heading] 'org-ctrl-c-ret) + +;; Outline functions from `outline-mode-prefix-map' that can not +;; be remapped in Org: +;; +;; - the column "key binding" shows whether the Outline function is still +;; available in Org mode on the same key that it has been bound to in +;; Outline mode: +;; - "overridden": key used for a different functionality in Org mode +;; - else: key still bound to the same Outline function in Org mode +;; +;; | Outline function | key binding | Org replacement | +;; |------------------------------------+-------------+-----------------------| +;; | `outline-next-visible-heading' | `C-c C-n' | still same function | +;; | `outline-previous-visible-heading' | `C-c C-p' | still same function | +;; | `outline-up-heading' | `C-c C-u' | still same function | +;; | `outline-move-subtree-up' | overridden | better: org-shiftup | +;; | `outline-move-subtree-down' | overridden | better: org-shiftdown | +;; | `show-entry' | overridden | no replacement | +;; | `show-children' | `C-c C-i' | visibility cycling | +;; | `show-branches' | `C-c C-k' | still same function | +;; | `show-subtree' | overridden | visibility cycling | +;; | `show-all' | overridden | no replacement | +;; | `hide-subtree' | overridden | visibility cycling | +;; | `hide-body' | overridden | no replacement | +;; | `hide-entry' | overridden | visibility cycling | +;; | `hide-leaves' | overridden | no replacement | +;; | `hide-sublevels' | overridden | no replacement | +;; | `hide-other' | overridden | no replacement | + +;; Make `C-c C-x' a prefix key +(org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap)) + +;; TAB key with modifiers +(org-defkey org-mode-map "\C-i" 'org-cycle) +(org-defkey org-mode-map [(tab)] 'org-cycle) +(org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) +(org-defkey org-mode-map "\M-\t" 'pcomplete) +;; The following line is necessary under Suse GNU/Linux +(unless (featurep 'xemacs) + (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) +(org-defkey org-mode-map [(shift tab)] 'org-shifttab) +(define-key org-mode-map [backtab] 'org-shifttab) + +(org-defkey org-mode-map [(shift return)] 'org-table-copy-down) +(org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading) +(org-defkey org-mode-map [(meta return)] 'org-meta-return) + +;; Cursor keys with modifiers +(org-defkey org-mode-map [(meta left)] 'org-metaleft) +(org-defkey org-mode-map [(meta right)] 'org-metaright) +(org-defkey org-mode-map [(meta up)] 'org-metaup) +(org-defkey org-mode-map [(meta down)] 'org-metadown) + +(org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft) +(org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright) +(org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup) +(org-defkey org-mode-map [(meta shift down)] 'org-shiftmetadown) + +(org-defkey org-mode-map [(shift up)] 'org-shiftup) +(org-defkey org-mode-map [(shift down)] 'org-shiftdown) +(org-defkey org-mode-map [(shift left)] 'org-shiftleft) +(org-defkey org-mode-map [(shift right)] 'org-shiftright) + +(org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright) +(org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft) +(org-defkey org-mode-map [(control shift up)] 'org-shiftcontrolup) +(org-defkey org-mode-map [(control shift down)] 'org-shiftcontroldown) + +;; Babel keys +(define-key org-mode-map org-babel-key-prefix org-babel-map) +(mapc (lambda (pair) + (define-key org-babel-map (car pair) (cdr pair))) + org-babel-key-bindings) + +;;; Extra keys for tty access. +;; We only set them when really needed because otherwise the +;; menus don't show the simple keys + +(when (or org-use-extra-keys + (featurep 'xemacs) ;; because XEmacs supports multi-device stuff + (not window-system)) + (org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down) + (org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading) + (org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return) + (org-defkey org-mode-map [?\e (return)] 'org-meta-return) + (org-defkey org-mode-map [?\e (left)] 'org-metaleft) + (org-defkey org-mode-map "\C-c\C-xl" 'org-metaleft) + (org-defkey org-mode-map [?\e (right)] 'org-metaright) + (org-defkey org-mode-map "\C-c\C-xr" 'org-metaright) + (org-defkey org-mode-map [?\e (up)] 'org-metaup) + (org-defkey org-mode-map "\C-c\C-xu" 'org-metaup) + (org-defkey org-mode-map [?\e (down)] 'org-metadown) + (org-defkey org-mode-map "\C-c\C-xd" 'org-metadown) + (org-defkey org-mode-map "\C-c\C-xL" 'org-shiftmetaleft) + (org-defkey org-mode-map "\C-c\C-xR" 'org-shiftmetaright) + (org-defkey org-mode-map "\C-c\C-xU" 'org-shiftmetaup) + (org-defkey org-mode-map "\C-c\C-xD" 'org-shiftmetadown) + (org-defkey org-mode-map [?\C-c (up)] 'org-shiftup) + (org-defkey org-mode-map [?\C-c (down)] 'org-shiftdown) + (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft) + (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright) + (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright) + (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft) + (org-defkey org-mode-map [?\e (tab)] 'pcomplete) + (org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading) + (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft) + (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright) + (org-defkey org-mode-map [?\e (shift up)] 'org-shiftmetaup) + (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown)) + +;; All the other keys + +(org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. +(org-defkey org-mode-map "\C-c\C-r" 'org-reveal) +(if (boundp 'narrow-map) + (org-defkey narrow-map "s" 'org-narrow-to-subtree) + (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree)) +(if (boundp 'narrow-map) + (org-defkey narrow-map "b" 'org-narrow-to-block) + (org-defkey org-mode-map "\C-xnb" 'org-narrow-to-block)) +(if (boundp 'narrow-map) + (org-defkey narrow-map "e" 'org-narrow-to-element) + (org-defkey org-mode-map "\C-xne" 'org-narrow-to-element)) +(org-defkey org-mode-map "\C-\M-t" 'org-transpose-element) +(org-defkey org-mode-map "\M-}" 'org-forward-element) +(org-defkey org-mode-map "\M-{" 'org-backward-element) +(org-defkey org-mode-map "\C-c\C-^" 'org-up-element) +(org-defkey org-mode-map "\C-c\C-_" 'org-down-element) +(org-defkey org-mode-map "\C-c\C-f" 'org-forward-heading-same-level) +(org-defkey org-mode-map "\C-c\C-b" 'org-backward-heading-same-level) +(org-defkey org-mode-map "\C-c\M-f" 'org-next-block) +(org-defkey org-mode-map "\C-c\M-b" 'org-previous-block) +(org-defkey org-mode-map "\C-c$" 'org-archive-subtree) +(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) +(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default) +(org-defkey org-mode-map "\C-c\C-xd" 'org-insert-drawer) +(org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag) +(org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling) +(org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) +(org-defkey org-mode-map "\C-c\C-xq" 'org-toggle-tags-groups) +(org-defkey org-mode-map "\C-c\C-j" 'org-goto) +(org-defkey org-mode-map "\C-c\C-t" 'org-todo) +(org-defkey org-mode-map "\C-c\C-q" 'org-set-tags-command) +(org-defkey org-mode-map "\C-c\C-s" 'org-schedule) +(org-defkey org-mode-map "\C-c\C-d" 'org-deadline) +(org-defkey org-mode-map "\C-c;" 'org-toggle-comment) +(org-defkey org-mode-map "\C-c\C-w" 'org-refile) +(org-defkey org-mode-map "\C-c\M-w" 'org-copy) +(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved +(org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res. +(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) +(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading) +(org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift) +(org-defkey org-mode-map "\C-c\C-xv" 'org-copy-visible) +(org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content) +(org-defkey org-mode-map [(shift control return)] 'org-insert-todo-heading-respect-content) +(org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link) +(org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link) +(org-defkey org-mode-map "\C-c\C-l" 'org-insert-link) +(org-defkey org-mode-map "\C-c\C-\M-l" 'org-insert-all-links) +(org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point) +(org-defkey org-mode-map "\C-c%" 'org-mark-ring-push) +(org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto) +(org-defkey org-mode-map "\C-c\C-z" 'org-add-note) ; Alternative binding +(org-defkey org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved +(org-defkey org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r. +(org-defkey org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved +(org-defkey org-mode-map "\C-c\C-y" 'org-evaluate-time-range) +(org-defkey org-mode-map "\C-c>" 'org-goto-calendar) +(org-defkey org-mode-map "\C-c<" 'org-date-from-calendar) +(org-defkey org-mode-map [(control ?,)] 'org-cycle-agenda-files) +(org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files) +(org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front) +(org-defkey org-mode-map "\C-c]" 'org-remove-file) +(org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock) +(org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) +(org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus) +(org-defkey org-mode-map "\C-c*" 'org-ctrl-c-star) +(org-defkey org-mode-map "\C-c^" 'org-sort) +(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) +(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) +(org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies) +(org-defkey org-mode-map [remap open-line] 'org-open-line) +(org-defkey org-mode-map [remap forward-paragraph] 'org-forward-paragraph) +(org-defkey org-mode-map [remap backward-paragraph] 'org-backward-paragraph) +(org-defkey org-mode-map "\C-m" 'org-return) +(org-defkey org-mode-map "\C-j" 'org-return-indent) +(org-defkey org-mode-map "\C-c?" 'org-table-field-info) +(org-defkey org-mode-map "\C-c " 'org-table-blank-field) +(org-defkey org-mode-map "\C-c+" 'org-table-sum) +(org-defkey org-mode-map "\C-c=" 'org-table-eval-formula) +(org-defkey org-mode-map "\C-c'" 'org-edit-special) +(org-defkey org-mode-map "\C-c`" 'org-table-edit-field) +(org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region) +(org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks) +(org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el) +(org-defkey org-mode-map "\C-c\C-a" 'org-attach) +(org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays) +(org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger) +(org-defkey org-mode-map "\C-c\C-e" 'org-export-dispatch) +(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section) +(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize) +(org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action) +(org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) +(org-defkey org-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) +(org-defkey org-mode-map "\C-c@" 'org-mark-subtree) +(org-defkey org-mode-map "\M-h" 'org-mark-element) +(org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree) +;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree) + +(org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special) +(org-defkey org-mode-map "\C-c\C-x\M-w" 'org-copy-special) +(org-defkey org-mode-map "\C-c\C-x\C-y" 'org-paste-special) + +(org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays) +(org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in) +(org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-in-last) +(org-defkey org-mode-map "\C-c\C-x\C-z" 'org-resolve-clocks) +(org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out) +(org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto) +(org-defkey org-mode-map "\C-c\C-x\C-q" 'org-clock-cancel) +(org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display) +(org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report) +(org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) +(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) +(org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images) +(org-defkey org-mode-map "\C-c\C-x\C-\M-v" 'org-redisplay-inline-images) +(org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities) +(org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) +(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) +(org-defkey org-mode-map "\C-c\C-xP" 'org-set-property-and-value) +(org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort) +(org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort) +(org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) +(org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock) +(org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer) +(org-defkey org-mode-map [(control ?c) (control ?x) ?\:] 'org-timer-cancel-timer) + +(org-defkey org-mode-map "\C-c\C-x." 'org-timer) +(org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item) +(org-defkey org-mode-map "\C-c\C-x0" 'org-timer-start) +(org-defkey org-mode-map "\C-c\C-x_" 'org-timer-stop) +(org-defkey org-mode-map "\C-c\C-x," 'org-timer-pause-or-continue) + +(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) + +(define-key org-mode-map "\C-c\C-x!" 'org-reload) + +(define-key org-mode-map "\C-c\C-xg" 'org-feed-update-all) +(define-key org-mode-map "\C-c\C-xG" 'org-feed-goto-inbox) + +(define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation) + + +(when (featurep 'xemacs) + (org-defkey org-mode-map 'button3 'popup-mode-menu)) + + +(defconst org-speed-commands-default + '( + ("Outline Navigation") + ("n" . (org-speed-move-safe 'outline-next-visible-heading)) + ("p" . (org-speed-move-safe 'outline-previous-visible-heading)) + ("f" . (org-speed-move-safe 'org-forward-heading-same-level)) + ("b" . (org-speed-move-safe 'org-backward-heading-same-level)) + ("F" . org-next-block) + ("B" . org-previous-block) + ("u" . (org-speed-move-safe 'outline-up-heading)) + ("j" . org-goto) + ("g" . (org-refile t)) + ("Outline Visibility") + ("c" . org-cycle) + ("C" . org-shifttab) + (" " . org-display-outline-path) + ("s" . org-narrow-to-subtree) + ("=" . org-columns) + ("Outline Structure Editing") + ("U" . org-shiftmetaup) + ("D" . org-shiftmetadown) + ("r" . org-metaright) + ("l" . org-metaleft) + ("R" . org-shiftmetaright) + ("L" . org-shiftmetaleft) + ("i" . (progn (forward-char 1) (call-interactively + 'org-insert-heading-respect-content))) + ("^" . org-sort) + ("w" . org-refile) + ("a" . org-archive-subtree-default-with-confirmation) + ("@" . org-mark-subtree) + ("#" . org-toggle-comment) + ("Clock Commands") + ("I" . org-clock-in) + ("O" . org-clock-out) + ("Meta Data Editing") + ("t" . org-todo) + ("," . (org-priority)) + ("0" . (org-priority ?\ )) + ("1" . (org-priority ?A)) + ("2" . (org-priority ?B)) + ("3" . (org-priority ?C)) + (":" . org-set-tags-command) + ("e" . org-set-effort) + ("E" . org-inc-effort) + ("W" . (lambda(m) (interactive "sMinutes before warning: ") + (org-entry-put (point) "APPT_WARNTIME" m))) + ("Agenda Views etc") + ("v" . org-agenda) + ("/" . org-sparse-tree) + ("Misc") + ("o" . org-open-at-point) + ("?" . org-speed-command-help) + ("<" . (org-agenda-set-restriction-lock 'subtree)) + (">" . (org-agenda-remove-restriction-lock)) + ) + "The default speed commands.") + +(defun org-print-speed-command (e) + (if (> (length (car e)) 1) + (progn + (princ "\n") + (princ (car e)) + (princ "\n") + (princ (make-string (length (car e)) ?-)) + (princ "\n")) + (princ (car e)) + (princ " ") + (if (symbolp (cdr e)) + (princ (symbol-name (cdr e))) + (prin1 (cdr e))) + (princ "\n"))) + +(defun org-speed-command-help () + "Show the available speed commands." + (interactive) + (if (not org-use-speed-commands) + (user-error "Speed commands are not activated, customize `org-use-speed-commands'") + (with-output-to-temp-buffer "*Help*" + (princ "User-defined Speed commands\n===========================\n") + (mapc 'org-print-speed-command org-speed-commands-user) + (princ "\n") + (princ "Built-in Speed commands\n=======================\n") + (mapc 'org-print-speed-command org-speed-commands-default)) + (with-current-buffer "*Help*" + (setq truncate-lines t)))) + +(defun org-speed-move-safe (cmd) + "Execute CMD, but make sure that the cursor always ends up in a headline. +If not, return to the original position and throw an error." + (interactive) + (let ((pos (point))) + (call-interactively cmd) + (unless (and (bolp) (org-at-heading-p)) + (goto-char pos) + (error "Boundary reached while executing %s" cmd)))) + +(defvar org-self-insert-command-undo-counter 0) + +(defvar org-table-auto-blank-field) ; defined in org-table.el +(defvar org-speed-command nil) + +(define-obsolete-function-alias + 'org-speed-command-default-hook 'org-speed-command-activate "24.3") + +(defun org-speed-command-activate (keys) + "Hook for activating single-letter speed commands. +`org-speed-commands-default' specifies a minimal command set. +Use `org-speed-commands-user' for further customization." + (when (or (and (bolp) (looking-at org-outline-regexp)) + (and (functionp org-use-speed-commands) + (funcall org-use-speed-commands))) + (cdr (assoc keys (append org-speed-commands-user + org-speed-commands-default))))) + +(define-obsolete-function-alias + 'org-babel-speed-command-hook 'org-babel-speed-command-activate "24.3") + +(defun org-babel-speed-command-activate (keys) + "Hook for activating single-letter code block commands." + (when (and (bolp) (looking-at org-babel-src-block-regexp)) + (cdr (assoc keys org-babel-key-bindings)))) + +(defcustom org-speed-command-hook + '(org-speed-command-default-hook org-babel-speed-command-hook) + "Hook for activating speed commands at strategic locations. +Hook functions are called in sequence until a valid handler is +found. + +Each hook takes a single argument, a user-pressed command key +which is also a `self-insert-command' from the global map. + +Within the hook, examine the cursor position and the command key +and return nil or a valid handler as appropriate. Handler could +be one of an interactive command, a function, or a form. + +Set `org-use-speed-commands' to non-nil value to enable this +hook. The default setting is `org-speed-command-activate'." + :group 'org-structure + :version "24.1" + :type 'hook) + +(defun org-self-insert-command (N) + "Like `self-insert-command', use overwrite-mode for whitespace in tables. +If the cursor is in a table looking at whitespace, the whitespace is +overwritten, and the table is not marked as requiring realignment." + (interactive "p") + (org-check-before-invisible-edit 'insert) + (cond + ((and org-use-speed-commands + (setq org-speed-command + (run-hook-with-args-until-success + 'org-speed-command-hook (this-command-keys)))) + (cond + ((commandp org-speed-command) + (setq this-command org-speed-command) + (call-interactively org-speed-command)) + ((functionp org-speed-command) + (funcall org-speed-command)) + ((and org-speed-command (listp org-speed-command)) + (eval org-speed-command)) + (t (let (org-use-speed-commands) + (call-interactively 'org-self-insert-command))))) + ((and + (org-table-p) + (progn + ;; check if we blank the field, and if that triggers align + (and (featurep 'org-table) org-table-auto-blank-field + (member last-command + '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c yas/expand)) + (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) + ;; got extra space, this field does not determine column width + (let (org-table-may-need-update) (org-table-blank-field)) + ;; no extra space, this field may determine column width + (org-table-blank-field))) + t) + (eq N 1) + (looking-at "[^|\n]* |")) + (let (org-table-may-need-update) + (goto-char (1- (match-end 0))) + (backward-delete-char 1) + (goto-char (match-beginning 0)) + (self-insert-command N))) + (t + (setq org-table-may-need-update t) + (self-insert-command N) + (org-fix-tags-on-the-fly) + (if org-self-insert-cluster-for-undo + (if (not (eq last-command 'org-self-insert-command)) + (setq org-self-insert-command-undo-counter 1) + (if (>= org-self-insert-command-undo-counter 20) + (setq org-self-insert-command-undo-counter 1) + (and (> org-self-insert-command-undo-counter 0) + buffer-undo-list (listp buffer-undo-list) + (not (cadr buffer-undo-list)) ; remove nil entry + (setcdr buffer-undo-list (cddr buffer-undo-list))) + (setq org-self-insert-command-undo-counter + (1+ org-self-insert-command-undo-counter)))))))) + +(defun org-check-before-invisible-edit (kind) + "Check is editing if kind KIND would be dangerous with invisible text around. +The detailed reaction depends on the user option `org-catch-invisible-edits'." + ;; First, try to get out of here as quickly as possible, to reduce overhead + (if (and org-catch-invisible-edits + (or (not (boundp 'visible-mode)) (not visible-mode)) + (or (get-char-property (point) 'invisible) + (get-char-property (max (point-min) (1- (point))) 'invisible))) + ;; OK, we need to take a closer look + (let* ((invisible-at-point (get-char-property (point) 'invisible)) + (invisible-before-point (if (bobp) nil (get-char-property + (1- (point)) 'invisible))) + (border-and-ok-direction + (or + ;; Check if we are acting predictably before invisible text + (and invisible-at-point (not invisible-before-point) + (memq kind '(insert delete-backward))) + ;; Check if we are acting predictably after invisible text + ;; This works not well, and I have turned it off. It seems + ;; better to always show and stop after invisible text. + ;; (and (not invisible-at-point) invisible-before-point + ;; (memq kind '(insert delete))) + ))) + (when (or (memq invisible-at-point '(outline org-hide-block t)) + (memq invisible-before-point '(outline org-hide-block t))) + (if (eq org-catch-invisible-edits 'error) + (user-error "Editing in invisible areas is prohibited, make them visible first")) + (if (and org-custom-properties-overlays + (y-or-n-p "Display invisible properties in this buffer? ")) + (org-toggle-custom-properties-visibility) + ;; Make the area visible + (save-excursion + (if invisible-before-point + (goto-char (previous-single-char-property-change + (point) 'invisible))) + (show-subtree)) + (cond + ((eq org-catch-invisible-edits 'show) + ;; That's it, we do the edit after showing + (message + "Unfolding invisible region around point before editing") + (sit-for 1)) + ((and (eq org-catch-invisible-edits 'smart) + border-and-ok-direction) + (message "Unfolding invisible region around point before editing")) + (t + ;; Don't do the edit, make the user repeat it in full visibility + (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) + +(defun org-fix-tags-on-the-fly () + (when (and (equal (char-after (point-at-bol)) ?*) + (org-at-heading-p)) + (org-align-tags-here org-tags-column))) + +(defun org-delete-backward-char (N) + "Like `delete-backward-char', insert whitespace at field end in tables. +When deleting backwards, in tables this function will insert whitespace in +front of the next \"|\" separator, to keep the table aligned. The table will +still be marked for re-alignment if the field did fill the entire column, +because, in this case the deletion might narrow the column." + (interactive "p") + (save-match-data + (org-check-before-invisible-edit 'delete-backward) + (if (and (org-table-p) + (eq N 1) + (string-match "|" (buffer-substring (point-at-bol) (point))) + (looking-at ".*?|")) + (let ((pos (point)) + (noalign (looking-at "[^|\n\r]* |")) + (c org-table-may-need-update)) + (backward-delete-char N) + (if (not overwrite-mode) + (progn + (skip-chars-forward "^|") + (insert " ") + (goto-char (1- pos)))) + ;; noalign: if there were two spaces at the end, this field + ;; does not determine the width of the column. + (if noalign (setq org-table-may-need-update c))) + (backward-delete-char N) + (org-fix-tags-on-the-fly)))) + +(defun org-delete-char (N) + "Like `delete-char', but insert whitespace at field end in tables. +When deleting characters, in tables this function will insert whitespace in +front of the next \"|\" separator, to keep the table aligned. The table will +still be marked for re-alignment if the field did fill the entire column, +because, in this case the deletion might narrow the column." + (interactive "p") + (save-match-data + (org-check-before-invisible-edit 'delete) + (if (and (org-table-p) + (not (bolp)) + (not (= (char-after) ?|)) + (eq N 1)) + (if (looking-at ".*?|") + (let ((pos (point)) + (noalign (looking-at "[^|\n\r]* |")) + (c org-table-may-need-update)) + (replace-match + (concat (substring (match-string 0) 1 -1) " |") nil t) + (goto-char pos) + ;; noalign: if there were two spaces at the end, this field + ;; does not determine the width of the column. + (if noalign (setq org-table-may-need-update c))) + (delete-char N)) + (delete-char N) + (org-fix-tags-on-the-fly)))) + +;; Make `delete-selection-mode' work with org-mode and orgtbl-mode +(put 'org-self-insert-command 'delete-selection + (lambda () + (not (run-hook-with-args-until-success + 'self-insert-uses-region-functions)))) +(put 'orgtbl-self-insert-command 'delete-selection + (lambda () + (not (run-hook-with-args-until-success + 'self-insert-uses-region-functions)))) +(put 'org-delete-char 'delete-selection 'supersede) +(put 'org-delete-backward-char 'delete-selection 'supersede) +(put 'org-yank 'delete-selection 'yank) + +;; Make `flyspell-mode' delay after some commands +(put 'org-self-insert-command 'flyspell-delayed t) +(put 'orgtbl-self-insert-command 'flyspell-delayed t) +(put 'org-delete-char 'flyspell-delayed t) +(put 'org-delete-backward-char 'flyspell-delayed t) + +;; Make pabbrev-mode expand after org-mode commands +(put 'org-self-insert-command 'pabbrev-expand-after-command t) +(put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t) + +(defun org-remap (map &rest commands) + "In MAP, remap the functions given in COMMANDS. +COMMANDS is a list of alternating OLDDEF NEWDEF command names." + (let (new old) + (while commands + (setq old (pop commands) new (pop commands)) + (if (fboundp 'command-remapping) + (org-defkey map (vector 'remap old) new) + (substitute-key-definition old new map global-map))))) + +(defun org-transpose-words () + "Transpose words for Org. +This uses the `org-mode-transpose-word-syntax-table' syntax +table, which interprets characters in `org-emphasis-alist' as +word constituents." + (interactive) + (with-syntax-table org-mode-transpose-word-syntax-table + (call-interactively 'transpose-words))) +(org-remap org-mode-map 'transpose-words 'org-transpose-words) + +(when (eq org-enable-table-editor 'optimized) + ;; If the user wants maximum table support, we need to hijack + ;; some standard editing functions + (org-remap org-mode-map + 'self-insert-command 'org-self-insert-command + 'delete-char 'org-delete-char + 'delete-backward-char 'org-delete-backward-char) + (org-defkey org-mode-map "|" 'org-force-self-insert)) + +(defvar org-ctrl-c-ctrl-c-hook nil + "Hook for functions attaching themselves to `C-c C-c'. + +This can be used to add additional functionality to the C-c C-c +key which executes context-dependent commands. This hook is run +before any other test, while `org-ctrl-c-ctrl-c-final-hook' is +run after the last test. + +Each function will be called with no arguments. The function +must check if the context is appropriate for it to act. If yes, +it should do its thing and then return a non-nil value. If the +context is wrong, just do nothing and return nil.") + +(defvar org-ctrl-c-ctrl-c-final-hook nil + "Hook for functions attaching themselves to `C-c C-c'. + +This can be used to add additional functionality to the C-c C-c +key which executes context-dependent commands. This hook is run +after any other test, while `org-ctrl-c-ctrl-c-hook' is run +before the first test. + +Each function will be called with no arguments. The function +must check if the context is appropriate for it to act. If yes, +it should do its thing and then return a non-nil value. If the +context is wrong, just do nothing and return nil.") + +(defvar org-tab-first-hook nil + "Hook for functions to attach themselves to TAB. +See `org-ctrl-c-ctrl-c-hook' for more information. +This hook runs as the first action when TAB is pressed, even before +`org-cycle' messes around with the `outline-regexp' to cater for +inline tasks and plain list item folding. +If any function in this hook returns t, any other actions that +would have been caused by TAB (such as table field motion or visibility +cycling) will not occur.") + +(defvar org-tab-after-check-for-table-hook nil + "Hook for functions to attach themselves to TAB. +See `org-ctrl-c-ctrl-c-hook' for more information. +This hook runs after it has been established that the cursor is not in a +table, but before checking if the cursor is in a headline or if global cycling +should be done. +If any function in this hook returns t, not other actions like visibility +cycling will be done.") + +(defvar org-tab-after-check-for-cycling-hook nil + "Hook for functions to attach themselves to TAB. +See `org-ctrl-c-ctrl-c-hook' for more information. +This hook runs after it has been established that not table field motion and +not visibility should be done because of current context. This is probably +the place where a package like yasnippets can hook in.") + +(defvar org-tab-before-tab-emulation-hook nil + "Hook for functions to attach themselves to TAB. +See `org-ctrl-c-ctrl-c-hook' for more information. +This hook runs after every other options for TAB have been exhausted, but +before indentation and \t insertion takes place.") + +(defvar org-metaleft-hook nil + "Hook for functions attaching themselves to `M-left'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-metaright-hook nil + "Hook for functions attaching themselves to `M-right'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-metaup-hook nil + "Hook for functions attaching themselves to `M-up'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-metadown-hook nil + "Hook for functions attaching themselves to `M-down'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftmetaleft-hook nil + "Hook for functions attaching themselves to `M-S-left'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftmetaright-hook nil + "Hook for functions attaching themselves to `M-S-right'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftmetaup-hook nil + "Hook for functions attaching themselves to `M-S-up'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftmetadown-hook nil + "Hook for functions attaching themselves to `M-S-down'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-metareturn-hook nil + "Hook for functions attaching themselves to `M-RET'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftup-hook nil + "Hook for functions attaching themselves to `S-up'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftup-final-hook nil + "Hook for functions attaching themselves to `S-up'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftdown-hook nil + "Hook for functions attaching themselves to `S-down'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftdown-final-hook nil + "Hook for functions attaching themselves to `S-down'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftleft-hook nil + "Hook for functions attaching themselves to `S-left'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftleft-final-hook nil + "Hook for functions attaching themselves to `S-left'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftright-hook nil + "Hook for functions attaching themselves to `S-right'. +See `org-ctrl-c-ctrl-c-hook' for more information.") +(defvar org-shiftright-final-hook nil + "Hook for functions attaching themselves to `S-right'. +This one runs after all other options except shift-select have been excluded. +See `org-ctrl-c-ctrl-c-hook' for more information.") + +(defun org-modifier-cursor-error () + "Throw an error, a modified cursor command was applied in wrong context." + (user-error "This command is active in special context like tables, headlines or items")) + +(defun org-shiftselect-error () + "Throw an error because Shift-Cursor command was applied in wrong context." + (if (and (boundp 'shift-select-mode) shift-select-mode) + (user-error "To use shift-selection with Org-mode, customize `org-support-shift-select'") + (user-error "This command works only in special context like headlines or timestamps"))) + +(defun org-call-for-shift-select (cmd) + (let ((this-command-keys-shift-translated t)) + (call-interactively cmd))) + +(defun org-shifttab (&optional arg) + "Global visibility cycling or move to previous table field. +Call `org-table-previous-field' within a table. +When ARG is nil, cycle globally through visibility states. +When ARG is a numeric prefix, show contents of this level." + (interactive "P") + (cond + ((org-at-table-p) (call-interactively 'org-table-previous-field)) + ((integerp arg) + (let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg))) + (message "Content view to level: %d" arg) + (org-content (prefix-numeric-value arg2)) + (org-cycle-show-empty-lines t) + (setq org-cycle-global-status 'overview))) + (t (call-interactively 'org-global-cycle)))) + +(defun org-shiftmetaleft () + "Promote subtree or delete table column. +Calls `org-promote-subtree', `org-outdent-item-tree', or +`org-table-delete-column', depending on context. See the +individual commands for more information." + (interactive) + (cond + ((run-hook-with-args-until-success 'org-shiftmetaleft-hook)) + ((org-at-table-p) (call-interactively 'org-table-delete-column)) + ((org-at-heading-p) (call-interactively 'org-promote-subtree)) + ((if (not (org-region-active-p)) (org-at-item-p) + (save-excursion (goto-char (region-beginning)) + (org-at-item-p))) + (call-interactively 'org-outdent-item-tree)) + (t (org-modifier-cursor-error)))) + +(defun org-shiftmetaright () + "Demote subtree or insert table column. +Calls `org-demote-subtree', `org-indent-item-tree', or +`org-table-insert-column', depending on context. See the +individual commands for more information." + (interactive) + (cond + ((run-hook-with-args-until-success 'org-shiftmetaright-hook)) + ((org-at-table-p) (call-interactively 'org-table-insert-column)) + ((org-at-heading-p) (call-interactively 'org-demote-subtree)) + ((if (not (org-region-active-p)) (org-at-item-p) + (save-excursion (goto-char (region-beginning)) + (org-at-item-p))) + (call-interactively 'org-indent-item-tree)) + (t (org-modifier-cursor-error)))) + +(defun org-shiftmetaup (&optional arg) + "Move subtree up or kill table row. +Calls `org-move-subtree-up' or `org-table-kill-row' or +`org-move-item-up' or `org-timestamp-up', depending on context. +See the individual commands for more information." + (interactive "P") + (cond + ((run-hook-with-args-until-success 'org-shiftmetaup-hook)) + ((org-at-table-p) (call-interactively 'org-table-kill-row)) + ((org-at-heading-p) (call-interactively 'org-move-subtree-up)) + ((org-at-item-p) (call-interactively 'org-move-item-up)) + ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) + (call-interactively 'org-timestamp-up))) + (t (call-interactively 'org-drag-line-backward)))) + +(defun org-shiftmetadown (&optional arg) + "Move subtree down or insert table row. +Calls `org-move-subtree-down' or `org-table-insert-row' or +`org-move-item-down' or `org-timestamp-up', depending on context. +See the individual commands for more information." + (interactive "P") + (cond + ((run-hook-with-args-until-success 'org-shiftmetadown-hook)) + ((org-at-table-p) (call-interactively 'org-table-insert-row)) + ((org-at-heading-p) (call-interactively 'org-move-subtree-down)) + ((org-at-item-p) (call-interactively 'org-move-item-down)) + ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) + (call-interactively 'org-timestamp-down))) + (t (call-interactively 'org-drag-line-forward)))) + +(defsubst org-hidden-tree-error () + (user-error + "Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>")) + +(defun org-metaleft (&optional arg) + "Promote heading or move table column to left. +Calls `org-do-promote' or `org-table-move-column', depending on context. +With no specific context, calls the Emacs default `backward-word'. +See the individual commands for more information." + (interactive "P") + (cond + ((run-hook-with-args-until-success 'org-metaleft-hook)) + ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) + ((org-with-limited-levels + (or (org-at-heading-p) + (and (org-region-active-p) + (save-excursion + (goto-char (region-beginning)) + (org-at-heading-p))))) + (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) + (call-interactively 'org-do-promote)) + ;; At an inline task. + ((org-at-heading-p) + (call-interactively 'org-inlinetask-promote)) + ((or (org-at-item-p) + (and (org-region-active-p) + (save-excursion + (goto-char (region-beginning)) + (org-at-item-p)))) + (when (org-check-for-hidden 'items) (org-hidden-tree-error)) + (call-interactively 'org-outdent-item)) + (t (call-interactively 'backward-word)))) + +(defun org-metaright (&optional arg) + "Demote a subtree, a list item or move table column to right. +In front of a drawer or a block keyword, indent it correctly. +With no specific context, calls the Emacs default `forward-word'. +See the individual commands for more information." + (interactive "P") + (cond + ((run-hook-with-args-until-success 'org-metaright-hook)) + ((org-at-table-p) (call-interactively 'org-table-move-column)) + ((org-at-drawer-p) (call-interactively 'org-indent-drawer)) + ((org-at-block-p) (call-interactively 'org-indent-block)) + ((org-with-limited-levels + (or (org-at-heading-p) + (and (org-region-active-p) + (save-excursion + (goto-char (region-beginning)) + (org-at-heading-p))))) + (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) + (call-interactively 'org-do-demote)) + ;; At an inline task. + ((org-at-heading-p) + (call-interactively 'org-inlinetask-demote)) + ((or (org-at-item-p) + (and (org-region-active-p) + (save-excursion + (goto-char (region-beginning)) + (org-at-item-p)))) + (when (org-check-for-hidden 'items) (org-hidden-tree-error)) + (call-interactively 'org-indent-item)) + (t (call-interactively 'forward-word)))) + +(defun org-check-for-hidden (what) + "Check if there are hidden headlines/items in the current visual line. +WHAT can be either `headlines' or `items'. If the current line is +an outline or item heading and it has a folded subtree below it, +this function returns t, nil otherwise." + (let ((re (cond + ((eq what 'headlines) org-outline-regexp-bol) + ((eq what 'items) (org-item-beginning-re)) + (t (error "This should not happen")))) + beg end) + (save-excursion + (catch 'exit + (unless (org-region-active-p) + (setq beg (point-at-bol)) + (beginning-of-line 2) + (while (and (not (eobp)) ;; this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (beginning-of-line 2)) + (setq end (point)) + (goto-char beg) + (goto-char (point-at-eol)) + (setq end (max end (point))) + (while (re-search-forward re end t) + (if (get-char-property (match-beginning 0) 'invisible) + (throw 'exit t)))) + nil)))) + +(defun org-metaup (&optional arg) + "Move subtree up or move table row up. +Calls `org-move-subtree-up' or `org-table-move-row' or +`org-move-item-up', depending on context. See the individual commands +for more information." + (interactive "P") + (cond + ((run-hook-with-args-until-success 'org-metaup-hook)) + ((org-region-active-p) + (let* ((a (min (region-beginning) (region-end))) + (b (1- (max (region-beginning) (region-end)))) + (c (save-excursion (goto-char a) + (move-beginning-of-line 0))) + (d (save-excursion (goto-char a) + (move-end-of-line 0) (point)))) + (transpose-regions a b c d) + (goto-char c))) + ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) + ((org-at-heading-p) (call-interactively 'org-move-subtree-up)) + ((org-at-item-p) (call-interactively 'org-move-item-up)) + (t (org-drag-element-backward)))) + +(defun org-metadown (&optional arg) + "Move subtree down or move table row down. +Calls `org-move-subtree-down' or `org-table-move-row' or +`org-move-item-down', depending on context. See the individual +commands for more information." + (interactive "P") + (cond + ((run-hook-with-args-until-success 'org-metadown-hook)) + ((org-region-active-p) + (let* ((a (min (region-beginning) (region-end))) + (b (max (region-beginning) (region-end))) + (c (save-excursion (goto-char b) + (move-beginning-of-line 1))) + (d (save-excursion (goto-char b) + (move-end-of-line 1) (1+ (point))))) + (transpose-regions a b c d) + (goto-char d))) + ((org-at-table-p) (call-interactively 'org-table-move-row)) + ((org-at-heading-p) (call-interactively 'org-move-subtree-down)) + ((org-at-item-p) (call-interactively 'org-move-item-down)) + (t (org-drag-element-forward)))) + +(defun org-shiftup (&optional arg) + "Increase item in timestamp or increase priority of current headline. +Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item', +depending on context. See the individual commands for more information." + (interactive "P") + (cond + ((run-hook-with-args-until-success 'org-shiftup-hook)) + ((and org-support-shift-select (org-region-active-p)) + (org-call-for-shift-select 'previous-line)) + ((org-at-timestamp-p t) + (call-interactively (if org-edit-timestamp-down-means-later + 'org-timestamp-down 'org-timestamp-up))) + ((and (not (eq org-support-shift-select 'always)) + org-enable-priority-commands + (org-at-heading-p)) + (call-interactively 'org-priority-up)) + ((and (not org-support-shift-select) (org-at-item-p)) + (call-interactively 'org-previous-item)) + ((org-clocktable-try-shift 'up arg)) + ((run-hook-with-args-until-success 'org-shiftup-final-hook)) + (org-support-shift-select + (org-call-for-shift-select 'previous-line)) + (t (org-shiftselect-error)))) + +(defun org-shiftdown (&optional arg) + "Decrease item in timestamp or decrease priority of current headline. +Calls `org-timestamp-down' or `org-priority-down', or `org-next-item' +depending on context. See the individual commands for more information." + (interactive "P") + (cond + ((run-hook-with-args-until-success 'org-shiftdown-hook)) + ((and org-support-shift-select (org-region-active-p)) + (org-call-for-shift-select 'next-line)) + ((org-at-timestamp-p t) + (call-interactively (if org-edit-timestamp-down-means-later + 'org-timestamp-up 'org-timestamp-down))) + ((and (not (eq org-support-shift-select 'always)) + org-enable-priority-commands + (org-at-heading-p)) + (call-interactively 'org-priority-down)) + ((and (not org-support-shift-select) (org-at-item-p)) + (call-interactively 'org-next-item)) + ((org-clocktable-try-shift 'down arg)) + ((run-hook-with-args-until-success 'org-shiftdown-final-hook)) + (org-support-shift-select + (org-call-for-shift-select 'next-line)) + (t (org-shiftselect-error)))) + +(defun org-shiftright (&optional arg) + "Cycle the thing at point or in the current line, depending on context. +Depending on context, this does one of the following: + +- switch a timestamp at point one day into the future +- on a headline, switch to the next TODO keyword. +- on an item, switch entire list to the next bullet type +- on a property line, switch to the next allowed value +- on a clocktable definition line, move time block into the future" + (interactive "P") + (cond + ((run-hook-with-args-until-success 'org-shiftright-hook)) + ((and org-support-shift-select (org-region-active-p)) + (org-call-for-shift-select 'forward-char)) + ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) + ((and (not (eq org-support-shift-select 'always)) + (org-at-heading-p)) + (let ((org-inhibit-logging + (not org-treat-S-cursor-todo-selection-as-state-change)) + (org-inhibit-blocking + (not org-treat-S-cursor-todo-selection-as-state-change))) + (org-call-with-arg 'org-todo 'right))) + ((or (and org-support-shift-select + (not (eq org-support-shift-select 'always)) + (org-at-item-bullet-p)) + (and (not org-support-shift-select) (org-at-item-p))) + (org-call-with-arg 'org-cycle-list-bullet nil)) + ((and (not (eq org-support-shift-select 'always)) + (org-at-property-p)) + (call-interactively 'org-property-next-allowed-value)) + ((org-clocktable-try-shift 'right arg)) + ((run-hook-with-args-until-success 'org-shiftright-final-hook)) + (org-support-shift-select + (org-call-for-shift-select 'forward-char)) + (t (org-shiftselect-error)))) + +(defun org-shiftleft (&optional arg) + "Cycle the thing at point or in the current line, depending on context. +Depending on context, this does one of the following: + +- switch a timestamp at point one day into the past +- on a headline, switch to the previous TODO keyword. +- on an item, switch entire list to the previous bullet type +- on a property line, switch to the previous allowed value +- on a clocktable definition line, move time block into the past" + (interactive "P") + (cond + ((run-hook-with-args-until-success 'org-shiftleft-hook)) + ((and org-support-shift-select (org-region-active-p)) + (org-call-for-shift-select 'backward-char)) + ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) + ((and (not (eq org-support-shift-select 'always)) + (org-at-heading-p)) + (let ((org-inhibit-logging + (not org-treat-S-cursor-todo-selection-as-state-change)) + (org-inhibit-blocking + (not org-treat-S-cursor-todo-selection-as-state-change))) + (org-call-with-arg 'org-todo 'left))) + ((or (and org-support-shift-select + (not (eq org-support-shift-select 'always)) + (org-at-item-bullet-p)) + (and (not org-support-shift-select) (org-at-item-p))) + (org-call-with-arg 'org-cycle-list-bullet 'previous)) + ((and (not (eq org-support-shift-select 'always)) + (org-at-property-p)) + (call-interactively 'org-property-previous-allowed-value)) + ((org-clocktable-try-shift 'left arg)) + ((run-hook-with-args-until-success 'org-shiftleft-final-hook)) + (org-support-shift-select + (org-call-for-shift-select 'backward-char)) + (t (org-shiftselect-error)))) + +(defun org-shiftcontrolright () + "Switch to next TODO set." + (interactive) + (cond + ((and org-support-shift-select (org-region-active-p)) + (org-call-for-shift-select 'forward-word)) + ((and (not (eq org-support-shift-select 'always)) + (org-at-heading-p)) + (org-call-with-arg 'org-todo 'nextset)) + (org-support-shift-select + (org-call-for-shift-select 'forward-word)) + (t (org-shiftselect-error)))) + +(defun org-shiftcontrolleft () + "Switch to previous TODO set." + (interactive) + (cond + ((and org-support-shift-select (org-region-active-p)) + (org-call-for-shift-select 'backward-word)) + ((and (not (eq org-support-shift-select 'always)) + (org-at-heading-p)) + (org-call-with-arg 'org-todo 'previousset)) + (org-support-shift-select + (org-call-for-shift-select 'backward-word)) + (t (org-shiftselect-error)))) + +(defun org-shiftcontrolup (&optional n) + "Change timestamps synchronously up in CLOCK log lines. +Optional argument N tells to change by that many units." + (interactive "P") + (if (and (org-at-clock-log-p) (org-at-timestamp-p t)) + (let (org-support-shift-select) + (org-clock-timestamps-up n)) + (user-error "Not at a clock log"))) + +(defun org-shiftcontroldown (&optional n) + "Change timestamps synchronously down in CLOCK log lines. +Optional argument N tells to change by that many units." + (interactive "P") + (if (and (org-at-clock-log-p) (org-at-timestamp-p t)) + (let (org-support-shift-select) + (org-clock-timestamps-down n)) + (user-error "Not at a clock log"))) + +(defun org-ctrl-c-ret () + "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context." + (interactive) + (cond + ((org-at-table-p) (call-interactively 'org-table-hline-and-move)) + (t (call-interactively 'org-insert-heading)))) + +(defun org-find-visible () + (let ((s (point))) + (while (and (not (= (point-max) (setq s (next-overlay-change s)))) + (get-char-property s 'invisible))) + s)) +(defun org-find-invisible () + (let ((s (point))) + (while (and (not (= (point-max) (setq s (next-overlay-change s)))) + (not (get-char-property s 'invisible)))) + s)) + +(defun org-copy-visible (beg end) + "Copy the visible parts of the region." + (interactive "r") + (let (snippets s) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (setq s (goto-char (point-min))) + (while (not (= (point) (point-max))) + (goto-char (org-find-invisible)) + (push (buffer-substring s (point)) snippets) + (setq s (goto-char (org-find-visible)))))) + (kill-new (apply 'concat (nreverse snippets))))) + +(defun org-copy-special () + "Copy region in table or copy current subtree. +Calls `org-table-copy' or `org-copy-subtree', depending on context. +See the individual commands for more information." + (interactive) + (call-interactively + (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree))) + +(defun org-cut-special () + "Cut region in table or cut current subtree. +Calls `org-table-copy' or `org-cut-subtree', depending on context. +See the individual commands for more information." + (interactive) + (call-interactively + (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree))) + +(defun org-paste-special (arg) + "Paste rectangular region into table, or past subtree relative to level. +Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context. +See the individual commands for more information." + (interactive "P") + (if (org-at-table-p) + (org-table-paste-rectangle) + (org-paste-subtree arg))) + +(defsubst org-in-fixed-width-region-p () + "Is point in a fixed-width region?" + (save-match-data + (eq 'fixed-width (org-element-type (org-element-at-point))))) + +(defun org-edit-special (&optional arg) + "Call a special editor for the element at point. +When at a table, call the formula editor with `org-table-edit-formulas'. +When in a source code block, call `org-edit-src-code'. +When in a fixed-width region, call `org-edit-fixed-width-region'. +When at an #+INCLUDE keyword, visit the included file. +On a link, call `ffap' to visit the link at point. +Otherwise, return a user error." + (interactive "P") + (let ((element (org-element-at-point))) + (assert (not buffer-read-only) nil + "Buffer is read-only: %s" (buffer-name)) + (case (org-element-type element) + (src-block + (if (not arg) (org-edit-src-code) + (let* ((info (org-babel-get-src-block-info)) + (lang (nth 0 info)) + (params (nth 2 info)) + (session (cdr (assq :session params)))) + (if (not session) (org-edit-src-code) + ;; At a src-block with a session and function called with + ;; an ARG: switch to the buffer related to the inferior + ;; process. + (switch-to-buffer + (funcall (intern (concat "org-babel-prep-session:" lang)) + session params)))))) + (keyword + (if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE")) + (find-file + (org-remove-double-quotes + (car (org-split-string (org-element-property :value element))))) + (user-error "No special environment to edit here"))) + (table + (if (eq (org-element-property :type element) 'table.el) + (org-edit-src-code) + (call-interactively 'org-table-edit-formulas))) + ;; Only Org tables contain `table-row' type elements. + (table-row (call-interactively 'org-table-edit-formulas)) + ((example-block export-block) (org-edit-src-code)) + (fixed-width (org-edit-fixed-width-region)) + (otherwise + ;; No notable element at point. Though, we may be at a link, + ;; which is an object. Thus, scan deeper. + (if (eq (org-element-type (org-element-context element)) 'link) + (call-interactively 'ffap) + (user-error "No special environment to edit here")))))) + +(defvar org-table-coordinate-overlays) ; defined in org-table.el +(defun org-ctrl-c-ctrl-c (&optional arg) + "Set tags in headline, or update according to changed information at point. + +This command does many different things, depending on context: + +- If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location, + this is what we do. + +- If the cursor is on a statistics cookie, update it. + +- If the cursor is in a headline, prompt for tags and insert them + into the current line, aligned to `org-tags-column'. When called + with prefix arg, realign all tags in the current buffer. + +- If the cursor is in one of the special #+KEYWORD lines, this + triggers scanning the buffer for these lines and updating the + information. + +- If the cursor is inside a table, realign the table. This command + works even if the automatic table editor has been turned off. + +- If the cursor is on a #+TBLFM line, re-apply the formulas to + the entire table. + +- If the cursor is at a footnote reference or definition, jump to + the corresponding definition or references, respectively. + +- If the cursor is a the beginning of a dynamic block, update it. + +- If the current buffer is a capture buffer, close note and file it. + +- If the cursor is on a <<<target>>>, update radio targets and + corresponding links in this buffer. + +- If the cursor is on a numbered item in a plain list, renumber the + ordered list. + +- If the cursor is on a checkbox, toggle it. + +- If the cursor is on a code block, evaluate it. The variable + `org-confirm-babel-evaluate' can be used to control prompting + before code block evaluation, by default every code block + evaluation requires confirmation. Code block evaluation can be + inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'." + (interactive "P") + (cond + ((or (and (boundp 'org-clock-overlays) org-clock-overlays) + org-occur-highlights + org-latex-fragment-image-overlays) + (and (boundp 'org-clock-overlays) (org-clock-remove-overlays)) + (org-remove-occur-highlights) + (org-remove-latex-fragment-image-overlays) + (message "Temporary highlights/overlays removed from current buffer")) + ((and (local-variable-p 'org-finish-function (current-buffer)) + (fboundp org-finish-function)) + (funcall org-finish-function)) + ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) + (t + (let* ((context (org-element-context)) (type (org-element-type context))) + ;; Test if point is within a blank line. + (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$")) + (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) + (user-error "C-c C-c can do nothing useful at this location")) + (case type + ;; When at a link, act according to the parent instead. + (link (setq context (org-element-property :parent context)) + (setq type (org-element-type context))) + ;; Unsupported object types: refer to the first supported + ;; element or object containing it. + ((bold code entity export-snippet inline-babel-call inline-src-block + italic latex-fragment line-break macro strike-through subscript + superscript underline verbatim) + (while (and (setq context (org-element-property :parent context)) + (not (memq (setq type (org-element-type context)) + '(radio-target paragraph verse-block + table-cell))))))) + ;; For convenience: at the first line of a paragraph on the + ;; same line as an item, apply function on that item instead. + (when (eq type 'paragraph) + (let ((parent (org-element-property :parent context))) + (when (and (eq (org-element-type parent) 'item) + (= (point-at-bol) (org-element-property :begin parent))) + (setq context parent type 'item)))) + ;; Act according to type of element or object at point. + (case type + (clock (org-clock-update-time-maybe)) + (dynamic-block + (save-excursion + (goto-char (org-element-property :post-affiliated context)) + (org-update-dblock))) + (footnote-definition + (goto-char (org-element-property :post-affiliated context)) + (call-interactively 'org-footnote-action)) + (footnote-reference (call-interactively 'org-footnote-action)) + ((headline inlinetask) + (save-excursion (goto-char (org-element-property :begin context)) + (call-interactively 'org-set-tags))) + (item + ;; At an item: a double C-u set checkbox to "[-]" + ;; unconditionally, whereas a single one will toggle its + ;; presence. Without an universal argument, if the item + ;; has a checkbox, toggle it. Otherwise repair the list. + (let* ((box (org-element-property :checkbox context)) + (struct (org-element-property :structure context)) + (old-struct (copy-tree struct)) + (parents (org-list-parents-alist struct)) + (prevs (org-list-prevs-alist struct)) + (orderedp (org-not-nil (org-entry-get nil "ORDERED")))) + (org-list-set-checkbox + (org-element-property :begin context) struct + (cond ((equal arg '(16)) "[-]") + ((and (not box) (equal arg '(4))) "[ ]") + ((or (not box) (equal arg '(4))) nil) + ((eq box 'on) "[ ]") + (t "[X]"))) + ;; Mimic `org-list-write-struct' but with grabbing + ;; a return value from `org-list-struct-fix-box'. + (org-list-struct-fix-ind struct parents 2) + (org-list-struct-fix-item-end struct) + (org-list-struct-fix-bul struct prevs) + (org-list-struct-fix-ind struct parents) + (let ((block-item + (org-list-struct-fix-box struct parents prevs orderedp))) + (if (and box (equal struct old-struct)) + (if (equal arg '(16)) + (message "Checkboxes already reset") + (user-error "Cannot toggle this checkbox: %s" + (if (eq box 'on) + "all subitems checked" + "unchecked subitems"))) + (org-list-struct-apply-struct struct old-struct) + (org-update-checkbox-count-maybe)) + (when block-item + (message "Checkboxes were removed due to empty box at line %d" + (org-current-line block-item)))))) + (keyword + (let ((org-inhibit-startup-visibility-stuff t) + (org-startup-align-all-tables nil)) + (when (boundp 'org-table-coordinate-overlays) + (mapc 'delete-overlay org-table-coordinate-overlays) + (setq org-table-coordinate-overlays nil)) + (org-save-outline-visibility 'use-markers (org-mode-restart))) + (message "Local setup has been refreshed")) + (plain-list + ;; At a plain list, with a double C-u argument, set + ;; checkboxes of each item to "[-]", whereas a single one + ;; will toggle their presence according to the state of the + ;; first item in the list. Without an argument, repair the + ;; list. + (let* ((begin (org-element-property :contents-begin context)) + (beginm (move-marker (make-marker) begin)) + (struct (org-element-property :structure context)) + (old-struct (copy-tree struct)) + (first-box (save-excursion + (goto-char begin) + (looking-at org-list-full-item-re) + (match-string-no-properties 3))) + (new-box (cond ((equal arg '(16)) "[-]") + ((equal arg '(4)) (unless first-box "[ ]")) + ((equal first-box "[X]") "[ ]") + (t "[X]")))) + (cond + (arg + (mapc (lambda (pos) (org-list-set-checkbox pos struct new-box)) + (org-list-get-all-items + begin struct (org-list-prevs-alist struct)))) + ((and first-box (eq (point) begin)) + ;; For convenience, when point is at bol on the first + ;; item of the list and no argument is provided, simply + ;; toggle checkbox of that item, if any. + (org-list-set-checkbox begin struct new-box))) + (org-list-write-struct + struct (org-list-parents-alist struct) old-struct) + (org-update-checkbox-count-maybe) + (save-excursion (goto-char beginm) (org-list-send-list 'maybe)))) + ((property-drawer node-property) + (call-interactively 'org-property-action)) + ((radio-target target) + (call-interactively 'org-update-radio-target-regexp)) + (statistics-cookie + (call-interactively 'org-update-statistics-cookies)) + ((table table-cell table-row) + ;; At a table, recalculate every field and align it. Also + ;; send the table if necessary. If the table has + ;; a `table.el' type, just give up. At a table row or + ;; cell, maybe recalculate line but always align table. + (if (eq (org-element-property :type context) 'table.el) + (message "Use C-c ' to edit table.el tables") + (let ((org-enable-table-editor t)) + (if (or (eq type 'table) + ;; Check if point is at a TBLFM line. + (and (eq type 'table-row) + (= (point) (org-element-property :end context)))) + (save-excursion + (if (org-at-TBLFM-p) + (progn (require 'org-table) + (org-table-calc-current-TBLFM)) + (goto-char (org-element-property :contents-begin context)) + (org-call-with-arg 'org-table-recalculate (or arg t)) + (orgtbl-send-table 'maybe))) + (org-table-maybe-eval-formula) + (cond (arg (call-interactively 'org-table-recalculate)) + ((org-table-maybe-recalculate-line)) + (t (org-table-align))))))) + (timestamp (org-timestamp-change 0 'day)) + (otherwise + (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) + (user-error + "C-c C-c can do nothing useful at this location"))))))))) + +(defun org-mode-restart () + (interactive) + (let ((indent-status (org-bound-and-true-p org-indent-mode))) + (funcall major-mode) + (hack-local-variables) + (when (and indent-status (not (org-bound-and-true-p org-indent-mode))) + (org-indent-mode -1))) + (message "%s restarted" major-mode)) + +(defun org-kill-note-or-show-branches () + "If this is a Note buffer, abort storing the note. Else call `show-branches'." + (interactive) + (if (not org-finish-function) + (progn + (hide-subtree) + (call-interactively 'show-branches)) + (let ((org-note-abort t)) + (funcall org-finish-function)))) + +(defun org-open-line (n) + "Insert a new row in tables, call `open-line' elsewhere. +If `org-special-ctrl-o' is nil, just call `open-line' everywhere." + (interactive "*p") + (cond + ((not org-special-ctrl-o) + (open-line n)) + ((org-at-table-p) + (org-table-insert-row)) + (t + (open-line n)))) + +(defun org-return (&optional indent) + "Goto next table row or insert a newline. +Calls `org-table-next-row' or `newline', depending on context. +See the individual commands for more information." + (interactive) + (let (org-ts-what) + (cond + ((or (bobp) (org-in-src-block-p)) + (if indent (newline-and-indent) (newline))) + ((org-at-table-p) + (org-table-justify-field-maybe) + (call-interactively 'org-table-next-row)) + ;; when `newline-and-indent' is called within a list, make sure + ;; text moved stays inside the item. + ((and (org-in-item-p) indent) + (if (and (org-at-item-p) (>= (point) (match-end 0))) + (progn + (save-match-data (newline)) + (org-indent-line-to (length (match-string 0)))) + (let ((ind (org-get-indentation))) + (newline) + (if (org-looking-back org-list-end-re) + (org-indent-line) + (org-indent-line-to ind))))) + ((and org-return-follows-link + (org-at-timestamp-p t) + (not (eq org-ts-what 'after))) + (org-follow-timestamp-link)) + ((and org-return-follows-link + (let ((tprop (get-text-property (point) 'face))) + (or (eq tprop 'org-link) + (and (listp tprop) (memq 'org-link tprop))))) + (call-interactively 'org-open-at-point)) + ((and (org-at-heading-p) + (looking-at + (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))) + (org-show-entry) + (end-of-line 1) + (newline)) + (t (if indent (newline-and-indent) (newline)))))) + +(defun org-return-indent () + "Goto next table row or insert a newline and indent. +Calls `org-table-next-row' or `newline-and-indent', depending on +context. See the individual commands for more information." + (interactive) + (org-return t)) + +(defun org-ctrl-c-star () + "Compute table, or change heading status of lines. +Calls `org-table-recalculate' or `org-toggle-heading', +depending on context." + (interactive) + (cond + ((org-at-table-p) + (call-interactively 'org-table-recalculate)) + (t + ;; Convert all lines in region to list items + (call-interactively 'org-toggle-heading)))) + +(defun org-ctrl-c-minus () + "Insert separator line in table or modify bullet status of line. +Also turns a plain line or a region of lines into list items. +Calls `org-table-insert-hline', `org-toggle-item', or +`org-cycle-list-bullet', depending on context." + (interactive) + (cond + ((org-at-table-p) + (call-interactively 'org-table-insert-hline)) + ((org-region-active-p) + (call-interactively 'org-toggle-item)) + ((org-in-item-p) + (call-interactively 'org-cycle-list-bullet)) + (t + (call-interactively 'org-toggle-item)))) + +(defun org-toggle-item (arg) + "Convert headings or normal lines to items, items to normal lines. +If there is no active region, only the current line is considered. + +If the first non blank line in the region is a headline, convert +all headlines to items, shifting text accordingly. + +If it is an item, convert all items to normal lines. + +If it is normal text, change region into a list of items. +With a prefix argument ARG, change the region in a single item." + (interactive "P") + (let ((shift-text + (function + ;; Shift text in current section to IND, from point to END. + ;; The function leaves point to END line. + (lambda (ind end) + (let ((min-i 1000) (end (copy-marker end))) + ;; First determine the minimum indentation (MIN-I) of + ;; the text. + (save-excursion + (catch 'exit + (while (< (point) end) + (let ((i (org-get-indentation))) + (cond + ;; Skip blank lines and inline tasks. + ((looking-at "^[ \t]*$")) + ((looking-at org-outline-regexp-bol)) + ;; We can't find less than 0 indentation. + ((zerop i) (throw 'exit (setq min-i 0))) + ((< i min-i) (setq min-i i)))) + (forward-line)))) + ;; Then indent each line so that a line indented to + ;; MIN-I becomes indented to IND. Ignore blank lines + ;; and inline tasks in the process. + (let ((delta (- ind min-i))) + (while (< (point) end) + (unless (or (looking-at "^[ \t]*$") + (looking-at org-outline-regexp-bol)) + (org-indent-line-to (+ (org-get-indentation) delta))) + (forward-line))))))) + (skip-blanks + (function + ;; Return beginning of first non-blank line, starting from + ;; line at POS. + (lambda (pos) + (save-excursion + (goto-char pos) + (skip-chars-forward " \r\t\n") + (point-at-bol))))) + beg end) + ;; Determine boundaries of changes. + (if (org-region-active-p) + (setq beg (funcall skip-blanks (region-beginning)) + end (copy-marker (region-end))) + (setq beg (funcall skip-blanks (point-at-bol)) + end (copy-marker (point-at-eol)))) + ;; Depending on the starting line, choose an action on the text + ;; between BEG and END. + (org-with-limited-levels + (save-excursion + (goto-char beg) + (cond + ;; Case 1. Start at an item: de-itemize. Note that it only + ;; happens when a region is active: `org-ctrl-c-minus' + ;; would call `org-cycle-list-bullet' otherwise. + ((org-at-item-p) + (while (< (point) end) + (when (org-at-item-p) + (skip-chars-forward " \t") + (delete-region (point) (match-end 0))) + (forward-line))) + ;; Case 2. Start at an heading: convert to items. + ((org-at-heading-p) + (let* ((bul (org-list-bullet-string "-")) + (bul-len (length bul)) + ;; Indentation of the first heading. It should be + ;; relative to the indentation of its parent, if any. + (start-ind (save-excursion + (cond + ((not org-adapt-indentation) 0) + ((not (outline-previous-heading)) 0) + (t (length (match-string 0)))))) + ;; Level of first heading. Further headings will be + ;; compared to it to determine hierarchy in the list. + (ref-level (org-reduced-level (org-outline-level)))) + (while (< (point) end) + (let* ((level (org-reduced-level (org-outline-level))) + (delta (max 0 (- level ref-level)))) + ;; If current headline is less indented than the first + ;; one, set it as reference, in order to preserve + ;; subtrees. + (when (< level ref-level) (setq ref-level level)) + (replace-match bul t t) + (org-indent-line-to (+ start-ind (* delta bul-len))) + ;; Ensure all text down to END (or SECTION-END) belongs + ;; to the newly created item. + (let ((section-end (save-excursion + (or (outline-next-heading) (point))))) + (forward-line) + (funcall shift-text + (+ start-ind (* (1+ delta) bul-len)) + (min end section-end))))))) + ;; Case 3. Normal line with ARG: make the first line of region + ;; an item, and shift indentation of others lines to + ;; set them as item's body. + (arg (let* ((bul (org-list-bullet-string "-")) + (bul-len (length bul)) + (ref-ind (org-get-indentation))) + (skip-chars-forward " \t") + (insert bul) + (forward-line) + (while (< (point) end) + ;; Ensure that lines less indented than first one + ;; still get included in item body. + (funcall shift-text + (+ ref-ind bul-len) + (min end (save-excursion (or (outline-next-heading) + (point))))) + (forward-line)))) + ;; Case 4. Normal line without ARG: turn each non-item line + ;; into an item. + (t + (while (< (point) end) + (unless (or (org-at-heading-p) (org-at-item-p)) + (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") + (replace-match + (concat "\\1" (org-list-bullet-string "-") "\\2")))) + (forward-line)))))))) + +(defun org-toggle-heading (&optional nstars) + "Convert headings to normal text, or items or text to headings. +If there is no active region, only convert the current line. + +With a \\[universal-argument] prefix, convert the whole list at +point into heading. + +In a region: + +- If the first non blank line is a headline, remove the stars + from all headlines in the region. + +- If it is a normal line, turn each and every normal line (i.e., + not an heading or an item) in the region into headings. If you + want to convert only the first line of this region, use one + universal prefix argument. + +- If it is a plain list item, turn all plain list items into headings. + +When converting a line into a heading, the number of stars is chosen +such that the lines become children of the current entry. However, +when a numeric prefix argument is given, its value determines the +number of stars to add." + (interactive "P") + (let ((skip-blanks + (function + ;; Return beginning of first non-blank line, starting from + ;; line at POS. + (lambda (pos) + (save-excursion + (goto-char pos) + (while (org-at-comment-p) (forward-line)) + (skip-chars-forward " \r\t\n") + (point-at-bol))))) + beg end toggled) + ;; Determine boundaries of changes. If a universal prefix has + ;; been given, put the list in a region. If region ends at a bol, + ;; do not consider the last line to be in the region. + + (when (and current-prefix-arg (org-at-item-p)) + (if (listp current-prefix-arg) (setq current-prefix-arg 1)) + (org-mark-element)) + + (if (org-region-active-p) + (setq beg (funcall skip-blanks (region-beginning)) + end (copy-marker (save-excursion + (goto-char (region-end)) + (if (bolp) (point) (point-at-eol))))) + (setq beg (funcall skip-blanks (point-at-bol)) + end (copy-marker (point-at-eol)))) + ;; Ensure inline tasks don't count as headings. + (org-with-limited-levels + (save-excursion + (goto-char beg) + (cond + ;; Case 1. Started at an heading: de-star headings. + ((org-at-heading-p) + (while (< (point) end) + (when (org-at-heading-p t) + (looking-at org-outline-regexp) (replace-match "") + (setq toggled t)) + (forward-line))) + ;; Case 2. Started at an item: change items into headlines. + ;; One star will be added by `org-list-to-subtree'. + ((org-at-item-p) + (let* ((stars (make-string + ;; subtract the star that will be added again by + ;; `org-list-to-subtree' + (if (numberp nstars) (1- nstars) + (or (org-current-level) 0)) + ?*)) + (add-stars + (cond (nstars "") ; stars from prefix only + ((equal stars "") "") ; before first heading + (org-odd-levels-only "*") ; inside heading, odd + (t "")))) ; inside heading, oddeven + (while (< (point) end) + (when (org-at-item-p) + ;; Pay attention to cases when region ends before list. + (let* ((struct (org-list-struct)) + (list-end (min (org-list-get-bottom-point struct) (1+ end)))) + (save-restriction + (narrow-to-region (point) list-end) + (insert + (org-list-to-subtree + (org-list-parse-list t) + '(:istart (concat stars add-stars (funcall get-stars depth)) + :icount (concat stars add-stars (funcall get-stars depth))))))) + (setq toggled t)) + (forward-line)))) + ;; Case 3. Started at normal text: make every line an heading, + ;; skipping headlines and items. + (t (let* ((stars + (make-string + (if (numberp nstars) nstars (or (org-current-level) 0)) ?*)) + (add-stars + (cond (nstars "") ; stars from prefix only + ((equal stars "") "*") ; before first heading + (org-odd-levels-only "**") ; inside heading, odd + (t "*"))) ; inside heading, oddeven + (rpl (concat stars add-stars " ")) + (lend (if (listp nstars) (save-excursion (end-of-line) (point))))) + (while (< (point) (if (equal nstars '(4)) lend end)) + (when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p))) + (looking-at "\\([ \t]*\\)\\(\\S-\\)")) + (replace-match (concat rpl (match-string 2))) (setq toggled t)) + (forward-line))))))) + (unless toggled (message "Cannot toggle heading from here")))) + +(defun org-meta-return (&optional arg) + "Insert a new heading or wrap a region in a table. +Calls `org-insert-heading' or `org-table-wrap-region', depending +on context. See the individual commands for more information." + (interactive "P") + (org-check-before-invisible-edit 'insert) + (or (run-hook-with-args-until-success 'org-metareturn-hook) + (let* ((element (org-element-at-point)) + (type (org-element-type element))) + (when (eq type 'table-row) + (setq element (org-element-property :parent element)) + (setq type 'table)) + (if (and (eq type 'table) + (eq (org-element-property :type element) 'org) + (>= (point) (org-element-property :contents-begin element)) + (< (point) (org-element-property :contents-end element))) + (call-interactively 'org-table-wrap-region) + (call-interactively 'org-insert-heading))))) + +;;; Menu entries + +(defsubst org-in-subtree-not-table-p () + "Are we in a subtree and not in a table?" + (and (not (org-before-first-heading-p)) + (not (org-at-table-p)))) + +;; Define the Org-mode menus +(easy-menu-define org-tbl-menu org-mode-map "Tbl menu" + '("Tbl" + ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)] + ["Next Field" org-cycle (org-at-table-p)] + ["Previous Field" org-shifttab (org-at-table-p)] + ["Next Row" org-return (org-at-table-p)] + "--" + ["Blank Field" org-table-blank-field (org-at-table-p)] + ["Edit Field" org-table-edit-field (org-at-table-p)] + ["Copy Field from Above" org-table-copy-down (org-at-table-p)] + "--" + ("Column" + ["Move Column Left" org-metaleft (org-at-table-p)] + ["Move Column Right" org-metaright (org-at-table-p)] + ["Delete Column" org-shiftmetaleft (org-at-table-p)] + ["Insert Column" org-shiftmetaright (org-at-table-p)]) + ("Row" + ["Move Row Up" org-metaup (org-at-table-p)] + ["Move Row Down" org-metadown (org-at-table-p)] + ["Delete Row" org-shiftmetaup (org-at-table-p)] + ["Insert Row" org-shiftmetadown (org-at-table-p)] + ["Sort lines in region" org-table-sort-lines (org-at-table-p)] + "--" + ["Insert Hline" org-ctrl-c-minus (org-at-table-p)]) + ("Rectangle" + ["Copy Rectangle" org-copy-special (org-at-table-p)] + ["Cut Rectangle" org-cut-special (org-at-table-p)] + ["Paste Rectangle" org-paste-special (org-at-table-p)] + ["Fill Rectangle" org-table-wrap-region (org-at-table-p)]) + "--" + ("Calculate" + ["Set Column Formula" org-table-eval-formula (org-at-table-p)] + ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] + ["Edit Formulas" org-edit-special (org-at-table-p)] + "--" + ["Recalculate line" org-table-recalculate (org-at-table-p)] + ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"] + ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"] + "--" + ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)] + "--" + ["Sum Column/Rectangle" org-table-sum + (or (org-at-table-p) (org-region-active-p))] + ["Which Column?" org-table-current-column (org-at-table-p)]) + ["Debug Formulas" + org-table-toggle-formula-debugger + :style toggle :selected (org-bound-and-true-p org-table-formula-debug)] + ["Show Col/Row Numbers" + org-table-toggle-coordinate-overlays + :style toggle + :selected (org-bound-and-true-p org-table-overlay-coordinates)] + "--" + ["Create" org-table-create (and (not (org-at-table-p)) + org-enable-table-editor)] + ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))] + ["Import from File" org-table-import (not (org-at-table-p))] + ["Export to File" org-table-export (org-at-table-p)] + "--" + ["Create/Convert from/to table.el" org-table-create-with-table.el t])) + +(easy-menu-define org-org-menu org-mode-map "Org menu" + '("Org" + ("Show/Hide" + ["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))] + ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))] + ["Sparse Tree..." org-sparse-tree t] + ["Reveal Context" org-reveal t] + ["Show All" show-all t] + "--" + ["Subtree to indirect buffer" org-tree-to-indirect-buffer t]) + "--" + ["New Heading" org-insert-heading t] + ("Navigate Headings" + ["Up" outline-up-heading t] + ["Next" outline-next-visible-heading t] + ["Previous" outline-previous-visible-heading t] + ["Next Same Level" outline-forward-same-level t] + ["Previous Same Level" outline-backward-same-level t] + "--" + ["Jump" org-goto t]) + ("Edit Structure" + ["Refile Subtree" org-refile (org-in-subtree-not-table-p)] + "--" + ["Move Subtree Up" org-shiftmetaup (org-in-subtree-not-table-p)] + ["Move Subtree Down" org-shiftmetadown (org-in-subtree-not-table-p)] + "--" + ["Copy Subtree" org-copy-special (org-in-subtree-not-table-p)] + ["Cut Subtree" org-cut-special (org-in-subtree-not-table-p)] + ["Paste Subtree" org-paste-special (not (org-at-table-p))] + "--" + ["Clone subtree, shift time" org-clone-subtree-with-time-shift t] + "--" + ["Copy visible text" org-copy-visible t] + "--" + ["Promote Heading" org-metaleft (org-in-subtree-not-table-p)] + ["Promote Subtree" org-shiftmetaleft (org-in-subtree-not-table-p)] + ["Demote Heading" org-metaright (org-in-subtree-not-table-p)] + ["Demote Subtree" org-shiftmetaright (org-in-subtree-not-table-p)] + "--" + ["Sort Region/Children" org-sort t] + "--" + ["Convert to odd levels" org-convert-to-odd-levels t] + ["Convert to odd/even levels" org-convert-to-oddeven-levels t]) + ("Editing" + ["Emphasis..." org-emphasize t] + ["Edit Source Example" org-edit-special t] + "--" + ["Footnote new/jump" org-footnote-action t] + ["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"]) + ("Archive" + ["Archive (default method)" org-archive-subtree-default (org-in-subtree-not-table-p)] + "--" + ["Move Subtree to Archive file" org-advertized-archive-subtree (org-in-subtree-not-table-p)] + ["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)] + ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)] + ) + "--" + ("Hyperlinks" + ["Store Link (Global)" org-store-link t] + ["Find existing link to here" org-occur-link-in-agenda-files t] + ["Insert Link" org-insert-link t] + ["Follow Link" org-open-at-point t] + "--" + ["Next link" org-next-link t] + ["Previous link" org-previous-link t] + "--" + ["Descriptive Links" + org-toggle-link-display + :style radio + :selected org-descriptive-links + ] + ["Literal Links" + org-toggle-link-display + :style radio + :selected (not org-descriptive-links)]) + "--" + ("TODO Lists" + ["TODO/DONE/-" org-todo t] + ("Select keyword" + ["Next keyword" org-shiftright (org-at-heading-p)] + ["Previous keyword" org-shiftleft (org-at-heading-p)] + ["Complete Keyword" pcomplete (assq :todo-keyword (org-context))] + ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))] + ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))]) + ["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"] + ["Global TODO list" org-todo-list :active t :keys "C-c a t"] + "--" + ["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies) + :selected org-enforce-todo-dependencies :style toggle :active t] + "Settings for tree at point" + ["Do Children sequentially" org-toggle-ordered-property :style radio + :selected (org-entry-get nil "ORDERED") + :active org-enforce-todo-dependencies :keys "C-c C-x o"] + ["Do Children parallel" org-toggle-ordered-property :style radio + :selected (not (org-entry-get nil "ORDERED")) + :active org-enforce-todo-dependencies :keys "C-c C-x o"] + "--" + ["Set Priority" org-priority t] + ["Priority Up" org-shiftup t] + ["Priority Down" org-shiftdown t] + "--" + ["Get news from all feeds" org-feed-update-all t] + ["Go to the inbox of a feed..." org-feed-goto-inbox t] + ["Customize feeds" (customize-variable 'org-feed-alist) t]) + ("TAGS and Properties" + ["Set Tags" org-set-tags-command (not (org-before-first-heading-p))] + ["Change tag in region" org-change-tag-in-region (org-region-active-p)] + "--" + ["Set property" org-set-property (not (org-before-first-heading-p))] + ["Column view of properties" org-columns t] + ["Insert Column View DBlock" org-insert-columns-dblock t]) + ("Dates and Scheduling" + ["Timestamp" org-time-stamp (not (org-before-first-heading-p))] + ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))] + ("Change Date" + ["1 Day Later" org-shiftright (org-at-timestamp-p)] + ["1 Day Earlier" org-shiftleft (org-at-timestamp-p)] + ["1 ... Later" org-shiftup (org-at-timestamp-p)] + ["1 ... Earlier" org-shiftdown (org-at-timestamp-p)]) + ["Compute Time Range" org-evaluate-time-range t] + ["Schedule Item" org-schedule (not (org-before-first-heading-p))] + ["Deadline" org-deadline (not (org-before-first-heading-p))] + "--" + ["Custom time format" org-toggle-time-stamp-overlays + :style radio :selected org-display-custom-times] + "--" + ["Goto Calendar" org-goto-calendar t] + ["Date from Calendar" org-date-from-calendar t] + "--" + ["Start/Restart Timer" org-timer-start t] + ["Pause/Continue Timer" org-timer-pause-or-continue t] + ["Stop Timer" org-timer-pause-or-continue :active t :keys "C-u C-c C-x ,"] + ["Insert Timer String" org-timer t] + ["Insert Timer Item" org-timer-item t]) + ("Logging work" + ["Clock in" org-clock-in :active t :keys "C-c C-x C-i"] + ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"] + ["Clock out" org-clock-out t] + ["Clock cancel" org-clock-cancel t] + "--" + ["Mark as default task" org-clock-mark-default-task t] + ["Clock in, mark as default" (lambda () (interactive) (org-clock-in '(16))) :active t :keys "C-u C-u C-c C-x C-i"] + ["Goto running clock" org-clock-goto t] + "--" + ["Display times" org-clock-display t] + ["Create clock table" org-clock-report t] + "--" + ["Record DONE time" + (progn (setq org-log-done (not org-log-done)) + (message "Switching to %s will %s record a timestamp" + (car org-done-keywords) + (if org-log-done "automatically" "not"))) + :style toggle :selected org-log-done]) + "--" + ["Agenda Command..." org-agenda t] + ["Set Restriction Lock" org-agenda-set-restriction-lock t] + ("File List for Agenda") + ("Special views current file" + ["TODO Tree" org-show-todo-tree t] + ["Check Deadlines" org-check-deadlines t] + ["Timeline" org-timeline t] + ["Tags/Property tree" org-match-sparse-tree t]) + "--" + ["Export/Publish..." org-export-dispatch t] + ("LaTeX" + ["Org CDLaTeX mode" org-cdlatex-mode :style toggle + :selected org-cdlatex-mode] + ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)] + ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] + ["Modify math symbol" org-cdlatex-math-modify + (org-inside-LaTeX-fragment-p)] + ["Insert citation" org-reftex-citation t] + "--" + ["Template for BEAMER" (org-beamer-insert-options-template) t]) + "--" + ("MobileOrg" + ["Push Files and Views" org-mobile-push t] + ["Get Captured and Flagged" org-mobile-pull t] + ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "C-c a ?"] + "--" + ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t]) + "--" + ("Documentation" + ["Show Version" org-version t] + ["Info Documentation" org-info t]) + ("Customize" + ["Browse Org Group" org-customize t] + "--" + ["Expand This Menu" org-create-customize-menu + (fboundp 'customize-menu-create)]) + ["Send bug report" org-submit-bug-report t] + "--" + ("Refresh/Reload" + ["Refresh setup current buffer" org-mode-restart t] + ["Reload Org (after update)" org-reload t] + ["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x !"]) + )) + +(defun org-info (&optional node) + "Read documentation for Org-mode in the info system. +With optional NODE, go directly to that node." + (interactive) + (info (format "(org)%s" (or node "")))) + +;;;###autoload +(defun org-submit-bug-report () + "Submit a bug report on Org-mode via mail. + +Don't hesitate to report any problems or inaccurate documentation. + +If you don't have setup sending mail from (X)Emacs, please copy the +output buffer into your mail program, as it gives us important +information about your Org-mode version and configuration." + (interactive) + (require 'reporter) + (org-load-modules-maybe) + (org-require-autoloaded-modules) + (let ((reporter-prompt-for-summary-p "Bug report subject: ")) + (reporter-submit-bug-report + "emacs-orgmode@gnu.org" + (org-version nil 'full) + (let (list) + (save-window-excursion + (org-pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*")) + (delete-other-windows) + (erase-buffer) + (insert "You are about to submit a bug report to the Org-mode mailing list. + +We would like to add your full Org-mode and Outline configuration to the +bug report. This greatly simplifies the work of the maintainer and +other experts on the mailing list. + +HOWEVER, some variables you have customized may contain private +information. The names of customers, colleagues, or friends, might +appear in the form of file names, tags, todo states, or search strings. +If you answer yes to the prompt, you might want to check and remove +such private information before sending the email.") + (add-text-properties (point-min) (point-max) '(face org-warning)) + (when (yes-or-no-p "Include your Org-mode configuration ") + (mapatoms + (lambda (v) + (and (boundp v) + (string-match "\\`\\(org-\\|outline-\\)" (symbol-name v)) + (or (and (symbol-value v) + (string-match "\\(-hook\\|-function\\)\\'" (symbol-name v))) + (and + (get v 'custom-type) (get v 'standard-value) + (not (equal (symbol-value v) (eval (car (get v 'standard-value))))))) + (push v list))))) + (kill-buffer (get-buffer "*Warn about privacy*")) + list)) + nil nil + "Remember to cover the basics, that is, what you expected to happen and +what in fact did happen. You don't know how to make a good report? See + + http://orgmode.org/manual/Feedback.html#Feedback + +Your bug report will be posted to the Org-mode mailing list. +------------------------------------------------------------------------") + (save-excursion + (if (re-search-backward "^\\(Subject: \\)Org-mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t) + (replace-match "\\1Bug: \\3 [\\2]"))))) + + +(defun org-install-agenda-files-menu () + (let ((bl (buffer-list))) + (save-excursion + (while bl + (set-buffer (pop bl)) + (if (derived-mode-p 'org-mode) (setq bl nil))) + (when (derived-mode-p 'org-mode) + (easy-menu-change + '("Org") "File List for Agenda" + (append + (list + ["Edit File List" (org-edit-agenda-file-list) t] + ["Add/Move Current File to Front of List" org-agenda-file-to-front t] + ["Remove Current File from List" org-remove-file t] + ["Cycle through agenda files" org-cycle-agenda-files t] + ["Occur in all agenda files" org-occur-in-agenda-files t] + "--") + (mapcar 'org-file-menu-entry (org-agenda-files t)))))))) + +;;;; Documentation + +(defun org-require-autoloaded-modules () + (interactive) + (mapc 'require + '(org-agenda org-archive org-attach org-clock org-colview org-id + org-table org-timer))) + +;;;###autoload +(defun org-reload (&optional uncompiled) + "Reload all org lisp files. +With prefix arg UNCOMPILED, load the uncompiled versions." + (interactive "P") + (require 'loadhist) + (let* ((org-dir (org-find-library-dir "org")) + (contrib-dir (or (org-find-library-dir "org-contribdir") org-dir)) + (feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?") + (remove-re (mapconcat 'identity + (mapcar (lambda (f) (concat "^" f "$")) + (list (if (featurep 'xemacs) + "org-colview" + "org-colview-xemacs") + "org" "org-loaddefs" "org-version")) + "\\|")) + (feats (delete-dups + (mapcar 'file-name-sans-extension + (mapcar 'file-name-nondirectory + (delq nil + (mapcar 'feature-file + features)))))) + (lfeat (append + (sort + (setq feats + (delq nil (mapcar + (lambda (f) + (if (and (string-match feature-re f) + (not (string-match remove-re f))) + f nil)) + feats))) + 'string-lessp) + (list "org-version" "org"))) + (load-suffixes (when (boundp 'load-suffixes) load-suffixes)) + (load-suffixes (if uncompiled (reverse load-suffixes) load-suffixes)) + load-uncore load-misses) + (setq load-misses + (delq 't + (mapcar (lambda (f) + (or (org-load-noerror-mustsuffix (concat org-dir f)) + (and (string= org-dir contrib-dir) + (org-load-noerror-mustsuffix (concat contrib-dir f))) + (and (org-load-noerror-mustsuffix (concat (org-find-library-dir f) f)) + (add-to-list 'load-uncore f 'append) + 't) + f)) + lfeat))) + (if load-uncore + (message "The following feature%s found in load-path, please check if that's correct:\n%s" + (if (> (length load-uncore) 1) "s were" " was") load-uncore)) + (if load-misses + (message "Some error occurred while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s" + (if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full)) + (message "Successfully reloaded Org\n%s" (org-version nil 'full))))) + +;;;###autoload +(defun org-customize () + "Call the customize function with org as argument." + (interactive) + (org-load-modules-maybe) + (org-require-autoloaded-modules) + (customize-browse 'org)) + +(defun org-create-customize-menu () + "Create a full customization menu for Org-mode, insert it into the menu." + (interactive) + (org-load-modules-maybe) + (org-require-autoloaded-modules) + (if (fboundp 'customize-menu-create) + (progn + (easy-menu-change + '("Org") "Customize" + `(["Browse Org group" org-customize t] + "--" + ,(customize-menu-create 'org) + ["Set" Custom-set t] + ["Save" Custom-save t] + ["Reset to Current" Custom-reset-current t] + ["Reset to Saved" Custom-reset-saved t] + ["Reset to Standard Settings" Custom-reset-standard t])) + (message "\"Org\"-menu now contains full customization menu")) + (error "Cannot expand menu (outdated version of cus-edit.el)"))) + +;;;; Miscellaneous stuff + +;;; Generally useful functions + +(defun org-get-at-bol (property) + "Get text property PROPERTY at beginning of line." + (get-text-property (point-at-bol) property)) + +(defun org-find-text-property-in-string (prop s) + "Return the first non-nil value of property PROP in string S." + (or (get-text-property 0 prop s) + (get-text-property (or (next-single-property-change 0 prop s) 0) + prop s))) + +(defun org-display-warning (message) ;; Copied from Emacs-Muse + "Display the given MESSAGE as a warning." + (if (fboundp 'display-warning) + (display-warning 'org message + (if (featurep 'xemacs) 'warning :warning)) + (let ((buf (get-buffer-create "*Org warnings*"))) + (with-current-buffer buf + (goto-char (point-max)) + (insert "Warning (Org): " message) + (unless (bolp) + (newline))) + (display-buffer buf) + (sit-for 0)))) + +(defun org-eval (form) + "Eval FORM and return result." + (condition-case error + (eval form) + (error (format "%%![Error: %s]" error)))) + +(defun org-in-clocktable-p () + "Check if the cursor is in a clocktable." + (let ((pos (point)) start) + (save-excursion + (end-of-line 1) + (and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t) + (setq start (match-beginning 0)) + (re-search-forward "^[ \t]*#\\+END:.*" nil t) + (>= (match-end 0) pos) + start)))) + +(defun org-in-commented-line () + "Is point in a line starting with `#'?" + (equal (char-after (point-at-bol)) ?#)) + +(defun org-in-indented-comment-line () + "Is point in a line starting with `#' after some white space?" + (save-excursion + (save-match-data + (goto-char (point-at-bol)) + (looking-at "[ \t]*#")))) + +(defun org-in-verbatim-emphasis () + (save-match-data + (and (org-in-regexp org-emph-re 2) + (>= (point) (match-beginning 3)) + (<= (point) (match-end 4)) + (member (match-string 3) '("=" "~"))))) + +(defun org-goto-marker-or-bmk (marker &optional bookmark) + "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK." + (if (and marker (marker-buffer marker) + (buffer-live-p (marker-buffer marker))) + (progn + (org-pop-to-buffer-same-window (marker-buffer marker)) + (if (or (> marker (point-max)) (< marker (point-min))) + (widen)) + (goto-char marker) + (org-show-context 'org-goto)) + (if bookmark + (bookmark-jump bookmark) + (error "Cannot find location")))) + +(defun org-quote-csv-field (s) + "Quote field for inclusion in CSV material." + (if (string-match "[\",]" s) + (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") + s)) + +(defun org-force-self-insert (N) + "Needed to enforce self-insert under remapping." + (interactive "p") + (self-insert-command N)) + +(defun org-string-width (s) + "Compute width of string, ignoring invisible characters. +This ignores character with invisibility property `org-link', and also +characters with property `org-cwidth', because these will become invisible +upon the next fontification round." + (let (b l) + (when (or (eq t buffer-invisibility-spec) + (assq 'org-link buffer-invisibility-spec)) + (while (setq b (text-property-any 0 (length s) + 'invisible 'org-link s)) + (setq s (concat (substring s 0 b) + (substring s (or (next-single-property-change + b 'invisible s) (length s))))))) + (while (setq b (text-property-any 0 (length s) 'org-cwidth t s)) + (setq s (concat (substring s 0 b) + (substring s (or (next-single-property-change + b 'org-cwidth s) (length s)))))) + (setq l (string-width s) b -1) + (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s)) + (setq l (- l (get-text-property b 'org-dwidth-n s)))) + l)) + +(defun org-shorten-string (s maxlength) + "Shorten string S so tht it is no longer than MAXLENGTH characters. +If the string is shorter or has length MAXLENGTH, just return the +original string. If it is longer, the functions finds a space in the +string, breaks this string off at that locations and adds three dots +as ellipsis. Including the ellipsis, the string will not be longer +than MAXLENGTH. If finding a good breaking point in the string does +not work, the string is just chopped off in the middle of a word +if necessary." + (if (<= (length s) maxlength) + s + (let* ((n (max (- maxlength 4) 1)) + (re (concat "\\`\\(.\\{1," (int-to-string n) "\\}[^ ]\\)\\([ ]\\|\\'\\)"))) + (if (string-match re s) + (concat (match-string 1 s) "...") + (concat (substring s 0 (max (- maxlength 3) 0)) "..."))))) + +(defun org-get-indentation (&optional line) + "Get the indentation of the current line, interpreting tabs. +When LINE is given, assume it represents a line and compute its indentation." + (if line + (if (string-match "^ *" (org-remove-tabs line)) + (match-end 0)) + (save-excursion + (beginning-of-line 1) + (skip-chars-forward " \t") + (current-column)))) + +(defun org-get-string-indentation (s) + "What indentation has S due to SPACE and TAB at the beginning of the string?" + (let ((n -1) (i 0) (w tab-width) c) + (catch 'exit + (while (< (setq n (1+ n)) (length s)) + (setq c (aref s n)) + (cond ((= c ?\ ) (setq i (1+ i))) + ((= c ?\t) (setq i (* (/ (+ w i) w) w))) + (t (throw 'exit t))))) + i)) + +(defun org-remove-tabs (s &optional width) + "Replace tabulators in S with spaces. +Assumes that s is a single line, starting in column 0." + (setq width (or width tab-width)) + (while (string-match "\t" s) + (setq s (replace-match + (make-string + (- (* width (/ (+ (match-beginning 0) width) width)) + (match-beginning 0)) ?\ ) + t t s))) + s) + +(defun org-fix-indentation (line ind) + "Fix indentation in LINE. +IND is a cons cell with target and minimum indentation. +If the current indentation in LINE is smaller than the minimum, +leave it alone. If it is larger than ind, set it to the target." + (let* ((l (org-remove-tabs line)) + (i (org-get-indentation l)) + (i1 (car ind)) (i2 (cdr ind))) + (if (>= i i2) (setq l (substring line i2))) + (if (> i1 0) + (concat (make-string i1 ?\ ) l) + l))) + +(defun org-remove-indentation (code &optional n) + "Remove the maximum common indentation from the lines in CODE. +N may optionally be the number of spaces to remove." + (with-temp-buffer + (insert code) + (org-do-remove-indentation n) + (buffer-string))) + +(defun org-do-remove-indentation (&optional n) + "Remove the maximum common indentation from the buffer." + (untabify (point-min) (point-max)) + (let ((min 10000) re) + (if n + (setq min n) + (goto-char (point-min)) + (while (re-search-forward "^ *[^ \n]" nil t) + (setq min (min min (1- (- (match-end 0) (match-beginning 0))))))) + (unless (or (= min 0) (= min 10000)) + (setq re (format "^ \\{%d\\}" min)) + (goto-char (point-min)) + (while (re-search-forward re nil t) + (replace-match "") + (end-of-line 1)) + min))) + +(defun org-fill-template (template alist) + "Find each %key of ALIST in TEMPLATE and replace it." + (let ((case-fold-search nil) + entry key value) + (setq alist (sort (copy-sequence alist) + (lambda (a b) (< (length (car a)) (length (car b)))))) + (while (setq entry (pop alist)) + (setq template + (replace-regexp-in-string + (concat "%" (regexp-quote (car entry))) + (or (cdr entry) "") template t t))) + template)) + +(defun org-base-buffer (buffer) + "Return the base buffer of BUFFER, if it has one. Else return the buffer." + (if (not buffer) + buffer + (or (buffer-base-buffer buffer) + buffer))) + +(defun org-trim (s) + "Remove whitespace at beginning and end of string." + (if (string-match "\\`[ \t\n\r]+" s) (setq s (replace-match "" t t s))) + (if (string-match "[ \t\n\r]+\\'" s) (setq s (replace-match "" t t s))) + s) + +(defun org-wrap (string &optional width lines) + "Wrap string to either a number of lines, or a width in characters. +If WIDTH is non-nil, the string is wrapped to that width, however many lines +that costs. If there is a word longer than WIDTH, the text is actually +wrapped to the length of that word. +IF WIDTH is nil and LINES is non-nil, the string is forced into at most that +many lines, whatever width that takes. +The return value is a list of lines, without newlines at the end." + (let* ((words (org-split-string string "[ \t\n]+")) + (maxword (apply 'max (mapcar 'org-string-width words))) + w ll) + (cond (width + (org-do-wrap words (max maxword width))) + (lines + (setq w maxword) + (setq ll (org-do-wrap words maxword)) + (if (<= (length ll) lines) + ll + (setq ll words) + (while (> (length ll) lines) + (setq w (1+ w)) + (setq ll (org-do-wrap words w))) + ll)) + (t (error "Cannot wrap this"))))) + +(defun org-do-wrap (words width) + "Create lines of maximum width WIDTH (in characters) from word list WORDS." + (let (lines line) + (while words + (setq line (pop words)) + (while (and words (< (+ (length line) (length (car words))) width)) + (setq line (concat line " " (pop words)))) + (setq lines (push line lines))) + (nreverse lines))) + +(defun org-split-string (string &optional separators) + "Splits STRING into substrings at SEPARATORS. +No empty strings are returned if there are matches at the beginning +and end of string." + (let ((rexp (or separators "[ \f\t\n\r\v]+")) + (start 0) + notfirst + (list nil)) + (while (and (string-match rexp string + (if (and notfirst + (= start (match-beginning 0)) + (< start (length string))) + (1+ start) start)) + (< (match-beginning 0) (length string))) + (setq notfirst t) + (or (eq (match-beginning 0) 0) + (and (eq (match-beginning 0) (match-end 0)) + (eq (match-beginning 0) start)) + (setq list + (cons (substring string start (match-beginning 0)) + list))) + (setq start (match-end 0))) + (or (eq start (length string)) + (setq list + (cons (substring string start) + list))) + (nreverse list))) + +(defun org-quote-vert (s) + "Replace \"|\" with \"\\vert\"." + (while (string-match "|" s) + (setq s (replace-match "\\vert" t t s))) + s) + +(defun org-uuidgen-p (s) + "Is S an ID created by UUIDGEN?" + (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s))) + +(defun org-in-src-block-p (&optional inside) + "Whether point is in a code source block. +When INSIDE is non-nil, don't consider we are within a src block +when point is at #+BEGIN_SRC or #+END_SRC." + (let ((case-fold-search t) ov) + (or (and (setq ov (overlays-at (point))) + (memq 'org-block-background + (overlay-properties (car ov)))) + (and (not inside) + (save-match-data + (save-excursion + (beginning-of-line) + (looking-at ".*#\\+\\(begin\\|end\\)_src"))))))) + +(defun org-context () + "Return a list of contexts of the current cursor position. +If several contexts apply, all are returned. +Each context entry is a list with a symbol naming the context, and +two positions indicating start and end of the context. Possible +contexts are: + +:headline anywhere in a headline +:headline-stars on the leading stars in a headline +:todo-keyword on a TODO keyword (including DONE) in a headline +:tags on the TAGS in a headline +:priority on the priority cookie in a headline +:item on the first line of a plain list item +:item-bullet on the bullet/number of a plain list item +:checkbox on the checkbox in a plain list item +:table in an org-mode table +:table-special on a special filed in a table +:table-table in a table.el table +:clocktable in a clocktable +:src-block in a source block +:link on a hyperlink +:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT, QUOTE. +:target on a <<target>> +:radio-target on a <<<radio-target>>> +:latex-fragment on a LaTeX fragment +:latex-preview on a LaTeX fragment with overlaid preview image + +This function expects the position to be visible because it uses font-lock +faces as a help to recognize the following contexts: :table-special, :link, +and :keyword." + (let* ((f (get-text-property (point) 'face)) + (faces (if (listp f) f (list f))) + (case-fold-search t) + (p (point)) clist o) + ;; First the large context + (cond + ((org-at-heading-p t) + (push (list :headline (point-at-bol) (point-at-eol)) clist) + (when (progn + (beginning-of-line 1) + (looking-at org-todo-line-tags-regexp)) + (push (org-point-in-group p 1 :headline-stars) clist) + (push (org-point-in-group p 2 :todo-keyword) clist) + (push (org-point-in-group p 4 :tags) clist)) + (goto-char p) + (skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1)) + (if (looking-at "\\[#[A-Z0-9]\\]") + (push (org-point-in-group p 0 :priority) clist))) + + ((org-at-item-p) + (push (org-point-in-group p 2 :item-bullet) clist) + (push (list :item (point-at-bol) + (save-excursion (org-end-of-item) (point))) + clist) + (and (org-at-item-checkbox-p) + (push (org-point-in-group p 0 :checkbox) clist))) + + ((org-at-table-p) + (push (list :table (org-table-begin) (org-table-end)) clist) + (if (memq 'org-formula faces) + (push (list :table-special + (previous-single-property-change p 'face) + (next-single-property-change p 'face)) clist))) + ((org-at-table-p 'any) + (push (list :table-table) clist))) + (goto-char p) + + (let ((case-fold-search t)) + ;; New the "medium" contexts: clocktables, source blocks + (cond ((org-in-clocktable-p) + (push (list :clocktable + (and (or (looking-at "#\\+BEGIN: clocktable") + (search-backward "#+BEGIN: clocktable" nil t)) + (match-beginning 0)) + (and (re-search-forward "#\\+END:?" nil t) + (match-end 0))) clist)) + ((org-in-src-block-p) + (push (list :src-block + (and (or (looking-at "#\\+BEGIN_SRC") + (search-backward "#+BEGIN_SRC" nil t)) + (match-beginning 0)) + (and (search-forward "#+END_SRC" nil t) + (match-beginning 0))) clist)))) + (goto-char p) + + ;; Now the small context + (cond + ((org-at-timestamp-p) + (push (org-point-in-group p 0 :timestamp) clist)) + ((memq 'org-link faces) + (push (list :link + (previous-single-property-change p 'face) + (next-single-property-change p 'face)) clist)) + ((memq 'org-special-keyword faces) + (push (list :keyword + (previous-single-property-change p 'face) + (next-single-property-change p 'face)) clist)) + ((org-at-target-p) + (push (org-point-in-group p 0 :target) clist) + (goto-char (1- (match-beginning 0))) + (if (looking-at org-radio-target-regexp) + (push (org-point-in-group p 0 :radio-target) clist)) + (goto-char p)) + ((setq o (car (delq nil + (mapcar + (lambda (x) + (if (memq x org-latex-fragment-image-overlays) x)) + (overlays-at (point)))))) + (push (list :latex-fragment + (overlay-start o) (overlay-end o)) clist) + (push (list :latex-preview + (overlay-start o) (overlay-end o)) clist)) + ((org-inside-LaTeX-fragment-p) + ;; FIXME: positions wrong. + (push (list :latex-fragment (point) (point)) clist))) + + (setq clist (nreverse (delq nil clist))) + clist)) + +;; FIXME: Compare with at-regexp-p Do we need both? +(defun org-in-regexp (re &optional nlines visually) + "Check if point is inside a match of regexp. +Normally only the current line is checked, but you can include NLINES extra +lines both before and after point into the search. +If VISUALLY is set, require that the cursor is not after the match but +really on, so that the block visually is on the match." + (catch 'exit + (let ((pos (point)) + (eol (point-at-eol (+ 1 (or nlines 0)))) + (inc (if visually 1 0))) + (save-excursion + (beginning-of-line (- 1 (or nlines 0))) + (while (re-search-forward re eol t) + (if (and (<= (match-beginning 0) pos) + (>= (+ inc (match-end 0)) pos)) + (throw 'exit (cons (match-beginning 0) (match-end 0))))))))) + +(defun org-at-regexp-p (regexp) + "Is point inside a match of REGEXP in the current line?" + (catch 'exit + (save-excursion + (let ((pos (point)) (end (point-at-eol))) + (beginning-of-line 1) + (while (re-search-forward regexp end t) + (if (and (<= (match-beginning 0) pos) + (>= (match-end 0) pos)) + (throw 'exit t))) + nil)))) + +(defun org-between-regexps-p (start-re end-re &optional lim-up lim-down) + "Non-nil when point is between matches of START-RE and END-RE. + +Also return a non-nil value when point is on one of the matches. + +Optional arguments LIM-UP and LIM-DOWN bound the search; they are +buffer positions. Default values are the positions of headlines +surrounding the point. + +The functions returns a cons cell whose car (resp. cdr) is the +position before START-RE (resp. after END-RE)." + (save-match-data + (let ((pos (point)) + (limit-up (or lim-up (save-excursion (outline-previous-heading)))) + (limit-down (or lim-down (save-excursion (outline-next-heading)))) + beg end) + (save-excursion + ;; Point is on a block when on START-RE or if START-RE can be + ;; found before it... + (and (or (org-at-regexp-p start-re) + (re-search-backward start-re limit-up t)) + (setq beg (match-beginning 0)) + ;; ... and END-RE after it... + (goto-char (match-end 0)) + (re-search-forward end-re limit-down t) + (> (setq end (match-end 0)) pos) + ;; ... without another START-RE in-between. + (goto-char (match-beginning 0)) + (not (re-search-backward start-re (1+ beg) t)) + ;; Return value. + (cons beg end)))))) + +(defun org-in-block-p (names) + "Non-nil when point belongs to a block whose name belongs to NAMES. + +NAMES is a list of strings containing names of blocks. + +Return first block name matched, or nil. Beware that in case of +nested blocks, the returned name may not belong to the closest +block from point." + (save-match-data + (catch 'exit + (let ((case-fold-search t) + (lim-up (save-excursion (outline-previous-heading))) + (lim-down (save-excursion (outline-next-heading)))) + (mapc (lambda (name) + (let ((n (regexp-quote name))) + (when (org-between-regexps-p + (concat "^[ \t]*#\\+begin_" n) + (concat "^[ \t]*#\\+end_" n) + lim-up lim-down) + (throw 'exit n)))) + names)) + nil))) + +(defun org-in-drawer-p () + "Is point within a drawer?" + (save-match-data + (let ((case-fold-search t) + (lim-up (save-excursion (outline-previous-heading))) + (lim-down (save-excursion (outline-next-heading)))) + (org-between-regexps-p + (concat "^[ \t]*:" (regexp-opt org-drawers) ":") + "^[ \t]*:end:.*$" + lim-up lim-down)))) + +(defun org-occur-in-agenda-files (regexp &optional nlines) + "Call `multi-occur' with buffers for all agenda files." + (interactive "sOrg-files matching: \np") + (let* ((files (org-agenda-files)) + (tnames (mapcar 'file-truename files)) + (extra org-agenda-text-search-extra-files) + f) + (when (eq (car extra) 'agenda-archives) + (setq extra (cdr extra)) + (setq files (org-add-archive-files files))) + (while (setq f (pop extra)) + (unless (member (file-truename f) tnames) + (add-to-list 'files f 'append) + (add-to-list 'tnames (file-truename f) 'append))) + (multi-occur + (mapcar (lambda (x) + (with-current-buffer + (or (get-file-buffer x) (find-file-noselect x)) + (widen) + (current-buffer))) + files) + regexp))) + +(if (boundp 'occur-mode-find-occurrence-hook) + ;; Emacs 23 + (add-hook 'occur-mode-find-occurrence-hook + (lambda () + (when (derived-mode-p 'org-mode) + (org-reveal)))) + ;; Emacs 22 + (defadvice occur-mode-goto-occurrence + (after org-occur-reveal activate) + (and (derived-mode-p 'org-mode) (org-reveal))) + (defadvice occur-mode-goto-occurrence-other-window + (after org-occur-reveal activate) + (and (derived-mode-p 'org-mode) (org-reveal))) + (defadvice occur-mode-display-occurrence + (after org-occur-reveal activate) + (when (derived-mode-p 'org-mode) + (let ((pos (occur-mode-find-occurrence))) + (with-current-buffer (marker-buffer pos) + (save-excursion + (goto-char pos) + (org-reveal))))))) + +(defun org-occur-link-in-agenda-files () + "Create a link and search for it in the agendas. +The link is not stored in `org-stored-links', it is just created +for the search purpose." + (interactive) + (let ((link (condition-case nil + (org-store-link nil) + (error "Unable to create a link to here")))) + (org-occur-in-agenda-files (regexp-quote link)))) + +(defun org-reverse-string (string) + "Return the reverse of STRING." + (apply 'string (reverse (string-to-list string)))) + +;; defsubst org-uniquify must be defined before first use + +(defun org-uniquify-alist (alist) + "Merge elements of ALIST with the same key. + +For example, in this alist: + +\(org-uniquify-alist '((a 1) (b 2) (a 3))) + => '((a 1 3) (b 2)) + +merge (a 1) and (a 3) into (a 1 3). + +The function returns the new ALIST." + (let (rtn) + (mapc + (lambda (e) + (let (n) + (if (not (assoc (car e) rtn)) + (push e rtn) + (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e)))) + (setq rtn (assq-delete-all (car e) rtn)) + (push n rtn)))) + alist) + rtn)) + +(defun org-delete-all (elts list) + "Remove all elements in ELTS from LIST." + (while elts + (setq list (delete (pop elts) list))) + list) + +(defun org-count (cl-item cl-seq) + "Count the number of occurrences of ITEM in SEQ. +Taken from `count' in cl-seq.el with all keyword arguments removed." + (let ((cl-end (length cl-seq)) (cl-start 0) (cl-count 0) cl-x) + (when (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) + (while (< cl-start cl-end) + (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start))) + (if (equal cl-item cl-x) (setq cl-count (1+ cl-count))) + (setq cl-start (1+ cl-start))) + cl-count)) + +(defun org-remove-if (predicate seq) + "Remove everything from SEQ that fulfills PREDICATE." + (let (res e) + (while seq + (setq e (pop seq)) + (if (not (funcall predicate e)) (push e res))) + (nreverse res))) + +(defun org-remove-if-not (predicate seq) + "Remove everything from SEQ that does not fulfill PREDICATE." + (let (res e) + (while seq + (setq e (pop seq)) + (if (funcall predicate e) (push e res))) + (nreverse res))) + +(defun org-reduce (cl-func cl-seq &rest cl-keys) + "Reduce two-argument FUNCTION across SEQ. +Taken from `reduce' in cl-seq.el with all keyword arguments but +\":initial-value\" removed." + (let ((cl-accum (cond ((memq :initial-value cl-keys) + (cadr (memq :initial-value cl-keys))) + (cl-seq (pop cl-seq)) + (t (funcall cl-func))))) + (while cl-seq + (setq cl-accum (funcall cl-func cl-accum (pop cl-seq)))) + cl-accum)) + +(defun org-every (pred seq) + "Return true if PREDICATE is true of every element of SEQ. +Adapted from `every' in cl.el." + (catch 'org-every + (mapc (lambda (e) (unless (funcall pred e) (throw 'org-every nil))) seq) + t)) + +(defun org-some (pred seq) + "Return true if PREDICATE is true of any element of SEQ. +Adapted from `some' in cl.el." + (catch 'org-some + (mapc (lambda (e) (when (funcall pred e) (throw 'org-some t))) seq) + nil)) + +(defun org-back-over-empty-lines () + "Move backwards over whitespace, to the beginning of the first empty line. +Returns the number of empty lines passed." + (let ((pos (point))) + (if (cdr (assoc 'heading org-blank-before-new-entry)) + (skip-chars-backward " \t\n\r") + (unless (eobp) + (forward-line -1))) + (beginning-of-line 2) + (goto-char (min (point) pos)) + (count-lines (point) pos))) + +(defun org-skip-whitespace () + (skip-chars-forward " \t\n\r")) + +(defun org-point-in-group (point group &optional context) + "Check if POINT is in match-group GROUP. +If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the +match. If the match group does not exist or point is not inside it, +return nil." + (and (match-beginning group) + (>= point (match-beginning group)) + (<= point (match-end group)) + (if context + (list context (match-beginning group) (match-end group)) + t))) + +(defun org-switch-to-buffer-other-window (&rest args) + "Switch to buffer in a second window on the current frame. +In particular, do not allow pop-up frames. +Returns the newly created buffer." + (org-no-popups + (apply 'switch-to-buffer-other-window args))) + +(defun org-combine-plists (&rest plists) + "Create a single property list from all plists in PLISTS. +The process starts by copying the first list, and then setting properties +from the other lists. Settings in the last list are the most significant +ones and overrule settings in the other lists." + (let ((rtn (copy-sequence (pop plists))) + p v ls) + (while plists + (setq ls (pop plists)) + (while ls + (setq p (pop ls) v (pop ls)) + (setq rtn (plist-put rtn p v)))) + rtn)) + +(defun org-replace-escapes (string table) + "Replace %-escapes in STRING with values in TABLE. +TABLE is an association list with keys like \"%a\" and string values. +The sequences in STRING may contain normal field width and padding information, +for example \"%-5s\". Replacements happen in the sequence given by TABLE, +so values can contain further %-escapes if they are define later in TABLE." + (let ((tbl (copy-alist table)) + (case-fold-search nil) + (pchg 0) + e re rpl) + (while (setq e (pop tbl)) + (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) + (when (and (cdr e) (string-match re (cdr e))) + (let ((sref (substring (cdr e) (match-beginning 0) (match-end 0))) + (safe "SREF")) + (add-text-properties 0 3 (list 'sref sref) safe) + (setcdr e (replace-match safe t t (cdr e))))) + (while (string-match re string) + (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s") + (cdr e))) + (setq string (replace-match rpl t t string)))) + (while (setq pchg (next-property-change pchg string)) + (let ((sref (get-text-property pchg 'sref string))) + (when (and sref (string-match "SREF" string pchg)) + (setq string (replace-match sref t t string))))) + string)) + +(defun org-sublist (list start end) + "Return a section of LIST, from START to END. +Counting starts at 1." + (let (rtn (c start)) + (setq list (nthcdr (1- start) list)) + (while (and list (<= c end)) + (push (pop list) rtn) + (setq c (1+ c))) + (nreverse rtn))) + +(defun org-find-base-buffer-visiting (file) + "Like `find-buffer-visiting' but always return the base buffer and +not an indirect buffer." + (let ((buf (or (get-file-buffer file) + (find-buffer-visiting file)))) + (if buf + (or (buffer-base-buffer buf) buf) + nil))) + +(defun org-image-file-name-regexp (&optional extensions) + "Return regexp matching the file names of images. +If EXTENSIONS is given, only match these." + (if (and (not extensions) (fboundp 'image-file-name-regexp)) + (image-file-name-regexp) + (let ((image-file-name-extensions + (or extensions + '("png" "jpeg" "jpg" "gif" "tiff" "tif" + "xbm" "xpm" "pbm" "pgm" "ppm")))) + (concat "\\." + (regexp-opt (nconc (mapcar 'upcase + image-file-name-extensions) + image-file-name-extensions) + t) + "\\'")))) + +(defun org-file-image-p (file &optional extensions) + "Return non-nil if FILE is an image." + (save-match-data + (string-match (org-image-file-name-regexp extensions) file))) + +(defun org-get-cursor-date (&optional with-time) + "Return the date at cursor in as a time. +This works in the calendar and in the agenda, anywhere else it just +returns the current time. +If WITH-TIME is non-nil, returns the time of the event at point (in +the agenda) or the current time of the day." + (let (date day defd tp tm hod mod) + (when with-time + (setq tp (get-text-property (point) 'time)) + (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp)) + (setq hod (string-to-number (match-string 1 tp)) + mod (string-to-number (match-string 2 tp)))) + (or tp (setq hod (nth 2 (decode-time (current-time))) + mod (nth 1 (decode-time (current-time)))))) + (cond + ((eq major-mode 'calendar-mode) + (setq date (calendar-cursor-to-date) + defd (encode-time 0 (or mod 0) (or hod 0) + (nth 1 date) (nth 0 date) (nth 2 date)))) + ((eq major-mode 'org-agenda-mode) + (setq day (get-text-property (point) 'day)) + (if day + (setq date (calendar-gregorian-from-absolute day) + defd (encode-time 0 (or mod 0) (or hod 0) + (nth 1 date) (nth 0 date) (nth 2 date)))))) + (or defd (current-time)))) + +(defun org-mark-subtree (&optional up) + "Mark the current subtree. +This puts point at the start of the current subtree, and mark at +the end. If a numeric prefix UP is given, move up into the +hierarchy of headlines by UP levels before marking the subtree." + (interactive "P") + (org-with-limited-levels + (cond ((org-at-heading-p) (beginning-of-line)) + ((org-before-first-heading-p) (user-error "Not in a subtree")) + (t (outline-previous-visible-heading 1)))) + (when up (while (and (> up 0) (org-up-heading-safe)) (decf up))) + (if (org-called-interactively-p 'any) + (call-interactively 'org-mark-element) + (org-mark-element))) + + +;;; Indentation + +(defun org-indent-line () + "Indent line depending on context." + (interactive) + (let* ((pos (point)) + (itemp (org-at-item-p)) + (case-fold-search t) + (org-drawer-regexp (or org-drawer-regexp "\000")) + (inline-task-p (and (featurep 'org-inlinetask) + (org-inlinetask-in-task-p))) + (inline-re (and inline-task-p + (org-inlinetask-outline-regexp))) + column) + (if (and orgstruct-is-++ (eq pos (point))) + (let ((indent-line-function (cadadr (assoc 'indent-line-function org-fb-vars)))) + (indent-according-to-mode)) + (beginning-of-line 1) + (cond + ;; Headings + ((looking-at org-outline-regexp) (setq column 0)) + ;; Footnote definition + ((looking-at org-footnote-definition-re) (setq column 0)) + ;; Literal examples + ((looking-at "[ \t]*:\\( \\|$\\)") + (setq column (org-get-indentation))) ; do nothing + ;; Lists + ((ignore-errors (goto-char (org-in-item-p))) + (setq column (if itemp + (org-get-indentation) + (org-list-item-body-column (point)))) + (goto-char pos)) + ;; Drawers + ((and (looking-at "[ \t]*:END:") + (save-excursion (re-search-backward org-drawer-regexp nil t))) + (save-excursion + (goto-char (1- (match-beginning 1))) + (setq column (current-column)))) + ;; Special blocks + ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)") + (save-excursion + (re-search-backward + (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t))) + (setq column (org-get-indentation (match-string 0)))) + ((and (not (looking-at "[ \t]*#\\+begin_")) + (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_")) + (save-excursion + (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t)) + (setq column + (cond ((equal (downcase (match-string 1)) "src") + ;; src blocks: let `org-edit-src-exit' handle them + (org-get-indentation)) + ((equal (downcase (match-string 1)) "example") + (max (org-get-indentation) + (org-get-indentation (match-string 0)))) + (t + (org-get-indentation (match-string 0)))))) + ;; This line has nothing special, look at the previous relevant + ;; line to compute indentation + (t + (beginning-of-line 0) + (while (and (not (bobp)) + (not (looking-at org-table-line-regexp)) + (not (looking-at org-drawer-regexp)) + ;; When point started in an inline task, do not move + ;; above task starting line. + (not (and inline-task-p (looking-at inline-re))) + ;; Skip drawers, blocks, empty lines, verbatim, + ;; comments, tables, footnotes definitions, lists, + ;; inline tasks. + (or (and (looking-at "[ \t]*:END:") + (re-search-backward org-drawer-regexp nil t)) + (and (looking-at "[ \t]*#\\+end_") + (re-search-backward "[ \t]*#\\+begin_"nil t)) + (looking-at "[ \t]*[\n:#|]") + (looking-at org-footnote-definition-re) + (and (not inline-task-p) + (featurep 'org-inlinetask) + (org-inlinetask-in-task-p) + (or (org-inlinetask-goto-beginning) t)))) + (beginning-of-line 0)) + (cond + ;; There was a list item above. + ((ignore-errors (goto-char (org-in-item-p))) + (goto-char (org-list-get-top-point (org-list-struct))) + (setq column (org-get-indentation))) + ;; There was an heading above. + ((looking-at "\\*+[ \t]+") + (if (not org-adapt-indentation) + (setq column 0) + (goto-char (match-end 0)) + (setq column (current-column)))) + ;; A drawer had started and is unfinished + ((looking-at org-drawer-regexp) + (goto-char (1- (match-beginning 1))) + (setq column (current-column))) + ;; Else, nothing noticeable found: get indentation and go on. + (t (setq column (org-get-indentation)))))) + ;; Now apply indentation and move cursor accordingly + (goto-char pos) + (if (<= (current-column) (current-indentation)) + (org-indent-line-to column) + (save-excursion (org-indent-line-to column))) + ;; Special polishing for properties, see `org-property-format' + (setq column (current-column)) + (beginning-of-line 1) + (if (looking-at org-property-re) + (replace-match (concat (match-string 4) + (format org-property-format + (match-string 1) (match-string 3))) + t t)) + (org-move-to-column column)))) + +(defun org-indent-drawer () + "Indent the drawer at point." + (interactive) + (let ((p (point)) + (e (and (save-excursion (re-search-forward ":END:" nil t)) + (match-end 0))) + (folded + (save-excursion + (end-of-line) + (when (overlays-at (point)) + (member 'invisible (overlay-properties + (car (overlays-at (point))))))))) + (when folded (org-cycle)) + (indent-for-tab-command) + (while (and (move-beginning-of-line 2) (< (point) e)) + (indent-for-tab-command)) + (goto-char p) + (when folded (org-cycle))) + (message "Drawer at point indented")) + +(defun org-indent-block () + "Indent the block at point." + (interactive) + (let ((p (point)) + (case-fold-search t) + (e (and (save-excursion (re-search-forward "#\\+end_?\\(?:[a-z]+\\)?" nil t)) + (match-end 0))) + (folded + (save-excursion + (end-of-line) + (when (overlays-at (point)) + (member 'invisible (overlay-properties + (car (overlays-at (point))))))))) + (when folded (org-cycle)) + (indent-for-tab-command) + (while (and (move-beginning-of-line 2) (< (point) e)) + (indent-for-tab-command)) + (goto-char p) + (when folded (org-cycle))) + (message "Block at point indented")) + +(defun org-indent-region (start end) + "Indent region." + (interactive "r") + (save-excursion + (let ((line-end (org-current-line end))) + (goto-char start) + (while (< (org-current-line) line-end) + (cond ((org-in-src-block-p t) (org-src-native-tab-command-maybe)) + (t (call-interactively 'org-indent-line))) + (move-beginning-of-line 2))))) + + +;;; Filling + +;; We use our own fill-paragraph and auto-fill functions. + +;; `org-fill-paragraph' relies on adaptive filling and context +;; checking. Appropriate `fill-prefix' is computed with +;; `org-adaptive-fill-function'. + +;; `org-auto-fill-function' takes care of auto-filling. It calls +;; `do-auto-fill' only on valid areas with `fill-prefix' shadowed with +;; `org-adaptive-fill-function' value. Internally, +;; `org-comment-line-break-function' breaks the line. + +;; `org-setup-filling' installs filling and auto-filling related +;; variables during `org-mode' initialization. + +(defvar org-element-paragraph-separate) ; org-element.el +(defun org-setup-filling () + (require 'org-element) + ;; Prevent auto-fill from inserting unwanted new items. + (when (boundp 'fill-nobreak-predicate) + (org-set-local + 'fill-nobreak-predicate + (org-uniquify + (append fill-nobreak-predicate + '(org-fill-line-break-nobreak-p + org-fill-paragraph-with-timestamp-nobreak-p))))) + (let ((paragraph-ending (substring org-element-paragraph-separate 1))) + (org-set-local 'paragraph-start paragraph-ending) + (org-set-local 'paragraph-separate paragraph-ending)) + (org-set-local 'fill-paragraph-function 'org-fill-paragraph) + (org-set-local 'auto-fill-inhibit-regexp nil) + (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function) + (org-set-local 'normal-auto-fill-function 'org-auto-fill-function) + (org-set-local 'comment-line-break-function 'org-comment-line-break-function)) + +(defun org-fill-line-break-nobreak-p () + "Non-nil when a new line at point would create an Org line break." + (save-excursion + (skip-chars-backward "[ \t]") + (skip-chars-backward "\\\\") + (looking-at "\\\\\\\\\\($\\|[^\\\\]\\)"))) + +(defun org-fill-paragraph-with-timestamp-nobreak-p () + "Non-nil when a new line at point would split a timestamp." + (and (org-at-timestamp-p t) + (not (looking-at org-ts-regexp-both)))) + +(declare-function message-in-body-p "message" ()) +(defvar orgtbl-line-start-regexp) ; From org-table.el +(defun org-adaptive-fill-function () + "Compute a fill prefix for the current line. +Return fill prefix, as a string, or nil if current line isn't +meant to be filled. For convenience, if `adaptive-fill-regexp' +matches in paragraphs or comments, use it." + (catch 'exit + (when (derived-mode-p 'message-mode) + (save-excursion + (beginning-of-line) + (cond ((or (not (message-in-body-p)) + (looking-at orgtbl-line-start-regexp)) + (throw 'exit nil)) + ((looking-at message-cite-prefix-regexp) + (throw 'exit (match-string-no-properties 0))) + ((looking-at org-outline-regexp) + (throw 'exit (make-string (length (match-string 0)) ? )))))) + (org-with-wide-buffer + (let* ((p (line-beginning-position)) + (element (save-excursion + (beginning-of-line) + (or (ignore-errors (org-element-at-point)) + (user-error "An element cannot be parsed line %d" + (line-number-at-pos (point)))))) + (type (org-element-type element)) + (post-affiliated (org-element-property :post-affiliated element))) + (unless (and post-affiliated (< p post-affiliated)) + (case type + (comment + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*") + (concat (match-string 0) "# "))) + (footnote-definition "") + ((item plain-list) + (make-string (org-list-item-body-column + (or post-affiliated + (org-element-property :begin element))) + ? )) + (paragraph + ;; Fill prefix is usually the same as the current line, + ;; unless the paragraph is at the beginning of an item. + (let ((parent (org-element-property :parent element))) + (save-excursion + (beginning-of-line) + (cond ((eq (org-element-type parent) 'item) + (make-string (org-list-item-body-column + (org-element-property :begin parent)) + ? )) + ((and adaptive-fill-regexp + ;; Locally disable + ;; `adaptive-fill-function' to let + ;; `fill-context-prefix' handle + ;; `adaptive-fill-regexp' variable. + (let (adaptive-fill-function) + (fill-context-prefix + post-affiliated + (org-element-property :end element))))) + ((looking-at "[ \t]+") (match-string 0)) + (t ""))))) + (comment-block + ;; Only fill contents if P is within block boundaries. + (let* ((cbeg (save-excursion (goto-char post-affiliated) + (forward-line) + (point))) + (cend (save-excursion + (goto-char (org-element-property :end element)) + (skip-chars-backward " \r\t\n") + (line-beginning-position)))) + (when (and (>= p cbeg) (< p cend)) + (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) + (match-string 0) + "")))))))))) + +(declare-function message-goto-body "message" ()) +(defvar message-cite-prefix-regexp) ; From message.el +(defun org-fill-paragraph (&optional justify) + "Fill element at point, when applicable. + +This function only applies to comment blocks, comments, example +blocks and paragraphs. Also, as a special case, re-align table +when point is at one. + +If JUSTIFY is non-nil (interactively, with prefix argument), +justify as well. If `sentence-end-double-space' is non-nil, then +period followed by one space does not end a sentence, so don't +break a line there. The variable `fill-column' controls the +width for filling. + +For convenience, when point is at a plain list, an item or +a footnote definition, try to fill the first paragraph within." + (interactive) + (if (and (derived-mode-p 'message-mode) + (or (not (message-in-body-p)) + (save-excursion (move-beginning-of-line 1) + (looking-at message-cite-prefix-regexp)))) + ;; First ensure filling is correct in message-mode. + (let ((fill-paragraph-function + (cadadr (assoc 'fill-paragraph-function org-fb-vars))) + (fill-prefix (cadadr (assoc 'fill-prefix org-fb-vars))) + (paragraph-start (cadadr (assoc 'paragraph-start org-fb-vars))) + (paragraph-separate + (cadadr (assoc 'paragraph-separate org-fb-vars)))) + (fill-paragraph nil)) + (with-syntax-table org-mode-transpose-word-syntax-table + ;; Move to end of line in order to get the first paragraph + ;; within a plain list or a footnote definition. + (let ((element (save-excursion + (end-of-line) + (or (ignore-errors (org-element-at-point)) + (user-error "An element cannot be parsed line %d" + (line-number-at-pos (point))))))) + ;; First check if point is in a blank line at the beginning of + ;; the buffer. In that case, ignore filling. + (case (org-element-type element) + ;; Use major mode filling function is src blocks. + (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) + ;; Align Org tables, leave table.el tables as-is. + (table-row (org-table-align) t) + (table + (when (eq (org-element-property :type element) 'org) + (save-excursion + (goto-char (org-element-property :post-affiliated element)) + (org-table-align))) + t) + (paragraph + ;; Paragraphs may contain `line-break' type objects. + (let ((beg (max (point-min) + (org-element-property :contents-begin element))) + (end (min (point-max) + (org-element-property :contents-end element)))) + ;; Do nothing if point is at an affiliated keyword. + (if (< (line-end-position) beg) t + (when (derived-mode-p 'message-mode) + ;; In `message-mode', do not fill following citation + ;; in current paragraph nor text before message body. + (let ((body-start (save-excursion (message-goto-body)))) + (when body-start (setq beg (max body-start beg)))) + (when (save-excursion + (re-search-forward + (concat "^" message-cite-prefix-regexp) end t)) + (setq end (match-beginning 0)))) + ;; Fill paragraph, taking line breaks into account. + ;; For that, slice the paragraph using line breaks as + ;; separators, and fill the parts in reverse order to + ;; avoid messing with markers. + (save-excursion + (goto-char end) + (mapc + (lambda (pos) + (fill-region-as-paragraph pos (point) justify) + (goto-char pos)) + ;; Find the list of ending positions for line breaks + ;; in the current paragraph. Add paragraph + ;; beginning to include first slice. + (nreverse + (cons beg + (org-element-map + (org-element--parse-objects + beg end nil (org-element-restriction 'paragraph)) + 'line-break + (lambda (lb) (org-element-property :end lb))))))) + t))) + ;; Contents of `comment-block' type elements should be + ;; filled as plain text, but only if point is within block + ;; markers. + (comment-block + (let* ((case-fold-search t) + (beg (save-excursion + (goto-char (org-element-property :begin element)) + (re-search-forward "^[ \t]*#\\+begin_comment" nil t) + (forward-line) + (point))) + (end (save-excursion + (goto-char (org-element-property :end element)) + (re-search-backward "^[ \t]*#\\+end_comment" nil t) + (line-beginning-position)))) + (if (or (< (point) beg) (> (point) end)) t + (fill-region-as-paragraph + (save-excursion (end-of-line) + (re-search-backward "^[ \t]*$" beg 'move) + (line-beginning-position)) + (save-excursion (beginning-of-line) + (re-search-forward "^[ \t]*$" end 'move) + (line-beginning-position)) + justify)))) + ;; Fill comments. + (comment + (let ((begin (org-element-property :post-affiliated element)) + (end (org-element-property :end element))) + (when (and (>= (point) begin) (<= (point) end)) + (let ((begin (save-excursion + (end-of-line) + (if (re-search-backward "^[ \t]*#[ \t]*$" begin t) + (progn (forward-line) (point)) + begin))) + (end (save-excursion + (end-of-line) + (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move) + (1- (line-beginning-position)) + (skip-chars-backward " \r\t\n") + (line-end-position))))) + ;; Do not fill comments when at a blank line. + (when (> end begin) + (let ((fill-prefix + (save-excursion + (beginning-of-line) + (looking-at "[ \t]*#") + (let ((comment-prefix (match-string 0))) + (goto-char (match-end 0)) + (if (looking-at adaptive-fill-regexp) + (concat comment-prefix (match-string 0)) + (concat comment-prefix " ")))))) + (save-excursion + (fill-region-as-paragraph begin end justify)))))) + t)) + ;; Ignore every other element. + (otherwise t)))))) + +(defun org-auto-fill-function () + "Auto-fill function." + ;; Check if auto-filling is meaningful. + (let ((fc (current-fill-column))) + (when (and fc (> (current-column) fc)) + (let* ((fill-prefix (org-adaptive-fill-function)) + ;; Enforce empty fill prefix, if required. Otherwise, it + ;; will be computed again. + (adaptive-fill-mode (not (equal fill-prefix "")))) + (when fill-prefix (do-auto-fill)))))) + +(defun org-comment-line-break-function (&optional soft) + "Break line at point and indent, continuing comment if within one. +The inserted newline is marked hard if variable +`use-hard-newlines' is true, unless optional argument SOFT is +non-nil." + (if soft (insert-and-inherit ?\n) (newline 1)) + (save-excursion (forward-char -1) (delete-horizontal-space)) + (delete-horizontal-space) + (indent-to-left-margin) + (insert-before-markers-and-inherit fill-prefix)) + + +;;; Comments + +;; Org comments syntax is quite complex. It requires the entire line +;; to be just a comment. Also, even with the right syntax at the +;; beginning of line, some some elements (i.e. verse-block or +;; example-block) don't accept comments. Usual Emacs comment commands +;; cannot cope with those requirements. Therefore, Org replaces them. + +;; Org still relies on `comment-dwim', but cannot trust +;; `comment-only-p'. So, `comment-region-function' and +;; `uncomment-region-function' both point +;; to`org-comment-or-uncomment-region'. Eventually, +;; `org-insert-comment' takes care of insertion of comments at the +;; beginning of line. + +;; `org-setup-comments-handling' install comments related variables +;; during `org-mode' initialization. + +(defun org-setup-comments-handling () + (interactive) + (org-set-local 'comment-use-syntax nil) + (org-set-local 'comment-start "# ") + (org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)") + (org-set-local 'comment-insert-comment-function 'org-insert-comment) + (org-set-local 'comment-region-function 'org-comment-or-uncomment-region) + (org-set-local 'uncomment-region-function 'org-comment-or-uncomment-region)) + +(defun org-insert-comment () + "Insert an empty comment above current line. +If the line is empty, insert comment at its beginning." + (beginning-of-line) + (if (looking-at "\\s-*$") (replace-match "") (open-line 1)) + (org-indent-line) + (insert "# ")) + +(defvar comment-empty-lines) ; From newcomment.el. +(defun org-comment-or-uncomment-region (beg end &rest ignore) + "Comment or uncomment each non-blank line in the region. +Uncomment each non-blank line between BEG and END if it only +contains commented lines. Otherwise, comment them." + (save-restriction + ;; Restrict region + (narrow-to-region (save-excursion (goto-char beg) + (skip-chars-forward " \r\t\n" end) + (line-beginning-position)) + (save-excursion (goto-char end) + (skip-chars-backward " \r\t\n" beg) + (line-end-position))) + (let ((uncommentp + ;; UNCOMMENTP is non-nil when every non blank line between + ;; BEG and END is a comment. + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) + (let ((element (org-element-at-point))) + (and (eq (org-element-type element) 'comment) + (goto-char (min (point-max) + (org-element-property + :end element))))))) + (eobp)))) + (if uncommentp + ;; Only blank lines and comments in region: uncomment it. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)") + (replace-match "" nil nil nil 1)) + (forward-line))) + ;; Comment each line in region. + (let ((min-indent (point-max))) + ;; First find the minimum indentation across all lines. + (save-excursion + (goto-char (point-min)) + (while (and (not (eobp)) (not (zerop min-indent))) + (unless (looking-at "[ \t]*$") + (setq min-indent (min min-indent (current-indentation)))) + (forward-line))) + ;; Then loop over all lines. + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) + ;; Don't get fooled by invisible text (e.g. link path) + ;; when moving to column MIN-INDENT. + (let ((buffer-invisibility-spec nil)) + (org-move-to-column min-indent t)) + (insert comment-start)) + (forward-line)))))))) + + +;;; Planning + +;; This section contains tools to operate on timestamp objects, as +;; returned by, e.g. `org-element-context'. + +(defun org-timestamp-has-time-p (timestamp) + "Non-nil when TIMESTAMP has a time specified." + (org-element-property :hour-start timestamp)) + +(defun org-timestamp-format (timestamp format &optional end utc) + "Format a TIMESTAMP element into a string. + +FORMAT is a format specifier to be passed to +`format-time-string'. + +When optional argument END is non-nil, use end of date-range or +time-range, if possible. + +When optional argument UTC is non-nil, time will be expressed as +Universal Time." + (format-time-string + format + (apply 'encode-time + (cons 0 + (mapcar + (lambda (prop) (or (org-element-property prop timestamp) 0)) + (if end '(:minute-end :hour-end :day-end :month-end :year-end) + '(:minute-start :hour-start :day-start :month-start + :year-start))))) + utc)) + +(defun org-timestamp-split-range (timestamp &optional end) + "Extract a timestamp object from a date or time range. + +TIMESTAMP is a timestamp object. END, when non-nil, means extract +the end of the range. Otherwise, extract its start. + +Return a new timestamp object sharing the same parent as +TIMESTAMP." + (let ((type (org-element-property :type timestamp))) + (if (memq type '(active inactive diary)) timestamp + (let ((split-ts (list 'timestamp (copy-sequence (nth 1 timestamp))))) + ;; Set new type. + (org-element-put-property + split-ts :type (if (eq type 'active-range) 'active 'inactive)) + ;; Copy start properties over end properties if END is + ;; non-nil. Otherwise, copy end properties over `start' ones. + (let ((p-alist '((:minute-start . :minute-end) + (:hour-start . :hour-end) + (:day-start . :day-end) + (:month-start . :month-end) + (:year-start . :year-end)))) + (dolist (p-cell p-alist) + (org-element-put-property + split-ts + (funcall (if end 'car 'cdr) p-cell) + (org-element-property + (funcall (if end 'cdr 'car) p-cell) split-ts))) + ;; Eventually refresh `:raw-value'. + (org-element-put-property split-ts :raw-value nil) + (org-element-put-property + split-ts :raw-value (org-element-interpret-data split-ts))))))) + +(defun org-timestamp-translate (timestamp &optional boundary) + "Apply `org-translate-time' on a TIMESTAMP object. +When optional argument BOUNDARY is non-nil, it is either the +symbol `start' or `end'. In this case, only translate the +starting or ending part of TIMESTAMP if it is a date or time +range. Otherwise, translate both parts." + (if (and (not boundary) + (memq (org-element-property :type timestamp) + '(active-range inactive-range))) + (concat + (org-translate-time + (org-element-property :raw-value + (org-timestamp-split-range timestamp))) + "--" + (org-translate-time + (org-element-property :raw-value + (org-timestamp-split-range timestamp t)))) + (org-translate-time + (org-element-property + :raw-value + (if (not boundary) timestamp + (org-timestamp-split-range timestamp (eq boundary 'end))))))) + + + +;;; Other stuff. + +(defun org-toggle-fixed-width-section (arg) + "Toggle the fixed-width export. +If there is no active region, the QUOTE keyword at the current headline is +inserted or removed. When present, it causes the text between this headline +and the next to be exported as fixed-width text, and unmodified. +If there is an active region, this command adds or removes a colon as the +first character of this line. If the first character of a line is a colon, +this line is also exported in fixed-width font." + (interactive "P") + (let* ((cc 0) + (regionp (org-region-active-p)) + (beg (if regionp (region-beginning) (point))) + (end (if regionp (region-end))) + (nlines (or arg (if (and beg end) (count-lines beg end) 1))) + (case-fold-search nil) + (re "[ \t]*\\(:\\(?: \\|$\\)\\)") + off) + (if regionp + (save-excursion + (goto-char beg) + (setq cc (current-column)) + (beginning-of-line 1) + (setq off (looking-at re)) + (while (> nlines 0) + (setq nlines (1- nlines)) + (beginning-of-line 1) + (cond + (arg + (org-move-to-column cc t) + (insert ": \n") + (forward-line -1)) + ((and off (looking-at re)) + (replace-match "" t t nil 1)) + ((not off) (org-move-to-column cc t) (insert ": "))) + (forward-line 1))) + (save-excursion + (org-back-to-heading) + (cond + ((looking-at (format org-heading-keyword-regexp-format + org-quote-string)) + (goto-char (match-end 1)) + (looking-at (concat " +" org-quote-string)) + (replace-match "" t t) + (when (eolp) (insert " "))) + ((looking-at org-outline-regexp) + (goto-char (match-end 0)) + (insert org-quote-string " "))))))) + +(defun org-reftex-citation () + "Use reftex-citation to insert a citation into the buffer. +This looks for a line like + +#+BIBLIOGRAPHY: foo plain option:-d + +and derives from it that foo.bib is the bibliography file relevant +for this document. It then installs the necessary environment for RefTeX +to work in this buffer and calls `reftex-citation' to insert a citation +into the buffer. + +Export of such citations to both LaTeX and HTML is handled by the contributed +package ox-bibtex by Taru Karttunen." + (interactive) + (let ((reftex-docstruct-symbol 'rds) + (reftex-cite-format "\\cite{%l}") + rds bib) + (save-excursion + (save-restriction + (widen) + (let ((case-fold-search t) + (re "^#\\+bibliography:[ \t]+\\([^ \t\n]+\\)")) + (if (not (save-excursion + (or (re-search-forward re nil t) + (re-search-backward re nil t)))) + (error "No bibliography defined in file") + (setq bib (concat (match-string 1) ".bib") + rds (list (list 'bib bib))))))) + (call-interactively 'reftex-citation))) + +;;;; Functions extending outline functionality + +(defun org-beginning-of-line (&optional arg) + "Go to the beginning of the current line. If that is invisible, continue +to a visible line beginning. This makes the function of C-a more intuitive. +If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the +first attempt, and only move to after the tags when the cursor is already +beyond the end of the headline." + (interactive "P") + (let ((pos (point)) + (special (if (consp org-special-ctrl-a/e) + (car org-special-ctrl-a/e) + org-special-ctrl-a/e)) + deactivate-mark refpos) + (if (org-bound-and-true-p visual-line-mode) + (beginning-of-visual-line 1) + (beginning-of-line 1)) + (if (and arg (fboundp 'move-beginning-of-line)) + (call-interactively 'move-beginning-of-line) + (if (bobp) + nil + (backward-char 1) + (if (org-truely-invisible-p) + (while (and (not (bobp)) (org-truely-invisible-p)) + (backward-char 1) + (beginning-of-line 1)) + (forward-char 1)))) + (when special + (cond + ((and (looking-at org-complex-heading-regexp) + (= (char-after (match-end 1)) ?\ )) + (setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1))) + (point-at-eol))) + (goto-char + (if (eq special t) + (cond ((> pos refpos) refpos) + ((= pos (point)) refpos) + (t (point))) + (cond ((> pos (point)) (point)) + ((not (eq last-command this-command)) (point)) + (t refpos))))) + ((org-at-item-p) + ;; Being at an item and not looking at an the item means point + ;; was previously moved to beginning of a visual line, which + ;; doesn't contain the item. Therefore, do nothing special, + ;; just stay here. + (when (looking-at org-list-full-item-re) + ;; Set special position at first white space character after + ;; bullet, and check-box, if any. + (let ((after-bullet + (let ((box (match-end 3))) + (if (not box) (match-end 1) + (let ((after (char-after box))) + (if (and after (= after ? )) (1+ box) box)))))) + ;; Special case: Move point to special position when + ;; currently after it or at beginning of line. + (if (eq special t) + (when (or (> pos after-bullet) (= (point) pos)) + (goto-char after-bullet)) + ;; Reversed case: Move point to special position when + ;; point was already at beginning of line and command is + ;; repeated. + (when (and (= (point) pos) (eq last-command this-command)) + (goto-char after-bullet)))))))) + (org-no-warnings + (and (featurep 'xemacs) (setq zmacs-region-stays t)))) + (setq disable-point-adjustment + (or (not (invisible-p (point))) + (not (invisible-p (max (point-min) (1- (point)))))))) + +(defun org-end-of-line (&optional arg) + "Go to the end of the line. +If this is a headline, and `org-special-ctrl-a/e' is set, ignore +tags on the first attempt, and only move to after the tags when +the cursor is already beyond the end of the headline." + (interactive "P") + (let ((special (if (consp org-special-ctrl-a/e) (cdr org-special-ctrl-a/e) + org-special-ctrl-a/e)) + (move-fun (cond ((org-bound-and-true-p visual-line-mode) + 'end-of-visual-line) + ((fboundp 'move-end-of-line) 'move-end-of-line) + (t 'end-of-line))) + deactivate-mark) + (if (or (not special) arg) (call-interactively move-fun) + (let* ((element (save-excursion (beginning-of-line) + (org-element-at-point))) + (type (org-element-type element))) + (cond + ((memq type '(headline inlinetask)) + (let ((pos (point))) + (beginning-of-line 1) + (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$")) + (if (eq special t) + (if (or (< pos (match-beginning 1)) (= pos (match-end 0))) + (goto-char (match-beginning 1)) + (goto-char (match-end 0))) + (if (or (< pos (match-end 0)) + (not (eq this-command last-command))) + (goto-char (match-end 0)) + (goto-char (match-beginning 1)))) + (call-interactively move-fun)))) + ((org-element-property :hiddenp element) + ;; If element is hidden, `move-end-of-line' would put point + ;; after it. Use `end-of-line' to stay on current line. + (call-interactively 'end-of-line)) + (t (call-interactively move-fun))))) + (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t)))) + (setq disable-point-adjustment + (or (not (invisible-p (point))) + (not (invisible-p (max (point-min) (1- (point)))))))) + +(define-key org-mode-map "\C-a" 'org-beginning-of-line) +(define-key org-mode-map "\C-e" 'org-end-of-line) + +(defun org-backward-sentence (&optional arg) + "Go to beginning of sentence, or beginning of table field. +This will call `backward-sentence' or `org-table-beginning-of-field', +depending on context." + (interactive "P") + (cond + ((org-at-table-p) (call-interactively 'org-table-beginning-of-field)) + (t (call-interactively 'backward-sentence)))) + +(defun org-forward-sentence (&optional arg) + "Go to end of sentence, or end of table field. +This will call `forward-sentence' or `org-table-end-of-field', +depending on context." + (interactive "P") + (cond + ((org-at-table-p) (call-interactively 'org-table-end-of-field)) + (t (call-interactively 'forward-sentence)))) + +(define-key org-mode-map "\M-a" 'org-backward-sentence) +(define-key org-mode-map "\M-e" 'org-forward-sentence) + +(defun org-kill-line (&optional arg) + "Kill line, to tags or end of line." + (interactive "P") + (cond + ((or (not org-special-ctrl-k) + (bolp) + (not (org-at-heading-p))) + (if (and (get-char-property (min (point-max) (point-at-eol)) 'invisible) + org-ctrl-k-protect-subtree) + (if (or (eq org-ctrl-k-protect-subtree 'error) + (not (y-or-n-p "Kill hidden subtree along with headline? "))) + (user-error "C-k aborted as it would kill a hidden subtree"))) + (call-interactively + (if (org-bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line))) + ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")) + (kill-region (point) (match-beginning 1)) + (org-set-tags nil t)) + (t (kill-region (point) (point-at-eol))))) + +(define-key org-mode-map "\C-k" 'org-kill-line) + +(defun org-yank (&optional arg) + "Yank. If the kill is a subtree, treat it specially. +This command will look at the current kill and check if is a single +subtree, or a series of subtrees[1]. If it passes the test, and if the +cursor is at the beginning of a line or after the stars of a currently +empty headline, then the yank is handled specially. How exactly depends +on the value of the following variables, both set by default. + +org-yank-folded-subtrees + When set, the subtree(s) will be folded after insertion, but only + if doing so would now swallow text after the yanked text. + +org-yank-adjusted-subtrees + When set, the subtree will be promoted or demoted in order to + fit into the local outline tree structure, which means that the level + will be adjusted so that it becomes the smaller one of the two + *visible* surrounding headings. + +Any prefix to this command will cause `yank' to be called directly with +no special treatment. In particular, a simple \\[universal-argument] prefix \ +will just +plainly yank the text as it is. + +\[1] The test checks if the first non-white line is a heading + and if there are no other headings with fewer stars." + (interactive "P") + (org-yank-generic 'yank arg)) + +(defun org-yank-generic (command arg) + "Perform some yank-like command. + +This function implements the behavior described in the `org-yank' +documentation. However, it has been generalized to work for any +interactive command with similar behavior." + + ;; pretend to be command COMMAND + (setq this-command command) + + (if arg + (call-interactively command) + + (let ((subtreep ; is kill a subtree, and the yank position appropriate? + (and (org-kill-is-subtree-p) + (or (bolp) + (and (looking-at "[ \t]*$") + (string-match + "\\`\\*+\\'" + (buffer-substring (point-at-bol) (point))))))) + swallowp) + (cond + ((and subtreep org-yank-folded-subtrees) + (let ((beg (point)) + end) + (if (and subtreep org-yank-adjusted-subtrees) + (org-paste-subtree nil nil 'for-yank) + (call-interactively command)) + + (setq end (point)) + (goto-char beg) + (when (and (bolp) subtreep + (not (setq swallowp + (org-yank-folding-would-swallow-text beg end)))) + (org-with-limited-levels + (or (looking-at org-outline-regexp) + (re-search-forward org-outline-regexp-bol end t)) + (while (and (< (point) end) (looking-at org-outline-regexp)) + (hide-subtree) + (org-cycle-show-empty-lines 'folded) + (condition-case nil + (outline-forward-same-level 1) + (error (goto-char end)))))) + (when swallowp + (message + "Inserted text not folded because that would swallow text")) + + (goto-char end) + (skip-chars-forward " \t\n\r") + (beginning-of-line 1) + (push-mark beg 'nomsg))) + ((and subtreep org-yank-adjusted-subtrees) + (let ((beg (point-at-bol))) + (org-paste-subtree nil nil 'for-yank) + (push-mark beg 'nomsg))) + (t + (call-interactively command)))))) + +(defun org-yank-folding-would-swallow-text (beg end) + "Would hide-subtree at BEG swallow any text after END?" + (let (level) + (org-with-limited-levels + (save-excursion + (goto-char beg) + (when (or (looking-at org-outline-regexp) + (re-search-forward org-outline-regexp-bol end t)) + (setq level (org-outline-level))) + (goto-char end) + (skip-chars-forward " \t\r\n\v\f") + (if (or (eobp) + (and (bolp) (looking-at org-outline-regexp) + (<= (org-outline-level) level))) + nil ; Nothing would be swallowed + t))))) ; something would swallow + +(define-key org-mode-map "\C-y" 'org-yank) + +(defun org-truely-invisible-p () + "Check if point is at a character currently not visible. +This version does not only check the character property, but also +`visible-mode'." + ;; Early versions of noutline don't have `outline-invisible-p'. + (if (org-bound-and-true-p visible-mode) + nil + (outline-invisible-p))) + +(defun org-invisible-p2 () + "Check if point is at a character currently not visible." + (save-excursion + (if (and (eolp) (not (bobp))) (backward-char 1)) + ;; Early versions of noutline don't have `outline-invisible-p'. + (outline-invisible-p))) + +(defun org-back-to-heading (&optional invisible-ok) + "Call `outline-back-to-heading', but provide a better error message." + (condition-case nil + (outline-back-to-heading invisible-ok) + (error (error "Before first headline at position %d in buffer %s" + (point) (current-buffer))))) + +(defun org-before-first-heading-p () + "Before first heading?" + (save-excursion + (end-of-line) + (null (re-search-backward org-outline-regexp-bol nil t)))) + +(defun org-at-heading-p (&optional ignored) + (outline-on-heading-p t)) +;; Compatibility alias with Org versions < 7.8.03 +(defalias 'org-on-heading-p 'org-at-heading-p) + +(defun org-at-comment-p nil + "Is cursor in a line starting with a # character?" + (save-excursion + (beginning-of-line) + (looking-at "^#"))) + +(defun org-at-drawer-p nil + "Is cursor at a drawer keyword?" + (save-excursion + (move-beginning-of-line 1) + (looking-at org-drawer-regexp))) + +(defun org-at-block-p nil + "Is cursor at a block keyword?" + (save-excursion + (move-beginning-of-line 1) + (looking-at org-block-regexp))) + +(defun org-point-at-end-of-empty-headline () + "If point is at the end of an empty headline, return t, else nil. +If the heading only contains a TODO keyword, it is still still considered +empty." + (and (looking-at "[ \t]*$") + (when org-todo-line-regexp + (save-excursion + (beginning-of-line 1) + (let ((case-fold-search nil)) + (looking-at org-todo-line-regexp) + (string= (match-string 3) "")))))) + +(defun org-at-heading-or-item-p () + (or (org-at-heading-p) (org-at-item-p))) + +(defun org-at-target-p () + (or (org-in-regexp org-radio-target-regexp) + (org-in-regexp org-target-regexp))) +;; Compatibility alias with Org versions < 7.8.03 +(defalias 'org-on-target-p 'org-at-target-p) + +(defun org-up-heading-all (arg) + "Move to the heading line of which the present line is a subheading. +This function considers both visible and invisible heading lines. +With argument, move up ARG levels." + (if (fboundp 'outline-up-heading-all) + (outline-up-heading-all arg) ; emacs 21 version of outline.el + (outline-up-heading arg t))) ; emacs 22 version of outline.el + +(defun org-up-heading-safe () + "Move to the heading line of which the present line is a subheading. +This version will not throw an error. It will return the level of the +headline found, or nil if no higher level is found. + +Also, this function will be a lot faster than `outline-up-heading', +because it relies on stars being the outline starters. This can really +make a significant difference in outlines with very many siblings." + (let (start-level re) + (org-back-to-heading t) + (setq start-level (funcall outline-level)) + (if (equal start-level 1) + nil + (setq re (concat "^\\*\\{1," (number-to-string (1- start-level)) "\\} ")) + (if (re-search-backward re nil t) + (funcall outline-level))))) + +(defun org-first-sibling-p () + "Is this heading the first child of its parents?" + (interactive) + (let ((re org-outline-regexp-bol) + level l) + (unless (org-at-heading-p t) + (user-error "Not at a heading")) + (setq level (funcall outline-level)) + (save-excursion + (if (not (re-search-backward re nil t)) + t + (setq l (funcall outline-level)) + (< l level))))) + +(defun org-goto-sibling (&optional previous) + "Goto the next sibling, even if it is invisible. +When PREVIOUS is set, go to the previous sibling instead. Returns t +when a sibling was found. When none is found, return nil and don't +move point." + (let ((fun (if previous 're-search-backward 're-search-forward)) + (pos (point)) + (re org-outline-regexp-bol) + level l) + (when (condition-case nil (org-back-to-heading t) (error nil)) + (setq level (funcall outline-level)) + (catch 'exit + (or previous (forward-char 1)) + (while (funcall fun re nil t) + (setq l (funcall outline-level)) + (when (< l level) (goto-char pos) (throw 'exit nil)) + (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t))) + (goto-char pos) + nil)))) + +(defun org-show-siblings () + "Show all siblings of the current headline." + (save-excursion + (while (org-goto-sibling) (org-flag-heading nil))) + (save-excursion + (while (org-goto-sibling 'previous) + (org-flag-heading nil)))) + +(defun org-goto-first-child () + "Goto the first child, even if it is invisible. +Return t when a child was found. Otherwise don't move point and +return nil." + (let (level (pos (point)) (re org-outline-regexp-bol)) + (when (condition-case nil (org-back-to-heading t) (error nil)) + (setq level (outline-level)) + (forward-char 1) + (if (and (re-search-forward re nil t) (> (outline-level) level)) + (progn (goto-char (match-beginning 0)) t) + (goto-char pos) nil)))) + +(defun org-show-hidden-entry () + "Show an entry where even the heading is hidden." + (save-excursion + (org-show-entry))) + +(defun org-flag-heading (flag &optional entry) + "Flag the current heading. FLAG non-nil means make invisible. +When ENTRY is non-nil, show the entire entry." + (save-excursion + (org-back-to-heading t) + ;; Check if we should show the entire entry + (if entry + (progn + (org-show-entry) + (save-excursion + (and (outline-next-heading) + (org-flag-heading nil)))) + (outline-flag-region (max (point-min) (1- (point))) + (save-excursion (outline-end-of-heading) (point)) + flag)))) + +(defun org-get-next-sibling () + "Move to next heading of the same level, and return point. +If there is no such heading, return nil. +This is like outline-next-sibling, but invisible headings are ok." + (let ((level (funcall outline-level))) + (outline-next-heading) + (while (and (not (eobp)) (> (funcall outline-level) level)) + (outline-next-heading)) + (if (or (eobp) (< (funcall outline-level) level)) + nil + (point)))) + +(defun org-get-last-sibling () + "Move to previous heading of the same level, and return point. +If there is no such heading, return nil." + (let ((opoint (point)) + (level (funcall outline-level))) + (outline-previous-heading) + (when (and (/= (point) opoint) (outline-on-heading-p t)) + (while (and (> (funcall outline-level) level) + (not (bobp))) + (outline-previous-heading)) + (if (< (funcall outline-level) level) + nil + (point))))) + +(defun org-end-of-subtree (&optional invisible-ok to-heading) + "Goto to the end of a subtree." + ;; This contains an exact copy of the original function, but it uses + ;; `org-back-to-heading', to make it work also in invisible + ;; trees. And is uses an invisible-ok argument. + ;; Under Emacs this is not needed, but the old outline.el needs this fix. + ;; Furthermore, when used inside Org, finding the end of a large subtree + ;; with many children and grandchildren etc, this can be much faster + ;; than the outline version. + (org-back-to-heading invisible-ok) + (let ((first t) + (level (funcall outline-level))) + (if (and (derived-mode-p 'org-mode) (< level 1000)) + ;; A true heading (not a plain list item), in Org-mode + ;; This means we can easily find the end by looking + ;; only for the right number of stars. Using a regexp to do + ;; this is so much faster than using a Lisp loop. + (let ((re (concat "^\\*\\{1," (int-to-string level) "\\} "))) + (forward-char 1) + (and (re-search-forward re nil 'move) (beginning-of-line 1))) + ;; something else, do it the slow way + (while (and (not (eobp)) + (or first (> (funcall outline-level) level))) + (setq first nil) + (outline-next-heading))) + (unless to-heading + (if (memq (preceding-char) '(?\n ?\^M)) + (progn + ;; Go to end of line before heading + (forward-char -1) + (if (memq (preceding-char) '(?\n ?\^M)) + ;; leave blank line before heading + (forward-char -1)))))) + (point)) + +(defun org-end-of-meta-data-and-drawers () + "Jump to the first text after meta data and drawers in the current entry. +This will move over empty lines, lines with planning time stamps, +clocking lines, and drawers." + (org-back-to-heading t) + (let ((end (save-excursion (outline-next-heading) (point))) + (re (concat "\\(" org-drawer-regexp "\\)" + "\\|" "[ \t]*" org-keyword-time-regexp))) + (forward-line 1) + (while (re-search-forward re end t) + (if (not (match-end 1)) + ;; empty or planning line + (forward-line 1) + ;; a drawer, find the end + (re-search-forward "^[ \t]*:END:" end 'move) + (forward-line 1))) + (and (re-search-forward "[^\n]" nil t) (backward-char 1)) + (point))) + +(defun org-forward-heading-same-level (arg &optional invisible-ok) + "Move forward to the ARG'th subheading at same level as this one. +Stop at the first and last subheadings of a superior heading. +Normally this only looks at visible headings, but when INVISIBLE-OK is +non-nil it will also look at invisible ones." + (interactive "p") + (if (not (ignore-errors (org-back-to-heading invisible-ok))) + (if (and arg (< arg 0)) + (goto-char (point-min)) + (outline-next-heading)) + (org-at-heading-p) + (let ((level (- (match-end 0) (match-beginning 0) 1)) + (f (if (and arg (< arg 0)) + 're-search-backward + 're-search-forward)) + (count (if arg (abs arg) 1)) + (result (point))) + (while (and (prog1 (> count 0) + (forward-char (if (and arg (< arg 0)) -1 1))) + (funcall f org-outline-regexp-bol nil 'move)) + (let ((l (- (match-end 0) (match-beginning 0) 1))) + (cond ((< l level) (setq count 0)) + ((and (= l level) + (or invisible-ok + (progn + (goto-char (line-beginning-position)) + (not (outline-invisible-p))))) + (setq count (1- count)) + (when (eq l level) + (setq result (point))))))) + (goto-char result)) + (beginning-of-line 1))) + +(defun org-backward-heading-same-level (arg &optional invisible-ok) + "Move backward to the ARG'th subheading at same level as this one. +Stop at the first and last subheadings of a superior heading." + (interactive "p") + (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok)) + +(defun org-next-block (arg &optional backward block-regexp) + "Jump to the next block. +With a prefix argument ARG, jump forward ARG many source blocks. +When BACKWARD is non-nil, jump to the previous block. +When BLOCK-REGEXP is non-nil, use this regexp to find blocks." + (interactive "p") + (let ((re (or block-regexp org-block-regexp)) + (re-search-fn (or (and backward 're-search-backward) + 're-search-forward))) + (if (looking-at re) (forward-char 1)) + (condition-case nil + (funcall re-search-fn re nil nil arg) + (error (error "No %s code blocks" (if backward "previous" "further" )))) + (goto-char (match-beginning 0)) (org-show-context))) + +(defun org-previous-block (arg &optional block-regexp) + "Jump to the previous block. +With a prefix argument ARG, jump backward ARG many source blocks. +When BLOCK-REGEXP is non-nil, use this regexp to find blocks." + (interactive "p") + (org-next-block arg t block-regexp)) + +(defun org-forward-paragraph () + "Move forward to beginning of next paragraph or equivalent. + +The function moves point to the beginning of the next visible +structural element, which can be a paragraph, a table, a list +item, etc. It also provides some special moves for convenience: + + - On an affiliated keyword, jump to the beginning of the + relative element. + - On an item or a footnote definition, move to the second + element inside, if any. + - On a table or a property drawer, jump after it. + - On a verse or source block, stop after blank lines." + (interactive) + (when (eobp) (user-error "Cannot move further down")) + (let* ((deactivate-mark nil) + (element (org-element-at-point)) + (type (org-element-type element)) + (post-affiliated (org-element-property :post-affiliated element)) + (contents-begin (org-element-property :contents-begin element)) + (contents-end (org-element-property :contents-end element)) + (end (let ((end (org-element-property :end element)) (parent element)) + (while (and (setq parent (org-element-property :parent parent)) + (= (org-element-property :contents-end parent) end)) + (setq end (org-element-property :end parent))) + end))) + (cond ((not element) + (skip-chars-forward " \r\t\n") + (or (eobp) (beginning-of-line))) + ;; On affiliated keywords, move to element's beginning. + ((and post-affiliated (< (point) post-affiliated)) + (goto-char post-affiliated)) + ;; At a table row, move to the end of the table. Similarly, + ;; at a node property, move to the end of the property + ;; drawer. + ((memq type '(node-property table-row)) + (goto-char (org-element-property + :end (org-element-property :parent element)))) + ((memq type '(property-drawer table)) (goto-char end)) + ;; Consider blank lines as separators in verse and source + ;; blocks to ease editing. + ((memq type '(src-block verse-block)) + (when (eq type 'src-block) + (setq contents-end + (save-excursion (goto-char end) + (skip-chars-backward " \r\t\n") + (line-beginning-position)))) + (beginning-of-line) + (when (looking-at "[ \t]*$") (skip-chars-forward " \r\t\n")) + (if (not (re-search-forward "^[ \t]*$" contents-end t)) + (goto-char end) + (skip-chars-forward " \r\t\n") + (if (= (point) contents-end) (goto-char end) + (beginning-of-line)))) + ;; With no contents, just skip element. + ((not contents-begin) (goto-char end)) + ;; If contents are invisible, skip the element altogether. + ((outline-invisible-p (line-end-position)) + (case type + (headline + (org-with-limited-levels (outline-next-visible-heading 1))) + ;; At a plain list, make sure we move to the next item + ;; instead of skipping the whole list. + (plain-list (forward-char) + (org-forward-paragraph)) + (otherwise (goto-char end)))) + ((>= (point) contents-end) (goto-char end)) + ((>= (point) contents-begin) + ;; This can only happen on paragraphs and plain lists. + (case type + (paragraph (goto-char end)) + ;; At a plain list, try to move to second element in + ;; first item, if possible. + (plain-list (end-of-line) + (org-forward-paragraph)))) + ;; When contents start on the middle of a line (e.g. in + ;; items and footnote definitions), try to reach first + ;; element starting after current line. + ((> (line-end-position) contents-begin) + (end-of-line) + (org-forward-paragraph)) + (t (goto-char contents-begin))))) + +(defun org-backward-paragraph () + "Move backward to start of previous paragraph or equivalent. + +The function moves point to the beginning of the current +structural element, which can be a paragraph, a table, a list +item, etc., or to the beginning of the previous visible one if +point is already there. It also provides some special moves for +convenience: + + - On an affiliated keyword, jump to the first one. + - On a table or a property drawer, move to its beginning. + - On a verse or source block, stop before blank lines." + (interactive) + (when (bobp) (user-error "Cannot move further up")) + (let* ((deactivate-mark nil) + (element (org-element-at-point)) + (type (org-element-type element)) + (contents-begin (org-element-property :contents-begin element)) + (contents-end (org-element-property :contents-end element)) + (post-affiliated (org-element-property :post-affiliated element)) + (begin (org-element-property :begin element))) + (cond + ((not element) (goto-char (point-min))) + ((= (point) begin) + (backward-char) + (org-backward-paragraph)) + ((and post-affiliated (<= (point) post-affiliated)) (goto-char begin)) + ((memq type '(node-property table-row)) + (goto-char (org-element-property + :post-affiliated (org-element-property :parent element)))) + ((memq type '(property-drawer table)) (goto-char begin)) + ((memq type '(src-block verse-block)) + (when (eq type 'src-block) + (setq contents-begin + (save-excursion (goto-char begin) (forward-line) (point)))) + (if (= (point) contents-begin) (goto-char post-affiliated) + ;; Inside a verse block, see blank lines as paragraph + ;; separators. + (let ((origin (point))) + (skip-chars-backward " \r\t\n" contents-begin) + (when (re-search-backward "^[ \t]*$" contents-begin 'move) + (skip-chars-forward " \r\t\n" origin) + (if (= (point) origin) (goto-char contents-begin) + (beginning-of-line)))))) + ((not contents-begin) (goto-char (or post-affiliated begin))) + ((eq type 'paragraph) + (goto-char contents-begin) + ;; When at first paragraph in an item or a footnote definition, + ;; move directly to beginning of line. + (let ((parent-contents + (org-element-property + :contents-begin (org-element-property :parent element)))) + (when (and parent-contents (= parent-contents contents-begin)) + (beginning-of-line)))) + ;; At the end of a greater element, move to the beginning of the + ;; last element within. + ((>= (point) contents-end) + (goto-char (1- contents-end)) + (org-backward-paragraph)) + (t (goto-char (or post-affiliated begin)))) + ;; Ensure we never leave point invisible. + (when (outline-invisible-p (point)) (beginning-of-visual-line)))) + +(defun org-forward-element () + "Move forward by one element. +Move to the next element at the same level, when possible." + (interactive) + (cond ((eobp) (user-error "Cannot move further down")) + ((org-with-limited-levels (org-at-heading-p)) + (let ((origin (point))) + (goto-char (org-end-of-subtree nil t)) + (unless (org-with-limited-levels (org-at-heading-p)) + (goto-char origin) + (user-error "Cannot move further down")))) + (t + (let* ((elem (org-element-at-point)) + (end (org-element-property :end elem)) + (parent (org-element-property :parent elem))) + (cond ((and parent (= (org-element-property :contents-end parent) end)) + (goto-char (org-element-property :end parent))) + ((integer-or-marker-p end) (goto-char end)) + (t (message "No element at point"))))))) + +(defun org-backward-element () + "Move backward by one element. +Move to the previous element at the same level, when possible." + (interactive) + (cond ((bobp) (user-error "Cannot move further up")) + ((org-with-limited-levels (org-at-heading-p)) + ;; At a headline, move to the previous one, if any, or stay + ;; here. + (let ((origin (point))) + (org-with-limited-levels (org-backward-heading-same-level 1)) + ;; When current headline has no sibling above, move to its + ;; parent. + (when (= (point) origin) + (or (org-with-limited-levels (org-up-heading-safe)) + (progn (goto-char origin) + (user-error "Cannot move further up")))))) + (t + (let* ((trail (org-element-at-point 'keep-trail)) + (elem (car trail)) + (prev-elem (nth 1 trail)) + (beg (org-element-property :begin elem))) + (cond + ;; Move to beginning of current element if point isn't + ;; there already. + ((null beg) (message "No element at point")) + ((/= (point) beg) (goto-char beg)) + (prev-elem (goto-char (org-element-property :begin prev-elem))) + ((org-before-first-heading-p) (goto-char (point-min))) + (t (org-back-to-heading))))))) + +(defun org-up-element () + "Move to upper element." + (interactive) + (if (org-with-limited-levels (org-at-heading-p)) + (unless (org-up-heading-safe) (user-error "No surrounding element")) + (let* ((elem (org-element-at-point)) + (parent (org-element-property :parent elem))) + (if parent (goto-char (org-element-property :begin parent)) + (if (org-with-limited-levels (org-before-first-heading-p)) + (user-error "No surrounding element") + (org-with-limited-levels (org-back-to-heading))))))) + +(defvar org-element-greater-elements) +(defun org-down-element () + "Move to inner element." + (interactive) + (let ((element (org-element-at-point))) + (cond + ((memq (org-element-type element) '(plain-list table)) + (goto-char (org-element-property :contents-begin element)) + (forward-char)) + ((memq (org-element-type element) org-element-greater-elements) + ;; If contents are hidden, first disclose them. + (when (org-element-property :hiddenp element) (org-cycle)) + (goto-char (or (org-element-property :contents-begin element) + (user-error "No content for this element")))) + (t (user-error "No inner element"))))) + +(defun org-drag-element-backward () + "Move backward element at point." + (interactive) + (if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up) + (let* ((trail (org-element-at-point 'keep-trail)) + (elem (car trail)) + (prev-elem (nth 1 trail))) + ;; Error out if no previous element or previous element is + ;; a parent of the current one. + (if (or (not prev-elem) (org-element-nested-p elem prev-elem)) + (user-error "Cannot drag element backward") + (let ((pos (point))) + (org-element-swap-A-B prev-elem elem) + (goto-char (+ (org-element-property :begin prev-elem) + (- pos (org-element-property :begin elem))))))))) + +(defun org-drag-element-forward () + "Move forward element at point." + (interactive) + (let* ((pos (point)) + (elem (org-element-at-point))) + (when (= (point-max) (org-element-property :end elem)) + (user-error "Cannot drag element forward")) + (goto-char (org-element-property :end elem)) + (let ((next-elem (org-element-at-point))) + (when (or (org-element-nested-p elem next-elem) + (and (eq (org-element-type next-elem) 'headline) + (not (eq (org-element-type elem) 'headline)))) + (goto-char pos) + (user-error "Cannot drag element forward")) + ;; Compute new position of point: it's shifted by NEXT-ELEM + ;; body's length (without final blanks) and by the length of + ;; blanks between ELEM and NEXT-ELEM. + (let ((size-next (- (save-excursion + (goto-char (org-element-property :end next-elem)) + (skip-chars-backward " \r\t\n") + (forward-line) + ;; Small correction if buffer doesn't end + ;; with a newline character. + (if (and (eolp) (not (bolp))) (1+ (point)) (point))) + (org-element-property :begin next-elem))) + (size-blank (- (org-element-property :end elem) + (save-excursion + (goto-char (org-element-property :end elem)) + (skip-chars-backward " \r\t\n") + (forward-line) + (point))))) + (org-element-swap-A-B elem next-elem) + (goto-char (+ pos size-next size-blank)))))) + +(defun org-drag-line-forward (arg) + "Drag the line at point ARG lines forward." + (interactive "p") + (dotimes (n (abs arg)) + (let ((c (current-column))) + (if (< 0 arg) + (progn + (beginning-of-line 2) + (transpose-lines 1) + (beginning-of-line 0)) + (transpose-lines 1) + (beginning-of-line -1)) + (org-move-to-column c)))) + +(defun org-drag-line-backward (arg) + "Drag the line at point ARG lines backward." + (interactive "p") + (org-drag-line-forward (- arg))) + +(defun org-mark-element () + "Put point at beginning of this element, mark at end. + +Interactively, if this command is repeated or (in Transient Mark +mode) if the mark is active, it marks the next element after the +ones already marked." + (interactive) + (let (deactivate-mark) + (if (and (org-called-interactively-p 'any) + (or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active))) + (set-mark + (save-excursion + (goto-char (mark)) + (goto-char (org-element-property :end (org-element-at-point))))) + (let ((element (org-element-at-point))) + (end-of-line) + (push-mark (org-element-property :end element) t t) + (goto-char (org-element-property :begin element)))))) + +(defun org-narrow-to-element () + "Narrow buffer to current element." + (interactive) + (let ((elem (org-element-at-point))) + (cond + ((eq (car elem) 'headline) + (narrow-to-region + (org-element-property :begin elem) + (org-element-property :end elem))) + ((memq (car elem) org-element-greater-elements) + (narrow-to-region + (org-element-property :contents-begin elem) + (org-element-property :contents-end elem))) + (t + (narrow-to-region + (org-element-property :begin elem) + (org-element-property :end elem)))))) + +(defun org-transpose-element () + "Transpose current and previous elements, keeping blank lines between. +Point is moved after both elements." + (interactive) + (org-skip-whitespace) + (let ((end (org-element-property :end (org-element-at-point)))) + (org-drag-element-backward) + (goto-char end))) + +(defun org-unindent-buffer () + "Un-indent the visible part of the buffer. +Relative indentation (between items, inside blocks, etc.) isn't +modified." + (interactive) + (unless (eq major-mode 'org-mode) + (user-error "Cannot un-indent a buffer not in Org mode")) + (let* ((parse-tree (org-element-parse-buffer 'greater-element)) + unindent-tree ; For byte-compiler. + (unindent-tree + (function + (lambda (contents) + (mapc + (lambda (element) + (if (memq (org-element-type element) '(headline section)) + (funcall unindent-tree (org-element-contents element)) + (save-excursion + (save-restriction + (narrow-to-region + (org-element-property :begin element) + (org-element-property :end element)) + (org-do-remove-indentation))))) + (reverse contents)))))) + (funcall unindent-tree (org-element-contents parse-tree)))) + +(defun org-show-subtree () + "Show everything after this heading at deeper levels." + (interactive) + (outline-flag-region + (point) + (save-excursion + (org-end-of-subtree t t)) + nil)) + +(defun org-show-entry () + "Show the body directly following this heading. +Show the heading too, if it is currently invisible." + (interactive) + (save-excursion + (condition-case nil + (progn + (org-back-to-heading t) + (outline-flag-region + (max (point-min) (1- (point))) + (save-excursion + (if (re-search-forward + (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t) + (match-beginning 1) + (point-max))) + nil) + (org-cycle-hide-drawers 'children)) + (error nil)))) + +(defun org-make-options-regexp (kwds &optional extra) + "Make a regular expression for keyword lines." + (concat + "^#\\+\\(" + (mapconcat 'regexp-quote kwds "\\|") + (if extra (concat "\\|" extra)) + "\\):[ \t]*\\(.*\\)")) + +;; Make isearch reveal the necessary context +(defun org-isearch-end () + "Reveal context after isearch exits." + (when isearch-success ; only if search was successful + (if (featurep 'xemacs) + ;; Under XEmacs, the hook is run in the correct place, + ;; we directly show the context. + (org-show-context 'isearch) + ;; In Emacs the hook runs *before* restoring the overlays. + ;; So we have to use a one-time post-command-hook to do this. + ;; (Emacs 22 has a special variable, see function `org-mode') + (unless (and (boundp 'isearch-mode-end-hook-quit) + isearch-mode-end-hook-quit) + ;; Only when the isearch was not quitted. + (org-add-hook 'post-command-hook 'org-isearch-post-command + 'append 'local))))) + +(defun org-isearch-post-command () + "Remove self from hook, and show context." + (remove-hook 'post-command-hook 'org-isearch-post-command 'local) + (org-show-context 'isearch)) + + +;;;; Integration with and fixes for other packages + +;;; Imenu support + +(defvar org-imenu-markers nil + "All markers currently used by Imenu.") +(make-variable-buffer-local 'org-imenu-markers) + +(defun org-imenu-new-marker (&optional pos) + "Return a new marker for use by Imenu, and remember the marker." + (let ((m (make-marker))) + (move-marker m (or pos (point))) + (push m org-imenu-markers) + m)) + +(defun org-imenu-get-tree () + "Produce the index for Imenu." + (mapc (lambda (x) (move-marker x nil)) org-imenu-markers) + (setq org-imenu-markers nil) + (let* ((n org-imenu-depth) + (re (concat "^" (org-get-limited-outline-regexp))) + (subs (make-vector (1+ n) nil)) + (last-level 0) + m level head0 head) + (save-excursion + (save-restriction + (widen) + (goto-char (point-max)) + (while (re-search-backward re nil t) + (setq level (org-reduced-level (funcall outline-level))) + (when (and (<= level n) + (looking-at org-complex-heading-regexp) + (setq head0 (org-match-string-no-properties 4))) + (setq head (org-link-display-format head0) + m (org-imenu-new-marker)) + (org-add-props head nil 'org-imenu-marker m 'org-imenu t) + (if (>= level last-level) + (push (cons head m) (aref subs level)) + (push (cons head (aref subs (1+ level))) (aref subs level)) + (loop for i from (1+ level) to n do (aset subs i nil))) + (setq last-level level))))) + (aref subs 1))) + +(eval-after-load "imenu" + '(progn + (add-hook 'imenu-after-jump-hook + (lambda () + (if (derived-mode-p 'org-mode) + (org-show-context 'org-goto)))))) + +(defun org-link-display-format (link) + "Replace a link with its the description. +If there is no description, use the link target." + (save-match-data + (if (string-match org-bracket-link-analytic-regexp link) + (replace-match (if (match-end 5) + (match-string 5 link) + (concat (match-string 1 link) + (match-string 3 link))) + nil t link) + link))) + +(defun org-toggle-link-display () + "Toggle the literal or descriptive display of links." + (interactive) + (if org-descriptive-links + (progn (org-remove-from-invisibility-spec '(org-link)) + (org-restart-font-lock) + (setq org-descriptive-links nil)) + (progn (add-to-invisibility-spec '(org-link)) + (org-restart-font-lock) + (setq org-descriptive-links t)))) + +;; Speedbar support + +(defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1) + "Overlay marking the agenda restriction line in speedbar.") +(overlay-put org-speedbar-restriction-lock-overlay + 'face 'org-agenda-restriction-lock) +(overlay-put org-speedbar-restriction-lock-overlay + 'help-echo "Agendas are currently limited to this item.") +(org-detach-overlay org-speedbar-restriction-lock-overlay) + +(defun org-speedbar-set-agenda-restriction () + "Restrict future agenda commands to the location at point in speedbar. +To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." + (interactive) + (require 'org-agenda) + (let (p m tp np dir txt) + (cond + ((setq p (text-property-any (point-at-bol) (point-at-eol) + 'org-imenu t)) + (setq m (get-text-property p 'org-imenu-marker)) + (with-current-buffer (marker-buffer m) + (goto-char m) + (org-agenda-set-restriction-lock 'subtree))) + ((setq p (text-property-any (point-at-bol) (point-at-eol) + 'speedbar-function 'speedbar-find-file)) + (setq tp (previous-single-property-change + (1+ p) 'speedbar-function) + np (next-single-property-change + tp 'speedbar-function) + dir (speedbar-line-directory) + txt (buffer-substring-no-properties (or tp (point-min)) + (or np (point-max)))) + (with-current-buffer (find-file-noselect + (let ((default-directory dir)) + (expand-file-name txt))) + (unless (derived-mode-p 'org-mode) + (user-error "Cannot restrict to non-Org-mode file")) + (org-agenda-set-restriction-lock 'file))) + (t (user-error "Don't know how to restrict Org-mode's agenda"))) + (move-overlay org-speedbar-restriction-lock-overlay + (point-at-bol) (point-at-eol)) + (setq current-prefix-arg nil) + (org-agenda-maybe-redo))) + +(defvar speedbar-file-key-map) +(declare-function speedbar-add-supported-extension "speedbar" (extension)) +(eval-after-load "speedbar" + '(progn + (speedbar-add-supported-extension ".org") + (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction) + (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction) + (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock) + (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) + (add-hook 'speedbar-visiting-tag-hook + (lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto)))))) + +;;; Fixes and Hacks for problems with other packages + +;; Make flyspell not check words in links, to not mess up our keymap +(defvar org-element-affiliated-keywords) ; From org-element.el +(defvar org-element-block-name-alist) ; From org-element.el +(defun org-mode-flyspell-verify () + "Don't let flyspell put overlays at active buttons, or on + {todo,all-time,additional-option-like}-keywords." + (require 'org-element) ; For `org-element-affiliated-keywords' + (let ((pos (max (1- (point)) (point-min))) + (word (thing-at-point 'word))) + (and (not (get-text-property pos 'keymap)) + (not (get-text-property pos 'org-no-flyspell)) + (not (member word org-todo-keywords-1)) + (not (member word org-all-time-keywords)) + (not (member word org-options-keywords)) + (not (member word (mapcar 'car org-startup-options))) + (not (member-ignore-case word org-element-affiliated-keywords)) + (not (member-ignore-case word (org-get-export-keywords))) + (not (member-ignore-case + word (mapcar 'car org-element-block-name-alist))) + (not (member-ignore-case word '("BEGIN" "END" "ATTR"))) + (not (org-in-src-block-p))))) + +(defun org-remove-flyspell-overlays-in (beg end) + "Remove flyspell overlays in region." + (and (org-bound-and-true-p flyspell-mode) + (fboundp 'flyspell-delete-region-overlays) + (flyspell-delete-region-overlays beg end)) + (add-text-properties beg end '(org-no-flyspell t))) + +;; Make `bookmark-jump' shows the jump location if it was hidden. +(eval-after-load "bookmark" + '(if (boundp 'bookmark-after-jump-hook) + ;; We can use the hook + (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide) + ;; Hook not available, use advice + (defadvice bookmark-jump (after org-make-visible activate) + "Make the position visible." + (org-bookmark-jump-unhide)))) + +;; Make sure saveplace shows the location if it was hidden +(eval-after-load "saveplace" + '(defadvice save-place-find-file-hook (after org-make-visible activate) + "Make the position visible." + (org-bookmark-jump-unhide))) + +;; Make sure ecb shows the location if it was hidden +(eval-after-load "ecb" + '(defadvice ecb-method-clicked (after esf/org-show-context activate) + "Make hierarchy visible when jumping into location from ECB tree buffer." + (if (derived-mode-p 'org-mode) + (org-show-context)))) + +(defun org-bookmark-jump-unhide () + "Unhide the current position, to show the bookmark location." + (and (derived-mode-p 'org-mode) + (or (outline-invisible-p) + (save-excursion (goto-char (max (point-min) (1- (point)))) + (outline-invisible-p))) + (org-show-context 'bookmark-jump))) + +;; Make session.el ignore our circular variable +(defvar session-globals-exclude) +(eval-after-load "session" + '(add-to-list 'session-globals-exclude 'org-mark-ring)) + +;;;; Finish up + +(provide 'org) + +(run-hooks 'org-load-hook) + +;;; org.el ends here diff --git a/elpa/org-20150427/orgcard.pdf b/elpa/org-20150427/orgcard.pdf new file mode 100644 index 00000000..aedf8e59 Binary files /dev/null and b/elpa/org-20150427/orgcard.pdf differ diff --git a/elpa/org-20150427/ox-ascii.el b/elpa/org-20150427/ox-ascii.el new file mode 100644 index 00000000..cd2a9af1 --- /dev/null +++ b/elpa/org-20150427/ox-ascii.el @@ -0,0 +1,1971 @@ +;;; ox-ascii.el --- ASCII Back-End for Org Export Engine + +;; Copyright (C) 2012-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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: +;; +;; This library implements an ASCII back-end for Org generic exporter. +;; See Org manual for more information. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ox) +(require 'ox-publish) + +(declare-function aa2u "ext:ascii-art-to-unicode" ()) + +;;; Define Back-End +;; +;; The following setting won't allow to modify preferred charset +;; through a buffer keyword or an option item, but, since the property +;; will appear in communication channel nonetheless, it allows to +;; override `org-ascii-charset' variable on the fly by the ext-plist +;; mechanism. +;; +;; We also install a filter for headlines and sections, in order to +;; control blank lines separating them in output string. + +(org-export-define-backend 'ascii + '((bold . org-ascii-bold) + (center-block . org-ascii-center-block) + (clock . org-ascii-clock) + (code . org-ascii-code) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (drawer . org-ascii-drawer) + (dynamic-block . org-ascii-dynamic-block) + (entity . org-ascii-entity) + (example-block . org-ascii-example-block) + (export-block . org-ascii-export-block) + (export-snippet . org-ascii-export-snippet) + (fixed-width . org-ascii-fixed-width) + (footnote-reference . org-ascii-footnote-reference) + (headline . org-ascii-headline) + (horizontal-rule . org-ascii-horizontal-rule) + (inline-src-block . org-ascii-inline-src-block) + (inlinetask . org-ascii-inlinetask) + (inner-template . org-ascii-inner-template) + (italic . org-ascii-italic) + (item . org-ascii-item) + (keyword . org-ascii-keyword) + (latex-environment . org-ascii-latex-environment) + (latex-fragment . org-ascii-latex-fragment) + (line-break . org-ascii-line-break) + (link . org-ascii-link) + (paragraph . org-ascii-paragraph) + (plain-list . org-ascii-plain-list) + (plain-text . org-ascii-plain-text) + (planning . org-ascii-planning) + (quote-block . org-ascii-quote-block) + (quote-section . org-ascii-quote-section) + (radio-target . org-ascii-radio-target) + (section . org-ascii-section) + (special-block . org-ascii-special-block) + (src-block . org-ascii-src-block) + (statistics-cookie . org-ascii-statistics-cookie) + (strike-through . org-ascii-strike-through) + (subscript . org-ascii-subscript) + (superscript . org-ascii-superscript) + (table . org-ascii-table) + (table-cell . org-ascii-table-cell) + (table-row . org-ascii-table-row) + (target . org-ascii-target) + (template . org-ascii-template) + (timestamp . org-ascii-timestamp) + (underline . org-ascii-underline) + (verbatim . org-ascii-verbatim) + (verse-block . org-ascii-verse-block)) + :export-block "ASCII" + :menu-entry + '(?t "Export to Plain Text" + ((?A "As ASCII buffer" + (lambda (a s v b) + (org-ascii-export-as-ascii a s v b '(:ascii-charset ascii)))) + (?a "As ASCII file" + (lambda (a s v b) + (org-ascii-export-to-ascii a s v b '(:ascii-charset ascii)))) + (?L "As Latin1 buffer" + (lambda (a s v b) + (org-ascii-export-as-ascii a s v b '(:ascii-charset latin1)))) + (?l "As Latin1 file" + (lambda (a s v b) + (org-ascii-export-to-ascii a s v b '(:ascii-charset latin1)))) + (?U "As UTF-8 buffer" + (lambda (a s v b) + (org-ascii-export-as-ascii a s v b '(:ascii-charset utf-8)))) + (?u "As UTF-8 file" + (lambda (a s v b) + (org-ascii-export-to-ascii a s v b '(:ascii-charset utf-8)))))) + :filters-alist '((:filter-headline . org-ascii-filter-headline-blank-lines) + (:filter-parse-tree org-ascii-filter-paragraph-spacing + org-ascii-filter-comment-spacing) + (:filter-section . org-ascii-filter-headline-blank-lines)) + :options-alist '((:ascii-charset nil nil org-ascii-charset))) + + + +;;; User Configurable Variables + +(defgroup org-export-ascii nil + "Options for exporting Org mode files to ASCII." + :tag "Org Export ASCII" + :group 'org-export) + +(defcustom org-ascii-text-width 72 + "Maximum width of exported text. +This number includes margin size, as set in +`org-ascii-global-margin'." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +(defcustom org-ascii-global-margin 0 + "Width of the left margin, in number of characters." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +(defcustom org-ascii-inner-margin 2 + "Width of the inner margin, in number of characters. +Inner margin is applied between each headline." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +(defcustom org-ascii-quote-margin 6 + "Width of margin used for quoting text, in characters. +This margin is applied on both sides of the text." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +(defcustom org-ascii-inlinetask-width 30 + "Width of inline tasks, in number of characters. +This number ignores any margin." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +(defcustom org-ascii-headline-spacing '(1 . 2) + "Number of blank lines inserted around headlines. + +This variable can be set to a cons cell. In that case, its car +represents the number of blank lines present before headline +contents whereas its cdr reflects the number of blank lines after +contents. + +A nil value replicates the number of blank lines found in the +original Org buffer at the same place." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Replicate original spacing" nil) + (cons :tag "Set an uniform spacing" + (integer :tag "Number of blank lines before contents") + (integer :tag "Number of blank lines after contents")))) + +(defcustom org-ascii-indented-line-width 'auto + "Additional indentation width for the first line in a paragraph. +If the value is an integer, indent the first line of each +paragraph by this width, unless it is located at the beginning of +a section, in which case indentation is removed from that line. +If it is the symbol `auto' preserve indentation from original +document." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (integer :tag "Number of white spaces characters") + (const :tag "Preserve original width" auto))) + +(defcustom org-ascii-paragraph-spacing 'auto + "Number of white lines between paragraphs. +If the value is an integer, add this number of blank lines +between contiguous paragraphs. If is it the symbol `auto', keep +the same number of blank lines as in the original document." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (integer :tag "Number of blank lines") + (const :tag "Preserve original spacing" auto))) + +(defcustom org-ascii-charset 'ascii + "The charset allowed to represent various elements and objects. +Possible values are: +`ascii' Only use plain ASCII characters +`latin1' Include Latin-1 characters +`utf-8' Use all UTF-8 characters" + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "ASCII" ascii) + (const :tag "Latin-1" latin1) + (const :tag "UTF-8" utf-8))) + +(defcustom org-ascii-underline '((ascii ?= ?~ ?-) + (latin1 ?= ?~ ?-) + (utf-8 ?═ ?─ ?╌ ?┄ ?┈)) + "Characters for underlining headings in ASCII export. + +Alist whose key is a symbol among `ascii', `latin1' and `utf-8' +and whose value is a list of characters. + +For each supported charset, this variable associates a sequence +of underline characters. In a sequence, the characters will be +used in order for headlines level 1, 2, ... If no character is +available for a given level, the headline won't be underlined." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type '(list + (cons :tag "Underline characters sequence" + (const :tag "ASCII charset" ascii) + (repeat character)) + (cons :tag "Underline characters sequence" + (const :tag "Latin-1 charset" latin1) + (repeat character)) + (cons :tag "Underline characters sequence" + (const :tag "UTF-8 charset" utf-8) + (repeat character)))) + +(defcustom org-ascii-bullets '((ascii ?* ?+ ?-) + (latin1 ?§ ?¶) + (utf-8 ?◊)) + "Bullet characters for headlines converted to lists in ASCII export. + +Alist whose key is a symbol among `ascii', `latin1' and `utf-8' +and whose value is a list of characters. + +The first character is used for the first level considered as low +level, and so on. If there are more levels than characters given +here, the list will be repeated. + +Note that this variable doesn't affect plain lists +representation." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type '(list + (cons :tag "Bullet characters for low level headlines" + (const :tag "ASCII charset" ascii) + (repeat character)) + (cons :tag "Bullet characters for low level headlines" + (const :tag "Latin-1 charset" latin1) + (repeat character)) + (cons :tag "Bullet characters for low level headlines" + (const :tag "UTF-8 charset" utf-8) + (repeat character)))) + +(defcustom org-ascii-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-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-ascii-table-keep-all-vertical-lines nil + "Non-nil means keep all vertical lines in ASCII tables. +When nil, vertical lines will be removed except for those needed +for column grouping." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-ascii-table-widen-columns t + "Non-nil means widen narrowed columns for export. +When nil, narrowed columns will look in ASCII export just like in +Org mode, i.e. with \"=>\" as ellipsis." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-ascii-table-use-ascii-art nil + "Non-nil means table.el tables are turned into ascii-art. + +It only makes sense when export charset is `utf-8'. It is nil by +default since it requires ascii-art-to-unicode.el package. You +can download it here: + + http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-ascii-caption-above nil + "When non-nil, place caption string before the element. +Otherwise, place it right after it." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-ascii-verbatim-format "`%s'" + "Format string used for verbatim text and inline code." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-ascii-format-drawer-function + (lambda (name contents width) contents) + "Function called to format a drawer in ASCII. + +The function must accept three parameters: + NAME the drawer name, like \"LOGBOOK\" + CONTENTS the contents of the drawer. + WIDTH the text width within the drawer. + +The function should return either the string to be exported or +nil to ignore the drawer. + +The default value simply returns the value of CONTENTS." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + +(defcustom org-ascii-format-inlinetask-function + 'org-ascii-format-inlinetask-default + "Function called to format an inlinetask in ASCII. + +The function must accept nine parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a list of strings. + CONTENTS the contents of the inlinetask, as a string. + WIDTH the width of the inlinetask, as a number. + INLINETASK the inlinetask itself. + INFO the info channel. + +The function should return either the string to be exported or +nil to ignore the inline task." + :group 'org-export-ascii + :version "24.4" + :package-version '(Org . "8.3") + :type 'function) + + + +;;; Internal Functions + +;; Internal functions fall into three categories. + +;; The first one is about text formatting. The core function is +;; `org-ascii--current-text-width', which determines the current +;; text width allowed to a given element. In other words, it helps +;; keeping each line width within maximum text width defined in +;; `org-ascii-text-width'. Once this information is known, +;; `org-ascii--fill-string', `org-ascii--justify-string', +;; `org-ascii--box-string' and `org-ascii--indent-string' can +;; operate on a given output string. + +;; The second category contains functions handling elements listings, +;; triggered by "#+TOC:" keyword. As such, `org-ascii--build-toc' +;; returns a complete table of contents, `org-ascii--list-listings' +;; returns a list of referenceable src-block elements, and +;; `org-ascii--list-tables' does the same for table elements. + +;; The third category includes general helper functions. +;; `org-ascii--build-title' creates the title for a given headline +;; or inlinetask element. `org-ascii--build-caption' returns the +;; caption string associated to a table or a src-block. +;; `org-ascii--describe-links' creates notes about links for +;; insertion at the end of a section. It uses +;; `org-ascii--unique-links' to get the list of links to describe. +;; Eventually, `org-ascii--translate' translates a string according +;; to language and charset specification. + + +(defun org-ascii--fill-string (s text-width info &optional justify) + "Fill a string with specified text-width and return it. + +S is the string being filled. TEXT-WIDTH is an integer +specifying maximum length of a line. INFO is the plist used as +a communication channel. + +Optional argument JUSTIFY can specify any type of justification +among `left', `center', `right' or `full'. A nil value is +equivalent to `left'. For a justification that doesn't also fill +string, see `org-ascii--justify-string'. + +Return nil if S isn't a string." + (when (stringp s) + (let ((double-space-p sentence-end-double-space)) + (with-temp-buffer + (let ((fill-column text-width) + (use-hard-newlines t) + (sentence-end-double-space double-space-p)) + (insert (if (plist-get info :preserve-breaks) + (replace-regexp-in-string "\n" hard-newline s) + s)) + (fill-region (point-min) (point-max) justify)) + (buffer-string))))) + +(defun org-ascii--justify-string (s text-width how) + "Justify string S. +TEXT-WIDTH is an integer specifying maximum length of a line. +HOW determines the type of justification: it can be `left', +`right', `full' or `center'." + (with-temp-buffer + (insert s) + (goto-char (point-min)) + (let ((fill-column text-width) + ;; Disable `adaptive-fill-mode' so it doesn't prevent + ;; filling lines matching `adaptive-fill-regexp'. + (adaptive-fill-mode nil)) + (while (< (point) (point-max)) + (justify-current-line how) + (forward-line))) + (buffer-string))) + +(defun org-ascii--indent-string (s width) + "Indent string S by WIDTH white spaces. +Empty lines are not indented." + (when (stringp s) + (replace-regexp-in-string + "\\(^\\)[ \t]*\\S-" (make-string width ?\s) s nil nil 1))) + +(defun org-ascii--box-string (s info) + "Return string S with a partial box to its left. +INFO is a plist used as a communication channel." + (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) + (format (if utf8p "┌────\n%s\n└────" ",----\n%s\n`----") + (replace-regexp-in-string + "^" (if utf8p "│ " "| ") + ;; Remove last newline character. + (replace-regexp-in-string "\n[ \t]*\\'" "" s))))) + +(defun org-ascii--current-text-width (element info) + "Return maximum text width for ELEMENT's contents. +INFO is a plist used as a communication channel." + (case (org-element-type element) + ;; Elements with an absolute width: `headline' and `inlinetask'. + (inlinetask org-ascii-inlinetask-width) + (headline + (- org-ascii-text-width + (let ((low-level-rank (org-export-low-level-p element info))) + (if low-level-rank (* low-level-rank 2) org-ascii-global-margin)))) + ;; Elements with a relative width: store maximum text width in + ;; TOTAL-WIDTH. + (otherwise + (let* ((genealogy (cons element (org-export-get-genealogy element))) + ;; Total width is determined by the presence, or not, of an + ;; inline task among ELEMENT parents. + (total-width + (if (loop for parent in genealogy + thereis (eq (org-element-type parent) 'inlinetask)) + org-ascii-inlinetask-width + ;; No inlinetask: Remove global margin from text width. + (- org-ascii-text-width + org-ascii-global-margin + (let ((parent (org-export-get-parent-headline element))) + ;; Inner margin doesn't apply to text before first + ;; headline. + (if (not parent) 0 + (let ((low-level-rank + (org-export-low-level-p parent info))) + ;; Inner margin doesn't apply to contents of + ;; low level headlines, since they've got their + ;; own indentation mechanism. + (if low-level-rank (* low-level-rank 2) + org-ascii-inner-margin)))))))) + (- total-width + ;; Each `quote-block', `quote-section' and `verse-block' above + ;; narrows text width by twice the standard margin size. + (+ (* (loop for parent in genealogy + when (memq (org-element-type parent) + '(quote-block quote-section verse-block)) + count parent) + 2 org-ascii-quote-margin) + ;; Text width within a plain-list is restricted by + ;; indentation of current item. If that's the case, + ;; compute it with the help of `:structure' property from + ;; parent item, if any. + (let ((parent-item + (if (eq (org-element-type element) 'item) element + (loop for parent in genealogy + when (eq (org-element-type parent) 'item) + return parent)))) + (if (not parent-item) 0 + ;; Compute indentation offset of the current item, + ;; that is the sum of the difference between its + ;; indentation and the indentation of the top item in + ;; the list and current item bullet's length. Also + ;; remove checkbox length, and tag length (for + ;; description lists) or bullet length. + (let ((struct (org-element-property :structure parent-item)) + (beg-item (org-element-property :begin parent-item))) + (+ (- (org-list-get-ind beg-item struct) + (org-list-get-ind + (org-list-get-top-point struct) struct)) + (string-width (or (org-ascii--checkbox parent-item info) + "")) + (string-width + (or (org-list-get-tag beg-item struct) + (org-list-get-bullet beg-item struct))))))))))))) + +(defun org-ascii--build-title + (element info text-width &optional underline notags toc) + "Format ELEMENT title and return it. + +ELEMENT is either an `headline' or `inlinetask' element. INFO is +a plist used as a communication channel. TEXT-WIDTH is an +integer representing the maximum length of a line. + +When optional argument UNDERLINE is non-nil, underline title, +without the tags, according to `org-ascii-underline' +specifications. + +If optional argument NOTAGS is non-nil, no tags will be added to +the title. + +When optional argument TOC is non-nil, use optional title if +possible. It doesn't apply to `inlinetask' elements." + (let* ((headlinep (eq (org-element-type element) 'headline)) + (numbers + ;; Numbering is specific to headlines. + (and headlinep (org-export-numbered-headline-p element info) + ;; All tests passed: build numbering string. + (concat + (mapconcat + 'number-to-string + (org-export-get-headline-number element info) ".") + " "))) + (text + (org-trim + (org-export-data + (if (and toc headlinep) (org-export-get-alt-title element info) + (org-element-property :title element)) + info))) + (todo + (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword element))) + (and todo (concat (org-export-data todo info) " "))))) + (tags (and (not notags) + (plist-get info :with-tags) + (let ((tag-list (org-export-get-tags element info))) + (and tag-list + (format ":%s:" + (mapconcat 'identity tag-list ":")))))) + (priority + (and (plist-get info :with-priority) + (let ((char (org-element-property :priority element))) + (and char (format "(#%c) " char))))) + (first-part (concat numbers todo priority text))) + (concat + first-part + ;; Align tags, if any. + (when tags + (format + (format " %%%ds" + (max (- text-width (1+ (string-width first-part))) + (string-width tags))) + tags)) + ;; Maybe underline text, if ELEMENT type is `headline' and an + ;; underline character has been defined. + (when (and underline headlinep) + (let ((under-char + (nth (1- (org-export-get-relative-level element info)) + (cdr (assq (plist-get info :ascii-charset) + org-ascii-underline))))) + (and under-char + (concat "\n" + (make-string (/ (string-width first-part) + (char-width under-char)) + under-char)))))))) + +(defun org-ascii--has-caption-p (element info) + "Non-nil when ELEMENT has a caption affiliated keyword. +INFO is a plist used as a communication channel. This function +is meant to be used as a predicate for `org-export-get-ordinal'." + (org-element-property :caption element)) + +(defun org-ascii--build-caption (element info) + "Return caption string for ELEMENT, if applicable. + +INFO is a plist used as a communication channel. + +The caption string contains the sequence number of ELEMENT along +with its real caption. Return nil when ELEMENT has no affiliated +caption keyword." + (let ((caption (org-export-get-caption element))) + (when caption + ;; Get sequence number of current src-block among every + ;; src-block with a caption. + (let ((reference + (org-export-get-ordinal + element info nil 'org-ascii--has-caption-p)) + (title-fmt (org-ascii--translate + (case (org-element-type element) + (table "Table %d:") + (src-block "Listing %d:")) + info))) + (org-ascii--fill-string + (concat (format title-fmt reference) + " " + (org-export-data caption info)) + (org-ascii--current-text-width element info) info))))) + +(defun org-ascii--build-toc (info &optional n keyword) + "Return a table of contents. + +INFO is a plist used as a communication channel. + +Optional argument N, when non-nil, is an integer specifying the +depth of the table. + +Optional argument KEYWORD specifies the TOC keyword, if any, from +which the table of contents generation has been initiated." + (let ((title (org-ascii--translate "Table of Contents" info))) + (concat + title "\n" + (make-string (string-width title) + (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)) + "\n\n" + (let ((text-width + (if keyword (org-ascii--current-text-width keyword info) + (- org-ascii-text-width org-ascii-global-margin)))) + (mapconcat + (lambda (headline) + (let* ((level (org-export-get-relative-level headline info)) + (indent (* (1- level) 3))) + (concat + (unless (zerop indent) (concat (make-string (1- indent) ?.) " ")) + (org-ascii--build-title + headline info (- text-width indent) nil + (or (not (plist-get info :with-tags)) + (eq (plist-get info :with-tags) 'not-in-toc)) + 'toc)))) + (org-export-collect-headlines info n) "\n"))))) + +(defun org-ascii--list-listings (keyword info) + "Return a list of listings. + +KEYWORD is the keyword that initiated the list of listings +generation. INFO is a plist used as a communication channel." + (let ((title (org-ascii--translate "List of Listings" info))) + (concat + title "\n" + (make-string (string-width title) + (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)) + "\n\n" + (let ((text-width + (if keyword (org-ascii--current-text-width keyword info) + (- org-ascii-text-width org-ascii-global-margin))) + ;; Use a counter instead of retrieving ordinal of each + ;; src-block. + (count 0)) + (mapconcat + (lambda (src-block) + ;; Store initial text so its length can be computed. This is + ;; used to properly align caption right to it in case of + ;; filling (like contents of a description list item). + (let* ((initial-text + (format (org-ascii--translate "Listing %d:" info) + (incf count))) + (initial-width (string-width initial-text))) + (concat + initial-text " " + (org-trim + (org-ascii--indent-string + (org-ascii--fill-string + ;; Use short name in priority, if available. + (let ((caption (or (org-export-get-caption src-block t) + (org-export-get-caption src-block)))) + (org-export-data caption info)) + (- text-width initial-width) info) + initial-width))))) + (org-export-collect-listings info) "\n"))))) + +(defun org-ascii--list-tables (keyword info) + "Return a list of tables. + +KEYWORD is the keyword that initiated the list of tables +generation. INFO is a plist used as a communication channel." + (let ((title (org-ascii--translate "List of Tables" info))) + (concat + title "\n" + (make-string (string-width title) + (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)) + "\n\n" + (let ((text-width + (if keyword (org-ascii--current-text-width keyword info) + (- org-ascii-text-width org-ascii-global-margin))) + ;; Use a counter instead of retrieving ordinal of each + ;; src-block. + (count 0)) + (mapconcat + (lambda (table) + ;; Store initial text so its length can be computed. This is + ;; used to properly align caption right to it in case of + ;; filling (like contents of a description list item). + (let* ((initial-text + (format (org-ascii--translate "Table %d:" info) + (incf count))) + (initial-width (string-width initial-text))) + (concat + initial-text " " + (org-trim + (org-ascii--indent-string + (org-ascii--fill-string + ;; Use short name in priority, if available. + (let ((caption (or (org-export-get-caption table t) + (org-export-get-caption table)))) + (org-export-data caption info)) + (- text-width initial-width) info) + initial-width))))) + (org-export-collect-tables info) "\n"))))) + +(defun org-ascii--unique-links (element info) + "Return a list of unique link references in ELEMENT. +ELEMENT is either a headline element or a section element. INFO +is a plist used as a communication channel." + (let* (seen + (unique-link-p + (function + ;; Return LINK if it wasn't referenced so far, or nil. + ;; Update SEEN links along the way. + (lambda (link) + (let ((footprint + ;; Normalize description in footprints. + (cons (org-element-property :raw-link link) + (let ((contents (org-element-contents link))) + (and contents + (replace-regexp-in-string + "[ \r\t\n]+" " " + (org-trim + (org-element-interpret-data contents)))))))) + ;; Ignore LINK if it hasn't been translated already. + ;; It can happen if it is located in an affiliated + ;; keyword that was ignored. + (when (and (org-string-nw-p + (gethash link (plist-get info :exported-data))) + (not (member footprint seen))) + (push footprint seen) link))))) + ;; If at a section, find parent headline, if any, in order to + ;; count links that might be in the title. + (headline + (if (eq (org-element-type element) 'headline) element + (or (org-export-get-parent-headline element) element)))) + ;; Get all links in HEADLINE. + (org-element-map headline 'link + (lambda (l) (funcall unique-link-p l)) info nil nil t))) + +(defun org-ascii--describe-links (links width info) + "Return a string describing a list of links. + +LINKS is a list of link type objects, as returned by +`org-ascii--unique-links'. WIDTH is the text width allowed for +the output string. INFO is a plist used as a communication +channel." + (mapconcat + (lambda (link) + (let ((type (org-element-property :type link)) + (anchor (let ((desc (org-element-contents link))) + (if desc (org-export-data desc info) + (org-element-property :raw-link link))))) + (cond + ;; Coderefs, radio links and fuzzy links are ignored. + ((member type '("coderef" "radio" "fuzzy")) nil) + ;; Id and custom-id links: Headlines refer to their numbering. + ((member type '("custom-id" "id")) + (let ((dest (org-export-resolve-id-link link info))) + (concat + (org-ascii--fill-string + (format + "[%s] %s" + anchor + (if (not dest) (org-ascii--translate "Unknown reference" info) + (format + (org-ascii--translate "See section %s" info) + (mapconcat 'number-to-string + (org-export-get-headline-number dest info) ".")))) + width info) "\n\n"))) + ;; Do not add a link that cannot be resolved and doesn't have + ;; any description: destination is already visible in the + ;; paragraph. + ((not (org-element-contents link)) nil) + (t + (concat + (org-ascii--fill-string + (format "[%s] %s" anchor (org-element-property :raw-link link)) + width info) + "\n\n"))))) + links "")) + +(defun org-ascii--checkbox (item info) + "Return checkbox string for ITEM or nil. +INFO is a plist used as a communication channel." + (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) + (case (org-element-property :checkbox item) + (on (if utf8p "☑ " "[X] ")) + (off (if utf8p "☐ " "[ ] ")) + (trans (if utf8p "☒ " "[-] "))))) + + + +;;; Template + +(defun org-ascii-template--document-title (info) + "Return document title, as a string. +INFO is a plist used as a communication channel." + (let* ((text-width org-ascii-text-width) + ;; Links in the title will not be resolved later, so we make + ;; sure their path is located right after them. + (org-ascii-links-to-notes nil) + (title (org-export-data (plist-get info :title) info)) + (author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth (org-export-data auth info))))) + (email (and (plist-get info :with-email) + (org-export-data (plist-get info :email) info))) + (date (and (plist-get info :with-date) + (org-export-data (org-export-get-date info) info)))) + ;; There are two types of title blocks depending on the presence + ;; of a title to display. + (if (string= title "") + ;; Title block without a title. DATE is positioned at the top + ;; right of the document, AUTHOR to the top left and EMAIL + ;; just below. + (cond + ((and (org-string-nw-p date) (org-string-nw-p author)) + (concat + author + (make-string (- text-width (string-width date) (string-width author)) + ?\s) + date + (when (org-string-nw-p email) (concat "\n" email)) + "\n\n\n")) + ((and (org-string-nw-p date) (org-string-nw-p email)) + (concat + email + (make-string (- text-width (string-width date) (string-width email)) + ?\s) + date "\n\n\n")) + ((org-string-nw-p date) + (concat + (org-ascii--justify-string date text-width 'right) + "\n\n\n")) + ((and (org-string-nw-p author) (org-string-nw-p email)) + (concat author "\n" email "\n\n\n")) + ((org-string-nw-p author) (concat author "\n\n\n")) + ((org-string-nw-p email) (concat email "\n\n\n"))) + ;; Title block with a title. Document's TITLE, along with the + ;; AUTHOR and its EMAIL are both overlined and an underlined, + ;; centered. Date is just below, also centered. + (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)) + ;; Format TITLE. It may be filled if it is too wide, + ;; that is wider than the two thirds of the total width. + (title-len (min (length title) (/ (* 2 text-width) 3))) + (formatted-title (org-ascii--fill-string title title-len info)) + (line + (make-string + (min (+ (max title-len + (string-width (or author "")) + (string-width (or email ""))) + 2) + text-width) (if utf8p ?━ ?_)))) + (org-ascii--justify-string + (concat line "\n" + (unless utf8p "\n") + (upcase formatted-title) + (cond + ((and (org-string-nw-p author) (org-string-nw-p email)) + (concat (if utf8p "\n\n\n" "\n\n") author "\n" email)) + ((org-string-nw-p author) + (concat (if utf8p "\n\n\n" "\n\n") author)) + ((org-string-nw-p email) + (concat (if utf8p "\n\n\n" "\n\n") email))) + "\n" line + (when (org-string-nw-p date) (concat "\n\n\n" date)) + "\n\n\n") text-width 'center))))) + +(defun org-ascii-inner-template (contents info) + "Return complete document string after ASCII conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (org-element-normalize-string + (org-ascii--indent-string + (concat + ;; 1. Document's body. + contents + ;; 2. Footnote definitions. + (let ((definitions (org-export-collect-footnote-definitions + (plist-get info :parse-tree) info)) + ;; Insert full links right inside the footnote definition + ;; as they have no chance to be inserted later. + (org-ascii-links-to-notes nil)) + (when definitions + (concat + "\n\n\n" + (let ((title (org-ascii--translate "Footnotes" info))) + (concat + title "\n" + (make-string + (string-width title) + (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)))) + "\n\n" + (let ((text-width (- org-ascii-text-width org-ascii-global-margin))) + (mapconcat + (lambda (ref) + (let ((id (format "[%s] " (car ref)))) + ;; Distinguish between inline definitions and + ;; full-fledged definitions. + (org-trim + (let ((def (nth 2 ref))) + (if (eq (org-element-type def) 'org-data) + ;; Full-fledged definition: footnote ID is + ;; inserted inside the first parsed paragraph + ;; (FIRST), if any, to be sure filling will + ;; take it into consideration. + (let ((first (car (org-element-contents def)))) + (if (not (eq (org-element-type first) 'paragraph)) + (concat id "\n" (org-export-data def info)) + (push id (nthcdr 2 first)) + (org-export-data def info))) + ;; Fill paragraph once footnote ID is inserted + ;; in order to have a correct length for first + ;; line. + (org-ascii--fill-string + (concat id (org-export-data def info)) + text-width info)))))) + definitions "\n\n")))))) + org-ascii-global-margin))) + +(defun org-ascii-template (contents info) + "Return complete document string after ASCII conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (concat + ;; 1. Build title block. + (org-ascii--indent-string + (concat (org-ascii-template--document-title info) + ;; 2. Table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth + (concat + (org-ascii--build-toc info (and (wholenump depth) depth)) + "\n\n\n")))) + org-ascii-global-margin) + ;; 3. Document's body. + contents + ;; 4. Creator. Ignore `comment' value as there are no comments in + ;; ASCII. Justify it to the bottom right. + (org-ascii--indent-string + (let ((creator-info (plist-get info :with-creator)) + (text-width (- org-ascii-text-width org-ascii-global-margin))) + (unless (or (not creator-info) (eq creator-info 'comment)) + (concat + "\n\n\n" + (org-ascii--fill-string + (plist-get info :creator) text-width info 'right)))) + org-ascii-global-margin))) + +(defun org-ascii--translate (s info) + "Translate string S according to specified language and charset. +INFO is a plist used as a communication channel." + (let ((charset (intern (format ":%s" (plist-get info :ascii-charset))))) + (org-export-translate s charset info))) + + + +;;; Transcode Functions + +;;;; Bold + +(defun org-ascii-bold (bold contents info) + "Transcode BOLD from Org to ASCII. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (format "*%s*" contents)) + + +;;;; Center Block + +(defun org-ascii-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to ASCII. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (org-ascii--justify-string + contents (org-ascii--current-text-width center-block info) 'center)) + + +;;;; Clock + +(defun org-ascii-clock (clock contents info) + "Transcode a CLOCK object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual +information." + (concat org-clock-string " " + (org-translate-time + (org-element-property :raw-value + (org-element-property :value clock))) + (let ((time (org-element-property :duration clock))) + (and time + (concat " => " + (apply 'format + "%2s:%02s" + (org-split-string time ":"))))))) + + +;;;; Code + +(defun org-ascii-code (code contents info) + "Return a CODE object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format org-ascii-verbatim-format (org-element-property :value code))) + + +;;;; Drawer + +(defun org-ascii-drawer (drawer contents info) + "Transcode a DRAWER element from Org to ASCII. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((name (org-element-property :drawer-name drawer)) + (width (org-ascii--current-text-width drawer info))) + (funcall org-ascii-format-drawer-function name contents width))) + + +;;;; Dynamic Block + +(defun org-ascii-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to ASCII. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + contents) + + +;;;; Entity + +(defun org-ascii-entity (entity contents info) + "Transcode an ENTITY object from Org to ASCII. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (org-element-property + (intern (concat ":" (symbol-name (plist-get info :ascii-charset)))) + entity)) + + +;;;; Example Block + +(defun org-ascii-example-block (example-block contents info) + "Transcode a EXAMPLE-BLOCK element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-ascii--box-string + (org-export-format-code-default example-block info) info)) + + +;;;; Export Snippet + +(defun org-ascii-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (eq (org-export-snippet-backend export-snippet) 'ascii) + (org-element-property :value export-snippet))) + + +;;;; Export Block + +(defun org-ascii-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (string= (org-element-property :type export-block) "ASCII") + (org-remove-indentation (org-element-property :value export-block)))) + + +;;;; Fixed Width + +(defun org-ascii-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-ascii--box-string + (org-remove-indentation + (org-element-property :value fixed-width)) info)) + + +;;;; Footnote Definition + +;; Footnote Definitions are ignored. They are compiled at the end of +;; the document, by `org-ascii-inner-template'. + + +;;;; Footnote Reference + +(defun org-ascii-footnote-reference (footnote-reference contents info) + "Transcode a FOOTNOTE-REFERENCE element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (format "[%s]" (org-export-get-footnote-number footnote-reference info))) + + +;;;; Headline + +(defun org-ascii-headline (headline contents info) + "Transcode a HEADLINE element from Org to ASCII. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + ;; Don't export footnote section, which will be handled at the end + ;; of the template. + (unless (org-element-property :footnote-section-p headline) + (let* ((low-level-rank (org-export-low-level-p headline info)) + (width (org-ascii--current-text-width headline info)) + ;; Blank lines between headline and its contents. + ;; `org-ascii-headline-spacing', when set, overwrites + ;; original buffer's spacing. + (pre-blanks + (make-string + (if org-ascii-headline-spacing (car org-ascii-headline-spacing) + (org-element-property :pre-blank headline)) ?\n)) + ;; Even if HEADLINE has no section, there might be some + ;; links in its title that we shouldn't forget to describe. + (links + (unless (or (eq (caar (org-element-contents headline)) 'section)) + (let ((title (org-element-property :title headline))) + (when (consp title) + (org-ascii--describe-links + (org-ascii--unique-links title info) width info)))))) + ;; Deep subtree: export it as a list item. + (if low-level-rank + (concat + ;; Bullet. + (let ((bullets (cdr (assq (plist-get info :ascii-charset) + org-ascii-bullets)))) + (char-to-string + (nth (mod (1- low-level-rank) (length bullets)) bullets))) + " " + ;; Title. + (org-ascii--build-title headline info width) "\n" + ;; Contents, indented by length of bullet. + pre-blanks + (org-ascii--indent-string + (concat contents + (when (org-string-nw-p links) (concat "\n\n" links))) + 2)) + ;; Else: Standard headline. + (concat + (org-ascii--build-title headline info width 'underline) + "\n" pre-blanks + (concat (when (org-string-nw-p links) links) contents)))))) + + +;;;; Horizontal Rule + +(defun org-ascii-horizontal-rule (horizontal-rule contents info) + "Transcode an HORIZONTAL-RULE object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((text-width (org-ascii--current-text-width horizontal-rule info)) + (spec-width + (org-export-read-attribute :attr_ascii horizontal-rule :width))) + (org-ascii--justify-string + (make-string (if (and spec-width (string-match "^[0-9]+$" spec-width)) + (string-to-number spec-width) + text-width) + (if (eq (plist-get info :ascii-charset) 'utf-8) ?― ?-)) + text-width 'center))) + + +;;;; Inline Src Block + +(defun org-ascii-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to ASCII. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (format org-ascii-verbatim-format + (org-element-property :value inline-src-block))) + + +;;;; Inlinetask + +(defun org-ascii-format-inlinetask-default + (todo type priority name tags contents width inlinetask info) + "Format an inline task element for ASCII export. +See `org-ascii-format-inlinetask-function' for a description +of the parameters." + (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)) + (width (or width org-ascii-inlinetask-width))) + (org-ascii--indent-string + (concat + ;; Top line, with an additional blank line if not in UTF-8. + (make-string width (if utf8p ?━ ?_)) "\n" + (unless utf8p (concat (make-string width ? ) "\n")) + ;; Add title. Fill it if wider than inlinetask. + (let ((title (org-ascii--build-title inlinetask info width))) + (if (<= (string-width title) width) title + (org-ascii--fill-string title width info))) + "\n" + ;; If CONTENTS is not empty, insert it along with + ;; a separator. + (when (org-string-nw-p contents) + (concat (make-string width (if utf8p ?─ ?-)) "\n" contents)) + ;; Bottom line. + (make-string width (if utf8p ?━ ?_))) + ;; Flush the inlinetask to the right. + (- org-ascii-text-width org-ascii-global-margin + (if (not (org-export-get-parent-headline inlinetask)) 0 + org-ascii-inner-margin) + (org-ascii--current-text-width inlinetask info))))) + +(defun org-ascii-inlinetask (inlinetask contents info) + "Transcode an INLINETASK element from Org to ASCII. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((width (org-ascii--current-text-width inlinetask info))) + (funcall org-ascii-format-inlinetask-function + ;; todo. + (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property + :todo-keyword inlinetask))) + (and todo (org-export-data todo info)))) + ;; todo-type + (org-element-property :todo-type inlinetask) + ;; priority + (and (plist-get info :with-priority) + (org-element-property :priority inlinetask)) + ;; title + (org-export-data (org-element-property :title inlinetask) info) + ;; tags + (and (plist-get info :with-tags) + (org-element-property :tags inlinetask)) + ;; contents and width + contents width inlinetask info))) + + +;;;; Italic + +(defun org-ascii-italic (italic contents info) + "Transcode italic from Org to ASCII. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (format "/%s/" contents)) + + +;;;; Item + +(defun org-ascii-item (item contents info) + "Transcode an ITEM element from Org to ASCII. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)) + (checkbox (org-ascii--checkbox item info)) + (list-type (org-element-property :type (org-export-get-parent item))) + (bullet + ;; First parent of ITEM is always the plain-list. Get + ;; `:type' property from it. + (org-list-bullet-string + (case list-type + (descriptive + (concat checkbox + (org-export-data (org-element-property :tag item) info) + ": ")) + (ordered + ;; Return correct number for ITEM, paying attention to + ;; counters. + (let* ((struct (org-element-property :structure item)) + (bul (org-element-property :bullet item)) + (num (number-to-string + (car (last (org-list-get-item-number + (org-element-property :begin item) + struct + (org-list-prevs-alist struct) + (org-list-parents-alist struct))))))) + (replace-regexp-in-string "[0-9]+" num bul))) + (t (let ((bul (org-element-property :bullet item))) + ;; Change bullets into more visible form if UTF-8 is active. + (if (not utf8p) bul + (replace-regexp-in-string + "-" "•" + (replace-regexp-in-string + "+" "⁃" + (replace-regexp-in-string "*" "‣" bul)))))))))) + (concat + bullet + (unless (eq list-type 'descriptive) checkbox) + ;; Contents: Pay attention to indentation. Note: check-boxes are + ;; already taken care of at the paragraph level so they don't + ;; interfere with indentation. + (let ((contents (org-ascii--indent-string contents (string-width bullet)))) + (if (eq (org-element-type (car (org-element-contents item))) 'paragraph) + (org-trim contents) + (concat "\n" contents)))))) + + +;;;; Keyword + +(defun org-ascii-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "ASCII") value) + ((string= key "TOC") + (let ((value (downcase value))) + (cond + ((string-match "\\<headlines\\>" value) + (let ((depth (or (and (string-match "[0-9]+" value) + (string-to-number (match-string 0 value))) + (plist-get info :with-toc)))) + (org-ascii--build-toc + info (and (wholenump depth) depth) keyword))) + ((string= "tables" value) + (org-ascii--list-tables keyword info)) + ((string= "listings" value) + (org-ascii--list-listings keyword info)))))))) + + +;;;; Latex Environment + +(defun org-ascii-latex-environment (latex-environment contents info) + "Transcode a LATEX-ENVIRONMENT element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual +information." + (when (plist-get info :with-latex) + (org-remove-indentation (org-element-property :value latex-environment)))) + + +;;;; Latex Fragment + +(defun org-ascii-latex-fragment (latex-fragment contents info) + "Transcode a LATEX-FRAGMENT object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual +information." + (when (plist-get info :with-latex) + (org-element-property :value latex-fragment))) + + +;;;; Line Break + +(defun org-ascii-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual + information." hard-newline) + + +;;;; Link + +(defun org-ascii-link (link desc info) + "Transcode a LINK object from Org to ASCII. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information." + (let ((raw-link (org-element-property :raw-link link)) + (type (org-element-property :type link))) + (cond + ((string= type "coderef") + (let ((ref (org-element-property :path link))) + (format (org-export-get-coderef-format ref desc) + (org-export-resolve-coderef ref info)))) + ;; Do not apply a special syntax on radio links. Though, use + ;; transcoded target's contents as output. + ((string= type "radio") desc) + ;; Do not apply a special syntax on fuzzy links pointing to + ;; targets. + ((string= type "fuzzy") + (let ((destination (org-export-resolve-fuzzy-link link info))) + (if (org-string-nw-p desc) desc + (when destination + (let ((number + (org-export-get-ordinal + destination info nil 'org-ascii--has-caption-p))) + (when number + (if (atom number) (number-to-string number) + (mapconcat 'number-to-string number ".")))))))) + (t + (if (not (org-string-nw-p desc)) (format "[%s]" raw-link) + (concat + (format "[%s]" desc) + (unless org-ascii-links-to-notes (format " (%s)" raw-link)))))))) + + +;;;; Paragraph + +(defun org-ascii-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to ASCII. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + (org-ascii--fill-string + (if (not (wholenump org-ascii-indented-line-width)) contents + (concat + ;; Do not indent first paragraph in a section. + (unless (and (not (org-export-get-previous-element paragraph info)) + (eq (org-element-type (org-export-get-parent paragraph)) + 'section)) + (make-string org-ascii-indented-line-width ?\s)) + (replace-regexp-in-string "\\`[ \t]+" "" contents))) + (org-ascii--current-text-width paragraph info) info)) + + +;;;; Plain List + +(defun org-ascii-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to ASCII. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + contents) + + +;;;; Plain Text + +(defun org-ascii-plain-text (text info) + "Transcode a TEXT string from Org to ASCII. +INFO is a plist used as a communication channel." + (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) + (when (and utf8p (plist-get info :with-smart-quotes)) + (setq text (org-export-activate-smart-quotes text :utf-8 info))) + (if (not (plist-get info :with-special-strings)) text + (setq text (replace-regexp-in-string "\\\\-" "" text)) + (if (not utf8p) text + ;; Usual replacements in utf-8 with proper option set. + (replace-regexp-in-string + "\\.\\.\\." "…" + (replace-regexp-in-string + "--" "–" + (replace-regexp-in-string "---" "—" text))))))) + + +;;;; Planning + +(defun org-ascii-planning (planning contents info) + "Transcode a PLANNING element from Org to ASCII. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (mapconcat + 'identity + (delq nil + (list (let ((closed (org-element-property :closed planning))) + (when closed + (concat org-closed-string " " + (org-translate-time + (org-element-property :raw-value closed))))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat org-deadline-string " " + (org-translate-time + (org-element-property :raw-value deadline))))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat org-scheduled-string " " + (org-translate-time + (org-element-property :raw-value scheduled))))))) + " ")) + + +;;;; Quote Block + +(defun org-ascii-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to ASCII. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (org-ascii--indent-string contents org-ascii-quote-margin)) + + +;;;; Quote Section + +(defun org-ascii-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((width (org-ascii--current-text-width quote-section info)) + (value + (org-export-data + (org-remove-indentation (org-element-property :value quote-section)) + info))) + (org-ascii--indent-string + value + (+ org-ascii-quote-margin + ;; Don't apply inner margin if parent headline is low level. + (let ((headline (org-export-get-parent-headline quote-section))) + (if (org-export-low-level-p headline info) 0 + org-ascii-inner-margin)))))) + + +;;;; Radio Target + +(defun org-ascii-radio-target (radio-target contents info) + "Transcode a RADIO-TARGET object from Org to ASCII. +CONTENTS is the contents of the target. INFO is a plist holding +contextual information." + contents) + + +;;;; Section + +(defun org-ascii-section (section contents info) + "Transcode a SECTION element from Org to ASCII. +CONTENTS is the contents of the section. INFO is a plist holding +contextual information." + (org-ascii--indent-string + (concat + contents + (when org-ascii-links-to-notes + ;; Add list of links at the end of SECTION. + (let ((links (org-ascii--describe-links + (org-ascii--unique-links section info) + (org-ascii--current-text-width section info) info))) + ;; Separate list of links and section contents. + (when (org-string-nw-p links) (concat "\n\n" links))))) + ;; Do not apply inner margin if parent headline is low level. + (let ((headline (org-export-get-parent-headline section))) + (if (or (not headline) (org-export-low-level-p headline info)) 0 + org-ascii-inner-margin)))) + + +;;;; Special Block + +(defun org-ascii-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to ASCII. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + contents) + + +;;;; Src Block + +(defun org-ascii-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to ASCII. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let ((caption (org-ascii--build-caption src-block info)) + (code (org-export-format-code-default src-block info))) + (if (equal code "") "" + (concat + (when (and caption org-ascii-caption-above) (concat caption "\n")) + (org-ascii--box-string code info) + (when (and caption (not org-ascii-caption-above)) + (concat "\n" caption)))))) + + +;;;; Statistics Cookie + +(defun org-ascii-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-element-property :value statistics-cookie)) + + +;;;; Subscript + +(defun org-ascii-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to ASCII. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (if (org-element-property :use-brackets-p subscript) + (format "_{%s}" contents) + (format "_%s" contents))) + + +;;;; Superscript + +(defun org-ascii-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to ASCII. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (if (org-element-property :use-brackets-p superscript) + (format "^{%s}" contents) + (format "^%s" contents))) + + +;;;; Strike-through + +(defun org-ascii-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to ASCII. +CONTENTS is text with strike-through markup. INFO is a plist +holding contextual information." + (format "+%s+" contents)) + + +;;;; Table + +(defun org-ascii-table (table contents info) + "Transcode a TABLE element from Org to ASCII. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (let ((caption (org-ascii--build-caption table info))) + (concat + ;; Possibly add a caption string above. + (when (and caption org-ascii-caption-above) (concat caption "\n")) + ;; Insert table. Note: "table.el" tables are left unmodified. + (cond ((eq (org-element-property :type table) 'org) contents) + ((and org-ascii-table-use-ascii-art + (eq (plist-get info :ascii-charset) 'utf-8) + (require 'ascii-art-to-unicode nil t)) + (with-temp-buffer + (insert (org-remove-indentation + (org-element-property :value table))) + (goto-char (point-min)) + (aa2u) + (goto-char (point-max)) + (skip-chars-backward " \r\t\n") + (buffer-substring (point-min) (point)))) + (t (org-remove-indentation (org-element-property :value table)))) + ;; Possible add a caption string below. + (and (not org-ascii-caption-above) caption)))) + + +;;;; Table Cell + +(defun org-ascii--table-cell-width (table-cell info) + "Return width of TABLE-CELL. + +INFO is a plist used as a communication channel. + +Width of a cell is determined either by a width cookie in the +same column as the cell, or by the maximum cell's length in that +column. + +When `org-ascii-table-widen-columns' is non-nil, width cookies +are ignored." + (let* ((row (org-export-get-parent table-cell)) + (table (org-export-get-parent row)) + (col (let ((cells (org-element-contents row))) + (- (length cells) (length (memq table-cell cells))))) + (cache + (or (plist-get info :ascii-table-cell-width-cache) + (plist-get (setq info + (plist-put info :ascii-table-cell-width-cache + (make-hash-table :test 'equal))) + :ascii-table-cell-width-cache))) + (key (cons table col))) + (or (gethash key cache) + (puthash + key + (let ((cookie-width (org-export-table-cell-width table-cell info))) + (or (and (not org-ascii-table-widen-columns) cookie-width) + (let ((contents-width + (let ((max-width 0)) + (org-element-map table 'table-row + (lambda (row) + (setq max-width + (max (string-width + (org-export-data + (org-element-contents + (elt (org-element-contents row) col)) + info)) + max-width))) + info) + max-width))) + (cond ((not cookie-width) contents-width) + (org-ascii-table-widen-columns + (max cookie-width contents-width)) + (t cookie-width))))) + cache)))) + +(defun org-ascii-table-cell (table-cell contents info) + "Transcode a TABLE-CELL object from Org to ASCII. +CONTENTS is the cell contents. INFO is a plist used as +a communication channel." + ;; Determine column width. When `org-ascii-table-widen-columns' + ;; is nil and some width cookie has set it, use that value. + ;; Otherwise, compute the maximum width among transcoded data of + ;; each cell in the column. + (let ((width (org-ascii--table-cell-width table-cell info))) + ;; When contents are too large, truncate them. + (unless (or org-ascii-table-widen-columns + (<= (string-width (or contents "")) width)) + (setq contents (concat (substring contents 0 (- width 2)) "=>"))) + ;; Align contents correctly within the cell. + (let* ((indent-tabs-mode nil) + (data + (when contents + (org-ascii--justify-string + contents width + (org-export-table-cell-alignment table-cell info))))) + (setq contents + (concat data + (make-string (- width (string-width (or data ""))) ?\s)))) + ;; Return cell. + (concat (format " %s " contents) + (when (memq 'right (org-export-table-cell-borders table-cell info)) + (if (eq (plist-get info :ascii-charset) 'utf-8) "│" "|"))))) + + +;;;; Table Row + +(defun org-ascii-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to ASCII. +CONTENTS is the row contents. INFO is a plist used as +a communication channel." + (when (eq (org-element-property :type table-row) 'standard) + (let ((build-hline + (function + (lambda (lcorner horiz vert rcorner) + (concat + (apply + 'concat + (org-element-map table-row 'table-cell + (lambda (cell) + (let ((width (org-ascii--table-cell-width cell info)) + (borders (org-export-table-cell-borders cell info))) + (concat + ;; In order to know if CELL starts the row, do + ;; not compare it with the first cell in the + ;; row as there might be a special column. + ;; Instead, compare it with first exportable + ;; cell, obtained with `org-element-map'. + (when (and (memq 'left borders) + (eq (org-element-map table-row 'table-cell + 'identity info t) + cell)) + lcorner) + (make-string (+ 2 width) (string-to-char horiz)) + (cond + ((not (memq 'right borders)) nil) + ((eq (car (last (org-element-contents table-row))) cell) + rcorner) + (t vert))))) + info)) "\n")))) + (utf8p (eq (plist-get info :ascii-charset) 'utf-8)) + (borders (org-export-table-cell-borders + (org-element-map table-row 'table-cell 'identity info t) + info))) + (concat (cond + ((and (memq 'top borders) (or utf8p (memq 'above borders))) + (if utf8p (funcall build-hline "┍" "━" "┯" "┑") + (funcall build-hline "+" "-" "+" "+"))) + ((memq 'above borders) + (if utf8p (funcall build-hline "├" "─" "┼" "┤") + (funcall build-hline "+" "-" "+" "+")))) + (when (memq 'left borders) (if utf8p "│" "|")) + contents "\n" + (when (and (memq 'bottom borders) (or utf8p (memq 'below borders))) + (if utf8p (funcall build-hline "┕" "━" "┷" "┙") + (funcall build-hline "+" "-" "+" "+"))))))) + + +;;;; Timestamp + +(defun org-ascii-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-ascii-plain-text (org-timestamp-translate timestamp) info)) + + +;;;; Underline + +(defun org-ascii-underline (underline contents info) + "Transcode UNDERLINE from Org to ASCII. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (format "_%s_" contents)) + + +;;;; Verbatim + +(defun org-ascii-verbatim (verbatim contents info) + "Return a VERBATIM object from Org to ASCII. +CONTENTS is nil. INFO is a plist holding contextual information." + (format org-ascii-verbatim-format + (org-element-property :value verbatim))) + + +;;;; Verse Block + +(defun org-ascii-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to ASCII. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + (let ((verse-width (org-ascii--current-text-width verse-block info))) + (org-ascii--indent-string + (org-ascii--justify-string contents verse-width 'left) + org-ascii-quote-margin))) + + + +;;; Filters + +(defun org-ascii-filter-headline-blank-lines (headline back-end info) + "Filter controlling number of blank lines after a headline. + +HEADLINE is a string representing a transcoded headline. +BACK-END is symbol specifying back-end used for export. INFO is +plist containing the communication channel. + +This function only applies to `ascii' back-end. See +`org-ascii-headline-spacing' for information." + (if (not org-ascii-headline-spacing) headline + (let ((blanks (make-string (1+ (cdr org-ascii-headline-spacing)) ?\n))) + (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline)))) + +(defun org-ascii-filter-paragraph-spacing (tree back-end info) + "Filter controlling number of blank lines between paragraphs. + +TREE is the parse tree. BACK-END is the symbol specifying +back-end used for export. INFO is a plist used as +a communication channel. + +See `org-ascii-paragraph-spacing' for information." + (when (wholenump org-ascii-paragraph-spacing) + (org-element-map tree 'paragraph + (lambda (p) + (when (eq (org-element-type (org-export-get-next-element p info)) + 'paragraph) + (org-element-put-property + p :post-blank org-ascii-paragraph-spacing))))) + tree) + +(defun org-ascii-filter-comment-spacing (tree backend info) + "Filter removing blank lines between comments. +TREE is the parse tree. BACK-END is the symbol specifying +back-end used for export. INFO is a plist used as +a communication channel." + (org-element-map tree '(comment comment-block) + (lambda (c) + (when (memq (org-element-type (org-export-get-next-element c info)) + '(comment comment-block)) + (org-element-put-property c :post-blank 0)))) + tree) + + + +;;; End-user functions + +;;;###autoload +(defun org-ascii-export-as-ascii + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a text buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, strip title and +table of contents from output. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org ASCII Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil." + (interactive) + (org-export-to-buffer 'ascii "*Org ASCII Export*" + async subtreep visible-only body-only ext-plist (lambda () (text-mode)))) + +;;;###autoload +(defun org-ascii-export-to-ascii + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a text file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, strip title and +table of contents from output. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let ((file (org-export-output-file-name ".txt" subtreep))) + (org-export-to-file 'ascii file + async subtreep visible-only body-only ext-plist))) + +;;;###autoload +(defun org-ascii-publish-to-ascii (plist filename pub-dir) + "Publish an Org file to ASCII. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to + 'ascii filename ".txt" `(:ascii-charset ascii ,@plist) pub-dir)) + +;;;###autoload +(defun org-ascii-publish-to-latin1 (plist filename pub-dir) + "Publish an Org file to Latin-1. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to + 'ascii filename ".txt" `(:ascii-charset latin1 ,@plist) pub-dir)) + +;;;###autoload +(defun org-ascii-publish-to-utf8 (plist filename pub-dir) + "Publish an org file to UTF-8. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to + 'ascii filename ".txt" `(:ascii-charset utf-8 ,@plist) pub-dir)) + + +(provide 'ox-ascii) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; coding: utf-8-emacs +;; End: + +;;; ox-ascii.el ends here diff --git a/elpa/org-20150427/ox-beamer.el b/elpa/org-20150427/ox-beamer.el new file mode 100644 index 00000000..abfd181c --- /dev/null +++ b/elpa/org-20150427/ox-beamer.el @@ -0,0 +1,1183 @@ +;;; ox-beamer.el --- Beamer Back-End for Org Export Engine + +;; Copyright (C) 2007-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com> +;; Nicolas Goaziou <n.goaziou AT gmail DOT com> +;; Keywords: org, wp, tex + +;; 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: +;; +;; This library implements both a Beamer back-end, derived from the +;; LaTeX one and a minor mode easing structure edition of the +;; document. See Org manual for more information. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ox-latex) + +;; Install a default set-up for Beamer export. +(unless (assoc "beamer" org-latex-classes) + (add-to-list 'org-latex-classes + '("beamer" + "\\documentclass[presentation]{beamer}" + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}")))) + + + +;;; User-Configurable Variables + +(defgroup org-export-beamer nil + "Options specific for using the beamer class in LaTeX export." + :tag "Org Beamer" + :group 'org-export + :version "24.2") + +(defcustom org-beamer-frame-level 1 + "The level at which headlines become frames. + +Headlines at a lower level will be translated into a sectioning +structure. At a higher level, they will be translated into +blocks. + +If a headline with a \"BEAMER_env\" property set to \"frame\" is +found within a tree, its level locally overrides this number. + +This variable has no effect on headlines with the \"BEAMER_env\" +property set to either \"ignoreheading\", \"appendix\", or +\"note\", which will respectively, be invisible, become an +appendix or a note. + +This integer is relative to the minimal level of a headline +within the parse tree, defined as 1." + :group 'org-export-beamer + :type 'integer) + +(defcustom org-beamer-frame-default-options "" + "Default options string to use for frames. +For example, it could be set to \"allowframebreaks\"." + :group 'org-export-beamer + :type '(string :tag "[options]")) + +(defcustom org-beamer-column-view-format + "%45ITEM %10BEAMER_env(Env) %10BEAMER_act(Act) %4BEAMER_col(Col) %8BEAMER_opt(Opt)" + "Column view format that should be used to fill the template." + :group 'org-export-beamer + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Do not insert Beamer column view format" nil) + (string :tag "Beamer column view format"))) + +(defcustom org-beamer-theme "default" + "Default theme used in Beamer presentations." + :group 'org-export-beamer + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Do not insert a Beamer theme" nil) + (string :tag "Beamer theme"))) + +(defcustom org-beamer-environments-extra nil + "Environments triggered by tags in Beamer export. +Each entry has 4 elements: + +name Name of the environment +key Selection key for `org-beamer-select-environment' +open The opening template for the environment, with the following escapes + %a the action/overlay specification + %A the default action/overlay specification + %o the options argument of the template + %h the headline text + %r the raw headline text (i.e. without any processing) + %H if there is headline text, that raw text in {} braces + %U if there is headline text, that raw text in [] brackets +close The closing string of the environment." + :group 'org-export-beamer + :version "24.4" + :package-version '(Org . "8.1") + :type '(repeat + (list + (string :tag "Environment") + (string :tag "Selection key") + (string :tag "Begin") + (string :tag "End")))) + +(defcustom org-beamer-outline-frame-title "Outline" + "Default title of a frame containing an outline." + :group 'org-export-beamer + :type '(string :tag "Outline frame title")) + +(defcustom org-beamer-outline-frame-options "" + "Outline frame options appended after \\begin{frame}. +You might want to put e.g. \"allowframebreaks=0.9\" here." + :group 'org-export-beamer + :type '(string :tag "Outline frame options")) + + + +;;; Internal Variables + +(defconst org-beamer-column-widths + "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC" +"The column widths that should be installed as allowed property values.") + +(defconst org-beamer-environments-special + '(("againframe" "A") + ("appendix" "x") + ("column" "c") + ("columns" "C") + ("frame" "f") + ("fullframe" "F") + ("ignoreheading" "i") + ("note" "n") + ("noteNH" "N")) + "Alist of environments treated in a special way by the back-end. +Keys are environment names, as strings, values are bindings used +in `org-beamer-select-environment'. Environments listed here, +along with their binding, are hard coded and cannot be modified +through `org-beamer-environments-extra' variable.") + +(defconst org-beamer-environments-default + '(("block" "b" "\\begin{block}%a{%h}" "\\end{block}") + ("alertblock" "a" "\\begin{alertblock}%a{%h}" "\\end{alertblock}") + ("verse" "v" "\\begin{verse}%a %% %h" "\\end{verse}") + ("quotation" "q" "\\begin{quotation}%a %% %h" "\\end{quotation}") + ("quote" "Q" "\\begin{quote}%a %% %h" "\\end{quote}") + ("structureenv" "s" "\\begin{structureenv}%a %% %h" "\\end{structureenv}") + ("theorem" "t" "\\begin{theorem}%a%U" "\\end{theorem}") + ("definition" "d" "\\begin{definition}%a%U" "\\end{definition}") + ("example" "e" "\\begin{example}%a%U" "\\end{example}") + ("exampleblock" "E" "\\begin{exampleblock}%a{%h}" "\\end{exampleblock}") + ("proof" "p" "\\begin{proof}%a%U" "\\end{proof}") + ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}" "\\end{beamercolorbox}")) + "Environments triggered by properties in Beamer export. +These are the defaults - for user definitions, see +`org-beamer-environments-extra'.") + +(defconst org-beamer-verbatim-elements + '(code example-block fixed-width inline-src-block src-block verbatim) + "List of element or object types producing verbatim text. +This is used internally to determine when a frame should have the +\"fragile\" option.") + + + +;;; Internal functions + +(defun org-beamer--normalize-argument (argument type) + "Return ARGUMENT string with proper boundaries. + +TYPE is a symbol among the following: +`action' Return ARGUMENT within angular brackets. +`defaction' Return ARGUMENT within both square and angular brackets. +`option' Return ARGUMENT within square brackets." + (if (not (string-match "\\S-" argument)) "" + (case type + (action (if (string-match "\\`<.*>\\'" argument) argument + (format "<%s>" argument))) + (defaction (cond + ((string-match "\\`\\[<.*>\\]\\'" argument) argument) + ((string-match "\\`<.*>\\'" argument) + (format "[%s]" argument)) + ((string-match "\\`\\[\\(.*\\)\\]\\'" argument) + (format "[<%s>]" (match-string 1 argument))) + (t (format "[<%s>]" argument)))) + (option (if (string-match "\\`\\[.*\\]\\'" argument) argument + (format "[%s]" argument))) + (otherwise argument)))) + +(defun org-beamer--element-has-overlay-p (element) + "Non-nil when ELEMENT has an overlay specified. +An element has an overlay specification when it starts with an +`beamer' export-snippet whose value is between angular brackets. +Return overlay specification, as a string, or nil." + (let ((first-object (car (org-element-contents element)))) + (when (eq (org-element-type first-object) 'export-snippet) + (let ((value (org-element-property :value first-object))) + (and (string-match "\\`<.*>\\'" value) value))))) + + + +;;; Define Back-End + +(org-export-define-derived-backend 'beamer 'latex + :export-block "BEAMER" + :menu-entry + '(?l 1 + ((?B "As LaTeX buffer (Beamer)" org-beamer-export-as-latex) + (?b "As LaTeX file (Beamer)" org-beamer-export-to-latex) + (?P "As PDF file (Beamer)" org-beamer-export-to-pdf) + (?O "As PDF file and open (Beamer)" + (lambda (a s v b) + (if a (org-beamer-export-to-pdf t s v b) + (org-open-file (org-beamer-export-to-pdf nil s v b))))))) + :options-alist + '((:beamer-theme "BEAMER_THEME" nil org-beamer-theme) + (:beamer-color-theme "BEAMER_COLOR_THEME" nil nil t) + (:beamer-font-theme "BEAMER_FONT_THEME" nil nil t) + (:beamer-inner-theme "BEAMER_INNER_THEME" nil nil t) + (:beamer-outer-theme "BEAMER_OUTER_THEME" nil nil t) + (:beamer-header-extra "BEAMER_HEADER" nil nil newline) + ;; Modify existing properties. + (:headline-levels nil "H" org-beamer-frame-level) + (:latex-class "LATEX_CLASS" nil "beamer" t)) + :translate-alist '((bold . org-beamer-bold) + (export-block . org-beamer-export-block) + (export-snippet . org-beamer-export-snippet) + (headline . org-beamer-headline) + (item . org-beamer-item) + (keyword . org-beamer-keyword) + (link . org-beamer-link) + (plain-list . org-beamer-plain-list) + (radio-target . org-beamer-radio-target) + (target . org-beamer-target) + (template . org-beamer-template))) + + + +;;; Transcode Functions + +;;;; Bold + +(defun org-beamer-bold (bold contents info) + "Transcode BLOCK object into Beamer code. +CONTENTS is the text being bold. INFO is a plist used as +a communication channel." + (format "\\alert%s{%s}" + (or (org-beamer--element-has-overlay-p bold) "") + contents)) + + +;;;; Export Block + +(defun org-beamer-export-block (export-block contents info) + "Transcode an EXPORT-BLOCK element into Beamer code. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (when (member (org-element-property :type export-block) '("BEAMER" "LATEX")) + (org-remove-indentation (org-element-property :value export-block)))) + + +;;;; Export Snippet + +(defun org-beamer-export-snippet (export-snippet contents info) + "Transcode an EXPORT-SNIPPET object into Beamer code. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let ((backend (org-export-snippet-backend export-snippet)) + (value (org-element-property :value export-snippet))) + ;; Only "latex" and "beamer" snippets are retained. + (cond ((eq backend 'latex) value) + ;; Ignore "beamer" snippets specifying overlays. + ((and (eq backend 'beamer) + (or (org-export-get-previous-element export-snippet info) + (not (string-match "\\`<.*>\\'" value)))) + value)))) + + +;;;; Headline +;; +;; The main function to translate a headline is +;; `org-beamer-headline'. +;; +;; Depending on the level at which a headline is considered as +;; a frame (given by `org-beamer--frame-level'), the headline is +;; either a section (`org-beamer--format-section'), a frame +;; (`org-beamer--format-frame') or a block +;; (`org-beamer--format-block'). +;; +;; `org-beamer-headline' also takes care of special environments +;; like "ignoreheading", "note", "noteNH", "appendix" and +;; "againframe". + +(defun org-beamer--get-label (headline info) + "Return label for HEADLINE, as a string. + +INFO is a plist used as a communication channel. + +The value is either the label specified in \"BEAMER_opt\" +property, or a fallback value built from headline's number. This +function assumes HEADLINE will be treated as a frame." + (let ((opt (org-element-property :BEAMER_OPT headline))) + (if (and (org-string-nw-p opt) + (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt)) + (match-string 1 opt) + (format "sec-%s" + (mapconcat 'number-to-string + (org-export-get-headline-number headline info) + "-"))))) + +(defun org-beamer--frame-level (headline info) + "Return frame level in subtree containing HEADLINE. +INFO is a plist used as a communication channel." + (or + ;; 1. Look for "frame" environment in parents, starting from the + ;; farthest. + (catch 'exit + (mapc (lambda (parent) + (let ((env (org-element-property :BEAMER_ENV parent))) + (when (and env (member-ignore-case env '("frame" "fullframe"))) + (throw 'exit (org-export-get-relative-level parent info))))) + (nreverse (org-export-get-genealogy headline))) + nil) + ;; 2. Look for "frame" environment in HEADLINE. + (let ((env (org-element-property :BEAMER_ENV headline))) + (and env (member-ignore-case env '("frame" "fullframe")) + (org-export-get-relative-level headline info))) + ;; 3. Look for "frame" environment in sub-tree. + (org-element-map headline 'headline + (lambda (hl) + (let ((env (org-element-property :BEAMER_ENV hl))) + (when (and env (member-ignore-case env '("frame" "fullframe"))) + (org-export-get-relative-level hl info)))) + info 'first-match) + ;; 4. No "frame" environment in tree: use default value. + (plist-get info :headline-levels))) + +(defun org-beamer--format-section (headline contents info) + "Format HEADLINE as a sectioning part. +CONTENTS holds the contents of the headline. INFO is a plist +used as a communication channel." + (let ((latex-headline + (org-export-with-backend + ;; We create a temporary export back-end which behaves the + ;; same as current one, but adds "\protect" in front of the + ;; output of some objects. + (org-export-create-backend + :parent 'latex + :transcoders + (let ((protected-output + (function + (lambda (object contents info) + (let ((code (org-export-with-backend + 'beamer object contents info))) + (if (org-string-nw-p code) (concat "\\protect" code) + code)))))) + (mapcar #'(lambda (type) (cons type protected-output)) + '(bold footnote-reference italic strike-through timestamp + underline)))) + headline + contents + info)) + (mode-specs (org-element-property :BEAMER_ACT headline))) + (if (and mode-specs + (string-match "\\`\\\\\\(.*?\\)\\(?:\\*\\|\\[.*\\]\\)?{" + latex-headline)) + ;; Insert overlay specifications. + (replace-match (concat (match-string 1 latex-headline) + (format "<%s>" mode-specs)) + nil nil latex-headline 1) + latex-headline))) + +(defun org-beamer--format-frame (headline contents info) + "Format HEADLINE as a frame. +CONTENTS holds the contents of the headline. INFO is a plist +used as a communication channel." + (let ((fragilep + ;; FRAGILEP is non-nil when HEADLINE contains an element + ;; among `org-beamer-verbatim-elements'. + (org-element-map headline org-beamer-verbatim-elements 'identity + info 'first-match))) + (concat "\\begin{frame}" + ;; Overlay specification, if any. When surrounded by + ;; square brackets, consider it as a default + ;; specification. + (let ((action (org-element-property :BEAMER_ACT headline))) + (cond + ((not action) "") + ((string-match "\\`\\[.*\\]\\'" action ) + (org-beamer--normalize-argument action 'defaction)) + (t (org-beamer--normalize-argument action 'action)))) + ;; Options, if any. + (let* ((beamer-opt (org-element-property :BEAMER_OPT headline)) + (options + ;; Collect options from default value and headline's + ;; properties. Also add a label for links. + (append + (org-split-string org-beamer-frame-default-options ",") + (and beamer-opt + (org-split-string + ;; Remove square brackets if user provided + ;; them. + (and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt) + (match-string 1 beamer-opt)) + ",")) + ;; Provide an automatic label for the frame + ;; unless the user specified one. + (unless (and beamer-opt + (string-match "\\(^\\|,\\)label=" beamer-opt)) + (list + (format "label=%s" + (org-beamer--get-label headline info))))))) + ;; Change options list into a string. + (org-beamer--normalize-argument + (mapconcat + 'identity + (if (or (not fragilep) (member "fragile" options)) options + (cons "fragile" options)) + ",") + 'option)) + ;; Title. + (let ((env (org-element-property :BEAMER_ENV headline))) + (format "{%s}" + (if (and env (equal (downcase env) "fullframe")) "" + (org-export-data + (org-element-property :title headline) info)))) + "\n" + ;; The following workaround is required in fragile frames + ;; as Beamer will append "\par" to the beginning of the + ;; contents. So we need to make sure the command is + ;; separated from the contents by at least one space. If + ;; it isn't, it will create "\parfirst-word" command and + ;; remove the first word from the contents in the PDF + ;; output. + (if (not fragilep) contents + (replace-regexp-in-string "\\`\n*" "\\& " (or contents ""))) + "\\end{frame}"))) + +(defun org-beamer--format-block (headline contents info) + "Format HEADLINE as a block. +CONTENTS holds the contents of the headline. INFO is a plist +used as a communication channel." + (let* ((column-width (org-element-property :BEAMER_COL headline)) + ;; ENVIRONMENT defaults to "block" if none is specified and + ;; there is no column specification. If there is a column + ;; specified but still no explicit environment, ENVIRONMENT + ;; is "column". + (environment (let ((env (org-element-property :BEAMER_ENV headline))) + (cond + ;; "block" is the fallback environment. + ((and (not env) (not column-width)) "block") + ;; "column" only. + ((not env) "column") + ;; Use specified environment. + (t env)))) + (raw-title (org-element-property :raw-value headline)) + (env-format + (cond ((member environment '("column" "columns")) nil) + ((assoc environment + (append org-beamer-environments-extra + org-beamer-environments-default))) + (t (user-error "Wrong block type at a headline named \"%s\"" + raw-title)))) + (title (org-export-data (org-element-property :title headline) info)) + (options (let ((options (org-element-property :BEAMER_OPT headline))) + (if (not options) "" + (org-beamer--normalize-argument options 'option)))) + ;; Start a "columns" environment when explicitly requested or + ;; when there is no previous headline or the previous + ;; headline do not have a BEAMER_column property. + (parent-env (org-element-property + :BEAMER_ENV (org-export-get-parent-headline headline))) + (start-columns-p + (or (equal environment "columns") + (and column-width + (not (and parent-env + (equal (downcase parent-env) "columns"))) + (or (org-export-first-sibling-p headline info) + (not (org-element-property + :BEAMER_COL + (org-export-get-previous-element + headline info))))))) + ;; End the "columns" environment when explicitly requested or + ;; when there is no next headline or the next headline do not + ;; have a BEAMER_column property. + (end-columns-p + (or (equal environment "columns") + (and column-width + (not (and parent-env + (equal (downcase parent-env) "columns"))) + (or (org-export-last-sibling-p headline info) + (not (org-element-property + :BEAMER_COL + (org-export-get-next-element headline info)))))))) + (concat + (when start-columns-p + ;; Column can accept options only when the environment is + ;; explicitly defined. + (if (not (equal environment "columns")) "\\begin{columns}\n" + (format "\\begin{columns}%s\n" options))) + (when column-width + (format "\\begin{column}%s{%s}\n" + ;; One can specify placement for column only when + ;; HEADLINE stands for a column on its own. + (if (equal environment "column") options "") + (format "%s\\textwidth" column-width))) + ;; Block's opening string. + (when (nth 2 env-format) + (concat + (org-fill-template + (nth 2 env-format) + (nconc + ;; If BEAMER_act property has its value enclosed in square + ;; brackets, it is a default overlay specification and + ;; overlay specification is empty. Otherwise, it is an + ;; overlay specification and the default one is nil. + (let ((action (org-element-property :BEAMER_ACT headline))) + (cond + ((not action) (list (cons "a" "") (cons "A" ""))) + ((string-match "\\`\\[.*\\]\\'" action) + (list + (cons "A" (org-beamer--normalize-argument action 'defaction)) + (cons "a" ""))) + (t + (list (cons "a" (org-beamer--normalize-argument action 'action)) + (cons "A" ""))))) + (list (cons "o" options) + (cons "h" title) + (cons "r" raw-title) + (cons "H" (if (equal raw-title "") "" + (format "{%s}" raw-title))) + (cons "U" (if (equal raw-title "") "" + (format "[%s]" raw-title)))))) + "\n")) + contents + ;; Block's closing string, if any. + (and (nth 3 env-format) (concat (nth 3 env-format) "\n")) + (when column-width "\\end{column}\n") + (when end-columns-p "\\end{columns}")))) + +(defun org-beamer-headline (headline contents info) + "Transcode HEADLINE element into Beamer code. +CONTENTS is the contents of the headline. INFO is a plist used +as a communication channel." + (unless (org-element-property :footnote-section-p headline) + (let ((level (org-export-get-relative-level headline info)) + (frame-level (org-beamer--frame-level headline info)) + (environment (let ((env (org-element-property :BEAMER_ENV headline))) + (or (org-string-nw-p env) "block")))) + (cond + ;; Case 1: Resume frame specified by "BEAMER_ref" property. + ((equal environment "againframe") + (let ((ref (org-element-property :BEAMER_REF headline))) + ;; Reference to frame being resumed is mandatory. Ignore + ;; the whole headline if it isn't provided. + (when (org-string-nw-p ref) + (concat "\\againframe" + ;; Overlay specification. + (let ((overlay (org-element-property :BEAMER_ACT headline))) + (when overlay + (org-beamer--normalize-argument + overlay + (if (string-match "^\\[.*\\]$" overlay) 'defaction + 'action)))) + ;; Options. + (let ((options (org-element-property :BEAMER_OPT headline))) + (when options + (org-beamer--normalize-argument options 'option))) + ;; Resolve reference provided by "BEAMER_ref" + ;; property. This is done by building a minimal fake + ;; link and calling the appropriate resolve function, + ;; depending on the reference syntax. + (let* ((type + (progn + (string-match "^\\(id:\\|#\\|\\*\\)?\\(.*\\)" ref) + (cond + ((or (not (match-string 1 ref)) + (equal (match-string 1 ref) "*")) 'fuzzy) + ((equal (match-string 1 ref) "id:") 'id) + (t 'custom-id)))) + (link (list 'link (list :path (match-string 2 ref)))) + (target (if (eq type 'fuzzy) + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + ;; Now use user-defined label provided in TARGET + ;; headline, or fallback to standard one. + (format "{%s}" (org-beamer--get-label target info))))))) + ;; Case 2: Creation of an appendix is requested. + ((equal environment "appendix") + (concat "\\appendix" + (org-element-property :BEAMER_ACT headline) + "\n" + (make-string (org-element-property :pre-blank headline) ?\n) + contents)) + ;; Case 3: Ignore heading. + ((equal environment "ignoreheading") + (concat (make-string (org-element-property :pre-blank headline) ?\n) + contents)) + ;; Case 4: HEADLINE is a note. + ((member environment '("note" "noteNH")) + (format "\\note{%s}" + (concat (and (equal environment "note") + (concat + (org-export-data + (org-element-property :title headline) info) + "\n")) + (org-trim contents)))) + ;; Case 5: HEADLINE is a frame. + ((= level frame-level) + (org-beamer--format-frame headline contents info)) + ;; Case 6: Regular section, extracted from + ;; `org-latex-classes'. + ((< level frame-level) + (org-beamer--format-section headline contents info)) + ;; Case 7: Otherwise, HEADLINE is a block. + (t (org-beamer--format-block headline contents info)))))) + + +;;;; Item + +(defun org-beamer-item (item contents info) + "Transcode an ITEM element into Beamer code. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let ((action (let ((first-element (car (org-element-contents item)))) + (and (eq (org-element-type first-element) 'paragraph) + (org-beamer--element-has-overlay-p first-element)))) + (output (org-export-with-backend 'latex item contents info))) + (if (or (not action) (not (string-match "\\\\item" output))) output + ;; If the item starts with a paragraph and that paragraph starts + ;; with an export snippet specifying an overlay, insert it after + ;; \item command. + (replace-match (concat "\\\\item" action) nil nil output)))) + + +;;;; Keyword + +(defun org-beamer-keyword (keyword contents info) + "Transcode a KEYWORD element into Beamer code. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + ;; Handle specifically BEAMER and TOC (headlines only) keywords. + ;; Otherwise, fallback to `latex' back-end. + (cond + ((equal key "BEAMER") value) + ((and (equal key "TOC") (string-match "\\<headlines\\>" value)) + (let ((depth (or (and (string-match "[0-9]+" value) + (string-to-number (match-string 0 value))) + (plist-get info :with-toc))) + (options (and (string-match "\\[.*?\\]" value) + (match-string 0 value)))) + (concat + (when (wholenump depth) (format "\\setcounter{tocdepth}{%s}\n" depth)) + "\\tableofcontents" options))) + (t (org-export-with-backend 'latex keyword contents info))))) + + +;;;; Link + +(defun org-beamer-link (link contents info) + "Transcode a LINK object into Beamer code. +CONTENTS is the description part of the link. INFO is a plist +used as a communication channel." + (let ((type (org-element-property :type link)) + (path (org-element-property :path link))) + ;; Use \hyperlink command for all internal links. + (cond + ((equal type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (if (not destination) contents + (format "\\hyperlink%s{%s}{%s}" + (or (org-beamer--element-has-overlay-p link) "") + (org-export-solidify-link-text + (org-element-property :value destination)) + contents)))) + ((and (member type '("custom-id" "fuzzy" "id")) + (let ((destination (if (string= type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (case (org-element-type destination) + (headline + (let ((label + (format "sec-%s" + (mapconcat + 'number-to-string + (org-export-get-headline-number + destination info) + "-")))) + (if (and (plist-get info :section-numbers) (not contents)) + (format "\\ref{%s}" label) + (format "\\hyperlink%s{%s}{%s}" + (or (org-beamer--element-has-overlay-p link) "") + label + contents)))) + (target + (let ((path (org-export-solidify-link-text path))) + (if (not contents) (format "\\ref{%s}" path) + (format "\\hyperlink%s{%s}{%s}" + (or (org-beamer--element-has-overlay-p link) "") + path + contents)))))))) + ;; Otherwise, use `latex' back-end. + (t (org-export-with-backend 'latex link contents info))))) + + +;;;; Plain List +;; +;; Plain lists support `:environment', `:overlay' and `:options' +;; attributes. + +(defun org-beamer-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element into Beamer code. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + (let* ((type (org-element-property :type plain-list)) + (attributes (org-combine-plists + (org-export-read-attribute :attr_latex plain-list) + (org-export-read-attribute :attr_beamer plain-list))) + (latex-type (let ((env (plist-get attributes :environment))) + (cond (env) + ((eq type 'ordered) "enumerate") + ((eq type 'descriptive) "description") + (t "itemize"))))) + (org-latex--wrap-label + plain-list + (format "\\begin{%s}%s%s\n%s\\end{%s}" + latex-type + ;; Default overlay specification, if any. + (org-beamer--normalize-argument + (or (plist-get attributes :overlay) "") + 'defaction) + ;; Second optional argument depends on the list type. + (org-beamer--normalize-argument + (or (plist-get attributes :options) "") + 'option) + ;; Eventually insert contents and close environment. + contents + latex-type)))) + + +;;;; Radio Target + +(defun org-beamer-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object into Beamer code. +TEXT is the text of the target. INFO is a plist holding +contextual information." + (format "\\hypertarget%s{%s}{%s}" + (or (org-beamer--element-has-overlay-p radio-target) "") + (org-export-solidify-link-text + (org-element-property :value radio-target)) + text)) + + +;;;; Target + +(defun org-beamer-target (target contents info) + "Transcode a TARGET object into Beamer code. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "\\label{%s}" + (org-export-solidify-link-text (org-element-property :value target)))) + + +;;;; Template +;; +;; Template used is similar to the one used in `latex' back-end, +;; excepted for the table of contents and Beamer themes. + +(defun org-beamer-template (contents info) + "Return complete document string after Beamer conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (let ((title (org-export-data (plist-get info :title) info))) + (concat + ;; 1. Time-stamp. + (and (plist-get info :time-stamp-file) + (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) + ;; 2. Document class and packages. + (let* ((class (plist-get info :latex-class)) + (class-options (plist-get info :latex-class-options)) + (header (nth 1 (assoc class org-latex-classes))) + (document-class-string + (and (stringp header) + (if (not class-options) header + (replace-regexp-in-string + "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" + class-options header t nil 1))))) + (if (not document-class-string) + (user-error "Unknown LaTeX class `%s'" class) + (org-latex-guess-babel-language + (org-latex-guess-inputenc + (org-element-normalize-string + (org-splice-latex-header + document-class-string + org-latex-default-packages-alist + org-latex-packages-alist nil + (concat (org-element-normalize-string + (plist-get info :latex-header)) + (org-element-normalize-string + (plist-get info :latex-header-extra)) + (plist-get info :beamer-header-extra))))) + info))) + ;; 3. Insert themes. + (let ((format-theme + (function + (lambda (prop command) + (let ((theme (plist-get info prop))) + (when theme + (concat command + (if (not (string-match "\\[.*\\]" theme)) + (format "{%s}\n" theme) + (format "%s{%s}\n" + (match-string 0 theme) + (org-trim + (replace-match "" nil nil theme))))))))))) + (mapconcat (lambda (args) (apply format-theme args)) + '((:beamer-theme "\\usetheme") + (:beamer-color-theme "\\usecolortheme") + (:beamer-font-theme "\\usefonttheme") + (:beamer-inner-theme "\\useinnertheme") + (:beamer-outer-theme "\\useoutertheme")) + "")) + ;; 4. Possibly limit depth for headline numbering. + (let ((sec-num (plist-get info :section-numbers))) + (when (integerp sec-num) + (format "\\setcounter{secnumdepth}{%d}\n" sec-num))) + ;; 5. Author. + (let ((author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth (org-export-data auth info))))) + (email (and (plist-get info :with-email) + (org-export-data (plist-get info :email) info)))) + (cond ((and author email (not (string= "" email))) + (format "\\author{%s\\thanks{%s}}\n" author email)) + (author (format "\\author{%s}\n" author)) + (t "\\author{}\n"))) + ;; 6. Date. + (let ((date (and (plist-get info :with-date) (org-export-get-date info)))) + (format "\\date{%s}\n" (org-export-data date info))) + ;; 7. Title + (format "\\title{%s}\n" title) + ;; 8. Hyperref options. + (when (plist-get info :latex-hyperref-p) + (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" + (or (plist-get info :keywords) "") + (or (plist-get info :description) "") + (if (not (plist-get info :with-creator)) "" + (plist-get info :creator)))) + ;; 9. Document start. + "\\begin{document}\n\n" + ;; 10. Title command. + (org-element-normalize-string + (cond ((string= "" title) nil) + ((not (stringp org-latex-title-command)) nil) + ((string-match "\\(?:[^%]\\|^\\)%s" + org-latex-title-command) + (format org-latex-title-command title)) + (t org-latex-title-command))) + ;; 11. Table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth + (concat + (format "\\begin{frame}%s{%s}\n" + (org-beamer--normalize-argument + org-beamer-outline-frame-options 'option) + org-beamer-outline-frame-title) + (when (wholenump depth) + (format "\\setcounter{tocdepth}{%d}\n" depth)) + "\\tableofcontents\n" + "\\end{frame}\n\n"))) + ;; 12. Document's body. + contents + ;; 13. Creator. + (let ((creator-info (plist-get info :with-creator))) + (cond + ((not creator-info) "") + ((eq creator-info 'comment) + (format "%% %s\n" (plist-get info :creator))) + (t (concat (plist-get info :creator) "\n")))) + ;; 14. Document end. + "\\end{document}"))) + + + +;;; Minor Mode + + +(defvar org-beamer-mode-map (make-sparse-keymap) + "The keymap for `org-beamer-mode'.") +(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment) + +;;;###autoload +(define-minor-mode org-beamer-mode + "Support for editing Beamer oriented Org mode files." + nil " Bm" 'org-beamer-mode-map) + +(when (fboundp 'font-lock-add-keywords) + (font-lock-add-keywords + 'org-mode + '((":\\(B_[a-z]+\\|BMCOL\\):" 1 'org-beamer-tag prepend)) + 'prepend)) + +(defface org-beamer-tag '((t (:box (:line-width 1 :color grey40)))) + "The special face for beamer tags." + :group 'org-export-beamer) + +(defun org-beamer-property-changed (property value) + "Track the BEAMER_env property with tags. +PROPERTY is the name of the modified property. VALUE is its new +value." + (cond + ((equal property "BEAMER_env") + (save-excursion + (org-back-to-heading t) + ;; Filter out Beamer-related tags and install environment tag. + (let ((tags (org-remove-if (lambda (x) (string-match "^B_" x)) + (org-get-tags))) + (env-tag (and (org-string-nw-p value) (concat "B_" value)))) + (org-set-tags-to (if env-tag (cons env-tag tags) tags)) + (when env-tag (org-toggle-tag env-tag 'on))))) + ((equal property "BEAMER_col") + (org-toggle-tag "BMCOL" (if (org-string-nw-p value) 'on 'off))))) + +(add-hook 'org-property-changed-functions 'org-beamer-property-changed) + +(defun org-beamer-allowed-property-values (property) + "Supply allowed values for PROPERTY." + (cond + ((and (equal property "BEAMER_env") + (not (org-entry-get nil (concat property "_ALL") 'inherit))) + ;; If no allowed values for BEAMER_env have been defined, + ;; supply all defined environments + (mapcar 'car (append org-beamer-environments-special + org-beamer-environments-extra + org-beamer-environments-default))) + ((and (equal property "BEAMER_col") + (not (org-entry-get nil (concat property "_ALL") 'inherit))) + ;; If no allowed values for BEAMER_col have been defined, + ;; supply some + (org-split-string org-beamer-column-widths " ")))) + +(add-hook 'org-property-allowed-value-functions + 'org-beamer-allowed-property-values) + + + +;;; Commands + +;;;###autoload +(defun org-beamer-export-as-latex + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer as a Beamer buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org BEAMER Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil." + (interactive) + (org-export-to-buffer 'beamer "*Org BEAMER Export*" + async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) + +;;;###autoload +(defun org-beamer-export-to-latex + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer as a Beamer presentation (tex). + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let ((file (org-export-output-file-name ".tex" subtreep))) + (org-export-to-file 'beamer file + async subtreep visible-only body-only ext-plist))) + +;;;###autoload +(defun org-beamer-export-to-pdf + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer as a Beamer presentation (PDF). + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return PDF file's name." + (interactive) + (let ((file (org-export-output-file-name ".tex" subtreep))) + (org-export-to-file 'beamer file + async subtreep visible-only body-only ext-plist + (lambda (file) (org-latex-compile file))))) + +;;;###autoload +(defun org-beamer-select-environment () + "Select the environment to be used by beamer for this entry. +While this uses (for convenience) a tag selection interface, the +result of this command will be that the BEAMER_env *property* of +the entry is set. + +In addition to this, the command will also set a tag as a visual +aid, but the tag does not have any semantic meaning." + (interactive) + ;; Make sure `org-beamer-environments-special' has a higher + ;; priority than `org-beamer-environments-extra'. + (let* ((envs (append org-beamer-environments-special + org-beamer-environments-extra + org-beamer-environments-default)) + (org-tag-alist + (append '((:startgroup)) + (mapcar (lambda (e) (cons (concat "B_" (car e)) + (string-to-char (nth 1 e)))) + envs) + '((:endgroup)) + '(("BMCOL" . ?|)))) + (org-tag-persistent-alist nil) + (org-use-fast-tag-selection t) + (org-fast-tag-selection-single-key t)) + (org-set-tags) + (let ((tags (or (ignore-errors (org-get-tags-string)) ""))) + (cond + ;; For a column, automatically ask for its width. + ((eq org-last-tag-selection-key ?|) + (if (string-match ":BMCOL:" tags) + (org-set-property "BEAMER_col" (read-string "Column width: ")) + (org-delete-property "BEAMER_col"))) + ;; For an "againframe" section, automatically ask for reference + ;; to resumed frame and overlay specifications. + ((eq org-last-tag-selection-key ?A) + (if (equal (org-entry-get nil "BEAMER_env") "againframe") + (progn (org-entry-delete nil "BEAMER_env") + (org-entry-delete nil "BEAMER_ref") + (org-entry-delete nil "BEAMER_act")) + (org-entry-put nil "BEAMER_env" "againframe") + (org-set-property + "BEAMER_ref" + (read-string "Frame reference (*Title, #custom-id, id:...): ")) + (org-set-property "BEAMER_act" + (read-string "Overlay specification: ")))) + ((string-match (concat ":B_\\(" (mapconcat 'car envs "\\|") "\\):") tags) + (org-entry-put nil "BEAMER_env" (match-string 1 tags))) + (t (org-entry-delete nil "BEAMER_env")))))) + +;;;###autoload +(defun org-beamer-insert-options-template (&optional kind) + "Insert a settings template, to make sure users do this right." + (interactive (progn + (message "Current [s]ubtree or [g]lobal?") + (if (eq (read-char-exclusive) ?g) (list 'global) + (list 'subtree)))) + (if (eq kind 'subtree) + (progn + (org-back-to-heading t) + (org-reveal) + (org-entry-put nil "EXPORT_LaTeX_CLASS" "beamer") + (org-entry-put nil "EXPORT_LaTeX_CLASS_OPTIONS" "[presentation]") + (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf") + (when org-beamer-column-view-format + (org-entry-put nil "COLUMNS" org-beamer-column-view-format)) + (org-entry-put nil "BEAMER_col_ALL" org-beamer-column-widths)) + (insert "#+LaTeX_CLASS: beamer\n") + (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n") + (when org-beamer-theme (insert "#+BEAMER_THEME: " org-beamer-theme "\n")) + (when org-beamer-column-view-format + (insert "#+COLUMNS: " org-beamer-column-view-format "\n")) + (insert "#+PROPERTY: BEAMER_col_ALL " org-beamer-column-widths "\n"))) + +;;;###autoload +(defun org-beamer-publish-to-latex (plist filename pub-dir) + "Publish an Org file to a Beamer presentation (LaTeX). + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'beamer filename ".tex" plist pub-dir)) + +;;;###autoload +(defun org-beamer-publish-to-pdf (plist filename pub-dir) + "Publish an Org file to a Beamer presentation (PDF, via LaTeX). + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + ;; Unlike to `org-beamer-publish-to-latex', PDF file is generated in + ;; working directory and then moved to publishing directory. + (org-publish-attachment + plist + (org-latex-compile + (org-publish-org-to + 'beamer filename ".tex" plist (file-name-directory filename))) + pub-dir)) + + +(provide 'ox-beamer) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-beamer.el ends here diff --git a/elpa/org-20150427/ox-html.el b/elpa/org-20150427/ox-html.el new file mode 100644 index 00000000..23498b26 --- /dev/null +++ b/elpa/org-20150427/ox-html.el @@ -0,0 +1,3438 @@ +;;; ox-html.el --- HTML Back-End for Org Export Engine + +;; Copyright (C) 2011-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik <carsten at orgmode dot org> +;; Jambunathan K <kjambunathan at gmail dot com> +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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: + +;; This library implements a HTML back-end for Org generic exporter. +;; See Org manual for more information. + +;;; Code: + +;;; Dependencies + +(require 'ox) +(require 'ox-publish) +(require 'format-spec) +(eval-when-compile (require 'cl) (require 'table nil 'noerror)) + + +;;; Function Declarations + +(declare-function org-id-find-id-file "org-id" (id)) +(declare-function htmlize-region "ext:htmlize" (beg end)) +(declare-function org-pop-to-buffer-same-window + "org-compat" (&optional buffer-or-name norecord label)) +(declare-function mm-url-decode-entities "mm-url" ()) + +;;; Define Back-End + +(org-export-define-backend 'html + '((bold . org-html-bold) + (center-block . org-html-center-block) + (clock . org-html-clock) + (code . org-html-code) + (drawer . org-html-drawer) + (dynamic-block . org-html-dynamic-block) + (entity . org-html-entity) + (example-block . org-html-example-block) + (export-block . org-html-export-block) + (export-snippet . org-html-export-snippet) + (fixed-width . org-html-fixed-width) + (footnote-definition . org-html-footnote-definition) + (footnote-reference . org-html-footnote-reference) + (headline . org-html-headline) + (horizontal-rule . org-html-horizontal-rule) + (inline-src-block . org-html-inline-src-block) + (inlinetask . org-html-inlinetask) + (inner-template . org-html-inner-template) + (italic . org-html-italic) + (item . org-html-item) + (keyword . org-html-keyword) + (latex-environment . org-html-latex-environment) + (latex-fragment . org-html-latex-fragment) + (line-break . org-html-line-break) + (link . org-html-link) + (paragraph . org-html-paragraph) + (plain-list . org-html-plain-list) + (plain-text . org-html-plain-text) + (planning . org-html-planning) + (property-drawer . org-html-property-drawer) + (quote-block . org-html-quote-block) + (quote-section . org-html-quote-section) + (radio-target . org-html-radio-target) + (section . org-html-section) + (special-block . org-html-special-block) + (src-block . org-html-src-block) + (statistics-cookie . org-html-statistics-cookie) + (strike-through . org-html-strike-through) + (subscript . org-html-subscript) + (superscript . org-html-superscript) + (table . org-html-table) + (table-cell . org-html-table-cell) + (table-row . org-html-table-row) + (target . org-html-target) + (template . org-html-template) + (timestamp . org-html-timestamp) + (underline . org-html-underline) + (verbatim . org-html-verbatim) + (verse-block . org-html-verse-block)) + :export-block "HTML" + :filters-alist '((:filter-options . org-html-infojs-install-script) + (:filter-final-output . org-html-final-function)) + :menu-entry + '(?h "Export to HTML" + ((?H "As HTML buffer" org-html-export-as-html) + (?h "As HTML file" org-html-export-to-html) + (?o "As HTML file and open" + (lambda (a s v b) + (if a (org-html-export-to-html t s v b) + (org-open-file (org-html-export-to-html nil s v b))))))) + :options-alist + '((:html-extension nil nil org-html-extension) + (:html-link-org-as-html nil nil org-html-link-org-files-as-html) + (:html-doctype "HTML_DOCTYPE" nil org-html-doctype) + (:html-container "HTML_CONTAINER" nil org-html-container-element) + (:html-html5-fancy nil "html5-fancy" org-html-html5-fancy) + (:html-link-use-abs-url nil "html-link-use-abs-url" org-html-link-use-abs-url) + (:html-link-home "HTML_LINK_HOME" nil org-html-link-home) + (:html-link-up "HTML_LINK_UP" nil org-html-link-up) + (:html-mathjax "HTML_MATHJAX" nil "" space) + (:html-postamble nil "html-postamble" org-html-postamble) + (:html-preamble nil "html-preamble" org-html-preamble) + (:html-head "HTML_HEAD" nil org-html-head newline) + (:html-head-extra "HTML_HEAD_EXTRA" nil org-html-head-extra newline) + (:html-head-include-default-style nil "html-style" org-html-head-include-default-style) + (:html-head-include-scripts nil "html-scripts" org-html-head-include-scripts) + (:html-table-attributes nil nil org-html-table-default-attributes) + (:html-table-row-tags nil nil org-html-table-row-tags) + (:html-xml-declaration nil nil org-html-xml-declaration) + (:html-inline-images nil nil org-html-inline-images) + (:infojs-opt "INFOJS_OPT" nil nil) + ;; Redefine regular options. + (:creator "CREATOR" nil org-html-creator-string) + (:with-latex nil "tex" org-html-with-latex) + ;; Retrieve LaTeX header for fragments. + (:latex-header "LATEX_HEADER" nil nil newline))) + + +;;; Internal Variables + +(defvar org-html-format-table-no-css) +(defvar htmlize-buffer-places) ; from htmlize.el + +(defvar org-html--pre/postamble-class "status" + "CSS class used for pre/postamble") + +(defconst org-html-doctype-alist + '(("html4-strict" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\" +\"http://www.w3.org/TR/html4/strict.dtd\">") + ("html4-transitional" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" +\"http://www.w3.org/TR/html4/loose.dtd\">") + ("html4-frameset" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\" +\"http://www.w3.org/TR/html4/frameset.dtd\">") + + ("xhtml-strict" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" +\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">") + ("xhtml-transitional" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" +\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">") + ("xhtml-frameset" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\" +\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">") + ("xhtml-11" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" +\"http://www.w3.org/TR/xhtml1/DTD/xhtml11.dtd\">") + + ("html5" . "<!DOCTYPE html>") + ("xhtml5" . "<!DOCTYPE html>")) + "An alist mapping (x)html flavors to specific doctypes.") + +(defconst org-html-html5-elements + '("article" "aside" "audio" "canvas" "details" "figcaption" + "figure" "footer" "header" "menu" "meter" "nav" "output" + "progress" "section" "video") + "New elements in html5. + +For blocks that should contain headlines, use the HTML_CONTAINER +property on the headline itself.") + +(defconst org-html-special-string-regexps + '(("\\\\-" . "­") ; shy + ("---\\([^-]\\)" . "—\\1") ; mdash + ("--\\([^-]\\)" . "–\\1") ; ndash + ("\\.\\.\\." . "…")) ; hellip + "Regular expressions for special string conversion.") + +(defconst org-html-scripts + "<script type=\"text/javascript\"> +/* +@licstart The following is the entire license notice for the +JavaScript code in this tag. + +Copyright (C) 2012-2013 Free Software Foundation, Inc. + +The JavaScript code in this tag is free software: you can +redistribute it and/or modify it under the terms of the GNU +General Public License (GNU GPL) as published by the Free Software +Foundation, either version 3 of the License, or (at your option) +any later version. The code is distributed WITHOUT ANY WARRANTY; +without even the implied warranty of MERCHANTABILITY or FITNESS +FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. + +As additional permission under GNU GPL version 3 section 7, you +may distribute non-source (e.g., minimized or compacted) forms of +that code without the copy of the GNU GPL normally required by +section 4, provided you include this license notice and a URL +through which recipients can access the Corresponding Source. + + +@licend The above is the entire license notice +for the JavaScript code in this tag. +*/ +<!--/*--><![CDATA[/*><!--*/ + function CodeHighlightOn(elem, id) + { + var target = document.getElementById(id); + if(null != target) { + elem.cacheClassElem = elem.className; + elem.cacheClassTarget = target.className; + target.className = \"code-highlighted\"; + elem.className = \"code-highlighted\"; + } + } + function CodeHighlightOff(elem, id) + { + var target = document.getElementById(id); + if(elem.cacheClassElem) + elem.className = elem.cacheClassElem; + if(elem.cacheClassTarget) + target.className = elem.cacheClassTarget; + } +/*]]>*///--> +</script>" + "Basic JavaScript that is needed by HTML files produced by Org mode.") + +(defconst org-html-style-default + "<style type=\"text/css\"> + <!--/*--><![CDATA[/*><!--*/ + .title { text-align: center; } + .todo { font-family: monospace; color: red; } + .done { color: green; } + .tag { background-color: #eee; font-family: monospace; + padding: 2px; font-size: 80%; font-weight: normal; } + .timestamp { color: #bebebe; } + .timestamp-kwd { color: #5f9ea0; } + .right { margin-left: auto; margin-right: 0px; text-align: right; } + .left { margin-left: 0px; margin-right: auto; text-align: left; } + .center { margin-left: auto; margin-right: auto; text-align: center; } + .underline { text-decoration: underline; } + #postamble p, #preamble p { font-size: 90%; margin: .2em; } + p.verse { margin-left: 3%; } + pre { + border: 1px solid #ccc; + box-shadow: 3px 3px 3px #eee; + padding: 8pt; + font-family: monospace; + overflow: auto; + margin: 1.2em; + } + pre.src { + position: relative; + overflow: visible; + padding-top: 1.2em; + } + pre.src:before { + display: none; + position: absolute; + background-color: white; + top: -10px; + right: 10px; + padding: 3px; + border: 1px solid black; + } + pre.src:hover:before { display: inline;} + pre.src-sh:before { content: 'sh'; } + pre.src-bash:before { content: 'sh'; } + pre.src-emacs-lisp:before { content: 'Emacs Lisp'; } + pre.src-R:before { content: 'R'; } + pre.src-perl:before { content: 'Perl'; } + pre.src-java:before { content: 'Java'; } + pre.src-sql:before { content: 'SQL'; } + + table { border-collapse:collapse; } + caption.t-above { caption-side: top; } + caption.t-bottom { caption-side: bottom; } + td, th { vertical-align:top; } + th.right { text-align: center; } + th.left { text-align: center; } + th.center { text-align: center; } + td.right { text-align: right; } + td.left { text-align: left; } + td.center { text-align: center; } + dt { font-weight: bold; } + .footpara:nth-child(2) { display: inline; } + .footpara { display: block; } + .footdef { margin-bottom: 1em; } + .figure { padding: 1em; } + .figure p { text-align: center; } + .inlinetask { + padding: 10px; + border: 2px solid gray; + margin: 10px; + background: #ffffcc; + } + #org-div-home-and-up + { text-align: right; font-size: 70%; white-space: nowrap; } + textarea { overflow-x: auto; } + .linenr { font-size: smaller } + .code-highlighted { background-color: #ffff00; } + .org-info-js_info-navigation { border-style: none; } + #org-info-js_console-label + { font-size: 10px; font-weight: bold; white-space: nowrap; } + .org-info-js_search-highlight + { background-color: #ffff00; color: #000000; font-weight: bold; } + /*]]>*/--> +</style>" + "The default style specification for exported HTML files. +You can use `org-html-head' and `org-html-head-extra' to add to +this style. If you don't want to include this default style, +customize `org-html-head-include-default-style'.") + + +;;; User Configuration Variables + +(defgroup org-export-html nil + "Options for exporting Org mode files to HTML." + :tag "Org Export HTML" + :group 'org-export) + +;;;; Handle infojs + +(defvar org-html-infojs-opts-table + '((path PATH "http://orgmode.org/org-info.js") + (view VIEW "info") + (toc TOC :with-toc) + (ftoc FIXED_TOC "0") + (tdepth TOC_DEPTH "max") + (sdepth SECTION_DEPTH "max") + (mouse MOUSE_HINT "underline") + (buttons VIEW_BUTTONS "0") + (ltoc LOCAL_TOC "1") + (up LINK_UP :html-link-up) + (home LINK_HOME :html-link-home)) + "JavaScript options, long form for script, default values.") + +(defcustom org-html-use-infojs 'when-configured + "Non-nil when Sebastian Rose's Java Script org-info.js should be active. +This option can be nil or t to never or always use the script. +It can also be the symbol `when-configured', meaning that the +script will be linked into the export file if and only if there +is a \"#+INFOJS_OPT:\" line in the buffer. See also the variable +`org-html-infojs-options'." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Never" nil) + (const :tag "When configured in buffer" when-configured) + (const :tag "Always" t))) + +(defcustom org-html-infojs-options + (mapcar (lambda (x) (cons (car x) (nth 2 x))) org-html-infojs-opts-table) + "Options settings for the INFOJS JavaScript. +Each of the options must have an entry in `org-html-infojs-opts-table'. +The value can either be a string that will be passed to the script, or +a property. This property is then assumed to be a property that is defined +by the Export/Publishing setup of Org. +The `sdepth' and `tdepth' parameters can also be set to \"max\", which +means to use the maximum value consistent with other options." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type + `(set :greedy t :inline t + ,@(mapcar + (lambda (x) + (list 'cons (list 'const (car x)) + '(choice + (symbol :tag "Publishing/Export property") + (string :tag "Value")))) + org-html-infojs-opts-table))) + +(defcustom org-html-infojs-template + "<script type=\"text/javascript\" src=\"%SCRIPT_PATH\"> +/** + * + * @source: %SCRIPT_PATH + * + * @licstart The following is the entire license notice for the + * JavaScript code in %SCRIPT_PATH. + * + * Copyright (C) 2012-2013 Free Software Foundation, Inc. + * + * + * The JavaScript code in this tag is free software: you can + * redistribute it and/or modify it under the terms of the GNU + * General Public License (GNU GPL) as published by the Free Software + * Foundation, either version 3 of the License, or (at your option) + * any later version. The code is distributed WITHOUT ANY WARRANTY; + * without even the implied warranty of MERCHANTABILITY or FITNESS + * FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. + * + * As additional permission under GNU GPL version 3 section 7, you + * may distribute non-source (e.g., minimized or compacted) forms of + * that code without the copy of the GNU GPL normally required by + * section 4, provided you include this license notice and a URL + * through which recipients can access the Corresponding Source. + * + * @licend The above is the entire license notice + * for the JavaScript code in %SCRIPT_PATH. + * + */ +</script> + +<script type=\"text/javascript\"> + +/* +@licstart The following is the entire license notice for the +JavaScript code in this tag. + +Copyright (C) 2012-2013 Free Software Foundation, Inc. + +The JavaScript code in this tag is free software: you can +redistribute it and/or modify it under the terms of the GNU +General Public License (GNU GPL) as published by the Free Software +Foundation, either version 3 of the License, or (at your option) +any later version. The code is distributed WITHOUT ANY WARRANTY; +without even the implied warranty of MERCHANTABILITY or FITNESS +FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. + +As additional permission under GNU GPL version 3 section 7, you +may distribute non-source (e.g., minimized or compacted) forms of +that code without the copy of the GNU GPL normally required by +section 4, provided you include this license notice and a URL +through which recipients can access the Corresponding Source. + + +@licend The above is the entire license notice +for the JavaScript code in this tag. +*/ + +<!--/*--><![CDATA[/*><!--*/ +%MANAGER_OPTIONS +org_html_manager.setup(); // activate after the parameters are set +/*]]>*///--> +</script>" + "The template for the export style additions when org-info.js is used. +Option settings will replace the %MANAGER-OPTIONS cookie." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defun org-html-infojs-install-script (exp-plist backend) + "Install script in export options when appropriate. +EXP-PLIST is a plist containing export options. BACKEND is the +export back-end currently used." + (unless (or (memq 'body-only (plist-get exp-plist :export-options)) + (not org-html-use-infojs) + (and (eq org-html-use-infojs 'when-configured) + (or (not (plist-get exp-plist :infojs-opt)) + (string= "" (plist-get exp-plist :infojs-opt)) + (string-match "\\<view:nil\\>" + (plist-get exp-plist :infojs-opt))))) + (let* ((template org-html-infojs-template) + (ptoc (plist-get exp-plist :with-toc)) + (hlevels (plist-get exp-plist :headline-levels)) + (sdepth hlevels) + (tdepth (if (integerp ptoc) (min ptoc hlevels) hlevels)) + (options (plist-get exp-plist :infojs-opt)) + (table org-html-infojs-opts-table) + style) + (dolist (entry table) + (let* ((opt (car entry)) + (var (nth 1 entry)) + ;; Compute default values for script option OPT from + ;; `org-html-infojs-options' variable. + (default + (let ((default (cdr (assq opt org-html-infojs-options)))) + (if (and (symbolp default) (not (memq default '(t nil)))) + (plist-get exp-plist default) + default))) + ;; Value set through INFOJS_OPT keyword has precedence + ;; over the default one. + (val (if (and options + (string-match (format "\\<%s:\\(\\S-+\\)" opt) + options)) + (match-string 1 options) + default))) + (case opt + (path (setq template + (replace-regexp-in-string + "%SCRIPT_PATH" val template t t))) + (sdepth (when (integerp (read val)) + (setq sdepth (min (read val) sdepth)))) + (tdepth (when (integerp (read val)) + (setq tdepth (min (read val) tdepth)))) + (otherwise (setq val + (cond + ((or (eq val t) (equal val "t")) "1") + ((or (eq val nil) (equal val "nil")) "0") + ((stringp val) val) + (t (format "%s" val)))) + (push (cons var val) style))))) + ;; Now we set the depth of the *generated* TOC to SDEPTH, + ;; because the toc will actually determine the splitting. How + ;; much of the toc will actually be displayed is governed by the + ;; TDEPTH option. + (setq exp-plist (plist-put exp-plist :with-toc sdepth)) + ;; The table of contents should not show more sections than we + ;; generate. + (setq tdepth (min tdepth sdepth)) + (push (cons "TOC_DEPTH" tdepth) style) + ;; Build style string. + (setq style (mapconcat + (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");" + (car x) + (cdr x))) + style "\n")) + (when (and style (> (length style) 0)) + (and (string-match "%MANAGER_OPTIONS" template) + (setq style (replace-match style t t template)) + (setq exp-plist + (plist-put + exp-plist :html-head-extra + (concat (or (plist-get exp-plist :html-head-extra) "") + "\n" + style))))) + ;; This script absolutely needs the table of contents, so we + ;; change that setting. + (unless (plist-get exp-plist :with-toc) + (setq exp-plist (plist-put exp-plist :with-toc t))) + ;; Return the modified property list. + exp-plist))) + +;;;; Bold, etc. + +(defcustom org-html-text-markup-alist + '((bold . "<b>%s</b>") + (code . "<code>%s</code>") + (italic . "<i>%s</i>") + (strike-through . "<del>%s</del>") + (underline . "<span class=\"underline\">%s</span>") + (verbatim . "<code>%s</code>")) + "Alist of HTML expressions to convert text markup. + +The key must be a symbol among `bold', `code', `italic', +`strike-through', `underline' and `verbatim'. The value is +a formatting string to wrap fontified text with. + +If no association can be found for a given markup, text will be +returned as-is." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(alist :key-type (symbol :tag "Markup type") + :value-type (string :tag "Format string")) + :options '(bold code italic strike-through underline verbatim)) + +(defcustom org-html-indent nil + "Non-nil means to indent the generated HTML. +Warning: non-nil may break indentation of source code blocks." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-html-use-unicode-chars nil + "Non-nil means to use unicode characters instead of HTML entities." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +;;;; Drawers + +(defcustom org-html-format-drawer-function + (lambda (name contents) contents) + "Function called to format a drawer in HTML code. + +The function must accept two parameters: + NAME the drawer name, like \"LOGBOOK\" + CONTENTS the contents of the drawer. + +The function should return the string to be exported. + +For example, the variable could be set to the following function +in order to mimic default behaviour: + +The default value simply returns the value of CONTENTS." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + +;;;; Footnotes + +(defcustom org-html-footnotes-section "<div id=\"footnotes\"> +<h2 class=\"footnotes\">%s: </h2> +<div id=\"text-footnotes\"> +%s +</div> +</div>" + "Format for the footnotes section. +Should contain a two instances of %s. The first will be replaced with the +language-specific word for \"Footnotes\", the second one will be replaced +by the footnotes themselves." + :group 'org-export-html + :type 'string) + +(defcustom org-html-footnote-format "<sup>%s</sup>" + "The format for the footnote reference. +%s will be replaced by the footnote reference itself." + :group 'org-export-html + :type 'string) + +(defcustom org-html-footnote-separator "<sup>, </sup>" + "Text used to separate footnotes." + :group 'org-export-html + :type 'string) + +;;;; Headline + +(defcustom org-html-toplevel-hlevel 2 + "The <H> level for level 1 headings in HTML export. +This is also important for the classes that will be wrapped around headlines +and outline structure. If this variable is 1, the top-level headlines will +be <h1>, and the corresponding classes will be outline-1, section-number-1, +and outline-text-1. If this is 2, all of these will get a 2 instead. +The default for this variable is 2, because we use <h1> for formatting the +document title." + :group 'org-export-html + :type 'integer) + +(defcustom org-html-format-headline-function 'ignore + "Function to format headline text. + +This function will be called with 5 arguments: +TODO the todo keyword (string or nil). +TODO-TYPE the type of todo (symbol: `todo', `done', nil) +PRIORITY the priority of the headline (integer or nil) +TEXT the main headline text (string). +TAGS the tags (string or nil). + +The function result will be used in the section format string." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + +;;;; HTML-specific + +(defcustom org-html-allow-name-attribute-in-anchors t + "When nil, do not set \"name\" attribute in anchors. +By default, anchors are formatted with both \"id\" and \"name\" +attributes, when appropriate." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +;;;; Inlinetasks + +(defcustom org-html-format-inlinetask-function 'ignore + "Function called to format an inlinetask in HTML code. + +The function must accept six parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a list of strings. + CONTENTS the contents of the inlinetask, as a string. + +The function should return the string to be exported." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + +;;;; LaTeX + +(defcustom org-html-with-latex org-export-with-latex + "Non-nil means process LaTeX math snippets. + +When set, the exporter will process LaTeX environments and +fragments. + +This option can also be set with the +OPTIONS line, +e.g. \"tex:mathjax\". Allowed values are: + +nil Ignore math snippets. +`verbatim' Keep everything in verbatim +`dvipng' Process the LaTeX fragments to images. This will also + include processing of non-math environments. +`imagemagick' Convert the LaTeX fragments to pdf files and use + imagemagick to convert pdf files to png files. +`mathjax' Do MathJax preprocessing and arrange for MathJax.js to + be loaded. +t Synonym for `mathjax'." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Do not process math in any way" nil) + (const :tag "Use dvipng to make images" dvipng) + (const :tag "Use imagemagick to make images" imagemagick) + (const :tag "Use MathJax to display math" mathjax) + (const :tag "Leave math verbatim" verbatim))) + +;;;; Links :: Generic + +(defcustom org-html-link-org-files-as-html t + "Non-nil means make file links to `file.org' point to `file.html'. +When `org-mode' is exporting an `org-mode' file to HTML, links to +non-html files are directly put into a href tag in HTML. +However, links to other Org-mode files (recognized by the +extension `.org.) should become links to the corresponding html +file, assuming that the linked `org-mode' file will also be +converted to HTML. +When nil, the links still point to the plain `.org' file." + :group 'org-export-html + :type 'boolean) + +;;;; Links :: Inline images + +(defcustom org-html-inline-images t + "Non-nil means inline images into exported HTML pages. +This is done using an <img> tag. When nil, an anchor with href is used to +link to the image." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.1") + :type 'boolean) + +(defcustom org-html-inline-image-rules + '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") + ("http" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") + ("https" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")) + "Rules characterizing image files that can be inlined into HTML. +A rule consists in an association whose key is the type of link +to consider, and value is a regexp that will be matched against +link's path." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(alist :key-type (string :tag "Type") + :value-type (regexp :tag "Path"))) + +;;;; Plain Text + +(defcustom org-html-protect-char-alist + '(("&" . "&") + ("<" . "<") + (">" . ">")) + "Alist of characters to be converted by `org-html-protect'." + :group 'org-export-html + :type '(repeat (cons (string :tag "Character") + (string :tag "HTML equivalent")))) + +;;;; Src Block + +(defcustom org-html-htmlize-output-type 'inline-css + "Output type to be used by htmlize when formatting code snippets. +Choices are `css', to export the CSS selectors only, or `inline-css', to +export the CSS attribute values inline in the HTML. We use as default +`inline-css', in order to make the resulting HTML self-containing. + +However, this will fail when using Emacs in batch mode for export, because +then no rich font definitions are in place. It will also not be good if +people with different Emacs setup contribute HTML files to a website, +because the fonts will represent the individual setups. In these cases, +it is much better to let Org/Htmlize assign classes only, and to use +a style file to define the look of these classes. +To get a start for your css file, start Emacs session and make sure that +all the faces you are interested in are defined, for example by loading files +in all modes you want. Then, use the command +\\[org-html-htmlize-generate-css] to extract class definitions." + :group 'org-export-html + :type '(choice (const css) (const inline-css))) + +(defcustom org-html-htmlize-font-prefix "org-" + "The prefix for CSS class names for htmlize font specifications." + :group 'org-export-html + :type 'string) + +;;;; Table + +(defcustom org-html-table-default-attributes + '(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups" :frame "hsides") + "Default attributes and values which will be used in table tags. +This is a plist where attributes are symbols, starting with +colons, and values are strings. + +When exporting to HTML5, these values will be disregarded." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(plist :key-type (symbol :tag "Property") + :value-type (string :tag "Value"))) + +(defcustom org-html-table-header-tags '("<th scope=\"%s\"%s>" . "</th>") + "The opening tag for table header fields. +This is customizable so that alignment options can be specified. +The first %s will be filled with the scope of the field, either row or col. +The second %s will be replaced by a style entry to align the field. +See also the variable `org-html-table-use-header-tags-for-first-column'. +See also the variable `org-html-table-align-individual-fields'." + :group 'org-export-html + :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) + +(defcustom org-html-table-data-tags '("<td%s>" . "</td>") + "The opening tag for table data fields. +This is customizable so that alignment options can be specified. +The first %s will be filled with the scope of the field, either row or col. +The second %s will be replaced by a style entry to align the field. +See also the variable `org-html-table-align-individual-fields'." + :group 'org-export-html + :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) + +(defcustom org-html-table-row-tags '("<tr>" . "</tr>") + "The opening and ending tags for table rows. +This is customizable so that alignment options can be specified. +Instead of strings, these can be Lisp forms that will be +evaluated for each row in order to construct the table row tags. + +During evaluation, these variables will be dynamically bound so that +you can reuse them: + + `row-number': row number (0 is the first row) + `rowgroup-number': group number of current row + `start-rowgroup-p': non-nil means the row starts a group + `end-rowgroup-p': non-nil means the row ends a group + `top-row-p': non-nil means this is the top row + `bottom-row-p': non-nil means this is the bottom row + +For example: + +\(setq org-html-table-row-tags + (cons '(cond (top-row-p \"<tr class=\\\"tr-top\\\">\") + (bottom-row-p \"<tr class=\\\"tr-bottom\\\">\") + (t (if (= (mod row-number 2) 1) + \"<tr class=\\\"tr-odd\\\">\" + \"<tr class=\\\"tr-even\\\">\"))) + \"</tr>\")) + +will use the \"tr-top\" and \"tr-bottom\" classes for the top row +and the bottom row, and otherwise alternate between \"tr-odd\" and +\"tr-even\" for odd and even rows." + :group 'org-export-html + :type '(cons + (choice :tag "Opening tag" + (string :tag "Specify") + (sexp)) + (choice :tag "Closing tag" + (string :tag "Specify") + (sexp)))) + +(defcustom org-html-table-align-individual-fields t + "Non-nil means attach style attributes for alignment to each table field. +When nil, alignment will only be specified in the column tags, but this +is ignored by some browsers (like Firefox, Safari). Opera does it right +though." + :group 'org-export-html + :type 'boolean) + +(defcustom org-html-table-use-header-tags-for-first-column nil + "Non-nil means format column one in tables with header tags. +When nil, also column one will use data tags." + :group 'org-export-html + :type 'boolean) + +(defcustom org-html-table-caption-above t + "When non-nil, place caption string at the beginning of the table. +Otherwise, place it near the end." + :group 'org-export-html + :type 'boolean) + +;;;; Tags + +(defcustom org-html-tag-class-prefix "" + "Prefix to class names for TODO keywords. +Each tag gets a class given by the tag itself, with this prefix. +The default prefix is empty because it is nice to just use the keyword +as a class name. But if you get into conflicts with other, existing +CSS classes, then this prefix can be very useful." + :group 'org-export-html + :type 'string) + +;;;; Template :: Generic + +(defcustom org-html-extension "html" + "The extension for exported HTML files." + :group 'org-export-html + :type 'string) + +(defcustom org-html-xml-declaration + '(("html" . "<?xml version=\"1.0\" encoding=\"%s\"?>") + ("php" . "<?php echo \"<?xml version=\\\"1.0\\\" encoding=\\\"%s\\\" ?>\"; ?>")) + "The extension for exported HTML files. +%s will be replaced with the charset of the exported file. +This may be a string, or an alist with export extensions +and corresponding declarations. + +This declaration only applies when exporting to XHTML." + :group 'org-export-html + :type '(choice + (string :tag "Single declaration") + (repeat :tag "Dependent on extension" + (cons (string :tag "Extension") + (string :tag "Declaration"))))) + +(defcustom org-html-coding-system 'utf-8 + "Coding system for HTML export. +Use utf-8 as the default value." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'coding-system) + +(defcustom org-html-doctype "xhtml-strict" + "Document type definition to use for exported HTML files. +Can be set with the in-buffer HTML_DOCTYPE property or for +publishing, with :html-doctype." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-html-html5-fancy nil + "Non-nil means using new HTML5 elements. +This variable is ignored for anything other than HTML5 export. + +For compatibility with Internet Explorer, it's probably a good +idea to download some form of the html5shiv (for instance +https://code.google.com/p/html5shiv/) and add it to your +HTML_HEAD_EXTRA, so that your pages don't break for users of IE +versions 8 and below." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-html-container-element "div" + "HTML element to use for wrapping top level sections. +Can be set with the in-buffer HTML_CONTAINER property or for +publishing, with :html-container. + +Note that changing the default will prevent you from using +org-info.js for your website." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-html-divs + '((preamble "div" "preamble") + (content "div" "content") + (postamble "div" "postamble")) + "Alist of the three section elements for HTML export. +The car of each entry is one of 'preamble, 'content or 'postamble. +The cdrs of each entry are the ELEMENT_TYPE and ID for each +section of the exported document. + +Note that changing the default will prevent you from using +org-info.js for your website." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(list :greedy t + (list :tag "Preamble" + (const :format "" preamble) + (string :tag "element") (string :tag " id")) + (list :tag "Content" + (const :format "" content) + (string :tag "element") (string :tag " id")) + (list :tag "Postamble" (const :format "" postamble) + (string :tag " id") (string :tag "element")))) + +(defcustom org-html-metadata-timestamp-format "%Y-%m-%d %a %H:%M" + "Format used for timestamps in preamble, postamble and metadata. +See `format-time-string' for more information on its components." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +;;;; Template :: Mathjax + +(defcustom org-html-mathjax-options + '((path "http://orgmode.org/mathjax/MathJax.js") + (scale "100") + (align "center") + (indent "2em") + (mathml nil)) + "Options for MathJax setup. + +path The path where to find MathJax +scale Scaling for the HTML-CSS backend, usually between 100 and 133 +align How to align display math: left, center, or right +indent If align is not center, how far from the left/right side? +mathml Should a MathML player be used if available? + This is faster and reduces bandwidth use, but currently + sometimes has lower spacing quality. Therefore, the default is + nil. When browsers get better, this switch can be flipped. + +You can also customize this for each buffer, using something like + +#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\"" + :group 'org-export-html + :type '(list :greedy t + (list :tag "path (the path from where to load MathJax.js)" + (const :format " " path) (string)) + (list :tag "scale (scaling for the displayed math)" + (const :format " " scale) (string)) + (list :tag "align (alignment of displayed equations)" + (const :format " " align) (string)) + (list :tag "indent (indentation with left or right alignment)" + (const :format " " indent) (string)) + (list :tag "mathml (should MathML display be used is possible)" + (const :format " " mathml) (boolean)))) + +(defcustom org-html-mathjax-template + "<script type=\"text/javascript\" src=\"%PATH\"></script> +<script type=\"text/javascript\"> +<!--/*--><![CDATA[/*><!--*/ + MathJax.Hub.Config({ + // Only one of the two following lines, depending on user settings + // First allows browser-native MathML display, second forces HTML/CSS + :MMLYES: config: [\"MMLorHTML.js\"], jax: [\"input/TeX\"], + :MMLNO: jax: [\"input/TeX\", \"output/HTML-CSS\"], + extensions: [\"tex2jax.js\",\"TeX/AMSmath.js\",\"TeX/AMSsymbols.js\", + \"TeX/noUndefined.js\"], + tex2jax: { + inlineMath: [ [\"\\\\(\",\"\\\\)\"] ], + displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"], [\"\\\\begin{displaymath}\",\"\\\\end{displaymath}\"] ], + skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"], + ignoreClass: \"tex2jax_ignore\", + processEscapes: false, + processEnvironments: true, + preview: \"TeX\" + }, + showProcessingMessages: true, + displayAlign: \"%ALIGN\", + displayIndent: \"%INDENT\", + + \"HTML-CSS\": { + scale: %SCALE, + availableFonts: [\"STIX\",\"TeX\"], + preferredFont: \"TeX\", + webFont: \"TeX\", + imageFont: \"TeX\", + showMathMenu: true, + }, + MMLorHTML: { + prefer: { + MSIE: \"MML\", + Firefox: \"MML\", + Opera: \"HTML\", + other: \"HTML\" + } + } + }); +/*]]>*///--> +</script>" + "The MathJax setup for XHTML files." + :group 'org-export-html + :type 'string) + +;;;; Template :: Postamble + +(defcustom org-html-postamble 'auto + "Non-nil means insert a postamble in HTML export. + +When set to 'auto, check against the +`org-export-with-author/email/creator/date' variables to set the +content of the postamble. When set to a string, use this string +as the postamble. When t, insert a string as defined by the +formatting string in `org-html-postamble-format'. + +When set to a function, apply this function and insert the +returned string. The function takes the property list of export +options as its only argument. + +Setting :html-postamble in publishing projects will take +precedence over this variable." + :group 'org-export-html + :type '(choice (const :tag "No postamble" nil) + (const :tag "Auto postamble" auto) + (const :tag "Default formatting string" t) + (string :tag "Custom formatting string") + (function :tag "Function (must return a string)"))) + +(defcustom org-html-postamble-format + '(("en" "<p class=\"author\">Author: %a (%e)</p> +<p class=\"date\">Date: %d</p> +<p class=\"creator\">%c</p> +<p class=\"validation\">%v</p>")) + "Alist of languages and format strings for the HTML postamble. + +The first element of each list is the language code, as used for +the LANGUAGE keyword. See `org-export-default-language'. + +The second element of each list is a format string to format the +postamble itself. This format string can contain these elements: + + %t stands for the title. + %a stands for the author's name. + %e stands for the author's email. + %d stands for the date. + %c will be replaced by `org-html-creator-string'. + %v will be replaced by `org-html-validation-link'. + %T will be replaced by the export time. + %C will be replaced by the last modification time. + +If you need to use a \"%\" character, you need to escape it +like that: \"%%\"." + :group 'org-export-html + :type '(repeat + (list (string :tag "Language") + (string :tag "Format string")))) + +(defcustom org-html-validation-link + "<a href=\"http://validator.w3.org/check?uri=referer\">Validate</a>" + "Link to HTML validation service." + :group 'org-export-html + :type 'string) + +(defcustom org-html-creator-string + (format "<a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> %s (<a href=\"http://orgmode.org\">Org</a> mode %s)" + emacs-version + (if (fboundp 'org-version) (org-version) "unknown version")) + "Information about the creator of the HTML document. +This option can also be set on with the CREATOR keyword." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type '(string :tag "Creator string")) + +;;;; Template :: Preamble + +(defcustom org-html-preamble t + "Non-nil means insert a preamble in HTML export. + +When t, insert a string as defined by the formatting string in +`org-html-preamble-format'. When set to a string, use this +formatting string instead (see `org-html-postamble-format' for an +example of such a formatting string). + +When set to a function, apply this function and insert the +returned string. The function takes the property list of export +options as its only argument. + +Setting :html-preamble in publishing projects will take +precedence over this variable." + :group 'org-export-html + :type '(choice (const :tag "No preamble" nil) + (const :tag "Default preamble" t) + (string :tag "Custom formatting string") + (function :tag "Function (must return a string)"))) + +(defcustom org-html-preamble-format '(("en" "")) + "Alist of languages and format strings for the HTML preamble. + +The first element of each list is the language code, as used for +the LANGUAGE keyword. See `org-export-default-language'. + +The second element of each list is a format string to format the +preamble itself. This format string can contain these elements: + + %t stands for the title. + %a stands for the author's name. + %e stands for the author's email. + %d stands for the date. + %c will be replaced by `org-html-creator-string'. + %v will be replaced by `org-html-validation-link'. + %T will be replaced by the export time. + %C will be replaced by the last modification time. + +If you need to use a \"%\" character, you need to escape it +like that: \"%%\". + +See the default value of `org-html-postamble-format' for an +example." + :group 'org-export-html + :type '(repeat + (list (string :tag "Language") + (string :tag "Format string")))) + +(defcustom org-html-link-up "" + "Where should the \"UP\" link of exported HTML pages lead?" + :group 'org-export-html + :type '(string :tag "File or URL")) + +(defcustom org-html-link-home "" + "Where should the \"HOME\" link of exported HTML pages lead?" + :group 'org-export-html + :type '(string :tag "File or URL")) + +(defcustom org-html-link-use-abs-url nil + "Should we prepend relative links with HTML_LINK_HOME?" + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.1") + :type 'boolean) + +(defcustom org-html-home/up-format + "<div id=\"org-div-home-and-up\"> + <a accesskey=\"h\" href=\"%s\"> UP </a> + | + <a accesskey=\"H\" href=\"%s\"> HOME </a> +</div>" + "Snippet used to insert the HOME and UP links. +This is a format string, the first %s will receive the UP link, +the second the HOME link. If both `org-html-link-up' and +`org-html-link-home' are empty, the entire snippet will be +ignored." + :group 'org-export-html + :type 'string) + +;;;; Template :: Scripts + +(define-obsolete-variable-alias + 'org-html-style-include-scripts 'org-html-head-include-scripts "24.4") +(defcustom org-html-head-include-scripts t + "Non-nil means include the JavaScript snippets in exported HTML files. +The actual script is defined in `org-html-scripts' and should +not be modified." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +;;;; Template :: Styles + +(define-obsolete-variable-alias + 'org-html-style-include-default 'org-html-head-include-default-style "24.4") +(defcustom org-html-head-include-default-style t + "Non-nil means include the default style in exported HTML files. +The actual style is defined in `org-html-style-default' and +should not be modified. Use `org-html-head' to use your own +style information." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) +;;;###autoload +(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp) + +(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4") +(defcustom org-html-head "" + "Org-wide head definitions for exported HTML files. + +This variable can contain the full HTML structure to provide a +style, including the surrounding HTML tags. You can consider +including definitions for the following classes: title, todo, +done, timestamp, timestamp-kwd, tag, target. + +For example, a valid value would be: + + <style type=\"text/css\"> + <![CDATA[ + p { font-weight: normal; color: gray; } + h1 { color: black; } + .title { text-align: center; } + .todo, .timestamp-kwd { color: red; } + .done { color: green; } + ]]> + </style> + +If you want to refer to an external style, use something like + + <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\" /> + +As the value of this option simply gets inserted into the HTML +<head> header, you can use it to add any arbitrary text to the +header. + +You can set this on a per-file basis using #+HTML_HEAD:, +or for publication projects using the :html-head property." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) +;;;###autoload +(put 'org-html-head 'safe-local-variable 'stringp) + +(defcustom org-html-head-extra "" + "More head information to add in the HTML output. + +You can set this on a per-file basis using #+HTML_HEAD_EXTRA:, +or for publication projects using the :html-head-extra property." + :group 'org-export-html + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) +;;;###autoload +(put 'org-html-head-extra 'safe-local-variable 'stringp) + +;;;; Todos + +(defcustom org-html-todo-kwd-class-prefix "" + "Prefix to class names for TODO keywords. +Each TODO keyword gets a class given by the keyword itself, with this prefix. +The default prefix is empty because it is nice to just use the keyword +as a class name. But if you get into conflicts with other, existing +CSS classes, then this prefix can be very useful." + :group 'org-export-html + :type 'string) + + +;;; Internal Functions + +(defun org-html-xhtml-p (info) + (let ((dt (downcase (plist-get info :html-doctype)))) + (string-match-p "xhtml" dt))) + +(defun org-html-html5-p (info) + (let ((dt (downcase (plist-get info :html-doctype)))) + (member dt '("html5" "xhtml5" "<!doctype html>")))) + +(defun org-html-close-tag (tag attr info) + (concat "<" tag " " attr + (if (org-html-xhtml-p info) " />" ">"))) + +(defun org-html-doctype (info) + "Return correct html doctype tag from `org-html-doctype-alist', +or the literal value of :html-doctype from INFO if :html-doctype +is not found in the alist. +INFO is a plist used as a communication channel." + (let ((dt (plist-get info :html-doctype))) + (or (cdr (assoc dt org-html-doctype-alist)) dt))) + +(defun org-html--make-attribute-string (attributes) + "Return a list of attributes, as a string. +ATTRIBUTES is a plist where values are either strings or nil. An +attributes with a nil value will be omitted from the result." + (let (output) + (dolist (item attributes (mapconcat 'identity (nreverse output) " ")) + (cond ((null item) (pop output)) + ((symbolp item) (push (substring (symbol-name item) 1) output)) + (t (let ((key (car output)) + (value (replace-regexp-in-string + "\"" """ (org-html-encode-plain-text item)))) + (setcar output (format "%s=\"%s\"" key value)))))))) + +(defun org-html--wrap-image (contents info &optional caption label) + "Wrap CONTENTS string within an appropriate environment for images. +INFO is a plist used as a communication channel. When optional +arguments CAPTION and LABEL are given, use them for caption and +\"id\" attribute." + (let ((html5-fancy (and (org-html-html5-p info) + (plist-get info :html-html5-fancy)))) + (format (if html5-fancy "\n<figure%s>%s%s\n</figure>" + "\n<div%s class=\"figure\">%s%s\n</div>") + ;; ID. + (if (not (org-string-nw-p label)) "" + (format " id=\"%s\"" (org-export-solidify-link-text label))) + ;; Contents. + (format "\n<p>%s</p>" contents) + ;; Caption. + (if (not (org-string-nw-p caption)) "" + (format (if html5-fancy "\n<figcaption>%s</figcaption>" + "\n<p>%s</p>") + caption))))) + +(defun org-html--format-image (source attributes info) + "Return \"img\" tag with given SOURCE and ATTRIBUTES. +SOURCE is a string specifying the location of the image. +ATTRIBUTES is a plist, as returned by +`org-export-read-attribute'. INFO is a plist used as +a communication channel." + (org-html-close-tag + "img" + (org-html--make-attribute-string + (org-combine-plists + (list :src source + :alt (if (string-match-p "^ltxpng/" source) + (org-html-encode-plain-text + (org-find-text-property-in-string 'org-latex-src source)) + (file-name-nondirectory source))) + attributes)) + info)) + +(defun org-html--textarea-block (element) + "Transcode ELEMENT into a textarea block. +ELEMENT is either a src block or an example block." + (let* ((code (car (org-export-unravel-code element))) + (attr (org-export-read-attribute :attr_html element))) + (format "<p>\n<textarea cols=\"%s\" rows=\"%s\">\n%s</textarea>\n</p>" + (or (plist-get attr :width) 80) + (or (plist-get attr :height) (org-count-lines code)) + code))) + +(defun org-html--has-caption-p (element &optional info) + "Non-nil when ELEMENT has a caption affiliated keyword. +INFO is a plist used as a communication channel. This function +is meant to be used as a predicate for `org-export-get-ordinal' or +a value to `org-html-standalone-image-predicate'." + (org-element-property :caption element)) + +;;;; Table + +(defun org-html-htmlize-region-for-paste (beg end) + "Convert the region between BEG and END to HTML, using htmlize.el. +This is much like `htmlize-region-for-paste', only that it uses +the settings define in the org-... variables." + (let* ((htmlize-output-type org-html-htmlize-output-type) + (htmlize-css-name-prefix org-html-htmlize-font-prefix) + (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)))) + +;;;###autoload +(defun org-html-htmlize-generate-css () + "Create the CSS for all font definitions in the current Emacs session. +Use this to create face definitions in your CSS style file that can then +be used by code snippets transformed by htmlize. +This command just produces a buffer that contains class definitions for all +faces used in the current Emacs session. You can copy and paste the ones you +need into your CSS file. + +If you then set `org-html-htmlize-output-type' to `css', calls +to the function `org-html-htmlize-region-for-paste' will +produce code that uses these same face definitions." + (interactive) + (require 'htmlize) + (and (get-buffer "*html*") (kill-buffer "*html*")) + (with-temp-buffer + (let ((fl (face-list)) + (htmlize-css-name-prefix "org-") + (htmlize-output-type 'css) + f i) + (while (setq f (pop fl) + i (and f (face-attribute f :inherit))) + (when (and (symbolp f) (or (not i) (not (listp i)))) + (insert (org-add-props (copy-sequence "1") nil 'face f)))) + (htmlize-region (point-min) (point-max)))) + (org-pop-to-buffer-same-window "*html*") + (goto-char (point-min)) + (if (re-search-forward "<style" nil t) + (delete-region (point-min) (match-beginning 0))) + (if (re-search-forward "</style>" nil t) + (delete-region (1+ (match-end 0)) (point-max))) + (beginning-of-line 1) + (if (looking-at " +") (replace-match "")) + (goto-char (point-min))) + +(defun org-html--make-string (n string) + "Build a string by concatenating N times STRING." + (let (out) (dotimes (i n out) (setq out (concat string out))))) + +(defun org-html-fix-class-name (kwd) ; audit callers of this function + "Turn todo keyword KWD into a valid class name. +Replaces invalid characters with \"_\"." + (save-match-data + (while (string-match "[^a-zA-Z0-9_]" kwd) + (setq kwd (replace-match "_" t t kwd)))) + kwd) + +(defun org-html-format-footnote-reference (n def refcnt) + "Format footnote reference N with definition DEF into HTML." + (let ((extra (if (= refcnt 1) "" (format ".%d" refcnt)))) + (format org-html-footnote-format + (let* ((id (format "fnr.%s%s" n extra)) + (href (format " href=\"#fn.%s\"" n)) + (attributes (concat " class=\"footref\"" href))) + (org-html--anchor id n attributes))))) + +(defun org-html-format-footnotes-section (section-name definitions) + "Format footnotes section SECTION-NAME." + (if (not definitions) "" + (format org-html-footnotes-section section-name definitions))) + +(defun org-html-format-footnote-definition (fn) + "Format the footnote definition FN." + (let ((n (car fn)) (def (cdr fn))) + (format + "<div class=\"footdef\">%s %s</div>\n" + (format org-html-footnote-format + (let* ((id (format "fn.%s" n)) + (href (format " href=\"#fnr.%s\"" n)) + (attributes (concat " class=\"footnum\"" href))) + (org-html--anchor id n attributes))) + def))) + +(defun org-html-footnote-section (info) + "Format the footnote section. +INFO is a plist used as a communication channel." + (let* ((fn-alist (org-export-collect-footnote-definitions + (plist-get info :parse-tree) info)) + (fn-alist + (loop for (n type raw) in fn-alist collect + (cons n (if (eq (org-element-type raw) 'org-data) + (org-trim (org-export-data raw info)) + (format "<p>%s</p>" + (org-trim (org-export-data raw info)))))))) + (when fn-alist + (org-html-format-footnotes-section + (org-html--translate "Footnotes" info) + (format + "\n%s\n" + (mapconcat 'org-html-format-footnote-definition fn-alist "\n")))))) + + +;;; Template + +(defun org-html--build-meta-info (info) + "Return meta tags for exported document. +INFO is a plist used as a communication channel." + (let ((protect-string + (lambda (str) + (replace-regexp-in-string + "\"" """ (org-html-encode-plain-text str)))) + (title (org-export-data (plist-get info :title) info)) + (author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth + ;; Return raw Org syntax, skipping non + ;; exportable objects. + (org-element-interpret-data + (org-element-map auth + (cons 'plain-text org-element-all-objects) + 'identity info)))))) + (description (plist-get info :description)) + (keywords (plist-get info :keywords)) + (charset (or (and org-html-coding-system + (fboundp 'coding-system-get) + (coding-system-get org-html-coding-system + 'mime-charset)) + "iso-8859-1"))) + (concat + (format "<title>%s\n" title) + (when (plist-get info :time-stamp-file) + (format-time-string + (concat "\n"))) + (format + (if (org-html-html5-p info) + (org-html-close-tag "meta" " charset=\"%s\"" info) + (org-html-close-tag + "meta" " http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"" + info)) + charset) "\n" + (org-html-close-tag "meta" " name=\"generator\" content=\"Org-mode\"" info) + "\n" + (and (org-string-nw-p author) + (concat + (org-html-close-tag "meta" + (format " name=\"author\" content=\"%s\"" + (funcall protect-string author)) + info) + "\n")) + (and (org-string-nw-p description) + (concat + (org-html-close-tag "meta" + (format " name=\"description\" content=\"%s\"\n" + (funcall protect-string description)) + info) + "\n")) + (and (org-string-nw-p keywords) + (concat + (org-html-close-tag "meta" + (format " name=\"keywords\" content=\"%s\"" + (funcall protect-string keywords)) + info) + "\n"))))) + +(defun org-html--build-head (info) + "Return information for the .. of the HTML output. +INFO is a plist used as a communication channel." + (org-element-normalize-string + (concat + (when (plist-get info :html-head-include-default-style) + (org-element-normalize-string org-html-style-default)) + (org-element-normalize-string (plist-get info :html-head)) + (org-element-normalize-string (plist-get info :html-head-extra)) + (when (and (plist-get info :html-htmlized-css-url) + (eq org-html-htmlize-output-type 'css)) + (org-html-close-tag "link" + (format " rel=\"stylesheet\" href=\"%s\" type=\"text/css\"" + (plist-get info :html-htmlized-css-url)) + info)) + (when (plist-get info :html-head-include-scripts) org-html-scripts)))) + +(defun org-html--build-mathjax-config (info) + "Insert the user setup into the mathjax template. +INFO is a plist used as a communication channel." + (when (and (memq (plist-get info :with-latex) '(mathjax t)) + (org-element-map (plist-get info :parse-tree) + '(latex-fragment latex-environment) 'identity info t)) + (let ((template org-html-mathjax-template) + (options org-html-mathjax-options) + (in-buffer (or (plist-get info :html-mathjax) "")) + name val (yes " ") (no "// ") x) + (mapc + (lambda (e) + (setq name (car e) val (nth 1 e)) + (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer) + (setq val (car (read-from-string + (substring in-buffer (match-end 0)))))) + (if (not (stringp val)) (setq val (format "%s" val))) + (if (string-match (concat "%" (upcase (symbol-name name))) template) + (setq template (replace-match val t t template)))) + options) + (setq val (nth 1 (assq 'mathml options))) + (if (string-match (concat "\\%s" e e)) + (split-string (plist-get info :email) ",+ *") + ", ")) + (?c . ,(plist-get info :creator)) + (?C . ,(let ((file (plist-get info :input-file))) + (format-time-string org-html-metadata-timestamp-format + (if file (nth 5 (file-attributes file)) + (current-time))))) + (?v . ,(or org-html-validation-link "")))) + +(defun org-html--build-pre/postamble (type info) + "Return document preamble or postamble as a string, or nil. +TYPE is either 'preamble or 'postamble, INFO is a plist used as a +communication channel." + (let ((section (plist-get info (intern (format ":html-%s" type)))) + (spec (org-html-format-spec info))) + (when section + (let ((section-contents + (if (functionp section) (funcall section info) + (cond + ((stringp section) (format-spec section spec)) + ((eq section 'auto) + (let ((date (cdr (assq ?d spec))) + (author (cdr (assq ?a spec))) + (email (cdr (assq ?e spec))) + (creator (cdr (assq ?c spec))) + (timestamp (cdr (assq ?T spec))) + (validation-link (cdr (assq ?v spec)))) + (concat + (when (and (plist-get info :with-date) + (org-string-nw-p date)) + (format "

%s: %s

\n" + (org-html--translate "Date" info) + date)) + (when (and (plist-get info :with-author) + (org-string-nw-p author)) + (format "

%s: %s

\n" + (org-html--translate "Author" info) + author)) + (when (and (plist-get info :with-email) + (org-string-nw-p email)) + (format "

%s: %s

\n" + (org-html--translate "Email" info) + email)) + (when (plist-get info :time-stamp-file) + (format + "

%s: %s

\n" + (org-html--translate "Created" info) + (format-time-string org-html-metadata-timestamp-format))) + (when (plist-get info :with-creator) + (format "

%s

\n" creator)) + (format "

%s

\n" + validation-link)))) + (t (format-spec + (or (cadr (assoc + (plist-get info :language) + (eval (intern + (format "org-html-%s-format" type))))) + (cadr + (assoc + "en" + (eval + (intern (format "org-html-%s-format" type)))))) + spec)))))) + (when (org-string-nw-p section-contents) + (concat + (format "<%s id=\"%s\" class=\"%s\">\n" + (nth 1 (assq type org-html-divs)) + (nth 2 (assq type org-html-divs)) + org-html--pre/postamble-class) + (org-element-normalize-string section-contents) + (format "\n" (nth 1 (assq type org-html-divs))))))))) + +(defun org-html-inner-template (contents info) + "Return body of document string after HTML conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (concat + ;; Table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth (org-html-toc depth info))) + ;; Document contents. + contents + ;; Footnotes section. + (org-html-footnote-section info))) + +(defun org-html-template (contents info) + "Return complete document string after HTML conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (concat + (when (and (not (org-html-html5-p info)) (org-html-xhtml-p info)) + (let ((decl (or (and (stringp org-html-xml-declaration) + org-html-xml-declaration) + (cdr (assoc (plist-get info :html-extension) + org-html-xml-declaration)) + (cdr (assoc "html" org-html-xml-declaration)) + + ""))) + (when (not (or (eq nil decl) (string= "" decl))) + (format "%s\n" + (format decl + (or (and org-html-coding-system + (fboundp 'coding-system-get) + (coding-system-get org-html-coding-system 'mime-charset)) + "iso-8859-1")))))) + (org-html-doctype info) + "\n" + (concat "\n") + "\n" + (org-html--build-meta-info info) + (org-html--build-head info) + (org-html--build-mathjax-config info) + "\n" + "\n" + (let ((link-up (org-trim (plist-get info :html-link-up))) + (link-home (org-trim (plist-get info :html-link-home)))) + (unless (and (string= link-up "") (string= link-home "")) + (format org-html-home/up-format + (or link-up link-home) + (or link-home link-up)))) + ;; Preamble. + (org-html--build-pre/postamble 'preamble info) + ;; Document contents. + (format "<%s id=\"%s\">\n" + (nth 1 (assq 'content org-html-divs)) + (nth 2 (assq 'content org-html-divs))) + ;; Document title. + (let ((title (plist-get info :title))) + (format "

%s

\n" (org-export-data (or title "") info))) + contents + (format "\n" + (nth 1 (assq 'content org-html-divs))) + ;; Postamble. + (org-html--build-pre/postamble 'postamble info) + ;; Closing document. + "\n")) + +(defun org-html--translate (s info) + "Translate string S according to specified language. +INFO is a plist used as a communication channel." + (org-export-translate s :html info)) + +;;;; Anchor + +(defun org-html--anchor (&optional id desc attributes) + "Format a HTML anchor." + (let* ((name (and org-html-allow-name-attribute-in-anchors id)) + (attributes (concat (and id (format " id=\"%s\"" id)) + (and name (format " name=\"%s\"" name)) + attributes))) + (format "%s" attributes (or desc "")))) + +;;;; Todo + +(defun org-html--todo (todo) + "Format TODO keywords into HTML." + (when todo + (format "%s" + (if (member todo org-done-keywords) "done" "todo") + org-html-todo-kwd-class-prefix (org-html-fix-class-name todo) + todo))) + +;;;; Tags + +(defun org-html--tags (tags) + "Format TAGS into HTML." + (when tags + (format "%s" + (mapconcat + (lambda (tag) + (format "%s" + (concat org-html-tag-class-prefix + (org-html-fix-class-name tag)) + tag)) + tags " ")))) + +;;;; Headline + +(defun* org-html-format-headline + (todo todo-type priority text tags + &key level section-number headline-label &allow-other-keys) + "Format a headline in HTML." + (let ((section-number + (when section-number + (format "%s " + level section-number))) + (todo (org-html--todo todo)) + (tags (org-html--tags tags))) + (concat section-number todo (and todo " ") text + (and tags "   ") tags))) + +;;;; Src Code + +(defun org-html-fontify-code (code lang) + "Color CODE with htmlize library. +CODE is a string representing the source code to colorize. LANG +is the language used for CODE, as a string, or nil." + (when code + (cond + ;; Case 1: No lang. Possibly an example block. + ((not lang) + ;; Simple transcoding. + (org-html-encode-plain-text code)) + ;; Case 2: No htmlize or an inferior version of htmlize + ((not (and (require 'htmlize nil t) (fboundp 'htmlize-region-for-paste))) + ;; Emit a warning. + (message "Cannot fontify src block (htmlize.el >= 1.34 required)") + ;; Simple transcoding. + (org-html-encode-plain-text code)) + (t + ;; Map language + (setq lang (or (assoc-default lang org-src-lang-modes) lang)) + (let* ((lang-mode (and lang (intern (format "%s-mode" lang))))) + (cond + ;; Case 1: Language is not associated with any Emacs mode + ((not (functionp lang-mode)) + ;; Simple transcoding. + (org-html-encode-plain-text code)) + ;; Case 2: Default. Fontify code. + (t + ;; htmlize + (setq code (with-temp-buffer + ;; Switch to language-specific mode. + (funcall lang-mode) + (insert code) + ;; Fontify buffer. + (font-lock-fontify-buffer) + ;; Remove formatting on newline characters. + (save-excursion + (let ((beg (point-min)) + (end (point-max))) + (goto-char beg) + (while (progn (end-of-line) (< (point) end)) + (put-text-property (point) (1+ (point)) 'face nil) + (forward-char 1)))) + (org-src-mode) + (set-buffer-modified-p nil) + ;; Htmlize region. + (org-html-htmlize-region-for-paste + (point-min) (point-max)))) + ;; Strip any enclosing
 tags.
+	  (let* ((beg (and (string-match "\\`]*>\n*" code) (match-end 0)))
+		 (end (and beg (string-match "\\'" code))))
+	    (if (and beg end) (substring code beg end) code)))))))))
+
+(defun org-html-do-format-code
+  (code &optional lang refs retain-labels num-start)
+  "Format CODE string as source code.
+Optional arguments LANG, REFS, RETAIN-LABELS and NUM-START are,
+respectively, the language of the source code, as a string, an
+alist between line numbers and references (as returned by
+`org-export-unravel-code'), a boolean specifying if labels should
+appear in the source code, and the number associated to the first
+line of code."
+  (let* ((code-lines (org-split-string code "\n"))
+	 (code-length (length code-lines))
+	 (num-fmt
+	  (and num-start
+	       (format "%%%ds: "
+		       (length (number-to-string (+ code-length num-start))))))
+	 (code (org-html-fontify-code code lang)))
+    (org-export-format-code
+     code
+     (lambda (loc line-num ref)
+       (setq loc
+	     (concat
+	      ;; Add line number, if needed.
+	      (when num-start
+		(format "%s"
+			(format num-fmt line-num)))
+	      ;; Transcoded src line.
+	      loc
+	      ;; Add label, if needed.
+	      (when (and ref retain-labels) (format " (%s)" ref))))
+       ;; Mark transcoded line as an anchor, if needed.
+       (if (not ref) loc
+	 (format "%s"
+		 ref loc)))
+     num-start refs)))
+
+(defun org-html-format-code (element info)
+  "Format contents of ELEMENT as source code.
+ELEMENT is either an example block or a src block.  INFO is
+a plist used as a communication channel."
+  (let* ((lang (org-element-property :language element))
+	 ;; Extract code and references.
+	 (code-info (org-export-unravel-code element))
+	 (code (car code-info))
+	 (refs (cdr code-info))
+	 ;; Does the src block contain labels?
+	 (retain-labels (org-element-property :retain-labels element))
+	 ;; Does it have line numbers?
+	 (num-start (case (org-element-property :number-lines element)
+		      (continued (org-export-get-loc element info))
+		      (new 0))))
+    (org-html-do-format-code code lang refs retain-labels num-start)))
+
+
+;;; Tables of Contents
+
+(defun org-html-toc (depth info)
+  "Build a table of contents.
+DEPTH is an integer specifying the depth of the table.  INFO is a
+plist used as a communication channel.  Return the table of
+contents as a string, or nil if it is empty."
+  (let ((toc-entries
+	 (mapcar (lambda (headline)
+		   (cons (org-html--format-toc-headline headline info)
+			 (org-export-get-relative-level headline info)))
+		 (org-export-collect-headlines info depth)))
+	(outer-tag (if (and (org-html-html5-p info)
+			    (plist-get info :html-html5-fancy))
+		       "nav"
+		     "div")))
+    (when toc-entries
+      (concat (format "<%s id=\"table-of-contents\">\n" outer-tag)
+	      (format "%s\n"
+		      org-html-toplevel-hlevel
+		      (org-html--translate "Table of Contents" info)
+		      org-html-toplevel-hlevel)
+	      "
" + (org-html--toc-text toc-entries) + "
\n" + (format "\n" outer-tag))))) + +(defun org-html--toc-text (toc-entries) + "Return innards of a table of contents, as a string. +TOC-ENTRIES is an alist where key is an entry title, as a string, +and value is its relative level, as an integer." + (let* ((prev-level (1- (cdar toc-entries))) + (start-level prev-level)) + (concat + (mapconcat + (lambda (entry) + (let ((headline (car entry)) + (level (cdr entry))) + (concat + (let* ((cnt (- level prev-level)) + (times (if (> cnt 0) (1- cnt) (- cnt))) + rtn) + (setq prev-level level) + (concat + (org-html--make-string + times (cond ((> cnt 0) "\n
    \n
  • ") + ((< cnt 0) "
  • \n
\n"))) + (if (> cnt 0) "\n
    \n
  • " "
  • \n
  • "))) + headline))) + toc-entries "") + (org-html--make-string (- prev-level start-level) "
  • \n
\n")))) + +(defun org-html--format-toc-headline (headline info) + "Return an appropriate table of contents entry for HEADLINE. +INFO is a plist used as a communication channel." + (let* ((headline-number (org-export-get-headline-number headline info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + (text (org-export-data-with-backend + (org-export-get-alt-title headline info) + ;; Create an anonymous back-end that will ignore any + ;; footnote-reference, link, radio-target and target + ;; in table of contents. + (org-export-create-backend + :parent 'html + :transcoders '((footnote-reference . ignore) + (link . (lambda (object c i) c)) + (radio-target . (lambda (object c i) c)) + (target . ignore))) + info)) + (tags (and (eq (plist-get info :with-tags) t) + (org-export-get-tags headline info)))) + (format "%s" + ;; Label. + (org-export-solidify-link-text + (or (org-element-property :CUSTOM_ID headline) + (concat "sec-" + (mapconcat #'number-to-string headline-number "-")))) + ;; Body. + (concat + (and (not (org-export-low-level-p headline info)) + (org-export-numbered-headline-p headline info) + (concat (mapconcat #'number-to-string headline-number ".") + ". ")) + (apply (if (not (eq org-html-format-headline-function 'ignore)) + (lambda (todo todo-type priority text tags &rest ignore) + (funcall org-html-format-headline-function + todo todo-type priority text tags)) + #'org-html-format-headline) + todo todo-type priority text tags :section-number nil))))) + +(defun org-html-list-of-listings (info) + "Build a list of listings. +INFO is a plist used as a communication channel. Return the list +of listings as a string, or nil if it is empty." + (let ((lol-entries (org-export-collect-listings info))) + (when lol-entries + (concat "
\n" + (format "%s\n" + org-html-toplevel-hlevel + (org-html--translate "List of Listings" info) + org-html-toplevel-hlevel) + "
\n
    \n" + (let ((count 0) + (initial-fmt (format "%s" + (org-html--translate "Listing %d:" info)))) + (mapconcat + (lambda (entry) + (let ((label (org-element-property :name entry)) + (title (org-trim + (org-export-data + (or (org-export-get-caption entry t) + (org-export-get-caption entry)) + info)))) + (concat + "
  • " + (if (not label) + (concat (format initial-fmt (incf count)) " " title) + (format "%s %s" + (org-export-solidify-link-text label) + (format initial-fmt (incf count)) + title)) + "
  • "))) + lol-entries "\n")) + "\n
\n
\n
")))) + +(defun org-html-list-of-tables (info) + "Build a list of tables. +INFO is a plist used as a communication channel. Return the list +of tables as a string, or nil if it is empty." + (let ((lol-entries (org-export-collect-tables info))) + (when lol-entries + (concat "
\n" + (format "%s\n" + org-html-toplevel-hlevel + (org-html--translate "List of Tables" info) + org-html-toplevel-hlevel) + "
\n
    \n" + (let ((count 0) + (initial-fmt (format "%s" + (org-html--translate "Table %d:" info)))) + (mapconcat + (lambda (entry) + (let ((label (org-element-property :name entry)) + (title (org-trim + (org-export-data + (or (org-export-get-caption entry t) + (org-export-get-caption entry)) + info)))) + (concat + "
  • " + (if (not label) + (concat (format initial-fmt (incf count)) " " title) + (format "%s %s" + (org-export-solidify-link-text label) + (format initial-fmt (incf count)) + title)) + "
  • "))) + lol-entries "\n")) + "\n
\n
\n
")))) + + +;;; Transcode Functions + +;;;; Bold + +(defun org-html-bold (bold contents info) + "Transcode BOLD from Org to HTML. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (format (or (cdr (assq 'bold org-html-text-markup-alist)) "%s") + contents)) + +;;;; Center Block + +(defun org-html-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (format "
\n%s
" contents)) + +;;;; Clock + +(defun org-html-clock (clock contents info) + "Transcode a CLOCK element from Org to HTML. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "

+ +%s %s%s + +

" + org-clock-string + (org-translate-time + (org-element-property :raw-value + (org-element-property :value clock))) + (let ((time (org-element-property :duration clock))) + (and time (format " (%s)" time))))) + +;;;; Code + +(defun org-html-code (code contents info) + "Transcode CODE from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format (or (cdr (assq 'code org-html-text-markup-alist)) "%s") + (org-html-encode-plain-text (org-element-property :value code)))) + +;;;; Drawer + +(defun org-html-drawer (drawer contents info) + "Transcode a DRAWER element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (if (functionp org-html-format-drawer-function) + (funcall org-html-format-drawer-function + (org-element-property :drawer-name drawer) + contents) + ;; If there's no user defined function: simply + ;; display contents of the drawer. + contents)) + +;;;; Dynamic Block + +(defun org-html-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information. See `org-export-data'." + contents) + +;;;; Entity + +(defun org-html-entity (entity contents info) + "Transcode an ENTITY object from Org to HTML. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (org-element-property :html entity)) + +;;;; Example Block + +(defun org-html-example-block (example-block contents info) + "Transcode a EXAMPLE-BLOCK element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (if (org-export-read-attribute :attr_html example-block :textarea) + (org-html--textarea-block example-block) + (format "
\n%s
" + (org-html-format-code example-block info)))) + +;;;; Export Snippet + +(defun org-html-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (when (eq (org-export-snippet-backend export-snippet) 'html) + (org-element-property :value export-snippet))) + +;;;; Export Block + +(defun org-html-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (string= (org-element-property :type export-block) "HTML") + (org-remove-indentation (org-element-property :value export-block)))) + +;;;; Fixed Width + +(defun org-html-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (format "
\n%s
" + (org-html-do-format-code + (org-remove-indentation + (org-element-property :value fixed-width))))) + +;;;; Footnote Reference + +(defun org-html-footnote-reference (footnote-reference contents info) + "Transcode a FOOTNOTE-REFERENCE element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (concat + ;; Insert separator between two footnotes in a row. + (let ((prev (org-export-get-previous-element footnote-reference info))) + (when (eq (org-element-type prev) 'footnote-reference) + org-html-footnote-separator)) + (cond + ((not (org-export-footnote-first-reference-p footnote-reference info)) + (org-html-format-footnote-reference + (org-export-get-footnote-number footnote-reference info) + "IGNORED" 100)) + ;; Inline definitions are secondary strings. + ((eq (org-element-property :type footnote-reference) 'inline) + (org-html-format-footnote-reference + (org-export-get-footnote-number footnote-reference info) + "IGNORED" 1)) + ;; Non-inline footnotes definitions are full Org data. + (t (org-html-format-footnote-reference + (org-export-get-footnote-number footnote-reference info) + "IGNORED" 1))))) + +;;;; Headline + +(defun org-html-format-headline--wrap + (headline info &optional format-function &rest extra-keys) + "Transcode a HEADLINE element from Org to HTML. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + (let* ((level (+ (org-export-get-relative-level headline info) + (1- org-html-toplevel-hlevel))) + (headline-number (org-export-get-headline-number headline info)) + (section-number (and (not (org-export-low-level-p headline info)) + (org-export-numbered-headline-p headline info) + (mapconcat 'number-to-string + headline-number "."))) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + (text (org-export-data (org-element-property :title headline) info)) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (headline-label (or (org-element-property :CUSTOM_ID headline) + (concat "sec-" (mapconcat 'number-to-string + headline-number "-")))) + (format-function + (cond ((functionp format-function) format-function) + ((not (eq org-html-format-headline-function 'ignore)) + (lambda (todo todo-type priority text tags &rest ignore) + (funcall org-html-format-headline-function + todo todo-type priority text tags))) + (t 'org-html-format-headline)))) + (apply format-function + todo todo-type priority text tags + :headline-label headline-label :level level + :section-number section-number extra-keys))) + +(defun org-html-headline (headline contents info) + "Transcode a HEADLINE element from Org to HTML. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + (unless (org-element-property :footnote-section-p headline) + (let* ((contents (or contents "")) + (numberedp (org-export-numbered-headline-p headline info)) + (level (org-export-get-relative-level headline info)) + (text (org-export-data (org-element-property :title headline) info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + (section-number (mapconcat #'number-to-string + (org-export-get-headline-number + headline info) "-")) + (ids (delq 'nil + (list (org-element-property :CUSTOM_ID headline) + (concat "sec-" section-number) + (org-element-property :ID headline)))) + (preferred-id (car ids)) + (extra-ids (mapconcat + (lambda (id) + (org-html--anchor + (org-export-solidify-link-text + (if (org-uuidgen-p id) (concat "ID-" id) id)))) + (cdr ids) "")) + ;; Create the headline text. + (full-text (org-html-format-headline--wrap headline info))) + (if (org-export-low-level-p headline info) + ;; This is a deep sub-tree: export it as a list item. + (let* ((type (if numberedp 'ordered 'unordered)) + (itemized-body + (org-html-format-list-item + contents type nil info nil + (concat (org-html--anchor preferred-id) extra-ids + full-text)))) + (concat + (and (org-export-first-sibling-p headline info) + (org-html-begin-plain-list type)) + itemized-body + (and (org-export-last-sibling-p headline info) + (org-html-end-plain-list type)))) + ;; Standard headline. Export it as a section. + (let ((extra-class (org-element-property :HTML_CONTAINER_CLASS headline)) + (level1 (+ level (1- org-html-toplevel-hlevel))) + (first-content (car (org-element-contents headline)))) + (format "<%s id=\"%s\" class=\"%s\">%s%s\n" + (org-html--container headline info) + (format "outline-container-%s" + (or (org-element-property :CUSTOM_ID headline) + (concat "sec-" section-number))) + (concat (format "outline-%d" level1) (and extra-class " ") + extra-class) + (format "\n%s%s\n" + level1 preferred-id extra-ids full-text level1) + ;; When there is no section, pretend there is an + ;; empty one to get the correct
\n" class extra) text "
\n"))) + +(defun org-html-inlinetask (inlinetask contents info) + "Transcode an INLINETASK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (cond + ;; If `org-html-format-inlinetask-function' is not 'ignore, call it + ;; with appropriate arguments. + ((not (eq org-html-format-inlinetask-function 'ignore)) + (let ((format-function + (function* + (lambda (todo todo-type priority text tags + &key contents &allow-other-keys) + (funcall org-html-format-inlinetask-function + todo todo-type priority text tags contents))))) + (org-html-format-headline--wrap + inlinetask info format-function :contents contents))) + ;; Otherwise, use a default template. + (t (format "
\n%s%s\n%s
" + (org-html-format-headline--wrap inlinetask info) + (org-html-close-tag "br" nil info) + contents)))) + +;;;; Italic + +(defun org-html-italic (italic contents info) + "Transcode ITALIC from Org to HTML. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (format (or (cdr (assq 'italic org-html-text-markup-alist)) "%s") contents)) + +;;;; Item + +(defun org-html-checkbox (checkbox) + "Format CHECKBOX into HTML." + (case checkbox (on "[X]") + (off "[ ]") + (trans "[-]") + (t ""))) + +(defun org-html-format-list-item (contents type checkbox info + &optional term-counter-id + headline) + "Format a list item into HTML." + (let ((checkbox (concat (org-html-checkbox checkbox) (and checkbox " "))) + (br (org-html-close-tag "br" nil info))) + (concat + (case type + (ordered + (let* ((counter term-counter-id) + (extra (if counter (format " value=\"%s\"" counter) ""))) + (concat + (format "" extra) + (when headline (concat headline br))))) + (unordered + (let* ((id term-counter-id) + (extra (if id (format " id=\"%s\"" id) ""))) + (concat + (format "" extra) + (when headline (concat headline br))))) + (descriptive + (let* ((term term-counter-id)) + (setq term (or term "(no term)")) + ;; Check-boxes in descriptive lists are associated to tag. + (concat (format "
%s
" + (concat checkbox term)) + "
")))) + (unless (eq type 'descriptive) checkbox) + contents + (case type + (ordered "") + (unordered "") + (descriptive "
"))))) + +(defun org-html-item (item contents info) + "Transcode an ITEM element from Org to HTML. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((plain-list (org-export-get-parent item)) + (type (org-element-property :type plain-list)) + (counter (org-element-property :counter item)) + (checkbox (org-element-property :checkbox item)) + (tag (let ((tag (org-element-property :tag item))) + (and tag (org-export-data tag info))))) + (org-html-format-list-item + contents type checkbox info (or tag counter)))) + +;;;; Keyword + +(defun org-html-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "HTML") value) + ((string= key "TOC") + (let ((value (downcase value))) + (cond + ((string-match "\\" value) + (let ((depth (or (and (string-match "[0-9]+" value) + (string-to-number (match-string 0 value))) + (plist-get info :with-toc)))) + (org-html-toc depth info))) + ((string= "listings" value) (org-html-list-of-listings info)) + ((string= "tables" value) (org-html-list-of-tables info)))))))) + +;;;; Latex Environment + +(defun org-html-format-latex (latex-frag processing-type info) + "Format a LaTeX fragment LATEX-FRAG into HTML. +PROCESSING-TYPE designates the tool used for conversion. It is +a symbol among `mathjax', `dvipng', `imagemagick', `verbatim' nil +and t. See `org-html-with-latex' for more information. INFO is +a plist containing export properties." + (let ((cache-relpath "") (cache-dir "")) + (unless (eq processing-type 'mathjax) + (let ((bfn (or (buffer-file-name) + (make-temp-name + (expand-file-name "latex" temporary-file-directory)))) + (latex-header + (let ((header (plist-get info :latex-header))) + (and header + (concat (mapconcat + (lambda (line) (concat "#+LATEX_HEADER: " line)) + (org-split-string header "\n") + "\n") + "\n"))))) + (setq cache-relpath + (concat "ltxpng/" + (file-name-sans-extension + (file-name-nondirectory bfn))) + cache-dir (file-name-directory bfn)) + ;; Re-create LaTeX environment from original buffer in + ;; temporary buffer so that dvipng/imagemagick can properly + ;; turn the fragment into an image. + (setq latex-frag (concat latex-header latex-frag)))) + (with-temp-buffer + (insert latex-frag) + (org-format-latex cache-relpath cache-dir nil "Creating LaTeX Image..." + nil nil processing-type) + (buffer-string)))) + +(defun org-html-latex-environment (latex-environment contents info) + "Transcode a LATEX-ENVIRONMENT element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((processing-type (plist-get info :with-latex)) + (latex-frag (org-remove-indentation + (org-element-property :value latex-environment))) + (attributes (org-export-read-attribute :attr_html latex-environment))) + (case processing-type + ((t mathjax) + (org-html-format-latex latex-frag 'mathjax info)) + ((dvipng imagemagick) + (let ((formula-link + (org-html-format-latex latex-frag processing-type info))) + (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) + ;; Do not provide a caption or a name to be consistent with + ;; `mathjax' handling. + (org-html--wrap-image + (org-html--format-image + (match-string 1 formula-link) attributes info) info)))) + (t latex-frag)))) + +;;;; Latex Fragment + +(defun org-html-latex-fragment (latex-fragment contents info) + "Transcode a LATEX-FRAGMENT object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((latex-frag (org-element-property :value latex-fragment)) + (processing-type (plist-get info :with-latex))) + (case processing-type + ((t mathjax) + (org-html-format-latex latex-frag 'mathjax info)) + ((dvipng imagemagick) + (let ((formula-link + (org-html-format-latex latex-frag processing-type info))) + (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) + (org-html--format-image (match-string 1 formula-link) nil info)))) + (t latex-frag)))) + +;;;; Line Break + +(defun org-html-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (concat (org-html-close-tag "br" nil info) "\n")) + +;;;; Link + +(defun org-html-inline-image-p (link info) + "Non-nil when LINK is meant to appear as an image. +INFO is a plist used as a communication channel. LINK is an +inline image when it has no description and targets an image +file (see `org-html-inline-image-rules' for more information), or +if its description is a single link targeting an image file." + (if (not (org-element-contents link)) + (org-export-inline-image-p link org-html-inline-image-rules) + (not + (let ((link-count 0)) + (org-element-map (org-element-contents link) + (cons 'plain-text org-element-all-objects) + (lambda (obj) + (case (org-element-type obj) + (plain-text (org-string-nw-p obj)) + (link (if (= link-count 1) t + (incf link-count) + (not (org-export-inline-image-p + obj org-html-inline-image-rules)))) + (otherwise t))) + info t))))) + +(defvar org-html-standalone-image-predicate) +(defun org-html-standalone-image-p (element info) + "Non-nil if ELEMENT is a standalone image. + +INFO is a plist holding contextual information. + +An element or object is a standalone image when + + - its type is `paragraph' and its sole content, save for white + spaces, is a link that qualifies as an inline image; + + - its type is `link' and its containing paragraph has no other + content save white spaces. + +Bind `org-html-standalone-image-predicate' to constrain paragraph +further. For example, to check for only captioned standalone +images, set it to: + + \(lambda (paragraph) (org-element-property :caption paragraph))" + (let ((paragraph (case (org-element-type element) + (paragraph element) + (link (org-export-get-parent element))))) + (and (eq (org-element-type paragraph) 'paragraph) + (or (not (fboundp 'org-html-standalone-image-predicate)) + (funcall org-html-standalone-image-predicate paragraph)) + (catch 'exit + (let ((link-count 0)) + (org-element-map (org-element-contents paragraph) + (cons 'plain-text org-element-all-objects) + #'(lambda (obj) + (when (case (org-element-type obj) + (plain-text (org-string-nw-p obj)) + (link (or (> (incf link-count) 1) + (not (org-html-inline-image-p obj info)))) + (otherwise t)) + (throw 'exit nil))) + info nil 'link) + (= link-count 1)))))) + +(defun org-html-link (link desc info) + "Transcode a LINK object from Org to HTML. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + (let* ((home (when (plist-get info :html-link-home) + (org-trim (plist-get info :html-link-home)))) + (use-abs-url (plist-get info :html-link-use-abs-url)) + (link-org-files-as-html-maybe + (function + (lambda (raw-path info) + "Treat links to `file.org' as links to `file.html', if needed. + See `org-html-link-org-files-as-html'." + (cond + ((and org-html-link-org-files-as-html + (string= ".org" + (downcase (file-name-extension raw-path ".")))) + (concat (file-name-sans-extension raw-path) "." + (plist-get info :html-extension))) + (t raw-path))))) + (type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + ;; Ensure DESC really exists, or set it to nil. + (desc (org-string-nw-p desc)) + (path + (cond + ((member type '("http" "https" "ftp" "mailto")) + (org-link-escape + (org-link-unescape + (concat type ":" raw-path)) org-link-escape-chars-browser)) + ((string= type "file") + ;; Treat links to ".org" files as ".html", if needed. + (setq raw-path + (funcall link-org-files-as-html-maybe raw-path info)) + ;; If file path is absolute, prepend it with protocol + ;; component - "file:". + (cond + ((file-name-absolute-p raw-path) + (setq raw-path (concat "file:" raw-path))) + ((and home use-abs-url) + (setq raw-path (concat (file-name-as-directory home) raw-path)))) + ;; Add search option, if any. A search option can be + ;; relative to a custom-id or a headline title. Any other + ;; option is ignored. + (let ((option (org-element-property :search-option link))) + (cond ((not option) raw-path) + ((eq (aref option 0) ?#) (concat raw-path option)) + ;; External fuzzy link: try to resolve it if path + ;; belongs to current project, if any. + ((eq (aref option 0) ?*) + (concat + raw-path + (let ((numbers + (org-publish-resolve-external-fuzzy-link + (org-element-property :path link) option))) + (and numbers (concat "#sec-" + (mapconcat 'number-to-string + numbers "-")))))) + (t raw-path)))) + (t raw-path))) + ;; Extract attributes from parent's paragraph. HACK: Only do + ;; this for the first link in parent (inner image link for + ;; inline images). This is needed as long as attributes + ;; cannot be set on a per link basis. + (attributes-plist + (let* ((parent (org-export-get-parent-element link)) + (link (let ((container (org-export-get-parent link))) + (if (and (eq (org-element-type container) 'link) + (org-html-inline-image-p link info)) + container + link)))) + (and (eq (org-element-map parent 'link 'identity info t) link) + (org-export-read-attribute :attr_html parent)))) + (attributes + (let ((attr (org-html--make-attribute-string attributes-plist))) + (if (org-string-nw-p attr) (concat " " attr) ""))) + protocol) + (cond + ;; Image file. + ((and org-html-inline-images + (org-export-inline-image-p link org-html-inline-image-rules)) + (org-html--format-image path attributes-plist info)) + ;; Radio target: Transcode target's contents and use them as + ;; link's description. + ((string= type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (if (not destination) desc + (format "%s" + (org-export-solidify-link-text + (org-element-property :value destination)) + attributes desc)))) + ;; Links pointing to a headline: Find destination and build + ;; appropriate referencing command. + ((member type '("custom-id" "fuzzy" "id")) + (let ((destination (if (string= type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (case (org-element-type destination) + ;; ID link points to an external file. + (plain-text + (let ((fragment (concat "ID-" path)) + ;; Treat links to ".org" files as ".html", if needed. + (path (funcall link-org-files-as-html-maybe + destination info))) + (format "%s" + path fragment attributes (or desc destination)))) + ;; Fuzzy link points nowhere. + ((nil) + (format "%s" + (or desc + (org-export-data + (org-element-property :raw-link link) info)))) + ;; Link points to a headline. + (headline + (let ((href + ;; What href to use? + (cond + ;; Case 1: Headline is linked via it's CUSTOM_ID + ;; property. Use CUSTOM_ID. + ((string= type "custom-id") + (org-element-property :CUSTOM_ID destination)) + ;; Case 2: Headline is linked via it's ID property + ;; or through other means. Use the default href. + ((member type '("id" "fuzzy")) + (format "sec-%s" + (mapconcat 'number-to-string + (org-export-get-headline-number + destination info) "-"))) + (t (error "Shouldn't reach here")))) + ;; What description to use? + (desc + ;; Case 1: Headline is numbered and LINK has no + ;; description. Display section number. + (if (and (org-export-numbered-headline-p destination info) + (not desc)) + (mapconcat 'number-to-string + (org-export-get-headline-number + destination info) ".") + ;; Case 2: Either the headline is un-numbered or + ;; LINK has a custom description. Display LINK's + ;; description or headline's title. + (or desc (org-export-data (org-element-property + :title destination) info))))) + (format "%s" + (org-export-solidify-link-text href) attributes desc))) + ;; Fuzzy link points to a target or an element. + (t + (let* ((path (org-export-solidify-link-text path)) + (org-html-standalone-image-predicate 'org-html--has-caption-p) + (number (cond + (desc nil) + ((org-html-standalone-image-p destination info) + (org-export-get-ordinal + (org-element-map destination 'link + 'identity info t) + info 'link 'org-html-standalone-image-p)) + (t (org-export-get-ordinal + destination info nil 'org-html--has-caption-p)))) + (desc (cond (desc) + ((not number) "No description for this link") + ((numberp number) (number-to-string number)) + (t (mapconcat 'number-to-string number "."))))) + (format "%s" path attributes desc)))))) + ;; Coderef: replace link with the reference name or the + ;; equivalent line number. + ((string= type "coderef") + (let ((fragment (concat "coderef-" path))) + (format "%s" + fragment + (org-trim + (format (concat "class=\"coderef\"" + " onmouseover=\"CodeHighlightOn(this, '%s');\"" + " onmouseout=\"CodeHighlightOff(this, '%s');\"") + fragment fragment)) + attributes + (format (org-export-get-coderef-format path desc) + (org-export-resolve-coderef path info))))) + ;; Link type is handled by a special function. + ((functionp (setq protocol (nth 2 (assoc type org-link-protocols)))) + (funcall protocol (org-link-unescape path) desc 'html)) + ;; External link with a description part. + ((and path desc) (format "%s" path attributes desc)) + ;; External link without a description part. + (path (format "%s" path attributes path)) + ;; No path, only description. Try to do something useful. + (t (format "%s" desc))))) + +;;;; Paragraph + +(defun org-html-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to HTML. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + (let* ((parent (org-export-get-parent paragraph)) + (parent-type (org-element-type parent)) + (style '((footnote-definition " class=\"footpara\""))) + (extra (or (cadr (assoc parent-type style)) ""))) + (cond + ((and (eq (org-element-type parent) 'item) + (= (org-element-property :begin paragraph) + (org-element-property :contents-begin parent))) + ;; Leading paragraph in a list item have no tags. + contents) + ((org-html-standalone-image-p paragraph info) + ;; Standalone image. + (let ((caption + (let ((raw (org-export-data + (org-export-get-caption paragraph) info)) + (org-html-standalone-image-predicate + 'org-html--has-caption-p)) + (if (not (org-string-nw-p raw)) raw + (concat + "" + (format (org-html--translate "Figure %d:" info) + (org-export-get-ordinal + (org-element-map paragraph 'link + 'identity info t) + info nil 'org-html-standalone-image-p)) + " " raw)))) + (label (org-element-property :name paragraph))) + (org-html--wrap-image contents info caption label))) + ;; Regular paragraph. + (t (format "\n%s

" extra contents))))) + +;;;; Plain List + +;; FIXME Maybe arg1 is not needed because
  • already sets +;; the correct value for the item counter +(defun org-html-begin-plain-list (type &optional arg1) + "Insert the beginning of the HTML list depending on TYPE. +When ARG1 is a string, use it as the start parameter for ordered +lists." + (case type + (ordered + (format "
      " + (if arg1 (format " start=\"%d\"" arg1) ""))) + (unordered "
        ") + (descriptive "
        "))) + +(defun org-html-end-plain-list (type) + "Insert the end of the HTML list depending on TYPE." + (case type + (ordered "
    ") + (unordered "") + (descriptive ""))) + +(defun org-html-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to HTML. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + (let* (arg1 ;; (assoc :counter (org-element-map plain-list 'item + (type (org-element-property :type plain-list))) + (format "%s\n%s%s" + (org-html-begin-plain-list type) + contents (org-html-end-plain-list type)))) + +;;;; Plain Text + +(defun org-html-convert-special-strings (string) + "Convert special characters in STRING to HTML." + (let ((all org-html-special-string-regexps) + e a re rpl start) + (while (setq a (pop all)) + (setq re (car a) rpl (cdr a) start 0) + (while (string-match re string start) + (setq string (replace-match rpl t nil string)))) + string)) + +(defun org-html-encode-plain-text (text) + "Convert plain text characters from TEXT to HTML equivalent. +Possible conversions are set in `org-html-protect-char-alist'." + (mapc + (lambda (pair) + (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))) + org-html-protect-char-alist) + text) + +(defun org-html-plain-text (text info) + "Transcode a TEXT string from Org to HTML. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + (let ((output text)) + ;; Protect following characters: <, >, &. + (setq output (org-html-encode-plain-text output)) + ;; Handle smart quotes. Be sure to provide original string since + ;; OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output (org-export-activate-smart-quotes output :html info text))) + ;; Handle special strings. + (when (plist-get info :with-special-strings) + (setq output (org-html-convert-special-strings output))) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output + (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" + (concat (org-html-close-tag "br" nil info) "\n") output))) + ;; Return value. + output)) + + +;; Planning + +(defun org-html-planning (planning contents info) + "Transcode a PLANNING element from Org to HTML. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let ((span-fmt "%s %s")) + (format + "

    %s

    " + (mapconcat + 'identity + (delq nil + (list + (let ((closed (org-element-property :closed planning))) + (when closed + (format span-fmt org-closed-string + (org-translate-time + (org-element-property :raw-value closed))))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (format span-fmt org-deadline-string + (org-translate-time + (org-element-property :raw-value deadline))))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (format span-fmt org-scheduled-string + (org-translate-time + (org-element-property :raw-value scheduled))))))) + " ")))) + +;;;; Property Drawer + +(defun org-html-property-drawer (property-drawer contents info) + "Transcode a PROPERTY-DRAWER element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + ;; The property drawer isn't exported but we want separating blank + ;; lines nonetheless. + "") + +;;;; Quote Block + +(defun org-html-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (format "
    \n%s
    " contents)) + +;;;; Quote Section + +(defun org-html-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (format "
    \n%s
    " value)))) + +;;;; Section + +(defun org-html-section (section contents info) + "Transcode a SECTION element from Org to HTML. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + (let ((parent (org-export-get-parent-headline section))) + ;; Before first headline: no container, just return CONTENTS. + (if (not parent) contents + ;; Get div's class and id references. + (let* ((class-num (+ (org-export-get-relative-level parent info) + (1- org-html-toplevel-hlevel))) + (section-number + (mapconcat + 'number-to-string + (org-export-get-headline-number parent info) "-"))) + ;; Build return value. + (format "
    \n%s
    " + class-num + (or (org-element-property :CUSTOM_ID parent) section-number) + contents))))) + +;;;; Radio Target + +(defun org-html-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to HTML. +TEXT is the text of the target. INFO is a plist holding +contextual information." + (let ((id (org-export-solidify-link-text + (org-element-property :value radio-target)))) + (org-html--anchor id text))) + +;;;; Special Block + +(defun org-html-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to HTML. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let* ((block-type (downcase + (org-element-property :type special-block))) + (contents (or contents "")) + (html5-fancy (and (org-html-html5-p info) + (plist-get info :html-html5-fancy) + (member block-type org-html-html5-elements))) + (attributes (org-export-read-attribute :attr_html special-block))) + (unless html5-fancy + (let ((class (plist-get attributes :class))) + (setq attributes (plist-put attributes :class + (if class (concat class " " block-type) + block-type))))) + (setq attributes (org-html--make-attribute-string attributes)) + (when (not (equal attributes "")) + (setq attributes (concat " " attributes))) + (if html5-fancy + (format "<%s%s>\n%s" block-type attributes + contents block-type) + (format "\n%s\n
  • " attributes contents)))) + +;;;; Src Block + +(defun org-html-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to HTML. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (if (org-export-read-attribute :attr_html src-block :textarea) + (org-html--textarea-block src-block) + (let ((lang (org-element-property :language src-block)) + (caption (org-export-get-caption src-block)) + (code (org-html-format-code src-block info)) + (label (let ((lbl (org-element-property :name src-block))) + (if (not lbl) "" + (format " id=\"%s\"" + (org-export-solidify-link-text lbl)))))) + (if (not lang) (format "
    \n%s
    " label code) + (format + "
    \n%s%s\n
    " + (if (not caption) "" + (format "" + (org-export-data caption info))) + (format "\n
    %s
    " lang label code)))))) + +;;;; Statistics Cookie + +(defun org-html-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((cookie-value (org-element-property :value statistics-cookie))) + (format "%s" cookie-value))) + +;;;; Strike-Through + +(defun org-html-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to HTML. +CONTENTS is the text with strike-through markup. INFO is a plist +holding contextual information." + (format (or (cdr (assq 'strike-through org-html-text-markup-alist)) "%s") + contents)) + +;;;; Subscript + +(defun org-html-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to HTML. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "%s" contents)) + +;;;; Superscript + +(defun org-html-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to HTML. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "%s" contents)) + +;;;; Table Cell + +(defun org-html-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to HTML. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let* ((table-row (org-export-get-parent table-cell)) + (table (org-export-get-parent-table table-cell)) + (cell-attrs + (if (not org-html-table-align-individual-fields) "" + (format (if (and (boundp 'org-html-format-table-no-css) + org-html-format-table-no-css) + " align=\"%s\"" " class=\"%s\"") + (org-export-table-cell-alignment table-cell info))))) + (when (or (not contents) (string= "" (org-trim contents))) + (setq contents " ")) + (cond + ((and (org-export-table-has-header-p table info) + (= 1 (org-export-table-row-group table-row info))) + (concat "\n" (format (car org-html-table-header-tags) "col" cell-attrs) + contents (cdr org-html-table-header-tags))) + ((and org-html-table-use-header-tags-for-first-column + (zerop (cdr (org-export-table-cell-address table-cell info)))) + (concat "\n" (format (car org-html-table-header-tags) "row" cell-attrs) + contents (cdr org-html-table-header-tags))) + (t (concat "\n" (format (car org-html-table-data-tags) cell-attrs) + contents (cdr org-html-table-data-tags)))))) + +;;;; Table Row + +(defun org-html-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to HTML. +CONTENTS is the contents of the row. INFO is a plist used as a +communication channel." + ;; Rules are ignored since table separators are deduced from + ;; borders of the current row. + (when (eq (org-element-property :type table-row) 'standard) + (let* ((rowgroup-number (org-export-table-row-group table-row info)) + (row-number (org-export-table-row-number table-row info)) + (start-rowgroup-p + (org-export-table-row-starts-rowgroup-p table-row info)) + (end-rowgroup-p + (org-export-table-row-ends-rowgroup-p table-row info)) + ;; `top-row-p' and `end-rowgroup-p' are not used directly + ;; but should be set so that `org-html-table-row-tags' can + ;; use them (see the docstring of this variable.) + (top-row-p (and (equal start-rowgroup-p '(top)) + (equal end-rowgroup-p '(below top)))) + (bottom-row-p (and (equal start-rowgroup-p '(above)) + (equal end-rowgroup-p '(bottom above)))) + (rowgroup-tags + (cond + ;; Case 1: Row belongs to second or subsequent rowgroups. + ((not (= 1 rowgroup-number)) + '("" . "\n")) + ;; Case 2: Row is from first rowgroup. Table has >=1 rowgroups. + ((org-export-table-has-header-p + (org-export-get-parent-table table-row) info) + '("" . "\n")) + ;; Case 2: Row is from first and only row group. + (t '("" . "\n"))))) + (concat + ;; Begin a rowgroup? + (when start-rowgroup-p (car rowgroup-tags)) + ;; Actual table row + (concat "\n" (eval (car org-html-table-row-tags)) + contents + "\n" + (eval (cdr org-html-table-row-tags))) + ;; End a rowgroup? + (when end-rowgroup-p (cdr rowgroup-tags)))))) + +;;;; Table + +(defun org-html-table-first-row-data-cells (table info) + "Transcode the first row of TABLE. +INFO is a plist used as a communication channel." + (let ((table-row + (org-element-map table 'table-row + (lambda (row) + (unless (eq (org-element-property :type row) 'rule) row)) + info 'first-match)) + (special-column-p (org-export-table-has-special-column-p table))) + (if (not special-column-p) (org-element-contents table-row) + (cdr (org-element-contents table-row))))) + +(defun org-html-table--table.el-table (table info) + "Format table.el tables into HTML. +INFO is a plist used as a communication channel." + (when (eq (org-element-property :type table) 'table.el) + (require 'table) + (let ((outbuf (with-current-buffer + (get-buffer-create "*org-export-table*") + (erase-buffer) (current-buffer)))) + (with-temp-buffer + (insert (org-element-property :value table)) + (goto-char 1) + (re-search-forward "^[ \t]*|[^|]" nil t) + (table-generate-source 'html outbuf)) + (with-current-buffer outbuf + (prog1 (org-trim (buffer-string)) + (kill-buffer) ))))) + +(defun org-html-table (table contents info) + "Transcode a TABLE element from Org to HTML. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (case (org-element-property :type table) + ;; Case 1: table.el table. Convert it using appropriate tools. + (table.el (org-html-table--table.el-table table info)) + ;; Case 2: Standard table. + (t + (let* ((label (org-element-property :name table)) + (caption (org-export-get-caption table)) + (number (org-export-get-ordinal + table info nil 'org-html--has-caption-p)) + (attributes + (org-html--make-attribute-string + (org-combine-plists + (and label (list :id (org-export-solidify-link-text label))) + (and (not (org-html-html5-p info)) + (plist-get info :html-table-attributes)) + (org-export-read-attribute :attr_html table)))) + (alignspec + (if (and (boundp 'org-html-format-table-no-css) + org-html-format-table-no-css) + "align=\"%s\"" "class=\"%s\"")) + (table-column-specs + (function + (lambda (table info) + (mapconcat + (lambda (table-cell) + (let ((alignment (org-export-table-cell-alignment + table-cell info))) + (concat + ;; Begin a colgroup? + (when (org-export-table-cell-starts-colgroup-p + table-cell info) + "\n") + ;; Add a column. Also specify it's alignment. + (format "\n%s" + (org-html-close-tag + "col" (concat " " (format alignspec alignment)) info)) + ;; End a colgroup? + (when (org-export-table-cell-ends-colgroup-p + table-cell info) + "\n")))) + (org-html-table-first-row-data-cells table info) "\n"))))) + (format "\n%s\n%s\n%s" + (if (equal attributes "") "" (concat " " attributes)) + (if (not caption) "" + (format (if org-html-table-caption-above + "%s" + "%s") + (concat + "" + (format (org-html--translate "Table %d:" info) number) + " " (org-export-data caption info)))) + (funcall table-column-specs table info) + contents))))) + +;;;; Target + +(defun org-html-target (target contents info) + "Transcode a TARGET object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((id (org-export-solidify-link-text + (org-element-property :value target)))) + (org-html--anchor id))) + +;;;; Timestamp + +(defun org-html-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((value (org-html-plain-text + (org-timestamp-translate timestamp) info))) + (format "%s" + (replace-regexp-in-string "--" "–" value)))) + +;;;; Underline + +(defun org-html-underline (underline contents info) + "Transcode UNDERLINE from Org to HTML. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (format (or (cdr (assq 'underline org-html-text-markup-alist)) "%s") + contents)) + +;;;; Verbatim + +(defun org-html-verbatim (verbatim contents info) + "Transcode VERBATIM from Org to HTML. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format (or (cdr (assq 'verbatim org-html-text-markup-alist)) "%s") + (org-html-encode-plain-text (org-element-property :value verbatim)))) + +;;;; Verse Block + +(defun org-html-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to HTML. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + ;; Replace each newline character with line break. Also replace + ;; each blank line with a line break. + (setq contents (replace-regexp-in-string + "^ *\\\\\\\\$" (format "%s\n" (org-html-close-tag "br" nil info)) + (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" + (format "%s\n" (org-html-close-tag "br" nil info)) contents))) + ;; Replace each white space at beginning of a line with a + ;; non-breaking space. + (while (string-match "^[ \t]+" contents) + (let* ((num-ws (length (match-string 0 contents))) + (ws (let (out) (dotimes (i num-ws out) + (setq out (concat out " ")))))) + (setq contents (replace-match ws nil t contents)))) + (format "

    \n%s

    " contents)) + + +;;; Filter Functions + +(defun org-html-final-function (contents backend info) + "Filter to indent the HTML and convert HTML entities." + (with-temp-buffer + (insert contents) + (set-auto-mode t) + (if org-html-indent + (indent-region (point-min) (point-max))) + (when org-html-use-unicode-chars + (require 'mm-url) + (mm-url-decode-entities)) + (buffer-substring-no-properties (point-min) (point-max)))) + + +;;; End-user functions + +;;;###autoload +(defun org-html-export-as-html + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to an HTML buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\" and \"\" tags. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org HTML Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil." + (interactive) + (org-export-to-buffer 'html "*Org HTML Export*" + async subtreep visible-only body-only ext-plist + (lambda () (set-auto-mode t)))) + +;;;###autoload +(defun org-html-convert-region-to-html () + "Assume the current region has org-mode syntax, and convert it to HTML. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in an HTML buffer and use this +command to convert it." + (interactive) + (org-export-replace-region-by 'html)) + +;;;###autoload +(defun org-html-export-to-html + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a HTML file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\" and \"\" tags. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let* ((extension (concat "." org-html-extension)) + (file (org-export-output-file-name extension subtreep)) + (org-export-coding-system org-html-coding-system)) + (org-export-to-file 'html file + async subtreep visible-only body-only ext-plist))) + +;;;###autoload +(defun org-html-publish-to-html (plist filename pub-dir) + "Publish an org file to HTML. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'html filename + (concat "." (or (plist-get plist :html-extension) + org-html-extension "html")) + plist pub-dir)) + + +(provide 'ox-html) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-html.el ends here diff --git a/elpa/org-20150427/ox-icalendar.el b/elpa/org-20150427/ox-icalendar.el new file mode 100644 index 00000000..cd48bbf9 --- /dev/null +++ b/elpa/org-20150427/ox-icalendar.el @@ -0,0 +1,984 @@ +;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine + +;; Copyright (C) 2004-2014 Free Software Foundation, Inc. + +;; Author: Carsten Dominik +;; Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: +;; +;; This library implements an iCalendar back-end for Org generic +;; exporter. See Org manual for more information. +;; +;; It is expected to conform to RFC 5545. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ox-ascii) +(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil) + + + +;;; User-Configurable Variables + +(defgroup org-export-icalendar nil + "Options specific for iCalendar export back-end." + :tag "Org Export iCalendar" + :group 'org-export) + +(defcustom org-icalendar-combined-agenda-file "~/org.ics" + "The file name for the iCalendar file covering all agenda files. +This file is created with the command \\[org-icalendar-combine-agenda-files]. +The file name should be absolute. It will be overwritten without warning." + :group 'org-export-icalendar + :type 'file) + +(defcustom org-icalendar-alarm-time 0 + "Number of minutes for triggering an alarm for exported timed events. + +A zero value (the default) turns off the definition of an alarm trigger +for timed events. If non-zero, alarms are created. + +- a single alarm per entry is defined +- The alarm will go off N minutes before the event +- only a DISPLAY action is defined." + :group 'org-export-icalendar + :version "24.1" + :type 'integer) + +(defcustom org-icalendar-combined-name "OrgMode" + "Calendar name for the combined iCalendar representing all agenda files." + :group 'org-export-icalendar + :type 'string) + +(defcustom org-icalendar-combined-description "" + "Calendar description for the combined iCalendar (all agenda files)." + :group 'org-export-icalendar + :type 'string) + +(defcustom org-icalendar-exclude-tags nil + "Tags that exclude a tree from export. +This variable allows to specify different exclude tags from other +back-ends. It can also be set with the ICAL_EXCLUDE_TAGS +keyword." + :group 'org-export-icalendar + :type '(repeat (string :tag "Tag"))) + +(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due) + "Contexts where iCalendar 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 'org-export-icalendar + :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-icalendar-use-scheduled '(todo-start) + "Contexts where iCalendar 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 'org-export-icalendar + :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-icalendar-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 'org-export-icalendar + :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-icalendar-with-timestamps 'active + "Non-nil means make an event from plain time stamps. + +It can be set to `active', `inactive', t or nil, in order to make +an event from, respectively, only active timestamps, only +inactive ones, all of them or none. + +This variable has precedence over `org-export-with-timestamps'. +It can also be set with the #+OPTIONS line, e.g. \"<:t\"." + :group 'org-export-icalendar + :type '(choice + (const :tag "All timestamps" t) + (const :tag "Only active timestamps" active) + (const :tag "Only inactive timestamps" inactive) + (const :tag "No timestamp" nil))) + +(defcustom org-icalendar-include-todo nil + "Non-nil means create VTODO components from TODO items. + +Valid values are: +nil don't include any task. +t include tasks that are not in DONE state. +`unblocked' include all TODO items that are not blocked. +`all' include both done and not done items." + :group 'org-export-icalendar + :type '(choice + (const :tag "None" nil) + (const :tag "Unfinished" t) + (const :tag "Unblocked" unblocked) + (const :tag "All" all) + (repeat :tag "Specific TODO keywords" + (string :tag "Keyword")))) + +(defcustom org-icalendar-include-bbdb-anniversaries nil + "Non-nil means a combined iCalendar file should include anniversaries. +The anniversaries are defined in the BBDB database." + :group 'org-export-icalendar + :type 'boolean) + +(defcustom org-icalendar-include-sexps t + "Non-nil means export to iCalendar files should also cover sexp entries. +These are entries like in the diary, but directly in an Org file." + :group 'org-export-icalendar + :type 'boolean) + +(defcustom org-icalendar-include-body t + "Amount of text below headline to be included in iCalendar 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 'org-export-icalendar + :type '(choice + (const :tag "Nothing" nil) + (const :tag "Everything" t) + (integer :tag "Max characters"))) + +(defcustom org-icalendar-store-UID nil + "Non-nil means store any created UIDs in properties. + +The iCalendar standard requires that all entries have a unique identifier. +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, +superseding 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 'org-export-icalendar + :type 'boolean) + +(defcustom org-icalendar-timezone (getenv "TZ") + "The time zone string for iCalendar export. +When nil or the empty string, use output +from (current-time-zone)." + :group 'org-export-icalendar + :type '(choice + (const :tag "Unspecified" nil) + (string :tag "Time zone"))) + +(defcustom org-icalendar-date-time-format ":%Y%m%dT%H%M%S" + "Format-string for exporting icalendar DATE-TIME. + +See `format-time-string' for a full documentation. The only +difference is that `org-icalendar-timezone' is used for %Z. + +Interesting value are: + - \":%Y%m%dT%H%M%S\" for local time + - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone + - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time" + :group 'org-export-icalendar + :version "24.1" + :type '(choice + (const :tag "Local time" ":%Y%m%dT%H%M%S") + (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S") + (const :tag "Universal time" ":%Y%m%dT%H%M%SZ") + (string :tag "Explicit format"))) + +(defvar org-icalendar-after-save-hook nil + "Hook run after an iCalendar file has been saved. +This hook is run with the name of the file as argument. A good +way to use this is to tell a desktop calendar application to +re-read the iCalendar file.") + + + +;;; Define Back-End + +(org-export-define-derived-backend 'icalendar 'ascii + :translate-alist '((clock . ignore) + (footnote-definition . ignore) + (footnote-reference . ignore) + (headline . org-icalendar-entry) + (inlinetask . ignore) + (planning . ignore) + (section . ignore) + (inner-template . (lambda (c i) c)) + (template . org-icalendar-template)) + :options-alist + '((:exclude-tags + "ICALENDAR_EXCLUDE_TAGS" nil org-icalendar-exclude-tags split) + (:with-timestamps nil "<" org-icalendar-with-timestamps) + (:with-vtodo nil nil org-icalendar-include-todo) + ;; The following property will be non-nil when export has been + ;; started from org-agenda-mode. In this case, any entry without + ;; a non-nil "ICALENDAR_MARK" property will be ignored. + (:icalendar-agenda-view nil nil nil)) + :filters-alist + '((:filter-headline . org-icalendar-clear-blank-lines)) + :menu-entry + '(?c "Export to iCalendar" + ((?f "Current file" org-icalendar-export-to-ics) + (?a "All agenda files" + (lambda (a s v b) (org-icalendar-export-agenda-files a))) + (?c "Combine all agenda files" + (lambda (a s v b) (org-icalendar-combine-agenda-files a)))))) + + + +;;; Internal Functions + +(defun org-icalendar-create-uid (file &optional bell h-markers) + "Set ID property on headlines missing it in FILE. +When optional argument BELL is non-nil, inform the user with +a message if the file was modified. With optional argument +H-MARKERS non-nil, it is a list of markers for the headlines +which will be updated." + (let ((pt (if h-markers (goto-char (car h-markers)) (point-min))) + modified-flag) + (org-map-entries + (lambda () + (let ((entry (org-element-at-point))) + (unless (or (< (point) pt) (org-element-property :ID entry)) + (org-id-get-create) + (setq modified-flag t) + (forward-line)) + (when h-markers (setq org-map-continue-from (pop h-markers))))) + nil nil 'comment) + (when (and bell modified-flag) + (message "ID properties created in file \"%s\"" file) + (sit-for 2)))) + +(defun org-icalendar-blocked-headline-p (headline info) + "Non-nil when HEADLINE is considered to be blocked. + +INFO is a plist used as a communication channel. + +A headline is blocked when either + + - it has children which are not all in a completed state; + + - it has a parent with the property :ORDERED:, and there are + siblings prior to it with incomplete status; + + - its parent is blocked because it has siblings that should be + done first or is a child of a blocked grandparent entry." + (or + ;; Check if any child is not done. + (org-element-map headline 'headline + (lambda (hl) (eq (org-element-property :todo-type hl) 'todo)) + info 'first-match) + ;; Check :ORDERED: node property. + (catch 'blockedp + (let ((current headline)) + (mapc (lambda (parent) + (cond + ((not (org-element-property :todo-keyword parent)) + (throw 'blockedp nil)) + ((org-not-nil (org-element-property :ORDERED parent)) + (let ((sibling current)) + (while (setq sibling (org-export-get-previous-element + sibling info)) + (when (eq (org-element-property :todo-type sibling) 'todo) + (throw 'blockedp t))))) + (t (setq current parent)))) + (org-export-get-genealogy headline)) + nil)))) + +(defun org-icalendar-use-UTC-date-time-p () + "Non-nil when `org-icalendar-date-time-format' requires UTC time." + (char-equal (elt org-icalendar-date-time-format + (1- (length org-icalendar-date-time-format))) ?Z)) + +(defvar org-agenda-default-appointment-duration) ; From org-agenda.el. +(defun org-icalendar-convert-timestamp (timestamp keyword &optional end utc) + "Convert TIMESTAMP to iCalendar format. + +TIMESTAMP is a timestamp object. KEYWORD is added in front of +it, in order to make a complete line (e.g. \"DTSTART\"). + +When optional argument END is non-nil, use end of time range. +Also increase the hour by two (if time string contains a time), +or the day by one (if it does not contain a time) when no +explicit ending time is specified. + +When optional argument UTC is non-nil, time will be expressed in +Universal Time, ignoring `org-icalendar-date-time-format'." + (let* ((year-start (org-element-property :year-start timestamp)) + (year-end (org-element-property :year-end timestamp)) + (month-start (org-element-property :month-start timestamp)) + (month-end (org-element-property :month-end timestamp)) + (day-start (org-element-property :day-start timestamp)) + (day-end (org-element-property :day-end timestamp)) + (hour-start (org-element-property :hour-start timestamp)) + (hour-end (org-element-property :hour-end timestamp)) + (minute-start (org-element-property :minute-start timestamp)) + (minute-end (org-element-property :minute-end timestamp)) + (with-time-p minute-start) + (equal-bounds-p + (equal (list year-start month-start day-start hour-start minute-start) + (list year-end month-end day-end hour-end minute-end))) + (mi (cond ((not with-time-p) 0) + ((not end) minute-start) + ((and org-agenda-default-appointment-duration equal-bounds-p) + (+ minute-end org-agenda-default-appointment-duration)) + (t minute-end))) + (h (cond ((not with-time-p) 0) + ((not end) hour-start) + ((or (not equal-bounds-p) + org-agenda-default-appointment-duration) + hour-end) + (t (+ hour-end 2)))) + (d (cond ((not end) day-start) + ((not with-time-p) (1+ day-end)) + (t day-end))) + (m (if end month-end month-start)) + (y (if end year-end year-start))) + (concat + keyword + (format-time-string + (cond (utc ":%Y%m%dT%H%M%SZ") + ((not with-time-p) ";VALUE=DATE:%Y%m%d") + (t (replace-regexp-in-string "%Z" + org-icalendar-timezone + org-icalendar-date-time-format + t))) + ;; Convert timestamp into internal time in order to use + ;; `format-time-string' and fix any mistake (i.e. MI >= 60). + (encode-time 0 mi h d m y) + (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p))))))) + +(defun org-icalendar-dtstamp () + "Return DTSTAMP property, as a string." + (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) + +(defun org-icalendar-get-categories (entry info) + "Return categories according to `org-icalendar-categories'. +ENTRY is a headline or an inlinetask element. INFO is a plist +used as a communication channel." + (mapconcat + 'identity + (org-uniquify + (let (categories) + (mapc (lambda (type) + (case type + (category + (push (org-export-get-category entry info) categories)) + (todo-state + (let ((todo (org-element-property :todo-keyword entry))) + (and todo (push todo categories)))) + (local-tags + (setq categories + (append (nreverse (org-export-get-tags entry info)) + categories))) + (all-tags + (setq categories + (append (nreverse (org-export-get-tags entry info nil t)) + categories))))) + org-icalendar-categories) + ;; Return list of categories, following specified order. + (nreverse categories))) ",")) + +(defun org-icalendar-transcode-diary-sexp (sexp uid summary) + "Transcode a diary sexp into iCalendar format. +SEXP is the diary sexp being transcoded, as a string. UID is the +unique identifier for the entry. SUMMARY defines a short summary +or subject for the event." + (when (require 'icalendar nil t) + (org-element-normalize-string + (with-temp-buffer + (let ((sexp (if (not (string-match "\\`<%%" sexp)) sexp + (concat (substring sexp 1 -1) " " summary)))) + (put-text-property 0 1 'uid uid sexp) + (insert sexp "\n")) + (org-diary-to-ical-string (current-buffer)))))) + +(defun org-icalendar-cleanup-string (s) + "Cleanup string S according to RFC 5545." + (when s + ;; Protect "\", "," and ";" characters. and replace newline + ;; characters with literal \n. + (replace-regexp-in-string + "[ \t]*\n" "\\n" + (replace-regexp-in-string "[\\,;]" "\\\&" s) + nil t))) + +(defun org-icalendar-fold-string (s) + "Fold string S according to RFC 5545." + (org-element-normalize-string + (mapconcat + (lambda (line) + ;; Limit each line to a maximum of 75 characters. If it is + ;; longer, fold it by using "\n " as a continuation marker. + (let ((len (length line))) + (if (<= len 75) line + (let ((folded-line (substring line 0 75)) + (chunk-start 75) + chunk-end) + ;; Since continuation marker takes up one character on the + ;; line, real contents must be split at 74 chars. + (while (< (setq chunk-end (+ chunk-start 74)) len) + (setq folded-line + (concat folded-line "\n " + (substring line chunk-start chunk-end)) + chunk-start chunk-end)) + (concat folded-line "\n " (substring line chunk-start)))))) + (org-split-string s "\n") "\n"))) + + + +;;; Filters + +(defun org-icalendar-clear-blank-lines (headline back-end info) + "Remove blank lines in HEADLINE export. +HEADLINE is a string representing a transcoded headline. +BACK-END and INFO are ignored." + (replace-regexp-in-string "^\\(?:[ \t]*\n\\)+" "" headline)) + + + +;;; Transcode Functions + +;;;; Headline and Inlinetasks + +;; The main function is `org-icalendar-entry', which extracts +;; information from a headline or an inlinetask (summary, +;; description...) and then delegates code generation to +;; `org-icalendar--vtodo' and `org-icalendar--vevent', depending +;; on the component needed. + +;; Obviously, `org-icalendar--valarm' handles alarms, which can +;; happen within a VTODO component. + +(defun org-icalendar-entry (entry contents info) + "Transcode ENTRY element into iCalendar format. + +ENTRY is either a headline or an inlinetask. CONTENTS is +ignored. INFO is a plist used as a communication channel. + +This function is called on every headline, the section below +it (minus inlinetasks) being its contents. It tries to create +VEVENT and VTODO components out of scheduled date, deadline date, +plain timestamps, diary sexps. It also calls itself on every +inlinetask within the section." + (unless (org-element-property :footnote-section-p entry) + (let* ((type (org-element-type entry)) + ;; Determine contents really associated to the entry. For + ;; a headline, limit them to section, if any. For an + ;; inlinetask, this is every element within the task. + (inside + (if (eq type 'inlinetask) + (cons 'org-data (cons nil (org-element-contents entry))) + (let ((first (car (org-element-contents entry)))) + (and (eq (org-element-type first) 'section) + (cons 'org-data + (cons nil (org-element-contents first)))))))) + (concat + (unless (and (plist-get info :icalendar-agenda-view) + (not (org-element-property :ICALENDAR-MARK entry))) + (let ((todo-type (org-element-property :todo-type entry)) + (uid (or (org-element-property :ID entry) (org-id-new))) + (summary (org-icalendar-cleanup-string + (or (org-element-property :SUMMARY entry) + (org-export-data + (org-element-property :title entry) info)))) + (loc (org-icalendar-cleanup-string + (org-element-property :LOCATION entry))) + ;; Build description of the entry from associated + ;; section (headline) or contents (inlinetask). + (desc + (org-icalendar-cleanup-string + (or (org-element-property :DESCRIPTION entry) + (let ((contents (org-export-data inside info))) + (cond + ((not (org-string-nw-p contents)) nil) + ((wholenump org-icalendar-include-body) + (let ((contents (org-trim contents))) + (substring + contents 0 (min (length contents) + org-icalendar-include-body)))) + (org-icalendar-include-body (org-trim contents))))))) + (cat (org-icalendar-get-categories entry info))) + (concat + ;; Events: Delegate to `org-icalendar--vevent' to + ;; generate "VEVENT" component from scheduled, deadline, + ;; or any timestamp in the entry. + (let ((deadline (org-element-property :deadline entry))) + (and deadline + (memq (if todo-type 'event-if-todo 'event-if-not-todo) + org-icalendar-use-deadline) + (org-icalendar--vevent + entry deadline (concat "DL-" uid) + (concat "DL: " summary) loc desc cat))) + (let ((scheduled (org-element-property :scheduled entry))) + (and scheduled + (memq (if todo-type 'event-if-todo 'event-if-not-todo) + org-icalendar-use-scheduled) + (org-icalendar--vevent + entry scheduled (concat "SC-" uid) + (concat "S: " summary) loc desc cat))) + ;; When collecting plain timestamps from a headline and + ;; its title, skip inlinetasks since collection will + ;; happen once ENTRY is one of them. + (let ((counter 0)) + (mapconcat + #'identity + (org-element-map (cons (org-element-property :title entry) + (org-element-contents inside)) + 'timestamp + (lambda (ts) + (when (let ((type (org-element-property :type ts))) + (case (plist-get info :with-timestamps) + (active (memq type '(active active-range))) + (inactive (memq type '(inactive inactive-range))) + ((t) t))) + (let ((uid (format "TS%d-%s" (incf counter) uid))) + (org-icalendar--vevent + entry ts uid summary loc desc cat)))) + info nil (and (eq type 'headline) 'inlinetask)) + "")) + ;; Task: First check if it is appropriate to export it. + ;; If so, call `org-icalendar--vtodo' to transcode it + ;; into a "VTODO" component. + (when (and todo-type + (case (plist-get info :with-vtodo) + (all t) + (unblocked + (and (eq type 'headline) + (not (org-icalendar-blocked-headline-p + entry info)))) + ((t) (eq todo-type 'todo)))) + (org-icalendar--vtodo entry uid summary loc desc cat)) + ;; Diary-sexp: Collect every diary-sexp element within + ;; ENTRY and its title, and transcode them. If ENTRY is + ;; a headline, skip inlinetasks: they will be handled + ;; separately. + (when org-icalendar-include-sexps + (let ((counter 0)) + (mapconcat #'identity + (org-element-map + (cons (org-element-property :title entry) + (org-element-contents inside)) + 'diary-sexp + (lambda (sexp) + (org-icalendar-transcode-diary-sexp + (org-element-property :value sexp) + (format "DS%d-%s" (incf counter) uid) + summary)) + info nil (and (eq type 'headline) 'inlinetask)) + "")))))) + ;; If ENTRY is a headline, call current function on every + ;; inlinetask within it. In agenda export, this is independent + ;; from the mark (or lack thereof) on the entry. + (when (eq type 'headline) + (mapconcat #'identity + (org-element-map inside 'inlinetask + (lambda (task) (org-icalendar-entry task nil info)) + info) "")) + ;; Don't forget components from inner entries. + contents)))) + +(defun org-icalendar--vevent + (entry timestamp uid summary location description categories) + "Create a VEVENT component. + +ENTRY is either a headline or an inlinetask element. TIMESTAMP +is a timestamp object defining the date-time of the event. UID +is the unique identifier for the event. SUMMARY defines a short +summary or subject for the event. LOCATION defines the intended +venue for the event. DESCRIPTION provides the complete +description of the event. CATEGORIES defines the categories the +event belongs to. + +Return VEVENT component as a string." + (org-icalendar-fold-string + (if (eq (org-element-property :type timestamp) 'diary) + (org-icalendar-transcode-diary-sexp + (org-element-property :raw-value timestamp) uid summary) + (concat "BEGIN:VEVENT\n" + (org-icalendar-dtstamp) "\n" + "UID:" uid "\n" + (org-icalendar-convert-timestamp timestamp "DTSTART") "\n" + (org-icalendar-convert-timestamp timestamp "DTEND" t) "\n" + ;; RRULE. + (when (org-element-property :repeater-type timestamp) + (format "RRULE:FREQ=%s;INTERVAL=%d\n" + (case (org-element-property :repeater-unit timestamp) + (hour "HOURLY") (day "DAILY") (week "WEEKLY") + (month "MONTHLY") (year "YEARLY")) + (org-element-property :repeater-value timestamp))) + "SUMMARY:" summary "\n" + (and (org-string-nw-p location) (format "LOCATION:%s\n" location)) + (and (org-string-nw-p description) + (format "DESCRIPTION:%s\n" description)) + "CATEGORIES:" categories "\n" + ;; VALARM. + (org-icalendar--valarm entry timestamp summary) + "END:VEVENT")))) + +(defun org-icalendar--vtodo + (entry uid summary location description categories) + "Create a VTODO component. + +ENTRY is either a headline or an inlinetask element. UID is the +unique identifier for the task. SUMMARY defines a short summary +or subject for the task. LOCATION defines the intended venue for +the task. DESCRIPTION provides the complete description of the +task. CATEGORIES defines the categories the task belongs to. + +Return VTODO component as a string." + (let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled) + (org-element-property :scheduled entry)) + ;; If we can't use a scheduled time for some + ;; reason, start task now. + (let ((now (decode-time (current-time)))) + (list 'timestamp + (list :type 'active + :minute-start (nth 1 now) + :hour-start (nth 2 now) + :day-start (nth 3 now) + :month-start (nth 4 now) + :year-start (nth 5 now))))))) + (org-icalendar-fold-string + (concat "BEGIN:VTODO\n" + "UID:TODO-" uid "\n" + (org-icalendar-dtstamp) "\n" + (org-icalendar-convert-timestamp start "DTSTART") "\n" + (and (memq 'todo-due org-icalendar-use-deadline) + (org-element-property :deadline entry) + (concat (org-icalendar-convert-timestamp + (org-element-property :deadline entry) "DUE") + "\n")) + "SUMMARY:" summary "\n" + (and (org-string-nw-p location) (format "LOCATION:%s\n" location)) + (and (org-string-nw-p description) + (format "DESCRIPTION:%s\n" description)) + "CATEGORIES:" categories "\n" + "SEQUENCE:1\n" + (format "PRIORITY:%d\n" + (let ((pri (or (org-element-property :priority entry) + org-default-priority))) + (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri)) + (- org-lowest-priority + org-highest-priority))))))) + (format "STATUS:%s\n" + (if (eq (org-element-property :todo-type entry) 'todo) + "NEEDS-ACTION" + "COMPLETED")) + "END:VTODO")))) + +(defun org-icalendar--valarm (entry timestamp summary) + "Create a VALARM component. + +ENTRY is the calendar entry triggering the alarm. TIMESTAMP is +the start date-time of the entry. SUMMARY defines a short +summary or subject for the task. + +Return VALARM component as a string, or nil if it isn't allowed." + ;; Create a VALARM entry if the entry is timed. This is not very + ;; general in that: + ;; (a) only one alarm per entry is defined, + ;; (b) only minutes are allowed for the trigger period ahead of the + ;; start time, + ;; (c) only a DISPLAY action is defined. [ESF] + (let ((alarm-time + (let ((warntime + (org-element-property :APPT_WARNTIME entry))) + (if warntime (string-to-number warntime) 0)))) + (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0)) + (org-element-property :hour-start timestamp) + (format "BEGIN:VALARM +ACTION:DISPLAY +DESCRIPTION:%s +TRIGGER:-P0DT0H%dM0S +END:VALARM\n" + summary + (if (zerop alarm-time) org-icalendar-alarm-time alarm-time))))) + + +;;;; Template + +(defun org-icalendar-template (contents info) + "Return complete document string after iCalendar conversion. +CONTENTS is the transcoded contents string. INFO is a plist used +as a communication channel." + (org-icalendar--vcalendar + ;; Name. + (if (not (plist-get info :input-file)) (buffer-name (buffer-base-buffer)) + (file-name-nondirectory + (file-name-sans-extension (plist-get info :input-file)))) + ;; Owner. + (if (not (plist-get info :with-author)) "" + (org-export-data (plist-get info :author) info)) + ;; Timezone. + (if (org-string-nw-p org-icalendar-timezone) org-icalendar-timezone + (cadr (current-time-zone))) + ;; Description. + (org-export-data (plist-get info :title) info) + contents)) + +(defun org-icalendar--vcalendar (name owner tz description contents) + "Create a VCALENDAR component. +NAME, OWNER, TZ, DESCRIPTION and CONTENTS are all strings giving, +respectively, the name of the calendar, its owner, the timezone +used, a short description and the other components included." + (concat (format "BEGIN:VCALENDAR +VERSION:2.0 +X-WR-CALNAME:%s +PRODID:-//%s//Emacs with Org mode//EN +X-WR-TIMEZONE:%s +X-WR-CALDESC:%s +CALSCALE:GREGORIAN\n" + (org-icalendar-cleanup-string name) + (org-icalendar-cleanup-string owner) + (org-icalendar-cleanup-string tz) + (org-icalendar-cleanup-string description)) + contents + "END:VCALENDAR\n")) + + + +;;; Interactive Functions + +;;;###autoload +(defun org-icalendar-export-to-ics + (&optional async subtreep visible-only body-only) + "Export current buffer to an iCalendar file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"BEGIN:VCALENDAR\" and \"END:VCALENDAR\". + +Return ICS file name." + (interactive) + (let ((file (buffer-file-name (buffer-base-buffer)))) + (when (and file org-icalendar-store-UID) + (org-icalendar-create-uid file 'warn-user))) + ;; Export part. Since this back-end is backed up by `ascii', ensure + ;; links will not be collected at the end of sections. + (let ((outfile (org-export-output-file-name ".ics" subtreep))) + (org-export-to-file 'icalendar outfile + async subtreep visible-only body-only '(:ascii-charset utf-8) + (lambda (file) + (run-hook-with-args 'org-icalendar-after-save-hook file) nil)))) + +;;;###autoload +(defun org-icalendar-export-agenda-files (&optional async) + "Export all agenda files to iCalendar files. +When optional argument ASYNC is non-nil, export happens in an +external process." + (interactive) + (if async + ;; Asynchronous export is not interactive, so we will not call + ;; `org-check-agenda-file'. Instead we remove any non-existent + ;; agenda file from the list. + (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t)))) + (org-export-async-start + (lambda (results) + (mapc (lambda (f) (org-export-add-to-stack f 'icalendar)) + results)) + `(let (output-files) + (mapc (lambda (file) + (with-current-buffer (org-get-agenda-file-buffer file) + (push (expand-file-name (org-icalendar-export-to-ics)) + output-files))) + ',files) + output-files))) + (let ((files (org-agenda-files t))) + (org-agenda-prepare-buffers files) + (unwind-protect + (mapc (lambda (file) + (catch 'nextfile + (org-check-agenda-file file) + (with-current-buffer (org-get-agenda-file-buffer file) + (org-icalendar-export-to-ics)))) + files) + (org-release-buffers org-agenda-new-buffers))))) + +;;;###autoload +(defun org-icalendar-combine-agenda-files (&optional async) + "Combine all agenda files into a single iCalendar file. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +The file is stored under the name chosen in +`org-icalendar-combined-agenda-file'." + (interactive) + (if async + (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t)))) + (org-export-async-start + (lambda (dummy) + (org-export-add-to-stack + (expand-file-name org-icalendar-combined-agenda-file) + 'icalendar)) + `(apply 'org-icalendar--combine-files nil ',files))) + (apply 'org-icalendar--combine-files nil (org-agenda-files t)))) + +(defun org-icalendar-export-current-agenda (file) + "Export current agenda view to an iCalendar FILE. +This function assumes major mode for current buffer is +`org-agenda-mode'." + (let (org-export-babel-evaluate ; Don't evaluate Babel block + (org-icalendar-combined-agenda-file file) + (marker-list + ;; Collect the markers pointing to entries in the current + ;; agenda buffer. + (let (markers) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (let ((m (or (org-get-at-bol 'org-hd-marker) + (org-get-at-bol 'org-marker)))) + (and m (push m markers))) + (beginning-of-line 2))) + (nreverse markers)))) + (apply 'org-icalendar--combine-files + ;; Build restriction alist. + (let (restriction) + ;; Sort markers in each association within RESTRICTION. + (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x) + (dolist (m marker-list restriction) + (let* ((pos (marker-position m)) + (file (buffer-file-name + (org-base-buffer (marker-buffer m)))) + (file-markers (assoc file restriction))) + ;; Add POS in FILE association if one exists + ;; or create a new association for FILE. + (if file-markers (push pos (cdr file-markers)) + (push (list file pos) restriction)))))) + (org-agenda-files nil 'ifmode)))) + +(defun org-icalendar--combine-files (restriction &rest files) + "Combine entries from multiple files into an iCalendar file. +RESTRICTION, when non-nil, is an alist where key is a file name +and value a list of buffer positions pointing to entries that +should appear in the calendar. It only makes sense if the +function was called from an agenda buffer. FILES is a list of +files to build the calendar from." + (org-agenda-prepare-buffers files) + (unwind-protect + (progn + (with-temp-file org-icalendar-combined-agenda-file + (insert + (org-icalendar--vcalendar + ;; Name. + org-icalendar-combined-name + ;; Owner. + user-full-name + ;; Timezone. + (or (org-string-nw-p org-icalendar-timezone) + (cadr (current-time-zone))) + ;; Description. + org-icalendar-combined-description + ;; Contents. + (concat + ;; Agenda contents. + (mapconcat + (lambda (file) + (catch 'nextfile + (org-check-agenda-file file) + (with-current-buffer (org-get-agenda-file-buffer file) + (let ((marks (cdr (assoc (expand-file-name file) + restriction)))) + ;; Create ID if necessary. + (when org-icalendar-store-UID + (org-icalendar-create-uid file t marks)) + (unless (and restriction (not marks)) + ;; Add a hook adding :ICALENDAR_MARK: property + ;; to each entry appearing in agenda view. + ;; Use `apply-partially' because the function + ;; still has to accept one argument. + (let ((org-export-before-processing-hook + (cons (apply-partially + (lambda (m-list dummy) + (mapc (lambda (m) + (org-entry-put + m "ICALENDAR-MARK" "t")) + m-list)) + (sort marks '>)) + org-export-before-processing-hook))) + (org-export-as + 'icalendar nil nil t + (list :ascii-charset 'utf-8 + :icalendar-agenda-view restriction)))))))) + files "") + ;; BBDB anniversaries. + (when (and org-icalendar-include-bbdb-anniversaries + (require 'org-bbdb nil t)) + (with-output-to-string (org-bbdb-anniv-export-ical))))))) + (run-hook-with-args 'org-icalendar-after-save-hook + org-icalendar-combined-agenda-file)) + (org-release-buffers org-agenda-new-buffers))) + + +(provide 'ox-icalendar) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-icalendar.el ends here diff --git a/elpa/org-20150427/ox-latex.el b/elpa/org-20150427/ox-latex.el new file mode 100644 index 00000000..2c71f7d7 --- /dev/null +++ b/elpa/org-20150427/ox-latex.el @@ -0,0 +1,2951 @@ +;;; ox-latex.el --- LaTeX Back-End for Org Export Engine + +;; Copyright (C) 2011-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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 . + +;;; Commentary: +;; +;; See Org manual for details. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ox) +(require 'ox-publish) + +(defvar org-latex-default-packages-alist) +(defvar org-latex-packages-alist) +(defvar orgtbl-exp-regexp) + + + +;;; Define Back-End + +(org-export-define-backend 'latex + '((bold . org-latex-bold) + (center-block . org-latex-center-block) + (clock . org-latex-clock) + (code . org-latex-code) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (drawer . org-latex-drawer) + (dynamic-block . org-latex-dynamic-block) + (entity . org-latex-entity) + (example-block . org-latex-example-block) + (export-block . org-latex-export-block) + (export-snippet . org-latex-export-snippet) + (fixed-width . org-latex-fixed-width) + (footnote-definition . org-latex-footnote-definition) + (footnote-reference . org-latex-footnote-reference) + (headline . org-latex-headline) + (horizontal-rule . org-latex-horizontal-rule) + (inline-src-block . org-latex-inline-src-block) + (inlinetask . org-latex-inlinetask) + (italic . org-latex-italic) + (item . org-latex-item) + (keyword . org-latex-keyword) + (latex-environment . org-latex-latex-environment) + (latex-fragment . org-latex-latex-fragment) + (line-break . org-latex-line-break) + (link . org-latex-link) + (paragraph . org-latex-paragraph) + (plain-list . org-latex-plain-list) + (plain-text . org-latex-plain-text) + (planning . org-latex-planning) + (property-drawer . (lambda (&rest args) "")) + (quote-block . org-latex-quote-block) + (quote-section . org-latex-quote-section) + (radio-target . org-latex-radio-target) + (section . org-latex-section) + (special-block . org-latex-special-block) + (src-block . org-latex-src-block) + (statistics-cookie . org-latex-statistics-cookie) + (strike-through . org-latex-strike-through) + (subscript . org-latex-subscript) + (superscript . org-latex-superscript) + (table . org-latex-table) + (table-cell . org-latex-table-cell) + (table-row . org-latex-table-row) + (target . org-latex-target) + (template . org-latex-template) + (timestamp . org-latex-timestamp) + (underline . org-latex-underline) + (verbatim . org-latex-verbatim) + (verse-block . org-latex-verse-block)) + :export-block '("LATEX" "TEX") + :menu-entry + '(?l "Export to LaTeX" + ((?L "As LaTeX buffer" org-latex-export-as-latex) + (?l "As LaTeX file" org-latex-export-to-latex) + (?p "As PDF file" org-latex-export-to-pdf) + (?o "As PDF file and open" + (lambda (a s v b) + (if a (org-latex-export-to-pdf t s v b) + (org-open-file (org-latex-export-to-pdf nil s v b))))))) + :options-alist '((:latex-class "LATEX_CLASS" nil org-latex-default-class t) + (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t) + (:latex-header "LATEX_HEADER" nil nil newline) + (:latex-header-extra "LATEX_HEADER_EXTRA" nil nil newline) + (:latex-hyperref-p nil "texht" org-latex-with-hyperref t) + ;; Redefine regular options. + (:date "DATE" nil "\\today" t))) + + + +;;; Internal Variables + +(defconst org-latex-babel-language-alist + '(("af" . "afrikaans") + ("bg" . "bulgarian") + ("bt-br" . "brazilian") + ("ca" . "catalan") + ("cs" . "czech") + ("cy" . "welsh") + ("da" . "danish") + ("de" . "germanb") + ("de-at" . "naustrian") + ("de-de" . "ngerman") + ("el" . "greek") + ("en" . "english") + ("en-au" . "australian") + ("en-ca" . "canadian") + ("en-gb" . "british") + ("en-ie" . "irish") + ("en-nz" . "newzealand") + ("en-us" . "american") + ("es" . "spanish") + ("et" . "estonian") + ("eu" . "basque") + ("fi" . "finnish") + ("fr" . "frenchb") + ("fr-ca" . "canadien") + ("gl" . "galician") + ("hr" . "croatian") + ("hu" . "hungarian") + ("id" . "indonesian") + ("is" . "icelandic") + ("it" . "italian") + ("la" . "latin") + ("ms" . "malay") + ("nl" . "dutch") + ("nb" . "norsk") + ("nn" . "nynorsk") + ("no" . "norsk") + ("pl" . "polish") + ("pt" . "portuguese") + ("ro" . "romanian") + ("ru" . "russian") + ("sa" . "sanskrit") + ("sb" . "uppersorbian") + ("sk" . "slovak") + ("sl" . "slovene") + ("sq" . "albanian") + ("sr" . "serbian") + ("sv" . "swedish") + ("ta" . "tamil") + ("tr" . "turkish") + ("uk" . "ukrainian")) + "Alist between language code and corresponding Babel option.") + +(defconst org-latex-table-matrix-macros '(("bordermatrix" . "\\cr") + ("qbordermatrix" . "\\cr") + ("kbordermatrix" . "\\\\")) + "Alist between matrix macros and their row ending.") + + + +;;; User Configurable Variables + +(defgroup org-export-latex nil + "Options for exporting Org mode files to LaTeX." + :tag "Org Export LaTeX" + :group 'org-export) + + +;;;; Preamble + +(defcustom org-latex-default-class "article" + "The default LaTeX class." + :group 'org-export-latex + :type '(string :tag "LaTeX class")) + +(defcustom org-latex-classes + '(("article" + "\\documentclass[11pt]{article}" + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}") + ("\\paragraph{%s}" . "\\paragraph*{%s}") + ("\\subparagraph{%s}" . "\\subparagraph*{%s}")) + ("report" + "\\documentclass[11pt]{report}" + ("\\part{%s}" . "\\part*{%s}") + ("\\chapter{%s}" . "\\chapter*{%s}") + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) + ("book" + "\\documentclass[11pt]{book}" + ("\\part{%s}" . "\\part*{%s}") + ("\\chapter{%s}" . "\\chapter*{%s}") + ("\\section{%s}" . "\\section*{%s}") + ("\\subsection{%s}" . "\\subsection*{%s}") + ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))) + "Alist of LaTeX classes and associated header and structure. +If #+LATEX_CLASS is set in the buffer, use its value and the +associated information. Here is the structure of each cell: + + \(class-name + header-string + \(numbered-section . unnumbered-section) + ...) + +The header string +----------------- + +The HEADER-STRING is the header that will be inserted into the +LaTeX file. It should contain the \\documentclass macro, and +anything else that is needed for this setup. To this header, the +following commands will be added: + +- Calls to \\usepackage for all packages mentioned in the + variables `org-latex-default-packages-alist' and + `org-latex-packages-alist'. Thus, your header definitions + should avoid to also request these packages. + +- Lines specified via \"#+LATEX_HEADER:\" and + \"#+LATEX_HEADER_EXTRA:\" keywords. + +If you need more control about the sequence in which the header +is built up, or if you want to exclude one of these building +blocks for a particular class, you can use the following +macro-like placeholders. + + [DEFAULT-PACKAGES] \\usepackage statements for default packages + [NO-DEFAULT-PACKAGES] do not include any of the default packages + [PACKAGES] \\usepackage statements for packages + [NO-PACKAGES] do not include the packages + [EXTRA] the stuff from #+LATEX_HEADER(_EXTRA) + [NO-EXTRA] do not include #+LATEX_HEADER(_EXTRA) stuff + +So a header like + + \\documentclass{article} + [NO-DEFAULT-PACKAGES] + [EXTRA] + \\providecommand{\\alert}[1]{\\textbf{#1}} + [PACKAGES] + +will omit the default packages, and will include the +#+LATEX_HEADER and #+LATEX_HEADER_EXTRA lines, then have a call +to \\providecommand, and then place \\usepackage commands based +on the content of `org-latex-packages-alist'. + +If your header, `org-latex-default-packages-alist' or +`org-latex-packages-alist' inserts \"\\usepackage[AUTO]{inputenc}\", +AUTO will automatically be replaced with a coding system derived +from `buffer-file-coding-system'. See also the variable +`org-latex-inputenc-alist' for a way to influence this mechanism. + +Likewise, if your header contains \"\\usepackage[AUTO]{babel}\", +AUTO will be replaced with the language related to the language +code specified by `org-export-default-language', which see. Note +that constructions such as \"\\usepackage[french,AUTO,english]{babel}\" +are permitted. + +The sectioning structure +------------------------ + +The sectioning structure of the class is given by the elements +following the header string. For each sectioning level, a number +of strings is specified. A %s formatter is mandatory in each +section string and will be replaced by the title of the section. + +Instead of a cons cell (numbered . unnumbered), you can also +provide a list of 2 or 4 elements, + + \(numbered-open numbered-close) + +or + + \(numbered-open numbered-close unnumbered-open unnumbered-close) + +providing opening and closing strings for a LaTeX environment +that should represent the document section. The opening clause +should have a %s to represent the section title. + +Instead of a list of sectioning commands, you can also specify +a function name. That function will be called with two +parameters, the (reduced) level of the headline, and a predicate +non-nil when the headline should be numbered. It must return +a format string in which the section title will be added." + :group 'org-export-latex + :type '(repeat + (list (string :tag "LaTeX class") + (string :tag "LaTeX header") + (repeat :tag "Levels" :inline t + (choice + (cons :tag "Heading" + (string :tag " numbered") + (string :tag "unnumbered")) + (list :tag "Environment" + (string :tag "Opening (numbered)") + (string :tag "Closing (numbered)") + (string :tag "Opening (unnumbered)") + (string :tag "Closing (unnumbered)")) + (function :tag "Hook computing sectioning")))))) + +(defcustom org-latex-inputenc-alist nil + "Alist of inputenc coding system names, and what should really be used. +For example, adding an entry + + (\"utf8\" . \"utf8x\") + +will cause \\usepackage[utf8x]{inputenc} to be used for buffers that +are written as utf8 files." + :group 'org-export-latex + :type '(repeat + (cons + (string :tag "Derived from buffer") + (string :tag "Use this instead")))) + +(defcustom org-latex-title-command "\\maketitle" + "The command used to insert the title just after \\begin{document}. +If this string contains the formatting specification \"%s\" then +it will be used as a formatting string, passing the title as an +argument." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-toc-command "\\tableofcontents\n\n" + "LaTeX command to set the table of contents, list of figures, etc. +This command only applies to the table of contents generated with +the toc:nil option, not to those generated with #+TOC keyword." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-with-hyperref t + "Toggle insertion of \\hypersetup{...} in the preamble." + :group 'org-export-latex + :type 'boolean) + +;;;; Headline + +(defcustom org-latex-format-headline-function + 'org-latex-format-headline-default-function + "Function for formatting the headline's text. + +This function will be called with 5 arguments: +TODO the todo keyword (string or nil). +TODO-TYPE the type of todo (symbol: `todo', `done', nil) +PRIORITY the priority of the headline (integer or nil) +TEXT the main headline text (string). +TAGS the tags as a list of strings (list of strings or nil). + +The function result will be used in the section format string. + +Use `org-latex-format-headline-default-function' by default, +which format headlines like for Org version prior to 8.0." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + + +;;;; Footnotes + +(defcustom org-latex-footnote-separator "\\textsuperscript{,}\\," + "Text used to separate footnotes." + :group 'org-export-latex + :type 'string) + + +;;;; Timestamps + +(defcustom org-latex-active-timestamp-format "\\textit{%s}" + "A printf format string to be applied to active timestamps." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-inactive-timestamp-format "\\textit{%s}" + "A printf format string to be applied to inactive timestamps." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-diary-timestamp-format "\\textit{%s}" + "A printf format string to be applied to diary timestamps." + :group 'org-export-latex + :type 'string) + + +;;;; Links + +(defcustom org-latex-image-default-option "" + "Default option for images." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-latex-image-default-width ".9\\linewidth" + "Default width for images. +This value will not be used if a height is provided." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-latex-image-default-height "" + "Default height for images. +This value will not be used if a width is provided, or if the +image is wrapped within a \"figure\" or \"wrapfigure\" +environment." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-latex-default-figure-position "htb" + "Default position for latex figures." + :group 'org-export-latex + :type 'string) + +(defcustom org-latex-inline-image-rules + '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'")) + "Rules characterizing image files that can be inlined into LaTeX. + +A rule consists in an association whose key is the type of link +to consider, and value is a regexp that will be matched against +link's path. + +Note that, by default, the image extension *actually* allowed +depend on the way the LaTeX file is processed. When used with +pdflatex, pdf, jpg and png images are OK. When processing +through dvi to Postscript, only ps and eps are allowed. The +default we use here encompasses both." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type '(alist :key-type (string :tag "Type") + :value-type (regexp :tag "Path"))) + +(defcustom org-latex-link-with-unknown-path-format "\\texttt{%s}" + "Format string for links with unknown path type." + :group 'org-export-latex + :type 'string) + + +;;;; Tables + +(defcustom org-latex-default-table-environment "tabular" + "Default environment used to build tables." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'string) + +(defcustom org-latex-default-table-mode 'table + "Default mode for tables. + +Value can be a symbol among: + + `table' Regular LaTeX table. + + `math' In this mode, every cell is considered as being in math + mode and the complete table will be wrapped within a math + environment. It is particularly useful to write matrices. + + `inline-math' This mode is almost the same as `math', but the + math environment will be inlined. + + `verbatim' The table is exported as it appears in the Org + buffer, within a verbatim environment. + +This value can be overridden locally with, i.e. \":mode math\" in +LaTeX attributes. + +When modifying this variable, it may be useful to change +`org-latex-default-table-environment' accordingly." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice (const :tag "Table" table) + (const :tag "Matrix" math) + (const :tag "Inline matrix" inline-math) + (const :tag "Verbatim" verbatim))) + +(defcustom org-latex-tables-centered t + "When non-nil, tables are exported in a center environment." + :group 'org-export-latex + :type 'boolean) + +(defcustom org-latex-tables-booktabs nil + "When non-nil, display tables in a formal \"booktabs\" style. +This option assumes that the \"booktabs\" package is properly +loaded in the header of the document. This value can be ignored +locally with \":booktabs t\" and \":booktabs nil\" LaTeX +attributes." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-latex-table-caption-above t + "When non-nil, place caption string at the beginning of the table. +Otherwise, place it near the end." + :group 'org-export-latex + :type 'boolean) + +(defcustom org-latex-table-scientific-notation "%s\\,(%s)" + "Format string to display numbers in scientific notation. +The format should have \"%s\" twice, for mantissa and exponent +\(i.e., \"%s\\\\times10^{%s}\"). + +When nil, no transformation is made." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (string :tag "Format string") + (const :tag "No formatting" nil))) + + +;;;; Text markup + +(defcustom org-latex-text-markup-alist '((bold . "\\textbf{%s}") + (code . verb) + (italic . "\\emph{%s}") + (strike-through . "\\sout{%s}") + (underline . "\\uline{%s}") + (verbatim . protectedtexttt)) + "Alist of LaTeX expressions to convert text markup. + +The key must be a symbol among `bold', `code', `italic', +`strike-through', `underline' and `verbatim'. The value is +a formatting string to wrap fontified text with. + +Value can also be set to the following symbols: `verb' and +`protectedtexttt'. For the former, Org will use \"\\verb\" to +create a format string and select a delimiter character that +isn't in the string. For the latter, Org will use \"\\texttt\" +to typeset and try to protect special characters. + +If no association can be found for a given markup, text will be +returned as-is." + :group 'org-export-latex + :type 'alist + :options '(bold code italic strike-through underline verbatim)) + + +;;;; Drawers + +(defcustom org-latex-format-drawer-function + (lambda (name contents) contents) + "Function called to format a drawer in LaTeX code. + +The function must accept two parameters: + NAME the drawer name, like \"LOGBOOK\" + CONTENTS the contents of the drawer. + +The function should return the string to be exported. + +The default function simply returns the value of CONTENTS." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.3") + :type 'function) + + +;;;; Inlinetasks + +(defcustom org-latex-format-inlinetask-function 'ignore + "Function called to format an inlinetask in LaTeX code. + +The function must accept six parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a list of strings. + CONTENTS the contents of the inlinetask, as a string. + +The function should return the string to be exported. + +For example, the variable could be set to the following function +in order to mimic default behaviour: + +\(defun org-latex-format-inlinetask \(todo type priority name tags contents\) +\"Format an inline task element for LaTeX export.\" + \(let ((full-title + \(concat + \(when todo + \(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo)) + \(when priority (format \"\\\\framebox{\\\\#%c} \" priority)) + title + \(when tags + \(format \"\\\\hfill{}\\\\textsc{:%s:}\" + \(mapconcat 'identity tags \":\"))))) + \(format (concat \"\\\\begin{center}\\n\" + \"\\\\fbox{\\n\" + \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\" + \"%s\\n\\n\" + \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\" + \"%s\" + \"\\\\end{minipage}}\" + \"\\\\end{center}\") + full-title contents))" + :group 'org-export-latex + :type 'function) + + +;; Src blocks + +(defcustom org-latex-listings nil + "Non-nil means export source code using the listings package. + +This package will fontify source code, possibly even with color. +If you want to use this, you also need to make LaTeX use the +listings package, and if you want to have color, the color +package. Just add these to `org-latex-packages-alist', for +example using customize, or with something like: + + \(require 'ox-latex) + \(add-to-list 'org-latex-packages-alist '(\"\" \"listings\")) + \(add-to-list 'org-latex-packages-alist '(\"\" \"color\")) + +Alternatively, + + \(setq org-latex-listings 'minted) + +causes source code to be exported using the minted package as +opposed to listings. If you want to use minted, you need to add +the minted package to `org-latex-packages-alist', for example +using customize, or with + + \(require 'ox-latex) + \(add-to-list 'org-latex-packages-alist '(\"\" \"minted\")) + +In addition, it is necessary to install pygments +\(http://pygments.org), and to configure the variable +`org-latex-pdf-process' so that the -shell-escape option is +passed to pdflatex. + +The minted choice has possible repercussions on the preview of +latex fragments (see `org-preview-latex-fragment'). If you run +into previewing problems, please consult + + http://orgmode.org/worg/org-tutorials/org-latex-preview.html" + :group 'org-export-latex + :type '(choice + (const :tag "Use listings" t) + (const :tag "Use minted" minted) + (const :tag "Export verbatim" nil))) + +(defcustom org-latex-listings-langs + '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp") + (c "C") (cc "C++") + (fortran "fortran") + (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby") + (html "HTML") (xml "XML") + (tex "TeX") (latex "[LaTeX]TeX") + (shell-script "bash") + (gnuplot "Gnuplot") + (ocaml "Caml") (caml "Caml") + (sql "SQL") (sqlite "sql")) + "Alist mapping languages to their listing language counterpart. +The key is a symbol, the major mode symbol without the \"-mode\". +The value is the string that should be inserted as the language +parameter for the listings package. If the mode name and the +listings name are the same, the language does not need an entry +in this list - but it does not hurt if it is present." + :group 'org-export-latex + :type '(repeat + (list + (symbol :tag "Major mode ") + (string :tag "Listings language")))) + +(defcustom org-latex-listings-options nil + "Association list of options for the latex listings package. + +These options are supplied as a comma-separated list to the +\\lstset command. Each element of the association list should be +a list containing two strings: the name of the option, and the +value. For example, + + \(setq org-latex-listings-options + '((\"basicstyle\" \"\\\\small\") + \(\"keywordstyle\" \"\\\\color{black}\\\\bfseries\\\\underbar\"))) + +will typeset the code in a small size font with underlined, bold +black keywords. + +Note that the same options will be applied to blocks of all +languages." + :group 'org-export-latex + :type '(repeat + (list + (string :tag "Listings option name ") + (string :tag "Listings option value")))) + +(defcustom org-latex-minted-langs + '((emacs-lisp "common-lisp") + (cc "c++") + (cperl "perl") + (shell-script "bash") + (caml "ocaml")) + "Alist mapping languages to their minted language counterpart. +The key is a symbol, the major mode symbol without the \"-mode\". +The value is the string that should be inserted as the language +parameter for the minted package. If the mode name and the +listings name are the same, the language does not need an entry +in this list - but it does not hurt if it is present. + +Note that minted uses all lower case for language identifiers, +and that the full list of language identifiers can be obtained +with: + + pygmentize -L lexers" + :group 'org-export-latex + :type '(repeat + (list + (symbol :tag "Major mode ") + (string :tag "Minted language")))) + +(defcustom org-latex-minted-options nil + "Association list of options for the latex minted package. + +These options are supplied within square brackets in +\\begin{minted} environments. Each element of the alist should +be a list containing two strings: the name of the option, and the +value. For example, + + \(setq org-latex-minted-options + '\((\"bgcolor\" \"bg\") \(\"frame\" \"lines\"))) + +will result in src blocks being exported with + +\\begin{minted}[bgcolor=bg,frame=lines]{} + +as the start of the minted environment. Note that the same +options will be applied to blocks of all languages." + :group 'org-export-latex + :type '(repeat + (list + (string :tag "Minted option name ") + (string :tag "Minted option value")))) + +(defvar org-latex-custom-lang-environments nil + "Alist mapping languages to language-specific LaTeX environments. + +It is used during export of src blocks by the listings and minted +latex packages. For example, + + \(setq org-latex-custom-lang-environments + '\(\(python \"pythoncode\"\)\)\) + +would have the effect that if org encounters begin_src python +during latex export it will output + + \\begin{pythoncode} + + \\end{pythoncode}") + + +;;;; Compilation + +(defcustom org-latex-pdf-process + '("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f") + "Commands to process a LaTeX file to a PDF file. +This is a list of strings, each of them will be given to the +shell as a command. %f in the command will be replaced by the +full file name, %b by the file base name (i.e. without directory +and extension parts) and %o by the base directory of the file. + +The reason why this is a list is that it usually takes several +runs of `pdflatex', maybe mixed with a call to `bibtex'. Org +does not have a clever mechanism to detect which of these +commands have to be run to get to a stable result, and it also +does not do any error checking. + +By default, Org uses 3 runs of `pdflatex' to do the processing. +If you have texi2dvi on your system and if that does not cause +the infamous egrep/locale bug: + + http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html + +then `texi2dvi' is the superior choice as it automates the LaTeX +build process by calling the \"correct\" combinations of +auxiliary programs. Org does offer `texi2dvi' as one of the +customize options. Alternatively, `rubber' and `latexmk' also +provide similar functionality. The latter supports `biber' out +of the box. + +Alternatively, this may be a Lisp function that does the +processing, so you could use this to apply the machinery of +AUCTeX or the Emacs LaTeX mode. This function should accept the +file name as its single argument." + :group 'org-export-pdf + :type '(choice + (repeat :tag "Shell command sequence" + (string :tag "Shell command")) + (const :tag "2 runs of pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "3 runs of pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "pdflatex,bibtex,pdflatex,pdflatex" + ("pdflatex -interaction nonstopmode -output-directory %o %f" + "bibtex %b" + "pdflatex -interaction nonstopmode -output-directory %o %f" + "pdflatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "2 runs of xelatex" + ("xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "3 runs of xelatex" + ("xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "xelatex,bibtex,xelatex,xelatex" + ("xelatex -interaction nonstopmode -output-directory %o %f" + "bibtex %b" + "xelatex -interaction nonstopmode -output-directory %o %f" + "xelatex -interaction nonstopmode -output-directory %o %f")) + (const :tag "texi2dvi" + ("texi2dvi -p -b -V %f")) + (const :tag "rubber" + ("rubber -d --into %o %f")) + (const :tag "latexmk" + ("latexmk -g -pdf %f")) + (function))) + +(defcustom org-latex-logfiles-extensions + '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb") + "The list of file extensions to consider as LaTeX logfiles. +The logfiles will be remove if `org-latex-remove-logfiles' is +non-nil." + :group 'org-export-latex + :type '(repeat (string :tag "Extension"))) + +(defcustom org-latex-remove-logfiles t + "Non-nil means remove the logfiles produced by PDF production. +By default, logfiles are files with these extensions: .aux, .idx, +.log, .out, .toc, .nav, .snm and .vrb. To define the set of +logfiles to remove, set `org-latex-logfiles-extensions'." + :group 'org-export-latex + :type 'boolean) + +(defcustom org-latex-known-errors + '(("Reference.*?undefined" . "[undefined reference]") + ("Citation.*?undefined" . "[undefined citation]") + ("Undefined control sequence" . "[undefined control sequence]") + ("^! LaTeX.*?Error" . "[LaTeX error]") + ("^! Package.*?Error" . "[package error]") + ("Runaway argument" . "Runaway argument")) + "Alist of regular expressions and associated messages for the user. +The regular expressions are used to find possible errors in the +log of a latex-run." + :group 'org-export-latex + :version "24.4" + :package-version '(Org . "8.0") + :type '(repeat + (cons + (string :tag "Regexp") + (string :tag "Message")))) + + + +;;; Internal Functions + +(defun org-latex--caption/label-string (element info) + "Return caption and label LaTeX string for ELEMENT. + +INFO is a plist holding contextual information. If there's no +caption nor label, return the empty string. + +For non-floats, see `org-latex--wrap-label'." + (let* ((label (org-element-property :name element)) + (label-str (if (not (org-string-nw-p label)) "" + (format "\\label{%s}" + (org-export-solidify-link-text label)))) + (main (org-export-get-caption element)) + (short (org-export-get-caption element t)) + (caption-from-attr-latex (org-export-read-attribute :attr_latex element :caption))) + (cond + ((org-string-nw-p caption-from-attr-latex) + (concat caption-from-attr-latex "\n")) + ((and (not main) (equal label-str "")) "") + ((not main) (concat label-str "\n")) + ;; Option caption format with short name. + (short (format "\\caption[%s]{%s%s}\n" + (org-export-data short info) + label-str + (org-export-data main info))) + ;; Standard caption format. + (t (format "\\caption{%s%s}\n" label-str (org-export-data main info)))))) + +(defun org-latex-guess-inputenc (header) + "Set the coding system in inputenc to what the buffer is. + +HEADER is the LaTeX header string. This function only applies +when specified inputenc option is \"AUTO\". + +Return the new header, as a string." + (let* ((cs (or (ignore-errors + (latexenc-coding-system-to-inputenc + (or org-export-coding-system buffer-file-coding-system))) + "utf8"))) + (if (not cs) header + ;; First translate if that is requested. + (setq cs (or (cdr (assoc cs org-latex-inputenc-alist)) cs)) + ;; Then find the \usepackage statement and replace the option. + (replace-regexp-in-string "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}" + cs header t nil 1)))) + +(defun org-latex-guess-babel-language (header info) + "Set Babel's language according to LANGUAGE keyword. + +HEADER is the LaTeX header string. INFO is the plist used as +a communication channel. + +Insertion of guessed language only happens when Babel package has +explicitly been loaded. Then it is added to the rest of +package's options. + +The argument to Babel may be \"AUTO\" which is then replaced with +the language of the document or `org-export-default-language' +unless language in question is already loaded. + +Return the new header." + (let ((language-code (plist-get info :language))) + ;; If no language is set or Babel package is not loaded, return + ;; HEADER as-is. + (if (or (not (stringp language-code)) + (not (string-match "\\\\usepackage\\[\\(.*\\)\\]{babel}" header))) + header + (let ((options (save-match-data + (org-split-string (match-string 1 header) ",[ \t]*"))) + (language (cdr (assoc language-code + org-latex-babel-language-alist)))) + ;; If LANGUAGE is already loaded, return header without AUTO. + ;; Otherwise, replace AUTO with language or append language if + ;; AUTO is not present. + (replace-match + (mapconcat (lambda (option) (if (equal "AUTO" option) language option)) + (cond ((member language options) (delete "AUTO" options)) + ((member "AUTO" options) options) + (t (append options (list language)))) + ", ") + t nil header 1))))) + +(defun org-latex--find-verb-separator (s) + "Return a character not used in string S. +This is used to choose a separator for constructs like \\verb." + (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) + (loop for c across ll + when (not (string-match (regexp-quote (char-to-string c)) s)) + return (char-to-string c)))) + +(defun org-latex--make-option-string (options) + "Return a comma separated string of keywords and values. +OPTIONS is an alist where the key is the options keyword as +a string, and the value a list containing the keyword value, or +nil." + (mapconcat (lambda (pair) + (concat (first pair) + (when (> (length (second pair)) 0) + (concat "=" (second pair))))) + options + ",")) + +(defun org-latex--wrap-label (element output) + "Wrap label associated to ELEMENT around OUTPUT, if appropriate. +This function shouldn't be used for floats. See +`org-latex--caption/label-string'." + (let ((label (org-element-property :name element))) + (if (not (and (org-string-nw-p output) (org-string-nw-p label))) output + (concat (format "\\label{%s}\n" (org-export-solidify-link-text label)) + output)))) + +(defun org-latex--text-markup (text markup) + "Format TEXT depending on MARKUP text markup. +See `org-latex-text-markup-alist' for details." + (let ((fmt (cdr (assq markup org-latex-text-markup-alist)))) + (cond + ;; No format string: Return raw text. + ((not fmt) text) + ;; Handle the `verb' special case: Find and appropriate separator + ;; and use "\\verb" command. + ((eq 'verb fmt) + (let ((separator (org-latex--find-verb-separator text))) + (concat "\\verb" separator + (replace-regexp-in-string "\n" " " text) + separator))) + ;; Handle the `protectedtexttt' special case: Protect some + ;; special chars and use "\texttt{%s}" format string. + ((eq 'protectedtexttt fmt) + (let ((start 0) + (trans '(("\\" . "\\textbackslash{}") + ("~" . "\\textasciitilde{}") + ("^" . "\\textasciicircum{}"))) + (rtn "") + char) + (while (string-match "[\\{}$%&_#~^]" text) + (setq char (match-string 0 text)) + (if (> (match-beginning 0) 0) + (setq rtn (concat rtn (substring text 0 (match-beginning 0))))) + (setq text (substring text (1+ (match-beginning 0)))) + (setq char (or (cdr (assoc char trans)) (concat "\\" char)) + rtn (concat rtn char))) + (setq text (concat rtn text) + fmt "\\texttt{%s}") + (while (string-match "--" text) + (setq text (replace-match "-{}-" t t text))) + (format fmt text))) + ;; Else use format string. + (t (format fmt text))))) + +(defun org-latex--delayed-footnotes-definitions (element info) + "Return footnotes definitions in ELEMENT as a string. + +INFO is a plist used as a communication channel. + +Footnotes definitions are returned within \"\\footnotetxt{}\" +commands. + +This function is used within constructs that don't support +\"\\footnote{}\" command (i.e. an item's tag). In that case, +\"\\footnotemark\" is used within the construct and the function +just outside of it." + (mapconcat + (lambda (ref) + (format + "\\footnotetext[%s]{%s}" + (org-export-get-footnote-number ref info) + (org-trim + (org-export-data + (org-export-get-footnote-definition ref info) info)))) + ;; Find every footnote reference in ELEMENT. + (let* (all-refs + search-refs ; For byte-compiler. + (search-refs + (function + (lambda (data) + ;; Return a list of all footnote references never seen + ;; before in DATA. + (org-element-map data 'footnote-reference + (lambda (ref) + (when (org-export-footnote-first-reference-p ref info) + (push ref all-refs) + (when (eq (org-element-property :type ref) 'standard) + (funcall search-refs + (org-export-get-footnote-definition ref info))))) + info) + (reverse all-refs))))) + (funcall search-refs element)) + "")) + + + +;;; Template + +(defun org-latex-template (contents info) + "Return complete document string after LaTeX conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (let ((title (org-export-data (plist-get info :title) info))) + (concat + ;; Time-stamp. + (and (plist-get info :time-stamp-file) + (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) + ;; Document class and packages. + (let* ((class (plist-get info :latex-class)) + (class-options (plist-get info :latex-class-options)) + (header (nth 1 (assoc class org-latex-classes))) + (document-class-string + (and (stringp header) + (if (not class-options) header + (replace-regexp-in-string + "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" + class-options header t nil 1))))) + (if (not document-class-string) + (user-error "Unknown LaTeX class `%s'" class) + (org-latex-guess-babel-language + (org-latex-guess-inputenc + (org-element-normalize-string + (org-splice-latex-header + document-class-string + org-latex-default-packages-alist + org-latex-packages-alist nil + (concat (org-element-normalize-string + (plist-get info :latex-header)) + (plist-get info :latex-header-extra))))) + info))) + ;; Possibly limit depth for headline numbering. + (let ((sec-num (plist-get info :section-numbers))) + (when (integerp sec-num) + (format "\\setcounter{secnumdepth}{%d}\n" sec-num))) + ;; Author. + (let ((author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth (org-export-data auth info))))) + (email (and (plist-get info :with-email) + (org-export-data (plist-get info :email) info)))) + (cond ((and author email (not (string= "" email))) + (format "\\author{%s\\thanks{%s}}\n" author email)) + ((or author email) (format "\\author{%s}\n" (or author email))))) + ;; Date. + (let ((date (and (plist-get info :with-date) (org-export-get-date info)))) + (format "\\date{%s}\n" (org-export-data date info))) + ;; Title + (format "\\title{%s}\n" title) + ;; Hyperref options. + (when (plist-get info :latex-hyperref-p) + (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" + (or (plist-get info :keywords) "") + (or (plist-get info :description) "") + (if (not (plist-get info :with-creator)) "" + (plist-get info :creator)))) + ;; Document start. + "\\begin{document}\n\n" + ;; Title command. + (org-element-normalize-string + (cond ((string= "" title) nil) + ((not (stringp org-latex-title-command)) nil) + ((string-match "\\(?:[^%]\\|^\\)%s" + org-latex-title-command) + (format org-latex-title-command title)) + (t org-latex-title-command))) + ;; Table of contents. + (let ((depth (plist-get info :with-toc))) + (when depth + (concat (when (wholenump depth) + (format "\\setcounter{tocdepth}{%d}\n" depth)) + org-latex-toc-command))) + ;; Document's body. + contents + ;; Creator. + (let ((creator-info (plist-get info :with-creator))) + (cond + ((not creator-info) "") + ((eq creator-info 'comment) + (format "%% %s\n" (plist-get info :creator))) + (t (concat (plist-get info :creator) "\n")))) + ;; Document end. + "\\end{document}"))) + + + +;;; Transcode Functions + +;;;; Bold + +(defun org-latex-bold (bold contents info) + "Transcode BOLD from Org to LaTeX. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (org-latex--text-markup contents 'bold)) + + +;;;; Center Block + +(defun org-latex-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the center block. INFO is a plist +holding contextual information." + (org-latex--wrap-label + center-block + (format "\\begin{center}\n%s\\end{center}" contents))) + + +;;;; Clock + +(defun org-latex-clock (clock contents info) + "Transcode a CLOCK element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (concat + "\\noindent" + (format "\\textbf{%s} " org-clock-string) + (format org-latex-inactive-timestamp-format + (concat (org-translate-time + (org-element-property :raw-value + (org-element-property :value clock))) + (let ((time (org-element-property :duration clock))) + (and time (format " (%s)" time))))) + "\\\\")) + + +;;;; Code + +(defun org-latex-code (code contents info) + "Transcode a CODE object from Org to LaTeX. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (org-latex--text-markup (org-element-property :value code) 'code)) + + +;;;; Drawer + +(defun org-latex-drawer (drawer contents info) + "Transcode a DRAWER element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let* ((name (org-element-property :drawer-name drawer)) + (output (funcall org-latex-format-drawer-function + name contents))) + (org-latex--wrap-label drawer output))) + + +;;;; Dynamic Block + +(defun org-latex-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information. See `org-export-data'." + (org-latex--wrap-label dynamic-block contents)) + + +;;;; Entity + +(defun org-latex-entity (entity contents info) + "Transcode an ENTITY object from Org to LaTeX. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (let ((ent (org-element-property :latex entity))) + (if (org-element-property :latex-math-p entity) (format "$%s$" ent) ent))) + + +;;;; Example Block + +(defun org-latex-example-block (example-block contents info) + "Transcode an EXAMPLE-BLOCK element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (when (org-string-nw-p (org-element-property :value example-block)) + (org-latex--wrap-label + example-block + (format "\\begin{verbatim}\n%s\\end{verbatim}" + (org-export-format-code-default example-block info))))) + + +;;;; Export Block + +(defun org-latex-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (member (org-element-property :type export-block) '("LATEX" "TEX")) + (org-remove-indentation (org-element-property :value export-block)))) + + +;;;; Export Snippet + +(defun org-latex-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (eq (org-export-snippet-backend export-snippet) 'latex) + (org-element-property :value export-snippet))) + + +;;;; Fixed Width + +(defun org-latex-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-latex--wrap-label + fixed-width + (format "\\begin{verbatim}\n%s\\end{verbatim}" + (org-remove-indentation + (org-element-property :value fixed-width))))) + + +;;;; Footnote Reference + +(defun org-latex-footnote-reference (footnote-reference contents info) + "Transcode a FOOTNOTE-REFERENCE element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (concat + ;; Insert separator between two footnotes in a row. + (let ((prev (org-export-get-previous-element footnote-reference info))) + (when (eq (org-element-type prev) 'footnote-reference) + org-latex-footnote-separator)) + (cond + ;; Use \footnotemark if the footnote has already been defined. + ((not (org-export-footnote-first-reference-p footnote-reference info)) + (format "\\footnotemark[%s]{}" + (org-export-get-footnote-number footnote-reference info))) + ;; Use \footnotemark if reference is within another footnote + ;; reference, footnote definition or table cell. + ((loop for parent in (org-export-get-genealogy footnote-reference) + thereis (memq (org-element-type parent) + '(footnote-reference footnote-definition table-cell))) + "\\footnotemark") + ;; Otherwise, define it with \footnote command. + (t + (let ((def (org-export-get-footnote-definition footnote-reference info))) + (concat + (format "\\footnote{%s}" (org-trim (org-export-data def info))) + ;; Retrieve all footnote references within the footnote and + ;; add their definition after it, since LaTeX doesn't support + ;; them inside. + (org-latex--delayed-footnotes-definitions def info))))))) + + +;;;; Headline + +(defun org-latex-headline (headline contents info) + "Transcode a HEADLINE element from Org to LaTeX. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + (unless (org-element-property :footnote-section-p headline) + (let* ((class (plist-get info :latex-class)) + (level (org-export-get-relative-level headline info)) + (numberedp (org-export-numbered-headline-p headline info)) + (class-sectioning (assoc class org-latex-classes)) + ;; Section formatting will set two placeholders: one for + ;; the title and the other for the contents. + (section-fmt + (let ((sec (if (functionp (nth 2 class-sectioning)) + (funcall (nth 2 class-sectioning) level numberedp) + (nth (1+ level) class-sectioning)))) + (cond + ;; No section available for that LEVEL. + ((not sec) nil) + ;; Section format directly returned by a function. Add + ;; placeholder for contents. + ((stringp sec) (concat sec "\n%s")) + ;; (numbered-section . unnumbered-section) + ((not (consp (cdr sec))) + (concat (funcall (if numberedp #'car #'cdr) sec) "\n%s")) + ;; (numbered-open numbered-close) + ((= (length sec) 2) + (when numberedp (concat (car sec) "\n%s" (nth 1 sec)))) + ;; (num-in num-out no-num-in no-num-out) + ((= (length sec) 4) + (if numberedp (concat (car sec) "\n%s" (nth 1 sec)) + (concat (nth 2 sec) "\n%s" (nth 3 sec))))))) + ;; Create a temporary export back-end that hard-codes + ;; "\underline" within "\section" and alike. + (section-back-end + (org-export-create-backend + :parent 'latex + :transcoders + '((underline . (lambda (o c i) (format "\\underline{%s}" c)))))) + (text + (org-export-data-with-backend + (org-element-property :title headline) section-back-end info)) + (todo + (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + ;; Create the headline text along with a no-tag version. + ;; The latter is required to remove tags from toc. + (full-text (funcall org-latex-format-headline-function + todo todo-type priority text tags)) + ;; Associate \label to the headline for internal links. + (headline-label + (format "\\label{sec-%s}\n" + (mapconcat 'number-to-string + (org-export-get-headline-number headline info) + "-"))) + (pre-blanks + (make-string (org-element-property :pre-blank headline) 10))) + (if (or (not section-fmt) (org-export-low-level-p headline info)) + ;; This is a deep sub-tree: export it as a list item. Also + ;; export as items headlines for which no section format has + ;; been found. + (let ((low-level-body + (concat + ;; If headline is the first sibling, start a list. + (when (org-export-first-sibling-p headline info) + (format "\\begin{%s}\n" (if numberedp 'enumerate 'itemize))) + ;; Itemize headline + "\\item" + (and full-text (org-string-match-p "\\`[ \t]*\\[" full-text) + "\\relax") + " " full-text "\n" + headline-label + pre-blanks + contents))) + ;; If headline is not the last sibling simply return + ;; LOW-LEVEL-BODY. Otherwise, also close the list, before + ;; any blank line. + (if (not (org-export-last-sibling-p headline info)) low-level-body + (replace-regexp-in-string + "[ \t\n]*\\'" + (format "\n\\\\end{%s}" (if numberedp 'enumerate 'itemize)) + low-level-body))) + ;; This is a standard headline. Export it as a section. Add + ;; an alternative heading when possible, and when this is not + ;; identical to the usual heading. + (let ((opt-title + (funcall org-latex-format-headline-function + todo todo-type priority + (org-export-data-with-backend + (org-export-get-alt-title headline info) + section-back-end info) + (and (eq (plist-get info :with-tags) t) tags)))) + (if (and numberedp opt-title + (not (equal opt-title full-text)) + (string-match "\\`\\\\\\(.*?[^*]\\){" section-fmt)) + (format (replace-match "\\1[%s]" nil nil section-fmt 1) + ;; Replace square brackets with parenthesis + ;; since square brackets are not supported in + ;; optional arguments. + (replace-regexp-in-string + "\\[" "(" (replace-regexp-in-string "\\]" ")" opt-title)) + full-text + (concat headline-label pre-blanks contents)) + ;; Impossible to add an alternative heading. Fallback to + ;; regular sectioning format string. + (format section-fmt full-text + (concat headline-label pre-blanks contents)))))))) + +(defun org-latex-format-headline-default-function + (todo todo-type priority text tags) + "Default format function for a headline. +See `org-latex-format-headline-function' for details." + (concat + (and todo (format "{\\bfseries\\sffamily %s} " todo)) + (and priority (format "\\framebox{\\#%c} " priority)) + text + (and tags + (format "\\hfill{}\\textsc{%s}" (mapconcat 'identity tags ":"))))) + + +;;;; Horizontal Rule + +(defun org-latex-horizontal-rule (horizontal-rule contents info) + "Transcode an HORIZONTAL-RULE object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((attr (org-export-read-attribute :attr_latex horizontal-rule)) + (prev (org-export-get-previous-element horizontal-rule info))) + (concat + ;; Make sure the rule doesn't start at the end of the current + ;; line by separating it with a blank line from previous element. + (when (and prev + (let ((prev-blank (org-element-property :post-blank prev))) + (or (not prev-blank) (zerop prev-blank)))) + "\n") + (org-latex--wrap-label + horizontal-rule + (format "\\rule{%s}{%s}" + (or (plist-get attr :width) "\\linewidth") + (or (plist-get attr :thickness) "0.5pt")))))) + + +;;;; Inline Src Block + +(defun org-latex-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((code (org-element-property :value inline-src-block)) + (separator (org-latex--find-verb-separator code))) + (cond + ;; Do not use a special package: transcode it verbatim. + ((not org-latex-listings) + (concat "\\verb" separator code separator)) + ;; Use minted package. + ((eq org-latex-listings 'minted) + (let* ((org-lang (org-element-property :language inline-src-block)) + (mint-lang (or (cadr (assq (intern org-lang) + org-latex-minted-langs)) + (downcase org-lang))) + (options (org-latex--make-option-string + org-latex-minted-options))) + (concat (format "\\mint%s{%s}" + (if (string= options "") "" (format "[%s]" options)) + mint-lang) + separator code separator))) + ;; Use listings package. + (t + ;; Maybe translate language's name. + (let* ((org-lang (org-element-property :language inline-src-block)) + (lst-lang (or (cadr (assq (intern org-lang) + org-latex-listings-langs)) + org-lang)) + (options (org-latex--make-option-string + (append org-latex-listings-options + `(("language" ,lst-lang)))))) + (concat (format "\\lstinline[%s]" options) + separator code separator)))))) + + +;;;; Inlinetask + +(defun org-latex-inlinetask (inlinetask contents info) + "Transcode an INLINETASK element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((title (org-export-data (org-element-property :title inlinetask) info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword inlinetask))) + (and todo (org-export-data todo info))))) + (todo-type (org-element-property :todo-type inlinetask)) + (tags (and (plist-get info :with-tags) + (org-export-get-tags inlinetask info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority inlinetask)))) + ;; If `org-latex-format-inlinetask-function' is provided, call it + ;; with appropriate arguments. + (if (not (eq org-latex-format-inlinetask-function 'ignore)) + (funcall org-latex-format-inlinetask-function + todo todo-type priority title tags contents) + ;; Otherwise, use a default template. + (org-latex--wrap-label + inlinetask + (let ((full-title + (concat + (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo)) + (when priority (format "\\framebox{\\#%c} " priority)) + title + (when tags (format "\\hfill{}\\textsc{:%s:}" + (mapconcat #'identity tags ":")))))) + (concat "\\begin{center}\n" + "\\fbox{\n" + "\\begin{minipage}[c]{.6\\textwidth}\n" + full-title "\n\n" + (and (org-string-nw-p contents) + (concat "\\rule[.8em]{\\textwidth}{2pt}\n\n" contents)) + "\\end{minipage}\n" + "}\n" + "\\end{center}")))))) + + +;;;; Italic + +(defun org-latex-italic (italic contents info) + "Transcode ITALIC from Org to LaTeX. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (org-latex--text-markup contents 'italic)) + + +;;;; Item + +(defun org-latex-item (item contents info) + "Transcode an ITEM element from Org to LaTeX. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((counter + (let ((count (org-element-property :counter item)) + (level + ;; Determine level of current item to determine the + ;; correct LaTeX counter to use (enumi, enumii...). + (let ((parent item) (level 0)) + (while (memq (org-element-type + (setq parent (org-export-get-parent parent))) + '(plain-list item)) + (when (and (eq (org-element-type parent) 'plain-list) + (eq (org-element-property :type parent) + 'ordered)) + (incf level))) + level))) + (and count + (< level 5) + (format "\\setcounter{enum%s}{%s}\n" + (nth (1- level) '("i" "ii" "iii" "iv")) + (1- count))))) + (checkbox (case (org-element-property :checkbox item) + (on "$\\boxtimes$ ") + (off "$\\square$ ") + (trans "$\\boxminus$ "))) + (tag (let ((tag (org-element-property :tag item))) + ;; Check-boxes must belong to the tag. + (and tag (format "[{%s}] " + (concat checkbox + (org-export-data tag info))))))) + (concat counter + "\\item" + (cond + (tag) + (checkbox (concat " " checkbox)) + ;; Without a tag or a check-box, if CONTENTS starts with + ;; an opening square bracket, add "\relax" to "\item", + ;; unless the brackets comes from an initial export + ;; snippet (i.e. it is inserted willingly by the user). + ((and contents + (org-string-match-p "\\`[ \t]*\\[" contents) + (not (let ((e (car (org-element-contents item)))) + (and (eq (org-element-type e) 'paragraph) + (let ((o (car (org-element-contents e)))) + (and (eq (org-element-type o) 'export-snippet) + (eq (org-export-snippet-backend o) + 'latex))))))) + "\\relax ") + (t " ")) + (and contents (org-trim contents)) + ;; If there are footnotes references in tag, be sure to + ;; add their definition at the end of the item. This + ;; workaround is necessary since "\footnote{}" command is + ;; not supported in tags. + (and tag + (org-latex--delayed-footnotes-definitions + (org-element-property :tag item) info))))) + + +;;;; Keyword + +(defun org-latex-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "LATEX") value) + ((string= key "INDEX") (format "\\index{%s}" value)) + ((string= key "TOC") + (let ((value (downcase value))) + (cond + ((string-match "\\" value) + (let ((depth (or (and (string-match "[0-9]+" value) + (string-to-number (match-string 0 value))) + (plist-get info :with-toc)))) + (concat + (when (wholenump depth) + (format "\\setcounter{tocdepth}{%s}\n" depth)) + "\\tableofcontents"))) + ((string= "tables" value) "\\listoftables") + ((string= "listings" value) + (cond + ((eq org-latex-listings 'minted) "\\listoflistings") + (org-latex-listings "\\lstlistoflistings") + ;; At the moment, src blocks with a caption are wrapped + ;; into a figure environment. + (t "\\listoffigures"))))))))) + + +;;;; Latex Environment + +(defun org-latex-latex-environment (latex-environment contents info) + "Transcode a LATEX-ENVIRONMENT element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (plist-get info :with-latex) + (let ((label (org-element-property :name latex-environment)) + (value (org-remove-indentation + (org-element-property :value latex-environment)))) + (if (not (org-string-nw-p label)) value + ;; Environment is labeled: label must be within the environment + ;; (otherwise, a reference pointing to that element will count + ;; the section instead). + (with-temp-buffer + (insert value) + (goto-char (point-min)) + (forward-line) + (insert + (format "\\label{%s}\n" (org-export-solidify-link-text label))) + (buffer-string)))))) + + +;;;; Latex Fragment + +(defun org-latex-latex-fragment (latex-fragment contents info) + "Transcode a LATEX-FRAGMENT object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (plist-get info :with-latex) + (org-element-property :value latex-fragment))) + + +;;;; Line Break + +(defun org-latex-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + "\\\\\n") + + +;;;; Link + +(defun org-latex--inline-image (link info) + "Return LaTeX code for an inline image. +LINK is the link pointing to the inline image. INFO is a plist +used as a communication channel." + (let* ((parent (org-export-get-parent-element link)) + (path (let ((raw-path (org-element-property :path link))) + (if (not (file-name-absolute-p raw-path)) raw-path + (expand-file-name raw-path)))) + (filetype (file-name-extension path)) + (caption (org-latex--caption/label-string parent info)) + ;; Retrieve latex attributes from the element around. + (attr (org-export-read-attribute :attr_latex parent)) + (float (let ((float (plist-get attr :float))) + (cond ((and (not float) (plist-member attr :float)) nil) + ((string= float "wrap") 'wrap) + ((string= float "multicolumn") 'multicolumn) + ((or float + (org-element-property :caption parent) + (org-string-nw-p (plist-get attr :caption))) + 'figure)))) + (placement + (let ((place (plist-get attr :placement))) + (cond (place (format "%s" place)) + ((eq float 'wrap) "{l}{0.5\\textwidth}") + ((eq float 'figure) + (format "[%s]" org-latex-default-figure-position)) + (t "")))) + (comment-include (if (plist-get attr :comment-include) "%" "")) + ;; It is possible to specify width and height in the + ;; ATTR_LATEX line, and also via default variables. + (width (cond ((plist-get attr :width)) + ((plist-get attr :height) "") + ((eq float 'wrap) "0.48\\textwidth") + (t org-latex-image-default-width))) + (height (cond ((plist-get attr :height)) + ((or (plist-get attr :width) + (memq float '(figure wrap))) "") + (t org-latex-image-default-height))) + (options (let ((opt (or (plist-get attr :options) + org-latex-image-default-option))) + (if (not (string-match "\\`\\[\\(.*\\)\\]\\'" opt)) opt + (match-string 1 opt)))) + image-code) + (if (member filetype '("tikz" "pgf")) + ;; For tikz images: + ;; - use \input to read in image file. + ;; - if options are present, wrap in a tikzpicture environment. + ;; - if width or height are present, use \resizebox to change + ;; the image size. + (progn + (setq image-code (format "\\input{%s}" path)) + (when (org-string-nw-p options) + (setq image-code + (format "\\begin{tikzpicture}[%s]\n%s\n\\end{tikzpicture}" + options + image-code))) + (when (or (org-string-nw-p width) (org-string-nw-p height)) + (setq image-code (format "\\resizebox{%s}{%s}{%s}" + (if (org-string-nw-p width) width "!") + (if (org-string-nw-p height) height "!") + image-code)))) + ;; For other images: + ;; - add width and height to options. + ;; - include the image with \includegraphics. + (when (org-string-nw-p width) + (setq options (concat options ",width=" width))) + (when (org-string-nw-p height) + (setq options (concat options ",height=" height))) + (setq image-code + (format "\\includegraphics%s{%s}" + (cond ((not (org-string-nw-p options)) "") + ((= (aref options 0) ?,) + (format "[%s]"(substring options 1))) + (t (format "[%s]" options))) + path)) + (when (equal filetype "svg") + (setq image-code (replace-regexp-in-string "^\\\\includegraphics" + "\\includesvg" + image-code + nil t)) + (setq image-code (replace-regexp-in-string "\\.svg}" + "}" + image-code + nil t)))) + ;; Return proper string, depending on FLOAT. + (case float + (wrap (format "\\begin{wrapfigure}%s +\\centering +%s%s +%s\\end{wrapfigure}" placement comment-include image-code caption)) + (multicolumn (format "\\begin{figure*}%s +\\centering +%s%s +%s\\end{figure*}" placement comment-include image-code caption)) + (figure (format "\\begin{figure}%s +\\centering +%s%s +%s\\end{figure}" placement comment-include image-code caption)) + (otherwise image-code)))) + +(defun org-latex-link (link desc info) + "Transcode a LINK object from Org to LaTeX. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + (let* ((type (org-element-property :type link)) + (raw-path (replace-regexp-in-string + "%" "\\%" (org-element-property :path link) nil t)) + ;; Ensure DESC really exists, or set it to nil. + (desc (and (not (string= desc "")) desc)) + (imagep (org-export-inline-image-p + link org-latex-inline-image-rules)) + (path (cond + ((member type '("http" "https" "ftp" "mailto")) + (concat type ":" raw-path)) + ((and (string= type "file") (file-name-absolute-p raw-path)) + (concat "file:" raw-path)) + (t raw-path))) + protocol) + (cond + ;; Image file. + (imagep (org-latex--inline-image link info)) + ;; Radio link: Transcode target's contents and use them as link's + ;; description. + ((string= type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (if (not destination) desc + (format "\\hyperref[%s]{%s}" + (org-export-solidify-link-text + (org-element-property :value destination)) + desc)))) + ;; Links pointing to a headline: Find destination and build + ;; appropriate referencing command. + ((member type '("custom-id" "fuzzy" "id")) + (let ((destination (if (string= type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (case (org-element-type destination) + ;; Id link points to an external file. + (plain-text + (if desc (format "\\href{%s}{%s}" destination desc) + (format "\\url{%s}" destination))) + ;; Fuzzy link points nowhere. + ('nil + (format org-latex-link-with-unknown-path-format + (or desc + (org-export-data + (org-element-property :raw-link link) info)))) + ;; LINK points to a headline. If headlines are numbered + ;; and the link has no description, display headline's + ;; number. Otherwise, display description or headline's + ;; title. + (headline + (let ((label + (format "sec-%s" + (mapconcat + 'number-to-string + (org-export-get-headline-number destination info) + "-")))) + (if (and (not desc) + (org-export-numbered-headline-p destination info)) + (format "\\ref{%s}" label) + (format "\\hyperref[%s]{%s}" label + (or desc + (org-export-data + (org-element-property :title destination) info)))))) + ;; Fuzzy link points to a target. Do as above. + (otherwise + (let ((path (org-export-solidify-link-text path))) + (if (not desc) (format "\\ref{%s}" path) + (format "\\hyperref[%s]{%s}" path desc))))))) + ;; Coderef: replace link with the reference name or the + ;; equivalent line number. + ((string= type "coderef") + (format (org-export-get-coderef-format path desc) + (org-export-resolve-coderef path info))) + ;; Link type is handled by a special function. + ((functionp (setq protocol (nth 2 (assoc type org-link-protocols)))) + (funcall protocol (org-link-unescape path) desc 'latex)) + ;; External link with a description part. + ((and path desc) (format "\\href{%s}{%s}" path desc)) + ;; External link without a description part. + (path (format "\\url{%s}" path)) + ;; No path, only description. Try to do something useful. + (t (format org-latex-link-with-unknown-path-format desc))))) + + +;;;; Paragraph + +(defun org-latex-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to LaTeX. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + contents) + + +;;;; Plain List + +(defun org-latex-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to LaTeX. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + (let* ((type (org-element-property :type plain-list)) + (attr (org-export-read-attribute :attr_latex plain-list)) + (latex-type (let ((env (plist-get attr :environment))) + (cond (env (format "%s" env)) + ((eq type 'ordered) "enumerate") + ((eq type 'descriptive) "description") + (t "itemize"))))) + (org-latex--wrap-label + plain-list + (format "\\begin{%s}%s\n%s\\end{%s}" + latex-type + (or (plist-get attr :options) "") + contents + latex-type)))) + + +;;;; Plain Text + +(defun org-latex-plain-text (text info) + "Transcode a TEXT string from Org to LaTeX. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + (let ((specialp (plist-get info :with-special-strings)) + (output text)) + ;; Protect %, #, &, $, _, { and }. + (while (string-match "\\([^\\]\\|^\\)\\([%$#&{}_]\\)" output) + (setq output + (replace-match + (format "\\%s" (match-string 2 output)) nil t output 2))) + ;; Protect ^. + (setq output + (replace-regexp-in-string + "\\([^\\]\\|^\\)\\(\\^\\)" "\\\\^{}" output nil nil 2)) + ;; Protect \. If special strings are used, be careful not to + ;; protect "\" in "\-" constructs. + (let ((symbols (if specialp "-%$#&{}^_\\" "%$#&{}^_\\"))) + (setq output + (replace-regexp-in-string + (format "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%s]\\|$\\)" symbols) + "$\\backslash$" output nil t 1))) + ;; Protect ~. + (setq output + (replace-regexp-in-string + "\\([^\\]\\|^\\)\\(~\\)" "\\textasciitilde{}" output nil t 2)) + ;; Activate smart quotes. Be sure to provide original TEXT string + ;; since OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output (org-export-activate-smart-quotes output :latex info text))) + ;; LaTeX into \LaTeX{} and TeX into \TeX{}. + (let ((case-fold-search nil) + (start 0)) + (while (string-match "\\<\\(\\(?:La\\)?TeX\\)\\>" output start) + (setq output (replace-match + (format "\\%s{}" (match-string 1 output)) nil t output) + start (match-end 0)))) + ;; Convert special strings. + (when specialp + (setq output + (replace-regexp-in-string "\\.\\.\\." "\\ldots{}" output nil t))) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" output))) + ;; Return value. + output)) + + +;;;; Planning + +(defun org-latex-planning (planning contents info) + "Transcode a PLANNING element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (concat + "\\noindent" + (mapconcat + 'identity + (delq nil + (list + (let ((closed (org-element-property :closed planning))) + (when closed + (concat + (format "\\textbf{%s} " org-closed-string) + (format org-latex-inactive-timestamp-format + (org-translate-time + (org-element-property :raw-value closed)))))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat + (format "\\textbf{%s} " org-deadline-string) + (format org-latex-active-timestamp-format + (org-translate-time + (org-element-property :raw-value deadline)))))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat + (format "\\textbf{%s} " org-scheduled-string) + (format org-latex-active-timestamp-format + (org-translate-time + (org-element-property :raw-value scheduled)))))))) + " ") + "\\\\")) + + +;;;; Quote Block + +(defun org-latex-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (org-latex--wrap-label + quote-block + (format "\\begin{quote}\n%s\\end{quote}" contents))) + + +;;;; Quote Section + +(defun org-latex-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (format "\\begin{verbatim}\n%s\\end{verbatim}" value)))) + + +;;;; Radio Target + +(defun org-latex-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to LaTeX. +TEXT is the text of the target. INFO is a plist holding +contextual information." + (format "\\label{%s}%s" + (org-export-solidify-link-text + (org-element-property :value radio-target)) + text)) + + +;;;; Section + +(defun org-latex-section (section contents info) + "Transcode a SECTION element from Org to LaTeX. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + contents) + + +;;;; Special Block + +(defun org-latex-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((type (downcase (org-element-property :type special-block))) + (opt (org-export-read-attribute :attr_latex special-block :options))) + (concat (format "\\begin{%s}%s\n" type (or opt "")) + ;; Insert any label or caption within the block + ;; (otherwise, a reference pointing to that element will + ;; count the section instead). + (org-latex--caption/label-string special-block info) + contents + (format "\\end{%s}" type)))) + + +;;;; Src Block + +(defun org-latex-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to LaTeX. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (when (org-string-nw-p (org-element-property :value src-block)) + (let* ((lang (org-element-property :language src-block)) + (caption (org-element-property :caption src-block)) + (label (org-element-property :name src-block)) + (custom-env (and lang + (cadr (assq (intern lang) + org-latex-custom-lang-environments)))) + (num-start (case (org-element-property :number-lines src-block) + (continued (org-export-get-loc src-block info)) + (new 0))) + (retain-labels (org-element-property :retain-labels src-block)) + (attributes (org-export-read-attribute :attr_latex src-block)) + (float (plist-get attributes :float))) + (cond + ;; Case 1. No source fontification. + ((not org-latex-listings) + (let* ((caption-str (org-latex--caption/label-string src-block info)) + (float-env + (cond ((and (not float) (plist-member attributes :float)) "%s") + ((string= "multicolumn" float) + (format "\\begin{figure*}[%s]\n%%s%s\n\\end{figure*}" + org-latex-default-figure-position + caption-str)) + ((or caption float) + (format "\\begin{figure}[H]\n%%s%s\n\\end{figure}" + caption-str)) + (t "%s")))) + (format + float-env + (concat (format "\\begin{verbatim}\n%s\\end{verbatim}" + (org-export-format-code-default src-block info)))))) + ;; Case 2. Custom environment. + (custom-env (format "\\begin{%s}\n%s\\end{%s}\n" + custom-env + (org-export-format-code-default src-block info) + custom-env)) + ;; Case 3. Use minted package. + ((eq org-latex-listings 'minted) + (let* ((caption-str (org-latex--caption/label-string src-block info)) + (float-env + (cond ((and (not float) (plist-member attributes :float)) "%s") + ((string= "multicolumn" float) + (format "\\begin{listing*}\n%%s\n%s\\end{listing*}" + caption-str)) + ((or caption float) + (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}" + caption-str)) + (t "%s"))) + (body + (format + "\\begin{minted}[%s]{%s}\n%s\\end{minted}" + ;; Options. + (org-latex--make-option-string + (if (or (not num-start) + (assoc "linenos" org-latex-minted-options)) + org-latex-minted-options + (append + `(("linenos") + ("firstnumber" ,(number-to-string (1+ num-start)))) + org-latex-minted-options))) + ;; Language. + (or (cadr (assq (intern lang) org-latex-minted-langs)) + (downcase lang)) + ;; Source code. + (let* ((code-info (org-export-unravel-code src-block)) + (max-width + (apply 'max + (mapcar 'length + (org-split-string (car code-info) + "\n"))))) + (org-export-format-code + (car code-info) + (lambda (loc num ref) + (concat + loc + (when ref + ;; Ensure references are flushed to the right, + ;; separated with 6 spaces from the widest line + ;; of code. + (concat (make-string (+ (- max-width (length loc)) 6) + ?\s) + (format "(%s)" ref))))) + nil (and retain-labels (cdr code-info))))))) + ;; Return value. + (format float-env body))) + ;; Case 4. Use listings package. + (t + (let ((lst-lang + (or (cadr (assq (intern lang) org-latex-listings-langs)) lang)) + (caption-str + (when caption + (let ((main (org-export-get-caption src-block)) + (secondary (org-export-get-caption src-block t))) + (if (not secondary) + (format "{%s}" (org-export-data main info)) + (format "{[%s]%s}" + (org-export-data secondary info) + (org-export-data main info))))))) + (concat + ;; Options. + (format + "\\lstset{%s}\n" + (org-latex--make-option-string + (append + org-latex-listings-options + (cond + ((and (not float) (plist-member attributes :float)) nil) + ((string= "multicolumn" float) '(("float" "*"))) + ((and float (not (assoc "float" org-latex-listings-options))) + `(("float" ,org-latex-default-figure-position)))) + `(("language" ,lst-lang)) + (if label `(("label" ,label)) '(("label" " "))) + (if caption-str `(("caption" ,caption-str)) '(("caption" " "))) + (cond ((assoc "numbers" org-latex-listings-options) nil) + ((not num-start) '(("numbers" "none"))) + ((zerop num-start) '(("numbers" "left"))) + (t `(("numbers" "left") + ("firstnumber" + ,(number-to-string (1+ num-start))))))))) + ;; Source code. + (format + "\\begin{lstlisting}\n%s\\end{lstlisting}" + (let* ((code-info (org-export-unravel-code src-block)) + (max-width + (apply 'max + (mapcar 'length + (org-split-string (car code-info) "\n"))))) + (org-export-format-code + (car code-info) + (lambda (loc num ref) + (concat + loc + (when ref + ;; Ensure references are flushed to the right, + ;; separated with 6 spaces from the widest line of + ;; code + (concat (make-string (+ (- max-width (length loc)) 6) ? ) + (format "(%s)" ref))))) + nil (and retain-labels (cdr code-info)))))))))))) + + +;;;; Statistics Cookie + +(defun org-latex-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual information." + (replace-regexp-in-string + "%" "\\%" (org-element-property :value statistics-cookie) nil t)) + + +;;;; Strike-Through + +(defun org-latex-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to LaTeX. +CONTENTS is the text with strike-through markup. INFO is a plist +holding contextual information." + (org-latex--text-markup contents 'strike-through)) + + +;;;; Subscript + +(defun org-latex--script-size (object info) + "Transcode a subscript or superscript object. +OBJECT is an Org object. INFO is a plist used as a communication +channel." + (let ((in-script-p + ;; Non-nil if object is already in a sub/superscript. + (let ((parent object)) + (catch 'exit + (while (setq parent (org-export-get-parent parent)) + (let ((type (org-element-type parent))) + (cond ((memq type '(subscript superscript)) + (throw 'exit t)) + ((memq type org-element-all-elements) + (throw 'exit nil)))))))) + (type (org-element-type object)) + (output "")) + (org-element-map (org-element-contents object) + (cons 'plain-text org-element-all-objects) + (lambda (obj) + (case (org-element-type obj) + ((entity latex-fragment) + (let ((data (org-trim (org-export-data obj info)))) + (string-match + "\\`\\(?:\\\\[([]\\|\\$+\\)?\\(.*?\\)\\(?:\\\\[])]\\|\\$+\\)?\\'" + data) + (setq output + (concat output + (match-string 1 data) + (let ((blank (org-element-property :post-blank obj))) + (and blank (> blank 0) "\\ ")))))) + (plain-text + (setq output + (format "%s\\text{%s}" output (org-export-data obj info)))) + (otherwise + (setq output + (concat output + (org-export-data obj info) + (let ((blank (org-element-property :post-blank obj))) + (and blank (> blank 0) "\\ "))))))) + info nil org-element-recursive-objects) + ;; Result. Do not wrap into math mode if already in a subscript + ;; or superscript. Do not wrap into curly brackets if OUTPUT is + ;; a single character. Also merge consecutive subscript and + ;; superscript into the same math snippet. + (concat (and (not in-script-p) + (let ((prev (org-export-get-previous-element object info))) + (or (not prev) + (not (eq (org-element-type prev) + (if (eq type 'subscript) 'superscript + 'subscript))) + (let ((blank (org-element-property :post-blank prev))) + (and blank (> blank 0))))) + "$") + (if (eq (org-element-type object) 'subscript) "_" "^") + (and (> (length output) 1) "{") + output + (and (> (length output) 1) "}") + (and (not in-script-p) + (or (let ((blank (org-element-property :post-blank object))) + (and blank (> blank 0))) + (not (eq (org-element-type + (org-export-get-next-element object info)) + (if (eq type 'subscript) 'superscript + 'subscript)))) + "$")))) + +(defun org-latex-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to LaTeX. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (org-latex--script-size subscript info)) + + +;;;; Superscript + +(defun org-latex-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to LaTeX. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (org-latex--script-size superscript info)) + + +;;;; Table +;; +;; `org-latex-table' is the entry point for table transcoding. It +;; takes care of tables with a "verbatim" mode. Otherwise, it +;; delegates the job to either `org-latex--table.el-table', +;; `org-latex--org-table' or `org-latex--math-table' functions, +;; depending of the type of the table and the mode requested. +;; +;; `org-latex--align-string' is a subroutine used to build alignment +;; string for Org tables. + +(defun org-latex-table (table contents info) + "Transcode a TABLE element from Org to LaTeX. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (if (eq (org-element-property :type table) 'table.el) + ;; "table.el" table. Convert it using appropriate tools. + (org-latex--table.el-table table info) + (let ((type (or (org-export-read-attribute :attr_latex table :mode) + org-latex-default-table-mode))) + (cond + ;; Case 1: Verbatim table. + ((string= type "verbatim") + (format "\\begin{verbatim}\n%s\n\\end{verbatim}" + ;; Re-create table, without affiliated keywords. + (org-trim (org-element-interpret-data + `(table nil ,@(org-element-contents table)))))) + ;; Case 2: Matrix. + ((or (string= type "math") (string= type "inline-math")) + (org-latex--math-table table info)) + ;; Case 3: Standard table. + (t (concat (org-latex--org-table table contents info) + ;; When there are footnote references within the + ;; table, insert their definition just after it. + (org-latex--delayed-footnotes-definitions table info))))))) + +(defun org-latex--align-string (table info) + "Return an appropriate LaTeX alignment string. +TABLE is the considered table. INFO is a plist used as +a communication channel." + (or (org-export-read-attribute :attr_latex table :align) + (let (align) + ;; Extract column groups and alignment from first (non-rule) + ;; row. + (org-element-map + (org-element-map table 'table-row + (lambda (row) + (and (eq (org-element-property :type row) 'standard) row)) + info 'first-match) + 'table-cell + (lambda (cell) + (let ((borders (org-export-table-cell-borders cell info))) + ;; Check left border for the first cell only. + (when (and (memq 'left borders) (not align)) + (push "|" align)) + (push (case (org-export-table-cell-alignment cell info) + (left "l") + (right "r") + (center "c")) + align) + (when (memq 'right borders) (push "|" align)))) + info) + (apply 'concat (nreverse align))))) + +(defun org-latex--org-table (table contents info) + "Return appropriate LaTeX code for an Org table. + +TABLE is the table type element to transcode. CONTENTS is its +contents, as a string. INFO is a plist used as a communication +channel. + +This function assumes TABLE has `org' as its `:type' property and +`table' as its `:mode' attribute." + (let* ((caption (org-latex--caption/label-string table info)) + (attr (org-export-read-attribute :attr_latex table)) + ;; Determine alignment string. + (alignment (org-latex--align-string table info)) + ;; Determine environment for the table: longtable, tabular... + (table-env (or (plist-get attr :environment) + org-latex-default-table-environment)) + ;; If table is a float, determine environment: table, table* + ;; or sidewaystable. + (float-env (unless (member table-env '("longtable" "longtabu")) + (let ((float (plist-get attr :float))) + (cond + ((and (not float) (plist-member attr :float)) nil) + ((string= float "sidewaystable") "sidewaystable") + ((string= float "multicolumn") "table*") + ((or float + (org-element-property :caption table) + (org-string-nw-p (plist-get attr :caption))) + "table"))))) + ;; Extract others display options. + (fontsize (let ((font (plist-get attr :font))) + (and font (concat font "\n")))) + (width (plist-get attr :width)) + (spreadp (plist-get attr :spread)) + (placement (or (plist-get attr :placement) + (format "[%s]" org-latex-default-figure-position))) + (centerp (if (plist-member attr :center) (plist-get attr :center) + org-latex-tables-centered))) + ;; Prepare the final format string for the table. + (cond + ;; Longtable. + ((equal "longtable" table-env) + (concat (and fontsize (concat "{" fontsize)) + (format "\\begin{longtable}{%s}\n" alignment) + (and org-latex-table-caption-above + (org-string-nw-p caption) + (concat caption "\\\\\n")) + contents + (and (not org-latex-table-caption-above) + (org-string-nw-p caption) + (concat caption "\\\\\n")) + "\\end{longtable}\n" + (and fontsize "}"))) + ;; Longtabu + ((equal "longtabu" table-env) + (concat (and fontsize (concat "{" fontsize)) + (format "\\begin{longtabu}%s{%s}\n" + (if width + (format " %s %s " + (if spreadp "spread" "to") width) "") + alignment) + (and org-latex-table-caption-above + (org-string-nw-p caption) + (concat caption "\\\\\n")) + contents + (and (not org-latex-table-caption-above) + (org-string-nw-p caption) + (concat caption "\\\\\n")) + "\\end{longtabu}\n" + (and fontsize "}"))) + ;; Others. + (t (concat (cond + (float-env + (concat (format "\\begin{%s}%s\n" float-env placement) + (if org-latex-table-caption-above caption "") + (when centerp "\\centering\n") + fontsize)) + (centerp (concat "\\begin{center}\n" fontsize)) + (fontsize (concat "{" fontsize))) + (cond ((equal "tabu" table-env) + (format "\\begin{tabu}%s{%s}\n%s\\end{tabu}" + (if width (format + (if spreadp " spread %s " " to %s ") + width) "") + alignment + contents)) + (t (format "\\begin{%s}%s{%s}\n%s\\end{%s}" + table-env + (if width (format "{%s}" width) "") + alignment + contents + table-env))) + (cond + (float-env + (concat (if org-latex-table-caption-above "" caption) + (format "\n\\end{%s}" float-env))) + (centerp "\n\\end{center}") + (fontsize "}"))))))) + +(defun org-latex--table.el-table (table info) + "Return appropriate LaTeX code for a table.el table. + +TABLE is the table type element to transcode. INFO is a plist +used as a communication channel. + +This function assumes TABLE has `table.el' as its `:type' +property." + (require 'table) + ;; Ensure "*org-export-table*" buffer is empty. + (with-current-buffer (get-buffer-create "*org-export-table*") + (erase-buffer)) + (let ((output (with-temp-buffer + (insert (org-element-property :value table)) + (goto-char 1) + (re-search-forward "^[ \t]*|[^|]" nil t) + (table-generate-source 'latex "*org-export-table*") + (with-current-buffer "*org-export-table*" + (org-trim (buffer-string)))))) + (kill-buffer (get-buffer "*org-export-table*")) + ;; Remove left out comments. + (while (string-match "^%.*\n" output) + (setq output (replace-match "" t t output))) + (let ((attr (org-export-read-attribute :attr_latex table))) + (when (plist-get attr :rmlines) + ;; When the "rmlines" attribute is provided, remove all hlines + ;; but the the one separating heading from the table body. + (let ((n 0) (pos 0)) + (while (and (< (length output) pos) + (setq pos (string-match "^\\\\hline\n?" output pos))) + (incf n) + (unless (= n 2) (setq output (replace-match "" nil nil output)))))) + (let ((centerp (if (plist-member attr :center) (plist-get attr :center) + org-latex-tables-centered))) + (if (not centerp) output + (format "\\begin{center}\n%s\n\\end{center}" output)))))) + +(defun org-latex--math-table (table info) + "Return appropriate LaTeX code for a matrix. + +TABLE is the table type element to transcode. INFO is a plist +used as a communication channel. + +This function assumes TABLE has `org' as its `:type' property and +`inline-math' or `math' as its `:mode' attribute.." + (let* ((caption (org-latex--caption/label-string table info)) + (attr (org-export-read-attribute :attr_latex table)) + (inlinep (equal (plist-get attr :mode) "inline-math")) + (env (or (plist-get attr :environment) + org-latex-default-table-environment)) + (contents + (mapconcat + (lambda (row) + ;; Ignore horizontal rules. + (when (eq (org-element-property :type row) 'standard) + ;; Return each cell unmodified. + (concat + (mapconcat + (lambda (cell) + (substring (org-element-interpret-data cell) 0 -1)) + (org-element-map row 'table-cell 'identity info) "&") + (or (cdr (assoc env org-latex-table-matrix-macros)) "\\\\") + "\n"))) + (org-element-map table 'table-row 'identity info) "")) + ;; Variables related to math clusters (contiguous math tables + ;; of the same type). + (mode (org-export-read-attribute :attr_latex table :mode)) + (prev (org-export-get-previous-element table info)) + (next (org-export-get-next-element table info)) + (same-mode-p + (lambda (table) + ;; Non-nil when TABLE has the same mode as current table. + (string= (or (org-export-read-attribute :attr_latex table :mode) + org-latex-default-table-mode) + mode)))) + (concat + ;; Opening string. If TABLE is in the middle of a table cluster, + ;; do not insert any. + (cond ((and prev + (eq (org-element-type prev) 'table) + (memq (org-element-property :post-blank prev) '(0 nil)) + (funcall same-mode-p prev)) + nil) + (inlinep "\\(") + ((org-string-nw-p caption) (concat "\\begin{equation}\n" caption)) + (t "\\[")) + ;; Prefix. + (or (plist-get attr :math-prefix) "") + ;; Environment. Also treat special cases. + (cond ((equal env "array") + (let ((align (org-latex--align-string table info))) + (format "\\begin{array}{%s}\n%s\\end{array}" align contents))) + ((assoc env org-latex-table-matrix-macros) + (format "\\%s%s{\n%s}" + env + (or (plist-get attr :math-arguments) "") + contents)) + (t (format "\\begin{%s}\n%s\\end{%s}" env contents env))) + ;; Suffix. + (or (plist-get attr :math-suffix) "") + ;; Closing string. If TABLE is in the middle of a table cluster, + ;; do not insert any. If it closes such a cluster, be sure to + ;; close the cluster with a string matching the opening string. + (cond ((and next + (eq (org-element-type next) 'table) + (memq (org-element-property :post-blank table) '(0 nil)) + (funcall same-mode-p next)) + nil) + (inlinep "\\)") + ;; Find cluster beginning to know which environment to use. + ((let ((cluster-beg table) prev) + (while (and (setq prev (org-export-get-previous-element + cluster-beg info)) + (memq (org-element-property :post-blank prev) + '(0 nil)) + (funcall same-mode-p prev)) + (setq cluster-beg prev)) + (and (or (org-element-property :caption cluster-beg) + (org-element-property :name cluster-beg)) + "\n\\end{equation}"))) + (t "\\]"))))) + + +;;;; Table Cell + +(defun org-latex-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to LaTeX. +CONTENTS is the cell contents. INFO is a plist used as +a communication channel." + (concat (if (and contents + org-latex-table-scientific-notation + (string-match orgtbl-exp-regexp contents)) + ;; Use appropriate format string for scientific + ;; notation. + (format org-latex-table-scientific-notation + (match-string 1 contents) + (match-string 2 contents)) + contents) + (when (org-export-get-next-element table-cell info) " & "))) + + +;;;; Table Row + +(defun org-latex-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to LaTeX. +CONTENTS is the contents of the row. INFO is a plist used as +a communication channel." + ;; Rules are ignored since table separators are deduced from + ;; borders of the current row. + (when (eq (org-element-property :type table-row) 'standard) + (let* ((attr (org-export-read-attribute :attr_latex + (org-export-get-parent table-row))) + (longtablep (member (or (plist-get attr :environment) + org-latex-default-table-environment) + '("longtable" "longtabu"))) + (booktabsp (if (plist-member attr :booktabs) + (plist-get attr :booktabs) + org-latex-tables-booktabs)) + ;; TABLE-ROW's borders are extracted from its first cell. + (borders (org-export-table-cell-borders + (car (org-element-contents table-row)) info))) + (concat + ;; When BOOKTABS are activated enforce top-rule even when no + ;; hline was specifically marked. + (cond ((and booktabsp (memq 'top borders)) "\\toprule\n") + ((and (memq 'top borders) (memq 'above borders)) "\\hline\n")) + contents "\\\\\n" + (cond + ;; Special case for long tables. Define header and footers. + ((and longtablep (org-export-table-row-ends-header-p table-row info)) + (format "%s +\\endhead +%s\\multicolumn{%d}{r}{Continued on next page} \\\\ +\\endfoot +\\endlastfoot" + (if booktabsp "\\midrule" "\\hline") + (if booktabsp "\\midrule" "\\hline") + ;; Number of columns. + (cdr (org-export-table-dimensions + (org-export-get-parent-table table-row) info)))) + ;; When BOOKTABS are activated enforce bottom rule even when + ;; no hline was specifically marked. + ((and booktabsp (memq 'bottom borders)) "\\bottomrule") + ((and (memq 'bottom borders) (memq 'below borders)) "\\hline") + ((memq 'below borders) (if booktabsp "\\midrule" "\\hline"))))))) + + +;;;; Target + +(defun org-latex-target (target contents info) + "Transcode a TARGET object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "\\label{%s}" + (org-export-solidify-link-text (org-element-property :value target)))) + + +;;;; Timestamp + +(defun org-latex-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to LaTeX. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((value (org-latex-plain-text + (org-timestamp-translate timestamp) info))) + (case (org-element-property :type timestamp) + ((active active-range) (format org-latex-active-timestamp-format value)) + ((inactive inactive-range) + (format org-latex-inactive-timestamp-format value)) + (otherwise (format org-latex-diary-timestamp-format value))))) + + +;;;; Underline + +(defun org-latex-underline (underline contents info) + "Transcode UNDERLINE from Org to LaTeX. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (org-latex--text-markup contents 'underline)) + + +;;;; Verbatim + +(defun org-latex-verbatim (verbatim contents info) + "Transcode a VERBATIM object from Org to LaTeX. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (org-latex--text-markup (org-element-property :value verbatim) 'verbatim)) + + +;;;; Verse Block + +(defun org-latex-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to LaTeX. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + (org-latex--wrap-label + verse-block + ;; In a verse environment, add a line break to each newline + ;; character and change each white space at beginning of a line + ;; into a space of 1 em. Also change each blank line with + ;; a vertical space of 1 em. + (progn + (setq contents (replace-regexp-in-string + "^ *\\\\\\\\$" "\\\\vspace*{1em}" + (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" contents))) + (while (string-match "^[ \t]+" contents) + (let ((new-str (format "\\hspace*{%dem}" + (length (match-string 0 contents))))) + (setq contents (replace-match new-str nil t contents)))) + (format "\\begin{verse}\n%s\\end{verse}" contents)))) + + + +;;; End-user functions + +;;;###autoload +(defun org-latex-export-as-latex + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer as a LaTeX buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org LATEX Export*\", which +will be displayed when `org-export-show-temporary-export-buffer' +is non-nil." + (interactive) + (org-export-to-buffer 'latex "*Org LATEX Export*" + async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) + +;;;###autoload +(defun org-latex-convert-region-to-latex () + "Assume the current region has org-mode syntax, and convert it to LaTeX. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in an LaTeX buffer and use this +command to convert it." + (interactive) + (org-export-replace-region-by 'latex)) + +;;;###autoload +(defun org-latex-export-to-latex + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a LaTeX file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings." + (interactive) + (let ((outfile (org-export-output-file-name ".tex" subtreep))) + (org-export-to-file 'latex outfile + async subtreep visible-only body-only ext-plist))) + +;;;###autoload +(defun org-latex-export-to-pdf + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to LaTeX then process through to PDF. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return PDF file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".tex" subtreep))) + (org-export-to-file 'latex outfile + async subtreep visible-only body-only ext-plist + (lambda (file) (org-latex-compile file))))) + +(defun org-latex-compile (texfile &optional snippet) + "Compile a TeX file. + +TEXFILE is the name of the file being compiled. Processing is +done through the command specified in `org-latex-pdf-process'. + +When optional argument SNIPPET is non-nil, TEXFILE is a temporary +file used to preview a LaTeX snippet. In this case, do not +create a log buffer and do not bother removing log files. + +Return PDF file name or an error if it couldn't be produced." + (let* ((base-name (file-name-sans-extension (file-name-nondirectory texfile))) + (full-name (file-truename texfile)) + (out-dir (file-name-directory texfile)) + ;; Properly set working directory for compilation. + (default-directory (if (file-name-absolute-p texfile) + (file-name-directory full-name) + default-directory)) + errors) + (unless snippet (message (format "Processing LaTeX file %s..." texfile))) + (save-window-excursion + (cond + ;; A function is provided: Apply it. + ((functionp org-latex-pdf-process) + (funcall org-latex-pdf-process (shell-quote-argument texfile))) + ;; A list is provided: Replace %b, %f and %o with appropriate + ;; values in each command before applying it. Output is + ;; redirected to "*Org PDF LaTeX Output*" buffer. + ((consp org-latex-pdf-process) + (let ((outbuf (and (not snippet) + (get-buffer-create "*Org PDF LaTeX Output*")))) + (mapc + (lambda (command) + (shell-command + (replace-regexp-in-string + "%b" (shell-quote-argument base-name) + (replace-regexp-in-string + "%f" (shell-quote-argument full-name) + (replace-regexp-in-string + "%o" (shell-quote-argument out-dir) command t t) t t) t t) + outbuf)) + org-latex-pdf-process) + ;; Collect standard errors from output buffer. + (setq errors (and (not snippet) (org-latex--collect-errors outbuf))))) + (t (error "No valid command to process to PDF"))) + (let ((pdffile (concat out-dir base-name ".pdf"))) + ;; Check for process failure. Provide collected errors if + ;; possible. + (if (not (file-exists-p pdffile)) + (error (concat (format "PDF file %s wasn't produced" pdffile) + (when errors (concat ": " errors)))) + ;; Else remove log files, when specified, and signal end of + ;; process to user, along with any error encountered. + (when (and (not snippet) org-latex-remove-logfiles) + (dolist (file (directory-files + out-dir t + (concat (regexp-quote base-name) + "\\(?:\\.[0-9]+\\)?" + "\\." + (regexp-opt org-latex-logfiles-extensions)))) + (delete-file file))) + (message (concat "Process completed" + (if (not errors) "." + (concat " with errors: " errors))))) + ;; Return output file name. + pdffile)))) + +(defun org-latex--collect-errors (buffer) + "Collect some kind of errors from \"pdflatex\" command output. + +BUFFER is the buffer containing output. + +Return collected error types as a string, or nil if there was +none." + (with-current-buffer buffer + (save-excursion + (goto-char (point-max)) + (when (re-search-backward "^[ \t]*This is .*?TeX.*?Version" nil t) + (let ((case-fold-search t) + (errors "")) + (dolist (latex-error org-latex-known-errors) + (when (save-excursion (re-search-forward (car latex-error) nil t)) + (setq errors (concat errors " " (cdr latex-error))))) + (and (org-string-nw-p errors) (org-trim errors))))))) + +;;;###autoload +(defun org-latex-publish-to-latex (plist filename pub-dir) + "Publish an Org file to LaTeX. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'latex filename ".tex" plist pub-dir)) + +;;;###autoload +(defun org-latex-publish-to-pdf (plist filename pub-dir) + "Publish an Org file to PDF (via LaTeX). + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + ;; Unlike to `org-latex-publish-to-latex', PDF file is generated + ;; in working directory and then moved to publishing directory. + (org-publish-attachment + plist + (org-latex-compile + (org-publish-org-to + 'latex filename ".tex" plist (file-name-directory filename))) + pub-dir)) + + +(provide 'ox-latex) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-latex.el ends here diff --git a/elpa/org-20150427/ox-man.el b/elpa/org-20150427/ox-man.el new file mode 100644 index 00000000..7407c9b6 --- /dev/null +++ b/elpa/org-20150427/ox-man.el @@ -0,0 +1,1254 @@ +;; ox-man.el --- Man Back-End for Org Export Engine + +;; Copyright (C) 2011-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Luis R Anaya +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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 . + +;;; Commentary: +;; +;; This library implements a Man back-end for Org generic exporter. +;; +;; To test it, run +;; +;; M-: (org-export-to-buffer 'man "*Test Man*") RET +;; +;; in an org-mode buffer then switch to the buffer to see the Man +;; export. See ox.el for more details on how this exporter works. +;; +;; It introduces one new buffer keywords: +;; "MAN_CLASS_OPTIONS". + +;;; Code: + +(require 'ox) + +(eval-when-compile (require 'cl)) + +(defvar org-export-man-default-packages-alist) +(defvar org-export-man-packages-alist) +(defvar orgtbl-exp-regexp) + + + +;;; Define Back-End + +(org-export-define-backend 'man + '((babel-call . org-man-babel-call) + (bold . org-man-bold) + (center-block . org-man-center-block) + (clock . org-man-clock) + (code . org-man-code) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (drawer . org-man-drawer) + (dynamic-block . org-man-dynamic-block) + (entity . org-man-entity) + (example-block . org-man-example-block) + (export-block . org-man-export-block) + (export-snippet . org-man-export-snippet) + (fixed-width . org-man-fixed-width) + (footnote-definition . org-man-footnote-definition) + (footnote-reference . org-man-footnote-reference) + (headline . org-man-headline) + (horizontal-rule . org-man-horizontal-rule) + (inline-babel-call . org-man-inline-babel-call) + (inline-src-block . org-man-inline-src-block) + (inlinetask . org-man-inlinetask) + (italic . org-man-italic) + (item . org-man-item) + (keyword . org-man-keyword) + (line-break . org-man-line-break) + (link . org-man-link) + (paragraph . org-man-paragraph) + (plain-list . org-man-plain-list) + (plain-text . org-man-plain-text) + (planning . org-man-planning) + (property-drawer . (lambda (&rest args) "")) + (quote-block . org-man-quote-block) + (quote-section . org-man-quote-section) + (radio-target . org-man-radio-target) + (section . org-man-section) + (special-block . org-man-special-block) + (src-block . org-man-src-block) + (statistics-cookie . org-man-statistics-cookie) + (strike-through . org-man-strike-through) + (subscript . org-man-subscript) + (superscript . org-man-superscript) + (table . org-man-table) + (table-cell . org-man-table-cell) + (table-row . org-man-table-row) + (target . org-man-target) + (template . org-man-template) + (timestamp . org-man-timestamp) + (underline . org-man-underline) + (verbatim . org-man-verbatim) + (verse-block . org-man-verse-block)) + :export-block "MAN" + :menu-entry + '(?M "Export to MAN" + ((?m "As MAN file" org-man-export-to-man) + (?p "As PDF file" org-man-export-to-pdf) + (?o "As PDF file and open" + (lambda (a s v b) + (if a (org-man-export-to-pdf t s v b) + (org-open-file (org-man-export-to-pdf nil s v b))))))) + :options-alist + '((:man-class "MAN_CLASS" nil nil t) + (:man-class-options "MAN_CLASS_OPTIONS" nil nil t) + (:man-header-extra "MAN_HEADER" nil nil newline))) + + + +;;; User Configurable Variables + +(defgroup org-export-man nil + "Options for exporting Org mode files to Man." + :tag "Org Export Man" + :group 'org-export) + +;;; Tables + +(defcustom org-man-tables-centered t + "When non-nil, tables are exported in a center environment." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-man-tables-verbatim nil + "When non-nil, tables are exported verbatim." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + + +(defcustom org-man-table-scientific-notation "%sE%s" + "Format string to display numbers in scientific notation. +The format should have \"%s\" twice, for mantissa and exponent +\(i.e. \"%s\\\\times10^{%s}\"). + +When nil, no transformation is made." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (string :tag "Format string") + (const :tag "No formatting"))) + + +;;; Inlinetasks +;; Src blocks + +(defcustom org-man-source-highlight nil + "Use GNU source highlight to embellish source blocks " + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + + +(defcustom org-man-source-highlight-langs + '((emacs-lisp "lisp") (lisp "lisp") (clojure "lisp") + (scheme "scheme") + (c "c") (cc "cpp") (csharp "csharp") (d "d") + (fortran "fortran") (cobol "cobol") (pascal "pascal") + (ada "ada") (asm "asm") + (perl "perl") (cperl "perl") + (python "python") (ruby "ruby") (tcl "tcl") (lua "lua") + (java "java") (javascript "javascript") + (tex "latex") + (shell-script "sh") (awk "awk") (diff "diff") (m4 "m4") + (ocaml "caml") (caml "caml") + (sql "sql") (sqlite "sql") + (html "html") (css "css") (xml "xml") + (bat "bat") (bison "bison") (clipper "clipper") + (ldap "ldap") (opa "opa") + (php "php") (postscript "postscript") (prolog "prolog") + (properties "properties") (makefile "makefile") + (tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg")) + "Alist mapping languages to their listing language counterpart. +The key is a symbol, the major mode symbol without the \"-mode\". +The value is the string that should be inserted as the language +parameter for the listings package. If the mode name and the +listings name are the same, the language does not need an entry +in this list - but it does not hurt if it is present." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type '(repeat + (list + (symbol :tag "Major mode ") + (string :tag "Listings language")))) + + + +(defvar org-man-custom-lang-environments nil + "Alist mapping languages to language-specific Man environments. + +It is used during export of src blocks by the listings and +man packages. For example, + + \(setq org-man-custom-lang-environments + '\(\(python \"pythoncode\"\)\)\) + +would have the effect that if org encounters begin_src python +during man export." +) + + +;;; Compilation + +(defcustom org-man-pdf-process + '("tbl %f | eqn | groff -man | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf") + + "Commands to process a Man file to a PDF file. +This is a list of strings, each of them will be given to the +shell as a command. %f in the command will be replaced by the +full file name, %b by the file base name (i.e. without directory +and extension parts) and %o by the base directory of the file. + + +By default, Org uses 3 runs of to do the processing. + +Alternatively, this may be a Lisp function that does the +processing. This function should accept the file name as +its single argument." + :group 'org-export-pdf + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (repeat :tag "Shell command sequence" + (string :tag "Shell command")) + (const :tag "2 runs of pdfgroff" + ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" )) + (const :tag "3 runs of pdfgroff" + ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" + "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf")) + (function))) + +(defcustom org-man-logfiles-extensions + '("log" "out" "toc") + "The list of file extensions to consider as Man logfiles." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type '(repeat (string :tag "Extension"))) + +(defcustom org-man-remove-logfiles t + "Non-nil means remove the logfiles produced by PDF production. +These are the .aux, .log, .out, and .toc files." + :group 'org-export-man + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + + + +;;; Internal Functions + +(defun org-man--caption/label-string (element info) + "Return caption and label Man string for ELEMENT. + +INFO is a plist holding contextual information. If there's no +caption nor label, return the empty string. + +For non-floats, see `org-man--wrap-label'." + (let ((label (org-element-property :label element)) + (main (org-export-get-caption element)) + (short (org-export-get-caption element t))) + (cond ((and (not main) (not label)) "") + ((not main) (format "\\fI%s\\fP" label)) + ;; Option caption format with short name. + (short (format "\\fR%s\\fP - \\fI\\P - %s\n" + (org-export-data short info) + (org-export-data main info))) + ;; Standard caption format. + (t (format "\\fR%s\\fP" (org-export-data main info)))))) + +(defun org-man--wrap-label (element output) + "Wrap label associated to ELEMENT around OUTPUT, if appropriate. +This function shouldn't be used for floats. See +`org-man--caption/label-string'." + (let ((label (org-element-property :name element))) + (if (or (not output) (not label) (string= output "") (string= label "")) + output + (concat (format "%s\n.br\n" label) output)))) + + + +;;; Template + +(defun org-man-template (contents info) + "Return complete document string after Man conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (let* ((title (org-export-data (plist-get info :title) info)) + (attr (read (format "(%s)" + (mapconcat + #'identity + (list (plist-get info :man-class-options)) + " ")))) + (section-item (plist-get attr :section-id))) + + (concat + + (cond + ((and title (stringp section-item)) + (format ".TH \"%s\" \"%s\" \n" title section-item)) + ((and (string= "" title) (stringp section-item)) + (format ".TH \"%s\" \"%s\" \n" " " section-item)) + (title + (format ".TH \"%s\" \"1\" \n" title)) + (t + ".TH \" \" \"1\" ")) + contents))) + + + + +;;; Transcode Functions + +;;; Babel Call +;; +;; Babel Calls are ignored. + + +;;; Bold + +(defun org-man-bold (bold contents info) + "Transcode BOLD from Org to Man. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (format "\\fB%s\\fP" contents)) + + +;;; Center Block + +(defun org-man-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to Man. +CONTENTS holds the contents of the center block. INFO is a plist +holding contextual information." + (org-man--wrap-label + center-block + (format ".ce %d\n.nf\n%s\n.fi" + (- (length (split-string contents "\n")) 1 ) + contents))) + + +;;; Clock + +(defun org-man-clock (clock contents info) + "Transcode a CLOCK element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual +information." + "" ) + + +;;; Code + +(defun org-man-code (code contents info) + "Transcode a CODE object from Org to Man. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "\\fC%s\\fP" code)) + + +;;; Comment +;; +;; Comments are ignored. + + +;;; Comment Block +;; +;; Comment Blocks are ignored. + + +;;; Drawer + +(defun org-man-drawer (drawer contents info) + "Transcode a DRAWER element from Org to Man. + DRAWER holds the drawer information + CONTENTS holds the contents of the block. + INFO is a plist holding contextual information. " + contents) + + +;;; Dynamic Block + +(defun org-man-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to Man. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information. See `org-export-data'." + (org-man--wrap-label dynamic-block contents)) + + +;;; Entity + +(defun org-man-entity (entity contents info) + "Transcode an ENTITY object from Org to Man. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (org-element-property :utf-8 entity)) + + +;;; Example Block + +(defun org-man-example-block (example-block contents info) + "Transcode an EXAMPLE-BLOCK element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual +information." + (org-man--wrap-label + example-block + (format ".RS\n.nf\n%s\n.fi\n.RE" + (org-export-format-code-default example-block info)))) + + +;;; Export Block + +(defun org-man-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (string= (org-element-property :type export-block) "MAN") + (org-remove-indentation (org-element-property :value export-block)))) + + +;;; Export Snippet + +(defun org-man-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (eq (org-export-snippet-backend export-snippet) 'man) + (org-element-property :value export-snippet))) + + +;;; Fixed Width + +(defun org-man-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-man--wrap-label + fixed-width + (format "\\fC\n%s\\fP" + (org-remove-indentation + (org-element-property :value fixed-width))))) + + +;;; Footnote Definition +;; +;; Footnote Definitions are ignored. + +;;; Footnote References +;; +;; Footnote References are Ignored + + +;;; Headline + +(defun org-man-headline (headline contents info) + "Transcode a HEADLINE element from Org to Man. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + (let* ((level (org-export-get-relative-level headline info)) + (numberedp (org-export-numbered-headline-p headline info)) + ;; Section formatting will set two placeholders: one for the + ;; title and the other for the contents. + (section-fmt + (case level + (1 ".SH \"%s\"\n%s") + (2 ".SS \"%s\"\n%s") + (3 ".SS \"%s\"\n%s") + (t nil))) + (text (org-export-data (org-element-property :title headline) info))) + + (cond + ;; Case 1: This is a footnote section: ignore it. + ((org-element-property :footnote-section-p headline) nil) + + ;; Case 2. This is a deep sub-tree: export it as a list item. + ;; Also export as items headlines for which no section + ;; format has been found. + ((or (not section-fmt) (org-export-low-level-p headline info)) + ;; Build the real contents of the sub-tree. + (let ((low-level-body + (concat + ;; If the headline is the first sibling, start a list. + (when (org-export-first-sibling-p headline info) + (format "%s\n" ".RS")) + ;; Itemize headline + ".TP\n.ft I\n" text "\n.ft\n" + contents ".RE"))) + ;; If headline is not the last sibling simply return + ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any + ;; blank line. + (if (not (org-export-last-sibling-p headline info)) low-level-body + (replace-regexp-in-string + "[ \t\n]*\\'" "" + low-level-body)))) + + ;; Case 3. Standard headline. Export it as a section. + (t (format section-fmt text contents ))))) + +;;; Horizontal Rule +;; Not supported + +;;; Inline Babel Call +;; +;; Inline Babel Calls are ignored. + +;;; Inline Src Block + +(defun org-man-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to Man. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((code (org-element-property :value inline-src-block))) + (cond + (org-man-source-highlight + (let* ((tmpdir (if (featurep 'xemacs) + temp-directory + temporary-file-directory )) + (in-file (make-temp-name + (expand-file-name "srchilite" tmpdir))) + (out-file (make-temp-name + (expand-file-name "reshilite" tmpdir))) + (org-lang (org-element-property :language inline-src-block)) + (lst-lang (cadr (assq (intern org-lang) + org-man-source-highlight-langs))) + + (cmd (concat (expand-file-name "source-highlight") + " -s " lst-lang + " -f groff_man" + " -i " in-file + " -o " out-file ))) + + (if lst-lang + (let ((code-block "" )) + (with-temp-file in-file (insert code)) + (shell-command cmd) + (setq code-block (org-file-contents out-file)) + (delete-file in-file) + (delete-file out-file) + code-block) + (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE\n" + code)))) + + ;; Do not use a special package: transcode it verbatim. + (t + (concat ".RS\n.nf\n" "\\fC" "\n" code "\n" + "\\fP\n.fi\n.RE\n"))))) + + +;;; Inlinetask +;;; Italic + +(defun org-man-italic (italic contents info) + "Transcode ITALIC from Org to Man. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (format "\\fI%s\\fP" contents)) + + +;;; Item + + +(defun org-man-item (item contents info) + + "Transcode an ITEM element from Org to Man. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + + (let* ((bullet (org-element-property :bullet item)) + (type (org-element-property :type (org-element-property :parent item))) + (checkbox (case (org-element-property :checkbox item) + (on "\\o'\\(sq\\(mu'") ;; + (off "\\(sq ") ;; + (trans "\\o'\\(sq\\(mi'" ))) ;; + + (tag (let ((tag (org-element-property :tag item))) + ;; Check-boxes must belong to the tag. + (and tag (format "\\fB%s\\fP" + (concat checkbox + (org-export-data tag info))))))) + + (if (and (null tag ) + (null checkbox)) + (let* ((bullet (org-trim bullet)) + (marker (cond ((string= "-" bullet) "\\(em") + ((string= "*" bullet) "\\(bu") + ((eq type 'ordered) + (format "%s " (org-trim bullet))) + (t "\\(dg")))) + (concat ".IP " marker " 4\n" + (org-trim (or contents " " )))) + ; else + (concat ".TP\n" (or tag (concat " " checkbox)) "\n" + (org-trim (or contents " " )))))) + +;;; Keyword + + +(defun org-man-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "MAN") value) + ((string= key "INDEX") nil) + ((string= key "TOC" ) nil)))) + + +;;; Line Break + +(defun org-man-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + ".br\n") + + +;;; Link + + +(defun org-man-link (link desc info) + "Transcode a LINK object from Org to Man. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + (let* ((type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + ;; Ensure DESC really exists, or set it to nil. + (desc (and (not (string= desc "")) desc)) + (path (cond + ((member type '("http" "https" "ftp" "mailto")) + (concat type ":" raw-path)) + ((and (string= type "file") (file-name-absolute-p raw-path)) + (concat "file:" raw-path)) + (t raw-path))) + protocol) + (cond + ;; External link with a description part. + ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc)) + ;; External link without a description part. + (path (format "\\fI%s\\fP" path)) + ;; No path, only description. Try to do something useful. + (t (format "\\fI%s\\fP" desc))))) + + +;;; Paragraph + +(defun org-man-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to Man. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + (let ((parent (plist-get (nth 1 paragraph) :parent))) + (when parent + (let ((parent-type (car parent)) + (fixed-paragraph "")) + (cond ((and (eq parent-type 'item) + (plist-get (nth 1 parent) :bullet )) + (setq fixed-paragraph (concat "" contents))) + ((eq parent-type 'section) + (setq fixed-paragraph (concat ".PP\n" contents))) + ((eq parent-type 'footnote-definition) + (setq fixed-paragraph contents)) + (t (setq fixed-paragraph (concat "" contents)))) + fixed-paragraph )))) + + +;;; Plain List + +(defun org-man-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to Man. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + contents) + +;;; Plain Text + +(defun org-man-plain-text (text info) + "Transcode a TEXT string from Org to Man. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + (let ((output text)) + ;; Protect various chars. + (setq output (replace-regexp-in-string + "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)" + "$\\" output nil t 1)) + ;; Activate smart quotes. Be sure to provide original TEXT string + ;; since OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output (org-export-activate-smart-quotes output :utf-8 info text))) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" ".br\n" + output))) + ;; Return value. + output)) + + + +;;; Planning + + +;;; Property Drawer + + +;;; Quote Block + +(defun org-man-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to Man. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (org-man--wrap-label + quote-block + (format ".RS\n%s\n.RE" contents))) + +;;; Quote Section + +(defun org-man-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (format ".RS\\fI%s\\fP\n.RE\n" value)))) + + +;;; Radio Target + +(defun org-man-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to Man. +TEXT is the text of the target. INFO is a plist holding +contextual information." + text ) + + +;;; Section + +(defun org-man-section (section contents info) + "Transcode a SECTION element from Org to Man. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + contents) + + +;;; Special Block + +(defun org-man-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to Man. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((type (downcase (org-element-property :type special-block)))) + (org-man--wrap-label + special-block + (format "%s\n" contents)))) + + +;;; Src Block + +(defun org-man-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to Man. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((lang (org-element-property :language src-block)) + (code (org-element-property :value src-block)) + (custom-env (and lang + (cadr (assq (intern lang) + org-man-custom-lang-environments)))) + (num-start (case (org-element-property :number-lines src-block) + (continued (org-export-get-loc src-block info)) + (new 0))) + (retain-labels (org-element-property :retain-labels src-block))) + (cond + ;; Case 1. No source fontification. + ((not org-man-source-highlight) + (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n" + (org-export-format-code-default src-block info))) + (org-man-source-highlight + (let* ((tmpdir (if (featurep 'xemacs) + temp-directory + temporary-file-directory )) + + (in-file (make-temp-name + (expand-file-name "srchilite" tmpdir))) + (out-file (make-temp-name + (expand-file-name "reshilite" tmpdir))) + + (org-lang (org-element-property :language src-block)) + (lst-lang (cadr (assq (intern org-lang) + org-man-source-highlight-langs))) + + (cmd (concat "source-highlight" + " -s " lst-lang + " -f groff_man " + " -i " in-file + " -o " out-file))) + + (if lst-lang + (let ((code-block "")) + (with-temp-file in-file (insert code)) + (shell-command cmd) + (setq code-block (org-file-contents out-file)) + (delete-file in-file) + (delete-file out-file) + code-block) + (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code))))))) + + +;;; Statistics Cookie + +(defun org-man-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-element-property :value statistics-cookie)) + + +;;; Strike-Through + +(defun org-man-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to Man. +CONTENTS is the text with strike-through markup. INFO is a plist +holding contextual information." + (format "\\fI%s\\fP" contents)) + +;;; Subscript + +(defun org-man-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to Man. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "\\d\\s-2%s\\s+2\\u" contents)) + +;;; Superscript "^_%s$ + +(defun org-man-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to Man. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "\\u\\s-2%s\\s+2\\d" contents)) + + +;;; Table +;; +;; `org-man-table' is the entry point for table transcoding. It +;; takes care of tables with a "verbatim" attribute. Otherwise, it +;; delegates the job to either `org-man-table--table.el-table' or +;; `org-man-table--org-table' functions, depending of the type of +;; the table. +;; +;; `org-man-table--align-string' is a subroutine used to build +;; alignment string for Org tables. + +(defun org-man-table (table contents info) + "Transcode a TABLE element from Org to Man. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (cond + ;; Case 1: verbatim table. + ((or org-man-tables-verbatim + (let ((attr (read (format "(%s)" + (mapconcat + #'identity + (org-element-property :attr_man table) + " "))))) + + (and attr (plist-get attr :verbatim)))) + + (format ".nf\n\\fC%s\\fP\n.fi" + ;; Re-create table, without affiliated keywords. + (org-trim + (org-element-interpret-data + `(table nil ,@(org-element-contents table)))))) + ;; Case 2: Standard table. + (t (org-man-table--org-table table contents info)))) + +(defun org-man-table--align-string (divider table info) + "Return an appropriate Man alignment string. +TABLE is the considered table. INFO is a plist used as +a communication channel." + (let (alignment) + ;; Extract column groups and alignment from first (non-rule) row. + (org-element-map + (org-element-map table 'table-row + (lambda (row) + (and (eq (org-element-property :type row) 'standard) row)) + info 'first-match) + 'table-cell + (lambda (cell) + (let* ((borders (org-export-table-cell-borders cell info)) + (raw-width (org-export-table-cell-width cell info)) + (width-cm (when raw-width (/ raw-width 5))) + (width (if raw-width (format "w(%dc)" + (if (< width-cm 1) 1 width-cm)) ""))) + ;; Check left border for the first cell only. + (when (and (memq 'left borders) (not alignment)) + (push "|" alignment)) + (push + (case (org-export-table-cell-alignment cell info) + (left (concat "l" width divider)) + (right (concat "r" width divider)) + (center (concat "c" width divider))) + alignment) + (when (memq 'right borders) (push "|" alignment)))) + info) + (apply 'concat (reverse alignment)))) + +(defun org-man-table--org-table (table contents info) + "Return appropriate Man code for an Org table. + +TABLE is the table type element to transcode. CONTENTS is its +contents, as a string. INFO is a plist used as a communication +channel. + +This function assumes TABLE has `org' as its `:type' attribute." + (let* ((attr (org-export-read-attribute :attr_man table)) + (label (org-element-property :name table)) + (caption (and (not (plist-get attr :disable-caption)) + (org-man--caption/label-string table info))) + (divider (if (plist-get attr :divider) "|" " ")) + + ;; Determine alignment string. + (alignment (org-man-table--align-string divider table info)) + ;; Extract others display options. + + (lines (org-split-string contents "\n")) + + (attr-list + (delq nil + (list + (and (plist-get attr :expand) "expand") + (let ((placement (plist-get attr :placement))) + (cond ((string= placement 'center) "center") + ((string= placement 'left) nil) + (t (if org-man-tables-centered "center" "")))) + (or (plist-get attr :boxtype) "box")))) + + (title-line (plist-get attr :title-line)) + (long-cells (plist-get attr :long-cells)) + + (table-format (concat + (format "%s" (or (car attr-list) "" )) + (or + (let ((output-list '())) + (when (cdr attr-list) + (dolist (attr-item (cdr attr-list)) + (setq output-list (concat output-list (format ",%s" attr-item))))) + output-list) + ""))) + + (first-line (when lines (org-split-string (car lines) "\t")))) + ;; Prepare the final format string for the table. + + + (cond + ;; Others. + (lines (concat ".TS\n " table-format ";\n" + + (format "%s.\n" + (let ((final-line "")) + (when title-line + (dotimes (i (length first-line)) + (setq final-line (concat final-line "cb" divider)))) + + (setq final-line (concat final-line "\n")) + + (if alignment + (setq final-line (concat final-line alignment)) + (dotimes (i (length first-line)) + (setq final-line (concat final-line "c" divider)))) + final-line )) + + (format "%s.TE\n" + (let ((final-line "") + (long-line "") + (lines (org-split-string contents "\n"))) + + (dolist (line-item lines) + (setq long-line "") + + (if long-cells + (progn + (if (string= line-item "_") + (setq long-line (format "%s\n" line-item)) + ;; else string = + (let ((cell-item-list (org-split-string line-item "\t"))) + (dolist (cell-item cell-item-list) + + (cond ((eq cell-item (car (last cell-item-list))) + (setq long-line (concat long-line + (format "T{\n%s\nT}\t\n" cell-item )))) + (t + (setq long-line (concat long-line + (format "T{\n%s\nT}\t" cell-item )))))) + long-line)) + ;; else long cells + (setq final-line (concat final-line long-line ))) + + (setq final-line (concat final-line line-item "\n")))) + final-line)) + + (and caption (format ".TB \"%s\"" caption))))))) + +;;; Table Cell + +(defun org-man-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to Man +CONTENTS is the cell contents. INFO is a plist used as +a communication channel." + (concat (if (and contents + org-man-table-scientific-notation + (string-match orgtbl-exp-regexp contents)) + ;; Use appropriate format string for scientific + ;; notation. + (format org-man-table-scientific-notation + (match-string 1 contents) + (match-string 2 contents)) + contents ) + (when (org-export-get-next-element table-cell info) "\t"))) + + +;;; Table Row + +(defun org-man-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to Man +CONTENTS is the contents of the row. INFO is a plist used as +a communication channel." + ;; Rules are ignored since table separators are deduced from + ;; borders of the current row. + (when (eq (org-element-property :type table-row) 'standard) + (let* ((attr (mapconcat 'identity + (org-element-property + :attr_man (org-export-get-parent table-row)) + " ")) + ;; TABLE-ROW's borders are extracted from its first cell. + (borders + (org-export-table-cell-borders + (car (org-element-contents table-row)) info))) + (concat + ;; Mark horizontal lines + (cond ((and (memq 'top borders) (memq 'above borders)) "_\n")) + contents + + (cond + ;; When BOOKTABS are activated enforce bottom rule even when + ;; no hline was specifically marked. + ((and (memq 'bottom borders) (memq 'below borders)) "\n_") + ((memq 'below borders) "\n_")))))) + + +;;; Target + +(defun org-man-target (target contents info) + "Transcode a TARGET object from Org to Man. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "\\fI%s\\fP" + (org-export-solidify-link-text (org-element-property :value target)))) + + +;;; Timestamp + +(defun org-man-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to Man. + CONTENTS is nil. INFO is a plist holding contextual + information." + "" ) + + +;;; Underline + +(defun org-man-underline (underline contents info) + "Transcode UNDERLINE from Org to Man. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (format "\\fI%s\\fP" contents)) + + +;;; Verbatim + +(defun org-man-verbatim (verbatim contents info) + "Transcode a VERBATIM object from Org to Man. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format ".nf\n%s\n.fi" contents)) + + +;;; Verse Block + +(defun org-man-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to Man. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + (format ".RS\n.ft I\n%s\n.ft\n.RE" contents)) + + + +;;; Interactive functions + +(defun org-man-export-to-man + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a Man file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only the body +without any markers. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".man" subtreep))) + (org-export-to-file 'man outfile + async subtreep visible-only body-only ext-plist))) + +(defun org-man-export-to-pdf + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to Groff then process through to PDF. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write between +markers. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return PDF file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".man" subtreep))) + (org-export-to-file 'man outfile + async subtreep visible-only body-only ext-plist + (lambda (file) (org-latex-compile file))))) + +(defun org-man-compile (file) + "Compile a Groff file. + +FILE is the name of the file being compiled. Processing is done +through the command specified in `org-man-pdf-process'. + +Return PDF file name or an error if it couldn't be produced." + (let* ((base-name (file-name-sans-extension (file-name-nondirectory file))) + (full-name (file-truename file)) + (out-dir (file-name-directory file)) + ;; Properly set working directory for compilation. + (default-directory (if (file-name-absolute-p file) + (file-name-directory full-name) + default-directory)) + errors) + (message (format "Processing Groff file %s..." file)) + (save-window-excursion + (cond + ;; A function is provided: Apply it. + ((functionp org-man-pdf-process) + (funcall org-man-pdf-process (shell-quote-argument file))) + ;; A list is provided: Replace %b, %f and %o with appropriate + ;; values in each command before applying it. Output is + ;; redirected to "*Org PDF Groff Output*" buffer. + ((consp org-man-pdf-process) + (let ((outbuf (get-buffer-create "*Org PDF Groff Output*"))) + (mapc + (lambda (command) + (shell-command + (replace-regexp-in-string + "%b" (shell-quote-argument base-name) + (replace-regexp-in-string + "%f" (shell-quote-argument full-name) + (replace-regexp-in-string + "%o" (shell-quote-argument out-dir) command t t) t t) t t) + outbuf)) + org-man-pdf-process) + ;; Collect standard errors from output buffer. + (setq errors (org-man-collect-errors outbuf)))) + (t (error "No valid command to process to PDF"))) + (let ((pdffile (concat out-dir base-name ".pdf"))) + ;; Check for process failure. Provide collected errors if + ;; possible. + (if (not (file-exists-p pdffile)) + (error (concat (format "PDF file %s wasn't produced" pdffile) + (when errors (concat ": " errors)))) + ;; Else remove log files, when specified, and signal end of + ;; process to user, along with any error encountered. + (when org-man-remove-logfiles + (dolist (ext org-man-logfiles-extensions) + (let ((file (concat out-dir base-name "." ext))) + (when (file-exists-p file) (delete-file file))))) + (message (concat "Process completed" + (if (not errors) "." + (concat " with errors: " errors))))) + ;; Return output file name. + pdffile)))) + +(defun org-man-collect-errors (buffer) + "Collect some kind of errors from \"groff\" output +BUFFER is the buffer containing output. +Return collected error types as a string, or nil if there was +none." + (with-current-buffer buffer + (save-excursion + (goto-char (point-max)) + ;; Find final run + nil ))) + + +(provide 'ox-man) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-man.el ends here diff --git a/elpa/org-20150427/ox-md.el b/elpa/org-20150427/ox-md.el new file mode 100644 index 00000000..c8dc484b --- /dev/null +++ b/elpa/org-20150427/ox-md.el @@ -0,0 +1,511 @@ +;;; ox-md.el --- Markdown Back-End for Org Export Engine + +;; Copyright (C) 2012-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: org, wp, markdown + +;; 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 . + +;;; Commentary: + +;; This library implements a Markdown back-end (vanilla flavor) for +;; Org exporter, based on `html' back-end. See Org manual for more +;; information. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ox-html) + + + +;;; User-Configurable Variables + +(defgroup org-export-md nil + "Options specific to Markdown export back-end." + :tag "Org Markdown" + :group 'org-export + :version "24.4" + :package-version '(Org . "8.0")) + +(defcustom org-md-headline-style 'atx + "Style used to format headlines. +This variable can be set to either `atx' or `setext'." + :group 'org-export-md + :type '(choice + (const :tag "Use \"atx\" style" atx) + (const :tag "Use \"Setext\" style" setext))) + + + +;;; Define Back-End + +(org-export-define-derived-backend 'md 'html + :export-block '("MD" "MARKDOWN") + :filters-alist '((:filter-parse-tree . org-md-separate-elements)) + :menu-entry + '(?m "Export to Markdown" + ((?M "To temporary buffer" + (lambda (a s v b) (org-md-export-as-markdown a s v))) + (?m "To file" (lambda (a s v b) (org-md-export-to-markdown a s v))) + (?o "To file and open" + (lambda (a s v b) + (if a (org-md-export-to-markdown t s v) + (org-open-file (org-md-export-to-markdown nil s v))))))) + :translate-alist '((bold . org-md-bold) + (code . org-md-verbatim) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (example-block . org-md-example-block) + (fixed-width . org-md-example-block) + (headline . org-md-headline) + (horizontal-rule . org-md-horizontal-rule) + (inline-src-block . org-md-verbatim) + (inner-template . org-md-inner-template) + (italic . org-md-italic) + (item . org-md-item) + (line-break . org-md-line-break) + (link . org-md-link) + (paragraph . org-md-paragraph) + (plain-list . org-md-plain-list) + (plain-text . org-md-plain-text) + (quote-block . org-md-quote-block) + (quote-section . org-md-example-block) + (section . org-md-section) + (src-block . org-md-example-block) + (template . org-md-template) + (verbatim . org-md-verbatim))) + + + +;;; Filters + +(defun org-md-separate-elements (tree backend info) + "Fix blank lines between elements. + +TREE is the parse tree being exported. BACKEND is the export +back-end used. INFO is a plist used as a communication channel. + +Enforce a blank line between elements. There are two exceptions +to this rule: + + 1. Preserve blank lines between sibling items in a plain list, + + 2. In an item, remove any blank line before the very first + paragraph and the next sub-list. + +Assume BACKEND is `md'." + (org-element-map tree (remq 'item org-element-all-elements) + (lambda (e) + (org-element-put-property + e :post-blank + (if (and (eq (org-element-type e) 'paragraph) + (eq (org-element-type (org-element-property :parent e)) 'item) + (eq (org-element-type (org-export-get-next-element e info)) + 'plain-list) + (not (org-export-get-previous-element e info))) + 0 + 1)))) + ;; Return updated tree. + tree) + + + +;;; Transcode Functions + +;;;; Bold + +(defun org-md-bold (bold contents info) + "Transcode BOLD object into Markdown format. +CONTENTS is the text within bold markup. INFO is a plist used as +a communication channel." + (format "**%s**" contents)) + + +;;;; Code and Verbatim + +(defun org-md-verbatim (verbatim contents info) + "Transcode VERBATIM object into Markdown format. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let ((value (org-element-property :value verbatim))) + (format (cond ((not (string-match "`" value)) "`%s`") + ((or (string-match "\\``" value) + (string-match "`\\'" value)) + "`` %s ``") + (t "``%s``")) + value))) + + +;;;; Example Block and Src Block + +(defun org-md-example-block (example-block contents info) + "Transcode EXAMPLE-BLOCK element into Markdown format. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (replace-regexp-in-string + "^" " " + (org-remove-indentation + (org-export-format-code-default example-block info)))) + + +;;;; Headline + +(defun org-md-headline (headline contents info) + "Transcode HEADLINE element into Markdown format. +CONTENTS is the headline contents. INFO is a plist used as +a communication channel." + (unless (org-element-property :footnote-section-p headline) + (let* ((level (org-export-get-relative-level headline info)) + (title (org-export-data (org-element-property :title headline) info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword + headline))) + (and todo (concat (org-export-data todo info) " "))))) + (tags (and (plist-get info :with-tags) + (let ((tag-list (org-export-get-tags headline info))) + (and tag-list + (format " :%s:" + (mapconcat 'identity tag-list ":")))))) + (priority + (and (plist-get info :with-priority) + (let ((char (org-element-property :priority headline))) + (and char (format "[#%c] " char))))) + (anchor + (when (plist-get info :with-toc) + (org-html--anchor + (or (org-element-property :CUSTOM_ID headline) + (concat "sec-" + (mapconcat 'number-to-string + (org-export-get-headline-number + headline info) "-")))))) + ;; Headline text without tags. + (heading (concat todo priority title))) + (cond + ;; Cannot create a headline. Fall-back to a list. + ((or (org-export-low-level-p headline info) + (not (memq org-md-headline-style '(atx setext))) + (and (eq org-md-headline-style 'atx) (> level 6)) + (and (eq org-md-headline-style 'setext) (> level 2))) + (let ((bullet + (if (not (org-export-numbered-headline-p headline info)) "-" + (concat (number-to-string + (car (last (org-export-get-headline-number + headline info)))) + ".")))) + (concat bullet (make-string (- 4 (length bullet)) ? ) heading tags + "\n\n" + (and contents + (replace-regexp-in-string "^" " " contents))))) + ;; Use "Setext" style. + ((eq org-md-headline-style 'setext) + (concat heading tags anchor "\n" + (make-string (length heading) (if (= level 1) ?= ?-)) + "\n\n" + contents)) + ;; Use "atx" style. + (t (concat (make-string level ?#) " " heading tags anchor "\n\n" contents)))))) + + +;;;; Horizontal Rule + +(defun org-md-horizontal-rule (horizontal-rule contents info) + "Transcode HORIZONTAL-RULE element into Markdown format. +CONTENTS is the horizontal rule contents. INFO is a plist used +as a communication channel." + "---") + + +;;;; Italic + +(defun org-md-italic (italic contents info) + "Transcode ITALIC object into Markdown format. +CONTENTS is the text within italic markup. INFO is a plist used +as a communication channel." + (format "*%s*" contents)) + + +;;;; Item + +(defun org-md-item (item contents info) + "Transcode ITEM element into Markdown format. +CONTENTS is the item contents. INFO is a plist used as +a communication channel." + (let* ((type (org-element-property :type (org-export-get-parent item))) + (struct (org-element-property :structure item)) + (bullet (if (not (eq type 'ordered)) "-" + (concat (number-to-string + (car (last (org-list-get-item-number + (org-element-property :begin item) + struct + (org-list-prevs-alist struct) + (org-list-parents-alist struct))))) + ".")))) + (concat bullet + (make-string (- 4 (length bullet)) ? ) + (case (org-element-property :checkbox item) + (on "[X] ") + (trans "[-] ") + (off "[ ] ")) + (let ((tag (org-element-property :tag item))) + (and tag (format "**%s:** "(org-export-data tag info)))) + (and contents + (org-trim (replace-regexp-in-string "^" " " contents)))))) + + +;;;; Line Break + +(defun org-md-line-break (line-break contents info) + "Transcode LINE-BREAK object into Markdown format. +CONTENTS is nil. INFO is a plist used as a communication +channel." + " \n") + + +;;;; Link + +(defun org-md-link (link contents info) + "Transcode LINE-BREAK object into Markdown format. +CONTENTS is the link's description. INFO is a plist used as +a communication channel." + (let ((link-org-files-as-md + (function + (lambda (raw-path) + ;; Treat links to `file.org' as links to `file.md'. + (if (string= ".org" (downcase (file-name-extension raw-path "."))) + (concat (file-name-sans-extension raw-path) ".md") + raw-path)))) + (type (org-element-property :type link))) + (cond + ((member type '("custom-id" "id")) + (let ((destination (org-export-resolve-id-link link info))) + (if (stringp destination) ; External file. + (let ((path (funcall link-org-files-as-md destination))) + (if (not contents) (format "<%s>" path) + (format "[%s](%s)" contents path))) + (concat + (and contents (concat contents " ")) + (format "(%s)" + (format (org-export-translate "See section %s" :html info) + (mapconcat 'number-to-string + (org-export-get-headline-number + destination info) + "."))))))) + ((org-export-inline-image-p link org-html-inline-image-rules) + (let ((path (let ((raw-path (org-element-property :path link))) + (if (not (file-name-absolute-p raw-path)) raw-path + (expand-file-name raw-path)))) + (caption (org-export-data + (org-export-get-caption + (org-export-get-parent-element link)) info))) + (format "![img](%s)" + (if (not (org-string-nw-p caption)) path + (format "%s \"%s\"" path caption))))) + ((string= type "coderef") + (let ((ref (org-element-property :path link))) + (format (org-export-get-coderef-format ref contents) + (org-export-resolve-coderef ref info)))) + ((equal type "radio") contents) + ((equal type "fuzzy") + (let ((destination (org-export-resolve-fuzzy-link link info))) + (if (org-string-nw-p contents) contents + (when destination + (let ((number (org-export-get-ordinal destination info))) + (when number + (if (atom number) (number-to-string number) + (mapconcat 'number-to-string number ".")))))))) + ;; Link type is handled by a special function. + ((let ((protocol (nth 2 (assoc type org-link-protocols)))) + (and (functionp protocol) + (funcall protocol + (org-link-unescape (org-element-property :path link)) + contents + 'md)))) + (t (let* ((raw-path (org-element-property :path link)) + (path + (cond + ((member type '("http" "https" "ftp")) + (concat type ":" raw-path)) + ((string= type "file") + (let ((path (funcall link-org-files-as-md raw-path))) + (if (not (file-name-absolute-p path)) path + ;; If file path is absolute, prepend it + ;; with "file:" component. + (concat "file:" path)))) + (t raw-path)))) + (if (not contents) (format "<%s>" path) + (format "[%s](%s)" contents path))))))) + + +;;;; Paragraph + +(defun org-md-paragraph (paragraph contents info) + "Transcode PARAGRAPH element into Markdown format. +CONTENTS is the paragraph contents. INFO is a plist used as +a communication channel." + (let ((first-object (car (org-element-contents paragraph)))) + ;; If paragraph starts with a #, protect it. + (if (and (stringp first-object) (string-match "\\`#" first-object)) + (replace-regexp-in-string "\\`#" "\\#" contents nil t) + contents))) + + +;;;; Plain List + +(defun org-md-plain-list (plain-list contents info) + "Transcode PLAIN-LIST element into Markdown format. +CONTENTS is the plain-list contents. INFO is a plist used as +a communication channel." + contents) + + +;;;; Plain Text + +(defun org-md-plain-text (text info) + "Transcode a TEXT string into Markdown format. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + (when (plist-get info :with-smart-quotes) + (setq text (org-export-activate-smart-quotes text :html info))) + ;; Protect ambiguous #. This will protect # at the beginning of + ;; a line, but not at the beginning of a paragraph. See + ;; `org-md-paragraph'. + (setq text (replace-regexp-in-string "\n#" "\n\\\\#" text)) + ;; Protect ambiguous ! + (setq text (replace-regexp-in-string "\\(!\\)\\[" "\\\\!" text nil nil 1)) + ;; Protect `, *, _ and \ + (setq text (replace-regexp-in-string "[`*_\\]" "\\\\\\&" text)) + ;; Handle special strings, if required. + (when (plist-get info :with-special-strings) + (setq text (org-html-convert-special-strings text))) + ;; Handle break preservation, if required. + (when (plist-get info :preserve-breaks) + (setq text (replace-regexp-in-string "[ \t]*\n" " \n" text))) + ;; Return value. + text) + + +;;;; Quote Block + +(defun org-md-quote-block (quote-block contents info) + "Transcode QUOTE-BLOCK element into Markdown format. +CONTENTS is the quote-block contents. INFO is a plist used as +a communication channel." + (replace-regexp-in-string + "^" "> " + (replace-regexp-in-string "\n\\'" "" contents))) + + +;;;; Section + +(defun org-md-section (section contents info) + "Transcode SECTION element into Markdown format. +CONTENTS is the section contents. INFO is a plist used as +a communication channel." + contents) + + +;;;; Template + +(defun org-md-inner-template (contents info) + "Return body of document after converting it to Markdown syntax. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + ;; Make sure CONTENTS is separated from table of contents and + ;; footnotes with at least a blank line. + (org-trim (org-html-inner-template (concat "\n" contents "\n") info))) + +(defun org-md-template (contents info) + "Return complete document string after Markdown conversion. +CONTENTS is the transcoded contents string. INFO is a plist used +as a communication channel." + contents) + + + +;;; Interactive function + +;;;###autoload +(defun org-md-export-as-markdown (&optional async subtreep visible-only) + "Export current buffer to a Markdown buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +Export is done in a buffer named \"*Org MD Export*\", which will +be displayed when `org-export-show-temporary-export-buffer' is +non-nil." + (interactive) + (org-export-to-buffer 'md "*Org MD Export*" + async subtreep visible-only nil nil (lambda () (text-mode)))) + +;;;###autoload +(defun org-md-convert-region-to-md () + "Assume the current region has org-mode syntax, and convert it to Markdown. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in a Markdown buffer and use +this command to convert it." + (interactive) + (org-export-replace-region-by 'md)) + + +;;;###autoload +(defun org-md-export-to-markdown (&optional async subtreep visible-only) + "Export current buffer to a Markdown file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +Return output file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".md" subtreep))) + (org-export-to-file 'md outfile async subtreep visible-only))) + + +(provide 'ox-md) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-md.el ends here diff --git a/elpa/org-20150427/ox-odt.el b/elpa/org-20150427/ox-odt.el new file mode 100644 index 00000000..95e73f54 --- /dev/null +++ b/elpa/org-20150427/ox-odt.el @@ -0,0 +1,4386 @@ +;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode + +;; Copyright (C) 2010-2014 Free Software Foundation, Inc. + +;; Author: Jambunathan K +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org + +;; 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 . + +;;; Commentary: + +;;; Code: + +(eval-when-compile + (require 'cl) + (require 'table nil 'noerror)) +(require 'format-spec) +(require 'ox) +(require 'org-compat) + +;;; Define Back-End + +(org-export-define-backend 'odt + '((bold . org-odt-bold) + (center-block . org-odt-center-block) + (clock . org-odt-clock) + (code . org-odt-code) + (drawer . org-odt-drawer) + (dynamic-block . org-odt-dynamic-block) + (entity . org-odt-entity) + (example-block . org-odt-example-block) + (export-block . org-odt-export-block) + (export-snippet . org-odt-export-snippet) + (fixed-width . org-odt-fixed-width) + (footnote-definition . org-odt-footnote-definition) + (footnote-reference . org-odt-footnote-reference) + (headline . org-odt-headline) + (horizontal-rule . org-odt-horizontal-rule) + (inline-src-block . org-odt-inline-src-block) + (inlinetask . org-odt-inlinetask) + (italic . org-odt-italic) + (item . org-odt-item) + (keyword . org-odt-keyword) + (latex-environment . org-odt-latex-environment) + (latex-fragment . org-odt-latex-fragment) + (line-break . org-odt-line-break) + (link . org-odt-link) + (paragraph . org-odt-paragraph) + (plain-list . org-odt-plain-list) + (plain-text . org-odt-plain-text) + (planning . org-odt-planning) + (property-drawer . org-odt-property-drawer) + (quote-block . org-odt-quote-block) + (quote-section . org-odt-quote-section) + (radio-target . org-odt-radio-target) + (section . org-odt-section) + (special-block . org-odt-special-block) + (src-block . org-odt-src-block) + (statistics-cookie . org-odt-statistics-cookie) + (strike-through . org-odt-strike-through) + (subscript . org-odt-subscript) + (superscript . org-odt-superscript) + (table . org-odt-table) + (table-cell . org-odt-table-cell) + (table-row . org-odt-table-row) + (target . org-odt-target) + (template . org-odt-template) + (timestamp . org-odt-timestamp) + (underline . org-odt-underline) + (verbatim . org-odt-verbatim) + (verse-block . org-odt-verse-block)) + :export-block "ODT" + :filters-alist '((:filter-parse-tree + . (org-odt--translate-latex-fragments + org-odt--translate-description-lists + org-odt--translate-list-tables))) + :menu-entry + '(?o "Export to ODT" + ((?o "As ODT file" org-odt-export-to-odt) + (?O "As ODT file and open" + (lambda (a s v b) + (if a (org-odt-export-to-odt t s v) + (org-open-file (org-odt-export-to-odt nil s v) 'system)))))) + :options-alist + '((:odt-styles-file "ODT_STYLES_FILE" nil nil t) + ;; Redefine regular option. + (:with-latex nil "tex" org-odt-with-latex))) + + +;;; Dependencies + +;;; Hooks + +;;; Function Declarations + +(declare-function org-id-find-id-file "org-id" (id)) +(declare-function hfy-face-to-style "htmlfontify" (fn)) +(declare-function hfy-face-or-def-to-name "htmlfontify" (fn)) +(declare-function archive-zip-extract "arc-mode" (archive name)) +(declare-function org-create-math-formula "org" (latex-frag &optional mathml-file)) +(declare-function browse-url-file-url "browse-url" (file)) + + + +;;; Internal Variables + +(defconst org-odt-lib-dir + (file-name-directory load-file-name) + "Location of ODT exporter. +Use this to infer values of `org-odt-styles-dir' and +`org-odt-schema-dir'.") + +(defvar org-odt-data-dir + (expand-file-name "../../etc/" org-odt-lib-dir) + "Data directory for ODT exporter. +Use this to infer values of `org-odt-styles-dir' and +`org-odt-schema-dir'.") + +(defconst org-odt-special-string-regexps + '(("\\\\-" . "­\\1") ; shy + ("---\\([^-]\\)" . "—\\1") ; mdash + ("--\\([^-]\\)" . "–\\1") ; ndash + ("\\.\\.\\." . "…")) ; hellip + "Regular expressions for special string conversion.") + +(defconst org-odt-schema-dir-list + (list + (and org-odt-data-dir + (expand-file-name "./schema/" org-odt-data-dir)) ; bail out + (eval-when-compile + (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install + (expand-file-name "./schema/" org-odt-data-dir)))) + "List of directories to search for OpenDocument schema files. +Use this list to set the default value of +`org-odt-schema-dir'. The entries in this list are +populated heuristically based on the values of `org-odt-lib-dir' +and `org-odt-data-dir'.") + +(defconst org-odt-styles-dir-list + (list + (and org-odt-data-dir + (expand-file-name "./styles/" org-odt-data-dir)) ; bail out + (eval-when-compile + (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install + (expand-file-name "./styles/" org-odt-data-dir))) + (expand-file-name "../../etc/styles/" org-odt-lib-dir) ; git + (expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa + (expand-file-name "./org/" data-directory) ; system + ) + "List of directories to search for OpenDocument styles files. +See `org-odt-styles-dir'. The entries in this list are populated +heuristically based on the values of `org-odt-lib-dir' and +`org-odt-data-dir'.") + +(defconst org-odt-styles-dir + (let* ((styles-dir + (catch 'styles-dir + (message "Debug (ox-odt): Searching for OpenDocument styles files...") + (mapc (lambda (styles-dir) + (when styles-dir + (message "Debug (ox-odt): Trying %s..." styles-dir) + (when (and (file-readable-p + (expand-file-name + "OrgOdtContentTemplate.xml" styles-dir)) + (file-readable-p + (expand-file-name + "OrgOdtStyles.xml" styles-dir))) + (message "Debug (ox-odt): Using styles under %s" + styles-dir) + (throw 'styles-dir styles-dir)))) + org-odt-styles-dir-list) + nil))) + (unless styles-dir + (error "Error (ox-odt): Cannot find factory styles files, aborting")) + styles-dir) + "Directory that holds auxiliary XML files used by the ODT exporter. + +This directory contains the following XML files - + \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These + XML files are used as the default values of + `org-odt-styles-file' and + `org-odt-content-template-file'. + +The default value of this variable varies depending on the +version of org in use and is initialized from +`org-odt-styles-dir-list'. Note that the user could be using org +from one of: org's own private git repository, GNU ELPA tar or +standard Emacs.") + +(defconst org-odt-bookmark-prefix "OrgXref.") + +(defconst org-odt-manifest-file-entry-tag + "\n") + +(defconst org-odt-file-extensions + '(("odt" . "OpenDocument Text") + ("ott" . "OpenDocument Text Template") + ("odm" . "OpenDocument Master Document") + ("ods" . "OpenDocument Spreadsheet") + ("ots" . "OpenDocument Spreadsheet Template") + ("odg" . "OpenDocument Drawing (Graphics)") + ("otg" . "OpenDocument Drawing Template") + ("odp" . "OpenDocument Presentation") + ("otp" . "OpenDocument Presentation Template") + ("odi" . "OpenDocument Image") + ("odf" . "OpenDocument Formula") + ("odc" . "OpenDocument Chart"))) + +(defconst org-odt-table-style-format + " + + + +" + "Template for auto-generated Table styles.") + +(defvar org-odt-automatic-styles '() + "Registry of automatic styles for various OBJECT-TYPEs. +The variable has the following form: +\(\(OBJECT-TYPE-A + \(\(OBJECT-NAME-A.1 OBJECT-PROPS-A.1\) + \(OBJECT-NAME-A.2 OBJECT-PROPS-A.2\) ...\)\) + \(OBJECT-TYPE-B + \(\(OBJECT-NAME-B.1 OBJECT-PROPS-B.1\) + \(OBJECT-NAME-B.2 OBJECT-PROPS-B.2\) ...\)\) + ...\). + +OBJECT-TYPEs could be \"Section\", \"Table\", \"Figure\" etc. +OBJECT-PROPS is (typically) a plist created by passing +\"#+ATTR_ODT: \" option to `org-odt-parse-block-attributes'. + +Use `org-odt-add-automatic-style' to add update this variable.'") + +(defvar org-odt-object-counters nil + "Running counters for various OBJECT-TYPEs. +Use this to generate automatic names and style-names. See +`org-odt-add-automatic-style'.") + +(defvar org-odt-src-block-paragraph-format + " + + + + + " + "Custom paragraph style for colorized source and example blocks. +This style is much the same as that of \"OrgFixedWidthBlock\" +except that the foreground and background colors are set +according to the default face identified by the `htmlfontify'.") + +(defvar hfy-optimisations) +(defvar org-odt-embedded-formulas-count 0) +(defvar org-odt-embedded-images-count 0) +(defvar org-odt-image-size-probe-method + (append (and (executable-find "identify") '(imagemagick)) ; See Bug#10675 + '(emacs fixed)) + "Ordered list of methods for determining image sizes.") + +(defvar org-odt-default-image-sizes-alist + '(("as-char" . (5 . 0.4)) + ("paragraph" . (5 . 5))) + "Hardcoded image dimensions one for each of the anchor + methods.") + +;; A4 page size is 21.0 by 29.7 cms +;; The default page settings has 2cm margin on each of the sides. So +;; the effective text area is 17.0 by 25.7 cm +(defvar org-odt-max-image-size '(17.0 . 20.0) + "Limiting dimensions for an embedded image.") + +(defconst org-odt-label-styles + '(("math-formula" "%c" "text" "(%n)") + ("math-label" "(%n)" "text" "(%n)") + ("category-and-value" "%e %n: %c" "category-and-value" "%e %n") + ("value" "%e %n: %c" "value" "%n")) + "Specify how labels are applied and referenced. + +This is an alist where each element is of the form: + + \(STYLE-NAME ATTACH-FMT REF-MODE REF-FMT) + +ATTACH-FMT controls how labels and captions are attached to an +entity. It may contain following specifiers - %e and %c. %e is +replaced with the CATEGORY-NAME. %n is replaced with +\" SEQNO \". %c is replaced +with CAPTION. + +REF-MODE and REF-FMT controls how label references are generated. +The following XML is generated for a label reference - +\" +REF-FMT \". REF-FMT may contain following +specifiers - %e and %n. %e is replaced with the CATEGORY-NAME. +%n is replaced with SEQNO. + +See also `org-odt-format-label'.") + +(defvar org-odt-category-map-alist + '(("__Table__" "Table" "value" "Table" org-odt--enumerable-p) + ("__Figure__" "Illustration" "value" "Figure" org-odt--enumerable-image-p) + ("__MathFormula__" "Text" "math-formula" "Equation" org-odt--enumerable-formula-p) + ("__DvipngImage__" "Equation" "value" "Equation" org-odt--enumerable-latex-image-p) + ("__Listing__" "Listing" "value" "Listing" org-odt--enumerable-p)) + "Map a CATEGORY-HANDLE to OD-VARIABLE and LABEL-STYLE. + +This is a list where each entry is of the form: + + \(CATEGORY-HANDLE OD-VARIABLE LABEL-STYLE CATEGORY-NAME ENUMERATOR-PREDICATE) + +CATEGORY_HANDLE identifies the captionable entity in question. + +OD-VARIABLE is the OpenDocument sequence counter associated with +the entity. These counters are declared within +\"...\" block of +`org-odt-content-template-file'. + +LABEL-STYLE is a key into `org-odt-label-styles' and specifies +how a given entity should be captioned and referenced. + +CATEGORY-NAME is used for qualifying captions on export. + +ENUMERATOR-PREDICATE is used for assigning a sequence number to +the entity. See `org-odt--enumerate'.") + +(defvar org-odt-manifest-file-entries nil) +(defvar hfy-user-sheet-assoc) + +(defvar org-odt-zip-dir nil + "Temporary work directory for OpenDocument exporter.") + + + +;;; User Configuration Variables + +(defgroup org-export-odt nil + "Options for exporting Org mode files to ODT." + :tag "Org Export ODT" + :group 'org-export) + + +;;;; Debugging + +(defcustom org-odt-prettify-xml nil + "Specify whether or not the xml output should be prettified. +When this option is turned on, `indent-region' is run on all +component xml buffers before they are saved. Turn this off for +regular use. Turn this on if you need to examine the xml +visually." + :group 'org-export-odt + :version "24.1" + :type 'boolean) + + +;;;; Document schema + +(require 'rng-loc) +(defcustom org-odt-schema-dir + (let* ((schema-dir + (catch 'schema-dir + (message "Debug (ox-odt): Searching for OpenDocument schema files...") + (mapc + (lambda (schema-dir) + (when schema-dir + (message "Debug (ox-odt): Trying %s..." schema-dir) + (when (and (file-expand-wildcards + (expand-file-name "od-manifest-schema*.rnc" + schema-dir)) + (file-expand-wildcards + (expand-file-name "od-schema*.rnc" + schema-dir)) + (file-readable-p + (expand-file-name "schemas.xml" schema-dir))) + (message "Debug (ox-odt): Using schema files under %s" + schema-dir) + (throw 'schema-dir schema-dir)))) + org-odt-schema-dir-list) + (message "Debug (ox-odt): No OpenDocument schema files installed") + nil))) + schema-dir) + "Directory that contains OpenDocument schema files. + +This directory contains: +1. rnc files for OpenDocument schema +2. a \"schemas.xml\" file that specifies locating rules needed + for auto validation of OpenDocument XML files. + +Use the customize interface to set this variable. This ensures +that `rng-schema-locating-files' is updated and auto-validation +of OpenDocument XML takes place based on the value +`rng-nxml-auto-validate-flag'. + +The default value of this variable varies depending on the +version of org in use and is initialized from +`org-odt-schema-dir-list'. The OASIS schema files are available +only in the org's private git repository. It is *not* bundled +with GNU ELPA tar or standard Emacs distribution." + :type '(choice + (const :tag "Not set" nil) + (directory :tag "Schema directory")) + :group 'org-export-odt + :version "24.1" + :set + (lambda (var value) + "Set `org-odt-schema-dir'. +Also add it to `rng-schema-locating-files'." + (let ((schema-dir value)) + (set var + (if (and + (file-expand-wildcards + (expand-file-name "od-manifest-schema*.rnc" schema-dir)) + (file-expand-wildcards + (expand-file-name "od-schema*.rnc" schema-dir)) + (file-readable-p + (expand-file-name "schemas.xml" schema-dir))) + schema-dir + (when value + (message "Error (ox-odt): %s has no OpenDocument schema files" + value)) + nil))) + (when org-odt-schema-dir + (eval-after-load 'rng-loc + '(add-to-list 'rng-schema-locating-files + (expand-file-name "schemas.xml" + org-odt-schema-dir)))))) + + +;;;; Document styles + +(defcustom org-odt-content-template-file nil + "Template file for \"content.xml\". +The exporter embeds the exported content just before +\"\" element. + +If unspecified, the file named \"OrgOdtContentTemplate.xml\" +under `org-odt-styles-dir' is used." + :type '(choice (const nil) + (file)) + :group 'org-export-odt + :version "24.3") + +(defcustom org-odt-styles-file nil + "Default styles file for use with ODT export. +Valid values are one of: +1. nil +2. path to a styles.xml file +3. path to a *.odt or a *.ott file +4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2 +...)) + +In case of option 1, an in-built styles.xml is used. See +`org-odt-styles-dir' for more information. + +In case of option 3, the specified file is unzipped and the +styles.xml embedded therein is used. + +In case of option 4, the specified ODT-OR-OTT-FILE is unzipped +and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the +generated odt file. Use relative path for specifying the +FILE-MEMBERS. styles.xml must be specified as one of the +FILE-MEMBERS. + +Use options 1, 2 or 3 only if styles.xml alone suffices for +achieving the desired formatting. Use option 4, if the styles.xml +references additional files like header and footer images for +achieving the desired formatting. + +Use \"#+ODT_STYLES_FILE: ...\" directive to set this variable on +a per-file basis. For example, + +#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or +#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))." + :group 'org-export-odt + :version "24.1" + :type + '(choice + (const :tag "Factory settings" nil) + (file :must-match t :tag "styles.xml") + (file :must-match t :tag "ODT or OTT file") + (list :tag "ODT or OTT file + Members" + (file :must-match t :tag "ODF Text or Text Template file") + (cons :tag "Members" + (file :tag " Member" "styles.xml") + (repeat (file :tag "Member")))))) + +(defcustom org-odt-display-outline-level 2 + "Outline levels considered for enumerating captioned entities." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type 'integer) + +;;;; Document conversion + +(defcustom org-odt-convert-processes + '(("LibreOffice" + "soffice --headless --convert-to %f%x --outdir %d %i") + ("unoconv" + "unoconv -f %f -o %d %i")) + "Specify a list of document converters and their usage. +The converters in this list are offered as choices while +customizing `org-odt-convert-process'. + +This variable is a list where each element is of the +form (CONVERTER-NAME CONVERTER-CMD). CONVERTER-NAME is the name +of the converter. CONVERTER-CMD is the shell command for the +converter and can contain format specifiers. These format +specifiers are interpreted as below: + +%i input file name in full +%I input file name as a URL +%f format of the output file +%o output file name in full +%O output file name as a URL +%d output dir in full +%D output dir as a URL. +%x extra options as set in `org-odt-convert-capabilities'." + :group 'org-export-odt + :version "24.1" + :type + '(choice + (const :tag "None" nil) + (alist :tag "Converters" + :key-type (string :tag "Converter Name") + :value-type (group (string :tag "Command line"))))) + +(defcustom org-odt-convert-process "LibreOffice" + "Use this converter to convert from \"odt\" format to other formats. +During customization, the list of converter names are populated +from `org-odt-convert-processes'." + :group 'org-export-odt + :version "24.1" + :type '(choice :convert-widget + (lambda (w) + (apply 'widget-convert (widget-type w) + (eval (car (widget-get w :args))))) + `((const :tag "None" nil) + ,@(mapcar (lambda (c) + `(const :tag ,(car c) ,(car c))) + org-odt-convert-processes)))) + +(defcustom org-odt-convert-capabilities + '(("Text" + ("odt" "ott" "doc" "rtf" "docx") + (("pdf" "pdf") ("odt" "odt") ("rtf" "rtf") ("ott" "ott") + ("doc" "doc" ":\"MS Word 97\"") ("docx" "docx") ("html" "html"))) + ("Web" + ("html") + (("pdf" "pdf") ("odt" "odt") ("html" "html"))) + ("Spreadsheet" + ("ods" "ots" "xls" "csv" "xlsx") + (("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv") ("ods" "ods") + ("xls" "xls") ("xlsx" "xlsx"))) + ("Presentation" + ("odp" "otp" "ppt" "pptx") + (("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("otp" "otp") ("ppt" "ppt") + ("pptx" "pptx") ("odg" "odg")))) + "Specify input and output formats of `org-odt-convert-process'. +More correctly, specify the set of input and output formats that +the user is actually interested in. + +This variable is an alist where each element is of the +form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST). +INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an +alist where each element is of the form (OUTPUT-FMT +OUTPUT-FILE-EXTENSION EXTRA-OPTIONS). + +The variable is interpreted as follows: +`org-odt-convert-process' can take any document that is in +INPUT-FMT-LIST and produce any document that is in the +OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have +OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT +serves dual purposes: +- It is used for populating completion candidates during + `org-odt-convert' commands. +- It is used as the value of \"%f\" specifier in + `org-odt-convert-process'. + +EXTRA-OPTIONS is used as the value of \"%x\" specifier in +`org-odt-convert-process'. + +DOCUMENT-CLASS is used to group a set of file formats in +INPUT-FMT-LIST in to a single class. + +Note that this variable inherently captures how LibreOffice based +converters work. LibreOffice maps documents of various formats +to classes like Text, Web, Spreadsheet, Presentation etc and +allow document of a given class (irrespective of its source +format) to be converted to any of the export formats associated +with that class. + +See default setting of this variable for an typical +configuration." + :group 'org-export-odt + :version "24.1" + :type + '(choice + (const :tag "None" nil) + (alist :tag "Capabilities" + :key-type (string :tag "Document Class") + :value-type + (group (repeat :tag "Input formats" (string :tag "Input format")) + (alist :tag "Output formats" + :key-type (string :tag "Output format") + :value-type + (group (string :tag "Output file extension") + (choice + (const :tag "None" nil) + (string :tag "Extra options")))))))) + +(defcustom org-odt-preferred-output-format nil + "Automatically post-process to this format after exporting to \"odt\". +Command `org-odt-export-to-odt' exports first to \"odt\" format +and then uses `org-odt-convert-process' to convert the +resulting document to this format. During customization of this +variable, the list of valid values are populated based on +`org-odt-convert-capabilities'. + +You can set this option on per-file basis using file local +values. See Info node `(emacs) File Variables'." + :group 'org-export-odt + :version "24.1" + :type '(choice :convert-widget + (lambda (w) + (apply 'widget-convert (widget-type w) + (eval (car (widget-get w :args))))) + `((const :tag "None" nil) + ,@(mapcar (lambda (c) + `(const :tag ,c ,c)) + (org-odt-reachable-formats "odt"))))) +;;;###autoload +(put 'org-odt-preferred-output-format 'safe-local-variable 'stringp) + + +;;;; Drawers + +(defcustom org-odt-format-drawer-function + (lambda (name contents) contents) + "Function called to format a drawer in ODT code. + +The function must accept two parameters: + NAME the drawer name, like \"LOGBOOK\" + CONTENTS the contents of the drawer. + +The function should return the string to be exported. + +The default value simply returns the value of CONTENTS." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.3") + :type 'function) + + +;;;; Headline + +(defcustom org-odt-format-headline-function 'ignore + "Function to format headline text. + +This function will be called with 5 arguments: +TODO the todo keyword \(string or nil\). +TODO-TYPE the type of todo \(symbol: `todo', `done', nil\) +PRIORITY the priority of the headline \(integer or nil\) +TEXT the main headline text \(string\). +TAGS the tags string, separated with colons \(string or nil\). + +The function result will be used as headline text." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + + +;;;; Inlinetasks + +(defcustom org-odt-format-inlinetask-function 'ignore + "Function called to format an inlinetask in ODT code. + +The function must accept six parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a string. + CONTENTS the contents of the inlinetask, as a string. + +The function should return the string to be exported." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type 'function) + + +;;;; LaTeX + +(defcustom org-odt-with-latex org-export-with-latex + "Non-nil means process LaTeX math snippets. + +When set, the exporter will process LaTeX environments and +fragments. + +This option can also be set with the +OPTIONS line, +e.g. \"tex:mathjax\". Allowed values are: + +nil Ignore math snippets. +`verbatim' Keep everything in verbatim +`dvipng' Process the LaTeX fragments to images. This will also + include processing of non-math environments. +`imagemagick' Convert the LaTeX fragments to pdf files and use + imagemagick to convert pdf files to png files. +`mathjax' Do MathJax preprocessing and arrange for MathJax.js to + be loaded. +t Synonym for `mathjax'." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Do not process math in any way" nil) + (const :tag "Use dvipng to make images" dvipng) + (const :tag "Use imagemagick to make images" imagemagick) + (const :tag "Use MathJax to display math" mathjax) + (const :tag "Leave math verbatim" verbatim))) + + +;;;; Links + +(defcustom org-odt-inline-formula-rules + '(("file" . "\\.\\(mathml\\|mml\\|odf\\)\\'")) + "Rules characterizing formula files that can be inlined into ODT. + +A rule consists in an association whose key is the type of link +to consider, and value is a regexp that will be matched against +link's path." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type '(alist :key-type (string :tag "Type") + :value-type (regexp :tag "Path"))) + +(defcustom org-odt-inline-image-rules + '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\)\\'")) + "Rules characterizing image files that can be inlined into ODT. + +A rule consists in an association whose key is the type of link +to consider, and value is a regexp that will be matched against +link's path." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type '(alist :key-type (string :tag "Type") + :value-type (regexp :tag "Path"))) + +(defcustom org-odt-pixels-per-inch 96.0 + "Scaling factor for converting images pixels to inches. +Use this for sizing of embedded images. See Info node `(org) +Images in ODT export' for more information." + :type 'float + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.1")) + + +;;;; Src Block + +(defcustom org-odt-create-custom-styles-for-srcblocks t + "Whether custom styles for colorized source blocks be automatically created. +When this option is turned on, the exporter creates custom styles +for source blocks based on the advice of `htmlfontify'. Creation +of custom styles happen as part of `org-odt-hfy-face-to-css'. + +When this option is turned off exporter does not create such +styles. + +Use the latter option if you do not want the custom styles to be +based on your current display settings. It is necessary that the +styles.xml already contains needed styles for colorizing to work. + +This variable is effective only if +`org-odt-fontify-srcblocks' is turned on." + :group 'org-export-odt + :version "24.1" + :type 'boolean) + +(defcustom org-odt-fontify-srcblocks t + "Specify whether or not source blocks need to be fontified. +Turn this option on if you want to colorize the source code +blocks in the exported file. For colorization to work, you need +to make available an enhanced version of `htmlfontify' library." + :type 'boolean + :group 'org-export-odt + :version "24.1") + + +;;;; Table + +(defcustom org-odt-table-styles + '(("OrgEquation" "OrgEquation" + ((use-first-column-styles . t) + (use-last-column-styles . t))) + ("TableWithHeaderRowAndColumn" "Custom" + ((use-first-row-styles . t) + (use-first-column-styles . t))) + ("TableWithFirstRowandLastRow" "Custom" + ((use-first-row-styles . t) + (use-last-row-styles . t))) + ("GriddedTable" "Custom" nil)) + "Specify how Table Styles should be derived from a Table Template. +This is a list where each element is of the +form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS). + +TABLE-STYLE-NAME is the style associated with the table through +\"#+ATTR_ODT: :style TABLE-STYLE-NAME\" line. + +TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic +TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined +below) that is included in +`org-odt-content-template-file'. + +TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + + \"TableCell\" +PARAGRAPH-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + + \"TableParagraph\" +TABLE-CELL-TYPE := \"FirstRow\" | \"LastColumn\" | + \"FirstRow\" | \"LastRow\" | + \"EvenRow\" | \"OddRow\" | + \"EvenColumn\" | \"OddColumn\" | \"\" +where \"+\" above denotes string concatenation. + +TABLE-CELL-OPTIONS is an alist where each element is of the +form (TABLE-CELL-STYLE-SELECTOR . ON-OR-OFF). +TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' | + `use-last-row-styles' | + `use-first-column-styles' | + `use-last-column-styles' | + `use-banding-rows-styles' | + `use-banding-columns-styles' | + `use-first-row-styles' +ON-OR-OFF := `t' | `nil' + +For example, with the following configuration + +\(setq org-odt-table-styles + '\(\(\"TableWithHeaderRowsAndColumns\" \"Custom\" + \(\(use-first-row-styles . t\) + \(use-first-column-styles . t\)\)\) + \(\"TableWithHeaderColumns\" \"Custom\" + \(\(use-first-column-styles . t\)\)\)\)\) + +1. A table associated with \"TableWithHeaderRowsAndColumns\" + style will use the following table-cell styles - + \"CustomFirstRowTableCell\", \"CustomFirstColumnTableCell\", + \"CustomTableCell\" and the following paragraph styles + \"CustomFirstRowTableParagraph\", + \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" + as appropriate. + +2. A table associated with \"TableWithHeaderColumns\" style will + use the following table-cell styles - + \"CustomFirstColumnTableCell\", \"CustomTableCell\" and the + following paragraph styles + \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" + as appropriate.. + +Note that TABLE-TEMPLATE-NAME corresponds to the +\"\" elements contained within +\"\". The entries (TABLE-STYLE-NAME +TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS) correspond to +\"table:template-name\" and \"table:use-first-row-styles\" etc +attributes of \"\" element. Refer ODF-1.2 +specification for more information. Also consult the +implementation filed under `org-odt-get-table-cell-styles'. + +The TABLE-STYLE-NAME \"OrgEquation\" is used internally for +formatting of numbered display equations. Do not delete this +style from the list." + :group 'org-export-odt + :version "24.1" + :type '(choice + (const :tag "None" nil) + (repeat :tag "Table Styles" + (list :tag "Table Style Specification" + (string :tag "Table Style Name") + (string :tag "Table Template Name") + (alist :options (use-first-row-styles + use-last-row-styles + use-first-column-styles + use-last-column-styles + use-banding-rows-styles + use-banding-columns-styles) + :key-type symbol + :value-type (const :tag "True" t)))))) + +;;;; Timestamps + +(defcustom org-odt-use-date-fields nil + "Non-nil, if timestamps should be exported as date fields. + +When nil, export timestamps as plain text. + +When non-nil, map `org-time-stamp-custom-formats' to a pair of +OpenDocument date-styles with names \"OrgDate1\" and \"OrgDate2\" +respectively. A timestamp with no time component is formatted +with style \"OrgDate1\" while one with explicit hour and minutes +is formatted with style \"OrgDate2\". + +This feature is experimental. Most (but not all) of the common +%-specifiers in `format-time-string' are supported. +Specifically, locale-dependent specifiers like \"%c\", \"%x\" are +formatted as canonical Org timestamps. For finer control, avoid +these %-specifiers. + +Textual specifiers like \"%b\", \"%h\", \"%B\", \"%a\", \"%A\" +etc., are displayed by the application in the default language +and country specified in `org-odt-styles-file'. Note that the +default styles file uses language \"en\" and country \"GB\". You +can localize the week day and month strings in the exported +document by setting the default language and country either using +the application UI or through a custom styles file. + +See `org-odt--build-date-styles' for implementation details." + :group 'org-export-odt + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + + + +;;; Internal functions + +;;;; Date + +(defun org-odt--format-timestamp (timestamp &optional end iso-date-p) + (let* ((format-timestamp + (lambda (timestamp format &optional end utc) + (if timestamp + (org-timestamp-format timestamp format end utc) + (format-time-string format nil utc)))) + (has-time-p (or (not timestamp) + (org-timestamp-has-time-p timestamp))) + (iso-date (let ((format (if has-time-p "%Y-%m-%dT%H:%M:%S" + "%Y-%m-%dT%H:%M:%S"))) + (funcall format-timestamp timestamp format end)))) + (if iso-date-p iso-date + (let* ((style (if has-time-p "OrgDate2" "OrgDate1")) + ;; LibreOffice does not care about end goes as content + ;; within the "..." field. The + ;; displayed date is automagically corrected to match the + ;; format requested by "style:data-style-name" attribute. So + ;; don't bother about formatting the date contents to be + ;; compatible with "OrgDate1" and "OrgDateTime" styles. A + ;; simple Org-style date should suffice. + (date (let* ((formats + (if org-display-custom-times + (cons (substring + (car org-time-stamp-custom-formats) 1 -1) + (substring + (cdr org-time-stamp-custom-formats) 1 -1)) + '("%Y-%m-%d %a" . "%Y-%m-%d %a %H:%M"))) + (format (if has-time-p (cdr formats) (car formats)))) + (funcall format-timestamp timestamp format end))) + (repeater (let ((repeater-type (org-element-property + :repeater-type timestamp)) + (repeater-value (org-element-property + :repeater-value timestamp)) + (repeater-unit (org-element-property + :repeater-unit timestamp))) + (concat + (case repeater-type + (catchup "++") (restart ".+") (cumulate "+")) + (when repeater-value + (number-to-string repeater-value)) + (case repeater-unit + (hour "h") (day "d") (week "w") (month "m") + (year "y")))))) + (concat + (format "%s" + iso-date style date) + (and (not (string= repeater "")) " ") + repeater))))) + +;;;; Frame + +(defun org-odt--frame (text width height style &optional extra + anchor-type &rest title-and-desc) + (let ((frame-attrs + (concat + (if width (format " svg:width=\"%0.2fcm\"" width) "") + (if height (format " svg:height=\"%0.2fcm\"" height) "") + extra + (format " text:anchor-type=\"%s\"" (or anchor-type "paragraph")) + (format " draw:name=\"%s\"" + (car (org-odt-add-automatic-style "Frame")))))) + (format + "\n\n%s\n" + style frame-attrs + (concat text + (let ((title (car title-and-desc)) + (desc (cadr title-and-desc))) + (concat (when title + (format "%s" + (org-odt--encode-plain-text title t))) + (when desc + (format "%s" + (org-odt--encode-plain-text desc t))))))))) + + +;;;; Library wrappers + +(defun org-odt--zip-extract (archive members target) + (when (atom members) (setq members (list members))) + (mapc (lambda (member) + (require 'arc-mode) + (let* ((--quote-file-name + ;; This is shamelessly stolen from `archive-zip-extract'. + (lambda (name) + (if (or (not (memq system-type '(windows-nt ms-dos))) + (and (boundp 'w32-quote-process-args) + (null w32-quote-process-args))) + (shell-quote-argument name) + name))) + (target (funcall --quote-file-name target)) + (archive (expand-file-name archive)) + (archive-zip-extract + (list "unzip" "-qq" "-o" "-d" target)) + exit-code command-output) + (setq command-output + (with-temp-buffer + (setq exit-code (archive-zip-extract archive member)) + (buffer-string))) + (unless (zerop exit-code) + (message command-output) + (error "Extraction failed")))) + members)) + +;;;; Target + +(defun org-odt--target (text id) + (if (not id) text + (concat + (format "\n" id) + (format "\n" id) text + (format "\n" id)))) + +;;;; Textbox + +(defun org-odt--textbox (text width height style &optional + extra anchor-type) + (org-odt--frame + (format "\n%s\n" + (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2)) + (and (not width) + (format " fo:min-width=\"%0.2fcm\"" (or width .2)))) + text) + width nil style extra anchor-type)) + + + +;;;; Table of Contents + +(defun org-odt-begin-toc (index-title depth) + (concat + (format " + + + %s +" depth index-title) + + (let ((levels (number-sequence 1 10))) + (mapconcat + (lambda (level) + (format + " + + + + + + +" level level)) levels "")) + + (format " + + + + + %s + + " index-title))) + +(defun org-odt-end-toc () + (format " + + +")) + +(defun* org-odt-format-toc-headline + (todo todo-type priority text tags + &key level section-number headline-label &allow-other-keys) + (setq text + (concat + ;; Section number. + (when section-number (concat section-number ". ")) + ;; Todo. + (when todo + (let ((style (if (member todo org-done-keywords) + "OrgDone" "OrgTodo"))) + (format "%s " + style todo))) + (when priority + (let* ((style (format "OrgPriority-%s" priority)) + (priority (format "[#%c]" priority))) + (format "%s " + style priority))) + ;; Title. + text + ;; Tags. + (when tags + (concat + (format " [%s]" + "OrgTags" + (mapconcat + (lambda (tag) + (format + "%s" + "OrgTag" tag)) tags " : ")))))) + (format "%s" + headline-label text)) + +(defun org-odt-toc (depth info) + (assert (wholenump depth)) + ;; When a headline is marked as a radio target, as in the example below: + ;; + ;; ** <<>> + ;; Some text. + ;; + ;; suppress generation of radio targets. i.e., Radio targets are to + ;; be marked as targets within /document body/ and *not* within + ;; /TOC/, as otherwise there will be duplicated anchors one in TOC + ;; and one in the document body. + ;; + ;; FIXME-1: Currently exported headings are memoized. `org-export.el' + ;; doesn't provide a way to disable memoization. So this doesn't + ;; work. + ;; + ;; FIXME-2: Are there any other objects that need to be suppressed + ;; within TOC? + (let* ((title (org-export-translate "Table of Contents" :utf-8 info)) + (headlines (org-export-collect-headlines + info (and (wholenump depth) depth))) + (backend (org-export-create-backend + :parent (org-export-backend-name + (plist-get info :back-end)) + :transcoders (mapcar + (lambda (type) (cons type (lambda (d c i) c))) + (list 'radio-target))))) + (when headlines + (concat + (org-odt-begin-toc title depth) + (mapconcat + (lambda (headline) + (let* ((entry (org-odt-format-headline--wrap + headline backend info 'org-odt-format-toc-headline)) + (level (org-export-get-relative-level headline info)) + (style (format "Contents_20_%d" level))) + (format "\n%s" + style entry))) + headlines "\n") + (org-odt-end-toc))))) + + +;;;; Document styles + +(defun org-odt-add-automatic-style (object-type &optional object-props) + "Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS. +OBJECT-PROPS is (typically) a plist created by passing +\"#+ATTR_ODT: \" option of the object in question to +`org-odt-parse-block-attributes'. + +Use `org-odt-object-counters' to generate an automatic +OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a +new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME +. STYLE-NAME)." + (assert (stringp object-type)) + (let* ((object (intern object-type)) + (seqvar object) + (seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0))) + (object-name (format "%s%d" object-type seqno)) style-name) + (setq org-odt-object-counters + (plist-put org-odt-object-counters seqvar seqno)) + (when object-props + (setq style-name (format "Org%s" object-name)) + (setq org-odt-automatic-styles + (plist-put org-odt-automatic-styles object + (append (list (list style-name object-props)) + (plist-get org-odt-automatic-styles object))))) + (cons object-name style-name))) + +;;;; Checkbox + +(defun org-odt--checkbox (item) + "Return check-box string associated to ITEM." + (let ((checkbox (org-element-property :checkbox item))) + (if (not checkbox) "" + (format "%s" + "OrgCode" (case checkbox + (on "[✓] ") ; CHECK MARK + (off "[ ] ") + (trans "[-] ")))))) + +;;; Template + +(defun org-odt--build-date-styles (fmt style) + ;; In LibreOffice 3.4.6, there doesn't seem to be a convenient way + ;; to modify the date fields. A date could be modified by + ;; offsetting in days. That's about it. Also, date and time may + ;; have to be emitted as two fields - a date field and a time field + ;; - separately. + + ;; One can add Form Controls to date and time fields so that they + ;; can be easily modified. But then, the exported document will + ;; become tightly coupled with LibreOffice and may not function + ;; properly with other OpenDocument applications. + + ;; I have a strange feeling that Date styles are a bit flaky at the + ;; moment. + + ;; The feature is experimental. + (when (and fmt style) + (let* ((fmt-alist + '(("%A" . "") + ("%B" . "") + ("%H" . "") + ("%M" . "") + ("%S" . "") + ("%V" . "") + ("%Y" . "") + ("%a" . "") + ("%b" . "") + ("%d" . "") + ("%e" . "") + ("%h" . "") + ("%k" . "") + ("%m" . "") + ("%p" . "") + ("%y" . ""))) + (case-fold-search nil) + (re (mapconcat 'identity (mapcar 'car fmt-alist) "\\|")) + match rpl (start 0) (filler-beg 0) filler-end filler output) + (mapc + (lambda (pair) + (setq fmt (replace-regexp-in-string (car pair) (cdr pair) fmt t t))) + '(("\\(?:%[[:digit:]]*N\\)" . "") ; strip ns, us and ns + ("%C" . "Y") ; replace century with year + ("%D" . "%m/%d/%y") + ("%G" . "Y") ; year corresponding to iso week + ("%I" . "%H") ; hour on a 12-hour clock + ("%R" . "%H:%M") + ("%T" . "%H:%M:%S") + ("%U\\|%W" . "%V") ; week no. starting on Sun./Mon. + ("%Z" . "") ; time zone name + ("%c" . "%Y-%M-%d %a %H:%M" ) ; locale's date and time format + ("%g" . "%y") + ("%X" . "%x" ) ; locale's pref. time format + ("%j" . "") ; day of the year + ("%l" . "%k") ; like %I blank-padded + ("%s" . "") ; no. of secs since 1970-01-01 00:00:00 +0000 + ("%n" . "") + ("%r" . "%I:%M:%S %p") + ("%t" . "") + ("%u\\|%w" . "") ; numeric day of week - Mon (1-7), Sun(0-6) + ("%x" . "%Y-%M-%d %a") ; locale's pref. time format + ("%z" . "") ; time zone in numeric form + )) + (while (string-match re fmt start) + (setq match (match-string 0 fmt)) + (setq rpl (assoc-default match fmt-alist)) + (setq start (match-end 0)) + (setq filler-end (match-beginning 0)) + (setq filler (substring fmt (prog1 filler-beg + (setq filler-beg (match-end 0))) + filler-end)) + (setq filler (and (not (string= filler "")) + (format "%s" + (org-odt--encode-plain-text filler)))) + (setq output (concat output "\n" filler "\n" rpl))) + (setq filler (substring fmt filler-beg)) + (unless (string= filler "") + (setq output (concat output + (format "\n%s" + (org-odt--encode-plain-text filler))))) + (format "\n%s\n" + style + (concat " number:automatic-order=\"true\"" + " number:format-source=\"fixed\"") + output )))) + +(defun org-odt-template (contents info) + "Return complete document string after ODT conversion. +CONTENTS is the transcoded contents string. RAW-DATA is the +original parsed data. INFO is a plist holding export options." + ;; Write meta file. + (let ((title (org-export-data (plist-get info :title) info)) + (author (let ((author (plist-get info :author))) + (if (not author) "" (org-export-data author info)))) + (email (plist-get info :email)) + (keywords (plist-get info :keywords)) + (description (plist-get info :description))) + (write-region + (concat + " + + \n" + (format "%s\n" author) + (format "%s\n" author) + ;; Date, if required. + (when (plist-get info :with-date) + ;; Check if DATE is specified as an Org-timestamp. If yes, + ;; include it as meta information. Otherwise, just use + ;; today's date. + (let* ((date (let ((date (plist-get info :date))) + (and (not (cdr date)) + (eq (org-element-type (car date)) 'timestamp) + (car date))))) + (let ((iso-date (org-odt--format-timestamp date nil 'iso-date))) + (concat + (format "%s\n" iso-date) + (format "%s\n" + iso-date))))) + (format "%s\n" + (let ((creator-info (plist-get info :with-creator))) + (if (or (not creator-info) (eq creator-info 'comment)) "" + (plist-get info :creator)))) + (format "%s\n" keywords) + (format "%s\n" description) + (format "%s\n" title) + "\n" + " \n" "") + nil (concat org-odt-zip-dir "meta.xml")) + ;; Add meta.xml in to manifest. + (org-odt-create-manifest-file-entry "text/xml" "meta.xml")) + + ;; Update styles file. + ;; Copy styles.xml. Also dump htmlfontify styles, if there is any. + ;; Write styles file. + (let* ((styles-file (plist-get info :odt-styles-file)) + (styles-file (and styles-file (read (org-trim styles-file)))) + ;; Non-availability of styles.xml is not a critical + ;; error. For now, throw an error. + (styles-file (or styles-file + org-odt-styles-file + (expand-file-name "OrgOdtStyles.xml" + org-odt-styles-dir) + (error "org-odt: Missing styles file?")))) + (cond + ((listp styles-file) + (let ((archive (nth 0 styles-file)) + (members (nth 1 styles-file))) + (org-odt--zip-extract archive members org-odt-zip-dir) + (mapc + (lambda (member) + (when (org-file-image-p member) + (let* ((image-type (file-name-extension member)) + (media-type (format "image/%s" image-type))) + (org-odt-create-manifest-file-entry media-type member)))) + members))) + ((and (stringp styles-file) (file-exists-p styles-file)) + (let ((styles-file-type (file-name-extension styles-file))) + (cond + ((string= styles-file-type "xml") + (copy-file styles-file (concat org-odt-zip-dir "styles.xml") t)) + ((member styles-file-type '("odt" "ott")) + (org-odt--zip-extract styles-file "styles.xml" org-odt-zip-dir))))) + (t + (error (format "Invalid specification of styles.xml file: %S" + org-odt-styles-file)))) + + ;; create a manifest entry for styles.xml + (org-odt-create-manifest-file-entry "text/xml" "styles.xml") + + ;; FIXME: Who is opening an empty styles.xml before this point? + (with-current-buffer + (find-file-noselect (concat org-odt-zip-dir "styles.xml") t) + (revert-buffer t t) + + ;; Write custom styles for source blocks + ;; Save STYLES used for colorizing of source blocks. + ;; Update styles.xml with styles that were collected as part of + ;; `org-odt-hfy-face-to-css' callbacks. + (let ((styles (mapconcat (lambda (style) (format " %s\n" (cddr style))) + hfy-user-sheet-assoc ""))) + (when styles + (goto-char (point-min)) + (when (re-search-forward "" nil t) + (goto-char (match-beginning 0)) + (insert "\n\n" styles "\n")))) + + ;; Update styles.xml - take care of outline numbering + + ;; Don't make automatic backup of styles.xml file. This setting + ;; prevents the backed-up styles.xml file from being zipped in to + ;; odt file. This is more of a hackish fix. Better alternative + ;; would be to fix the zip command so that the output odt file + ;; includes only the needed files and excludes any auto-generated + ;; extra files like backups and auto-saves etc etc. Note that + ;; currently the zip command zips up the entire temp directory so + ;; that any auto-generated files created under the hood ends up in + ;; the resulting odt file. + (set (make-local-variable 'backup-inhibited) t) + + ;; Outline numbering is retained only upto LEVEL. + ;; To disable outline numbering pass a LEVEL of 0. + + (goto-char (point-min)) + (let ((regex + "]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>") + (replacement + "")) + (while (re-search-forward regex nil t) + (unless (let ((sec-num (plist-get info :section-numbers)) + (level (string-to-number (match-string 2)))) + (if (wholenump sec-num) (<= level sec-num) sec-num)) + (replace-match replacement t nil)))) + (save-buffer 0))) + ;; Update content.xml. + + (let* ( ;; `org-display-custom-times' should be accessed right + ;; within the context of the Org buffer. So obtain its + ;; value before moving on to temp-buffer context down below. + (custom-time-fmts + (if org-display-custom-times + (cons (substring (car org-time-stamp-custom-formats) 1 -1) + (substring (cdr org-time-stamp-custom-formats) 1 -1)) + '("%Y-%M-%d %a" . "%Y-%M-%d %a %H:%M")))) + (with-temp-buffer + (insert-file-contents + (or org-odt-content-template-file + (expand-file-name "OrgOdtContentTemplate.xml" + org-odt-styles-dir))) + ;; Write automatic styles. + ;; - Position the cursor. + (goto-char (point-min)) + (re-search-forward " " nil t) + (goto-char (match-beginning 0)) + ;; - Dump automatic table styles. + (loop for (style-name props) in + (plist-get org-odt-automatic-styles 'Table) do + (when (setq props (or (plist-get props :rel-width) "96")) + (insert (format org-odt-table-style-format style-name props)))) + ;; - Dump date-styles. + (when org-odt-use-date-fields + (insert (org-odt--build-date-styles (car custom-time-fmts) + "OrgDate1") + (org-odt--build-date-styles (cdr custom-time-fmts) + "OrgDate2"))) + ;; Update display level. + ;; - Remove existing sequence decls. Also position the cursor. + (goto-char (point-min)) + (when (re-search-forward "" nil nil))) + ;; Update sequence decls according to user preference. + (insert + (format + "\n\n%s\n" + (mapconcat + (lambda (x) + (format + "" + org-odt-display-outline-level (nth 1 x))) + org-odt-category-map-alist "\n"))) + ;; Position the cursor to document body. + (goto-char (point-min)) + (re-search-forward "" nil nil) + (goto-char (match-beginning 0)) + + ;; Preamble - Title, Author, Date etc. + (insert + (let* ((title (org-export-data (plist-get info :title) info)) + (author (and (plist-get info :with-author) + (let ((auth (plist-get info :author))) + (and auth (org-export-data auth info))))) + (email (plist-get info :email)) + ;; Switch on or off above vars based on user settings + (author (and (plist-get info :with-author) (or author email))) + (email (and (plist-get info :with-email) email))) + (concat + ;; Title. + (when (org-string-nw-p title) + (concat + (format "\n%s" + "OrgTitle" (format "\n%s" title)) + ;; Separator. + "\n")) + (cond + ((and author (not email)) + ;; Author only. + (concat + (format "\n%s" + "OrgSubtitle" + (format "%s" author)) + ;; Separator. + "\n")) + ((and author email) + ;; Author and E-mail. + (concat + (format + "\n%s" + "OrgSubtitle" + (format + "%s" + (concat "mailto:" email) + (format "%s" author))) + ;; Separator. + "\n"))) + ;; Date, if required. + (when (plist-get info :with-date) + (let* ((date (plist-get info :date)) + ;; Check if DATE is specified as a timestamp. + (timestamp (and (not (cdr date)) + (eq (org-element-type (car date)) 'timestamp) + (car date)))) + (concat + (format "\n%s" + "OrgSubtitle" + (if (and org-odt-use-date-fields timestamp) + (org-odt--format-timestamp (car date)) + (org-export-data (plist-get info :date) info))) + ;; Separator + "")))))) + ;; Table of Contents + (let* ((with-toc (plist-get info :with-toc)) + (depth (and with-toc (if (wholenump with-toc) + with-toc + (plist-get info :headline-levels))))) + (when depth (insert (or (org-odt-toc depth info) "")))) + ;; Contents. + (insert contents) + ;; Return contents. + (buffer-substring-no-properties (point-min) (point-max))))) + + + +;;; Transcode Functions + +;;;; Bold + +(defun org-odt-bold (bold contents info) + "Transcode BOLD from Org to ODT. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (format "%s" + "Bold" contents)) + + +;;;; Center Block + +(defun org-odt-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to ODT. +CONTENTS holds the contents of the center block. INFO is a plist +holding contextual information." + contents) + + +;;;; Clock + +(defun org-odt-clock (clock contents info) + "Transcode a CLOCK element from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let ((timestamp (org-element-property :value clock)) + (duration (org-element-property :duration clock))) + (format "\n%s" + (if (eq (org-element-type (org-export-get-next-element clock info)) + 'clock) "OrgClock" "OrgClockLastLine") + (concat + (format "%s" + "OrgClockKeyword" org-clock-string) + (org-odt-timestamp timestamp contents info) + (and duration (format " (%s)" duration)))))) + + +;;;; Code + +(defun org-odt-code (code contents info) + "Transcode a CODE object from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "%s" + "OrgCode" (org-odt--encode-plain-text + (org-element-property :value code)))) + + +;;;; Comment + +;; Comments are ignored. + + +;;;; Comment Block + +;; Comment Blocks are ignored. + + +;;;; Drawer + +(defun org-odt-drawer (drawer contents info) + "Transcode a DRAWER element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let* ((name (org-element-property :drawer-name drawer)) + (output (funcall org-odt-format-drawer-function + name contents))) + output)) + + +;;;; Dynamic Block + +(defun org-odt-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information. See `org-export-data'." + contents) + + +;;;; Entity + +(defun org-odt-entity (entity contents info) + "Transcode an ENTITY object from Org to ODT. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (org-element-property :utf-8 entity)) + + +;;;; Example Block + +(defun org-odt-example-block (example-block contents info) + "Transcode a EXAMPLE-BLOCK element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-odt-format-code example-block info)) + + +;;;; Export Snippet + +(defun org-odt-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (eq (org-export-snippet-backend export-snippet) 'odt) + (org-element-property :value export-snippet))) + + +;;;; Export Block + +(defun org-odt-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (string= (org-element-property :type export-block) "ODT") + (org-remove-indentation (org-element-property :value export-block)))) + + +;;;; Fixed Width + +(defun org-odt-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-odt-do-format-code (org-element-property :value fixed-width))) + + +;;;; Footnote Definition + +;; Footnote Definitions are ignored. + + +;;;; Footnote Reference + +(defun org-odt-footnote-reference (footnote-reference contents info) + "Transcode a FOOTNOTE-REFERENCE element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((--format-footnote-definition + (function + (lambda (n def) + (setq n (format "%d" n)) + (let ((id (concat "fn" n)) + (note-class "footnote") + (par-style "Footnote")) + (format + "%s" + id note-class + (concat + (format "%s" n) + (format "%s" def))))))) + (--format-footnote-reference + (function + (lambda (n) + (setq n (format "%d" n)) + (let ((note-class "footnote") + (ref-format "text") + (ref-name (concat "fn" n))) + (format + "%s" + "OrgSuperscript" + (format "%s" + note-class ref-format ref-name n))))))) + (concat + ;; Insert separator between two footnotes in a row. + (let ((prev (org-export-get-previous-element footnote-reference info))) + (and (eq (org-element-type prev) 'footnote-reference) + (format "%s" + "OrgSuperscript" ","))) + ;; Transcode footnote reference. + (let ((n (org-export-get-footnote-number footnote-reference info))) + (cond + ((not (org-export-footnote-first-reference-p footnote-reference info)) + (funcall --format-footnote-reference n)) + ;; Inline definitions are secondary strings. + ;; Non-inline footnotes definitions are full Org data. + (t + (let* ((raw (org-export-get-footnote-definition + footnote-reference info)) + (def + (let ((def (org-trim + (org-export-data-with-backend + raw + (org-export-create-backend + :parent 'odt + :transcoders + '((paragraph . (lambda (p c i) + (org-odt--format-paragraph + p c i + "Footnote" + "OrgFootnoteCenter" + "OrgFootnoteQuotations"))))) + info)))) + (if (eq (org-element-type raw) 'org-data) def + (format "\n%s" + "Footnote" def))))) + (funcall --format-footnote-definition n def)))))))) + + +;;;; Headline + +(defun* org-odt-format-headline + (todo todo-type priority text tags + &key level section-number headline-label &allow-other-keys) + (concat + ;; Todo. + (when todo + (let ((style (if (member todo org-done-keywords) "OrgDone" "OrgTodo"))) + (format "%s " + style todo))) + (when priority + (let* ((style (format "OrgPriority-%s" priority)) + (priority (format "[#%c]" priority))) + (format "%s " + style priority))) + ;; Title. + text + ;; Tags. + (when tags + (concat + "" + (format "[%s]" + "OrgTags" (mapconcat + (lambda (tag) + (format + "%s" + "OrgTag" tag)) tags " : ")))))) + +(defun org-odt-format-headline--wrap (headline backend info + &optional format-function + &rest extra-keys) + "Transcode a HEADLINE element using BACKEND. +INFO is a plist holding contextual information." + (setq backend (or backend (plist-get info :back-end))) + (let* ((level (+ (org-export-get-relative-level headline info))) + (headline-number (org-export-get-headline-number headline info)) + (section-number (and (org-export-numbered-headline-p headline info) + (mapconcat 'number-to-string + headline-number "."))) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo + (org-export-data-with-backend todo backend info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + (text (org-export-data-with-backend + (org-element-property :title headline) backend info)) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (headline-label (concat "sec-" (mapconcat 'number-to-string + headline-number "-"))) + (format-function (cond + ((functionp format-function) format-function) + ((not (eq org-odt-format-headline-function 'ignore)) + (function* + (lambda (todo todo-type priority text tags + &allow-other-keys) + (funcall org-odt-format-headline-function + todo todo-type priority text tags)))) + (t 'org-odt-format-headline)))) + (apply format-function + todo todo-type priority text tags + :headline-label headline-label :level level + :section-number section-number extra-keys))) + +(defun org-odt-headline (headline contents info) + "Transcode a HEADLINE element from Org to ODT. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + ;; Case 1: This is a footnote section: ignore it. + (unless (org-element-property :footnote-section-p headline) + (let* ((text (org-export-data (org-element-property :title headline) info)) + ;; Create the headline text. + (full-text (org-odt-format-headline--wrap headline nil info)) + ;; Get level relative to current parsed data. + (level (org-export-get-relative-level headline info)) + ;; Get canonical label for the headline. + (id (concat "sec-" (mapconcat 'number-to-string + (org-export-get-headline-number + headline info) "-"))) + ;; Get user-specified labels for the headline. + (extra-ids (list (org-element-property :CUSTOM_ID headline) + (org-element-property :ID headline))) + ;; Extra targets. + (extra-targets + (mapconcat (lambda (x) + (when x + (let ((x (if (org-uuidgen-p x) (concat "ID-" x) x))) + (org-odt--target + "" (org-export-solidify-link-text x))))) + extra-ids "")) + ;; Title. + (anchored-title (org-odt--target full-text id))) + (cond + ;; Case 2. This is a deep sub-tree: export it as a list item. + ;; Also export as items headlines for which no section + ;; format has been found. + ((org-export-low-level-p headline info) + ;; Build the real contents of the sub-tree. + (concat + (and (org-export-first-sibling-p headline info) + (format "\n" + ;; Choose style based on list type. + (if (org-export-numbered-headline-p headline info) + "OrgNumberedList" "OrgBulletedList") + ;; If top-level list, re-start numbering. Otherwise, + ;; continue numbering. + (format "text:continue-numbering=\"%s\"" + (let* ((parent (org-export-get-parent-headline + headline))) + (if (and parent + (org-export-low-level-p parent info)) + "true" "false"))))) + (let ((headline-has-table-p + (let ((section (assq 'section (org-element-contents headline)))) + (assq 'table (and section (org-element-contents section)))))) + (format "\n\n%s\n%s" + (concat + (format "\n%s" + "Text_20_body" + (concat extra-targets anchored-title)) + contents) + (if headline-has-table-p + "" + ""))) + (and (org-export-last-sibling-p headline info) + ""))) + ;; Case 3. Standard headline. Export it as a section. + (t + (concat + (format + "\n%s" + (format "Heading_20_%s" level) + level + (concat extra-targets anchored-title)) + contents)))))) + + +;;;; Horizontal Rule + +(defun org-odt-horizontal-rule (horizontal-rule contents info) + "Transcode an HORIZONTAL-RULE object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (format "\n%s" + "Horizontal_20_Line" "")) + + +;;;; Inline Babel Call + +;; Inline Babel Calls are ignored. + + +;;;; Inline Src Block + +(defun org-odt--find-verb-separator (s) + "Return a character not used in string S. +This is used to choose a separator for constructs like \\verb." + (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) + (loop for c across ll + when (not (string-match (regexp-quote (char-to-string c)) s)) + return (char-to-string c)))) + +(defun org-odt-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to ODT. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((org-lang (org-element-property :language inline-src-block)) + (code (org-element-property :value inline-src-block)) + (separator (org-odt--find-verb-separator code))) + (error "FIXME"))) + + +;;;; Inlinetask + +(defun org-odt-inlinetask (inlinetask contents info) + "Transcode an INLINETASK element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (cond + ;; If `org-odt-format-inlinetask-function' is not 'ignore, call it + ;; with appropriate arguments. + ((not (eq org-odt-format-inlinetask-function 'ignore)) + (let ((format-function + (function* + (lambda (todo todo-type priority text tags + &key contents &allow-other-keys) + (funcall org-odt-format-inlinetask-function + todo todo-type priority text tags contents))))) + (org-odt-format-headline--wrap + inlinetask nil info format-function :contents contents))) + ;; Otherwise, use a default template. + (t + (format "\n%s" + "Text_20_body" + (org-odt--textbox + (concat + (format "\n%s" + "OrgInlineTaskHeading" + (org-odt-format-headline--wrap inlinetask nil info)) + contents) + nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\""))))) + +;;;; Italic + +(defun org-odt-italic (italic contents info) + "Transcode ITALIC from Org to ODT. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (format "%s" + "Emphasis" contents)) + + +;;;; Item + +(defun org-odt-item (item contents info) + "Transcode an ITEM element from Org to ODT. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((plain-list (org-export-get-parent item)) + (type (org-element-property :type plain-list)) + (counter (org-element-property :counter item)) + (tag (let ((tag (org-element-property :tag item))) + (and tag + (concat (org-odt--checkbox item) + (org-export-data tag info)))))) + (case type + ((ordered unordered descriptive-1 descriptive-2) + (format "\n\n%s\n%s" + contents + (let* ((--element-has-a-table-p + (function + (lambda (element info) + (loop for el in (org-element-contents element) + thereis (eq (org-element-type el) 'table)))))) + (cond + ((funcall --element-has-a-table-p item info) + "") + (t ""))))) + (t (error "Unknown list type: %S" type))))) + +;;;; Keyword + +(defun org-odt-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "ODT") value) + ((string= key "INDEX") + ;; FIXME + (ignore)) + ((string= key "TOC") + (let ((value (downcase value))) + (cond + ((string-match "\\" value) + (let ((depth (or (and (string-match "[0-9]+" value) + (string-to-number (match-string 0 value))) + (plist-get info :with-toc)))) + (when (wholenump depth) (org-odt-toc depth info)))) + ((member value '("tables" "figures" "listings")) + ;; FIXME + (ignore)))))))) + + +;;;; Latex Environment + + +;; (eval-after-load 'ox-odt '(ad-deactivate 'org-format-latex-as-mathml)) +;; (defadvice org-format-latex-as-mathml ; FIXME +;; (after org-odt-protect-latex-fragment activate) +;; "Encode LaTeX fragment as XML. +;; Do this when translation to MathML fails." +;; (unless (> (length ad-return-value) 0) +;; (setq ad-return-value (org-odt--encode-plain-text (ad-get-arg 0))))) + +(defun org-odt-latex-environment (latex-environment contents info) + "Transcode a LATEX-ENVIRONMENT element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let* ((latex-frag (org-remove-indentation + (org-element-property :value latex-environment)))) + (org-odt-do-format-code latex-frag))) + + +;;;; Latex Fragment + +;; (when latex-frag ; FIXME +;; (setq href (org-propertize href :title "LaTeX Fragment" +;; :description latex-frag))) +;; handle verbatim +;; provide descriptions + +(defun org-odt-latex-fragment (latex-fragment contents info) + "Transcode a LATEX-FRAGMENT object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let* ((latex-frag (org-element-property :value latex-fragment)) + (processing-type (plist-get info :with-latex))) + (format "%s" + "OrgCode" (org-odt--encode-plain-text latex-frag t)))) + + +;;;; Line Break + +(defun org-odt-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + "") + + +;;;; Link + +;;;; Links :: Label references + +(defun org-odt--enumerate (element info &optional predicate n) + (when predicate (assert (funcall predicate element info))) + (let* ((--numbered-parent-headline-at-<=-n + (function + (lambda (element n info) + (loop for x in (org-export-get-genealogy element) + thereis (and (eq (org-element-type x) 'headline) + (<= (org-export-get-relative-level x info) n) + (org-export-numbered-headline-p x info) + x))))) + (--enumerate + (function + (lambda (element scope info &optional predicate) + (let ((counter 0)) + (org-element-map (or scope (plist-get info :parse-tree)) + (org-element-type element) + (lambda (el) + (and (or (not predicate) (funcall predicate el info)) + (incf counter) + (eq element el) + counter)) + info 'first-match))))) + (scope (funcall --numbered-parent-headline-at-<=-n + element (or n org-odt-display-outline-level) info)) + (ordinal (funcall --enumerate element scope info predicate)) + (tag + (concat + ;; Section number. + (and scope + (mapconcat 'number-to-string + (org-export-get-headline-number scope info) ".")) + ;; Separator. + (and scope ".") + ;; Ordinal. + (number-to-string ordinal)))) + tag)) + +(defun org-odt-format-label (element info op) + "Return a label for ELEMENT. + +ELEMENT is a `link', `table', `src-block' or `paragraph' type +element. INFO is a plist used as a communication channel. OP is +either `definition' or `reference', depending on the purpose of +the generated string. + +Return value is a string if OP is set to `reference' or a cons +cell like CAPTION . SHORT-CAPTION) where CAPTION and +SHORT-CAPTION are strings." + (assert (memq (org-element-type element) '(link table src-block paragraph))) + (let* ((caption-from + (case (org-element-type element) + (link (org-export-get-parent-element element)) + (t element))) + ;; Get label and caption. + (label (org-element-property :name caption-from)) + (caption (org-export-get-caption caption-from)) + (caption (and caption (org-export-data caption info))) + ;; FIXME: We don't use short-caption for now + (short-caption nil)) + (when (or label caption) + (let* ((default-category + (case (org-element-type element) + (table "__Table__") + (src-block "__Listing__") + ((link paragraph) + (cond + ((org-odt--enumerable-latex-image-p element info) + "__DvipngImage__") + ((org-odt--enumerable-image-p element info) + "__Figure__") + ((org-odt--enumerable-formula-p element info) + "__MathFormula__") + (t (error "Don't know how to format label for link: %S" + element)))) + (t (error "Don't know how to format label for element type: %s" + (org-element-type element))))) + seqno) + (assert default-category) + (destructuring-bind (counter label-style category predicate) + (assoc-default default-category org-odt-category-map-alist) + ;; Compute sequence number of the element. + (setq seqno (org-odt--enumerate element info predicate)) + ;; Localize category string. + (setq category (org-export-translate category :utf-8 info)) + (case op + ;; Case 1: Handle Label definition. + (definition + ;; Assign an internal label, if user has not provided one + (setq label (org-export-solidify-link-text + (or label (format "%s-%s" default-category seqno)))) + (cons + (concat + ;; Sneak in a bookmark. The bookmark is used when the + ;; labeled element is referenced with a link that + ;; provides its own description. + (format "\n" label) + ;; Label definition: Typically formatted as below: + ;; CATEGORY SEQ-NO: LONG CAPTION + ;; with translation for correct punctuation. + (format-spec + (org-export-translate + (cadr (assoc-string label-style org-odt-label-styles t)) + :utf-8 info) + `((?e . ,category) + (?n . ,(format + "%s" + label counter counter seqno)) + (?c . ,(or caption ""))))) + short-caption)) + ;; Case 2: Handle Label reference. + (reference + (assert label) + (setq label (org-export-solidify-link-text label)) + (let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t))) + (fmt1 (car fmt)) + (fmt2 (cadr fmt))) + (format "%s" + fmt1 label (format-spec fmt2 `((?e . ,category) + (?n . ,seqno)))))) + (t (error "Unknown %S on label" op)))))))) + + +;;;; Links :: Inline Images + +(defun org-odt--copy-image-file (path) + "Returns the internal name of the file" + (let* ((image-type (file-name-extension path)) + (media-type (format "image/%s" image-type)) + (target-dir "Images/") + (target-file + (format "%s%04d.%s" target-dir + (incf org-odt-embedded-images-count) image-type))) + (message "Embedding %s as %s..." + (substring-no-properties path) target-file) + + (when (= 1 org-odt-embedded-images-count) + (make-directory (concat org-odt-zip-dir target-dir)) + (org-odt-create-manifest-file-entry "" target-dir)) + + (copy-file path (concat org-odt-zip-dir target-file) 'overwrite) + (org-odt-create-manifest-file-entry media-type target-file) + target-file)) + +(defun org-odt--image-size (file &optional user-width + user-height scale dpi embed-as) + (let* ((--pixels-to-cms + (function (lambda (pixels dpi) + (let ((cms-per-inch 2.54) + (inches (/ pixels dpi))) + (* cms-per-inch inches))))) + (--size-in-cms + (function + (lambda (size-in-pixels dpi) + (and size-in-pixels + (cons (funcall --pixels-to-cms (car size-in-pixels) dpi) + (funcall --pixels-to-cms (cdr size-in-pixels) dpi)))))) + (dpi (or dpi org-odt-pixels-per-inch)) + (anchor-type (or embed-as "paragraph")) + (user-width (and (not scale) user-width)) + (user-height (and (not scale) user-height)) + (size + (and + (not (and user-height user-width)) + (or + ;; Use Imagemagick. + (and (executable-find "identify") + (let ((size-in-pixels + (let ((dim (shell-command-to-string + (format "identify -format \"%%w:%%h\" \"%s\"" + file)))) + (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim) + (cons (string-to-number (match-string 1 dim)) + (string-to-number (match-string 2 dim))))))) + (funcall --size-in-cms size-in-pixels dpi))) + ;; Use Emacs. + (let ((size-in-pixels + (ignore-errors ; Emacs could be in batch mode + (clear-image-cache) + (image-size (create-image file) 'pixels)))) + (funcall --size-in-cms size-in-pixels dpi)) + ;; Use hard-coded values. + (cdr (assoc-string anchor-type + org-odt-default-image-sizes-alist)) + ;; Error out. + (error "Cannot determine image size, aborting")))) + (width (car size)) (height (cdr size))) + (cond + (scale + (setq width (* width scale) height (* height scale))) + ((and user-height user-width) + (setq width user-width height user-height)) + (user-height + (setq width (* user-height (/ width height)) height user-height)) + (user-width + (setq height (* user-width (/ height width)) width user-width)) + (t (ignore))) + ;; ensure that an embedded image fits comfortably within a page + (let ((max-width (car org-odt-max-image-size)) + (max-height (cdr org-odt-max-image-size))) + (when (or (> width max-width) (> height max-height)) + (let* ((scale1 (/ max-width width)) + (scale2 (/ max-height height)) + (scale (min scale1 scale2))) + (setq width (* scale width) height (* scale height))))) + (cons width height))) + +(defun org-odt-link--inline-image (element info) + "Return ODT code for an inline image. +LINK is the link pointing to the inline image. INFO is a plist +used as a communication channel." + (assert (eq (org-element-type element) 'link)) + (let* ((src (let* ((type (org-element-property :type element)) + (raw-path (org-element-property :path element))) + (cond ((member type '("http" "https")) + (concat type ":" raw-path)) + ((file-name-absolute-p raw-path) + (expand-file-name raw-path)) + (t raw-path)))) + (src-expanded (if (file-name-absolute-p src) src + (expand-file-name src (file-name-directory + (plist-get info :input-file))))) + (href (format + "\n" + (org-odt--copy-image-file src-expanded))) + ;; Extract attributes from #+ATTR_ODT line. + (attr-from (case (org-element-type element) + (link (org-export-get-parent-element element)) + (t element))) + ;; Convert attributes to a plist. + (attr-plist (org-export-read-attribute :attr_odt attr-from)) + ;; Handle `:anchor', `:style' and `:attributes' properties. + (user-frame-anchor + (car (assoc-string (plist-get attr-plist :anchor) + '(("as-char") ("paragraph") ("page")) t))) + (user-frame-style + (and user-frame-anchor (plist-get attr-plist :style))) + (user-frame-attrs + (and user-frame-anchor (plist-get attr-plist :attributes))) + (user-frame-params + (list user-frame-style user-frame-attrs user-frame-anchor)) + ;; (embed-as (or embed-as user-frame-anchor "paragraph")) + ;; + ;; Handle `:width', `:height' and `:scale' properties. Read + ;; them as numbers since we need them for computations. + (size (org-odt--image-size + src-expanded + (let ((width (plist-get attr-plist :width))) + (and width (read width))) + (let ((length (plist-get attr-plist :length))) + (and length (read length))) + (let ((scale (plist-get attr-plist :scale))) + (and scale (read scale))) + nil ; embed-as + "paragraph" ; FIXME + )) + (width (car size)) (height (cdr size)) + (standalone-link-p (org-odt--standalone-link-p element info)) + (embed-as (if standalone-link-p "paragraph" "as-char")) + (captions (org-odt-format-label element info 'definition)) + (caption (car captions)) (short-caption (cdr captions)) + (entity (concat (and caption "Captioned") embed-as "Image")) + ;; Check if this link was created by LaTeX-to-PNG converter. + (replaces (org-element-property + :replaces (if (not standalone-link-p) element + (org-export-get-parent-element element)))) + ;; If yes, note down the type of the element - LaTeX Fragment + ;; or LaTeX environment. It will go in to frame title. + (title (and replaces (capitalize + (symbol-name (org-element-type replaces))))) + + ;; If yes, note down its contents. It will go in to frame + ;; description. This quite useful for debugging. + (desc (and replaces (org-element-property :value replaces)))) + (org-odt--render-image/formula entity href width height + captions user-frame-params title desc))) + + +;;;; Links :: Math formula + +(defun org-odt-link--inline-formula (element info) + (let* ((src (let* ((type (org-element-property :type element)) + (raw-path (org-element-property :path element))) + (cond + ((file-name-absolute-p raw-path) + (expand-file-name raw-path)) + (t raw-path)))) + (src-expanded (if (file-name-absolute-p src) src + (expand-file-name src (file-name-directory + (plist-get info :input-file))))) + (href + (format + "\n" + " xlink:show=\"embed\" xlink:actuate=\"onLoad\"" + (file-name-directory (org-odt--copy-formula-file src-expanded)))) + (standalone-link-p (org-odt--standalone-link-p element info)) + (embed-as (if standalone-link-p 'paragraph 'character)) + (captions (org-odt-format-label element info 'definition)) + (caption (car captions)) (short-caption (cdr captions)) + ;; Check if this link was created by LaTeX-to-MathML + ;; converter. + (replaces (org-element-property + :replaces (if (not standalone-link-p) element + (org-export-get-parent-element element)))) + ;; If yes, note down the type of the element - LaTeX Fragment + ;; or LaTeX environment. It will go in to frame title. + (title (and replaces (capitalize + (symbol-name (org-element-type replaces))))) + + ;; If yes, note down its contents. It will go in to frame + ;; description. This quite useful for debugging. + (desc (and replaces (org-element-property :value replaces))) + width height) + (cond + ((eq embed-as 'character) + (org-odt--render-image/formula "InlineFormula" href width height + nil nil title desc)) + (t + (let* ((equation (org-odt--render-image/formula + "CaptionedDisplayFormula" href width height + captions nil title desc)) + (label + (let* ((org-odt-category-map-alist + '(("__MathFormula__" "Text" "math-label" "Equation" + org-odt--enumerable-formula-p)))) + (car (org-odt-format-label element info 'definition))))) + (concat equation "" label)))))) + +(defun org-odt--copy-formula-file (src-file) + "Returns the internal name of the file" + (let* ((target-dir (format "Formula-%04d/" + (incf org-odt-embedded-formulas-count))) + (target-file (concat target-dir "content.xml"))) + ;; Create a directory for holding formula file. Also enter it in + ;; to manifest. + (make-directory (concat org-odt-zip-dir target-dir)) + (org-odt-create-manifest-file-entry + "application/vnd.oasis.opendocument.formula" target-dir "1.2") + ;; Copy over the formula file from user directory to zip + ;; directory. + (message "Embedding %s as %s..." src-file target-file) + (let ((case-fold-search nil)) + (cond + ;; Case 1: Mathml. + ((string-match "\\.\\(mathml\\|mml\\)\\'" src-file) + (copy-file src-file (concat org-odt-zip-dir target-file) 'overwrite)) + ;; Case 2: OpenDocument formula. + ((string-match "\\.odf\\'" src-file) + (org-odt--zip-extract src-file "content.xml" + (concat org-odt-zip-dir target-dir))) + (t (error "%s is not a formula file" src-file)))) + ;; Enter the formula file in to manifest. + (org-odt-create-manifest-file-entry "text/xml" target-file) + target-file)) + +;;;; Targets + +(defun org-odt--render-image/formula (cfg-key href width height &optional + captions user-frame-params + &rest title-and-desc) + (let* ((frame-cfg-alist + ;; Each element of this alist is of the form (CFG-HANDLE + ;; INNER-FRAME-PARAMS OUTER-FRAME-PARAMS). + + ;; CFG-HANDLE is the key to the alist. + + ;; INNER-FRAME-PARAMS and OUTER-FRAME-PARAMS specify the + ;; frame params for INNER-FRAME and OUTER-FRAME + ;; respectively. See below. + + ;; Configurations that are meant to be applied to + ;; non-captioned image/formula specifies no + ;; OUTER-FRAME-PARAMS. + + ;; TERMINOLOGY + ;; =========== + ;; INNER-FRAME :: Frame that directly surrounds an + ;; image/formula. + + ;; OUTER-FRAME :: Frame that encloses the INNER-FRAME. This + ;; frame also contains the caption, if any. + + ;; FRAME-PARAMS :: List of the form (FRAME-STYLE-NAME + ;; FRAME-ATTRIBUTES FRAME-ANCHOR). Note + ;; that these are the last three arguments + ;; to `org-odt--frame'. + + ;; Note that an un-captioned image/formula requires just an + ;; INNER-FRAME, while a captioned image/formula requires + ;; both an INNER and an OUTER-FRAME. + '(("As-CharImage" ("OrgInlineImage" nil "as-char")) + ("ParagraphImage" ("OrgDisplayImage" nil "paragraph")) + ("PageImage" ("OrgPageImage" nil "page")) + ("CaptionedAs-CharImage" + ("OrgCaptionedImage" + " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") + ("OrgInlineImage" nil "as-char")) + ("CaptionedParagraphImage" + ("OrgCaptionedImage" + " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") + ("OrgImageCaptionFrame" nil "paragraph")) + ("CaptionedPageImage" + ("OrgCaptionedImage" + " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") + ("OrgPageImageCaptionFrame" nil "page")) + ("InlineFormula" ("OrgInlineFormula" nil "as-char")) + ("DisplayFormula" ("OrgDisplayFormula" nil "as-char")) + ("CaptionedDisplayFormula" + ("OrgCaptionedFormula" nil "paragraph") + ("OrgFormulaCaptionFrame" nil "paragraph")))) + (caption (car captions)) (short-caption (cdr captions)) + ;; Retrieve inner and outer frame params, from configuration. + (frame-cfg (assoc-string cfg-key frame-cfg-alist t)) + (inner (nth 1 frame-cfg)) + (outer (nth 2 frame-cfg)) + ;; User-specified frame params (from #+ATTR_ODT spec) + (user user-frame-params) + (--merge-frame-params (function + (lambda (default user) + "Merge default and user frame params." + (if (not user) default + (assert (= (length default) 3)) + (assert (= (length user) 3)) + (loop for u in user + for d in default + collect (or u d))))))) + (cond + ;; Case 1: Image/Formula has no caption. + ;; There is only one frame, one that surrounds the image + ;; or formula. + ((not caption) + ;; Merge user frame params with that from configuration. + (setq inner (funcall --merge-frame-params inner user)) + (apply 'org-odt--frame href width height + (append inner title-and-desc))) + ;; Case 2: Image/Formula is captioned or labeled. + ;; There are two frames: The inner one surrounds the + ;; image or formula. The outer one contains the + ;; caption/sequence number. + (t + ;; Merge user frame params with outer frame params. + (setq outer (funcall --merge-frame-params outer user)) + ;; Short caption, if specified, goes as part of inner frame. + (setq inner (let ((frame-params (copy-sequence inner))) + (setcar (cdr frame-params) + (concat + (cadr frame-params) + (when short-caption + (format " draw:name=\"%s\" " short-caption)))) + frame-params)) + (apply 'org-odt--textbox + (format "\n%s" + "Illustration" + (concat + (apply 'org-odt--frame href width height + (append inner title-and-desc)) + caption)) + width height outer))))) + +(defun org-odt--enumerable-p (element info) + ;; Element should have a caption or label. + (or (org-element-property :caption element) + (org-element-property :name element))) + +(defun org-odt--enumerable-image-p (element info) + (org-odt--standalone-link-p + element info + ;; Paragraph should have a caption or label. It SHOULD NOT be a + ;; replacement element. (i.e., It SHOULD NOT be a result of LaTeX + ;; processing.) + (lambda (p) + (and (not (org-element-property :replaces p)) + (or (org-element-property :caption p) + (org-element-property :name p)))) + ;; Link should point to an image file. + (lambda (l) + (assert (eq (org-element-type l) 'link)) + (org-export-inline-image-p l org-odt-inline-image-rules)))) + +(defun org-odt--enumerable-latex-image-p (element info) + (org-odt--standalone-link-p + element info + ;; Paragraph should have a caption or label. It SHOULD also be a + ;; replacement element. (i.e., It SHOULD be a result of LaTeX + ;; processing.) + (lambda (p) + (and (org-element-property :replaces p) + (or (org-element-property :caption p) + (org-element-property :name p)))) + ;; Link should point to an image file. + (lambda (l) + (assert (eq (org-element-type l) 'link)) + (org-export-inline-image-p l org-odt-inline-image-rules)))) + +(defun org-odt--enumerable-formula-p (element info) + (org-odt--standalone-link-p + element info + ;; Paragraph should have a caption or label. + (lambda (p) + (or (org-element-property :caption p) + (org-element-property :name p))) + ;; Link should point to a MathML or ODF file. + (lambda (l) + (assert (eq (org-element-type l) 'link)) + (org-export-inline-image-p l org-odt-inline-formula-rules)))) + +(defun org-odt--standalone-link-p (element info &optional + paragraph-predicate + link-predicate) + "Test if ELEMENT is a standalone link for the purpose ODT export. +INFO is a plist holding contextual information. + +Return non-nil, if ELEMENT is of type paragraph satisfying +PARAGRAPH-PREDICATE and its sole content, save for whitespaces, +is a link that satisfies LINK-PREDICATE. + +Return non-nil, if ELEMENT is of type link satisfying +LINK-PREDICATE and its containing paragraph satisfies +PARAGRAPH-PREDICATE in addition to having no other content save for +leading and trailing whitespaces. + +Return nil, otherwise." + (let ((p (case (org-element-type element) + (paragraph element) + (link (and (or (not link-predicate) + (funcall link-predicate element)) + (org-export-get-parent element))) + (t nil)))) + (when (and p (eq (org-element-type p) 'paragraph)) + (when (or (not paragraph-predicate) + (funcall paragraph-predicate p)) + (let ((contents (org-element-contents p))) + (loop for x in contents + with inline-image-count = 0 + always (case (org-element-type x) + (plain-text + (not (org-string-nw-p x))) + (link + (and (or (not link-predicate) + (funcall link-predicate x)) + (= (incf inline-image-count) 1))) + (t nil)))))))) + +(defun org-odt-link--infer-description (destination info) + ;; DESTINATION is a headline or an element (like paragraph, + ;; verse-block etc) to which a "#+NAME: label" can be attached. + + ;; Note that labels that are attached to captioned entities - inline + ;; images, math formulae and tables - get resolved as part of + ;; `org-odt-format-label' and `org-odt--enumerate'. + + ;; Create a cross-reference to DESTINATION but make best-efforts to + ;; create a *meaningful* description. Check item numbers, section + ;; number and section title in that order. + + ;; NOTE: Counterpart of `org-export-get-ordinal'. + ;; FIXME: Handle footnote-definition footnote-reference? + (let* ((genealogy (org-export-get-genealogy destination)) + (data (reverse genealogy)) + (label (case (org-element-type destination) + (headline + (format "sec-%s" (mapconcat 'number-to-string + (org-export-get-headline-number + destination info) "-"))) + (target + (org-element-property :value destination)) + (t (error "FIXME: Resolve %S" destination))))) + (or + (let* ( ;; Locate top-level list. + (top-level-list + (loop for x on data + when (eq (org-element-type (car x)) 'plain-list) + return x)) + ;; Get list item nos. + (item-numbers + (loop for (plain-list item . rest) on top-level-list by #'cddr + until (not (eq (org-element-type plain-list) 'plain-list)) + collect (when (eq (org-element-property :type + plain-list) + 'ordered) + (1+ (length (org-export-get-previous-element + item info t)))))) + ;; Locate top-most listified headline. + (listified-headlines + (loop for x on data + when (and (eq (org-element-type (car x)) 'headline) + (org-export-low-level-p (car x) info)) + return x)) + ;; Get listified headline numbers. + (listified-headline-nos + (loop for el in listified-headlines + when (eq (org-element-type el) 'headline) + collect (when (org-export-numbered-headline-p el info) + (1+ (length (org-export-get-previous-element + el info t))))))) + ;; Combine item numbers from both the listified headlines and + ;; regular list items. + + ;; Case 1: Check if all the parents of list item are numbered. + ;; If yes, link to the item proper. + (let ((item-numbers (append listified-headline-nos item-numbers))) + (when (and item-numbers (not (memq nil item-numbers))) + (format "%s" + (org-export-solidify-link-text label) + (mapconcat (lambda (n) (if (not n) " " + (concat (number-to-string n) "."))) + item-numbers ""))))) + ;; Case 2: Locate a regular and numbered headline in the + ;; hierarchy. Display its section number. + (let ((headline (loop for el in (cons destination genealogy) + when (and (eq (org-element-type el) 'headline) + (not (org-export-low-level-p el info)) + (org-export-numbered-headline-p el info)) + return el))) + ;; We found one. + (when headline + (format "%s" + (org-export-solidify-link-text label) + (mapconcat 'number-to-string (org-export-get-headline-number + headline info) ".")))) + ;; Case 4: Locate a regular headline in the hierarchy. Display + ;; its title. + (let ((headline (loop for el in (cons destination genealogy) + when (and (eq (org-element-type el) 'headline) + (not (org-export-low-level-p el info))) + return el))) + ;; We found one. + (when headline + (format "%s" + (org-export-solidify-link-text label) + (let ((title (org-element-property :title headline))) + (org-export-data title info))))) + (error "FIXME?")))) + +(defun org-odt-link (link desc info) + "Transcode a LINK object from Org to ODT. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + (let* ((type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + ;; Ensure DESC really exists, or set it to nil. + (desc (and (not (string= desc "")) desc)) + (imagep (org-export-inline-image-p + link org-odt-inline-image-rules)) + (path (cond + ((member type '("http" "https" "ftp" "mailto")) + (concat type ":" raw-path)) + ((and (string= type "file") (file-name-absolute-p raw-path)) + (concat "file:" raw-path)) + (t raw-path))) + ;; Convert & to & for correct XML representation + (path (replace-regexp-in-string "&" "&" path)) + protocol) + (cond + ;; Image file. + ((and (not desc) (org-export-inline-image-p + link org-odt-inline-image-rules)) + (org-odt-link--inline-image link info)) + ;; Formula file. + ((and (not desc) (org-export-inline-image-p + link org-odt-inline-formula-rules)) + (org-odt-link--inline-formula link info)) + ;; Radio target: Transcode target's contents and use them as + ;; link's description. + ((string= type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (if (not destination) desc + (format + "%s" + (org-export-solidify-link-text + (org-element-property :value destination)) + desc)))) + ;; Links pointing to a headline: Find destination and build + ;; appropriate referencing command. + ((member type '("custom-id" "fuzzy" "id")) + (let ((destination (if (string= type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (case (org-element-type destination) + ;; Case 1: Fuzzy link points nowhere. + ('nil + (format "%s" + "Emphasis" + (or desc + (org-export-data (org-element-property :raw-link link) + info)))) + ;; Case 2: Fuzzy link points to a headline. + (headline + ;; If there's a description, create a hyperlink. + ;; Otherwise, try to provide a meaningful description. + (if (not desc) (org-odt-link--infer-description destination info) + (let* ((headline-no + (org-export-get-headline-number destination info)) + (label + (format "sec-%s" + (mapconcat 'number-to-string headline-no "-")))) + (format + "%s" + label desc)))) + ;; Case 3: Fuzzy link points to a target. + (target + ;; If there's a description, create a hyperlink. + ;; Otherwise, try to provide a meaningful description. + (let ((label (org-element-property :value destination))) + (format "%s" + (org-export-solidify-link-text label) + (or desc (org-export-get-ordinal destination info))))) + ;; Case 4: Fuzzy link points to some element (e.g., an + ;; inline image, a math formula or a table). + (otherwise + (let ((label-reference + (ignore-errors (org-odt-format-label + destination info 'reference)))) + (cond ((not label-reference) + (org-odt-link--infer-description destination info)) + ;; LINK has no description. Create + ;; a cross-reference showing entity's sequence + ;; number. + ((not desc) label-reference) + ;; LINK has description. Insert a hyperlink with + ;; user-provided description. + (t + (let ((label (org-element-property :name destination))) + (format "%s" + (org-export-solidify-link-text label) + desc))))))))) + ;; Coderef: replace link with the reference name or the + ;; equivalent line number. + ((string= type "coderef") + (let* ((line-no (format "%d" (org-export-resolve-coderef path info))) + (href (concat "coderef-" path))) + (format + (org-export-get-coderef-format path desc) + (format + "%s" + href line-no)))) + ;; Link type is handled by a special function. + ((functionp (setq protocol (nth 2 (assoc type org-link-protocols)))) + (funcall protocol (org-link-unescape path) desc 'odt)) + ;; External link with a description part. + ((and path desc) + (let ((link-contents (org-element-contents link))) + ;; Check if description is a link to an inline image. + (if (and (not (cdr link-contents)) + (let ((desc-element (car link-contents))) + (and (eq (org-element-type desc-element) 'link) + (org-export-inline-image-p + desc-element org-odt-inline-image-rules)))) + ;; Format link as a clickable image. + (format "\n\n%s\n" + path desc) + ;; Otherwise, format it as a regular link. + (format "%s" + path desc)))) + ;; External link without a description part. + (path + (format "%s" + path path)) + ;; No path, only description. Try to do something useful. + (t (format "%s" + "Emphasis" desc))))) + + +;;;; Paragraph + +(defun org-odt--paragraph-style (paragraph) + "Return style of PARAGRAPH. +Style is a symbol among `quoted', `centered' and nil." + (let ((up paragraph)) + (while (and (setq up (org-element-property :parent up)) + (not (memq (org-element-type up) + '(center-block quote-block section))))) + (case (org-element-type up) + (center-block 'centered) + (quote-block 'quoted)))) + +(defun org-odt--format-paragraph (paragraph contents info default center quote) + "Format paragraph according to given styles. +PARAGRAPH is a paragraph type element. CONTENTS is the +transcoded contents of that paragraph, as a string. INFO is +a plist used as a communication channel. DEFAULT, CENTER and +QUOTE are, respectively, style to use when paragraph belongs to +no special environment, a center block, or a quote block." + (format "\n%s" + (case (org-odt--paragraph-style paragraph) + (quoted quote) + (centered center) + (otherwise default)) + ;; If PARAGRAPH is a leading paragraph in an item that has + ;; a checkbox, splice checkbox and paragraph contents + ;; together. + (concat (let ((parent (org-element-property :parent paragraph))) + (and (eq (org-element-type parent) 'item) + (not (org-export-get-previous-element paragraph info)) + (org-odt--checkbox parent))) + contents))) + +(defun org-odt-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to ODT. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + (org-odt--format-paragraph + paragraph contents info + (or (org-element-property :style paragraph) "Text_20_body") + "OrgCenter" + "Quotations")) + + +;;;; Plain List + +(defun org-odt-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to ODT. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + (format "\n\n%s" + ;; Choose style based on list type. + (case (org-element-property :type plain-list) + (ordered "OrgNumberedList") + (unordered "OrgBulletedList") + (descriptive-1 "OrgDescriptionList") + (descriptive-2 "OrgDescriptionList")) + ;; If top-level list, re-start numbering. Otherwise, + ;; continue numbering. + (format "text:continue-numbering=\"%s\"" + (let* ((parent (org-export-get-parent plain-list))) + (if (and parent (eq (org-element-type parent) 'item)) + "true" "false"))) + contents)) + +;;;; Plain Text + +(defun org-odt--encode-tabs-and-spaces (line) + (replace-regexp-in-string + "\\([\t]\\|\\([ ]+\\)\\)" + (lambda (s) + (cond + ((string= s "\t") "") + (t (let ((n (length s))) + (cond + ((= n 1) " ") + ((> n 1) (concat " " (format "" (1- n)))) + (t "")))))) + line)) + +(defun org-odt--encode-plain-text (text &optional no-whitespace-filling) + (mapc + (lambda (pair) + (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))) + '(("&" . "&") ("<" . "<") (">" . ">"))) + (if no-whitespace-filling text + (org-odt--encode-tabs-and-spaces text))) + +(defun org-odt-plain-text (text info) + "Transcode a TEXT string from Org to ODT. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + (let ((output text)) + ;; Protect &, < and >. + (setq output (org-odt--encode-plain-text output t)) + ;; Handle smart quotes. Be sure to provide original string since + ;; OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output (org-export-activate-smart-quotes output :utf-8 info text))) + ;; Convert special strings. + (when (plist-get info :with-special-strings) + (mapc + (lambda (pair) + (setq output + (replace-regexp-in-string (car pair) (cdr pair) output t nil))) + org-odt-special-string-regexps)) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" "" output t))) + ;; Return value. + output)) + + +;;;; Planning + +(defun org-odt-planning (planning contents info) + "Transcode a PLANNING element from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "\n%s" + "OrgPlanning" + (concat + (let ((closed (org-element-property :closed planning))) + (when closed + (concat + (format "%s" + "OrgClosedKeyword" org-closed-string) + (org-odt-timestamp closed contents info)))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat + (format "%s" + "OrgDeadlineKeyword" org-deadline-string) + (org-odt-timestamp deadline contents info)))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat + (format "%s" + "OrgScheduledKeyword" org-deadline-string) + (org-odt-timestamp scheduled contents info))))))) + + +;;;; Property Drawer + +(defun org-odt-property-drawer (property-drawer contents info) + "Transcode a PROPERTY-DRAWER element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual +information." + ;; The property drawer isn't exported but we want separating blank + ;; lines nonetheless. + "") + + +;;;; Quote Block + +(defun org-odt-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + contents) + + +;;;; Quote Section + +(defun org-odt-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (org-odt-do-format-code value)))) + + +;;;; Section + +(defun org-odt-format-section (text style &optional name) + (let ((default-name (car (org-odt-add-automatic-style "Section")))) + (format "\n\n%s\n" + style + (format "text:name=\"%s\"" (or name default-name)) + text))) + + +(defun org-odt-section (section contents info) ; FIXME + "Transcode a SECTION element from Org to ODT. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + contents) + +;;;; Radio Target + +(defun org-odt-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to ODT. +TEXT is the text of the target. INFO is a plist holding +contextual information." + (org-odt--target + text (org-export-solidify-link-text + (org-element-property :value radio-target)))) + + +;;;; Special Block + +(defun org-odt-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to ODT. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((type (downcase (org-element-property :type special-block))) + (attributes (org-export-read-attribute :attr_odt special-block))) + (cond + ;; Annotation. + ((string= type "annotation") + (let* ((author (or (plist-get attributes :author) + (let ((author (plist-get info :author))) + (and author (org-export-data author info))))) + (date (or (plist-get attributes :date) + ;; FIXME: Is `car' right thing to do below? + (car (plist-get info :date))))) + (format "\n%s" + (format "\n%s\n" + (concat + (and author + (format "%s" author)) + (and date + (format "%s" + (org-odt--format-timestamp date nil 'iso-date))) + contents))))) + ;; Textbox. + ((string= type "textbox") + (let ((width (plist-get attributes :width)) + (height (plist-get attributes :height)) + (style (plist-get attributes :style)) + (extra (plist-get attributes :extra)) + (anchor (plist-get attributes :anchor))) + (format "\n%s" + "Text_20_body" (org-odt--textbox contents width height + style extra anchor)))) + (t contents)))) + + +;;;; Src Block + +(defun org-odt-hfy-face-to-css (fn) + "Create custom style for face FN. +When FN is the default face, use its foreground and background +properties to create \"OrgSrcBlock\" paragraph style. Otherwise +use its color attribute to create a character style whose name +is obtained from FN. Currently all attributes of FN other than +color are ignored. + +The style name for a face FN is derived using the following +operations on the face name in that order - de-dash, CamelCase +and prefix with \"OrgSrc\". For example, +`font-lock-function-name-face' is associated with +\"OrgSrcFontLockFunctionNameFace\"." + (let* ((css-list (hfy-face-to-style fn)) + (style-name (concat "OrgSrc" + (mapconcat + 'capitalize (split-string + (hfy-face-or-def-to-name fn) "-") + ""))) + (color-val (cdr (assoc "color" css-list))) + (background-color-val (cdr (assoc "background" css-list))) + (style (and org-odt-create-custom-styles-for-srcblocks + (cond + ((eq fn 'default) + (format org-odt-src-block-paragraph-format + background-color-val color-val)) + (t + (format + " + + + " style-name color-val)))))) + (cons style-name style))) + +(defun org-odt-htmlfontify-string (line) + (let* ((hfy-html-quote-regex "\\([<\"&> ]\\)") + (hfy-html-quote-map '(("\"" """) + ("<" "<") + ("&" "&") + (">" ">") + (" " "") + (" " ""))) + (hfy-face-to-css 'org-odt-hfy-face-to-css) + (hfy-optimisations-1 (copy-sequence hfy-optimisations)) + (hfy-optimisations (add-to-list 'hfy-optimisations-1 + 'body-text-only)) + (hfy-begin-span-handler + (lambda (style text-block text-id text-begins-block-p) + (insert (format "" style)))) + (hfy-end-span-handler (lambda nil (insert "")))) + (org-no-warnings (htmlfontify-string line)))) + +(defun org-odt-do-format-code + (code &optional lang refs retain-labels num-start) + (let* ((lang (or (assoc-default lang org-src-lang-modes) lang)) + (lang-mode (and lang (intern (format "%s-mode" lang)))) + (code-lines (org-split-string code "\n")) + (code-length (length code-lines)) + (use-htmlfontify-p (and (functionp lang-mode) + org-odt-fontify-srcblocks + (require 'htmlfontify nil t) + (fboundp 'htmlfontify-string))) + (code (if (not use-htmlfontify-p) code + (with-temp-buffer + (insert code) + (funcall lang-mode) + (font-lock-fontify-buffer) + (buffer-string)))) + (fontifier (if use-htmlfontify-p 'org-odt-htmlfontify-string + 'org-odt--encode-plain-text)) + (par-style (if use-htmlfontify-p "OrgSrcBlock" + "OrgFixedWidthBlock")) + (i 0)) + (assert (= code-length (length (org-split-string code "\n")))) + (setq code + (org-export-format-code + code + (lambda (loc line-num ref) + (setq par-style + (concat par-style (and (= (incf i) code-length) "LastLine"))) + + (setq loc (concat loc (and ref retain-labels (format " (%s)" ref)))) + (setq loc (funcall fontifier loc)) + (when ref + (setq loc (org-odt--target loc (concat "coderef-" ref)))) + (assert par-style) + (setq loc (format "\n%s" + par-style loc)) + (if (not line-num) loc + (format "\n%s\n" loc))) + num-start refs)) + (cond + ((not num-start) code) + ((= num-start 0) + (format + "\n%s" + " text:continue-numbering=\"false\"" code)) + (t + (format + "\n%s" + " text:continue-numbering=\"true\"" code))))) + +(defun org-odt-format-code (element info) + (let* ((lang (org-element-property :language element)) + ;; Extract code and references. + (code-info (org-export-unravel-code element)) + (code (car code-info)) + (refs (cdr code-info)) + ;; Does the src block contain labels? + (retain-labels (org-element-property :retain-labels element)) + ;; Does it have line numbers? + (num-start (case (org-element-property :number-lines element) + (continued (org-export-get-loc element info)) + (new 0)))) + (org-odt-do-format-code code lang refs retain-labels num-start))) + +(defun org-odt-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to ODT. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((lang (org-element-property :language src-block)) + (attributes (org-export-read-attribute :attr_odt src-block)) + (captions (org-odt-format-label src-block info 'definition)) + (caption (car captions)) (short-caption (cdr captions))) + (concat + (and caption + (format "\n%s" + "Listing" caption)) + (let ((--src-block (org-odt-format-code src-block info))) + (if (not (plist-get attributes :textbox)) --src-block + (format "\n%s" + "Text_20_body" + (org-odt--textbox --src-block nil nil nil))))))) + + +;;;; Statistics Cookie + +(defun org-odt-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((cookie-value (org-element-property :value statistics-cookie))) + (format "%s" + "OrgCode" cookie-value))) + + +;;;; Strike-Through + +(defun org-odt-strike-through (strike-through contents info) + "Transcode STRIKE-THROUGH from Org to ODT. +CONTENTS is the text with strike-through markup. INFO is a plist +holding contextual information." + (format "%s" + "Strikethrough" contents)) + + +;;;; Subscript + +(defun org-odt-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to ODT. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "%s" + "OrgSubscript" contents)) + + +;;;; Superscript + +(defun org-odt-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to ODT. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "%s" + "OrgSuperscript" contents)) + + +;;;; Table Cell + +(defun org-odt-table-style-spec (element info) + (let* ((table (org-export-get-parent-table element)) + (table-attributes (org-export-read-attribute :attr_odt table)) + (table-style (plist-get table-attributes :style))) + (assoc table-style org-odt-table-styles))) + +(defun org-odt-get-table-cell-styles (table-cell info) + "Retrieve styles applicable to a table cell. +R and C are (zero-based) row and column numbers of the table +cell. STYLE-SPEC is an entry in `org-odt-table-styles' +applicable to the current table. It is `nil' if the table is not +associated with any style attributes. + +Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME). + +When STYLE-SPEC is nil, style the table cell the conventional way +- choose cell borders based on row and column groupings and +choose paragraph alignment based on `org-col-cookies' text +property. See also +`org-odt-get-paragraph-style-cookie-for-table-cell'. + +When STYLE-SPEC is non-nil, ignore the above cookie and return +styles congruent with the ODF-1.2 specification." + (let* ((table-cell-address (org-export-table-cell-address table-cell info)) + (r (car table-cell-address)) (c (cdr table-cell-address)) + (style-spec (org-odt-table-style-spec table-cell info)) + (table-dimensions (org-export-table-dimensions + (org-export-get-parent-table table-cell) + info))) + (when style-spec + ;; LibreOffice - particularly the Writer - honors neither table + ;; templates nor custom table-cell styles. Inorder to retain + ;; inter-operability with LibreOffice, only automatic styles are + ;; used for styling of table-cells. The current implementation is + ;; congruent with ODF-1.2 specification and hence is + ;; future-compatible. + + ;; Additional Note: LibreOffice's AutoFormat facility for tables - + ;; which recognizes as many as 16 different cell types - is much + ;; richer. Unfortunately it is NOT amenable to easy configuration + ;; by hand. + (let* ((template-name (nth 1 style-spec)) + (cell-style-selectors (nth 2 style-spec)) + (cell-type + (cond + ((and (cdr (assoc 'use-first-column-styles cell-style-selectors)) + (= c 0)) "FirstColumn") + ((and (cdr (assoc 'use-last-column-styles cell-style-selectors)) + (= (1+ c) (cdr table-dimensions))) + "LastColumn") + ((and (cdr (assoc 'use-first-row-styles cell-style-selectors)) + (= r 0)) "FirstRow") + ((and (cdr (assoc 'use-last-row-styles cell-style-selectors)) + (= (1+ r) (car table-dimensions))) + "LastRow") + ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) + (= (% r 2) 1)) "EvenRow") + ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) + (= (% r 2) 0)) "OddRow") + ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) + (= (% c 2) 1)) "EvenColumn") + ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) + (= (% c 2) 0)) "OddColumn") + (t "")))) + (concat template-name cell-type))))) + +(defun org-odt-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let* ((table-cell-address (org-export-table-cell-address table-cell info)) + (r (car table-cell-address)) + (c (cdr table-cell-address)) + (horiz-span (or (org-export-table-cell-width table-cell info) 0)) + (table-row (org-export-get-parent table-cell)) + (custom-style-prefix (org-odt-get-table-cell-styles + table-cell info)) + (paragraph-style + (or + (and custom-style-prefix + (format "%sTableParagraph" custom-style-prefix)) + (concat + (cond + ((and (= 1 (org-export-table-row-group table-row info)) + (org-export-table-has-header-p + (org-export-get-parent-table table-row) info)) + "OrgTableHeading") + ((let* ((table (org-export-get-parent-table table-cell)) + (table-attrs (org-export-read-attribute :attr_odt table)) + (table-header-columns + (let ((cols (plist-get table-attrs :header-columns))) + (and cols (read cols))))) + (<= c (cond ((wholenump table-header-columns) + (- table-header-columns 1)) + (table-header-columns 0) + (t -1)))) + "OrgTableHeading") + (t "OrgTableContents")) + (capitalize (symbol-name (org-export-table-cell-alignment + table-cell info)))))) + (cell-style-name + (or + (and custom-style-prefix (format "%sTableCell" + custom-style-prefix)) + (concat + "OrgTblCell" + (when (or (org-export-table-row-starts-rowgroup-p table-row info) + (zerop r)) "T") + (when (org-export-table-row-ends-rowgroup-p table-row info) "B") + (when (and (org-export-table-cell-starts-colgroup-p table-cell info) + (not (zerop c)) ) "L")))) + (cell-attributes + (concat + (format " table:style-name=\"%s\"" cell-style-name) + (and (> horiz-span 0) + (format " table:number-columns-spanned=\"%d\"" + (1+ horiz-span)))))) + (unless contents (setq contents "")) + (concat + (assert paragraph-style) + (format "\n\n%s\n" + cell-attributes + (let ((table-cell-contents (org-element-contents table-cell))) + (if (memq (org-element-type (car table-cell-contents)) + org-element-all-elements) + contents + (format "\n%s" + paragraph-style contents)))) + (let (s) + (dotimes (i horiz-span s) + (setq s (concat s "\n")))) + "\n"))) + + +;;;; Table Row + +(defun org-odt-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to ODT. +CONTENTS is the contents of the row. INFO is a plist used as a +communication channel." + ;; Rules are ignored since table separators are deduced from + ;; borders of the current row. + (when (eq (org-element-property :type table-row) 'standard) + (let* ((rowgroup-tags + (if (and (= 1 (org-export-table-row-group table-row info)) + (org-export-table-has-header-p + (org-export-get-parent-table table-row) info)) + ;; If the row belongs to the first rowgroup and the + ;; table has more than one row groups, then this row + ;; belongs to the header row group. + '("\n" . "\n") + ;; Otherwise, it belongs to non-header row group. + '("\n" . "\n")))) + (concat + ;; Does this row begin a rowgroup? + (when (org-export-table-row-starts-rowgroup-p table-row info) + (car rowgroup-tags)) + ;; Actual table row + (format "\n\n%s\n" contents) + ;; Does this row end a rowgroup? + (when (org-export-table-row-ends-rowgroup-p table-row info) + (cdr rowgroup-tags)))))) + + +;;;; Table + +(defun org-odt-table-first-row-data-cells (table info) + (let ((table-row + (org-element-map table 'table-row + (lambda (row) + (unless (eq (org-element-property :type row) 'rule) row)) + info 'first-match)) + (special-column-p (org-export-table-has-special-column-p table))) + (if (not special-column-p) (org-element-contents table-row) + (cdr (org-element-contents table-row))))) + +(defun org-odt--table (table contents info) + "Transcode a TABLE element from Org to ODT. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (case (org-element-property :type table) + ;; Case 1: table.el doesn't support export to OD format. Strip + ;; such tables from export. + (table.el + (prog1 nil + (message + (concat + "(ox-odt): Found table.el-type table in the source Org file." + " table.el doesn't support export to ODT format." + " Stripping the table from export.")))) + ;; Case 2: Native Org tables. + (otherwise + (let* ((captions (org-odt-format-label table info 'definition)) + (caption (car captions)) (short-caption (cdr captions)) + (attributes (org-export-read-attribute :attr_odt table)) + (custom-table-style (nth 1 (org-odt-table-style-spec table info))) + (table-column-specs + (function + (lambda (table info) + (let* ((table-style (or custom-table-style "OrgTable")) + (column-style (format "%sColumn" table-style))) + (mapconcat + (lambda (table-cell) + (let ((width (1+ (or (org-export-table-cell-width + table-cell info) 0))) + (s (format + "\n" + column-style)) + out) + (dotimes (i width out) (setq out (concat s out))))) + (org-odt-table-first-row-data-cells table info) "\n")))))) + (concat + ;; caption. + (when caption + (format "\n%s" + "Table" caption)) + ;; begin table. + (let* ((automatic-name + (org-odt-add-automatic-style "Table" attributes))) + (format + "\n" + (or custom-table-style (cdr automatic-name) "OrgTable") + (concat (when short-caption + (format " table:name=\"%s\"" short-caption))))) + ;; column specification. + (funcall table-column-specs table info) + ;; actual contents. + "\n" contents + ;; end table. + ""))))) + +(defun org-odt-table (table contents info) + "Transcode a TABLE element from Org to ODT. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information. + +Use `org-odt--table' to typeset the table. Handle details +pertaining to indentation here." + (let* ((--element-preceded-by-table-p + (function + (lambda (element info) + (loop for el in (org-export-get-previous-element element info t) + thereis (eq (org-element-type el) 'table))))) + (--walk-list-genealogy-and-collect-tags + (function + (lambda (table info) + (let* ((genealogy (org-export-get-genealogy table)) + (list-genealogy + (when (eq (org-element-type (car genealogy)) 'item) + (loop for el in genealogy + when (memq (org-element-type el) + '(item plain-list)) + collect el))) + (llh-genealogy + (apply 'nconc + (loop for el in genealogy + when (and (eq (org-element-type el) 'headline) + (org-export-low-level-p el info)) + collect + (list el + (assq 'headline + (org-element-contents + (org-export-get-parent el))))))) + parent-list) + (nconc + ;; Handle list genealogy. + (loop for el in list-genealogy collect + (case (org-element-type el) + (plain-list + (setq parent-list el) + (cons "" + (format "\n" + (case (org-element-property :type el) + (ordered "OrgNumberedList") + (unordered "OrgBulletedList") + (descriptive-1 "OrgDescriptionList") + (descriptive-2 "OrgDescriptionList")) + "text:continue-numbering=\"true\""))) + (item + (cond + ((not parent-list) + (if (funcall --element-preceded-by-table-p table info) + '("" . "") + '("" . ""))) + ((funcall --element-preceded-by-table-p + parent-list info) + '("" . "")) + (t '("" . "")))))) + ;; Handle low-level headlines. + (loop for el in llh-genealogy + with step = 'item collect + (case step + (plain-list + (setq step 'item) ; Flip-flop + (setq parent-list el) + (cons "" + (format "\n" + (if (org-export-numbered-headline-p + el info) + "OrgNumberedList" + "OrgBulletedList") + "text:continue-numbering=\"true\""))) + (item + (setq step 'plain-list) ; Flip-flop + (cond + ((not parent-list) + (if (funcall --element-preceded-by-table-p table info) + '("" . "") + '("" . ""))) + ((let ((section? (org-export-get-previous-element + parent-list info))) + (and section? + (eq (org-element-type section?) 'section) + (assq 'table (org-element-contents section?)))) + '("" . "")) + (t + '("" . ""))))))))))) + (close-open-tags (funcall --walk-list-genealogy-and-collect-tags + table info))) + ;; OpenDocument schema does not permit table to occur within a + ;; list item. + + ;; One solution - the easiest and lightweight, in terms of + ;; implementation - is to put the table in an indented text box + ;; and make the text box part of the list-item. Unfortunately if + ;; the table is big and spans multiple pages, the text box could + ;; overflow. In this case, the following attribute will come + ;; handy. + + ;; ,---- From OpenDocument-v1.1.pdf + ;; | 15.27.28 Overflow behavior + ;; | + ;; | For text boxes contained within text document, the + ;; | style:overflow-behavior property specifies the behavior of text + ;; | boxes where the containing text does not fit into the text + ;; | box. + ;; | + ;; | If the attribute's value is clip, the text that does not fit + ;; | into the text box is not displayed. + ;; | + ;; | If the attribute value is auto-create-new-frame, a new frame + ;; | will be created on the next page, with the same position and + ;; | dimensions of the original frame. + ;; | + ;; | If the style:overflow-behavior property's value is + ;; | auto-create-new-frame and the text box has a minimum width or + ;; | height specified, then the text box will grow until the page + ;; | bounds are reached before a new frame is created. + ;; `---- + + ;; Unfortunately, LibreOffice-3.4.6 doesn't honor + ;; auto-create-new-frame property and always resorts to clipping + ;; the text box. This results in table being truncated. + + ;; So we solve the problem the hard (and fun) way using list + ;; continuations. + + ;; The problem only becomes more interesting if you take in to + ;; account the following facts: + ;; + ;; - Description lists are simulated as plain lists. + ;; - Low-level headlines can be listified. + ;; - In Org-mode, a table can occur not only as a regular list + ;; item, but also within description lists and low-level + ;; headlines. + + ;; See `org-odt-translate-description-lists' and + ;; `org-odt-translate-low-level-headlines' for how this is + ;; tackled. + + (concat "\n" + ;; Discontinue the list. + (mapconcat 'car close-open-tags "\n") + ;; Put the table in an indented section. + (let* ((table (org-odt--table table contents info)) + (level (/ (length (mapcar 'car close-open-tags)) 2)) + (style (format "OrgIndentedSection-Level-%d" level))) + (when table (org-odt-format-section table style))) + ;; Continue the list. + (mapconcat 'cdr (nreverse close-open-tags) "\n")))) + + +;;;; Target + +(defun org-odt-target (target contents info) + "Transcode a TARGET object from Org to ODT. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((value (org-element-property :value target))) + (org-odt--target "" (org-export-solidify-link-text value)))) + + +;;;; Timestamp + +(defun org-odt-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (let* ((raw-value (org-element-property :raw-value timestamp)) + (type (org-element-property :type timestamp))) + (if (not org-odt-use-date-fields) + (let ((value (org-odt-plain-text + (org-timestamp-translate timestamp) info))) + (case (org-element-property :type timestamp) + ((active active-range) + (format "%s" + "OrgActiveTimestamp" value)) + ((inactive inactive-range) + (format "%s" + "OrgInactiveTimestamp" value)) + (otherwise value))) + (case type + (active + (format "%s" + "OrgActiveTimestamp" + (format "<%s>" (org-odt--format-timestamp timestamp)))) + (inactive + (format "%s" + "OrgInactiveTimestamp" + (format "[%s]" (org-odt--format-timestamp timestamp)))) + (active-range + (format "%s" + "OrgActiveTimestamp" + (format "<%s>–<%s>" + (org-odt--format-timestamp timestamp) + (org-odt--format-timestamp timestamp 'end)))) + (inactive-range + (format "%s" + "OrgInactiveTimestamp" + (format "[%s]–[%s]" + (org-odt--format-timestamp timestamp) + (org-odt--format-timestamp timestamp 'end)))) + (otherwise + (format "%s" + "OrgDiaryTimestamp" + (org-odt-plain-text (org-timestamp-translate timestamp) + info))))))) + + +;;;; Underline + +(defun org-odt-underline (underline contents info) + "Transcode UNDERLINE from Org to ODT. +CONTENTS is the text with underline markup. INFO is a plist +holding contextual information." + (format "%s" + "Underline" contents)) + + +;;;; Verbatim + +(defun org-odt-verbatim (verbatim contents info) + "Transcode a VERBATIM object from Org to ODT. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (format "%s" + "OrgCode" (org-odt--encode-plain-text + (org-element-property :value verbatim)))) + + +;;;; Verse Block + +(defun org-odt-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to ODT. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + ;; Add line breaks to each line of verse. + (setq contents (replace-regexp-in-string + "\\(\\)?[ \t]*\n" + "" contents)) + ;; Replace tabs and spaces. + (setq contents (org-odt--encode-tabs-and-spaces contents)) + ;; Surround it in a verse environment. + (format "\n%s" + "OrgVerse" contents)) + + + +;;; Filters + +;;;; LaTeX fragments + +(defun org-odt--translate-latex-fragments (tree backend info) + (let ((processing-type (plist-get info :with-latex)) + (count 0)) + ;; Normalize processing-type to one of dvipng, mathml or verbatim. + ;; If the desired converter is not available, force verbatim + ;; processing. + (case processing-type + ((t mathml) + (if (and (fboundp 'org-format-latex-mathml-available-p) + (org-format-latex-mathml-available-p)) + (setq processing-type 'mathml) + (message "LaTeX to MathML converter not available.") + (setq processing-type 'verbatim))) + ((dvipng imagemagick) + (unless (and (org-check-external-command "latex" "" t) + (org-check-external-command + (if (eq processing-type 'dvipng) "dvipng" "convert") "" t)) + (message "LaTeX to PNG converter not available.") + (setq processing-type 'verbatim))) + (otherwise + (message "Unknown LaTeX option. Forcing verbatim.") + (setq processing-type 'verbatim))) + + ;; Store normalized value for later use. + (when (plist-get info :with-latex) + (plist-put info :with-latex processing-type)) + (message "Formatting LaTeX using %s" processing-type) + + ;; Convert `latex-fragment's and `latex-environment's. + (when (memq processing-type '(mathml dvipng imagemagick)) + (org-element-map tree '(latex-fragment latex-environment) + (lambda (latex-*) + (incf count) + (let* ((latex-frag (org-element-property :value latex-*)) + (input-file (plist-get info :input-file)) + (cache-dir (file-name-directory input-file)) + (cache-subdir (concat + (case processing-type + ((dvipng imagemagick) "ltxpng/") + (mathml "ltxmathml/")) + (file-name-sans-extension + (file-name-nondirectory input-file)))) + (display-msg + (case processing-type + ((dvipng imagemagick) (format "Creating LaTeX Image %d..." count)) + (mathml (format "Creating MathML snippet %d..." count)))) + ;; Get an Org-style link to PNG image or the MathML + ;; file. + (org-link + (let ((link (with-temp-buffer + (insert latex-frag) + (org-format-latex cache-subdir cache-dir + nil display-msg + nil nil processing-type) + (buffer-substring-no-properties + (point-min) (point-max))))) + (if (not (string-match "file:\\([^]]*\\)" link)) + (prog1 nil (message "LaTeX Conversion failed.")) + link)))) + (when org-link + ;; Conversion succeeded. Parse above Org-style link to a + ;; `link' object. + (let* ((link (car (org-element-map (with-temp-buffer + (org-mode) + (insert org-link) + (org-element-parse-buffer)) + 'link 'identity)))) + ;; Orphan the link. + (org-element-put-property link :parent nil) + (let* ( + (replacement + (case (org-element-type latex-*) + ;; Case 1: LaTeX environment. + ;; Mimic a "standalone image or formula" by + ;; enclosing the `link' in a `paragraph'. + ;; Copy over original attributes, captions to + ;; the enclosing paragraph. + (latex-environment + (org-element-adopt-elements + (list 'paragraph + (list :style "OrgFormula" + :name (org-element-property :name + latex-*) + :caption (org-element-property :caption + latex-*))) + link)) + ;; Case 2: LaTeX fragment. + ;; No special action. + (latex-fragment link)))) + ;; Note down the object that link replaces. + (org-element-put-property replacement :replaces + (list (org-element-type latex-*) + (list :value latex-frag))) + ;; Replace now. + (org-element-set-element latex-* replacement)))))) + info))) + tree) + + +;;;; Description lists + +;; This translator is necessary to handle indented tables in a uniform +;; manner. See comment in `org-odt--table'. + +(defun org-odt--translate-description-lists (tree backend info) + ;; OpenDocument has no notion of a description list. So simulate it + ;; using plain lists. Description lists in the exported document + ;; are typeset in the same manner as they are in a typical HTML + ;; document. + ;; + ;; Specifically, a description list like this: + ;; + ;; ,---- + ;; | - term-1 :: definition-1 + ;; | - term-2 :: definition-2 + ;; `---- + ;; + ;; gets translated in to the following form: + ;; + ;; ,---- + ;; | - term-1 + ;; | - definition-1 + ;; | - term-2 + ;; | - definition-2 + ;; `---- + ;; + ;; Further effect is achieved by fixing the OD styles as below: + ;; + ;; 1. Set the :type property of the simulated lists to + ;; `descriptive-1' and `descriptive-2'. Map these to list-styles + ;; that has *no* bullets whatsoever. + ;; + ;; 2. The paragraph containing the definition term is styled to be + ;; in bold. + ;; + (org-element-map tree 'plain-list + (lambda (el) + (when (equal (org-element-property :type el) 'descriptive) + (org-element-set-element + el + (apply 'org-element-adopt-elements + (list 'plain-list (list :type 'descriptive-1)) + (mapcar + (lambda (item) + (org-element-adopt-elements + (list 'item (list :checkbox (org-element-property + :checkbox item))) + (list 'paragraph (list :style "Text_20_body_20_bold") + (or (org-element-property :tag item) "(no term)")) + (org-element-adopt-elements + (list 'plain-list (list :type 'descriptive-2)) + (apply 'org-element-adopt-elements + (list 'item nil) + (org-element-contents item))))) + (org-element-contents el))))) + nil) + info) + tree) + +;;;; List tables + +;; Lists that are marked with attribute `:list-table' are called as +;; list tables. They will be rendered as a table within the exported +;; document. + +;; Consider an example. The following list table +;; +;; #+attr_odt :list-table t +;; - Row 1 +;; - 1.1 +;; - 1.2 +;; - 1.3 +;; - Row 2 +;; - 2.1 +;; - 2.2 +;; - 2.3 +;; +;; will be exported as though it were an Org table like the one show +;; below. +;; +;; | Row 1 | 1.1 | 1.2 | 1.3 | +;; | Row 2 | 2.1 | 2.2 | 2.3 | +;; +;; Note that org-tables are NOT multi-line and each line is mapped to +;; a unique row in the exported document. So if an exported table +;; needs to contain a single paragraph (with copious text) it needs to +;; be typed up in a single line. Editing such long lines using the +;; table editor will be a cumbersome task. Furthermore inclusion of +;; multi-paragraph text in a table cell is well-nigh impossible. +;; +;; A LIST-TABLE circumvents above problems. +;; +;; Note that in the example above the list items could be paragraphs +;; themselves and the list can be arbitrarily deep. +;; +;; Inspired by following thread: +;; https://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01101.html + +;; Translate lists to tables + +(defun org-odt--translate-list-tables (tree backend info) + (org-element-map tree 'plain-list + (lambda (l1-list) + (when (org-export-read-attribute :attr_odt l1-list :list-table) + ;; Replace list with table. + (org-element-set-element + l1-list + ;; Build replacement table. + (apply 'org-element-adopt-elements + (list 'table '(:type org :attr_odt (":style \"GriddedTable\""))) + (org-element-map l1-list 'item + (lambda (l1-item) + (let* ((l1-item-contents (org-element-contents l1-item)) + l1-item-leading-text l2-list) + ;; Remove Level-2 list from the Level-item. It + ;; will be subsequently attached as table-cells. + (let ((cur l1-item-contents) prev) + (while (and cur (not (eq (org-element-type (car cur)) + 'plain-list))) + (setq prev cur) + (setq cur (cdr cur))) + (when prev + (setcdr prev nil) + (setq l2-list (car cur))) + (setq l1-item-leading-text l1-item-contents)) + ;; Level-1 items start a table row. + (apply 'org-element-adopt-elements + (list 'table-row (list :type 'standard)) + ;; Leading text of level-1 item define + ;; the first table-cell. + (apply 'org-element-adopt-elements + (list 'table-cell nil) + l1-item-leading-text) + ;; Level-2 items define subsequent + ;; table-cells of the row. + (org-element-map l2-list 'item + (lambda (l2-item) + (apply 'org-element-adopt-elements + (list 'table-cell nil) + (org-element-contents l2-item))) + info nil 'item)))) + info nil 'item)))) + nil) + info) + tree) + + +;;; Interactive functions + +(defun org-odt-create-manifest-file-entry (&rest args) + (push args org-odt-manifest-file-entries)) + +(defun org-odt-write-manifest-file () + (make-directory (concat org-odt-zip-dir "META-INF")) + (let ((manifest-file (concat org-odt-zip-dir "META-INF/manifest.xml"))) + (with-current-buffer + (let ((nxml-auto-insert-xml-declaration-flag nil)) + (find-file-noselect manifest-file t)) + (insert + " + \n") + (mapc + (lambda (file-entry) + (let* ((version (nth 2 file-entry)) + (extra (if (not version) "" + (format " manifest:version=\"%s\"" version)))) + (insert + (format org-odt-manifest-file-entry-tag + (nth 0 file-entry) (nth 1 file-entry) extra)))) + org-odt-manifest-file-entries) + (insert "\n")))) + +(defmacro org-odt--export-wrap (out-file &rest body) + `(let* ((--out-file ,out-file) + (out-file-type (file-name-extension --out-file)) + (org-odt-xml-files '("META-INF/manifest.xml" "content.xml" + "meta.xml" "styles.xml")) + ;; Initialize temporary workarea. All files that end up in + ;; the exported document get parked/created here. + (org-odt-zip-dir (file-name-as-directory + (make-temp-file (format "%s-" out-file-type) t))) + (org-odt-manifest-file-entries nil) + (--cleanup-xml-buffers + (function + (lambda nil + ;; Kill all XML buffers. + (mapc (lambda (file) + (let ((buf (find-buffer-visiting + (concat org-odt-zip-dir file)))) + (when buf + (with-current-buffer buf + (set-buffer-modified-p nil) + (kill-buffer buf))))) + org-odt-xml-files) + ;; Delete temporary directory and also other embedded + ;; files that get copied there. + (delete-directory org-odt-zip-dir t))))) + (condition-case err + (progn + (unless (executable-find "zip") + ;; Not at all OSes ship with zip by default + (error "Executable \"zip\" needed for creating OpenDocument files")) + ;; Do export. This creates a bunch of xml files ready to be + ;; saved and zipped. + (progn ,@body) + ;; Create a manifest entry for content.xml. + (org-odt-create-manifest-file-entry "text/xml" "content.xml") + ;; Write mimetype file + (let* ((mimetypes + '(("odt" . "application/vnd.oasis.opendocument.text") + ("odf" . "application/vnd.oasis.opendocument.formula"))) + (mimetype (cdr (assoc-string out-file-type mimetypes t)))) + (unless mimetype + (error "Unknown OpenDocument backend %S" out-file-type)) + (write-region mimetype nil (concat org-odt-zip-dir "mimetype")) + (org-odt-create-manifest-file-entry mimetype "/" "1.2")) + ;; Write out the manifest entries before zipping + (org-odt-write-manifest-file) + ;; Save all XML files. + (mapc (lambda (file) + (let ((buf (find-buffer-visiting + (concat org-odt-zip-dir file)))) + (when buf + (with-current-buffer buf + ;; Prettify output if needed. + (when org-odt-prettify-xml + (indent-region (point-min) (point-max))) + (save-buffer 0))))) + org-odt-xml-files) + ;; Run zip. + (let* ((target --out-file) + (target-name (file-name-nondirectory target)) + (cmds `(("zip" "-mX0" ,target-name "mimetype") + ("zip" "-rmTq" ,target-name ".")))) + ;; If a file with same name as the desired output file + ;; exists, remove it. + (when (file-exists-p target) + (delete-file target)) + ;; Zip up the xml files. + (let ((coding-system-for-write 'no-conversion) exitcode err-string) + (message "Creating ODT file...") + ;; Switch temporarily to content.xml. This way Zip + ;; process will inherit `org-odt-zip-dir' as the current + ;; directory. + (with-current-buffer + (find-file-noselect (concat org-odt-zip-dir "content.xml") t) + (mapc + (lambda (cmd) + (message "Running %s" (mapconcat 'identity cmd " ")) + (setq err-string + (with-output-to-string + (setq exitcode + (apply 'call-process (car cmd) + nil standard-output nil (cdr cmd))))) + (or (zerop exitcode) + (error (concat "Unable to create OpenDocument file." + (format " Zip failed with error (%s)" + err-string))))) + cmds))) + ;; Move the zip file from temporary work directory to + ;; user-mandated location. + (rename-file (concat org-odt-zip-dir target-name) target) + (message "Created %s" (expand-file-name target)) + ;; Cleanup work directory and work files. + (funcall --cleanup-xml-buffers) + ;; Open the OpenDocument file in archive-mode for + ;; examination. + (find-file-noselect target t) + ;; Return exported file. + (cond + ;; Case 1: Conversion desired on exported file. Run the + ;; converter on the OpenDocument file. Return the + ;; converted file. + (org-odt-preferred-output-format + (or (org-odt-convert target org-odt-preferred-output-format) + target)) + ;; Case 2: No further conversion. Return exported + ;; OpenDocument file. + (t target)))) + (error + ;; Cleanup work directory and work files. + (funcall --cleanup-xml-buffers) + (message "OpenDocument export failed: %s" + (error-message-string err)))))) + + +;;;; Export to OpenDocument formula + +;;;###autoload +(defun org-odt-export-as-odf (latex-frag &optional odf-file) + "Export LATEX-FRAG as OpenDocument formula file ODF-FILE. +Use `org-create-math-formula' to convert LATEX-FRAG first to +MathML. When invoked as an interactive command, use +`org-latex-regexps' to infer LATEX-FRAG from currently active +region. If no LaTeX fragments are found, prompt for it. Push +MathML source to kill ring depending on the value of +`org-export-copy-to-kill-ring'." + (interactive + `(,(let (frag) + (setq frag (and (setq frag (and (region-active-p) + (buffer-substring (region-beginning) + (region-end)))) + (loop for e in org-latex-regexps + thereis (when (string-match (nth 1 e) frag) + (match-string (nth 2 e) frag))))) + (read-string "LaTeX Fragment: " frag nil frag)) + ,(let ((odf-filename (expand-file-name + (concat + (file-name-sans-extension + (or (file-name-nondirectory buffer-file-name))) + "." "odf") + (file-name-directory buffer-file-name)))) + (read-file-name "ODF filename: " nil odf-filename nil + (file-name-nondirectory odf-filename))))) + (let ((filename (or odf-file + (expand-file-name + (concat + (file-name-sans-extension + (or (file-name-nondirectory buffer-file-name))) + "." "odf") + (file-name-directory buffer-file-name))))) + (org-odt--export-wrap + filename + (let* ((buffer (progn + (require 'nxml-mode) + (let ((nxml-auto-insert-xml-declaration-flag nil)) + (find-file-noselect (concat org-odt-zip-dir + "content.xml") t)))) + (coding-system-for-write 'utf-8) + (save-buffer-coding-system 'utf-8)) + (set-buffer buffer) + (set-buffer-file-coding-system coding-system-for-write) + (let ((mathml (org-create-math-formula latex-frag))) + (unless mathml (error "No Math formula created")) + (insert mathml) + ;; Add MathML to kill ring, if needed. + (when (org-export--copy-to-kill-ring-p) + (org-kill-new (buffer-string)))))))) + +;;;###autoload +(defun org-odt-export-as-odf-and-open () + "Export LaTeX fragment as OpenDocument formula and immediately open it. +Use `org-odt-export-as-odf' to read LaTeX fragment and OpenDocument +formula file." + (interactive) + (org-open-file (call-interactively 'org-odt-export-as-odf) 'system)) + + +;;;; Export to OpenDocument Text + +;;;###autoload +(defun org-odt-export-to-odt (&optional async subtreep visible-only ext-plist) + "Export current buffer to a ODT file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".odt" subtreep))) + (if async + (org-export-async-start (lambda (f) (org-export-add-to-stack f 'odt)) + `(expand-file-name + (org-odt--export-wrap + ,outfile + (let* ((org-odt-embedded-images-count 0) + (org-odt-embedded-formulas-count 0) + (org-odt-automatic-styles nil) + (org-odt-object-counters nil) + ;; Let `htmlfontify' know that we are interested in + ;; collecting styles. + (hfy-user-sheet-assoc nil)) + ;; Initialize content.xml and kick-off the export + ;; process. + (let ((out-buf + (progn + (require 'nxml-mode) + (let ((nxml-auto-insert-xml-declaration-flag nil)) + (find-file-noselect + (concat org-odt-zip-dir "content.xml") t)))) + (output (org-export-as + 'odt ,subtreep ,visible-only nil ,ext-plist))) + (with-current-buffer out-buf + (erase-buffer) + (insert output))))))) + (org-odt--export-wrap + outfile + (let* ((org-odt-embedded-images-count 0) + (org-odt-embedded-formulas-count 0) + (org-odt-automatic-styles nil) + (org-odt-object-counters nil) + ;; Let `htmlfontify' know that we are interested in collecting + ;; styles. + (hfy-user-sheet-assoc nil)) + ;; Initialize content.xml and kick-off the export process. + (let ((output (org-export-as 'odt subtreep visible-only nil ext-plist)) + (out-buf (progn + (require 'nxml-mode) + (let ((nxml-auto-insert-xml-declaration-flag nil)) + (find-file-noselect + (concat org-odt-zip-dir "content.xml") t))))) + (with-current-buffer out-buf (erase-buffer) (insert output)))))))) + + +;;;; Convert between OpenDocument and other formats + +(defun org-odt-reachable-p (in-fmt out-fmt) + "Return non-nil if IN-FMT can be converted to OUT-FMT." + (catch 'done + (let ((reachable-formats (org-odt-do-reachable-formats in-fmt))) + (dolist (e reachable-formats) + (let ((out-fmt-spec (assoc out-fmt (cdr e)))) + (when out-fmt-spec + (throw 'done (cons (car e) out-fmt-spec)))))))) + +(defun org-odt-do-convert (in-file out-fmt &optional prefix-arg) + "Workhorse routine for `org-odt-convert'." + (require 'browse-url) + (let* ((in-file (expand-file-name (or in-file buffer-file-name))) + (dummy (or (file-readable-p in-file) + (error "Cannot read %s" in-file))) + (in-fmt (file-name-extension in-file)) + (out-fmt (or out-fmt (error "Output format unspecified"))) + (how (or (org-odt-reachable-p in-fmt out-fmt) + (error "Cannot convert from %s format to %s format?" + in-fmt out-fmt))) + (convert-process (car how)) + (out-file (concat (file-name-sans-extension in-file) "." + (nth 1 (or (cdr how) out-fmt)))) + (extra-options (or (nth 2 (cdr how)) "")) + (out-dir (file-name-directory in-file)) + (cmd (format-spec convert-process + `((?i . ,(shell-quote-argument in-file)) + (?I . ,(browse-url-file-url in-file)) + (?f . ,out-fmt) + (?o . ,out-file) + (?O . ,(browse-url-file-url out-file)) + (?d . , (shell-quote-argument out-dir)) + (?D . ,(browse-url-file-url out-dir)) + (?x . ,extra-options))))) + (when (file-exists-p out-file) + (delete-file out-file)) + + (message "Executing %s" cmd) + (let ((cmd-output (shell-command-to-string cmd))) + (message "%s" cmd-output)) + + (cond + ((file-exists-p out-file) + (message "Exported to %s" out-file) + (when prefix-arg + (message "Opening %s..." out-file) + (org-open-file out-file 'system)) + out-file) + (t + (message "Export to %s failed" out-file) + nil)))) + +(defun org-odt-do-reachable-formats (in-fmt) + "Return verbose info about formats to which IN-FMT can be converted. +Return a list where each element is of the +form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See +`org-odt-convert-processes' for CONVERTER-PROCESS and see +`org-odt-convert-capabilities' for OUTPUT-FMT-ALIST." + (let* ((converter + (and org-odt-convert-process + (cadr (assoc-string org-odt-convert-process + org-odt-convert-processes t)))) + (capabilities + (and org-odt-convert-process + (cadr (assoc-string org-odt-convert-process + org-odt-convert-processes t)) + org-odt-convert-capabilities)) + reachable-formats) + (when converter + (dolist (c capabilities) + (when (member in-fmt (nth 1 c)) + (push (cons converter (nth 2 c)) reachable-formats)))) + reachable-formats)) + +(defun org-odt-reachable-formats (in-fmt) + "Return list of formats to which IN-FMT can be converted. +The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)." + (let (l) + (mapc (lambda (e) (add-to-list 'l e)) + (apply 'append (mapcar + (lambda (e) (mapcar 'car (cdr e))) + (org-odt-do-reachable-formats in-fmt)))) + l)) + +(defun org-odt-convert-read-params () + "Return IN-FILE and OUT-FMT params for `org-odt-do-convert'. +This is a helper routine for interactive use." + (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read)) + (in-file (read-file-name "File to be converted: " + nil buffer-file-name t)) + (in-fmt (file-name-extension in-file)) + (out-fmt-choices (org-odt-reachable-formats in-fmt)) + (out-fmt + (or (and out-fmt-choices + (funcall input "Output format: " + out-fmt-choices nil nil nil)) + (error + "No known converter or no known output formats for %s files" + in-fmt)))) + (list in-file out-fmt))) + +;;;###autoload +(defun org-odt-convert (&optional in-file out-fmt prefix-arg) + "Convert IN-FILE to format OUT-FMT using a command line converter. +IN-FILE is the file to be converted. If unspecified, it defaults +to variable `buffer-file-name'. OUT-FMT is the desired output +format. Use `org-odt-convert-process' as the converter. +If PREFIX-ARG is non-nil then the newly converted file is opened +using `org-open-file'." + (interactive + (append (org-odt-convert-read-params) current-prefix-arg)) + (org-odt-do-convert in-file out-fmt prefix-arg)) + +;;; Library Initializations + +(mapc + (lambda (desc) + ;; Let Emacs open all OpenDocument files in archive mode + (add-to-list 'auto-mode-alist + (cons (concat "\\." (car desc) "\\'") 'archive-mode))) + org-odt-file-extensions) + +(provide 'ox-odt) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-odt.el ends here diff --git a/elpa/org-20150427/ox-org.el b/elpa/org-20150427/ox-org.el new file mode 100644 index 00000000..195b9d76 --- /dev/null +++ b/elpa/org-20150427/ox-org.el @@ -0,0 +1,281 @@ +;;; ox-org.el --- Org Back-End for Org Export Engine + +;; Copyright (C) 2013-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: org, wp + +;; 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 . + +;;; Commentary: + +;;; Code: + +(require 'ox) +(declare-function htmlize-buffer "htmlize" (&optional buffer)) + +(defgroup org-export-org nil + "Options for exporting Org mode files to Org." + :tag "Org Export Org" + :group 'org-export + :version "24.4" + :package-version '(Org . "8.0")) + +(define-obsolete-variable-alias + 'org-export-htmlized-org-css-url 'org-org-htmlized-css-url "24.4") +(defcustom org-org-htmlized-css-url nil + "URL pointing to the CSS defining colors for htmlized Emacs buffers. +Normally when creating an htmlized version of an Org buffer, +htmlize will create the CSS to define the font colors. However, +this does not work when converting in batch mode, and it also can +look bad if different people with different fontification setup +work on the same website. When this variable is non-nil, +creating an htmlized version of an Org buffer using +`org-org-export-as-org' will include a link to this URL if the +setting of `org-html-htmlize-output-type' is 'css." + :group 'org-export-org + :type '(choice + (const :tag "Don't include external stylesheet link" nil) + (string :tag "URL or local href"))) + +(org-export-define-backend 'org + '((babel-call . org-org-identity) + (bold . org-org-identity) + (center-block . org-org-identity) + (clock . org-org-identity) + (code . org-org-identity) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (diary-sexp . org-org-identity) + (drawer . org-org-identity) + (dynamic-block . org-org-identity) + (entity . org-org-identity) + (example-block . org-org-identity) + (fixed-width . org-org-identity) + (footnote-definition . ignore) + (footnote-reference . org-org-identity) + (headline . org-org-headline) + (horizontal-rule . org-org-identity) + (inline-babel-call . org-org-identity) + (inline-src-block . org-org-identity) + (inlinetask . org-org-identity) + (italic . org-org-identity) + (item . org-org-identity) + (keyword . org-org-keyword) + (latex-environment . org-org-identity) + (latex-fragment . org-org-identity) + (line-break . org-org-identity) + (link . org-org-identity) + (node-property . org-org-identity) + (paragraph . org-org-identity) + (plain-list . org-org-identity) + (planning . org-org-identity) + (property-drawer . org-org-identity) + (quote-block . org-org-identity) + (quote-section . org-org-identity) + (radio-target . org-org-identity) + (section . org-org-section) + (special-block . org-org-identity) + (src-block . org-org-identity) + (statistics-cookie . org-org-identity) + (strike-through . org-org-identity) + (subscript . org-org-identity) + (superscript . org-org-identity) + (table . org-org-identity) + (table-cell . org-org-identity) + (table-row . org-org-identity) + (target . org-org-identity) + (timestamp . org-org-identity) + (underline . org-org-identity) + (verbatim . org-org-identity) + (verse-block . org-org-identity)) + :menu-entry + '(?O "Export to Org" + ((?O "As Org buffer" org-org-export-as-org) + (?o "As Org file" org-org-export-to-org) + (?v "As Org file and open" + (lambda (a s v b) + (if a (org-org-export-to-org t s v b) + (org-open-file (org-org-export-to-org nil s v b)))))))) + +(defun org-org-identity (blob contents info) + "Transcode BLOB element or object back into Org syntax. +CONTENTS is its contents, as a string or nil. INFO is ignored." + (let ((case-fold-search t)) + (replace-regexp-in-string + "^[ \t]*#\\+ATTR_[-_A-Za-z0-9]+:\\(?: .*\\)?\n" "" + (org-export-expand blob contents t)))) + +(defun org-org-headline (headline contents info) + "Transcode HEADLINE element back into Org syntax. +CONTENTS is its contents, as a string or nil. INFO is ignored." + (unless (org-element-property :footnote-section-p headline) + (unless (plist-get info :with-todo-keywords) + (org-element-put-property headline :todo-keyword nil)) + (unless (plist-get info :with-tags) + (org-element-put-property headline :tags nil)) + (unless (plist-get info :with-priority) + (org-element-put-property headline :priority nil)) + (org-element-put-property headline :level + (org-export-get-relative-level headline info)) + (org-element-headline-interpreter headline contents))) + +(defun org-org-keyword (keyword contents info) + "Transcode KEYWORD element back into Org syntax. +CONTENTS is nil. INFO is ignored. This function ignores +keywords targeted at other export back-ends." + (unless (member (org-element-property :key keyword) + (mapcar + (lambda (block-cons) + (and (eq (cdr block-cons) 'org-element-export-block-parser) + (car block-cons))) + org-element-block-name-alist)) + (org-element-keyword-interpreter keyword nil))) + +(defun org-org-section (section contents info) + "Transcode SECTION element back into Org syntax. +CONTENTS is the contents of the section. INFO is a plist used as +a communication channel." + (concat + (org-element-normalize-string contents) + ;; Insert footnote definitions appearing for the first time in this + ;; section. Indeed, some of them may not be available to narrowing + ;; so we make sure all of them are included in the result. + (let ((footnotes-alist + (org-element-map section 'footnote-reference + (lambda (fn) + (and (eq (org-element-property :type fn) 'standard) + (org-export-footnote-first-reference-p fn info) + (cons (org-element-property :label fn) + (org-export-get-footnote-definition fn info)))) + info))) + (and footnotes-alist + (concat "\n" + (mapconcat + (lambda (d) + (org-element-normalize-string + (concat (format "[%s] "(car d)) + (org-export-data (cdr d) info)))) + footnotes-alist "\n")))) + (make-string (or (org-element-property :post-blank section) 0) ?\n))) + +;;;###autoload +(defun org-org-export-as-org (&optional async subtreep visible-only ext-plist) + "Export current buffer to an Org buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Export is done in a buffer named \"*Org ORG Export*\", which will +be displayed when `org-export-show-temporary-export-buffer' is +non-nil." + (interactive) + (org-export-to-buffer 'org "*Org ORG Export*" + async subtreep visible-only nil ext-plist (lambda () (org-mode)))) + +;;;###autoload +(defun org-org-export-to-org (&optional async subtreep visible-only ext-plist) + "Export current buffer to an org file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file name." + (interactive) + (let ((outfile (org-export-output-file-name ".org" subtreep))) + (org-export-to-file 'org outfile + async subtreep visible-only nil ext-plist))) + +;;;###autoload +(defun org-org-publish-to-org (plist filename pub-dir) + "Publish an org file to org. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'org filename ".org" plist pub-dir) + (when (plist-get plist :htmlized-source) + (require 'htmlize) + (require 'ox-html) + (let* ((org-inhibit-startup t) + (htmlize-output-type 'css) + (html-ext (concat "." (or (plist-get plist :html-extension) + org-html-extension "html"))) + (visitingp (find-buffer-visiting filename)) + (work-buffer (or visitingp (find-file filename))) + newbuf) + (font-lock-fontify-buffer) + (show-all) + (org-show-block-all) + (setq newbuf (htmlize-buffer)) + (with-current-buffer newbuf + (when org-org-htmlized-css-url + (goto-char (point-min)) + (and (re-search-forward + ".*" nil t) + (replace-match + (format + "" + org-org-htmlized-css-url) t t))) + (write-file (concat pub-dir (file-name-nondirectory filename) html-ext))) + (kill-buffer newbuf) + (unless visitingp (kill-buffer work-buffer))) + (set-buffer-modified-p nil))) + + +(provide 'ox-org) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-org.el ends here diff --git a/elpa/org-20150427/ox-publish.el b/elpa/org-20150427/ox-publish.el new file mode 100644 index 00000000..180764ee --- /dev/null +++ b/elpa/org-20150427/ox-publish.el @@ -0,0 +1,1250 @@ +;;; ox-publish.el --- Publish Related Org Mode Files as a Website +;; Copyright (C) 2006-2014 Free Software Foundation, Inc. + +;; Author: David O'Toole +;; Maintainer: Carsten Dominik +;; Keywords: hypermedia, outlines, wp + +;; 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 . + +;;; Commentary: + +;; This program allow configurable publishing of related sets of +;; Org mode files as a complete website. +;; +;; ox-publish.el can do the following: +;; +;; + Publish all one's Org files to a given export back-end +;; + Upload HTML, images, attachments and other files to a web server +;; + Exclude selected private pages from publishing +;; + Publish a clickable sitemap of pages +;; + Manage local timestamps for publishing only changed files +;; + Accept plugin functions to extend range of publishable content +;; +;; Documentation for publishing is in the manual. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'format-spec) +(require 'ox) + + + +;;; Variables + +(defvar org-publish-temp-files nil + "Temporary list of files to be published.") + +;; Here, so you find the variable right before it's used the first time: +(defvar org-publish-cache nil + "This will cache timestamps and titles for files in publishing projects. +Blocks could hash sha1 values here.") + +(defgroup org-publish nil + "Options for publishing a set of Org-mode and related files." + :tag "Org Publishing" + :group 'org) + +(defcustom org-publish-project-alist nil + "Association list to control publishing behavior. +Each element of the alist is a publishing 'project.' The CAR of +each element is a string, uniquely identifying the project. The +CDR of each element is in one of the following forms: + +1. A well-formed property list with an even number of elements, + alternating keys and values, specifying parameters for the + publishing process. + + \(:property value :property value ... ) + +2. A meta-project definition, specifying of a list of + sub-projects: + + \(:components (\"project-1\" \"project-2\" ...)) + +When the CDR of an element of org-publish-project-alist is in +this second form, the elements of the list after `:components' +are taken to be components of the project, which group together +files requiring different publishing options. When you publish +such a project with \\[org-publish], the components all publish. + +When a property is given a value in `org-publish-project-alist', +its setting overrides the value of the corresponding user +variable (if any) during publishing. However, options set within +a file override everything. + +Most properties are optional, but some should always be set: + + `:base-directory' + + Directory containing publishing source files. + + `:base-extension' + + Extension (without the dot!) of source files. This can be + a regular expression. If not given, \"org\" will be used as + default extension. + + `:publishing-directory' + + Directory (possibly remote) where output files will be + published. + +The `:exclude' property may be used to prevent certain files from +being published. Its value may be a string or regexp matching +file names you don't want to be published. + +The `:include' property may be used to include extra files. Its +value may be a list of filenames to include. The filenames are +considered relative to the base directory. + +When both `:include' and `:exclude' properties are given values, +the exclusion step happens first. + +One special property controls which back-end function to use for +publishing files in the project. This can be used to extend the +set of file types publishable by `org-publish', as well as the +set of output formats. + + `:publishing-function' + + Function to publish file. Each back-end may define its + own (i.e. `org-latex-publish-to-pdf', + `org-html-publish-to-html'). May be a list of functions, in + which case each function in the list is invoked in turn. + +Another property allows you to insert code that prepares +a project for publishing. For example, you could call GNU Make +on a certain makefile, to ensure published files are built up to +date. + + `:preparation-function' + + Function to be called before publishing this project. This + may also be a list of functions. + + `:completion-function' + + Function to be called after publishing this project. This + may also be a list of functions. + +Some properties control details of the Org publishing process, +and are equivalent to the corresponding user variables listed in +the right column. Back-end specific properties may also be +included. See the back-end documentation for more information. + + :author `user-full-name' + :creator `org-export-creator-string' + :email `user-mail-address' + :exclude-tags `org-export-exclude-tags' + :headline-levels `org-export-headline-levels' + :language `org-export-default-language' + :preserve-breaks `org-export-preserve-breaks' + :section-numbers `org-export-with-section-numbers' + :select-tags `org-export-select-tags' + :time-stamp-file `org-export-time-stamp-file' + :with-archived-trees `org-export-with-archived-trees' + :with-author `org-export-with-author' + :with-creator `org-export-with-creator' + :with-date `org-export-with-date' + :with-drawers `org-export-with-drawers' + :with-email `org-export-with-email' + :with-emphasize `org-export-with-emphasize' + :with-entities `org-export-with-entities' + :with-fixed-width `org-export-with-fixed-width' + :with-footnotes `org-export-with-footnotes' + :with-inlinetasks `org-export-with-inlinetasks' + :with-latex `org-export-with-latex' + :with-priority `org-export-with-priority' + :with-smart-quotes `org-export-with-smart-quotes' + :with-special-strings `org-export-with-special-strings' + :with-statistics-cookies' `org-export-with-statistics-cookies' + :with-sub-superscript `org-export-with-sub-superscripts' + :with-toc `org-export-with-toc' + :with-tables `org-export-with-tables' + :with-tags `org-export-with-tags' + :with-tasks `org-export-with-tasks' + :with-timestamps `org-export-with-timestamps' + :with-planning `org-export-with-planning' + :with-todo-keywords `org-export-with-todo-keywords' + +The following properties may be used to control publishing of +a site-map of files or summary page for a given project. + + `:auto-sitemap' + + Whether to publish a site-map during + `org-publish-current-project' or `org-publish-all'. + + `:sitemap-filename' + + Filename for output of sitemap. Defaults to \"sitemap.org\". + + `:sitemap-title' + + Title of site-map page. Defaults to name of file. + + `:sitemap-function' + + Plugin function to use for generation of site-map. Defaults + to `org-publish-org-sitemap', which generates a plain list of + links to all files in the project. + + `:sitemap-style' + + Can be `list' (site-map is just an itemized list of the + titles of the files involved) or `tree' (the directory + structure of the source files is reflected in the site-map). + Defaults to `tree'. + + `:sitemap-sans-extension' + + Remove extension from site-map's file-names. Useful to have + cool URIs (see http://www.w3.org/Provider/Style/URI). + Defaults to nil. + +If you create a site-map file, adjust the sorting like this: + + `:sitemap-sort-folders' + + Where folders should appear in the site-map. Set this to + `first' (default) or `last' to display folders first or last, + respectively. Any other value will mix files and folders. + + `:sitemap-sort-files' + + The site map is normally sorted alphabetically. You can + change this behaviour setting this to `anti-chronologically', + `chronologically', or nil. + + `:sitemap-ignore-case' + + Should sorting be case-sensitive? Default nil. + +The following property control the creation of a concept index. + + `:makeindex' + + Create a concept index. The file containing the index has to + be called \"theindex.org\". If it doesn't exist in the + project, it will be generated. Contents of the index are + stored in the file \"theindex.inc\", which can be included in + \"theindex.org\". + +Other properties affecting publication. + + `:body-only' + + Set this to t to publish only the body of the documents." + :group 'org-export-publish + :type 'alist) + +(defcustom org-publish-use-timestamps-flag t + "Non-nil means use timestamp checking to publish only changed files. +When nil, do no timestamp checking and always publish all files." + :group 'org-export-publish + :type 'boolean) + +(defcustom org-publish-timestamp-directory + (convert-standard-filename "~/.org-timestamps/") + "Name of directory in which to store publishing timestamps." + :group 'org-export-publish + :type 'directory) + +(defcustom org-publish-list-skipped-files t + "Non-nil means show message about files *not* published." + :group 'org-export-publish + :type 'boolean) + +(defcustom org-publish-sitemap-sort-files 'alphabetically + "Method to sort files in site-maps. +Possible values are `alphabetically', `chronologically', +`anti-chronologically' and nil. + +If `alphabetically', files will be sorted alphabetically. If +`chronologically', files will be sorted with older modification +time first. If `anti-chronologically', files will be sorted with +newer modification time first. nil won't sort files. + +You can overwrite this default per project in your +`org-publish-project-alist', using `:sitemap-sort-files'." + :group 'org-export-publish + :type 'symbol) + +(defcustom org-publish-sitemap-sort-folders 'first + "A symbol, denoting if folders are sorted first in sitemaps. +Possible values are `first', `last', and nil. +If `first', folders will be sorted before files. +If `last', folders are sorted to the end after the files. +Any other value will not mix files and folders. + +You can overwrite this default per project in your +`org-publish-project-alist', using `:sitemap-sort-folders'." + :group 'org-export-publish + :type 'symbol) + +(defcustom org-publish-sitemap-sort-ignore-case nil + "Non-nil when site-map sorting should ignore case. + +You can overwrite this default per project in your +`org-publish-project-alist', using `:sitemap-ignore-case'." + :group 'org-export-publish + :type 'boolean) + +(defcustom org-publish-sitemap-date-format "%Y-%m-%d" + "Format for printing a date in the sitemap. +See `format-time-string' for allowed formatters." + :group 'org-export-publish + :type 'string) + +(defcustom org-publish-sitemap-file-entry-format "%t" + "Format string for site-map file entry. +You could use brackets to delimit on what part the link will be. + +%t is the title. +%a is the author. +%d is the date formatted using `org-publish-sitemap-date-format'." + :group 'org-export-publish + :type 'string) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Timestamp-related functions + +(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func) + "Return path to timestamp file for filename FILENAME." + (setq filename (concat filename "::" (or pub-dir "") "::" + (format "%s" (or pub-func "")))) + (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) + +(defun org-publish-needed-p + (filename &optional pub-dir pub-func true-pub-dir base-dir) + "Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC. +TRUE-PUB-DIR is where the file will truly end up. Currently we +are not using this - maybe it can eventually be used to check if +the file is present at the target location, and how old it is. +Right now we cannot do this, because we do not know under what +file name the file will be stored - the publishing function can +still decide about that independently." + (let ((rtn (if (not org-publish-use-timestamps-flag) t + (org-publish-cache-file-needs-publishing + filename pub-dir pub-func base-dir)))) + (if rtn (message "Publishing file %s using `%s'" filename pub-func) + (when org-publish-list-skipped-files + (message "Skipping unmodified file %s" filename))) + rtn)) + +(defun org-publish-update-timestamp + (filename &optional pub-dir pub-func base-dir) + "Update publishing timestamp for file FILENAME. +If there is no timestamp, create one." + (let ((key (org-publish-timestamp-filename filename pub-dir pub-func)) + (stamp (org-publish-cache-ctime-of-src filename))) + (org-publish-cache-set key stamp))) + +(defun org-publish-remove-all-timestamps () + "Remove all files in the timestamp directory." + (let ((dir org-publish-timestamp-directory) + files) + (when (and (file-exists-p dir) (file-directory-p dir)) + (mapc 'delete-file (directory-files dir 'full "[^.]\\'")) + (org-publish-reset-cache)))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Getting project information out of `org-publish-project-alist' + +(defun org-publish-expand-projects (projects-alist) + "Expand projects in PROJECTS-ALIST. +This splices all the components into the list." + (let ((rest projects-alist) rtn p components) + (while (setq p (pop rest)) + (if (setq components (plist-get (cdr p) :components)) + (setq rest (append + (mapcar (lambda (x) (assoc x org-publish-project-alist)) + components) + rest)) + (push p rtn))) + (nreverse (delete-dups (delq nil rtn))))) + +(defvar org-publish-sitemap-sort-files) +(defvar org-publish-sitemap-sort-folders) +(defvar org-publish-sitemap-ignore-case) +(defvar org-publish-sitemap-requested) +(defvar org-publish-sitemap-date-format) +(defvar org-publish-sitemap-file-entry-format) +(defun org-publish-compare-directory-files (a b) + "Predicate for `sort', that sorts folders and files for sitemap." + (let ((retval t)) + (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders) + ;; First we sort files: + (when org-publish-sitemap-sort-files + (case org-publish-sitemap-sort-files + (alphabetically + (let* ((adir (file-directory-p a)) + (aorg (and (string-match "\\.org$" a) (not adir))) + (bdir (file-directory-p b)) + (borg (and (string-match "\\.org$" b) (not bdir))) + (A (if aorg (concat (file-name-directory a) + (org-publish-find-title a)) a)) + (B (if borg (concat (file-name-directory b) + (org-publish-find-title b)) b))) + (setq retval (if org-publish-sitemap-ignore-case + (not (string-lessp (upcase B) (upcase A))) + (not (string-lessp B A)))))) + ((anti-chronologically chronologically) + (let* ((adate (org-publish-find-date a)) + (bdate (org-publish-find-date b)) + (A (+ (lsh (car adate) 16) (cadr adate))) + (B (+ (lsh (car bdate) 16) (cadr bdate)))) + (setq retval + (if (eq org-publish-sitemap-sort-files 'chronologically) (<= A B) + (>= A B))))))) + ;; Directory-wise wins: + (when org-publish-sitemap-sort-folders + ;; a is directory, b not: + (cond + ((and (file-directory-p a) (not (file-directory-p b))) + (setq retval (equal org-publish-sitemap-sort-folders 'first))) + ;; a is not a directory, but b is: + ((and (not (file-directory-p a)) (file-directory-p b)) + (setq retval (equal org-publish-sitemap-sort-folders 'last)))))) + retval)) + +(defun org-publish-get-base-files-1 + (base-dir &optional recurse match skip-file skip-dir) + "Set `org-publish-temp-files' with files from BASE-DIR directory. +If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is +non-nil, restrict this list to the files matching the regexp +MATCH. If SKIP-FILE is non-nil, skip file matching the regexp +SKIP-FILE. If SKIP-DIR is non-nil, don't check directories +matching the regexp SKIP-DIR when recursing through BASE-DIR." + (mapc (lambda (f) + (let ((fd-p (file-directory-p f)) + (fnd (file-name-nondirectory f))) + (if (and fd-p recurse + (not (string-match "^\\.+$" fnd)) + (if skip-dir (not (string-match skip-dir fnd)) t)) + (org-publish-get-base-files-1 + f recurse match skip-file skip-dir) + (unless (or fd-p ;; this is a directory + (and skip-file (string-match skip-file fnd)) + (not (file-exists-p (file-truename f))) + (not (string-match match fnd))) + + (pushnew f org-publish-temp-files))))) + (let ((all-files (if (not recurse) (directory-files base-dir t match) + ;; If RECURSE is non-nil, we want all files + ;; matching MATCH and sub-directories. + (org-remove-if-not + (lambda (file) + (or (file-directory-p file) + (and match (string-match match file)))) + (directory-files base-dir t))))) + (if (not org-publish-sitemap-requested) all-files + (sort all-files 'org-publish-compare-directory-files))))) + +(defun org-publish-get-base-files (project &optional exclude-regexp) + "Return a list of all files in PROJECT. +If EXCLUDE-REGEXP is set, this will be used to filter out +matching filenames." + (let* ((project-plist (cdr project)) + (base-dir (file-name-as-directory + (plist-get project-plist :base-directory))) + (include-list (plist-get project-plist :include)) + (recurse (plist-get project-plist :recursive)) + (extension (or (plist-get project-plist :base-extension) "org")) + ;; sitemap-... variables are dynamically scoped for + ;; org-publish-compare-directory-files: + (org-publish-sitemap-requested + (plist-get project-plist :auto-sitemap)) + (sitemap-filename + (or (plist-get project-plist :sitemap-filename) "sitemap.org")) + (org-publish-sitemap-sort-folders + (if (plist-member project-plist :sitemap-sort-folders) + (plist-get project-plist :sitemap-sort-folders) + org-publish-sitemap-sort-folders)) + (org-publish-sitemap-sort-files + (cond ((plist-member project-plist :sitemap-sort-files) + (plist-get project-plist :sitemap-sort-files)) + ;; For backward compatibility: + ((plist-member project-plist :sitemap-alphabetically) + (if (plist-get project-plist :sitemap-alphabetically) + 'alphabetically nil)) + (t org-publish-sitemap-sort-files))) + (org-publish-sitemap-ignore-case + (if (plist-member project-plist :sitemap-ignore-case) + (plist-get project-plist :sitemap-ignore-case) + org-publish-sitemap-sort-ignore-case)) + (match (if (eq extension 'any) "^[^\\.]" + (concat "^[^\\.].*\\.\\(" extension "\\)$")))) + ;; Make sure `org-publish-sitemap-sort-folders' has an accepted + ;; value. + (unless (memq org-publish-sitemap-sort-folders '(first last)) + (setq org-publish-sitemap-sort-folders nil)) + + (setq org-publish-temp-files nil) + (if org-publish-sitemap-requested + (pushnew (expand-file-name (concat base-dir sitemap-filename)) + org-publish-temp-files)) + (org-publish-get-base-files-1 base-dir recurse match + ;; FIXME distinguish exclude regexp + ;; for skip-file and skip-dir? + exclude-regexp exclude-regexp) + (mapc (lambda (f) + (pushnew + (expand-file-name (concat base-dir f)) + org-publish-temp-files)) + include-list) + org-publish-temp-files)) + +(defun org-publish-get-project-from-filename (filename &optional up) + "Return the project that FILENAME belongs to." + (let* ((filename (expand-file-name filename)) + project-name) + + (catch 'p-found + (dolist (prj org-publish-project-alist) + (unless (plist-get (cdr prj) :components) + ;; [[info:org:Selecting%20files]] shows how this is supposed to work: + (let* ((r (plist-get (cdr prj) :recursive)) + (b (expand-file-name (file-name-as-directory + (plist-get (cdr prj) :base-directory)))) + (x (or (plist-get (cdr prj) :base-extension) "org")) + (e (plist-get (cdr prj) :exclude)) + (i (plist-get (cdr prj) :include)) + (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) + (when + (or (and i + (member filename + (mapcar (lambda (file) + (expand-file-name file b)) + i))) + (and (not (and e (string-match e filename))) + (string-match xm filename))) + (setq project-name (car prj)) + (throw 'p-found project-name)))))) + (when up + (dolist (prj org-publish-project-alist) + (if (member project-name (plist-get (cdr prj) :components)) + (setq project-name (car prj))))) + (assoc project-name org-publish-project-alist))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Tools for publishing functions in back-ends + +(defun org-publish-org-to (backend filename extension plist &optional pub-dir) + "Publish an Org file to a specified back-end. + +BACKEND is a symbol representing the back-end used for +transcoding. FILENAME is the filename of the Org file to be +published. EXTENSION is the extension used for the output +string, with the leading dot. PLIST is the property list for the +given project. + +Optional argument PUB-DIR, when non-nil is the publishing +directory. + +Return output file name." + (unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t)) + ;; Check if a buffer visiting FILENAME is already open. + (let* ((org-inhibit-startup t) + (visitingp (find-buffer-visiting filename)) + (work-buffer (or visitingp (find-file-noselect filename)))) + (prog1 (with-current-buffer work-buffer + (let ((output-file + (org-export-output-file-name extension nil pub-dir)) + (body-p (plist-get plist :body-only))) + (org-export-to-file backend output-file + nil nil nil body-p + ;; Add `org-publish-collect-numbering' and + ;; `org-publish-collect-index' to final output + ;; filters. The latter isn't dependent on + ;; `:makeindex', since we want to keep it up-to-date + ;; in cache anyway. + (org-combine-plists + plist + `(:filter-final-output + ,(cons 'org-publish-collect-numbering + (cons 'org-publish-collect-index + (plist-get plist :filter-final-output)))))))) + ;; Remove opened buffer in the process. + (unless visitingp (kill-buffer work-buffer))))) + +(defun org-publish-attachment (plist filename pub-dir) + "Publish a file with no transformation of any kind. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (unless (file-directory-p pub-dir) + (make-directory pub-dir t)) + (or (equal (expand-file-name (file-name-directory filename)) + (file-name-as-directory (expand-file-name pub-dir))) + (copy-file filename + (expand-file-name (file-name-nondirectory filename) pub-dir) + t))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Publishing files, sets of files, and indices + +(defun org-publish-file (filename &optional project no-cache) + "Publish file FILENAME from PROJECT. +If NO-CACHE is not nil, do not initialize org-publish-cache and +write it to disk. This is needed, since this function is used to +publish single files, when entire projects are published. +See `org-publish-projects'." + (let* ((project + (or project + (or (org-publish-get-project-from-filename filename) + (error "File %s not part of any known project" + (abbreviate-file-name filename))))) + (project-plist (cdr project)) + (ftname (expand-file-name filename)) + (publishing-function + (or (plist-get project-plist :publishing-function) + (error "No publishing function chosen"))) + (base-dir + (file-name-as-directory + (expand-file-name + (or (plist-get project-plist :base-directory) + (error "Project %s does not have :base-directory defined" + (car project)))))) + (pub-dir + (file-name-as-directory + (file-truename + (or (eval (plist-get project-plist :publishing-directory)) + (error "Project %s does not have :publishing-directory defined" + (car project)))))) + tmp-pub-dir) + + (unless no-cache (org-publish-initialize-cache (car project))) + + (setq tmp-pub-dir + (file-name-directory + (concat pub-dir + (and (string-match (regexp-quote base-dir) ftname) + (substring ftname (match-end 0)))))) + (if (listp publishing-function) + ;; allow chain of publishing functions + (mapc (lambda (f) + (when (org-publish-needed-p + filename pub-dir f tmp-pub-dir base-dir) + (funcall f project-plist filename tmp-pub-dir) + (org-publish-update-timestamp filename pub-dir f base-dir))) + publishing-function) + (when (org-publish-needed-p + filename pub-dir publishing-function tmp-pub-dir base-dir) + (funcall publishing-function project-plist filename tmp-pub-dir) + (org-publish-update-timestamp + filename pub-dir publishing-function base-dir))) + (unless no-cache (org-publish-write-cache-file)))) + +(defun org-publish-projects (projects) + "Publish all files belonging to the PROJECTS alist. +If `:auto-sitemap' is set, publish the sitemap too. If +`:makeindex' is set, also produce a file theindex.org." + (mapc + (lambda (project) + ;; Each project uses its own cache file: + (org-publish-initialize-cache (car project)) + (let* ((project-plist (cdr project)) + (exclude-regexp (plist-get project-plist :exclude)) + (sitemap-p (plist-get project-plist :auto-sitemap)) + (sitemap-filename (or (plist-get project-plist :sitemap-filename) + "sitemap.org")) + (sitemap-function (or (plist-get project-plist :sitemap-function) + 'org-publish-org-sitemap)) + (org-publish-sitemap-date-format + (or (plist-get project-plist :sitemap-date-format) + org-publish-sitemap-date-format)) + (org-publish-sitemap-file-entry-format + (or (plist-get project-plist :sitemap-file-entry-format) + org-publish-sitemap-file-entry-format)) + (preparation-function + (plist-get project-plist :preparation-function)) + (completion-function (plist-get project-plist :completion-function)) + (files (org-publish-get-base-files project exclude-regexp)) + (theindex + (expand-file-name "theindex.org" + (plist-get project-plist :base-directory)))) + (when preparation-function (run-hooks 'preparation-function)) + (if sitemap-p (funcall sitemap-function project sitemap-filename)) + ;; Publish all files from PROJECT excepted "theindex.org". Its + ;; publishing will be deferred until "theindex.inc" is + ;; populated. + (dolist (file files) + (unless (equal file theindex) + (org-publish-file file project t))) + ;; Populate "theindex.inc", if needed, and publish + ;; "theindex.org". + (when (plist-get project-plist :makeindex) + (org-publish-index-generate-theindex + project (plist-get project-plist :base-directory)) + (org-publish-file theindex project t)) + (when completion-function (run-hooks 'completion-function)) + (org-publish-write-cache-file))) + (org-publish-expand-projects projects))) + +(defun org-publish-org-sitemap (project &optional sitemap-filename) + "Create a sitemap of pages in set defined by PROJECT. +Optionally set the filename of the sitemap with SITEMAP-FILENAME. +Default for SITEMAP-FILENAME is 'sitemap.org'." + (let* ((project-plist (cdr project)) + (dir (file-name-as-directory + (plist-get project-plist :base-directory))) + (localdir (file-name-directory dir)) + (indent-str (make-string 2 ?\ )) + (exclude-regexp (plist-get project-plist :exclude)) + (files (nreverse + (org-publish-get-base-files project exclude-regexp))) + (sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) + (sitemap-title (or (plist-get project-plist :sitemap-title) + (concat "Sitemap for project " (car project)))) + (sitemap-style (or (plist-get project-plist :sitemap-style) + 'tree)) + (sitemap-sans-extension + (plist-get project-plist :sitemap-sans-extension)) + (visiting (find-buffer-visiting sitemap-filename)) + (ifn (file-name-nondirectory sitemap-filename)) + file sitemap-buffer) + (with-current-buffer + (let ((org-inhibit-startup t)) + (setq sitemap-buffer + (or visiting (find-file sitemap-filename)))) + (erase-buffer) + (insert (concat "#+TITLE: " sitemap-title "\n\n")) + (while (setq file (pop files)) + (let ((fn (file-name-nondirectory file)) + (link (file-relative-name file dir)) + (oldlocal localdir)) + (when sitemap-sans-extension + (setq link (file-name-sans-extension link))) + ;; sitemap shouldn't list itself + (unless (equal (file-truename sitemap-filename) + (file-truename file)) + (if (eq sitemap-style 'list) + (message "Generating list-style sitemap for %s" sitemap-title) + (message "Generating tree-style sitemap for %s" sitemap-title) + (setq localdir (concat (file-name-as-directory dir) + (file-name-directory link))) + (unless (string= localdir oldlocal) + (if (string= localdir dir) + (setq indent-str (make-string 2 ?\ )) + (let ((subdirs + (split-string + (directory-file-name + (file-name-directory + (file-relative-name localdir dir))) "/")) + (subdir "") + (old-subdirs (split-string + (file-relative-name oldlocal dir) "/"))) + (setq indent-str (make-string 2 ?\ )) + (while (string= (car old-subdirs) (car subdirs)) + (setq indent-str (concat indent-str (make-string 2 ?\ ))) + (pop old-subdirs) + (pop subdirs)) + (dolist (d subdirs) + (setq subdir (concat subdir d "/")) + (insert (concat indent-str " + " d "\n")) + (setq indent-str (make-string + (+ (length indent-str) 2) ?\ ))))))) + ;; This is common to 'flat and 'tree + (let ((entry + (org-publish-format-file-entry + org-publish-sitemap-file-entry-format file project-plist)) + (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) + (cond ((string-match-p regexp entry) + (string-match regexp entry) + (insert (concat indent-str " + " (match-string 1 entry) + "[[file:" link "][" + (match-string 2 entry) + "]]" (match-string 3 entry) "\n"))) + (t + (insert (concat indent-str " + [[file:" link "][" + entry + "]]\n")))))))) + (save-buffer)) + (or visiting (kill-buffer sitemap-buffer)))) + +(defun org-publish-format-file-entry (fmt file project-plist) + (format-spec + fmt + `((?t . ,(org-publish-find-title file t)) + (?d . ,(format-time-string org-publish-sitemap-date-format + (org-publish-find-date file))) + (?a . ,(or (plist-get project-plist :author) user-full-name))))) + +(defun org-publish-find-title (file &optional reset) + "Find the title of FILE in project." + (or + (and (not reset) (org-publish-cache-get-file-property file :title nil t)) + (let* ((org-inhibit-startup t) + (visiting (find-buffer-visiting file)) + (buffer (or visiting (find-file-noselect file)))) + (with-current-buffer buffer + (let ((title + (let ((property + (plist-get + ;; protect local variables in open buffers + (if visiting + (org-export-with-buffer-copy (org-export-get-environment)) + (org-export-get-environment)) + :title))) + (if property + (org-no-properties (org-element-interpret-data property)) + (file-name-nondirectory (file-name-sans-extension file)))))) + (unless visiting (kill-buffer buffer)) + (org-publish-cache-set-file-property file :title title) + title))))) + +(defun org-publish-find-date (file) + "Find the date of FILE in project. +This function assumes FILE is either a directory or an Org file. +If FILE is an Org file and provides a DATE keyword use it. In +any other case use the file system's modification time. Return +time in `current-time' format." + (if (file-directory-p file) (nth 5 (file-attributes file)) + (let* ((org-inhibit-startup t) + (visiting (find-buffer-visiting file)) + (file-buf (or visiting (find-file-noselect file nil))) + (date (plist-get + (with-current-buffer file-buf + (if visiting + (org-export-with-buffer-copy (org-export-get-environment)) + (org-export-get-environment))) + :date))) + (unless visiting (kill-buffer file-buf)) + ;; DATE is either a timestamp object or a secondary string. If it + ;; is a timestamp or if the secondary string contains a timestamp, + ;; convert it to internal format. Otherwise, use FILE + ;; modification time. + (cond ((eq (org-element-type date) 'timestamp) + (org-time-string-to-time (org-element-interpret-data date))) + ((let ((ts (and (consp date) (assq 'timestamp date)))) + (and ts + (let ((value (org-element-interpret-data ts))) + (and (org-string-nw-p value) + (org-time-string-to-time value)))))) + ((file-exists-p file) (nth 5 (file-attributes file))) + (t (error "No such file: \"%s\"" file)))))) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Interactive publishing functions + +;;;###autoload +(defalias 'org-publish-project 'org-publish) + +;;;###autoload +(defun org-publish (project &optional force async) + "Publish PROJECT. + +PROJECT is either a project name, as a string, or a project +alist (see `org-publish-project-alist' variable). + +When optional argument FORCE is non-nil, force publishing all +files in PROJECT. With a non-nil optional argument ASYNC, +publishing will be done asynchronously, in another process." + (interactive + (list (assoc (org-icompleting-read "Publish project: " + org-publish-project-alist nil t) + org-publish-project-alist) + current-prefix-arg)) + (let ((project (if (not (stringp project)) project + ;; If this function is called in batch mode, + ;; PROJECT is still a string here. + (assoc project org-publish-project-alist)))) + (cond + ((not project)) + (async + (org-export-async-start (lambda (results) nil) + `(let ((org-publish-use-timestamps-flag + ,(and (not force) org-publish-use-timestamps-flag))) + ;; Expand components right now as external process may not + ;; be aware of complete `org-publish-project-alist'. + (org-publish-projects + ',(org-publish-expand-projects (list project)))))) + (t (save-window-excursion + (let ((org-publish-use-timestamps-flag + (and (not force) org-publish-use-timestamps-flag))) + (org-publish-projects (list project)))))))) + +;;;###autoload +(defun org-publish-all (&optional force async) + "Publish all projects. +With prefix argument FORCE, remove all files in the timestamp +directory and force publishing all projects. With a non-nil +optional argument ASYNC, publishing will be done asynchronously, +in another process." + (interactive "P") + (if async + (org-export-async-start (lambda (results) nil) + `(progn + (when ',force (org-publish-remove-all-timestamps)) + (let ((org-publish-use-timestamps-flag + (if ',force nil ,org-publish-use-timestamps-flag))) + (org-publish-projects ',org-publish-project-alist)))) + (when force (org-publish-remove-all-timestamps)) + (save-window-excursion + (let ((org-publish-use-timestamps-flag + (if force nil org-publish-use-timestamps-flag))) + (org-publish-projects org-publish-project-alist))))) + + +;;;###autoload +(defun org-publish-current-file (&optional force async) + "Publish the current file. +With prefix argument FORCE, force publish the file. When +optional argument ASYNC is non-nil, publishing will be done +asynchronously, in another process." + (interactive "P") + (let ((file (buffer-file-name (buffer-base-buffer)))) + (if async + (org-export-async-start (lambda (results) nil) + `(let ((org-publish-use-timestamps-flag + (if ',force nil ,org-publish-use-timestamps-flag))) + (org-publish-file ,file))) + (save-window-excursion + (let ((org-publish-use-timestamps-flag + (if force nil org-publish-use-timestamps-flag))) + (org-publish-file file)))))) + +;;;###autoload +(defun org-publish-current-project (&optional force async) + "Publish the project associated with the current file. +With a prefix argument, force publishing of all files in +the project." + (interactive "P") + (save-window-excursion + (let ((project (org-publish-get-project-from-filename + (buffer-file-name (buffer-base-buffer)) 'up))) + (if project (org-publish project force async) + (error "File %s is not part of any known project" + (buffer-file-name (buffer-base-buffer))))))) + + + +;;; Index generation + +(defun org-publish-collect-index (output backend info) + "Update index for a file in cache. + +OUTPUT is the output from transcoding current file. BACKEND is +the back-end that was used for transcoding. INFO is a plist +containing publishing and export options. + +The index relative to current file is stored as an alist. An +association has the following shape: (TERM FILE-NAME PARENT), +where TERM is the indexed term, as a string, FILE-NAME is the +original full path of the file where the term in encountered, and +PARENT is a reference to the headline, if any, containing the +original index keyword. When non-nil, this reference is a cons +cell. Its CAR is a symbol among `id', `custom-id' and `name' and +its CDR is a string." + (let ((file (plist-get info :input-file))) + (org-publish-cache-set-file-property + file :index + (delete-dups + (org-element-map (plist-get info :parse-tree) 'keyword + (lambda (k) + (when (equal (org-element-property :key k) "INDEX") + (let ((parent (org-export-get-parent-headline k))) + (list (org-element-property :value k) + file + (cond + ((not parent) nil) + ((let ((id (org-element-property :ID parent))) + (and id (cons 'id id)))) + ((let ((id (org-element-property :CUSTOM_ID parent))) + (and id (cons 'custom-id id)))) + (t (cons 'name + ;; Remove statistics cookie. + (replace-regexp-in-string + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + (org-element-property :raw-value parent))))))))) + info)))) + ;; Return output unchanged. + output) + +(defun org-publish-index-generate-theindex (project directory) + "Retrieve full index from cache and build \"theindex.org\". +PROJECT is the project the index relates to. DIRECTORY is the +publishing directory." + (let ((all-files (org-publish-get-base-files + project (plist-get (cdr project) :exclude))) + full-index) + ;; Compile full index and sort it alphabetically. + (dolist (file all-files + (setq full-index + (sort (nreverse full-index) + (lambda (a b) (string< (downcase (car a)) + (downcase (car b))))))) + (let ((index (org-publish-cache-get-file-property file :index))) + (dolist (term index) + (unless (member term full-index) (push term full-index))))) + ;; Write "theindex.inc" in DIRECTORY. + (with-temp-file (expand-file-name "theindex.inc" directory) + (let ((current-letter nil) (last-entry nil)) + (dolist (idx full-index) + (let* ((entry (org-split-string (car idx) "!")) + (letter (upcase (substring (car entry) 0 1))) + ;; Transform file into a path relative to publishing + ;; directory. + (file (file-relative-name + (nth 1 idx) + (plist-get (cdr project) :base-directory)))) + ;; Check if another letter has to be inserted. + (unless (string= letter current-letter) + (insert (format "* %s\n" letter))) + ;; Compute the first difference between last entry and + ;; current one: it tells the level at which new items + ;; should be added. + (let* ((rank (if (equal entry last-entry) (1- (length entry)) + (loop for n from 0 to (length entry) + unless (equal (nth n entry) (nth n last-entry)) + return n))) + (len (length (nthcdr rank entry)))) + ;; For each term after the first difference, create + ;; a new sub-list with the term as body. Moreover, + ;; linkify the last term. + (dotimes (n len) + (insert + (concat + (make-string (* (+ rank n) 2) ? ) " - " + (if (not (= (1- len) n)) (nth (+ rank n) entry) + ;; Last term: Link it to TARGET, if possible. + (let ((target (nth 2 idx))) + (format + "[[%s][%s]]" + ;; Destination. + (case (car target) + ('nil (format "file:%s" file)) + (id (format "id:%s" (cdr target))) + (custom-id (format "file:%s::#%s" file (cdr target))) + (otherwise (format "file:%s::*%s" file (cdr target)))) + ;; Description. + (car (last entry))))) + "\n")))) + (setq current-letter letter last-entry entry)))) + ;; Create "theindex.org", if it doesn't exist yet, and provide + ;; a default index file. + (let ((index.org (expand-file-name "theindex.org" directory))) + (unless (file-exists-p index.org) + (with-temp-file index.org + (insert "#+TITLE: Index\n\n#+INCLUDE: \"theindex.inc\"\n\n"))))))) + + + +;;; External Fuzzy Links Resolution +;; +;; This part implements tools to resolve [[file.org::*Some headline]] +;; links, where "file.org" belongs to the current project. + +(defun org-publish-collect-numbering (output backend info) + (org-publish-cache-set-file-property + (plist-get info :input-file) :numbering + (mapcar (lambda (entry) + (cons (org-split-string + (replace-regexp-in-string + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + (org-element-property :raw-value (car entry)))) + (cdr entry))) + (plist-get info :headline-numbering))) + ;; Return output unchanged. + output) + +(defun org-publish-resolve-external-fuzzy-link (file fuzzy) + "Return numbering for headline matching FUZZY search in FILE. + +Return value is a list of numbers, or nil. This function allows +to resolve external fuzzy links like: + + [[file.org::*fuzzy][description]]" + (when org-publish-cache + (cdr (assoc (org-split-string + (if (eq (aref fuzzy 0) ?*) (substring fuzzy 1) fuzzy)) + (org-publish-cache-get-file-property + (expand-file-name file) :numbering nil t))))) + + + +;;; Caching functions + +(defun org-publish-write-cache-file (&optional free-cache) + "Write `org-publish-cache' to file. +If FREE-CACHE, empty the cache." + (unless org-publish-cache + (error "`org-publish-write-cache-file' called, but no cache present")) + + (let ((cache-file (org-publish-cache-get ":cache-file:"))) + (unless cache-file + (error "Cannot find cache-file name in `org-publish-write-cache-file'")) + (with-temp-file cache-file + (let (print-level print-length) + (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n") + (maphash (lambda (k v) + (insert + (format (concat "(puthash %S " + (if (or (listp v) (symbolp v)) + "'" "") + "%S org-publish-cache)\n") k v))) + org-publish-cache))) + (when free-cache (org-publish-reset-cache)))) + +(defun org-publish-initialize-cache (project-name) + "Initialize the projects cache if not initialized yet and return it." + + (unless project-name + (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'")) + + (unless (file-exists-p org-publish-timestamp-directory) + (make-directory org-publish-timestamp-directory t)) + (unless (file-directory-p org-publish-timestamp-directory) + (error "Org publish timestamp: %s is not a directory" + org-publish-timestamp-directory)) + + (unless (and org-publish-cache + (string= (org-publish-cache-get ":project:") project-name)) + (let* ((cache-file + (concat + (expand-file-name org-publish-timestamp-directory) + project-name ".cache")) + (cexists (file-exists-p cache-file))) + + (when org-publish-cache (org-publish-reset-cache)) + + (if cexists (load-file cache-file) + (setq org-publish-cache + (make-hash-table :test 'equal :weakness nil :size 100)) + (org-publish-cache-set ":project:" project-name) + (org-publish-cache-set ":cache-file:" cache-file)) + (unless cexists (org-publish-write-cache-file nil)))) + org-publish-cache) + +(defun org-publish-reset-cache () + "Empty org-publish-cache and reset it nil." + (message "%s" "Resetting org-publish-cache") + (when (hash-table-p org-publish-cache) + (clrhash org-publish-cache)) + (setq org-publish-cache nil)) + +(defun org-publish-cache-file-needs-publishing + (filename &optional pub-dir pub-func base-dir) + "Check the timestamp of the last publishing of FILENAME. +Return non-nil if the file needs publishing. Also check if +any included files have been more recently published, so that +the file including them will be republished as well." + (unless org-publish-cache + (error + "`org-publish-cache-file-needs-publishing' called, but no cache present")) + (let* ((case-fold-search t) + (key (org-publish-timestamp-filename filename pub-dir pub-func)) + (pstamp (org-publish-cache-get key)) + (org-inhibit-startup t) + (visiting (find-buffer-visiting filename)) + included-files-ctime buf) + + (when (equal (file-name-extension filename) "org") + (setq buf (find-file (expand-file-name filename))) + (with-current-buffer buf + (goto-char (point-min)) + (while (re-search-forward + "^#\\+INCLUDE:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t) + (let* ((included-file (expand-file-name (match-string 1)))) + (add-to-list 'included-files-ctime + (org-publish-cache-ctime-of-src included-file) t)))) + (unless visiting (kill-buffer buf))) + (if (null pstamp) t + (let ((ctime (org-publish-cache-ctime-of-src filename))) + (or (< pstamp ctime) + (when included-files-ctime + (not (null (delq nil (mapcar (lambda(ct) (< ctime ct)) + included-files-ctime)))))))))) + +(defun org-publish-cache-set-file-property + (filename property value &optional project-name) + "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE. +Use cache file of PROJECT-NAME. If the entry does not exist, it +will be created. Return VALUE." + ;; Evtl. load the requested cache file: + (if project-name (org-publish-initialize-cache project-name)) + (let ((pl (org-publish-cache-get filename))) + (if pl (progn (plist-put pl property value) value) + (org-publish-cache-get-file-property + filename property value nil project-name)))) + +(defun org-publish-cache-get-file-property + (filename property &optional default no-create project-name) + "Return the value for a PROPERTY of file FILENAME in publishing cache. +Use cache file of PROJECT-NAME. Return the value of that PROPERTY +or DEFAULT, if the value does not yet exist. If the entry will +be created, unless NO-CREATE is not nil." + ;; Evtl. load the requested cache file: + (if project-name (org-publish-initialize-cache project-name)) + (let ((pl (org-publish-cache-get filename)) retval) + (if pl + (if (plist-member pl property) + (setq retval (plist-get pl property)) + (setq retval default)) + ;; no pl yet: + (unless no-create + (org-publish-cache-set filename (list property default))) + (setq retval default)) + retval)) + +(defun org-publish-cache-get (key) + "Return the value stored in `org-publish-cache' for key KEY. +Returns nil, if no value or nil is found, or the cache does not +exist." + (unless org-publish-cache + (error "`org-publish-cache-get' called, but no cache present")) + (gethash key org-publish-cache)) + +(defun org-publish-cache-set (key value) + "Store KEY VALUE pair in `org-publish-cache'. +Returns value on success, else nil." + (unless org-publish-cache + (error "`org-publish-cache-set' called, but no cache present")) + (puthash key value org-publish-cache)) + +(defun org-publish-cache-ctime-of-src (file) + "Get the ctime of FILE as an integer." + (let ((attr (file-attributes + (expand-file-name (or (file-symlink-p file) file) + (file-name-directory file))))) + (if (not attr) (error "No such file: \"%s\"" file) + (+ (lsh (car (nth 5 attr)) 16) + (cadr (nth 5 attr)))))) + + +(provide 'ox-publish) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-publish.el ends here diff --git a/elpa/org-20150427/ox-texinfo.el b/elpa/org-20150427/ox-texinfo.el new file mode 100644 index 00000000..37841d77 --- /dev/null +++ b/elpa/org-20150427/ox-texinfo.el @@ -0,0 +1,1595 @@ +;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine + +;; Copyright (C) 2012-2014 Free Software Foundation, Inc. +;; Author: Jonathan Leech-Pepin +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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 . + +;;; Commentary: +;; +;; See Org manual for details. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'ox) + +(defvar orgtbl-exp-regexp) + + + +;;; Define Back-End + +(org-export-define-backend 'texinfo + '((bold . org-texinfo-bold) + (center-block . org-texinfo-center-block) + (clock . org-texinfo-clock) + (code . org-texinfo-code) + (comment . (lambda (&rest args) "")) + (comment-block . (lambda (&rest args) "")) + (drawer . org-texinfo-drawer) + (dynamic-block . org-texinfo-dynamic-block) + (entity . org-texinfo-entity) + (example-block . org-texinfo-example-block) + (export-block . org-texinfo-export-block) + (export-snippet . org-texinfo-export-snippet) + (fixed-width . org-texinfo-fixed-width) + (footnote-definition . org-texinfo-footnote-definition) + (footnote-reference . org-texinfo-footnote-reference) + (headline . org-texinfo-headline) + (inline-src-block . org-texinfo-inline-src-block) + (inlinetask . org-texinfo-inlinetask) + (italic . org-texinfo-italic) + (item . org-texinfo-item) + (keyword . org-texinfo-keyword) + (line-break . org-texinfo-line-break) + (link . org-texinfo-link) + (paragraph . org-texinfo-paragraph) + (plain-list . org-texinfo-plain-list) + (plain-text . org-texinfo-plain-text) + (planning . org-texinfo-planning) + (property-drawer . org-texinfo-property-drawer) + (quote-block . org-texinfo-quote-block) + (quote-section . org-texinfo-quote-section) + (radio-target . org-texinfo-radio-target) + (section . org-texinfo-section) + (special-block . org-texinfo-special-block) + (src-block . org-texinfo-src-block) + (statistics-cookie . org-texinfo-statistics-cookie) + (subscript . org-texinfo-subscript) + (superscript . org-texinfo-superscript) + (table . org-texinfo-table) + (table-cell . org-texinfo-table-cell) + (table-row . org-texinfo-table-row) + (target . org-texinfo-target) + (template . org-texinfo-template) + (timestamp . org-texinfo-timestamp) + (verbatim . org-texinfo-verbatim) + (verse-block . org-texinfo-verse-block)) + :export-block "TEXINFO" + :filters-alist + '((:filter-headline . org-texinfo-filter-section-blank-lines) + (:filter-parse-tree . org-texinfo--normalize-headlines) + (:filter-section . org-texinfo-filter-section-blank-lines)) + :menu-entry + '(?i "Export to Texinfo" + ((?t "As TEXI file" org-texinfo-export-to-texinfo) + (?i "As INFO file" org-texinfo-export-to-info))) + :options-alist + '((:texinfo-filename "TEXINFO_FILENAME" nil nil t) + (:texinfo-class "TEXINFO_CLASS" nil org-texinfo-default-class t) + (:texinfo-header "TEXINFO_HEADER" nil nil newline) + (:texinfo-post-header "TEXINFO_POST_HEADER" nil nil newline) + (:subtitle "SUBTITLE" nil nil newline) + (:subauthor "SUBAUTHOR" nil nil newline) + (:texinfo-dircat "TEXINFO_DIR_CATEGORY" nil nil t) + (:texinfo-dirtitle "TEXINFO_DIR_TITLE" nil nil t) + (:texinfo-dirdesc "TEXINFO_DIR_DESC" nil nil t) + (:texinfo-printed-title "TEXINFO_PRINTED_TITLE" nil nil t))) + + + +;;; User Configurable Variables + +(defgroup org-export-texinfo nil + "Options for exporting Org mode files to Texinfo." + :tag "Org Export Texinfo" + :version "24.4" + :package-version '(Org . "8.0") + :group 'org-export) + +;;;; Preamble + +(defcustom org-texinfo-coding-system nil + "Default document encoding for Texinfo output. + +If `nil' it will default to `buffer-file-coding-system'." + :group 'org-export-texinfo + :type 'coding-system) + +(defcustom org-texinfo-default-class "info" + "The default Texinfo class." + :group 'org-export-texinfo + :type '(string :tag "Texinfo class")) + +(defcustom org-texinfo-classes + '(("info" + "@documentencoding AUTO\n@documentlanguage AUTO" + ("@chapter %s" . "@unnumbered %s") + ("@section %s" . "@unnumberedsec %s") + ("@subsection %s" . "@unnumberedsubsec %s") + ("@subsubsection %s" . "@unnumberedsubsubsec %s"))) + "Alist of Texinfo classes and associated header and structure. +If #+TEXINFO_CLASS is set in the buffer, use its value and the +associated information. Here is the structure of each cell: + + \(class-name + header-string + \(numbered-section . unnumbered-section) + ...) + + +The header string +----------------- + +The header string is inserted in the header of the generated +document, right after \"@setfilename\" and \"@settitle\" +commands. + +If it contains the special string + + \"@documentencoding AUTO\" + +\"AUTO\" will be replaced with an appropriate coding system. See +`org-texinfo-coding-system' for more information. Likewise, if +the string contains the special string + + \"@documentlanguage AUTO\" + +\"AUTO\" will be replaced with the language defined in the +buffer, through #+LANGUAGE keyword, or globally, with +`org-export-default-language', which see. + + +The sectioning structure +------------------------ + +The sectioning structure of the class is given by the elements +following the header string. For each sectioning level, a number +of strings is specified. A %s formatter is mandatory in each +section string and will be replaced by the title of the section. + +Instead of a list of sectioning commands, you can also specify +a function name. That function will be called with two +parameters, the reduced) level of the headline, and a predicate +non-nil when the headline should be numbered. It must return +a format string in which the section title will be added." + :group 'org-export-texinfo + :version "24.4" + :package-version '(Org . "8.2") + :type '(repeat + (list (string :tag "Texinfo class") + (string :tag "Texinfo header") + (repeat :tag "Levels" :inline t + (choice + (cons :tag "Heading" + (string :tag " numbered") + (string :tag "unnumbered")) + (function :tag "Hook computing sectioning")))))) + +;;;; Headline + +(defcustom org-texinfo-format-headline-function 'ignore + "Function to format headline text. + +This function will be called with 5 arguments: +TODO the todo keyword (string or nil). +TODO-TYPE the type of todo (symbol: `todo', `done', nil) +PRIORITY the priority of the headline (integer or nil) +TEXT the main headline text (string). +TAGS the tags as a list of strings (list of strings or nil). + +The function result will be used in the section format string. + +As an example, one could set the variable to the following, in +order to reproduce the default set-up: + +\(defun org-texinfo-format-headline (todo todo-type priority text tags) + \"Default format function for a headline.\" + \(concat (when todo + \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo)) + \(when priority + \(format \"\\\\framebox{\\\\#%c} \" priority)) + text + \(when tags + \(format \"\\\\hfill{}\\\\textsc{%s}\" + \(mapconcat 'identity tags \":\"))))" + :group 'org-export-texinfo + :type 'function) + +;;;; Node listing (menu) + +(defcustom org-texinfo-node-description-column 32 + "Column at which to start the description in the node listings. +If a node title is greater than this length, the description will +be placed after the end of the title." + :group 'org-export-texinfo + :type 'integer) + +;;;; Timestamps + +(defcustom org-texinfo-active-timestamp-format "@emph{%s}" + "A printf format string to be applied to active timestamps." + :group 'org-export-texinfo + :type 'string) + +(defcustom org-texinfo-inactive-timestamp-format "@emph{%s}" + "A printf format string to be applied to inactive timestamps." + :group 'org-export-texinfo + :type 'string) + +(defcustom org-texinfo-diary-timestamp-format "@emph{%s}" + "A printf format string to be applied to diary timestamps." + :group 'org-export-texinfo + :type 'string) + +;;;; Links + +(defcustom org-texinfo-link-with-unknown-path-format "@indicateurl{%s}" + "Format string for links with unknown path type." + :group 'org-export-texinfo + :type 'string) + +;;;; Tables + +(defcustom org-texinfo-tables-verbatim nil + "When non-nil, tables are exported verbatim." + :group 'org-export-texinfo + :type 'boolean) + +(defcustom org-texinfo-table-scientific-notation "%s\\,(%s)" + "Format string to display numbers in scientific notation. +The format should have \"%s\" twice, for mantissa and exponent +\(i.e. \"%s\\\\times10^{%s}\"). + +When nil, no transformation is made." + :group 'org-export-texinfo + :type '(choice + (string :tag "Format string") + (const :tag "No formatting" nil))) + +(defcustom org-texinfo-def-table-markup "@samp" + "Default setting for @table environments." + :group 'org-export-texinfo + :type 'string) + +;;;; Text markup + +(defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}") + (code . code) + (italic . "@emph{%s}") + (verbatim . verb) + (comment . "@c %s")) + "Alist of Texinfo expressions to convert text markup. + +The key must be a symbol among `bold', `italic' and `comment'. +The value is a formatting string to wrap fontified text with. + +Value can also be set to the following symbols: `verb' and +`code'. For the former, Org will use \"@verb\" to +create a format string and select a delimiter character that +isn't in the string. For the latter, Org will use \"@code\" +to typeset and try to protect special characters. + +If no association can be found for a given markup, text will be +returned as-is." + :group 'org-export-texinfo + :type 'alist + :options '(bold code italic verbatim comment)) + +;;;; Drawers + +(defcustom org-texinfo-format-drawer-function + (lambda (name contents) contents) + "Function called to format a drawer in Texinfo code. + +The function must accept two parameters: + NAME the drawer name, like \"LOGBOOK\" + CONTENTS the contents of the drawer. + +The function should return the string to be exported. + +The default function simply returns the value of CONTENTS." + :group 'org-export-texinfo + :version "24.4" + :package-version '(Org . "8.2") + :type 'function) + +;;;; Inlinetasks + +(defcustom org-texinfo-format-inlinetask-function 'ignore + "Function called to format an inlinetask in Texinfo code. + +The function must accept six parameters: + TODO the todo keyword, as a string + TODO-TYPE the todo type, a symbol among `todo', `done' and nil. + PRIORITY the inlinetask priority, as a string + NAME the inlinetask name, as a string. + TAGS the inlinetask tags, as a list of strings. + CONTENTS the contents of the inlinetask, as a string. + +The function should return the string to be exported. + +For example, the variable could be set to the following function +in order to mimic default behavior: + +\(defun org-texinfo-format-inlinetask \(todo type priority name tags contents\) +\"Format an inline task element for Texinfo export.\" + \(let ((full-title + \(concat + \(when todo + \(format \"@strong{%s} \" todo)) + \(when priority (format \"#%c \" priority)) + title + \(when tags + \(format \":%s:\" + \(mapconcat 'identity tags \":\"))))) + \(format (concat \"@center %s\n\n\" + \"%s\" + \"\n\")) + full-title contents))" + :group 'org-export-texinfo + :type 'function) + +;;;; Compilation + +(defcustom org-texinfo-info-process '("makeinfo %f") + "Commands to process a Texinfo file to an INFO file. +This is list of strings, each of them will be given to the shell +as a command. %f in the command will be replaced by the full +file name, %b by the file base name (i.e without extension) and +%o by the base directory of the file." + :group 'org-export-texinfo + :type '(repeat :tag "Shell command sequence" + (string :tag "Shell command"))) + +(defcustom org-texinfo-logfiles-extensions + '("aux" "toc" "cp" "fn" "ky" "pg" "tp" "vr") + "The list of file extensions to consider as Texinfo logfiles. +The logfiles will be remove if `org-texinfo-remove-logfiles' is +non-nil." + :group 'org-export-texinfo + :type '(repeat (string :tag "Extension"))) + +(defcustom org-texinfo-remove-logfiles t + "Non-nil means remove the logfiles produced by compiling a Texinfo file. +By default, logfiles are files with these extensions: .aux, .toc, +.cp, .fn, .ky, .pg and .tp. To define the set of logfiles to remove, +set `org-texinfo-logfiles-extensions'." + :group 'org-export-latex + :type 'boolean) + +;;; Constants + +(defconst org-texinfo-max-toc-depth 4 + "Maximum depth for creation of detailed menu listings. +Beyond this depth, Texinfo will not recognize the nodes and will +cause errors. Left as a constant in case this value ever +changes.") + +(defconst org-texinfo-supported-coding-systems + '("US-ASCII" "UTF-8" "ISO-8859-15" "ISO-8859-1" "ISO-8859-2" "koi8-r" "koi8-u") + "List of coding systems supported by Texinfo, as strings. +Specified coding system will be matched against these strings. +If two strings share the same prefix (e.g. \"ISO-8859-1\" and +\"ISO-8859-15\"), the most specific one has to be listed first.") + + +;;; Internal Functions + +(defun org-texinfo-filter-section-blank-lines (headline back-end info) + "Filter controlling number of blank lines after a section." + (let ((blanks (make-string 2 ?\n))) + (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline))) + +(defun org-texinfo--normalize-headlines (tree back-end info) + "Normalize headlines in TREE. + +BACK-END is the symbol specifying back-end used for export. INFO +is a plist used as a communication channel. + +Make sure every headline in TREE contains a section, since those +are required to install a menu. Also put exactly one blank line +at the end of each section. + +Return new tree." + (org-element-map tree 'headline + (lambda (hl) + (org-element-put-property hl :post-blank 1) + (let ((contents (org-element-contents hl))) + (when contents + (let ((first (org-element-map contents '(headline section) + #'identity info t))) + (unless (eq (org-element-type first) 'section) + (apply #'org-element-set-contents + hl + (cons `(section (:parent ,hl)) contents))))))) + info) + tree) + +(defun org-texinfo--find-verb-separator (s) + "Return a character not used in string S. +This is used to choose a separator for constructs like \\verb." + (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) + (loop for c across ll + when (not (string-match (regexp-quote (char-to-string c)) s)) + return (char-to-string c)))) + +(defun org-texinfo--text-markup (text markup) + "Format TEXT depending on MARKUP text markup. +See `org-texinfo-text-markup-alist' for details." + (let ((fmt (cdr (assq markup org-texinfo-text-markup-alist)))) + (cond + ;; No format string: Return raw text. + ((not fmt) text) + ((eq 'verb fmt) + (let ((separator (org-texinfo--find-verb-separator text))) + (concat "@verb{" separator text separator "}"))) + ((eq 'code fmt) + (let ((start 0) + (rtn "") + char) + (while (string-match "[@{}]" text) + (setq char (match-string 0 text)) + (if (> (match-beginning 0) 0) + (setq rtn (concat rtn (substring text 0 (match-beginning 0))))) + (setq text (substring text (1+ (match-beginning 0)))) + (setq char (concat "@" char) + rtn (concat rtn char))) + (setq text (concat rtn text) + fmt "@code{%s}") + (format fmt text))) + ;; Else use format string. + (t (format fmt text))))) + +(defun org-texinfo--get-node (blob info) + "Return node or anchor associated to BLOB. +BLOB is an element or object. INFO is a plist used as +a communication channel. The function guarantees the node or +anchor name is unique." + (let ((cache (plist-get info :texinfo-node-cache))) + (or (cdr (assq blob cache)) + (let ((name + (org-texinfo--sanitize-node + (case (org-element-type blob) + (headline + (org-export-data (org-export-get-alt-title blob info) info)) + ((radio-target target) (org-element-property :value blob)) + (otherwise (or (org-element-property :name blob) "")))))) + ;; Ensure NAME is unique. + (while (rassoc name cache) (setq name (concat name "x"))) + (plist-put info :texinfo-node-cache (cons (cons blob name) cache)) + name)))) + +;;;; Menu sanitizing + +(defun org-texinfo--sanitize-node (title) + "Bend string TITLE to node line requirements. +Trim string and collapse multiple whitespace characters as they +are not significant. Also remove the following characters: @ +{ } ( ) : . ," + (replace-regexp-in-string + "[:,.]" "" + (replace-regexp-in-string + "\\`(\\(.*)\\)" "[\\1" + (org-trim (replace-regexp-in-string "[ \t]\\{2,\\}" " " title))))) + +;;;; Content sanitizing + +(defun org-texinfo--sanitize-content (text) + "Escape special characters in string TEXT. +Special characters are: @ { }" + (replace-regexp-in-string "[@{}]" "@\\&" text)) + +;;; Template + +(defun org-texinfo-template (contents info) + "Return complete document string after Texinfo conversion. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (let ((title (org-export-data (plist-get info :title) info)) + ;; Copying data is the contents of the first headline in + ;; parse tree with a non-nil copying property. + (copying (org-element-map (plist-get info :parse-tree) 'headline + (lambda (hl) + (and (org-not-nil (org-element-property :COPYING hl)) + (org-element-contents hl))) + info t))) + (concat + "\\input texinfo @c -*- texinfo -*-\n" + "@c %**start of header\n" + (let ((file (or (plist-get info :texinfo-filename) + (let ((f (plist-get info :output-file))) + (and f (concat (file-name-sans-extension f) ".info")))))) + (and file (format "@setfilename %s\n" file))) + (format "@settitle %s\n" title) + ;; Insert class-defined header. + (org-element-normalize-string + (let ((header (nth 1 (assoc (plist-get info :texinfo-class) + org-texinfo-classes))) + (coding + (catch 'coding-system + (let ((case-fold-search t) + (name (symbol-name (or org-texinfo-coding-system + buffer-file-coding-system)))) + (dolist (system org-texinfo-supported-coding-systems "UTF-8") + (when (org-string-match-p (regexp-quote system) name) + (throw 'coding-system system)))))) + (language (plist-get info :language)) + (case-fold-search nil)) + ;; Auto coding system. + (replace-regexp-in-string + "^@documentencoding \\(AUTO\\)$" + coding + (replace-regexp-in-string + "^@documentlanguage \\(AUTO\\)$" language header t nil 1) t nil 1))) + ;; Additional header options set by #+TEXINFO_HEADER. + (let ((texinfo-header (plist-get info :texinfo-header))) + (and texinfo-header (org-element-normalize-string texinfo-header))) + "@c %**end of header\n\n" + ;; Additional options set by #+TEXINFO_POST_HEADER. + (let ((texinfo-post-header (plist-get info :texinfo-post-header))) + (and texinfo-post-header + (org-element-normalize-string texinfo-post-header))) + ;; Copying. + (and copying + (format "@copying\n%s@end copying\n\n" + (org-element-normalize-string + (org-export-data copying info)))) + ;; Info directory information. Only supply if both title and + ;; category are provided. + (let ((dircat (plist-get info :texinfo-dircat)) + (dirtitle + (let ((title (plist-get info :texinfo-dirtitle))) + (and title + (string-match "^\\(?:\\* \\)?\\(.*?\\)\\(\\.\\)?$" title) + (format "* %s." (match-string 1 title)))))) + (when (and dircat dirtitle) + (concat "@dircategory " dircat "\n" + "@direntry\n" + (let ((dirdesc + (let ((desc (plist-get info :texinfo-dirdesc))) + (cond ((not desc) nil) + ((org-string-match-p "\\.$" desc) desc) + (t (concat desc ".")))))) + (if dirdesc (format "%-23s %s" dirtitle dirdesc) dirtitle)) + "\n" + "@end direntry\n\n"))) + ;; Title + "@finalout\n" + "@titlepage\n" + (format "@title %s\n" (or (plist-get info :texinfo-printed-title) title)) + (let ((subtitle (plist-get info :subtitle))) + (and subtitle + (org-element-normalize-string + (replace-regexp-in-string "^" "@subtitle " subtitle)))) + (when (plist-get info :with-author) + (concat + ;; Primary author. + (let ((author (org-string-nw-p + (org-export-data (plist-get info :author) info))) + (email (and (plist-get info :with-email) + (org-string-nw-p + (org-export-data (plist-get info :email) info))))) + (cond ((and author email) + (format "@author %s (@email{%s})\n" author email)) + (author (format "@author %s\n" author)) + (email (format "@author @email{%s}\n" email)))) + ;; Other authors. + (let ((subauthor (plist-get info :subauthor))) + (and subauthor + (org-element-normalize-string + (replace-regexp-in-string "^" "@author " subauthor)))))) + (and copying "@page\n@vskip 0pt plus 1filll\n@insertcopying\n") + "@end titlepage\n\n" + ;; Table of contents. + (and (plist-get info :with-toc) "@contents\n\n") + ;; Configure Top Node when not for Tex + "@ifnottex\n" + "@node Top\n" + (format "@top %s\n" title) + (and copying "@insertcopying\n") + "@end ifnottex\n\n" + ;; Menu. + (org-texinfo-make-menu (plist-get info :parse-tree) info 'master) + "\n" + ;; Document's body. + contents "\n" + ;; Creator. + (case (plist-get info :with-creator) + ((nil) nil) + (comment (format "@c %s\n" (plist-get info :creator))) + (otherwise (concat (plist-get info :creator) "\n"))) + ;; Document end. + "@bye"))) + + + +;;; Transcode Functions + +;;;; Bold + +(defun org-texinfo-bold (bold contents info) + "Transcode BOLD from Org to Texinfo. +CONTENTS is the text with bold markup. INFO is a plist holding +contextual information." + (org-texinfo--text-markup contents 'bold)) + +;;;; Center Block + +(defun org-texinfo-center-block (center-block contents info) + "Transcode a CENTER-BLOCK element from Org to Texinfo. +CONTENTS holds the contents of the block. INFO is a plist used +as a communication channel." + contents) + +;;;; Clock + +(defun org-texinfo-clock (clock contents info) + "Transcode a CLOCK element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual +information." + (concat + "@noindent" + (format "@strong{%s} " org-clock-string) + (format org-texinfo-inactive-timestamp-format + (concat (org-translate-time + (org-element-property :raw-value + (org-element-property :value clock))) + (let ((time (org-element-property :duration clock))) + (and time (format " (%s)" time))))) + "@*")) + +;;;; Code + +(defun org-texinfo-code (code contents info) + "Transcode a CODE object from Org to Texinfo. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (org-texinfo--text-markup (org-element-property :value code) 'code)) + +;;;; Drawer + +(defun org-texinfo-drawer (drawer contents info) + "Transcode a DRAWER element from Org to Texinfo. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let* ((name (org-element-property :drawer-name drawer)) + (output (funcall org-texinfo-format-drawer-function + name contents))) + output)) + +;;;; Dynamic Block + +(defun org-texinfo-dynamic-block (dynamic-block contents info) + "Transcode a DYNAMIC-BLOCK element from Org to Texinfo. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + contents) + +;;;; Entity + +(defun org-texinfo-entity (entity contents info) + "Transcode an ENTITY object from Org to Texinfo. +CONTENTS are the definition itself. INFO is a plist holding +contextual information." + (let ((ent (org-element-property :latex entity))) + (if (org-element-property :latex-math-p entity) (format "@math{%s}" ent) ent))) + +;;;; Example Block + +(defun org-texinfo-example-block (example-block contents info) + "Transcode an EXAMPLE-BLOCK element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "@verbatim\n%s@end verbatim" + (org-export-format-code-default example-block info))) + +;;;; Export Block + +(defun org-texinfo-export-block (export-block contents info) + "Transcode a EXPORT-BLOCK element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (string= (org-element-property :type export-block) "TEXINFO") + (org-remove-indentation (org-element-property :value export-block)))) + +;;;; Export Snippet + +(defun org-texinfo-export-snippet (export-snippet contents info) + "Transcode a EXPORT-SNIPPET object from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual information." + (when (eq (org-export-snippet-backend export-snippet) 'texinfo) + (org-element-property :value export-snippet))) + +;;;; Fixed Width + +(defun org-texinfo-fixed-width (fixed-width contents info) + "Transcode a FIXED-WIDTH element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual information." + (format "@example\n%s\n@end example" + (org-remove-indentation + (org-texinfo--sanitize-content + (org-element-property :value fixed-width))))) + +;;;; Footnote Reference + +(defun org-texinfo-footnote-reference (footnote contents info) + "Create a footnote reference for FOOTNOTE. + +FOOTNOTE is the footnote to define. CONTENTS is nil. INFO is a +plist holding contextual information." + (let ((def (org-export-get-footnote-definition footnote info))) + (format "@footnote{%s}" + (org-trim (org-export-data def info))))) + +;;;; Headline + +(defun org-texinfo-headline (headline contents info) + "Transcode a HEADLINE element from Org to Texinfo. +CONTENTS holds the contents of the headline. INFO is a plist +holding contextual information." + (let* ((class (plist-get info :texinfo-class)) + (level (org-export-get-relative-level headline info)) + (numberedp (org-export-numbered-headline-p headline info)) + (class-sectioning (assoc class org-texinfo-classes)) + ;; Find the index type, if any. + (index (org-element-property :INDEX headline)) + ;; Create node info, to insert it before section formatting. + ;; Use custom menu title if present. + (node (format "@node %s\n" (org-texinfo--get-node headline info))) + ;; Section formatting will set two placeholders: one for the + ;; title and the other for the contents. + (section-fmt + (if (org-not-nil (org-element-property :APPENDIX headline)) + "@appendix %s\n%s" + (let ((sec (if (and (symbolp (nth 2 class-sectioning)) + (fboundp (nth 2 class-sectioning))) + (funcall (nth 2 class-sectioning) level numberedp) + (nth (1+ level) class-sectioning)))) + (cond + ;; No section available for that LEVEL. + ((not sec) nil) + ;; Section format directly returned by a function. + ((stringp sec) sec) + ;; (numbered-section . unnumbered-section) + ((not (consp (cdr sec))) + (concat (if (or index (not numberedp)) (cdr sec) (car sec)) + "\n%s")))))) + (todo + (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword headline))) + (and todo (org-export-data todo info))))) + (todo-type (and todo (org-element-property :todo-type headline))) + (tags (and (plist-get info :with-tags) + (org-export-get-tags headline info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority headline))) + (text (org-export-data (org-element-property :title headline) info)) + (full-text (if (not (eq org-texinfo-format-headline-function 'ignore)) + ;; User-defined formatting function. + (funcall org-texinfo-format-headline-function + todo todo-type priority text tags) + ;; Default formatting. + (concat + (when todo + (format "@strong{%s} " todo)) + (when priority (format "@emph{#%s} " priority)) + text + (when tags + (format " :%s:" + (mapconcat 'identity tags ":")))))) + (contents (if (org-string-nw-p contents) (concat "\n" contents) ""))) + (cond + ;; Case 1: This is a footnote section: ignore it. + ((org-element-property :footnote-section-p headline) nil) + ;; Case 2: This is the `copying' section: ignore it + ;; This is used elsewhere. + ((org-not-nil (org-element-property :COPYING headline)) nil) + ;; Case 3: An index. If it matches one of the known indexes, + ;; print it as such following the contents, otherwise + ;; print the contents and leave the index up to the user. + (index + (concat node + (format + section-fmt + full-text + (concat contents + (and (member index '("cp" "fn" "ky" "pg" "tp" "vr")) + (concat "\n@printindex " index)))))) + ;; Case 4: This is a deep sub-tree: export it as a list item. + ;; Also export as items headlines for which no section + ;; format has been found. + ((or (not section-fmt) (org-export-low-level-p headline info)) + ;; Build the real contents of the sub-tree. + (concat (and (org-export-first-sibling-p headline info) + (format "@%s\n" (if numberedp 'enumerate 'itemize))) + "@item\n" full-text "\n" + contents + (if (org-export-last-sibling-p headline info) + (format "@end %s" (if numberedp 'enumerate 'itemize)) + "\n"))) + ;; Case 5: Standard headline. Export it as a section. + (t (concat node (format section-fmt full-text contents)))))) + +;;;; Inline Src Block + +(defun org-texinfo-inline-src-block (inline-src-block contents info) + "Transcode an INLINE-SRC-BLOCK element from Org to Texinfo. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let* ((code (org-element-property :value inline-src-block)) + (separator (org-texinfo--find-verb-separator code))) + (concat "@verb{" separator code separator "}"))) + +;;;; Inlinetask + +(defun org-texinfo-inlinetask (inlinetask contents info) + "Transcode an INLINETASK element from Org to Texinfo. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let ((title (org-export-data (org-element-property :title inlinetask) info)) + (todo (and (plist-get info :with-todo-keywords) + (let ((todo (org-element-property :todo-keyword inlinetask))) + (and todo (org-export-data todo info))))) + (todo-type (org-element-property :todo-type inlinetask)) + (tags (and (plist-get info :with-tags) + (org-export-get-tags inlinetask info))) + (priority (and (plist-get info :with-priority) + (org-element-property :priority inlinetask)))) + ;; If `org-texinfo-format-inlinetask-function' is provided, call it + ;; with appropriate arguments. + (if (not (eq org-texinfo-format-inlinetask-function 'ignore)) + (funcall org-texinfo-format-inlinetask-function + todo todo-type priority title tags contents) + ;; Otherwise, use a default template. + (let ((full-title + (concat + (when todo (format "@strong{%s} " todo)) + (when priority (format "#%c " priority)) + title + (when tags (format ":%s:" + (mapconcat 'identity tags ":")))))) + (format (concat "@center %s\n\n" + "%s" + "\n") + full-title contents))))) + +;;;; Italic + +(defun org-texinfo-italic (italic contents info) + "Transcode ITALIC from Org to Texinfo. +CONTENTS is the text with italic markup. INFO is a plist holding +contextual information." + (org-texinfo--text-markup contents 'italic)) + +;;;; Item + +(defun org-texinfo-item (item contents info) + "Transcode an ITEM element from Org to Texinfo. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (format "@item%s\n%s" + (let ((tag (org-element-property :tag item))) + (if tag (concat " " (org-export-data tag info)) "")) + (or contents ""))) + +;;;; Keyword + +(defun org-texinfo-keyword (keyword contents info) + "Transcode a KEYWORD element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((key (org-element-property :key keyword)) + (value (org-element-property :value keyword))) + (cond + ((string= key "TEXINFO") value) + ((string= key "CINDEX") (format "@cindex %s" value)) + ((string= key "FINDEX") (format "@findex %s" value)) + ((string= key "KINDEX") (format "@kindex %s" value)) + ((string= key "PINDEX") (format "@pindex %s" value)) + ((string= key "TINDEX") (format "@tindex %s" value)) + ((string= key "VINDEX") (format "@vindex %s" value))))) + +;;;; Line Break + +(defun org-texinfo-line-break (line-break contents info) + "Transcode a LINE-BREAK object from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual information." + "@*\n") + +;;;; Link + +(defun org-texinfo-link (link desc info) + "Transcode a LINK object from Org to Texinfo. + +DESC is the description part of the link, or the empty string. +INFO is a plist holding contextual information. See +`org-export-data'." + (let* ((type (org-element-property :type link)) + (raw-path (org-element-property :path link)) + ;; Ensure DESC really exists, or set it to nil. + (desc (and (not (string= desc "")) desc)) + (path (cond + ((member type '("http" "https" "ftp")) + (concat type ":" raw-path)) + ((and (string= type "file") (file-name-absolute-p raw-path)) + (concat "file:" raw-path)) + (t raw-path))) + protocol) + (cond + ((equal type "radio") + (let ((destination (org-export-resolve-radio-link link info))) + (if (not destination) desc + (format "@ref{%s,,%s}" + (org-texinfo--get-node destination info) + desc)))) + ((member type '("custom-id" "id" "fuzzy")) + (let ((destination + (if (equal type "fuzzy") + (org-export-resolve-fuzzy-link link info) + (org-export-resolve-id-link link info)))) + (case (org-element-type destination) + ((nil) + (format org-texinfo-link-with-unknown-path-format + (org-texinfo--sanitize-content path))) + ;; Id link points to an external file. + (plain-text + (if desc (format "@uref{file://%s,%s}" destination desc) + (format "@uref{file://%s}" destination))) + (headline + (format "@ref{%s,%s}" + (org-texinfo--get-node destination info) + (cond + (desc) + ((org-export-numbered-headline-p destination info) + (org-export-data + (org-element-property :title destination) info)) + (t + (mapconcat + #'number-to-string + (org-export-get-headline-number destination info) "."))))) + (otherwise + (let ((topic + (or desc + (if (and (eq (org-element-type destination) 'headline) + (not (org-export-numbered-headline-p + destination info))) + (org-export-data + (org-element-property :title destination) info)) + (let ((n (org-export-get-ordinal destination info))) + (cond + ((not n) nil) + ((integerp n) n) + (t (mapconcat #'number-to-string n "."))))))) + (when topic + (format "@ref{%s,,%s}" + (org-texinfo--get-node destination info) + topic))))))) + ((equal type "info") + (let* ((info-path (split-string path "[:#]")) + (info-manual (car info-path)) + (info-node (or (cadr info-path) "top")) + (title (or desc ""))) + (format "@ref{%s,%s,,%s,}" info-node title info-manual))) + ((string= type "mailto") + (format "@email{%s}" + (concat (org-texinfo--sanitize-content path) + (and desc (concat "," desc))))) + ((let ((protocol (nth 2 (assoc type org-link-protocols)))) + (and (functionp protocol) + (funcall protocol (org-link-unescape path) desc 'texinfo)))) + ;; External link with a description part. + ((and path desc) (format "@uref{%s,%s}" path desc)) + ;; External link without a description part. + (path (format "@uref{%s}" path)) + ;; No path, only description. Try to do something useful. + (t (format org-texinfo-link-with-unknown-path-format desc))))) + + +;;;; Menu + +(defun org-texinfo-make-menu (scope info &optional master) + "Create the menu for inclusion in the Texinfo document. + +SCOPE is a headline or a full parse tree. INFO is the +communication channel, as a plist. + +When optional argument MASTER is non-nil, generate a master menu, +including detailed node listing." + (let ((menu (org-texinfo--build-menu scope info))) + (when (org-string-nw-p menu) + (org-element-normalize-string + (format + "@menu\n%s@end menu" + (concat menu + (when master + (let ((detailmenu + (org-texinfo--build-menu + scope info + (let ((toc-depth (plist-get info :with-toc))) + (if (wholenump toc-depth) toc-depth + org-texinfo-max-toc-depth))))) + (when (org-string-nw-p detailmenu) + (concat "\n@detailmenu\n" + "--- The Detailed Node Listing ---\n\n" + detailmenu + "@end detailmenu\n")))))))))) + +(defun org-texinfo--build-menu (scope info &optional level) + "Build menu for entries within SCOPE. +SCOPE is a headline or a full parse tree. INFO is a plist +containing contextual information. When optional argument LEVEL +is an integer, build the menu recursively, down to this depth." + (cond + ((not level) + (org-texinfo--format-entries (org-texinfo--menu-entries scope info) info)) + ((zerop level) nil) + (t + (org-element-normalize-string + (mapconcat + (lambda (h) + (let ((entries (org-texinfo--menu-entries h info))) + (when entries + (concat + (format "%s\n\n%s\n" + (org-export-data (org-export-get-alt-title h info) info) + (org-texinfo--format-entries entries info)) + (org-texinfo--build-menu h info (1- level)))))) + (org-texinfo--menu-entries scope info) ""))))) + +(defun org-texinfo--format-entries (entries info) + "Format all direct menu entries in SCOPE, as a string. +SCOPE is either a headline or a full Org document. INFO is +a plist containing contextual information." + (org-element-normalize-string + (mapconcat + (lambda (h) + (let* ((title (org-export-data + (org-export-get-alt-title h info) info)) + (node (org-texinfo--get-node h info)) + (entry (concat "* " title ":" + (if (string= title node) ":" + (concat " " node ". ")))) + (desc (org-element-property :DESCRIPTION h))) + (if (not desc) entry + (format (format "%%-%ds %%s" org-texinfo-node-description-column) + entry desc)))) + entries "\n"))) + +(defun org-texinfo--menu-entries (scope info) + "List direct children in SCOPE needing a menu entry. +SCOPE is a headline or a full parse tree. INFO is a plist +holding contextual information." + (let* ((cache (or (plist-get info :texinfo-entries-cache) + (plist-get (plist-put info :texinfo-entries-cache + (make-hash-table :test #'eq)) + :texinfo-entries-cache))) + (cached-entries (gethash scope cache 'no-cache))) + (if (not (eq cached-entries 'no-cache)) cached-entries + (puthash scope + (org-element-map (org-element-contents scope) 'headline + (lambda (h) + (and (not (org-not-nil (org-element-property :COPYING h))) + (not (org-element-property :footnote-section-p h)) + (not (org-export-low-level-p h info)) + h)) + info nil 'headline) + cache)))) + +;;;; Paragraph + +(defun org-texinfo-paragraph (paragraph contents info) + "Transcode a PARAGRAPH element from Org to Texinfo. +CONTENTS is the contents of the paragraph, as a string. INFO is +the plist used as a communication channel." + contents) + +;;;; Plain List + +(defun org-texinfo-plain-list (plain-list contents info) + "Transcode a PLAIN-LIST element from Org to Texinfo. +CONTENTS is the contents of the list. INFO is a plist holding +contextual information." + (let* ((attr (org-export-read-attribute :attr_texinfo plain-list)) + (indic (or (plist-get attr :indic) org-texinfo-def-table-markup)) + (table-type (plist-get attr :table-type)) + (type (org-element-property :type plain-list)) + (list-type (cond + ((eq type 'ordered) "enumerate") + ((eq type 'unordered) "itemize") + ((member table-type '("ftable" "vtable")) table-type) + (t "table")))) + (format "@%s\n%s@end %s" + (if (eq type 'descriptive) (concat list-type " " indic) list-type) + contents + list-type))) + +;;;; Plain Text + +(defun org-texinfo-plain-text (text info) + "Transcode a TEXT string from Org to Texinfo. +TEXT is the string to transcode. INFO is a plist holding +contextual information." + ;; First protect @, { and }. + (let ((output (org-texinfo--sanitize-content text))) + ;; Activate smart quotes. Be sure to provide original TEXT string + ;; since OUTPUT may have been modified. + (when (plist-get info :with-smart-quotes) + (setq output + (org-export-activate-smart-quotes output :texinfo info text))) + ;; LaTeX into @LaTeX{} and TeX into @TeX{} + (let ((case-fold-search nil) + (start 0)) + (while (string-match "\\(\\(?:La\\)?TeX\\)" output start) + (setq output (replace-match + (format "@%s{}" (match-string 1 output)) nil t output) + start (match-end 0)))) + ;; Convert special strings. + (when (plist-get info :with-special-strings) + (while (string-match (regexp-quote "...") output) + (setq output (replace-match "@dots{}" nil t output)))) + ;; Handle break preservation if required. + (when (plist-get info :preserve-breaks) + (setq output (replace-regexp-in-string + "\\(\\\\\\\\\\)?[ \t]*\n" " @*\n" output))) + ;; Return value. + output)) + +;;;; Planning + +(defun org-texinfo-planning (planning contents info) + "Transcode a PLANNING element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual +information." + (concat + "@noindent" + (mapconcat + 'identity + (delq nil + (list + (let ((closed (org-element-property :closed planning))) + (when closed + (concat + (format "@strong{%s} " org-closed-string) + (format org-texinfo-inactive-timestamp-format + (org-translate-time + (org-element-property :raw-value closed)))))) + (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat + (format "@strong{%s} " org-deadline-string) + (format org-texinfo-active-timestamp-format + (org-translate-time + (org-element-property :raw-value deadline)))))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat + (format "@strong{%s} " org-scheduled-string) + (format org-texinfo-active-timestamp-format + (org-translate-time + (org-element-property :raw-value scheduled)))))))) + " ") + "@*")) + +;;;; Property Drawer + +(defun org-texinfo-property-drawer (property-drawer contents info) + "Transcode a PROPERTY-DRAWER element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual +information." + ;; The property drawer isn't exported but we want separating blank + ;; lines nonetheless. + "") + +;;;; Quote Block + +(defun org-texinfo-quote-block (quote-block contents info) + "Transcode a QUOTE-BLOCK element from Org to Texinfo. +CONTENTS holds the contents of the block. INFO is a plist +holding contextual information." + (let* ((title (org-element-property :name quote-block)) + (start-quote (concat "@quotation" + (if title + (format " %s" title))))) + (format "%s\n%s@end quotation" start-quote contents))) + +;;;; Quote Section + +(defun org-texinfo-quote-section (quote-section contents info) + "Transcode a QUOTE-SECTION element from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual information." + (let ((value (org-remove-indentation + (org-element-property :value quote-section)))) + (when value (format "@verbatim\n%s@end verbatim" value)))) + +;;;; Radio Target + +(defun org-texinfo-radio-target (radio-target text info) + "Transcode a RADIO-TARGET object from Org to Texinfo. +TEXT is the text of the target. INFO is a plist holding +contextual information." + (format "@anchor{%s}%s" + (org-export-solidify-link-text + (org-element-property :value radio-target)) + text)) + +;;;; Section + +(defun org-texinfo-section (section contents info) + "Transcode a SECTION element from Org to Texinfo. +CONTENTS holds the contents of the section. INFO is a plist +holding contextual information." + (concat contents + (let ((parent (org-export-get-parent-headline section))) + (and parent (org-texinfo-make-menu parent info))))) + +;;;; Special Block + +(defun org-texinfo-special-block (special-block contents info) + "Transcode a SPECIAL-BLOCK element from Org to Texinfo. +CONTENTS holds the contents of the block. INFO is a plist used +as a communication channel." + contents) + +;;;; Src Block + +(defun org-texinfo-src-block (src-block contents info) + "Transcode a SRC-BLOCK element from Org to Texinfo. +CONTENTS holds the contents of the item. INFO is a plist holding +contextual information." + (let ((lispp (org-string-match-p "lisp" + (org-element-property :language src-block))) + (code (org-texinfo--sanitize-content + (org-export-format-code-default src-block info)))) + (format (if lispp "@lisp\n%s@end lisp" "@example\n%s@end example") code))) + +;;;; Statistics Cookie + +(defun org-texinfo-statistics-cookie (statistics-cookie contents info) + "Transcode a STATISTICS-COOKIE object from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual information." + (org-element-property :value statistics-cookie)) + +;;;; Subscript + +(defun org-texinfo-subscript (subscript contents info) + "Transcode a SUBSCRIPT object from Org to Texinfo. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "@math{_%s}" contents)) + +;;;; Superscript + +(defun org-texinfo-superscript (superscript contents info) + "Transcode a SUPERSCRIPT object from Org to Texinfo. +CONTENTS is the contents of the object. INFO is a plist holding +contextual information." + (format "@math{^%s}" contents)) + +;;;; Table + +(defun org-texinfo-table (table contents info) + "Transcode a TABLE element from Org to Texinfo. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (if (eq (org-element-property :type table) 'table.el) + (format "@verbatim\n%s@end verbatim" + (org-element-normalize-string + (org-element-property :value table))) + (let* ((col-width (org-export-read-attribute :attr_texinfo table :columns)) + (columns + (if col-width (format "@columnfractions %s" col-width) + (org-texinfo-table-column-widths table info)))) + (format "@multitable %s\n%s@end multitable" + columns + contents)))) + +(defun org-texinfo-table-column-widths (table info) + "Determine the largest table cell in each column to process alignment. +TABLE is the table element to transcode. INFO is a plist used as +a communication channel." + (let ((widths (make-vector (cdr (org-export-table-dimensions table info)) 0))) + (org-element-map table 'table-row + (lambda (row) + (let ((idx 0)) + (org-element-map row 'table-cell + (lambda (cell) + ;; Length of the cell in the original buffer is only an + ;; approximation of the length of the cell in the + ;; output. It can sometimes fail (e.g. it considers + ;; "/a/" being larger than "ab"). + (let ((w (- (org-element-property :contents-end cell) + (org-element-property :contents-begin cell)))) + (aset widths idx (max w (aref widths idx)))) + (incf idx)) + info))) + info) + (format "{%s}" (mapconcat (lambda (w) (make-string w ?a)) widths "} {")))) + +;;;; Table Cell + +(defun org-texinfo-table-cell (table-cell contents info) + "Transcode a TABLE-CELL element from Org to Texinfo. +CONTENTS is the cell contents. INFO is a plist used as +a communication channel." + (concat (if (and contents + org-texinfo-table-scientific-notation + (string-match orgtbl-exp-regexp contents)) + ;; Use appropriate format string for scientific + ;; notation. + (format org-texinfo-table-scientific-notation + (match-string 1 contents) + (match-string 2 contents)) + contents) + (when (org-export-get-next-element table-cell info) "\n@tab "))) + +;;;; Table Row + +(defun org-texinfo-table-row (table-row contents info) + "Transcode a TABLE-ROW element from Org to Texinfo. +CONTENTS is the contents of the row. INFO is a plist used as +a communication channel." + ;; Rules are ignored since table separators are deduced from + ;; borders of the current row. + (when (eq (org-element-property :type table-row) 'standard) + (let ((rowgroup-tag + (if (and (= 1 (org-export-table-row-group table-row info)) + (org-export-table-has-header-p + (org-export-get-parent-table table-row) info)) + "@headitem " + "@item "))) + (concat rowgroup-tag contents "\n")))) + +;;;; Target + +(defun org-texinfo-target (target contents info) + "Transcode a TARGET object from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual +information." + (format "@anchor{%s}" + (org-export-solidify-link-text (org-element-property :value target)))) + +;;;; Timestamp + +(defun org-texinfo-timestamp (timestamp contents info) + "Transcode a TIMESTAMP object from Org to Texinfo. +CONTENTS is nil. INFO is a plist holding contextual +information." + (let ((value (org-texinfo-plain-text + (org-timestamp-translate timestamp) info))) + (case (org-element-property :type timestamp) + ((active active-range) + (format org-texinfo-active-timestamp-format value)) + ((inactive inactive-range) + (format org-texinfo-inactive-timestamp-format value)) + (t (format org-texinfo-diary-timestamp-format value))))) + +;;;; Verbatim + +(defun org-texinfo-verbatim (verbatim contents info) + "Transcode a VERBATIM object from Org to Texinfo. +CONTENTS is nil. INFO is a plist used as a communication +channel." + (org-texinfo--text-markup (org-element-property :value verbatim) 'verbatim)) + +;;;; Verse Block + +(defun org-texinfo-verse-block (verse-block contents info) + "Transcode a VERSE-BLOCK element from Org to Texinfo. +CONTENTS is verse block contents. INFO is a plist holding +contextual information." + (format "@display\n%s@end display" contents)) + + +;;; Interactive functions + +(defun org-texinfo-export-to-texinfo + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to a Texinfo file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +Return output file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".texi" subtreep)) + (org-export-coding-system `,org-texinfo-coding-system)) + (org-export-to-file 'texinfo outfile + async subtreep visible-only body-only ext-plist))) + +(defun org-texinfo-export-to-info + (&optional async subtreep visible-only body-only ext-plist) + "Export current buffer to Texinfo then process through to INFO. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only write code +between \"\\begin{document}\" and \"\\end{document}\". + +EXT-PLIST, when provided, is a property list with external +parameters overriding Org default settings, but still inferior to +file-local settings. + +When optional argument PUB-DIR is set, use it as the publishing +directory. + +Return INFO file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".texi" subtreep)) + (org-export-coding-system `,org-texinfo-coding-system)) + (org-export-to-file 'texinfo outfile + async subtreep visible-only body-only ext-plist + (lambda (file) (org-texinfo-compile file))))) + +;;;###autoload +(defun org-texinfo-publish-to-texinfo (plist filename pub-dir) + "Publish an org file to Texinfo. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'texinfo filename ".texi" plist pub-dir)) + +;;;###autoload +(defun org-texinfo-convert-region-to-texinfo () + "Assume the current region has org-mode syntax, and convert it to Texinfo. +This can be used in any buffer. For example, you can write an +itemized list in org-mode syntax in an Texinfo buffer and use +this command to convert it." + (interactive) + (org-export-replace-region-by 'texinfo)) + +(defun org-texinfo-compile (file) + "Compile a texinfo file. + +FILE is the name of the file being compiled. Processing is +done through the command specified in `org-texinfo-info-process'. + +Return INFO file name or an error if it couldn't be produced." + (let* ((base-name (file-name-sans-extension (file-name-nondirectory file))) + (full-name (file-truename file)) + (out-dir (file-name-directory file)) + ;; Properly set working directory for compilation. + (default-directory (if (file-name-absolute-p file) + (file-name-directory full-name) + default-directory)) + errors) + (message (format "Processing Texinfo file %s..." file)) + (save-window-excursion + ;; Replace %b, %f and %o with appropriate values in each command + ;; before applying it. Output is redirected to "*Org INFO + ;; Texinfo Output*" buffer. + (let ((outbuf (get-buffer-create "*Org INFO Texinfo Output*"))) + (dolist (command org-texinfo-info-process) + (shell-command + (replace-regexp-in-string + "%b" (shell-quote-argument base-name) + (replace-regexp-in-string + "%f" (shell-quote-argument full-name) + (replace-regexp-in-string + "%o" (shell-quote-argument out-dir) command t t) t t) t t) + outbuf)) + ;; Collect standard errors from output buffer. + (setq errors (org-texinfo-collect-errors outbuf))) + (let ((infofile (concat out-dir base-name ".info"))) + ;; Check for process failure. Provide collected errors if + ;; possible. + (if (not (file-exists-p infofile)) + (error (concat (format "INFO file %s wasn't produced" infofile) + (when errors (concat ": " errors)))) + ;; Else remove log files, when specified, and signal end of + ;; process to user, along with any error encountered. + (when org-texinfo-remove-logfiles + (dolist (ext org-texinfo-logfiles-extensions) + (let ((file (concat out-dir base-name "." ext))) + (when (file-exists-p file) (delete-file file))))) + (message (concat "Process completed" + (if (not errors) "." + (concat " with errors: " errors))))) + ;; Return output file name. + infofile)))) + +(defun org-texinfo-collect-errors (buffer) + "Collect some kind of errors from \"makeinfo\" command output. + +BUFFER is the buffer containing output. + +Return collected error types as a string, or nil if there was +none." + (with-current-buffer buffer + (save-excursion + (goto-char (point-min)) + ;; Find final "makeinfo" run. + (when t + (let ((case-fold-search t) + (errors "")) + (when (save-excursion + (re-search-forward "perhaps incorrect sectioning?" nil t)) + (setq errors (concat errors " [incorrect sectioning]"))) + (when (save-excursion + (re-search-forward "missing close brace" nil t)) + (setq errors (concat errors " [syntax error]"))) + (when (save-excursion + (re-search-forward "Unknown command" nil t)) + (setq errors (concat errors " [undefined @command]"))) + (when (save-excursion + (re-search-forward "No matching @end" nil t)) + (setq errors (concat errors " [block incomplete]"))) + (when (save-excursion + (re-search-forward "requires a sectioning" nil t)) + (setq errors (concat errors " [invalid section command]"))) + (when (save-excursion + (re-search-forward "\\[unexpected\]" nil t)) + (setq errors (concat errors " [unexpected error]"))) + (when (save-excursion + (re-search-forward "misplaced " nil t)) + (setq errors (concat errors " [syntax error]"))) + (and (org-string-nw-p errors) (org-trim errors))))))) + + +(provide 'ox-texinfo) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox-texinfo.el ends here diff --git a/elpa/org-20150427/ox.el b/elpa/org-20150427/ox.el new file mode 100644 index 00000000..72cf4006 --- /dev/null +++ b/elpa/org-20150427/ox.el @@ -0,0 +1,6254 @@ +;;; ox.el --- Generic Export Engine for Org Mode + +;; Copyright (C) 2012-2014 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp + +;; 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 . + +;;; Commentary: +;; +;; This library implements a generic export engine for Org, built on +;; its syntactical parser: Org Elements. +;; +;; Besides that parser, the generic exporter is made of three distinct +;; parts: +;; +;; - The communication channel consists in a property list, which is +;; created and updated during the process. Its use is to offer +;; every piece of information, would it be about initial environment +;; or contextual data, all in a single place. The exhaustive list +;; of properties is given in "The Communication Channel" section of +;; this file. +;; +;; - The transcoder walks the parse tree, ignores or treat as plain +;; text elements and objects according to export options, and +;; eventually calls back-end specific functions to do the real +;; transcoding, concatenating their return value along the way. +;; +;; - The filter system is activated at the very beginning and the very +;; end of the export process, and each time an element or an object +;; has been converted. It is the entry point to fine-tune standard +;; output from back-end transcoders. See "The Filter System" +;; section for more information. +;; +;; The core function is `org-export-as'. It returns the transcoded +;; buffer as a string. +;; +;; An export back-end is defined with `org-export-define-backend'. +;; This function can also support specific buffer keywords, OPTION +;; keyword's items and filters. Refer to function's documentation for +;; more information. +;; +;; If the new back-end shares most properties with another one, +;; `org-export-define-derived-backend' can be used to simplify the +;; process. +;; +;; Any back-end can define its own variables. Among them, those +;; customizable should belong to the `org-export-BACKEND' group. +;; +;; Tools for common tasks across back-ends are implemented in the +;; following part of the file. +;; +;; Then, a wrapper macro for asynchronous export, +;; `org-export-async-start', along with tools to display results. are +;; given in the penultimate part. +;; +;; Eventually, a dispatcher (`org-export-dispatch') for standard +;; back-ends is provided in the last one. + +;;; Code: + +(eval-when-compile (require 'cl)) +(require 'org-element) +(require 'org-macro) +(require 'ob-exp) + +(declare-function org-publish "ox-publish" (project &optional force async)) +(declare-function org-publish-all "ox-publish" (&optional force async)) +(declare-function + org-publish-current-file "ox-publish" (&optional force async)) +(declare-function org-publish-current-project "ox-publish" + (&optional force async)) + +(defvar org-publish-project-alist) +(defvar org-table-number-fraction) +(defvar org-table-number-regexp) + + + +;;; Internal Variables +;; +;; Among internal variables, the most important is +;; `org-export-options-alist'. This variable define the global export +;; options, shared between every exporter, and how they are acquired. + +(defconst org-export-max-depth 19 + "Maximum nesting depth for headlines, counting from 0.") + +(defconst org-export-options-alist + '((:author "AUTHOR" nil user-full-name t) + (:creator "CREATOR" nil org-export-creator-string) + (:date "DATE" nil nil t) + (:description "DESCRIPTION" nil nil newline) + (:email "EMAIL" nil user-mail-address t) + (:exclude-tags "EXCLUDE_TAGS" nil org-export-exclude-tags split) + (:headline-levels nil "H" org-export-headline-levels) + (:keywords "KEYWORDS" nil nil space) + (:language "LANGUAGE" nil org-export-default-language t) + (:preserve-breaks nil "\\n" org-export-preserve-breaks) + (:section-numbers nil "num" org-export-with-section-numbers) + (:select-tags "SELECT_TAGS" nil org-export-select-tags split) + (:time-stamp-file nil "timestamp" org-export-time-stamp-file) + (:title "TITLE" nil nil space) + (:with-archived-trees nil "arch" org-export-with-archived-trees) + (:with-author nil "author" org-export-with-author) + (:with-clocks nil "c" org-export-with-clocks) + (:with-creator nil "creator" org-export-with-creator) + (:with-date nil "date" org-export-with-date) + (:with-drawers nil "d" org-export-with-drawers) + (:with-email nil "email" org-export-with-email) + (:with-emphasize nil "*" org-export-with-emphasize) + (:with-entities nil "e" org-export-with-entities) + (:with-fixed-width nil ":" org-export-with-fixed-width) + (:with-footnotes nil "f" org-export-with-footnotes) + (:with-inlinetasks nil "inline" org-export-with-inlinetasks) + (:with-latex nil "tex" org-export-with-latex) + (:with-planning nil "p" org-export-with-planning) + (:with-priority nil "pri" org-export-with-priority) + (:with-smart-quotes nil "'" org-export-with-smart-quotes) + (:with-special-strings nil "-" org-export-with-special-strings) + (:with-statistics-cookies nil "stat" org-export-with-statistics-cookies) + (:with-sub-superscript nil "^" org-export-with-sub-superscripts) + (:with-toc nil "toc" org-export-with-toc) + (:with-tables nil "|" org-export-with-tables) + (:with-tags nil "tags" org-export-with-tags) + (:with-tasks nil "tasks" org-export-with-tasks) + (:with-timestamps nil "<" org-export-with-timestamps) + (:with-todo-keywords nil "todo" org-export-with-todo-keywords)) + "Alist between export properties and ways to set them. + +The CAR of the alist is the property name, and the CDR is a list +like (KEYWORD OPTION DEFAULT BEHAVIOR) where: + +KEYWORD is a string representing a buffer keyword, or nil. Each + property defined this way can also be set, during subtree + export, through a headline property named after the keyword + with the \"EXPORT_\" prefix (i.e. DATE keyword and EXPORT_DATE + property). +OPTION is a string that could be found in an #+OPTIONS: line. +DEFAULT is the default value for the property. +BEHAVIOR determines how Org should handle multiple keywords for + the same property. It is a symbol among: + nil Keep old value and discard the new one. + t Replace old value with the new one. + `space' Concatenate the values, separating them with a space. + `newline' Concatenate the values, separating them with + a newline. + `split' Split values at white spaces, and cons them to the + previous list. + +Values set through KEYWORD and OPTION have precedence over +DEFAULT. + +All these properties should be back-end agnostic. Back-end +specific properties are set through `org-export-define-backend'. +Properties redefined there have precedence over these.") + +(defconst org-export-special-keywords '("FILETAGS" "SETUPFILE" "OPTIONS") + "List of in-buffer keywords that require special treatment. +These keywords are not directly associated to a property. The +way they are handled must be hard-coded into +`org-export--get-inbuffer-options' function.") + +(defconst org-export-filters-alist + '((:filter-bold . org-export-filter-bold-functions) + (:filter-babel-call . org-export-filter-babel-call-functions) + (:filter-center-block . org-export-filter-center-block-functions) + (:filter-clock . org-export-filter-clock-functions) + (:filter-code . org-export-filter-code-functions) + (:filter-comment . org-export-filter-comment-functions) + (:filter-comment-block . org-export-filter-comment-block-functions) + (:filter-diary-sexp . org-export-filter-diary-sexp-functions) + (:filter-drawer . org-export-filter-drawer-functions) + (:filter-dynamic-block . org-export-filter-dynamic-block-functions) + (:filter-entity . org-export-filter-entity-functions) + (:filter-example-block . org-export-filter-example-block-functions) + (:filter-export-block . org-export-filter-export-block-functions) + (:filter-export-snippet . org-export-filter-export-snippet-functions) + (:filter-final-output . org-export-filter-final-output-functions) + (:filter-fixed-width . org-export-filter-fixed-width-functions) + (:filter-footnote-definition . org-export-filter-footnote-definition-functions) + (:filter-footnote-reference . org-export-filter-footnote-reference-functions) + (:filter-headline . org-export-filter-headline-functions) + (:filter-horizontal-rule . org-export-filter-horizontal-rule-functions) + (:filter-inline-babel-call . org-export-filter-inline-babel-call-functions) + (:filter-inline-src-block . org-export-filter-inline-src-block-functions) + (:filter-inlinetask . org-export-filter-inlinetask-functions) + (:filter-italic . org-export-filter-italic-functions) + (:filter-item . org-export-filter-item-functions) + (:filter-keyword . org-export-filter-keyword-functions) + (:filter-latex-environment . org-export-filter-latex-environment-functions) + (:filter-latex-fragment . org-export-filter-latex-fragment-functions) + (:filter-line-break . org-export-filter-line-break-functions) + (:filter-link . org-export-filter-link-functions) + (:filter-node-property . org-export-filter-node-property-functions) + (:filter-options . org-export-filter-options-functions) + (:filter-paragraph . org-export-filter-paragraph-functions) + (:filter-parse-tree . org-export-filter-parse-tree-functions) + (:filter-plain-list . org-export-filter-plain-list-functions) + (:filter-plain-text . org-export-filter-plain-text-functions) + (:filter-planning . org-export-filter-planning-functions) + (:filter-property-drawer . org-export-filter-property-drawer-functions) + (:filter-quote-block . org-export-filter-quote-block-functions) + (:filter-quote-section . org-export-filter-quote-section-functions) + (:filter-radio-target . org-export-filter-radio-target-functions) + (:filter-section . org-export-filter-section-functions) + (:filter-special-block . org-export-filter-special-block-functions) + (:filter-src-block . org-export-filter-src-block-functions) + (:filter-statistics-cookie . org-export-filter-statistics-cookie-functions) + (:filter-strike-through . org-export-filter-strike-through-functions) + (:filter-subscript . org-export-filter-subscript-functions) + (:filter-superscript . org-export-filter-superscript-functions) + (:filter-table . org-export-filter-table-functions) + (:filter-table-cell . org-export-filter-table-cell-functions) + (:filter-table-row . org-export-filter-table-row-functions) + (:filter-target . org-export-filter-target-functions) + (:filter-timestamp . org-export-filter-timestamp-functions) + (:filter-underline . org-export-filter-underline-functions) + (:filter-verbatim . org-export-filter-verbatim-functions) + (:filter-verse-block . org-export-filter-verse-block-functions)) + "Alist between filters properties and initial values. + +The key of each association is a property name accessible through +the communication channel. Its value is a configurable global +variable defining initial filters. + +This list is meant to install user specified filters. Back-end +developers may install their own filters using +`org-export-define-backend'. Filters defined there will always +be prepended to the current list, so they always get applied +first.") + +(defconst org-export-default-inline-image-rule + `(("file" . + ,(format "\\.%s\\'" + (regexp-opt + '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" + "xpm" "pbm" "pgm" "ppm") t)))) + "Default rule for link matching an inline image. +This rule applies to links with no description. By default, it +will be considered as an inline image if it targets a local file +whose extension is either \"png\", \"jpeg\", \"jpg\", \"gif\", +\"tiff\", \"tif\", \"xbm\", \"xpm\", \"pbm\", \"pgm\" or \"ppm\". +See `org-export-inline-image-p' for more information about +rules.") + +(defvar org-export-async-debug nil + "Non-nil means asynchronous export process should leave data behind. + +This data is found in the appropriate \"*Org Export Process*\" +buffer, and in files prefixed with \"org-export-process\" and +located in `temporary-file-directory'. + +When non-nil, it will also set `debug-on-error' to a non-nil +value in the external process.") + +(defvar org-export-stack-contents nil + "Record asynchronously generated export results and processes. +This is an alist: its CAR is the source of the +result (destination file or buffer for a finished process, +original buffer for a running one) and its CDR is a list +containing the back-end used, as a symbol, and either a process +or the time at which it finished. It is used to build the menu +from `org-export-stack'.") + +(defvar org-export--registered-backends nil + "List of backends currently available in the exporter. +This variable is set with `org-export-define-backend' and +`org-export-define-derived-backend' functions.") + +(defvar org-export-dispatch-last-action nil + "Last command called from the dispatcher. +The value should be a list. Its CAR is the action, as a symbol, +and its CDR is a list of export options.") + +(defvar org-export-dispatch-last-position (make-marker) + "The position where the last export command was created using the dispatcher. +This marker will be used with `C-u C-c C-e' to make sure export repetition +uses the same subtree if the previous command was restricted to a subtree.") + +;; For compatibility with Org < 8 +(defvar org-export-current-backend nil + "Name, if any, of the back-end used during an export process. + +Its value is a symbol such as `html', `latex', `ascii', or nil if +the back-end is anonymous (see `org-export-create-backend') or if +there is no export process in progress. + +It can be used to teach Babel blocks how to act differently +according to the back-end used.") + + +;;; User-configurable Variables +;; +;; Configuration for the masses. +;; +;; They should never be accessed directly, as their value is to be +;; stored in a property list (cf. `org-export-options-alist'). +;; Back-ends will read their value from there instead. + +(defgroup org-export nil + "Options for exporting Org mode files." + :tag "Org Export" + :group 'org) + +(defgroup org-export-general nil + "General options for export engine." + :tag "Org Export General" + :group 'org-export) + +(defcustom org-export-with-archived-trees 'headline + "Whether sub-trees with the ARCHIVE tag should be exported. + +This can have three different values: +nil Do not export, pretend this tree is not present. +t Do export the entire tree. +`headline' Only export the headline, but skip the tree below it. + +This option can also be set with the OPTIONS keyword, +e.g. \"arch:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "Not at all" nil) + (const :tag "Headline only" headline) + (const :tag "Entirely" t))) + +(defcustom org-export-with-author t + "Non-nil means insert author name into the exported file. +This option can also be set with the OPTIONS keyword, +e.g. \"author:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-clocks nil + "Non-nil means export CLOCK keywords. +This option can also be set with the OPTIONS keyword, +e.g. \"c:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-creator 'comment + "Non-nil means the postamble should contain a creator sentence. + +The sentence can be set in `org-export-creator-string' and +defaults to \"Generated by Org mode XX in Emacs XXX.\". + +If the value is `comment' insert it as a comment." + :group 'org-export-general + :type '(choice + (const :tag "No creator sentence" nil) + (const :tag "Sentence as a comment" comment) + (const :tag "Insert the sentence" t))) + +(defcustom org-export-with-date t + "Non-nil means insert date in the exported document. +This option can also be set with the OPTIONS keyword, +e.g. \"date:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-date-timestamp-format nil + "Time-stamp format string to use for DATE keyword. + +The format string, when specified, only applies if date consists +in a single time-stamp. Otherwise its value will be ignored. + +See `format-time-string' for details on how to build this +string." + :group 'org-export-general + :type '(choice + (string :tag "Time-stamp format string") + (const :tag "No format string" nil))) + +(defcustom org-export-creator-string + (format "Emacs %s (Org mode %s)" + emacs-version + (if (fboundp 'org-version) (org-version) "unknown version")) + "Information about the creator of the document. +This option can also be set on with the CREATOR keyword." + :group 'org-export-general + :type '(string :tag "Creator string")) + +(defcustom org-export-with-drawers '(not "LOGBOOK") + "Non-nil means export contents of standard drawers. + +When t, all drawers are exported. This may also be a list of +drawer names to export. If that list starts with `not', only +drawers with such names will be ignored. + +This variable doesn't apply to properties drawers. + +This option can also be set with the OPTIONS keyword, +e.g. \"d:nil\"." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "All drawers" t) + (const :tag "None" nil) + (repeat :tag "Selected drawers" + (string :tag "Drawer name")) + (list :tag "Ignored drawers" + (const :format "" not) + (repeat :tag "Specify names of drawers to ignore during export" + :inline t + (string :tag "Drawer name"))))) + +(defcustom org-export-with-email nil + "Non-nil means insert author email into the exported file. +This option can also be set with the OPTIONS keyword, +e.g. \"email:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-emphasize t + "Non-nil means interpret *word*, /word/, _word_ and +word+. + +If the export target supports emphasizing text, the word will be +typeset in bold, italic, with an underline or strike-through, +respectively. + +This option can also be set with the OPTIONS keyword, +e.g. \"*:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-exclude-tags '("noexport") + "Tags that exclude a tree from export. + +All trees carrying any of these tags will be excluded from +export. This is without condition, so even subtrees inside that +carry one of the `org-export-select-tags' will be removed. + +This option can also be set with the EXCLUDE_TAGS keyword." + :group 'org-export-general + :type '(repeat (string :tag "Tag"))) + +(defcustom org-export-with-fixed-width t + "Non-nil means lines starting with \":\" will be in fixed width font. + +This can be used to have pre-formatted text, fragments of code +etc. For example: + : ;; Some Lisp examples + : (while (defc cnt) + : (ding)) +will be looking just like this in also HTML. See also the QUOTE +keyword. Not all export backends support this. + +This option can also be set with the OPTIONS keyword, +e.g. \"::nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-footnotes t + "Non-nil means Org footnotes should be exported. +This option can also be set with the OPTIONS keyword, +e.g. \"f:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-latex t + "Non-nil means process LaTeX environments and fragments. + +This option can also be set with the OPTIONS line, +e.g. \"tex:verbatim\". Allowed values are: + +nil Ignore math snippets. +`verbatim' Keep everything in verbatim. +t Allow export of math snippets." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Do not process math in any way" nil) + (const :tag "Interpret math snippets" t) + (const :tag "Leave math verbatim" verbatim))) + +(defcustom org-export-headline-levels 3 + "The last level which is still exported as a headline. + +Inferior levels will usually produce itemize or enumerate lists +when exported, but back-end behaviour may differ. + +This option can also be set with the OPTIONS keyword, +e.g. \"H:2\"." + :group 'org-export-general + :type 'integer) + +(defcustom org-export-default-language "en" + "The default language for export and clocktable translations, as a string. +This may have an association in +`org-clock-clocktable-language-setup', +`org-export-smart-quotes-alist' and `org-export-dictionary'. +This option can also be set with the LANGUAGE keyword." + :group 'org-export-general + :type '(string :tag "Language")) + +(defcustom org-export-preserve-breaks nil + "Non-nil means preserve all line breaks when exporting. +This option can also be set with the OPTIONS keyword, +e.g. \"\\n:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-entities t + "Non-nil means interpret entities when exporting. + +For example, HTML export converts \\alpha to α and \\AA to +Å. + +For a list of supported names, see the constant `org-entities' +and the user option `org-entities-user'. + +This option can also be set with the OPTIONS keyword, +e.g. \"e:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-inlinetasks t + "Non-nil means inlinetasks should be exported. +This option can also be set with the OPTIONS keyword, +e.g. \"inline:nil\"." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-with-planning nil + "Non-nil means include planning info in export. + +Planning info is the line containing either SCHEDULED:, +DEADLINE:, CLOSED: time-stamps, or a combination of them. + +This option can also be set with the OPTIONS keyword, +e.g. \"p:t\"." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-with-priority nil + "Non-nil means include priority cookies in export. +This option can also be set with the OPTIONS keyword, +e.g. \"pri:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-section-numbers t + "Non-nil means add section numbers to headlines when exporting. + +When set to an integer n, numbering will only happen for +headlines whose relative level is higher or equal to n. + +This option can also be set with the OPTIONS keyword, +e.g. \"num:t\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-select-tags '("export") + "Tags that select a tree for export. + +If any such tag is found in a buffer, all trees that do not carry +one of these tags will be ignored during export. Inside trees +that are selected like this, you can still deselect a subtree by +tagging it with one of the `org-export-exclude-tags'. + +This option can also be set with the SELECT_TAGS keyword." + :group 'org-export-general + :type '(repeat (string :tag "Tag"))) + +(defcustom org-export-with-smart-quotes nil + "Non-nil means activate smart quotes during export. +This option can also be set with the OPTIONS keyword, +e.g., \"':t\". + +When setting this to non-nil, you need to take care of +using the correct Babel package when exporting to LaTeX. +E.g., you can load Babel for french like this: + +#+LATEX_HEADER: \\usepackage[french]{babel}" + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-with-special-strings t + "Non-nil means interpret \"\\-\", \"--\" and \"---\" for export. + +When this option is turned on, these strings will be exported as: + + Org HTML LaTeX UTF-8 + -----+----------+--------+------- + \\- ­ \\- + -- – -- – + --- — --- — + ... … \\ldots … + +This option can also be set with the OPTIONS keyword, +e.g. \"-:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-statistics-cookies t + "Non-nil means include statistics cookies in export. +This option can also be set with the OPTIONS keyword, +e.g. \"stat:nil\"" + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-with-sub-superscripts t + "Non-nil means interpret \"_\" and \"^\" for export. + +If you want to control how Org displays those characters, see +`org-use-sub-superscripts'. `org-export-with-sub-superscripts' +used to be an alias for `org-use-sub-superscripts' in Org <8.0, +it is not anymore. + +When this option is turned on, you can use TeX-like syntax for +sub- and superscripts and see them exported correctly. + +You can also set the option with #+OPTIONS: ^:t + +Several characters after \"_\" or \"^\" will be considered as a +single item - so grouping with {} is normally not needed. For +example, the following things will be parsed as single sub- or +superscripts: + + 10^24 or 10^tau several digits will be considered 1 item. + 10^-12 or 10^-tau a leading sign with digits or a word + x^2-y^3 will be read as x^2 - y^3, because items are + terminated by almost any nonword/nondigit char. + x_{i^2} or x^(2-i) braces or parenthesis do grouping. + +Still, ambiguity is possible. So when in doubt, use {} to enclose +the sub/superscript. If you set this variable to the symbol `{}', +the braces are *required* in order to trigger interpretations as +sub/superscript. This can be helpful in documents that need \"_\" +frequently in plain text." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(choice + (const :tag "Interpret them" t) + (const :tag "Curly brackets only" {}) + (const :tag "Do not interpret them" nil))) + +(defcustom org-export-with-toc t + "Non-nil means create a table of contents in exported files. + +The TOC contains headlines with levels up +to`org-export-headline-levels'. When an integer, include levels +up to N in the toc, this may then be different from +`org-export-headline-levels', but it will not be allowed to be +larger than the number of headline levels. When nil, no table of +contents is made. + +This option can also be set with the OPTIONS keyword, +e.g. \"toc:nil\" or \"toc:3\"." + :group 'org-export-general + :type '(choice + (const :tag "No Table of Contents" nil) + (const :tag "Full Table of Contents" t) + (integer :tag "TOC to level"))) + +(defcustom org-export-with-tables t + "If non-nil, lines starting with \"|\" define a table. +For example: + + | Name | Address | Birthday | + |-------------+----------+-----------| + | Arthur Dent | England | 29.2.2100 | + +This option can also be set with the OPTIONS keyword, +e.g. \"|:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-tags t + "If nil, do not export tags, just remove them from headlines. + +If this is the symbol `not-in-toc', tags will be removed from +table of contents entries, but still be shown in the headlines of +the document. + +This option can also be set with the OPTIONS keyword, +e.g. \"tags:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "Off" nil) + (const :tag "Not in TOC" not-in-toc) + (const :tag "On" t))) + +(defcustom org-export-with-tasks t + "Non-nil means include TODO items for export. + +This may have the following values: +t include tasks independent of state. +`todo' include only tasks that are not yet done. +`done' include only tasks that are already done. +nil ignore all tasks. +list of keywords include tasks with these keywords. + +This option can also be set with the OPTIONS keyword, +e.g. \"tasks:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "All tasks" t) + (const :tag "No tasks" nil) + (const :tag "Not-done tasks" todo) + (const :tag "Only done tasks" done) + (repeat :tag "Specific TODO keywords" + (string :tag "Keyword")))) + +(defcustom org-export-time-stamp-file t + "Non-nil means insert a time stamp into the exported file. +The time stamp shows when the file was created. This option can +also be set with the OPTIONS keyword, e.g. \"timestamp:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-with-timestamps t + "Non nil means allow timestamps in export. + +It can be set to any of the following values: + t export all timestamps. + `active' export active timestamps only. + `inactive' export inactive timestamps only. + nil do not export timestamps + +This only applies to timestamps isolated in a paragraph +containing only timestamps. Other timestamps are always +exported. + +This option can also be set with the OPTIONS keyword, e.g. +\"<:nil\"." + :group 'org-export-general + :type '(choice + (const :tag "All timestamps" t) + (const :tag "Only active timestamps" active) + (const :tag "Only inactive timestamps" inactive) + (const :tag "No timestamp" nil))) + +(defcustom org-export-with-todo-keywords t + "Non-nil means include TODO keywords in export. +When nil, remove all these keywords from the export. This option +can also be set with the OPTIONS keyword, e.g. \"todo:nil\"." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-allow-bind-keywords nil + "Non-nil means BIND keywords can define local variable values. +This is a potential security risk, which is why the default value +is nil. You can also allow them through local buffer variables." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-snippet-translation-alist nil + "Alist between export snippets back-ends and exporter back-ends. + +This variable allows to provide shortcuts for export snippets. + +For example, with a value of '\(\(\"h\" . \"html\"\)\), the +HTML back-end will recognize the contents of \"@@h:@@\" as +HTML code while every other back-end will ignore it." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(repeat + (cons (string :tag "Shortcut") + (string :tag "Back-end")))) + +(defcustom org-export-coding-system nil + "Coding system for the exported file." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'coding-system) + +(defcustom org-export-copy-to-kill-ring 'if-interactive + "Non-nil means pushing export output to the kill ring. +This variable is ignored during asynchronous export." + :group 'org-export-general + :version "24.3" + :type '(choice + (const :tag "Always" t) + (const :tag "When export is done interactively" if-interactive) + (const :tag "Never" nil))) + +(defcustom org-export-initial-scope 'buffer + "The initial scope when exporting with `org-export-dispatch'. +This variable can be either set to `buffer' or `subtree'." + :group 'org-export-general + :type '(choice + (const :tag "Export current buffer" buffer) + (const :tag "Export current subtree" subtree))) + +(defcustom org-export-show-temporary-export-buffer t + "Non-nil means show buffer after exporting to temp buffer. +When Org exports to a file, the buffer visiting that file is never +shown, but remains buried. However, when exporting to +a temporary buffer, that buffer is popped up in a second window. +When this variable is nil, the buffer remains buried also in +these cases." + :group 'org-export-general + :type 'boolean) + +(defcustom org-export-in-background nil + "Non-nil means export and publishing commands will run in background. +Results from an asynchronous export are never displayed +automatically. But you can retrieve them with \\[org-export-stack]." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + +(defcustom org-export-async-init-file user-init-file + "File used to initialize external export process. +Value must be an absolute file name. It defaults to user's +initialization file. Though, a specific configuration makes the +process faster and the export more portable." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type '(file :must-match t)) + +(defcustom org-export-dispatch-use-expert-ui nil + "Non-nil means using a non-intrusive `org-export-dispatch'. +In that case, no help buffer is displayed. Though, an indicator +for current export scope is added to the prompt (\"b\" when +output is restricted to body only, \"s\" when it is restricted to +the current subtree, \"v\" when only visible elements are +considered for export, \"f\" when publishing functions should be +passed the FORCE argument and \"a\" when the export should be +asynchronous). Also, \[?] allows to switch back to standard +mode." + :group 'org-export-general + :version "24.4" + :package-version '(Org . "8.0") + :type 'boolean) + + + +;;; Defining Back-ends +;; +;; An export back-end is a structure with `org-export-backend' type +;; and `name', `parent', `transcoders', `options', `filters', `blocks' +;; and `menu' slots. +;; +;; At the lowest level, a back-end is created with +;; `org-export-create-backend' function. +;; +;; A named back-end can be registered with +;; `org-export-register-backend' function. A registered back-end can +;; later be referred to by its name, with `org-export-get-backend' +;; function. Also, such a back-end can become the parent of a derived +;; back-end from which slot values will be inherited by default. +;; `org-export-derived-backend-p' can check if a given back-end is +;; derived from a list of back-end names. +;; +;; `org-export-get-all-transcoders', `org-export-get-all-options' and +;; `org-export-get-all-filters' return the full alist of transcoders, +;; options and filters, including those inherited from ancestors. +;; +;; At a higher level, `org-export-define-backend' is the standard way +;; to define an export back-end. If the new back-end is similar to +;; a registered back-end, `org-export-define-derived-backend' may be +;; used instead. +;; +;; Eventually `org-export-barf-if-invalid-backend' returns an error +;; when a given back-end hasn't been registered yet. + +(defstruct (org-export-backend (:constructor org-export-create-backend) + (:copier nil)) + name parent transcoders options filters blocks menu) + +(defun org-export-get-backend (name) + "Return export back-end named after NAME. +NAME is a symbol. Return nil if no such back-end is found." + (catch 'found + (dolist (b org-export--registered-backends) + (when (eq (org-export-backend-name b) name) + (throw 'found b))))) + +(defun org-export-register-backend (backend) + "Register BACKEND as a known export back-end. +BACKEND is a structure with `org-export-backend' type." + ;; Refuse to register an unnamed back-end. + (unless (org-export-backend-name backend) + (error "Cannot register a unnamed export back-end")) + ;; Refuse to register a back-end with an unknown parent. + (let ((parent (org-export-backend-parent backend))) + (when (and parent (not (org-export-get-backend parent))) + (error "Cannot use unknown \"%s\" back-end as a parent" parent))) + ;; Register dedicated export blocks in the parser. + (dolist (name (org-export-backend-blocks backend)) + (add-to-list 'org-element-block-name-alist + (cons name 'org-element-export-block-parser))) + ;; If a back-end with the same name as BACKEND is already + ;; registered, replace it with BACKEND. Otherwise, simply add + ;; BACKEND to the list of registered back-ends. + (let ((old (org-export-get-backend (org-export-backend-name backend)))) + (if old (setcar (memq old org-export--registered-backends) backend) + (push backend org-export--registered-backends)))) + +(defun org-export-barf-if-invalid-backend (backend) + "Signal an error if BACKEND isn't defined." + (unless (org-export-backend-p backend) + (error "Unknown \"%s\" back-end: Aborting export" backend))) + +(defun org-export-derived-backend-p (backend &rest backends) + "Non-nil if BACKEND is derived from one of BACKENDS. +BACKEND is an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. BACKENDS is constituted of symbols." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (catch 'exit + (while (org-export-backend-parent backend) + (when (memq (org-export-backend-name backend) backends) + (throw 'exit t)) + (setq backend + (org-export-get-backend (org-export-backend-parent backend)))) + (memq (org-export-backend-name backend) backends)))) + +(defun org-export-get-all-transcoders (backend) + "Return full translation table for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. Return value is an alist where +keys are element or object types, as symbols, and values are +transcoders. + +Unlike to `org-export-backend-transcoders', this function +also returns transcoders inherited from parent back-ends, +if any." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((transcoders (org-export-backend-transcoders backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq transcoders + (append transcoders (org-export-backend-transcoders backend)))) + transcoders))) + +(defun org-export-get-all-options (backend) + "Return export options for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. See `org-export-options-alist' +for the shape of the return value. + +Unlike to `org-export-backend-options', this function also +returns options inherited from parent back-ends, if any." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((options (org-export-backend-options backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq options (append options (org-export-backend-options backend)))) + options))) + +(defun org-export-get-all-filters (backend) + "Return complete list of filters for BACKEND. + +BACKEND is an export back-end, as return by, e.g,, +`org-export-create-backend'. Return value is an alist where +keys are symbols and values lists of functions. + +Unlike to `org-export-backend-filters', this function also +returns filters inherited from parent back-ends, if any." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (when backend + (let ((filters (org-export-backend-filters backend)) + parent) + (while (setq parent (org-export-backend-parent backend)) + (setq backend (org-export-get-backend parent)) + (setq filters (append filters (org-export-backend-filters backend)))) + filters))) + +(defun org-export-define-backend (backend transcoders &rest body) + "Define a new back-end BACKEND. + +TRANSCODERS is an alist between object or element types and +functions handling them. + +These functions should return a string without any trailing +space, or nil. They must accept three arguments: the object or +element itself, its contents or nil when it isn't recursive and +the property list used as a communication channel. + +Contents, when not nil, are stripped from any global indentation +\(although the relative one is preserved). They also always end +with a single newline character. + +If, for a given type, no function is found, that element or +object type will simply be ignored, along with any blank line or +white space at its end. The same will happen if the function +returns the nil value. If that function returns the empty +string, the type will be ignored, but the blank lines or white +spaces will be kept. + +In addition to element and object types, one function can be +associated to the `template' (or `inner-template') symbol and +another one to the `plain-text' symbol. + +The former returns the final transcoded string, and can be used +to add a preamble and a postamble to document's body. It must +accept two arguments: the transcoded string and the property list +containing export options. A function associated to `template' +will not be applied if export has option \"body-only\". +A function associated to `inner-template' is always applied. + +The latter, when defined, is to be called on every text not +recognized as an element or an object. It must accept two +arguments: the text string and the information channel. It is an +appropriate place to protect special chars relative to the +back-end. + +BODY can start with pre-defined keyword arguments. The following +keywords are understood: + + :export-block + + String, or list of strings, representing block names that + will not be parsed. This is used to specify blocks that will + contain raw code specific to the back-end. These blocks + still have to be handled by the relative `export-block' type + translator. + + :filters-alist + + Alist between filters and function, or list of functions, + specific to the back-end. See `org-export-filters-alist' for + a list of all allowed filters. Filters defined here + shouldn't make a back-end test, as it may prevent back-ends + derived from this one to behave properly. + + :menu-entry + + Menu entry for the export dispatcher. It should be a list + like: + + '(KEY DESCRIPTION-OR-ORDINAL ACTION-OR-MENU) + + where : + + KEY is a free character selecting the back-end. + + DESCRIPTION-OR-ORDINAL is either a string or a number. + + If it is a string, is will be used to name the back-end in + its menu entry. If it is a number, the following menu will + be displayed as a sub-menu of the back-end with the same + KEY. Also, the number will be used to determine in which + order such sub-menus will appear (lowest first). + + ACTION-OR-MENU is either a function or an alist. + + If it is an action, it will be called with four + arguments (booleans): ASYNC, SUBTREEP, VISIBLE-ONLY and + BODY-ONLY. See `org-export-as' for further explanations on + some of them. + + If it is an alist, associations should follow the + pattern: + + '(KEY DESCRIPTION ACTION) + + where KEY, DESCRIPTION and ACTION are described above. + + Valid values include: + + '(?m \"My Special Back-end\" my-special-export-function) + + or + + '(?l \"Export to LaTeX\" + \(?p \"As PDF file\" org-latex-export-to-pdf) + \(?o \"As PDF file and open\" + \(lambda (a s v b) + \(if a (org-latex-export-to-pdf t s v b) + \(org-open-file + \(org-latex-export-to-pdf nil s v b))))))) + + or the following, which will be added to the previous + sub-menu, + + '(?l 1 + \((?B \"As TEX buffer (Beamer)\" org-beamer-export-as-latex) + \(?P \"As PDF file (Beamer)\" org-beamer-export-to-pdf))) + + :options-alist + + Alist between back-end specific properties introduced in + communication channel and how their value are acquired. See + `org-export-options-alist' for more information about + structure of the values." + (declare (indent 1)) + (let (blocks filters menu-entry options contents) + (while (keywordp (car body)) + (case (pop body) + (:export-block (let ((names (pop body))) + (setq blocks (if (consp names) (mapcar 'upcase names) + (list (upcase names)))))) + (:filters-alist (setq filters (pop body))) + (:menu-entry (setq menu-entry (pop body))) + (:options-alist (setq options (pop body))) + (t (pop body)))) + (org-export-register-backend + (org-export-create-backend :name backend + :transcoders transcoders + :options options + :filters filters + :blocks blocks + :menu menu-entry)))) + +(defun org-export-define-derived-backend (child parent &rest body) + "Create a new back-end as a variant of an existing one. + +CHILD is the name of the derived back-end. PARENT is the name of +the parent back-end. + +BODY can start with pre-defined keyword arguments. The following +keywords are understood: + + :export-block + + String, or list of strings, representing block names that + will not be parsed. This is used to specify blocks that will + contain raw code specific to the back-end. These blocks + still have to be handled by the relative `export-block' type + translator. + + :filters-alist + + Alist of filters that will overwrite or complete filters + defined in PARENT back-end. See `org-export-filters-alist' + for a list of allowed filters. + + :menu-entry + + Menu entry for the export dispatcher. See + `org-export-define-backend' for more information about the + expected value. + + :options-alist + + Alist of back-end specific properties that will overwrite or + complete those defined in PARENT back-end. Refer to + `org-export-options-alist' for more information about + structure of the values. + + :translate-alist + + Alist of element and object types and transcoders that will + overwrite or complete transcode table from PARENT back-end. + Refer to `org-export-define-backend' for detailed information + about transcoders. + +As an example, here is how one could define \"my-latex\" back-end +as a variant of `latex' back-end with a custom template function: + + \(org-export-define-derived-backend 'my-latex 'latex + :translate-alist '((template . my-latex-template-fun))) + +The back-end could then be called with, for example: + + \(org-export-to-buffer 'my-latex \"*Test my-latex*\")" + (declare (indent 2)) + (let (blocks filters menu-entry options transcoders contents) + (while (keywordp (car body)) + (case (pop body) + (:export-block (let ((names (pop body))) + (setq blocks (if (consp names) (mapcar 'upcase names) + (list (upcase names)))))) + (:filters-alist (setq filters (pop body))) + (:menu-entry (setq menu-entry (pop body))) + (:options-alist (setq options (pop body))) + (:translate-alist (setq transcoders (pop body))) + (t (pop body)))) + (org-export-register-backend + (org-export-create-backend :name child + :parent parent + :transcoders transcoders + :options options + :filters filters + :blocks blocks + :menu menu-entry)))) + + + +;;; The Communication Channel +;; +;; During export process, every function has access to a number of +;; properties. They are of two types: +;; +;; 1. Environment options are collected once at the very beginning of +;; the process, out of the original buffer and configuration. +;; Collecting them is handled by `org-export-get-environment' +;; function. +;; +;; Most environment options are defined through the +;; `org-export-options-alist' variable. +;; +;; 2. Tree properties are extracted directly from the parsed tree, +;; just before export, by `org-export-collect-tree-properties'. +;; +;; Here is the full list of properties available during transcode +;; process, with their category and their value type. +;; +;; + `:author' :: Author's name. +;; - category :: option +;; - type :: string +;; +;; + `:back-end' :: Current back-end used for transcoding. +;; - category :: tree +;; - type :: symbol +;; +;; + `:creator' :: String to write as creation information. +;; - category :: option +;; - type :: string +;; +;; + `:date' :: String to use as date. +;; - category :: option +;; - type :: string +;; +;; + `:description' :: Description text for the current data. +;; - category :: option +;; - type :: string +;; +;; + `:email' :: Author's email. +;; - category :: option +;; - type :: string +;; +;; + `:exclude-tags' :: Tags for exclusion of subtrees from export +;; process. +;; - category :: option +;; - type :: list of strings +;; +;; + `:export-options' :: List of export options available for current +;; process. +;; - category :: none +;; - type :: list of symbols, among `subtree', `body-only' and +;; `visible-only'. +;; +;; + `:exported-data' :: Hash table used for memoizing +;; `org-export-data'. +;; - category :: tree +;; - type :: hash table +;; +;; + `:filetags' :: List of global tags for buffer. Used by +;; `org-export-get-tags' to get tags with inheritance. +;; - category :: option +;; - type :: list of strings +;; +;; + `:footnote-definition-alist' :: Alist between footnote labels and +;; their definition, as parsed data. Only non-inlined footnotes +;; are represented in this alist. Also, every definition isn't +;; guaranteed to be referenced in the parse tree. The purpose of +;; this property is to preserve definitions from oblivion +;; (i.e. when the parse tree comes from a part of the original +;; buffer), it isn't meant for direct use in a back-end. To +;; retrieve a definition relative to a reference, use +;; `org-export-get-footnote-definition' instead. +;; - category :: option +;; - type :: alist (STRING . LIST) +;; +;; + `:headline-levels' :: Maximum level being exported as an +;; headline. Comparison is done with the relative level of +;; headlines in the parse tree, not necessarily with their +;; actual level. +;; - category :: option +;; - type :: integer +;; +;; + `:headline-offset' :: Difference between relative and real level +;; of headlines in the parse tree. For example, a value of -1 +;; means a level 2 headline should be considered as level +;; 1 (cf. `org-export-get-relative-level'). +;; - category :: tree +;; - type :: integer +;; +;; + `:headline-numbering' :: Alist between headlines and their +;; numbering, as a list of numbers +;; (cf. `org-export-get-headline-number'). +;; - category :: tree +;; - type :: alist (INTEGER . LIST) +;; +;; + `:id-alist' :: Alist between ID strings and destination file's +;; path, relative to current directory. It is used by +;; `org-export-resolve-id-link' to resolve ID links targeting an +;; external file. +;; - category :: option +;; - type :: alist (STRING . STRING) +;; +;; + `:ignore-list' :: List of elements and objects that should be +;; ignored during export. +;; - category :: tree +;; - type :: list of elements and objects +;; +;; + `:input-buffer' :: Name of input buffer. +;; - category :: option +;; - type :: string +;; +;; + `:input-file' :: Full path to input file, if any. +;; - category :: option +;; - type :: string or nil +;; +;; + `:keywords' :: List of keywords attached to data. +;; - category :: option +;; - type :: string +;; +;; + `:language' :: Default language used for translations. +;; - category :: option +;; - type :: string +;; +;; + `:output-file' :: Full path to output file, if any. +;; - category :: option +;; - type :: string or nil +;; +;; + `:parse-tree' :: Whole parse tree, available at any time during +;; transcoding. +;; - category :: option +;; - type :: list (as returned by `org-element-parse-buffer') +;; +;; + `:preserve-breaks' :: Non-nil means transcoding should preserve +;; all line breaks. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:section-numbers' :: Non-nil means transcoding should add +;; section numbers to headlines. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:select-tags' :: List of tags enforcing inclusion of sub-trees +;; in transcoding. When such a tag is present, subtrees without +;; it are de facto excluded from the process. See +;; `use-select-tags'. +;; - category :: option +;; - type :: list of strings +;; +;; + `:time-stamp-file' :: Non-nil means transcoding should insert +;; a time stamp in the output. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:translate-alist' :: Alist between element and object types and +;; transcoding functions relative to the current back-end. +;; Special keys `inner-template', `template' and `plain-text' are +;; also possible. +;; - category :: option +;; - type :: alist (SYMBOL . FUNCTION) +;; +;; + `:with-archived-trees' :: Non-nil when archived subtrees should +;; also be transcoded. If it is set to the `headline' symbol, +;; only the archived headline's name is retained. +;; - category :: option +;; - type :: symbol (nil, t, `headline') +;; +;; + `:with-author' :: Non-nil means author's name should be included +;; in the output. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-clocks' :: Non-nil means clock keywords should be exported. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-creator' :: Non-nil means a creation sentence should be +;; inserted at the end of the transcoded string. If the value +;; is `comment', it should be commented. +;; - category :: option +;; - type :: symbol (`comment', nil, t) +;; +;; + `:with-date' :: Non-nil means output should contain a date. +;; - category :: option +;; - type :. symbol (nil, t) +;; +;; + `:with-drawers' :: Non-nil means drawers should be exported. If +;; its value is a list of names, only drawers with such names +;; will be transcoded. If that list starts with `not', drawer +;; with these names will be skipped. +;; - category :: option +;; - type :: symbol (nil, t) or list of strings +;; +;; + `:with-email' :: Non-nil means output should contain author's +;; email. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-emphasize' :: Non-nil means emphasized text should be +;; interpreted. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-fixed-width' :: Non-nil if transcoder should interpret +;; strings starting with a colon as a fixed-with (verbatim) area. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-footnotes' :: Non-nil if transcoder should interpret +;; footnotes. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-latex' :: Non-nil means `latex-environment' elements and +;; `latex-fragment' objects should appear in export output. When +;; this property is set to `verbatim', they will be left as-is. +;; - category :: option +;; - type :: symbol (`verbatim', nil, t) +;; +;; + `:with-planning' :: Non-nil means transcoding should include +;; planning info. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-priority' :: Non-nil means transcoding should include +;; priority cookies. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-smart-quotes' :: Non-nil means activate smart quotes in +;; plain text. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-special-strings' :: Non-nil means transcoding should +;; interpret special strings in plain text. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-sub-superscript' :: Non-nil means transcoding should +;; interpret subscript and superscript. With a value of "{}", +;; only interpret those using curly brackets. +;; - category :: option +;; - type :: symbol (nil, {}, t) +;; +;; + `:with-tables' :: Non-nil means transcoding should interpret +;; tables. +;; - category :: option +;; - type :: symbol (nil, t) +;; +;; + `:with-tags' :: Non-nil means transcoding should keep tags in +;; headlines. A `not-in-toc' value will remove them from the +;; table of contents, if any, nonetheless. +;; - category :: option +;; - type :: symbol (nil, t, `not-in-toc') +;; +;; + `:with-tasks' :: Non-nil means transcoding should include +;; headlines with a TODO keyword. A `todo' value will only +;; include headlines with a todo type keyword while a `done' +;; value will do the contrary. If a list of strings is provided, +;; only tasks with keywords belonging to that list will be kept. +;; - category :: option +;; - type :: symbol (t, todo, done, nil) or list of strings +;; +;; + `:with-timestamps' :: Non-nil means transcoding should include +;; time stamps. Special value `active' (resp. `inactive') ask to +;; export only active (resp. inactive) timestamps. Otherwise, +;; completely remove them. +;; - category :: option +;; - type :: symbol: (`active', `inactive', t, nil) +;; +;; + `:with-toc' :: Non-nil means that a table of contents has to be +;; added to the output. An integer value limits its depth. +;; - category :: option +;; - type :: symbol (nil, t or integer) +;; +;; + `:with-todo-keywords' :: Non-nil means transcoding should +;; include TODO keywords. +;; - category :: option +;; - type :: symbol (nil, t) + + +;;;; Environment Options +;; +;; Environment options encompass all parameters defined outside the +;; scope of the parsed data. They come from five sources, in +;; increasing precedence order: +;; +;; - Global variables, +;; - Buffer's attributes, +;; - Options keyword symbols, +;; - Buffer keywords, +;; - Subtree properties. +;; +;; The central internal function with regards to environment options +;; is `org-export-get-environment'. It updates global variables with +;; "#+BIND:" keywords, then retrieve and prioritize properties from +;; the different sources. +;; +;; The internal functions doing the retrieval are: +;; `org-export--get-global-options', +;; `org-export--get-buffer-attributes', +;; `org-export--parse-option-keyword', +;; `org-export--get-subtree-options' and +;; `org-export--get-inbuffer-options' +;; +;; Also, `org-export--list-bound-variables' collects bound variables +;; along with their value in order to set them as buffer local +;; variables later in the process. + +(defun org-export-get-environment (&optional backend subtreep ext-plist) + "Collect export options from the current buffer. + +Optional argument BACKEND is an export back-end, as returned by +`org-export-create-backend'. + +When optional argument SUBTREEP is non-nil, assume the export is +done against the current sub-tree. + +Third optional argument EXT-PLIST is a property list with +external parameters overriding Org default settings, but still +inferior to file-local settings." + ;; First install #+BIND variables since these must be set before + ;; global options are read. + (dolist (pair (org-export--list-bound-variables)) + (org-set-local (car pair) (nth 1 pair))) + ;; Get and prioritize export options... + (org-combine-plists + ;; ... from global variables... + (org-export--get-global-options backend) + ;; ... from an external property list... + ext-plist + ;; ... from in-buffer settings... + (org-export--get-inbuffer-options backend) + ;; ... and from subtree, when appropriate. + (and subtreep (org-export--get-subtree-options backend)) + ;; Eventually add misc. properties. + (list + :back-end + backend + :translate-alist (org-export-get-all-transcoders backend) + :footnote-definition-alist + ;; Footnotes definitions must be collected in the original + ;; buffer, as there's no insurance that they will still be in + ;; the parse tree, due to possible narrowing. + (let (alist) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward org-footnote-definition-re nil t) + (let ((def (save-match-data (org-element-at-point)))) + (when (eq (org-element-type def) 'footnote-definition) + (push + (cons (org-element-property :label def) + (let ((cbeg (org-element-property :contents-begin def))) + (when cbeg + (org-element--parse-elements + cbeg (org-element-property :contents-end def) + nil nil nil nil (list 'org-data nil))))) + alist)))) + alist)) + :id-alist + ;; Collect id references. + (let (alist) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward "\\[\\[id:\\S-+?\\]" nil t) + (let ((link (org-element-context))) + (when (eq (org-element-type link) 'link) + (let* ((id (org-element-property :path link)) + (file (org-id-find-id-file id))) + (when file + (push (cons id (file-relative-name file)) alist))))))) + alist)))) + +(defun org-export--parse-option-keyword (options &optional backend) + "Parse an OPTIONS line and return values as a plist. +Optional argument BACKEND is an export back-end, as returned by, +e.g., `org-export-create-backend'. It specifies which back-end +specific items to read, if any." + (let* ((all + ;; Priority is given to back-end specific options. + (append (and backend (org-export-get-all-options backend)) + org-export-options-alist)) + plist) + (dolist (option all) + (let ((property (car option)) + (item (nth 2 option))) + (when (and item + (not (plist-member plist property)) + (string-match (concat "\\(\\`\\|[ \t]\\)" + (regexp-quote item) + ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)") + options)) + (setq plist (plist-put plist + property + (car (read-from-string + (match-string 2 options)))))))) + plist)) + +(defun org-export--get-subtree-options (&optional backend) + "Get export options in subtree at point. +Optional argument BACKEND is an export back-end, as returned by, +e.g., `org-export-create-backend'. It specifies back-end used +for export. Return options as a plist." + ;; For each buffer keyword, create a headline property setting the + ;; same property in communication channel. The name for the property + ;; is the keyword with "EXPORT_" appended to it. + (org-with-wide-buffer + (let (prop plist) + ;; Make sure point is at a heading. + (if (org-at-heading-p) (org-up-heading-safe) (org-back-to-heading t)) + ;; Take care of EXPORT_TITLE. If it isn't defined, use headline's + ;; title (with no todo keyword, priority cookie or tag) as its + ;; fallback value. + (when (setq prop (or (org-entry-get (point) "EXPORT_TITLE") + (progn (looking-at org-complex-heading-regexp) + (org-match-string-no-properties 4)))) + (setq plist + (plist-put + plist :title + (org-element-parse-secondary-string + prop (org-element-restriction 'keyword))))) + ;; EXPORT_OPTIONS are parsed in a non-standard way. + (when (setq prop (org-entry-get (point) "EXPORT_OPTIONS")) + (setq plist + (nconc plist (org-export--parse-option-keyword prop backend)))) + ;; Handle other keywords. TITLE keyword is excluded as it has + ;; been handled already. + (let ((seen '("TITLE"))) + (mapc + (lambda (option) + (let ((property (car option)) + (keyword (nth 1 option))) + (when (and keyword (not (member keyword seen))) + (let* ((subtree-prop (concat "EXPORT_" keyword)) + ;; Export properties are not case-sensitive. + (value (let ((case-fold-search t)) + (org-entry-get (point) subtree-prop)))) + (push keyword seen) + (when (and value (not (plist-member plist property))) + (setq plist + (plist-put + plist + property + (cond + ;; Parse VALUE if required. + ((member keyword org-element-document-properties) + (org-element-parse-secondary-string + value (org-element-restriction 'keyword))) + ;; If BEHAVIOR is `split' expected value is + ;; a list of strings, not a string. + ((eq (nth 4 option) 'split) (org-split-string value)) + (t value))))))))) + ;; Look for both general keywords and back-end specific + ;; options, with priority given to the latter. + (append (and backend (org-export-get-all-options backend)) + org-export-options-alist))) + ;; Return value. + plist))) + +(defun org-export--get-inbuffer-options (&optional backend) + "Return current buffer export options, as a plist. + +Optional argument BACKEND, when non-nil, is an export back-end, +as returned by, e.g., `org-export-create-backend'. It specifies +which back-end specific options should also be read in the +process. + +Assume buffer is in Org mode. Narrowing, if any, is ignored." + (let* (plist + get-options ; For byte-compiler. + (case-fold-search t) + (options (append + ;; Priority is given to back-end specific options. + (and backend (org-export-get-all-options backend)) + org-export-options-alist)) + (regexp (format "^[ \t]*#\\+%s:" + (regexp-opt (nconc (delq nil (mapcar 'cadr options)) + org-export-special-keywords)))) + (find-properties + (lambda (keyword) + ;; Return all properties associated to KEYWORD. + (let (properties) + (dolist (option options properties) + (when (equal (nth 1 option) keyword) + (pushnew (car option) properties)))))) + (get-options + (lambda (&optional files plist) + ;; Recursively read keywords in buffer. FILES is a list + ;; of files read so far. PLIST is the current property + ;; list obtained. + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((key (org-element-property :key element)) + (val (org-element-property :value element))) + (cond + ;; Options in `org-export-special-keywords'. + ((equal key "SETUPFILE") + (let ((file (expand-file-name + (org-remove-double-quotes (org-trim val))))) + ;; Avoid circular dependencies. + (unless (member file files) + (with-temp-buffer + (insert (org-file-contents file 'noerror)) + (let ((org-inhibit-startup t)) (org-mode)) + (setq plist (funcall get-options + (cons file files) plist)))))) + ((equal key "OPTIONS") + (setq plist + (org-combine-plists + plist + (org-export--parse-option-keyword val backend)))) + ((equal key "FILETAGS") + (setq plist + (org-combine-plists + plist + (list :filetags + (org-uniquify + (append (org-split-string val ":") + (plist-get plist :filetags))))))) + (t + ;; Options in `org-export-options-alist'. + (dolist (property (funcall find-properties key)) + (let ((behaviour (nth 4 (assq property options)))) + (setq plist + (plist-put + plist property + ;; Handle value depending on specified + ;; BEHAVIOR. + (case behaviour + (space + (if (not (plist-get plist property)) + (org-trim val) + (concat (plist-get plist property) + " " + (org-trim val)))) + (newline + (org-trim + (concat (plist-get plist property) + "\n" + (org-trim val)))) + (split `(,@(plist-get plist property) + ,@(org-split-string val))) + ('t val) + (otherwise + (if (not (plist-member plist property)) val + (plist-get plist property)))))))))))))) + ;; Return final value. + plist)))) + ;; Read options in the current buffer. + (setq plist (funcall get-options + (and buffer-file-name (list buffer-file-name)) nil)) + ;; Parse keywords specified in `org-element-document-properties' + ;; and return PLIST. + (dolist (keyword org-element-document-properties plist) + (dolist (property (funcall find-properties keyword)) + (let ((value (plist-get plist property))) + (when (stringp value) + (setq plist + (plist-put plist property + (or (org-element-parse-secondary-string + value (org-element-restriction 'keyword)) + ;; When TITLE keyword sets an empty + ;; string, make sure it doesn't + ;; appear as nil in the plist. + (and (eq property :title) "")))))))))) + +(defun org-export--get-buffer-attributes () + "Return properties related to buffer attributes, as a plist." + ;; Store full path of input file name, or nil. For internal use. + (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (list :input-file visited-file + :input-buffer (buffer-name (buffer-base-buffer))))) + +(defun org-export--get-global-options (&optional backend) + "Return global export options as a plist. +Optional argument BACKEND, if non-nil, is an export back-end, as +returned by, e.g., `org-export-create-backend'. It specifies +which back-end specific export options should also be read in the +process." + (let (plist + ;; Priority is given to back-end specific options. + (all (append (and backend (org-export-get-all-options backend)) + org-export-options-alist))) + (dolist (cell all plist) + (let ((prop (car cell))) + (unless (plist-member plist prop) + (setq plist + (plist-put + plist + prop + ;; Evaluate default value provided. If keyword is + ;; a member of `org-element-document-properties', + ;; parse it as a secondary string before storing it. + (let ((value (eval (nth 3 cell)))) + (if (and (stringp value) + (member (nth 1 cell) + org-element-document-properties)) + (org-element-parse-secondary-string + value (org-element-restriction 'keyword)) + value))))))))) + +(defun org-export--list-bound-variables () + "Return variables bound from BIND keywords in current buffer. +Also look for BIND keywords in setup files. The return value is +an alist where associations are (VARIABLE-NAME VALUE)." + (when org-export-allow-bind-keywords + (let* (collect-bind ; For byte-compiler. + (collect-bind + (lambda (files alist) + ;; Return an alist between variable names and their + ;; value. FILES is a list of setup files names read so + ;; far, used to avoid circular dependencies. ALIST is + ;; the alist collected so far. + (let ((case-fold-search t)) + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward + "^[ \t]*#\\+\\(BIND\\|SETUPFILE\\):" nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((val (org-element-property :value element))) + (if (equal (org-element-property :key element) "BIND") + (push (read (format "(%s)" val)) alist) + ;; Enter setup file. + (let ((file (expand-file-name + (org-remove-double-quotes val)))) + (unless (member file files) + (with-temp-buffer + (let ((org-inhibit-startup t)) (org-mode)) + (insert (org-file-contents file 'noerror)) + (setq alist + (funcall collect-bind + (cons file files) + alist)))))))))) + alist))))) + ;; Return value in appropriate order of appearance. + (nreverse (funcall collect-bind nil nil))))) + +;; defsubst org-export-get-parent must be defined before first use, +;; was originally defined in the topology section + +(defsubst org-export-get-parent (blob) + "Return BLOB parent or nil. +BLOB is the element or object considered." + (org-element-property :parent blob)) + +;;;; Tree Properties +;; +;; Tree properties are information extracted from parse tree. They +;; are initialized at the beginning of the transcoding process by +;; `org-export-collect-tree-properties'. +;; +;; Dedicated functions focus on computing the value of specific tree +;; properties during initialization. Thus, +;; `org-export--populate-ignore-list' lists elements and objects that +;; should be skipped during export, `org-export--get-min-level' gets +;; the minimal exportable level, used as a basis to compute relative +;; level for headlines. Eventually +;; `org-export--collect-headline-numbering' builds an alist between +;; headlines and their numbering. + +(defun org-export-collect-tree-properties (data info) + "Extract tree properties from parse tree. + +DATA is the parse tree from which information is retrieved. INFO +is a list holding export options. + +Following tree properties are set or updated: + +`:exported-data' Hash table used to memoize results from + `org-export-data'. + +`:footnote-definition-alist' List of footnotes definitions in + original buffer and current parse tree. + +`:headline-offset' Offset between true level of headlines and + local level. An offset of -1 means a headline + of level 2 should be considered as a level + 1 headline in the context. + +`:headline-numbering' Alist of all headlines as key an the + associated numbering as value. + +`:ignore-list' List of elements that should be ignored during + export. + +Return updated plist." + ;; Install the parse tree in the communication channel, in order to + ;; use `org-export-get-genealogy' and al. + (setq info (plist-put info :parse-tree data)) + ;; Get the list of elements and objects to ignore, and put it into + ;; `:ignore-list'. Do not overwrite any user ignore that might have + ;; been done during parse tree filtering. + (setq info + (plist-put info + :ignore-list + (append (org-export--populate-ignore-list data info) + (plist-get info :ignore-list)))) + ;; Compute `:headline-offset' in order to be able to use + ;; `org-export-get-relative-level'. + (setq info + (plist-put info + :headline-offset + (- 1 (org-export--get-min-level data info)))) + ;; Update footnotes definitions list with definitions in parse tree. + ;; This is required since buffer expansion might have modified + ;; boundaries of footnote definitions contained in the parse tree. + ;; This way, definitions in `footnote-definition-alist' are bound to + ;; match those in the parse tree. + (let ((defs (plist-get info :footnote-definition-alist))) + (org-element-map data 'footnote-definition + (lambda (fn) + (push (cons (org-element-property :label fn) + `(org-data nil ,@(org-element-contents fn))) + defs))) + (setq info (plist-put info :footnote-definition-alist defs))) + ;; Properties order doesn't matter: get the rest of the tree + ;; properties. + (nconc + `(:headline-numbering ,(org-export--collect-headline-numbering data info) + :exported-data ,(make-hash-table :test 'eq :size 4001)) + info)) + +(defun org-export--get-min-level (data options) + "Return minimum exportable headline's level in DATA. +DATA is parsed tree as returned by `org-element-parse-buffer'. +OPTIONS is a plist holding export options." + (catch 'exit + (let ((min-level 10000)) + (mapc + (lambda (blob) + (when (and (eq (org-element-type blob) 'headline) + (not (org-element-property :footnote-section-p blob)) + (not (memq blob (plist-get options :ignore-list)))) + (setq min-level (min (org-element-property :level blob) min-level))) + (when (= min-level 1) (throw 'exit 1))) + (org-element-contents data)) + ;; If no headline was found, for the sake of consistency, set + ;; minimum level to 1 nonetheless. + (if (= min-level 10000) 1 min-level)))) + +(defun org-export--collect-headline-numbering (data options) + "Return numbering of all exportable headlines in a parse tree. + +DATA is the parse tree. OPTIONS is the plist holding export +options. + +Return an alist whose key is a headline and value is its +associated numbering \(in the shape of a list of numbers\) or nil +for a footnotes section." + (let ((numbering (make-vector org-export-max-depth 0))) + (org-element-map data 'headline + (lambda (headline) + (unless (org-element-property :footnote-section-p headline) + (let ((relative-level + (1- (org-export-get-relative-level headline options)))) + (cons + headline + (loop for n across numbering + for idx from 0 to org-export-max-depth + when (< idx relative-level) collect n + when (= idx relative-level) collect (aset numbering idx (1+ n)) + when (> idx relative-level) do (aset numbering idx 0)))))) + options))) + +(defun org-export--populate-ignore-list (data options) + "Return list of elements and objects to ignore during export. +DATA is the parse tree to traverse. OPTIONS is the plist holding +export options." + (let* (ignore + walk-data + ;; First find trees containing a select tag, if any. + (selected (org-export--selected-trees data options)) + (walk-data + (lambda (data) + ;; Collect ignored elements or objects into IGNORE-LIST. + (let ((type (org-element-type data))) + (if (org-export--skip-p data options selected) (push data ignore) + (if (and (eq type 'headline) + (eq (plist-get options :with-archived-trees) 'headline) + (org-element-property :archivedp data)) + ;; If headline is archived but tree below has + ;; to be skipped, add it to ignore list. + (mapc (lambda (e) (push e ignore)) + (org-element-contents data)) + ;; Move into secondary string, if any. + (let ((sec-prop + (cdr (assq type org-element-secondary-value-alist)))) + (when sec-prop + (mapc walk-data (org-element-property sec-prop data)))) + ;; Move into recursive objects/elements. + (mapc walk-data (org-element-contents data)))))))) + ;; Main call. + (funcall walk-data data) + ;; Return value. + ignore)) + +(defun org-export--selected-trees (data info) + "Return list of headlines and inlinetasks with a select tag in their tree. +DATA is parsed data as returned by `org-element-parse-buffer'. +INFO is a plist holding export options." + (let* (selected-trees + walk-data ; For byte-compiler. + (walk-data + (function + (lambda (data genealogy) + (let ((type (org-element-type data))) + (cond + ((memq type '(headline inlinetask)) + (let ((tags (org-element-property :tags data))) + (if (loop for tag in (plist-get info :select-tags) + thereis (member tag tags)) + ;; When a select tag is found, mark full + ;; genealogy and every headline within the tree + ;; as acceptable. + (setq selected-trees + (append + genealogy + (org-element-map data '(headline inlinetask) + 'identity) + selected-trees)) + ;; If at a headline, continue searching in tree, + ;; recursively. + (when (eq type 'headline) + (mapc (lambda (el) + (funcall walk-data el (cons data genealogy))) + (org-element-contents data)))))) + ((or (eq type 'org-data) + (memq type org-element-greater-elements)) + (mapc (lambda (el) (funcall walk-data el genealogy)) + (org-element-contents data))))))))) + (funcall walk-data data nil) + selected-trees)) + +(defun org-export--skip-p (blob options selected) + "Non-nil when element or object BLOB should be skipped during export. +OPTIONS is the plist holding export options. SELECTED, when +non-nil, is a list of headlines or inlinetasks belonging to +a tree with a select tag." + (case (org-element-type blob) + (clock (not (plist-get options :with-clocks))) + (drawer + (let ((with-drawers-p (plist-get options :with-drawers))) + (or (not with-drawers-p) + (and (consp with-drawers-p) + ;; If `:with-drawers' value starts with `not', ignore + ;; every drawer whose name belong to that list. + ;; Otherwise, ignore drawers whose name isn't in that + ;; list. + (let ((name (org-element-property :drawer-name blob))) + (if (eq (car with-drawers-p) 'not) + (member-ignore-case name (cdr with-drawers-p)) + (not (member-ignore-case name with-drawers-p)))))))) + ((footnote-definition footnote-reference) + (not (plist-get options :with-footnotes))) + ((headline inlinetask) + (let ((with-tasks (plist-get options :with-tasks)) + (todo (org-element-property :todo-keyword blob)) + (todo-type (org-element-property :todo-type blob)) + (archived (plist-get options :with-archived-trees)) + (tags (org-element-property :tags blob))) + (or + (and (eq (org-element-type blob) 'inlinetask) + (not (plist-get options :with-inlinetasks))) + ;; Ignore subtrees with an exclude tag. + (loop for k in (plist-get options :exclude-tags) + thereis (member k tags)) + ;; When a select tag is present in the buffer, ignore any tree + ;; without it. + (and selected (not (memq blob selected))) + ;; Ignore commented sub-trees. + (org-element-property :commentedp blob) + ;; Ignore archived subtrees if `:with-archived-trees' is nil. + (and (not archived) (org-element-property :archivedp blob)) + ;; Ignore tasks, if specified by `:with-tasks' property. + (and todo + (or (not with-tasks) + (and (memq with-tasks '(todo done)) + (not (eq todo-type with-tasks))) + (and (consp with-tasks) (not (member todo with-tasks)))))))) + ((latex-environment latex-fragment) (not (plist-get options :with-latex))) + (planning (not (plist-get options :with-planning))) + (statistics-cookie (not (plist-get options :with-statistics-cookies))) + (table-cell + (and (org-export-table-has-special-column-p + (org-export-get-parent-table blob)) + (not (org-export-get-previous-element blob options)))) + (table-row (org-export-table-row-is-special-p blob options)) + (timestamp + ;; `:with-timestamps' only applies to isolated timestamps + ;; objects, i.e. timestamp objects in a paragraph containing only + ;; timestamps and whitespaces. + (when (let ((parent (org-export-get-parent-element blob))) + (and (memq (org-element-type parent) '(paragraph verse-block)) + (not (org-element-map parent + (cons 'plain-text + (remq 'timestamp org-element-all-objects)) + (lambda (obj) + (or (not (stringp obj)) (org-string-nw-p obj))) + options t)))) + (case (plist-get options :with-timestamps) + ('nil t) + (active + (not (memq (org-element-property :type blob) '(active active-range)))) + (inactive + (not (memq (org-element-property :type blob) + '(inactive inactive-range))))))))) + + +;;; The Transcoder +;; +;; `org-export-data' reads a parse tree (obtained with, i.e. +;; `org-element-parse-buffer') and transcodes it into a specified +;; back-end output. It takes care of filtering out elements or +;; objects according to export options and organizing the output blank +;; lines and white space are preserved. The function memoizes its +;; results, so it is cheap to call it within transcoders. +;; +;; It is possible to modify locally the back-end used by +;; `org-export-data' or even use a temporary back-end by using +;; `org-export-data-with-backend'. +;; +;; Internally, three functions handle the filtering of objects and +;; elements during the export. In particular, +;; `org-export-ignore-element' marks an element or object so future +;; parse tree traversals skip it, `org-export--interpret-p' tells which +;; elements or objects should be seen as real Org syntax and +;; `org-export-expand' transforms the others back into their original +;; shape +;; +;; `org-export-transcoder' is an accessor returning appropriate +;; translator function for a given element or object. + +(defun org-export-transcoder (blob info) + "Return appropriate transcoder for BLOB. +INFO is a plist containing export directives." + (let ((type (org-element-type blob))) + ;; Return contents only for complete parse trees. + (if (eq type 'org-data) (lambda (blob contents info) contents) + (let ((transcoder (cdr (assq type (plist-get info :translate-alist))))) + (and (functionp transcoder) transcoder))))) + +(defun org-export-data (data info) + "Convert DATA into current back-end format. + +DATA is a parse tree, an element or an object or a secondary +string. INFO is a plist holding export options. + +Return a string." + (or (gethash data (plist-get info :exported-data)) + (let* ((type (org-element-type data)) + (results + (cond + ;; Ignored element/object. + ((memq data (plist-get info :ignore-list)) nil) + ;; Plain text. + ((eq type 'plain-text) + (org-export-filter-apply-functions + (plist-get info :filter-plain-text) + (let ((transcoder (org-export-transcoder data info))) + (if transcoder (funcall transcoder data info) data)) + info)) + ;; Uninterpreted element/object: change it back to Org + ;; syntax and export again resulting raw string. + ((not (org-export--interpret-p data info)) + (org-export-data + (org-export-expand + data + (mapconcat (lambda (blob) (org-export-data blob info)) + (org-element-contents data) + "")) + info)) + ;; Secondary string. + ((not type) + (mapconcat (lambda (obj) (org-export-data obj info)) data "")) + ;; Element/Object without contents or, as a special + ;; case, headline with archive tag and archived trees + ;; restricted to title only. + ((or (not (org-element-contents data)) + (and (eq type 'headline) + (eq (plist-get info :with-archived-trees) 'headline) + (org-element-property :archivedp data))) + (let ((transcoder (org-export-transcoder data info))) + (or (and (functionp transcoder) + (funcall transcoder data nil info)) + ;; Export snippets never return a nil value so + ;; that white spaces following them are never + ;; ignored. + (and (eq type 'export-snippet) "")))) + ;; Element/Object with contents. + (t + (let ((transcoder (org-export-transcoder data info))) + (when transcoder + (let* ((greaterp (memq type org-element-greater-elements)) + (objectp + (and (not greaterp) + (memq type org-element-recursive-objects))) + (contents + (mapconcat + (lambda (element) (org-export-data element info)) + (org-element-contents + (if (or greaterp objectp) data + ;; Elements directly containing + ;; objects must have their indentation + ;; normalized first. + (org-element-normalize-contents + data + ;; When normalizing contents of the + ;; first paragraph in an item or + ;; a footnote definition, ignore + ;; first line's indentation: there is + ;; none and it might be misleading. + (when (eq type 'paragraph) + (let ((parent (org-export-get-parent data))) + (and + (eq (car (org-element-contents parent)) + data) + (memq (org-element-type parent) + '(footnote-definition item)))))))) + ""))) + (funcall transcoder data + (if (not greaterp) contents + (org-element-normalize-string contents)) + info)))))))) + ;; Final result will be memoized before being returned. + (puthash + data + (cond + ((not results) "") + ((memq type '(org-data plain-text nil)) results) + ;; Append the same white space between elements or objects + ;; as in the original buffer, and call appropriate filters. + (t + (let ((results + (org-export-filter-apply-functions + (plist-get info (intern (format ":filter-%s" type))) + (let ((post-blank (or (org-element-property :post-blank data) + 0))) + (if (memq type org-element-all-elements) + (concat (org-element-normalize-string results) + (make-string post-blank ?\n)) + (concat results (make-string post-blank ?\s)))) + info))) + results))) + (plist-get info :exported-data))))) + +(defun org-export-data-with-backend (data backend info) + "Convert DATA into BACKEND format. + +DATA is an element, an object, a secondary string or a string. +BACKEND is a symbol. INFO is a plist used as a communication +channel. + +Unlike to `org-export-with-backend', this function will +recursively convert DATA using BACKEND translation table." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (org-export-data + data + ;; Set-up a new communication channel with translations defined in + ;; BACKEND as the translate table and a new hash table for + ;; memoization. + (org-combine-plists + info + (list :back-end backend + :translate-alist (org-export-get-all-transcoders backend) + ;; Size of the hash table is reduced since this function + ;; will probably be used on small trees. + :exported-data (make-hash-table :test 'eq :size 401))))) + +(defun org-export--interpret-p (blob info) + "Non-nil if element or object BLOB should be interpreted during export. +If nil, BLOB will appear as raw Org syntax. Check is done +according to export options INFO, stored as a plist." + (case (org-element-type blob) + ;; ... entities... + (entity (plist-get info :with-entities)) + ;; ... emphasis... + ((bold italic strike-through underline) + (plist-get info :with-emphasize)) + ;; ... fixed-width areas. + (fixed-width (plist-get info :with-fixed-width)) + ;; ... LaTeX environments and fragments... + ((latex-environment latex-fragment) + (let ((with-latex-p (plist-get info :with-latex))) + (and with-latex-p (not (eq with-latex-p 'verbatim))))) + ;; ... sub/superscripts... + ((subscript superscript) + (let ((sub/super-p (plist-get info :with-sub-superscript))) + (if (eq sub/super-p '{}) + (org-element-property :use-brackets-p blob) + sub/super-p))) + ;; ... tables... + (table (plist-get info :with-tables)) + (otherwise t))) + +(defun org-export-expand (blob contents &optional with-affiliated) + "Expand a parsed element or object to its original state. + +BLOB is either an element or an object. CONTENTS is its +contents, as a string or nil. + +When optional argument WITH-AFFILIATED is non-nil, add affiliated +keywords before output." + (let ((type (org-element-type blob))) + (concat (and with-affiliated (memq type org-element-all-elements) + (org-element--interpret-affiliated-keywords blob)) + (funcall (intern (format "org-element-%s-interpreter" type)) + blob contents)))) + +(defun org-export-ignore-element (element info) + "Add ELEMENT to `:ignore-list' in INFO. + +Any element in `:ignore-list' will be skipped when using +`org-element-map'. INFO is modified by side effects." + (plist-put info :ignore-list (cons element (plist-get info :ignore-list)))) + + + +;;; The Filter System +;; +;; Filters allow end-users to tweak easily the transcoded output. +;; They are the functional counterpart of hooks, as every filter in +;; a set is applied to the return value of the previous one. +;; +;; Every set is back-end agnostic. Although, a filter is always +;; called, in addition to the string it applies to, with the back-end +;; used as argument, so it's easy for the end-user to add back-end +;; specific filters in the set. The communication channel, as +;; a plist, is required as the third argument. +;; +;; From the developer side, filters sets can be installed in the +;; process with the help of `org-export-define-backend', which +;; internally stores filters as an alist. Each association has a key +;; among the following symbols and a function or a list of functions +;; as value. +;; +;; - `:filter-options' applies to the property list containing export +;; options. Unlike to other filters, functions in this list accept +;; two arguments instead of three: the property list containing +;; export options and the back-end. Users can set its value through +;; `org-export-filter-options-functions' variable. +;; +;; - `:filter-parse-tree' applies directly to the complete parsed +;; tree. Users can set it through +;; `org-export-filter-parse-tree-functions' variable. +;; +;; - `:filter-final-output' applies to the final transcoded string. +;; Users can set it with `org-export-filter-final-output-functions' +;; variable +;; +;; - `:filter-plain-text' applies to any string not recognized as Org +;; syntax. `org-export-filter-plain-text-functions' allows users to +;; configure it. +;; +;; - `:filter-TYPE' applies on the string returned after an element or +;; object of type TYPE has been transcoded. A user can modify +;; `org-export-filter-TYPE-functions' +;; +;; All filters sets are applied with +;; `org-export-filter-apply-functions' function. Filters in a set are +;; applied in a LIFO fashion. It allows developers to be sure that +;; their filters will be applied first. +;; +;; Filters properties are installed in communication channel with +;; `org-export-install-filters' function. +;; +;; Eventually, two hooks (`org-export-before-processing-hook' and +;; `org-export-before-parsing-hook') are run at the beginning of the +;; export process and just before parsing to allow for heavy structure +;; modifications. + + +;;;; Hooks + +(defvar org-export-before-processing-hook nil + "Hook run at the beginning of the export process. + +This is run before include keywords and macros are expanded and +Babel code blocks executed, on a copy of the original buffer +being exported. Visibility and narrowing are preserved. Point +is at the beginning of the buffer. + +Every function in this hook will be called with one argument: the +back-end currently used, as a symbol.") + +(defvar org-export-before-parsing-hook nil + "Hook run before parsing an export buffer. + +This is run after include keywords and macros have been expanded +and Babel code blocks executed, on a copy of the original buffer +being exported. Visibility and narrowing are preserved. Point +is at the beginning of the buffer. + +Every function in this hook will be called with one argument: the +back-end currently used, as a symbol.") + + +;;;; Special Filters + +(defvar org-export-filter-options-functions nil + "List of functions applied to the export options. +Each filter is called with two arguments: the export options, as +a plist, and the back-end, as a symbol. It must return +a property list containing export options.") + +(defvar org-export-filter-parse-tree-functions nil + "List of functions applied to the parsed tree. +Each filter is called with three arguments: the parse tree, as +returned by `org-element-parse-buffer', the back-end, as +a symbol, and the communication channel, as a plist. It must +return the modified parse tree to transcode.") + +(defvar org-export-filter-plain-text-functions nil + "List of functions applied to plain text. +Each filter is called with three arguments: a string which +contains no Org syntax, the back-end, as a symbol, and the +communication channel, as a plist. It must return a string or +nil.") + +(defvar org-export-filter-final-output-functions nil + "List of functions applied to the transcoded string. +Each filter is called with three arguments: the full transcoded +string, the back-end, as a symbol, and the communication channel, +as a plist. It must return a string that will be used as the +final export output.") + + +;;;; Elements Filters + +(defvar org-export-filter-babel-call-functions nil + "List of functions applied to a transcoded babel-call. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-center-block-functions nil + "List of functions applied to a transcoded center block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-clock-functions nil + "List of functions applied to a transcoded clock. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-comment-functions nil + "List of functions applied to a transcoded comment. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-comment-block-functions nil + "List of functions applied to a transcoded comment-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-diary-sexp-functions nil + "List of functions applied to a transcoded diary-sexp. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-drawer-functions nil + "List of functions applied to a transcoded drawer. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-dynamic-block-functions nil + "List of functions applied to a transcoded dynamic-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-example-block-functions nil + "List of functions applied to a transcoded example-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-export-block-functions nil + "List of functions applied to a transcoded export-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-fixed-width-functions nil + "List of functions applied to a transcoded fixed-width. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-footnote-definition-functions nil + "List of functions applied to a transcoded footnote-definition. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-headline-functions nil + "List of functions applied to a transcoded headline. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-horizontal-rule-functions nil + "List of functions applied to a transcoded horizontal-rule. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-inlinetask-functions nil + "List of functions applied to a transcoded inlinetask. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-item-functions nil + "List of functions applied to a transcoded item. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-keyword-functions nil + "List of functions applied to a transcoded keyword. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-latex-environment-functions nil + "List of functions applied to a transcoded latex-environment. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-node-property-functions nil + "List of functions applied to a transcoded node-property. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-paragraph-functions nil + "List of functions applied to a transcoded paragraph. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-plain-list-functions nil + "List of functions applied to a transcoded plain-list. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-planning-functions nil + "List of functions applied to a transcoded planning. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-property-drawer-functions nil + "List of functions applied to a transcoded property-drawer. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-quote-block-functions nil + "List of functions applied to a transcoded quote block. +Each filter is called with three arguments: the transcoded quote +data, as a string, the back-end, as a symbol, and the +communication channel, as a plist. It must return a string or +nil.") + +(defvar org-export-filter-quote-section-functions nil + "List of functions applied to a transcoded quote-section. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-section-functions nil + "List of functions applied to a transcoded section. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-special-block-functions nil + "List of functions applied to a transcoded special block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-src-block-functions nil + "List of functions applied to a transcoded src-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-table-functions nil + "List of functions applied to a transcoded table. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-table-cell-functions nil + "List of functions applied to a transcoded table-cell. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-table-row-functions nil + "List of functions applied to a transcoded table-row. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-verse-block-functions nil + "List of functions applied to a transcoded verse block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + + +;;;; Objects Filters + +(defvar org-export-filter-bold-functions nil + "List of functions applied to transcoded bold text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-code-functions nil + "List of functions applied to transcoded code text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-entity-functions nil + "List of functions applied to a transcoded entity. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-export-snippet-functions nil + "List of functions applied to a transcoded export-snippet. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-footnote-reference-functions nil + "List of functions applied to a transcoded footnote-reference. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-inline-babel-call-functions nil + "List of functions applied to a transcoded inline-babel-call. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-inline-src-block-functions nil + "List of functions applied to a transcoded inline-src-block. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-italic-functions nil + "List of functions applied to transcoded italic text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-latex-fragment-functions nil + "List of functions applied to a transcoded latex-fragment. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-line-break-functions nil + "List of functions applied to a transcoded line-break. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-link-functions nil + "List of functions applied to a transcoded link. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-radio-target-functions nil + "List of functions applied to a transcoded radio-target. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-statistics-cookie-functions nil + "List of functions applied to a transcoded statistics-cookie. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-strike-through-functions nil + "List of functions applied to transcoded strike-through text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-subscript-functions nil + "List of functions applied to a transcoded subscript. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-superscript-functions nil + "List of functions applied to a transcoded superscript. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-target-functions nil + "List of functions applied to a transcoded target. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-timestamp-functions nil + "List of functions applied to a transcoded timestamp. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-underline-functions nil + "List of functions applied to transcoded underline text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + +(defvar org-export-filter-verbatim-functions nil + "List of functions applied to transcoded verbatim text. +Each filter is called with three arguments: the transcoded data, +as a string, the back-end, as a symbol, and the communication +channel, as a plist. It must return a string or nil.") + + +;;;; Filters Tools +;; +;; Internal function `org-export-install-filters' installs filters +;; hard-coded in back-ends (developer filters) and filters from global +;; variables (user filters) in the communication channel. +;; +;; Internal function `org-export-filter-apply-functions' takes care +;; about applying each filter in order to a given data. It ignores +;; filters returning a nil value but stops whenever a filter returns +;; an empty string. + +(defun org-export-filter-apply-functions (filters value info) + "Call every function in FILTERS. + +Functions are called with arguments VALUE, current export +back-end's name and INFO. A function returning a nil value will +be skipped. If it returns the empty string, the process ends and +VALUE is ignored. + +Call is done in a LIFO fashion, to be sure that developer +specified filters, if any, are called first." + (catch 'exit + (let* ((backend (plist-get info :back-end)) + (backend-name (and backend (org-export-backend-name backend)))) + (dolist (filter filters value) + (let ((result (funcall filter value backend-name info))) + (cond ((not result) value) + ((equal value "") (throw 'exit nil)) + (t (setq value result)))))))) + +(defun org-export-install-filters (info) + "Install filters properties in communication channel. +INFO is a plist containing the current communication channel. +Return the updated communication channel." + (let (plist) + ;; Install user-defined filters with `org-export-filters-alist' + ;; and filters already in INFO (through ext-plist mechanism). + (mapc (lambda (p) + (let* ((prop (car p)) + (info-value (plist-get info prop)) + (default-value (symbol-value (cdr p)))) + (setq plist + (plist-put plist prop + ;; Filters in INFO will be called + ;; before those user provided. + (append (if (listp info-value) info-value + (list info-value)) + default-value))))) + org-export-filters-alist) + ;; Prepend back-end specific filters to that list. + (mapc (lambda (p) + ;; Single values get consed, lists are appended. + (let ((key (car p)) (value (cdr p))) + (when value + (setq plist + (plist-put + plist key + (if (atom value) (cons value (plist-get plist key)) + (append value (plist-get plist key)))))))) + (org-export-get-all-filters (plist-get info :back-end))) + ;; Return new communication channel. + (org-combine-plists info plist))) + + + +;;; Core functions +;; +;; This is the room for the main function, `org-export-as', along with +;; its derivative, `org-export-string-as'. +;; `org-export--copy-to-kill-ring-p' determines if output of these +;; function should be added to kill ring. +;; +;; Note that `org-export-as' doesn't really parse the current buffer, +;; but a copy of it (with the same buffer-local variables and +;; visibility), where macros and include keywords are expanded and +;; Babel blocks are executed, if appropriate. +;; `org-export-with-buffer-copy' macro prepares that copy. +;; +;; File inclusion is taken care of by +;; `org-export-expand-include-keyword' and +;; `org-export--prepare-file-contents'. Structure wise, including +;; a whole Org file in a buffer often makes little sense. For +;; example, if the file contains a headline and the include keyword +;; was within an item, the item should contain the headline. That's +;; why file inclusion should be done before any structure can be +;; associated to the file, that is before parsing. +;; +;; `org-export-insert-default-template' is a command to insert +;; a default template (or a back-end specific template) at point or in +;; current subtree. + +(defun org-export-copy-buffer () + "Return a copy of the current buffer. +The copy preserves Org buffer-local variables, visibility and +narrowing." + (let ((copy-buffer-fun (org-export--generate-copy-script (current-buffer))) + (new-buf (generate-new-buffer (buffer-name)))) + (with-current-buffer new-buf + (funcall copy-buffer-fun) + (set-buffer-modified-p nil)) + new-buf)) + +(defmacro org-export-with-buffer-copy (&rest body) + "Apply BODY in a copy of the current buffer. +The copy preserves local variables, visibility and contents of +the original buffer. Point is at the beginning of the buffer +when BODY is applied." + (declare (debug t)) + (org-with-gensyms (buf-copy) + `(let ((,buf-copy (org-export-copy-buffer))) + (unwind-protect + (with-current-buffer ,buf-copy + (goto-char (point-min)) + (progn ,@body)) + (and (buffer-live-p ,buf-copy) + ;; Kill copy without confirmation. + (progn (with-current-buffer ,buf-copy + (restore-buffer-modified-p nil)) + (kill-buffer ,buf-copy))))))) + +(defun org-export--generate-copy-script (buffer) + "Generate a function duplicating BUFFER. + +The copy will preserve local variables, visibility, contents and +narrowing of the original buffer. If a region was active in +BUFFER, contents will be narrowed to that region instead. + +The resulting function can be evaluated at a later time, from +another buffer, effectively cloning the original buffer there. + +The function assumes BUFFER's major mode is `org-mode'." + (with-current-buffer buffer + `(lambda () + (let ((inhibit-modification-hooks t)) + ;; Set major mode. Ignore `org-mode-hook' as it has been run + ;; already in BUFFER. + (let ((org-mode-hook nil) (org-inhibit-startup t)) (org-mode)) + ;; Copy specific buffer local variables and variables set + ;; through BIND keywords. + ,@(let ((bound-variables (org-export--list-bound-variables)) + vars) + (dolist (entry (buffer-local-variables (buffer-base-buffer)) vars) + (when (consp entry) + (let ((var (car entry)) + (val (cdr entry))) + (and (not (eq var 'org-font-lock-keywords)) + (or (memq var + '(default-directory + buffer-file-name + buffer-file-coding-system)) + (assq var bound-variables) + (string-match "^\\(org-\\|orgtbl-\\)" + (symbol-name var))) + ;; Skip unreadable values, as they cannot be + ;; sent to external process. + (or (not val) (ignore-errors (read (format "%S" val)))) + (push `(set (make-local-variable (quote ,var)) + (quote ,val)) + vars)))))) + ;; Whole buffer contents. + (insert + ,(org-with-wide-buffer + (buffer-substring-no-properties + (point-min) (point-max)))) + ;; Narrowing. + ,(if (org-region-active-p) + `(narrow-to-region ,(region-beginning) ,(region-end)) + `(narrow-to-region ,(point-min) ,(point-max))) + ;; Current position of point. + (goto-char ,(point)) + ;; Overlays with invisible property. + ,@(let (ov-set) + (mapc + (lambda (ov) + (let ((invis-prop (overlay-get ov 'invisible))) + (when invis-prop + (push `(overlay-put + (make-overlay ,(overlay-start ov) + ,(overlay-end ov)) + 'invisible (quote ,invis-prop)) + ov-set)))) + (overlays-in (point-min) (point-max))) + ov-set))))) + +;;;###autoload +(defun org-export-as + (backend &optional subtreep visible-only body-only ext-plist) + "Transcode current Org buffer into BACKEND code. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +If narrowing is active in the current buffer, only transcode its +narrowed part. + +If a region is active, transcode that region. + +When optional argument SUBTREEP is non-nil, transcode the +sub-tree at point, extracting information from the headline +properties first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +When optional argument BODY-ONLY is non-nil, only return body +code, without surrounding template. + +Optional argument EXT-PLIST, when provided, is a property list +with external parameters overriding Org default settings, but +still inferior to file-local settings. + +Return code as a string." + (when (symbolp backend) (setq backend (org-export-get-backend backend))) + (org-export-barf-if-invalid-backend backend) + (save-excursion + (save-restriction + ;; Narrow buffer to an appropriate region or subtree for + ;; parsing. If parsing subtree, be sure to remove main headline + ;; too. + (cond ((org-region-active-p) + (narrow-to-region (region-beginning) (region-end))) + (subtreep + (org-narrow-to-subtree) + (goto-char (point-min)) + (forward-line) + (narrow-to-region (point) (point-max)))) + ;; Initialize communication channel with original buffer + ;; attributes, unavailable in its copy. + (let* ((org-export-current-backend (org-export-backend-name backend)) + (info (org-combine-plists + (list :export-options + (delq nil + (list (and subtreep 'subtree) + (and visible-only 'visible-only) + (and body-only 'body-only)))) + (org-export--get-buffer-attributes))) + tree) + ;; Update communication channel and get parse tree. Buffer + ;; isn't parsed directly. Instead, a temporary copy is + ;; created, where include keywords, macros are expanded and + ;; code blocks are evaluated. + (org-export-with-buffer-copy + ;; Run first hook with current back-end's name as argument. + (run-hook-with-args 'org-export-before-processing-hook + (org-export-backend-name backend)) + (org-export-expand-include-keyword) + ;; Update macro templates since #+INCLUDE keywords might have + ;; added some new ones. + (org-macro-initialize-templates) + (org-macro-replace-all org-macro-templates) + (org-export-execute-babel-code) + ;; Update radio targets since keyword inclusion might have + ;; added some more. + (org-update-radio-target-regexp) + ;; Run last hook with current back-end's name as argument. + (goto-char (point-min)) + (save-excursion + (run-hook-with-args 'org-export-before-parsing-hook + (org-export-backend-name backend))) + ;; Update communication channel with environment. Also + ;; install user's and developer's filters. + (setq info + (org-export-install-filters + (org-combine-plists + info (org-export-get-environment backend subtreep ext-plist)))) + ;; Special case: provide original file name or buffer name as + ;; default value for :title property. + (unless (plist-get info :title) + (plist-put + info :title + (let ((file (plist-get info :input-file))) + (if file (file-name-sans-extension (file-name-nondirectory file)) + (plist-get info :input-buffer))))) + ;; Expand export-specific set of macros: {{{author}}}, + ;; {{{date}}}, {{{email}}} and {{{title}}}. It must be done + ;; once regular macros have been expanded, since document + ;; keywords may contain one of them. + (org-macro-replace-all + (list (cons "author" + (org-element-interpret-data (plist-get info :author))) + (cons "date" + (org-element-interpret-data (plist-get info :date))) + ;; EMAIL is not a parsed keyword: store it as-is. + (cons "email" (or (plist-get info :email) "")) + (cons "title" + (org-element-interpret-data (plist-get info :title))))) + ;; Call options filters and update export options. We do not + ;; use `org-export-filter-apply-functions' here since the + ;; arity of such filters is different. + (let ((backend-name (org-export-backend-name backend))) + (dolist (filter (plist-get info :filter-options)) + (let ((result (funcall filter info backend-name))) + (when result (setq info result))))) + ;; Parse buffer and call parse-tree filter on it. + (setq tree + (org-export-filter-apply-functions + (plist-get info :filter-parse-tree) + (org-element-parse-buffer nil visible-only) info)) + ;; Now tree is complete, compute its properties and add them + ;; to communication channel. + (setq info + (org-combine-plists + info (org-export-collect-tree-properties tree info))) + ;; Eventually transcode TREE. Wrap the resulting string into + ;; a template. + (let* ((body (org-element-normalize-string + (or (org-export-data tree info) ""))) + (inner-template (cdr (assq 'inner-template + (plist-get info :translate-alist)))) + (full-body (if (not (functionp inner-template)) body + (funcall inner-template body info))) + (template (cdr (assq 'template + (plist-get info :translate-alist))))) + ;; Remove all text properties since they cannot be + ;; retrieved from an external process. Finally call + ;; final-output filter and return result. + (org-no-properties + (org-export-filter-apply-functions + (plist-get info :filter-final-output) + (if (or (not (functionp template)) body-only) full-body + (funcall template full-body info)) + info)))))))) + +;;;###autoload +(defun org-export-string-as (string backend &optional body-only ext-plist) + "Transcode STRING into BACKEND code. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +When optional argument BODY-ONLY is non-nil, only return body +code, without preamble nor postamble. + +Optional argument EXT-PLIST, when provided, is a property list +with external parameters overriding Org default settings, but +still inferior to file-local settings. + +Return code as a string." + (with-temp-buffer + (insert string) + (let ((org-inhibit-startup t)) (org-mode)) + (org-export-as backend nil nil body-only ext-plist))) + +;;;###autoload +(defun org-export-replace-region-by (backend) + "Replace the active region by its export to BACKEND. +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end." + (if (not (org-region-active-p)) + (user-error "No active region to replace") + (let* ((beg (region-beginning)) + (end (region-end)) + (str (buffer-substring beg end)) rpl) + (setq rpl (org-export-string-as str backend t)) + (delete-region beg end) + (insert rpl)))) + +;;;###autoload +(defun org-export-insert-default-template (&optional backend subtreep) + "Insert all export keywords with default values at beginning of line. + +BACKEND is a symbol referring to the name of a registered export +back-end, for which specific export options should be added to +the template, or `default' for default template. When it is nil, +the user will be prompted for a category. + +If SUBTREEP is non-nil, export configuration will be set up +locally for the subtree through node properties." + (interactive) + (unless (derived-mode-p 'org-mode) (user-error "Not in an Org mode buffer")) + (when (and subtreep (org-before-first-heading-p)) + (user-error "No subtree to set export options for")) + (let ((node (and subtreep (save-excursion (org-back-to-heading t) (point)))) + (backend + (or backend + (intern + (org-completing-read + "Options category: " + (cons "default" + (mapcar (lambda (b) + (symbol-name (org-export-backend-name b))) + org-export--registered-backends)))))) + options keywords) + ;; Populate OPTIONS and KEYWORDS. + (dolist (entry (cond ((eq backend 'default) org-export-options-alist) + ((org-export-backend-p backend) + (org-export-backend-options backend)) + (t (org-export-backend-options + (org-export-get-backend backend))))) + (let ((keyword (nth 1 entry)) + (option (nth 2 entry))) + (cond + (keyword (unless (assoc keyword keywords) + (let ((value + (if (eq (nth 4 entry) 'split) + (mapconcat 'identity (eval (nth 3 entry)) " ") + (eval (nth 3 entry))))) + (push (cons keyword value) keywords)))) + (option (unless (assoc option options) + (push (cons option (eval (nth 3 entry))) options)))))) + ;; Move to an appropriate location in order to insert options. + (unless subtreep (beginning-of-line)) + ;; First get TITLE, DATE, AUTHOR and EMAIL if they belong to the + ;; list of available keywords. + (when (assoc "TITLE" keywords) + (let ((title + (or (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (and visited-file + (file-name-sans-extension + (file-name-nondirectory visited-file)))) + (buffer-name (buffer-base-buffer))))) + (if (not subtreep) (insert (format "#+TITLE: %s\n" title)) + (org-entry-put node "EXPORT_TITLE" title)))) + (when (assoc "DATE" keywords) + (let ((date (with-temp-buffer (org-insert-time-stamp (current-time))))) + (if (not subtreep) (insert "#+DATE: " date "\n") + (org-entry-put node "EXPORT_DATE" date)))) + (when (assoc "AUTHOR" keywords) + (let ((author (cdr (assoc "AUTHOR" keywords)))) + (if subtreep (org-entry-put node "EXPORT_AUTHOR" author) + (insert + (format "#+AUTHOR:%s\n" + (if (not (org-string-nw-p author)) "" + (concat " " author))))))) + (when (assoc "EMAIL" keywords) + (let ((email (cdr (assoc "EMAIL" keywords)))) + (if subtreep (org-entry-put node "EXPORT_EMAIL" email) + (insert + (format "#+EMAIL:%s\n" + (if (not (org-string-nw-p email)) "" + (concat " " email))))))) + ;; Then (multiple) OPTIONS lines. Never go past fill-column. + (when options + (let ((items + (mapcar + #'(lambda (opt) (format "%s:%S" (car opt) (cdr opt))) + (sort options (lambda (k1 k2) (string< (car k1) (car k2))))))) + (if subtreep + (org-entry-put + node "EXPORT_OPTIONS" (mapconcat 'identity items " ")) + (while items + (insert "#+OPTIONS:") + (let ((width 10)) + (while (and items + (< (+ width (length (car items)) 1) fill-column)) + (let ((item (pop items))) + (insert " " item) + (incf width (1+ (length item)))))) + (insert "\n"))))) + ;; And the rest of keywords. + (dolist (key (sort keywords (lambda (k1 k2) (string< (car k1) (car k2))))) + (unless (member (car key) '("TITLE" "DATE" "AUTHOR" "EMAIL")) + (let ((val (cdr key))) + (if subtreep (org-entry-put node (concat "EXPORT_" (car key)) val) + (insert + (format "#+%s:%s\n" + (car key) + (if (org-string-nw-p val) (format " %s" val) ""))))))))) + +(defun org-export-expand-include-keyword (&optional included dir) + "Expand every include keyword in buffer. +Optional argument INCLUDED is a list of included file names along +with their line restriction, when appropriate. It is used to +avoid infinite recursion. Optional argument DIR is the current +working directory. It is used to properly resolve relative +paths." + (let ((case-fold-search t)) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t) + (let ((element (save-match-data (org-element-at-point)))) + (when (eq (org-element-type element) 'keyword) + (beginning-of-line) + ;; Extract arguments from keyword's value. + (let* ((value (org-element-property :value element)) + (ind (org-get-indentation)) + (file (and (string-match + "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value) + (prog1 (expand-file-name + (org-remove-double-quotes + (match-string 1 value)) + dir) + (setq value (replace-match "" nil nil value))))) + (lines + (and (string-match + ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\"" + value) + (prog1 (match-string 1 value) + (setq value (replace-match "" nil nil value))))) + (env (cond ((string-match "\\" value) 'example) + ((string-match "\\ level limit) (- level limit)))))) + +(defun org-export-get-headline-number (headline info) + "Return HEADLINE numbering as a list of numbers. +INFO is a plist holding contextual information." + (cdr (assoc headline (plist-get info :headline-numbering)))) + +(defun org-export-numbered-headline-p (headline info) + "Return a non-nil value if HEADLINE element should be numbered. +INFO is a plist used as a communication channel." + (let ((sec-num (plist-get info :section-numbers)) + (level (org-export-get-relative-level headline info))) + (if (wholenump sec-num) (<= level sec-num) sec-num))) + +(defun org-export-number-to-roman (n) + "Convert integer N into a roman numeral." + (let ((roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD") + ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL") + ( 10 . "X") ( 9 . "IX") ( 5 . "V") ( 4 . "IV") + ( 1 . "I"))) + (res "")) + (if (<= n 0) + (number-to-string n) + (while roman + (if (>= n (caar roman)) + (setq n (- n (caar roman)) + res (concat res (cdar roman))) + (pop roman))) + res))) + +(defun org-export-get-tags (element info &optional tags inherited) + "Return list of tags associated to ELEMENT. + +ELEMENT has either an `headline' or an `inlinetask' type. INFO +is a plist used as a communication channel. + +Select tags (see `org-export-select-tags') and exclude tags (see +`org-export-exclude-tags') are removed from the list. + +When non-nil, optional argument TAGS should be a list of strings. +Any tag belonging to this list will also be removed. + +When optional argument INHERITED is non-nil, tags can also be +inherited from parent headlines and FILETAGS keywords." + (org-remove-if + (lambda (tag) (or (member tag (plist-get info :select-tags)) + (member tag (plist-get info :exclude-tags)) + (member tag tags))) + (if (not inherited) (org-element-property :tags element) + ;; Build complete list of inherited tags. + (let ((current-tag-list (org-element-property :tags element))) + (mapc + (lambda (parent) + (mapc + (lambda (tag) + (when (and (memq (org-element-type parent) '(headline inlinetask)) + (not (member tag current-tag-list))) + (push tag current-tag-list))) + (org-element-property :tags parent))) + (org-export-get-genealogy element)) + ;; Add FILETAGS keywords and return results. + (org-uniquify (append (plist-get info :filetags) current-tag-list)))))) + +(defun org-export-get-node-property (property blob &optional inherited) + "Return node PROPERTY value for BLOB. + +PROPERTY is an upcase symbol (i.e. `:COOKIE_DATA'). BLOB is an +element or object. + +If optional argument INHERITED is non-nil, the value can be +inherited from a parent headline. + +Return value is a string or nil." + (let ((headline (if (eq (org-element-type blob) 'headline) blob + (org-export-get-parent-headline blob)))) + (if (not inherited) (org-element-property property blob) + (let ((parent headline) value) + (catch 'found + (while parent + (when (plist-member (nth 1 parent) property) + (throw 'found (org-element-property property parent))) + (setq parent (org-element-property :parent parent)))))))) + +(defun org-export-get-category (blob info) + "Return category for element or object BLOB. + +INFO is a plist used as a communication channel. + +CATEGORY is automatically inherited from a parent headline, from +#+CATEGORY: keyword or created out of original file name. If all +fail, the fall-back value is \"???\"." + (or (let ((headline (if (eq (org-element-type blob) 'headline) blob + (org-export-get-parent-headline blob)))) + ;; Almost like `org-export-node-property', but we cannot trust + ;; `plist-member' as every headline has a `:CATEGORY' + ;; property, would it be nil or equal to "???" (which has the + ;; same meaning). + (let ((parent headline) value) + (catch 'found + (while parent + (let ((category (org-element-property :CATEGORY parent))) + (and category (not (equal "???" category)) + (throw 'found category))) + (setq parent (org-element-property :parent parent)))))) + (org-element-map (plist-get info :parse-tree) 'keyword + (lambda (kwd) + (when (equal (org-element-property :key kwd) "CATEGORY") + (org-element-property :value kwd))) + info 'first-match) + (let ((file (plist-get info :input-file))) + (and file (file-name-sans-extension (file-name-nondirectory file)))) + "???")) + +(defun org-export-get-alt-title (headline info) + "Return alternative title for HEADLINE, as a secondary string. +INFO is a plist used as a communication channel. If no optional +title is defined, fall-back to the regular title." + (or (org-element-property :alt-title headline) + (org-element-property :title headline))) + +(defun org-export-first-sibling-p (headline info) + "Non-nil when HEADLINE is the first sibling in its sub-tree. +INFO is a plist used as a communication channel." + (not (eq (org-element-type (org-export-get-previous-element headline info)) + 'headline))) + +(defun org-export-last-sibling-p (headline info) + "Non-nil when HEADLINE is the last sibling in its sub-tree. +INFO is a plist used as a communication channel." + (not (org-export-get-next-element headline info))) + + +;;;; For Keywords +;; +;; `org-export-get-date' returns a date appropriate for the document +;; to about to be exported. In particular, it takes care of +;; `org-export-date-timestamp-format'. + +(defun org-export-get-date (info &optional fmt) + "Return date value for the current document. + +INFO is a plist used as a communication channel. FMT, when +non-nil, is a time format string that will be applied on the date +if it consists in a single timestamp object. It defaults to +`org-export-date-timestamp-format' when nil. + +A proper date can be a secondary string, a string or nil. It is +meant to be translated with `org-export-data' or alike." + (let ((date (plist-get info :date)) + (fmt (or fmt org-export-date-timestamp-format))) + (cond ((not date) nil) + ((and fmt + (not (cdr date)) + (eq (org-element-type (car date)) 'timestamp)) + (org-timestamp-format (car date) fmt)) + (t date)))) + + +;;;; For Links +;; +;; `org-export-solidify-link-text' turns a string into a safer version +;; for links, replacing most non-standard characters with hyphens. +;; +;; `org-export-get-coderef-format' returns an appropriate format +;; string for coderefs. +;; +;; `org-export-inline-image-p' returns a non-nil value when the link +;; provided should be considered as an inline image. +;; +;; `org-export-resolve-fuzzy-link' searches destination of fuzzy links +;; (i.e. links with "fuzzy" as type) within the parsed tree, and +;; returns an appropriate unique identifier when found, or nil. +;; +;; `org-export-resolve-id-link' returns the first headline with +;; specified id or custom-id in parse tree, the path to the external +;; file with the id or nil when neither was found. +;; +;; `org-export-resolve-coderef' associates a reference to a line +;; number in the element it belongs, or returns the reference itself +;; when the element isn't numbered. + +(defun org-export-solidify-link-text (s) + "Take link text S and make a safe target out of it." + (save-match-data + (mapconcat 'identity (org-split-string s "[^a-zA-Z0-9_.-:]+") "-"))) + +(defun org-export-get-coderef-format (path desc) + "Return format string for code reference link. +PATH is the link path. DESC is its description." + (save-match-data + (cond ((not desc) "%s") + ((string-match (regexp-quote (concat "(" path ")")) desc) + (replace-match "%s" t t desc)) + (t desc)))) + +(defun org-export-inline-image-p (link &optional rules) + "Non-nil if LINK object points to an inline image. + +Optional argument is a set of RULES defining inline images. It +is an alist where associations have the following shape: + + \(TYPE . REGEXP) + +Applying a rule means apply REGEXP against LINK's path when its +type is TYPE. The function will return a non-nil value if any of +the provided rules is non-nil. The default rule is +`org-export-default-inline-image-rule'. + +This only applies to links without a description." + (and (not (org-element-contents link)) + (let ((case-fold-search t) + (rules (or rules org-export-default-inline-image-rule))) + (catch 'exit + (mapc + (lambda (rule) + (and (string= (org-element-property :type link) (car rule)) + (string-match (cdr rule) + (org-element-property :path link)) + (throw 'exit t))) + rules) + ;; Return nil if no rule matched. + nil)))) + +(defun org-export-resolve-coderef (ref info) + "Resolve a code reference REF. + +INFO is a plist used as a communication channel. + +Return associated line number in source code, or REF itself, +depending on src-block or example element's switches." + (org-element-map (plist-get info :parse-tree) '(example-block src-block) + (lambda (el) + (with-temp-buffer + (insert (org-trim (org-element-property :value el))) + (let* ((label-fmt (regexp-quote + (or (org-element-property :label-fmt el) + org-coderef-label-format))) + (ref-re + (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$" + (replace-regexp-in-string "%s" ref label-fmt nil t)))) + ;; Element containing REF is found. Resolve it to either + ;; a label or a line number, as needed. + (when (re-search-backward ref-re nil t) + (cond + ((org-element-property :use-labels el) ref) + ((eq (org-element-property :number-lines el) 'continued) + (+ (org-export-get-loc el info) (line-number-at-pos))) + (t (line-number-at-pos))))))) + info 'first-match)) + +(defun org-export-resolve-fuzzy-link (link info) + "Return LINK destination. + +INFO is a plist holding contextual information. + +Return value can be an object, an element, or nil: + +- If LINK path matches a target object (i.e. <>) return it. + +- If LINK path exactly matches the name affiliated keyword + \(i.e. #+NAME: path) of an element, return that element. + +- If LINK path exactly matches any headline name, return that + element. If more than one headline share that name, priority + will be given to the one with the closest common ancestor, if + any, or the first one in the parse tree otherwise. + +- Otherwise, return nil. + +Assume LINK type is \"fuzzy\". White spaces are not +significant." + (let* ((raw-path (org-element-property :path link)) + (match-title-p (eq (aref raw-path 0) ?*)) + ;; Split PATH at white spaces so matches are space + ;; insensitive. + (path (org-split-string + (if match-title-p (substring raw-path 1) raw-path))) + ;; Cache for destinations that are not position dependent. + (link-cache + (or (plist-get info :resolve-fuzzy-link-cache) + (plist-get (setq info (plist-put info :resolve-fuzzy-link-cache + (make-hash-table :test 'equal))) + :resolve-fuzzy-link-cache))) + (cached (gethash path link-cache 'not-found))) + (cond + ;; Destination is not position dependent: use cached value. + ((and (not match-title-p) (not (eq cached 'not-found))) cached) + ;; First try to find a matching "<>" unless user specified + ;; he was looking for a headline (path starts with a "*" + ;; character). + ((and (not match-title-p) + (let ((match (org-element-map (plist-get info :parse-tree) 'target + (lambda (blob) + (and (equal (org-split-string + (org-element-property :value blob)) + path) + blob)) + info 'first-match))) + (and match (puthash path match link-cache))))) + ;; Then try to find an element with a matching "#+NAME: path" + ;; affiliated keyword. + ((and (not match-title-p) + (let ((match (org-element-map (plist-get info :parse-tree) + org-element-all-elements + (lambda (el) + (let ((name (org-element-property :name el))) + (when (and name + (equal (org-split-string name) path)) + el))) + info 'first-match))) + (and match (puthash path match link-cache))))) + ;; Last case: link either points to a headline or to nothingness. + ;; Try to find the source, with priority given to headlines with + ;; the closest common ancestor. If such candidate is found, + ;; return it, otherwise return nil. + (t + (let ((find-headline + (function + ;; Return first headline whose `:raw-value' property is + ;; NAME in parse tree DATA, or nil. Statistics cookies + ;; are ignored. + (lambda (name data) + (org-element-map data 'headline + (lambda (headline) + (when (equal (org-split-string + (replace-regexp-in-string + "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" + (org-element-property :raw-value headline))) + name) + headline)) + info 'first-match))))) + ;; Search among headlines sharing an ancestor with link, from + ;; closest to farthest. + (catch 'exit + (mapc + (lambda (parent) + (let ((foundp (funcall find-headline path parent))) + (when foundp (throw 'exit foundp)))) + (let ((parent-hl (org-export-get-parent-headline link))) + (if (not parent-hl) (list (plist-get info :parse-tree)) + (cons parent-hl (org-export-get-genealogy parent-hl))))) + ;; No destination found: return nil. + (and (not match-title-p) (puthash path nil link-cache)))))))) + +(defun org-export-resolve-id-link (link info) + "Return headline referenced as LINK destination. + +INFO is a plist used as a communication channel. + +Return value can be the headline element matched in current parse +tree, a file name or nil. Assume LINK type is either \"id\" or +\"custom-id\"." + (let ((id (org-element-property :path link))) + ;; First check if id is within the current parse tree. + (or (org-element-map (plist-get info :parse-tree) 'headline + (lambda (headline) + (when (or (string= (org-element-property :ID headline) id) + (string= (org-element-property :CUSTOM_ID headline) id)) + headline)) + info 'first-match) + ;; Otherwise, look for external files. + (cdr (assoc id (plist-get info :id-alist)))))) + +(defun org-export-resolve-radio-link (link info) + "Return radio-target object referenced as LINK destination. + +INFO is a plist used as a communication channel. + +Return value can be a radio-target object or nil. Assume LINK +has type \"radio\"." + (let ((path (replace-regexp-in-string + "[ \r\t\n]+" " " (org-element-property :path link)))) + (org-element-map (plist-get info :parse-tree) 'radio-target + (lambda (radio) + (and (eq (compare-strings + (replace-regexp-in-string + "[ \r\t\n]+" " " (org-element-property :value radio)) + nil nil path nil nil t) + t) + radio)) + info 'first-match))) + + +;;;; For References +;; +;; `org-export-get-ordinal' associates a sequence number to any object +;; or element. + +(defun org-export-get-ordinal (element info &optional types predicate) + "Return ordinal number of an element or object. + +ELEMENT is the element or object considered. INFO is the plist +used as a communication channel. + +Optional argument TYPES, when non-nil, is a list of element or +object types, as symbols, that should also be counted in. +Otherwise, only provided element's type is considered. + +Optional argument PREDICATE is a function returning a non-nil +value if the current element or object should be counted in. It +accepts two arguments: the element or object being considered and +the plist used as a communication channel. This allows to count +only a certain type of objects (i.e. inline images). + +Return value is a list of numbers if ELEMENT is a headline or an +item. It is nil for keywords. It represents the footnote number +for footnote definitions and footnote references. If ELEMENT is +a target, return the same value as if ELEMENT was the closest +table, item or headline containing the target. In any other +case, return the sequence number of ELEMENT among elements or +objects of the same type." + ;; Ordinal of a target object refer to the ordinal of the closest + ;; table, item, or headline containing the object. + (when (eq (org-element-type element) 'target) + (setq element + (loop for parent in (org-export-get-genealogy element) + when + (memq + (org-element-type parent) + '(footnote-definition footnote-reference headline item + table)) + return parent))) + (case (org-element-type element) + ;; Special case 1: A headline returns its number as a list. + (headline (org-export-get-headline-number element info)) + ;; Special case 2: An item returns its number as a list. + (item (let ((struct (org-element-property :structure element))) + (org-list-get-item-number + (org-element-property :begin element) + struct + (org-list-prevs-alist struct) + (org-list-parents-alist struct)))) + ((footnote-definition footnote-reference) + (org-export-get-footnote-number element info)) + (otherwise + (let ((counter 0)) + ;; Increment counter until ELEMENT is found again. + (org-element-map (plist-get info :parse-tree) + (or types (org-element-type element)) + (lambda (el) + (cond + ((eq element el) (1+ counter)) + ((not predicate) (incf counter) nil) + ((funcall predicate el info) (incf counter) nil))) + info 'first-match))))) + + +;;;; For Src-Blocks +;; +;; `org-export-get-loc' counts number of code lines accumulated in +;; src-block or example-block elements with a "+n" switch until +;; a given element, excluded. Note: "-n" switches reset that count. +;; +;; `org-export-unravel-code' extracts source code (along with a code +;; references alist) from an `element-block' or `src-block' type +;; element. +;; +;; `org-export-format-code' applies a formatting function to each line +;; of code, providing relative line number and code reference when +;; appropriate. Since it doesn't access the original element from +;; which the source code is coming, it expects from the code calling +;; it to know if lines should be numbered and if code references +;; should appear. +;; +;; Eventually, `org-export-format-code-default' is a higher-level +;; function (it makes use of the two previous functions) which handles +;; line numbering and code references inclusion, and returns source +;; code in a format suitable for plain text or verbatim output. + +(defun org-export-get-loc (element info) + "Return accumulated lines of code up to ELEMENT. + +INFO is the plist used as a communication channel. + +ELEMENT is excluded from count." + (let ((loc 0)) + (org-element-map (plist-get info :parse-tree) + `(src-block example-block ,(org-element-type element)) + (lambda (el) + (cond + ;; ELEMENT is reached: Quit the loop. + ((eq el element)) + ;; Only count lines from src-block and example-block elements + ;; with a "+n" or "-n" switch. A "-n" switch resets counter. + ((not (memq (org-element-type el) '(src-block example-block))) nil) + ((let ((linums (org-element-property :number-lines el))) + (when linums + ;; Accumulate locs or reset them. + (let ((lines (org-count-lines + (org-trim (org-element-property :value el))))) + (setq loc (if (eq linums 'new) lines (+ loc lines)))))) + ;; Return nil to stay in the loop. + nil))) + info 'first-match) + ;; Return value. + loc)) + +(defun org-export-unravel-code (element) + "Clean source code and extract references out of it. + +ELEMENT has either a `src-block' an `example-block' type. + +Return a cons cell whose CAR is the source code, cleaned from any +reference and protective comma and CDR is an alist between +relative line number (integer) and name of code reference on that +line (string)." + (let* ((line 0) refs + ;; Get code and clean it. Remove blank lines at its + ;; beginning and end. + (code (replace-regexp-in-string + "\\`\\([ \t]*\n\\)+" "" + (replace-regexp-in-string + "\\([ \t]*\n\\)*[ \t]*\\'" "\n" + (org-element-property :value element)))) + ;; Get format used for references. + (label-fmt (regexp-quote + (or (org-element-property :label-fmt element) + org-coderef-label-format))) + ;; Build a regexp matching a loc with a reference. + (with-ref-re + (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)[ \t]*\\)$" + (replace-regexp-in-string + "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t)))) + ;; Return value. + (cons + ;; Code with references removed. + (org-element-normalize-string + (mapconcat + (lambda (loc) + (incf line) + (if (not (string-match with-ref-re loc)) loc + ;; Ref line: remove ref, and signal its position in REFS. + (push (cons line (match-string 3 loc)) refs) + (replace-match "" nil nil loc 1))) + (org-split-string code "\n") "\n")) + ;; Reference alist. + refs))) + +(defun org-export-format-code (code fun &optional num-lines ref-alist) + "Format CODE by applying FUN line-wise and return it. + +CODE is a string representing the code to format. FUN is +a function. It must accept three arguments: a line of +code (string), the current line number (integer) or nil and the +reference associated to the current line (string) or nil. + +Optional argument NUM-LINES can be an integer representing the +number of code lines accumulated until the current code. Line +numbers passed to FUN will take it into account. If it is nil, +FUN's second argument will always be nil. This number can be +obtained with `org-export-get-loc' function. + +Optional argument REF-ALIST can be an alist between relative line +number (i.e. ignoring NUM-LINES) and the name of the code +reference on it. If it is nil, FUN's third argument will always +be nil. It can be obtained through the use of +`org-export-unravel-code' function." + (let ((--locs (org-split-string code "\n")) + (--line 0)) + (org-element-normalize-string + (mapconcat + (lambda (--loc) + (incf --line) + (let ((--ref (cdr (assq --line ref-alist)))) + (funcall fun --loc (and num-lines (+ num-lines --line)) --ref))) + --locs "\n")))) + +(defun org-export-format-code-default (element info) + "Return source code from ELEMENT, formatted in a standard way. + +ELEMENT is either a `src-block' or `example-block' element. INFO +is a plist used as a communication channel. + +This function takes care of line numbering and code references +inclusion. Line numbers, when applicable, appear at the +beginning of the line, separated from the code by two white +spaces. Code references, on the other hand, appear flushed to +the right, separated by six white spaces from the widest line of +code." + ;; Extract code and references. + (let* ((code-info (org-export-unravel-code element)) + (code (car code-info)) + (code-lines (org-split-string code "\n"))) + (if (null code-lines) "" + (let* ((refs (and (org-element-property :retain-labels element) + (cdr code-info))) + ;; Handle line numbering. + (num-start (case (org-element-property :number-lines element) + (continued (org-export-get-loc element info)) + (new 0))) + (num-fmt + (and num-start + (format "%%%ds " + (length (number-to-string + (+ (length code-lines) num-start)))))) + ;; Prepare references display, if required. Any reference + ;; should start six columns after the widest line of code, + ;; wrapped with parenthesis. + (max-width + (+ (apply 'max (mapcar 'length code-lines)) + (if (not num-start) 0 (length (format num-fmt num-start)))))) + (org-export-format-code + code + (lambda (loc line-num ref) + (let ((number-str (and num-fmt (format num-fmt line-num)))) + (concat + number-str + loc + (and ref + (concat (make-string + (- (+ 6 max-width) + (+ (length loc) (length number-str))) ? ) + (format "(%s)" ref)))))) + num-start refs))))) + + +;;;; For Tables +;; +;; `org-export-table-has-special-column-p' and and +;; `org-export-table-row-is-special-p' are predicates used to look for +;; meta-information about the table structure. +;; +;; `org-table-has-header-p' tells when the rows before the first rule +;; should be considered as table's header. +;; +;; `org-export-table-cell-width', `org-export-table-cell-alignment' +;; and `org-export-table-cell-borders' extract information from +;; a table-cell element. +;; +;; `org-export-table-dimensions' gives the number on rows and columns +;; in the table, ignoring horizontal rules and special columns. +;; `org-export-table-cell-address', given a table-cell object, returns +;; the absolute address of a cell. On the other hand, +;; `org-export-get-table-cell-at' does the contrary. +;; +;; `org-export-table-cell-starts-colgroup-p', +;; `org-export-table-cell-ends-colgroup-p', +;; `org-export-table-row-starts-rowgroup-p', +;; `org-export-table-row-ends-rowgroup-p', +;; `org-export-table-row-starts-header-p' and +;; `org-export-table-row-ends-header-p' indicate position of current +;; row or cell within the table. + +(defun org-export-table-has-special-column-p (table) + "Non-nil when TABLE has a special column. +All special columns will be ignored during export." + ;; The table has a special column when every first cell of every row + ;; has an empty value or contains a symbol among "/", "#", "!", "$", + ;; "*" "_" and "^". Though, do not consider a first row containing + ;; only empty cells as special. + (let ((special-column-p 'empty)) + (catch 'exit + (mapc + (lambda (row) + (when (eq (org-element-property :type row) 'standard) + (let ((value (org-element-contents + (car (org-element-contents row))))) + (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) + (setq special-column-p 'special)) + ((not value)) + (t (throw 'exit nil)))))) + (org-element-contents table)) + (eq special-column-p 'special)))) + +(defun org-export-table-has-header-p (table info) + "Non-nil when TABLE has a header. + +INFO is a plist used as a communication channel. + +A table has a header when it contains at least two row groups." + (let ((cache (or (plist-get info :table-header-cache) + (plist-get (setq info + (plist-put info :table-header-cache + (make-hash-table :test 'eq))) + :table-header-cache)))) + (or (gethash table cache) + (let ((rowgroup 1) row-flag) + (puthash + table + (org-element-map table 'table-row + (lambda (row) + (cond + ((> rowgroup 1) t) + ((and row-flag (eq (org-element-property :type row) 'rule)) + (incf rowgroup) (setq row-flag nil)) + ((and (not row-flag) (eq (org-element-property :type row) + 'standard)) + (setq row-flag t) nil))) + info 'first-match) + cache))))) + +(defun org-export-table-row-is-special-p (table-row info) + "Non-nil if TABLE-ROW is considered special. + +INFO is a plist used as the communication channel. + +All special rows will be ignored during export." + (when (eq (org-element-property :type table-row) 'standard) + (let ((first-cell (org-element-contents + (car (org-element-contents table-row))))) + ;; A row is special either when... + (or + ;; ... it starts with a field only containing "/", + (equal first-cell '("/")) + ;; ... the table contains a special column and the row start + ;; with a marking character among, "^", "_", "$" or "!", + (and (org-export-table-has-special-column-p + (org-export-get-parent table-row)) + (member first-cell '(("^") ("_") ("$") ("!")))) + ;; ... it contains only alignment cookies and empty cells. + (let ((special-row-p 'empty)) + (catch 'exit + (mapc + (lambda (cell) + (let ((value (org-element-contents cell))) + ;; Since VALUE is a secondary string, the following + ;; checks avoid expanding it with `org-export-data'. + (cond ((not value)) + ((and (not (cdr value)) + (stringp (car value)) + (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" + (car value))) + (setq special-row-p 'cookie)) + (t (throw 'exit nil))))) + (org-element-contents table-row)) + (eq special-row-p 'cookie))))))) + +(defun org-export-table-row-group (table-row info) + "Return TABLE-ROW's group number, as an integer. + +INFO is a plist used as the communication channel. + +Return value is the group number, as an integer, or nil for +special rows and rows separators. First group is also table's +header." + (let ((cache (or (plist-get info :table-row-group-cache) + (plist-get (setq info + (plist-put info :table-row-group-cache + (make-hash-table :test 'eq))) + :table-row-group-cache)))) + (cond ((gethash table-row cache)) + ((eq (org-element-property :type table-row) 'rule) nil) + (t (let ((group 0) row-flag) + (org-element-map (org-export-get-parent table-row) 'table-row + (lambda (row) + (if (eq (org-element-property :type row) 'rule) + (setq row-flag nil) + (unless row-flag (incf group) (setq row-flag t))) + (when (eq table-row row) (puthash table-row group cache))) + info 'first-match)))))) + +(defun org-export-table-cell-width (table-cell info) + "Return TABLE-CELL contents width. + +INFO is a plist used as the communication channel. + +Return value is the width given by the last width cookie in the +same column as TABLE-CELL, or nil." + (let* ((row (org-export-get-parent table-cell)) + (table (org-export-get-parent row)) + (cells (org-element-contents row)) + (columns (length cells)) + (column (- columns (length (memq table-cell cells)))) + (cache (or (plist-get info :table-cell-width-cache) + (plist-get (setq info + (plist-put info :table-cell-width-cache + (make-hash-table :test 'eq))) + :table-cell-width-cache))) + (width-vector (or (gethash table cache) + (puthash table (make-vector columns 'empty) cache))) + (value (aref width-vector column))) + (if (not (eq value 'empty)) value + (let (cookie-width) + (dolist (row (org-element-contents table) + (aset width-vector column cookie-width)) + (when (org-export-table-row-is-special-p row info) + ;; In a special row, try to find a width cookie at COLUMN. + (let* ((value (org-element-contents + (elt (org-element-contents row) column))) + (cookie (car value))) + ;; The following checks avoid expanding unnecessarily + ;; the cell with `org-export-data'. + (when (and value + (not (cdr value)) + (stringp cookie) + (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" cookie) + (match-string 1 cookie)) + (setq cookie-width + (string-to-number (match-string 1 cookie))))))))))) + +(defun org-export-table-cell-alignment (table-cell info) + "Return TABLE-CELL contents alignment. + +INFO is a plist used as the communication channel. + +Return alignment as specified by the last alignment cookie in the +same column as TABLE-CELL. If no such cookie is found, a default +alignment value will be deduced from fraction of numbers in the +column (see `org-table-number-fraction' for more information). +Possible values are `left', `right' and `center'." + ;; Load `org-table-number-fraction' and `org-table-number-regexp'. + (require 'org-table) + (let* ((row (org-export-get-parent table-cell)) + (table (org-export-get-parent row)) + (cells (org-element-contents row)) + (columns (length cells)) + (column (- columns (length (memq table-cell cells)))) + (cache (or (plist-get info :table-cell-alignment-cache) + (plist-get (setq info + (plist-put info :table-cell-alignment-cache + (make-hash-table :test 'eq))) + :table-cell-alignment-cache))) + (align-vector (or (gethash table cache) + (puthash table (make-vector columns nil) cache)))) + (or (aref align-vector column) + (let ((number-cells 0) + (total-cells 0) + cookie-align + previous-cell-number-p) + (dolist (row (org-element-contents (org-export-get-parent row))) + (cond + ;; In a special row, try to find an alignment cookie at + ;; COLUMN. + ((org-export-table-row-is-special-p row info) + (let ((value (org-element-contents + (elt (org-element-contents row) column)))) + ;; Since VALUE is a secondary string, the following + ;; checks avoid useless expansion through + ;; `org-export-data'. + (when (and value + (not (cdr value)) + (stringp (car value)) + (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" + (car value)) + (match-string 1 (car value))) + (setq cookie-align (match-string 1 (car value)))))) + ;; Ignore table rules. + ((eq (org-element-property :type row) 'rule)) + ;; In a standard row, check if cell's contents are + ;; expressing some kind of number. Increase NUMBER-CELLS + ;; accordingly. Though, don't bother if an alignment + ;; cookie has already defined cell's alignment. + ((not cookie-align) + (let ((value (org-export-data + (org-element-contents + (elt (org-element-contents row) column)) + info))) + (incf total-cells) + ;; Treat an empty cell as a number if it follows + ;; a number. + (if (not (or (string-match org-table-number-regexp value) + (and (string= value "") previous-cell-number-p))) + (setq previous-cell-number-p nil) + (setq previous-cell-number-p t) + (incf number-cells)))))) + ;; Return value. Alignment specified by cookies has + ;; precedence over alignment deduced from cell's contents. + (aset align-vector + column + (cond ((equal cookie-align "l") 'left) + ((equal cookie-align "r") 'right) + ((equal cookie-align "c") 'center) + ((>= (/ (float number-cells) total-cells) + org-table-number-fraction) + 'right) + (t 'left))))))) + +(defun org-export-table-cell-borders (table-cell info) + "Return TABLE-CELL borders. + +INFO is a plist used as a communication channel. + +Return value is a list of symbols, or nil. Possible values are: +`top', `bottom', `above', `below', `left' and `right'. Note: +`top' (resp. `bottom') only happen for a cell in the first +row (resp. last row) of the table, ignoring table rules, if any. + +Returned borders ignore special rows." + (let* ((row (org-export-get-parent table-cell)) + (table (org-export-get-parent-table table-cell)) + borders) + ;; Top/above border? TABLE-CELL has a border above when a rule + ;; used to demarcate row groups can be found above. Hence, + ;; finding a rule isn't sufficient to push `above' in BORDERS: + ;; another regular row has to be found above that rule. + (let (rule-flag) + (catch 'exit + (mapc (lambda (row) + (cond ((eq (org-element-property :type row) 'rule) + (setq rule-flag t)) + ((not (org-export-table-row-is-special-p row info)) + (if rule-flag (throw 'exit (push 'above borders)) + (throw 'exit nil))))) + ;; Look at every row before the current one. + (cdr (memq row (reverse (org-element-contents table))))) + ;; No rule above, or rule found starts the table (ignoring any + ;; special row): TABLE-CELL is at the top of the table. + (when rule-flag (push 'above borders)) + (push 'top borders))) + ;; Bottom/below border? TABLE-CELL has a border below when next + ;; non-regular row below is a rule. + (let (rule-flag) + (catch 'exit + (mapc (lambda (row) + (cond ((eq (org-element-property :type row) 'rule) + (setq rule-flag t)) + ((not (org-export-table-row-is-special-p row info)) + (if rule-flag (throw 'exit (push 'below borders)) + (throw 'exit nil))))) + ;; Look at every row after the current one. + (cdr (memq row (org-element-contents table)))) + ;; No rule below, or rule found ends the table (modulo some + ;; special row): TABLE-CELL is at the bottom of the table. + (when rule-flag (push 'below borders)) + (push 'bottom borders))) + ;; Right/left borders? They can only be specified by column + ;; groups. Column groups are defined in a row starting with "/". + ;; Also a column groups row only contains "<", "<>", ">" or blank + ;; cells. + (catch 'exit + (let ((column (let ((cells (org-element-contents row))) + (- (length cells) (length (memq table-cell cells)))))) + (mapc + (lambda (row) + (unless (eq (org-element-property :type row) 'rule) + (when (equal (org-element-contents + (car (org-element-contents row))) + '("/")) + (let ((column-groups + (mapcar + (lambda (cell) + (let ((value (org-element-contents cell))) + (when (member value '(("<") ("<>") (">") nil)) + (car value)))) + (org-element-contents row)))) + ;; There's a left border when previous cell, if + ;; any, ends a group, or current one starts one. + (when (or (and (not (zerop column)) + (member (elt column-groups (1- column)) + '(">" "<>"))) + (member (elt column-groups column) '("<" "<>"))) + (push 'left borders)) + ;; There's a right border when next cell, if any, + ;; starts a group, or current one ends one. + (when (or (and (/= (1+ column) (length column-groups)) + (member (elt column-groups (1+ column)) + '("<" "<>"))) + (member (elt column-groups column) '(">" "<>"))) + (push 'right borders)) + (throw 'exit nil))))) + ;; Table rows are read in reverse order so last column groups + ;; row has precedence over any previous one. + (reverse (org-element-contents table))))) + ;; Return value. + borders)) + +(defun org-export-table-cell-starts-colgroup-p (table-cell info) + "Non-nil when TABLE-CELL is at the beginning of a row group. +INFO is a plist used as a communication channel." + ;; A cell starts a column group either when it is at the beginning + ;; of a row (or after the special column, if any) or when it has + ;; a left border. + (or (eq (org-element-map (org-export-get-parent table-cell) 'table-cell + 'identity info 'first-match) + table-cell) + (memq 'left (org-export-table-cell-borders table-cell info)))) + +(defun org-export-table-cell-ends-colgroup-p (table-cell info) + "Non-nil when TABLE-CELL is at the end of a row group. +INFO is a plist used as a communication channel." + ;; A cell ends a column group either when it is at the end of a row + ;; or when it has a right border. + (or (eq (car (last (org-element-contents + (org-export-get-parent table-cell)))) + table-cell) + (memq 'right (org-export-table-cell-borders table-cell info)))) + +(defun org-export-table-row-starts-rowgroup-p (table-row info) + "Non-nil when TABLE-ROW is at the beginning of a column group. +INFO is a plist used as a communication channel." + (unless (or (eq (org-element-property :type table-row) 'rule) + (org-export-table-row-is-special-p table-row info)) + (let ((borders (org-export-table-cell-borders + (car (org-element-contents table-row)) info))) + (or (memq 'top borders) (memq 'above borders))))) + +(defun org-export-table-row-ends-rowgroup-p (table-row info) + "Non-nil when TABLE-ROW is at the end of a column group. +INFO is a plist used as a communication channel." + (unless (or (eq (org-element-property :type table-row) 'rule) + (org-export-table-row-is-special-p table-row info)) + (let ((borders (org-export-table-cell-borders + (car (org-element-contents table-row)) info))) + (or (memq 'bottom borders) (memq 'below borders))))) + +(defun org-export-table-row-starts-header-p (table-row info) + "Non-nil when TABLE-ROW is the first table header's row. +INFO is a plist used as a communication channel." + (and (org-export-table-has-header-p + (org-export-get-parent-table table-row) info) + (org-export-table-row-starts-rowgroup-p table-row info) + (= (org-export-table-row-group table-row info) 1))) + +(defun org-export-table-row-ends-header-p (table-row info) + "Non-nil when TABLE-ROW is the last table header's row. +INFO is a plist used as a communication channel." + (and (org-export-table-has-header-p + (org-export-get-parent-table table-row) info) + (org-export-table-row-ends-rowgroup-p table-row info) + (= (org-export-table-row-group table-row info) 1))) + +(defun org-export-table-row-number (table-row info) + "Return TABLE-ROW number. +INFO is a plist used as a communication channel. Return value is +zero-based and ignores separators. The function returns nil for +special columns and separators." + (when (and (eq (org-element-property :type table-row) 'standard) + (not (org-export-table-row-is-special-p table-row info))) + (let ((number 0)) + (org-element-map (org-export-get-parent-table table-row) 'table-row + (lambda (row) + (cond ((eq row table-row) number) + ((eq (org-element-property :type row) 'standard) + (incf number) nil))) + info 'first-match)))) + +(defun org-export-table-dimensions (table info) + "Return TABLE dimensions. + +INFO is a plist used as a communication channel. + +Return value is a CONS like (ROWS . COLUMNS) where +ROWS (resp. COLUMNS) is the number of exportable +rows (resp. columns)." + (let (first-row (columns 0) (rows 0)) + ;; Set number of rows, and extract first one. + (org-element-map table 'table-row + (lambda (row) + (when (eq (org-element-property :type row) 'standard) + (incf rows) + (unless first-row (setq first-row row)))) info) + ;; Set number of columns. + (org-element-map first-row 'table-cell (lambda (cell) (incf columns)) info) + ;; Return value. + (cons rows columns))) + +(defun org-export-table-cell-address (table-cell info) + "Return address of a regular TABLE-CELL object. + +TABLE-CELL is the cell considered. INFO is a plist used as +a communication channel. + +Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are +zero-based index. Only exportable cells are considered. The +function returns nil for other cells." + (let* ((table-row (org-export-get-parent table-cell)) + (row-number (org-export-table-row-number table-row info))) + (when row-number + (cons row-number + (let ((col-count 0)) + (org-element-map table-row 'table-cell + (lambda (cell) + (if (eq cell table-cell) col-count (incf col-count) nil)) + info 'first-match)))))) + +(defun org-export-get-table-cell-at (address table info) + "Return regular table-cell object at ADDRESS in TABLE. + +Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are +zero-based index. TABLE is a table type element. INFO is +a plist used as a communication channel. + +If no table-cell, among exportable cells, is found at ADDRESS, +return nil." + (let ((column-pos (cdr address)) (column-count 0)) + (org-element-map + ;; Row at (car address) or nil. + (let ((row-pos (car address)) (row-count 0)) + (org-element-map table 'table-row + (lambda (row) + (cond ((eq (org-element-property :type row) 'rule) nil) + ((= row-count row-pos) row) + (t (incf row-count) nil))) + info 'first-match)) + 'table-cell + (lambda (cell) + (if (= column-count column-pos) cell + (incf column-count) nil)) + info 'first-match))) + + +;;;; For Tables Of Contents +;; +;; `org-export-collect-headlines' builds a list of all exportable +;; headline elements, maybe limited to a certain depth. One can then +;; easily parse it and transcode it. +;; +;; Building lists of tables, figures or listings is quite similar. +;; Once the generic function `org-export-collect-elements' is defined, +;; `org-export-collect-tables', `org-export-collect-figures' and +;; `org-export-collect-listings' can be derived from it. + +(defun org-export-collect-headlines (info &optional n) + "Collect headlines in order to build a table of contents. + +INFO is a plist used as a communication channel. + +When optional argument N is an integer, it specifies the depth of +the table of contents. Otherwise, it is set to the value of the +last headline level. See `org-export-headline-levels' for more +information. + +Return a list of all exportable headlines as parsed elements. +Footnote sections, if any, will be ignored." + (let ((limit (plist-get info :headline-levels))) + (setq n (if (wholenump n) (min n limit) limit)) + (org-element-map (plist-get info :parse-tree) 'headline + #'(lambda (headline) + (unless (org-element-property :footnote-section-p headline) + (let ((level (org-export-get-relative-level headline info))) + (and (<= level n) headline)))) + info))) + +(defun org-export-collect-elements (type info &optional predicate) + "Collect referenceable elements of a determined type. + +TYPE can be a symbol or a list of symbols specifying element +types to search. Only elements with a caption are collected. + +INFO is a plist used as a communication channel. + +When non-nil, optional argument PREDICATE is a function accepting +one argument, an element of type TYPE. It returns a non-nil +value when that element should be collected. + +Return a list of all elements found, in order of appearance." + (org-element-map (plist-get info :parse-tree) type + (lambda (element) + (and (org-element-property :caption element) + (or (not predicate) (funcall predicate element)) + element)) + info)) + +(defun org-export-collect-tables (info) + "Build a list of tables. +INFO is a plist used as a communication channel. + +Return a list of table elements with a caption." + (org-export-collect-elements 'table info)) + +(defun org-export-collect-figures (info predicate) + "Build a list of figures. + +INFO is a plist used as a communication channel. PREDICATE is +a function which accepts one argument: a paragraph element and +whose return value is non-nil when that element should be +collected. + +A figure is a paragraph type element, with a caption, verifying +PREDICATE. The latter has to be provided since a \"figure\" is +a vague concept that may depend on back-end. + +Return a list of elements recognized as figures." + (org-export-collect-elements 'paragraph info predicate)) + +(defun org-export-collect-listings (info) + "Build a list of src blocks. + +INFO is a plist used as a communication channel. + +Return a list of src-block elements with a caption." + (org-export-collect-elements 'src-block info)) + + +;;;; Smart Quotes +;; +;; The main function for the smart quotes sub-system is +;; `org-export-activate-smart-quotes', which replaces every quote in +;; a given string from the parse tree with its "smart" counterpart. +;; +;; Dictionary for smart quotes is stored in +;; `org-export-smart-quotes-alist'. +;; +;; Internally, regexps matching potential smart quotes (checks at +;; string boundaries are also necessary) are defined in +;; `org-export-smart-quotes-regexps'. + +(defconst org-export-smart-quotes-alist + '(("da" + ;; one may use: »...«, "...", ›...‹, or '...'. + ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/ + ;; LaTeX quotes require Babel! + (opening-double-quote :utf-8 "»" :html "»" :latex ">>" + :texinfo "@guillemetright{}") + (closing-double-quote :utf-8 "«" :html "«" :latex "<<" + :texinfo "@guillemetleft{}") + (opening-single-quote :utf-8 "›" :html "›" :latex "\\frq{}" + :texinfo "@guilsinglright{}") + (closing-single-quote :utf-8 "‹" :html "‹" :latex "\\flq{}" + :texinfo "@guilsingleft{}") + (apostrophe :utf-8 "’" :html "’")) + ("de" + (opening-double-quote :utf-8 "„" :html "„" :latex "\"`" + :texinfo "@quotedblbase{}") + (closing-double-quote :utf-8 "“" :html "“" :latex "\"'" + :texinfo "@quotedblleft{}") + (opening-single-quote :utf-8 "‚" :html "‚" :latex "\\glq{}" + :texinfo "@quotesinglbase{}") + (closing-single-quote :utf-8 "‘" :html "‘" :latex "\\grq{}" + :texinfo "@quoteleft{}") + (apostrophe :utf-8 "’" :html "’")) + ("en" + (opening-double-quote :utf-8 "“" :html "“" :latex "``" :texinfo "``") + (closing-double-quote :utf-8 "”" :html "”" :latex "''" :texinfo "''") + (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("es" + (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "“" :html "“" :latex "``" :texinfo "``") + (closing-single-quote :utf-8 "”" :html "”" :latex "''" :texinfo "''") + (apostrophe :utf-8 "’" :html "’")) + ("fr" + (opening-double-quote :utf-8 "« " :html "« " :latex "\\og " + :texinfo "@guillemetleft{}@tie{}") + (closing-double-quote :utf-8 " »" :html " »" :latex "\\fg{}" + :texinfo "@tie{}@guillemetright{}") + (opening-single-quote :utf-8 "« " :html "« " :latex "\\og " + :texinfo "@guillemetleft{}@tie{}") + (closing-single-quote :utf-8 " »" :html " »" :latex "\\fg{}" + :texinfo "@tie{}@guillemetright{}") + (apostrophe :utf-8 "’" :html "’")) + ("no" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("nb" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("nn" + ;; https://nn.wikipedia.org/wiki/Sitatteikn + (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" + :texinfo "@guillemetleft{}") + (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" + :texinfo "@guillemetright{}") + (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ("sv" + ;; based on https://sv.wikipedia.org/wiki/Citattecken + (opening-double-quote :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") + (closing-double-quote :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") + (opening-single-quote :utf-8 "’" :html "’" :latex "’" :texinfo "`") + (closing-single-quote :utf-8 "’" :html "’" :latex "’" :texinfo "'") + (apostrophe :utf-8 "’" :html "’")) + ) + "Smart quotes translations. + +Alist whose CAR is a language string and CDR is an alist with +quote type as key and a plist associating various encodings to +their translation as value. + +A quote type can be any symbol among `opening-double-quote', +`closing-double-quote', `opening-single-quote', +`closing-single-quote' and `apostrophe'. + +Valid encodings include `:utf-8', `:html', `:latex' and +`:texinfo'. + +If no translation is found, the quote character is left as-is.") + +(defconst org-export-smart-quotes-regexps + (list + ;; Possible opening quote at beginning of string. + "\\`\\([\"']\\)\\(\\w\\|\\s.\\|\\s_\\|\\s(\\)" + ;; Possible closing quote at beginning of string. + "\\`\\([\"']\\)\\(\\s-\\|\\s)\\|\\s.\\)" + ;; Possible apostrophe at beginning of string. + "\\`\\('\\)\\S-" + ;; Opening single and double quotes. + "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\(?:\\w\\|\\s.\\|\\s_\\)" + ;; Closing single and double quotes. + "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\(?:\\s-\\|\\s)\\|\\s.\\)" + ;; Apostrophe. + "\\S-\\('\\)\\S-" + ;; Possible opening quote at end of string. + "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\'" + ;; Possible closing quote at end of string. + "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\'" + ;; Possible apostrophe at end of string. + "\\S-\\('\\)\\'") + "List of regexps matching a quote or an apostrophe. +In every regexp, quote or apostrophe matched is put in group 1.") + +(defun org-export-activate-smart-quotes (s encoding info &optional original) + "Replace regular quotes with \"smart\" quotes in string S. + +ENCODING is a symbol among `:html', `:latex', `:texinfo' and +`:utf-8'. INFO is a plist used as a communication channel. + +The function has to retrieve information about string +surroundings in parse tree. It can only happen with an +unmodified string. Thus, if S has already been through another +process, a non-nil ORIGINAL optional argument will provide that +original string. + +Return the new string." + (if (equal s "") "" + (let* ((prev (org-export-get-previous-element (or original s) info)) + ;; Try to be flexible when computing number of blanks + ;; before object. The previous object may be a string + ;; introduced by the back-end and not completely parsed. + (pre-blank (and prev + (or (org-element-property :post-blank prev) + ;; A string with missing `:post-blank' + ;; property. + (and (stringp prev) + (string-match " *\\'" prev) + (length (match-string 0 prev))) + ;; Fallback value. + 0))) + (next (org-export-get-next-element (or original s) info)) + (get-smart-quote + (lambda (q type) + ;; Return smart quote associated to a give quote Q, as + ;; a string. TYPE is a symbol among `open', `close' and + ;; `apostrophe'. + (let ((key (case type + (apostrophe 'apostrophe) + (open (if (equal "'" q) 'opening-single-quote + 'opening-double-quote)) + (otherwise (if (equal "'" q) 'closing-single-quote + 'closing-double-quote))))) + (or (plist-get + (cdr (assq key + (cdr (assoc (plist-get info :language) + org-export-smart-quotes-alist)))) + encoding) + q))))) + (if (or (equal "\"" s) (equal "'" s)) + ;; Only a quote: no regexp can match. We have to check both + ;; sides and decide what to do. + (cond ((and (not prev) (not next)) s) + ((not prev) (funcall get-smart-quote s 'open)) + ((and (not next) (zerop pre-blank)) + (funcall get-smart-quote s 'close)) + ((not next) s) + ((zerop pre-blank) (funcall get-smart-quote s 'apostrophe)) + (t (funcall get-smart-quote 'open))) + ;; 1. Replace quote character at the beginning of S. + (cond + ;; Apostrophe? + ((and prev (zerop pre-blank) + (string-match (nth 2 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'apostrophe) + nil t s 1))) + ;; Closing quote? + ((and prev (zerop pre-blank) + (string-match (nth 1 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'close) + nil t s 1))) + ;; Opening quote? + ((and (or (not prev) (> pre-blank 0)) + (string-match (nth 0 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'open) + nil t s 1)))) + ;; 2. Replace quotes in the middle of the string. + (setq s (replace-regexp-in-string + ;; Opening quotes. + (nth 3 org-export-smart-quotes-regexps) + (lambda (text) + (funcall get-smart-quote (match-string 1 text) 'open)) + s nil t 1)) + (setq s (replace-regexp-in-string + ;; Closing quotes. + (nth 4 org-export-smart-quotes-regexps) + (lambda (text) + (funcall get-smart-quote (match-string 1 text) 'close)) + s nil t 1)) + (setq s (replace-regexp-in-string + ;; Apostrophes. + (nth 5 org-export-smart-quotes-regexps) + (lambda (text) + (funcall get-smart-quote (match-string 1 text) 'apostrophe)) + s nil t 1)) + ;; 3. Replace quote character at the end of S. + (cond + ;; Apostrophe? + ((and next (string-match (nth 8 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'apostrophe) + nil t s 1))) + ;; Closing quote? + ((and (not next) + (string-match (nth 7 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'close) + nil t s 1))) + ;; Opening quote? + ((and next (string-match (nth 6 org-export-smart-quotes-regexps) s)) + (setq s (replace-match + (funcall get-smart-quote (match-string 1 s) 'open) + nil t s 1)))) + ;; Return string with smart quotes. + s)))) + +;;;; Topology +;; +;; Here are various functions to retrieve information about the +;; neighborhood of a given element or object. Neighbors of interest +;; are direct parent (`org-export-get-parent'), parent headline +;; (`org-export-get-parent-headline'), first element containing an +;; object, (`org-export-get-parent-element'), parent table +;; (`org-export-get-parent-table'), previous element or object +;; (`org-export-get-previous-element') and next element or object +;; (`org-export-get-next-element'). +;; +;; `org-export-get-genealogy' returns the full genealogy of a given +;; element or object, from closest parent to full parse tree. + +;; defsubst org-export-get-parent must be defined before first use +(defun org-export-get-genealogy (blob) + "Return full genealogy relative to a given element or object. + +BLOB is the element or object being considered. + +Ancestors are returned from closest to farthest, the last one +being the full parse tree." + (let (genealogy (parent blob)) + (while (setq parent (org-element-property :parent parent)) + (push parent genealogy)) + (nreverse genealogy))) + +(defun org-export-get-parent-headline (blob) + "Return BLOB parent headline or nil. +BLOB is the element or object being considered." + (let ((parent blob)) + (while (and (setq parent (org-element-property :parent parent)) + (not (eq (org-element-type parent) 'headline)))) + parent)) + +(defun org-export-get-parent-element (object) + "Return first element containing OBJECT or nil. +OBJECT is the object to consider." + (let ((parent object)) + (while (and (setq parent (org-element-property :parent parent)) + (memq (org-element-type parent) org-element-all-objects))) + parent)) + +(defun org-export-get-parent-table (object) + "Return OBJECT parent table or nil. +OBJECT is either a `table-cell' or `table-element' type object." + (let ((parent object)) + (while (and (setq parent (org-element-property :parent parent)) + (not (eq (org-element-type parent) 'table)))) + parent)) + +(defun org-export-get-previous-element (blob info &optional n) + "Return previous element or object. + +BLOB is an element or object. INFO is a plist used as +a communication channel. Return previous exportable element or +object, a string, or nil. + +When optional argument N is a positive integer, return a list +containing up to N siblings before BLOB, from farthest to +closest. With any other non-nil value, return a list containing +all of them." + (let ((siblings + ;; An object can belong to the contents of its parent or + ;; to a secondary string. We check the latter option + ;; first. + (let ((parent (org-export-get-parent blob))) + (or (let ((sec-value (org-element-property + (cdr (assq (org-element-type parent) + org-element-secondary-value-alist)) + parent))) + (and (memq blob sec-value) sec-value)) + (org-element-contents parent)))) + prev) + (catch 'exit + (mapc (lambda (obj) + (cond ((memq obj (plist-get info :ignore-list))) + ((null n) (throw 'exit obj)) + ((not (wholenump n)) (push obj prev)) + ((zerop n) (throw 'exit prev)) + (t (decf n) (push obj prev)))) + (cdr (memq blob (reverse siblings)))) + prev))) + +(defun org-export-get-next-element (blob info &optional n) + "Return next element or object. + +BLOB is an element or object. INFO is a plist used as +a communication channel. Return next exportable element or +object, a string, or nil. + +When optional argument N is a positive integer, return a list +containing up to N siblings after BLOB, from closest to farthest. +With any other non-nil value, return a list containing all of +them." + (let ((siblings + ;; An object can belong to the contents of its parent or to + ;; a secondary string. We check the latter option first. + (let ((parent (org-export-get-parent blob))) + (or (let ((sec-value (org-element-property + (cdr (assq (org-element-type parent) + org-element-secondary-value-alist)) + parent))) + (cdr (memq blob sec-value))) + (cdr (memq blob (org-element-contents parent)))))) + next) + (catch 'exit + (mapc (lambda (obj) + (cond ((memq obj (plist-get info :ignore-list))) + ((null n) (throw 'exit obj)) + ((not (wholenump n)) (push obj next)) + ((zerop n) (throw 'exit (nreverse next))) + (t (decf n) (push obj next)))) + siblings) + (nreverse next)))) + + +;;;; Translation +;; +;; `org-export-translate' translates a string according to the language +;; specified by the LANGUAGE keyword. `org-export-dictionary' contains +;; the dictionary used for the translation. + +(defconst org-export-dictionary + '(("%e %n: %c" + ("fr" :default "%e %n : %c" :html "%e %n : %c")) + ("Author" + ("ca" :default "Autor") + ("cs" :default "Autor") + ("da" :default "Forfatter") + ("de" :default "Autor") + ("eo" :html "Aŭtoro") + ("es" :default "Autor") + ("fi" :html "Tekijä") + ("fr" :default "Auteur") + ("hu" :default "Szerzõ") + ("is" :html "Höfundur") + ("it" :default "Autore") + ("ja" :html "著者" :utf-8 "著者") + ("nl" :default "Auteur") + ("no" :default "Forfatter") + ("nb" :default "Forfatter") + ("nn" :default "Forfattar") + ("pl" :default "Autor") + ("pt_BR" :default "Autor") + ("ru" :html "Автор" :utf-8 "Автор") + ("sv" :html "Författare") + ("uk" :html "Автор" :utf-8 "Автор") + ("zh-CN" :html "作者" :utf-8 "作者") + ("zh-TW" :html "作者" :utf-8 "作者")) + ("Date" + ("ca" :default "Data") + ("cs" :default "Datum") + ("da" :default "Dato") + ("de" :default "Datum") + ("eo" :default "Dato") + ("es" :default "Fecha") + ("fi" :html "Päivämäärä") + ("hu" :html "Dátum") + ("is" :default "Dagsetning") + ("it" :default "Data") + ("ja" :html "日付" :utf-8 "日付") + ("nl" :default "Datum") + ("no" :default "Dato") + ("nb" :default "Dato") + ("nn" :default "Dato") + ("pl" :default "Data") + ("pt_BR" :default "Data") + ("ru" :html "Дата" :utf-8 "Дата") + ("sv" :default "Datum") + ("uk" :html "Дата" :utf-8 "Дата") + ("zh-CN" :html "日期" :utf-8 "日期") + ("zh-TW" :html "日期" :utf-8 "日期")) + ("Equation" + ("da" :default "Ligning") + ("de" :default "Gleichung") + ("es" :html "Ecuación" :default "Ecuación") + ("fr" :ascii "Equation" :default "Équation") + ("no" :default "Ligning") + ("nb" :default "Ligning") + ("nn" :default "Likning") + ("pt_BR" :html "Equação" :default "Equação" :ascii "Equacao") + ("sv" :default "Ekvation") + ("zh-CN" :html "方程" :utf-8 "方程")) + ("Figure" + ("da" :default "Figur") + ("de" :default "Abbildung") + ("es" :default "Figura") + ("ja" :html "図" :utf-8 "図") + ("no" :default "Illustrasjon") + ("nb" :default "Illustrasjon") + ("nn" :default "Illustrasjon") + ("pt_BR" :default "Figura") + ("sv" :default "Illustration") + ("zh-CN" :html "图" :utf-8 "图")) + ("Figure %d:" + ("da" :default "Figur %d") + ("de" :default "Abbildung %d:") + ("es" :default "Figura %d:") + ("fr" :default "Figure %d :" :html "Figure %d :") + ("ja" :html "図%d: " :utf-8 "図%d: ") + ("no" :default "Illustrasjon %d") + ("nb" :default "Illustrasjon %d") + ("nn" :default "Illustrasjon %d") + ("pt_BR" :default "Figura %d:") + ("sv" :default "Illustration %d") + ("zh-CN" :html "图%d " :utf-8 "图%d ")) + ("Footnotes" + ("ca" :html "Peus de pàgina") + ("cs" :default "Pozn\xe1mky pod carou") + ("da" :default "Fodnoter") + ("de" :html "Fußnoten" :default "Fußnoten") + ("eo" :default "Piednotoj") + ("es" :html "Nota al pie de página" :default "Nota al pie de página") + ("fi" :default "Alaviitteet") + ("fr" :default "Notes de bas de page") + ("hu" :html "Lábjegyzet") + ("is" :html "Aftanmálsgreinar") + ("it" :html "Note a piè di pagina") + ("ja" :html "脚注" :utf-8 "脚注") + ("nl" :default "Voetnoten") + ("no" :default "Fotnoter") + ("nb" :default "Fotnoter") + ("nn" :default "Fotnotar") + ("pl" :default "Przypis") + ("pt_BR" :html "Notas de Rodapé" :default "Notas de Rodapé" :ascii "Notas de Rodape") + ("ru" :html "Сноски" :utf-8 "Сноски") + ("sv" :default "Fotnoter") + ("uk" :html "Примітки" + :utf-8 "Примітки") + ("zh-CN" :html "脚注" :utf-8 "脚注") + ("zh-TW" :html "腳註" :utf-8 "腳註")) + ("List of Listings" + ("da" :default "Programmer") + ("de" :default "Programmauflistungsverzeichnis") + ("es" :default "Indice de Listados de programas") + ("fr" :default "Liste des programmes") + ("no" :default "Dataprogrammer") + ("nb" :default "Dataprogrammer") + ("zh-CN" :html "代码目录" :utf-8 "代码目录")) + ("List of Tables" + ("da" :default "Tabeller") + ("de" :default "Tabellenverzeichnis") + ("es" :default "Indice de tablas") + ("fr" :default "Liste des tableaux") + ("no" :default "Tabeller") + ("nb" :default "Tabeller") + ("nn" :default "Tabeller") + ("pt_BR" :default "Índice de Tabelas" :ascii "Indice de Tabelas") + ("sv" :default "Tabeller") + ("zh-CN" :html "表格目录" :utf-8 "表格目录")) + ("Listing %d:" + ("da" :default "Program %d") + ("de" :default "Programmlisting %d") + ("es" :default "Listado de programa %d") + ("fr" :default "Programme %d :" :html "Programme %d :") + ("no" :default "Dataprogram") + ("nb" :default "Dataprogram") + ("pt_BR" :default "Listagem %d") + ("zh-CN" :html "代码%d " :utf-8 "代码%d ")) + ("See section %s" + ("da" :default "jævnfør afsnit %s") + ("de" :default "siehe Abschnitt %s") + ("es" :default "vea seccion %s") + ("fr" :default "cf. section %s") + ("pt_BR" :html "Veja a seção %s" :default "Veja a seção %s" :ascii "Veja a secao %s") + ("zh-CN" :html "参见第%d节" :utf-8 "参见第%s节")) + ("Table" + ("de" :default "Tabelle") + ("es" :default "Tabla") + ("fr" :default "Tableau") + ("ja" :html "表" :utf-8 "表") + ("pt_BR" :default "Tabela") + ("zh-CN" :html "表" :utf-8 "表")) + ("Table %d:" + ("da" :default "Tabel %d") + ("de" :default "Tabelle %d") + ("es" :default "Tabla %d") + ("fr" :default "Tableau %d :") + ("ja" :html "表%d:" :utf-8 "表%d:") + ("no" :default "Tabell %d") + ("nb" :default "Tabell %d") + ("nn" :default "Tabell %d") + ("pt_BR" :default "Tabela %d") + ("sv" :default "Tabell %d") + ("zh-CN" :html "表%d " :utf-8 "表%d ")) + ("Table of Contents" + ("ca" :html "Índex") + ("cs" :default "Obsah") + ("da" :default "Indhold") + ("de" :default "Inhaltsverzeichnis") + ("eo" :default "Enhavo") + ("es" :html "Índice") + ("fi" :html "Sisällysluettelo") + ("fr" :ascii "Sommaire" :default "Table des matières") + ("hu" :html "Tartalomjegyzék") + ("is" :default "Efnisyfirlit") + ("it" :default "Indice") + ("ja" :html "目次" :utf-8 "目次") + ("nl" :default "Inhoudsopgave") + ("no" :default "Innhold") + ("nb" :default "Innhold") + ("nn" :default "Innhald") + ("pl" :html "Spis treści") + ("pt_BR" :html "Índice" :utf8 "Índice" :ascii "Indice") + ("ru" :html "Содержание" + :utf-8 "Содержание") + ("sv" :html "Innehåll") + ("uk" :html "Зміст" :utf-8 "Зміст") + ("zh-CN" :html "目录" :utf-8 "目录") + ("zh-TW" :html "目錄" :utf-8 "目錄")) + ("Unknown reference" + ("da" :default "ukendt reference") + ("de" :default "Unbekannter Verweis") + ("es" :default "referencia desconocida") + ("fr" :ascii "Destination inconnue" :default "Référence inconnue") + ("pt_BR" :default "Referência desconhecida" :ascii "Referencia desconhecida") + ("zh-CN" :html "未知引用" :utf-8 "未知引用"))) + "Dictionary for export engine. + +Alist whose CAR is the string to translate and CDR is an alist +whose CAR is the language string and CDR is a plist whose +properties are possible charsets and values translated terms. + +It is used as a database for `org-export-translate'. Since this +function returns the string as-is if no translation was found, +the variable only needs to record values different from the +entry.") + +(defun org-export-translate (s encoding info) + "Translate string S according to language specification. + +ENCODING is a symbol among `:ascii', `:html', `:latex', `:latin1' +and `:utf-8'. INFO is a plist used as a communication channel. + +Translation depends on `:language' property. Return the +translated string. If no translation is found, try to fall back +to `:default' encoding. If it fails, return S." + (let* ((lang (plist-get info :language)) + (translations (cdr (assoc lang + (cdr (assoc s org-export-dictionary)))))) + (or (plist-get translations encoding) + (plist-get translations :default) + s))) + + + +;;; Asynchronous Export +;; +;; `org-export-async-start' is the entry point for asynchronous +;; export. It recreates current buffer (including visibility, +;; narrowing and visited file) in an external Emacs process, and +;; evaluates a command there. It then applies a function on the +;; returned results in the current process. +;; +;; At a higher level, `org-export-to-buffer' and `org-export-to-file' +;; allow to export to a buffer or a file, asynchronously or not. +;; +;; `org-export-output-file-name' is an auxiliary function meant to be +;; used with `org-export-to-file'. With a given extension, it tries +;; to provide a canonical file name to write export output to. +;; +;; Asynchronously generated results are never displayed directly. +;; Instead, they are stored in `org-export-stack-contents'. They can +;; then be retrieved by calling `org-export-stack'. +;; +;; Export Stack is viewed through a dedicated major mode +;;`org-export-stack-mode' and tools: `org-export-stack-refresh', +;;`org-export-stack-delete', `org-export-stack-view' and +;;`org-export-stack-clear'. +;; +;; For back-ends, `org-export-add-to-stack' add a new source to stack. +;; It should be used whenever `org-export-async-start' is called. + +(defmacro org-export-async-start (fun &rest body) + "Call function FUN on the results returned by BODY evaluation. + +FUN is an anonymous function of one argument. BODY evaluation +happens in an asynchronous process, from a buffer which is an +exact copy of the current one. + +Use `org-export-add-to-stack' in FUN in order to register results +in the stack. + +This is a low level function. See also `org-export-to-buffer' +and `org-export-to-file' for more specialized functions." + (declare (indent 1) (debug t)) + (org-with-gensyms (process temp-file copy-fun proc-buffer coding) + ;; Write the full sexp evaluating BODY in a copy of the current + ;; buffer to a temporary file, as it may be too long for program + ;; args in `start-process'. + `(with-temp-message "Initializing asynchronous export process" + (let ((,copy-fun (org-export--generate-copy-script (current-buffer))) + (,temp-file (make-temp-file "org-export-process")) + (,coding buffer-file-coding-system)) + (with-temp-file ,temp-file + (insert + ;; Null characters (from variable values) are inserted + ;; within the file. As a consequence, coding system for + ;; buffer contents will not be recognized properly. So, + ;; we make sure it is the same as the one used to display + ;; the original buffer. + (format ";; -*- coding: %s; -*-\n%S" + ,coding + `(with-temp-buffer + (when org-export-async-debug '(setq debug-on-error t)) + ;; Ignore `kill-emacs-hook' and code evaluation + ;; queries from Babel as we need a truly + ;; non-interactive process. + (setq kill-emacs-hook nil + org-babel-confirm-evaluate-answer-no t) + ;; Initialize export framework. + (require 'ox) + ;; Re-create current buffer there. + (funcall ,,copy-fun) + (restore-buffer-modified-p nil) + ;; Sexp to evaluate in the buffer. + (print (progn ,,@body)))))) + ;; Start external process. + (let* ((process-connection-type nil) + (,proc-buffer (generate-new-buffer-name "*Org Export Process*")) + (,process + (start-process + "org-export-process" ,proc-buffer + (expand-file-name invocation-name invocation-directory) + "-Q" "--batch" + "-l" org-export-async-init-file + "-l" ,temp-file))) + ;; Register running process in stack. + (org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process) + ;; Set-up sentinel in order to catch results. + (let ((handler ,fun)) + (set-process-sentinel + ,process + `(lambda (p status) + (let ((proc-buffer (process-buffer p))) + (when (eq (process-status p) 'exit) + (unwind-protect + (if (zerop (process-exit-status p)) + (unwind-protect + (let ((results + (with-current-buffer proc-buffer + (goto-char (point-max)) + (backward-sexp) + (read (current-buffer))))) + (funcall ,handler results)) + (unless org-export-async-debug + (and (get-buffer proc-buffer) + (kill-buffer proc-buffer)))) + (org-export-add-to-stack proc-buffer nil p) + (ding) + (message "Process '%s' exited abnormally" p)) + (unless org-export-async-debug + (delete-file ,,temp-file))))))))))))) + +;;;###autoload +(defun org-export-to-buffer + (backend buffer + &optional async subtreep visible-only body-only ext-plist + post-process) + "Call `org-export-as' with output to a specified buffer. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. + +BUFFER is the name of the output buffer. If it already exists, +it will be erased first, otherwise, it will be created. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should then be accessible +through the `org-export-stack' interface. When ASYNC is nil, the +buffer is displayed if `org-export-show-temporary-export-buffer' +is non-nil. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which +see. + +Optional argument POST-PROCESS is a function which should accept +no argument. It is always called within the current process, +from BUFFER, with point at its beginning. Export back-ends can +use it to set a major mode there, e.g, + + \(defun org-latex-export-as-latex + \(&optional async subtreep visible-only body-only ext-plist) + \(interactive) + \(org-export-to-buffer 'latex \"*Org LATEX Export*\" + async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) + +This function returns BUFFER." + (declare (indent 2)) + (if async + (org-export-async-start + `(lambda (output) + (with-current-buffer (get-buffer-create ,buffer) + (erase-buffer) + (setq buffer-file-coding-system ',buffer-file-coding-system) + (insert output) + (goto-char (point-min)) + (org-export-add-to-stack (current-buffer) ',backend) + (ignore-errors (funcall ,post-process)))) + `(org-export-as + ',backend ,subtreep ,visible-only ,body-only ',ext-plist)) + (let ((output + (org-export-as backend subtreep visible-only body-only ext-plist)) + (buffer (get-buffer-create buffer)) + (encoding buffer-file-coding-system)) + (when (and (org-string-nw-p output) (org-export--copy-to-kill-ring-p)) + (org-kill-new output)) + (with-current-buffer buffer + (erase-buffer) + (setq buffer-file-coding-system encoding) + (insert output) + (goto-char (point-min)) + (and (functionp post-process) (funcall post-process))) + (when org-export-show-temporary-export-buffer + (switch-to-buffer-other-window buffer)) + buffer))) + +;;;###autoload +(defun org-export-to-file + (backend file &optional async subtreep visible-only body-only ext-plist + post-process) + "Call `org-export-as' with output to a specified file. + +BACKEND is either an export back-end, as returned by, e.g., +`org-export-create-backend', or a symbol referring to +a registered back-end. FILE is the name of the output file, as +a string. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer will then be accessible +through the `org-export-stack' interface. + +Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and +EXT-PLIST are similar to those used in `org-export-as', which +see. + +Optional argument POST-PROCESS is called with FILE as its +argument and happens asynchronously when ASYNC is non-nil. It +has to return a file name, or nil. Export back-ends can use this +to send the output file through additional processing, e.g, + + \(defun org-latex-export-to-latex + \(&optional async subtreep visible-only body-only ext-plist) + \(interactive) + \(let ((outfile (org-export-output-file-name \".tex\" subtreep))) + \(org-export-to-file 'latex outfile + async subtreep visible-only body-only ext-plist + \(lambda (file) (org-latex-compile file))) + +The function returns either a file name returned by POST-PROCESS, +or FILE." + (declare (indent 2)) + (if (not (file-writable-p file)) (error "Output file not writable") + (let ((ext-plist (org-combine-plists `(:output-file ,file) ext-plist)) + (encoding (or org-export-coding-system buffer-file-coding-system))) + (if async + (org-export-async-start + `(lambda (file) + (org-export-add-to-stack (expand-file-name file) ',backend)) + `(let ((output + (org-export-as + ',backend ,subtreep ,visible-only ,body-only + ',ext-plist))) + (with-temp-buffer + (insert output) + (let ((coding-system-for-write ',encoding)) + (write-file ,file))) + (or (ignore-errors (funcall ',post-process ,file)) ,file))) + (let ((output (org-export-as + backend subtreep visible-only body-only ext-plist))) + (with-temp-buffer + (insert output) + (let ((coding-system-for-write encoding)) + (write-file file))) + (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p output)) + (org-kill-new output)) + ;; Get proper return value. + (or (and (functionp post-process) (funcall post-process file)) + file)))))) + +(defun org-export-output-file-name (extension &optional subtreep pub-dir) + "Return output file's name according to buffer specifications. + +EXTENSION is a string representing the output file extension, +with the leading dot. + +With a non-nil optional argument SUBTREEP, try to determine +output file's name by looking for \"EXPORT_FILE_NAME\" property +of subtree at point. + +When optional argument PUB-DIR is set, use it as the publishing +directory. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +Return file name as a string." + (let* ((visited-file (buffer-file-name (buffer-base-buffer))) + (base-name + ;; File name may come from EXPORT_FILE_NAME subtree + ;; property, assuming point is at beginning of said + ;; sub-tree. + (file-name-sans-extension + (or (and subtreep + (org-entry-get + (save-excursion + (ignore-errors (org-back-to-heading) (point))) + "EXPORT_FILE_NAME" t)) + ;; File name may be extracted from buffer's associated + ;; file, if any. + (and visited-file (file-name-nondirectory visited-file)) + ;; Can't determine file name on our own: Ask user. + (let ((read-file-name-function + (and org-completion-use-ido 'ido-read-file-name))) + (read-file-name + "Output file: " pub-dir nil nil nil + (lambda (name) + (string= (file-name-extension name t) extension))))))) + (output-file + ;; Build file name. Enforce EXTENSION over whatever user + ;; may have come up with. PUB-DIR, if defined, always has + ;; precedence over any provided path. + (cond + (pub-dir + (concat (file-name-as-directory pub-dir) + (file-name-nondirectory base-name) + extension)) + ((file-name-absolute-p base-name) (concat base-name extension)) + (t (concat (file-name-as-directory ".") base-name extension))))) + ;; If writing to OUTPUT-FILE would overwrite original file, append + ;; EXTENSION another time to final name. + (if (and visited-file (org-file-equal-p visited-file output-file)) + (concat output-file extension) + output-file))) + +(defun org-export-add-to-stack (source backend &optional process) + "Add a new result to export stack if not present already. + +SOURCE is a buffer or a file name containing export results. +BACKEND is a symbol representing export back-end used to generate +it. + +Entries already pointing to SOURCE and unavailable entries are +removed beforehand. Return the new stack." + (setq org-export-stack-contents + (cons (list source backend (or process (current-time))) + (org-export-stack-remove source)))) + +(defun org-export-stack () + "Menu for asynchronous export results and running processes." + (interactive) + (let ((buffer (get-buffer-create "*Org Export Stack*"))) + (set-buffer buffer) + (when (zerop (buffer-size)) (org-export-stack-mode)) + (org-export-stack-refresh) + (pop-to-buffer buffer)) + (message "Type \"q\" to quit, \"?\" for help")) + +(defun org-export--stack-source-at-point () + "Return source from export results at point in stack." + (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents)))) + (if (not source) (error "Source unavailable, please refresh buffer") + (let ((source-name (if (stringp source) source (buffer-name source)))) + (if (save-excursion + (beginning-of-line) + (looking-at (concat ".* +" (regexp-quote source-name) "$"))) + source + ;; SOURCE is not consistent with current line. The stack + ;; view is outdated. + (error "Source unavailable; type `g' to update buffer")))))) + +(defun org-export-stack-clear () + "Remove all entries from export stack." + (interactive) + (setq org-export-stack-contents nil)) + +(defun org-export-stack-refresh (&rest dummy) + "Refresh the asynchronous export stack. +DUMMY is ignored. Unavailable sources are removed from the list. +Return the new stack." + (let ((inhibit-read-only t)) + (org-preserve-lc + (erase-buffer) + (insert (concat + (let ((counter 0)) + (mapconcat + (lambda (entry) + (let ((proc-p (processp (nth 2 entry)))) + (concat + ;; Back-end. + (format " %-12s " (or (nth 1 entry) "")) + ;; Age. + (let ((data (nth 2 entry))) + (if proc-p (format " %6s " (process-status data)) + ;; Compute age of the results. + (org-format-seconds + "%4h:%.2m " + (float-time (time-since data))))) + ;; Source. + (format " %s" + (let ((source (car entry))) + (if (stringp source) source + (buffer-name source))))))) + ;; Clear stack from exited processes, dead buffers or + ;; non-existent files. + (setq org-export-stack-contents + (org-remove-if-not + (lambda (el) + (if (processp (nth 2 el)) + (buffer-live-p (process-buffer (nth 2 el))) + (let ((source (car el))) + (if (bufferp source) (buffer-live-p source) + (file-exists-p source))))) + org-export-stack-contents)) "\n"))))))) + +(defun org-export-stack-remove (&optional source) + "Remove export results at point from stack. +If optional argument SOURCE is non-nil, remove it instead." + (interactive) + (let ((source (or source (org-export--stack-source-at-point)))) + (setq org-export-stack-contents + (org-remove-if (lambda (el) (equal (car el) source)) + org-export-stack-contents)))) + +(defun org-export-stack-view (&optional in-emacs) + "View export results at point in stack. +With an optional prefix argument IN-EMACS, force viewing files +within Emacs." + (interactive "P") + (let ((source (org-export--stack-source-at-point))) + (cond ((processp source) + (org-switch-to-buffer-other-window (process-buffer source))) + ((bufferp source) (org-switch-to-buffer-other-window source)) + (t (org-open-file source in-emacs))))) + +(defvar org-export-stack-mode-map + (let ((km (make-sparse-keymap))) + (define-key km " " 'next-line) + (define-key km "n" 'next-line) + (define-key km "\C-n" 'next-line) + (define-key km [down] 'next-line) + (define-key km "p" 'previous-line) + (define-key km "\C-p" 'previous-line) + (define-key km "\C-?" 'previous-line) + (define-key km [up] 'previous-line) + (define-key km "C" 'org-export-stack-clear) + (define-key km "v" 'org-export-stack-view) + (define-key km (kbd "RET") 'org-export-stack-view) + (define-key km "d" 'org-export-stack-remove) + km) + "Keymap for Org Export Stack.") + +(define-derived-mode org-export-stack-mode special-mode "Org-Stack" + "Mode for displaying asynchronous export stack. + +Type \\[org-export-stack] to visualize the asynchronous export +stack. + +In an Org Export Stack buffer, use \\\\[org-export-stack-view] to view export output +on current line, \\[org-export-stack-remove] to remove it from the stack and \\[org-export-stack-clear] to clear +stack completely. + +Removing entries in an Org Export Stack buffer doesn't affect +files or buffers, only the display. + +\\{org-export-stack-mode-map}" + (abbrev-mode 0) + (auto-fill-mode 0) + (setq buffer-read-only t + buffer-undo-list t + truncate-lines t + header-line-format + '(:eval + (format " %-12s | %6s | %s" "Back-End" "Age" "Source"))) + (org-add-hook 'post-command-hook 'org-export-stack-refresh nil t) + (set (make-local-variable 'revert-buffer-function) + 'org-export-stack-refresh)) + + + +;;; The Dispatcher +;; +;; `org-export-dispatch' is the standard interactive way to start an +;; export process. It uses `org-export--dispatch-ui' as a subroutine +;; for its interface, which, in turn, delegates response to key +;; pressed to `org-export--dispatch-action'. + +;;;###autoload +(defun org-export-dispatch (&optional arg) + "Export dispatcher for Org mode. + +It provides an access to common export related tasks in a buffer. +Its interface comes in two flavors: standard and expert. + +While both share the same set of bindings, only the former +displays the valid keys associations in a dedicated buffer. +Scrolling (resp. line-wise motion) in this buffer is done with +SPC and DEL (resp. C-n and C-p) keys. + +Set variable `org-export-dispatch-use-expert-ui' to switch to one +flavor or the other. + +When ARG is \\[universal-argument], repeat the last export action, with the same set +of options used back then, on the current buffer. + +When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack." + (interactive "P") + (let* ((input + (cond ((equal arg '(16)) '(stack)) + ((and arg org-export-dispatch-last-action)) + (t (save-window-excursion + (unwind-protect + (progn + ;; Remember where we are + (move-marker org-export-dispatch-last-position + (point) + (org-base-buffer (current-buffer))) + ;; Get and store an export command + (setq org-export-dispatch-last-action + (org-export--dispatch-ui + (list org-export-initial-scope + (and org-export-in-background 'async)) + nil + org-export-dispatch-use-expert-ui))) + (and (get-buffer "*Org Export Dispatcher*") + (kill-buffer "*Org Export Dispatcher*"))))))) + (action (car input)) + (optns (cdr input))) + (unless (memq 'subtree optns) + (move-marker org-export-dispatch-last-position nil)) + (case action + ;; First handle special hard-coded actions. + (template (org-export-insert-default-template nil optns)) + (stack (org-export-stack)) + (publish-current-file + (org-publish-current-file (memq 'force optns) (memq 'async optns))) + (publish-current-project + (org-publish-current-project (memq 'force optns) (memq 'async optns))) + (publish-choose-project + (org-publish (assoc (org-icompleting-read + "Publish project: " + org-publish-project-alist nil t) + org-publish-project-alist) + (memq 'force optns) + (memq 'async optns))) + (publish-all (org-publish-all (memq 'force optns) (memq 'async optns))) + (otherwise + (save-excursion + (when arg + ;; Repeating command, maybe move cursor to restore subtree + ;; context. + (if (eq (marker-buffer org-export-dispatch-last-position) + (org-base-buffer (current-buffer))) + (goto-char org-export-dispatch-last-position) + ;; We are in a different buffer, forget position. + (move-marker org-export-dispatch-last-position nil))) + (funcall action + ;; Return a symbol instead of a list to ease + ;; asynchronous export macro use. + (and (memq 'async optns) t) + (and (memq 'subtree optns) t) + (and (memq 'visible optns) t) + (and (memq 'body optns) t))))))) + +(defun org-export--dispatch-ui (options first-key expertp) + "Handle interface for `org-export-dispatch'. + +OPTIONS is a list containing current interactive options set for +export. It can contain any of the following symbols: +`body' toggles a body-only export +`subtree' restricts export to current subtree +`visible' restricts export to visible part of buffer. +`force' force publishing files. +`async' use asynchronous export process + +FIRST-KEY is the key pressed to select the first level menu. It +is nil when this menu hasn't been selected yet. + +EXPERTP, when non-nil, triggers expert UI. In that case, no help +buffer is provided, but indications about currently active +options are given in the prompt. Moreover, \[?] allows to switch +back to standard interface." + (let* ((fontify-key + (lambda (key &optional access-key) + ;; Fontify KEY string. Optional argument ACCESS-KEY, when + ;; non-nil is the required first-level key to activate + ;; KEY. When its value is t, activate KEY independently + ;; on the first key, if any. A nil value means KEY will + ;; only be activated at first level. + (if (or (eq access-key t) (eq access-key first-key)) + (org-propertize key 'face 'org-warning) + key))) + (fontify-value + (lambda (value) + ;; Fontify VALUE string. + (org-propertize value 'face 'font-lock-variable-name-face))) + ;; Prepare menu entries by extracting them from registered + ;; back-ends and sorting them by access key and by ordinal, + ;; if any. + (entries + (sort (sort (delq nil + (mapcar 'org-export-backend-menu + org-export--registered-backends)) + (lambda (a b) + (let ((key-a (nth 1 a)) + (key-b (nth 1 b))) + (cond ((and (numberp key-a) (numberp key-b)) + (< key-a key-b)) + ((numberp key-b) t))))) + 'car-less-than-car)) + ;; Compute a list of allowed keys based on the first key + ;; pressed, if any. Some keys + ;; (?^B, ?^V, ?^S, ?^F, ?^A, ?&, ?# and ?q) are always + ;; available. + (allowed-keys + (nconc (list 2 22 19 6 1) + (if (not first-key) (org-uniquify (mapcar 'car entries)) + (let (sub-menu) + (dolist (entry entries (sort (mapcar 'car sub-menu) '<)) + (when (eq (car entry) first-key) + (setq sub-menu (append (nth 2 entry) sub-menu)))))) + (cond ((eq first-key ?P) (list ?f ?p ?x ?a)) + ((not first-key) (list ?P))) + (list ?& ?#) + (when expertp (list ??)) + (list ?q))) + ;; Build the help menu for standard UI. + (help + (unless expertp + (concat + ;; Options are hard-coded. + (format "[%s] Body only: %s [%s] Visible only: %s +\[%s] Export scope: %s [%s] Force publishing: %s +\[%s] Async export: %s\n\n" + (funcall fontify-key "C-b" t) + (funcall fontify-value + (if (memq 'body options) "On " "Off")) + (funcall fontify-key "C-v" t) + (funcall fontify-value + (if (memq 'visible options) "On " "Off")) + (funcall fontify-key "C-s" t) + (funcall fontify-value + (if (memq 'subtree options) "Subtree" "Buffer ")) + (funcall fontify-key "C-f" t) + (funcall fontify-value + (if (memq 'force options) "On " "Off")) + (funcall fontify-key "C-a" t) + (funcall fontify-value + (if (memq 'async options) "On " "Off"))) + ;; Display registered back-end entries. When a key + ;; appears for the second time, do not create another + ;; entry, but append its sub-menu to existing menu. + (let (last-key) + (mapconcat + (lambda (entry) + (let ((top-key (car entry))) + (concat + (unless (eq top-key last-key) + (setq last-key top-key) + (format "\n[%s] %s\n" + (funcall fontify-key (char-to-string top-key)) + (nth 1 entry))) + (let ((sub-menu (nth 2 entry))) + (unless (functionp sub-menu) + ;; Split sub-menu into two columns. + (let ((index -1)) + (concat + (mapconcat + (lambda (sub-entry) + (incf index) + (format + (if (zerop (mod index 2)) " [%s] %-26s" + "[%s] %s\n") + (funcall fontify-key + (char-to-string (car sub-entry)) + top-key) + (nth 1 sub-entry))) + sub-menu "") + (when (zerop (mod index 2)) "\n")))))))) + entries "")) + ;; Publishing menu is hard-coded. + (format "\n[%s] Publish + [%s] Current file [%s] Current project + [%s] Choose project [%s] All projects\n\n\n" + (funcall fontify-key "P") + (funcall fontify-key "f" ?P) + (funcall fontify-key "p" ?P) + (funcall fontify-key "x" ?P) + (funcall fontify-key "a" ?P)) + (format "[%s] Export stack [%s] Insert template\n" + (funcall fontify-key "&" t) + (funcall fontify-key "#" t)) + (format "[%s] %s" + (funcall fontify-key "q" t) + (if first-key "Main menu" "Exit"))))) + ;; Build prompts for both standard and expert UI. + (standard-prompt (unless expertp "Export command: ")) + (expert-prompt + (when expertp + (format + "Export command (C-%s%s%s%s%s) [%s]: " + (if (memq 'body options) (funcall fontify-key "b" t) "b") + (if (memq 'visible options) (funcall fontify-key "v" t) "v") + (if (memq 'subtree options) (funcall fontify-key "s" t) "s") + (if (memq 'force options) (funcall fontify-key "f" t) "f") + (if (memq 'async options) (funcall fontify-key "a" t) "a") + (mapconcat (lambda (k) + ;; Strip control characters. + (unless (< k 27) (char-to-string k))) + allowed-keys ""))))) + ;; With expert UI, just read key with a fancy prompt. In standard + ;; UI, display an intrusive help buffer. + (if expertp + (org-export--dispatch-action + expert-prompt allowed-keys entries options first-key expertp) + ;; At first call, create frame layout in order to display menu. + (unless (get-buffer "*Org Export Dispatcher*") + (delete-other-windows) + (org-switch-to-buffer-other-window + (get-buffer-create "*Org Export Dispatcher*")) + (setq cursor-type nil + header-line-format "Use SPC, DEL, C-n or C-p to navigate.") + ;; Make sure that invisible cursor will not highlight square + ;; brackets. + (set-syntax-table (copy-syntax-table)) + (modify-syntax-entry ?\[ "w")) + ;; At this point, the buffer containing the menu exists and is + ;; visible in the current window. So, refresh it. + (with-current-buffer "*Org Export Dispatcher*" + ;; Refresh help. Maintain display continuity by re-visiting + ;; previous window position. + (let ((pos (window-start))) + (erase-buffer) + (insert help) + (set-window-start nil pos))) + (org-fit-window-to-buffer) + (org-export--dispatch-action + standard-prompt allowed-keys entries options first-key expertp)))) + +(defun org-export--dispatch-action + (prompt allowed-keys entries options first-key expertp) + "Read a character from command input and act accordingly. + +PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is +a list of characters available at a given step in the process. +ENTRIES is a list of menu entries. OPTIONS, FIRST-KEY and +EXPERTP are the same as defined in `org-export--dispatch-ui', +which see. + +Toggle export options when required. Otherwise, return value is +a list with action as CAR and a list of interactive export +options as CDR." + (let (key) + ;; Scrolling: when in non-expert mode, act on motion keys (C-n, + ;; C-p, SPC, DEL). + (while (and (setq key (read-char-exclusive prompt)) + (not expertp) + (memq key '(14 16 ?\s ?\d))) + (case key + (14 (if (not (pos-visible-in-window-p (point-max))) + (ignore-errors (scroll-up 1)) + (message "End of buffer") + (sit-for 1))) + (16 (if (not (pos-visible-in-window-p (point-min))) + (ignore-errors (scroll-down 1)) + (message "Beginning of buffer") + (sit-for 1))) + (?\s (if (not (pos-visible-in-window-p (point-max))) + (scroll-up nil) + (message "End of buffer") + (sit-for 1))) + (?\d (if (not (pos-visible-in-window-p (point-min))) + (scroll-down nil) + (message "Beginning of buffer") + (sit-for 1))))) + (cond + ;; Ignore undefined associations. + ((not (memq key allowed-keys)) + (ding) + (unless expertp (message "Invalid key") (sit-for 1)) + (org-export--dispatch-ui options first-key expertp)) + ;; q key at first level aborts export. At second level, cancel + ;; first key instead. + ((eq key ?q) (if (not first-key) (error "Export aborted") + (org-export--dispatch-ui options nil expertp))) + ;; Help key: Switch back to standard interface if expert UI was + ;; active. + ((eq key ??) (org-export--dispatch-ui options first-key nil)) + ;; Send request for template insertion along with export scope. + ((eq key ?#) (cons 'template (memq 'subtree options))) + ;; Switch to asynchronous export stack. + ((eq key ?&) '(stack)) + ;; Toggle options: C-b (2) C-v (22) C-s (19) C-f (6) C-a (1). + ((memq key '(2 22 19 6 1)) + (org-export--dispatch-ui + (let ((option (case key (2 'body) (22 'visible) (19 'subtree) + (6 'force) (1 'async)))) + (if (memq option options) (remq option options) + (cons option options))) + first-key expertp)) + ;; Action selected: Send key and options back to + ;; `org-export-dispatch'. + ((or first-key (functionp (nth 2 (assq key entries)))) + (cons (cond + ((not first-key) (nth 2 (assq key entries))) + ;; Publishing actions are hard-coded. Send a special + ;; signal to `org-export-dispatch'. + ((eq first-key ?P) + (case key + (?f 'publish-current-file) + (?p 'publish-current-project) + (?x 'publish-choose-project) + (?a 'publish-all))) + ;; Return first action associated to FIRST-KEY + KEY + ;; path. Indeed, derived backends can share the same + ;; FIRST-KEY. + (t (catch 'found + (mapc (lambda (entry) + (let ((match (assq key (nth 2 entry)))) + (when match (throw 'found (nth 2 match))))) + (member (assq first-key entries) entries))))) + options)) + ;; Otherwise, enter sub-menu. + (t (org-export--dispatch-ui options key expertp))))) + + + +(provide 'ox) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; ox.el ends here diff --git a/elpa/pkg-info-20140610.630/pkg-info-autoloads.el b/elpa/pkg-info-20140610.630/pkg-info-autoloads.el new file mode 100644 index 00000000..ff8870b1 --- /dev/null +++ b/elpa/pkg-info-20140610.630/pkg-info-autoloads.el @@ -0,0 +1,131 @@ +;;; pkg-info-autoloads.el --- automatically extracted autoloads +;; +;;; Code: + + +;;;### (autoloads (pkg-info-version-info pkg-info-package-version +;;;;;; pkg-info-defining-library-version pkg-info-defining-library-original-version +;;;;;; pkg-info-library-version pkg-info-library-original-version) +;;;;;; "pkg-info" "pkg-info.el" (21695 37112 0 0)) +;;; Generated autoloads from pkg-info.el + +(autoload 'pkg-info-library-original-version "pkg-info" "\ +Get the original version in the header of LIBRARY. + +The original version is stored in the X-Original-Version header. +This header is added by the MELPA package archive to preserve +upstream version numbers. + +LIBRARY is either a symbol denoting a named feature, or a library +name as string. + +If SHOW is non-nil, show the version in the minibuffer. + +Return the version from the header of LIBRARY as list. Signal an +error if the LIBRARY was not found or had no X-Original-Version +header. + +See Info node `(elisp)Library Headers' for more information +about library headers. + +\(fn LIBRARY &optional SHOW)" t nil) + +(autoload 'pkg-info-library-version "pkg-info" "\ +Get the version in the header of LIBRARY. + +LIBRARY is either a symbol denoting a named feature, or a library +name as string. + +If SHOW is non-nil, show the version in the minibuffer. + +Return the version from the header of LIBRARY as list. Signal an +error if the LIBRARY was not found or had no proper header. + +See Info node `(elisp)Library Headers' for more information +about library headers. + +\(fn LIBRARY &optional SHOW)" t nil) + +(autoload 'pkg-info-defining-library-original-version "pkg-info" "\ +Get the original version of the library defining FUNCTION. + +The original version is stored in the X-Original-Version header. +This header is added by the MELPA package archive to preserve +upstream version numbers. + +If SHOW is non-nil, show the version in mini-buffer. + +This function is mainly intended to find the version of a major +or minor mode, i.e. + + (pkg-info-defining-library-version 'flycheck-mode) + +Return the version of the library defining FUNCTION. Signal an +error if FUNCTION is not a valid function, if its defining +library was not found, or if the library had no proper version +header. + +\(fn FUNCTION &optional SHOW)" t nil) + +(autoload 'pkg-info-defining-library-version "pkg-info" "\ +Get the version of the library defining FUNCTION. + +If SHOW is non-nil, show the version in mini-buffer. + +This function is mainly intended to find the version of a major +or minor mode, i.e. + + (pkg-info-defining-library-version 'flycheck-mode) + +Return the version of the library defining FUNCTION. Signal an +error if FUNCTION is not a valid function, if its defining +library was not found, or if the library had no proper version +header. + +\(fn FUNCTION &optional SHOW)" t nil) + +(autoload 'pkg-info-package-version "pkg-info" "\ +Get the version of an installed PACKAGE. + +If SHOW is non-nil, show the version in the minibuffer. + +Return the version as list, or nil if PACKAGE is not installed. + +\(fn PACKAGE &optional SHOW)" t nil) + +(autoload 'pkg-info-version-info "pkg-info" "\ +Obtain complete version info for LIBRARY and PACKAGE. + +LIBRARY is a symbol denoting a named feature, or a library name +as string. PACKAGE is a symbol denoting an ELPA package. If +omitted or nil, default to LIBRARY. + +If SHOW is non-nil, show the version in the minibuffer. + +When called interactively, prompt for LIBRARY. When called +interactively with prefix argument, prompt for PACKAGE as well. + +Return a string with complete version information for LIBRARY. +This version information contains the version from the headers of +LIBRARY, and the version of the installed PACKAGE, the LIBRARY is +part of. If PACKAGE is not installed, or if the PACKAGE version +is the same as the LIBRARY version, do not include a package +version. + +\(fn LIBRARY &optional PACKAGE SHOW)" t nil) + +;;;*** + +;;;### (autoloads nil nil ("pkg-info-pkg.el") (21695 37112 672123 +;;;;;; 0)) + +;;;*** + +(provide 'pkg-info-autoloads) +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; coding: utf-8 +;; End: +;;; pkg-info-autoloads.el ends here diff --git a/elpa/pkg-info-20140610.630/pkg-info-pkg.el b/elpa/pkg-info-20140610.630/pkg-info-pkg.el new file mode 100644 index 00000000..9e603b6d --- /dev/null +++ b/elpa/pkg-info-20140610.630/pkg-info-pkg.el @@ -0,0 +1 @@ +(define-package "pkg-info" "20140610.630" "Information about packages" (quote ((epl "0.4")))) diff --git a/elpa/pkg-info-20140610.630/pkg-info.el b/elpa/pkg-info-20140610.630/pkg-info.el new file mode 100644 index 00000000..5c36a81d --- /dev/null +++ b/elpa/pkg-info-20140610.630/pkg-info.el @@ -0,0 +1,279 @@ +;;; pkg-info.el --- Information about packages -*- lexical-binding: t; -*- + +;; Copyright (C) 2013, 2014 Sebastian Wiesner + +;; Author: Sebastian Wiesner +;; URL: https://github.com/lunaryorn/pkg-info.el +;; Keywords: convenience +;; Version: 20140610.630 +;; X-Original-Version: 0.6-cvs +;; Package-Requires: ((epl "0.4")) + +;; 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, 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 . + +;;; Commentary: + +;; This library extracts information from installed packages. + +;;;; Functions: + +;; `pkg-info-library-version' extracts the version from the header of a library. +;; +;; `pkg-info-defining-library-version' extracts the version from the header of a +;; library defining a function. +;; +;; `pkg-info-package-version' gets the version of an installed package. +;; +;; `pkg-info-format-version' formats a version list as human readable string. +;; +;; `pkg-info-version-info' returns complete version information for a specific +;; package. + +;;; Code: + +(require 'epl) + +(require 'lisp-mnt) +(require 'find-func) + + +;;; Version information +(defun pkg-info-format-version (version) + "Format VERSION as human-readable string. + +Return a human-readable string representing VERSION." + ;; XXX: Find a better, more flexible way of formatting? + (package-version-join version)) + +(defsubst pkg-info--show-version-and-return (version show) + "Show and return VERSION. + +When SHOW is non-nil, show VERSION in minibuffer. + +Return VERSION." + (when show + (message (if (listp version) (pkg-info-format-version version) version))) + version) + +(defun pkg-info--read-library () + "Read a library from minibuffer." + (completing-read "Load library: " + (apply-partially 'locate-file-completion-table + load-path + (get-load-suffixes)))) + +(defun pkg-info--read-function () + "Read a function name from minibuffer." + (let ((input (completing-read "Function: " obarray #'boundp :require-match))) + (if (string= input "") nil (intern input)))) + +(defun pkg-info--read-package () + "Read a package name from minibuffer." + (let* ((installed (epl-installed-packages)) + (names (sort (mapcar (lambda (pkg) + (symbol-name (epl-package-name pkg))) + installed) + #'string<)) + (default (car names))) + (completing-read "Installed package: " names nil 'require-match + nil nil default))) + +(defun pkg-info-library-source (library) + "Get the source file of LIBRARY. + +LIBRARY is either a symbol denoting a named feature, or a library +name as string. + +Return the source file of LIBRARY as string." + (find-library-name (if (symbolp library) (symbol-name library) library))) + +(defun pkg-info-defining-library (function) + "Get the source file of the library defining FUNCTION. + +FUNCTION is a function symbol. + +Return the file name of the library as string. Signal an error +if the library does not exist, or if the definition of FUNCTION +was not found." + (unless (functionp function) + (signal 'wrong-type-argument (list 'functionp function))) + (let ((library (symbol-file function 'defun))) + (unless library + (error "Can't find definition of %s" function)) + library)) + +(defun pkg-info-x-original-version (file) + "Read the X-Original-Version header from FILE. + +Return the value as version list, or return nil if FILE lacks +this header. Signal an error, if the value of the header is not +a valid version." + (let ((version-str (with-temp-buffer + (insert-file-contents file) + (lm-header "X-Original-Version")))) + (when version-str + (version-to-list version-str)))) + +;;;###autoload +(defun pkg-info-library-original-version (library &optional show) + "Get the original version in the header of LIBRARY. + +The original version is stored in the X-Original-Version header. +This header is added by the MELPA package archive to preserve +upstream version numbers. + +LIBRARY is either a symbol denoting a named feature, or a library +name as string. + +If SHOW is non-nil, show the version in the minibuffer. + +Return the version from the header of LIBRARY as list. Signal an +error if the LIBRARY was not found or had no X-Original-Version +header. + +See Info node `(elisp)Library Headers' for more information +about library headers." + (interactive (list (pkg-info--read-library) t)) + (let ((version (pkg-info-x-original-version + (pkg-info-library-source library)))) + (if version + (pkg-info--show-version-and-return version show) + (error "Library %s has no original version" library)))) + +;;;###autoload +(defun pkg-info-library-version (library &optional show) + "Get the version in the header of LIBRARY. + +LIBRARY is either a symbol denoting a named feature, or a library +name as string. + +If SHOW is non-nil, show the version in the minibuffer. + +Return the version from the header of LIBRARY as list. Signal an +error if the LIBRARY was not found or had no proper header. + +See Info node `(elisp)Library Headers' for more information +about library headers." + (interactive (list (pkg-info--read-library) t)) + (let* ((source (pkg-info-library-source library)) + (version (epl-package-version (epl-package-from-file source)))) + (pkg-info--show-version-and-return version show))) + +;;;###autoload +(defun pkg-info-defining-library-original-version (function &optional show) + "Get the original version of the library defining FUNCTION. + +The original version is stored in the X-Original-Version header. +This header is added by the MELPA package archive to preserve +upstream version numbers. + +If SHOW is non-nil, show the version in mini-buffer. + +This function is mainly intended to find the version of a major +or minor mode, i.e. + + (pkg-info-defining-library-version 'flycheck-mode) + +Return the version of the library defining FUNCTION. Signal an +error if FUNCTION is not a valid function, if its defining +library was not found, or if the library had no proper version +header." + (interactive (list (pkg-info--read-function) t)) + (pkg-info-library-original-version (pkg-info-defining-library function) show)) + +;;;###autoload +(defun pkg-info-defining-library-version (function &optional show) + "Get the version of the library defining FUNCTION. + +If SHOW is non-nil, show the version in mini-buffer. + +This function is mainly intended to find the version of a major +or minor mode, i.e. + + (pkg-info-defining-library-version 'flycheck-mode) + +Return the version of the library defining FUNCTION. Signal an +error if FUNCTION is not a valid function, if its defining +library was not found, or if the library had no proper version +header." + (interactive (list (pkg-info--read-function) t)) + (pkg-info-library-version (pkg-info-defining-library function) show)) + +;;;###autoload +(defun pkg-info-package-version (package &optional show) + "Get the version of an installed PACKAGE. + +If SHOW is non-nil, show the version in the minibuffer. + +Return the version as list, or nil if PACKAGE is not installed." + (interactive (list (pkg-info--read-package) t)) + (let* ((name (if (stringp package) (intern package) package)) + (package (epl-find-installed-package name))) + (unless package + (error "Can't find installed package %s" name)) + (pkg-info--show-version-and-return (epl-package-version package) show))) + +;;;###autoload +(defun pkg-info-version-info (library &optional package show) + "Obtain complete version info for LIBRARY and PACKAGE. + +LIBRARY is a symbol denoting a named feature, or a library name +as string. PACKAGE is a symbol denoting an ELPA package. If +omitted or nil, default to LIBRARY. + +If SHOW is non-nil, show the version in the minibuffer. + +When called interactively, prompt for LIBRARY. When called +interactively with prefix argument, prompt for PACKAGE as well. + +Return a string with complete version information for LIBRARY. +This version information contains the version from the headers of +LIBRARY, and the version of the installed PACKAGE, the LIBRARY is +part of. If PACKAGE is not installed, or if the PACKAGE version +is the same as the LIBRARY version, do not include a package +version." + (interactive (list (pkg-info--read-library) + (when current-prefix-arg + (pkg-info--read-package)) + t)) + (let* ((package (or package (if (stringp library) (intern library) library))) + (orig-version (condition-case nil + (pkg-info-library-original-version library) + (error nil))) + ;; If we have X-Original-Version, we assume that MELPA replaced the + ;; library version with its generated version, so we use the + ;; X-Original-Version header instead, and ignore the library version + ;; header + (lib-version (or orig-version (pkg-info-library-version library))) + (pkg-version (condition-case nil + (pkg-info-package-version package) + (error nil))) + (version (if (and pkg-version + (not (version-list-= lib-version pkg-version))) + (format "%s (package: %s)" + (pkg-info-format-version lib-version) + (pkg-info-format-version pkg-version)) + (pkg-info-format-version lib-version)))) + (pkg-info--show-version-and-return version show))) + +(provide 'pkg-info) + +;; Local Variables: +;; indent-tabs-mode: nil +;; coding: utf-8 +;; End: + +;;; pkg-info.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/Makefile b/xemacs-packages/lisp/org-8.2.3c/Makefile deleted file mode 100644 index 89f504db..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/Makefile +++ /dev/null @@ -1,93 +0,0 @@ -.NOTPARALLEL: # always run this make serially -.SUFFIXES: # we don't need default suffix rules -ifeq ($(MAKELEVEL), 0) - $(error This make needs to be started as a sub-make from the toplevel directory.) -endif - -ifneq ($(ORG_ADD_CONTRIB),) - _ORG_ADD_EL_ := \ - $(notdir \ - $(wildcard \ - $(addsuffix .el, \ - $(addprefix ../contrib/lisp/, \ - $(basename \ - $(notdir $(ORG_ADD_CONTRIB))))))) -endif - -LISPV := org-version.el -LISPI := org-loaddefs.el -LISPA := $(LISPV) $(LISPI) -LISPB := $(LISPA:%el=%elc) org-install.elc -LISPF := $(filter-out $(LISPA),$(sort $(wildcard *.el) $(_ORG_ADD_EL_))) -LISPC := $(filter-out $(LISPB) $(LISPN:%el=%elc),$(LISPF:%el=%elc)) -_ORGCM_ := dirall single source slint1 slint2 --include local.mk - -.PHONY: all compile compile-dirty \ - $(_ORGCM_) $(_ORGCM_:%=compile-%) \ - autoloads addcontrib \ - install clean cleanauto cleanall cleanelc clean-install - -# do not clean here, done in toplevel make -all compile compile-dirty:: autoloads -ifeq ($(filter-out $(_ORGCM_),$(ORGCM)),) - $(MAKE) compile-$(ORGCM) -else - $(error ORGCM has illegal value $(ORGCM) (valid: $(_ORGCM_))) -endif - -compile-dirall: dirall -compile-single: single $(LISPC) -compile-source: source dirall -compile-slint1: dirall slint1 -compile-slint2: source dirall slint1 - -# internal -dirall: - @$(info ==================== $@ ====================) - @$(ELCDIR) -single: - @$(info ==================== $@ ====================) -source: cleanelc - @$(info ==================== $@ ====================) - @$(foreach elc,$(LISPC),$(MAKE) $(elc) && $(RM) $(elc);) -slint1: - @$(info ==================== $@ ====================) - @$(foreach elc,$(LISPC),$(RM) $(elc); $(MAKE) $(elc);) - -%.elc: %.el - @$(info Compiling single $(abspath $<)...) - -@$(ELC) $< - -addcontrib: -ifneq ($(ORG_ADD_CONTRIB),) - $(CP) $(addprefix ../contrib/lisp/,$(_ORG_ADD_EL_)) . -endif - -autoloads: cleanauto addcontrib $(LISPI) $(LISPV) - -$(LISPV): $(LISPF) - @echo "org-version: $(ORGVERSION) ($(GITVERSION))" - @$(RM) $(@) - @$(MAKE_ORG_VERSION) - -$(LISPI): $(LISPV) $(LISPF) - @echo "org-loaddefs: $(ORGVERSION) ($(GITVERSION))" - @$(RM) $(@) - @$(MAKE_ORG_INSTALL) - -install: compile $(LISPF) - if [ ! -d $(DESTDIR)$(lispdir) ] ; then \ - $(MKDIR) $(DESTDIR)$(lispdir) ; \ - fi ; - $(CP) $(LISPC) $(LISPF) $(LISPA) $(DESTDIR)$(lispdir) - -cleanauto clean cleanall:: - $(RM) $(LISPA) $(LISPB) -clean cleanall cleanelc:: - $(RM) *.elc - -clean-install: - if [ -d $(DESTDIR)$(lispdir) ] ; then \ - $(RM) $(DESTDIR)$(lispdir)/org*.el* $(DESTDIR)$(lispdir)/ob*.el* $(DESTDIR)$(lispdir)/ox*.el* ; \ - fi ; diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-C.el b/xemacs-packages/lisp/org-8.2.3c/ob-C.el deleted file mode 100644 index ddceb14f..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-C.el +++ /dev/null @@ -1,243 +0,0 @@ -;;; ob-C.el --- org-babel functions for C and similar languages - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating C code. -;; -;; very limited implementation: -;; - currently only support :results output -;; - not much in the way of error feedback - -;;; Code: -(require 'ob) -(require 'cc-mode) - -(declare-function org-entry-get "org" - (pom property &optional inherit literal-nil)) - - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("C++" . "cpp")) - -(defvar org-babel-default-header-args:C '()) - -(defvar org-babel-C-compiler "gcc" - "Command used to compile a C source code file into an -executable.") - -(defvar org-babel-C++-compiler "g++" - "Command used to compile a C++ source code file into an -executable.") - -(defvar org-babel-c-variant nil - "Internal variable used to hold which type of C (e.g. C or C++) -is currently being evaluated.") - -(defun org-babel-execute:cpp (body params) - "Execute BODY according to PARAMS. -This function calls `org-babel-execute:C++'." - (org-babel-execute:C++ body params)) - -(defun org-babel-execute:C++ (body params) - "Execute a block of C++ code with org-babel. -This function is called by `org-babel-execute-src-block'." - (let ((org-babel-c-variant 'cpp)) (org-babel-C-execute body params))) - -(defun org-babel-expand-body:C++ (body params) - "Expand a block of C++ code with org-babel according to it's -header arguments (calls `org-babel-C-expand')." - (let ((org-babel-c-variant 'cpp)) (org-babel-C-expand body params))) - -(defun org-babel-execute:C (body params) - "Execute a block of C code with org-babel. -This function is called by `org-babel-execute-src-block'." - (let ((org-babel-c-variant 'c)) (org-babel-C-execute body params))) - -(defun org-babel-expand-body:c (body params) - "Expand a block of C code with org-babel according to it's -header arguments (calls `org-babel-C-expand')." - (let ((org-babel-c-variant 'c)) (org-babel-C-expand body params))) - -(defun org-babel-C-execute (body params) - "This function should only be called by `org-babel-execute:C' -or `org-babel-execute:C++'." - (let* ((tmp-src-file (org-babel-temp-file - "C-src-" - (cond - ((equal org-babel-c-variant 'c) ".c") - ((equal org-babel-c-variant 'cpp) ".cpp")))) - (tmp-bin-file (org-babel-temp-file "C-bin-" org-babel-exeext)) - (cmdline (cdr (assoc :cmdline params))) - (flags (cdr (assoc :flags params))) - (full-body (org-babel-C-expand body params)) - (compile - (progn - (with-temp-file tmp-src-file (insert full-body)) - (org-babel-eval - (format "%s -o %s %s %s" - (cond - ((equal org-babel-c-variant 'c) org-babel-C-compiler) - ((equal org-babel-c-variant 'cpp) org-babel-C++-compiler)) - (org-babel-process-file-name tmp-bin-file) - (mapconcat 'identity - (if (listp flags) flags (list flags)) " ") - (org-babel-process-file-name tmp-src-file)) "")))) - (let ((results - (org-babel-trim - (org-babel-eval - (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))) - (org-babel-reassemble-table - (org-babel-result-cond (cdr (assoc :result-params params)) - (org-babel-read results) - (let ((tmp-file (org-babel-temp-file "c-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))) - )) - -(defun org-babel-C-expand (body params) - "Expand a block of C or C++ code with org-babel according to -it's header arguments." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (main-p (not (string= (cdr (assoc :main params)) "no"))) - (includes (or (cdr (assoc :includes params)) - (org-babel-read (org-entry-get nil "includes" t)))) - (defines (org-babel-read - (or (cdr (assoc :defines params)) - (org-babel-read (org-entry-get nil "defines" t)))))) - (mapconcat 'identity - (list - ;; includes - (mapconcat - (lambda (inc) (format "#include %s" inc)) - (if (listp includes) includes (list includes)) "\n") - ;; defines - (mapconcat - (lambda (inc) (format "#define %s" inc)) - (if (listp defines) defines (list defines)) "\n") - ;; variables - (mapconcat 'org-babel-C-var-to-C vars "\n") - ;; body - (if main-p - (org-babel-C-ensure-main-wrap body) - body) "\n") "\n"))) - -(defun org-babel-C-ensure-main-wrap (body) - "Wrap BODY in a \"main\" function call if none exists." - (if (string-match "^[ \t]*[intvod]+[ \t\n\r]*main[ \t]*(.*)" body) - body - (format "int main() {\n%s\nreturn 0;\n}\n" body))) - -(defun org-babel-prep-session:C (session params) - "This function does nothing as C is a compiled language with no -support for sessions" - (error "C is a compiled languages -- no support for sessions")) - -(defun org-babel-load-session:C (session body params) - "This function does nothing as C is a compiled language with no -support for sessions" - (error "C is a compiled languages -- no support for sessions")) - -;; helper functions - -(defun org-babel-C-format-val (type val) - "Handle the FORMAT part of TYPE with the data from VAL." - (let ((format-data (cadr type))) - (if (stringp format-data) - (cons "" (format format-data val)) - (funcall format-data val)))) - -(defun org-babel-C-val-to-C-type (val) - "Determine the type of VAL. -Return a list (TYPE-NAME FORMAT). TYPE-NAME should be the name of the type. -FORMAT can be either a format string or a function which is called with VAL." - (cond - ((integerp val) '("int" "%d")) - ((floatp val) '("double" "%f")) - ((or (listp val) (vectorp val)) - (lexical-let ((type (org-babel-C-val-to-C-list-type val))) - (list (car type) - (lambda (val) - (cons - (format "[%d]%s" - (length val) - (car (org-babel-C-format-val type (elt val 0)))) - (concat "{ " - (mapconcat (lambda (v) - (cdr (org-babel-C-format-val type v))) - val - ", ") - " }")))))) - (t ;; treat unknown types as string - '("char" (lambda (val) - (let ((s (format "%s" val))) ;; convert to string for unknown types - (cons (format "[%d]" (1+ (length s))) - (concat "\"" s "\"")))))))) - -(defun org-babel-C-val-to-C-list-type (val) - "Determine the C array type of a VAL." - (let (type) - (mapc - #'(lambda (i) - (let* ((tmp-type (org-babel-C-val-to-C-type i)) - (type-name (car type)) - (tmp-type-name (car tmp-type))) - (when (and type (not (string= type-name tmp-type-name))) - (if (and (member type-name '("int" "double" "int32_t")) - (member tmp-type-name '("int" "double" "int32_t"))) - (setq tmp-type '("double" "" "%f")) - (error "Only homogeneous lists are supported by C. You can not mix %s and %s" - type-name - tmp-type-name))) - (setq type tmp-type))) - val) - type)) - -(defun org-babel-C-var-to-C (pair) - "Convert an elisp val into a string of C code specifying a var -of the same value." - ;; TODO list support - (let ((var (car pair)) - (val (cdr pair))) - (when (symbolp val) - (setq val (symbol-name val)) - (when (= (length val) 1) - (setq val (string-to-char val)))) - (let* ((type-data (org-babel-C-val-to-C-type val)) - (type (car type-data)) - (formated (org-babel-C-format-val type-data val)) - (suffix (car formated)) - (data (cdr formated))) - (format "%s %s%s = %s;" - type - var - suffix - data)))) - -(provide 'ob-C) - -;;; ob-C.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-R.el b/xemacs-packages/lisp/org-8.2.3c/ob-R.el deleted file mode 100644 index 58f55366..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-R.el +++ /dev/null @@ -1,390 +0,0 @@ -;;; ob-R.el --- org-babel functions for R code evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Dan Davison -;; Keywords: literate programming, reproducible research, R, statistics -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating R code - -;;; Code: -(require 'ob) -(eval-when-compile (require 'cl)) - -(declare-function orgtbl-to-tsv "org-table" (table params)) -(declare-function R "ext:essd-r" (&optional start-args)) -(declare-function inferior-ess-send-input "ext:ess-inf" ()) -(declare-function ess-make-buffer-current "ext:ess-inf" ()) -(declare-function ess-eval-buffer "ext:ess-inf" (vis)) -(declare-function org-number-sequence "org-compat" (from &optional to inc)) -(declare-function org-remove-if-not "org" (predicate seq)) - -(defconst org-babel-header-args:R - '((width . :any) - (height . :any) - (bg . :any) - (units . :any) - (pointsize . :any) - (antialias . :any) - (quality . :any) - (compression . :any) - (res . :any) - (type . :any) - (family . :any) - (title . :any) - (fonts . :any) - (version . :any) - (paper . :any) - (encoding . :any) - (pagecentre . :any) - (colormodel . :any) - (useDingbats . :any) - (horizontal . :any) - (results . ((file list vector table scalar verbatim) - (raw org html latex code pp wrap) - (replace silent append prepend) - (output value graphics)))) - "R-specific header arguments.") - -(defvar org-babel-default-header-args:R '()) - -(defcustom org-babel-R-command "R --slave --no-save" - "Name of command to use for executing R code." - :group 'org-babel - :version "24.1" - :type 'string) - -(defvar ess-local-process-name) ; dynamically scoped -(defun org-babel-edit-prep:R (info) - (let ((session (cdr (assoc :session (nth 2 info))))) - (when (and session (string-match "^\\*\\(.+?\\)\\*$" session)) - (save-match-data (org-babel-R-initiate-session session nil))))) - -(defun org-babel-expand-body:R (body params &optional graphics-file) - "Expand BODY according to PARAMS, return the expanded body." - (let ((graphics-file - (or graphics-file (org-babel-R-graphical-output-file params)))) - (mapconcat - #'identity - (let ((inside - (append - (when (cdr (assoc :prologue params)) - (list (cdr (assoc :prologue params)))) - (org-babel-variable-assignments:R params) - (list body) - (when (cdr (assoc :epilogue params)) - (list (cdr (assoc :epilogue params))))))) - (if graphics-file - (append - (list (org-babel-R-construct-graphics-device-call - graphics-file params)) - inside - (list "dev.off()")) - inside)) - "\n"))) - -(defun org-babel-execute:R (body params) - "Execute a block of R code. -This function is called by `org-babel-execute-src-block'." - (save-excursion - (let* ((result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) - (session (org-babel-R-initiate-session - (cdr (assoc :session params)) params)) - (colnames-p (cdr (assoc :colnames params))) - (rownames-p (cdr (assoc :rownames params))) - (graphics-file (org-babel-R-graphical-output-file params)) - (full-body (org-babel-expand-body:R body params graphics-file)) - (result - (org-babel-R-evaluate - session full-body result-type result-params - (or (equal "yes" colnames-p) - (org-babel-pick-name - (cdr (assoc :colname-names params)) colnames-p)) - (or (equal "yes" rownames-p) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) rownames-p))))) - (if graphics-file nil result)))) - -(defun org-babel-prep-session:R (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - (let* ((session (org-babel-R-initiate-session session params)) - (var-lines (org-babel-variable-assignments:R params))) - (org-babel-comint-in-buffer session - (mapc (lambda (var) - (end-of-line 1) (insert var) (comint-send-input nil t) - (org-babel-comint-wait-for-output session)) var-lines)) - session)) - -(defun org-babel-load-session:R (session body params) - "Load BODY into SESSION." - (save-window-excursion - (let ((buffer (org-babel-prep-session:R session params))) - (with-current-buffer buffer - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (insert (org-babel-chomp body))) - buffer))) - -;; helper functions - -(defun org-babel-variable-assignments:R (params) - "Return list of R statements assigning the block's variables." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) - (mapcar - (lambda (pair) - (org-babel-R-assign-elisp - (car pair) (cdr pair) - (equal "yes" (cdr (assoc :colnames params))) - (equal "yes" (cdr (assoc :rownames params))))) - (mapcar - (lambda (i) - (cons (car (nth i vars)) - (org-babel-reassemble-table - (cdr (nth i vars)) - (cdr (nth i (cdr (assoc :colname-names params)))) - (cdr (nth i (cdr (assoc :rowname-names params))))))) - (org-number-sequence 0 (1- (length vars))))))) - -(defun org-babel-R-quote-tsv-field (s) - "Quote field S for export to R." - (if (stringp s) - (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") - (format "%S" s))) - -(defun org-babel-R-assign-elisp (name value colnames-p rownames-p) - "Construct R code assigning the elisp VALUE to a variable named NAME." - (if (listp value) - (let ((max (apply #'max (mapcar #'length (org-remove-if-not - #'sequencep value)))) - (min (apply #'min (mapcar #'length (org-remove-if-not - #'sequencep value)))) - (transition-file (org-babel-temp-file "R-import-"))) - ;; ensure VALUE has an orgtbl structure (depth of at least 2) - (unless (listp (car value)) (setq value (list value))) - (with-temp-file transition-file - (insert - (orgtbl-to-tsv value '(:fmt org-babel-R-quote-tsv-field)) - "\n")) - (let ((file (org-babel-process-file-name transition-file 'noquote)) - (header (if (or (eq (nth 1 value) 'hline) colnames-p) - "TRUE" "FALSE")) - (row-names (if rownames-p "1" "NULL"))) - (if (= max min) - (format "%s <- read.table(\"%s\", - header=%s, - row.names=%s, - sep=\"\\t\", - as.is=TRUE)" name file header row-names) - (format "%s <- read.table(\"%s\", - header=%s, - row.names=%s, - sep=\"\\t\", - as.is=TRUE, - fill=TRUE, - col.names = paste(\"V\", seq_len(%d), sep =\"\"))" - name file header row-names max)))) - (format "%s <- %s" name (org-babel-R-quote-tsv-field value)))) - -(defvar ess-ask-for-ess-directory) ; dynamically scoped -(defun org-babel-R-initiate-session (session params) - "If there is not a current R process then create one." - (unless (string= session "none") - (let ((session (or session "*R*")) - (ess-ask-for-ess-directory - (and (and (boundp 'ess-ask-for-ess-directory) ess-ask-for-ess-directory) - (not (cdr (assoc :dir params)))))) - (if (org-babel-comint-buffer-livep session) - session - (save-window-excursion - (when (get-buffer session) - ;; Session buffer exists, but with dead process - (set-buffer session)) - (require 'ess) (R) - (rename-buffer - (if (bufferp session) - (buffer-name session) - (if (stringp session) - session - (buffer-name)))) - (current-buffer)))))) - -(defun org-babel-R-associate-session (session) - "Associate R code buffer with an R session. -Make SESSION be the inferior ESS process associated with the -current code buffer." - (setq ess-local-process-name - (process-name (get-buffer-process session))) - (ess-make-buffer-current)) - -(defun org-babel-R-graphical-output-file (params) - "Name of file to which R should send graphical output." - (and (member "graphics" (cdr (assq :result-params params))) - (cdr (assq :file params)))) - -(defvar org-babel-R-graphics-devices - '((:bmp "bmp" "filename") - (:jpg "jpeg" "filename") - (:jpeg "jpeg" "filename") - (:tikz "tikz" "file") - (:tiff "tiff" "filename") - (:png "png" "filename") - (:svg "svg" "file") - (:pdf "pdf" "file") - (:ps "postscript" "file") - (:postscript "postscript" "file")) - "An alist mapping graphics file types to R functions. - -Each member of this list is a list with three members: -1. the file extension of the graphics file, as an elisp :keyword -2. the R graphics device function to call to generate such a file -3. the name of the argument to this function which specifies the - file to write to (typically \"file\" or \"filename\")") - -(defun org-babel-R-construct-graphics-device-call (out-file params) - "Construct the call to the graphics device." - (let* ((allowed-args '(:width :height :bg :units :pointsize - :antialias :quality :compression :res - :type :family :title :fonts :version - :paper :encoding :pagecentre :colormodel - :useDingbats :horizontal)) - (device (and (string-match ".+\\.\\([^.]+\\)" out-file) - (match-string 1 out-file))) - (device-info (or (assq (intern (concat ":" device)) - org-babel-R-graphics-devices) - (assq :png org-babel-R-graphics-devices))) - (extra-args (cdr (assq :R-dev-args params))) filearg args) - (setq device (nth 1 device-info)) - (setq filearg (nth 2 device-info)) - (setq args (mapconcat - (lambda (pair) - (if (member (car pair) allowed-args) - (format ",%s=%S" - (substring (symbol-name (car pair)) 1) - (cdr pair)) "")) - params "")) - (format "%s(%s=\"%s\"%s%s%s)" - device filearg out-file args - (if extra-args "," "") (or extra-args "")))) - -(defvar org-babel-R-eoe-indicator "'org_babel_R_eoe'") -(defvar org-babel-R-eoe-output "[1] \"org_babel_R_eoe\"") - -(defvar org-babel-R-write-object-command "{function(object,transfer.file){object;invisible(if(inherits(try({tfile<-tempfile();write.table(object,file=tfile,sep=\"\\t\",na=\"nil\",row.names=%s,col.names=%s,quote=FALSE);file.rename(tfile,transfer.file)},silent=TRUE),\"try-error\")){if(!file.exists(transfer.file))file.create(transfer.file)})}}(object=%s,transfer.file=\"%s\")") - -(defun org-babel-R-evaluate - (session body result-type result-params column-names-p row-names-p) - "Evaluate R code in BODY." - (if session - (org-babel-R-evaluate-session - session body result-type result-params column-names-p row-names-p) - (org-babel-R-evaluate-external-process - body result-type result-params column-names-p row-names-p))) - -(defun org-babel-R-evaluate-external-process - (body result-type result-params column-names-p row-names-p) - "Evaluate BODY in external R process. -If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the -last statement in BODY, as elisp." - (case result-type - (value - (let ((tmp-file (org-babel-temp-file "R-"))) - (org-babel-eval org-babel-R-command - (format org-babel-R-write-object-command - (if row-names-p "TRUE" "FALSE") - (if column-names-p - (if row-names-p "NA" "TRUE") - "FALSE") - (format "{function ()\n{\n%s\n}}()" body) - (org-babel-process-file-name tmp-file 'noquote))) - (org-babel-R-process-value-result - (org-babel-result-cond result-params - (with-temp-buffer - (insert-file-contents tmp-file) - (buffer-string)) - (org-babel-import-elisp-from-file tmp-file '(16))) - column-names-p))) - (output (org-babel-eval org-babel-R-command body)))) - -(defvar ess-eval-visibly-p) - -(defun org-babel-R-evaluate-session - (session body result-type result-params column-names-p row-names-p) - "Evaluate BODY in SESSION. -If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the -last statement in BODY, as elisp." - (case result-type - (value - (with-temp-buffer - (insert (org-babel-chomp body)) - (let ((ess-local-process-name - (process-name (get-buffer-process session))) - (ess-eval-visibly-p nil)) - (ess-eval-buffer nil))) - (let ((tmp-file (org-babel-temp-file "R-"))) - (org-babel-comint-eval-invisibly-and-wait-for-file - session tmp-file - (format org-babel-R-write-object-command - (if row-names-p "TRUE" "FALSE") - (if column-names-p - (if row-names-p "NA" "TRUE") - "FALSE") - ".Last.value" (org-babel-process-file-name tmp-file 'noquote))) - (org-babel-R-process-value-result - (org-babel-result-cond result-params - (with-temp-buffer - (insert-file-contents tmp-file) - (buffer-string)) - (org-babel-import-elisp-from-file tmp-file '(16))) - column-names-p))) - (output - (mapconcat - #'org-babel-chomp - (butlast - (delq nil - (mapcar - (lambda (line) (when (> (length line) 0) line)) - (mapcar - (lambda (line) ;; cleanup extra prompts left in output - (if (string-match - "^\\([ ]*[>+\\.][ ]?\\)+\\([[0-9]+\\|[ ]\\)" line) - (substring line (match-end 1)) - line)) - (org-babel-comint-with-output (session org-babel-R-eoe-output) - (insert (mapconcat #'org-babel-chomp - (list body org-babel-R-eoe-indicator) - "\n")) - (inferior-ess-send-input)))))) "\n")))) - -(defun org-babel-R-process-value-result (result column-names-p) - "R-specific processing of return value. -Insert hline if column names in output have been requested." - (if column-names-p - (cons (car result) (cons 'hline (cdr result))) - result)) - -(provide 'ob-R) - - - -;;; ob-R.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-asymptote.el b/xemacs-packages/lisp/org-8.2.3c/ob-asymptote.el deleted file mode 100644 index 4ea68df9..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-asymptote.el +++ /dev/null @@ -1,150 +0,0 @@ -;;; ob-asymptote.el --- org-babel functions for asymptote evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating asymptote source code. -;; -;; This differs from most standard languages in that -;; -;; 1) there is no such thing as a "session" in asymptote -;; -;; 2) we are generally only going to return results of type "file" -;; -;; 3) we are adding the "file" and "cmdline" header arguments, if file -;; is omitted then the -V option is passed to the asy command for -;; interactive viewing - -;;; Requirements: - -;; - The asymptote program :: http://asymptote.sourceforge.net/ -;; -;; - asy-mode :: Major mode for editing asymptote files - -;;; Code: -(require 'ob) -(eval-when-compile (require 'cl)) - -(declare-function orgtbl-to-generic "org-table" (table params)) -(declare-function org-combine-plists "org" (&rest plists)) - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("asymptote" . "asy")) - -(defvar org-babel-default-header-args:asymptote - '((:results . "file") (:exports . "results")) - "Default arguments when evaluating an Asymptote source block.") - -(defun org-babel-execute:asymptote (body params) - "Execute a block of Asymptote code. -This function is called by `org-babel-execute-src-block'." - (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (cdr (assoc :file params))) - (format (or (and out-file - (string-match ".+\\.\\(.+\\)" out-file) - (match-string 1 out-file)) - "pdf")) - (cmdline (cdr (assoc :cmdline params))) - (in-file (org-babel-temp-file "asymptote-")) - (cmd - (concat "asy " - (if out-file - (concat - "-globalwrite -f " format - " -o " (org-babel-process-file-name out-file)) - "-V") - " " cmdline - " " (org-babel-process-file-name in-file)))) - (with-temp-file in-file - (insert (org-babel-expand-body:generic - body params - (org-babel-variable-assignments:asymptote params)))) - (message cmd) (shell-command cmd) - nil)) ;; signal that output has already been written to file - -(defun org-babel-prep-session:asymptote (session params) - "Return an error if the :session header argument is set. -Asymptote does not support sessions" - (error "Asymptote does not support sessions")) - -(defun org-babel-variable-assignments:asymptote (params) - "Return list of asymptote statements assigning the block's variables." - (mapcar #'org-babel-asymptote-var-to-asymptote - (mapcar #'cdr (org-babel-get-header params :var)))) - -(defun org-babel-asymptote-var-to-asymptote (pair) - "Convert an elisp value into an Asymptote variable. -The elisp value PAIR is converted into Asymptote code specifying -a variable of the same value." - (let ((var (car pair)) - (val (let ((v (cdr pair))) - (if (symbolp v) (symbol-name v) v)))) - (cond - ((integerp val) - (format "int %S=%S;" var val)) - ((floatp val) - (format "real %S=%S;" var val)) - ((stringp val) - (format "string %S=\"%s\";" var val)) - ((and (listp val) (not (listp (car val)))) - (let* ((type (org-babel-asymptote-define-type val)) - (fmt (if (eq 'string type) "\"%s\"" "%s")) - (vect (mapconcat (lambda (e) (format fmt e)) val ", "))) - (format "%s[] %S={%s};" type var vect))) - ((listp val) - (let* ((type (org-babel-asymptote-define-type val)) - (fmt (if (eq 'string type) "\"%s\"" "%s")) - (array (mapconcat (lambda (row) - (concat "{" - (mapconcat (lambda (e) (format fmt e)) - row ", ") - "}")) - val ","))) - (format "%S[][] %S={%s};" type var array)))))) - -(defun org-babel-asymptote-define-type (data) - "Determine type of DATA. - -DATA is a list. Return type as a symbol. - -The type is `string' if any element in DATA is -a string. Otherwise, it is either `real', if some elements are -floats, or `int'." - (let* ((type 'int) - find-type ; for byte-compiler - (find-type - (function - (lambda (row) - (catch 'exit - (mapc (lambda (el) - (cond ((listp el) (funcall find-type el)) - ((stringp el) (throw 'exit (setq type 'string))) - ((floatp el) (setq type 'real)))) - row)))))) - (funcall find-type data) type)) - -(provide 'ob-asymptote) - - - -;;; ob-asymptote.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-awk.el b/xemacs-packages/lisp/org-8.2.3c/ob-awk.el deleted file mode 100644 index a9215d0b..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-awk.el +++ /dev/null @@ -1,113 +0,0 @@ -;;; ob-awk.el --- org-babel functions for awk evaluation - -;; Copyright (C) 2011-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Babel's awk can use special header argument: -;; -;; - :in-file takes a path to a file of data to be processed by awk -;; -;; - :stdin takes an Org-mode data or code block reference, the value -;; of which will be passed to the awk process through STDIN - -;;; Code: -(require 'ob) -(require 'org-compat) -(eval-when-compile (require 'cl)) - -(declare-function org-babel-ref-resolve "ob-ref" (ref)) -(declare-function orgtbl-to-generic "org-table" (table params)) - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("awk" . "awk")) - -(defvar org-babel-awk-command "awk" - "Name of the awk executable command.") - -(defun org-babel-expand-body:awk (body params) - "Expand BODY according to PARAMS, return the expanded body." - (dolist (pair (mapcar #'cdr (org-babel-get-header params :var))) - (setf body (replace-regexp-in-string - (regexp-quote (format "$%s" (car pair))) (cdr pair) body))) - body) - -(defun org-babel-execute:awk (body params) - "Execute a block of Awk code with org-babel. This function is -called by `org-babel-execute-src-block'" - (message "executing Awk source code block") - (let* ((result-params (cdr (assoc :result-params params))) - (cmd-line (cdr (assoc :cmd-line params))) - (in-file (cdr (assoc :in-file params))) - (full-body (org-babel-expand-body:awk body params)) - (code-file (let ((file (org-babel-temp-file "awk-"))) - (with-temp-file file (insert full-body)) file)) - (stdin (let ((stdin (cdr (assoc :stdin params)))) - (when stdin - (let ((tmp (org-babel-temp-file "awk-stdin-")) - (res (org-babel-ref-resolve stdin))) - (with-temp-file tmp - (insert (org-babel-awk-var-to-awk res))) - tmp)))) - (cmd (mapconcat #'identity (remove nil (list org-babel-awk-command - "-f" code-file - cmd-line - in-file)) - " "))) - (org-babel-reassemble-table - (let ((results - (cond - (stdin (with-temp-buffer - (call-process-shell-command cmd stdin (current-buffer)) - (buffer-string))) - (t (org-babel-eval cmd ""))))) - (when results - (org-babel-result-cond result-params - results - (let ((tmp (org-babel-temp-file "awk-results-"))) - (with-temp-file tmp (insert results)) - (org-babel-import-elisp-from-file tmp))))) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) - -(defun org-babel-awk-var-to-awk (var &optional sep) - "Return a printed value of VAR suitable for parsing with awk." - (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v))))) - (cond - ((and (listp var) (listp (car var))) - (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var))) - ((listp var) - (mapconcat echo-var var "\n")) - (t (funcall echo-var var))))) - -(defun org-babel-awk-table-or-string (results) - "If the results look like a table, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape results)) - -(provide 'ob-awk) - - - -;;; ob-awk.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-calc.el b/xemacs-packages/lisp/org-8.2.3c/ob-calc.el deleted file mode 100644 index b4201a18..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-calc.el +++ /dev/null @@ -1,108 +0,0 @@ -;;; ob-calc.el --- org-babel functions for calc code evaluation - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating calc code - -;;; Code: -(require 'ob) -(require 'calc) -(unless (featurep 'xemacs) - (require 'calc-trail) - (require 'calc-store)) - -(declare-function calc-store-into "calc-store" (&optional var)) -(declare-function calc-recall "calc-store" (&optional var)) -(declare-function math-evaluate-expr "calc-ext" (x)) - -(defvar org-babel-default-header-args:calc nil - "Default arguments for evaluating an calc source block.") - -(defun org-babel-expand-body:calc (body params) - "Expand BODY according to PARAMS, return the expanded body." body) - -(defvar org--var-syms) ; Dynamically scoped from org-babel-execute:calc - -(defun org-babel-execute:calc (body params) - "Execute a block of calc code with Babel." - (unless (get-buffer "*Calculator*") - (save-window-excursion (calc) (calc-quit))) - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (org--var-syms (mapcar #'car vars)) - (var-names (mapcar #'symbol-name org--var-syms))) - (mapc - (lambda (pair) - (calc-push-list (list (cdr pair))) - (calc-store-into (car pair))) - vars) - (mapc - (lambda (line) - (when (> (length line) 0) - (cond - ;; simple variable name - ((member line var-names) (calc-recall (intern line))) - ;; stack operation - ((string= "'" (substring line 0 1)) - (funcall (lookup-key calc-mode-map (substring line 1)) nil)) - ;; complex expression - (t - (calc-push-list - (list (let ((res (calc-eval line))) - (cond - ((numberp res) res) - ((math-read-number res) (math-read-number res)) - ((listp res) (error "Calc error \"%s\" on input \"%s\"" - (cadr res) line)) - (t (replace-regexp-in-string - "'" "" - (calc-eval - (math-evaluate-expr - ;; resolve user variables, calc built in - ;; variables are handled automatically - ;; upstream by calc - (mapcar #'org-babel-calc-maybe-resolve-var - ;; parse line into calc objects - (car (math-read-exprs line))))))))) - )))))) - (mapcar #'org-babel-trim - (split-string (org-babel-expand-body:calc body params) "[\n\r]")))) - (save-excursion - (with-current-buffer (get-buffer "*Calculator*") - (calc-eval (calc-top 1))))) - -(defun org-babel-calc-maybe-resolve-var (el) - (if (consp el) - (if (and (equal 'var (car el)) (member (cadr el) org--var-syms)) - (progn - (calc-recall (cadr el)) - (prog1 (calc-top 1) - (calc-pop 1))) - (mapcar #'org-babel-calc-maybe-resolve-var el)) - el)) - -(provide 'ob-calc) - - - -;;; ob-calc.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-clojure.el b/xemacs-packages/lisp/org-8.2.3c/ob-clojure.el deleted file mode 100644 index 25b39f7f..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-clojure.el +++ /dev/null @@ -1,95 +0,0 @@ -;;; ob-clojure.el --- org-babel functions for clojure evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Joel Boehland -;; Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Support for evaluating clojure code, relies on slime for all eval. - -;;; Requirements: - -;; - clojure (at least 1.2.0) -;; - clojure-mode -;; - slime - -;; By far, the best way to install these components is by following -;; the directions as set out by Phil Hagelberg (Technomancy) on the -;; web page: http://technomancy.us/126 - -;;; Code: -(require 'ob) - -(declare-function slime-eval "ext:slime" (sexp &optional package)) - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("clojure" . "clj")) - -(defvar org-babel-default-header-args:clojure '()) -(defvar org-babel-header-args:clojure '((package . :any))) - -(defun org-babel-expand-body:clojure (body params) - "Expand BODY according to PARAMS, return the expanded body." - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) - (print-level nil) (print-length nil) - (body (org-babel-trim - (if (> (length vars) 0) - (concat "(let [" - (mapconcat - (lambda (var) - (format "%S (quote %S)" (car var) (cdr var))) - vars "\n ") - "]\n" body ")") - body)))) - (cond ((or (member "code" result-params) (member "pp" result-params)) - (format (concat "(let [org-mode-print-catcher (java.io.StringWriter.)] " - "(clojure.pprint/with-pprint-dispatch clojure.pprint/%s-dispatch " - "(clojure.pprint/pprint (do %s) org-mode-print-catcher) " - "(str org-mode-print-catcher)))") - (if (member "code" result-params) "code" "simple") body)) - ;; if (:results output), collect printed output - ((member "output" result-params) - (format "(clojure.core/with-out-str %s)" body)) - (t body)))) - -(defun org-babel-execute:clojure (body params) - "Execute a block of Clojure code with Babel." - (require 'slime) - (with-temp-buffer - (insert (org-babel-expand-body:clojure body params)) - (let ((result - (slime-eval - `(swank:eval-and-grab-output - ,(buffer-substring-no-properties (point-min) (point-max))) - (cdr (assoc :package params))))) - (let ((result-params (cdr (assoc :result-params params)))) - (org-babel-result-cond result-params - result - (condition-case nil (org-babel-script-escape result) - (error result))))))) - -(provide 'ob-clojure) - - - -;;; ob-clojure.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-comint.el b/xemacs-packages/lisp/org-8.2.3c/ob-comint.el deleted file mode 100644 index 8b03e2dc..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-comint.el +++ /dev/null @@ -1,166 +0,0 @@ -;;; ob-comint.el --- org-babel functions for interaction with comint buffers - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research, comint -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; These functions build on comint to ease the sending and receiving -;; of commands and results from comint buffers. - -;; Note that the buffers in this file are analogous to sessions in -;; org-babel at large. - -;;; Code: -(require 'ob-core) -(require 'org-compat) -(require 'comint) -(eval-when-compile (require 'cl)) -(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) -(declare-function tramp-flush-directory-property "tramp" (vec directory)) - -(defun org-babel-comint-buffer-livep (buffer) - "Check if BUFFER is a comint buffer with a live process." - (let ((buffer (if buffer (get-buffer buffer)))) - (and buffer (buffer-live-p buffer) (get-buffer-process buffer) buffer))) - -(defmacro org-babel-comint-in-buffer (buffer &rest body) - "Check BUFFER and execute BODY. -BUFFER is checked with `org-babel-comint-buffer-livep'. BODY is -executed inside the protection of `save-excursion' and -`save-match-data'." - (declare (indent 1)) - `(save-excursion - (save-match-data - (unless (org-babel-comint-buffer-livep ,buffer) - (error "Buffer %s does not exist or has no process" ,buffer)) - (set-buffer ,buffer) - ,@body))) -(def-edebug-spec org-babel-comint-in-buffer (form body)) - -(defmacro org-babel-comint-with-output (meta &rest body) - "Evaluate BODY in BUFFER and return process output. -Will wait until EOE-INDICATOR appears in the output, then return -all process output. If REMOVE-ECHO and FULL-BODY are present and -non-nil, then strip echo'd body from the returned output. META -should be a list containing the following where the last two -elements are optional. - - (BUFFER EOE-INDICATOR REMOVE-ECHO FULL-BODY) - -This macro ensures that the filter is removed in case of an error -or user `keyboard-quit' during execution of body." - (declare (indent 1)) - (let ((buffer (car meta)) - (eoe-indicator (cadr meta)) - (remove-echo (cadr (cdr meta))) - (full-body (cadr (cdr (cdr meta))))) - `(org-babel-comint-in-buffer ,buffer - (let ((string-buffer "") dangling-text raw) - ;; setup filter - (setq comint-output-filter-functions - (cons (lambda (text) (setq string-buffer (concat string-buffer text))) - comint-output-filter-functions)) - (unwind-protect - (progn - ;; got located, and save dangling text - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (let ((start (point)) - (end (point-max))) - (setq dangling-text (buffer-substring start end)) - (delete-region start end)) - ;; pass FULL-BODY to process - ,@body - ;; wait for end-of-evaluation indicator - (while (progn - (goto-char comint-last-input-end) - (not (save-excursion - (and (re-search-forward - (regexp-quote ,eoe-indicator) nil t) - (re-search-forward - comint-prompt-regexp nil t))))) - (accept-process-output (get-buffer-process (current-buffer))) - ;; thought the following this would allow async - ;; background running, but I was wrong... - ;; (run-with-timer .5 .5 'accept-process-output - ;; (get-buffer-process (current-buffer))) - ) - ;; replace cut dangling text - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (insert dangling-text)) - ;; remove filter - (setq comint-output-filter-functions - (cdr comint-output-filter-functions))) - ;; remove echo'd FULL-BODY from input - (if (and ,remove-echo ,full-body - (string-match - (replace-regexp-in-string - "\n" "[\r\n]+" (regexp-quote (or ,full-body ""))) - string-buffer)) - (setq raw (substring string-buffer (match-end 0)))) - (split-string string-buffer comint-prompt-regexp))))) -(def-edebug-spec org-babel-comint-with-output (sexp body)) - -(defun org-babel-comint-input-command (buffer cmd) - "Pass CMD to BUFFER. -The input will not be echoed." - (org-babel-comint-in-buffer buffer - (goto-char (process-mark (get-buffer-process buffer))) - (insert cmd) - (comint-send-input) - (org-babel-comint-wait-for-output buffer))) - -(defun org-babel-comint-wait-for-output (buffer) - "Wait until output arrives from BUFFER. -Note: this is only safe when waiting for the result of a single -statement (not large blocks of code)." - (org-babel-comint-in-buffer buffer - (while (progn - (goto-char comint-last-input-end) - (not (and (re-search-forward comint-prompt-regexp nil t) - (goto-char (match-beginning 0)) - (string= (face-name (face-at-point)) - "comint-highlight-prompt")))) - (accept-process-output (get-buffer-process buffer))))) - -(defun org-babel-comint-eval-invisibly-and-wait-for-file - (buffer file string &optional period) - "Evaluate STRING in BUFFER invisibly. -Don't return until FILE exists. Code in STRING must ensure that -FILE exists at end of evaluation." - (unless (org-babel-comint-buffer-livep buffer) - (error "Buffer %s does not exist or has no process" buffer)) - (if (file-exists-p file) (delete-file file)) - (process-send-string - (get-buffer-process buffer) - (if (string-match "\n$" string) string (concat string "\n"))) - ;; From Tramp 2.1.19 the following cache flush is not necessary - (if (file-remote-p default-directory) - (let (v) - (with-parsed-tramp-file-name default-directory nil - (tramp-flush-directory-property v "")))) - (while (not (file-exists-p file)) (sit-for (or period 0.25)))) - -(provide 'ob-comint) - - - -;;; ob-comint.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-core.el b/xemacs-packages/lisp/org-8.2.3c/ob-core.el deleted file mode 100644 index 0ec945d6..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-core.el +++ /dev/null @@ -1,2774 +0,0 @@ -;;; ob-core.el --- working with code blocks in org-mode - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Authors: Eric Schulte -;; Dan Davison -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Code: -(eval-when-compile - (require 'cl)) -(require 'ob-eval) -(require 'org-macs) -(require 'org-compat) - -(defconst org-babel-exeext - (if (memq system-type '(windows-nt cygwin)) - ".exe" - nil)) -;; dynamically scoped for tramp -(defvar org-babel-call-process-region-original nil) -(defvar org-src-lang-modes) -(defvar org-babel-library-of-babel) -(declare-function show-all "outline" ()) -(declare-function org-reduce "org" (CL-FUNC CL-SEQ &rest CL-KEYS)) -(declare-function org-mark-ring-push "org" (&optional pos buffer)) -(declare-function tramp-compat-make-temp-file "tramp-compat" - (filename &optional dir-flag)) -(declare-function tramp-dissect-file-name "tramp" (name &optional nodefault)) -(declare-function tramp-file-name-user "tramp" (vec)) -(declare-function tramp-file-name-host "tramp" (vec)) -(declare-function with-parsed-tramp-file-name "tramp" (filename var &rest body)) -(declare-function org-icompleting-read "org" (&rest args)) -(declare-function org-edit-src-code "org-src" - (&optional context code edit-buffer-name quietp)) -(declare-function org-edit-src-exit "org-src" (&optional context)) -(declare-function org-open-at-point "org" (&optional in-emacs reference-buffer)) -(declare-function org-save-outline-visibility "org-macs" (use-markers &rest body)) -(declare-function org-outline-overlay-data "org" (&optional use-markers)) -(declare-function org-set-outline-overlay-data "org" (data)) -(declare-function org-narrow-to-subtree "org" ()) -(declare-function org-split-string "org" (string &optional separators)) -(declare-function org-entry-get "org" - (pom property &optional inherit literal-nil)) -(declare-function org-make-options-regexp "org" (kwds &optional extra)) -(declare-function org-do-remove-indentation "org" (&optional n)) -(declare-function org-next-block "org" (arg &optional backward block-regexp)) -(declare-function org-previous-block "org" (arg &optional block-regexp)) -(declare-function org-show-context "org" (&optional key)) -(declare-function org-at-table-p "org" (&optional table-type)) -(declare-function org-cycle "org" (&optional arg)) -(declare-function org-uniquify "org" (list)) -(declare-function org-current-level "org" ()) -(declare-function org-table-import "org-table" (file arg)) -(declare-function org-add-hook "org-compat" - (hook function &optional append local)) -(declare-function org-table-align "org-table" ()) -(declare-function org-table-end "org-table" (&optional table-type)) -(declare-function orgtbl-to-generic "org-table" (table params)) -(declare-function orgtbl-to-orgtbl "org-table" (table params)) -(declare-function org-babel-tangle-comment-links "ob-tangle" (&optional info)) -(declare-function org-babel-lob-get-info "ob-lob" nil) -(declare-function org-babel-ref-split-args "ob-ref" (arg-string)) -(declare-function org-babel-ref-parse "ob-ref" (assignment)) -(declare-function org-babel-ref-resolve "ob-ref" (ref)) -(declare-function org-babel-ref-goto-headline-id "ob-ref" (id)) -(declare-function org-babel-ref-headline-body "ob-ref" ()) -(declare-function org-babel-lob-execute-maybe "ob-lob" ()) -(declare-function org-number-sequence "org-compat" (from &optional to inc)) -(declare-function org-at-item-p "org-list" ()) -(declare-function org-list-parse-list "org-list" (&optional delete)) -(declare-function org-list-to-generic "org-list" (LIST PARAMS)) -(declare-function org-list-struct "org-list" ()) -(declare-function org-list-prevs-alist "org-list" (struct)) -(declare-function org-list-get-list-end "org-list" (item struct prevs)) -(declare-function org-remove-if "org" (predicate seq)) -(declare-function org-completing-read "org" (&rest args)) -(declare-function org-escape-code-in-region "org-src" (beg end)) -(declare-function org-unescape-code-in-string "org-src" (s)) -(declare-function org-table-to-lisp "org-table" (&optional txt)) -(declare-function org-reverse-string "org" (string)) -(declare-function org-element-context "org-element" (&optional ELEMENT)) - -(defgroup org-babel nil - "Code block evaluation and management in `org-mode' documents." - :tag "Babel" - :group 'org) - -(defcustom org-confirm-babel-evaluate t - "Confirm before evaluation. -Require confirmation before interactively evaluating code -blocks in Org-mode buffers. The default value of this variable -is t, meaning confirmation is required for any code block -evaluation. This variable can be set to nil to inhibit any -future confirmation requests. This variable can also be set to a -function which takes two arguments the language of the code block -and the body of the code block. Such a function should then -return a non-nil value if the user should be prompted for -execution or nil if no prompt is required. - -Warning: Disabling confirmation may result in accidental -evaluation of potentially harmful code. It may be advisable -remove code block execution from C-c C-c as further protection -against accidental code block evaluation. The -`org-babel-no-eval-on-ctrl-c-ctrl-c' variable can be used to -remove code block execution from the C-c C-c keybinding." - :group 'org-babel - :version "24.1" - :type '(choice boolean function)) -;; don't allow this variable to be changed through file settings -(put 'org-confirm-babel-evaluate 'safe-local-variable (lambda (x) (eq x t))) - -(defcustom org-babel-no-eval-on-ctrl-c-ctrl-c nil - "Remove code block evaluation from the C-c C-c key binding." - :group 'org-babel - :version "24.1" - :type 'boolean) - -(defcustom org-babel-results-keyword "RESULTS" - "Keyword used to name results generated by code blocks. -Should be either RESULTS or NAME however any capitalization may -be used." - :group 'org-babel - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defcustom org-babel-noweb-wrap-start "<<" - "String used to begin a noweb reference in a code block. -See also `org-babel-noweb-wrap-end'." - :group 'org-babel - :type 'string) - -(defcustom org-babel-noweb-wrap-end ">>" - "String used to end a noweb reference in a code block. -See also `org-babel-noweb-wrap-start'." - :group 'org-babel - :type 'string) - -(defcustom org-babel-inline-result-wrap "=%s=" - "Format string used to wrap inline results. -This string must include a \"%s\" which will be replaced by the results." - :group 'org-babel - :type 'string) - -(defun org-babel-noweb-wrap (&optional regexp) - (concat org-babel-noweb-wrap-start - (or regexp "\\([^ \t\n].+?[^ \t]\\|[^ \t\n]\\)") - org-babel-noweb-wrap-end)) - -(defvar org-babel-src-name-regexp - "^[ \t]*#\\+name:[ \t]*" - "Regular expression used to match a source name line.") - -(defvar org-babel-multi-line-header-regexp - "^[ \t]*#\\+headers?:[ \t]*\\([^\n]*\\)$" - "Regular expression used to match multi-line header arguments.") - -(defvar org-babel-src-name-w-name-regexp - (concat org-babel-src-name-regexp - "\\(" - org-babel-multi-line-header-regexp - "\\)*" - "\\([^ ()\f\t\n\r\v]+\\)") - "Regular expression matching source name lines with a name.") - -(defvar org-babel-src-block-regexp - (concat - ;; (1) indentation (2) lang - "^\\([ \t]*\\)#\\+begin_src[ \t]+\\([^ \f\t\n\r\v]+\\)[ \t]*" - ;; (3) switches - "\\([^\":\n]*\"[^\"\n*]*\"[^\":\n]*\\|[^\":\n]*\\)" - ;; (4) header arguments - "\\([^\n]*\\)\n" - ;; (5) body - "\\([^\000]*?\n\\)??[ \t]*#\\+end_src") - "Regexp used to identify code blocks.") - -(defvar org-babel-inline-src-block-regexp - (concat - ;; (1) replacement target (2) lang - "\\(?:^\\|[^-[:alnum:]]\\)\\(src_\\([^ \f\t\n\r\v]+\\)" - ;; (3,4) (unused, headers) - "\\(\\|\\[\\(.*?\\)\\]\\)" - ;; (5) body - "{\\([^\f\n\r\v]+?\\)}\\)") - "Regexp used to identify inline src-blocks.") - -(defun org-babel-get-header (params key &optional others) - "Select only header argument of type KEY from a list. -Optional argument OTHERS indicates that only the header that do -not match KEY should be returned." - (delq nil - (mapcar - (lambda (p) (when (funcall (if others #'not #'identity) (eq (car p) key)) p)) - params))) - -(defun org-babel-get-inline-src-block-matches() - "Set match data if within body of an inline source block. -Returns non-nil if match-data set" - (let ((src-at-0-p (save-excursion - (beginning-of-line 1) - (string= "src" (thing-at-point 'word)))) - (first-line-p (= 1 (line-number-at-pos))) - (orig (point))) - (let ((search-for (cond ((and src-at-0-p first-line-p "src_")) - (first-line-p "[[:punct:] \t]src_") - (t "[[:punct:] \f\t\n\r\v]src_"))) - (lower-limit (if first-line-p - nil - (- (point-at-bol) 1)))) - (save-excursion - (when (or (and src-at-0-p (bobp)) - (and (re-search-forward "}" (point-at-eol) t) - (re-search-backward search-for lower-limit t) - (> orig (point)))) - (when (looking-at org-babel-inline-src-block-regexp) - t )))))) - -(defvar org-babel-inline-lob-one-liner-regexp) -(defun org-babel-get-lob-one-liner-matches() - "Set match data if on line of an lob one liner. -Returns non-nil if match-data set" - (save-excursion - (unless (= (point) (point-at-bol)) ;; move before inline block - (re-search-backward "[ \f\t\n\r\v]" nil t)) - (if (looking-at org-babel-inline-lob-one-liner-regexp) - t - nil))) - -(defun org-babel-get-src-block-info (&optional light) - "Get information on the current source block. - -Optional argument LIGHT does not resolve remote variable -references; a process which could likely result in the execution -of other code blocks. - -Returns a list - (language body header-arguments-alist switches name indent block-head)." - (let ((case-fold-search t) head info name indent) - ;; full code block - (if (setq head (org-babel-where-is-src-block-head)) - (save-excursion - (goto-char head) - (setq info (org-babel-parse-src-block-match)) - (setq indent (car (last info))) - (setq info (butlast info)) - (while (and (forward-line -1) - (looking-at org-babel-multi-line-header-regexp)) - (setf (nth 2 info) - (org-babel-merge-params - (nth 2 info) - (org-babel-parse-header-arguments (match-string 1))))) - (when (looking-at org-babel-src-name-w-name-regexp) - (setq name (org-no-properties (match-string 3))))) - ;; inline source block - (when (org-babel-get-inline-src-block-matches) - (setq info (org-babel-parse-inline-src-block-match)))) - ;; resolve variable references and add summary parameters - (when (and info (not light)) - (setf (nth 2 info) (org-babel-process-params (nth 2 info)))) - (when info (append info (list name indent head))))) - -(defvar org-current-export-file) ; dynamically bound -(defmacro org-babel-check-confirm-evaluate (info &rest body) - "Evaluate BODY with special execution confirmation variables set. - -Specifically; NOEVAL will indicate if evaluation is allowed, -QUERY will indicate if a user query is required, CODE-BLOCK will -hold the language of the code block, and BLOCK-NAME will hold the -name of the code block." - (declare (indent defun)) - (org-with-gensyms - (lang block-body headers name eval eval-no export eval-no-export) - `(let* ((,lang (nth 0 ,info)) - (,block-body (nth 1 ,info)) - (,headers (nth 2 ,info)) - (,name (nth 4 ,info)) - (,eval (or (cdr (assoc :eval ,headers)) - (when (assoc :noeval ,headers) "no"))) - (,eval-no (or (equal ,eval "no") - (equal ,eval "never"))) - (,export (org-bound-and-true-p org-current-export-file)) - (,eval-no-export (and ,export (or (equal ,eval "no-export") - (equal ,eval "never-export")))) - (noeval (or ,eval-no ,eval-no-export)) - (query (or (equal ,eval "query") - (and ,export (equal ,eval "query-export")) - (if (functionp org-confirm-babel-evaluate) - (funcall org-confirm-babel-evaluate - ,lang ,block-body) - org-confirm-babel-evaluate))) - (code-block (if ,info (format " %s " ,lang) " ")) - (block-name (if ,name (format " (%s) " ,name) " "))) - ,@body))) - -(defsubst org-babel-check-evaluate (info) - "Check if code block INFO should be evaluated. -Do not query the user." - (org-babel-check-confirm-evaluate info - (not (when noeval - (message (format "Evaluation of this%scode-block%sis disabled." - code-block block-name)))))) - - ;; dynamically scoped for asynchroneous export -(defvar org-babel-confirm-evaluate-answer-no) - -(defsubst org-babel-confirm-evaluate (info) - "Confirm evaluation of the code block INFO. - -If the variable `org-babel-confirm-evaluate-answer-no' is bound -to a non-nil value, auto-answer with \"no\". - -This query can also be suppressed by setting the value of -`org-confirm-babel-evaluate' to nil, in which case all future -interactive code block evaluations will proceed without any -confirmation from the user. - -Note disabling confirmation may result in accidental evaluation -of potentially harmful code." - (org-babel-check-confirm-evaluate info - (not (when query - (unless - (and (not (org-bound-and-true-p - org-babel-confirm-evaluate-answer-no)) - (yes-or-no-p - (format "Evaluate this%scode block%son your system? " - code-block block-name))) - (message (format "Evaluation of this%scode-block%sis aborted." - code-block block-name))))))) - -;;;###autoload -(defun org-babel-execute-safely-maybe () - (unless org-babel-no-eval-on-ctrl-c-ctrl-c - (org-babel-execute-maybe))) - -(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-execute-safely-maybe) - -;;;###autoload -(defun org-babel-execute-maybe () - (interactive) - (or (org-babel-execute-src-block-maybe) - (org-babel-lob-execute-maybe))) - -(defmacro org-babel-when-in-src-block (&rest body) - "Execute BODY if point is in a source block and return t. - -Otherwise do nothing and return nil." - `(if (or (org-babel-where-is-src-block-head) - (org-babel-get-inline-src-block-matches)) - (progn - ,@body - t) - nil)) - -(defun org-babel-execute-src-block-maybe () - "Conditionally execute a source block. -Detect if this is context for a Babel src-block and if so -then run `org-babel-execute-src-block'." - (interactive) - (org-babel-when-in-src-block - (org-babel-eval-wipe-error-buffer) - (org-babel-execute-src-block current-prefix-arg))) - -;;;###autoload -(defun org-babel-view-src-block-info () - "Display information on the current source block. -This includes header arguments, language and name, and is largely -a window into the `org-babel-get-src-block-info' function." - (interactive) - (let ((info (org-babel-get-src-block-info 'light)) - (full (lambda (it) (> (length it) 0))) - (printf (lambda (fmt &rest args) (princ (apply #'format fmt args))))) - (when info - (with-help-window (help-buffer) - (let ((name (nth 4 info)) - (lang (nth 0 info)) - (switches (nth 3 info)) - (header-args (nth 2 info))) - (when name (funcall printf "Name: %s\n" name)) - (when lang (funcall printf "Lang: %s\n" lang)) - (when (funcall full switches) (funcall printf "Switches: %s\n" switches)) - (funcall printf "Header Arguments:\n") - (dolist (pair (sort header-args - (lambda (a b) (string< (symbol-name (car a)) - (symbol-name (car b)))))) - (when (funcall full (cdr pair)) - (funcall printf "\t%S%s\t%s\n" - (car pair) - (if (> (length (format "%S" (car pair))) 7) "" "\t") - (cdr pair))))))))) - -;;;###autoload -(defun org-babel-expand-src-block-maybe () - "Conditionally expand a source block. -Detect if this is context for a org-babel src-block and if so -then run `org-babel-expand-src-block'." - (interactive) - (org-babel-when-in-src-block - (org-babel-expand-src-block current-prefix-arg))) - -;;;###autoload -(defun org-babel-load-in-session-maybe () - "Conditionally load a source block in a session. -Detect if this is context for a org-babel src-block and if so -then run `org-babel-load-in-session'." - (interactive) - (org-babel-when-in-src-block - (org-babel-load-in-session current-prefix-arg))) - -(add-hook 'org-metaup-hook 'org-babel-load-in-session-maybe) - -;;;###autoload -(defun org-babel-pop-to-session-maybe () - "Conditionally pop to a session. -Detect if this is context for a org-babel src-block and if so -then run `org-babel-switch-to-session'." - (interactive) - (org-babel-when-in-src-block - (org-babel-switch-to-session current-prefix-arg))) - -(add-hook 'org-metadown-hook 'org-babel-pop-to-session-maybe) - -(defconst org-babel-common-header-args-w-values - '((cache . ((no yes))) - (cmdline . :any) - (colnames . ((nil no yes))) - (comments . ((no link yes org both noweb))) - (dir . :any) - (eval . ((never query))) - (exports . ((code results both none))) - (epilogue . :any) - (file . :any) - (file-desc . :any) - (hlines . ((no yes))) - (mkdirp . ((yes no))) - (no-expand) - (noeval) - (noweb . ((yes no tangle no-export strip-export))) - (noweb-ref . :any) - (noweb-sep . :any) - (padline . ((yes no))) - (post . :any) - (prologue . :any) - (results . ((file list vector table scalar verbatim) - (raw html latex org code pp drawer) - (replace silent none append prepend) - (output value))) - (rownames . ((no yes))) - (sep . :any) - (session . :any) - (shebang . :any) - (tangle . ((tangle yes no :any))) - (tangle-mode . ((#o755 #o555 #o444 :any))) - (var . :any) - (wrap . :any))) - -(defconst org-babel-header-arg-names - (mapcar #'car org-babel-common-header-args-w-values) - "Common header arguments used by org-babel. -Note that individual languages may define their own language -specific header arguments as well.") - -(defvar org-babel-default-header-args - '((:session . "none") (:results . "replace") (:exports . "code") - (:cache . "no") (:noweb . "no") (:hlines . "no") (:tangle . "no")) - "Default arguments to use when evaluating a source block.") - -(defvar org-babel-default-inline-header-args - '((:session . "none") (:results . "replace") (:exports . "results")) - "Default arguments to use when evaluating an inline source block.") - -(defvar org-babel-data-names '("tblname" "results" "name")) - -(defvar org-babel-result-regexp - (concat "^[ \t]*#\\+" - (regexp-opt org-babel-data-names t) - "\\(\\[\\(" - ;; FIXME The string below is `org-ts-regexp' - "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>" - " \\)?\\([[:alnum:]]+\\)\\]\\)?\\:[ \t]*") - "Regular expression used to match result lines. -If the results are associated with a hash key then the hash will -be saved in the second match data.") - -(defvar org-babel-result-w-name-regexp - (concat org-babel-result-regexp - "\\([^ ()\f\t\n\r\v]+\\)\\(\(\\(.*\\)\)\\|\\)")) - -(defvar org-babel-min-lines-for-block-output 10 - "The minimum number of lines for block output. -If number of lines of output is equal to or exceeds this -value, the output is placed in a #+begin_example...#+end_example -block. Otherwise the output is marked as literal by inserting -colons at the starts of the lines. This variable only takes -effect if the :results output option is in effect.") - -(defvar org-babel-noweb-error-langs nil - "Languages for which Babel will raise literate programming errors. -List of languages for which errors should be raised when the -source code block satisfying a noweb reference in this language -can not be resolved.") - -(defvar org-babel-hash-show 4 - "Number of initial characters to show of a hidden results hash.") - -(defvar org-babel-hash-show-time nil - "Non-nil means show the time the code block was evaluated in the result hash.") - -(defvar org-babel-after-execute-hook nil - "Hook for functions to be called after `org-babel-execute-src-block'") - -(defun org-babel-named-src-block-regexp-for-name (name) - "This generates a regexp used to match a src block named NAME." - (concat org-babel-src-name-regexp (regexp-quote name) - "[ \t(]*[\r\n]\\(?:^#.*[\r\n]\\)*" - (substring org-babel-src-block-regexp 1))) - -(defun org-babel-named-data-regexp-for-name (name) - "This generates a regexp used to match data named NAME." - (concat org-babel-result-regexp (regexp-quote name) "\\([ \t]\\|$\\)")) - -;;; functions -(defvar call-process-region) -(defvar org-babel-current-src-block-location nil - "Marker pointing to the src block currently being executed. -This may also point to a call line or an inline code block. If -multiple blocks are being executed (e.g., in chained execution -through use of the :var header argument) this marker points to -the outer-most code block.") - -;;;###autoload -(defun org-babel-execute-src-block (&optional arg info params) - "Execute the current source code block. -Insert the results of execution into the buffer. Source code -execution and the collection and formatting of results can be -controlled through a variety of header arguments. - -With prefix argument ARG, force re-execution even if an existing -result cached in the buffer would otherwise have been returned. - -Optionally supply a value for INFO in the form returned by -`org-babel-get-src-block-info'. - -Optionally supply a value for PARAMS which will be merged with -the header arguments specified at the front of the source code -block." - (interactive) - (let* ((org-babel-current-src-block-location - (or org-babel-current-src-block-location - (nth 6 info) - (org-babel-where-is-src-block-head))) - (info (if info - (copy-tree info) - (org-babel-get-src-block-info))) - (merged-params (org-babel-merge-params (nth 2 info) params))) - (when (org-babel-check-evaluate - (let ((i info)) (setf (nth 2 i) merged-params) i)) - (let* ((params (if params - (org-babel-process-params merged-params) - (nth 2 info))) - (cachep (and (not arg) (cdr (assoc :cache params)) - (string= "yes" (cdr (assoc :cache params))))) - (new-hash (when cachep (org-babel-sha1-hash info))) - (old-hash (when cachep (org-babel-current-result-hash))) - (cache-current-p (and (not arg) new-hash - (equal new-hash old-hash)))) - (cond - (cache-current-p - (save-excursion ;; return cached result - (goto-char (org-babel-where-is-src-block-result nil info)) - (end-of-line 1) (forward-char 1) - (let ((result (org-babel-read-result))) - (message (replace-regexp-in-string - "%" "%%" (format "%S" result))) result))) - ((org-babel-confirm-evaluate - (let ((i info)) (setf (nth 2 i) merged-params) i)) - (let* ((lang (nth 0 info)) - (result-params (cdr (assoc :result-params params))) - (body (setf (nth 1 info) - (if (org-babel-noweb-p params :eval) - (org-babel-expand-noweb-references info) - (nth 1 info)))) - (dir (cdr (assoc :dir params))) - (default-directory - (or (and dir (file-name-as-directory (expand-file-name dir))) - default-directory)) - (org-babel-call-process-region-original ;; for tramp handler - (or (org-bound-and-true-p - org-babel-call-process-region-original) - (symbol-function 'call-process-region))) - (indent (nth 5 info)) - result cmd) - (unwind-protect - (let ((call-process-region - (lambda (&rest args) - (apply 'org-babel-tramp-handle-call-process-region - args)))) - (let ((lang-check - (lambda (f) - (let ((f (intern (concat "org-babel-execute:" f)))) - (when (fboundp f) f))))) - (setq cmd - (or (funcall lang-check lang) - (funcall lang-check - (symbol-name - (cdr (assoc lang org-src-lang-modes)))) - (error "No org-babel-execute function for %s!" - lang)))) - (message "executing %s code block%s..." - (capitalize lang) - (if (nth 4 info) (format " (%s)" (nth 4 info)) "")) - (if (member "none" result-params) - (progn - (funcall cmd body params) - (message "result silenced") - (setq result nil)) - (setq result - (let ((result (funcall cmd body params))) - (if (and (eq (cdr (assoc :result-type params)) - 'value) - (or (member "vector" result-params) - (member "table" result-params)) - (not (listp result))) - (list (list result)) result))) - ;; If non-empty result and :file then write to :file. - (when (cdr (assoc :file params)) - (when result - (with-temp-file (cdr (assoc :file params)) - (insert - (org-babel-format-result - result (cdr (assoc :sep (nth 2 info))))))) - (setq result (cdr (assoc :file params)))) - ;; Possibly perform post process provided its appropriate. - (when (cdr (assoc :post params)) - (let ((*this* (if (cdr (assoc :file params)) - (org-babel-result-to-file - (cdr (assoc :file params)) - (when (assoc :file-desc params) - (or (cdr (assoc :file-desc params)) - result))) - result))) - (setq result (org-babel-ref-resolve - (cdr (assoc :post params)))) - (when (cdr (assoc :file params)) - (setq result-params - (remove "file" result-params))))) - (org-babel-insert-result - result result-params info new-hash indent lang)) - (run-hooks 'org-babel-after-execute-hook) - result) - (setq call-process-region - 'org-babel-call-process-region-original))))))))) - -(defun org-babel-expand-body:generic (body params &optional var-lines) - "Expand BODY with PARAMS. -Expand a block of code with org-babel according to its header -arguments. This generic implementation of body expansion is -called for languages which have not defined their own specific -org-babel-expand-body:lang function." - (let ((pro (cdr (assoc :prologue params))) - (epi (cdr (assoc :epilogue params)))) - (mapconcat #'identity - (append (when pro (list pro)) - var-lines - (list body) - (when epi (list epi))) - "\n"))) - -;;;###autoload -(defun org-babel-expand-src-block (&optional arg info params) - "Expand the current source code block. -Expand according to the source code block's header -arguments and pop open the results in a preview buffer." - (interactive) - (let* ((info (or info (org-babel-get-src-block-info))) - (lang (nth 0 info)) - (params (setf (nth 2 info) - (sort (org-babel-merge-params (nth 2 info) params) - (lambda (el1 el2) (string< (symbol-name (car el1)) - (symbol-name (car el2))))))) - (body (setf (nth 1 info) - (if (org-babel-noweb-p params :eval) - (org-babel-expand-noweb-references info) (nth 1 info)))) - (expand-cmd (intern (concat "org-babel-expand-body:" lang))) - (assignments-cmd (intern (concat "org-babel-variable-assignments:" - lang))) - (expanded - (if (fboundp expand-cmd) (funcall expand-cmd body params) - (org-babel-expand-body:generic - body params (and (fboundp assignments-cmd) - (funcall assignments-cmd params)))))) - (if (org-called-interactively-p 'any) - (org-edit-src-code - nil expanded - (concat "*Org-Babel Preview " (buffer-name) "[ " lang " ]*")) - expanded))) - -(defun org-babel-edit-distance (s1 s2) - "Return the edit (levenshtein) distance between strings S1 S2." - (let* ((l1 (length s1)) - (l2 (length s2)) - (dist (vconcat (mapcar (lambda (_) (make-vector (1+ l2) nil)) - (number-sequence 1 (1+ l1))))) - (in (lambda (i j) (aref (aref dist i) j)))) - (setf (aref (aref dist 0) 0) 0) - (dolist (j (number-sequence 1 l2)) - (setf (aref (aref dist 0) j) j)) - (dolist (i (number-sequence 1 l1)) - (setf (aref (aref dist i) 0) i) - (dolist (j (number-sequence 1 l2)) - (setf (aref (aref dist i) j) - (min - (1+ (funcall in (1- i) j)) - (1+ (funcall in i (1- j))) - (+ (if (equal (aref s1 (1- i)) (aref s2 (1- j))) 0 1) - (funcall in (1- i) (1- j))))))) - (funcall in l1 l2))) - -(defun org-babel-combine-header-arg-lists (original &rest others) - "Combine a number of lists of header argument names and arguments." - (let ((results (copy-sequence original))) - (dolist (new-list others) - (dolist (arg-pair new-list) - (let ((header (car arg-pair)) - (args (cdr arg-pair))) - (setq results - (cons arg-pair (org-remove-if - (lambda (pair) (equal header (car pair))) - results)))))) - results)) - -;;;###autoload -(defun org-babel-check-src-block () - "Check for misspelled header arguments in the current code block." - (interactive) - ;; TODO: report malformed code block - ;; TODO: report incompatible combinations of header arguments - ;; TODO: report uninitialized variables - (let ((too-close 2) ;; <- control closeness to report potential match - (names (mapcar #'symbol-name org-babel-header-arg-names))) - (dolist (header (mapcar (lambda (arg) (substring (symbol-name (car arg)) 1)) - (and (org-babel-where-is-src-block-head) - (org-babel-parse-header-arguments - (org-no-properties - (match-string 4)))))) - (dolist (name names) - (when (and (not (string= header name)) - (<= (org-babel-edit-distance header name) too-close) - (not (member header names))) - (error "Supplied header \"%S\" is suspiciously close to \"%S\"" - header name)))) - (message "No suspicious header arguments found."))) - -;;;###autoload -(defun org-babel-insert-header-arg () - "Insert a header argument selecting from lists of common args and values." - (interactive) - (let* ((lang (car (org-babel-get-src-block-info 'light))) - (lang-headers (intern (concat "org-babel-header-args:" lang))) - (headers (org-babel-combine-header-arg-lists - org-babel-common-header-args-w-values - (when (boundp lang-headers) (eval lang-headers)))) - (arg (org-icompleting-read - "Header Arg: " - (mapcar - (lambda (header-spec) (symbol-name (car header-spec))) - headers)))) - (insert ":" arg) - (let ((vals (cdr (assoc (intern arg) headers)))) - (when vals - (insert - " " - (cond - ((eq vals :any) - (read-from-minibuffer "value: ")) - ((listp vals) - (mapconcat - (lambda (group) - (let ((arg (org-icompleting-read - "value: " - (cons "default" (mapcar #'symbol-name group))))) - (if (and arg (not (string= "default" arg))) - (concat arg " ") - ""))) - vals "")))))))) - -;; Add support for completing-read insertion of header arguments after ":" -(defun org-babel-header-arg-expand () - "Call `org-babel-enter-header-arg-w-completion' in appropriate contexts." - (when (and (equal (char-before) ?\:) (org-babel-where-is-src-block-head)) - (org-babel-enter-header-arg-w-completion (match-string 2)))) - -(defun org-babel-enter-header-arg-w-completion (&optional lang) - "Insert header argument appropriate for LANG with completion." - (let* ((lang-headers-var (intern (concat "org-babel-header-args:" lang))) - (lang-headers (when (boundp lang-headers-var) (eval lang-headers-var))) - (headers-w-values (org-babel-combine-header-arg-lists - org-babel-common-header-args-w-values lang-headers)) - (headers (mapcar #'symbol-name (mapcar #'car headers-w-values))) - (header (org-completing-read "Header Arg: " headers)) - (args (cdr (assoc (intern header) headers-w-values))) - (arg (when (and args (listp args)) - (org-completing-read - (format "%s: " header) - (mapcar #'symbol-name (apply #'append args)))))) - (insert (concat header " " (or arg ""))) - (cons header arg))) - -(add-hook 'org-tab-first-hook 'org-babel-header-arg-expand) - -;;;###autoload -(defun org-babel-load-in-session (&optional arg info) - "Load the body of the current source-code block. -Evaluate the header arguments for the source block before -entering the session. After loading the body this pops open the -session." - (interactive) - (let* ((info (or info (org-babel-get-src-block-info))) - (lang (nth 0 info)) - (params (nth 2 info)) - (body (if (not info) - (user-error "No src code block at point") - (setf (nth 1 info) - (if (org-babel-noweb-p params :eval) - (org-babel-expand-noweb-references info) - (nth 1 info))))) - (session (cdr (assoc :session params))) - (dir (cdr (assoc :dir params))) - (default-directory - (or (and dir (file-name-as-directory dir)) default-directory)) - (cmd (intern (concat "org-babel-load-session:" lang)))) - (unless (fboundp cmd) - (error "No org-babel-load-session function for %s!" lang)) - (pop-to-buffer (funcall cmd session body params)) - (end-of-line 1))) - -;;;###autoload -(defun org-babel-initiate-session (&optional arg info) - "Initiate session for current code block. -If called with a prefix argument then resolve any variable -references in the header arguments and assign these variables in -the session. Copy the body of the code block to the kill ring." - (interactive "P") - (let* ((info (or info (org-babel-get-src-block-info (not arg)))) - (lang (nth 0 info)) - (body (nth 1 info)) - (params (nth 2 info)) - (session (cdr (assoc :session params))) - (dir (cdr (assoc :dir params))) - (default-directory - (or (and dir (file-name-as-directory dir)) default-directory)) - (init-cmd (intern (format "org-babel-%s-initiate-session" lang))) - (prep-cmd (intern (concat "org-babel-prep-session:" lang)))) - (if (and (stringp session) (string= session "none")) - (error "This block is not using a session!")) - (unless (fboundp init-cmd) - (error "No org-babel-initiate-session function for %s!" lang)) - (with-temp-buffer (insert (org-babel-trim body)) - (copy-region-as-kill (point-min) (point-max))) - (when arg - (unless (fboundp prep-cmd) - (error "No org-babel-prep-session function for %s!" lang)) - (funcall prep-cmd session params)) - (funcall init-cmd session params))) - -;;;###autoload -(defun org-babel-switch-to-session (&optional arg info) - "Switch to the session of the current code block. -Uses `org-babel-initiate-session' to start the session. If called -with a prefix argument then this is passed on to -`org-babel-initiate-session'." - (interactive "P") - (pop-to-buffer (org-babel-initiate-session arg info)) - (end-of-line 1)) - -(defalias 'org-babel-pop-to-session 'org-babel-switch-to-session) - -(defvar org-src-window-setup) - -;;;###autoload -(defun org-babel-switch-to-session-with-code (&optional arg info) - "Switch to code buffer and display session." - (interactive "P") - (let ((swap-windows - (lambda () - (let ((other-window-buffer (window-buffer (next-window)))) - (set-window-buffer (next-window) (current-buffer)) - (set-window-buffer (selected-window) other-window-buffer)) - (other-window 1))) - (info (org-babel-get-src-block-info)) - (org-src-window-setup 'reorganize-frame)) - (save-excursion - (org-babel-switch-to-session arg info)) - (org-edit-src-code) - (funcall swap-windows))) - -(defmacro org-babel-do-in-edit-buffer (&rest body) - "Evaluate BODY in edit buffer if there is a code block at point. -Return t if a code block was found at point, nil otherwise." - `(let ((org-src-window-setup 'switch-invisibly)) - (when (and (org-babel-where-is-src-block-head) - (org-edit-src-code nil nil nil)) - (unwind-protect (progn ,@body) - (if (org-bound-and-true-p org-edit-src-from-org-mode) - (org-edit-src-exit))) - t))) -(def-edebug-spec org-babel-do-in-edit-buffer (body)) - -(defun org-babel-do-key-sequence-in-edit-buffer (key) - "Read key sequence and execute the command in edit buffer. -Enter a key sequence to be executed in the language major-mode -edit buffer. For example, TAB will alter the contents of the -Org-mode code block according to the effect of TAB in the -language major-mode buffer. For languages that support -interactive sessions, this can be used to send code from the Org -buffer to the session for evaluation using the native major-mode -evaluation mechanisms." - (interactive "kEnter key-sequence to execute in edit buffer: ") - (org-babel-do-in-edit-buffer - (call-interactively - (key-binding (or key (read-key-sequence nil)))))) - -(defvar org-bracket-link-regexp) - -(defun org-babel-active-location-p () - (memq (car (save-match-data (org-element-context))) - '(babel-call inline-babel-call inline-src-block src-block))) - -;;;###autoload -(defun org-babel-open-src-block-result (&optional re-run) - "If `point' is on a src block then open the results of the -source code block, otherwise return nil. With optional prefix -argument RE-RUN the source-code block is evaluated even if -results already exist." - (interactive "P") - (let ((info (org-babel-get-src-block-info 'light))) - (when info - (save-excursion - ;; go to the results, if there aren't any then run the block - (goto-char (or (and (not re-run) (org-babel-where-is-src-block-result)) - (progn (org-babel-execute-src-block) - (org-babel-where-is-src-block-result)))) - (end-of-line 1) - (while (looking-at "[\n\r\t\f ]") (forward-char 1)) - ;; open the results - (if (looking-at org-bracket-link-regexp) - ;; file results - (org-open-at-point) - (let ((r (org-babel-format-result - (org-babel-read-result) (cdr (assoc :sep (nth 2 info)))))) - (pop-to-buffer (get-buffer-create "*Org-Babel Results*")) - (delete-region (point-min) (point-max)) - (insert r))) - t)))) - -;;;###autoload -(defmacro org-babel-map-src-blocks (file &rest body) - "Evaluate BODY forms on each source-block in FILE. -If FILE is nil evaluate BODY forms on source blocks in current -buffer. During evaluation of BODY the following local variables -are set relative to the currently matched code block. - -full-block ------- string holding the entirety of the code block -beg-block -------- point at the beginning of the code block -end-block -------- point at the end of the matched code block -lang ------------- string holding the language of the code block -beg-lang --------- point at the beginning of the lang -end-lang --------- point at the end of the lang -switches --------- string holding the switches -beg-switches ----- point at the beginning of the switches -end-switches ----- point at the end of the switches -header-args ------ string holding the header-args -beg-header-args -- point at the beginning of the header-args -end-header-args -- point at the end of the header-args -body ------------- string holding the body of the code block -beg-body --------- point at the beginning of the body -end-body --------- point at the end of the body" - (declare (indent 1)) - (let ((tempvar (make-symbol "file"))) - `(let* ((,tempvar ,file) - (visited-p (or (null ,tempvar) - (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) - (save-window-excursion - (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) - (goto-char (point-min)) - (while (re-search-forward org-babel-src-block-regexp nil t) - (when (org-babel-active-location-p) - (goto-char (match-beginning 0)) - (let ((full-block (match-string 0)) - (beg-block (match-beginning 0)) - (end-block (match-end 0)) - (lang (match-string 2)) - (beg-lang (match-beginning 2)) - (end-lang (match-end 2)) - (switches (match-string 3)) - (beg-switches (match-beginning 3)) - (end-switches (match-end 3)) - (header-args (match-string 4)) - (beg-header-args (match-beginning 4)) - (end-header-args (match-end 4)) - (body (match-string 5)) - (beg-body (match-beginning 5)) - (end-body (match-end 5))) - ,@body - (goto-char end-block))))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) -(def-edebug-spec org-babel-map-src-blocks (form body)) - -;;;###autoload -(defmacro org-babel-map-inline-src-blocks (file &rest body) - "Evaluate BODY forms on each inline source-block in FILE. -If FILE is nil evaluate BODY forms on source blocks in current -buffer." - (declare (indent 1)) - (let ((tempvar (make-symbol "file"))) - `(let* ((,tempvar ,file) - (visited-p (or (null ,tempvar) - (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) - (save-window-excursion - (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) - (goto-char (point-min)) - (while (re-search-forward org-babel-inline-src-block-regexp nil t) - (when (org-babel-active-location-p) - (goto-char (match-beginning 1)) - (save-match-data ,@body)) - (goto-char (match-end 0)))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) -(def-edebug-spec org-babel-map-inline-src-blocks (form body)) - -(defvar org-babel-lob-one-liner-regexp) - -;;;###autoload -(defmacro org-babel-map-call-lines (file &rest body) - "Evaluate BODY forms on each call line in FILE. -If FILE is nil evaluate BODY forms on source blocks in current -buffer." - (declare (indent 1)) - (let ((tempvar (make-symbol "file"))) - `(let* ((,tempvar ,file) - (visited-p (or (null ,tempvar) - (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) - (save-window-excursion - (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) - (goto-char (point-min)) - (while (re-search-forward org-babel-lob-one-liner-regexp nil t) - (when (org-babel-active-location-p) - (goto-char (match-beginning 1)) - (save-match-data ,@body)) - (goto-char (match-end 0)))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) -(def-edebug-spec org-babel-map-call-lines (form body)) - -;;;###autoload -(defmacro org-babel-map-executables (file &rest body) - (declare (indent 1)) - (let ((tempvar (make-symbol "file")) - (rx (make-symbol "rx"))) - `(let* ((,tempvar ,file) - (,rx (concat "\\(" org-babel-src-block-regexp - "\\|" org-babel-inline-src-block-regexp - "\\|" org-babel-lob-one-liner-regexp "\\)")) - (visited-p (or (null ,tempvar) - (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) - (save-window-excursion - (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) - (goto-char (point-min)) - (while (re-search-forward ,rx nil t) - (when (org-babel-active-location-p) - (goto-char (match-beginning 1)) - (when (looking-at org-babel-inline-src-block-regexp) - (forward-char 1)) - (save-match-data ,@body)) - (goto-char (match-end 0)))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) -(def-edebug-spec org-babel-map-executables (form body)) - -;;;###autoload -(defun org-babel-execute-buffer (&optional arg) - "Execute source code blocks in a buffer. -Call `org-babel-execute-src-block' on every source block in -the current buffer." - (interactive "P") - (org-babel-eval-wipe-error-buffer) - (org-save-outline-visibility t - (org-babel-map-executables nil - (if (looking-at org-babel-lob-one-liner-regexp) - (org-babel-lob-execute-maybe) - (org-babel-execute-src-block arg))))) - -;;;###autoload -(defun org-babel-execute-subtree (&optional arg) - "Execute source code blocks in a subtree. -Call `org-babel-execute-src-block' on every source block in -the current subtree." - (interactive "P") - (save-restriction - (save-excursion - (org-narrow-to-subtree) - (org-babel-execute-buffer arg) - (widen)))) - -;;;###autoload -(defun org-babel-sha1-hash (&optional info) - "Generate an sha1 hash based on the value of info." - (interactive) - (let ((print-level nil) - (info (or info (org-babel-get-src-block-info)))) - (setf (nth 2 info) - (sort (copy-sequence (nth 2 info)) - (lambda (a b) (string< (car a) (car b))))) - (let* ((rm (lambda (lst) - (dolist (p '("replace" "silent" "none" - "append" "prepend")) - (setq lst (remove p lst))) - lst)) - (norm (lambda (arg) - (let ((v (if (and (listp (cdr arg)) (null (cddr arg))) - (copy-sequence (cdr arg)) - (cdr arg)))) - (when (and v (not (and (sequencep v) - (not (consp v)) - (= (length v) 0)))) - (cond - ((and (listp v) ; lists are sorted - (member (car arg) '(:result-params))) - (sort (funcall rm v) #'string<)) - ((and (stringp v) ; strings are sorted - (member (car arg) '(:results :exports))) - (mapconcat #'identity (sort (funcall rm (split-string v)) - #'string<) " ")) - (t v))))))) - (let* ((it (format "%s-%s" - (mapconcat - #'identity - (delq nil (mapcar (lambda (arg) - (let ((normalized (funcall norm arg))) - (when normalized - (format "%S" normalized)))) - (nth 2 info))) ":") - (nth 1 info))) - (hash (sha1 it))) - (when (org-called-interactively-p 'interactive) (message hash)) - hash)))) - -(defun org-babel-current-result-hash () - "Return the current in-buffer hash." - (org-babel-where-is-src-block-result) - (org-no-properties (match-string 5))) - -(defun org-babel-set-current-result-hash (hash) - "Set the current in-buffer hash to HASH." - (org-babel-where-is-src-block-result) - (save-excursion (goto-char (match-beginning 5)) - (mapc #'delete-overlay (overlays-at (point))) - (forward-char org-babel-hash-show) - (mapc #'delete-overlay (overlays-at (point))) - (replace-match hash nil nil nil 5) - (goto-char (point-at-bol)) - (org-babel-hide-hash))) - -(defun org-babel-hide-hash () - "Hide the hash in the current results line. -Only the initial `org-babel-hash-show' characters of the hash -will remain visible." - (add-to-invisibility-spec '(org-babel-hide-hash . t)) - (save-excursion - (when (and (re-search-forward org-babel-result-regexp nil t) - (match-string 5)) - (let* ((start (match-beginning 5)) - (hide-start (+ org-babel-hash-show start)) - (end (match-end 5)) - (hash (match-string 5)) - ov1 ov2) - (setq ov1 (make-overlay start hide-start)) - (setq ov2 (make-overlay hide-start end)) - (overlay-put ov2 'invisible 'org-babel-hide-hash) - (overlay-put ov1 'babel-hash hash))))) - -(defun org-babel-hide-all-hashes () - "Hide the hash in the current buffer. -Only the initial `org-babel-hash-show' characters of each hash -will remain visible. This function should be called as part of -the `org-mode-hook'." - (save-excursion - (while (and (not org-babel-hash-show-time) - (re-search-forward org-babel-result-regexp nil t)) - (goto-char (match-beginning 0)) - (org-babel-hide-hash) - (goto-char (match-end 0))))) -(add-hook 'org-mode-hook 'org-babel-hide-all-hashes) - -(defun org-babel-hash-at-point (&optional point) - "Return the value of the hash at POINT. -The hash is also added as the last element of the kill ring. -This can be called with C-c C-c." - (interactive) - (let ((hash (car (delq nil (mapcar - (lambda (ol) (overlay-get ol 'babel-hash)) - (overlays-at (or point (point)))))))) - (when hash (kill-new hash) (message hash)))) -(add-hook 'org-ctrl-c-ctrl-c-hook 'org-babel-hash-at-point) - -(defun org-babel-result-hide-spec () - "Hide portions of results lines. -Add `org-babel-hide-result' as an invisibility spec for hiding -portions of results lines." - (add-to-invisibility-spec '(org-babel-hide-result . t))) -(add-hook 'org-mode-hook 'org-babel-result-hide-spec) - -(defvar org-babel-hide-result-overlays nil - "Overlays hiding results.") - -(defun org-babel-result-hide-all () - "Fold all results in the current buffer." - (interactive) - (org-babel-show-result-all) - (save-excursion - (while (re-search-forward org-babel-result-regexp nil t) - (save-excursion (goto-char (match-beginning 0)) - (org-babel-hide-result-toggle-maybe))))) - -(defun org-babel-show-result-all () - "Unfold all results in the current buffer." - (mapc 'delete-overlay org-babel-hide-result-overlays) - (setq org-babel-hide-result-overlays nil)) - -;;;###autoload -(defun org-babel-hide-result-toggle-maybe () - "Toggle visibility of result at point." - (interactive) - (let ((case-fold-search t)) - (if (save-excursion - (beginning-of-line 1) - (looking-at org-babel-result-regexp)) - (progn (org-babel-hide-result-toggle) - t) ;; to signal that we took action - nil))) ;; to signal that we did not - -(defun org-babel-hide-result-toggle (&optional force) - "Toggle the visibility of the current result." - (interactive) - (save-excursion - (beginning-of-line) - (if (re-search-forward org-babel-result-regexp nil t) - (let ((start (progn (beginning-of-line 2) (- (point) 1))) - (end (progn - (while (looking-at org-babel-multi-line-header-regexp) - (forward-line 1)) - (goto-char (- (org-babel-result-end) 1)) (point))) - ov) - (if (memq t (mapcar (lambda (overlay) - (eq (overlay-get overlay 'invisible) - 'org-babel-hide-result)) - (overlays-at start))) - (if (or (not force) (eq force 'off)) - (mapc (lambda (ov) - (when (member ov org-babel-hide-result-overlays) - (setq org-babel-hide-result-overlays - (delq ov org-babel-hide-result-overlays))) - (when (eq (overlay-get ov 'invisible) - 'org-babel-hide-result) - (delete-overlay ov))) - (overlays-at start))) - (setq ov (make-overlay start end)) - (overlay-put ov 'invisible 'org-babel-hide-result) - ;; make the block accessible to isearch - (overlay-put - ov 'isearch-open-invisible - (lambda (ov) - (when (member ov org-babel-hide-result-overlays) - (setq org-babel-hide-result-overlays - (delq ov org-babel-hide-result-overlays))) - (when (eq (overlay-get ov 'invisible) - 'org-babel-hide-result) - (delete-overlay ov)))) - (push ov org-babel-hide-result-overlays))) - (error "Not looking at a result line")))) - -;; org-tab-after-check-for-cycling-hook -(add-hook 'org-tab-first-hook 'org-babel-hide-result-toggle-maybe) -;; Remove overlays when changing major mode -(add-hook 'org-mode-hook - (lambda () (org-add-hook 'change-major-mode-hook - 'org-babel-show-result-all 'append 'local))) - -(defvar org-file-properties) -(defun org-babel-params-from-properties (&optional lang) - "Retrieve parameters specified as properties. -Return a list of association lists of source block params -specified in the properties of the current outline entry." - (save-match-data - (list - ;; DEPRECATED header arguments specified as separate property at - ;; point of definition - (let (val sym) - (org-babel-parse-multiple-vars - (delq nil - (mapcar - (lambda (header-arg) - (and (setq val (org-entry-get (point) header-arg t)) - (cons (intern (concat ":" header-arg)) - (org-babel-read val)))) - (mapcar - #'symbol-name - (mapcar - #'car - (org-babel-combine-header-arg-lists - org-babel-common-header-args-w-values - (progn - (setq sym (intern (concat "org-babel-header-args:" lang))) - (and (boundp sym) (eval sym)))))))))) - ;; header arguments specified with the header-args property at - ;; point of call - (org-babel-parse-header-arguments - (org-entry-get org-babel-current-src-block-location - "header-args" 'inherit)) - (when lang ;; language-specific header arguments at point of call - (org-babel-parse-header-arguments - (org-entry-get org-babel-current-src-block-location - (concat "header-args:" lang) 'inherit)))))) - -(defvar org-src-preserve-indentation) -(defun org-babel-parse-src-block-match () - "Parse the results from a match of the `org-babel-src-block-regexp'." - (let* ((block-indentation (length (match-string 1))) - (lang (org-no-properties (match-string 2))) - (lang-headers (intern (concat "org-babel-default-header-args:" lang))) - (switches (match-string 3)) - (body (org-no-properties - (let* ((body (match-string 5)) - (sub-length (- (length body) 1))) - (if (and (> sub-length 0) - (string= "\n" (substring body sub-length))) - (substring body 0 sub-length) - (or body ""))))) - (preserve-indentation (or org-src-preserve-indentation - (save-match-data - (string-match "-i\\>" switches))))) - (list lang - ;; get block body less properties, protective commas, and indentation - (with-temp-buffer - (save-match-data - (insert (org-unescape-code-in-string body)) - (unless preserve-indentation (org-do-remove-indentation)) - (buffer-string))) - (apply #'org-babel-merge-params - org-babel-default-header-args - (when (boundp lang-headers) (eval lang-headers)) - (append - (org-babel-params-from-properties lang) - (list (org-babel-parse-header-arguments - (org-no-properties (or (match-string 4) "")))))) - switches - block-indentation))) - -(defun org-babel-parse-inline-src-block-match () - "Parse the results from a match of the `org-babel-inline-src-block-regexp'." - (let* ((lang (org-no-properties (match-string 2))) - (lang-headers (intern (concat "org-babel-default-header-args:" lang)))) - (list lang - (org-unescape-code-in-string (org-no-properties (match-string 5))) - (apply #'org-babel-merge-params - org-babel-default-inline-header-args - (if (boundp lang-headers) (eval lang-headers) nil) - (append - (org-babel-params-from-properties lang) - (list (org-babel-parse-header-arguments - (org-no-properties (or (match-string 4) ""))))))))) - -(defun org-babel-balanced-split (string alts) - "Split STRING on instances of ALTS. -ALTS is a cons of two character options where each option may be -either the numeric code of a single character or a list of -character alternatives. For example to split on balanced -instances of \"[ \t]:\" set ALTS to '((32 9) . 58)." - (let* ((matches (lambda (ch spec) (if (listp spec) (member ch spec) (equal spec ch)))) - (matched (lambda (ch last) - (if (consp alts) - (and (funcall matches ch (cdr alts)) - (funcall matches last (car alts))) - (funcall matches ch alts)))) - (balance 0) (last 0) - quote partial lst) - (mapc (lambda (ch) ; split on [], (), "" balanced instances of [ \t]: - (setq balance (+ balance - (cond ((or (equal 91 ch) (equal 40 ch)) 1) - ((or (equal 93 ch) (equal 41 ch)) -1) - (t 0)))) - (when (and (equal 34 ch) (not (equal 92 last))) - (setq quote (not quote))) - (setq partial (cons ch partial)) - (when (and (= balance 0) (not quote) (funcall matched ch last)) - (setq lst (cons (apply #'string (nreverse - (if (consp alts) - (cddr partial) - (cdr partial)))) - lst)) - (setq partial nil)) - (setq last ch)) - (string-to-list string)) - (nreverse (cons (apply #'string (nreverse partial)) lst)))) - -(defun org-babel-join-splits-near-ch (ch list) - "Join splits where \"=\" is on either end of the split." - (let ((last= (lambda (str) (= ch (aref str (1- (length str)))))) - (first= (lambda (str) (= ch (aref str 0))))) - (reverse - (org-reduce (lambda (acc el) - (let ((head (car acc))) - (if (and head (or (funcall last= head) (funcall first= el))) - (cons (concat head el) (cdr acc)) - (cons el acc)))) - list :initial-value nil)))) - -(defun org-babel-parse-header-arguments (arg-string) - "Parse a string of header arguments returning an alist." - (when (> (length arg-string) 0) - (org-babel-parse-multiple-vars - (delq nil - (mapcar - (lambda (arg) - (if (string-match - "\\([^ \f\t\n\r\v]+\\)[ \f\t\n\r\v]+\\([^ \f\t\n\r\v]+.*\\)" - arg) - (cons (intern (match-string 1 arg)) - (org-babel-read (org-babel-chomp (match-string 2 arg)))) - (cons (intern (org-babel-chomp arg)) nil))) - (let ((raw (org-babel-balanced-split arg-string '((32 9) . 58)))) - (cons (car raw) (mapcar (lambda (r) (concat ":" r)) (cdr raw))))))))) - -(defun org-babel-parse-multiple-vars (header-arguments) - "Expand multiple variable assignments behind a single :var keyword. - -This allows expression of multiple variables with one :var as -shown below. - -#+PROPERTY: var foo=1, bar=2" - (let (results) - (mapc (lambda (pair) - (if (eq (car pair) :var) - (mapcar (lambda (v) (push (cons :var (org-babel-trim v)) results)) - (org-babel-join-splits-near-ch - 61 (org-babel-balanced-split (cdr pair) 32))) - (push pair results))) - header-arguments) - (nreverse results))) - -(defun org-babel-process-params (params) - "Expand variables in PARAMS and add summary parameters." - (let* ((processed-vars (mapcar (lambda (el) - (if (consp (cdr el)) - (cdr el) - (org-babel-ref-parse (cdr el)))) - (org-babel-get-header params :var))) - (vars-and-names (if (and (assoc :colname-names params) - (assoc :rowname-names params)) - (list processed-vars) - (org-babel-disassemble-tables - processed-vars - (cdr (assoc :hlines params)) - (cdr (assoc :colnames params)) - (cdr (assoc :rownames params))))) - (raw-result (or (cdr (assoc :results params)) "")) - (result-params (append - (split-string (if (stringp raw-result) - raw-result - (eval raw-result))) - (cdr (assoc :result-params params))))) - (append - (mapcar (lambda (var) (cons :var var)) (car vars-and-names)) - (list - (cons :colname-names (or (cdr (assoc :colname-names params)) - (cadr vars-and-names))) - (cons :rowname-names (or (cdr (assoc :rowname-names params)) - (caddr vars-and-names))) - (cons :result-params result-params) - (cons :result-type (cond ((member "output" result-params) 'output) - ((member "value" result-params) 'value) - (t 'value)))) - (org-babel-get-header params :var 'other)))) - -;; row and column names -(defun org-babel-del-hlines (table) - "Remove all 'hlines from TABLE." - (remove 'hline table)) - -(defun org-babel-get-colnames (table) - "Return the column names of TABLE. -Return a cons cell, the `car' of which contains the TABLE less -colnames, and the `cdr' of which contains a list of the column -names." - (if (equal 'hline (nth 1 table)) - (cons (cddr table) (car table)) - (cons (cdr table) (car table)))) - -(defun org-babel-get-rownames (table) - "Return the row names of TABLE. -Return a cons cell, the `car' of which contains the TABLE less -rownames, and the `cdr' of which contains a list of the rownames. -Note: this function removes any hlines in TABLE." - (let* ((table (org-babel-del-hlines table)) - (rownames (funcall (lambda () - (let ((tp table)) - (mapcar - (lambda (row) - (prog1 - (pop (car tp)) - (setq tp (cdr tp)))) - table)))))) - (cons table rownames))) - -(defun org-babel-put-colnames (table colnames) - "Add COLNAMES to TABLE if they exist." - (if colnames (apply 'list colnames 'hline table) table)) - -(defun org-babel-put-rownames (table rownames) - "Add ROWNAMES to TABLE if they exist." - (if rownames - (mapcar (lambda (row) - (if (listp row) - (cons (or (pop rownames) "") row) - row)) table) - table)) - -(defun org-babel-pick-name (names selector) - "Select one out of an alist of row or column names. -SELECTOR can be either a list of names in which case those names -will be returned directly, or an index into the list NAMES in -which case the indexed names will be return." - (if (listp selector) - selector - (when names - (if (and selector (symbolp selector) (not (equal t selector))) - (cdr (assoc selector names)) - (if (integerp selector) - (nth (- selector 1) names) - (cdr (car (last names)))))))) - -(defun org-babel-disassemble-tables (vars hlines colnames rownames) - "Parse tables for further processing. -Process the variables in VARS according to the HLINES, -ROWNAMES and COLNAMES header arguments. Return a list consisting -of the vars, cnames and rnames." - (let (cnames rnames) - (list - (mapcar - (lambda (var) - (when (listp (cdr var)) - (when (and (not (equal colnames "no")) - (or colnames (and (equal (nth 1 (cdr var)) 'hline) - (not (member 'hline (cddr (cdr var))))))) - (let ((both (org-babel-get-colnames (cdr var)))) - (setq cnames (cons (cons (car var) (cdr both)) - cnames)) - (setq var (cons (car var) (car both))))) - (when (and rownames (not (equal rownames "no"))) - (let ((both (org-babel-get-rownames (cdr var)))) - (setq rnames (cons (cons (car var) (cdr both)) - rnames)) - (setq var (cons (car var) (car both))))) - (when (and hlines (not (equal hlines "yes"))) - (setq var (cons (car var) (org-babel-del-hlines (cdr var)))))) - var) - vars) - (reverse cnames) (reverse rnames)))) - -(defun org-babel-reassemble-table (table colnames rownames) - "Add column and row names to a table. -Given a TABLE and set of COLNAMES and ROWNAMES add the names -to the table for reinsertion to org-mode." - (if (listp table) - (let ((table (if (and rownames (= (length table) (length rownames))) - (org-babel-put-rownames table rownames) table))) - (if (and colnames (listp (car table)) (= (length (car table)) - (length colnames))) - (org-babel-put-colnames table colnames) table)) - table)) - -(defun org-babel-where-is-src-block-head () - "Find where the current source block begins. -Return the point at the beginning of the current source -block. Specifically at the beginning of the #+BEGIN_SRC line. -If the point is not on a source block then return nil." - (let ((initial (point)) (case-fold-search t) top bottom) - (or - (save-excursion ;; on a source name line or a #+header line - (beginning-of-line 1) - (and (or (looking-at org-babel-src-name-regexp) - (looking-at org-babel-multi-line-header-regexp)) - (progn - (while (and (forward-line 1) - (or (looking-at org-babel-src-name-regexp) - (looking-at org-babel-multi-line-header-regexp)))) - (looking-at org-babel-src-block-regexp)) - (point))) - (save-excursion ;; on a #+begin_src line - (beginning-of-line 1) - (and (looking-at org-babel-src-block-regexp) - (point))) - (save-excursion ;; inside a src block - (and - (re-search-backward "^[ \t]*#\\+begin_src" nil t) (setq top (point)) - (re-search-forward "^[ \t]*#\\+end_src" nil t) (setq bottom (point)) - (< top initial) (< initial bottom) - (progn (goto-char top) (beginning-of-line 1) - (looking-at org-babel-src-block-regexp)) - (point-marker)))))) - -;;;###autoload -(defun org-babel-goto-src-block-head () - "Go to the beginning of the current code block." - (interactive) - (let ((head (org-babel-where-is-src-block-head))) - (if head (goto-char head) (error "Not currently in a code block")))) - -;;;###autoload -(defun org-babel-goto-named-src-block (name) - "Go to a named source-code block." - (interactive - (let ((completion-ignore-case t) - (case-fold-search t) - (under-point (thing-at-point 'line))) - (list (org-icompleting-read - "source-block name: " (org-babel-src-block-names) nil t - (cond - ;; noweb - ((string-match (org-babel-noweb-wrap) under-point) - (let ((block-name (match-string 1 under-point))) - (string-match "[^(]*" block-name) - (match-string 0 block-name))) - ;; #+call: - ((string-match org-babel-lob-one-liner-regexp under-point) - (let ((source-info (car (org-babel-lob-get-info)))) - (if (string-match "^\\([^\\[]+?\\)\\(\\[.*\\]\\)?(" source-info) - (let ((source-name (match-string 1 source-info))) - source-name)))) - ;; #+results: - ((string-match (concat "#\\+" org-babel-results-keyword - "\\:\s+\\([^\\(]*\\)") under-point) - (match-string 1 under-point)) - ;; symbol-at-point - ((and (thing-at-point 'symbol)) - (org-babel-find-named-block (thing-at-point 'symbol)) - (thing-at-point 'symbol)) - ("")))))) - (let ((point (org-babel-find-named-block name))) - (if point - ;; taken from `org-open-at-point' - (progn (org-mark-ring-push) (goto-char point) (org-show-context)) - (message "source-code block '%s' not found in this buffer" name)))) - -(defun org-babel-find-named-block (name) - "Find a named source-code block. -Return the location of the source block identified by source -NAME, or nil if no such block exists. Set match data according to -org-babel-named-src-block-regexp." - (save-excursion - (let ((case-fold-search t) - (regexp (org-babel-named-src-block-regexp-for-name name)) msg) - (goto-char (point-min)) - (when (or (re-search-forward regexp nil t) - (re-search-backward regexp nil t)) - (match-beginning 0))))) - -(defun org-babel-src-block-names (&optional file) - "Returns the names of source blocks in FILE or the current buffer." - (save-excursion - (when file (find-file file)) (goto-char (point-min)) - (let ((case-fold-search t) names) - (while (re-search-forward org-babel-src-name-w-name-regexp nil t) - (setq names (cons (match-string 3) names))) - names))) - -;;;###autoload -(defun org-babel-goto-named-result (name) - "Go to a named result." - (interactive - (let ((completion-ignore-case t)) - (list (org-icompleting-read "source-block name: " - (org-babel-result-names) nil t)))) - (let ((point (org-babel-find-named-result name))) - (if point - ;; taken from `org-open-at-point' - (progn (goto-char point) (org-show-context)) - (message "result '%s' not found in this buffer" name)))) - -(defun org-babel-find-named-result (name &optional point) - "Find a named result. -Return the location of the result named NAME in the current -buffer or nil if no such result exists." - (save-excursion - (let ((case-fold-search t)) - (goto-char (or point (point-min))) - (catch 'is-a-code-block - (when (re-search-forward - (concat org-babel-result-regexp - "[ \t]" (regexp-quote name) "[ \t]*[\n\f\v\r]") nil t) - (when (and (string= "name" (downcase (match-string 1))) - (or (beginning-of-line 1) - (looking-at org-babel-src-block-regexp) - (looking-at org-babel-multi-line-header-regexp) - (looking-at org-babel-lob-one-liner-regexp))) - (throw 'is-a-code-block (org-babel-find-named-result name (point)))) - (beginning-of-line 0) (point)))))) - -(defun org-babel-result-names (&optional file) - "Returns the names of results in FILE or the current buffer." - (save-excursion - (when file (find-file file)) (goto-char (point-min)) - (let ((case-fold-search t) names) - (while (re-search-forward org-babel-result-w-name-regexp nil t) - (setq names (cons (match-string 4) names))) - names))) - -;;;###autoload -(defun org-babel-next-src-block (&optional arg) - "Jump to the next source block. -With optional prefix argument ARG, jump forward ARG many source blocks." - (interactive "p") - (org-next-block arg nil org-babel-src-block-regexp)) - -;;;###autoload -(defun org-babel-previous-src-block (&optional arg) - "Jump to the previous source block. -With optional prefix argument ARG, jump backward ARG many source blocks." - (interactive "p") - (org-previous-block arg org-babel-src-block-regexp)) - -(defvar org-babel-load-languages) - -;;;###autoload -(defun org-babel-mark-block () - "Mark current src block." - (interactive) - (let ((head (org-babel-where-is-src-block-head))) - (when head - (save-excursion - (goto-char head) - (looking-at org-babel-src-block-regexp)) - (push-mark (match-end 5) nil t) - (goto-char (match-beginning 5))))) - -(defun org-babel-demarcate-block (&optional arg) - "Wrap or split the code in the region or on the point. -When called from inside of a code block the current block is -split. When called from outside of a code block a new code block -is created. In both cases if the region is demarcated and if the -region is not active then the point is demarcated." - (interactive "P") - (let ((info (org-babel-get-src-block-info 'light)) - (headers (progn (org-babel-where-is-src-block-head) - (match-string 4))) - (stars (concat (make-string (or (org-current-level) 1) ?*) " "))) - (if info - (mapc - (lambda (place) - (save-excursion - (goto-char place) - (let ((lang (nth 0 info)) - (indent (make-string (nth 5 info) ? ))) - (when (string-match "^[[:space:]]*$" - (buffer-substring (point-at-bol) - (point-at-eol))) - (delete-region (point-at-bol) (point-at-eol))) - (insert (concat - (if (looking-at "^") "" "\n") - indent "#+end_src\n" - (if arg stars indent) "\n" - indent "#+begin_src " lang - (if (> (length headers) 1) - (concat " " headers) headers) - (if (looking-at "[\n\r]") - "" - (concat "\n" (make-string (current-column) ? ))))))) - (move-end-of-line 2)) - (sort (if (org-region-active-p) (list (mark) (point)) (list (point))) #'>)) - (let ((start (point)) - (lang (org-icompleting-read - "Lang: " - (mapcar #'symbol-name - (delete-dups - (append (mapcar #'car org-babel-load-languages) - (mapcar (lambda (el) (intern (car el))) - org-src-lang-modes)))))) - (body (delete-and-extract-region - (if (org-region-active-p) (mark) (point)) (point)))) - (insert (concat (if (looking-at "^") "" "\n") - (if arg (concat stars "\n") "") - "#+begin_src " lang "\n" - body - (if (or (= (length body) 0) - (string-match "[\r\n]$" body)) "" "\n") - "#+end_src\n")) - (goto-char start) (move-end-of-line 1))))) - -(defvar org-babel-lob-one-liner-regexp) -(defun org-babel-where-is-src-block-result (&optional insert info hash indent) - "Find where the current source block results begin. -Return the point at the beginning of the result of the current -source block. Specifically at the beginning of the results line. -If no result exists for this block then create a results line -following the source block." - (save-excursion - (let* ((case-fold-search t) - (on-lob-line (save-excursion - (beginning-of-line 1) - (looking-at org-babel-lob-one-liner-regexp))) - (inlinep (when (org-babel-get-inline-src-block-matches) - (match-end 0))) - (name (nth 4 (or info (org-babel-get-src-block-info 'light)))) - (head (unless on-lob-line (org-babel-where-is-src-block-head))) - found beg end) - (when head (goto-char head)) - (org-with-wide-buffer - (setq - found ;; was there a result (before we potentially insert one) - (or - inlinep - (and - ;; named results: - ;; - return t if it is found, else return nil - ;; - if it does not need to be rebuilt, then don't set end - ;; - if it does need to be rebuilt then do set end - name (setq beg (org-babel-find-named-result name)) - (prog1 beg - (when (and hash (not (string= hash (match-string 5)))) - (goto-char beg) (setq end beg) ;; beginning of result - (forward-line 1) - (delete-region end (org-babel-result-end)) nil))) - (and - ;; unnamed results: - ;; - return t if it is found, else return nil - ;; - if it is found, and the hash doesn't match, delete and set end - (or on-lob-line (re-search-forward "^[ \t]*#\\+end_src" nil t)) - (progn (end-of-line 1) - (if (eobp) (insert "\n") (forward-char 1)) - (setq end (point)) - (or (and - (not name) - (progn ;; unnamed results line already exists - (catch 'non-comment - (while (re-search-forward "[^ \f\t\n\r\v]" nil t) - (beginning-of-line 1) - (cond - ((looking-at (concat org-babel-result-regexp "\n")) - (throw 'non-comment t)) - ((looking-at "^[ \t]*#") (end-of-line 1)) - (t (throw 'non-comment nil)))))) - (let ((this-hash (match-string 5))) - (prog1 (point) - ;; must remove and rebuild if hash!=old-hash - (if (and hash (not (string= hash this-hash))) - (prog1 nil - (forward-line 1) - (delete-region - end (org-babel-result-end))) - (setq end nil))))))))))) - (if (not (and insert end)) found - (goto-char end) - (unless beg - (if (looking-at "[\n\r]") (forward-char 1) (insert "\n"))) - (insert (concat - (when (wholenump indent) (make-string indent ? )) - "#+" org-babel-results-keyword - (when hash - (if org-babel-hash-show-time - (concat - "["(format-time-string "<%Y-%m-%d %H:%M:%S>")" "hash"]") - (concat "["hash"]"))) - ":" - (when name (concat " " name)) "\n")) - (unless beg (insert "\n") (backward-char)) - (beginning-of-line 0) - (if hash (org-babel-hide-hash)) - (point))))) - -(defvar org-block-regexp) -(defun org-babel-read-result () - "Read the result at `point' into emacs-lisp." - (let ((case-fold-search t) result-string) - (cond - ((org-at-table-p) (org-babel-read-table)) - ((org-at-item-p) (org-babel-read-list)) - ((looking-at org-bracket-link-regexp) (org-babel-read-link)) - ((looking-at org-block-regexp) (org-babel-trim (match-string 4))) - ((or (looking-at "^[ \t]*: ") (looking-at "^[ \t]*:$")) - (setq result-string - (org-babel-trim - (mapconcat (lambda (line) - (or (and (> (length line) 1) - (string-match "^[ \t]*: ?\\(.+\\)" line) - (match-string 1 line)) - "")) - (split-string - (buffer-substring - (point) (org-babel-result-end)) "[\r\n]+") - "\n"))) - (or (org-babel-number-p result-string) result-string)) - ((looking-at org-babel-result-regexp) - (save-excursion (forward-line 1) (org-babel-read-result)))))) - -(defun org-babel-read-table () - "Read the table at `point' into emacs-lisp." - (mapcar (lambda (row) - (if (and (symbolp row) (equal row 'hline)) row - (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) row))) - (org-table-to-lisp))) - -(defun org-babel-read-list () - "Read the list at `point' into emacs-lisp." - (mapcar (lambda (el) (org-babel-read el 'inhibit-lisp-eval)) - (mapcar #'cadr (cdr (org-list-parse-list))))) - -(defvar org-link-types-re) -(defun org-babel-read-link () - "Read the link at `point' into emacs-lisp. -If the path of the link is a file path it is expanded using -`expand-file-name'." - (let* ((case-fold-search t) - (raw (and (looking-at org-bracket-link-regexp) - (org-no-properties (match-string 1)))) - (type (and (string-match org-link-types-re raw) - (match-string 1 raw)))) - (cond - ((not type) (expand-file-name raw)) - ((string= type "file") - (and (string-match "file\\(.*\\):\\(.+\\)" raw) - (expand-file-name (match-string 2 raw)))) - (t raw)))) - -(defun org-babel-format-result (result &optional sep) - "Format RESULT for writing to file." - (let ((echo-res (lambda (r) (if (stringp r) r (format "%S" r))))) - (if (listp result) - ;; table result - (orgtbl-to-generic - result (list :sep (or sep "\t") :fmt echo-res)) - ;; scalar result - (funcall echo-res result)))) - -(defun org-babel-insert-result - (result &optional result-params info hash indent lang) - "Insert RESULT into the current buffer. -By default RESULT is inserted after the end of the -current source block. With optional argument RESULT-PARAMS -controls insertion of results in the org-mode file. -RESULT-PARAMS can take the following values: - -replace - (default option) insert results after the source block - replacing any previously inserted results - -silent -- no results are inserted into the Org-mode buffer but - the results are echoed to the minibuffer and are - ingested by Emacs (a potentially time consuming - process) - -file ---- the results are interpreted as a file path, and are - inserted into the buffer using the Org-mode file syntax - -list ---- the results are interpreted as an Org-mode list. - -raw ----- results are added directly to the Org-mode file. This - is a good option if you code block will output org-mode - formatted text. - -drawer -- results are added directly to the Org-mode file as with - \"raw\", but are wrapped in a RESULTS drawer, allowing - them to later be replaced or removed automatically. - -org ----- results are added inside of a \"#+BEGIN_SRC org\" block. - They are not comma-escaped when inserted, but Org syntax - here will be discarded when exporting the file. - -html ---- results are added inside of a #+BEGIN_HTML block. This - is a good option if you code block will output html - formatted text. - -latex --- results are added inside of a #+BEGIN_LATEX block. - This is a good option if you code block will output - latex formatted text. - -code ---- the results are extracted in the syntax of the source - code of the language being evaluated and are added - inside of a #+BEGIN_SRC block with the source-code - language set appropriately. Note this relies on the - optional LANG argument." - (if (stringp result) - (progn - (setq result (org-no-properties result)) - (when (member "file" result-params) - (setq result (org-babel-result-to-file - result (when (assoc :file-desc (nth 2 info)) - (or (cdr (assoc :file-desc (nth 2 info))) - result)))))) - (unless (listp result) (setq result (format "%S" result)))) - (if (and result-params (member "silent" result-params)) - (progn - (message (replace-regexp-in-string "%" "%%" (format "%S" result))) - result) - (save-excursion - (let* ((inlinep - (save-excursion - (when (or (org-babel-get-inline-src-block-matches) - (org-babel-get-lob-one-liner-matches)) - (goto-char (match-end 0)) - (insert (if (listp result) "\n" " ")) - (point)))) - (existing-result (unless inlinep - (org-babel-where-is-src-block-result - t info hash indent))) - (results-switches - (cdr (assoc :results_switches (nth 2 info)))) - (visible-beg (copy-marker (point-min))) - (visible-end (copy-marker (point-max))) - ;; When results exist outside of the current visible - ;; region of the buffer, be sure to widen buffer to - ;; update them. - (outside-scope-p (and existing-result - (or (> visible-beg existing-result) - (<= visible-end existing-result)))) - beg end) - (when (and (stringp result) ; ensure results end in a newline - (not inlinep) - (> (length result) 0) - (not (or (string-equal (substring result -1) "\n") - (string-equal (substring result -1) "\r")))) - (setq result (concat result "\n"))) - (unwind-protect - (progn - (when outside-scope-p (widen)) - (if (not existing-result) - (setq beg (or inlinep (point))) - (goto-char existing-result) - (save-excursion - (re-search-forward "#" nil t) - (setq indent (- (current-column) 1))) - (forward-line 1) - (setq beg (point)) - (cond - ((member "replace" result-params) - (delete-region (point) (org-babel-result-end))) - ((member "append" result-params) - (goto-char (org-babel-result-end)) (setq beg (point-marker))) - ((member "prepend" result-params)))) ; already there - (setq results-switches - (if results-switches (concat " " results-switches) "")) - (let ((wrap (lambda (start finish &optional no-escape) - (goto-char end) (insert (concat finish "\n")) - (goto-char beg) (insert (concat start "\n")) - (unless no-escape - (org-escape-code-in-region (min (point) end) end)) - (goto-char end) (goto-char (point-at-eol)) - (setq end (point-marker)))) - (proper-list-p (lambda (it) (and (listp it) (null (cdr (last it))))))) - ;; insert results based on type - (cond - ;; do nothing for an empty result - ((null result)) - ;; insert a list if preferred - ((member "list" result-params) - (insert - (org-babel-trim - (org-list-to-generic - (cons 'unordered - (mapcar - (lambda (el) (list nil (if (stringp el) el (format "%S" el)))) - (if (listp result) result (split-string result "\n" t)))) - '(:splicep nil :istart "- " :iend "\n"))) - "\n")) - ;; assume the result is a table if it's not a string - ((funcall proper-list-p result) - (goto-char beg) - (insert (concat (orgtbl-to-orgtbl - (if (or (eq 'hline (car result)) - (and (listp (car result)) - (listp (cdr (car result))))) - result (list result)) - '(:fmt (lambda (cell) (format "%s" cell)))) "\n")) - (goto-char beg) (when (org-at-table-p) (org-table-align))) - ((and (listp result) (not (funcall proper-list-p result))) - (insert (format "%s\n" result))) - ((member "file" result-params) - (when inlinep (goto-char inlinep)) - (insert result)) - (t (goto-char beg) (insert result))) - (when (funcall proper-list-p result) (goto-char (org-table-end))) - (setq end (point-marker)) - ;; possibly wrap result - (cond - ((assoc :wrap (nth 2 info)) - (let ((name (or (cdr (assoc :wrap (nth 2 info))) "RESULTS"))) - (funcall wrap (concat "#+BEGIN_" name) - (concat "#+END_" (car (org-split-string name)))))) - ((member "html" result-params) - (funcall wrap "#+BEGIN_HTML" "#+END_HTML")) - ((member "latex" result-params) - (funcall wrap "#+BEGIN_LaTeX" "#+END_LaTeX")) - ((member "org" result-params) - (goto-char beg) (if (org-at-table-p) (org-cycle)) - (funcall wrap "#+BEGIN_SRC org" "#+END_SRC")) - ((member "code" result-params) - (funcall wrap (format "#+BEGIN_SRC %s%s" (or lang "none") results-switches) - "#+END_SRC")) - ((member "raw" result-params) - (goto-char beg) (if (org-at-table-p) (org-cycle))) - ((or (member "drawer" result-params) - ;; Stay backward compatible with <7.9.2 - (member "wrap" result-params)) - (goto-char beg) (if (org-at-table-p) (org-cycle)) - (funcall wrap ":RESULTS:" ":END:" 'no-escape)) - ((and (not (funcall proper-list-p result)) - (not (member "file" result-params))) - (org-babel-examplize-region beg end results-switches) - (setq end (point))))) - ;; possibly indent the results to match the #+results line - (when (and (not inlinep) (numberp indent) indent (> indent 0) - ;; in this case `table-align' does the work for us - (not (and (listp result) - (member "append" result-params)))) - (indent-rigidly beg end indent)) - (if (null result) - (if (member "value" result-params) - (message "Code block returned no value.") - (message "Code block produced no output.")) - (message "Code block evaluation complete."))) - (when outside-scope-p (narrow-to-region visible-beg visible-end)) - (set-marker visible-beg nil) - (set-marker visible-end nil)))))) - -(defun org-babel-remove-result (&optional info) - "Remove the result of the current source block." - (interactive) - (let ((location (org-babel-where-is-src-block-result nil info)) start) - (when location - (setq start (- location 1)) - (save-excursion - (goto-char location) (forward-line 1) - (delete-region start (org-babel-result-end)))))) - -(defun org-babel-result-end () - "Return the point at the end of the current set of results." - (save-excursion - (cond - ((org-at-table-p) (progn (goto-char (org-table-end)) (point))) - ((org-at-item-p) (let* ((struct (org-list-struct)) - (prvs (org-list-prevs-alist struct))) - (org-list-get-list-end (point-at-bol) struct prvs))) - ((let ((case-fold-search t)) (looking-at "^\\([ \t]*\\):results:")) - (progn (re-search-forward (concat "^" (match-string 1) ":END:")) - (forward-char 1) (point))) - (t - (let ((case-fold-search t)) - (if (looking-at (concat "[ \t]*#\\+begin_\\([^ \t\n\r]+\\)")) - (progn (re-search-forward (concat "[ \t]*#\\+end_" (match-string 1)) - nil t) - (forward-char 1)) - (while (looking-at "[ \t]*\\(: \\|:$\\|\\[\\[\\)") - (forward-line 1)))) - (point))))) - -(defun org-babel-result-to-file (result &optional description) - "Convert RESULT into an `org-mode' link with optional DESCRIPTION. -If the `default-directory' is different from the containing -file's directory then expand relative links." - (when (stringp result) - (format "[[file:%s]%s]" - (if (and default-directory - buffer-file-name - (not (string= (expand-file-name default-directory) - (expand-file-name - (file-name-directory buffer-file-name))))) - (expand-file-name result default-directory) - result) - (if description (concat "[" description "]") "")))) - -(defvar org-babel-capitalize-examplize-region-markers nil - "Make true to capitalize begin/end example markers inserted by code blocks.") - -(defun org-babel-examplize-region (beg end &optional results-switches) - "Comment out region using the inline '==' or ': ' org example quote." - (interactive "*r") - (let ((chars-between (lambda (b e) - (not (string-match "^[\\s]*$" (buffer-substring b e))))) - (maybe-cap (lambda (str) (if org-babel-capitalize-examplize-region-markers - (upcase str) str)))) - (if (or (funcall chars-between (save-excursion (goto-char beg) (point-at-bol)) beg) - (funcall chars-between end (save-excursion (goto-char end) (point-at-eol)))) - (save-excursion - (goto-char beg) - (insert (format org-babel-inline-result-wrap - (prog1 (buffer-substring beg end) - (delete-region beg end))))) - (let ((size (count-lines beg end))) - (save-excursion - (cond ((= size 0)) ; do nothing for an empty result - ((< size org-babel-min-lines-for-block-output) - (goto-char beg) - (dotimes (n size) - (beginning-of-line 1) (insert ": ") (forward-line 1))) - (t - (goto-char beg) - (insert (if results-switches - (format "%s%s\n" - (funcall maybe-cap "#+begin_example") - results-switches) - (funcall maybe-cap "#+begin_example\n"))) - (if (markerp end) (goto-char end) (forward-char (- end beg))) - (insert (funcall maybe-cap "#+end_example\n"))))))))) - -(defun org-babel-update-block-body (new-body) - "Update the body of the current code block to NEW-BODY." - (if (not (org-babel-where-is-src-block-head)) - (error "Not in a source block") - (save-match-data - (replace-match (concat (org-babel-trim new-body) "\n") nil t nil 5)) - (indent-rigidly (match-beginning 5) (match-end 5) 2))) - -(defun org-babel-merge-params (&rest plists) - "Combine all parameter association lists in PLISTS. -Later elements of PLISTS override the values of previous elements. -This takes into account some special considerations for certain -parameters when merging lists." - (let* ((results-exclusive-groups - (mapcar (lambda (group) (mapcar #'symbol-name group)) - (cdr (assoc 'results org-babel-common-header-args-w-values)))) - (exports-exclusive-groups - (mapcar (lambda (group) (mapcar #'symbol-name group)) - (cdr (assoc 'exports org-babel-common-header-args-w-values)))) - (variable-index 0) - (e-merge (lambda (exclusive-groups &rest result-params) - ;; maintain exclusivity of mutually exclusive parameters - (let (output) - (mapc (lambda (new-params) - (mapc (lambda (new-param) - (mapc (lambda (exclusive-group) - (when (member new-param exclusive-group) - (mapcar (lambda (excluded-param) - (setq output - (delete - excluded-param - output))) - exclusive-group))) - exclusive-groups) - (setq output (org-uniquify - (cons new-param output)))) - new-params)) - result-params) - output))) - params results exports tangle noweb cache vars shebang comments padline - clearnames) - - (mapc - (lambda (plist) - (mapc - (lambda (pair) - (case (car pair) - (:var - (let ((name (if (listp (cdr pair)) - (cadr pair) - (and (string-match "^\\([^= \f\t\n\r\v]+\\)[ \t]*=" - (cdr pair)) - (intern (match-string 1 (cdr pair))))))) - (if name - (setq vars - (append - (if (member name (mapcar #'car vars)) - (progn - (push name clearnames) - (delq nil - (mapcar - (lambda (p) - (unless (equal (car p) name) p)) - vars))) - vars) - (list (cons name pair)))) - ;; if no name is given and we already have named variables - ;; then assign to named variables in order - (if (and vars (nth variable-index vars)) - (let ((name (car (nth variable-index vars)))) - (push name clearnames) ; clear out colnames - ; and rownames - ; for replace vars - (prog1 (setf (cddr (nth variable-index vars)) - (concat (symbol-name name) "=" (cdr pair))) - (incf variable-index))) - (error "Variable \"%s\" must be assigned a default value" - (cdr pair)))))) - (:results - (setq results (funcall e-merge results-exclusive-groups - results - (split-string - (let ((r (cdr pair))) - (if (stringp r) r (eval r))))))) - (:file - (when (cdr pair) - (setq results (funcall e-merge results-exclusive-groups - results '("file"))) - (unless (or (member "both" exports) - (member "none" exports) - (member "code" exports)) - (setq exports (funcall e-merge exports-exclusive-groups - exports '("results")))) - (setq params (cons pair (assq-delete-all (car pair) params))))) - (:exports - (setq exports (funcall e-merge exports-exclusive-groups - exports (split-string (cdr pair))))) - (:tangle ;; take the latest -- always overwrite - (setq tangle (or (list (cdr pair)) tangle))) - (:noweb - (setq noweb (funcall e-merge - '(("yes" "no" "tangle" "no-export" - "strip-export" "eval")) - noweb - (split-string (or (cdr pair) ""))))) - (:cache - (setq cache (funcall e-merge '(("yes" "no")) cache - (split-string (or (cdr pair) ""))))) - (:padline - (setq padline (funcall e-merge '(("yes" "no")) padline - (split-string (or (cdr pair) ""))))) - (:shebang ;; take the latest -- always overwrite - (setq shebang (or (list (cdr pair)) shebang))) - (:comments - (setq comments (funcall e-merge '(("yes" "no")) comments - (split-string (or (cdr pair) ""))))) - (t ;; replace: this covers e.g. :session - (setq params (cons pair (assq-delete-all (car pair) params)))))) - plist)) - plists) - (setq vars (reverse vars)) - (while vars (setq params (cons (cons :var (cddr (pop vars))) params))) - ;; clear out col-names and row-names for replaced variables - (mapc - (lambda (name) - (mapc - (lambda (param) - (when (assoc param params) - (setf (cdr (assoc param params)) - (org-remove-if (lambda (pair) (equal (car pair) name)) - (cdr (assoc param params)))) - (setf params (org-remove-if (lambda (pair) (and (equal (car pair) param) - (null (cdr pair)))) - params)))) - (list :colname-names :rowname-names))) - clearnames) - (mapc - (lambda (hd) - (let ((key (intern (concat ":" (symbol-name hd)))) - (val (eval hd))) - (setf params (cons (cons key (mapconcat 'identity val " ")) params)))) - '(results exports tangle noweb padline cache shebang comments)) - params)) - -(defvar org-babel-use-quick-and-dirty-noweb-expansion nil - "Set to true to use regular expressions to expand noweb references. -This results in much faster noweb reference expansion but does -not properly allow code blocks to inherit the \":noweb-ref\" -header argument from buffer or subtree wide properties.") - -(defun org-babel-noweb-p (params context) - "Check if PARAMS require expansion in CONTEXT. -CONTEXT may be one of :tangle, :export or :eval." - (let* (intersect - (intersect (lambda (as bs) - (when as - (if (member (car as) bs) - (car as) - (funcall intersect (cdr as) bs)))))) - (funcall intersect (case context - (:tangle '("yes" "tangle" "no-export" "strip-export")) - (:eval '("yes" "no-export" "strip-export" "eval")) - (:export '("yes"))) - (split-string (or (cdr (assoc :noweb params)) ""))))) - -(defun org-babel-expand-noweb-references (&optional info parent-buffer) - "Expand Noweb references in the body of the current source code block. - -For example the following reference would be replaced with the -body of the source-code block named 'example-block'. - -<> - -Note that any text preceding the <> construct on a line will -be interposed between the lines of the replacement text. So for -example if <> is placed behind a comment, then the entire -replacement text will also be commented. - -This function must be called from inside of the buffer containing -the source-code block which holds BODY. - -In addition the following syntax can be used to insert the -results of evaluating the source-code block named 'example-block'. - -<> - -Any optional arguments can be passed to example-block by placing -the arguments inside the parenthesis following the convention -defined by `org-babel-lob'. For example - -<> - -would set the value of argument \"a\" equal to \"9\". Note that -these arguments are not evaluated in the current source-code -block but are passed literally to the \"example-block\"." - (let* ((parent-buffer (or parent-buffer (current-buffer))) - (info (or info (org-babel-get-src-block-info 'light))) - (lang (nth 0 info)) - (body (nth 1 info)) - (ob-nww-start org-babel-noweb-wrap-start) - (ob-nww-end org-babel-noweb-wrap-end) - (comment (string= "noweb" (cdr (assoc :comments (nth 2 info))))) - (rx-prefix (concat "\\(" org-babel-src-name-regexp "\\|" - ":noweb-ref[ \t]+" "\\)")) - (new-body "") - (nb-add (lambda (text) (setq new-body (concat new-body text)))) - (c-wrap (lambda (text) - (with-temp-buffer - (funcall (intern (concat lang "-mode"))) - (comment-region (point) (progn (insert text) (point))) - (org-babel-trim (buffer-string))))) - index source-name evaluate prefix) - (with-temp-buffer - (org-set-local 'org-babel-noweb-wrap-start ob-nww-start) - (org-set-local 'org-babel-noweb-wrap-end ob-nww-end) - (insert body) (goto-char (point-min)) - (setq index (point)) - (while (and (re-search-forward (org-babel-noweb-wrap) nil t)) - (save-match-data (setf source-name (match-string 1))) - (save-match-data (setq evaluate (string-match "\(.*\)" source-name))) - (save-match-data - (setq prefix - (buffer-substring (match-beginning 0) - (save-excursion - (beginning-of-line 1) (point))))) - ;; add interval to new-body (removing noweb reference) - (goto-char (match-beginning 0)) - (funcall nb-add (buffer-substring index (point))) - (goto-char (match-end 0)) - (setq index (point)) - (funcall - nb-add - (with-current-buffer parent-buffer - (save-restriction - (widen) - (mapconcat ;; Interpose PREFIX between every line. - #'identity - (split-string - (if evaluate - (let ((raw (org-babel-ref-resolve source-name))) - (if (stringp raw) raw (format "%S" raw))) - (or - ;; Retrieve from the library of babel. - (nth 2 (assoc (intern source-name) - org-babel-library-of-babel)) - ;; Return the contents of headlines literally. - (save-excursion - (when (org-babel-ref-goto-headline-id source-name) - (org-babel-ref-headline-body))) - ;; Find the expansion of reference in this buffer. - (let ((rx (concat rx-prefix source-name "[ \t\n]")) - expansion) - (save-excursion - (goto-char (point-min)) - (if org-babel-use-quick-and-dirty-noweb-expansion - (while (re-search-forward rx nil t) - (let* ((i (org-babel-get-src-block-info 'light)) - (body (org-babel-expand-noweb-references i)) - (sep (or (cdr (assoc :noweb-sep (nth 2 i))) - "\n")) - (full (if comment - (let ((cs (org-babel-tangle-comment-links i))) - (concat (funcall c-wrap (car cs)) "\n" - body "\n" - (funcall c-wrap (cadr cs)))) - body))) - (setq expansion (cons sep (cons full expansion))))) - (org-babel-map-src-blocks nil - (let ((i (org-babel-get-src-block-info 'light))) - (when (equal (or (cdr (assoc :noweb-ref (nth 2 i))) - (nth 4 i)) - source-name) - (let* ((body (org-babel-expand-noweb-references i)) - (sep (or (cdr (assoc :noweb-sep (nth 2 i))) - "\n")) - (full (if comment - (let ((cs (org-babel-tangle-comment-links i))) - (concat (funcall c-wrap (car cs)) "\n" - body "\n" - (funcall c-wrap (cadr cs)))) - body))) - (setq expansion - (cons sep (cons full expansion))))))))) - (and expansion - (mapconcat #'identity (nreverse (cdr expansion)) ""))) - ;; Possibly raise an error if named block doesn't exist. - (if (member lang org-babel-noweb-error-langs) - (error "%s" (concat - (org-babel-noweb-wrap source-name) - "could not be resolved (see " - "`org-babel-noweb-error-langs')")) - ""))) - "[\n\r]") (concat "\n" prefix)))))) - (funcall nb-add (buffer-substring index (point-max)))) - new-body)) - -(defun org-babel-script-escape (str &optional force) - "Safely convert tables into elisp lists." - (let ((escaped - (if (or force - (and (stringp str) - (> (length str) 2) - (or (and (string-equal "[" (substring str 0 1)) - (string-equal "]" (substring str -1))) - (and (string-equal "{" (substring str 0 1)) - (string-equal "}" (substring str -1))) - (and (string-equal "(" (substring str 0 1)) - (string-equal ")" (substring str -1)))))) - (org-babel-read - (concat - "'" - (let (in-single in-double out) - (mapc - (lambda (ch) - (setq - out - (case ch - (91 (if (or in-double in-single) ; [ - (cons 91 out) - (cons 40 out))) - (93 (if (or in-double in-single) ; ] - (cons 93 out) - (cons 41 out))) - (123 (if (or in-double in-single) ; { - (cons 123 out) - (cons 40 out))) - (125 (if (or in-double in-single) ; } - (cons 125 out) - (cons 41 out))) - (44 (if (or in-double in-single) ; , - (cons 44 out) (cons 32 out))) - (39 (if in-double ; ' - (cons 39 out) - (setq in-single (not in-single)) (cons 34 out))) - (34 (if in-single ; " - (append (list 34 32) out) - (setq in-double (not in-double)) (cons 34 out))) - (t (cons ch out))))) - (string-to-list str)) - (apply #'string (reverse out))))) - str))) - (condition-case nil (org-babel-read escaped) (error escaped)))) - -(defun org-babel-read (cell &optional inhibit-lisp-eval) - "Convert the string value of CELL to a number if appropriate. -Otherwise if cell looks like lisp (meaning it starts with a -\"(\", \"'\", \"`\" or a \"[\") then read it as lisp, -otherwise return it unmodified as a string. Optional argument -NO-LISP-EVAL inhibits lisp evaluation for situations in which is -it not appropriate." - (if (and (stringp cell) (not (equal cell ""))) - (or (org-babel-number-p cell) - (if (and (not inhibit-lisp-eval) - (or (member (substring cell 0 1) '("(" "'" "`" "[")) - (string= cell "*this*"))) - (eval (read cell)) - (if (string= (substring cell 0 1) "\"") - (read cell) - (progn (set-text-properties 0 (length cell) nil cell) cell)))) - cell)) - -(defun org-babel-number-p (string) - "If STRING represents a number return its value." - (if (and (string-match "[0-9]+" string) - (string-match "^-?[0-9]*\\.?[0-9]*$" string) - (= (length (substring string (match-beginning 0) - (match-end 0))) - (length string))) - (string-to-number string))) - -(defun org-babel-import-elisp-from-file (file-name &optional separator) - "Read the results located at FILE-NAME into an elisp table. -If the table is trivial, then return it as a scalar." - (let (result) - (save-window-excursion - (with-temp-buffer - (condition-case err - (progn - (org-table-import file-name separator) - (delete-file file-name) - (setq result (mapcar (lambda (row) - (mapcar #'org-babel-string-read row)) - (org-table-to-lisp)))) - (error (message "Error reading results: %s" err) nil))) - (if (null (cdr result)) ;; if result is trivial vector, then scalarize it - (if (consp (car result)) - (if (null (cdr (car result))) - (caar result) - result) - (car result)) - result)))) - -(defun org-babel-string-read (cell) - "Strip nested \"s from around strings." - (org-babel-read (or (and (stringp cell) - (string-match "\\\"\\(.+\\)\\\"" cell) - (match-string 1 cell)) - cell) t)) - -(defun org-babel-chomp (string &optional regexp) - "Strip trailing spaces and carriage returns from STRING. -Default regexp used is \"[ \f\t\n\r\v]\" but can be -overwritten by specifying a regexp as a second argument." - (let ((regexp (or regexp "[ \f\t\n\r\v]"))) - (while (and (> (length string) 0) - (string-match regexp (substring string -1))) - (setq string (substring string 0 -1))) - string)) - -(defun org-babel-trim (string &optional regexp) - "Strip leading and trailing spaces and carriage returns from STRING. -Like `org-babel-chomp' only it runs on both the front and back -of the string." - (org-babel-chomp (org-reverse-string - (org-babel-chomp (org-reverse-string string) regexp)) - regexp)) - -(defun org-babel-tramp-handle-call-process-region - (start end program &optional delete buffer display &rest args) - "Use Tramp to handle `call-process-region'. -Fixes a bug in `tramp-handle-call-process-region'." - (if (and (featurep 'tramp) (file-remote-p default-directory)) - (let ((tmpfile (tramp-compat-make-temp-file ""))) - (write-region start end tmpfile) - (when delete (delete-region start end)) - (unwind-protect - ;; (apply 'call-process program tmpfile buffer display args) - ;; bug in tramp - (apply 'process-file program tmpfile buffer display args) - (delete-file tmpfile))) - ;; org-babel-call-process-region-original is the original emacs - ;; definition. It is in scope from the let binding in - ;; org-babel-execute-src-block - (apply org-babel-call-process-region-original - start end program delete buffer display args))) - -(defun org-babel-local-file-name (file) - "Return the local name component of FILE." - (if (file-remote-p file) - (let (localname) - (with-parsed-tramp-file-name file nil - localname)) - file)) - -(defun org-babel-process-file-name (name &optional no-quote-p) - "Prepare NAME to be used in an external process. -If NAME specifies a remote location, the remote portion of the -name is removed, since in that case the process will be executing -remotely. The file name is then processed by `expand-file-name'. -Unless second argument NO-QUOTE-P is non-nil, the file name is -additionally processed by `shell-quote-argument'" - (let ((f (expand-file-name (org-babel-local-file-name name)))) - (if no-quote-p f (shell-quote-argument f)))) - -(defvar org-babel-temporary-directory) -(unless (or noninteractive (boundp 'org-babel-temporary-directory)) - (defvar org-babel-temporary-directory - (or (and (boundp 'org-babel-temporary-directory) - (file-exists-p org-babel-temporary-directory) - org-babel-temporary-directory) - (make-temp-file "babel-" t)) - "Directory to hold temporary files created to execute code blocks. -Used by `org-babel-temp-file'. This directory will be removed on -Emacs shutdown.")) - -(defmacro org-babel-result-cond (result-params scalar-form &rest table-forms) - "Call the code to parse raw string results according to RESULT-PARAMS." - (declare (indent 1) - (debug (form form &rest form))) - (org-with-gensyms (params) - `(let ((,params ,result-params)) - (unless (member "none" ,params) - (if (or (member "scalar" ,params) - (member "verbatim" ,params) - (member "html" ,params) - (member "code" ,params) - (member "pp" ,params) - (and (or (member "output" ,params) - (member "raw" ,params) - (member "org" ,params) - (member "drawer" ,params)) - (not (member "table" ,params)))) - ,scalar-form - ,@table-forms))))) -(def-edebug-spec org-babel-result-cond (form form body)) - -(defun org-babel-temp-file (prefix &optional suffix) - "Create a temporary file in the `org-babel-temporary-directory'. -Passes PREFIX and SUFFIX directly to `make-temp-file' with the -value of `temporary-file-directory' temporarily set to the value -of `org-babel-temporary-directory'." - (if (file-remote-p default-directory) - (let ((prefix - (concat (file-remote-p default-directory) - (expand-file-name prefix temporary-file-directory)))) - (make-temp-file prefix nil suffix)) - (let ((temporary-file-directory - (or (and (boundp 'org-babel-temporary-directory) - (file-exists-p org-babel-temporary-directory) - org-babel-temporary-directory) - temporary-file-directory))) - (make-temp-file prefix nil suffix)))) - -(defun org-babel-remove-temporary-directory () - "Remove `org-babel-temporary-directory' on Emacs shutdown." - (when (and (boundp 'org-babel-temporary-directory) - (file-exists-p org-babel-temporary-directory)) - ;; taken from `delete-directory' in files.el - (condition-case nil - (progn - (mapc (lambda (file) - ;; This test is equivalent to - ;; (and (file-directory-p fn) (not (file-symlink-p fn))) - ;; but more efficient - (if (eq t (car (file-attributes file))) - (delete-directory file) - (delete-file file))) - ;; We do not want to delete "." and "..". - (directory-files org-babel-temporary-directory 'full - "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) - (delete-directory org-babel-temporary-directory)) - (error - (message "Failed to remove temporary Org-babel directory %s" - (if (boundp 'org-babel-temporary-directory) - org-babel-temporary-directory - "[directory not defined]")))))) - -(add-hook 'kill-emacs-hook 'org-babel-remove-temporary-directory) - -(provide 'ob-core) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ob-core.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-css.el b/xemacs-packages/lisp/org-8.2.3c/ob-css.el deleted file mode 100644 index a1205f59..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-css.el +++ /dev/null @@ -1,48 +0,0 @@ -;;; ob-css.el --- org-babel functions for css evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Since CSS can't be executed, this file exists solely for tangling -;; CSS from org-mode files. - -;;; Code: -(require 'ob) - -(defvar org-babel-default-header-args:css '()) - -(defun org-babel-execute:css (body params) - "Execute a block of CSS code. -This function is called by `org-babel-execute-src-block'." - body) - -(defun org-babel-prep-session:css (session params) - "Return an error if the :session header argument is set. -CSS does not support sessions." - (error "CSS sessions are nonsensical")) - -(provide 'ob-css) - - - -;;; ob-css.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-ditaa.el b/xemacs-packages/lisp/org-8.2.3c/ob-ditaa.el deleted file mode 100644 index 36681d0a..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-ditaa.el +++ /dev/null @@ -1,122 +0,0 @@ -;;; ob-ditaa.el --- org-babel functions for ditaa evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating ditaa source code. -;; -;; This differs from most standard languages in that -;; -;; 1) there is no such thing as a "session" in ditaa -;; -;; 2) we are generally only going to return results of type "file" -;; -;; 3) we are adding the "file" and "cmdline" header arguments -;; -;; 4) there are no variables (at least for now) - -;;; Code: -(require 'ob) -(require 'org-compat) - -(defvar org-babel-default-header-args:ditaa - '((:results . "file") - (:exports . "results") - (:java . "-Dfile.encoding=UTF-8")) - "Default arguments for evaluating a ditaa source block.") - -(defcustom org-ditaa-jar-path (expand-file-name - "ditaa.jar" - (file-name-as-directory - (expand-file-name - "scripts" - (file-name-as-directory - (expand-file-name - "../contrib" - (file-name-directory (org-find-library-dir "org"))))))) - "Path to the ditaa jar executable." - :group 'org-babel - :type 'string) - -(defcustom org-babel-ditaa-java-cmd "java" - "Java executable to use when evaluating ditaa blocks." - :group 'org-babel - :type 'string) - -(defcustom org-ditaa-eps-jar-path - (expand-file-name "DitaaEps.jar" (file-name-directory org-ditaa-jar-path)) - "Path to the DitaaEps.jar executable." - :group 'org-babel - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defcustom org-ditaa-jar-option "-jar" - "Option for the ditaa jar file. -Do not leave leading or trailing spaces in this string." - :group 'org-babel - :version "24.1" - :type 'string) - -(defun org-babel-execute:ditaa (body params) - "Execute a block of Ditaa code with org-babel. -This function is called by `org-babel-execute-src-block'." - (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (let ((el (cdr (assoc :file params)))) - (or el - (error - "ditaa code block requires :file header argument")))) - (cmdline (cdr (assoc :cmdline params))) - (java (cdr (assoc :java params))) - (in-file (org-babel-temp-file "ditaa-")) - (eps (cdr (assoc :eps params))) - (cmd (concat org-babel-ditaa-java-cmd - " " java " " org-ditaa-jar-option " " - (shell-quote-argument - (expand-file-name - (if eps org-ditaa-eps-jar-path org-ditaa-jar-path))) - " " cmdline - " " (org-babel-process-file-name in-file) - " " (org-babel-process-file-name out-file))) - (pdf-cmd (when (and (or (string= (file-name-extension out-file) "pdf") - (cdr (assoc :pdf params)))) - (concat - "epstopdf" - " " (org-babel-process-file-name (concat in-file ".eps")) - " -o=" (org-babel-process-file-name out-file))))) - (unless (file-exists-p org-ditaa-jar-path) - (error "Could not find ditaa.jar at %s" org-ditaa-jar-path)) - (with-temp-file in-file (insert body)) - (message cmd) (shell-command cmd) - (when pdf-cmd (message pdf-cmd) (shell-command pdf-cmd)) - nil)) ;; signal that output has already been written to file - -(defun org-babel-prep-session:ditaa (session params) - "Return an error because ditaa does not support sessions." - (error "Ditaa does not support sessions")) - -(provide 'ob-ditaa) - - - -;;; ob-ditaa.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-dot.el b/xemacs-packages/lisp/org-8.2.3c/ob-dot.el deleted file mode 100644 index 75042641..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-dot.el +++ /dev/null @@ -1,89 +0,0 @@ -;;; ob-dot.el --- org-babel functions for dot evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating dot source code. -;; -;; For information on dot see http://www.graphviz.org/ -;; -;; This differs from most standard languages in that -;; -;; 1) there is no such thing as a "session" in dot -;; -;; 2) we are generally only going to return results of type "file" -;; -;; 3) we are adding the "file" and "cmdline" header arguments -;; -;; 4) there are no variables (at least for now) - -;;; Code: -(require 'ob) - -(defvar org-babel-default-header-args:dot - '((:results . "file") (:exports . "results")) - "Default arguments to use when evaluating a dot source block.") - -(defun org-babel-expand-body:dot (body params) - "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) - (mapc - (lambda (pair) - (let ((name (symbol-name (car pair))) - (value (cdr pair))) - (setq body - (replace-regexp-in-string - (concat "\$" (regexp-quote name)) - (if (stringp value) value (format "%S" value)) - body)))) - vars) - body)) - -(defun org-babel-execute:dot (body params) - "Execute a block of Dot code with org-babel. -This function is called by `org-babel-execute-src-block'." - (let* ((result-params (cdr (assoc :result-params params))) - (out-file (cdr (or (assoc :file params) - (error "You need to specify a :file parameter")))) - (cmdline (or (cdr (assoc :cmdline params)) - (format "-T%s" (file-name-extension out-file)))) - (cmd (or (cdr (assoc :cmd params)) "dot")) - (in-file (org-babel-temp-file "dot-"))) - (with-temp-file in-file - (insert (org-babel-expand-body:dot body params))) - (org-babel-eval - (concat cmd - " " (org-babel-process-file-name in-file) - " " cmdline - " -o " (org-babel-process-file-name out-file)) "") - nil)) ;; signal that output has already been written to file - -(defun org-babel-prep-session:dot (session params) - "Return an error because Dot does not support sessions." - (error "Dot does not support sessions")) - -(provide 'ob-dot) - - - -;;; ob-dot.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-emacs-lisp.el b/xemacs-packages/lisp/org-8.2.3c/ob-emacs-lisp.el deleted file mode 100644 index a30e369e..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-emacs-lisp.el +++ /dev/null @@ -1,82 +0,0 @@ -;;; ob-emacs-lisp.el --- org-babel functions for emacs-lisp code evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating emacs-lisp code - -;;; Code: -(require 'ob) - -(defvar org-babel-default-header-args:emacs-lisp - '((:hlines . "yes") (:colnames . "no")) - "Default arguments for evaluating an emacs-lisp source block.") - -(declare-function orgtbl-to-generic "org-table" (table params)) - -(defun org-babel-expand-body:emacs-lisp (body params) - "Expand BODY according to PARAMS, return the expanded body." - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) - (print-level nil) (print-length nil) - (body (if (> (length vars) 0) - (concat "(let (" - (mapconcat - (lambda (var) - (format "%S" (print `(,(car var) ',(cdr var))))) - vars "\n ") - ")\n" body "\n)") - (concat body "\n")))) - (if (or (member "code" result-params) - (member "pp" result-params)) - (concat "(pp " body ")") body))) - -(defun org-babel-execute:emacs-lisp (body params) - "Execute a block of emacs-lisp code with Babel." - (save-window-excursion - (let ((result - (eval (read (format (if (member "output" - (cdr (assoc :result-params params))) - "(with-output-to-string %s)" - "(progn %s)") - (org-babel-expand-body:emacs-lisp - body params)))))) - (org-babel-result-cond (cdr (assoc :result-params params)) - (let ((print-level nil) - (print-length nil)) - (if (or (member "scalar" (cdr (assoc :result-params params))) - (member "verbatim" (cdr (assoc :result-params params)))) - (format "%S" result) - (format "%s" result))) - (org-babel-reassemble-table - result - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params)))))))) - -(provide 'ob-emacs-lisp) - - - -;;; ob-emacs-lisp.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-eval.el b/xemacs-packages/lisp/org-8.2.3c/ob-eval.el deleted file mode 100644 index 85a8c4e3..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-eval.el +++ /dev/null @@ -1,143 +0,0 @@ -;;; ob-eval.el --- org-babel functions for external code evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research, comint -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; These functions build existing Emacs support for executing external -;; shell commands. - -;;; Code: -(require 'org-macs) -(eval-when-compile (require 'cl)) - -(defvar org-babel-error-buffer-name "*Org-Babel Error Output*") -(declare-function org-babel-temp-file "ob-core" (prefix &optional suffix)) - -(defun org-babel-eval-error-notify (exit-code stderr) - "Open a buffer to display STDERR and a message with the value of EXIT-CODE." - (let ((buf (get-buffer-create org-babel-error-buffer-name))) - (with-current-buffer buf - (goto-char (point-max)) - (save-excursion (insert stderr))) - (display-buffer buf)) - (message "Babel evaluation exited with code %S" exit-code)) - -(defun org-babel-eval (cmd body) - "Run CMD on BODY. -If CMD succeeds then return its results, otherwise display -STDERR with `org-babel-eval-error-notify'." - (let ((err-buff (get-buffer-create " *Org-Babel Error*")) exit-code) - (with-current-buffer err-buff (erase-buffer)) - (with-temp-buffer - (insert body) - (setq exit-code - (org-babel--shell-command-on-region - (point-min) (point-max) cmd err-buff)) - (if (or (not (numberp exit-code)) (> exit-code 0)) - (progn - (with-current-buffer err-buff - (org-babel-eval-error-notify exit-code (buffer-string))) - nil) - (buffer-string))))) - -(defun org-babel-eval-read-file (file) - "Return the contents of FILE as a string." - (with-temp-buffer (insert-file-contents file) - (buffer-string))) - -(defun org-babel--shell-command-on-region (start end command error-buffer) - "Execute COMMAND in an inferior shell with region as input. - -Stripped down version of shell-command-on-region for internal use -in Babel only. This lets us work around errors in the original -function in various versions of Emacs. -" - (let ((input-file (org-babel-temp-file "ob-input-")) - (error-file (if error-buffer (org-babel-temp-file "ob-error-") nil)) - ;; Unfortunately, `executable-find' does not support file name - ;; handlers. Therefore, we could use it in the local case - ;; only. - (shell-file-name - (cond ((and (not (file-remote-p default-directory)) - (executable-find shell-file-name)) - shell-file-name) - ((file-executable-p - (concat (file-remote-p default-directory) shell-file-name)) - shell-file-name) - ("/bin/sh"))) - exit-status) - ;; There is an error in `process-file' when `error-file' exists. - ;; This is fixed in Emacs trunk as of 2012-12-21; let's use this - ;; workaround for now. - (unless (file-remote-p default-directory) - (delete-file error-file)) - ;; we always call this with 'replace, remove conditional - ;; Replace specified region with output from command. - (let ((swap (< start end))) - (goto-char start) - (push-mark (point) 'nomsg) - (write-region start end input-file) - (delete-region start end) - (setq exit-status - (process-file shell-file-name input-file - (if error-file - (list t error-file) - t) - nil shell-command-switch command)) - (when swap (exchange-point-and-mark))) - - (when (and input-file (file-exists-p input-file) - ;; bind org-babel--debug-input around the call to keep - ;; the temporary input files available for inspection - (not (when (boundp 'org-babel--debug-input) - org-babel--debug-input))) - (delete-file input-file)) - - (when (and error-file (file-exists-p error-file)) - (if (< 0 (nth 7 (file-attributes error-file))) - (with-current-buffer (get-buffer-create error-buffer) - (let ((pos-from-end (- (point-max) (point)))) - (or (bobp) - (insert "\f\n")) - ;; Do no formatting while reading error file, - ;; because that can run a shell command, and we - ;; don't want that to cause an infinite recursion. - (format-insert-file error-file nil) - ;; Put point after the inserted errors. - (goto-char (- (point-max) pos-from-end))) - (current-buffer))) - (delete-file error-file)) - exit-status)) - -(defun org-babel-eval-wipe-error-buffer () - "Delete the contents of the Org code block error buffer. -This buffer is named by `org-babel-error-buffer-name'." - (when (get-buffer org-babel-error-buffer-name) - (with-current-buffer org-babel-error-buffer-name - (delete-region (point-min) (point-max))))) - -(provide 'ob-eval) - - - -;;; ob-eval.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-exp.el b/xemacs-packages/lisp/org-8.2.3c/ob-exp.el deleted file mode 100644 index d6d4566c..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-exp.el +++ /dev/null @@ -1,428 +0,0 @@ -;;; ob-exp.el --- Exportation of org-babel source blocks - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Authors: Eric Schulte -;; Dan Davison -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Code: -(require 'ob-core) -(eval-when-compile - (require 'cl)) - -(defvar org-current-export-file) -(defvar org-babel-lob-one-liner-regexp) -(defvar org-babel-ref-split-regexp) -(defvar org-list-forbidden-blocks) - -(declare-function org-babel-lob-get-info "ob-lob" ()) -(declare-function org-babel-eval-wipe-error-buffer "ob-eval" ()) -(declare-function org-between-regexps-p "org" - (start-re end-re &optional lim-up lim-down)) -(declare-function org-get-indentation "org" (&optional line)) -(declare-function org-heading-components "org" ()) -(declare-function org-in-block-p "org" (names)) -(declare-function org-in-verbatim-emphasis "org" ()) -(declare-function org-link-search "org" (s &optional type avoid-pos stealth)) -(declare-function org-fill-template "org" (template alist)) -(declare-function org-split-string "org" (string &optional separators)) -(declare-function org-element-at-point "org-element" (&optional keep-trail)) -(declare-function org-element-context "org-element" ()) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-type "org-element" (element)) -(declare-function org-escape-code-in-string "org-src" (s)) - -(defcustom org-export-babel-evaluate t - "Switch controlling code evaluation during export. -When set to nil no code will be evaluated as part of the export -process. When set to 'inline-only, only inline code blocks will -be executed." - :group 'org-babel - :version "24.1" - :type '(choice (const :tag "Never" nil) - (const :tag "Only inline code" inline-only) - (const :tag "Always" t))) -(put 'org-export-babel-evaluate 'safe-local-variable (lambda (x) (eq x nil))) - -(defun org-babel-exp-get-export-buffer () - "Return the current export buffer if possible." - (cond - ((bufferp org-current-export-file) org-current-export-file) - (org-current-export-file (get-file-buffer org-current-export-file)) - ('otherwise - (error "Requested export buffer when `org-current-export-file' is nil")))) - -(defvar org-link-search-inhibit-query) - -(defmacro org-babel-exp-in-export-file (lang &rest body) - (declare (indent 1)) - `(let* ((lang-headers (intern (concat "org-babel-default-header-args:" ,lang))) - (heading (nth 4 (ignore-errors (org-heading-components)))) - (export-buffer (current-buffer)) - (original-buffer (org-babel-exp-get-export-buffer)) results) - (when original-buffer - ;; resolve parameters in the original file so that - ;; headline and file-wide parameters are included, attempt - ;; to go to the same heading in the original file - (set-buffer original-buffer) - (save-restriction - (when heading - (condition-case nil - (let ((org-link-search-inhibit-query t)) - (org-link-search heading)) - (error (when heading - (goto-char (point-min)) - (re-search-forward (regexp-quote heading) nil t))))) - (setq results ,@body)) - (set-buffer export-buffer) - results))) -(def-edebug-spec org-babel-exp-in-export-file (form body)) - -(defun org-babel-exp-src-block (&rest headers) - "Process source block for export. -Depending on the 'export' headers argument, replace the source -code block like this: - -both ---- display the code and the results - -code ---- the default, display the code inside the block but do - not process - -results - just like none only the block is run on export ensuring - that it's results are present in the org-mode buffer - -none ---- do not display either code or results upon export - -Assume point is at the beginning of block's starting line." - (interactive) - (unless noninteractive (message "org-babel-exp processing...")) - (save-excursion - (let* ((info (org-babel-get-src-block-info 'light)) - (lang (nth 0 info)) - (raw-params (nth 2 info)) hash) - ;; bail if we couldn't get any info from the block - (when info - ;; if we're actually going to need the parameters - (when (member (cdr (assoc :exports (nth 2 info))) '("both" "results")) - (org-babel-exp-in-export-file lang - (setf (nth 2 info) - (org-babel-process-params - (apply #'org-babel-merge-params - org-babel-default-header-args - (if (boundp lang-headers) (eval lang-headers) nil) - (append (org-babel-params-from-properties lang) - (list raw-params)))))) - (setf hash (org-babel-sha1-hash info))) - (org-babel-exp-do-export info 'block hash))))) - -(defcustom org-babel-exp-call-line-template - "" - "Template used to export call lines. -This template may be customized to include the call line name -with any export markup. The template is filled out using -`org-fill-template', and the following %keys may be used. - - line --- call line - -An example value would be \"\\n: call: %line\" to export the call line -wrapped in a verbatim environment. - -Note: the results are inserted separately after the contents of -this template." - :group 'org-babel - :type 'string) - -(defvar org-babel-default-lob-header-args) -(defun org-babel-exp-non-block-elements (start end) - "Process inline source and call lines between START and END for export." - (interactive) - (save-excursion - (goto-char start) - (unless (markerp end) - (let ((m (make-marker))) - (set-marker m end (current-buffer)) - (setq end m))) - (let ((rx (concat "\\(?:" org-babel-inline-src-block-regexp - "\\|" org-babel-lob-one-liner-regexp "\\)"))) - (while (re-search-forward rx end t) - (save-excursion - (let* ((element (save-excursion - ;; If match is inline, point is at its - ;; end. Move backward so - ;; `org-element-context' can get the - ;; object, not the following one. - (backward-char) - (save-match-data (org-element-context)))) - (type (org-element-type element))) - (when (memq type '(babel-call inline-babel-call inline-src-block)) - (let ((beg-el (org-element-property :begin element)) - (end-el (org-element-property :end element))) - (case type - (inline-src-block - (let* ((info (org-babel-parse-inline-src-block-match)) - (params (nth 2 info))) - (setf (nth 1 info) - (if (and (cdr (assoc :noweb params)) - (string= "yes" (cdr (assoc :noweb params)))) - (org-babel-expand-noweb-references - info (org-babel-exp-get-export-buffer)) - (nth 1 info))) - (goto-char beg-el) - (let ((replacement (org-babel-exp-do-export info 'inline))) - (if (equal replacement "") - ;; Replacement code is empty: completely - ;; remove inline src block, including extra - ;; white space that might have been created - ;; when inserting results. - (delete-region beg-el - (progn (goto-char end-el) - (skip-chars-forward " \t") - (point))) - ;; Otherwise: remove inline src block but - ;; preserve following white spaces. Then - ;; insert value. - (delete-region beg-el - (progn (goto-char end-el) - (skip-chars-backward " \t") - (point))) - (insert replacement))))) - ((babel-call inline-babel-call) - (let* ((lob-info (org-babel-lob-get-info)) - (results - (org-babel-exp-do-export - (list "emacs-lisp" "results" - (apply #'org-babel-merge-params - org-babel-default-header-args - org-babel-default-lob-header-args - (append - (org-babel-params-from-properties) - (list - (org-babel-parse-header-arguments - (org-no-properties - (concat - ":var results=" - (mapconcat 'identity - (butlast lob-info 2) - " "))))))) - "" (nth 3 lob-info) (nth 2 lob-info)) - 'lob)) - (rep (org-fill-template - org-babel-exp-call-line-template - `(("line" . ,(nth 0 lob-info)))))) - ;; If replacement is empty, completely remove the - ;; object/element, including any extra white space - ;; that might have been created when including - ;; results. - (if (equal rep "") - (delete-region - beg-el - (progn (goto-char end-el) - (if (not (eq type 'babel-call)) - (progn (skip-chars-forward " \t") (point)) - (skip-chars-forward " \r\t\n") - (line-beginning-position)))) - ;; Otherwise, preserve following white - ;; spaces/newlines and then, insert replacement - ;; string. - (goto-char beg-el) - (delete-region beg-el - (progn (goto-char end-el) - (skip-chars-backward " \r\t\n") - (point))) - (insert rep))))))))))))) - -(defvar org-src-preserve-indentation) ; From org-src.el -(defun org-babel-exp-process-buffer () - "Execute all blocks in visible part of buffer." - (interactive) - (save-window-excursion - (let ((case-fold-search t) - (pos (point-min))) - (goto-char pos) - (while (re-search-forward "^[ \t]*#\\+BEGIN_SRC" nil t) - (let ((element (save-match-data (org-element-at-point)))) - (when (eq (org-element-type element) 'src-block) - (let* ((match-start (copy-marker (match-beginning 0))) - (begin (copy-marker (org-element-property :begin element))) - ;; Make sure we don't remove any blank lines after - ;; the block when replacing it. - (block-end (save-excursion - (goto-char (org-element-property :end element)) - (skip-chars-backward " \r\t\n") - (copy-marker (line-end-position)))) - (ind (org-get-indentation)) - (headers - (cons - (org-element-property :language element) - (let ((params (org-element-property :parameters element))) - (and params (org-split-string params "[ \t]+")))))) - ;; Execute all non-block elements between POS and - ;; current block. - (org-babel-exp-non-block-elements pos begin) - ;; Take care of matched block: compute replacement - ;; string. In particular, a nil REPLACEMENT means the - ;; block should be left as-is while an empty string - ;; should remove the block. - (let ((replacement (progn (goto-char match-start) - (org-babel-exp-src-block headers)))) - (cond ((not replacement) (goto-char block-end)) - ((equal replacement "") - (delete-region begin - (progn (goto-char block-end) - (skip-chars-forward " \r\t\n") - (if (eobp) (point) - (line-beginning-position))))) - (t - (goto-char match-start) - (delete-region (point) block-end) - (insert replacement) - (if (org-element-property :preserve-indent element) - ;; Indent only the code block markers. - (save-excursion (skip-chars-backward " \r\t\n") - (indent-line-to ind) - (goto-char match-start) - (indent-line-to ind)) - ;; Indent everything. - (indent-rigidly match-start (point) ind))))) - (setq pos (line-beginning-position)) - ;; Cleanup markers. - (set-marker match-start nil) - (set-marker begin nil) - (set-marker block-end nil))))) - ;; Eventually execute all non-block Babel elements between last - ;; src-block and end of buffer. - (org-babel-exp-non-block-elements pos (point-max))))) - -(defun org-babel-in-example-or-verbatim () - "Return true if point is in example or verbatim code. -Example and verbatim code include escaped portions of -an org-mode buffer code that should be treated as normal -org-mode text." - (or (save-match-data - (save-excursion - (goto-char (point-at-bol)) - (looking-at "[ \t]*:[ \t]"))) - (org-in-verbatim-emphasis) - (org-in-block-p org-list-forbidden-blocks) - (org-between-regexps-p "^[ \t]*#\\+begin_src" "^[ \t]*#\\+end_src"))) - -(defun org-babel-exp-do-export (info type &optional hash) - "Return a string with the exported content of a code block. -The function respects the value of the :exports header argument." - (let ((silently (lambda () (let ((session (cdr (assoc :session (nth 2 info))))) - (when (not (and session (equal "none" session))) - (org-babel-exp-results info type 'silent))))) - (clean (lambda () (unless (eq type 'inline) (org-babel-remove-result info))))) - (case (intern (or (cdr (assoc :exports (nth 2 info))) "code")) - ('none (funcall silently) (funcall clean) "") - ('code (funcall silently) (funcall clean) (org-babel-exp-code info)) - ('results (org-babel-exp-results info type nil hash) "") - ('both (org-babel-exp-results info type nil hash) - (org-babel-exp-code info))))) - -(defcustom org-babel-exp-code-template - "#+BEGIN_SRC %lang%flags\n%body\n#+END_SRC" - "Template used to export the body of code blocks. -This template may be customized to include additional information -such as the code block name, or the values of particular header -arguments. The template is filled out using `org-fill-template', -and the following %keys may be used. - - lang ------ the language of the code block - name ------ the name of the code block - body ------ the body of the code block - flags ----- the flags passed to the code block - -In addition to the keys mentioned above, every header argument -defined for the code block may be used as a key and will be -replaced with its value." - :group 'org-babel - :type 'string) - -(defun org-babel-exp-code (info) - "Return the original code block formatted for export." - (setf (nth 1 info) - (if (string= "strip-export" (cdr (assoc :noweb (nth 2 info)))) - (replace-regexp-in-string - (org-babel-noweb-wrap) "" (nth 1 info)) - (if (org-babel-noweb-p (nth 2 info) :export) - (org-babel-expand-noweb-references - info (org-babel-exp-get-export-buffer)) - (nth 1 info)))) - (org-fill-template - org-babel-exp-code-template - `(("lang" . ,(nth 0 info)) - ("body" . ,(org-escape-code-in-string (nth 1 info))) - ,@(mapcar (lambda (pair) - (cons (substring (symbol-name (car pair)) 1) - (format "%S" (cdr pair)))) - (nth 2 info)) - ("flags" . ,(let ((f (nth 3 info))) (when f (concat " " f)))) - ("name" . ,(or (nth 4 info) ""))))) - -(defun org-babel-exp-results (info type &optional silent hash) - "Evaluate and return the results of the current code block for export. -Results are prepared in a manner suitable for export by org-mode. -This function is called by `org-babel-exp-do-export'. The code -block will be evaluated. Optional argument SILENT can be used to -inhibit insertion of results into the buffer." - (when (and (or (eq org-export-babel-evaluate t) - (and (eq type 'inline) - (eq org-export-babel-evaluate 'inline-only))) - (not (and hash (equal hash (org-babel-current-result-hash))))) - (let ((lang (nth 0 info)) - (body (if (org-babel-noweb-p (nth 2 info) :eval) - (org-babel-expand-noweb-references - info (org-babel-exp-get-export-buffer)) - (nth 1 info))) - (info (copy-sequence info)) - (org-babel-current-src-block-location (point-marker))) - ;; skip code blocks which we can't evaluate - (when (fboundp (intern (concat "org-babel-execute:" lang))) - (org-babel-eval-wipe-error-buffer) - (prog1 nil - (setf (nth 1 info) body) - (setf (nth 2 info) - (org-babel-exp-in-export-file lang - (org-babel-process-params - (org-babel-merge-params - (nth 2 info) - `((:results . ,(if silent "silent" "replace"))))))) - (cond - ((equal type 'block) - (org-babel-execute-src-block nil info)) - ((equal type 'inline) - ;; position the point on the inline source block allowing - ;; `org-babel-insert-result' to check that the block is - ;; inline - (re-search-backward "[ \f\t\n\r\v]" nil t) - (re-search-forward org-babel-inline-src-block-regexp nil t) - (re-search-backward "src_" nil t) - (org-babel-execute-src-block nil info)) - ((equal type 'lob) - (save-excursion - (re-search-backward org-babel-lob-one-liner-regexp nil t) - (let (org-confirm-babel-evaluate) - (org-babel-execute-src-block nil info)))))))))) - - -(provide 'ob-exp) - -;;; ob-exp.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-fortran.el b/xemacs-packages/lisp/org-8.2.3c/ob-fortran.el deleted file mode 100644 index 61cb19a5..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-fortran.el +++ /dev/null @@ -1,168 +0,0 @@ -;;; ob-fortran.el --- org-babel functions for fortran - -;; Copyright (C) 2011-2013 Free Software Foundation, Inc. - -;; Authors: Sergey Litvinov -;; Eric Schulte -;; Keywords: literate programming, reproducible research, fortran -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating fortran code. - -;;; Code: -(require 'ob) -(require 'cc-mode) - -(declare-function org-entry-get "org" - (pom property &optional inherit literal-nil)) -(declare-function org-every "org" (pred seq)) - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("fortran" . "F90")) - -(defvar org-babel-default-header-args:fortran '()) - -(defvar org-babel-fortran-compiler "gfortran" - "fortran command used to compile a fortran source code file into an - executable.") - -(defun org-babel-execute:fortran (body params) - "This function should only be called by `org-babel-execute:fortran'" - (let* ((tmp-src-file (org-babel-temp-file "fortran-src-" ".F90")) - (tmp-bin-file (org-babel-temp-file "fortran-bin-" org-babel-exeext)) - (cmdline (cdr (assoc :cmdline params))) - (flags (cdr (assoc :flags params))) - (full-body (org-babel-expand-body:fortran body params)) - (compile - (progn - (with-temp-file tmp-src-file (insert full-body)) - (org-babel-eval - (format "%s -o %s %s %s" - org-babel-fortran-compiler - (org-babel-process-file-name tmp-bin-file) - (mapconcat 'identity - (if (listp flags) flags (list flags)) " ") - (org-babel-process-file-name tmp-src-file)) "")))) - (let ((results - (org-babel-trim - (org-babel-eval - (concat tmp-bin-file (if cmdline (concat " " cmdline) "")) "")))) - (org-babel-reassemble-table - (org-babel-result-cond (cdr (assoc :result-params params)) - (org-babel-read results) - (let ((tmp-file (org-babel-temp-file "f-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) - -(defun org-babel-expand-body:fortran (body params) - "Expand a block of fortran or fortran code with org-babel according to -it's header arguments." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (main-p (not (string= (cdr (assoc :main params)) "no"))) - (includes (or (cdr (assoc :includes params)) - (org-babel-read (org-entry-get nil "includes" t)))) - (defines (org-babel-read - (or (cdr (assoc :defines params)) - (org-babel-read (org-entry-get nil "defines" t)))))) - (mapconcat 'identity - (list - ;; includes - (mapconcat - (lambda (inc) (format "#include %s" inc)) - (if (listp includes) includes (list includes)) "\n") - ;; defines - (mapconcat - (lambda (inc) (format "#define %s" inc)) - (if (listp defines) defines (list defines)) "\n") - ;; body - (if main-p - (org-babel-fortran-ensure-main-wrap - (concat - ;; variables - (mapconcat 'org-babel-fortran-var-to-fortran vars "\n") - body) params) - body) "\n") "\n"))) - -(defun org-babel-fortran-ensure-main-wrap (body params) - "Wrap body in a \"program ... end program\" block if none exists." - (if (string-match "^[ \t]*program[ \t]*.*" (capitalize body)) - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) - (if vars (error "Cannot use :vars if 'program' statement is present")) - body) - (format "program main\n%s\nend program main\n" body))) - -(defun org-babel-prep-session:fortran (session params) - "This function does nothing as fortran is a compiled language with no -support for sessions" - (error "Fortran is a compiled languages -- no support for sessions")) - -(defun org-babel-load-session:fortran (session body params) - "This function does nothing as fortran is a compiled language with no -support for sessions" - (error "Fortran is a compiled languages -- no support for sessions")) - -;; helper functions - -(defun org-babel-fortran-var-to-fortran (pair) - "Convert an elisp val into a string of fortran code specifying a var -of the same value." - ;; TODO list support - (let ((var (car pair)) - (val (cdr pair))) - (when (symbolp val) - (setq val (symbol-name val)) - (when (= (length val) 1) - (setq val (string-to-char val)))) - (cond - ((integerp val) - (format "integer, parameter :: %S = %S\n" var val)) - ((floatp val) - (format "real, parameter :: %S = %S\n" var val)) - ((or (integerp val)) - (format "character, parameter :: %S = '%S'\n" var val)) - ((stringp val) - (format "character(len=%d), parameter :: %S = '%s'\n" - (length val) var val)) - ;; val is a matrix - ((and (listp val) (org-every #'listp val)) - (format "real, parameter :: %S(%d,%d) = transpose( reshape( %s , (/ %d, %d /) ) )\n" - var (length val) (length (car val)) - (org-babel-fortran-transform-list val) - (length (car val)) (length val))) - ((listp val) - (format "real, parameter :: %S(%d) = %s\n" - var (length val) (org-babel-fortran-transform-list val))) - (t - (error (format "the type of parameter %s is not supported by ob-fortran" - var)))))) - -(defun org-babel-fortran-transform-list (val) - "Return a fortran representation of enclose syntactic lists." - (if (listp val) - (concat "(/" (mapconcat #'org-babel-fortran-transform-list val ", ") "/)") - (format "%S" val))) - -(provide 'ob-fortran) - -;;; ob-fortran.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-gnuplot.el b/xemacs-packages/lisp/org-8.2.3c/ob-gnuplot.el deleted file mode 100644 index cc9186b1..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-gnuplot.el +++ /dev/null @@ -1,280 +0,0 @@ -;;; ob-gnuplot.el --- org-babel functions for gnuplot evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating gnuplot source code. -;; -;; This differs from most standard languages in that -;; -;; 1) we are generally only going to return results of type "file" -;; -;; 2) we are adding the "file" and "cmdline" header arguments - -;;; Requirements: - -;; - gnuplot :: http://www.gnuplot.info/ -;; -;; - gnuplot-mode :: http://cars9.uchicago.edu/~ravel/software/gnuplot-mode.html - -;;; Code: -(require 'ob) -(eval-when-compile (require 'cl)) - -(declare-function org-time-string-to-time "org" (s)) -(declare-function org-combine-plists "org" (&rest plists)) -(declare-function orgtbl-to-generic "org-table" (table params)) -(declare-function gnuplot-mode "ext:gnuplot-mode" ()) -(declare-function gnuplot-send-string-to-gnuplot "ext:gnuplot-mode" (str txt)) -(declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot-mode" ()) - -(defvar org-babel-default-header-args:gnuplot - '((:results . "file") (:exports . "results") (:session . nil)) - "Default arguments to use when evaluating a gnuplot source block.") - -(defvar org-babel-header-args:gnuplot - '((title . :any) - (lines . :any) - (sets . :any) - (x-labels . :any) - (y-labels . :any) - (timefmt . :any) - (time-ind . :any) - (missing . :any) - (term . :any)) - "Gnuplot specific header args.") - -(defvar org-babel-gnuplot-timestamp-fmt nil) - -(defvar *org-babel-gnuplot-missing* nil) - -(defcustom *org-babel-gnuplot-terms* - '((eps . "postscript eps")) - "List of file extensions and the associated gnuplot terminal." - :group 'org-babel - :type '(repeat (cons (symbol :tag "File extension") - (string :tag "Gnuplot terminal")))) - -(defun org-babel-gnuplot-process-vars (params) - "Extract variables from PARAMS and process the variables. -Dumps all vectors into files and returns an association list -of variable names and the related value to be used in the gnuplot -code." - (let ((*org-babel-gnuplot-missing* (cdr (assoc :missing params)))) - (mapcar - (lambda (pair) - (cons - (car pair) ;; variable name - (if (listp (cdr pair)) ;; variable value - (org-babel-gnuplot-table-to-data - (cdr pair) (org-babel-temp-file "gnuplot-") params) - (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var))))) - -(defun org-babel-expand-body:gnuplot (body params) - "Expand BODY according to PARAMS, return the expanded body." - (save-window-excursion - (let* ((vars (org-babel-gnuplot-process-vars params)) - (out-file (cdr (assoc :file params))) - (prologue (cdr (assoc :prologue params))) - (epilogue (cdr (assoc :epilogue params))) - (term (or (cdr (assoc :term params)) - (when out-file - (let ((ext (file-name-extension out-file))) - (or (cdr (assoc (intern (downcase ext)) - *org-babel-gnuplot-terms*)) - ext))))) - (cmdline (cdr (assoc :cmdline params))) - (title (cdr (assoc :title params))) - (lines (cdr (assoc :line params))) - (sets (cdr (assoc :set params))) - (x-labels (cdr (assoc :xlabels params))) - (y-labels (cdr (assoc :ylabels params))) - (timefmt (cdr (assoc :timefmt params))) - (time-ind (or (cdr (assoc :timeind params)) - (when timefmt 1))) - (missing (cdr (assoc :missing params))) - (add-to-body (lambda (text) (setq body (concat text "\n" body)))) - output) - ;; append header argument settings to body - (when title (funcall add-to-body (format "set title '%s'" title))) - (when lines (mapc (lambda (el) (funcall add-to-body el)) lines)) - (when missing - (funcall add-to-body (format "set datafile missing '%s'" missing))) - (when sets - (mapc (lambda (el) (funcall add-to-body (format "set %s" el))) sets)) - (when x-labels - (funcall add-to-body - (format "set xtics (%s)" - (mapconcat (lambda (pair) - (format "\"%s\" %d" - (cdr pair) (car pair))) - x-labels ", ")))) - (when y-labels - (funcall add-to-body - (format "set ytics (%s)" - (mapconcat (lambda (pair) - (format "\"%s\" %d" - (cdr pair) (car pair))) - y-labels ", ")))) - (when time-ind - (funcall add-to-body "set xdata time") - (funcall add-to-body (concat "set timefmt \"" - (or timefmt - "%Y-%m-%d-%H:%M:%S") "\""))) - (when out-file - ;; set the terminal at the top of the block - (funcall add-to-body (format "set output \"%s\"" out-file)) - ;; and close the terminal at the bottom of the block - (setq body (concat body "\nset output\n"))) - (when term (funcall add-to-body (format "set term %s" term))) - ;; insert variables into code body: this should happen last - ;; placing the variables at the *top* of the code in case their - ;; values are used later - (funcall add-to-body - (mapconcat #'identity - (org-babel-variable-assignments:gnuplot params) - "\n")) - ;; replace any variable names preceded by '$' with the actual - ;; value of the variable - (mapc (lambda (pair) - (setq body (replace-regexp-in-string - (format "\\$%s" (car pair)) (cdr pair) body))) - vars) - (when prologue (funcall add-to-body prologue)) - (when epilogue (setq body (concat body "\n" epilogue)))) - body)) - -(defun org-babel-execute:gnuplot (body params) - "Execute a block of Gnuplot code. -This function is called by `org-babel-execute-src-block'." - (require 'gnuplot) - (let ((session (cdr (assoc :session params))) - (result-type (cdr (assoc :results params))) - (out-file (cdr (assoc :file params))) - (body (org-babel-expand-body:gnuplot body params)) - output) - (save-window-excursion - ;; evaluate the code body with gnuplot - (if (string= session "none") - (let ((script-file (org-babel-temp-file "gnuplot-script-"))) - (with-temp-file script-file - (insert (concat body "\n"))) - (message "gnuplot \"%s\"" script-file) - (setq output - (shell-command-to-string - (format - "gnuplot \"%s\"" - (org-babel-process-file-name - script-file - (if (member system-type '(cygwin windows-nt ms-dos)) - t nil))))) - (message output)) - (with-temp-buffer - (insert (concat body "\n")) - (gnuplot-mode) - (gnuplot-send-buffer-to-gnuplot))) - (if (member "output" (split-string result-type)) - output - nil)))) ;; signal that output has already been written to file - -(defun org-babel-prep-session:gnuplot (session params) - "Prepare SESSION according to the header arguments in PARAMS." - (let* ((session (org-babel-gnuplot-initiate-session session)) - (var-lines (org-babel-variable-assignments:gnuplot params))) - (message "%S" session) - (org-babel-comint-in-buffer session - (mapc (lambda (var-line) - (insert var-line) (comint-send-input nil t) - (org-babel-comint-wait-for-output session) - (sit-for .1) (goto-char (point-max))) var-lines)) - session)) - -(defun org-babel-load-session:gnuplot (session body params) - "Load BODY into SESSION." - (save-window-excursion - (let ((buffer (org-babel-prep-session:gnuplot session params))) - (with-current-buffer buffer - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (insert (org-babel-chomp body))) - buffer))) - -(defun org-babel-variable-assignments:gnuplot (params) - "Return list of gnuplot statements assigning the block's variables." - (mapcar - (lambda (pair) (format "%s = \"%s\"" (car pair) (cdr pair))) - (org-babel-gnuplot-process-vars params))) - -(defvar gnuplot-buffer) -(defun org-babel-gnuplot-initiate-session (&optional session params) - "Initiate a gnuplot session. -If there is not a current inferior-process-buffer in SESSION -then create one. Return the initialized session. The current -`gnuplot-mode' doesn't provide support for multiple sessions." - (require 'gnuplot) - (unless (string= session "none") - (save-window-excursion - (gnuplot-send-string-to-gnuplot "" "line") - gnuplot-buffer))) - -(defun org-babel-gnuplot-quote-timestamp-field (s) - "Convert S from timestamp to Unix time and export to gnuplot." - (format-time-string org-babel-gnuplot-timestamp-fmt - (org-time-string-to-time s))) - -(defvar org-table-number-regexp) -(defvar org-ts-regexp3) -(defun org-babel-gnuplot-quote-tsv-field (s) - "Quote S for export to gnuplot." - (unless (stringp s) - (setq s (format "%s" s))) - (if (string-match org-table-number-regexp s) s - (if (string-match org-ts-regexp3 s) - (org-babel-gnuplot-quote-timestamp-field s) - (if (zerop (length s)) - (or *org-babel-gnuplot-missing* s) - (if (string-match "[ \"]" "?") - (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") - "\"") - s))))) - -(defun org-babel-gnuplot-table-to-data (table data-file params) - "Export TABLE to DATA-FILE in a format readable by gnuplot. -Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." - (with-temp-file data-file - (make-local-variable 'org-babel-gnuplot-timestamp-fmt) - (setq org-babel-gnuplot-timestamp-fmt (or - (plist-get params :timefmt) - "%Y-%m-%d-%H:%M:%S")) - (insert (orgtbl-to-generic - table - (org-combine-plists - '(:sep "\t" :fmt org-babel-gnuplot-quote-tsv-field) - params)))) - data-file) - -(provide 'ob-gnuplot) - - - -;;; ob-gnuplot.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-haskell.el b/xemacs-packages/lisp/org-8.2.3c/ob-haskell.el deleted file mode 100644 index 6c9fed14..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-haskell.el +++ /dev/null @@ -1,226 +0,0 @@ -;;; ob-haskell.el --- org-babel functions for haskell evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating haskell source code. This one will -;; be sort of tricky because haskell programs must be compiled before -;; they can be run, but haskell code can also be run through an -;; interactive interpreter. -;; -;; For now lets only allow evaluation using the haskell interpreter. - -;;; Requirements: - -;; - haskell-mode :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode -;; -;; - inf-haskell :: http://www.iro.umontreal.ca/~monnier/elisp/#haskell-mode -;; -;; - (optionally) lhs2tex :: http://people.cs.uu.nl/andres/lhs2tex/ - -;;; Code: -(require 'ob) -(require 'comint) -(eval-when-compile (require 'cl)) - -(declare-function org-remove-indentation "org" (code &optional n)) -(declare-function haskell-mode "ext:haskell-mode" ()) -(declare-function run-haskell "ext:inf-haskell" (&optional arg)) -(declare-function inferior-haskell-load-file - "ext:inf-haskell" (&optional reload)) - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("haskell" . "hs")) - -(defvar org-babel-default-header-args:haskell - '((:padlines . "no"))) - -(defvar org-babel-haskell-lhs2tex-command "lhs2tex") - -(defvar org-babel-haskell-eoe "\"org-babel-haskell-eoe\"") - -(defun org-babel-execute:haskell (body params) - "Execute a block of Haskell code." - (let* ((session (cdr (assoc :session params))) - (vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-type (cdr (assoc :result-type params))) - (full-body (org-babel-expand-body:generic - body params - (org-babel-variable-assignments:haskell params))) - (session (org-babel-haskell-initiate-session session params)) - (raw (org-babel-comint-with-output - (session org-babel-haskell-eoe t full-body) - (insert (org-babel-trim full-body)) - (comint-send-input nil t) - (insert org-babel-haskell-eoe) - (comint-send-input nil t))) - (results (mapcar - #'org-babel-haskell-read-string - (cdr (member org-babel-haskell-eoe - (reverse (mapcar #'org-babel-trim raw))))))) - (org-babel-reassemble-table - (let ((result - (case result-type - (output (mapconcat #'identity (reverse (cdr results)) "\n")) - (value (car results))))) - (org-babel-result-cond (cdr (assoc :result-params params)) - result (org-babel-haskell-table-or-string result))) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colname-names params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rowname-names params)))))) - -(defun org-babel-haskell-read-string (string) - "Strip \\\"s from around a haskell string." - (if (string-match "^\"\\([^\000]+\\)\"$" string) - (match-string 1 string) - string)) - -(defun org-babel-haskell-initiate-session (&optional session params) - "Initiate a haskell session. -If there is not a current inferior-process-buffer in SESSION -then create one. Return the initialized session." - (require 'inf-haskell) - (or (get-buffer "*haskell*") - (save-window-excursion (run-haskell) (sleep-for 0.25) (current-buffer)))) - -(defun org-babel-load-session:haskell (session body params) - "Load BODY into SESSION." - (save-window-excursion - (let* ((buffer (org-babel-prep-session:haskell session params)) - (load-file (concat (org-babel-temp-file "haskell-load-") ".hs"))) - (with-temp-buffer - (insert body) (write-file load-file) - (haskell-mode) (inferior-haskell-load-file)) - buffer))) - -(defun org-babel-prep-session:haskell (session params) - "Prepare SESSION according to the header arguments in PARAMS." - (save-window-excursion - (let ((buffer (org-babel-haskell-initiate-session session))) - (org-babel-comint-in-buffer buffer - (mapc (lambda (line) - (insert line) - (comint-send-input nil t)) - (org-babel-variable-assignments:haskell params))) - (current-buffer)))) - -(defun org-babel-variable-assignments:haskell (params) - "Return list of haskell statements assigning the block's variables." - (mapcar (lambda (pair) - (format "let %s = %s" - (car pair) - (org-babel-haskell-var-to-haskell (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) - -(defun org-babel-haskell-table-or-string (results) - "Convert RESULTS to an Emacs-lisp table or string. -If RESULTS look like a table, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape results)) - -(defun org-babel-haskell-var-to-haskell (var) - "Convert an elisp value VAR into a haskell variable. -The elisp VAR is converted to a string of haskell source code -specifying a variable of the same value." - (if (listp var) - (concat "[" (mapconcat #'org-babel-haskell-var-to-haskell var ", ") "]") - (format "%S" var))) - -(defvar org-src-preserve-indentation) -(defvar org-export-copy-to-kill-ring) -(declare-function org-export-to-file "ox" - (backend file - &optional async subtreep visible-only body-only ext-plist)) -(defun org-babel-haskell-export-to-lhs (&optional arg) - "Export to a .lhs file with all haskell code blocks escaped. -When called with a prefix argument the resulting -.lhs file will be exported to a .tex file. This function will -create two new files, base-name.lhs and base-name.tex where -base-name is the name of the current org-mode file. - -Note that all standard Babel literate programming -constructs (header arguments, no-web syntax etc...) are ignored." - (interactive "P") - (let* ((contents (buffer-string)) - (haskell-regexp - (concat "^\\([ \t]*\\)#\\+begin_src[ \t]haskell*\\(.*\\)?[\r\n]" - "\\([^\000]*?\\)[\r\n][ \t]*#\\+end_src.*")) - (base-name (file-name-sans-extension (buffer-file-name))) - (tmp-file (org-babel-temp-file "haskell-")) - (tmp-org-file (concat tmp-file ".org")) - (tmp-tex-file (concat tmp-file ".tex")) - (lhs-file (concat base-name ".lhs")) - (tex-file (concat base-name ".tex")) - (command (concat org-babel-haskell-lhs2tex-command - " " (org-babel-process-file-name lhs-file) - " > " (org-babel-process-file-name tex-file))) - (preserve-indentp org-src-preserve-indentation) - indentation) - ;; escape haskell source-code blocks - (with-temp-file tmp-org-file - (insert contents) - (goto-char (point-min)) - (while (re-search-forward haskell-regexp nil t) - (save-match-data (setq indentation (length (match-string 1)))) - (replace-match (save-match-data - (concat - "#+begin_latex\n\\begin{code}\n" - (if (or preserve-indentp - (string-match "-i" (match-string 2))) - (match-string 3) - (org-remove-indentation (match-string 3))) - "\n\\end{code}\n#+end_latex\n")) - t t) - (indent-code-rigidly (match-beginning 0) (match-end 0) indentation))) - (save-excursion - ;; export to latex w/org and save as .lhs - (require 'ox-latex) - (find-file tmp-org-file) - ;; Ensure we do not clutter kill ring with incomplete results. - (let (org-export-copy-to-kill-ring) - (org-export-to-file 'latex tmp-tex-file)) - (kill-buffer nil) - (delete-file tmp-org-file) - (find-file tmp-tex-file) - (goto-char (point-min)) (forward-line 2) - (insert "%include polycode.fmt\n") - ;; ensure all \begin/end{code} statements start at the first column - (while (re-search-forward "^[ \t]+\\\\begin{code}[^\000]+\\\\end{code}" nil t) - (replace-match (save-match-data (org-remove-indentation (match-string 0))) - t t)) - (setq contents (buffer-string)) - (save-buffer) (kill-buffer nil)) - (delete-file tmp-tex-file) - ;; save org exported latex to a .lhs file - (with-temp-file lhs-file (insert contents)) - (if (not arg) - (find-file lhs-file) - ;; process .lhs file with lhs2tex - (message "running %s" command) (shell-command command) (find-file tex-file)))) - -(provide 'ob-haskell) - - - -;;; ob-haskell.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-io.el b/xemacs-packages/lisp/org-8.2.3c/ob-io.el deleted file mode 100644 index 5368ff51..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-io.el +++ /dev/null @@ -1,118 +0,0 @@ -;;; ob-io.el --- org-babel functions for Io evaluation - -;; Copyright (C) 2012-2013 Free Software Foundation, Inc. - -;; Author: Andrzej Lichnerowicz -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: -;; Currently only supports the external execution. No session support yet. -;; :results output -- runs in scripting mode -;; :results output repl -- runs in repl mode - -;;; Requirements: -;; - Io language :: http://iolanguage.org/ -;; - Io major mode :: Can be installed from Io sources -;; https://github.com/stevedekorte/io/blob/master/extras/SyntaxHighlighters/Emacs/io-mode.el - -;;; Code: -(require 'ob) -(eval-when-compile (require 'cl)) - -(defvar org-babel-tangle-lang-exts) ;; Autoloaded -(add-to-list 'org-babel-tangle-lang-exts '("io" . "io")) -(defvar org-babel-default-header-args:io '()) -(defvar org-babel-io-command "io" - "Name of the command to use for executing Io code.") - -(defun org-babel-execute:io (body params) - "Execute a block of Io code with org-babel. This function is -called by `org-babel-execute-src-block'" - (message "executing Io source code block") - (let* ((processed-params (org-babel-process-params params)) - (session (org-babel-io-initiate-session (nth 0 processed-params))) - (vars (nth 1 processed-params)) - (result-params (nth 2 processed-params)) - (result-type (cdr (assoc :result-type params))) - (full-body (org-babel-expand-body:generic - body params)) - (result (org-babel-io-evaluate - session full-body result-type result-params))) - - (org-babel-reassemble-table - result - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) - - -(defun org-babel-io-table-or-string (results) - "Convert RESULTS into an appropriate elisp value. -If RESULTS look like a table, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape results)) - - -(defvar org-babel-io-wrapper-method - "( -%s -) asString print -") - - -(defun org-babel-io-evaluate (session body &optional result-type result-params) - "Evaluate BODY in external Io process. -If RESULT-TYPE equals 'output then return standard output as a string. -If RESULT-TYPE equals 'value then return the value of the last statement -in BODY as elisp." - (when session (error "Sessions are not (yet) supported for Io")) - (case result-type - (output - (if (member "repl" result-params) - (org-babel-eval org-babel-io-command body) - (let ((src-file (org-babel-temp-file "io-"))) - (progn (with-temp-file src-file (insert body)) - (org-babel-eval - (concat org-babel-io-command " " src-file) ""))))) - (value (let* ((src-file (org-babel-temp-file "io-")) - (wrapper (format org-babel-io-wrapper-method body))) - (with-temp-file src-file (insert wrapper)) - (let ((raw (org-babel-eval - (concat org-babel-io-command " " src-file) ""))) - (org-babel-result-cond result-params - raw - (org-babel-io-table-or-string raw))))))) - - -(defun org-babel-prep-session:io (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - (error "Sessions are not (yet) supported for Io")) - -(defun org-babel-io-initiate-session (&optional session) - "If there is not a current inferior-process-buffer in SESSION -then create. Return the initialized session. Sessions are not -supported in Io." - nil) - -(provide 'ob-io) - - - -;;; ob-io.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-java.el b/xemacs-packages/lisp/org-8.2.3c/ob-java.el deleted file mode 100644 index 37ac8dae..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-java.el +++ /dev/null @@ -1,75 +0,0 @@ -;;; ob-java.el --- org-babel functions for java evaluation - -;; Copyright (C) 2011-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Currently this only supports the external compilation and execution -;; of java code blocks (i.e., no session support). - -;;; Code: -(require 'ob) - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("java" . "java")) - -(defvar org-babel-java-command "java" - "Name of the java command.") - -(defvar org-babel-java-compiler "javac" - "Name of the java compiler.") - -(defun org-babel-execute:java (body params) - (let* ((classname (or (cdr (assoc :classname params)) - (error - "Can't compile a java block without a classname"))) - (packagename (file-name-directory classname)) - (src-file (concat classname ".java")) - (cmpflag (or (cdr (assoc :cmpflag params)) "")) - (cmdline (or (cdr (assoc :cmdline params)) "")) - (full-body (org-babel-expand-body:generic body params)) - (compile - (progn (with-temp-file src-file (insert full-body)) - (org-babel-eval - (concat org-babel-java-compiler - " " cmpflag " " src-file) "")))) - ;; created package-name directories if missing - (unless (or (not packagename) (file-exists-p packagename)) - (make-directory packagename 'parents)) - (let ((results (org-babel-eval (concat org-babel-java-command - " " cmdline " " classname) ""))) - (org-babel-reassemble-table - (org-babel-result-cond (cdr (assoc :result-params params)) - (org-babel-read results) - (let ((tmp-file (org-babel-temp-file "c-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) - -(provide 'ob-java) - - - -;;; ob-java.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-js.el b/xemacs-packages/lisp/org-8.2.3c/ob-js.el deleted file mode 100644 index 78914bc2..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-js.el +++ /dev/null @@ -1,162 +0,0 @@ -;;; ob-js.el --- org-babel functions for Javascript - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research, js -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Now working with SBCL for both session and external evaluation. -;; -;; This certainly isn't optimally robust, but it seems to be working -;; for the basic use cases. - -;;; Requirements: - -;; - a non-browser javascript engine such as node.js http://nodejs.org/ -;; or mozrepl http://wiki.github.com/bard/mozrepl/ -;; -;; - for session based evaluation mozrepl and moz.el are required see -;; http://wiki.github.com/bard/mozrepl/emacs-integration for -;; configuration instructions - -;;; Code: -(require 'ob) -(eval-when-compile (require 'cl)) - -(declare-function run-mozilla "ext:moz" (arg)) - -(defvar org-babel-default-header-args:js '() - "Default header arguments for js code blocks.") - -(defvar org-babel-js-eoe "org-babel-js-eoe" - "String to indicate that evaluation has completed.") - -(defcustom org-babel-js-cmd "node" - "Name of command used to evaluate js blocks." - :group 'org-babel - :version "24.1" - :type 'string) - -(defvar org-babel-js-function-wrapper - "require('sys').print(require('sys').inspect(function(){%s}()));" - "Javascript code to print value of body.") - -(defun org-babel-execute:js (body params) - "Execute a block of Javascript code with org-babel. -This function is called by `org-babel-execute-src-block'" - (let* ((org-babel-js-cmd (or (cdr (assoc :cmd params)) org-babel-js-cmd)) - (result-type (cdr (assoc :result-type params))) - (full-body (org-babel-expand-body:generic - body params (org-babel-variable-assignments:js params))) - (result (if (not (string= (cdr (assoc :session params)) "none")) - ;; session evaluation - (let ((session (org-babel-prep-session:js - (cdr (assoc :session params)) params))) - (nth 1 - (org-babel-comint-with-output - (session (format "%S" org-babel-js-eoe) t body) - (mapc - (lambda (line) - (insert (org-babel-chomp line)) - (comint-send-input nil t)) - (list body (format "%S" org-babel-js-eoe)))))) - ;; external evaluation - (let ((script-file (org-babel-temp-file "js-script-"))) - (with-temp-file script-file - (insert - ;; return the value or the output - (if (string= result-type "value") - (format org-babel-js-function-wrapper full-body) - full-body))) - (org-babel-eval - (format "%s %s" org-babel-js-cmd - (org-babel-process-file-name script-file)) ""))))) - (org-babel-result-cond (cdr (assoc :result-params params)) - result (org-babel-js-read result)))) - -(defun org-babel-js-read (results) - "Convert RESULTS into an appropriate elisp value. -If RESULTS look like a table, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (org-babel-read - (if (and (stringp results) (string-match "^\\[.+\\]$" results)) - (org-babel-read - (concat "'" - (replace-regexp-in-string - "\\[" "(" (replace-regexp-in-string - "\\]" ")" (replace-regexp-in-string - ", " " " (replace-regexp-in-string - "'" "\"" results)))))) - results))) - -(defun org-babel-js-var-to-js (var) - "Convert VAR into a js variable. -Convert an elisp value into a string of js source code -specifying a variable of the same value." - (if (listp var) - (concat "[" (mapconcat #'org-babel-js-var-to-js var ", ") "]") - (format "%S" var))) - -(defun org-babel-prep-session:js (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - (let* ((session (org-babel-js-initiate-session session)) - (var-lines (org-babel-variable-assignments:js params))) - (when session - (org-babel-comint-in-buffer session - (sit-for .5) (goto-char (point-max)) - (mapc (lambda (var) - (insert var) (comint-send-input nil t) - (org-babel-comint-wait-for-output session) - (sit-for .1) (goto-char (point-max))) var-lines))) - session)) - -(defun org-babel-variable-assignments:js (params) - "Return list of Javascript statements assigning the block's variables." - (mapcar - (lambda (pair) (format "var %s=%s;" - (car pair) (org-babel-js-var-to-js (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) - -(defun org-babel-js-initiate-session (&optional session) - "If there is not a current inferior-process-buffer in SESSION -then create. Return the initialized session." - (unless (string= session "none") - (cond - ((string= "mozrepl" org-babel-js-cmd) - (require 'moz) - (let ((session-buffer (save-window-excursion - (run-mozilla nil) - (rename-buffer session) - (current-buffer)))) - (if (org-babel-comint-buffer-livep session-buffer) - (progn (sit-for .25) session-buffer) - (sit-for .5) - (org-babel-js-initiate-session session)))) - ((string= "node" org-babel-js-cmd ) - (error "Session evaluation with node.js is not supported")) - (t - (error "Sessions are only supported with mozrepl add \":cmd mozrepl\""))))) - -(provide 'ob-js) - - - -;;; ob-js.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-keys.el b/xemacs-packages/lisp/org-8.2.3c/ob-keys.el deleted file mode 100644 index 6cc7387e..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-keys.el +++ /dev/null @@ -1,105 +0,0 @@ -;;; ob-keys.el --- key bindings for org-babel - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Add org-babel keybindings to the org-mode keymap for exposing -;; org-babel functions. These will all share a common prefix. See -;; the value of `org-babel-key-bindings' for a list of interactive -;; functions and their associated keys. - -;;; Code: -(require 'ob-core) - -(defvar org-babel-key-prefix "\C-c\C-v" - "The key prefix for Babel interactive key-bindings. -See `org-babel-key-bindings' for the list of interactive babel -functions which are assigned key bindings, and see -`org-babel-map' for the actual babel keymap.") - -(defvar org-babel-map (make-sparse-keymap) - "The keymap for interactive Babel functions.") - -;;;###autoload -(defun org-babel-describe-bindings () - "Describe all keybindings behind `org-babel-key-prefix'." - (interactive) - (describe-bindings org-babel-key-prefix)) - -(defvar org-babel-key-bindings - '(("p" . org-babel-previous-src-block) - ("\C-p" . org-babel-previous-src-block) - ("n" . org-babel-next-src-block) - ("\C-n" . org-babel-next-src-block) - ("e" . org-babel-execute-maybe) - ("\C-e" . org-babel-execute-maybe) - ("o" . org-babel-open-src-block-result) - ("\C-o" . org-babel-open-src-block-result) - ("\C-v" . org-babel-expand-src-block) - ("v" . org-babel-expand-src-block) - ("u" . org-babel-goto-src-block-head) - ("\C-u" . org-babel-goto-src-block-head) - ("g" . org-babel-goto-named-src-block) - ("r" . org-babel-goto-named-result) - ("\C-r" . org-babel-goto-named-result) - ("\C-b" . org-babel-execute-buffer) - ("b" . org-babel-execute-buffer) - ("\C-s" . org-babel-execute-subtree) - ("s" . org-babel-execute-subtree) - ("\C-d" . org-babel-demarcate-block) - ("d" . org-babel-demarcate-block) - ("\C-t" . org-babel-tangle) - ("t" . org-babel-tangle) - ("\C-f" . org-babel-tangle-file) - ("f" . org-babel-tangle-file) - ("\C-c" . org-babel-check-src-block) - ("c" . org-babel-check-src-block) - ("\C-j" . org-babel-insert-header-arg) - ("j" . org-babel-insert-header-arg) - ("\C-l" . org-babel-load-in-session) - ("l" . org-babel-load-in-session) - ("\C-i" . org-babel-lob-ingest) - ("i" . org-babel-lob-ingest) - ("\C-I" . org-babel-view-src-block-info) - ("I" . org-babel-view-src-block-info) - ("\C-z" . org-babel-switch-to-session) - ("z" . org-babel-switch-to-session-with-code) - ("\C-a" . org-babel-sha1-hash) - ("a" . org-babel-sha1-hash) - ("h" . org-babel-describe-bindings) - ("\C-x" . org-babel-do-key-sequence-in-edit-buffer) - ("x" . org-babel-do-key-sequence-in-edit-buffer) - ("\C-\M-h" . org-babel-mark-block)) - "Alist of key bindings and interactive Babel functions. -This list associates interactive Babel functions -with keys. Each element of this list will add an entry to the -`org-babel-map' using the letter key which is the `car' of the -a-list placed behind the generic `org-babel-key-prefix'.") - -(provide 'ob-keys) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ob-keys.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-latex.el b/xemacs-packages/lisp/org-8.2.3c/ob-latex.el deleted file mode 100644 index 85918e60..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-latex.el +++ /dev/null @@ -1,200 +0,0 @@ -;;; ob-latex.el --- org-babel functions for latex "evaluation" - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating LaTeX source code. -;; -;; Currently on evaluation this returns raw LaTeX code, unless a :file -;; header argument is given in which case small png or pdf files will -;; be created directly form the latex source code. - -;;; Code: -(require 'ob) - -(declare-function org-create-formula-image "org" (string tofile options buffer)) -(declare-function org-splice-latex-header "org" - (tpl def-pkg pkg snippets-p &optional extra)) -(declare-function org-latex-guess-inputenc "ox-latex" (header)) -(declare-function org-latex-compile "ox-latex" (file)) - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("latex" . "tex")) - -(defvar org-format-latex-header) ; From org.el -(defvar org-format-latex-options) ; From org.el -(defvar org-latex-default-packages-alist) ; From org.el -(defvar org-latex-packages-alist) ; From org.el - -(defvar org-babel-default-header-args:latex - '((:results . "latex") (:exports . "results")) - "Default arguments to use when evaluating a LaTeX source block.") - -(defcustom org-babel-latex-htlatex "" - "The htlatex command to enable conversion of latex to SVG or HTML." - :group 'org-babel - :type 'string) - -(defcustom org-babel-latex-htlatex-packages - '("[usenames]{color}" "{tikz}" "{color}" "{listings}" "{amsmath}") - "Packages to use for htlatex export." - :group 'org-babel - :type '(list (string))) - -(defun org-babel-expand-body:latex (body params) - "Expand BODY according to PARAMS, return the expanded body." - (mapc (lambda (pair) ;; replace variables - (setq body - (replace-regexp-in-string - (regexp-quote (format "%S" (car pair))) - (if (stringp (cdr pair)) - (cdr pair) (format "%S" (cdr pair))) - body))) (mapcar #'cdr (org-babel-get-header params :var))) - (org-babel-trim body)) - -(defun org-babel-execute:latex (body params) - "Execute a block of Latex code with Babel. -This function is called by `org-babel-execute-src-block'." - (setq body (org-babel-expand-body:latex body params)) - (if (cdr (assoc :file params)) - (let* ((out-file (cdr (assoc :file params))) - (tex-file (org-babel-temp-file "latex-" ".tex")) - (border (cdr (assoc :border params))) - (imagemagick (cdr (assoc :imagemagick params))) - (im-in-options (cdr (assoc :iminoptions params))) - (im-out-options (cdr (assoc :imoutoptions params))) - (pdfpng (cdr (assoc :pdfpng params))) - (fit (or (cdr (assoc :fit params)) border)) - (height (and fit (cdr (assoc :pdfheight params)))) - (width (and fit (cdr (assoc :pdfwidth params)))) - (headers (cdr (assoc :headers params))) - (in-buffer (not (string= "no" (cdr (assoc :buffer params))))) - (org-latex-packages-alist - (append (cdr (assoc :packages params)) org-latex-packages-alist))) - (cond - ((and (string-match "\\.png$" out-file) (not imagemagick)) - (org-create-formula-image - body out-file org-format-latex-options in-buffer)) - ((string-match "\\.tikz$" out-file) - (when (file-exists-p out-file) (delete-file out-file)) - (with-temp-file out-file - (insert body))) - ((or (string-match "\\.pdf$" out-file) imagemagick) - (with-temp-file tex-file - (require 'ox-latex) - (insert - (org-latex-guess-inputenc - (org-splice-latex-header - org-format-latex-header - (delq - nil - (mapcar - (lambda (el) - (unless (and (listp el) (string= "hyperref" (cadr el))) - el)) - org-latex-default-packages-alist)) - org-latex-packages-alist - nil)) - (if fit "\n\\usepackage[active, tightpage]{preview}\n" "") - (if border (format "\\setlength{\\PreviewBorder}{%s}" border) "") - (if height (concat "\n" (format "\\pdfpageheight %s" height)) "") - (if width (concat "\n" (format "\\pdfpagewidth %s" width)) "") - (if headers - (concat "\n" - (if (listp headers) - (mapconcat #'identity headers "\n") - headers) "\n") - "") - (if fit - (concat "\n\\begin{document}\n\\begin{preview}\n" body - "\n\\end{preview}\n\\end{document}\n") - (concat "\n\\begin{document}\n" body "\n\\end{document}\n")))) - (when (file-exists-p out-file) (delete-file out-file)) - (let ((transient-pdf-file (org-babel-latex-tex-to-pdf tex-file))) - (cond - ((string-match "\\.pdf$" out-file) - (rename-file transient-pdf-file out-file)) - (imagemagick - (convert-pdf - transient-pdf-file out-file im-in-options im-out-options) - (when (file-exists-p transient-pdf-file) - (delete-file transient-pdf-file)))))) - ((and (or (string-match "\\.svg$" out-file) - (string-match "\\.html$" out-file)) - (not (string= "" org-babel-latex-htlatex))) - (with-temp-file tex-file - (insert (concat - "\\documentclass[preview]{standalone} -\\def\\pgfsysdriver{pgfsys-tex4ht.def} -" - (mapconcat (lambda (pkg) - (concat "\\usepackage" pkg)) - org-babel-latex-htlatex-packages - "\n") - "\\begin{document}" - body - "\\end{document}"))) - (when (file-exists-p out-file) (delete-file out-file)) - (let ((default-directory (file-name-directory tex-file))) - (shell-command (format "%s %s" org-babel-latex-htlatex tex-file))) - (cond - ((file-exists-p (concat (file-name-sans-extension tex-file) "-1.svg")) - (if (string-match "\\.svg$" out-file) - (progn - (shell-command "pwd") - (shell-command (format "mv %s %s" - (concat (file-name-sans-extension tex-file) "-1.svg") - out-file))) - (error "SVG file produced but HTML file requested."))) - ((file-exists-p (concat (file-name-sans-extension tex-file) ".html")) - (if (string-match "\\.html$" out-file) - (shell-command "mv %s %s" - (concat (file-name-sans-extension tex-file) - ".html") - out-file) - (error "HTML file produced but SVG file requested."))))) - ((string-match "\\.\\([^\\.]+\\)$" out-file) - (error "Can not create %s files, please specify a .png or .pdf file or try the :imagemagick header argument" - (match-string 1 out-file)))) - nil) ;; signal that output has already been written to file - body)) - -(defun convert-pdf (pdffile out-file im-in-options im-out-options) - "Generate a file from a pdf file using imagemagick." - (let ((cmd (concat "convert " im-in-options " " pdffile " " - im-out-options " " out-file))) - (message (concat "Converting pdffile file " cmd "...")) - (shell-command cmd))) - -(defun org-babel-latex-tex-to-pdf (file) - "Generate a pdf file according to the contents FILE." - (require 'ox-latex) - (org-latex-compile file)) - -(defun org-babel-prep-session:latex (session params) - "Return an error because LaTeX doesn't support sessions." - (error "LaTeX does not support sessions")) - - -(provide 'ob-latex) -;;; ob-latex.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-ledger.el b/xemacs-packages/lisp/org-8.2.3c/ob-ledger.el deleted file mode 100644 index 17911cc7..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-ledger.el +++ /dev/null @@ -1,71 +0,0 @@ -;;; ob-ledger.el --- org-babel functions for ledger evaluation - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Eric S Fraga -;; Keywords: literate programming, reproducible research, accounting -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating ledger entries. -;; -;; This differs from most standard languages in that -;; -;; 1) there is no such thing as a "session" in ledger -;; -;; 2) we are generally only going to return output from the ledger program -;; -;; 3) we are adding the "cmdline" header argument -;; -;; 4) there are no variables - -;;; Code: -(require 'ob) - -(defvar org-babel-default-header-args:ledger - '((:results . "output") (:cmdline . "bal")) - "Default arguments to use when evaluating a ledger source block.") - -(defun org-babel-execute:ledger (body params) - "Execute a block of Ledger entries with org-babel. This function is -called by `org-babel-execute-src-block'." - (message "executing Ledger source code block") - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (cmdline (cdr (assoc :cmdline params))) - (in-file (org-babel-temp-file "ledger-")) - (out-file (org-babel-temp-file "ledger-output-"))) - (with-temp-file in-file (insert body)) - (message "%s" (concat "ledger" - " -f " (org-babel-process-file-name in-file) - " " cmdline)) - (with-output-to-string - (shell-command (concat "ledger" - " -f " (org-babel-process-file-name in-file) - " " cmdline - " > " (org-babel-process-file-name out-file)))) - (with-temp-buffer (insert-file-contents out-file) (buffer-string)))) - -(defun org-babel-prep-session:ledger (session params) - (error "Ledger does not support sessions")) - -(provide 'ob-ledger) - - - -;;; ob-ledger.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-lilypond.el b/xemacs-packages/lisp/org-8.2.3c/ob-lilypond.el deleted file mode 100644 index a58a443d..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-lilypond.el +++ /dev/null @@ -1,436 +0,0 @@ -;;; ob-lilypond.el --- org-babel functions for lilypond evaluation - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Martyn Jago -;; Keywords: babel language, literate programming -;; Homepage: http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.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 . - -;;; Commentary: - -;; Installation, ob-lilypond documentation, and examples are available at -;; http://orgmode.org/worg/org-contrib/babel/languages/ob-doc-lilypond.html -;; -;; Lilypond documentation can be found at -;; http://lilypond.org/manuals.html - -;;; Code: -(require 'ob) -(require 'outline) -(defalias 'lilypond-mode 'LilyPond-mode) - -(add-to-list 'org-babel-tangle-lang-exts '("LilyPond" . "ly")) - -(defvar org-babel-default-header-args:lilypond '() - "Default header arguments for lilypond code blocks. -NOTE: The arguments are determined at lilypond compile time. -See (ly-set-header-args)") - -(defvar ly-compile-post-tangle t - "Following the org-babel-tangle (C-c C-v t) command, -ly-compile-post-tangle determines whether ob-lilypond should -automatically attempt to compile the resultant tangled file. -If the value is nil, no automated compilation takes place. -Default value is t") - -(defvar ly-display-pdf-post-tangle t - "Following a successful LilyPond compilation -ly-display-pdf-post-tangle determines whether to automate the -drawing / redrawing of the resultant pdf. If the value is nil, -the pdf is not automatically redrawn. Default value is t") - -(defvar ly-play-midi-post-tangle t - "Following a successful LilyPond compilation -ly-play-midi-post-tangle determines whether to automate the -playing of the resultant midi file. If the value is nil, -the midi file is not automatically played. Default value is t") - -(defvar ly-OSX-ly-path - "/Applications/lilypond.app/Contents/Resources/bin/lilypond") -(defvar ly-OSX-pdf-path "open") -(defvar ly-OSX-midi-path "open") - -(defvar ly-nix-ly-path "/usr/bin/lilypond") -(defvar ly-nix-pdf-path "evince") -(defvar ly-nix-midi-path "timidity") - -(defvar ly-w32-ly-path "lilypond") -(defvar ly-w32-pdf-path "") -(defvar ly-w32-midi-path "") - -(defvar ly-gen-png nil - "Image generation (png) can be turned on by default by setting -LY-GEN-PNG to t") - -(defvar ly-gen-svg nil - "Image generation (SVG) can be turned on by default by setting -LY-GEN-SVG to t") - -(defvar ly-gen-html nil - "HTML generation can be turned on by default by setting -LY-GEN-HTML to t") - -(defvar ly-gen-pdf nil - "PDF generation can be turned on by default by setting -LY-GEN-PDF to t") - -(defvar ly-use-eps nil - "You can force the compiler to use the EPS backend by setting -LY-USE-EPS to t") - -(defvar ly-arrange-mode nil - "Arrange mode is turned on by setting LY-ARRANGE-MODE -to t. In Arrange mode the following settings are altered -from default... -:tangle yes, :noweb yes -:results silent :comments yes. -In addition lilypond block execution causes tangling of all lilypond -blocks") - -(defun org-babel-expand-body:lilypond (body params) - "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) - (mapc - (lambda (pair) - (let ((name (symbol-name (car pair))) - (value (cdr pair))) - (setq body - (replace-regexp-in-string - (concat "\$" (regexp-quote name)) - (if (stringp value) value (format "%S" value)) - body)))) - vars) - body)) - -(defun org-babel-execute:lilypond (body params) - "This function is called by `org-babel-execute-src-block'. -Depending on whether we are in arrange mode either: -1. Attempt to execute lilypond block according to header settings - (This is the default basic mode) -2. Tangle all lilypond blocks and process the result (arrange mode)" - (ly-set-header-args ly-arrange-mode) - (if ly-arrange-mode - (ly-tangle) - (ly-process-basic body params))) - -(defun ly-tangle () - "ob-lilypond specific tangle, attempts to invoke -=ly-execute-tangled-ly= if tangle is successful. Also passes -specific arguments to =org-babel-tangle=" - (interactive) - (if (org-babel-tangle nil "yes" "lilypond") - (ly-execute-tangled-ly) nil)) - -(defun ly-process-basic (body params) - "Execute a lilypond block in basic mode." - (let* ((result-params (cdr (assoc :result-params params))) - (out-file (cdr (assoc :file params))) - (cmdline (or (cdr (assoc :cmdline params)) - "")) - (in-file (org-babel-temp-file "lilypond-"))) - - (with-temp-file in-file - (insert (org-babel-expand-body:generic body params))) - (org-babel-eval - (concat - (ly-determine-ly-path) - " -dbackend=eps " - "-dno-gs-load-fonts " - "-dinclude-eps-fonts " - (or (cdr (assoc (file-name-extension out-file) - '(("pdf" . "--pdf ") - ("ps" . "--ps ") - ("png" . "--png ")))) - "--png ") - "--output=" - (file-name-sans-extension out-file) - " " - cmdline - in-file) "")) nil) - -(defun org-babel-prep-session:lilypond (session params) - "Return an error because LilyPond exporter does not support sessions." - (error "Sorry, LilyPond does not currently support sessions!")) - -(defun ly-execute-tangled-ly () - "Compile result of block tangle with lilypond. -If error in compilation, attempt to mark the error in lilypond org file" - (when ly-compile-post-tangle - (let ((ly-tangled-file (ly-switch-extension - (buffer-file-name) ".lilypond")) - (ly-temp-file (ly-switch-extension - (buffer-file-name) ".ly"))) - (if (file-exists-p ly-tangled-file) - (progn - (when (file-exists-p ly-temp-file) - (delete-file ly-temp-file)) - (rename-file ly-tangled-file - ly-temp-file)) - (error "Error: Tangle Failed!") t) - (switch-to-buffer-other-window "*lilypond*") - (erase-buffer) - (ly-compile-lilyfile ly-temp-file) - (goto-char (point-min)) - (if (not (ly-check-for-compile-error ly-temp-file)) - (progn - (other-window -1) - (ly-attempt-to-open-pdf ly-temp-file) - (ly-attempt-to-play-midi ly-temp-file)) - (error "Error in Compilation!")))) nil) - -(defun ly-compile-lilyfile (file-name &optional test) - "Compile lilypond file and check for compile errors -FILE-NAME is full path to lilypond (.ly) file" - (message "Compiling LilyPond...") - (let ((arg-1 (ly-determine-ly-path)) ;program - (arg-2 nil) ;infile - (arg-3 "*lilypond*") ;buffer - (arg-4 t) ;display - (arg-5 (if ly-gen-png "--png" "")) ;&rest... - (arg-6 (if ly-gen-html "--html" "")) - (arg-7 (if ly-gen-pdf "--pdf" "")) - (arg-8 (if ly-use-eps "-dbackend=eps" "")) - (arg-9 (if ly-gen-svg "-dbackend=svg" "")) - (arg-10 (concat "--output=" (file-name-sans-extension file-name))) - (arg-11 file-name)) - (if test - `(,arg-1 ,arg-2 ,arg-3 ,arg-4 ,arg-5 ,arg-6 - ,arg-7 ,arg-8 ,arg-9 ,arg-10 ,arg-11) - (call-process - arg-1 arg-2 arg-3 arg-4 arg-5 arg-6 - arg-7 arg-8 arg-9 arg-10 arg-11)))) - -(defun ly-check-for-compile-error (file-name &optional test) - "Check for compile error. -This is performed by parsing the *lilypond* buffer -containing the output message from the compilation. -FILE-NAME is full path to lilypond file. -If TEST is t just return nil if no error found, and pass -nil as file-name since it is unused in this context" - (let ((is-error (search-forward "error:" nil t))) - (if (not test) - (if (not is-error) - nil - (ly-process-compile-error file-name)) - is-error))) - -(defun ly-process-compile-error (file-name) - "Process the compilation error that has occurred. -FILE-NAME is full path to lilypond file" - (let ((line-num (ly-parse-line-num))) - (let ((error-lines (ly-parse-error-line file-name line-num))) - (ly-mark-error-line file-name error-lines) - (error "Error: Compilation Failed!")))) - -(defun ly-mark-error-line (file-name line) - "Mark the erroneous lines in the lilypond org buffer. -FILE-NAME is full path to lilypond file. -LINE is the erroneous line" - (switch-to-buffer-other-window - (concat (file-name-nondirectory - (ly-switch-extension file-name ".org")))) - (let ((temp (point))) - (goto-char (point-min)) - (setq case-fold-search nil) - (if (search-forward line nil t) - (progn - (show-all) - (set-mark (point)) - (goto-char (- (point) (length line)))) - (goto-char temp)))) - -(defun ly-parse-line-num (&optional buffer) - "Extract error line number." - (when buffer - (set-buffer buffer)) - (let ((start - (and (search-backward ":" nil t) - (search-backward ":" nil t) - (search-backward ":" nil t) - (search-backward ":" nil t))) - (num nil)) - (if start - (progn - (forward-char) - (let ((num (buffer-substring - (+ 1 start) - (- (search-forward ":" nil t) 1)))) - (setq num (string-to-number num)) - (if (numberp num) - num - nil))) - nil))) - -(defun ly-parse-error-line (file-name lineNo) - "Extract the erroneous line from the tangled .ly file -FILE-NAME is full path to lilypond file. -LINENO is the number of the erroneous line" - (with-temp-buffer - (insert-file-contents (ly-switch-extension file-name ".ly") - nil nil nil t) - (if (> lineNo 0) - (progn - (goto-char (point-min)) - (forward-line (- lineNo 1)) - (buffer-substring (point) (point-at-eol))) - nil))) - -(defun ly-attempt-to-open-pdf (file-name &optional test) - "Attempt to display the generated pdf file -FILE-NAME is full path to lilypond file -If TEST is non-nil, the shell command is returned and is not run" - (when ly-display-pdf-post-tangle - (let ((pdf-file (ly-switch-extension file-name ".pdf"))) - (if (file-exists-p pdf-file) - (let ((cmd-string - (concat (ly-determine-pdf-path) " " pdf-file))) - (if test - cmd-string - (start-process - "\"Audition pdf\"" - "*lilypond*" - (ly-determine-pdf-path) - pdf-file))) - (message "No pdf file generated so can't display!"))))) - -(defun ly-attempt-to-play-midi (file-name &optional test) - "Attempt to play the generated MIDI file -FILE-NAME is full path to lilypond file -If TEST is non-nil, the shell command is returned and is not run" - (when ly-play-midi-post-tangle - (let ((midi-file (ly-switch-extension file-name ".midi"))) - (if (file-exists-p midi-file) - (let ((cmd-string - (concat (ly-determine-midi-path) " " midi-file))) - (if test - cmd-string - (start-process - "\"Audition midi\"" - "*lilypond*" - (ly-determine-midi-path) - midi-file))) - (message "No midi file generated so can't play!"))))) - -(defun ly-determine-ly-path (&optional test) - "Return correct path to ly binary depending on OS -If TEST is non-nil, it contains a simulation of the OS for test purposes" - (let ((sys-type - (or test system-type))) - (cond ((string= sys-type "darwin") - ly-OSX-ly-path) - ((string= sys-type "windows-nt") - ly-w32-ly-path) - (t ly-nix-ly-path)))) - -(defun ly-determine-pdf-path (&optional test) - "Return correct path to pdf viewer depending on OS -If TEST is non-nil, it contains a simulation of the OS for test purposes" - (let ((sys-type - (or test system-type))) - (cond ((string= sys-type "darwin") - ly-OSX-pdf-path) - ((string= sys-type "windows-nt") - ly-w32-pdf-path) - (t ly-nix-pdf-path)))) - -(defun ly-determine-midi-path (&optional test) - "Return correct path to midi player depending on OS -If TEST is non-nil, it contains a simulation of the OS for test purposes" - (let ((sys-type - (or test test system-type))) - (cond ((string= sys-type "darwin") - ly-OSX-midi-path) - ((string= sys-type "windows-nt") - ly-w32-midi-path) - (t ly-nix-midi-path)))) - -(defun ly-toggle-midi-play () - "Toggle whether midi will be played following a successful compilation." - (interactive) - (setq ly-play-midi-post-tangle - (not ly-play-midi-post-tangle)) - (message (concat "Post-Tangle MIDI play has been " - (if ly-play-midi-post-tangle - "ENABLED." "DISABLED.")))) - -(defun ly-toggle-pdf-display () - "Toggle whether pdf will be displayed following a successful compilation." - (interactive) - (setq ly-display-pdf-post-tangle - (not ly-display-pdf-post-tangle)) - (message (concat "Post-Tangle PDF display has been " - (if ly-display-pdf-post-tangle - "ENABLED." "DISABLED.")))) - -(defun ly-toggle-png-generation () - "Toggle whether png image will be generated by compilation." - (interactive) - (setq ly-gen-png (not ly-gen-png)) - (message (concat "PNG image generation has been " - (if ly-gen-png "ENABLED." "DISABLED.")))) - -(defun ly-toggle-html-generation () - "Toggle whether html will be generated by compilation." - (interactive) - (setq ly-gen-html (not ly-gen-html)) - (message (concat "HTML generation has been " - (if ly-gen-html "ENABLED." "DISABLED.")))) - -(defun ly-toggle-pdf-generation () - "Toggle whether pdf will be generated by compilation." - (interactive) - (setq ly-gen-pdf (not ly-gen-pdf)) - (message (concat "PDF generation has been " - (if ly-gen-pdf "ENABLED." "DISABLED.")))) - -(defun ly-toggle-arrange-mode () - "Toggle whether in Arrange mode or Basic mode." - (interactive) - (setq ly-arrange-mode - (not ly-arrange-mode)) - (message (concat "Arrange mode has been " - (if ly-arrange-mode "ENABLED." "DISABLED.")))) - -(defun ly-switch-extension (file-name ext) - "Utility command to swap current FILE-NAME extension with EXT" - (concat (file-name-sans-extension - file-name) ext)) - -(defun ly-get-header-args (mode) - "Default arguments to use when evaluating a lilypond -source block. These depend upon whether we are in arrange -mode i.e. ARRANGE-MODE is t" - (cond (mode - '((:tangle . "yes") - (:noweb . "yes") - (:results . "silent") - (:cache . "yes") - (:comments . "yes"))) - (t - '((:results . "file") - (:exports . "results"))))) - -(defun ly-set-header-args (mode) - "Set org-babel-default-header-args:lilypond -dependent on LY-ARRANGE-MODE" - (setq org-babel-default-header-args:lilypond - (ly-get-header-args mode))) - -(provide 'ob-lilypond) - -;;; ob-lilypond.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-lisp.el b/xemacs-packages/lisp/org-8.2.3c/ob-lisp.el deleted file mode 100644 index c912fd9f..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-lisp.el +++ /dev/null @@ -1,109 +0,0 @@ -;;; ob-lisp.el --- org-babel functions for common lisp evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Authors: Joel Boehland -;; Eric Schulte -;; David T. O'Toole -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;;; support for evaluating common lisp code, relies on slime for all eval - -;;; Requirements: - -;; Requires SLIME (Superior Lisp Interaction Mode for Emacs.) -;; See http://common-lisp.net/project/slime/ - -;;; Code: -(require 'ob) - -(declare-function slime-eval "ext:slime" (sexp &optional package)) - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("lisp" . "lisp")) - -(defvar org-babel-default-header-args:lisp '()) -(defvar org-babel-header-args:lisp '((package . :any))) - -(defcustom org-babel-lisp-dir-fmt - "(let ((*default-pathname-defaults* #P%S)) %%s)" - "Format string used to wrap code bodies to set the current directory. -For example a value of \"(progn ;; %s\\n %%s)\" would ignore the -current directory string." - :group 'org-babel - :version "24.1" - :type 'string) - -(defun org-babel-expand-body:lisp (body params) - "Expand BODY according to PARAMS, return the expanded body." - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) - (print-level nil) (print-length nil) - (body (org-babel-trim - (if (> (length vars) 0) - (concat "(let (" - (mapconcat - (lambda (var) - (format "(%S (quote %S))" (car var) (cdr var))) - vars "\n ") - ")\n" body ")") - body)))) - (if (or (member "code" result-params) - (member "pp" result-params)) - (format "(pprint %s)" body) - body))) - -(defun org-babel-execute:lisp (body params) - "Execute a block of Common Lisp code with Babel." - (require 'slime) - (org-babel-reassemble-table - (let ((result - (with-temp-buffer - (insert (org-babel-expand-body:lisp body params)) - (slime-eval `(swank:eval-and-grab-output - ,(let ((dir (if (assoc :dir params) - (cdr (assoc :dir params)) - default-directory))) - (format - (if dir (format org-babel-lisp-dir-fmt dir) - "(progn %s)") - (buffer-substring-no-properties - (point-min) (point-max))))) - (cdr (assoc :package params)))))) - (org-babel-result-cond (cdr (assoc :result-params params)) - (car result) - (condition-case nil - (read (org-babel-lisp-vector-to-list (cadr result))) - (error (cadr result))))) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params))))) - -(defun org-babel-lisp-vector-to-list (results) - ;; TODO: better would be to replace #(...) with [...] - (replace-regexp-in-string "#(" "(" results)) - -(provide 'ob-lisp) - - - -;;; ob-lisp.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-lob.el b/xemacs-packages/lisp/org-8.2.3c/ob-lob.el deleted file mode 100644 index d37940a1..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-lob.el +++ /dev/null @@ -1,165 +0,0 @@ -;;; ob-lob.el --- functions supporting the Library of Babel - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Authors: Eric Schulte -;; Dan Davison -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Code: -(eval-when-compile - (require 'cl)) -(require 'ob-core) -(require 'ob-table) - -(declare-function org-babel-in-example-or-verbatim "ob-exp" nil) - -(defvar org-babel-library-of-babel nil - "Library of source-code blocks. -This is an association list. Populate the library by adding -files to `org-babel-lob-files'.") - -(defcustom org-babel-lob-files nil - "Files used to populate the `org-babel-library-of-babel'. -To add files to this list use the `org-babel-lob-ingest' command." - :group 'org-babel - :version "24.1" - :type 'list) - -(defvar org-babel-default-lob-header-args '((:exports . "results")) - "Default header arguments to use when exporting #+lob/call lines.") - -(defun org-babel-lob-ingest (&optional file) - "Add all named source-blocks defined in FILE to -`org-babel-library-of-babel'." - (interactive "fFile: ") - (let ((lob-ingest-count 0)) - (org-babel-map-src-blocks file - (let* ((info (org-babel-get-src-block-info 'light)) - (source-name (nth 4 info))) - (when source-name - (setq source-name (intern source-name) - org-babel-library-of-babel - (cons (cons source-name info) - (assq-delete-all source-name org-babel-library-of-babel)) - lob-ingest-count (1+ lob-ingest-count))))) - (message "%d src block%s added to Library of Babel" - lob-ingest-count (if (> lob-ingest-count 1) "s" "")) - lob-ingest-count)) - -(defconst org-babel-block-lob-one-liner-regexp - (concat - "^\\([ \t]*?\\)#\\+call:[ \t]+\\([^\(\)\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)" - "\(\\([^\n]*?\\)\)\\(\\[.+\\]\\|\\)[ \t]*\\(\\([^\n]*\\)\\)?") - "Regexp to match non-inline calls to predefined source block functions.") - -(defconst org-babel-inline-lob-one-liner-regexp - (concat - "\\([^\n]*?\\)call_\\([^\(\)\n]+?\\)\\(\\[\\(.*?\\)\\]\\|\\(\\)\\)" - "\(\\([^\n]*?\\)\)\\(\\[\\(.*?\\)\\]\\)?") - "Regexp to match inline calls to predefined source block functions.") - -(defconst org-babel-lob-one-liner-regexp - (concat "\\(" org-babel-block-lob-one-liner-regexp - "\\|" org-babel-inline-lob-one-liner-regexp "\\)") - "Regexp to match calls to predefined source block functions.") - -;; functions for executing lob one-liners - -;;;###autoload -(defun org-babel-lob-execute-maybe () - "Execute a Library of Babel source block, if appropriate. -Detect if this is context for a Library Of Babel source block and -if so then run the appropriate source block from the Library." - (interactive) - (let ((info (org-babel-lob-get-info))) - (if (and (nth 0 info) (not (org-babel-in-example-or-verbatim))) - (progn (org-babel-lob-execute info) t) - nil))) - -;;;###autoload -(defun org-babel-lob-get-info () - "Return a Library of Babel function call as a string." - (let ((case-fold-search t) - (nonempty (lambda (a b) - (let ((it (match-string a))) - (if (= (length it) 0) (match-string b) it))))) - (save-excursion - (beginning-of-line 1) - (when (looking-at org-babel-lob-one-liner-regexp) - (append - (mapcar #'org-no-properties - (list - (format "%s%s(%s)%s" - (funcall nonempty 3 12) - (if (not (= 0 (length (funcall nonempty 5 14)))) - (concat "[" (funcall nonempty 5 14) "]") "") - (or (funcall nonempty 7 16) "") - (or (funcall nonempty 8 19) "")) - (funcall nonempty 9 18))) - (list (length (if (= (length (match-string 12)) 0) - (match-string 2) (match-string 11))) - (save-excursion - (forward-line -1) - (and (looking-at (concat org-babel-src-name-regexp - "\\([^\n]*\\)$")) - (org-no-properties (match-string 1)))))))))) - -(defvar org-babel-default-header-args:emacs-lisp) ; Defined in ob-emacs-lisp.el -(defun org-babel-lob-execute (info) - "Execute the lob call specified by INFO." - (let* ((mkinfo (lambda (p) - (list "emacs-lisp" "results" p nil - (nth 3 info) ;; name - (nth 2 info)))) - (pre-params (apply #'org-babel-merge-params - org-babel-default-header-args - org-babel-default-header-args:emacs-lisp - (append - (org-babel-params-from-properties) - (list - (org-babel-parse-header-arguments - (org-no-properties - (concat - ":var results=" - (mapconcat #'identity (butlast info 2) - " ")))))))) - (pre-info (funcall mkinfo pre-params)) - (cache-p (and (cdr (assoc :cache pre-params)) - (string= "yes" (cdr (assoc :cache pre-params))))) - (new-hash (when cache-p (org-babel-sha1-hash pre-info))) - (old-hash (when cache-p (org-babel-current-result-hash))) - (org-babel-current-src-block-location (point-marker))) - (if (and cache-p (equal new-hash old-hash)) - (save-excursion (goto-char (org-babel-where-is-src-block-result)) - (forward-line 1) - (message "%S" (org-babel-read-result))) - (prog1 (let* ((proc-params (org-babel-process-params pre-params)) - org-confirm-babel-evaluate) - (org-babel-execute-src-block nil (funcall mkinfo proc-params))) - ;; update the hash - (when new-hash (org-babel-set-current-result-hash new-hash)))))) - -(provide 'ob-lob) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ob-lob.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-makefile.el b/xemacs-packages/lisp/org-8.2.3c/ob-makefile.el deleted file mode 100644 index 517b5a68..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-makefile.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; ob-makefile.el --- org-babel functions for makefile evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte and Thomas S. Dye -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; This file exists solely for tangling a Makefile from org-mode files. - -;;; Code: -(require 'ob) - -(defvar org-babel-default-header-args:makefile '()) - -(defun org-babel-execute:makefile (body params) - "Execute a block of makefile code. -This function is called by `org-babel-execute-src-block'." - body) - -(defun org-babel-prep-session:makefile (session params) - "Return an error if the :session header argument is set. Make -does not support sessions." - (error "Makefile sessions are nonsensical")) - -(provide 'ob-makefile) - - - -;;; ob-makefile.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-matlab.el b/xemacs-packages/lisp/org-8.2.3c/ob-matlab.el deleted file mode 100644 index 481ed24f..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-matlab.el +++ /dev/null @@ -1,47 +0,0 @@ -;;; ob-matlab.el --- org-babel support for matlab evaluation - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Dan Davison -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Functions that are common to org-babel support for matlab and -;; octave are in org-babel-octave.el - -;;; Requirements: - -;; Matlab - -;; matlab.el required for interactive emacs sessions and matlab-mode -;; major mode for source code editing buffer -;; http://matlab-emacs.sourceforge.net/ - -;;; Code: -(require 'ob) -(require 'ob-octave) - -;; see ob-octave for matlab implementation - -(provide 'ob-matlab) - - - -;;; ob-matlab.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-maxima.el b/xemacs-packages/lisp/org-8.2.3c/ob-maxima.el deleted file mode 100644 index 5be378ed..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-maxima.el +++ /dev/null @@ -1,131 +0,0 @@ -;;; ob-maxima.el --- org-babel functions for maxima evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric S Fraga -;; Eric Schulte -;; Keywords: literate programming, reproducible research, maxima -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating maxima entries. -;; -;; This differs from most standard languages in that -;; -;; 1) there is no such thing as a "session" in maxima -;; -;; 2) we are adding the "cmdline" header argument - -;;; Code: -(require 'ob) - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("maxima" . "max")) - -(defvar org-babel-default-header-args:maxima '()) - -(defcustom org-babel-maxima-command - (if (boundp 'maxima-command) maxima-command "maxima") - "Command used to call maxima on the shell." - :group 'org-babel) - -(defun org-babel-maxima-expand (body params) - "Expand a block of Maxima code according to its header arguments." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) - (mapconcat 'identity - (list - ;; graphic output - (let ((graphic-file (org-babel-maxima-graphical-output-file params))) - (if graphic-file - (format - "set_plot_option ([gnuplot_term, png]); set_plot_option ([gnuplot_out_file, %S]);" - graphic-file) - "")) - ;; variables - (mapconcat 'org-babel-maxima-var-to-maxima vars "\n") - ;; body - body - "gnuplot_close ()$") - "\n"))) - -(defun org-babel-execute:maxima (body params) - "Execute a block of Maxima entries with org-babel. -This function is called by `org-babel-execute-src-block'." - (message "executing Maxima source code block") - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (result - (let* ((cmdline (or (cdr (assoc :cmdline params)) "")) - (in-file (org-babel-temp-file "maxima-" ".max")) - (cmd (format "%s --very-quiet -r 'batchload(%S)$' %s" - org-babel-maxima-command in-file cmdline))) - (with-temp-file in-file (insert (org-babel-maxima-expand body params))) - (message cmd) - ;; " | grep -v batch | grep -v 'replaced' | sed '/^$/d' " - (let ((raw (org-babel-eval cmd ""))) - (mapconcat - #'identity - (delq nil - (mapcar (lambda (line) - (unless (or (string-match "batch" line) - (string-match "^rat: replaced .*$" line) - (string-match "^;;; Loading #P" line) - (= 0 (length line))) - line)) - (split-string raw "[\r\n]"))) "\n"))))) - (if (org-babel-maxima-graphical-output-file params) - nil - (org-babel-result-cond result-params - result - (let ((tmp-file (org-babel-temp-file "maxima-res-"))) - (with-temp-file tmp-file (insert result)) - (org-babel-import-elisp-from-file tmp-file)))))) - - -(defun org-babel-prep-session:maxima (session params) - (error "Maxima does not support sessions")) - -(defun org-babel-maxima-var-to-maxima (pair) - "Convert an elisp val into a string of maxima code specifying a var -of the same value." - (let ((var (car pair)) - (val (cdr pair))) - (when (symbolp val) - (setq val (symbol-name val)) - (when (= (length val) 1) - (setq val (string-to-char val)))) - (format "%S: %s$" var - (org-babel-maxima-elisp-to-maxima val)))) - -(defun org-babel-maxima-graphical-output-file (params) - "Name of file to which maxima should send graphical output." - (and (member "graphics" (cdr (assq :result-params params))) - (cdr (assq :file params)))) - -(defun org-babel-maxima-elisp-to-maxima (val) - "Return a string of maxima code which evaluates to VAL." - (if (listp val) - (concat "[" (mapconcat #'org-babel-maxima-elisp-to-maxima val ", ") "]") - (format "%s" val))) - - -(provide 'ob-maxima) - - - -;;; ob-maxima.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-mscgen.el b/xemacs-packages/lisp/org-8.2.3c/ob-mscgen.el deleted file mode 100644 index 209ad7dc..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-mscgen.el +++ /dev/null @@ -1,84 +0,0 @@ -;;; ob-msc.el --- org-babel functions for mscgen evaluation - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Juan Pechiar -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: -;; -;; This software provides EMACS org-babel export support for message -;; sequence charts. The mscgen utility is used for processing the -;; sequence definition, and must therefore be installed in the system. -;; -;; Mscgen is available and documented at -;; http://www.mcternan.me.uk/mscgen/index.html -;; -;; This code is directly inspired by Eric Schulte's ob-dot.el -;; -;; Example: -;; -;; #+begin_src mscgen :file example.png -;; msc { -;; A,B; -;; A -> B [ label = "send message" ]; -;; A <- B [ label = "get answer" ]; -;; } -;; #+end_src -;; -;; Header for alternative file type: -;; -;; #+begin_src mscgen :file ex2.svg :filetype svg - -;; This differs from most standard languages in that -;; -;; 1) there is no such thing as a "session" in mscgen -;; 2) we are generally only going to return results of type "file" -;; 3) we are adding the "file" and "filetype" header arguments -;; 4) there are no variables - -;;; Code: -(require 'ob) - -(defvar org-babel-default-header-args:mscgen - '((:results . "file") (:exports . "results")) - "Default arguments to use when evaluating a mscgen source block.") - -(defun org-babel-execute:mscgen (body params) - "Execute a block of Mscgen code with Babel. -This function is called by `org-babel-execute-src-block'. -Default filetype is png. Modify by setting :filetype parameter to -mscgen supported formats." - (let* ((out-file (or (cdr (assoc :file params)) "output.png" )) - (filetype (or (cdr (assoc :filetype params)) "png" ))) - (unless (cdr (assoc :file params)) - (error " -ERROR: no output file specified. Add \":file name.png\" to the src header")) - (org-babel-eval (concat "mscgen -T " filetype " -o " out-file) body) - nil)) ;; signal that output has already been written to file - -(defun org-babel-prep-session:mscgen (session params) - "Raise an error because Mscgen doesn't support sessions." - (error "Mscgen does not support sessions")) - -(provide 'ob-mscgen) - - - -;;; ob-msc.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-ocaml.el b/xemacs-packages/lisp/org-8.2.3c/ob-ocaml.el deleted file mode 100644 index 25f79c5b..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-ocaml.el +++ /dev/null @@ -1,160 +0,0 @@ -;;; ob-ocaml.el --- org-babel functions for ocaml evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating ocaml source code. This one will -;; be sort of tricky because ocaml programs must be compiled before -;; they can be run, but ocaml code can also be run through an -;; interactive interpreter. -;; -;; For now lets only allow evaluation using the ocaml interpreter. - -;;; Requirements: - -;; - tuareg-mode :: http://www-rocq.inria.fr/~acohen/tuareg/ - -;;; Code: -(require 'ob) -(require 'comint) -(eval-when-compile (require 'cl)) - -(declare-function tuareg-run-caml "ext:tuareg" ()) -(declare-function tuareg-run-ocaml "ext:tuareg" ()) -(declare-function tuareg-interactive-send-input "ext:tuareg" ()) - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("ocaml" . "ml")) - -(defvar org-babel-default-header-args:ocaml '()) - -(defvar org-babel-ocaml-eoe-indicator "\"org-babel-ocaml-eoe\";;") -(defvar org-babel-ocaml-eoe-output "org-babel-ocaml-eoe") - -(defcustom org-babel-ocaml-command "ocaml" - "Name of the command for executing Ocaml code." - :version "24.4" - :package-version '(Org . "8.0") - :group 'org-babel - :type 'string) - -(defun org-babel-execute:ocaml (body params) - "Execute a block of Ocaml code with Babel." - (let* ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (full-body (org-babel-expand-body:generic - body params - (org-babel-variable-assignments:ocaml params))) - (session (org-babel-prep-session:ocaml - (cdr (assoc :session params)) params)) - (raw (org-babel-comint-with-output - (session org-babel-ocaml-eoe-output t full-body) - (insert - (concat - (org-babel-chomp full-body)";;\n"org-babel-ocaml-eoe-indicator)) - (tuareg-interactive-send-input))) - (clean - (car (let ((re (regexp-quote org-babel-ocaml-eoe-output)) out) - (delq nil (mapcar (lambda (line) - (if out - (progn (setq out nil) line) - (when (string-match re line) - (progn (setq out t) nil)))) - (mapcar #'org-babel-trim (reverse raw)))))))) - (org-babel-reassemble-table - (let ((raw (org-babel-trim clean)) - (result-params (cdr (assoc :result-params params)))) - (org-babel-result-cond result-params - ;; strip type information from output unless verbatim is specified - (if (and (not (member "verbatim" result-params)) - (string-match "= \\(.+\\)$" raw)) - (match-string 1 raw) raw) - (org-babel-ocaml-parse-output raw))) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) - -(defvar tuareg-interactive-buffer-name) -(defun org-babel-prep-session:ocaml (session params) - "Prepare SESSION according to the header arguments in PARAMS." - (require 'tuareg) - (let ((tuareg-interactive-buffer-name (if (and (not (string= session "none")) - (not (string= session "default")) - (stringp session)) - session - tuareg-interactive-buffer-name))) - (save-window-excursion (if (fboundp 'tuareg-run-process-if-needed) - (tuareg-run-process-if-needed org-babel-ocaml-command) - (tuareg-run-caml))) - (get-buffer tuareg-interactive-buffer-name))) - -(defun org-babel-variable-assignments:ocaml (params) - "Return list of ocaml statements assigning the block's variables." - (mapcar - (lambda (pair) (format "let %s = %s;;" (car pair) - (org-babel-ocaml-elisp-to-ocaml (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) - -(defun org-babel-ocaml-elisp-to-ocaml (val) - "Return a string of ocaml code which evaluates to VAL." - (if (listp val) - (concat "[|" (mapconcat #'org-babel-ocaml-elisp-to-ocaml val "; ") "|]") - (format "%S" val))) - -(defun org-babel-ocaml-parse-output (output) - "Parse OUTPUT. -OUTPUT is string output from an ocaml process." - (let ((regexp "[^:]+ : %s = \\(.+\\)$")) - (cond - ((string-match (format regexp "string") output) - (org-babel-read (match-string 1 output))) - ((or (string-match (format regexp "int") output) - (string-match (format regexp "float") output)) - (string-to-number (match-string 1 output))) - ((string-match (format regexp "list") output) - (org-babel-ocaml-read-list (match-string 1 output))) - ((string-match (format regexp "array") output) - (org-babel-ocaml-read-array (match-string 1 output))) - (t (message "don't recognize type of %s" output) output)))) - -(defun org-babel-ocaml-read-list (results) - "Convert RESULTS into an elisp table or string. -If the results look like a table, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape (replace-regexp-in-string ";" "," results))) - -(defun org-babel-ocaml-read-array (results) - "Convert RESULTS into an elisp table or string. -If the results look like a table, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape - (replace-regexp-in-string - "\\[|" "[" (replace-regexp-in-string - "|\\]" "]" (replace-regexp-in-string - "; " "," results))))) - -(provide 'ob-ocaml) - - - -;;; ob-ocaml.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-octave.el b/xemacs-packages/lisp/org-8.2.3c/ob-octave.el deleted file mode 100644 index 40bedfdb..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-octave.el +++ /dev/null @@ -1,280 +0,0 @@ -;;; ob-octave.el --- org-babel functions for octave and matlab evaluation - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Dan Davison -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;;; Requirements: - -;; octave -;; octave-mode.el and octave-inf.el come with GNU emacs - -;;; Code: -(require 'ob) -(eval-when-compile (require 'cl)) - -(declare-function matlab-shell "ext:matlab-mode") -(declare-function matlab-shell-run-region "ext:matlab-mode") - -(defvar org-babel-default-header-args:matlab '()) -(defvar org-babel-default-header-args:octave '()) - -(defvar org-babel-matlab-shell-command "matlab -nosplash" - "Shell command to run matlab as an external process.") -(defvar org-babel-octave-shell-command "octave -q" - "Shell command to run octave as an external process.") - -(defvar org-babel-matlab-with-emacs-link nil - "If non-nil use matlab-shell-run-region for session evaluation. - This will use EmacsLink if (matlab-with-emacs-link) evaluates - to a non-nil value.") - -(defvar org-babel-matlab-emacs-link-wrapper-method - "%s -if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); -else, save -ascii %s ans -end -delete('%s') -") -(defvar org-babel-octave-wrapper-method - "%s -if ischar(ans), fid = fopen('%s', 'w'); fprintf(fid, '%%s\\n', ans); fclose(fid); -else, dlmwrite('%s', ans, '\\t') -end") - -(defvar org-babel-octave-eoe-indicator "\'org_babel_eoe\'") - -(defvar org-babel-octave-eoe-output "ans = org_babel_eoe") - -(defun org-babel-execute:matlab (body params) - "Execute a block of matlab code with Babel." - (org-babel-execute:octave body params 'matlab)) - -(defun org-babel-execute:octave (body params &optional matlabp) - "Execute a block of octave code with Babel." - (let* ((session - (funcall (intern (format "org-babel-%s-initiate-session" - (if matlabp "matlab" "octave"))) - (cdr (assoc :session params)) params)) - (vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) - (out-file (cdr (assoc :file params))) - (full-body - (org-babel-expand-body:generic - body params (org-babel-variable-assignments:octave params))) - (result (org-babel-octave-evaluate - session - (if (org-babel-octave-graphical-output-file params) - (mapconcat 'identity - (list - "set (0, \"defaultfigurevisible\", \"off\");" - full-body - (format "print -dpng %s" (org-babel-octave-graphical-output-file params))) - "\n") - full-body) - result-type matlabp))) - (if (org-babel-octave-graphical-output-file params) - nil - (org-babel-reassemble-table - result - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))) - -(defun org-babel-prep-session:matlab (session params) - "Prepare SESSION according to PARAMS." - (org-babel-prep-session:octave session params 'matlab)) - -(defun org-babel-variable-assignments:octave (params) - "Return list of octave statements assigning the block's variables." - (mapcar - (lambda (pair) - (format "%s=%s;" - (car pair) - (org-babel-octave-var-to-octave (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) - -(defalias 'org-babel-variable-assignments:matlab - 'org-babel-variable-assignments:octave) - -(defun org-babel-octave-var-to-octave (var) - "Convert an emacs-lisp value into an octave variable. -Converts an emacs-lisp variable into a string of octave code -specifying a variable of the same value." - (if (listp var) - (concat "[" (mapconcat #'org-babel-octave-var-to-octave var - (if (listp (car var)) "; " ",")) "]") - (cond - ((stringp var) - (format "\'%s\'" var)) - (t - (format "%s" var))))) - -(defun org-babel-prep-session:octave (session params &optional matlabp) - "Prepare SESSION according to the header arguments specified in PARAMS." - (let* ((session (org-babel-octave-initiate-session session params matlabp)) - (var-lines (org-babel-variable-assignments:octave params))) - (org-babel-comint-in-buffer session - (mapc (lambda (var) - (end-of-line 1) (insert var) (comint-send-input nil t) - (org-babel-comint-wait-for-output session)) var-lines)) - session)) - -(defun org-babel-matlab-initiate-session (&optional session params) - "Create a matlab inferior process buffer. -If there is not a current inferior-process-buffer in SESSION then -create. Return the initialized session." - (org-babel-octave-initiate-session session params 'matlab)) - -(defun org-babel-octave-initiate-session (&optional session params matlabp) - "Create an octave inferior process buffer. -If there is not a current inferior-process-buffer in SESSION then -create. Return the initialized session." - (if matlabp (require 'matlab) (or (require 'octave-inf nil 'noerror) - (require 'octave))) - (unless (string= session "none") - (let ((session (or session - (if matlabp "*Inferior Matlab*" "*Inferior Octave*")))) - (if (org-babel-comint-buffer-livep session) session - (save-window-excursion - (if matlabp (unless org-babel-matlab-with-emacs-link (matlab-shell)) - (run-octave)) - (rename-buffer (if (bufferp session) (buffer-name session) - (if (stringp session) session (buffer-name)))) - (current-buffer)))))) - -(defun org-babel-octave-evaluate - (session body result-type &optional matlabp) - "Pass BODY to the octave process in SESSION. -If RESULT-TYPE equals 'output then return the outputs of the -statements in BODY, if RESULT-TYPE equals 'value then return the -value of the last statement in BODY, as elisp." - (if session - (org-babel-octave-evaluate-session session body result-type matlabp) - (org-babel-octave-evaluate-external-process body result-type matlabp))) - -(defun org-babel-octave-evaluate-external-process (body result-type matlabp) - "Evaluate BODY in an external octave process." - (let ((cmd (if matlabp - org-babel-matlab-shell-command - org-babel-octave-shell-command))) - (case result-type - (output (org-babel-eval cmd body)) - (value (let ((tmp-file (org-babel-temp-file "octave-"))) - (org-babel-eval - cmd - (format org-babel-octave-wrapper-method body - (org-babel-process-file-name tmp-file 'noquote) - (org-babel-process-file-name tmp-file 'noquote))) - (org-babel-octave-import-elisp-from-file tmp-file)))))) - -(defun org-babel-octave-evaluate-session - (session body result-type &optional matlabp) - "Evaluate BODY in SESSION." - (let* ((tmp-file (org-babel-temp-file (if matlabp "matlab-" "octave-"))) - (wait-file (org-babel-temp-file "matlab-emacs-link-wait-signal-")) - (full-body - (case result-type - (output - (mapconcat - #'org-babel-chomp - (list body org-babel-octave-eoe-indicator) "\n")) - (value - (if (and matlabp org-babel-matlab-with-emacs-link) - (concat - (format org-babel-matlab-emacs-link-wrapper-method - body - (org-babel-process-file-name tmp-file 'noquote) - (org-babel-process-file-name tmp-file 'noquote) wait-file) "\n") - (mapconcat - #'org-babel-chomp - (list (format org-babel-octave-wrapper-method - body - (org-babel-process-file-name tmp-file 'noquote) - (org-babel-process-file-name tmp-file 'noquote)) - org-babel-octave-eoe-indicator) "\n"))))) - (raw (if (and matlabp org-babel-matlab-with-emacs-link) - (save-window-excursion - (with-temp-buffer - (insert full-body) - (write-region "" 'ignored wait-file nil nil nil 'excl) - (matlab-shell-run-region (point-min) (point-max)) - (message "Waiting for Matlab Emacs Link") - (while (file-exists-p wait-file) (sit-for 0.01)) - "")) ;; matlab-shell-run-region doesn't seem to - ;; make *matlab* buffer contents easily - ;; available, so :results output currently - ;; won't work - (org-babel-comint-with-output - (session - (if matlabp - org-babel-octave-eoe-indicator - org-babel-octave-eoe-output) - t full-body) - (insert full-body) (comint-send-input nil t)))) results) - (case result-type - (value - (org-babel-octave-import-elisp-from-file tmp-file)) - (output - (progn - (setq results - (if matlabp - (cdr (reverse (delq "" (mapcar - #'org-babel-octave-read-string - (mapcar #'org-babel-trim raw))))) - (cdr (member org-babel-octave-eoe-output - (reverse (mapcar - #'org-babel-octave-read-string - (mapcar #'org-babel-trim raw))))))) - (mapconcat #'identity (reverse results) "\n")))))) - -(defun org-babel-octave-import-elisp-from-file (file-name) - "Import data from FILE-NAME. -This removes initial blank and comment lines and then calls -`org-babel-import-elisp-from-file'." - (let ((temp-file (org-babel-temp-file "octave-matlab-")) beg end) - (with-temp-file temp-file - (insert-file-contents file-name) - (re-search-forward "^[ \t]*[^# \t]" nil t) - (if (< (setq beg (point-min)) - (setq end (point-at-bol))) - (delete-region beg end))) - (org-babel-import-elisp-from-file temp-file '(16)))) - -(defun org-babel-octave-read-string (string) - "Strip \\\"s from around octave string." - (if (string-match "^\"\\([^\000]+\\)\"$" string) - (match-string 1 string) - string)) - -(defun org-babel-octave-graphical-output-file (params) - "Name of file to which maxima should send graphical output." - (and (member "graphics" (cdr (assq :result-params params))) - (cdr (assq :file params)))) - -(provide 'ob-octave) - - - -;;; ob-octave.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-org.el b/xemacs-packages/lisp/org-8.2.3c/ob-org.el deleted file mode 100644 index 892c56c2..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-org.el +++ /dev/null @@ -1,72 +0,0 @@ -;;; ob-org.el --- org-babel functions for org code block evaluation - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; This is the simplest of code blocks, where upon evaluation the -;; contents of the code block are returned in a raw result. - -;;; Code: -(require 'ob) - -(declare-function org-export-string-as "ox" - (string backend &optional body-only ext-plist)) - -(defvar org-babel-default-header-args:org - '((:results . "raw silent") (:exports . "code")) - "Default arguments for evaluating a org source block.") - -(defvar org-babel-org-default-header - "#+TITLE: default empty header\n" - "Default header inserted during export of org blocks.") - -(defun org-babel-expand-body:org (body params) - (dolist (var (mapcar #'cdr (org-babel-get-header params :var))) - (setq body (replace-regexp-in-string - (regexp-quote (format "$%s" (car var))) - (format "%s" (cdr var)) - body nil 'literal))) - body) - -(defun org-babel-execute:org (body params) - "Execute a block of Org code with. -This function is called by `org-babel-execute-src-block'." - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (body (org-babel-expand-body:org - (replace-regexp-in-string "^," "" body) params))) - (cond - ((member "latex" result-params) - (org-export-string-as (concat "#+Title: \n" body) 'latex t)) - ((member "html" result-params) (org-export-string-as body 'html t)) - ((member "ascii" result-params) (org-export-string-as body 'ascii t)) - (t body)))) - -(defun org-babel-prep-session:org (session params) - "Return an error because org does not support sessions." - (error "Org does not support sessions")) - -(provide 'ob-org) - - - -;;; ob-org.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-perl.el b/xemacs-packages/lisp/org-8.2.3c/ob-perl.el deleted file mode 100644 index d374e47e..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-perl.el +++ /dev/null @@ -1,158 +0,0 @@ -;;; ob-perl.el --- org-babel functions for perl evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Authors: Dan Davison -;; Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating perl source code. - -;;; Code: -(require 'ob) -(eval-when-compile (require 'cl)) - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("perl" . "pl")) - -(defvar org-babel-default-header-args:perl '()) - -(defvar org-babel-perl-command "perl" - "Name of command to use for executing perl code.") - -(defun org-babel-execute:perl (body params) - "Execute a block of Perl code with Babel. -This function is called by `org-babel-execute-src-block'." - (let* ((session (cdr (assoc :session params))) - (result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) - (full-body (org-babel-expand-body:generic - body params (org-babel-variable-assignments:perl params))) - (session (org-babel-perl-initiate-session session))) - (org-babel-reassemble-table - (org-babel-perl-evaluate session full-body result-type result-params) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) - -(defun org-babel-prep-session:perl (session params) - "Prepare SESSION according to the header arguments in PARAMS." - (error "Sessions are not supported for Perl")) - -(defun org-babel-variable-assignments:perl (params) - "Return list of perl statements assigning the block's variables." - (mapcar - (lambda (pair) - (org-babel-perl--var-to-perl (cdr pair) (car pair))) - (mapcar #'cdr (org-babel-get-header params :var)))) - -;; helper functions - -(defvar org-babel-perl-var-wrap "q(%s)" - "Wrapper for variables inserted into Perl code.") - -(defvar org-babel-perl--lvl) -(defun org-babel-perl--var-to-perl (var &optional varn) - "Convert an elisp value to a perl variable. -The elisp value, VAR, is converted to a string of perl source code -specifying a var of the same value." - (if varn - (let ((org-babel-perl--lvl 0) (lvar (listp var)) prefix) - (concat "my $" (symbol-name varn) "=" (when lvar "\n") - (org-babel-perl--var-to-perl var) - ";\n")) - (let ((prefix (make-string (* 2 org-babel-perl--lvl) ?\ ))) - (concat prefix - (if (listp var) - (let ((org-babel-perl--lvl (1+ org-babel-perl--lvl))) - (concat "[\n" - (mapconcat #'org-babel-perl--var-to-perl var "") - prefix "]")) - (format "q(%s)" var)) - (unless (zerop org-babel-perl--lvl) ",\n"))))) - -(defvar org-babel-perl-buffers '(:default . nil)) - -(defun org-babel-perl-initiate-session (&optional session params) - "Return nil because sessions are not supported by perl." - nil) - -(defvar org-babel-perl-wrapper-method "{ - my $babel_sub = sub { - %s - }; - open my $BOH, qq(>%s) or die qq(Perl: Could not open output file.$/); - my $rv = &$babel_sub(); - my $rt = ref $rv; - select $BOH; - if (qq(ARRAY) eq $rt) { - local $\\=$/; - local $,=qq(\t); - foreach my $rv ( @$rv ) { - my $rt = ref $rv; - if (qq(ARRAY) eq $rt) { - print @$rv; - } else { - print $rv; - } - } - } else { - print $rv; - } -}") - -(defvar org-babel-perl-preface nil) - -(defvar org-babel-perl-pp-wrapper-method - nil) - -(defun org-babel-perl-evaluate (session ibody &optional result-type result-params) - "Pass BODY to the Perl process in SESSION. -If RESULT-TYPE equals 'output then return a list of the outputs -of the statements in BODY, if RESULT-TYPE equals 'value then -return the value of the last statement in BODY, as elisp." - (when session (error "Sessions are not supported for Perl")) - (let* ((body (concat org-babel-perl-preface ibody)) - (tmp-file (org-babel-temp-file "perl-")) - (tmp-babel-file (org-babel-process-file-name - tmp-file 'noquote))) - (let ((results - (case result-type - (output - (with-temp-file tmp-file - (insert - (org-babel-eval org-babel-perl-command body)) - (buffer-string))) - (value - (org-babel-eval org-babel-perl-command - (format org-babel-perl-wrapper-method - body tmp-babel-file)))))) - (when results - (org-babel-result-cond result-params - (org-babel-eval-read-file tmp-file) - (org-babel-import-elisp-from-file tmp-file '(16))))))) - -(provide 'ob-perl) - - - -;;; ob-perl.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-picolisp.el b/xemacs-packages/lisp/org-8.2.3c/ob-picolisp.el deleted file mode 100644 index 279cd7b3..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-picolisp.el +++ /dev/null @@ -1,189 +0,0 @@ -;;; ob-picolisp.el --- org-babel functions for picolisp evaluation - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Authors: Thorsten Jolitz -;; Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; This library enables the use of PicoLisp in the multi-language -;; programming framework Org-Babel. PicoLisp is a minimal yet -;; fascinating lisp dialect and a highly productive application -;; framework for web-based client-server applications on top of -;; object-oriented databases. A good way to learn PicoLisp is to first -;; read Paul Grahams essay "The hundred year language" -;; (http://www.paulgraham.com/hundred.html) and then study the various -;; documents and essays published in the PicoLisp wiki -;; (http://picolisp.com/5000/-2.html). PicoLisp is included in some -;; GNU/Linux Distributions, and can be downloaded here: -;; http://software-lab.de/down.html. It ships with a picolisp-mode and -;; a inferior-picolisp-mode for Emacs (to be found in the /lib/el/ -;; directory). - -;; Although it might seem more natural to use Emacs Lisp for most -;; Lisp-based programming tasks inside Org-Mode, an Emacs library -;; written in Emacs Lisp, PicoLisp has at least two outstanding -;; features that make it a valuable addition to Org-Babel: - -;; PicoLisp _is_ an object-oriented database with a Prolog-based query -;; language implemented in PicoLisp (Pilog). Database objects are -;; first-class members of the language. - -;; PicoLisp is an extremely productive framework for the development -;; of interactive web-applications (on top of a database). - -;;; Requirements: - -;;; Code: -(require 'ob) -(require 'comint) -(eval-when-compile (require 'cl)) - -(declare-function run-picolisp "ext:inferior-picolisp" (cmd)) -(defvar org-babel-tangle-lang-exts) ;; Autoloaded - -;; optionally define a file extension for this language -(add-to-list 'org-babel-tangle-lang-exts '("picolisp" . "l")) - -;;; interferes with settings in org-babel buffer? -;; optionally declare default header arguments for this language -;; (defvar org-babel-default-header-args:picolisp -;; '((:colnames . "no")) -;; "Default arguments for evaluating a picolisp source block.") - -(defvar org-babel-picolisp-eoe "org-babel-picolisp-eoe" - "String to indicate that evaluation has completed.") - -(defcustom org-babel-picolisp-cmd "pil" - "Name of command used to evaluate picolisp blocks." - :group 'org-babel - :version "24.1" - :type 'string) - -(defun org-babel-expand-body:picolisp (body params) - "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var))) - (result-params (cdr (assoc :result-params params))) - (print-level nil) (print-length nil)) - (if (> (length vars) 0) - (concat "(prog (let (" - (mapconcat - (lambda (var) - (format "%S '%S)" - (print (car var)) - (print (cdr var)))) - vars "\n ") - " \n" body ") )") - body))) - -(defun org-babel-execute:picolisp (body params) - "Execute a block of Picolisp code with org-babel. This function is - called by `org-babel-execute-src-block'" - (message "executing Picolisp source code block") - (let* ( - ;; Name of the session or "none". - (session-name (cdr (assoc :session params))) - ;; Set the session if the session variable is non-nil. - (session (org-babel-picolisp-initiate-session session-name)) - ;; Either OUTPUT or VALUE which should behave as described above. - (result-type (cdr (assoc :result-type params))) - (result-params (cdr (assoc :result-params params))) - ;; Expand the body with `org-babel-expand-body:picolisp'. - (full-body (org-babel-expand-body:picolisp body params)) - ;; Wrap body appropriately for the type of evaluation and results. - (wrapped-body - (cond - ((or (member "code" result-params) - (member "pp" result-params)) - (format "(pretty (out \"/dev/null\" %s))" full-body)) - ((and (member "value" result-params) (not session)) - (format "(print (out \"/dev/null\" %s))" full-body)) - ((member "value" result-params) - (format "(out \"/dev/null\" %s)" full-body)) - (t full-body))) - (result - (if (not (string= session-name "none")) - ;; Session based evaluation. - (mapconcat ;; <- joins the list back into a single string - #'identity - (butlast ;; <- remove the org-babel-picolisp-eoe line - (delq nil - (mapcar - (lambda (line) - (org-babel-chomp ;; Remove trailing newlines. - (when (> (length line) 0) ;; Remove empty lines. - (cond - ;; Remove leading "-> " from return values. - ((and (>= (length line) 3) - (string= "-> " (substring line 0 3))) - (substring line 3)) - ;; Remove trailing "-> <>" on the - ;; last line of output. - ((and (member "output" result-params) - (string-match-p "->" line)) - (substring line 0 (string-match "->" line))) - (t line) - ) - ;;(if (and (>= (length line) 3);Remove leading "<-" - ;; (string= "-> " (substring line 0 3))) - ;; (substring line 3) - ;; line) - ))) - ;; Returns a list of the output of each evaluated exp. - (org-babel-comint-with-output - (session org-babel-picolisp-eoe) - (insert wrapped-body) (comint-send-input) - (insert "'" org-babel-picolisp-eoe) - (comint-send-input))))) - "\n") - ;; external evaluation - (let ((script-file (org-babel-temp-file "picolisp-script-"))) - (with-temp-file script-file - (insert (concat wrapped-body "(bye)"))) - (org-babel-eval - (format "%s %s" - org-babel-picolisp-cmd - (org-babel-process-file-name script-file)) - ""))))) - (org-babel-result-cond result-params - result - (read result)))) - -(defun org-babel-picolisp-initiate-session (&optional session-name) - "If there is not a current inferior-process-buffer in SESSION -then create. Return the initialized session." - (unless (string= session-name "none") - (require 'inferior-picolisp) - ;; provide a reasonable default session name - (let ((session (or session-name "*inferior-picolisp*"))) - ;; check if we already have a live session by this name - (if (org-babel-comint-buffer-livep session) - (get-buffer session) - (save-window-excursion - (run-picolisp org-babel-picolisp-cmd) - (rename-buffer session-name) - (current-buffer)))))) - -(provide 'ob-picolisp) - - - -;;; ob-picolisp.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-plantuml.el b/xemacs-packages/lisp/org-8.2.3c/ob-plantuml.el deleted file mode 100644 index f992d04d..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-plantuml.el +++ /dev/null @@ -1,85 +0,0 @@ -;;; ob-plantuml.el --- org-babel functions for plantuml evaluation - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Zhang Weize -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating plantuml script. -;; -;; Inspired by Ian Yang's org-export-blocks-format-plantuml -;; http://www.emacswiki.org/emacs/org-export-blocks-format-plantuml.el - -;;; Requirements: - -;; plantuml | http://plantuml.sourceforge.net/ -;; plantuml.jar | `org-plantuml-jar-path' should point to the jar file - -;;; Code: -(require 'ob) - -(defvar org-babel-default-header-args:plantuml - '((:results . "file") (:exports . "results")) - "Default arguments for evaluating a plantuml source block.") - -(defcustom org-plantuml-jar-path "" - "Path to the plantuml.jar file." - :group 'org-babel - :version "24.1" - :type 'string) - -(defun org-babel-execute:plantuml (body params) - "Execute a block of plantuml code with org-babel. -This function is called by `org-babel-execute-src-block'." - (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (out-file (or (cdr (assoc :file params)) - (error "PlantUML requires a \":file\" header argument"))) - (cmdline (cdr (assoc :cmdline params))) - (in-file (org-babel-temp-file "plantuml-")) - (java (or (cdr (assoc :java params)) "")) - (cmd (if (string= "" org-plantuml-jar-path) - (error "`org-plantuml-jar-path' is not set") - (concat "java " java " -jar " - (shell-quote-argument - (expand-file-name org-plantuml-jar-path)) - (if (string= (file-name-extension out-file) "svg") - " -tsvg" "") - (if (string= (file-name-extension out-file) "eps") - " -teps" "") - " -p " cmdline " < " - (org-babel-process-file-name in-file) - " > " - (org-babel-process-file-name out-file))))) - (unless (file-exists-p org-plantuml-jar-path) - (error "Could not find plantuml.jar at %s" org-plantuml-jar-path)) - (with-temp-file in-file (insert (concat "@startuml\n" body "\n@enduml"))) - (message "%s" cmd) (org-babel-eval cmd "") - nil)) ;; signal that output has already been written to file - -(defun org-babel-prep-session:plantuml (session params) - "Return an error because plantuml does not support sessions." - (error "Plantuml does not support sessions")) - -(provide 'ob-plantuml) - - - -;;; ob-plantuml.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-python.el b/xemacs-packages/lisp/org-8.2.3c/ob-python.el deleted file mode 100644 index 2f91b535..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-python.el +++ /dev/null @@ -1,346 +0,0 @@ -;;; ob-python.el --- org-babel functions for python evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Authors: Eric Schulte -;; Dan Davison -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating python source code. - -;;; Code: -(require 'ob) -(eval-when-compile (require 'cl)) - -(declare-function org-remove-indentation "org" ) -(declare-function py-shell "ext:python-mode" (&optional argprompt)) -(declare-function py-toggle-shells "ext:python-mode" (arg)) -(declare-function run-python "ext:python" (cmd &optional dedicated show)) - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("python" . "py")) - -(defvar org-babel-default-header-args:python '()) - -(defcustom org-babel-python-command "python" - "Name of the command for executing Python code." - :version "24.4" - :package-version '(Org . "8.0") - :group 'org-babel - :type 'string) - -(defcustom org-babel-python-mode - (if (or (featurep 'xemacs) (featurep 'python-mode)) 'python-mode 'python) - "Preferred python mode for use in running python interactively. -This will typically be either 'python or 'python-mode." - :group 'org-babel - :version "24.4" - :package-version '(Org . "8.0") - :type 'symbol) - -(defvar org-src-preserve-indentation) - -(defcustom org-babel-python-hline-to "None" - "Replace hlines in incoming tables with this when translating to python." - :group 'org-babel - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defcustom org-babel-python-None-to 'hline - "Replace 'None' in python tables with this before returning." - :group 'org-babel - :version "24.4" - :package-version '(Org . "8.0") - :type 'symbol) - -(defun org-babel-execute:python (body params) - "Execute a block of Python code with Babel. -This function is called by `org-babel-execute-src-block'." - (let* ((session (org-babel-python-initiate-session - (cdr (assoc :session params)))) - (result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) - (return-val (when (and (eq result-type 'value) (not session)) - (cdr (assoc :return params)))) - (preamble (cdr (assoc :preamble params))) - (full-body - (org-babel-expand-body:generic - (concat body (if return-val (format "\nreturn %s" return-val) "")) - params (org-babel-variable-assignments:python params))) - (result (org-babel-python-evaluate - session full-body result-type result-params preamble))) - (org-babel-reassemble-table - result - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params)))))) - -(defun org-babel-prep-session:python (session params) - "Prepare SESSION according to the header arguments in PARAMS. -VARS contains resolved variable references" - (let* ((session (org-babel-python-initiate-session session)) - (var-lines - (org-babel-variable-assignments:python params))) - (org-babel-comint-in-buffer session - (mapc (lambda (var) - (end-of-line 1) (insert var) (comint-send-input) - (org-babel-comint-wait-for-output session)) var-lines)) - session)) - -(defun org-babel-load-session:python (session body params) - "Load BODY into SESSION." - (save-window-excursion - (let ((buffer (org-babel-prep-session:python session params))) - (with-current-buffer buffer - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (insert (org-babel-chomp body))) - buffer))) - -;; helper functions - -(defun org-babel-variable-assignments:python (params) - "Return a list of Python statements assigning the block's variables." - (mapcar - (lambda (pair) - (format "%s=%s" - (car pair) - (org-babel-python-var-to-python (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) - -(defun org-babel-python-var-to-python (var) - "Convert an elisp value to a python variable. -Convert an elisp value, VAR, into a string of python source code -specifying a variable of the same value." - (if (listp var) - (concat "[" (mapconcat #'org-babel-python-var-to-python var ", ") "]") - (if (equal var 'hline) - org-babel-python-hline-to - (format - (if (and (stringp var) (string-match "[\n\r]" var)) "\"\"%S\"\"" "%S") - var)))) - -(defun org-babel-python-table-or-string (results) - "Convert RESULTS into an appropriate elisp value. -If the results look like a list or tuple, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (let ((res (org-babel-script-escape results))) - (if (listp res) - (mapcar (lambda (el) (if (equal el 'None) - org-babel-python-None-to el)) - res) - res))) - -(defvar org-babel-python-buffers '((:default . "*Python*"))) - -(defun org-babel-python-session-buffer (session) - "Return the buffer associated with SESSION." - (cdr (assoc session org-babel-python-buffers))) - -(defun org-babel-python-with-earmufs (session) - (let ((name (if (stringp session) session (format "%s" session)))) - (if (and (string= "*" (substring name 0 1)) - (string= "*" (substring name (- (length name) 1)))) - name - (format "*%s*" name)))) - -(defun org-babel-python-without-earmufs (session) - (let ((name (if (stringp session) session (format "%s" session)))) - (if (and (string= "*" (substring name 0 1)) - (string= "*" (substring name (- (length name) 1)))) - (substring name 1 (- (length name) 1)) - name))) - -(defvar py-default-interpreter) -(defvar py-which-bufname) -(defvar python-shell-buffer-name) -(defun org-babel-python-initiate-session-by-key (&optional session) - "Initiate a python session. -If there is not a current inferior-process-buffer in SESSION -then create. Return the initialized session." - (require org-babel-python-mode) - (save-window-excursion - (let* ((session (if session (intern session) :default)) - (python-buffer (org-babel-python-session-buffer session)) - (cmd (if (member system-type '(cygwin windows-nt ms-dos)) - (concat org-babel-python-command " -i") - org-babel-python-command))) - (cond - ((and (eq 'python org-babel-python-mode) - (fboundp 'run-python)) ; python.el - (if (not (version< "24.1" emacs-version)) - (run-python cmd) - (unless python-buffer - (setq python-buffer (org-babel-python-with-earmufs session))) - (let ((python-shell-buffer-name - (org-babel-python-without-earmufs python-buffer))) - (run-python cmd)))) - ((and (eq 'python-mode org-babel-python-mode) - (fboundp 'py-shell)) ; python-mode.el - ;; Make sure that py-which-bufname is initialized, as otherwise - ;; it will be overwritten the first time a Python buffer is - ;; created. - (py-toggle-shells py-default-interpreter) - ;; `py-shell' creates a buffer whose name is the value of - ;; `py-which-bufname' with '*'s at the beginning and end - (let* ((bufname (if (and python-buffer (buffer-live-p python-buffer)) - (replace-regexp-in-string ;; zap surrounding * - "^\\*\\([^*]+\\)\\*$" "\\1" python-buffer) - (concat "Python-" (symbol-name session)))) - (py-which-bufname bufname)) - (py-shell) - (setq python-buffer (org-babel-python-with-earmufs bufname)))) - (t - (error "No function available for running an inferior Python"))) - (setq org-babel-python-buffers - (cons (cons session python-buffer) - (assq-delete-all session org-babel-python-buffers))) - session))) - -(defun org-babel-python-initiate-session (&optional session params) - "Create a session named SESSION according to PARAMS." - (unless (string= session "none") - (org-babel-python-session-buffer - (org-babel-python-initiate-session-by-key session)))) - -(defvar org-babel-python-eoe-indicator "'org_babel_python_eoe'" - "A string to indicate that evaluation has completed.") -(defvar org-babel-python-wrapper-method - " -def main(): -%s - -open('%s', 'w').write( str(main()) )") -(defvar org-babel-python-pp-wrapper-method - " -import pprint -def main(): -%s - -open('%s', 'w').write( pprint.pformat(main()) )") - -(defun org-babel-python-evaluate - (session body &optional result-type result-params preamble) - "Evaluate BODY as Python code." - (if session - (org-babel-python-evaluate-session - session body result-type result-params) - (org-babel-python-evaluate-external-process - body result-type result-params preamble))) - -(defun org-babel-python-evaluate-external-process - (body &optional result-type result-params preamble) - "Evaluate BODY in external python process. -If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the -last statement in BODY, as elisp." - (let ((raw - (case result-type - (output (org-babel-eval org-babel-python-command - (concat (if preamble (concat preamble "\n")) - body))) - (value (let ((tmp-file (org-babel-temp-file "python-"))) - (org-babel-eval - org-babel-python-command - (concat - (if preamble (concat preamble "\n") "") - (format - (if (member "pp" result-params) - org-babel-python-pp-wrapper-method - org-babel-python-wrapper-method) - (mapconcat - (lambda (line) (format "\t%s" line)) - (split-string - (org-remove-indentation - (org-babel-trim body)) - "[\r\n]") "\n") - (org-babel-process-file-name tmp-file 'noquote)))) - (org-babel-eval-read-file tmp-file)))))) - (org-babel-result-cond result-params - raw - (org-babel-python-table-or-string (org-babel-trim raw))))) - -(defun org-babel-python-evaluate-session - (session body &optional result-type result-params) - "Pass BODY to the Python process in SESSION. -If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the -last statement in BODY, as elisp." - (let* ((send-wait (lambda () (comint-send-input nil t) (sleep-for 0 5))) - (dump-last-value - (lambda - (tmp-file pp) - (mapc - (lambda (statement) (insert statement) (funcall send-wait)) - (if pp - (list - "import pprint" - (format "open('%s', 'w').write(pprint.pformat(_))" - (org-babel-process-file-name tmp-file 'noquote))) - (list (format "open('%s', 'w').write(str(_))" - (org-babel-process-file-name tmp-file - 'noquote))))))) - (input-body (lambda (body) - (mapc (lambda (line) (insert line) (funcall send-wait)) - (split-string body "[\r\n]")) - (funcall send-wait))) - (results - (case result-type - (output - (mapconcat - #'org-babel-trim - (butlast - (org-babel-comint-with-output - (session org-babel-python-eoe-indicator t body) - (funcall input-body body) - (funcall send-wait) (funcall send-wait) - (insert org-babel-python-eoe-indicator) - (funcall send-wait)) - 2) "\n")) - (value - (let ((tmp-file (org-babel-temp-file "python-"))) - (org-babel-comint-with-output - (session org-babel-python-eoe-indicator nil body) - (let ((comint-process-echoes nil)) - (funcall input-body body) - (funcall dump-last-value tmp-file - (member "pp" result-params)) - (funcall send-wait) (funcall send-wait) - (insert org-babel-python-eoe-indicator) - (funcall send-wait))) - (org-babel-eval-read-file tmp-file)))))) - (unless (string= (substring org-babel-python-eoe-indicator 1 -1) results) - (org-babel-result-cond result-params - results - (org-babel-python-table-or-string results))))) - -(defun org-babel-python-read-string (string) - "Strip 's from around Python string." - (if (string-match "^'\\([^\000]+\\)'$" string) - (match-string 1 string) - string)) - -(provide 'ob-python) - - - -;;; ob-python.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-ref.el b/xemacs-packages/lisp/org-8.2.3c/ob-ref.el deleted file mode 100644 index 5a3c8ba2..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-ref.el +++ /dev/null @@ -1,269 +0,0 @@ -;;; ob-ref.el --- org-babel functions for referencing external data - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Authors: Eric Schulte -;; Dan Davison -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Functions for referencing data from the header arguments of a -;; org-babel block. The syntax of such a reference should be - -;; #+VAR: variable-name=file:resource-id - -;; - variable-name :: the name of the variable to which the value -;; will be assigned - -;; - file :: path to the file containing the resource, or omitted if -;; resource is in the current file - -;; - resource-id :: the id or name of the resource - -;; So an example of a simple src block referencing table data in the -;; same file would be - -;; #+NAME: sandbox -;; | 1 | 2 | 3 | -;; | 4 | org-babel | 6 | -;; -;; #+begin_src emacs-lisp :var table=sandbox -;; (message table) -;; #+end_src - -;;; Code: -(require 'ob-core) -(eval-when-compile - (require 'cl)) - -(declare-function org-remove-if-not "org" (predicate seq)) -(declare-function org-at-table-p "org" (&optional table-type)) -(declare-function org-count "org" (CL-ITEM CL-SEQ)) -(declare-function org-at-item-p "org-list" ()) -(declare-function org-narrow-to-subtree "org" ()) -(declare-function org-id-find-id-in-file "org-id" (id file &optional markerp)) -(declare-function org-id-find-id-file "org-id" (id)) -(declare-function org-show-context "org" (&optional key)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) - -(defvar org-babel-ref-split-regexp - "[ \f\t\n\r\v]*\\(.+?\\)[ \f\t\n\r\v]*=[ \f\t\n\r\v]*\\(.+\\)[ \f\t\n\r\v]*") - -(defvar org-babel-update-intermediate nil - "Update the in-buffer results of code blocks executed to resolve references.") - -(defun org-babel-ref-parse (assignment) - "Parse a variable ASSIGNMENT in a header argument. -If the right hand side of the assignment has a literal value -return that value, otherwise interpret as a reference to an -external resource and find its value using -`org-babel-ref-resolve'. Return a list with two elements. The -first element of the list will be the name of the variable, and -the second will be an emacs-lisp representation of the value of -the variable." - (when (string-match org-babel-ref-split-regexp assignment) - (let ((var (match-string 1 assignment)) - (ref (match-string 2 assignment))) - (cons (intern var) - (let ((out (save-excursion - (when org-babel-current-src-block-location - (goto-char org-babel-current-src-block-location)) - (org-babel-read ref)))) - (if (equal out ref) - (if (string-match "^\".*\"$" ref) - (read ref) - (org-babel-ref-resolve ref)) - out)))))) - -(defun org-babel-ref-goto-headline-id (id) - (goto-char (point-min)) - (let ((rx (regexp-quote id))) - (or (re-search-forward - (concat "^[ \t]*:CUSTOM_ID:[ \t]+" rx "[ \t]*$") nil t) - (let* ((file (org-id-find-id-file id)) - (m (when file (org-id-find-id-in-file id file 'marker)))) - (when (and file m) - (message "file:%S" file) - (org-pop-to-buffer-same-window (marker-buffer m)) - (goto-char m) - (move-marker m nil) - (org-show-context) - t))))) - -(defun org-babel-ref-headline-body () - (save-restriction - (org-narrow-to-subtree) - (buffer-substring - (save-excursion (goto-char (point-min)) - (forward-line 1) - (when (looking-at "[ \t]*:PROPERTIES:") - (re-search-forward ":END:" nil) - (forward-char)) - (point)) - (point-max)))) - -(defvar org-babel-library-of-babel) -(defun org-babel-ref-resolve (ref) - "Resolve the reference REF and return its value." - (save-window-excursion - (save-excursion - (let ((case-fold-search t) - type args new-refere new-header-args new-referent result - lob-info split-file split-ref index index-row index-col id) - ;; if ref is indexed grab the indices -- beware nested indices - (when (and (string-match "\\[\\([^\\[]+\\)\\]$" ref) - (let ((str (substring ref 0 (match-beginning 0)))) - (= (org-count ?( str) (org-count ?) str)))) - (setq index (match-string 1 ref)) - (setq ref (substring ref 0 (match-beginning 0)))) - ;; assign any arguments to pass to source block - (when (string-match - "^\\(.+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)\(\\(.*\\)\)$" ref) - (setq new-refere (match-string 1 ref)) - (setq new-header-args (match-string 3 ref)) - (setq new-referent (match-string 5 ref)) - (when (> (length new-refere) 0) - (when (> (length new-referent) 0) - (setq args (mapcar (lambda (ref) (cons :var ref)) - (org-babel-ref-split-args new-referent)))) - (when (> (length new-header-args) 0) - (setq args (append (org-babel-parse-header-arguments - new-header-args) args))) - (setq ref new-refere))) - (when (string-match "^\\(.+\\):\\(.+\\)$" ref) - (setq split-file (match-string 1 ref)) - (setq split-ref (match-string 2 ref)) - (find-file split-file) (setq ref split-ref)) - (save-restriction - (widen) - (goto-char (point-min)) - (if (let ((src-rx (org-babel-named-src-block-regexp-for-name ref)) - (res-rx (org-babel-named-data-regexp-for-name ref))) - ;; goto ref in the current buffer - (or - ;; check for code blocks - (re-search-forward src-rx nil t) - ;; check for named data - (re-search-forward res-rx nil t) - ;; check for local or global headlines by id - (setq id (org-babel-ref-goto-headline-id ref)) - ;; check the Library of Babel - (setq lob-info (cdr (assoc (intern ref) - org-babel-library-of-babel))))) - (unless (or lob-info id) (goto-char (match-beginning 0))) - ;; ;; TODO: allow searching for names in other buffers - ;; (setq id-loc (org-id-find ref 'marker) - ;; buffer (marker-buffer id-loc) - ;; loc (marker-position id-loc)) - ;; (move-marker id-loc nil) - (error "Reference '%s' not found in this buffer" ref)) - (cond - (lob-info (setq type 'lob)) - (id (setq type 'id)) - ((and (looking-at org-babel-src-name-regexp) - (save-excursion - (forward-line 1) - (or (looking-at org-babel-src-block-regexp) - (looking-at org-babel-multi-line-header-regexp)))) - (setq type 'source-block)) - (t (while (not (setq type (org-babel-ref-at-ref-p))) - (forward-line 1) - (beginning-of-line) - (if (or (= (point) (point-min)) (= (point) (point-max))) - (error "Reference not found"))))) - (let ((params (append args '((:results . "silent"))))) - (setq result - (case type - (results-line (org-babel-read-result)) - (table (org-babel-read-table)) - (list (org-babel-read-list)) - (file (org-babel-read-link)) - (source-block (org-babel-execute-src-block - nil nil (if org-babel-update-intermediate - nil params))) - (lob (org-babel-execute-src-block - nil lob-info params)) - (id (org-babel-ref-headline-body))))) - (if (symbolp result) - (format "%S" result) - (if (and index (listp result)) - (org-babel-ref-index-list index result) - result))))))) - -(defun org-babel-ref-index-list (index lis) - "Return the subset of LIS indexed by INDEX. - -Indices are 0 based and negative indices count from the end of -LIS, so 0 references the first element of LIS and -1 references -the last. If INDEX is separated by \",\"s then each \"portion\" -is assumed to index into the next deepest nesting or dimension. - -A valid \"portion\" can consist of either an integer index, two -integers separated by a \":\" in which case the entire range is -returned, or an empty string or \"*\" both of which are -interpreted to mean the entire range and as such are equivalent -to \"0:-1\"." - (if (and (> (length index) 0) (string-match "^\\([^,]*\\),?" index)) - (let* ((ind-re "\\(\\([-[:digit:]]+\\):\\([-[:digit:]]+\\)\\|\*\\)") - (lgth (length lis)) - (portion (match-string 1 index)) - (remainder (substring index (match-end 0))) - (wrap (lambda (num) (if (< num 0) (+ lgth num) num))) - (open (lambda (ls) (if (and (listp ls) (= (length ls) 1)) (car ls) ls)))) - (funcall - open - (mapcar - (lambda (sub-lis) - (if (listp sub-lis) - (org-babel-ref-index-list remainder sub-lis) - sub-lis)) - (if (or (= 0 (length portion)) (string-match ind-re portion)) - (mapcar - (lambda (n) (nth n lis)) - (apply 'org-number-sequence - (if (and (> (length portion) 0) (match-string 2 portion)) - (list - (funcall wrap (string-to-number (match-string 2 portion))) - (funcall wrap (string-to-number (match-string 3 portion)))) - (list (funcall wrap 0) (funcall wrap -1))))) - (list (nth (funcall wrap (string-to-number portion)) lis)))))) - lis)) - -(defun org-babel-ref-split-args (arg-string) - "Split ARG-STRING into top-level arguments of balanced parenthesis." - (mapcar #'org-babel-trim (org-babel-balanced-split arg-string 44))) - -(defvar org-bracket-link-regexp) -(defun org-babel-ref-at-ref-p () - "Return the type of reference located at point. -Return nil if none of the supported reference types are found. -Supported reference types are tables and source blocks." - (cond ((org-at-table-p) 'table) - ((org-at-item-p) 'list) - ((looking-at "^[ \t]*#\\+BEGIN_SRC") 'source-block) - ((looking-at org-bracket-link-regexp) 'file) - ((looking-at org-babel-result-regexp) 'results-line))) - -(provide 'ob-ref) - - - -;;; ob-ref.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-ruby.el b/xemacs-packages/lisp/org-8.2.3c/ob-ruby.el deleted file mode 100644 index 34b9eaf4..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-ruby.el +++ /dev/null @@ -1,260 +0,0 @@ -;;; ob-ruby.el --- org-babel functions for ruby evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating ruby source code. - -;;; Requirements: - -;; - ruby and irb executables :: http://www.ruby-lang.org/ -;; -;; - ruby-mode :: Can be installed through ELPA, or from -;; http://github.com/eschulte/rinari/raw/master/util/ruby-mode.el -;; -;; - inf-ruby mode :: Can be installed through ELPA, or from -;; http://github.com/eschulte/rinari/raw/master/util/inf-ruby.el - -;;; Code: -(require 'ob) -(eval-when-compile (require 'cl)) - -(declare-function run-ruby "ext:inf-ruby" (&optional command name)) -(declare-function xmp "ext:rcodetools" (&optional option)) - -(defvar org-babel-tangle-lang-exts) -(add-to-list 'org-babel-tangle-lang-exts '("ruby" . "rb")) - -(defvar org-babel-default-header-args:ruby '()) - -(defvar org-babel-ruby-command "ruby" - "Name of command to use for executing ruby code.") - -(defcustom org-babel-ruby-hline-to "nil" - "Replace hlines in incoming tables with this when translating to ruby." - :group 'org-babel - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defcustom org-babel-ruby-nil-to 'hline - "Replace 'nil' in ruby tables with this before returning." - :group 'org-babel - :version "24.4" - :package-version '(Org . "8.0") - :type 'symbol) - -(defun org-babel-execute:ruby (body params) - "Execute a block of Ruby code with Babel. -This function is called by `org-babel-execute-src-block'." - (let* ((session (org-babel-ruby-initiate-session - (cdr (assoc :session params)))) - (result-params (cdr (assoc :result-params params))) - (result-type (cdr (assoc :result-type params))) - (full-body (org-babel-expand-body:generic - body params (org-babel-variable-assignments:ruby params))) - (result (if (member "xmp" result-params) - (with-temp-buffer - (require 'rcodetools) - (insert full-body) - (xmp (cdr (assoc :xmp-option params))) - (buffer-string)) - (org-babel-ruby-evaluate - session full-body result-type result-params)))) - (org-babel-reassemble-table - (org-babel-result-cond result-params - result - (org-babel-ruby-table-or-string result)) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params)))))) - -(defun org-babel-prep-session:ruby (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - ;; (message "params=%S" params) ;; debugging - (let* ((session (org-babel-ruby-initiate-session session)) - (var-lines (org-babel-variable-assignments:ruby params))) - (org-babel-comint-in-buffer session - (sit-for .5) (goto-char (point-max)) - (mapc (lambda (var) - (insert var) (comint-send-input nil t) - (org-babel-comint-wait-for-output session) - (sit-for .1) (goto-char (point-max))) var-lines)) - session)) - -(defun org-babel-load-session:ruby (session body params) - "Load BODY into SESSION." - (save-window-excursion - (let ((buffer (org-babel-prep-session:ruby session params))) - (with-current-buffer buffer - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (insert (org-babel-chomp body))) - buffer))) - -;; helper functions - -(defun org-babel-variable-assignments:ruby (params) - "Return list of ruby statements assigning the block's variables." - (mapcar - (lambda (pair) - (format "%s=%s" - (car pair) - (org-babel-ruby-var-to-ruby (cdr pair)))) - (mapcar #'cdr (org-babel-get-header params :var)))) - -(defun org-babel-ruby-var-to-ruby (var) - "Convert VAR into a ruby variable. -Convert an elisp value into a string of ruby source code -specifying a variable of the same value." - (if (listp var) - (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var ", ") "]") - (if (equal var 'hline) - org-babel-ruby-hline-to - (format "%S" var)))) - -(defun org-babel-ruby-table-or-string (results) - "Convert RESULTS into an appropriate elisp value. -If RESULTS look like a table, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (let ((res (org-babel-script-escape results))) - (if (listp res) - (mapcar (lambda (el) (if (equal el 'nil) - org-babel-ruby-nil-to el)) - res) - res))) - -(defun org-babel-ruby-initiate-session (&optional session params) - "Initiate a ruby session. -If there is not a current inferior-process-buffer in SESSION -then create one. Return the initialized session." - (unless (string= session "none") - (require 'inf-ruby) - (let ((session-buffer (save-window-excursion - (run-ruby nil session) (current-buffer)))) - (if (org-babel-comint-buffer-livep session-buffer) - (progn (sit-for .25) session-buffer) - (sit-for .5) - (org-babel-ruby-initiate-session session))))) - -(defvar org-babel-ruby-eoe-indicator ":org_babel_ruby_eoe" - "String to indicate that evaluation has completed.") -(defvar org-babel-ruby-f-write - "File.open('%s','w'){|f| f.write((_.class == String) ? _ : _.inspect)}") -(defvar org-babel-ruby-pp-f-write - "File.open('%s','w'){|f| $stdout = f; pp(results); $stdout = orig_out}") -(defvar org-babel-ruby-wrapper-method - " -def main() -%s -end -results = main() -File.open('%s', 'w'){ |f| f.write((results.class == String) ? results : results.inspect) } -") -(defvar org-babel-ruby-pp-wrapper-method - " -require 'pp' -def main() -%s -end -results = main() -File.open('%s', 'w') do |f| - $stdout = f - pp results -end -") - -(defun org-babel-ruby-evaluate - (buffer body &optional result-type result-params) - "Pass BODY to the Ruby process in BUFFER. -If RESULT-TYPE equals 'output then return a list of the outputs -of the statements in BODY, if RESULT-TYPE equals 'value then -return the value of the last statement in BODY, as elisp." - (if (not buffer) - ;; external process evaluation - (case result-type - (output (org-babel-eval org-babel-ruby-command body)) - (value (let ((tmp-file (org-babel-temp-file "ruby-"))) - (org-babel-eval - org-babel-ruby-command - (format (if (member "pp" result-params) - org-babel-ruby-pp-wrapper-method - org-babel-ruby-wrapper-method) - body (org-babel-process-file-name tmp-file 'noquote))) - (let ((raw (org-babel-eval-read-file tmp-file))) - (if (or (member "code" result-params) - (member "pp" result-params)) - raw - (org-babel-ruby-table-or-string raw)))))) - ;; comint session evaluation - (case result-type - (output - (mapconcat - #'identity - (butlast - (split-string - (mapconcat - #'org-babel-trim - (butlast - (org-babel-comint-with-output - (buffer org-babel-ruby-eoe-indicator t body) - (mapc - (lambda (line) - (insert (org-babel-chomp line)) (comint-send-input nil t)) - (list body org-babel-ruby-eoe-indicator)) - (comint-send-input nil t)) 2) - "\n") "[\r\n]")) "\n")) - (value - (let* ((tmp-file (org-babel-temp-file "ruby-")) - (ppp (or (member "code" result-params) - (member "pp" result-params)))) - (org-babel-comint-with-output - (buffer org-babel-ruby-eoe-indicator t body) - (when ppp (insert "require 'pp';") (comint-send-input nil t)) - (mapc - (lambda (line) - (insert (org-babel-chomp line)) (comint-send-input nil t)) - (append - (list body) - (if (not ppp) - (list (format org-babel-ruby-f-write - (org-babel-process-file-name tmp-file 'noquote))) - (list - "results=_" "require 'pp'" "orig_out = $stdout" - (format org-babel-ruby-pp-f-write - (org-babel-process-file-name tmp-file 'noquote)))) - (list org-babel-ruby-eoe-indicator))) - (comint-send-input nil t)) - (org-babel-eval-read-file tmp-file)))))) - -(defun org-babel-ruby-read-string (string) - "Strip \\\"s from around a ruby string." - (if (string-match "^\"\\([^\000]+\\)\"$" string) - (match-string 1 string) - string)) - -(provide 'ob-ruby) - - - -;;; ob-ruby.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-sass.el b/xemacs-packages/lisp/org-8.2.3c/ob-sass.el deleted file mode 100644 index cdb75bea..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-sass.el +++ /dev/null @@ -1,71 +0,0 @@ -;;; ob-sass.el --- org-babel functions for the sass css generation language - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; For more information on sass see http://sass-lang.com/ -;; -;; This accepts a 'file' header argument which is the target of the -;; compiled sass. The default output type for sass evaluation is -;; either file (if a 'file' header argument was given) or scalar if no -;; such header argument was supplied. -;; -;; A 'cmdline' header argument can be supplied to pass arguments to -;; the sass command line. - -;;; Requirements: - -;; - sass-mode :: http://github.com/nex3/haml/blob/master/extra/sass-mode.el - -;;; Code: -(require 'ob) - -(defvar org-babel-default-header-args:sass '()) - -(defun org-babel-execute:sass (body params) - "Execute a block of Sass code with Babel. -This function is called by `org-babel-execute-src-block'." - (let* ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (file (cdr (assoc :file params))) - (out-file (or file (org-babel-temp-file "sass-out-"))) - (cmdline (cdr (assoc :cmdline params))) - (in-file (org-babel-temp-file "sass-in-")) - (cmd (concat "sass " (or cmdline "") - " " (org-babel-process-file-name in-file) - " " (org-babel-process-file-name out-file)))) - (with-temp-file in-file - (insert (org-babel-expand-body:generic body params))) - (org-babel-eval cmd "") - (if file - nil ;; signal that output has already been written to file - (with-temp-buffer (insert-file-contents out-file) (buffer-string))))) - -(defun org-babel-prep-session:sass (session params) - "Raise an error because sass does not support sessions." - (error "Sass does not support sessions")) - -(provide 'ob-sass) - - - -;;; ob-sass.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-scala.el b/xemacs-packages/lisp/org-8.2.3c/ob-scala.el deleted file mode 100644 index f7783619..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-scala.el +++ /dev/null @@ -1,124 +0,0 @@ -;;; ob-scala.el --- org-babel functions for Scala evaluation - -;; Copyright (C) 2012-2013 Free Software Foundation, Inc. - -;; Author: Andrzej Lichnerowicz -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: -;; Currently only supports the external execution. No session support yet. - -;;; Requirements: -;; - Scala language :: http://www.scala-lang.org/ -;; - Scala major mode :: Can be installed from Scala sources -;; https://github.com/scala/scala-dist/blob/master/tool-support/src/emacs/scala-mode.el - -;;; Code: -(require 'ob) -(eval-when-compile (require 'cl)) - -(defvar org-babel-tangle-lang-exts) ;; Autoloaded -(add-to-list 'org-babel-tangle-lang-exts '("scala" . "scala")) -(defvar org-babel-default-header-args:scala '()) -(defvar org-babel-scala-command "scala" - "Name of the command to use for executing Scala code.") - -(defun org-babel-execute:scala (body params) - "Execute a block of Scala code with org-babel. This function is -called by `org-babel-execute-src-block'" - (message "executing Scala source code block") - (let* ((processed-params (org-babel-process-params params)) - (session (org-babel-scala-initiate-session (nth 0 processed-params))) - (vars (nth 1 processed-params)) - (result-params (nth 2 processed-params)) - (result-type (cdr (assoc :result-type params))) - (full-body (org-babel-expand-body:generic - body params)) - (result (org-babel-scala-evaluate - session full-body result-type result-params))) - - (org-babel-reassemble-table - result - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) - - -(defun org-babel-scala-table-or-string (results) - "Convert RESULTS into an appropriate elisp value. -If RESULTS look like a table, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape results)) - - -(defvar org-babel-scala-wrapper-method - -"var str_result :String = null; - -Console.withOut(new java.io.OutputStream() {def write(b: Int){ -}}) { - str_result = { -%s - }.toString -} - -print(str_result) -") - - -(defun org-babel-scala-evaluate - (session body &optional result-type result-params) - "Evaluate BODY in external Scala process. -If RESULT-TYPE equals 'output then return standard output as a string. -If RESULT-TYPE equals 'value then return the value of the last statement -in BODY as elisp." - (when session (error "Sessions are not (yet) supported for Scala")) - (case result-type - (output - (let ((src-file (org-babel-temp-file "scala-"))) - (progn (with-temp-file src-file (insert body)) - (org-babel-eval - (concat org-babel-scala-command " " src-file) "")))) - (value - (let* ((src-file (org-babel-temp-file "scala-")) - (wrapper (format org-babel-scala-wrapper-method body))) - (with-temp-file src-file (insert wrapper)) - (let ((raw (org-babel-eval - (concat org-babel-scala-command " " src-file) ""))) - (org-babel-result-cond result-params - raw - (org-babel-scala-table-or-string raw))))))) - - -(defun org-babel-prep-session:scala (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - (error "Sessions are not (yet) supported for Scala")) - -(defun org-babel-scala-initiate-session (&optional session) - "If there is not a current inferior-process-buffer in SESSION -then create. Return the initialized session. Sessions are not -supported in Scala." - nil) - -(provide 'ob-scala) - - - -;;; ob-scala.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-scheme.el b/xemacs-packages/lisp/org-8.2.3c/ob-scheme.el deleted file mode 100644 index f979640a..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-scheme.el +++ /dev/null @@ -1,189 +0,0 @@ -;;; ob-scheme.el --- org-babel functions for Scheme - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Authors: Eric Schulte, Michael Gauland -;; Keywords: literate programming, reproducible research, scheme -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Now working with SBCL for both session and external evaluation. -;; -;; This certainly isn't optimally robust, but it seems to be working -;; for the basic use cases. - -;;; Requirements: - -;; - a working scheme implementation -;; (e.g. guile http://www.gnu.org/software/guile/guile.html) -;; -;; - for session based evaluation geiser is required, which is available from -;; ELPA. - -;;; Code: -(require 'ob) -(require 'geiser nil t) -(defvar geiser-repl--repl) ; Defined in geiser-repl.el -(defvar geiser-impl--implementation) ; Defined in geiser-impl.el -(defvar geiser-default-implementation) ; Defined in geiser-impl.el -(defvar geiser-active-implementations) ; Defined in geiser-impl.el - -(declare-function run-geiser "geiser-repl" (impl)) -(declare-function geiser-mode "geiser-mode" ()) -(declare-function geiser-eval-region "geiser-mode" (start end &optional and-go raw nomsg)) -(declare-function geiser-repl-exit "geiser-repl" (&optional arg)) - -(defvar org-babel-default-header-args:scheme '() - "Default header arguments for scheme code blocks.") - -(defun org-babel-expand-body:scheme (body params) - "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) - (if (> (length vars) 0) - (concat "(let (" - (mapconcat - (lambda (var) (format "%S" (print `(,(car var) ',(cdr var))))) - vars "\n ") - ")\n" body ")") - body))) - - -(defvar org-babel-scheme-repl-map (make-hash-table :test 'equal) - "Map of scheme sessions to session names.") - -(defun org-babel-scheme-cleanse-repl-map () - "Remove dead buffers from the REPL map." - (maphash - (lambda (x y) - (when (not (buffer-name y)) - (remhash x org-babel-scheme-repl-map))) - org-babel-scheme-repl-map)) - -(defun org-babel-scheme-get-session-buffer (session-name) - "Look up the scheme buffer for a session; return nil if it doesn't exist." - (org-babel-scheme-cleanse-repl-map) ; Prune dead sessions - (gethash session-name org-babel-scheme-repl-map)) - -(defun org-babel-scheme-set-session-buffer (session-name buffer) - "Record the scheme buffer used for a given session." - (puthash session-name buffer org-babel-scheme-repl-map)) - -(defun org-babel-scheme-get-buffer-impl (buffer) - "Returns the scheme implementation geiser associates with the buffer." - (with-current-buffer (set-buffer buffer) - geiser-impl--implementation)) - -(defun org-babel-scheme-get-repl (impl name) - "Switch to a scheme REPL, creating it if it doesn't exist:" - (let ((buffer (org-babel-scheme-get-session-buffer name))) - (or buffer - (progn - (run-geiser impl) - (if name - (progn - (rename-buffer name t) - (org-babel-scheme-set-session-buffer name (current-buffer)))) - (current-buffer))))) - -(defun org-babel-scheme-make-session-name (buffer name impl) - "Generate a name for the session buffer. - -For a named session, the buffer name will be the session name. - -If the session is unnamed (nil), generate a name. - -If the session is 'none', use nil for the session name, and -org-babel-scheme-execute-with-geiser will use a temporary session." - (let ((result - (cond ((not name) - (concat buffer " " (symbol-name impl) " REPL")) - ((string= name "none") nil) - (name)))) - result)) - -(defun org-babel-scheme-execute-with-geiser (code output impl repl) - "Execute code in specified REPL. If the REPL doesn't exist, create it -using the given scheme implementation. - -Returns the output of executing the code if the output parameter -is true; otherwise returns the last value." - (let ((result nil)) - (with-temp-buffer - (insert (format ";; -*- geiser-scheme-implementation: %s -*-" impl)) - (newline) - (insert (if output - (format "(with-output-to-string (lambda () %s))" code) - code)) - (geiser-mode) - (let ((repl-buffer (save-current-buffer - (org-babel-scheme-get-repl impl repl)))) - (when (not (eq impl (org-babel-scheme-get-buffer-impl - (current-buffer)))) - (message "Implementation mismatch: %s (%s) %s (%s)" impl (symbolp impl) - (org-babel-scheme-get-buffer-impl (current-buffer)) - (symbolp (org-babel-scheme-get-buffer-impl - (current-buffer))))) - (setq geiser-repl--repl repl-buffer) - (setq geiser-impl--implementation nil) - (geiser-eval-region (point-min) (point-max)) - (setq result - (if (equal (substring (current-message) 0 3) "=> ") - (replace-regexp-in-string "^=> " "" (current-message)) - "\"An error occurred.\"")) - (when (not repl) - (save-current-buffer (set-buffer repl-buffer) - (geiser-repl-exit)) - (set-process-query-on-exit-flag (get-buffer-process repl-buffer) nil) - (kill-buffer repl-buffer)) - (setq result (if (or (string= result "#") - (string= result "#")) - nil - (read result))))) - result)) - -(defun org-babel-execute:scheme (body params) - "Execute a block of Scheme code with org-babel. -This function is called by `org-babel-execute-src-block'" - (let* ((source-buffer (current-buffer)) - (source-buffer-name (replace-regexp-in-string ;; zap surrounding * - "^ ?\\*\\([^*]+\\)\\*" "\\1" - (buffer-name source-buffer)))) - (save-excursion - (org-babel-reassemble-table - (let* ((result-type (cdr (assoc :result-type params))) - (impl (or (when (cdr (assoc :scheme params)) - (intern (cdr (assoc :scheme params)))) - geiser-default-implementation - (car geiser-active-implementations))) - (session (org-babel-scheme-make-session-name - source-buffer-name (cdr (assoc :session params)) impl)) - (full-body (org-babel-expand-body:scheme body params))) - (org-babel-scheme-execute-with-geiser - full-body ; code - (string= result-type "output") ; output? - impl ; implementation - (and (not (string= session "none")) session))) ; session - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params))))))) - -(provide 'ob-scheme) - -;;; ob-scheme.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-screen.el b/xemacs-packages/lisp/org-8.2.3c/ob-screen.el deleted file mode 100644 index f2633769..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-screen.el +++ /dev/null @@ -1,145 +0,0 @@ -;;; ob-screen.el --- org-babel support for interactive terminal - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Benjamin Andresen -;; Keywords: literate programming, interactive shell -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for interactive terminals. Mostly shell scripts. -;; Heavily inspired by 'eev' from Eduardo Ochs -;; -;; Adding :cmd and :terminal as header arguments -;; :terminal must support the -T (title) and -e (command) parameter -;; -;; You can test the default setup. (xterm + sh) with -;; M-x org-babel-screen-test RET - -;;; Code: -(require 'ob) - -(defvar org-babel-screen-location "screen" - "The command location for screen. -In case you want to use a different screen than one selected by your $PATH") - -(defvar org-babel-default-header-args:screen - '((:results . "silent") (:session . "default") (:cmd . "sh") (:terminal . "xterm")) - "Default arguments to use when running screen source blocks.") - -(defun org-babel-execute:screen (body params) - "Send a block of code via screen to a terminal using Babel. -\"default\" session is used when none is specified." - (message "Sending source code block to interactive terminal session...") - (save-window-excursion - (let* ((session (cdr (assoc :session params))) - (socket (org-babel-screen-session-socketname session))) - (unless socket (org-babel-prep-session:screen session params)) - (org-babel-screen-session-execute-string - session (org-babel-expand-body:generic body params))))) - -(defun org-babel-prep-session:screen (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - (let* ((session (cdr (assoc :session params))) - (socket (org-babel-screen-session-socketname session)) - (cmd (cdr (assoc :cmd params))) - (terminal (cdr (assoc :terminal params))) - (process-name (concat "org-babel: terminal (" session ")"))) - (apply 'start-process process-name "*Messages*" - terminal `("-T" ,(concat "org-babel: " session) "-e" ,org-babel-screen-location - "-c" "/dev/null" "-mS" ,(concat "org-babel-session-" session) - ,cmd)) - ;; XXX: Is there a better way than the following? - (while (not (org-babel-screen-session-socketname session)) - ;; wait until screen session is available before returning - ))) - -;; helper functions - -(defun org-babel-screen-session-execute-string (session body) - "If SESSION exists, send BODY to it." - (let ((socket (org-babel-screen-session-socketname session))) - (when socket - (let ((tmpfile (org-babel-screen-session-write-temp-file session body))) - (apply 'start-process (concat "org-babel: screen (" session ")") "*Messages*" - org-babel-screen-location - `("-S" ,socket "-X" "eval" "msgwait 0" - ,(concat "readreg z " tmpfile) - "paste z")))))) - -(defun org-babel-screen-session-socketname (session) - "Check if SESSION exists by parsing output of \"screen -ls\"." - (let* ((screen-ls (shell-command-to-string "screen -ls")) - (sockets (delq - nil - (mapcar - (lambda (x) - (when (string-match (rx (or "(Attached)" "(Detached)")) x) - x)) - (split-string screen-ls "\n")))) - (match-socket (car - (delq - nil - (mapcar - (lambda (x) - (when (string-match - (concat "org-babel-session-" session) x) - x)) - sockets))))) - (when match-socket (car (split-string match-socket))))) - -(defun org-babel-screen-session-write-temp-file (session body) - "Save BODY in a temp file that is named after SESSION." - (let ((tmpfile (concat "/tmp/screen.org-babel-session-" session))) - (with-temp-file tmpfile - (insert body) - - ;; org-babel has superfluous spaces - (goto-char (point-min)) - (delete-matching-lines "^ +$")) - tmpfile)) - -(defun org-babel-screen-test () - "Test if the default setup works. -The terminal should shortly flicker." - (interactive) - (let* ((session "org-babel-testing") - (random-string (format "%s" (random 99999))) - (tmpfile "/tmp/org-babel-screen.test") - (body (concat "echo '" random-string "' > " tmpfile "\nexit\n")) - process tmp-string) - (org-babel-execute:screen body org-babel-default-header-args:screen) - ;; XXX: need to find a better way to do the following - (while (not (file-readable-p tmpfile)) - ;; do something, otherwise this will be optimized away - (format "org-babel-screen: File not readable yet.")) - (setq tmp-string (with-temp-buffer - (insert-file-contents-literally tmpfile) - (buffer-substring (point-min) (point-max)))) - (delete-file tmpfile) - (message (concat "org-babel-screen: Setup " - (if (string-match random-string tmp-string) - "WORKS." - "DOESN'T work."))))) - -(provide 'ob-screen) - - - -;;; ob-screen.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-sh.el b/xemacs-packages/lisp/org-8.2.3c/ob-sh.el deleted file mode 100644 index 4984ff9b..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-sh.el +++ /dev/null @@ -1,212 +0,0 @@ -;;; ob-sh.el --- org-babel functions for shell evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating shell source code. - -;;; Code: -(require 'ob) -(require 'shell) -(eval-when-compile (require 'cl)) - -(declare-function org-babel-comint-in-buffer "ob-comint" (buffer &rest body)) -(declare-function org-babel-comint-wait-for-output "ob-comint" (buffer)) -(declare-function org-babel-comint-buffer-livep "ob-comint" (buffer)) -(declare-function org-babel-comint-with-output "ob-comint" (meta &rest body)) -(declare-function orgtbl-to-generic "org-table" (table params)) - -(defvar org-babel-default-header-args:sh '()) - -(defvar org-babel-sh-command "sh" - "Command used to invoke a shell. -This will be passed to `shell-command-on-region'") - -(defcustom org-babel-sh-var-quote-fmt - "$(cat <<'BABEL_TABLE'\n%s\nBABEL_TABLE\n)" - "Format string used to escape variables when passed to shell scripts." - :group 'org-babel - :type 'string) - -(defun org-babel-execute:sh (body params) - "Execute a block of Shell commands with Babel. -This function is called by `org-babel-execute-src-block'." - (let* ((session (org-babel-sh-initiate-session - (cdr (assoc :session params)))) - (stdin (let ((stdin (cdr (assoc :stdin params)))) - (when stdin (org-babel-sh-var-to-string - (org-babel-ref-resolve stdin))))) - (full-body (org-babel-expand-body:generic - body params (org-babel-variable-assignments:sh params)))) - (org-babel-reassemble-table - (org-babel-sh-evaluate session full-body params stdin) - (org-babel-pick-name - (cdr (assoc :colname-names params)) (cdr (assoc :colnames params))) - (org-babel-pick-name - (cdr (assoc :rowname-names params)) (cdr (assoc :rownames params)))))) - -(defun org-babel-prep-session:sh (session params) - "Prepare SESSION according to the header arguments specified in PARAMS." - (let* ((session (org-babel-sh-initiate-session session)) - (var-lines (org-babel-variable-assignments:sh params))) - (org-babel-comint-in-buffer session - (mapc (lambda (var) - (insert var) (comint-send-input nil t) - (org-babel-comint-wait-for-output session)) var-lines)) - session)) - -(defun org-babel-load-session:sh (session body params) - "Load BODY into SESSION." - (save-window-excursion - (let ((buffer (org-babel-prep-session:sh session params))) - (with-current-buffer buffer - (goto-char (process-mark (get-buffer-process (current-buffer)))) - (insert (org-babel-chomp body))) - buffer))) - -;; helper functions - -(defun org-babel-variable-assignments:sh (params) - "Return list of shell statements assigning the block's variables." - (let ((sep (cdr (assoc :separator params)))) - (mapcar - (lambda (pair) - (format "%s=%s" - (car pair) - (org-babel-sh-var-to-sh (cdr pair) sep))) - (mapcar #'cdr (org-babel-get-header params :var))))) - -(defun org-babel-sh-var-to-sh (var &optional sep) - "Convert an elisp value to a shell variable. -Convert an elisp var into a string of shell commands specifying a -var of the same value." - (format org-babel-sh-var-quote-fmt (org-babel-sh-var-to-string var sep))) - -(defun org-babel-sh-var-to-string (var &optional sep) - "Convert an elisp value to a string." - (let ((echo-var (lambda (v) (if (stringp v) v (format "%S" v))))) - (cond - ((and (listp var) (or (listp (car var)) (equal (car var) 'hline))) - (orgtbl-to-generic var (list :sep (or sep "\t") :fmt echo-var))) - ((listp var) - (mapconcat echo-var var "\n")) - (t (funcall echo-var var))))) - -(defun org-babel-sh-table-or-results (results) - "Convert RESULTS to an appropriate elisp value. -If the results look like a table, then convert them into an -Emacs-lisp table, otherwise return the results as a string." - (org-babel-script-escape results)) - -(defun org-babel-sh-initiate-session (&optional session params) - "Initiate a session named SESSION according to PARAMS." - (when (and session (not (string= session "none"))) - (save-window-excursion - (or (org-babel-comint-buffer-livep session) - (progn (shell session) (get-buffer (current-buffer))))))) - -(defvar org-babel-sh-eoe-indicator "echo 'org_babel_sh_eoe'" - "String to indicate that evaluation has completed.") -(defvar org-babel-sh-eoe-output "org_babel_sh_eoe" - "String to indicate that evaluation has completed.") - -(defun org-babel-sh-evaluate (session body &optional params stdin) - "Pass BODY to the Shell process in BUFFER. -If RESULT-TYPE equals 'output then return a list of the outputs -of the statements in BODY, if RESULT-TYPE equals 'value then -return the value of the last statement in BODY." - (let ((results - (cond - (stdin ; external shell script w/STDIN - (let ((script-file (org-babel-temp-file "sh-script-")) - (stdin-file (org-babel-temp-file "sh-stdin-")) - (shebang (cdr (assoc :shebang params))) - (padline (not (string= "no" (cdr (assoc :padline params)))))) - (with-temp-file script-file - (when shebang (insert (concat shebang "\n"))) - (when padline (insert "\n")) - (insert body)) - (set-file-modes script-file #o755) - (with-temp-file stdin-file (insert stdin)) - (with-temp-buffer - (call-process-shell-command - (if shebang - script-file - (format "%s %s" org-babel-sh-command script-file)) - stdin-file - (current-buffer)) - (buffer-string)))) - (session ; session evaluation - (mapconcat - #'org-babel-sh-strip-weird-long-prompt - (mapcar - #'org-babel-trim - (butlast - (org-babel-comint-with-output - (session org-babel-sh-eoe-output t body) - (mapc - (lambda (line) - (insert line) - (comint-send-input nil t) - (while (save-excursion - (goto-char comint-last-input-end) - (not (re-search-forward - comint-prompt-regexp nil t))) - (accept-process-output - (get-buffer-process (current-buffer))))) - (append - (split-string (org-babel-trim body) "\n") - (list org-babel-sh-eoe-indicator)))) - 2)) "\n")) - ('otherwise ; external shell script - (if (and (cdr (assoc :shebang params)) - (> (length (cdr (assoc :shebang params))) 0)) - (let ((script-file (org-babel-temp-file "sh-script-")) - (shebang (cdr (assoc :shebang params))) - (padline (not (equal "no" (cdr (assoc :padline params)))))) - (with-temp-file script-file - (when shebang (insert (concat shebang "\n"))) - (when padline (insert "\n")) - (insert body)) - (set-file-modes script-file #o755) - (org-babel-eval script-file "")) - (org-babel-eval org-babel-sh-command (org-babel-trim body))))))) - (when results - (let ((result-params (cdr (assoc :result-params params)))) - (org-babel-result-cond result-params - results - (let ((tmp-file (org-babel-temp-file "sh-"))) - (with-temp-file tmp-file (insert results)) - (org-babel-import-elisp-from-file tmp-file))))))) - -(defun org-babel-sh-strip-weird-long-prompt (string) - "Remove prompt cruft from a string of shell output." - (while (string-match "^% +[\r\n$]+ *" string) - (setq string (substring string (match-end 0)))) - string) - -(provide 'ob-sh) - - - -;;; ob-sh.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-shen.el b/xemacs-packages/lisp/org-8.2.3c/ob-shen.el deleted file mode 100644 index 68169da9..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-shen.el +++ /dev/null @@ -1,79 +0,0 @@ -;;; ob-shen.el --- org-babel functions for Shen - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research, shen -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Currently this only works using session evaluation as there is no -;; defined method for executing shen code outside of a session. - -;;; Requirements: - -;; - shen-mode and inf-shen will soon be available through the GNU -;; elpa, however in the interim they are available at -;; https://github.com/eschulte/shen-mode - -;;; Code: -(require 'ob) - -(declare-function shen-eval-defun "ext:inf-shen" (&optional and-go)) -(declare-function org-babel-ruby-var-to-ruby "ob-ruby" (var)) - -(defvar org-babel-default-header-args:shen '() - "Default header arguments for shen code blocks.") - -(defun org-babel-expand-body:shen (body params) - "Expand BODY according to PARAMS, return the expanded body." - (let ((vars (mapcar #'cdr (org-babel-get-header params :var)))) - (if (> (length vars) 0) - (concat "(let " - (mapconcat (lambda (var) - (format "%s %s" (car var) - (org-babel-shen-var-to-shen (cdr var)))) - vars " ") - body ")") - body))) - -(defun org-babel-shen-var-to-shen (var) - "Convert VAR into a shen variable." - (if (listp var) - (concat "[" (mapconcat #'org-babel-ruby-var-to-ruby var " ") "]") - (format "%S" var))) - -(defun org-babel-execute:shen (body params) - "Execute a block of Shen code with org-babel. -This function is called by `org-babel-execute-src-block'" - (require 'inf-shen) - (let* ((result-type (cdr (assoc :result-type params))) - (result-params (cdr (assoc :result-params params))) - (full-body (org-babel-expand-body:shen body params))) - (let ((results - (with-temp-buffer - (insert full-body) - (call-interactively #'shen-eval-defun)))) - (org-babel-result-cond result-params - results - (condition-case nil (org-babel-script-escape results) - (error results)))))) - -(provide 'ob-shen) -;;; ob-shen.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-sql.el b/xemacs-packages/lisp/org-8.2.3c/ob-sql.el deleted file mode 100644 index d17dd8a7..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-sql.el +++ /dev/null @@ -1,212 +0,0 @@ -;;; ob-sql.el --- org-babel functions for sql evaluation - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating sql source code. -;; (see also ob-sqlite.el) -;; -;; SQL is somewhat unique in that there are many different engines for -;; the evaluation of sql (Mysql, PostgreSQL, etc...), so much of this -;; file will have to be implemented engine by engine. -;; -;; Also SQL evaluation generally takes place inside of a database. -;; -;; Header args used: -;; - engine -;; - cmdline -;; - dbhost -;; - dbuser -;; - dbpassword -;; - database -;; - colnames (default, nil, means "yes") -;; - result-params -;; - out-file -;; The following are used but not really implemented for SQL: -;; - colname-names -;; - rownames -;; - rowname-names -;; -;; TODO: -;; -;; - support for sessions -;; - support for more engines (currently only supports mysql) -;; - what's a reasonable way to drop table data into SQL? -;; - -;;; Code: -(require 'ob) -(eval-when-compile (require 'cl)) - -(declare-function org-table-import "org-table" (file arg)) -(declare-function orgtbl-to-csv "org-table" (table params)) -(declare-function org-table-to-lisp "org-table" (&optional txt)) - -(defvar org-babel-default-header-args:sql '()) - -(defconst org-babel-header-args:sql - '((engine . :any) - (out-file . :any) - (dbhost . :any) - (dbuser . :any) - (dbpassword . :any) - (database . :any)) - "SQL-specific header arguments.") - -(defun org-babel-expand-body:sql (body params) - "Expand BODY according to the values of PARAMS." - (org-babel-sql-expand-vars - body (mapcar #'cdr (org-babel-get-header params :var)))) - -(defun dbstring-mysql (host user password database) - "Make MySQL cmd line args for database connection. Pass nil to omit that arg." - (combine-and-quote-strings - (remq nil - (list (when host (concat "-h" host)) - (when user (concat "-u" user)) - (when password (concat "-p" password)) - (when database (concat "-D" database)))))) - -(defun org-babel-execute:sql (body params) - "Execute a block of Sql code with Babel. -This function is called by `org-babel-execute-src-block'." - (let* ((result-params (cdr (assoc :result-params params))) - (cmdline (cdr (assoc :cmdline params))) - (dbhost (cdr (assoc :dbhost params))) - (dbuser (cdr (assoc :dbuser params))) - (dbpassword (cdr (assoc :dbpassword params))) - (database (cdr (assoc :database params))) - (engine (cdr (assoc :engine params))) - (colnames-p (not (equal "no" (cdr (assoc :colnames params))))) - (in-file (org-babel-temp-file "sql-in-")) - (out-file (or (cdr (assoc :out-file params)) - (org-babel-temp-file "sql-out-"))) - (header-delim "") - (command (case (intern engine) - ('dbi (format "dbish --batch %s < %s | sed '%s' > %s" - (or cmdline "") - (org-babel-process-file-name in-file) - "/^+/d;s/^\|//;s/(NULL)/ /g;$d" - (org-babel-process-file-name out-file))) - ('monetdb (format "mclient -f tab %s < %s > %s" - (or cmdline "") - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - ('msosql (format "osql %s -s \"\t\" -i %s -o %s" - (or cmdline "") - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - ('mysql (format "mysql %s %s %s < %s > %s" - (dbstring-mysql dbhost dbuser dbpassword database) - (if colnames-p "" "-N") - (or cmdline "") - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file))) - ('postgresql (format - "psql -A -P footer=off -F \"\t\" -f %s -o %s %s" - (org-babel-process-file-name in-file) - (org-babel-process-file-name out-file) - (or cmdline ""))) - (t (error "No support for the %s SQL engine" engine))))) - (with-temp-file in-file - (insert - (case (intern engine) - ('dbi "/format partbox\n") - (t "")) - (org-babel-expand-body:sql body params))) - (message command) - (org-babel-eval command "") - (org-babel-result-cond result-params - (with-temp-buffer - (progn (insert-file-contents-literally out-file) (buffer-string))) - (with-temp-buffer - (cond - ((or (eq (intern engine) 'mysql) - (eq (intern engine) 'dbi) - (eq (intern engine) 'postgresql)) - ;; Add header row delimiter after column-names header in first line - (cond - (colnames-p - (with-temp-buffer - (insert-file-contents out-file) - (goto-char (point-min)) - (forward-line 1) - (insert "-\n") - (setq header-delim "-") - (write-file out-file))))) - (t - ;; Need to figure out the delimiter for the header row - (with-temp-buffer - (insert-file-contents out-file) - (goto-char (point-min)) - (when (re-search-forward "^\\(-+\\)[^-]" nil t) - (setq header-delim (match-string-no-properties 1))) - (goto-char (point-max)) - (forward-char -1) - (while (looking-at "\n") - (delete-char 1) - (goto-char (point-max)) - (forward-char -1)) - (write-file out-file)))) - (org-table-import out-file '(16)) - (org-babel-reassemble-table - (mapcar (lambda (x) - (if (string= (car x) header-delim) - 'hline - x)) - (org-table-to-lisp)) - (org-babel-pick-name (cdr (assoc :colname-names params)) - (cdr (assoc :colnames params))) - (org-babel-pick-name (cdr (assoc :rowname-names params)) - (cdr (assoc :rownames params)))))))) - -(defun org-babel-sql-expand-vars (body vars) - "Expand the variables held in VARS in BODY." - (mapc - (lambda (pair) - (setq body - (replace-regexp-in-string - (format "\$%s" (car pair)) ;FIXME: "\$" == "$"! - (let ((val (cdr pair))) - (if (listp val) - (let ((data-file (org-babel-temp-file "sql-data-"))) - (with-temp-file data-file - (insert (orgtbl-to-csv - val '(:fmt (lambda (el) (if (stringp el) - el - (format "%S" el))))))) - data-file) - (if (stringp val) val (format "%S" val)))) - body))) - vars) - body) - -(defun org-babel-prep-session:sql (session params) - "Raise an error because Sql sessions aren't implemented." - (error "SQL sessions not yet implemented")) - -(provide 'ob-sql) - - - -;;; ob-sql.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-sqlite.el b/xemacs-packages/lisp/org-8.2.3c/ob-sqlite.el deleted file mode 100644 index fcfdb8eb..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-sqlite.el +++ /dev/null @@ -1,162 +0,0 @@ -;;; ob-sqlite.el --- org-babel functions for sqlite database interaction - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Org-Babel support for evaluating sqlite source code. - -;;; Code: -(require 'ob) - -(declare-function org-fill-template "org" (template alist)) -(declare-function org-table-convert-region "org-table" - (beg0 end0 &optional separator)) -(declare-function orgtbl-to-csv "org-table" (table params)) -(declare-function org-table-to-lisp "org-table" (&optional txt)) - -(defvar org-babel-default-header-args:sqlite '()) - -(defvar org-babel-header-args:sqlite - '((db . :any) - (header . :any) - (echo . :any) - (bail . :any) - (csv . :any) - (column . :any) - (html . :any) - (line . :any) - (list . :any) - (separator . :any) - (nullvalue . :any)) - "Sqlite specific header args.") - -(defun org-babel-expand-body:sqlite (body params) - "Expand BODY according to the values of PARAMS." - (org-babel-sqlite-expand-vars - body (mapcar #'cdr (org-babel-get-header params :var)))) - -(defvar org-babel-sqlite3-command "sqlite3") - -(defun org-babel-execute:sqlite (body params) - "Execute a block of Sqlite code with Babel. -This function is called by `org-babel-execute-src-block'." - (let ((result-params (split-string (or (cdr (assoc :results params)) ""))) - (db (cdr (assoc :db params))) - (separator (cdr (assoc :separator params))) - (nullvalue (cdr (assoc :nullvalue params))) - (headers-p (equal "yes" (cdr (assoc :colnames params)))) - (others (delq nil (mapcar - (lambda (arg) (car (assoc arg params))) - (list :header :echo :bail :column - :csv :html :line :list)))) - exit-code) - (unless db (error "ob-sqlite: can't evaluate without a database")) - (with-temp-buffer - (insert - (org-babel-eval - (org-fill-template - "%cmd %header %separator %nullvalue %others %csv %db " - (list - (cons "cmd" org-babel-sqlite3-command) - (cons "header" (if headers-p "-header" "-noheader")) - (cons "separator" - (if separator (format "-separator %s" separator) "")) - (cons "nullvalue" - (if nullvalue (format "-nullvalue %s" nullvalue) "")) - (cons "others" - (mapconcat - (lambda (arg) (format "-%s" (substring (symbol-name arg) 1))) - others " ")) - ;; for easy table parsing, default header type should be -csv - (cons "csv" (if (or (member :csv others) (member :column others) - (member :line others) (member :list others) - (member :html others) separator) - "" - "-csv")) - (cons "db " db))) - ;; body of the code block - (org-babel-expand-body:sqlite body params))) - (org-babel-result-cond result-params - (buffer-string) - (if (equal (point-min) (point-max)) - "" - (org-table-convert-region (point-min) (point-max) - (if (or (member :csv others) - (member :column others) - (member :line others) - (member :list others) - (member :html others) separator) - nil - '(4))) - (org-babel-sqlite-table-or-scalar - (org-babel-sqlite-offset-colnames - (org-table-to-lisp) headers-p))))))) - -(defun org-babel-sqlite-expand-vars (body vars) - "Expand the variables held in VARS in BODY." - ;; FIXME: Redundancy with org-babel-sql-expand-vars! - (mapc - (lambda (pair) - (setq body - (replace-regexp-in-string - (format "\$%s" (car pair)) ;FIXME: "\$" == "$"! - (let ((val (cdr pair))) - (if (listp val) - (let ((data-file (org-babel-temp-file "sqlite-data-"))) - (with-temp-file data-file - (insert (orgtbl-to-csv - val '(:fmt (lambda (el) (if (stringp el) - el - (format "%S" el))))))) - data-file) - (if (stringp val) val (format "%S" val)))) - body))) - vars) - body) - -(defun org-babel-sqlite-table-or-scalar (result) - "If RESULT looks like a trivial table, then unwrap it." - (if (and (equal 1 (length result)) - (equal 1 (length (car result)))) - (org-babel-read (caar result)) - (mapcar (lambda (row) - (if (equal 'hline row) - 'hline - (mapcar #'org-babel-string-read row))) result))) - -(defun org-babel-sqlite-offset-colnames (table headers-p) - "If HEADERS-P is non-nil then offset the first row as column names." - (if headers-p - (cons (car table) (cons 'hline (cdr table))) - table)) - -(defun org-babel-prep-session:sqlite (session params) - "Raise an error because support for SQLite sessions isn't implemented. -Prepare SESSION according to the header arguments specified in PARAMS." - (error "SQLite sessions not yet implemented")) - -(provide 'ob-sqlite) - - - -;;; ob-sqlite.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-table.el b/xemacs-packages/lisp/org-8.2.3c/ob-table.el deleted file mode 100644 index c71bb875..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-table.el +++ /dev/null @@ -1,141 +0,0 @@ -;;; ob-table.el --- support for calling org-babel functions from tables - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Should allow calling functions from org-mode tables using the -;; function `sbe' as so... - -;; #+begin_src emacs-lisp :results silent -;; (defun fibbd (n) (if (< n 2) 1 (+ (fibbd (- n 1)) (fibbd (- n 2))))) -;; #+end_src - -;; #+name: fibbd -;; #+begin_src emacs-lisp :var n=2 :results silent -;; (fibbd n) -;; #+end_src - -;; | original | fibbd | -;; |----------+--------| -;; | 0 | | -;; | 1 | | -;; | 2 | | -;; | 3 | | -;; | 4 | | -;; | 5 | | -;; | 6 | | -;; | 7 | | -;; | 8 | | -;; | 9 | | -;; #+TBLFM: $2='(sbe 'fibbd (n $1)) - -;;; Code: -(require 'ob-core) - -(defun org-babel-table-truncate-at-newline (string) - "Replace newline character with ellipses. -If STRING ends in a newline character, then remove the newline -character and replace it with ellipses." - (if (and (stringp string) (string-match "[\n\r]\\(.\\)?" string)) - (concat (substring string 0 (match-beginning 0)) - (if (match-string 1 string) "...")) string)) - -(defmacro sbe (source-block &rest variables) ;FIXME: Namespace prefix! - "Return the results of calling SOURCE-BLOCK with VARIABLES. -Each element of VARIABLES should be a two -element list, whose first element is the name of the variable and -second element is a string of its value. The following call to -`sbe' would be equivalent to the following source code block. - - (sbe 'source-block (n $2) (m 3)) - -#+begin_src emacs-lisp :var results=source-block(n=val_at_col_2, m=3) :results silent -results -#+end_src - -NOTE: by default string variable names are interpreted as -references to source-code blocks, to force interpretation of a -cell's value as a string, prefix the identifier a \"$\" (e.g., -\"$$2\" instead of \"$2\" or \"$@2$2\" instead of \"@2$2\"). - -NOTE: it is also possible to pass header arguments to the code -block. In this case a table cell should hold the string value of -the header argument which can then be passed before all variables -as shown in the example below. - -| 1 | 2 | :file nothing.png | nothing.png | -#+TBLFM: @1$4='(sbe test-sbe $3 (x $1) (y $2))" - (declare (debug (form form))) - (let* ((header-args (if (stringp (car variables)) (car variables) "")) - (variables (if (stringp (car variables)) (cdr variables) variables))) - (let* (quote - (variables - (mapcar - (lambda (var) - ;; ensure that all cells prefixed with $'s are strings - (cons (car var) - (delq nil (mapcar - (lambda (el) - (if (eq '$ el) - (prog1 nil (setq quote t)) - (prog1 - (cond - (quote (format "\"%s\"" el)) - ((stringp el) (org-no-properties el)) - (t el)) - (setq quote nil)))) - (cdr var))))) - variables))) - (unless (stringp source-block) - (setq source-block (symbol-name source-block))) - (let ((result - (if (and source-block (> (length source-block) 0)) - (let ((params - ;; FIXME: Why `eval'?!?!? - (eval `(org-babel-parse-header-arguments - (concat - ":var results=" - ,source-block - "[" ,header-args "]" - "(" - (mapconcat - (lambda (var-spec) - (if (> (length (cdr var-spec)) 1) - (format "%S='%S" - (car var-spec) - (mapcar #'read (cdr var-spec))) - (format "%S=%s" - (car var-spec) (cadr var-spec)))) - ',variables ", ") - ")"))))) - (org-babel-execute-src-block - nil (list "emacs-lisp" "results" params) - '((:results . "silent")))) - ""))) - (org-babel-trim (if (stringp result) result (format "%S" result))))))) - -(provide 'ob-table) - - - -;;; ob-table.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob-tangle.el b/xemacs-packages/lisp/org-8.2.3c/ob-tangle.el deleted file mode 100644 index ffc74cb2..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob-tangle.el +++ /dev/null @@ -1,559 +0,0 @@ -;;; ob-tangle.el --- extract source code from org-mode files - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;; Extract the code from source blocks out into raw source-code files. - -;;; Code: -(require 'org-src) -(eval-when-compile - (require 'cl)) - -(declare-function org-edit-special "org" (&optional arg)) -(declare-function org-link-escape "org" (text &optional table)) -(declare-function org-store-link "org" (arg)) -(declare-function org-open-link-from-string "org" (s &optional arg reference-buffer)) -(declare-function org-heading-components "org" ()) -(declare-function org-back-to-heading "org" (invisible-ok)) -(declare-function org-fill-template "org" (template alist)) -(declare-function org-babel-update-block-body "org" (new-body)) -(declare-function make-directory "files" (dir &optional parents)) - -(defcustom org-babel-tangle-lang-exts - '(("emacs-lisp" . "el")) - "Alist mapping languages to their file extensions. -The key is the language name, the value is the string that should -be inserted as the extension commonly used to identify files -written in this language. If no entry is found in this list, -then the name of the language is used." - :group 'org-babel-tangle - :version "24.1" - :type '(repeat - (cons - (string "Language name") - (string "File Extension")))) - -(defcustom org-babel-post-tangle-hook nil - "Hook run in code files tangled by `org-babel-tangle'." - :group 'org-babel - :version "24.1" - :type 'hook) - -(defcustom org-babel-pre-tangle-hook '(save-buffer) - "Hook run at the beginning of `org-babel-tangle'." - :group 'org-babel - :version "24.1" - :type 'hook) - -(defcustom org-babel-tangle-body-hook nil - "Hook run over the contents of each code block body." - :group 'org-babel - :version "24.1" - :type 'hook) - -(defcustom org-babel-tangle-comment-format-beg "[[%link][%source-name]]" - "Format of inserted comments in tangled code files. -The following format strings can be used to insert special -information into the output using `org-fill-template'. -%start-line --- the line number at the start of the code block -%file --------- the file from which the code block was tangled -%link --------- Org-mode style link to the code block -%source-name -- name of the code block - -Whether or not comments are inserted during tangling is -controlled by the :comments header argument." - :group 'org-babel - :version "24.1" - :type 'string) - -(defcustom org-babel-tangle-comment-format-end "%source-name ends here" - "Format of inserted comments in tangled code files. -The following format strings can be used to insert special -information into the output using `org-fill-template'. -%start-line --- the line number at the start of the code block -%file --------- the file from which the code block was tangled -%link --------- Org-mode style link to the code block -%source-name -- name of the code block - -Whether or not comments are inserted during tangling is -controlled by the :comments header argument." - :group 'org-babel - :version "24.1" - :type 'string) - -(defcustom org-babel-process-comment-text #'org-babel-trim - "Function called to process raw Org-mode text collected to be -inserted as comments in tangled source-code files. The function -should take a single string argument and return a string -result. The default value is `org-babel-trim'." - :group 'org-babel - :version "24.1" - :type 'function) - -(defun org-babel-find-file-noselect-refresh (file) - "Find file ensuring that the latest changes on disk are -represented in the file." - (find-file-noselect file 'nowarn) - (with-current-buffer (get-file-buffer file) - (revert-buffer t t t))) - -(defmacro org-babel-with-temp-filebuffer (file &rest body) - "Open FILE into a temporary buffer execute BODY there like -`progn', then kill the FILE buffer returning the result of -evaluating BODY." - (declare (indent 1)) - (let ((temp-path (make-symbol "temp-path")) - (temp-result (make-symbol "temp-result")) - (temp-file (make-symbol "temp-file")) - (visited-p (make-symbol "visited-p"))) - `(let* ((,temp-path ,file) - (,visited-p (get-file-buffer ,temp-path)) - ,temp-result ,temp-file) - (org-babel-find-file-noselect-refresh ,temp-path) - (setf ,temp-file (get-file-buffer ,temp-path)) - (with-current-buffer ,temp-file - (setf ,temp-result (progn ,@body))) - (unless ,visited-p (kill-buffer ,temp-file)) - ,temp-result))) -(def-edebug-spec org-babel-with-temp-filebuffer (form body)) - -;;;###autoload -(defun org-babel-tangle-file (file &optional target-file lang) - "Extract the bodies of source code blocks in FILE. -Source code blocks are extracted with `org-babel-tangle'. -Optional argument TARGET-FILE can be used to specify a default -export file for all source blocks. Optional argument LANG can be -used to limit the exported source code blocks by language. -Return a list whose CAR is the tangled file name." - (interactive "fFile to tangle: \nP") - (let ((visited-p (get-file-buffer (expand-file-name file))) - to-be-removed) - (prog1 - (save-window-excursion - (find-file file) - (setq to-be-removed (current-buffer)) - (org-babel-tangle nil target-file lang)) - (unless visited-p - (kill-buffer to-be-removed))))) - -(defun org-babel-tangle-publish (_ filename pub-dir) - "Tangle FILENAME and place the results in PUB-DIR." - (mapc (lambda (el) (copy-file el pub-dir t)) (org-babel-tangle-file filename))) - -;;;###autoload -(defun org-babel-tangle (&optional arg target-file lang) - "Write code blocks to source-specific files. -Extract the bodies of all source code blocks from the current -file into their own source-specific files. -With one universal prefix argument, only tangle the block at point. -When two universal prefix arguments, only tangle blocks for the -tangle file of the block at point. -Optional argument TARGET-FILE can be used to specify a default -export file for all source blocks. Optional argument LANG can be -used to limit the exported source code blocks by language." - (interactive "P") - (run-hooks 'org-babel-pre-tangle-hook) - ;; Possibly Restrict the buffer to the current code block - (save-restriction - (when (equal arg '(4)) - (let ((head (org-babel-where-is-src-block-head))) - (if head - (goto-char head) - (user-error "Point is not in a source code block")))) - (save-excursion - (let ((block-counter 0) - (org-babel-default-header-args - (if target-file - (org-babel-merge-params org-babel-default-header-args - (list (cons :tangle target-file))) - org-babel-default-header-args)) - (tangle-file - (when (equal arg '(16)) - (or (cdr (assoc :tangle (nth 2 (org-babel-get-src-block-info 'light)))) - (user-error "Point is not in a source code block")))) - path-collector) - (mapc ;; map over all languages - (lambda (by-lang) - (let* ((lang (car by-lang)) - (specs (cdr by-lang)) - (ext (or (cdr (assoc lang org-babel-tangle-lang-exts)) lang)) - (lang-f (intern - (concat - (or (and (cdr (assoc lang org-src-lang-modes)) - (symbol-name - (cdr (assoc lang org-src-lang-modes)))) - lang) - "-mode"))) - she-banged) - (mapc - (lambda (spec) - (let ((get-spec (lambda (name) (cdr (assoc name (nth 4 spec)))))) - (let* ((tangle (funcall get-spec :tangle)) - (she-bang (let ((sheb (funcall get-spec :shebang))) - (when (> (length sheb) 0) sheb))) - (tangle-mode (funcall get-spec :tangle-mode)) - (base-name (cond - ((string= "yes" tangle) - (file-name-sans-extension - (buffer-file-name))) - ((string= "no" tangle) nil) - ((> (length tangle) 0) tangle))) - (file-name (when base-name - ;; decide if we want to add ext to base-name - (if (and ext (string= "yes" tangle)) - (concat base-name "." ext) base-name)))) - (when file-name - ;; Possibly create the parent directories for file. - (when (let ((m (funcall get-spec :mkdirp))) - (and m (not (string= m "no")))) - (make-directory (file-name-directory file-name) 'parents)) - ;; delete any old versions of file - (when (and (file-exists-p file-name) - (not (member file-name (mapcar #'car path-collector)))) - (delete-file file-name)) - ;; drop source-block to file - (with-temp-buffer - (when (fboundp lang-f) (ignore-errors (funcall lang-f))) - (when (and she-bang (not (member file-name she-banged))) - (insert (concat she-bang "\n")) - (setq she-banged (cons file-name she-banged))) - (org-babel-spec-to-string spec) - ;; We avoid append-to-file as it does not work with tramp. - (let ((content (buffer-string))) - (with-temp-buffer - (if (file-exists-p file-name) - (insert-file-contents file-name)) - (goto-char (point-max)) - (insert content) - (write-region nil nil file-name)))) - ;; if files contain she-bangs, then make the executable - (when she-bang - (unless tangle-mode (setq tangle-mode #o755))) - ;; update counter - (setq block-counter (+ 1 block-counter)) - (add-to-list 'path-collector - (cons file-name tangle-mode) - nil - (lambda (a b) (equal (car a) (car b)))))))) - specs))) - (if (equal arg '(4)) - (org-babel-tangle-single-block 1 t) - (org-babel-tangle-collect-blocks lang tangle-file))) - (message "Tangled %d code block%s from %s" block-counter - (if (= block-counter 1) "" "s") - (file-name-nondirectory - (buffer-file-name - (or (buffer-base-buffer) (current-buffer))))) - ;; run `org-babel-post-tangle-hook' in all tangled files - (when org-babel-post-tangle-hook - (mapc - (lambda (file) - (org-babel-with-temp-filebuffer file - (run-hooks 'org-babel-post-tangle-hook))) - (mapcar #'car path-collector))) - ;; set permissions on tangled files - (mapc (lambda (pair) - (when (cdr pair) (set-file-modes (car pair) (cdr pair)))) - path-collector) - (mapcar #'car path-collector))))) - -(defun org-babel-tangle-clean () - "Remove comments inserted by `org-babel-tangle'. -Call this function inside of a source-code file generated by -`org-babel-tangle' to remove all comments inserted automatically -by `org-babel-tangle'. Warning, this comment removes any lines -containing constructs which resemble org-mode file links or noweb -references." - (interactive) - (goto-char (point-min)) - (while (or (re-search-forward "\\[\\[file:.*\\]\\[.*\\]\\]" nil t) - (re-search-forward (org-babel-noweb-wrap) nil t)) - (delete-region (save-excursion (beginning-of-line 1) (point)) - (save-excursion (end-of-line 1) (forward-char 1) (point))))) - -(defvar org-stored-links) -(defvar org-bracket-link-regexp) -(defun org-babel-spec-to-string (spec) - "Insert SPEC into the current file. - -Insert the source-code specified by SPEC into the current source -code file. This function uses `comment-region' which assumes -that the appropriate major-mode is set. SPEC has the form: - - \(start-line file link source-name params body comment)" - (let* ((start-line (nth 0 spec)) - (file (nth 1 spec)) - (link (nth 2 spec)) - (source-name (nth 3 spec)) - (body (nth 5 spec)) - (comment (nth 6 spec)) - (comments (cdr (assoc :comments (nth 4 spec)))) - (padline (not (string= "no" (cdr (assoc :padline (nth 4 spec)))))) - (link-p (or (string= comments "both") (string= comments "link") - (string= comments "yes") (string= comments "noweb"))) - (link-data (mapcar (lambda (el) - (cons (symbol-name el) - (let ((le (eval el))) - (if (stringp le) le (format "%S" le))))) - '(start-line file link source-name))) - (insert-comment (lambda (text) - (when (and comments (not (string= comments "no")) - (> (length text) 0)) - (when padline (insert "\n")) - (comment-region (point) (progn (insert text) (point))) - (end-of-line nil) (insert "\n"))))) - (when comment (funcall insert-comment comment)) - (when link-p - (funcall - insert-comment - (org-fill-template org-babel-tangle-comment-format-beg link-data))) - (when padline (insert "\n")) - (insert - (format - "%s\n" - (org-unescape-code-in-string - (org-babel-trim body (if org-src-preserve-indentation "[\f\n\r\v]"))))) - (when link-p - (funcall - insert-comment - (org-fill-template org-babel-tangle-comment-format-end link-data))))) - -(defvar org-comment-string) ;; Defined in org.el -(defun org-babel-tangle-collect-blocks (&optional language tangle-file) - "Collect source blocks in the current Org-mode file. -Return an association list of source-code block specifications of -the form used by `org-babel-spec-to-string' grouped by language. -Optional argument LANGUAGE can be used to limit the collected -source code blocks by language. Optional argument TANGLE-FILE -can be used to limit the collected code blocks by target file." - (let ((block-counter 1) (current-heading "") blocks by-lang) - (org-babel-map-src-blocks (buffer-file-name) - (lambda (new-heading) - (if (not (string= new-heading current-heading)) - (progn - (setq block-counter 1) - (setq current-heading new-heading)) - (setq block-counter (+ 1 block-counter)))) - (replace-regexp-in-string "[ \t]" "-" - (condition-case nil - (or (nth 4 (org-heading-components)) - "(dummy for heading without text)") - (error (buffer-file-name)))) - (let* ((info (org-babel-get-src-block-info 'light)) - (src-lang (nth 0 info)) - (src-tfile (cdr (assoc :tangle (nth 2 info))))) - (unless (or (string-match (concat "^" org-comment-string) current-heading) - (string= (cdr (assoc :tangle (nth 2 info))) "no") - (and tangle-file (not (equal tangle-file src-tfile)))) - (unless (and language (not (string= language src-lang))) - ;; Add the spec for this block to blocks under it's language - (setq by-lang (cdr (assoc src-lang blocks))) - (setq blocks (delq (assoc src-lang blocks) blocks)) - (setq blocks (cons - (cons src-lang - (cons - (org-babel-tangle-single-block - block-counter) - by-lang)) blocks)))))) - ;; Ensure blocks are in the correct order - (setq blocks - (mapcar - (lambda (by-lang) (cons (car by-lang) (reverse (cdr by-lang)))) - blocks)) - blocks)) - -(defun org-babel-tangle-single-block - (block-counter &optional only-this-block) - "Collect the tangled source for current block. -Return the list of block attributes needed by -`org-babel-tangle-collect-blocks'. -When ONLY-THIS-BLOCK is non-nil, return the full association -list to be used by `org-babel-tangle' directly." - (let* ((info (org-babel-get-src-block-info)) - (start-line - (save-restriction (widen) - (+ 1 (line-number-at-pos (point))))) - (file (buffer-file-name)) - (src-lang (nth 0 info)) - (params (nth 2 info)) - (extra (nth 3 info)) - (cref-fmt (or (and (string-match "-l \"\\(.+\\)\"" extra) - (match-string 1 extra)) - org-coderef-label-format)) - (link (let ((link (org-no-properties - (org-store-link nil)))) - (and (string-match org-bracket-link-regexp link) - (match-string 1 link)))) - (source-name - (intern (or (nth 4 info) - (format "%s:%d" - (or (ignore-errors (nth 4 (org-heading-components))) - "No heading") - block-counter)))) - (expand-cmd - (intern (concat "org-babel-expand-body:" src-lang))) - (assignments-cmd - (intern (concat "org-babel-variable-assignments:" src-lang))) - (body - ;; Run the tangle-body-hook. - (let* ((body ;; Expand the body in language specific manner. - (if (org-babel-noweb-p params :tangle) - (org-babel-expand-noweb-references info) - (nth 1 info))) - (body - (if (assoc :no-expand params) - body - (if (fboundp expand-cmd) - (funcall expand-cmd body params) - (org-babel-expand-body:generic - body params - (and (fboundp assignments-cmd) - (funcall assignments-cmd params))))))) - (with-temp-buffer - (insert body) - (when (string-match "-r" extra) - (goto-char (point-min)) - (while (re-search-forward - (replace-regexp-in-string "%s" ".+" cref-fmt) nil t) - (replace-match ""))) - (run-hooks 'org-babel-tangle-body-hook) - (buffer-string)))) - (comment - (when (or (string= "both" (cdr (assoc :comments params))) - (string= "org" (cdr (assoc :comments params)))) - ;; From the previous heading or code-block end - (funcall - org-babel-process-comment-text - (buffer-substring - (max (condition-case nil - (save-excursion - (org-back-to-heading t) ; Sets match data - (match-end 0)) - (error (point-min))) - (save-excursion - (if (re-search-backward - org-babel-src-block-regexp nil t) - (match-end 0) - (point-min)))) - (point))))) - (result - (list start-line file link source-name params body comment))) - (if only-this-block - (list (cons src-lang (list result))) - result))) - -(defun org-babel-tangle-comment-links ( &optional info) - "Return a list of begin and end link comments for the code block at point." - (let* ((start-line (org-babel-where-is-src-block-head)) - (file (buffer-file-name)) - (link (org-link-escape (progn (call-interactively 'org-store-link) - (org-no-properties - (car (pop org-stored-links)))))) - (source-name (nth 4 (or info (org-babel-get-src-block-info 'light)))) - (link-data (mapcar (lambda (el) - (cons (symbol-name el) - (let ((le (eval el))) - (if (stringp le) le (format "%S" le))))) - '(start-line file link source-name)))) - (list (org-fill-template org-babel-tangle-comment-format-beg link-data) - (org-fill-template org-babel-tangle-comment-format-end link-data)))) - -;; de-tangling functions -(defvar org-bracket-link-analytic-regexp) -(defun org-babel-detangle (&optional source-code-file) - "Propagate changes in source file back original to Org-mode file. -This requires that code blocks were tangled with link comments -which enable the original code blocks to be found." - (interactive) - (save-excursion - (when source-code-file (find-file source-code-file)) - (goto-char (point-min)) - (let ((counter 0) new-body end) - (while (re-search-forward org-bracket-link-analytic-regexp nil t) - (when (re-search-forward - (concat " " (regexp-quote (match-string 5)) " ends here")) - (setq end (match-end 0)) - (forward-line -1) - (save-excursion - (when (setq new-body (org-babel-tangle-jump-to-org)) - (org-babel-update-block-body new-body))) - (setq counter (+ 1 counter))) - (goto-char end)) - (prog1 counter (message "Detangled %d code blocks" counter))))) - -(defun org-babel-tangle-jump-to-org () - "Jump from a tangled code file to the related Org-mode file." - (interactive) - (let ((mid (point)) - start body-start end done - target-buffer target-char link path block-name body) - (save-window-excursion - (save-excursion - (while (and (re-search-backward org-bracket-link-analytic-regexp nil t) - (not ; ever wider searches until matching block comments - (and (setq start (point-at-eol)) - (setq body-start (save-excursion - (forward-line 2) (point-at-bol))) - (setq link (match-string 0)) - (setq path (match-string 3)) - (setq block-name (match-string 5)) - (save-excursion - (save-match-data - (re-search-forward - (concat " " (regexp-quote block-name) - " ends here") nil t) - (setq end (point-at-bol)))))))) - (unless (and start (< start mid) (< mid end)) - (error "Not in tangled code")) - (setq body (org-babel-trim (buffer-substring start end)))) - (when (string-match "::" path) - (setq path (substring path 0 (match-beginning 0)))) - (find-file path) (setq target-buffer (current-buffer)) - (goto-char start) (org-open-link-from-string link) - (if (string-match "[^ \t\n\r]:\\([[:digit:]]+\\)" block-name) - (org-babel-next-src-block - (string-to-number (match-string 1 block-name))) - (org-babel-goto-named-src-block block-name)) - ;; position at the beginning of the code block body - (goto-char (org-babel-where-is-src-block-head)) - (forward-line 1) - ;; Use org-edit-special to isolate the code. - (org-edit-special) - ;; Then move forward the correct number of characters in the - ;; code buffer. - (forward-char (- mid body-start)) - ;; And return to the Org-mode buffer with the point in the right - ;; place. - (org-edit-src-exit) - (setq target-char (point))) - (org-src-switch-to-buffer target-buffer t) - (prog1 body (goto-char target-char)))) - -(provide 'ob-tangle) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ob-tangle.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ob.el b/xemacs-packages/lisp/org-8.2.3c/ob.el deleted file mode 100644 index 827dd04a..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ob.el +++ /dev/null @@ -1,43 +0,0 @@ -;;; ob.el --- working with code blocks in org-mode - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Authors: Eric Schulte -;; Keywords: literate programming, reproducible research -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Code: -(require 'org-macs) -(require 'org-compat) -(require 'ob-eval) -(require 'ob-core) -(require 'ob-comint) -(require 'ob-exp) -(require 'ob-keys) -(require 'ob-table) -(require 'ob-lob) -(require 'ob-ref) -(require 'ob-tangle) - -(provide 'ob) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ob.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-agenda.el b/xemacs-packages/lisp/org-8.2.3c/org-agenda.el deleted file mode 100644 index 8bf122db..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-agenda.el +++ /dev/null @@ -1,10108 +0,0 @@ -;;; org-agenda.el --- Dynamic task and appointment lists for Org - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file contains the code for creating and using the Agenda for Org-mode. -;; -;; The functions `org-batch-agenda', `org-batch-agenda-csv', and -;; `org-batch-store-agenda-views' are implemented as macros to provide -;; a convenient way for extracting agenda information from the command -;; line. The Lisp does not evaluate parameters of a macro call; thus -;; it is not necessary to quote the parameters passed to one of those -;; functions. E.g. you can write: -;; -;; emacs -batch -l ~/.emacs -eval '(org-batch-agenda "a" org-agenda-span 7)' -;; -;; To export an agenda spanning 7 days. If `org-batch-agenda' would -;; have been implemented as a regular function you'd have to quote the -;; symbol org-agenda-span. Moreover: To use a symbol as parameter -;; value you would have to double quote the symbol. -;; -;; This is a hack, but it works even when running Org byte-compiled. -;; - -;;; Code: - -(require 'org) -(require 'org-macs) -(eval-when-compile - (require 'cl)) - -(declare-function diary-add-to-list "diary-lib" - (date string specifier &optional marker globcolor literal)) -(declare-function calendar-absolute-from-iso "cal-iso" (date)) -(declare-function calendar-astro-date-string "cal-julian" (&optional date)) -(declare-function calendar-bahai-date-string "cal-bahai" (&optional date)) -(declare-function calendar-chinese-date-string "cal-china" (&optional date)) -(declare-function calendar-coptic-date-string "cal-coptic" (&optional date)) -(declare-function calendar-ethiopic-date-string "cal-coptic" (&optional date)) -(declare-function calendar-french-date-string "cal-french" (&optional date)) -(declare-function calendar-goto-date "cal-move" (date)) -(declare-function calendar-hebrew-date-string "cal-hebrew" (&optional date)) -(declare-function calendar-islamic-date-string "cal-islam" (&optional date)) -(declare-function calendar-iso-date-string "cal-iso" (&optional date)) -(declare-function calendar-iso-from-absolute "cal-iso" (date)) -(declare-function calendar-julian-date-string "cal-julian" (&optional date)) -(declare-function calendar-mayan-date-string "cal-mayan" (&optional date)) -(declare-function calendar-persian-date-string "cal-persia" (&optional date)) -(declare-function calendar-check-holidays "holidays" (date)) - -(declare-function org-datetree-find-date-create "org-datetree" - (date &optional keep-restriction)) -(declare-function org-columns-quit "org-colview" ()) -(declare-function diary-date-display-form "diary-lib" (&optional type)) -(declare-function org-mobile-write-agenda-for-mobile "org-mobile" (file)) -(declare-function org-habit-insert-consistency-graphs - "org-habit" (&optional line)) -(declare-function org-is-habit-p "org-habit" (&optional pom)) -(declare-function org-habit-parse-todo "org-habit" (&optional pom)) -(declare-function org-habit-get-priority "org-habit" (habit &optional moment)) -(declare-function org-pop-to-buffer-same-window "org-compat" - (&optional buffer-or-name norecord label)) -(declare-function org-agenda-columns "org-colview" ()) -(declare-function org-add-archive-files "org-archive" (files)) -(declare-function org-capture "org-capture" (&optional goto keys)) - -(defvar calendar-mode-map) ; defined in calendar.el -(defvar org-clock-current-task nil) ; defined in org-clock.el -(defvar org-mobile-force-id-on-agenda-items) ; defined in org-mobile.el -(defvar org-habit-show-habits) ; defined in org-habit.el -(defvar org-habit-show-habits-only-for-today) -(defvar org-habit-show-all-today) - -;; Defined somewhere in this file, but used before definition. -(defvar org-agenda-buffer-name "*Org Agenda*") -(defvar org-agenda-overriding-header nil) -(defvar org-agenda-title-append nil) -(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el -(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el -(defvar original-date) ; dynamically scoped, calendar.el does scope this - -(defvar org-agenda-undo-list nil - "List of undoable operations in the agenda since last refresh.") -(defvar org-agenda-pending-undo-list nil - "In a series of undo commands, this is the list of remaining undo items.") - -(defcustom org-agenda-confirm-kill 1 - "When set, remote killing from the agenda buffer needs confirmation. -When t, a confirmation is always needed. When a number N, confirmation is -only needed when the text to be killed contains more than N non-white lines." - :group 'org-agenda - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (integer :tag "When more than N lines"))) - -(defcustom org-agenda-compact-blocks nil - "Non-nil means make the block agenda more compact. -This is done globally by leaving out lines like the agenda span -name and week number or the separator lines." - :group 'org-agenda - :type 'boolean) - -(defcustom org-agenda-block-separator ?= - "The separator between blocks in the agenda. -If this is a string, it will be used as the separator, with a newline added. -If it is a character, it will be repeated to fill the window width. -If nil the separator is disabled. In `org-agenda-custom-commands' this -addresses the separator between the current and the previous block." - :group 'org-agenda - :type '(choice - (const :tag "Disabled" nil) - (character) - (string))) - -(defgroup org-agenda-export nil - "Options concerning exporting agenda views in Org-mode." - :tag "Org Agenda Export" - :group 'org-agenda) - -(defcustom org-agenda-with-colors t - "Non-nil means use colors in agenda views." - :group 'org-agenda-export - :type 'boolean) - -(defcustom org-agenda-exporter-settings nil - "Alist of variable/value pairs that should be active during agenda export. -This is a good place to set options for ps-print and for htmlize. -Note that the way this is implemented, the values will be evaluated -before assigned to the variables. So make sure to quote values you do -*not* want evaluated, for example - - (setq org-agenda-exporter-settings - '((ps-print-color-p 'black-white)))" - :group 'org-agenda-export - :type '(repeat - (list - (variable) - (sexp :tag "Value")))) - -(defcustom org-agenda-before-write-hook '(org-agenda-add-entry-text) - "Hook run in a temporary buffer before writing the agenda to an export file. -A useful function for this hook is `org-agenda-add-entry-text'." - :group 'org-agenda-export - :type 'hook - :options '(org-agenda-add-entry-text)) - -(defcustom org-agenda-add-entry-text-maxlines 0 - "Maximum number of entry text lines to be added to agenda. -This is only relevant when `org-agenda-add-entry-text' is part of -`org-agenda-before-write-hook', which is the default. -When this is 0, nothing will happen. When it is greater than 0, it -specifies the maximum number of lines that will be added for each entry -that is listed in the agenda view. - -Note that this variable is not used during display, only when exporting -the agenda. For agenda display, see the variables `org-agenda-entry-text-mode' -and `org-agenda-entry-text-maxlines'." - :group 'org-agenda - :type 'integer) - -(defcustom org-agenda-add-entry-text-descriptive-links t - "Non-nil means export org-links as descriptive links in agenda added text. -This variable applies to the text added to the agenda when -`org-agenda-add-entry-text-maxlines' is larger than 0. -When this variable nil, the URL will (also) be shown." - :group 'org-agenda - :type 'boolean) - -(defcustom org-agenda-export-html-style nil - "The style specification for exported HTML Agenda files. -If this variable contains a string, it will replace the default - -or, if you want to keep the style in a file, - - - -As the value of this option simply gets inserted into the HTML header, -you can \"misuse\" it to also add other text to the header." - :group 'org-agenda-export - :group 'org-export-html - :type '(choice - (const nil) - (string))) - -(defcustom org-agenda-persistent-filter nil - "When set, keep filters from one agenda view to the next." - :group 'org-agenda - :type 'boolean) - -(defgroup org-agenda-custom-commands nil - "Options concerning agenda views in Org-mode." - :tag "Org Agenda Custom Commands" - :group 'org-agenda) - -(defconst org-sorting-choice - '(choice - (const time-up) (const time-down) - (const timestamp-up) (const timestamp-down) - (const scheduled-up) (const scheduled-down) - (const deadline-up) (const deadline-down) - (const ts-up) (const ts-down) - (const tsia-up) (const tsia-down) - (const category-keep) (const category-up) (const category-down) - (const tag-down) (const tag-up) - (const priority-up) (const priority-down) - (const todo-state-up) (const todo-state-down) - (const effort-up) (const effort-down) - (const habit-up) (const habit-down) - (const alpha-up) (const alpha-down) - (const user-defined-up) (const user-defined-down)) - "Sorting choices.") - -;; Keep custom values for `org-agenda-filter-preset' compatible with -;; the new variable `org-agenda-tag-filter-preset'. -(org-defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset) -(org-defvaralias 'org-agenda-filter 'org-agenda-tag-filter) - -(defvar org-agenda-entry-types '(:deadline :scheduled :timestamp :sexp) - "List of types searched for when creating the daily/weekly agenda. -This variable is a list of symbols that controls the types of -items that appear in the daily/weekly agenda. Allowed symbols in this -list are are - - :timestamp List items containing a date stamp or date range matching - the selected date. This includes sexp entries in angular - brackets. - - :sexp List entries resulting from plain diary-like sexps. - - :deadline List deadline due on that date. When the date is today, - also list any deadlines past due, or due within - `org-deadline-warning-days'. `:deadline' must appear before - `:scheduled' if the setting of - `org-agenda-skip-scheduled-if-deadline-is-shown' is to have - any effect. - - :deadline* Same as above, but only include the deadline if it has an - hour specification as [h]h:mm. - - :scheduled List all items which are scheduled for the given date. - The diary for *today* also contains items which were - scheduled earlier and are not yet marked DONE. - - :scheduled* Same as above, but only include the scheduled item if it - has an hour specification as [h]h:mm. - -By default, all four non-starred types are turned on. - -When :scheduled* or :deadline* are included, :schedule or :deadline -will be ignored. - -Never set this variable globally using `setq', because then it -will apply to all future agenda commands. Instead, bind it with -`let' to scope it dynamically into the agenda-constructing -command. A good way to set it is through options in -`org-agenda-custom-commands'. For a more flexible (though -somewhat less efficient) way of determining what is included in -the daily/weekly agenda, see `org-agenda-skip-function'.") - -(defconst org-agenda-custom-commands-local-options - `(repeat :tag "Local settings for this command. Remember to quote values" - (choice :tag "Setting" - (list :tag "Heading for this block" - (const org-agenda-overriding-header) - (string :tag "Headline")) - (list :tag "Files to be searched" - (const org-agenda-files) - (list - (const :format "" quote) - (repeat (file)))) - (list :tag "Sorting strategy" - (const org-agenda-sorting-strategy) - (list - (const :format "" quote) - (repeat - ,org-sorting-choice))) - (list :tag "Prefix format" - (const org-agenda-prefix-format :value " %-12:c%?-12t% s") - (string)) - (list :tag "Number of days in agenda" - (const org-agenda-span) - (choice (const :tag "Day" 'day) - (const :tag "Week" 'week) - (const :tag "Fortnight" 'fortnight) - (const :tag "Month" 'month) - (const :tag "Year" 'year) - (integer :tag "Custom"))) - (list :tag "Fixed starting date" - (const org-agenda-start-day) - (string :value "2007-11-01")) - (list :tag "Start on day of week" - (const org-agenda-start-on-weekday) - (choice :value 1 - (const :tag "Today" nil) - (integer :tag "Weekday No."))) - (list :tag "Include data from diary" - (const org-agenda-include-diary) - (boolean)) - (list :tag "Deadline Warning days" - (const org-deadline-warning-days) - (integer :value 1)) - (list :tag "Category filter preset" - (const org-agenda-category-filter-preset) - (list - (const :format "" quote) - (repeat - (string :tag "+category or -category")))) - (list :tag "Tags filter preset" - (const org-agenda-tag-filter-preset) - (list - (const :format "" quote) - (repeat - (string :tag "+tag or -tag")))) - (list :tag "Regexp filter preset" - (const org-agenda-regexp-filter-preset) - (list - (const :format "" quote) - (repeat - (string :tag "+regexp or -regexp")))) - (list :tag "Set daily/weekly entry types" - (const org-agenda-entry-types) - (list - (const :format "" quote) - (set :greedy t :value ,org-agenda-entry-types - (const :deadline) - (const :scheduled) - (const :deadline*) - (const :scheduled*) - (const :timestamp) - (const :sexp)))) - (list :tag "Standard skipping condition" - :value (org-agenda-skip-function '(org-agenda-skip-entry-if)) - (const org-agenda-skip-function) - (list - (const :format "" quote) - (list - (choice - :tag "Skipping range" - (const :tag "Skip entry" org-agenda-skip-entry-if) - (const :tag "Skip subtree" org-agenda-skip-subtree-if)) - (repeat :inline t :tag "Conditions for skipping" - (choice - :tag "Condition type" - (list :tag "Regexp matches" :inline t (const :format "" 'regexp) (regexp)) - (list :tag "Regexp does not match" :inline t (const :format "" 'notregexp) (regexp)) - (list :tag "TODO state is" :inline t - (const 'todo) - (choice - (const :tag "any not-done state" 'todo) - (const :tag "any done state" 'done) - (const :tag "any state" 'any) - (list :tag "Keyword list" - (const :format "" quote) - (repeat (string :tag "Keyword"))))) - (list :tag "TODO state is not" :inline t - (const 'nottodo) - (choice - (const :tag "any not-done state" 'todo) - (const :tag "any done state" 'done) - (const :tag "any state" 'any) - (list :tag "Keyword list" - (const :format "" quote) - (repeat (string :tag "Keyword"))))) - (const :tag "scheduled" 'scheduled) - (const :tag "not scheduled" 'notscheduled) - (const :tag "deadline" 'deadline) - (const :tag "no deadline" 'notdeadline) - (const :tag "timestamp" 'timestamp) - (const :tag "no timestamp" 'nottimestamp)))))) - (list :tag "Non-standard skipping condition" - :value (org-agenda-skip-function) - (const org-agenda-skip-function) - (sexp :tag "Function or form (quoted!)")) - (list :tag "Any variable" - (variable :tag "Variable") - (sexp :tag "Value (sexp)")))) - "Selection of examples for agenda command settings. -This will be spliced into the custom type of -`org-agenda-custom-commands'.") - - -(defcustom org-agenda-custom-commands - '(("n" "Agenda and all TODO's" ((agenda "") (alltodo "")))) - "Custom commands for the agenda. -These commands will be offered on the splash screen displayed by the -agenda dispatcher \\[org-agenda]. Each entry is a list like this: - - (key desc type match settings files) - -key The key (one or more characters as a string) to be associated - with the command. -desc A description of the command, when omitted or nil, a default - description is built using MATCH. -type The command type, any of the following symbols: - agenda The daily/weekly agenda. - todo Entries with a specific TODO keyword, in all agenda files. - search Entries containing search words entry or headline. - tags Tags/Property/TODO match in all agenda files. - tags-todo Tags/P/T match in all agenda files, TODO entries only. - todo-tree Sparse tree of specific TODO keyword in *current* file. - tags-tree Sparse tree with all tags matches in *current* file. - occur-tree Occur sparse tree for *current* file. - ... A user-defined function. -match What to search for: - - a single keyword for TODO keyword searches - - a tags match expression for tags searches - - a word search expression for text searches. - - a regular expression for occur searches - For all other commands, this should be the empty string. -settings A list of option settings, similar to that in a let form, so like - this: ((opt1 val1) (opt2 val2) ...). The values will be - evaluated at the moment of execution, so quote them when needed. -files A list of files file to write the produced agenda buffer to - with the command `org-store-agenda-views'. - If a file name ends in \".html\", an HTML version of the buffer - is written out. If it ends in \".ps\", a postscript version is - produced. Otherwise, only the plain text is written to the file. - -You can also define a set of commands, to create a composite agenda buffer. -In this case, an entry looks like this: - - (key desc (cmd1 cmd2 ...) general-settings-for-whole-set files) - -where - -desc A description string to be displayed in the dispatcher menu. -cmd An agenda command, similar to the above. However, tree commands - are not allowed, but instead you can get agenda and global todo list. - So valid commands for a set are: - (agenda \"\" settings) - (alltodo \"\" settings) - (stuck \"\" settings) - (todo \"match\" settings files) - (search \"match\" settings files) - (tags \"match\" settings files) - (tags-todo \"match\" settings files) - -Each command can carry a list of options, and another set of options can be -given for the whole set of commands. Individual command options take -precedence over the general options. - -When using several characters as key to a command, the first characters -are prefix commands. For the dispatcher to display useful information, you -should provide a description for the prefix, like - - (setq org-agenda-custom-commands - '((\"h\" . \"HOME + Name tag searches\") ; describe prefix \"h\" - (\"hl\" tags \"+HOME+Lisa\") - (\"hp\" tags \"+HOME+Peter\") - (\"hk\" tags \"+HOME+Kim\")))" - :group 'org-agenda-custom-commands - :type `(repeat - (choice :value ("x" "Describe command here" tags "" nil) - (list :tag "Single command" - (string :tag "Access Key(s) ") - (option (string :tag "Description")) - (choice - (const :tag "Agenda" agenda) - (const :tag "TODO list" alltodo) - (const :tag "Search words" search) - (const :tag "Stuck projects" stuck) - (const :tag "Tags/Property match (all agenda files)" tags) - (const :tag "Tags/Property match of TODO entries (all agenda files)" tags-todo) - (const :tag "TODO keyword search (all agenda files)" todo) - (const :tag "Tags sparse tree (current buffer)" tags-tree) - (const :tag "TODO keyword tree (current buffer)" todo-tree) - (const :tag "Occur tree (current buffer)" occur-tree) - (sexp :tag "Other, user-defined function")) - (string :tag "Match (only for some commands)") - ,org-agenda-custom-commands-local-options - (option (repeat :tag "Export" (file :tag "Export to")))) - (list :tag "Command series, all agenda files" - (string :tag "Access Key(s)") - (string :tag "Description ") - (repeat :tag "Component" - (choice - (list :tag "Agenda" - (const :format "" agenda) - (const :tag "" :format "" "") - ,org-agenda-custom-commands-local-options) - (list :tag "TODO list (all keywords)" - (const :format "" alltodo) - (const :tag "" :format "" "") - ,org-agenda-custom-commands-local-options) - (list :tag "Search words" - (const :format "" search) - (string :tag "Match") - ,org-agenda-custom-commands-local-options) - (list :tag "Stuck projects" - (const :format "" stuck) - (const :tag "" :format "" "") - ,org-agenda-custom-commands-local-options) - (list :tag "Tags search" - (const :format "" tags) - (string :tag "Match") - ,org-agenda-custom-commands-local-options) - (list :tag "Tags search, TODO entries only" - (const :format "" tags-todo) - (string :tag "Match") - ,org-agenda-custom-commands-local-options) - (list :tag "TODO keyword search" - (const :format "" todo) - (string :tag "Match") - ,org-agenda-custom-commands-local-options) - (list :tag "Other, user-defined function" - (symbol :tag "function") - (string :tag "Match") - ,org-agenda-custom-commands-local-options))) - - (repeat :tag "Settings for entire command set" - (list (variable :tag "Any variable") - (sexp :tag "Value"))) - (option (repeat :tag "Export" (file :tag "Export to")))) - (cons :tag "Prefix key documentation" - (string :tag "Access Key(s)") - (string :tag "Description "))))) - -(defcustom org-agenda-query-register ?o - "The register holding the current query string. -The purpose of this is that if you construct a query string interactively, -you can then use it to define a custom command." - :group 'org-agenda-custom-commands - :type 'character) - -(defcustom org-stuck-projects - '("+LEVEL=2/-DONE" ("TODO" "NEXT" "NEXTACTION") nil "") - "How to identify stuck projects. -This is a list of four items: -1. A tags/todo/property matcher string that is used to identify a project. - See the manual for a description of tag and property searches. - The entire tree below a headline matched by this is considered one project. -2. A list of TODO keywords identifying non-stuck projects. - If the project subtree contains any headline with one of these todo - keywords, the project is considered to be not stuck. If you specify - \"*\" as a keyword, any TODO keyword will mark the project unstuck. -3. A list of tags identifying non-stuck projects. - If the project subtree contains any headline with one of these tags, - the project is considered to be not stuck. If you specify \"*\" as - a tag, any tag will mark the project unstuck. Note that this is about - the explicit presence of a tag somewhere in the subtree, inherited - tags do not count here. If inherited tags make a project not stuck, - use \"-TAG\" in the tags part of the matcher under (1.) above. -4. An arbitrary regular expression matching non-stuck projects. - -If the project turns out to be not stuck, search continues also in the -subtree to see if any of the subtasks have project status. - -See also the variable `org-tags-match-list-sublevels' which applies -to projects matched by this search as well. - -After defining this variable, you may use \\[org-agenda-list-stuck-projects] -or `C-c a #' to produce the list." - :group 'org-agenda-custom-commands - :type '(list - (string :tag "Tags/TODO match to identify a project") - (repeat :tag "Projects are *not* stuck if they have an entry with TODO keyword any of" (string)) - (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string)) - (regexp :tag "Projects are *not* stuck if this regexp matches inside the subtree"))) - -(defcustom org-agenda-filter-effort-default-operator "<" - "The default operator for effort estimate filtering. -If you select an effort estimate limit without first pressing an operator, -this one will be used." - :group 'org-agenda-custom-commands - :type '(choice (const :tag "less or equal" "<") - (const :tag "greater or equal"">") - (const :tag "equal" "="))) - -(defgroup org-agenda-skip nil - "Options concerning skipping parts of agenda files." - :tag "Org Agenda Skip" - :group 'org-agenda) - -(defcustom org-agenda-skip-function-global nil - "Function to be called at each match during agenda construction. -If this function returns nil, the current match should not be skipped. -If the function decided to skip an agenda match, is must return the -buffer position from which the search should be continued. -This may also be a Lisp form, which will be evaluated. - -This variable will be applied to every agenda match, including -tags/property searches and TODO lists. So try to make the test function -do its checking as efficiently as possible. To implement a skipping -condition just for specific agenda commands, use the variable -`org-agenda-skip-function' which can be set in the options section -of custom agenda commands." - :group 'org-agenda-skip - :type 'sexp) - -(defgroup org-agenda-daily/weekly nil - "Options concerning the daily/weekly agenda." - :tag "Org Agenda Daily/Weekly" - :group 'org-agenda) -(defgroup org-agenda-todo-list nil - "Options concerning the global todo list agenda view." - :tag "Org Agenda Todo List" - :group 'org-agenda) -(defgroup org-agenda-match-view nil - "Options concerning the general tags/property/todo match agenda view." - :tag "Org Agenda Match View" - :group 'org-agenda) -(defgroup org-agenda-search-view nil - "Options concerning the general tags/property/todo match agenda view." - :tag "Org Agenda Match View" - :group 'org-agenda) - -(defvar org-agenda-archives-mode nil - "Non-nil means the agenda will include archived items. -If this is the symbol `trees', trees in the selected agenda scope -that are marked with the ARCHIVE tag will be included anyway. When this is -t, also all archive files associated with the current selection of agenda -files will be included.") - -(defcustom org-agenda-restriction-lock-highlight-subtree t - "Non-nil means highlight the whole subtree when restriction is active. -Otherwise only highlight the headline. Highlighting the whole subtree is -useful to ensure no edits happen beyond the restricted region." - :group 'org-agenda - :type 'boolean) - -(defcustom org-agenda-skip-comment-trees t - "Non-nil means skip trees that start with the COMMENT keyword. -When nil, these trees are also scanned by agenda commands." - :group 'org-agenda-skip - :type 'boolean) - -(defcustom org-agenda-todo-list-sublevels t - "Non-nil means check also the sublevels of a TODO entry for TODO entries. -When nil, the sublevels of a TODO entry are not checked, resulting in -potentially much shorter TODO lists." - :group 'org-agenda-skip - :group 'org-agenda-todo-list - :type 'boolean) - -(defcustom org-agenda-todo-ignore-with-date nil - "Non-nil means don't show entries with a date in the global todo list. -You can use this if you prefer to mark mere appointments with a TODO keyword, -but don't want them to show up in the TODO list. -When this is set, it also covers deadlines and scheduled items, the settings -of `org-agenda-todo-ignore-scheduled' and `org-agenda-todo-ignore-deadlines' -will be ignored. -See also the variable `org-agenda-tags-todo-honor-ignore-options'." - :group 'org-agenda-skip - :group 'org-agenda-todo-list - :type 'boolean) - -(defcustom org-agenda-todo-ignore-timestamp nil - "Non-nil means don't show entries with a timestamp. -This applies when creating the global todo list. -Valid values are: - -past Don't show entries for today or in the past. - -future Don't show entries with a timestamp in the future. - The idea behind this is that if it has a future - timestamp, you don't want to think about it until the - date. - -all Don't show any entries with a timestamp in the global todo list. - The idea behind this is that by setting a timestamp, you - have already \"taken care\" of this item. - -This variable can also have an integer as a value. If positive (N), -todos with a timestamp N or more days in the future will be ignored. If -negative (-N), todos with a timestamp N or more days in the past will be -ignored. If 0, todos with a timestamp either today or in the future will -be ignored. For example, a value of -1 will exclude todos with a -timestamp in the past (yesterday or earlier), while a value of 7 will -exclude todos with a timestamp a week or more in the future. - -See also `org-agenda-todo-ignore-with-date'. -See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want -to make his option also apply to the tags-todo list." - :group 'org-agenda-skip - :group 'org-agenda-todo-list - :version "24.1" - :type '(choice - (const :tag "Ignore future timestamp todos" future) - (const :tag "Ignore past or present timestamp todos" past) - (const :tag "Ignore all timestamp todos" all) - (const :tag "Show timestamp todos" nil) - (integer :tag "Ignore if N or more days in past(-) or future(+)."))) - -(defcustom org-agenda-todo-ignore-scheduled nil - "Non-nil means, ignore some scheduled TODO items when making TODO list. -This applies when creating the global todo list. -Valid values are: - -past Don't show entries scheduled today or in the past. - -future Don't show entries scheduled in the future. - The idea behind this is that by scheduling it, you don't want to - think about it until the scheduled date. - -all Don't show any scheduled entries in the global todo list. - The idea behind this is that by scheduling it, you have already - \"taken care\" of this item. - -t Same as `all', for backward compatibility. - -This variable can also have an integer as a value. See -`org-agenda-todo-ignore-timestamp' for more details. - -See also `org-agenda-todo-ignore-with-date'. -See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want -to make his option also apply to the tags-todo list." - :group 'org-agenda-skip - :group 'org-agenda-todo-list - :type '(choice - (const :tag "Ignore future-scheduled todos" future) - (const :tag "Ignore past- or present-scheduled todos" past) - (const :tag "Ignore all scheduled todos" all) - (const :tag "Ignore all scheduled todos (compatibility)" t) - (const :tag "Show scheduled todos" nil) - (integer :tag "Ignore if N or more days in past(-) or future(+)."))) - -(defcustom org-agenda-todo-ignore-deadlines nil - "Non-nil means ignore some deadlined TODO items when making TODO list. -There are different motivations for using different values, please think -carefully when configuring this variable. - -This applies when creating the global todo list. -Valid values are: - -near Don't show near deadline entries. A deadline is near when it is - closer than `org-deadline-warning-days' days. The idea behind this - is that such items will appear in the agenda anyway. - -far Don't show TODO entries where a deadline has been defined, but - the deadline is not near. This is useful if you don't want to - use the todo list to figure out what to do now. - -past Don't show entries with a deadline timestamp for today or in the past. - -future Don't show entries with a deadline timestamp in the future, not even - when they become `near' ones. Use it with caution. - -all Ignore all TODO entries that do have a deadline. - -t Same as `near', for backward compatibility. - -This variable can also have an integer as a value. See -`org-agenda-todo-ignore-timestamp' for more details. - -See also `org-agenda-todo-ignore-with-date'. -See also the variable `org-agenda-tags-todo-honor-ignore-options' if you want -to make his option also apply to the tags-todo list." - :group 'org-agenda-skip - :group 'org-agenda-todo-list - :type '(choice - (const :tag "Ignore near deadlines" near) - (const :tag "Ignore near deadlines (compatibility)" t) - (const :tag "Ignore far deadlines" far) - (const :tag "Ignore all TODOs with a deadlines" all) - (const :tag "Show all TODOs, even if they have a deadline" nil) - (integer :tag "Ignore if N or more days in past(-) or future(+)."))) - -(defcustom org-agenda-todo-ignore-time-comparison-use-seconds nil - "Time unit to use when possibly ignoring an agenda item. - -See the docstring of various `org-agenda-todo-ignore-*' options. -The default is to compare time stamps using days. An item is thus -considered to be in the future if it is at least one day after today. -Non-nil means to compare time stamps using seconds. An item is then -considered future if it has a time value later than current time." - :group 'org-agenda-skip - :group 'org-agenda-todo-list - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (const :tag "Compare time with days" nil) - (const :tag "Compare time with seconds" t))) - -(defcustom org-agenda-tags-todo-honor-ignore-options nil - "Non-nil means honor todo-list ignores options also in tags-todo search. -The variables - `org-agenda-todo-ignore-with-date', - `org-agenda-todo-ignore-timestamp', - `org-agenda-todo-ignore-scheduled', - `org-agenda-todo-ignore-deadlines' -make the global TODO list skip entries that have time stamps of certain -kinds. If this option is set, the same options will also apply for the -tags-todo search, which is the general tags/property matcher -restricted to unfinished TODO entries only." - :group 'org-agenda-skip - :group 'org-agenda-todo-list - :group 'org-agenda-match-view - :type 'boolean) - -(defcustom org-agenda-skip-scheduled-if-done nil - "Non-nil means don't show scheduled items in agenda when they are done. -This is relevant for the daily/weekly agenda, not for the TODO list. And -it applies only to the actual date of the scheduling. Warnings about -an item with a past scheduling dates are always turned off when the item -is DONE." - :group 'org-agenda-skip - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-skip-scheduled-if-deadline-is-shown nil - "Non-nil means skip scheduling line if same entry shows because of deadline. - -In the agenda of today, an entry can show up multiple times -because it is both scheduled and has a nearby deadline, and maybe -a plain time stamp as well. - -When this variable is nil, the entry will be shown several times. - -When set to t, then only the deadline is shown and the fact that -the entry is scheduled today or was scheduled previously is not -shown. - -When set to the symbol `not-today', skip scheduled previously, -but not scheduled today. - -When set to the symbol `repeated-after-deadline', skip scheduled -items if they are repeated beyond the current dealine." - :group 'org-agenda-skip - :group 'org-agenda-daily/weekly - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "Not when scheduled today" not-today) - (const :tag "When repeated past deadline" repeated-after-deadline))) - -(defcustom org-agenda-skip-timestamp-if-deadline-is-shown nil - "Non-nil means skip timestamp line if same entry shows because of deadline. -In the agenda of today, an entry can show up multiple times -because it has both a plain timestamp and has a nearby deadline. -When this variable is t, then only the deadline is shown and the -fact that the entry has a timestamp for or including today is not -shown. When this variable is nil, the entry will be shown -several times." - :group 'org-agenda-skip - :group 'org-agenda-daily/weekly - :version "24.1" - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t))) - -(defcustom org-agenda-skip-deadline-if-done nil - "Non-nil means don't show deadlines when the corresponding item is done. -When nil, the deadline is still shown and should give you a happy feeling. -This is relevant for the daily/weekly agenda. And it applied only to the -actually date of the deadline. Warnings about approaching and past-due -deadlines are always turned off when the item is DONE." - :group 'org-agenda-skip - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-skip-deadline-prewarning-if-scheduled nil - "Non-nil means skip deadline prewarning when entry is also scheduled. -This will apply on all days where a prewarning for the deadline would -be shown, but not at the day when the entry is actually due. On that day, -the deadline will be shown anyway. -This variable may be set to nil, t, the symbol `pre-scheduled', -or a number which will then give the number of days before the actual -deadline when the prewarnings should resume. The symbol `pre-scheduled' -eliminates the deadline prewarning only prior to the scheduled date. -This can be used in a workflow where the first showing of the deadline will -trigger you to schedule it, and then you don't want to be reminded of it -because you will take care of it on the day when scheduled." - :group 'org-agenda-skip - :group 'org-agenda-daily/weekly - :version "24.1" - :type '(choice - (const :tag "Always show prewarning" nil) - (const :tag "Remove prewarning prior to scheduled date" pre-scheduled) - (const :tag "Remove prewarning if entry is scheduled" t) - (integer :tag "Restart prewarning N days before deadline"))) - -(defcustom org-agenda-skip-scheduled-delay-if-deadline nil - "Non-nil means skip scheduled delay when entry also has a deadline. -This variable may be set to nil, t, the symbol `post-deadline', -or a number which will then give the number of days after the actual -scheduled date when the delay should expire. The symbol `post-deadline' -eliminates the schedule delay when the date is posterior to the deadline." - :group 'org-agenda-skip - :group 'org-agenda-daily/weekly - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (const :tag "Always honor delay" nil) - (const :tag "Ignore delay if posterior to the deadline" post-deadline) - (const :tag "Ignore delay if entry has a deadline" t) - (integer :tag "Honor delay up until N days after the scheduled date"))) - -(defcustom org-agenda-skip-additional-timestamps-same-entry nil - "When nil, multiple same-day timestamps in entry make multiple agenda lines. -When non-nil, after the search for timestamps has matched once in an -entry, the rest of the entry will not be searched." - :group 'org-agenda-skip - :type 'boolean) - -(defcustom org-agenda-skip-timestamp-if-done nil - "Non-nil means don't select item by timestamp or -range if it is DONE." - :group 'org-agenda-skip - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-dim-blocked-tasks t - "Non-nil means dim blocked tasks in the agenda display. -This causes some overhead during agenda construction, but if you -have turned on `org-enforce-todo-dependencies', -`org-enforce-todo-checkbox-dependencies', or any other blocking -mechanism, this will create useful feedback in the agenda. - -Instead of t, this variable can also have the value `invisible'. -Then blocked tasks will be invisible and only become visible when -they become unblocked. An exemption to this behavior is when a task is -blocked because of unchecked checkboxes below it. Since checkboxes do -not show up in the agenda views, making this task invisible you remove any -trace from agenda views that there is something to do. Therefore, a task -that is blocked because of checkboxes will never be made invisible, it -will only be dimmed." - :group 'org-agenda-daily/weekly - :group 'org-agenda-todo-list - :version "24.3" - :type '(choice - (const :tag "Do not dim" nil) - (const :tag "Dim to a gray face" t) - (const :tag "Make invisible" invisible))) - -(defcustom org-timeline-show-empty-dates 3 - "Non-nil means `org-timeline' also shows dates without an entry. -When nil, only the days which actually have entries are shown. -When t, all days between the first and the last date are shown. -When an integer, show also empty dates, but if there is a gap of more than -N days, just insert a special line indicating the size of the gap." - :group 'org-agenda-skip - :type '(choice - (const :tag "None" nil) - (const :tag "All" t) - (integer :tag "at most"))) - -(defgroup org-agenda-startup nil - "Options concerning initial settings in the Agenda in Org Mode." - :tag "Org Agenda Startup" - :group 'org-agenda) - -(defcustom org-agenda-menu-show-matcher t - "Non-nil means show the match string in the agenda dispatcher menu. -When nil, the matcher string is not shown, but is put into the help-echo -property so than moving the mouse over the command shows it. -Setting it to nil is good if matcher strings are very long and/or if -you want to use two-columns display (see `org-agenda-menu-two-columns')." - :group 'org-agenda - :version "24.1" - :type 'boolean) - -(define-obsolete-variable-alias 'org-agenda-menu-two-column 'org-agenda-menu-two-columns "24.3") - -(defcustom org-agenda-menu-two-columns nil - "Non-nil means, use two columns to show custom commands in the dispatcher. -If you use this, you probably want to set `org-agenda-menu-show-matcher' -to nil." - :group 'org-agenda - :version "24.1" - :type 'boolean) - -(define-obsolete-variable-alias 'org-finalize-agenda-hook 'org-agenda-finalize-hook "24.3") -(defcustom org-agenda-finalize-hook nil - "Hook run just before displaying an agenda buffer. -The buffer is still writable when the hook is called. - -You can modify some of the buffer substrings but you should be -extra careful not to modify the text properties of the agenda -headlines as the agenda display heavily relies on them." - :group 'org-agenda-startup - :type 'hook) - -(defcustom org-agenda-mouse-1-follows-link nil - "Non-nil means mouse-1 on a link will follow the link in the agenda. -A longer mouse click will still set point. Does not work on XEmacs. -Needs to be set before org.el is loaded." - :group 'org-agenda-startup - :type 'boolean) - -(defcustom org-agenda-start-with-follow-mode nil - "The initial value of follow mode in a newly created agenda window." - :group 'org-agenda-startup - :type 'boolean) - -(defcustom org-agenda-follow-indirect nil - "Non-nil means `org-agenda-follow-mode' displays only the -current item's tree, in an indirect buffer." - :group 'org-agenda - :version "24.1" - :type 'boolean) - -(defcustom org-agenda-show-outline-path t - "Non-nil means show outline path in echo area after line motion." - :group 'org-agenda-startup - :type 'boolean) - -(defcustom org-agenda-start-with-entry-text-mode nil - "The initial value of entry-text-mode in a newly created agenda window." - :group 'org-agenda-startup - :type 'boolean) - -(defcustom org-agenda-entry-text-maxlines 5 - "Number of text lines to be added when `E' is pressed in the agenda. - -Note that this variable only used during agenda display. Add add entry text -when exporting the agenda, configure the variable -`org-agenda-add-entry-ext-maxlines'." - :group 'org-agenda - :type 'integer) - -(defcustom org-agenda-entry-text-exclude-regexps nil - "List of regular expressions to clean up entry text. -The complete matches of all regular expressions in this list will be -removed from entry text before it is shown in the agenda." - :group 'org-agenda - :type '(repeat (regexp))) - -(defcustom org-agenda-entry-text-leaders " > " - "Text prepended to the entry text in agenda buffers." - :version "24.4" - :package-version '(Org . "8.0") - :group 'org-agenda - :type 'string) - -(defvar org-agenda-entry-text-cleanup-hook nil - "Hook that is run after basic cleanup of entry text to be shown in agenda. -This cleanup is done in a temporary buffer, so the function may inspect and -change the entire buffer. -Some default stuff like drawers and scheduling/deadline dates will already -have been removed when this is called, as will any matches for regular -expressions listed in `org-agenda-entry-text-exclude-regexps'.") - -(defvar org-agenda-include-inactive-timestamps nil - "Non-nil means include inactive time stamps in agenda and timeline. -Dynamically scoped.") - -(defgroup org-agenda-windows nil - "Options concerning the windows used by the Agenda in Org Mode." - :tag "Org Agenda Windows" - :group 'org-agenda) - -(defcustom org-agenda-window-setup 'reorganize-frame - "How the agenda buffer should be displayed. -Possible values for this option are: - -current-window Show agenda in the current window, keeping all other windows. -other-window Use `switch-to-buffer-other-window' to display agenda. -reorganize-frame Show only two windows on the current frame, the current - window and the agenda. -other-frame Use `switch-to-buffer-other-frame' to display agenda. - Also, when exiting the agenda, kill that frame. -See also the variable `org-agenda-restore-windows-after-quit'." - :group 'org-agenda-windows - :type '(choice - (const current-window) - (const other-frame) - (const other-window) - (const reorganize-frame))) - -(defcustom org-agenda-window-frame-fractions '(0.5 . 0.75) - "The min and max height of the agenda window as a fraction of frame height. -The value of the variable is a cons cell with two numbers between 0 and 1. -It only matters if `org-agenda-window-setup' is `reorganize-frame'." - :group 'org-agenda-windows - :type '(cons (number :tag "Minimum") (number :tag "Maximum"))) - -(defcustom org-agenda-restore-windows-after-quit nil - "Non-nil means restore window configuration upon exiting agenda. -Before the window configuration is changed for displaying the agenda, -the current status is recorded. When the agenda is exited with -`q' or `x' and this option is set, the old state is restored. If -`org-agenda-window-setup' is `other-frame', the value of this -option will be ignored." - :group 'org-agenda-windows - :type 'boolean) - -(defcustom org-agenda-ndays nil - "Number of days to include in overview display. -Should be 1 or 7. -Obsolete, see `org-agenda-span'." - :group 'org-agenda-daily/weekly - :type '(choice (const nil) - (integer))) - -(make-obsolete-variable 'org-agenda-ndays 'org-agenda-span "24.1") - -(defcustom org-agenda-span 'week - "Number of days to include in overview display. -Can be day, week, month, year, or any number of days. -Custom commands can set this variable in the options section." - :group 'org-agenda-daily/weekly - :type '(choice (const :tag "Day" day) - (const :tag "Week" week) - (const :tag "Fortnight" fortnight) - (const :tag "Month" month) - (const :tag "Year" year) - (integer :tag "Custom"))) - -(defcustom org-agenda-start-on-weekday 1 - "Non-nil means start the overview always on the specified weekday. -0 denotes Sunday, 1 denotes Monday, etc. -When nil, always start on the current day. -Custom commands can set this variable in the options section." - :group 'org-agenda-daily/weekly - :type '(choice (const :tag "Today" nil) - (integer :tag "Weekday No."))) - -(defcustom org-agenda-show-all-dates t - "Non-nil means `org-agenda' shows every day in the selected range. -When nil, only the days which actually have entries are shown." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-format-date 'org-agenda-format-date-aligned - "Format string for displaying dates in the agenda. -Used by the daily/weekly agenda and by the timeline. This should be -a format string understood by `format-time-string', or a function returning -the formatted date as a string. The function must take a single argument, -a calendar-style date list like (month day year)." - :group 'org-agenda-daily/weekly - :type '(choice - (string :tag "Format string") - (function :tag "Function"))) - -(defun org-agenda-format-date-aligned (date) - "Format a DATE string for display in the daily/weekly agenda, or timeline. -This function makes sure that dates are aligned for easy reading." - (require 'cal-iso) - (let* ((dayname (calendar-day-name date)) - (day (cadr date)) - (day-of-week (calendar-day-of-week date)) - (month (car date)) - (monthname (calendar-month-name month)) - (year (nth 2 date)) - (iso-week (org-days-to-iso-week - (calendar-absolute-from-gregorian date))) - (weekyear (cond ((and (= month 1) (>= iso-week 52)) - (1- year)) - ((and (= month 12) (<= iso-week 1)) - (1+ year)) - (t year))) - (weekstring (if (= day-of-week 1) - (format " W%02d" iso-week) - ""))) - (format "%-10s %2d %s %4d%s" - dayname day monthname year weekstring))) - -(defcustom org-agenda-time-leading-zero nil - "Non-nil means use leading zero for military times in agenda. -For example, 9:30am would become 09:30 rather than 9:30." - :group 'org-agenda-daily/weekly - :version "24.1" - :type 'boolean) - -(defcustom org-agenda-timegrid-use-ampm nil - "When set, show AM/PM style timestamps on the timegrid." - :group 'org-agenda - :version "24.1" - :type 'boolean) - -(defun org-agenda-time-of-day-to-ampm (time) - "Convert TIME of a string like '13:45' to an AM/PM style time string." - (let* ((hour-number (string-to-number (substring time 0 -3))) - (minute (substring time -2)) - (ampm "am")) - (cond - ((equal hour-number 12) - (setq ampm "pm")) - ((> hour-number 12) - (setq ampm "pm") - (setq hour-number (- hour-number 12)))) - (concat - (if org-agenda-time-leading-zero - (format "%02d" hour-number) - (format "%02s" (number-to-string hour-number))) - ":" minute ampm))) - -(defun org-agenda-time-of-day-to-ampm-maybe (time) - "Conditionally convert TIME to AM/PM format based on `org-agenda-timegrid-use-ampm'." - (if org-agenda-timegrid-use-ampm - (org-agenda-time-of-day-to-ampm time) - time)) - -(defcustom org-agenda-weekend-days '(6 0) - "Which days are weekend? -These days get the special face `org-agenda-date-weekend' in the agenda -and timeline buffers." - :group 'org-agenda-daily/weekly - :type '(set :greedy t - (const :tag "Monday" 1) - (const :tag "Tuesday" 2) - (const :tag "Wednesday" 3) - (const :tag "Thursday" 4) - (const :tag "Friday" 5) - (const :tag "Saturday" 6) - (const :tag "Sunday" 0))) - -(defcustom org-agenda-move-date-from-past-immediately-to-today t - "Non-nil means jump to today when moving a past date forward in time. -When using S-right in the agenda to move a a date forward, and the date -stamp currently points to the past, the first key press will move it -to today. WHen nil, just move one day forward even if the date stays -in the past." - :group 'org-agenda-daily/weekly - :version "24.1" - :type 'boolean) - -(defcustom org-agenda-include-diary nil - "If non-nil, include in the agenda entries from the Emacs Calendar's diary. -Custom commands can set this variable in the options section." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-include-deadlines t - "If non-nil, include entries within their deadline warning period. -Custom commands can set this variable in the options section." - :group 'org-agenda-daily/weekly - :version "24.1" - :type 'boolean) - -(defcustom org-agenda-repeating-timestamp-show-all t - "Non-nil means show all occurrences of a repeating stamp in the agenda. -When set to a list of strings, only show occurrences of repeating -stamps for these TODO keywords. When nil, only one occurrence is -shown, either today or the nearest into the future." - :group 'org-agenda-daily/weekly - :type '(choice - (const :tag "Show repeating stamps" t) - (repeat :tag "Show repeating stamps for these TODO keywords" - (string :tag "TODO Keyword")) - (const :tag "Don't show repeating stamps" nil))) - -(defcustom org-scheduled-past-days 10000 - "Number of days to continue listing scheduled items not marked DONE. -When an item is scheduled on a date, it shows up in the agenda on this -day and will be listed until it is marked done for the number of days -given here." - :group 'org-agenda-daily/weekly - :type 'integer) - -(defcustom org-agenda-log-mode-items '(closed clock) - "List of items that should be shown in agenda log mode. -This list may contain the following symbols: - - closed Show entries that have been closed on that day. - clock Show entries that have received clocked time on that day. - state Show all logged state changes. -Note that instead of changing this variable, you can also press `C-u l' in -the agenda to display all available LOG items temporarily." - :group 'org-agenda-daily/weekly - :type '(set :greedy t (const closed) (const clock) (const state))) - -(defcustom org-agenda-clock-consistency-checks - '(:max-duration "10:00" :min-duration 0 :max-gap "0:05" - :gap-ok-around ("4:00") - :default-face ((:background "DarkRed") (:foreground "white")) - :overlap-face nil :gap-face nil :no-end-time-face nil - :long-face nil :short-face nil) - "This is a property list, with the following keys: - -:max-duration Mark clocking chunks that are longer than this time. - This is a time string like \"HH:MM\", or the number - of minutes as an integer. - -:min-duration Mark clocking chunks that are shorter that this. - This is a time string like \"HH:MM\", or the number - of minutes as an integer. - -:max-gap Mark gaps between clocking chunks that are longer than - this duration. A number of minutes, or a string - like \"HH:MM\". - -:gap-ok-around List of times during the day which are usually not working - times. When a gap is detected, but the gap contains any - of these times, the gap is *not* reported. For example, - if this is (\"4:00\" \"13:00\") then gaps that contain - 4:00 in the morning (i.e. the night) and 13:00 - (i.e. a typical lunch time) do not cause a warning. - You should have at least one time during the night in this - list, or otherwise the first task each morning will trigger - a warning because it follows a long gap. - -Furthermore, the following properties can be used to define faces for -issue display. - -:default-face the default face, if the specific face is undefined -:overlap-face face for overlapping clocks -:gap-face face for gaps between clocks -:no-end-time-face face for incomplete clocks -:long-face face for clock intervals that are too long -:short-face face for clock intervals that are too short" - :group 'org-agenda-daily/weekly - :group 'org-clock - :version "24.1" - :type 'plist) - -(defcustom org-agenda-log-mode-add-notes t - "Non-nil means add first line of notes to log entries in agenda views. -If a log item like a state change or a clock entry is associated with -notes, the first line of these notes will be added to the entry in the -agenda display." - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-start-with-log-mode nil - "The initial value of log-mode in a newly created agenda window. -See `org-agenda-log-mode' and `org-agenda-log-mode-items' for further -explanations on the possible values." - :group 'org-agenda-startup - :group 'org-agenda-daily/weekly - :type '(choice (const :tag "Don't show log items" nil) - (const :tag "Show only log items" 'only) - (const :tag "Show all possible log items" 'clockcheck) - (repeat :tag "Choose among possible values for `org-agenda-log-mode-items'" - (choice (const :tag "Show closed log items" 'closed) - (const :tag "Show clocked log items" 'clock) - (const :tag "Show all logged state changes" 'state))))) - -(defcustom org-agenda-start-with-clockreport-mode nil - "The initial value of clockreport-mode in a newly created agenda window." - :group 'org-agenda-startup - :group 'org-agenda-daily/weekly - :type 'boolean) - -(defcustom org-agenda-clockreport-parameter-plist '(:link t :maxlevel 2) - "Property list with parameters for the clocktable in clockreport mode. -This is the display mode that shows a clock table in the daily/weekly -agenda, the properties for this dynamic block can be set here. -The usual clocktable parameters are allowed here, but you cannot set -the properties :name, :tstart, :tend, :block, and :scope - these will -be overwritten to make sure the content accurately reflects the -current display in the agenda." - :group 'org-agenda-daily/weekly - :type 'plist) - -(defcustom org-agenda-search-view-always-boolean nil - "Non-nil means the search string is interpreted as individual parts. - -The search string for search view can either be interpreted as a phrase, -or as a list of snippets that define a boolean search for a number of -strings. - -When this is non-nil, the string will be split on whitespace, and each -snippet will be searched individually, and all must match in order to -select an entry. A snippet is then a single string of non-white -characters, or a string in double quotes, or a regexp in {} braces. -If a snippet is preceded by \"-\", the snippet must *not* match. -\"+\" is syntactic sugar for positive selection. Each snippet may -be found as a full word or a partial word, but see the variable -`org-agenda-search-view-force-full-words'. - -When this is nil, search will look for the entire search phrase as one, -with each space character matching any amount of whitespace, including -line breaks. - -Even when this is nil, you can still switch to Boolean search dynamically -by preceding the first snippet with \"+\" or \"-\". If the first snippet -is a regexp marked with braces like \"{abc}\", this will also switch to -boolean search." - :group 'org-agenda-search-view - :version "24.1" - :type 'boolean) - -(org-defvaralias 'org-agenda-search-view-search-words-only - 'org-agenda-search-view-always-boolean) - -(defcustom org-agenda-search-view-force-full-words nil - "Non-nil means, search words must be matches as complete words. -When nil, they may also match part of a word." - :group 'org-agenda-search-view - :version "24.1" - :type 'boolean) - -(defcustom org-agenda-search-view-max-outline-level 0 - "Maximum outline level to display in search view. -E.g. when this is set to 1, the search view will only -show headlines of level 1. When set to 0, the default -value, don't limit agenda view by outline level." - :group 'org-agenda-search-view - :version "24.4" - :package-version '(Org . "8.3") - :type 'integer) - -(defgroup org-agenda-time-grid nil - "Options concerning the time grid in the Org-mode Agenda." - :tag "Org Agenda Time Grid" - :group 'org-agenda) - -(defcustom org-agenda-search-headline-for-time t - "Non-nil means search headline for a time-of-day. -If the headline contains a time-of-day in one format or another, it will -be used to sort the entry into the time sequence of items for a day. -Some people have time stamps in the headline that refer to the creation -time or so, and then this produces an unwanted side effect. If this is -the case for your, use this variable to turn off searching the headline -for a time." - :group 'org-agenda-time-grid - :type 'boolean) - -(defcustom org-agenda-use-time-grid t - "Non-nil means show a time grid in the agenda schedule. -A time grid is a set of lines for specific times (like every two hours between -8:00 and 20:00). The items scheduled for a day at specific times are -sorted in between these lines. -For details about when the grid will be shown, and what it will look like, see -the variable `org-agenda-time-grid'." - :group 'org-agenda-time-grid - :type 'boolean) - -(defcustom org-agenda-time-grid - '((daily today require-timed) - "----------------" - (800 1000 1200 1400 1600 1800 2000)) - - "The settings for time grid for agenda display. -This is a list of three items. The first item is again a list. It contains -symbols specifying conditions when the grid should be displayed: - - daily if the agenda shows a single day - weekly if the agenda shows an entire week - today show grid on current date, independent of daily/weekly display - require-timed show grid only if at least one item has a time specification - -The second item is a string which will be placed behind the grid time. - -The third item is a list of integers, indicating the times that should have -a grid line." - :group 'org-agenda-time-grid - :type - '(list - (set :greedy t :tag "Grid Display Options" - (const :tag "Show grid in single day agenda display" daily) - (const :tag "Show grid in weekly agenda display" weekly) - (const :tag "Always show grid for today" today) - (const :tag "Show grid only if any timed entries are present" - require-timed) - (const :tag "Skip grid times already present in an entry" - remove-match)) - (string :tag "Grid String") - (repeat :tag "Grid Times" (integer :tag "Time")))) - -(defcustom org-agenda-show-current-time-in-grid t - "Non-nil means show the current time in the time grid." - :group 'org-agenda-time-grid - :version "24.1" - :type 'boolean) - -(defcustom org-agenda-current-time-string - "now - - - - - - - - - - - - - - - - - - - - - - - - -" - "The string for the current time marker in the agenda." - :group 'org-agenda-time-grid - :version "24.1" - :type 'string) - -(defgroup org-agenda-sorting nil - "Options concerning sorting in the Org-mode Agenda." - :tag "Org Agenda Sorting" - :group 'org-agenda) - -(defcustom org-agenda-sorting-strategy - '((agenda habit-down time-up priority-down category-keep) - (todo priority-down category-keep) - (tags priority-down category-keep) - (search category-keep)) - "Sorting structure for the agenda items of a single day. -This is a list of symbols which will be used in sequence to determine -if an entry should be listed before another entry. The following -symbols are recognized: - -time-up Put entries with time-of-day indications first, early first -time-down Put entries with time-of-day indications first, late first -timestamp-up Sort by any timestamp, early first -timestamp-down Sort by any timestamp, late first -scheduled-up Sort by scheduled timestamp, early first -scheduled-down Sort by scheduled timestamp, late first -deadline-up Sort by deadline timestamp, early first -deadline-down Sort by deadline timestamp, late first -ts-up Sort by active timestamp, early first -ts-down Sort by active timestamp, late first -tsia-up Sort by inactive timestamp, early first -tsia-down Sort by inactive timestamp, late first -category-keep Keep the default order of categories, corresponding to the - sequence in `org-agenda-files'. -category-up Sort alphabetically by category, A-Z. -category-down Sort alphabetically by category, Z-A. -tag-up Sort alphabetically by last tag, A-Z. -tag-down Sort alphabetically by last tag, Z-A. -priority-up Sort numerically by priority, high priority last. -priority-down Sort numerically by priority, high priority first. -todo-state-up Sort by todo state, tasks that are done last. -todo-state-down Sort by todo state, tasks that are done first. -effort-up Sort numerically by estimated effort, high effort last. -effort-down Sort numerically by estimated effort, high effort first. -user-defined-up Sort according to `org-agenda-cmp-user-defined', high last. -user-defined-down Sort according to `org-agenda-cmp-user-defined', high first. -habit-up Put entries that are habits first -habit-down Put entries that are habits last -alpha-up Sort headlines alphabetically -alpha-down Sort headlines alphabetically, reversed - -The different possibilities will be tried in sequence, and testing stops -if one comparison returns a \"not-equal\". For example, the default - '(time-up category-keep priority-down) -means: Pull out all entries having a specified time of day and sort them, -in order to make a time schedule for the current day the first thing in the -agenda listing for the day. Of the entries without a time indication, keep -the grouped in categories, don't sort the categories, but keep them in -the sequence given in `org-agenda-files'. Within each category sort by -priority. - -Leaving out `category-keep' would mean that items will be sorted across -categories by priority. - -Instead of a single list, this can also be a set of list for specific -contents, with a context symbol in the car of the list, any of -`agenda', `todo', `tags', `search' for the corresponding agenda views. - -Custom commands can bind this variable in the options section." - :group 'org-agenda-sorting - :type `(choice - (repeat :tag "General" ,org-sorting-choice) - (list :tag "Individually" - (cons (const :tag "Strategy for Weekly/Daily agenda" agenda) - (repeat ,org-sorting-choice)) - (cons (const :tag "Strategy for TODO lists" todo) - (repeat ,org-sorting-choice)) - (cons (const :tag "Strategy for Tags matches" tags) - (repeat ,org-sorting-choice)) - (cons (const :tag "Strategy for search matches" search) - (repeat ,org-sorting-choice))))) - -(defcustom org-agenda-cmp-user-defined nil - "A function to define the comparison `user-defined'. -This function must receive two arguments, agenda entry a and b. -If a>b, return +1. If a effort operator. Then, tasks with no effort defined will be treated -as tasks with high effort. -When nil, such items are sorted as 0 minutes effort." - :group 'org-agenda-sorting - :type 'boolean) - -(defgroup org-agenda-line-format nil - "Options concerning the entry prefix in the Org-mode agenda display." - :tag "Org Agenda Line Format" - :group 'org-agenda) - -(defcustom org-agenda-prefix-format - '((agenda . " %i %-12:c%?-12t% s") - (timeline . " % s") - (todo . " %i %-12:c") - (tags . " %i %-12:c") - (search . " %i %-12:c")) - "Format specifications for the prefix of items in the agenda views. -An alist with five entries, each for the different agenda types. The -keys of the sublists are `agenda', `timeline', `todo', `search' and `tags'. -The values are format strings. - -This format works similar to a printf format, with the following meaning: - - %c the category of the item, \"Diary\" for entries from the diary, - or as given by the CATEGORY keyword or derived from the file name - %e the effort required by the item - %l the level of the item (insert X space(s) if item is of level X) - %i the icon category of the item, see `org-agenda-category-icon-alist' - %T the last tag of the item (ignore inherited tags, which come first) - %t the HH:MM time-of-day specification if one applies to the entry - %s Scheduling/Deadline information, a short string - %b show breadcrumbs, i.e., the names of the higher levels - %(expression) Eval EXPRESSION and replace the control string - by the result - -All specifiers work basically like the standard `%s' of printf, but may -contain two additional characters: a question mark just after the `%' -and a whitespace/punctuation character just before the final letter. - -If the first character after `%' is a question mark, the entire field -will only be included if the corresponding value applies to the current -entry. This is useful for fields which should have fixed width when -present, but zero width when absent. For example, \"%?-12t\" will -result in a 12 character time field if a time of the day is specified, -but will completely disappear in entries which do not contain a time. - -If there is punctuation or whitespace character just before the -final format letter, this character will be appended to the field -value if the value is not empty. For example, the format -\"%-12:c\" leads to \"Diary: \" if the category is \"Diary\". If -the category is empty, no additional colon is inserted. - -The default value for the agenda sublist is \" %-12:c%?-12t% s\", -which means: - -- Indent the line with two space characters -- Give the category a 12 chars wide field, padded with whitespace on - the right (because of `-'). Append a colon if there is a category - (because of `:'). -- If there is a time-of-day, put it into a 12 chars wide field. If no - time, don't put in an empty field, just skip it (because of '?'). -- Finally, put the scheduling information. - -See also the variables `org-agenda-remove-times-when-in-prefix' and -`org-agenda-remove-tags'. - -Custom commands can set this variable in the options section." - :type '(choice - (string :tag "General format") - (list :greedy t :tag "View dependent" - (cons (const agenda) (string :tag "Format")) - (cons (const timeline) (string :tag "Format")) - (cons (const todo) (string :tag "Format")) - (cons (const tags) (string :tag "Format")) - (cons (const search) (string :tag "Format")))) - :group 'org-agenda-line-format) - -(defvar org-prefix-format-compiled nil - "The compiled prefix format and associated variables. -This is a list where first element is a list of variable bindings, and second -element is the compiled format expression. See the variable -`org-agenda-prefix-format'.") - -(defcustom org-agenda-todo-keyword-format "%-1s" - "Format for the TODO keyword in agenda lines. -Set this to something like \"%-12s\" if you want all TODO keywords -to occupy a fixed space in the agenda display." - :group 'org-agenda-line-format - :type 'string) - -(defcustom org-agenda-diary-sexp-prefix nil - "A regexp that matches part of a diary sexp entry -which should be treated as scheduling/deadline information in -`org-agenda'. - -For example, you can use this to extract the `diary-remind-message' from -`diary-remind' entries." - :group 'org-agenda-line-format - :type '(choice (const :tag "None" nil) (regexp :tag "Regexp"))) - -(defcustom org-agenda-timerange-leaders '("" "(%d/%d): ") - "Text preceding timerange entries in the agenda view. -This is a list with two strings. The first applies when the range -is entirely on one day. The second applies if the range spans several days. -The strings may have two \"%d\" format specifiers which will be filled -with the sequence number of the days, and the total number of days in the -range, respectively." - :group 'org-agenda-line-format - :type '(list - (string :tag "Deadline today ") - (choice :tag "Deadline relative" - (string :tag "Format string") - (function)))) - -(defcustom org-agenda-scheduled-leaders '("Scheduled: " "Sched.%2dx: ") - "Text preceding scheduled items in the agenda view. -This is a list with two strings. The first applies when the item is -scheduled on the current day. The second applies when it has been scheduled -previously, it may contain a %d indicating that this is the nth time that -this item is scheduled, due to automatic rescheduling of unfinished items -for the following day. So this number is one larger than the number of days -that passed since this item was scheduled first." - :group 'org-agenda-line-format - :version "24.4" - :package-version '(Org . "8.0") - :type '(list - (string :tag "Scheduled today ") - (string :tag "Scheduled previously"))) - -(defcustom org-agenda-inactive-leader "[" - "Text preceding item pulled into the agenda by inactive time stamps. -These entries are added to the agenda when pressing \"[\"." - :group 'org-agenda-line-format - :version "24.1" - :type 'string) - -(defcustom org-agenda-deadline-leaders '("Deadline: " "In %3d d.: " "%2d d. ago: ") - "Text preceding deadline items in the agenda view. -This is a list with three strings. The first applies when the item has its -deadline on the current day. The second applies when the deadline is in the -future, the third one when it is in the past. The strings may contain %d -to capture the number of days." - :group 'org-agenda-line-format - :version "24.4" - :package-version '(Org . "8.0") - :type '(list - (string :tag "Deadline today ") - (string :tag "Deadline in the future ") - (string :tag "Deadline in the past "))) - -(defcustom org-agenda-remove-times-when-in-prefix t - "Non-nil means remove duplicate time specifications in agenda items. -When the format `org-agenda-prefix-format' contains a `%t' specifier, a -time-of-day specification in a headline or diary entry is extracted and -placed into the prefix. If this option is non-nil, the original specification -\(a timestamp or -range, or just a plain time(range) specification like -11:30-4pm) will be removed for agenda display. This makes the agenda less -cluttered. -The option can be t or nil. It may also be the symbol `beg', indicating -that the time should only be removed when it is located at the beginning of -the headline/diary entry." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "When at beginning of entry" beg))) - -(defcustom org-agenda-remove-timeranges-from-blocks nil - "Non-nil means remove time ranges specifications in agenda -items that span on several days." - :group 'org-agenda-line-format - :version "24.1" - :type 'boolean) - -(defcustom org-agenda-default-appointment-duration nil - "Default duration for appointments that only have a starting time. -When nil, no duration is specified in such cases. -When non-nil, this must be the number of minutes, e.g. 60 for one hour." - :group 'org-agenda-line-format - :type '(choice - (integer :tag "Minutes") - (const :tag "No default duration"))) - -(defcustom org-agenda-show-inherited-tags t - "Non-nil means show inherited tags in each agenda line. - -When this option is set to 'always, it take precedences over -`org-agenda-use-tag-inheritance' and inherited tags are shown -in every agenda. - -When this option is set to t (the default), inherited tags are -shown when they are available, i.e. when the value of -`org-agenda-use-tag-inheritance' has been taken into account. - -This can be set to a list of agenda types in which the agenda -must display the inherited tags. Available types are 'todo, -'agenda, 'search and 'timeline. - -When set to nil, never show inherited tags in agenda lines." - :group 'org-agenda-line-format - :group 'org-agenda - :version "24.3" - :type '(choice - (const :tag "Show inherited tags when available" t) - (const :tag "Always show inherited tags" 'always) - (repeat :tag "Show inherited tags only in selected agenda types" - (symbol :tag "Agenda type")))) - -(defcustom org-agenda-use-tag-inheritance '(todo search timeline agenda) - "List of agenda view types where to use tag inheritance. - -In tags/tags-todo/tags-tree agenda views, tag inheritance is -controlled by `org-use-tag-inheritance'. In other agenda types, -`org-use-tag-inheritance' is not used for the selection of the -agenda entries. Still, you may want the agenda to be aware of -the inherited tags anyway, e.g. for later tag filtering. - -Allowed value are 'todo, 'search, 'timeline and 'agenda. - -This variable has no effect if `org-agenda-show-inherited-tags' -is set to 'always. In that case, the agenda is aware of those -tags. - -The default value sets tags in every agenda type. Setting this -option to nil will speed up non-tags agenda view a lot." - :group 'org-agenda - :version "24.3" - :type '(choice - (const :tag "Use tag inheritance in all agenda types" t) - (repeat :tag "Use tag inheritance in selected agenda types" - (symbol :tag "Agenda type")))) - -(defcustom org-agenda-hide-tags-regexp nil - "Regular expression used to filter away specific tags in agenda views. -This means that these tags will be present, but not be shown in the agenda -line. Secondary filtering will still work on the hidden tags. -Nil means don't hide any tags." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Hide none" nil) - (string :tag "Regexp "))) - -(defcustom org-agenda-remove-tags nil - "Non-nil means remove the tags from the headline copy in the agenda. -When this is the symbol `prefix', only remove tags when -`org-agenda-prefix-format' contains a `%T' specifier." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "When prefix format contains %T" prefix))) - -(org-defvaralias 'org-agenda-remove-tags-when-in-prefix - 'org-agenda-remove-tags) - -(defcustom org-agenda-tags-column (if (featurep 'xemacs) -79 -80) - "Shift tags in agenda items to this column. -If this number is positive, it specifies the column. If it is negative, -it means that the tags should be flushright to that column. For example, --80 works well for a normal 80 character screen." - :group 'org-agenda-line-format - :type 'integer) - -(org-defvaralias 'org-agenda-align-tags-to-column 'org-agenda-tags-column) - -(defcustom org-agenda-fontify-priorities 'cookies - "Non-nil means highlight low and high priorities in agenda. -When t, the highest priority entries are bold, lowest priority italic. -However, settings in `org-priority-faces' will overrule these faces. -When this variable is the symbol `cookies', only fontify the -cookies, not the entire task. -This may also be an association list of priority faces, whose -keys are the character values of `org-highest-priority', -`org-default-priority', and `org-lowest-priority' (the default values -are ?A, ?B, and ?C, respectively). The face may be a named face, a -color as a string, or a list like `(:background \"Red\")'. -If it is a color, the variable `org-faces-easy-properties' -determines if it is a foreground or a background color." - :group 'org-agenda-line-format - :type '(choice - (const :tag "Never" nil) - (const :tag "Defaults" t) - (const :tag "Cookies only" cookies) - (repeat :tag "Specify" - (list (character :tag "Priority" :value ?A) - (choice :tag "Face " - (string :tag "Color") - (sexp :tag "Face")))))) - -(defcustom org-agenda-day-face-function nil - "Function called to determine what face should be used to display a day. -The only argument passed to that function is the day. It should -returns a face, or nil if does not want to specify a face and let -the normal rules apply." - :group 'org-agenda-line-format - :version "24.1" - :type '(choice (const nil) (function))) - -(defcustom org-agenda-category-icon-alist nil - "Alist of category icon to be displayed in agenda views. - -Each entry should have the following format: - - (CATEGORY-REGEXP FILE-OR-DATA TYPE DATA-P PROPS) - -Where CATEGORY-REGEXP is a regexp matching the categories where -the icon should be displayed. -FILE-OR-DATA either a file path or a string containing image data. - -The other fields can be omitted safely if not needed: -TYPE indicates the image type. -DATA-P is a boolean indicating whether the FILE-OR-DATA string is -image data. -PROPS are additional image attributes to assign to the image, -like, e.g. `:ascent center'. - - (\"Org\" \"/path/to/icon.png\" nil nil :ascent center) - -If you want to set the display properties yourself, just put a -list as second element: - - (CATEGORY-REGEXP (MY PROPERTY LIST)) - -For example, to display a 16px horizontal space for Emacs -category, you can use: - - (\"Emacs\" '(space . (:width (16))))" - :group 'org-agenda-line-format - :version "24.1" - :type '(alist :key-type (string :tag "Regexp matching category") - :value-type (choice (list :tag "Icon" - (string :tag "File or data") - (symbol :tag "Type") - (boolean :tag "Data?") - (repeat :tag "Extra image properties" :inline t symbol)) - (list :tag "Display properties" sexp)))) - -(defgroup org-agenda-column-view nil - "Options concerning column view in the agenda." - :tag "Org Agenda Column View" - :group 'org-agenda) - -(defcustom org-agenda-columns-show-summaries t - "Non-nil means show summaries for columns displayed in the agenda view." - :group 'org-agenda-column-view - :type 'boolean) - -(defcustom org-agenda-columns-compute-summary-properties t - "Non-nil means recompute all summary properties before column view. -When column view in the agenda is listing properties that have a summary -operator, it can go to all relevant buffers and recompute the summaries -there. This can mean overhead for the agenda column view, but is necessary -to have thing up to date. -As a special case, a CLOCKSUM property also makes sure that the clock -computations are current." - :group 'org-agenda-column-view - :type 'boolean) - -(defcustom org-agenda-columns-add-appointments-to-effort-sum nil - "Non-nil means the duration of an appointment will add to day effort. -The property to which appointment durations will be added is the one given -in the option `org-effort-property'. If an appointment does not have -an end time, `org-agenda-default-appointment-duration' will be used. If that -is not set, an appointment without end time will not contribute to the time -estimate." - :group 'org-agenda-column-view - :type 'boolean) - -(defcustom org-agenda-auto-exclude-function nil - "A function called with a tag to decide if it is filtered on '/ RET'. -The sole argument to the function, which is called once for each -possible tag, is a string giving the name of the tag. The -function should return either nil if the tag should be included -as normal, or \"-\" to exclude the tag. -Note that for the purpose of tag filtering, only the lower-case version of -all tags will be considered, so that this function will only ever see -the lower-case version of all tags." - :group 'org-agenda - :type '(choice (const nil) (function))) - -(defcustom org-agenda-bulk-custom-functions nil - "Alist of characters and custom functions for bulk actions. -For example, this value makes those two functions available: - - '((?R set-category) - (?C bulk-cut)) - -With selected entries in an agenda buffer, `B R' will call -the custom function `set-category' on the selected entries. -Note that functions in this alist don't need to be quoted." - :type 'alist - :version "24.1" - :group 'org-agenda) - -(defmacro org-agenda-with-point-at-orig-entry (string &rest body) - "Execute BODY with point at location given by `org-hd-marker' property. -If STRING is non-nil, the text property will be fetched from position 0 -in that string. If STRING is nil, it will be fetched from the beginning -of the current line." - (org-with-gensyms (marker) - `(let ((,marker (get-text-property (if string 0 (point-at-bol)) - 'org-hd-marker ,string))) - (with-current-buffer (marker-buffer ,marker) - (save-excursion - (goto-char ,marker) - ,@body))))) -(def-edebug-spec org-agenda-with-point-at-orig-entry (form body)) - -(defun org-add-agenda-custom-command (entry) - "Replace or add a command in `org-agenda-custom-commands'. -This is mostly for hacking and trying a new command - once the command -works you probably want to add it to `org-agenda-custom-commands' for good." - (let ((ass (assoc (car entry) org-agenda-custom-commands))) - (if ass - (setcdr ass (cdr entry)) - (push entry org-agenda-custom-commands)))) - -;;; Define the org-agenda-mode - -(defvar org-agenda-mode-map (make-sparse-keymap) - "Keymap for `org-agenda-mode'.") -(org-defvaralias 'org-agenda-keymap 'org-agenda-mode-map) - -(defvar org-agenda-menu) ; defined later in this file. -(defvar org-agenda-restrict nil) ; defined later in this file. -(defvar org-agenda-follow-mode nil) -(defvar org-agenda-entry-text-mode nil) -(defvar org-agenda-clockreport-mode nil) -(defvar org-agenda-show-log nil) -(defvar org-agenda-redo-command nil) -(defvar org-agenda-query-string nil) -(defvar org-agenda-mode-hook nil - "Hook run after `org-agenda-mode' is turned on. -The buffer is still writable when this hook is called.") -(defvar org-agenda-type nil) -(defvar org-agenda-force-single-file nil) -(defvar org-agenda-bulk-marked-entries nil - "List of markers that refer to marked entries in the agenda.") - -;;; Multiple agenda buffers support - -(defcustom org-agenda-sticky nil - "Non-nil means agenda q key will bury agenda buffers. -Agenda commands will then show existing buffer instead of generating new ones. -When nil, `q' will kill the single agenda buffer." - :group 'org-agenda - :version "24.3" - :type 'boolean) - - -;;;###autoload -(defun org-toggle-sticky-agenda (&optional arg) - "Toggle `org-agenda-sticky'." - (interactive "P") - (let ((new-value (if arg - (> (prefix-numeric-value arg) 0) - (not org-agenda-sticky)))) - (if (equal new-value org-agenda-sticky) - (and (org-called-interactively-p 'interactive) - (message "Sticky agenda was already %s" - (if org-agenda-sticky "enabled" "disabled"))) - (setq org-agenda-sticky new-value) - (org-agenda-kill-all-agenda-buffers) - (and (org-called-interactively-p 'interactive) - (message "Sticky agenda was %s" - (if org-agenda-sticky "enabled" "disabled")))))) - -(defvar org-agenda-buffer nil - "Agenda buffer currently being generated.") - -(defvar org-agenda-last-prefix-arg nil) -(defvar org-agenda-this-buffer-name nil) -(defvar org-agenda-doing-sticky-redo nil) -(defvar org-agenda-this-buffer-is-sticky nil) - -(defconst org-agenda-local-vars - '(org-agenda-this-buffer-name - org-agenda-undo-list - org-agenda-pending-undo-list - org-agenda-follow-mode - org-agenda-entry-text-mode - org-agenda-clockreport-mode - org-agenda-show-log - org-agenda-redo-command - org-agenda-query-string - org-agenda-type - org-agenda-bulk-marked-entries - org-agenda-undo-has-started-in - org-agenda-info - org-agenda-pre-window-conf - org-agenda-columns-active - org-agenda-tag-filter-overlays - org-agenda-tag-filter - org-agenda-cat-filter-overlays - org-agenda-category-filter - org-agenda-re-filter-overlays - org-agenda-regexp-filter - org-agenda-markers - org-agenda-last-search-view-search-was-boolean - org-agenda-filtered-by-category - org-agenda-filter-form - org-agenda-cycle-counter - org-agenda-last-prefix-arg) - "Variables that must be local in agenda buffers to allow multiple buffers.") - -(defun org-agenda-mode () - "Mode for time-sorted view on action items in Org-mode files. - -The following commands are available: - -\\{org-agenda-mode-map}" - (interactive) - (cond (org-agenda-doing-sticky-redo - ;; Refreshing sticky agenda-buffer - ;; - ;; Preserve the value of `org-agenda-local-vars' variables, - ;; while letting `kill-all-local-variables' kill the rest - (let ((save (buffer-local-variables))) - (kill-all-local-variables) - (mapc 'make-local-variable org-agenda-local-vars) - (dolist (elem save) - (let ((var (car elem)) - (val (cdr elem))) - (when (and val - (member var org-agenda-local-vars)) - (set var val))))) - (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t)) - (org-agenda-sticky - ;; Creating a sticky Agenda buffer for the first time - (kill-all-local-variables) - (mapc 'make-local-variable org-agenda-local-vars) - (set (make-local-variable 'org-agenda-this-buffer-is-sticky) t)) - (t - ;; Creating a non-sticky agenda buffer - (kill-all-local-variables) - (set (make-local-variable 'org-agenda-this-buffer-is-sticky) nil))) - (setq org-agenda-undo-list nil - org-agenda-pending-undo-list nil - org-agenda-bulk-marked-entries nil) - (setq major-mode 'org-agenda-mode) - ;; Keep global-font-lock-mode from turning on font-lock-mode - (org-set-local 'font-lock-global-modes (list 'not major-mode)) - (setq mode-name "Org-Agenda") - (use-local-map org-agenda-mode-map) - (easy-menu-add org-agenda-menu) - (if org-startup-truncated (setq truncate-lines t)) - (org-set-local 'line-move-visual nil) - (org-add-hook 'post-command-hook 'org-agenda-update-agenda-type nil 'local) - (org-add-hook 'pre-command-hook 'org-unhighlight nil 'local) - ;; Make sure properties are removed when copying text - (org-add-hook 'filter-buffer-substring-functions - (lambda (fun start end delete) - (substring-no-properties (funcall fun start end delete))) - nil t) - (unless org-agenda-keep-modes - (setq org-agenda-follow-mode org-agenda-start-with-follow-mode - org-agenda-entry-text-mode org-agenda-start-with-entry-text-mode - org-agenda-clockreport-mode org-agenda-start-with-clockreport-mode - org-agenda-show-log org-agenda-start-with-log-mode)) - - (easy-menu-change - '("Agenda") "Agenda Files" - (append - (list - (vector - (if (get 'org-agenda-files 'org-restrict) - "Restricted to single file" - "Edit File List") - '(org-edit-agenda-file-list) - (not (get 'org-agenda-files 'org-restrict))) - "--") - (mapcar 'org-file-menu-entry (org-agenda-files)))) - (org-agenda-set-mode-name) - (apply - (if (fboundp 'run-mode-hooks) 'run-mode-hooks 'run-hooks) - (list 'org-agenda-mode-hook))) - -(substitute-key-definition 'undo 'org-agenda-undo - org-agenda-mode-map global-map) -(org-defkey org-agenda-mode-map "\C-i" 'org-agenda-goto) -(org-defkey org-agenda-mode-map [(tab)] 'org-agenda-goto) -(org-defkey org-agenda-mode-map "\C-m" 'org-agenda-switch-to) -(org-defkey org-agenda-mode-map "\C-k" 'org-agenda-kill) -(org-defkey org-agenda-mode-map "\C-c\C-w" 'org-agenda-refile) -(org-defkey org-agenda-mode-map [(meta down)] 'org-agenda-drag-line-forward) -(org-defkey org-agenda-mode-map [(meta up)] 'org-agenda-drag-line-backward) -(org-defkey org-agenda-mode-map "m" 'org-agenda-bulk-mark) -(org-defkey org-agenda-mode-map "\M-m" 'org-agenda-bulk-toggle) -(org-defkey org-agenda-mode-map "*" 'org-agenda-bulk-mark-all) -(org-defkey org-agenda-mode-map "\M-*" 'org-agenda-bulk-toggle-all) -(org-defkey org-agenda-mode-map "#" 'org-agenda-dim-blocked-tasks) -(org-defkey org-agenda-mode-map "%" 'org-agenda-bulk-mark-regexp) -(org-defkey org-agenda-mode-map "u" 'org-agenda-bulk-unmark) -(org-defkey org-agenda-mode-map "U" 'org-agenda-bulk-unmark-all) -(org-defkey org-agenda-mode-map "B" 'org-agenda-bulk-action) -(org-defkey org-agenda-mode-map "k" 'org-agenda-capture) -(org-defkey org-agenda-mode-map "A" 'org-agenda-append-agenda) -(org-defkey org-agenda-mode-map "\C-c\C-x!" 'org-reload) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-a" 'org-agenda-archive-default) -(org-defkey org-agenda-mode-map "\C-c\C-xa" 'org-agenda-toggle-archive-tag) -(org-defkey org-agenda-mode-map "\C-c\C-xA" 'org-agenda-archive-to-archive-sibling) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-s" 'org-agenda-archive) -(org-defkey org-agenda-mode-map "\C-c$" 'org-agenda-archive) -(org-defkey org-agenda-mode-map "$" 'org-agenda-archive) -(org-defkey org-agenda-mode-map "\C-c\C-o" 'org-agenda-open-link) -(org-defkey org-agenda-mode-map " " 'org-agenda-show-and-scroll-up) -(org-defkey org-agenda-mode-map [backspace] 'org-agenda-show-scroll-down) -(org-defkey org-agenda-mode-map "\d" 'org-agenda-show-scroll-down) -(org-defkey org-agenda-mode-map [(control shift right)] 'org-agenda-todo-nextset) -(org-defkey org-agenda-mode-map [(control shift left)] 'org-agenda-todo-previousset) -(org-defkey org-agenda-mode-map "\C-c\C-xb" 'org-agenda-tree-to-indirect-buffer) -(org-defkey org-agenda-mode-map "o" 'delete-other-windows) -(org-defkey org-agenda-mode-map "L" 'org-agenda-recenter) -(org-defkey org-agenda-mode-map "\C-c\C-t" 'org-agenda-todo) -(org-defkey org-agenda-mode-map "t" 'org-agenda-todo) -(org-defkey org-agenda-mode-map "a" 'org-agenda-archive-default-with-confirmation) -(org-defkey org-agenda-mode-map ":" 'org-agenda-set-tags) -(org-defkey org-agenda-mode-map "\C-c\C-q" 'org-agenda-set-tags) -(org-defkey org-agenda-mode-map "." 'org-agenda-goto-today) -(org-defkey org-agenda-mode-map "j" 'org-agenda-goto-date) -(org-defkey org-agenda-mode-map "d" 'org-agenda-day-view) -(org-defkey org-agenda-mode-map "w" 'org-agenda-week-view) -(org-defkey org-agenda-mode-map "y" 'org-agenda-year-view) -(org-defkey org-agenda-mode-map "\C-c\C-z" 'org-agenda-add-note) -(org-defkey org-agenda-mode-map "z" 'org-agenda-add-note) -(org-defkey org-agenda-mode-map [(shift right)] 'org-agenda-do-date-later) -(org-defkey org-agenda-mode-map [(shift left)] 'org-agenda-do-date-earlier) -(org-defkey org-agenda-mode-map [?\C-c ?\C-x (right)] 'org-agenda-do-date-later) -(org-defkey org-agenda-mode-map [?\C-c ?\C-x (left)] 'org-agenda-do-date-earlier) - -(org-defkey org-agenda-mode-map ">" 'org-agenda-date-prompt) -(org-defkey org-agenda-mode-map "\C-c\C-s" 'org-agenda-schedule) -(org-defkey org-agenda-mode-map "\C-c\C-d" 'org-agenda-deadline) -(let ((l '(1 2 3 4 5 6 7 8 9 0))) - (while l (org-defkey org-agenda-mode-map - (int-to-string (pop l)) 'digit-argument))) - -(org-defkey org-agenda-mode-map "F" 'org-agenda-follow-mode) -(org-defkey org-agenda-mode-map "R" 'org-agenda-clockreport-mode) -(org-defkey org-agenda-mode-map "E" 'org-agenda-entry-text-mode) -(org-defkey org-agenda-mode-map "l" 'org-agenda-log-mode) -(org-defkey org-agenda-mode-map "v" 'org-agenda-view-mode-dispatch) -(org-defkey org-agenda-mode-map "D" 'org-agenda-toggle-diary) -(org-defkey org-agenda-mode-map "!" 'org-agenda-toggle-deadlines) -(org-defkey org-agenda-mode-map "G" 'org-agenda-toggle-time-grid) -(org-defkey org-agenda-mode-map "r" 'org-agenda-redo) -(org-defkey org-agenda-mode-map "g" (lambda () (interactive) (org-agenda-redo t))) -(org-defkey org-agenda-mode-map "e" 'org-agenda-set-effort) -(org-defkey org-agenda-mode-map "\C-c\C-xe" 'org-agenda-set-effort) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-e" - 'org-clock-modify-effort-estimate) -(org-defkey org-agenda-mode-map "\C-c\C-xp" 'org-agenda-set-property) -(org-defkey org-agenda-mode-map "q" 'org-agenda-quit) -(org-defkey org-agenda-mode-map "Q" 'org-agenda-Quit) -(org-defkey org-agenda-mode-map "x" 'org-agenda-exit) -(org-defkey org-agenda-mode-map "\C-x\C-w" 'org-agenda-write) -(org-defkey org-agenda-mode-map "\C-x\C-s" 'org-save-all-org-buffers) -(org-defkey org-agenda-mode-map "s" 'org-save-all-org-buffers) -(org-defkey org-agenda-mode-map "T" 'org-agenda-show-tags) -(org-defkey org-agenda-mode-map "n" 'org-agenda-next-line) -(org-defkey org-agenda-mode-map "p" 'org-agenda-previous-line) -(org-defkey org-agenda-mode-map "N" 'org-agenda-next-item) -(org-defkey org-agenda-mode-map "P" 'org-agenda-previous-item) -(substitute-key-definition 'next-line 'org-agenda-next-line - org-agenda-mode-map global-map) -(substitute-key-definition 'previous-line 'org-agenda-previous-line - org-agenda-mode-map global-map) -(org-defkey org-agenda-mode-map "\C-c\C-a" 'org-attach) -(org-defkey org-agenda-mode-map "\C-c\C-n" 'org-agenda-next-date-line) -(org-defkey org-agenda-mode-map "\C-c\C-p" 'org-agenda-previous-date-line) -(org-defkey org-agenda-mode-map "\C-c," 'org-agenda-priority) -(org-defkey org-agenda-mode-map "," 'org-agenda-priority) -(org-defkey org-agenda-mode-map "i" 'org-agenda-diary-entry) -(org-defkey org-agenda-mode-map "c" 'org-agenda-goto-calendar) -(org-defkey org-agenda-mode-map "C" 'org-agenda-convert-date) -(org-defkey org-agenda-mode-map "M" 'org-agenda-phases-of-moon) -(org-defkey org-agenda-mode-map "S" 'org-agenda-sunrise-sunset) -(org-defkey org-agenda-mode-map "h" 'org-agenda-holidays) -(org-defkey org-agenda-mode-map "H" 'org-agenda-holidays) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-i" 'org-agenda-clock-in) -(org-defkey org-agenda-mode-map "I" 'org-agenda-clock-in) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-o" 'org-agenda-clock-out) -(org-defkey org-agenda-mode-map "O" 'org-agenda-clock-out) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-x" 'org-agenda-clock-cancel) -(org-defkey org-agenda-mode-map "X" 'org-agenda-clock-cancel) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-j" 'org-clock-goto) -(org-defkey org-agenda-mode-map "J" 'org-agenda-clock-goto) -(org-defkey org-agenda-mode-map "+" 'org-agenda-priority-up) -(org-defkey org-agenda-mode-map "-" 'org-agenda-priority-down) -(org-defkey org-agenda-mode-map [(shift up)] 'org-agenda-priority-up) -(org-defkey org-agenda-mode-map [(shift down)] 'org-agenda-priority-down) -(org-defkey org-agenda-mode-map [?\C-c ?\C-x (up)] 'org-agenda-priority-up) -(org-defkey org-agenda-mode-map [?\C-c ?\C-x (down)] 'org-agenda-priority-down) -(org-defkey org-agenda-mode-map "f" 'org-agenda-later) -(org-defkey org-agenda-mode-map "b" 'org-agenda-earlier) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns) -(org-defkey org-agenda-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) - -(org-defkey org-agenda-mode-map "[" 'org-agenda-manipulate-query-add) -(org-defkey org-agenda-mode-map "]" 'org-agenda-manipulate-query-subtract) -(org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re) -(org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re) -(org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag) -(org-defkey org-agenda-mode-map "=" 'org-agenda-filter-by-regexp) -(org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all) -(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine) -(org-defkey org-agenda-mode-map "~" 'org-agenda-limit-interactively) -(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category) -(org-defkey org-agenda-mode-map "^" 'org-agenda-filter-by-top-headline) -(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer) -(define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) -(org-defkey org-agenda-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) - -(org-defkey org-agenda-mode-map [mouse-2] 'org-agenda-goto-mouse) -(org-defkey org-agenda-mode-map [mouse-3] 'org-agenda-show-mouse) -(when org-agenda-mouse-1-follows-link - (org-defkey org-agenda-mode-map [follow-link] 'mouse-face)) -(easy-menu-define org-agenda-menu org-agenda-mode-map "Agenda menu" - '("Agenda" - ("Agenda Files") - "--" - ("Agenda Dates" - ["Goto Today" org-agenda-goto-today (org-agenda-check-type nil 'agenda 'timeline)] - ["Next Dates" org-agenda-later (org-agenda-check-type nil 'agenda)] - ["Previous Dates" org-agenda-earlier (org-agenda-check-type nil 'agenda)] - ["Jump to date" org-agenda-goto-date (org-agenda-check-type nil 'agenda)]) - "--" - ("View" - ["Day View" org-agenda-day-view - :active (org-agenda-check-type nil 'agenda) - :style radio :selected (eq org-agenda-current-span 'day) - :keys "v d (or just d)"] - ["Week View" org-agenda-week-view - :active (org-agenda-check-type nil 'agenda) - :style radio :selected (eq org-agenda-current-span 'week) - :keys "v w"] - ["Fortnight View" org-agenda-fortnight-view - :active (org-agenda-check-type nil 'agenda) - :style radio :selected (eq org-agenda-current-span 'fortnight) - :keys "v f"] - ["Month View" org-agenda-month-view - :active (org-agenda-check-type nil 'agenda) - :style radio :selected (eq org-agenda-current-span 'month) - :keys "v m"] - ["Year View" org-agenda-year-view - :active (org-agenda-check-type nil 'agenda) - :style radio :selected (eq org-agenda-current-span 'year) - :keys "v y"] - "--" - ["Include Diary" org-agenda-toggle-diary - :style toggle :selected org-agenda-include-diary - :active (org-agenda-check-type nil 'agenda)] - ["Include Deadlines" org-agenda-toggle-deadlines - :style toggle :selected org-agenda-include-deadlines - :active (org-agenda-check-type nil 'agenda)] - ["Use Time Grid" org-agenda-toggle-time-grid - :style toggle :selected org-agenda-use-time-grid - :active (org-agenda-check-type nil 'agenda)] - "--" - ["Show clock report" org-agenda-clockreport-mode - :style toggle :selected org-agenda-clockreport-mode - :active (org-agenda-check-type nil 'agenda)] - ["Show some entry text" org-agenda-entry-text-mode - :style toggle :selected org-agenda-entry-text-mode - :active t] - "--" - ["Show Logbook entries" org-agenda-log-mode - :style toggle :selected org-agenda-show-log - :active (org-agenda-check-type nil 'agenda 'timeline) - :keys "v l (or just l)"] - ["Include archived trees" org-agenda-archives-mode - :style toggle :selected org-agenda-archives-mode :active t - :keys "v a"] - ["Include archive files" (org-agenda-archives-mode t) - :style toggle :selected (eq org-agenda-archives-mode t) :active t - :keys "v A"] - "--" - ["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict]) - ["Write view to file" org-agenda-write t] - ["Rebuild buffer" org-agenda-redo t] - ["Save all Org-mode Buffers" org-save-all-org-buffers t] - "--" - ["Show original entry" org-agenda-show t] - ["Go To (other window)" org-agenda-goto t] - ["Go To (this window)" org-agenda-switch-to t] - ["Capture with cursor date" org-agenda-capture t] - ["Follow Mode" org-agenda-follow-mode - :style toggle :selected org-agenda-follow-mode :active t] - ;; ["Tree to indirect frame" org-agenda-tree-to-indirect-buffer t] - "--" - ("TODO" - ["Cycle TODO" org-agenda-todo t] - ["Next TODO set" org-agenda-todo-nextset t] - ["Previous TODO set" org-agenda-todo-previousset t] - ["Add note" org-agenda-add-note t]) - ("Archive/Refile/Delete" - ["Archive default" org-agenda-archive-default t] - ["Archive default" org-agenda-archive-default-with-confirmation t] - ["Toggle ARCHIVE tag" org-agenda-toggle-archive-tag t] - ["Move to archive sibling" org-agenda-archive-to-archive-sibling t] - ["Archive subtree" org-agenda-archive t] - "--" - ["Refile" org-agenda-refile t] - "--" - ["Delete subtree" org-agenda-kill t]) - ("Bulk action" - ["Mark entry" org-agenda-bulk-mark t] - ["Mark all" org-agenda-bulk-mark-all t] - ["Unmark entry" org-agenda-bulk-unmark t] - ["Unmark all" org-agenda-bulk-unmark-all :active t :keys "U"] - ["Toggle mark" org-agenda-bulk-toggle t] - ["Toggle all" org-agenda-bulk-toggle-all t] - ["Mark regexp" org-agenda-bulk-mark-regexp t]) - ["Act on all marked" org-agenda-bulk-action t] - "--" - ("Tags and Properties" - ["Show all Tags" org-agenda-show-tags t] - ["Set Tags current line" org-agenda-set-tags (not (org-region-active-p))] - ["Change tag in region" org-agenda-set-tags (org-region-active-p)] - "--" - ["Column View" org-columns t]) - ("Deadline/Schedule" - ["Schedule" org-agenda-schedule t] - ["Set Deadline" org-agenda-deadline t] - "--" - ["Change Date +1 day" org-agenda-date-later (org-agenda-check-type nil 'agenda 'timeline)] - ["Change Date -1 day" org-agenda-date-earlier (org-agenda-check-type nil 'agenda 'timeline)] - ["Change Time +1 hour" org-agenda-do-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-right"] - ["Change Time -1 hour" org-agenda-do-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u S-left"] - ["Change Time + min" org-agenda-date-later :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-right"] - ["Change Time - min" org-agenda-date-earlier :active (org-agenda-check-type nil 'agenda 'timeline) :keys "C-u C-u S-left"] - ["Change Date to ..." org-agenda-date-prompt (org-agenda-check-type nil 'agenda 'timeline)]) - ("Clock and Effort" - ["Clock in" org-agenda-clock-in t] - ["Clock out" org-agenda-clock-out t] - ["Clock cancel" org-agenda-clock-cancel t] - ["Goto running clock" org-clock-goto t] - "--" - ["Set Effort" org-agenda-set-effort t] - ["Change clocked effort" org-clock-modify-effort-estimate - (org-clock-is-active)]) - ("Priority" - ["Set Priority" org-agenda-priority t] - ["Increase Priority" org-agenda-priority-up t] - ["Decrease Priority" org-agenda-priority-down t] - ["Show Priority" org-show-priority t]) - ("Calendar/Diary" - ["New Diary Entry" org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline)] - ["Goto Calendar" org-agenda-goto-calendar (org-agenda-check-type nil 'agenda 'timeline)] - ["Phases of the Moon" org-agenda-phases-of-moon (org-agenda-check-type nil 'agenda 'timeline)] - ["Sunrise/Sunset" org-agenda-sunrise-sunset (org-agenda-check-type nil 'agenda 'timeline)] - ["Holidays" org-agenda-holidays (org-agenda-check-type nil 'agenda 'timeline)] - ["Convert" org-agenda-convert-date (org-agenda-check-type nil 'agenda 'timeline)] - "--" - ["Create iCalendar File" org-icalendar-combine-agenda-files t]) - "--" - ["Undo Remote Editing" org-agenda-undo org-agenda-undo-list] - "--" - ("MobileOrg" - ["Push Files and Views" org-mobile-push t] - ["Get Captured and Flagged" org-mobile-pull t] - ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "C-c a ?"] - ["Show note / unflag" org-agenda-show-the-flagging-note t] - "--" - ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t]) - "--" - ["Quit" org-agenda-quit t] - ["Exit and Release Buffers" org-agenda-exit t] - )) - -;;; Agenda undo - -(defvar org-agenda-allow-remote-undo t - "Non-nil means allow remote undo from the agenda buffer.") -(defvar org-agenda-undo-has-started-in nil - "Buffers that have already seen `undo-start' in the current undo sequence.") - -(defun org-agenda-undo () - "Undo a remote editing step in the agenda. -This undoes changes both in the agenda buffer and in the remote buffer -that have been changed along." - (interactive) - (or org-agenda-allow-remote-undo - (user-error "Check the variable `org-agenda-allow-remote-undo' to activate remote undo")) - (if (not (eq this-command last-command)) - (setq org-agenda-undo-has-started-in nil - org-agenda-pending-undo-list org-agenda-undo-list)) - (if (not org-agenda-pending-undo-list) - (user-error "No further undo information")) - (let* ((entry (pop org-agenda-pending-undo-list)) - buf line cmd rembuf) - (setq cmd (pop entry) line (pop entry)) - (setq rembuf (nth 2 entry)) - (org-with-remote-undo rembuf - (while (bufferp (setq buf (pop entry))) - (if (pop entry) - (with-current-buffer buf - (let ((last-undo-buffer buf) - (inhibit-read-only t)) - (unless (memq buf org-agenda-undo-has-started-in) - (push buf org-agenda-undo-has-started-in) - (make-local-variable 'pending-undo-list) - (undo-start)) - (while (and pending-undo-list - (listp pending-undo-list) - (not (car pending-undo-list))) - (pop pending-undo-list)) - (undo-more 1)))))) - (org-goto-line line) - (message "`%s' undone (buffer %s)" cmd (buffer-name rembuf)))) - -(defun org-verify-change-for-undo (l1 l2) - "Verify that a real change occurred between the undo lists L1 and L2." - (while (and l1 (listp l1) (null (car l1))) (pop l1)) - (while (and l2 (listp l2) (null (car l2))) (pop l2)) - (not (eq l1 l2))) - -;;; Agenda dispatch - -(defvar org-agenda-restrict-begin (make-marker)) -(defvar org-agenda-restrict-end (make-marker)) -(defvar org-agenda-last-dispatch-buffer nil) -(defvar org-agenda-overriding-restriction nil) - -(defcustom org-agenda-custom-commands-contexts nil - "Alist of custom agenda keys and contextual rules. - -For example, if you have a custom agenda command \"p\" and you -want this command to be accessible only from plain text files, -use this: - - '((\"p\" ((in-file . \"\\.txt\")))) - -Here are the available contexts definitions: - - in-file: command displayed only in matching files - in-mode: command displayed only in matching modes - not-in-file: command not displayed in matching files - not-in-mode: command not displayed in matching modes - in-buffer: command displayed only in matching buffers -not-in-buffer: command not displayed in matching buffers - [function]: a custom function taking no argument - -If you define several checks, the agenda command will be -accessible if there is at least one valid check. - -You can also bind a key to another agenda custom command -depending on contextual rules. - - '((\"p\" \"q\" ((in-file . \"\\.txt\")))) - -Here it means: in .txt files, use \"p\" as the key for the -agenda command otherwise associated with \"q\". (The command -originally associated with \"q\" is not displayed to avoid -duplicates.)" - :version "24.3" - :group 'org-agenda-custom-commands - :type '(repeat (list :tag "Rule" - (string :tag " Agenda key") - (string :tag "Replace by command") - (repeat :tag "Available when" - (choice - (cons :tag "Condition" - (choice - (const :tag "In file" in-file) - (const :tag "Not in file" not-in-file) - (const :tag "In buffer" in-buffer) - (const :tag "Not in buffer" not-in-buffer) - (const :tag "In mode" in-mode) - (const :tag "Not in mode" not-in-mode)) - (regexp)) - (function :tag "Custom function")))))) - -(defcustom org-agenda-max-entries nil - "Maximum number of entries to display in an agenda. -This can be nil (no limit) or an integer or an alist of agenda -types with an associated number of entries to display in this -type." - :version "24.4" - :package-version '(Org . "8.0") - :group 'org-agenda-custom-commands - :type '(choice (symbol :tag "No limit" nil) - (integer :tag "Max number of entries") - (repeat - (cons (choice :tag "Agenda type" - (const agenda) - (const todo) - (const tags) - (const search) - (const timeline)) - (integer :tag "Max number of entries"))))) - -(defcustom org-agenda-max-todos nil - "Maximum number of TODOs to display in an agenda. -This can be nil (no limit) or an integer or an alist of agenda -types with an associated number of entries to display in this -type." - :version "24.4" - :package-version '(Org . "8.0") - :group 'org-agenda-custom-commands - :type '(choice (symbol :tag "No limit" nil) - (integer :tag "Max number of entries") - (repeat - (cons (choice :tag "Agenda type" - (const agenda) - (const todo) - (const tags) - (const search) - (const timeline)) - (integer :tag "Max number of entries"))))) - -(defcustom org-agenda-max-tags nil - "Maximum number of tagged entries to display in an agenda. -This can be nil (no limit) or an integer or an alist of agenda -types with an associated number of entries to display in this -type." - :version "24.4" - :package-version '(Org . "8.0") - :group 'org-agenda-custom-commands - :type '(choice (symbol :tag "No limit" nil) - (integer :tag "Max number of entries") - (repeat - (cons (choice :tag "Agenda type" - (const agenda) - (const todo) - (const tags) - (const search) - (const timeline)) - (integer :tag "Max number of entries"))))) - -(defcustom org-agenda-max-effort nil - "Maximum cumulated effort duration for the agenda. -This can be nil (no limit) or a number of minutes (as an integer) -or an alist of agenda types with an associated number of minutes -to limit entries to in this type." - :version "24.4" - :package-version '(Org . "8.0") - :group 'org-agenda-custom-commands - :type '(choice (symbol :tag "No limit" nil) - (integer :tag "Max number of entries") - (repeat - (cons (choice :tag "Agenda type" - (const agenda) - (const todo) - (const tags) - (const search) - (const timeline)) - (integer :tag "Max number of entries"))))) - -(defvar org-keys nil) -(defvar org-match nil) -;;;###autoload -(defun org-agenda (&optional arg org-keys restriction) - "Dispatch agenda commands to collect entries to the agenda buffer. -Prompts for a command to execute. Any prefix arg will be passed -on to the selected command. The default selections are: - -a Call `org-agenda-list' to display the agenda for current day or week. -t Call `org-todo-list' to display the global todo list. -T Call `org-todo-list' to display the global todo list, select only - entries with a specific TODO keyword (the user gets a prompt). -m Call `org-tags-view' to display headlines with tags matching - a condition (the user is prompted for the condition). -M Like `m', but select only TODO entries, no ordinary headlines. -L Create a timeline for the current buffer. -e Export views to associated files. -s Search entries for keywords. -S Search entries for keywords, only with TODO keywords. -/ Multi occur across all agenda files and also files listed - in `org-agenda-text-search-extra-files'. -< Restrict agenda commands to buffer, subtree, or region. - Press several times to get the desired effect. -> Remove a previous restriction. -# List \"stuck\" projects. -! Configure what \"stuck\" means. -C Configure custom agenda commands. - -More commands can be added by configuring the variable -`org-agenda-custom-commands'. In particular, specific tags and TODO keyword -searches can be pre-defined in this way. - -If the current buffer is in Org-mode and visiting a file, you can also -first press `<' once to indicate that the agenda should be temporarily -\(until the next use of \\[org-agenda]) restricted to the current file. -Pressing `<' twice means to restrict to the current subtree or region -\(if active)." - (interactive "P") - (catch 'exit - (let* ((prefix-descriptions nil) - (org-agenda-buffer-name org-agenda-buffer-name) - (org-agenda-window-setup (if (equal (buffer-name) - org-agenda-buffer-name) - 'current-window - org-agenda-window-setup)) - (org-agenda-custom-commands-orig org-agenda-custom-commands) - (org-agenda-custom-commands - ;; normalize different versions - (delq nil - (mapcar - (lambda (x) - (cond ((stringp (cdr x)) - (push x prefix-descriptions) - nil) - ((stringp (nth 1 x)) x) - ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) - (t (cons (car x) (cons "" (cdr x)))))) - org-agenda-custom-commands))) - (org-agenda-custom-commands - (org-contextualize-keys - org-agenda-custom-commands org-agenda-custom-commands-contexts)) - (buf (current-buffer)) - (bfn (buffer-file-name (buffer-base-buffer))) - entry key type org-match lprops ans) - ;; Turn off restriction unless there is an overriding one, - (unless org-agenda-overriding-restriction - (unless (org-bound-and-true-p org-agenda-keep-restricted-file-list) - ;; There is a request to keep the file list in place - (put 'org-agenda-files 'org-restrict nil)) - (setq org-agenda-restrict nil) - (move-marker org-agenda-restrict-begin nil) - (move-marker org-agenda-restrict-end nil)) - ;; Delete old local properties - (put 'org-agenda-redo-command 'org-lprops nil) - ;; Delete previously set last-arguments - (put 'org-agenda-redo-command 'last-args nil) - ;; Remember where this call originated - (setq org-agenda-last-dispatch-buffer (current-buffer)) - (unless org-keys - (setq ans (org-agenda-get-restriction-and-command prefix-descriptions) - org-keys (car ans) - restriction (cdr ans))) - ;; If we have sticky agenda buffers, set a name for the buffer, - ;; depending on the invoking keys. The user may still set this - ;; as a command option, which will overwrite what we do here. - (if org-agenda-sticky - (setq org-agenda-buffer-name - (format "*Org Agenda(%s)*" org-keys))) - ;; Establish the restriction, if any - (when (and (not org-agenda-overriding-restriction) restriction) - (put 'org-agenda-files 'org-restrict (list bfn)) - (cond - ((eq restriction 'region) - (setq org-agenda-restrict (current-buffer)) - (move-marker org-agenda-restrict-begin (region-beginning)) - (move-marker org-agenda-restrict-end (region-end))) - ((eq restriction 'subtree) - (save-excursion - (setq org-agenda-restrict (current-buffer)) - (org-back-to-heading t) - (move-marker org-agenda-restrict-begin (point)) - (move-marker org-agenda-restrict-end - (progn (org-end-of-subtree t))))))) - - ;; For example the todo list should not need it (but does...) - (cond - ((setq entry (assoc org-keys org-agenda-custom-commands)) - (if (or (symbolp (nth 2 entry)) (functionp (nth 2 entry))) - (progn - (setq type (nth 2 entry) org-match (eval (nth 3 entry)) - lprops (nth 4 entry)) - (if org-agenda-sticky - (setq org-agenda-buffer-name - (or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match)) - (format "*Org Agenda(%s)*" org-keys)))) - (put 'org-agenda-redo-command 'org-lprops lprops) - (cond - ((eq type 'agenda) - (org-let lprops '(org-agenda-list current-prefix-arg))) - ((eq type 'agenda*) - (org-let lprops '(org-agenda-list current-prefix-arg nil nil t))) - ((eq type 'alltodo) - (org-let lprops '(org-todo-list current-prefix-arg))) - ((eq type 'search) - (org-let lprops '(org-search-view current-prefix-arg org-match nil))) - ((eq type 'stuck) - (org-let lprops '(org-agenda-list-stuck-projects - current-prefix-arg))) - ((eq type 'tags) - (org-let lprops '(org-tags-view current-prefix-arg org-match))) - ((eq type 'tags-todo) - (org-let lprops '(org-tags-view '(4) org-match))) - ((eq type 'todo) - (org-let lprops '(org-todo-list org-match))) - ((eq type 'tags-tree) - (org-check-for-org-mode) - (org-let lprops '(org-match-sparse-tree current-prefix-arg org-match))) - ((eq type 'todo-tree) - (org-check-for-org-mode) - (org-let lprops - '(org-occur (concat "^" org-outline-regexp "[ \t]*" - (regexp-quote org-match) "\\>")))) - ((eq type 'occur-tree) - (org-check-for-org-mode) - (org-let lprops '(org-occur org-match))) - ((functionp type) - (org-let lprops '(funcall type org-match))) - ((fboundp type) - (org-let lprops '(funcall type org-match))) - (t (user-error "Invalid custom agenda command type %s" type)))) - (org-agenda-run-series (nth 1 entry) (cddr entry)))) - ((equal org-keys "C") - (setq org-agenda-custom-commands org-agenda-custom-commands-orig) - (customize-variable 'org-agenda-custom-commands)) - ((equal org-keys "a") (call-interactively 'org-agenda-list)) - ((equal org-keys "s") (call-interactively 'org-search-view)) - ((equal org-keys "S") (org-call-with-arg 'org-search-view (or arg '(4)))) - ((equal org-keys "t") (call-interactively 'org-todo-list)) - ((equal org-keys "T") (org-call-with-arg 'org-todo-list (or arg '(4)))) - ((equal org-keys "m") (call-interactively 'org-tags-view)) - ((equal org-keys "M") (org-call-with-arg 'org-tags-view (or arg '(4)))) - ((equal org-keys "e") (call-interactively 'org-store-agenda-views)) - ((equal org-keys "?") (org-tags-view nil "+FLAGGED") - (org-add-hook - 'post-command-hook - (lambda () - (unless (current-message) - (let* ((m (org-agenda-get-any-marker)) - (note (and m (org-entry-get m "THEFLAGGINGNOTE")))) - (when note - (message (concat - "FLAGGING-NOTE ([?] for more info): " - (org-add-props - (replace-regexp-in-string - "\\\\n" "//" - (copy-sequence note)) - nil 'face 'org-warning))))))) - t t)) - ((equal org-keys "L") - (unless (derived-mode-p 'org-mode) - (user-error "This is not an Org-mode file")) - (unless restriction - (put 'org-agenda-files 'org-restrict (list bfn)) - (org-call-with-arg 'org-timeline arg))) - ((equal org-keys "#") (call-interactively 'org-agenda-list-stuck-projects)) - ((equal org-keys "/") (call-interactively 'org-occur-in-agenda-files)) - ((equal org-keys "!") (customize-variable 'org-stuck-projects)) - (t (user-error "Invalid agenda key")))))) - -(defvar org-agenda-multi) - -(defun org-agenda-append-agenda () - "Append another agenda view to the current one. -This function allows interactive building of block agendas. -Agenda views are separated by `org-agenda-block-separator'." - (interactive) - (unless (derived-mode-p 'org-agenda-mode) - (user-error "Can only append from within agenda buffer")) - (let ((org-agenda-multi t)) - (org-agenda) - (widen) - (org-agenda-finalize) - (setq buffer-read-only t) - (org-agenda-fit-window-to-buffer))) - -(defun org-agenda-normalize-custom-commands (cmds) - "Normalize custom commands CMDS." - (delq nil - (mapcar - (lambda (x) - (cond ((stringp (cdr x)) nil) - ((stringp (nth 1 x)) x) - ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) - (t (cons (car x) (cons "" (cdr x)))))) - cmds))) - -(defun org-agenda-get-restriction-and-command (prefix-descriptions) - "The user interface for selecting an agenda command." - (catch 'exit - (let* ((bfn (buffer-file-name (buffer-base-buffer))) - (restrict-ok (and bfn (derived-mode-p 'org-mode))) - (region-p (org-region-active-p)) - (custom org-agenda-custom-commands) - (selstring "") - restriction second-time - c entry key type match prefixes rmheader header-end custom1 desc - line lines left right n n1) - (save-window-excursion - (delete-other-windows) - (org-switch-to-buffer-other-window " *Agenda Commands*") - (erase-buffer) - (insert (eval-when-compile - (let ((header - "Press key for an agenda command: < Buffer, subtree/region restriction --------------------------------- > Remove restriction -a Agenda for current week or day e Export agenda views -t List of all TODO entries T Entries with special TODO kwd -m Match a TAGS/PROP/TODO query M Like m, but only TODO entries -s Search for keywords S Like s, but only TODO entries -L Timeline for current buffer # List stuck projects (!=configure) -/ Multi-occur C Configure custom agenda commands -? Find :FLAGGED: entries * Toggle sticky agenda views -") - (start 0)) - (while (string-match - "\\(^\\| \\|(\\)\\(\\S-\\)\\( \\|=\\)" - header start) - (setq start (match-end 0)) - (add-text-properties (match-beginning 2) (match-end 2) - '(face bold) header)) - header))) - (setq header-end (point-marker)) - (while t - (setq custom1 custom) - (when (eq rmheader t) - (org-goto-line 1) - (re-search-forward ":" nil t) - (delete-region (match-end 0) (point-at-eol)) - (forward-char 1) - (looking-at "-+") - (delete-region (match-end 0) (point-at-eol)) - (move-marker header-end (match-end 0))) - (goto-char header-end) - (delete-region (point) (point-max)) - - ;; Produce all the lines that describe custom commands and prefixes - (setq lines nil) - (while (setq entry (pop custom1)) - (setq key (car entry) desc (nth 1 entry) - type (nth 2 entry) - match (nth 3 entry)) - (if (> (length key) 1) - (add-to-list 'prefixes (string-to-char key)) - (setq line - (format - "%-4s%-14s" - (org-add-props (copy-sequence key) - '(face bold)) - (cond - ((string-match "\\S-" desc) desc) - ((eq type 'agenda) "Agenda for current week or day") - ((eq type 'agenda*) "Appointments for current week or day") - ((eq type 'alltodo) "List of all TODO entries") - ((eq type 'search) "Word search") - ((eq type 'stuck) "List of stuck projects") - ((eq type 'todo) "TODO keyword") - ((eq type 'tags) "Tags query") - ((eq type 'tags-todo) "Tags (TODO)") - ((eq type 'tags-tree) "Tags tree") - ((eq type 'todo-tree) "TODO kwd tree") - ((eq type 'occur-tree) "Occur tree") - ((functionp type) (if (symbolp type) - (symbol-name type) - "Lambda expression")) - (t "???")))) - (if org-agenda-menu-show-matcher - (setq line - (concat line ": " - (cond - ((stringp match) - (setq match (copy-sequence match)) - (org-add-props match nil 'face 'org-warning)) - ((listp type) - (format "set of %d commands" (length type)))))) - (if (org-string-nw-p match) - (add-text-properties - 0 (length line) (list 'help-echo - (concat "Matcher: " match)) line))) - (push line lines))) - (setq lines (nreverse lines)) - (when prefixes - (mapc (lambda (x) - (push - (format "%s %s" - (org-add-props (char-to-string x) - nil 'face 'bold) - (or (cdr (assoc (concat selstring - (char-to-string x)) - prefix-descriptions)) - "Prefix key")) - lines)) - prefixes)) - - ;; Check if we should display in two columns - (if org-agenda-menu-two-columns - (progn - (setq n (length lines) - n1 (+ (/ n 2) (mod n 2)) - right (nthcdr n1 lines) - left (copy-sequence lines)) - (setcdr (nthcdr (1- n1) left) nil)) - (setq left lines right nil)) - (while left - (insert "\n" (pop left)) - (when right - (if (< (current-column) 40) - (move-to-column 40 t) - (insert " ")) - (insert (pop right)))) - - ;; Make the window the right size - (goto-char (point-min)) - (if second-time - (if (not (pos-visible-in-window-p (point-max))) - (org-fit-window-to-buffer)) - (setq second-time t) - (org-fit-window-to-buffer)) - - ;; Ask for selection - (message "Press key for agenda command%s:" - (if (or restrict-ok org-agenda-overriding-restriction) - (if org-agenda-overriding-restriction - " (restriction lock active)" - (if restriction - (format " (restricted to %s)" restriction) - " (unrestricted)")) - "")) - (setq c (read-char-exclusive)) - (message "") - (cond - ((assoc (char-to-string c) custom) - (setq selstring (concat selstring (char-to-string c))) - (throw 'exit (cons selstring restriction))) - ((memq c prefixes) - (setq selstring (concat selstring (char-to-string c)) - prefixes nil - rmheader (or rmheader t) - custom (delq nil (mapcar - (lambda (x) - (if (or (= (length (car x)) 1) - (/= (string-to-char (car x)) c)) - nil - (cons (substring (car x) 1) (cdr x)))) - custom)))) - ((eq c ?*) - (call-interactively 'org-toggle-sticky-agenda) - (sit-for 2)) - ((and (not restrict-ok) (memq c '(?1 ?0 ?<))) - (message "Restriction is only possible in Org-mode buffers") - (ding) (sit-for 1)) - ((eq c ?1) - (org-agenda-remove-restriction-lock 'noupdate) - (setq restriction 'buffer)) - ((eq c ?0) - (org-agenda-remove-restriction-lock 'noupdate) - (setq restriction (if region-p 'region 'subtree))) - ((eq c ?<) - (org-agenda-remove-restriction-lock 'noupdate) - (setq restriction - (cond - ((eq restriction 'buffer) - (if region-p 'region 'subtree)) - ((memq restriction '(subtree region)) - nil) - (t 'buffer)))) - ((eq c ?>) - (org-agenda-remove-restriction-lock 'noupdate) - (setq restriction nil)) - ((and (equal selstring "") (memq c '(?s ?S ?a ?t ?m ?L ?C ?e ?T ?M ?# ?! ?/ ??))) - (throw 'exit (cons (setq selstring (char-to-string c)) restriction))) - ((and (> (length selstring) 0) (eq c ?\d)) - (delete-window) - (org-agenda-get-restriction-and-command prefix-descriptions)) - - ((equal c ?q) (error "Abort")) - (t (user-error "Invalid key %c" c)))))))) - -(defun org-agenda-fit-window-to-buffer () - "Fit the window to the buffer size." - (and (memq org-agenda-window-setup '(reorganize-frame)) - (fboundp 'fit-window-to-buffer) - (org-fit-window-to-buffer - nil - (floor (* (frame-height) (cdr org-agenda-window-frame-fractions))) - (floor (* (frame-height) (car org-agenda-window-frame-fractions)))))) - -(defvar org-cmd nil) -(defvar org-agenda-overriding-cmd nil) -(defvar org-agenda-overriding-arguments nil) -(defvar org-agenda-overriding-cmd-arguments nil) -(defun org-agenda-run-series (name series) - "Run agenda NAME as a SERIES of agenda commands." - (org-let (nth 1 series) '(org-agenda-prepare name)) - ;; We need to reset agenda markers here, because when constructing a - ;; block agenda, the individual blocks do not do that. - (org-agenda-reset-markers) - (let* ((org-agenda-multi t) - (redo (list 'org-agenda-run-series name (list 'quote series))) - (cmds (car series)) - (gprops (nth 1 series)) - match ;; The byte compiler incorrectly complains about this. Keep it! - org-cmd type lprops) - (while (setq org-cmd (pop cmds)) - (setq type (car org-cmd) - match (eval (nth 1 org-cmd)) - lprops (nth 2 org-cmd)) - (let ((org-agenda-overriding-arguments - (if (eq org-agenda-overriding-cmd org-cmd) - (or org-agenda-overriding-arguments - org-agenda-overriding-cmd-arguments)))) - (cond - ((eq type 'agenda) - (org-let2 gprops lprops - '(call-interactively 'org-agenda-list))) - ((eq type 'agenda*) - (org-let2 gprops lprops - '(funcall 'org-agenda-list nil nil t))) - ((eq type 'alltodo) - (org-let2 gprops lprops - '(call-interactively 'org-todo-list))) - ((eq type 'search) - (org-let2 gprops lprops - '(org-search-view current-prefix-arg match nil))) - ((eq type 'stuck) - (org-let2 gprops lprops - '(call-interactively 'org-agenda-list-stuck-projects))) - ((eq type 'tags) - (org-let2 gprops lprops - '(org-tags-view current-prefix-arg match))) - ((eq type 'tags-todo) - (org-let2 gprops lprops - '(org-tags-view '(4) match))) - ((eq type 'todo) - (org-let2 gprops lprops - '(org-todo-list match))) - ((fboundp type) - (org-let2 gprops lprops - '(funcall type match))) - (t (error "Invalid type in command series"))))) - (widen) - (let ((inhibit-read-only t)) - (add-text-properties (point-min) (point-max) - `(org-series t org-series-redo-cmd ,redo))) - (setq org-agenda-redo-command redo) - (goto-char (point-min))) - (org-agenda-fit-window-to-buffer) - (org-let (nth 1 series) '(org-agenda-finalize))) - -;;;###autoload -(defmacro org-batch-agenda (cmd-key &rest parameters) - "Run an agenda command in batch mode and send the result to STDOUT. -If CMD-KEY is a string of length 1, it is used as a key in -`org-agenda-custom-commands' and triggers this command. If it is a -longer string it is used as a tags/todo match string. -Parameters are alternating variable names and values that will be bound -before running the agenda command." - (org-eval-in-environment (org-make-parameter-alist parameters) - (let (org-agenda-sticky) - (if (> (length cmd-key) 2) - (org-tags-view nil cmd-key) - (org-agenda nil cmd-key)))) - (set-buffer org-agenda-buffer-name) - (princ (buffer-string))) - -(defvar org-agenda-info nil) - -;;;###autoload -(defmacro org-batch-agenda-csv (cmd-key &rest parameters) - "Run an agenda command in batch mode and send the result to STDOUT. -If CMD-KEY is a string of length 1, it is used as a key in -`org-agenda-custom-commands' and triggers this command. If it is a -longer string it is used as a tags/todo match string. -Parameters are alternating variable names and values that will be bound -before running the agenda command. - -The output gives a line for each selected agenda item. Each -item is a list of comma-separated values, like this: - -category,head,type,todo,tags,date,time,extra,priority-l,priority-n - -category The category of the item -head The headline, without TODO kwd, TAGS and PRIORITY -type The type of the agenda entry, can be - todo selected in TODO match - tagsmatch selected in tags match - diary imported from diary - deadline a deadline on given date - scheduled scheduled on given date - timestamp entry has timestamp on given date - closed entry was closed on given date - upcoming-deadline warning about deadline - past-scheduled forwarded scheduled item - block entry has date block including g. date -todo The todo keyword, if any -tags All tags including inherited ones, separated by colons -date The relevant date, like 2007-2-14 -time The time, like 15:00-16:50 -extra Sting with extra planning info -priority-l The priority letter if any was given -priority-n The computed numerical priority -agenda-day The day in the agenda where this is listed" - (org-eval-in-environment (append '((org-agenda-remove-tags t)) - (org-make-parameter-alist parameters)) - (if (> (length cmd-key) 2) - (org-tags-view nil cmd-key) - (org-agenda nil cmd-key))) - (set-buffer org-agenda-buffer-name) - (let* ((lines (org-split-string (buffer-string) "\n")) - line) - (while (setq line (pop lines)) - (catch 'next - (if (not (get-text-property 0 'org-category line)) (throw 'next nil)) - (setq org-agenda-info - (org-fix-agenda-info (text-properties-at 0 line))) - (princ - (mapconcat 'org-agenda-export-csv-mapper - '(org-category txt type todo tags date time extra - priority-letter priority agenda-day) - ",")) - (princ "\n"))))) - -(defun org-fix-agenda-info (props) - "Make sure all properties on an agenda item have a canonical form. -This ensures the export commands can easily use it." - (let (tmp re) - (when (setq tmp (plist-get props 'tags)) - (setq props (plist-put props 'tags (mapconcat 'identity tmp ":")))) - (when (setq tmp (plist-get props 'date)) - (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) - (let ((calendar-date-display-form '(year "-" month "-" day))) - '((format "%4d, %9s %2s, %4s" dayname monthname day year)) - - (setq tmp (calendar-date-string tmp))) - (setq props (plist-put props 'date tmp))) - (when (setq tmp (plist-get props 'day)) - (if (integerp tmp) (setq tmp (calendar-gregorian-from-absolute tmp))) - (let ((calendar-date-display-form '(year "-" month "-" day))) - (setq tmp (calendar-date-string tmp))) - (setq props (plist-put props 'day tmp)) - (setq props (plist-put props 'agenda-day tmp))) - (when (setq tmp (plist-get props 'txt)) - (when (string-match "\\[#\\([A-Z0-9]\\)\\] ?" tmp) - (plist-put props 'priority-letter (match-string 1 tmp)) - (setq tmp (replace-match "" t t tmp))) - (when (and (setq re (plist-get props 'org-todo-regexp)) - (setq re (concat "\\`\\.*" re " ?")) - (string-match re tmp)) - (plist-put props 'todo (match-string 1 tmp)) - (setq tmp (replace-match "" t t tmp))) - (plist-put props 'txt tmp))) - props) - -(defun org-agenda-export-csv-mapper (prop) - (let ((res (plist-get org-agenda-info prop))) - (setq res - (cond - ((not res) "") - ((stringp res) res) - (t (prin1-to-string res)))) - (while (string-match "," res) - (setq res (replace-match ";" t t res))) - (org-trim res))) - -;;;###autoload -(defun org-store-agenda-views (&rest parameters) - "Store agenda views." - (interactive) - (eval (list 'org-batch-store-agenda-views))) - -;;;###autoload -(defmacro org-batch-store-agenda-views (&rest parameters) - "Run all custom agenda commands that have a file argument." - (let ((cmds (org-agenda-normalize-custom-commands org-agenda-custom-commands)) - (pop-up-frames nil) - (dir default-directory) - (pars (org-make-parameter-alist parameters)) - cmd thiscmdkey thiscmdcmd match files opts cmd-or-set bufname) - (save-window-excursion - (while cmds - (setq cmd (pop cmds) - thiscmdkey (car cmd) - thiscmdcmd (cdr cmd) - match (nth 2 thiscmdcmd) - bufname (if org-agenda-sticky - (or (and (stringp match) - (format "*Org Agenda(%s:%s)*" thiscmdkey match)) - (format "*Org Agenda(%s)*" thiscmdkey)) - org-agenda-buffer-name) - cmd-or-set (nth 2 cmd) - opts (nth (if (listp cmd-or-set) 3 4) cmd) - files (nth (if (listp cmd-or-set) 4 5) cmd)) - (if (stringp files) (setq files (list files))) - (when files - (org-eval-in-environment (append org-agenda-exporter-settings - opts pars) - (org-agenda nil thiscmdkey)) - (set-buffer bufname) - (while files - (org-eval-in-environment (append org-agenda-exporter-settings - opts pars) - (org-agenda-write (expand-file-name (pop files) dir) nil t bufname))) - (and (get-buffer bufname) - (kill-buffer bufname))))))) - -(defvar org-agenda-current-span nil - "The current span used in the agenda view.") ; local variable in the agenda buffer -(defun org-agenda-mark-header-line (pos) - "Mark the line at POS as an agenda structure header." - (save-excursion - (goto-char pos) - (put-text-property (point-at-bol) (point-at-eol) - 'org-agenda-structural-header t) - (when org-agenda-title-append - (put-text-property (point-at-bol) (point-at-eol) - 'org-agenda-title-append org-agenda-title-append)))) - -(defvar org-mobile-creating-agendas) ; defined in org-mobile.el -(defvar org-agenda-write-buffer-name "Agenda View") -(defun org-agenda-write (file &optional open nosettings agenda-bufname) - "Write the current buffer (an agenda view) as a file. -Depending on the extension of the file name, plain text (.txt), -HTML (.html or .htm), PDF (.pdf) or Postscript (.ps) is produced. -If the extension is .ics, run icalendar export over all files used -to construct the agenda and limit the export to entries listed in the -agenda now. -If the extension is .org, collect all subtrees corresponding to the -agenda entries and add them in an .org file. -With prefix argument OPEN, open the new file immediately. -If NOSETTINGS is given, do not scope the settings of -`org-agenda-exporter-settings' into the export commands. This is used when -the settings have already been scoped and we do not wish to overrule other, -higher priority settings. -If AGENDA-BUFFER-NAME, use this as the buffer name for the agenda to write." - (interactive "FWrite agenda to file: \nP") - (if (or (not (file-writable-p file)) - (and (file-exists-p file) - (if (org-called-interactively-p 'any) - (not (y-or-n-p (format "Overwrite existing file %s? " file)))))) - (user-error "Cannot write agenda to file %s" file)) - (org-let (if nosettings nil org-agenda-exporter-settings) - '(save-excursion - (save-window-excursion - (org-agenda-mark-filtered-text) - (let ((bs (copy-sequence (buffer-string))) beg content) - (org-agenda-unmark-filtered-text) - (with-temp-buffer - (rename-buffer org-agenda-write-buffer-name t) - (set-buffer-modified-p nil) - (insert bs) - (org-agenda-remove-marked-text 'org-filtered) - (while (setq beg (text-property-any (point-min) (point-max) - 'org-filtered t)) - (delete-region - beg (or (next-single-property-change beg 'org-filtered) - (point-max)))) - (run-hooks 'org-agenda-before-write-hook) - (cond - ((org-bound-and-true-p org-mobile-creating-agendas) - (org-mobile-write-agenda-for-mobile file)) - ((string-match "\\.org\\'" file) - (let (content p m message-log-max) - (goto-char (point-min)) - (while (setq p (next-single-property-change (point) 'org-hd-marker nil)) - (goto-char p) - (setq m (get-text-property (point) 'org-hd-marker)) - (when m - (push (save-excursion - (set-buffer (marker-buffer m)) - (goto-char m) - (org-copy-subtree 1 nil t t) - org-subtree-clip) - content))) - (find-file file) - (erase-buffer) - (mapcar (lambda (s) (org-paste-subtree 1 s)) (reverse content)) - (write-file file) - (kill-buffer (current-buffer)) - (message "Org file written to %s" file))) - ((string-match "\\.html?\\'" file) - (require 'htmlize) - (set-buffer (htmlize-buffer (current-buffer))) - (when org-agenda-export-html-style - ;; replace ")) - (insert org-agenda-export-html-style)) - (write-file file) - (kill-buffer (current-buffer)) - (message "HTML written to %s" file)) - ((string-match "\\.ps\\'" file) - (require 'ps-print) - (ps-print-buffer-with-faces file) - (message "Postscript written to %s" file)) - ((string-match "\\.pdf\\'" file) - (require 'ps-print) - (ps-print-buffer-with-faces - (concat (file-name-sans-extension file) ".ps")) - (call-process "ps2pdf" nil nil nil - (expand-file-name - (concat (file-name-sans-extension file) ".ps")) - (expand-file-name file)) - (delete-file (concat (file-name-sans-extension file) ".ps")) - (message "PDF written to %s" file)) - ((string-match "\\.ics\\'" file) - (require 'ox-icalendar) - (org-icalendar-export-current-agenda (expand-file-name file))) - (t - (let ((bs (buffer-string))) - (find-file file) - (erase-buffer) - (insert bs) - (save-buffer 0) - (kill-buffer (current-buffer)) - (message "Plain text written to %s" file)))))))) - (set-buffer (or agenda-bufname - (and (org-called-interactively-p 'any) (buffer-name)) - org-agenda-buffer-name))) - (when open (org-open-file file))) - -(defvar org-agenda-tag-filter-overlays nil) -(defvar org-agenda-cat-filter-overlays nil) -(defvar org-agenda-re-filter-overlays nil) - -(defun org-agenda-mark-filtered-text () - "Mark all text hidden by filtering with a text property." - (let ((inhibit-read-only t)) - (mapc - (lambda (o) - (when (equal (overlay-buffer o) (current-buffer)) - (put-text-property - (overlay-start o) (overlay-end o) - 'org-filtered t))) - (append org-agenda-tag-filter-overlays - org-agenda-cat-filter-overlays - org-agenda-re-filter-overlays)))) - -(defun org-agenda-unmark-filtered-text () - "Remove the filtering text property." - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(org-filtered t)))) - -(defun org-agenda-remove-marked-text (property &optional value) - "Delete all text marked with VALUE of PROPERTY. -VALUE defaults to t." - (let (beg) - (setq value (or value t)) - (while (setq beg (text-property-any (point-min) (point-max) - property value)) - (delete-region - beg (or (next-single-property-change beg 'org-filtered) - (point-max)))))) - -(defun org-agenda-add-entry-text () - "Add entry text to agenda lines. -This will add a maximum of `org-agenda-add-entry-text-maxlines' lines of the -entry text following headings shown in the agenda. -Drawers will be excluded, also the line with scheduling/deadline info." - (when (and (> org-agenda-add-entry-text-maxlines 0) - (not (org-bound-and-true-p org-mobile-creating-agendas))) - (let (m txt) - (goto-char (point-min)) - (while (not (eobp)) - (if (not (setq m (org-get-at-bol 'org-hd-marker))) - (beginning-of-line 2) - (setq txt (org-agenda-get-some-entry-text - m org-agenda-add-entry-text-maxlines " > ")) - (end-of-line 1) - (if (string-match "\\S-" txt) - (insert "\n" txt) - (or (eobp) (forward-char 1)))))))) - -(defun org-agenda-get-some-entry-text (marker n-lines &optional indent - &rest keep) - "Extract entry text from MARKER, at most N-LINES lines. -This will ignore drawers etc, just get the text. -If INDENT is given, prefix every line with this string. If KEEP is -given, it is a list of symbols, defining stuff that should not be -removed from the entry content. Currently only `planning' is allowed here." - (let (txt drawer-re kwd-time-re ind) - (save-excursion - (with-current-buffer (marker-buffer marker) - (if (not (derived-mode-p 'org-mode)) - (setq txt "") - (save-excursion - (save-restriction - (widen) - (goto-char marker) - (end-of-line 1) - (setq txt (buffer-substring - (min (1+ (point)) (point-max)) - (progn (outline-next-heading) (point))) - drawer-re org-drawer-regexp - kwd-time-re (concat "^[ \t]*" org-keyword-time-regexp - ".*\n?")) - (with-temp-buffer - (insert txt) - (when org-agenda-add-entry-text-descriptive-links - (goto-char (point-min)) - (while (org-activate-bracket-links (point-max)) - (add-text-properties (match-beginning 0) (match-end 0) - '(face org-link)))) - (goto-char (point-min)) - (while (re-search-forward org-bracket-link-regexp (point-max) t) - (set-text-properties (match-beginning 0) (match-end 0) - nil)) - (goto-char (point-min)) - (while (re-search-forward drawer-re nil t) - (delete-region - (match-beginning 0) - (progn (re-search-forward - "^[ \t]*:END:.*\n?" nil 'move) - (point)))) - (unless (member 'planning keep) - (goto-char (point-min)) - (while (re-search-forward kwd-time-re nil t) - (replace-match ""))) - (goto-char (point-min)) - (when org-agenda-entry-text-exclude-regexps - (let ((re-list org-agenda-entry-text-exclude-regexps) re) - (while (setq re (pop re-list)) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (replace-match ""))))) - (goto-char (point-max)) - (skip-chars-backward " \t\n") - (if (looking-at "[ \t\n]+\\'") (replace-match "")) - - ;; find and remove min common indentation - (goto-char (point-min)) - (untabify (point-min) (point-max)) - (setq ind (org-get-indentation)) - (while (not (eobp)) - (unless (looking-at "[ \t]*$") - (setq ind (min ind (org-get-indentation)))) - (beginning-of-line 2)) - (goto-char (point-min)) - (while (not (eobp)) - (unless (looking-at "[ \t]*$") - (move-to-column ind) - (delete-region (point-at-bol) (point))) - (beginning-of-line 2)) - - (run-hooks 'org-agenda-entry-text-cleanup-hook) - - (goto-char (point-min)) - (when indent - (while (and (not (eobp)) (re-search-forward "^" nil t)) - (replace-match indent t t))) - (goto-char (point-min)) - (while (looking-at "[ \t]*\n") (replace-match "")) - (goto-char (point-max)) - (when (> (org-current-line) - n-lines) - (org-goto-line (1+ n-lines)) - (backward-char 1)) - (setq txt (buffer-substring (point-min) (point))))))))) - txt)) - -(defun org-check-for-org-mode () - "Make sure current buffer is in org-mode. Error if not." - (or (derived-mode-p 'org-mode) - (error "Cannot execute org-mode agenda command on buffer in %s" - major-mode))) - -;;; Agenda prepare and finalize - -(defvar org-agenda-multi nil) ; dynamically scoped -(defvar org-agenda-pre-window-conf nil) -(defvar org-agenda-columns-active nil) -(defvar org-agenda-name nil) -(defvar org-agenda-tag-filter nil) -(defvar org-agenda-category-filter nil) -(defvar org-agenda-regexp-filter nil) -(defvar org-agenda-top-headline-filter nil) -(defvar org-agenda-tag-filter-while-redo nil) -(defvar org-agenda-tag-filter-preset nil - "A preset of the tags filter used for secondary agenda filtering. -This must be a list of strings, each string must be a single tag preceded -by \"+\" or \"-\". -This variable should not be set directly, but agenda custom commands can -bind it in the options section. The preset filter is a global property of -the entire agenda view. In a block agenda, it will not work reliably to -define a filter for one of the individual blocks. You need to set it in -the global options and expect it to be applied to the entire view.") - -(defvar org-agenda-category-filter-preset nil - "A preset of the category filter used for secondary agenda filtering. -This must be a list of strings, each string must be a single category -preceded by \"+\" or \"-\". -This variable should not be set directly, but agenda custom commands can -bind it in the options section. The preset filter is a global property of -the entire agenda view. In a block agenda, it will not work reliably to -define a filter for one of the individual blocks. You need to set it in -the global options and expect it to be applied to the entire view.") - -(defvar org-agenda-regexp-filter-preset nil - "A preset of the regexp filter used for secondary agenda filtering. -This must be a list of strings, each string must be a single category -preceded by \"+\" or \"-\". -This variable should not be set directly, but agenda custom commands can -bind it in the options section. The preset filter is a global property of -the entire agenda view. In a block agenda, it will not work reliably to -define a filter for one of the individual blocks. You need to set it in -the global options and expect it to be applied to the entire view.") - -(defun org-agenda-use-sticky-p () - "Return non-nil if an agenda buffer named -`org-agenda-buffer-name' exists and should be shown instead of -generating a new one." - (and - ;; turned off by user - org-agenda-sticky - ;; For multi-agenda buffer already exists - (not org-agenda-multi) - ;; buffer found - (get-buffer org-agenda-buffer-name) - ;; C-u parameter is same as last call - (with-current-buffer (get-buffer org-agenda-buffer-name) - (and - (equal current-prefix-arg - org-agenda-last-prefix-arg) - ;; In case user turned stickiness on, while having existing - ;; Agenda buffer active, don't reuse that buffer, because it - ;; does not have org variables local - org-agenda-this-buffer-is-sticky)))) - -(defun org-agenda-prepare-window (abuf) - "Setup agenda buffer in the window." - (let* ((awin (get-buffer-window abuf)) - wconf) - (cond - ((equal (current-buffer) abuf) nil) - (awin (select-window awin)) - ((not (setq wconf (current-window-configuration)))) - ((equal org-agenda-window-setup 'current-window) - (org-pop-to-buffer-same-window abuf)) - ((equal org-agenda-window-setup 'other-window) - (org-switch-to-buffer-other-window abuf)) - ((equal org-agenda-window-setup 'other-frame) - (switch-to-buffer-other-frame abuf)) - ((equal org-agenda-window-setup 'reorganize-frame) - (delete-other-windows) - (org-switch-to-buffer-other-window abuf))) - ;; additional test in case agenda is invoked from within agenda - ;; buffer via elisp link - (unless (equal (current-buffer) abuf) - (org-pop-to-buffer-same-window abuf)) - (setq org-agenda-pre-window-conf - (or org-agenda-pre-window-conf wconf)))) - -(defun org-agenda-prepare (&optional name) - (if (org-agenda-use-sticky-p) - (progn - ;; Popup existing buffer - (org-agenda-prepare-window (get-buffer org-agenda-buffer-name)) - (message "Sticky Agenda buffer, use `r' to refresh") - (or org-agenda-multi (org-agenda-fit-window-to-buffer)) - (throw 'exit "Sticky Agenda buffer, use `r' to refresh")) - (setq org-todo-keywords-for-agenda nil) - (setq org-drawers-for-agenda nil) - (unless org-agenda-persistent-filter - (setq org-agenda-tag-filter nil - org-agenda-category-filter nil - org-agenda-regexp-filter nil)) - (put 'org-agenda-tag-filter :preset-filter - org-agenda-tag-filter-preset) - (put 'org-agenda-category-filter :preset-filter - org-agenda-category-filter-preset) - (put 'org-agenda-regexp-filter :preset-filter - org-agenda-regexp-filter-preset) - (if org-agenda-multi - (progn - (setq buffer-read-only nil) - (goto-char (point-max)) - (unless (or (bobp) org-agenda-compact-blocks - (not org-agenda-block-separator)) - (insert "\n" - (if (stringp org-agenda-block-separator) - org-agenda-block-separator - (make-string (window-width) org-agenda-block-separator)) - "\n")) - (narrow-to-region (point) (point-max))) - (setq org-done-keywords-for-agenda nil) - - ;; Setting any org variables that are in org-agenda-local-vars - ;; list need to be done after the prepare call - (org-agenda-prepare-window (get-buffer-create org-agenda-buffer-name)) - (setq buffer-read-only nil) - (org-agenda-reset-markers) - (let ((inhibit-read-only t)) (erase-buffer)) - (org-agenda-mode) - (setq org-agenda-buffer (current-buffer)) - (setq org-agenda-contributing-files nil) - (setq org-agenda-columns-active nil) - (org-agenda-prepare-buffers (org-agenda-files nil 'ifmode)) - (setq org-todo-keywords-for-agenda - (org-uniquify org-todo-keywords-for-agenda)) - (setq org-done-keywords-for-agenda - (org-uniquify org-done-keywords-for-agenda)) - (setq org-drawers-for-agenda (org-uniquify org-drawers-for-agenda)) - (setq org-agenda-last-prefix-arg current-prefix-arg) - (setq org-agenda-this-buffer-name org-agenda-buffer-name) - (and name (not org-agenda-name) - (org-set-local 'org-agenda-name name))) - (setq buffer-read-only nil))) - -(defvar org-agenda-overriding-columns-format) ; From org-colview.el -(defun org-agenda-finalize () - "Finishing touch for the agenda buffer, called just before displaying it." - (unless org-agenda-multi - (save-excursion - (let ((inhibit-read-only t)) - (goto-char (point-min)) - (save-excursion - (while (org-activate-bracket-links (point-max)) - (add-text-properties (match-beginning 0) (match-end 0) - '(face org-link)))) - (save-excursion - (while (org-activate-plain-links (point-max)) - (add-text-properties (match-beginning 0) (match-end 0) - '(face org-link)))) - (unless (eq org-agenda-remove-tags t) - (org-agenda-align-tags)) - (unless org-agenda-with-colors - (remove-text-properties (point-min) (point-max) '(face nil))) - (if (and (boundp 'org-agenda-overriding-columns-format) - org-agenda-overriding-columns-format) - (org-set-local 'org-agenda-overriding-columns-format - org-agenda-overriding-columns-format)) - (if (and (boundp 'org-agenda-view-columns-initially) - org-agenda-view-columns-initially) - (org-agenda-columns)) - (when org-agenda-fontify-priorities - (org-agenda-fontify-priorities)) - (when (and org-agenda-dim-blocked-tasks org-blocker-hook) - (org-agenda-dim-blocked-tasks)) - ;; We need to widen when `org-agenda-finalize' is called from - ;; `org-agenda-change-all-lines' (e.g. in `org-agenda-clock-in') - (when org-clock-current-task - (save-restriction - (widen) - (org-agenda-mark-clocking-task))) - (when org-agenda-entry-text-mode - (org-agenda-entry-text-hide) - (org-agenda-entry-text-show)) - (if (and (functionp 'org-habit-insert-consistency-graphs) - (save-excursion (next-single-property-change (point-min) 'org-habit-p))) - (org-habit-insert-consistency-graphs)) - (setq org-agenda-type (org-get-at-bol 'org-agenda-type)) - (unless (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq org-agenda-type org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (and (listp org-agenda-use-tag-inheritance) - (not (memq org-agenda-type - org-agenda-use-tag-inheritance)))))) - (let (mrk) - (save-excursion - (goto-char (point-min)) - (while (equal (forward-line) 0) - (when (setq mrk (or (get-text-property (point) 'org-hd-marker) - (get-text-property (point) 'org-hd-marker))) - (put-text-property (point-at-bol) (point-at-eol) - 'tags (org-with-point-at mrk - (delete-dups - (mapcar 'downcase (org-get-tags-at)))))))))) - (run-hooks 'org-agenda-finalize-hook) - (when (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter)) - (org-agenda-filter-apply org-agenda-tag-filter 'tag)) - (when (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter)) - (org-agenda-filter-apply org-agenda-category-filter 'category)) - (when (or org-agenda-regexp-filter (get 'org-agenda-regexp-filter :preset-filter)) - (org-agenda-filter-apply org-agenda-regexp-filter 'regexp)) - (org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local))))) - -(defun org-agenda-mark-clocking-task () - "Mark the current clock entry in the agenda if it is present." - (org-agenda-unmark-clocking-task) - (when (marker-buffer org-clock-hd-marker) - (save-excursion - (goto-char (point-min)) - (let (s ov) - (while (setq s (next-single-property-change (point) 'org-hd-marker)) - (goto-char s) - (when (equal (org-get-at-bol 'org-hd-marker) - org-clock-hd-marker) - (setq ov (make-overlay (point-at-bol) (1+ (point-at-eol)))) - (overlay-put ov 'type 'org-agenda-clocking) - (overlay-put ov 'face 'org-agenda-clocking) - (overlay-put ov 'help-echo - "The clock is running in this item"))))))) - -(defun org-agenda-unmark-clocking-task () - "Unmark the current clocking task." - (mapc (lambda (o) - (if (eq (overlay-get o 'type) 'org-agenda-clocking) - (delete-overlay o))) - (overlays-in (point-min) (point-max)))) - -(defun org-agenda-fontify-priorities () - "Make highest priority lines bold, and lowest italic." - (interactive) - (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-priority) - (delete-overlay o))) - (overlays-in (point-min) (point-max))) - (save-excursion - (let (b e p ov h l) - (goto-char (point-min)) - (while (re-search-forward "\\[#\\(.\\)\\]" nil t) - (setq h (or (get-char-property (point) 'org-highest-priority) - org-highest-priority) - l (or (get-char-property (point) 'org-lowest-priority) - org-lowest-priority) - p (string-to-char (match-string 1)) - b (match-beginning 0) - e (if (eq org-agenda-fontify-priorities 'cookies) - (match-end 0) - (point-at-eol)) - ov (make-overlay b e)) - (overlay-put - ov 'face - (cons (cond ((org-face-from-face-or-color - 'priority nil - (cdr (assoc p org-priority-faces)))) - ((and (listp org-agenda-fontify-priorities) - (org-face-from-face-or-color - 'priority nil - (cdr (assoc p org-agenda-fontify-priorities))))) - ((equal p l) 'italic) - ((equal p h) 'bold)) - 'org-priority)) - (overlay-put ov 'org-type 'org-priority))))) - -(defvar org-depend-tag-blocked) - -(defun org-agenda-dim-blocked-tasks (&optional invisible) - "Dim currently blocked TODO's in the agenda display. -When INVISIBLE is non-nil, hide currently blocked TODO instead of -dimming them." - (interactive "P") - (when (org-called-interactively-p 'interactive) - (message "Dim or hide blocked tasks...")) - (mapc (lambda (o) (if (eq (overlay-get o 'org-type) 'org-blocked-todo) - (delete-overlay o))) - (overlays-in (point-min) (point-max))) - (save-excursion - (let ((inhibit-read-only t) - (org-depend-tag-blocked nil) - (invis (or (not (null invisible)) - (eq org-agenda-dim-blocked-tasks 'invisible))) - org-blocked-by-checkboxes - invis1 b e p ov h l) - (goto-char (point-min)) - (while (let ((pos (next-single-property-change (point) 'todo-state))) - (and pos (goto-char (1+ pos)))) - (setq org-blocked-by-checkboxes nil invis1 invis) - (let ((marker (org-get-at-bol 'org-hd-marker))) - (when (and marker - (with-current-buffer (marker-buffer marker) - (save-excursion (goto-char marker) - (org-entry-blocked-p)))) - (if org-blocked-by-checkboxes (setq invis1 nil)) - (setq b (if invis1 - (max (point-min) (1- (point-at-bol))) - (point-at-bol)) - e (point-at-eol) - ov (make-overlay b e)) - (if invis1 - (overlay-put ov 'invisible t) - (overlay-put ov 'face 'org-agenda-dimmed-todo-face)) - (overlay-put ov 'org-type 'org-blocked-todo)))))) - (when (org-called-interactively-p 'interactive) - (message "Dim or hide blocked tasks...done"))) - -(defvar org-agenda-skip-function nil - "Function to be called at each match during agenda construction. -If this function returns nil, the current match should not be skipped. -Otherwise, the function must return a position from where the search -should be continued. -This may also be a Lisp form, it will be evaluated. -Never set this variable using `setq' or so, because then it will apply -to all future agenda commands. If you do want a global skipping condition, -use the option `org-agenda-skip-function-global' instead. -The correct usage for `org-agenda-skip-function' is to bind it with -`let' to scope it dynamically into the agenda-constructing command. -A good way to set it is through options in `org-agenda-custom-commands'.") - -(defun org-agenda-skip () - "Throw to `:skip' in places that should be skipped. -Also moves point to the end of the skipped region, so that search can -continue from there." - (let ((p (point-at-bol)) to) - (when (or - (save-excursion (goto-char p) (looking-at comment-start-skip)) - (and org-agenda-skip-archived-trees (not org-agenda-archives-mode) - (get-text-property p :org-archived) - (org-end-of-subtree t)) - (and org-agenda-skip-comment-trees - (get-text-property p :org-comment) - (org-end-of-subtree t)) - (and (setq to (or (org-agenda-skip-eval org-agenda-skip-function-global) - (org-agenda-skip-eval org-agenda-skip-function))) - (goto-char to)) - (org-in-src-block-p t)) - (throw :skip t)))) - -(defun org-agenda-skip-eval (form) - "If FORM is a function or a list, call (or eval) it and return the result. -`save-excursion' and `save-match-data' are wrapped around the call, so point -and match data are returned to the previous state no matter what these -functions do." - (let (fp) - (and form - (or (setq fp (functionp form)) - (consp form)) - (save-excursion - (save-match-data - (if fp - (funcall form) - (eval form))))))) - -(defvar org-agenda-markers nil - "List of all currently active markers created by `org-agenda'.") -(defvar org-agenda-last-marker-time (org-float-time) - "Creation time of the last agenda marker.") - -(defun org-agenda-new-marker (&optional pos) - "Return a new agenda marker. -Org-mode keeps a list of these markers and resets them when they are -no longer in use." - (let ((m (copy-marker (or pos (point))))) - (setq org-agenda-last-marker-time (org-float-time)) - (if org-agenda-buffer - (with-current-buffer org-agenda-buffer - (push m org-agenda-markers)) - (push m org-agenda-markers)) - m)) - -(defun org-agenda-reset-markers () - "Reset markers created by `org-agenda'." - (while org-agenda-markers - (move-marker (pop org-agenda-markers) nil))) - -(defun org-agenda-save-markers-for-cut-and-paste (beg end) - "Save relative positions of markers in region. -This check for agenda markers in all agenda buffers currently active." - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (eq major-mode 'org-agenda-mode) - (mapc (lambda (m) (org-check-and-save-marker m beg end)) - org-agenda-markers))))) - -;;; Entry text mode - -(defun org-agenda-entry-text-show-here () - "Add some text from the entry as context to the current line." - (let (m txt o) - (setq m (org-get-at-bol 'org-hd-marker)) - (unless (marker-buffer m) - (error "No marker points to an entry here")) - (setq txt (concat "\n" (org-no-properties - (org-agenda-get-some-entry-text - m org-agenda-entry-text-maxlines - org-agenda-entry-text-leaders)))) - (when (string-match "\\S-" txt) - (setq o (make-overlay (point-at-bol) (point-at-eol))) - (overlay-put o 'evaporate t) - (overlay-put o 'org-overlay-type 'agenda-entry-content) - (overlay-put o 'after-string txt)))) - -(defun org-agenda-entry-text-show () - "Add entry context for all agenda lines." - (interactive) - (save-excursion - (goto-char (point-max)) - (beginning-of-line 1) - (while (not (bobp)) - (when (org-get-at-bol 'org-hd-marker) - (org-agenda-entry-text-show-here)) - (beginning-of-line 0)))) - -(defun org-agenda-entry-text-hide () - "Remove any shown entry context." - (delq nil - (mapcar (lambda (o) - (if (eq (overlay-get o 'org-overlay-type) - 'agenda-entry-content) - (progn (delete-overlay o) t))) - (overlays-in (point-min) (point-max))))) - -(defun org-agenda-get-day-face (date) - "Return the face DATE should be displayed with." - (or (and (functionp org-agenda-day-face-function) - (funcall org-agenda-day-face-function date)) - (cond ((org-agenda-todayp date) - 'org-agenda-date-today) - ((member (calendar-day-of-week date) org-agenda-weekend-days) - 'org-agenda-date-weekend) - (t 'org-agenda-date)))) - -;;; Agenda timeline - -(defvar org-agenda-only-exact-dates nil) ; dynamically scoped -(defvar org-agenda-show-log-scoped) ;; dynamically scope in `org-timeline' or `org-agenda-list' - -(defun org-timeline (&optional dotodo) - "Show a time-sorted view of the entries in the current org file. -Only entries with a time stamp of today or later will be listed. With -\\[universal-argument] prefix, all unfinished TODO items will also be shown, -under the current date. -If the buffer contains an active region, only check the region for -dates." - (interactive "P") - (let* ((dopast t) - (org-agenda-show-log-scoped org-agenda-show-log) - (org-agenda-show-log org-agenda-show-log-scoped) - (entry (buffer-file-name (or (buffer-base-buffer (current-buffer)) - (current-buffer)))) - (date (calendar-current-date)) - (beg (if (org-region-active-p) (region-beginning) (point-min))) - (end (if (org-region-active-p) (region-end) (point-max))) - (day-numbers (org-get-all-dates - beg end 'no-ranges - t org-agenda-show-log-scoped ; always include today - org-timeline-show-empty-dates)) - (org-deadline-warning-days 0) - (org-agenda-only-exact-dates t) - (today (org-today)) - (past t) - args - s e rtn d emptyp) - (setq org-agenda-redo-command - (list 'let - (list (list 'org-agenda-show-log 'org-agenda-show-log)) - (list 'org-switch-to-buffer-other-window (current-buffer)) - (list 'org-timeline (list 'quote dotodo)))) - (put 'org-agenda-redo-command 'org-lprops nil) - (if (not dopast) - ;; Remove past dates from the list of dates. - (setq day-numbers (delq nil (mapcar (lambda(x) - (if (>= x today) x nil)) - day-numbers)))) - (org-agenda-prepare (concat "Timeline " (file-name-nondirectory entry))) - (org-compile-prefix-format 'timeline) - (org-set-sorting-strategy 'timeline) - (if org-agenda-show-log-scoped (push :closed args)) - (push :timestamp args) - (push :deadline args) - (push :scheduled args) - (push :sexp args) - (if dotodo (push :todo args)) - (insert "Timeline of file " entry "\n") - (add-text-properties (point-min) (point) - (list 'face 'org-agenda-structure)) - (org-agenda-mark-header-line (point-min)) - (while (setq d (pop day-numbers)) - (if (and (listp d) (eq (car d) :omitted)) - (progn - (setq s (point)) - (insert (format "\n[... %d empty days omitted]\n\n" (cdr d))) - (put-text-property s (1- (point)) 'face 'org-agenda-structure)) - (if (listp d) (setq d (car d) emptyp t) (setq emptyp nil)) - (if (and (>= d today) - dopast - past) - (progn - (setq past nil) - (insert (make-string 79 ?-) "\n"))) - (setq date (calendar-gregorian-from-absolute d)) - (setq s (point)) - (setq rtn (and (not emptyp) - (apply 'org-agenda-get-day-entries entry - date args))) - (if (or rtn (equal d today) org-timeline-show-empty-dates) - (progn - (insert - (if (stringp org-agenda-format-date) - (format-time-string org-agenda-format-date - (org-time-from-absolute date)) - (funcall org-agenda-format-date date)) - "\n") - (put-text-property s (1- (point)) 'face - (org-agenda-get-day-face date)) - (put-text-property s (1- (point)) 'org-date-line t) - (put-text-property s (1- (point)) 'org-agenda-date-header t) - (if (equal d today) - (put-text-property s (1- (point)) 'org-today t)) - (and rtn (insert (org-agenda-finalize-entries rtn 'timeline) "\n")) - (put-text-property s (1- (point)) 'day d))))) - (goto-char (or (text-property-any (point-min) (point-max) 'org-today t) - (point-min))) - (add-text-properties - (point-min) (point-max) - `(org-agenda-type timeline org-redo-cmd ,org-agenda-redo-command)) - (org-agenda-finalize) - (setq buffer-read-only t))) - -(defun org-get-all-dates (beg end &optional no-ranges force-today inactive empty pre-re) - "Return a list of all relevant day numbers from BEG to END buffer positions. -If NO-RANGES is non-nil, include only the start and end dates of a range, -not every single day in the range. If FORCE-TODAY is non-nil, make -sure that TODAY is included in the list. If INACTIVE is non-nil, also -inactive time stamps (those in square brackets) are included. -When EMPTY is non-nil, also include days without any entries." - (let ((re (concat - (if pre-re pre-re "") - (if inactive org-ts-regexp-both org-ts-regexp))) - dates dates1 date day day1 day2 ts1 ts2 pos) - (if force-today - (setq dates (list (org-today)))) - (save-excursion - (goto-char beg) - (while (re-search-forward re end t) - (setq day (time-to-days (org-time-string-to-time - (substring (match-string 1) 0 10) - (current-buffer) (match-beginning 0)))) - (or (memq day dates) (push day dates))) - (unless no-ranges - (goto-char beg) - (while (re-search-forward org-tr-regexp end t) - (setq pos (match-beginning 0)) - (setq ts1 (substring (match-string 1) 0 10) - ts2 (substring (match-string 2) 0 10) - day1 (time-to-days (org-time-string-to-time - ts1 (current-buffer) pos)) - day2 (time-to-days (org-time-string-to-time - ts2 (current-buffer) pos))) - (while (< (setq day1 (1+ day1)) day2) - (or (memq day1 dates) (push day1 dates))))) - (setq dates (sort dates '<)) - (when empty - (while (setq day (pop dates)) - (setq day2 (car dates)) - (push day dates1) - (when (and day2 empty) - (if (or (eq empty t) - (and (numberp empty) (<= (- day2 day) empty))) - (while (< (setq day (1+ day)) day2) - (push (list day) dates1)) - (push (cons :omitted (- day2 day)) dates1)))) - (setq dates (nreverse dates1))) - dates))) - -;;; Agenda Daily/Weekly - -(defvar org-agenda-start-day nil ; dynamically scoped parameter - "Start day for the agenda view. -Custom commands can set this variable in the options section. -This is usually a string like \"2007-11-01\", \"+2d\" or any other -input allowed when reading a date through the Org calendar. -See the docstring of `org-read-date' for details.") -(defvar org-starting-day nil) ; local variable in the agenda buffer -(defvar org-arg-loc nil) ; local variable - -(defvar org-agenda-buffer-tmp-name nil) -;;;###autoload -(defun org-agenda-list (&optional arg start-day span with-hour) - "Produce a daily/weekly view from all files in variable `org-agenda-files'. -The view will be for the current day or week, but from the overview buffer -you will be able to go to other days/weeks. - -With a numeric prefix argument in an interactive call, the agenda will -span ARG days. Lisp programs should instead specify SPAN to change -the number of days. SPAN defaults to `org-agenda-span'. - -START-DAY defaults to TODAY, or to the most recent match for the weekday -given in `org-agenda-start-on-weekday'. - -When WITH-HOUR is non-nil, only include scheduled and deadline -items if they have an hour specification like [h]h:mm." - (interactive "P") - (if org-agenda-overriding-arguments - (setq arg (car org-agenda-overriding-arguments) - start-day (nth 1 org-agenda-overriding-arguments) - span (nth 2 org-agenda-overriding-arguments))) - (if (and (integerp arg) (> arg 0)) - (setq span arg arg nil)) - (catch 'exit - (setq org-agenda-buffer-name - (or org-agenda-buffer-tmp-name - (if org-agenda-sticky - (cond ((and org-keys (stringp org-match)) - (format "*Org Agenda(%s:%s)*" org-keys org-match)) - (org-keys - (format "*Org Agenda(%s)*" org-keys)) - (t "*Org Agenda(a)*"))) - org-agenda-buffer-name)) - (org-agenda-prepare "Day/Week") - (setq start-day (or start-day org-agenda-start-day)) - (if (stringp start-day) - ;; Convert to an absolute day number - (setq start-day (time-to-days (org-read-date nil t start-day)))) - (org-compile-prefix-format 'agenda) - (org-set-sorting-strategy 'agenda) - (let* ((span (org-agenda-ndays-to-span - (or span org-agenda-ndays org-agenda-span))) - (today (org-today)) - (sd (or start-day today)) - (ndays (org-agenda-span-to-ndays span sd)) - (org-agenda-start-on-weekday - (if (or (eq ndays 7) (eq ndays 14)) - org-agenda-start-on-weekday)) - (thefiles (org-agenda-files nil 'ifmode)) - (files thefiles) - (start (if (or (null org-agenda-start-on-weekday) - (< ndays 7)) - sd - (let* ((nt (calendar-day-of-week - (calendar-gregorian-from-absolute sd))) - (n1 org-agenda-start-on-weekday) - (d (- nt n1))) - (- sd (+ (if (< d 0) 7 0) d))))) - (day-numbers (list start)) - (day-cnt 0) - (inhibit-redisplay (not debug-on-error)) - (org-agenda-show-log-scoped org-agenda-show-log) - s e rtn rtnall file date d start-pos end-pos todayp - clocktable-start clocktable-end filter) - (setq org-agenda-redo-command - (list 'org-agenda-list (list 'quote arg) start-day (list 'quote span) with-hour)) - (dotimes (n (1- ndays)) - (push (1+ (car day-numbers)) day-numbers)) - (setq day-numbers (nreverse day-numbers)) - (setq clocktable-start (car day-numbers) - clocktable-end (1+ (or (org-last day-numbers) 0))) - (org-set-local 'org-starting-day (car day-numbers)) - (org-set-local 'org-arg-loc arg) - (org-set-local 'org-agenda-current-span (org-agenda-ndays-to-span span)) - (unless org-agenda-compact-blocks - (let* ((d1 (car day-numbers)) - (d2 (org-last day-numbers)) - (w1 (org-days-to-iso-week d1)) - (w2 (org-days-to-iso-week d2))) - (setq s (point)) - (if org-agenda-overriding-header - (insert (org-add-props (copy-sequence org-agenda-overriding-header) - nil 'face 'org-agenda-structure) "\n") - (insert (org-agenda-span-name span) - "-agenda" - (if (< (- d2 d1) 350) - (if (= w1 w2) - (format " (W%02d)" w1) - (format " (W%02d-W%02d)" w1 w2)) - "") - ":\n"))) - (add-text-properties s (1- (point)) (list 'face 'org-agenda-structure - 'org-date-line t)) - (org-agenda-mark-header-line s)) - (while (setq d (pop day-numbers)) - (setq date (calendar-gregorian-from-absolute d) - s (point)) - (if (or (setq todayp (= d today)) - (and (not start-pos) (= d sd))) - (setq start-pos (point)) - (if (and start-pos (not end-pos)) - (setq end-pos (point)))) - (setq files thefiles - rtnall nil) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (let ((org-agenda-entry-types org-agenda-entry-types)) - ;; Starred types override non-starred equivalents - (when (member :deadline* org-agenda-entry-types) - (setq org-agenda-entry-types - (delq :deadline org-agenda-entry-types))) - (when (member :scheduled* org-agenda-entry-types) - (setq org-agenda-entry-types - (delq :scheduled org-agenda-entry-types))) - ;; Honor with-hour - (when with-hour - (when (member :deadline org-agenda-entry-types) - (setq org-agenda-entry-types - (delq :deadline org-agenda-entry-types)) - (push :deadline* org-agenda-entry-types)) - (when (member :scheduled org-agenda-entry-types) - (setq org-agenda-entry-types - (delq :scheduled org-agenda-entry-types)) - (push :scheduled* org-agenda-entry-types))) - (unless org-agenda-include-deadlines - (setq org-agenda-entry-types - (delq :deadline* (delq :deadline org-agenda-entry-types)))) - (cond - ((memq org-agenda-show-log-scoped '(only clockcheck)) - (setq rtn (org-agenda-get-day-entries - file date :closed))) - (org-agenda-show-log-scoped - (setq rtn (apply 'org-agenda-get-day-entries - file date - (append '(:closed) org-agenda-entry-types)))) - (t - (setq rtn (apply 'org-agenda-get-day-entries - file date - org-agenda-entry-types))))) - (setq rtnall (append rtnall rtn)))) ;; all entries - (if org-agenda-include-diary - (let ((org-agenda-search-headline-for-time t)) - (require 'diary-lib) - (setq rtn (org-get-entries-from-diary date)) - (setq rtnall (append rtnall rtn)))) - (if (or rtnall org-agenda-show-all-dates) - (progn - (setq day-cnt (1+ day-cnt)) - (insert - (if (stringp org-agenda-format-date) - (format-time-string org-agenda-format-date - (org-time-from-absolute date)) - (funcall org-agenda-format-date date)) - "\n") - (put-text-property s (1- (point)) 'face - (org-agenda-get-day-face date)) - (put-text-property s (1- (point)) 'org-date-line t) - (put-text-property s (1- (point)) 'org-agenda-date-header t) - (put-text-property s (1- (point)) 'org-day-cnt day-cnt) - (when todayp - (put-text-property s (1- (point)) 'org-today t)) - (setq rtnall - (org-agenda-add-time-grid-maybe rtnall ndays todayp)) - (if rtnall (insert ;; all entries - (org-agenda-finalize-entries rtnall 'agenda) - "\n")) - (put-text-property s (1- (point)) 'day d) - (put-text-property s (1- (point)) 'org-day-cnt day-cnt)))) - (when (and org-agenda-clockreport-mode clocktable-start) - (let ((org-agenda-files (org-agenda-files nil 'ifmode)) - ;; the above line is to ensure the restricted range! - (p (copy-sequence org-agenda-clockreport-parameter-plist)) - tbl) - (setq p (org-plist-delete p :block)) - (setq p (plist-put p :tstart clocktable-start)) - (setq p (plist-put p :tend clocktable-end)) - (setq p (plist-put p :scope 'agenda)) - (when (and (eq org-agenda-clockreport-mode 'with-filter) - (setq filter (or org-agenda-tag-filter-while-redo - (get 'org-agenda-tag-filter :preset-filter)))) - (setq p (plist-put p :tags (mapconcat (lambda (x) - (if (string-match "[<>=]" x) - "" - x)) - filter "")))) - (setq tbl (apply 'org-clock-get-clocktable p)) - (insert tbl))) - (goto-char (point-min)) - (or org-agenda-multi (org-agenda-fit-window-to-buffer)) - (unless (and (pos-visible-in-window-p (point-min)) - (pos-visible-in-window-p (point-max))) - (goto-char (1- (point-max))) - (recenter -1) - (if (not (pos-visible-in-window-p (or start-pos 1))) - (progn - (goto-char (or start-pos 1)) - (recenter 1)))) - (goto-char (or start-pos 1)) - (add-text-properties (point-min) (point-max) - `(org-agenda-type agenda - org-last-args (,arg ,start-day ,span) - org-redo-cmd ,org-agenda-redo-command - org-series-cmd ,org-cmd)) - (if (eq org-agenda-show-log-scoped 'clockcheck) - (org-agenda-show-clocking-issues)) - (org-agenda-finalize) - (setq buffer-read-only t) - (message "")))) - -(defun org-agenda-ndays-to-span (n) - "Return a span symbol for a span of N days, or N if none matches." - (cond ((symbolp n) n) - ((= n 1) 'day) - ((= n 7) 'week) - ((= n 14) 'fortnight) - (t n))) - -(defun org-agenda-span-to-ndays (span &optional start-day) - "Return ndays from SPAN, possibly starting at START-DAY. -START-DAY is an absolute time value." - (cond ((numberp span) span) - ((eq span 'day) 1) - ((eq span 'week) 7) - ((eq span 'fortnight) 14) - ((eq span 'month) - (let ((date (calendar-gregorian-from-absolute start-day))) - (calendar-last-day-of-month (car date) (caddr date)))) - ((eq span 'year) - (let ((date (calendar-gregorian-from-absolute start-day))) - (if (calendar-leap-year-p (caddr date)) 366 365))))) - -(defun org-agenda-span-name (span) - "Return a SPAN name." - (if (null span) - "" - (if (symbolp span) - (capitalize (symbol-name span)) - (format "%d days" span)))) - -;;; Agenda word search - -(defvar org-agenda-search-history nil) - -(defvar org-search-syntax-table nil - "Special syntax table for org-mode search. -In this table, we have single quotes not as word constituents, to -that when \"+Ameli\" is searched as a work, it will also match \"Ameli's\"") - -(defvar org-mode-syntax-table) ; From org.el -(defun org-search-syntax-table () - (unless org-search-syntax-table - (setq org-search-syntax-table (copy-syntax-table org-mode-syntax-table)) - (modify-syntax-entry ?' "." org-search-syntax-table) - (modify-syntax-entry ?` "." org-search-syntax-table)) - org-search-syntax-table) - -(defvar org-agenda-last-search-view-search-was-boolean nil) - -;;;###autoload -(defun org-search-view (&optional todo-only string edit-at) - "Show all entries that contain a phrase or words or regular expressions. - -With optional prefix argument TODO-ONLY, only consider entries that are -TODO entries. The argument STRING can be used to pass a default search -string into this function. If EDIT-AT is non-nil, it means that the -user should get a chance to edit this string, with cursor at position -EDIT-AT. - -The search string can be viewed either as a phrase that should be found as -is, or it can be broken into a number of snippets, each of which must match -in a Boolean way to select an entry. The default depends on the variable -`org-agenda-search-view-always-boolean'. -Even if this is turned off (the default) you can always switch to -Boolean search dynamically by preceding the first word with \"+\" or \"-\". - -The default is a direct search of the whole phrase, where each space in -the search string can expand to an arbitrary amount of whitespace, -including newlines. - -If using a Boolean search, the search string is split on whitespace and -each snippet is searched separately, with logical AND to select an entry. -Words prefixed with a minus must *not* occur in the entry. Words without -a prefix or prefixed with a plus must occur in the entry. Matching is -case-insensitive. Words are enclosed by word delimiters (i.e. they must -match whole words, not parts of a word) if -`org-agenda-search-view-force-full-words' is set (default is nil). - -Boolean search snippets enclosed by curly braces are interpreted as -regular expressions that must or (when preceded with \"-\") must not -match in the entry. Snippets enclosed into double quotes will be taken -as a whole, to include whitespace. - -- If the search string starts with an asterisk, search only in headlines. -- If (possibly after the leading star) the search string starts with an - exclamation mark, this also means to look at TODO entries only, an effect - that can also be achieved with a prefix argument. -- If (possibly after star and exclamation mark) the search string starts - with a colon, this will mean that the (non-regexp) snippets of the - Boolean search must match as full words. - -This command searches the agenda files, and in addition the files listed -in `org-agenda-text-search-extra-files'." - (interactive "P") - (if org-agenda-overriding-arguments - (setq todo-only (car org-agenda-overriding-arguments) - string (nth 1 org-agenda-overriding-arguments) - edit-at (nth 2 org-agenda-overriding-arguments))) - (let* ((props (list 'face nil - 'done-face 'org-agenda-done - 'org-not-done-regexp org-not-done-regexp - 'org-todo-regexp org-todo-regexp - 'org-complex-heading-regexp org-complex-heading-regexp - 'mouse-face 'highlight - 'help-echo (format "mouse-2 or RET jump to location"))) - (full-words org-agenda-search-view-force-full-words) - (org-agenda-text-search-extra-files org-agenda-text-search-extra-files) - regexp rtn rtnall files file pos inherited-tags - marker category category-pos level tags c neg re boolean - ee txt beg end words regexps+ regexps- hdl-only buffer beg1 str) - (unless (and (not edit-at) - (stringp string) - (string-match "\\S-" string)) - (setq string (read-string - (if org-agenda-search-view-always-boolean - "[+-]Word/{Regexp} ...: " - "Phrase or [+-]Word/{Regexp} ...: ") - (cond - ((integerp edit-at) (cons string edit-at)) - (edit-at string)) - 'org-agenda-search-history))) - (catch 'exit - (if org-agenda-sticky - (setq org-agenda-buffer-name - (if (stringp string) - (format "*Org Agenda(%s:%s)*" - (or org-keys (or (and todo-only "S") "s")) string) - (format "*Org Agenda(%s)*" (or (and todo-only "S") "s"))))) - (org-agenda-prepare "SEARCH") - (org-compile-prefix-format 'search) - (org-set-sorting-strategy 'search) - (setq org-agenda-redo-command - (list 'org-search-view (if todo-only t nil) - (list 'if 'current-prefix-arg nil string))) - (setq org-agenda-query-string string) - (if (equal (string-to-char string) ?*) - (setq hdl-only t - words (substring string 1)) - (setq words string)) - (when (equal (string-to-char words) ?!) - (setq todo-only t - words (substring words 1))) - (when (equal (string-to-char words) ?:) - (setq full-words t - words (substring words 1))) - (if (or org-agenda-search-view-always-boolean - (member (string-to-char words) '(?- ?+ ?\{))) - (setq boolean t)) - (setq words (org-split-string words)) - (let (www w) - (while (setq w (pop words)) - (while (and (string-match "\\\\\\'" w) words) - (setq w (concat (substring w 0 -1) " " (pop words)))) - (push w www)) - (setq words (nreverse www) www nil) - (while (setq w (pop words)) - (when (and (string-match "\\`[-+]?{" w) - (not (string-match "}\\'" w))) - (while (and words (not (string-match "}\\'" (car words)))) - (setq w (concat w " " (pop words)))) - (setq w (concat w " " (pop words)))) - (push w www)) - (setq words (nreverse www))) - (setq org-agenda-last-search-view-search-was-boolean boolean) - (when boolean - (let (wds w) - (while (setq w (pop words)) - (if (or (equal (substring w 0 1) "\"") - (and (> (length w) 1) - (member (substring w 0 1) '("+" "-")) - (equal (substring w 1 2) "\""))) - (while (and words (not (equal (substring w -1) "\""))) - (setq w (concat w " " (pop words))))) - (and (string-match "\\`\\([-+]?\\)\"" w) - (setq w (replace-match "\\1" nil nil w))) - (and (equal (substring w -1) "\"") (setq w (substring w 0 -1))) - (push w wds)) - (setq words (nreverse wds)))) - (if boolean - (mapc (lambda (w) - (setq c (string-to-char w)) - (if (equal c ?-) - (setq neg t w (substring w 1)) - (if (equal c ?+) - (setq neg nil w (substring w 1)) - (setq neg nil))) - (if (string-match "\\`{.*}\\'" w) - (setq re (substring w 1 -1)) - (if full-words - (setq re (concat "\\<" (regexp-quote (downcase w)) "\\>")) - (setq re (regexp-quote (downcase w))))) - (if neg (push re regexps-) (push re regexps+))) - words) - (push (mapconcat (lambda (w) (regexp-quote w)) words "\\s-+") - regexps+)) - (setq regexps+ (sort regexps+ (lambda (a b) (> (length a) (length b))))) - (if (not regexps+) - (setq regexp org-outline-regexp-bol) - (setq regexp (pop regexps+)) - (if hdl-only (setq regexp (concat org-outline-regexp-bol ".*?" - regexp)))) - (setq files (org-agenda-files nil 'ifmode)) - (when (eq (car org-agenda-text-search-extra-files) 'agenda-archives) - (pop org-agenda-text-search-extra-files) - (setq files (org-add-archive-files files))) - (setq files (append files org-agenda-text-search-extra-files) - rtnall nil) - (while (setq file (pop files)) - (setq ee nil) - (catch 'nextfile - (org-check-agenda-file file) - (setq buffer (if (file-exists-p file) - (org-get-agenda-file-buffer file) - (error "No such file %s" file))) - (if (not buffer) - ;; If file does not exist, make sure an error message is sent - (setq rtn (list (format "ORG-AGENDA-ERROR: No such org-file %s" - file)))) - (with-current-buffer buffer - (with-syntax-table (org-search-syntax-table) - (unless (derived-mode-p 'org-mode) - (error "Agenda file %s is not in `org-mode'" file)) - (let ((case-fold-search t)) - (save-excursion - (save-restriction - (if (eq buffer org-agenda-restrict) - (narrow-to-region org-agenda-restrict-begin - org-agenda-restrict-end) - (widen)) - (goto-char (point-min)) - (unless (or (org-at-heading-p) - (outline-next-heading)) - (throw 'nextfile t)) - (goto-char (max (point-min) (1- (point)))) - (while (re-search-forward regexp nil t) - (org-back-to-heading t) - (while (and (not (zerop org-agenda-search-view-max-outline-level)) - (> (org-reduced-level (org-outline-level)) - org-agenda-search-view-max-outline-level) - (forward-line -1) - (outline-back-to-heading t))) - (skip-chars-forward "* ") - (setq beg (point-at-bol) - beg1 (point) - end (progn - (outline-next-heading) - (while (and (not (zerop org-agenda-search-view-max-outline-level)) - (> (org-reduced-level (org-outline-level)) - org-agenda-search-view-max-outline-level) - (forward-line 1) - (outline-next-heading))) - (point))) - - (catch :skip - (goto-char beg) - (org-agenda-skip) - (setq str (buffer-substring-no-properties - (point-at-bol) - (if hdl-only (point-at-eol) end))) - (mapc (lambda (wr) (when (string-match wr str) - (goto-char (1- end)) - (throw :skip t))) - regexps-) - (mapc (lambda (wr) (unless (string-match wr str) - (goto-char (1- end)) - (throw :skip t))) - (if todo-only - (cons (concat "^\*+[ \t]+" org-not-done-regexp) - regexps+) - regexps+)) - (goto-char beg) - (setq marker (org-agenda-new-marker (point)) - category (org-get-category) - level (make-string (org-reduced-level (org-outline-level)) ? ) - category-pos (get-text-property (point) 'org-category-position) - inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'todo org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'todo org-agenda-use-tag-inheritance)))) - tags (org-get-tags-at nil (not inherited-tags)) - txt (org-agenda-format-item - "" - (buffer-substring-no-properties - beg1 (point-at-eol)) - level category tags t)) - (org-add-props txt props - 'org-marker marker 'org-hd-marker marker - 'org-todo-regexp org-todo-regexp - 'level level - 'org-complex-heading-regexp org-complex-heading-regexp - 'priority 1000 'org-category category - 'org-category-position category-pos - 'type "search") - (push txt ee) - (goto-char (1- end)))))))))) - (setq rtn (nreverse ee)) - (setq rtnall (append rtnall rtn))) - (if org-agenda-overriding-header - (insert (org-add-props (copy-sequence org-agenda-overriding-header) - nil 'face 'org-agenda-structure) "\n") - (insert "Search words: ") - (add-text-properties (point-min) (1- (point)) - (list 'face 'org-agenda-structure)) - (setq pos (point)) - (insert string "\n") - (add-text-properties pos (1- (point)) (list 'face 'org-warning)) - (setq pos (point)) - (unless org-agenda-multi - (insert "Press `[', `]' to add/sub word, `{', `}' to add/sub regexp, `C-u r' to edit\n") - (add-text-properties pos (1- (point)) - (list 'face 'org-agenda-structure)))) - (org-agenda-mark-header-line (point-min)) - (when rtnall - (insert (org-agenda-finalize-entries rtnall 'search) "\n")) - (goto-char (point-min)) - (or org-agenda-multi (org-agenda-fit-window-to-buffer)) - (add-text-properties (point-min) (point-max) - `(org-agenda-type search - org-last-args (,todo-only ,string ,edit-at) - org-redo-cmd ,org-agenda-redo-command - org-series-cmd ,org-cmd)) - (org-agenda-finalize) - (setq buffer-read-only t)))) - -;;; Agenda TODO list - -(defun org-agenda-propertize-selected-todo-keywords (keywords) - "Use `org-todo-keyword-faces' for the selected todo KEYWORDS." - (concat - (if (or (equal keywords "ALL") (not keywords)) - (propertize "ALL" 'face 'warning) - (mapconcat - (lambda (kw) - (propertize kw 'face (org-get-todo-face kw))) - (org-split-string keywords "|") - "|")) - "\n")) - -(defvar org-select-this-todo-keyword nil) -(defvar org-last-arg nil) - -;;;###autoload -(defun org-todo-list (&optional arg) - "Show all (not done) TODO entries from all agenda file in a single list. -The prefix arg can be used to select a specific TODO keyword and limit -the list to these. When using \\[universal-argument], you will be prompted -for a keyword. A numeric prefix directly selects the Nth keyword in -`org-todo-keywords-1'." - (interactive "P") - (if org-agenda-overriding-arguments - (setq arg org-agenda-overriding-arguments)) - (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) - (let* ((today (org-today)) - (date (calendar-gregorian-from-absolute today)) - (kwds org-todo-keywords-for-agenda) - (completion-ignore-case t) - (org-select-this-todo-keyword - (if (stringp arg) arg - (and arg (integerp arg) (> arg 0) - (nth (1- arg) kwds)))) - rtn rtnall files file pos) - (when (equal arg '(4)) - (setq org-select-this-todo-keyword - (org-icompleting-read "Keyword (or KWD1|K2D2|...): " - (mapcar 'list kwds) nil nil))) - (and (equal 0 arg) (setq org-select-this-todo-keyword nil)) - (catch 'exit - (if org-agenda-sticky - (setq org-agenda-buffer-name - (if (stringp org-select-this-todo-keyword) - (format "*Org Agenda(%s:%s)*" (or org-keys "t") - org-select-this-todo-keyword) - (format "*Org Agenda(%s)*" (or org-keys "t"))))) - (org-agenda-prepare "TODO") - (org-compile-prefix-format 'todo) - (org-set-sorting-strategy 'todo) - (setq org-agenda-redo-command - `(org-todo-list (or (and (numberp current-prefix-arg) - current-prefix-arg) - ,org-select-this-todo-keyword - current-prefix-arg ,arg))) - (setq files (org-agenda-files nil 'ifmode) - rtnall nil) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (setq rtn (org-agenda-get-day-entries file date :todo)) - (setq rtnall (append rtnall rtn)))) - (if org-agenda-overriding-header - (insert (org-add-props (copy-sequence org-agenda-overriding-header) - nil 'face 'org-agenda-structure) "\n") - (insert "Global list of TODO items of type: ") - (add-text-properties (point-min) (1- (point)) - (list 'face 'org-agenda-structure - 'short-heading - (concat "ToDo: " - (or org-select-this-todo-keyword "ALL")))) - (org-agenda-mark-header-line (point-min)) - (insert (org-agenda-propertize-selected-todo-keywords - org-select-this-todo-keyword)) - (setq pos (point)) - (unless org-agenda-multi - (insert "Available with `N r': (0)[ALL]") - (let ((n 0) s) - (mapc (lambda (x) - (setq s (format "(%d)%s" (setq n (1+ n)) x)) - (if (> (+ (current-column) (string-width s) 1) (frame-width)) - (insert "\n ")) - (insert " " s)) - kwds)) - (insert "\n")) - (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) - (org-agenda-mark-header-line (point-min)) - (when rtnall - (insert (org-agenda-finalize-entries rtnall 'todo) "\n")) - (goto-char (point-min)) - (or org-agenda-multi (org-agenda-fit-window-to-buffer)) - (add-text-properties (point-min) (point-max) - `(org-agenda-type todo - org-last-args ,arg - org-redo-cmd ,org-agenda-redo-command - org-series-cmd ,org-cmd)) - (org-agenda-finalize) - (setq buffer-read-only t)))) - -;;; Agenda tags match - -;;;###autoload -(defun org-tags-view (&optional todo-only match) - "Show all headlines for all `org-agenda-files' matching a TAGS criterion. -The prefix arg TODO-ONLY limits the search to TODO entries." - (interactive "P") - (if org-agenda-overriding-arguments - (setq todo-only (car org-agenda-overriding-arguments) - match (nth 1 org-agenda-overriding-arguments))) - (let* ((org-tags-match-list-sublevels - org-tags-match-list-sublevels) - (completion-ignore-case t) - rtn rtnall files file pos matcher - buffer) - (when (and (stringp match) (not (string-match "\\S-" match))) - (setq match nil)) - (catch 'exit - (if org-agenda-sticky - (setq org-agenda-buffer-name - (if (stringp match) - (format "*Org Agenda(%s:%s)*" - (or org-keys (or (and todo-only "M") "m")) match) - (format "*Org Agenda(%s)*" (or (and todo-only "M") "m"))))) - ;; Prepare agendas (and `org-tag-alist-for-agenda') before - ;; expanding tags within `org-make-tags-matcher' - (org-agenda-prepare (concat "TAGS " match)) - (setq matcher (org-make-tags-matcher match) - match (car matcher) matcher (cdr matcher)) - (org-compile-prefix-format 'tags) - (org-set-sorting-strategy 'tags) - (setq org-agenda-query-string match) - (setq org-agenda-redo-command - (list 'org-tags-view `(quote ,todo-only) - (list 'if 'current-prefix-arg nil `(quote ,org-agenda-query-string)))) - (setq files (org-agenda-files nil 'ifmode) - rtnall nil) - (while (setq file (pop files)) - (catch 'nextfile - (org-check-agenda-file file) - (setq buffer (if (file-exists-p file) - (org-get-agenda-file-buffer file) - (error "No such file %s" file))) - (if (not buffer) - ;; If file does not exist, error message to agenda - (setq rtn (list - (format "ORG-AGENDA-ERROR: No such org-file %s" file)) - rtnall (append rtnall rtn)) - (with-current-buffer buffer - (unless (derived-mode-p 'org-mode) - (error "Agenda file %s is not in `org-mode'" file)) - (save-excursion - (save-restriction - (if (eq buffer org-agenda-restrict) - (narrow-to-region org-agenda-restrict-begin - org-agenda-restrict-end) - (widen)) - (setq rtn (org-scan-tags 'agenda matcher todo-only)) - (setq rtnall (append rtnall rtn)))))))) - (if org-agenda-overriding-header - (insert (org-add-props (copy-sequence org-agenda-overriding-header) - nil 'face 'org-agenda-structure) "\n") - (insert "Headlines with TAGS match: ") - (add-text-properties (point-min) (1- (point)) - (list 'face 'org-agenda-structure - 'short-heading - (concat "Match: " match))) - (setq pos (point)) - (insert match "\n") - (add-text-properties pos (1- (point)) (list 'face 'org-warning)) - (setq pos (point)) - (unless org-agenda-multi - (insert "Press `C-u r' to search again with new search string\n")) - (add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure))) - (org-agenda-mark-header-line (point-min)) - (when rtnall - (insert (org-agenda-finalize-entries rtnall 'tags) "\n")) - (goto-char (point-min)) - (or org-agenda-multi (org-agenda-fit-window-to-buffer)) - (add-text-properties (point-min) (point-max) - `(org-agenda-type tags - org-last-args (,todo-only ,match) - org-redo-cmd ,org-agenda-redo-command - org-series-cmd ,org-cmd)) - (org-agenda-finalize) - (setq buffer-read-only t)))) - -;;; Agenda Finding stuck projects - -(defvar org-agenda-skip-regexp nil - "Regular expression used in skipping subtrees for the agenda. -This is basically a temporary global variable that can be set and then -used by user-defined selections using `org-agenda-skip-function'.") - -(defvar org-agenda-overriding-header nil - "When set during agenda, todo and tags searches it replaces the header. -This variable should not be set directly, but custom commands can bind it -in the options section.") - -(defun org-agenda-skip-entry-when-regexp-matches () - "Check if the current entry contains match for `org-agenda-skip-regexp'. -If yes, it returns the end position of this entry, causing agenda commands -to skip the entry but continuing the search in the subtree. This is a -function that can be put into `org-agenda-skip-function' for the duration -of a command." - (let ((end (save-excursion (org-end-of-subtree t))) - skip) - (save-excursion - (setq skip (re-search-forward org-agenda-skip-regexp end t))) - (and skip end))) - -(defun org-agenda-skip-subtree-when-regexp-matches () - "Check if the current subtree contains match for `org-agenda-skip-regexp'. -If yes, it returns the end position of this tree, causing agenda commands -to skip this subtree. This is a function that can be put into -`org-agenda-skip-function' for the duration of a command." - (let ((end (save-excursion (org-end-of-subtree t))) - skip) - (save-excursion - (setq skip (re-search-forward org-agenda-skip-regexp end t))) - (and skip end))) - -(defun org-agenda-skip-entry-when-regexp-matches-in-subtree () - "Check if the current subtree contains match for `org-agenda-skip-regexp'. -If yes, it returns the end position of the current entry (NOT the tree), -causing agenda commands to skip the entry but continuing the search in -the subtree. This is a function that can be put into -`org-agenda-skip-function' for the duration of a command. An important -use of this function is for the stuck project list." - (let ((end (save-excursion (org-end-of-subtree t))) - (entry-end (save-excursion (outline-next-heading) (1- (point)))) - skip) - (save-excursion - (setq skip (re-search-forward org-agenda-skip-regexp end t))) - (and skip entry-end))) - -(defun org-agenda-skip-entry-if (&rest conditions) - "Skip entry if any of CONDITIONS is true. -See `org-agenda-skip-if' for details." - (org-agenda-skip-if nil conditions)) - -(defun org-agenda-skip-subtree-if (&rest conditions) - "Skip entry if any of CONDITIONS is true. -See `org-agenda-skip-if' for details." - (org-agenda-skip-if t conditions)) - -(defun org-agenda-skip-if (subtree conditions) - "Checks current entity for CONDITIONS. -If SUBTREE is non-nil, the entire subtree is checked. Otherwise, only -the entry (i.e. the text before the next heading) is checked. - -CONDITIONS is a list of symbols, boolean OR is used to combine the results -from different tests. Valid conditions are: - -scheduled Check if there is a scheduled cookie -notscheduled Check if there is no scheduled cookie -deadline Check if there is a deadline -notdeadline Check if there is no deadline -timestamp Check if there is a timestamp (also deadline or scheduled) -nottimestamp Check if there is no timestamp (also deadline or scheduled) -regexp Check if regexp matches -notregexp Check if regexp does not match. -todo Check if TODO keyword matches -nottodo Check if TODO keyword does not match - -The regexp is taken from the conditions list, it must come right after -the `regexp' or `notregexp' element. - -`todo' and `nottodo' accept as an argument a list of todo -keywords, which may include \"*\" to match any todo keyword. - - (org-agenda-skip-entry-if 'todo '(\"TODO\" \"WAITING\")) - -would skip all entries with \"TODO\" or \"WAITING\" keywords. - -Instead of a list, a keyword class may be given. For example: - - (org-agenda-skip-entry-if 'nottodo 'done) - -would skip entries that haven't been marked with any of \"DONE\" -keywords. Possible classes are: `todo', `done', `any'. - -If any of these conditions is met, this function returns the end point of -the entity, causing the search to continue from there. This is a function -that can be put into `org-agenda-skip-function' for the duration of a command." - (let (beg end m) - (org-back-to-heading t) - (setq beg (point) - end (if subtree - (progn (org-end-of-subtree t) (point)) - (progn (outline-next-heading) (1- (point))))) - (goto-char beg) - (and - (or - (and (memq 'scheduled conditions) - (re-search-forward org-scheduled-time-regexp end t)) - (and (memq 'notscheduled conditions) - (not (re-search-forward org-scheduled-time-regexp end t))) - (and (memq 'deadline conditions) - (re-search-forward org-deadline-time-regexp end t)) - (and (memq 'notdeadline conditions) - (not (re-search-forward org-deadline-time-regexp end t))) - (and (memq 'timestamp conditions) - (re-search-forward org-ts-regexp end t)) - (and (memq 'nottimestamp conditions) - (not (re-search-forward org-ts-regexp end t))) - (and (setq m (memq 'regexp conditions)) - (stringp (nth 1 m)) - (re-search-forward (nth 1 m) end t)) - (and (setq m (memq 'notregexp conditions)) - (stringp (nth 1 m)) - (not (re-search-forward (nth 1 m) end t))) - (and (or - (setq m (memq 'nottodo conditions)) - (setq m (memq 'todo-unblocked conditions)) - (setq m (memq 'nottodo-unblocked conditions)) - (setq m (memq 'todo conditions))) - (org-agenda-skip-if-todo m end))) - end))) - -(defun org-agenda-skip-if-todo (args end) - "Helper function for `org-agenda-skip-if', do not use it directly. -ARGS is a list with first element either `todo', `nottodo', -`todo-unblocked' or `nottodo-unblocked'. The remainder is either -a list of TODO keywords, or a state symbol `todo' or `done' or -`any'." - (let ((kw (car args)) - (arg (cadr args)) - todo-wds todo-re) - (setq todo-wds - (org-uniquify - (cond - ((listp arg) ;; list of keywords - (if (member "*" arg) - (mapcar 'substring-no-properties org-todo-keywords-1) - arg)) - ((symbolp arg) ;; keyword class name - (cond - ((eq arg 'todo) - (org-delete-all org-done-keywords - (mapcar 'substring-no-properties - org-todo-keywords-1))) - ((eq arg 'done) org-done-keywords) - ((eq arg 'any) - (mapcar 'substring-no-properties org-todo-keywords-1))))))) - (setq todo-re - (concat "^\\*+[ \t]+\\<\\(" - (mapconcat 'identity todo-wds "\\|") - "\\)\\>")) - (cond - ((eq kw 'todo) (re-search-forward todo-re end t)) - ((eq kw 'nottodo) (not (re-search-forward todo-re end t))) - ((eq kw 'todo-unblocked) - (catch 'unblocked - (while (re-search-forward todo-re end t) - (or (org-entry-blocked-p) (throw 'unblocked t))) - nil)) - ((eq kw 'nottodo-unblocked) - (catch 'unblocked - (while (re-search-forward todo-re end t) - (or (org-entry-blocked-p) (throw 'unblocked nil))) - t)) - ))) - -;;;###autoload -(defun org-agenda-list-stuck-projects (&rest ignore) - "Create agenda view for projects that are stuck. -Stuck projects are project that have no next actions. For the definitions -of what a project is and how to check if it stuck, customize the variable -`org-stuck-projects'." - (interactive) - (let* ((org-agenda-skip-function - 'org-agenda-skip-entry-when-regexp-matches-in-subtree) - ;; We could have used org-agenda-skip-if here. - (org-agenda-overriding-header - (or org-agenda-overriding-header "List of stuck projects: ")) - (matcher (nth 0 org-stuck-projects)) - (todo (nth 1 org-stuck-projects)) - (todo-wds (if (member "*" todo) - (progn - (org-agenda-prepare-buffers (org-agenda-files - nil 'ifmode)) - (org-delete-all - org-done-keywords-for-agenda - (copy-sequence org-todo-keywords-for-agenda))) - todo)) - (todo-re (concat "^\\*+[ \t]+\\(" - (mapconcat 'identity todo-wds "\\|") - "\\)\\>")) - (tags (nth 2 org-stuck-projects)) - (tags-re (if (member "*" tags) - (concat org-outline-regexp-bol - (org-re ".*:[[:alnum:]_@#%]+:[ \t]*$")) - (if tags - (concat org-outline-regexp-bol - ".*:\\(" - (mapconcat 'identity tags "\\|") - (org-re "\\):[[:alnum:]_@#%:]*[ \t]*$"))))) - (gen-re (nth 3 org-stuck-projects)) - (re-list - (delq nil - (list - (if todo todo-re) - (if tags tags-re) - (and gen-re (stringp gen-re) (string-match "\\S-" gen-re) - gen-re))))) - (setq org-agenda-skip-regexp - (if re-list - (mapconcat 'identity re-list "\\|") - (error "No information how to identify unstuck projects"))) - (org-tags-view nil matcher) - (with-current-buffer org-agenda-buffer-name - (setq org-agenda-redo-command - `(org-agenda-list-stuck-projects ,current-prefix-arg))))) - -;;; Diary integration - -(defvar org-disable-agenda-to-diary nil) ;Dynamically-scoped param. -(defvar diary-list-entries-hook) -(defvar diary-time-regexp) -(defun org-get-entries-from-diary (date) - "Get the (Emacs Calendar) diary entries for DATE." - (require 'diary-lib) - (let* ((diary-fancy-buffer "*temporary-fancy-diary-buffer*") - (diary-display-hook '(fancy-diary-display)) - (diary-display-function 'fancy-diary-display) - (pop-up-frames nil) - (diary-list-entries-hook - (cons 'org-diary-default-entry diary-list-entries-hook)) - (diary-file-name-prefix nil) ; turn this feature off - (diary-modify-entry-list-string-function 'org-modify-diary-entry-string) - entries - (org-disable-agenda-to-diary t)) - (save-excursion - (save-window-excursion - (funcall (if (fboundp 'diary-list-entries) - 'diary-list-entries 'list-diary-entries) - date 1))) - (if (not (get-buffer diary-fancy-buffer)) - (setq entries nil) - (with-current-buffer diary-fancy-buffer - (setq buffer-read-only nil) - (if (zerop (buffer-size)) - ;; No entries - (setq entries nil) - ;; Omit the date and other unnecessary stuff - (org-agenda-cleanup-fancy-diary) - ;; Add prefix to each line and extend the text properties - (if (zerop (buffer-size)) - (setq entries nil) - (setq entries (buffer-substring (point-min) (- (point-max) 1))) - (setq entries - (with-temp-buffer - (insert entries) (goto-char (point-min)) - (while (re-search-forward "\n[ \t]+\\(.+\\)$" nil t) - (unless (save-match-data (string-match diary-time-regexp (match-string 1))) - (replace-match (concat "; " (match-string 1))))) - (buffer-string))))) - (set-buffer-modified-p nil) - (kill-buffer diary-fancy-buffer))) - (when entries - (setq entries (org-split-string entries "\n")) - (setq entries - (mapcar - (lambda (x) - (setq x (org-agenda-format-item "" x nil "Diary" nil 'time)) - ;; Extend the text properties to the beginning of the line - (org-add-props x (text-properties-at (1- (length x)) x) - 'type "diary" 'date date 'face 'org-agenda-diary)) - entries))))) - -(defvar org-agenda-cleanup-fancy-diary-hook nil - "Hook run when the fancy diary buffer is cleaned up.") - -(defun org-agenda-cleanup-fancy-diary () - "Remove unwanted stuff in buffer created by `fancy-diary-display'. -This gets rid of the date, the underline under the date, and -the dummy entry installed by `org-mode' to ensure non-empty diary for each -date. It also removes lines that contain only whitespace." - (goto-char (point-min)) - (if (looking-at ".*?:[ \t]*") - (progn - (replace-match "") - (re-search-forward "\n=+$" nil t) - (replace-match "") - (while (re-search-backward "^ +\n?" nil t) (replace-match ""))) - (re-search-forward "\n=+$" nil t) - (delete-region (point-min) (min (point-max) (1+ (match-end 0))))) - (goto-char (point-min)) - (while (re-search-forward "^ +\n" nil t) - (replace-match "")) - (goto-char (point-min)) - (if (re-search-forward "^Org-mode dummy\n?" nil t) - (replace-match "")) - (run-hooks 'org-agenda-cleanup-fancy-diary-hook)) - -;; Make sure entries from the diary have the right text properties. -(eval-after-load "diary-lib" - '(if (boundp 'diary-modify-entry-list-string-function) - ;; We can rely on the hook, nothing to do - nil - ;; Hook not available, must use advice to make this work - (defadvice add-to-diary-list (before org-mark-diary-entry activate) - "Make the position visible." - (if (and org-disable-agenda-to-diary ;; called from org-agenda - (stringp string) - buffer-file-name) - (setq string (org-modify-diary-entry-string string)))))) - -(defun org-modify-diary-entry-string (string) - "Add text properties to string, allowing org-mode to act on it." - (org-add-props string nil - 'mouse-face 'highlight - 'help-echo (if buffer-file-name - (format "mouse-2 or RET jump to diary file %s" - (abbreviate-file-name buffer-file-name)) - "") - 'org-agenda-diary-link t - 'org-marker (org-agenda-new-marker (point-at-bol)))) - -(defun org-diary-default-entry () - "Add a dummy entry to the diary. -Needed to avoid empty dates which mess up holiday display." - ;; Catch the error if dealing with the new add-to-diary-alist - (when org-disable-agenda-to-diary - (condition-case nil - (org-add-to-diary-list original-date "Org-mode dummy" "") - (error - (org-add-to-diary-list original-date "Org-mode dummy" "" nil))))) - -(defun org-add-to-diary-list (&rest args) - (if (fboundp 'diary-add-to-list) - (apply 'diary-add-to-list args) - (apply 'add-to-diary-list args))) - -(defvar org-diary-last-run-time nil) - -;;;###autoload -(defun org-diary (&rest args) - "Return diary information from org files. -This function can be used in a \"sexp\" diary entry in the Emacs calendar. -It accesses org files and extracts information from those files to be -listed in the diary. The function accepts arguments specifying what -items should be listed. For a list of arguments allowed here, see the -variable `org-agenda-entry-types'. - -The call in the diary file should look like this: - - &%%(org-diary) ~/path/to/some/orgfile.org - -Use a separate line for each org file to check. Or, if you omit the file name, -all files listed in `org-agenda-files' will be checked automatically: - - &%%(org-diary) - -If you don't give any arguments (as in the example above), the default value -of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp). -So the example above may also be written as - - &%%(org-diary :deadline :timestamp :sexp :scheduled) - -The function expects the lisp variables `entry' and `date' to be provided -by the caller, because this is how the calendar works. Don't use this -function from a program - use `org-agenda-get-day-entries' instead." - (when (> (- (org-float-time) - org-agenda-last-marker-time) - 5) - ;; I am not sure if this works with sticky agendas, because the marker - ;; list is then no longer a global variable. - (org-agenda-reset-markers)) - (org-compile-prefix-format 'agenda) - (org-set-sorting-strategy 'agenda) - (setq args (or args org-agenda-entry-types)) - (let* ((files (if (and entry (stringp entry) (string-match "\\S-" entry)) - (list entry) - (org-agenda-files t))) - (time (org-float-time)) - file rtn results) - (when (or (not org-diary-last-run-time) - (> (- time - org-diary-last-run-time) - 3)) - (org-agenda-prepare-buffers files)) - (setq org-diary-last-run-time time) - ;; If this is called during org-agenda, don't return any entries to - ;; the calendar. Org Agenda will list these entries itself. - (if org-disable-agenda-to-diary (setq files nil)) - (while (setq file (pop files)) - (setq rtn (apply 'org-agenda-get-day-entries file date args)) - (setq results (append results rtn))) - (when results - (setq results - (mapcar (lambda (i) (replace-regexp-in-string - org-bracket-link-regexp "\\3" i)) results)) - (concat (org-agenda-finalize-entries results) "\n")))) - -;;; Agenda entry finders - -(defun org-agenda-get-day-entries (file date &rest args) - "Does the work for `org-diary' and `org-agenda'. -FILE is the path to a file to be checked for entries. DATE is date like -the one returned by `calendar-current-date'. ARGS are symbols indicating -which kind of entries should be extracted. For details about these, see -the documentation of `org-diary'." - (setq args (or args org-agenda-entry-types)) - (let* ((org-startup-folded nil) - (org-startup-align-all-tables nil) - (buffer (if (file-exists-p file) - (org-get-agenda-file-buffer file) - (error "No such file %s" file))) - arg results rtn deadline-results) - (if (not buffer) - ;; If file does not exist, make sure an error message ends up in diary - (list (format "ORG-AGENDA-ERROR: No such org-file %s" file)) - (with-current-buffer buffer - (unless (derived-mode-p 'org-mode) - (error "Agenda file %s is not in `org-mode'" file)) - (setq org-agenda-buffer (or org-agenda-buffer buffer)) - (let ((case-fold-search nil)) - (save-excursion - (save-restriction - (if (eq buffer org-agenda-restrict) - (narrow-to-region org-agenda-restrict-begin - org-agenda-restrict-end) - (widen)) - ;; The way we repeatedly append to `results' makes it O(n^2) :-( - (while (setq arg (pop args)) - (cond - ((and (eq arg :todo) - (equal date (calendar-gregorian-from-absolute - (org-today)))) - (setq rtn (org-agenda-get-todos)) - (setq results (append results rtn))) - ((eq arg :timestamp) - (setq rtn (org-agenda-get-blocks)) - (setq results (append results rtn)) - (setq rtn (org-agenda-get-timestamps deadline-results)) - (setq results (append results rtn))) - ((eq arg :sexp) - (setq rtn (org-agenda-get-sexps)) - (setq results (append results rtn))) - ((eq arg :scheduled) - (setq rtn (org-agenda-get-scheduled deadline-results)) - (setq results (append results rtn))) - ((eq arg :scheduled*) - (setq rtn (org-agenda-get-scheduled deadline-results t)) - (setq results (append results rtn))) - ((eq arg :closed) - (setq rtn (org-agenda-get-progress)) - (setq results (append results rtn))) - ((eq arg :deadline) - (setq rtn (org-agenda-get-deadlines)) - (setq deadline-results (copy-sequence rtn)) - (setq results (append results rtn))) - ((eq arg :deadline*) - (setq rtn (org-agenda-get-deadlines t)) - (setq deadline-results (copy-sequence rtn)) - (setq results (append results rtn)))))))) - results)))) - -(defsubst org-em (x y list) - "Is X or Y a member of LIST?" - (or (memq x list) (memq y list))) - -(defvar org-heading-keyword-regexp-format) ; defined in org.el -(defvar org-agenda-sorting-strategy-selected nil) - -(defun org-agenda-get-todos () - "Return the TODO information for agenda display." - (let* ((props (list 'face nil - 'done-face 'org-agenda-done - 'org-not-done-regexp org-not-done-regexp - 'org-todo-regexp org-todo-regexp - 'org-complex-heading-regexp org-complex-heading-regexp - 'mouse-face 'highlight - 'help-echo - (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) - (regexp (format org-heading-keyword-regexp-format - (cond - ((and org-select-this-todo-keyword - (equal org-select-this-todo-keyword "*")) - org-todo-regexp) - (org-select-this-todo-keyword - (concat "\\(" - (mapconcat 'identity - (org-split-string - org-select-this-todo-keyword - "|") - "\\|") "\\)")) - (t org-not-done-regexp)))) - marker priority category category-pos level tags todo-state ts-date ts-date-type - ee txt beg end inherited-tags todo-state-end-pos) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (catch :skip - (save-match-data - (beginning-of-line) - (org-agenda-skip) - (setq beg (point) end (save-excursion (outline-next-heading) (point))) - (unless (and (setq todo-state (org-get-todo-state)) - (setq todo-state-end-pos (match-end 2))) - (goto-char end) - (throw :skip nil)) - (when (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item end) - (goto-char (1+ beg)) - (or org-agenda-todo-list-sublevels (org-end-of-subtree 'invisible)) - (throw :skip nil))) - (goto-char (match-beginning 2)) - (setq marker (org-agenda-new-marker (match-beginning 0)) - category (org-get-category) - ts-date (let (ts) - (save-match-data - (cond ((org-em 'scheduled-up 'scheduled-down - org-agenda-sorting-strategy-selected) - (setq ts (org-entry-get (point) "SCHEDULED") - ts-date-type " scheduled")) - ((org-em 'deadline-up 'deadline-down - org-agenda-sorting-strategy-selected) - (setq ts (org-entry-get (point) "DEADLINE") - ts-date-type " deadline")) - ((org-em 'ts-up 'ts-down - org-agenda-sorting-strategy-selected) - (setq ts (org-entry-get (point) "TIMESTAMP") - ts-date-type " timestamp")) - ((org-em 'tsia-up 'tsia-down - org-agenda-sorting-strategy-selected) - (setq ts (org-entry-get (point) "TIMESTAMP_IA") - ts-date-type " timestamp_ia")) - ((org-em 'timestamp-up 'timestamp-down - org-agenda-sorting-strategy-selected) - (setq ts (or (org-entry-get (point) "SCHEDULED") - (org-entry-get (point) "DEADLINE") - (org-entry-get (point) "TIMESTAMP") - (org-entry-get (point) "TIMESTAMP_IA")) - ts-date-type "")) - (t (setq ts-date-type ""))) - (when ts (ignore-errors (org-time-string-to-absolute ts))))) - category-pos (get-text-property (point) 'org-category-position) - txt (org-trim - (buffer-substring (match-beginning 2) (match-end 0))) - inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'todo org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'todo org-agenda-use-tag-inheritance)))) - tags (org-get-tags-at nil (not inherited-tags)) - level (make-string (org-reduced-level (org-outline-level)) ? ) - txt (org-agenda-format-item "" txt level category tags t) - priority (1+ (org-get-priority txt))) - (org-add-props txt props - 'org-marker marker 'org-hd-marker marker - 'priority priority 'org-category category - 'level level - 'ts-date ts-date - 'org-category-position category-pos - 'type (concat "todo" ts-date-type) 'todo-state todo-state) - (push txt ee) - (if org-agenda-todo-list-sublevels - (goto-char todo-state-end-pos) - (org-end-of-subtree 'invisible)))) - (nreverse ee))) - -(defun org-agenda-todo-custom-ignore-p (time n) - "Check whether timestamp is farther away than n number of days. -This function is invoked if `org-agenda-todo-ignore-deadlines', -`org-agenda-todo-ignore-scheduled' or -`org-agenda-todo-ignore-timestamp' is set to an integer." - (let ((days (org-time-stamp-to-now - time org-agenda-todo-ignore-time-comparison-use-seconds))) - (if (>= n 0) - (>= days n) - (<= days n)))) - -;;;###autoload -(defun org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item - (&optional end) - "Do we have a reason to ignore this TODO entry because it has a time stamp?" - (when (or org-agenda-todo-ignore-with-date - org-agenda-todo-ignore-scheduled - org-agenda-todo-ignore-deadlines - org-agenda-todo-ignore-timestamp) - (setq end (or end (save-excursion (outline-next-heading) (point)))) - (save-excursion - (or (and org-agenda-todo-ignore-with-date - (re-search-forward org-ts-regexp end t)) - (and org-agenda-todo-ignore-scheduled - (re-search-forward org-scheduled-time-regexp end t) - (cond - ((eq org-agenda-todo-ignore-scheduled 'future) - (> (org-time-stamp-to-now - (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) - ((eq org-agenda-todo-ignore-scheduled 'past) - (<= (org-time-stamp-to-now - (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) - ((numberp org-agenda-todo-ignore-scheduled) - (org-agenda-todo-custom-ignore-p - (match-string 1) org-agenda-todo-ignore-scheduled)) - (t))) - (and org-agenda-todo-ignore-deadlines - (re-search-forward org-deadline-time-regexp end t) - (cond - ((memq org-agenda-todo-ignore-deadlines '(t all)) t) - ((eq org-agenda-todo-ignore-deadlines 'far) - (not (org-deadline-close (match-string 1)))) - ((eq org-agenda-todo-ignore-deadlines 'future) - (> (org-time-stamp-to-now - (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) - ((eq org-agenda-todo-ignore-deadlines 'past) - (<= (org-time-stamp-to-now - (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) - ((numberp org-agenda-todo-ignore-deadlines) - (org-agenda-todo-custom-ignore-p - (match-string 1) org-agenda-todo-ignore-deadlines)) - (t (org-deadline-close (match-string 1))))) - (and org-agenda-todo-ignore-timestamp - (let ((buffer (current-buffer)) - (regexp - (concat - org-scheduled-time-regexp "\\|" org-deadline-time-regexp)) - (start (point))) - ;; Copy current buffer into a temporary one - (with-temp-buffer - (insert-buffer-substring buffer start end) - (goto-char (point-min)) - ;; Delete SCHEDULED and DEADLINE items - (while (re-search-forward regexp end t) - (delete-region (match-beginning 0) (match-end 0))) - (goto-char (point-min)) - ;; No search for timestamp left - (when (re-search-forward org-ts-regexp nil t) - (cond - ((eq org-agenda-todo-ignore-timestamp 'future) - (> (org-time-stamp-to-now - (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) - ((eq org-agenda-todo-ignore-timestamp 'past) - (<= (org-time-stamp-to-now - (match-string 1) org-agenda-todo-ignore-time-comparison-use-seconds) 0)) - ((numberp org-agenda-todo-ignore-timestamp) - (org-agenda-todo-custom-ignore-p - (match-string 1) org-agenda-todo-ignore-timestamp)) - (t)))))))))) - -(defun org-agenda-get-timestamps (&optional deadline-results) - "Return the date stamp information for agenda display." - (let* ((props (list 'face 'org-agenda-calendar-event - 'org-not-done-regexp org-not-done-regexp - 'org-todo-regexp org-todo-regexp - 'org-complex-heading-regexp org-complex-heading-regexp - 'mouse-face 'highlight - 'help-echo - (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) - (d1 (calendar-absolute-from-gregorian date)) - mm - (deadline-position-alist - (mapcar (lambda (a) (and (setq mm (get-text-property - 0 'org-hd-marker a)) - (cons (marker-position mm) a))) - deadline-results)) - (remove-re org-ts-regexp) - (regexp - (concat - (if org-agenda-include-inactive-timestamps "[[<]" "<") - (regexp-quote - (substring - (format-time-string - (car org-time-stamp-formats) - (apply 'encode-time ; DATE bound by calendar - (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) - 1 11)) - "\\|\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[hdwmy]>\\)" - "\\|\\(<%%\\(([^>\n]+)\\)>\\)")) - marker hdmarker deadlinep scheduledp clockp closedp inactivep - donep tmp priority category category-pos level ee txt timestr tags - b0 b3 e3 head todo-state end-of-match show-all warntime habitp - inherited-tags ts-date) - (goto-char (point-min)) - (while (setq end-of-match (re-search-forward regexp nil t)) - (setq b0 (match-beginning 0) - b3 (match-beginning 3) e3 (match-end 3) - todo-state (save-match-data (ignore-errors (org-get-todo-state))) - habitp (and (functionp 'org-is-habit-p) (save-match-data (org-is-habit-p))) - show-all (or (eq org-agenda-repeating-timestamp-show-all t) - (member todo-state - org-agenda-repeating-timestamp-show-all))) - (catch :skip - (and (org-at-date-range-p) (throw :skip nil)) - (org-agenda-skip) - (if (and (match-end 1) - (not (= d1 (org-time-string-to-absolute - (match-string 1) d1 nil show-all - (current-buffer) b0)))) - (throw :skip nil)) - (if (and e3 - (not (org-diary-sexp-entry (buffer-substring b3 e3) "" date))) - (throw :skip nil)) - (setq tmp (buffer-substring (max (point-min) - (- b0 org-ds-keyword-length)) - b0) - timestr (if b3 "" (buffer-substring b0 (point-at-eol))) - inactivep (= (char-after b0) ?\[) - deadlinep (string-match org-deadline-regexp tmp) - scheduledp (string-match org-scheduled-regexp tmp) - closedp (and org-agenda-include-inactive-timestamps - (string-match org-closed-string tmp)) - clockp (and org-agenda-include-inactive-timestamps - (or (string-match org-clock-string tmp) - (string-match "]-+\\'" tmp))) - warntime (get-text-property (point) 'org-appt-warntime) - donep (member todo-state org-done-keywords)) - (if (or scheduledp deadlinep closedp clockp - (and donep org-agenda-skip-timestamp-if-done)) - (throw :skip t)) - (if (string-match ">" timestr) - ;; substring should only run to end of time stamp - (setq timestr (substring timestr 0 (match-end 0)))) - (setq marker (org-agenda-new-marker b0) - category (org-get-category b0) - category-pos (get-text-property b0 'org-category-position)) - (save-excursion - (if (not (re-search-backward org-outline-regexp-bol nil t)) - (throw :skip nil) - (goto-char (match-beginning 0)) - (if (and (eq t org-agenda-skip-timestamp-if-deadline-is-shown) - (assoc (point) deadline-position-alist)) - (throw :skip nil)) - (setq hdmarker (org-agenda-new-marker) - inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'agenda org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'agenda org-agenda-use-tag-inheritance)))) - tags (org-get-tags-at nil (not inherited-tags)) - level (make-string (org-reduced-level (org-outline-level)) ? )) - (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") - (setq head (or (match-string 1) "")) - (setq txt (org-agenda-format-item - (if inactivep org-agenda-inactive-leader nil) - head level category tags timestr - remove-re habitp))) - (setq priority (org-get-priority txt)) - (org-add-props txt props 'priority priority - 'org-marker marker 'org-hd-marker hdmarker - 'org-category category 'date date - 'level level - 'ts-date - (ignore-errors (org-time-string-to-absolute timestr)) - 'org-category-position category-pos - 'todo-state todo-state - 'warntime warntime - 'type "timestamp") - (push txt ee)) - (if org-agenda-skip-additional-timestamps-same-entry - (outline-next-heading) - (goto-char end-of-match)))) - (nreverse ee))) - -(defun org-agenda-get-sexps () - "Return the sexp information for agenda display." - (require 'diary-lib) - (let* ((props (list 'face 'org-agenda-calendar-sexp - 'mouse-face 'highlight - 'help-echo - (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) - (regexp "^&?%%(") - marker category extra category-pos level ee txt tags entry - result beg b sexp sexp-entry todo-state warntime inherited-tags) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (catch :skip - (org-agenda-skip) - (setq beg (match-beginning 0)) - (goto-char (1- (match-end 0))) - (setq b (point)) - (forward-sexp 1) - (setq sexp (buffer-substring b (point))) - (setq sexp-entry (if (looking-at "[ \t]*\\(\\S-.*\\)") - (org-trim (match-string 1)) - "")) - (setq result (org-diary-sexp-entry sexp sexp-entry date)) - (when result - (setq marker (org-agenda-new-marker beg) - level (make-string (org-reduced-level (org-outline-level)) ? ) - category (org-get-category beg) - category-pos (get-text-property beg 'org-category-position) - inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'agenda org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'agenda org-agenda-use-tag-inheritance)))) - tags (org-get-tags-at nil (not inherited-tags)) - todo-state (org-get-todo-state) - warntime (get-text-property (point) 'org-appt-warntime) - extra nil) - - (dolist (r (if (stringp result) - (list result) - result)) ;; we expect a list here - (when (and org-agenda-diary-sexp-prefix - (string-match org-agenda-diary-sexp-prefix r)) - (setq extra (match-string 0 r) - r (replace-match "" nil nil r))) - (if (string-match "\\S-" r) - (setq txt r) - (setq txt "SEXP entry returned empty string")) - (setq txt (org-agenda-format-item extra txt level category tags 'time)) - (org-add-props txt props 'org-marker marker - 'org-category category 'date date 'todo-state todo-state - 'org-category-position category-pos 'tags tags - 'level level - 'type "sexp" 'warntime warntime) - (push txt ee))))) - (nreverse ee))) - -;; Calendar sanity: define some functions that are independent of -;; `calendar-date-style'. -;; Normally I would like to use ISO format when calling the diary functions, -;; but to make sure we still have Emacs 22 compatibility we bind -;; also `european-calendar-style' and use european format -(defun org-anniversary (year month day &optional mark) - "Like `diary-anniversary', but with fixed (ISO) order of arguments." - (org-no-warnings - (let ((calendar-date-style 'european) (european-calendar-style t)) - (diary-anniversary day month year mark)))) -(defun org-cyclic (N year month day &optional mark) - "Like `diary-cyclic', but with fixed (ISO) order of arguments." - (org-no-warnings - (let ((calendar-date-style 'european) (european-calendar-style t)) - (diary-cyclic N day month year mark)))) -(defun org-block (Y1 M1 D1 Y2 M2 D2 &optional mark) - "Like `diary-block', but with fixed (ISO) order of arguments." - (org-no-warnings - (let ((calendar-date-style 'european) (european-calendar-style t)) - (diary-block D1 M1 Y1 D2 M2 Y2 mark)))) -(defun org-date (year month day &optional mark) - "Like `diary-date', but with fixed (ISO) order of arguments." - (org-no-warnings - (let ((calendar-date-style 'european) (european-calendar-style t)) - (diary-date day month year mark)))) - -;; Define the` org-class' function -(defun org-class (y1 m1 d1 y2 m2 d2 dayname &rest skip-weeks) - "Entry applies if date is between dates on DAYNAME, but skips SKIP-WEEKS. -DAYNAME is a number between 0 (Sunday) and 6 (Saturday). -SKIP-WEEKS is any number of ISO weeks in the block period for which the -item should be skipped. If any of the SKIP-WEEKS arguments is the symbol -`holidays', then any date that is known by the Emacs calendar to be a -holiday will also be skipped. If SKIP-WEEKS arguments are holiday strings, -then those holidays will be skipped." - (let* ((date1 (calendar-absolute-from-gregorian (list m1 d1 y1))) - (date2 (calendar-absolute-from-gregorian (list m2 d2 y2))) - (d (calendar-absolute-from-gregorian date)) - (h (when skip-weeks (calendar-check-holidays date)))) - (and - (<= date1 d) - (<= d date2) - (= (calendar-day-of-week date) dayname) - (or (not skip-weeks) - (progn - (require 'cal-iso) - (not (member (car (calendar-iso-from-absolute d)) skip-weeks)))) - (not (or (and h (memq 'holidays skip-weeks)) - (delq nil (mapcar (lambda(g) (member g skip-weeks)) h)))) - entry))) - -(defun org-diary-class (m1 d1 y1 m2 d2 y2 dayname &rest skip-weeks) - "Like `org-class', but honor `calendar-date-style'. -The order of the first 2 times 3 arguments depends on the variable -`calendar-date-style' or, if that is not defined, on `european-calendar-style'. -So for American calendars, give this as MONTH DAY YEAR, for European as -DAY MONTH YEAR, and for ISO as YEAR MONTH DAY. -DAYNAME is a number between 0 (Sunday) and 6 (Saturday). SKIP-WEEKS -is any number of ISO weeks in the block period for which the item should -be skipped. - -This function is here only for backward compatibility and it is deprecated, -please use `org-class' instead." - (let* ((date1 (org-order-calendar-date-args m1 d1 y1)) - (date2 (org-order-calendar-date-args m2 d2 y2))) - (org-class - (nth 2 date1) (car date1) (nth 1 date1) - (nth 2 date2) (car date2) (nth 1 date2) - dayname skip-weeks))) -(make-obsolete 'org-diary-class 'org-class "") - -(defalias 'org-get-closed 'org-agenda-get-progress) -(defun org-agenda-get-progress () - "Return the logged TODO entries for agenda display." - (let* ((props (list 'mouse-face 'highlight - 'org-not-done-regexp org-not-done-regexp - 'org-todo-regexp org-todo-regexp - 'org-complex-heading-regexp org-complex-heading-regexp - 'help-echo - (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) - (items (if (consp org-agenda-show-log-scoped) - org-agenda-show-log-scoped - (if (eq org-agenda-show-log-scoped 'clockcheck) - '(clock) - org-agenda-log-mode-items))) - (parts - (delq nil - (list - (if (memq 'closed items) (concat "\\<" org-closed-string)) - (if (memq 'clock items) (concat "\\<" org-clock-string)) - (if (memq 'state items) "- State \"\\([a-zA-Z0-9]+\\)\".*?")))) - (parts-re (if parts (mapconcat 'identity parts "\\|") - (error "`org-agenda-log-mode-items' is empty"))) - (regexp (concat - "\\(" parts-re "\\)" - " *\\[" - (regexp-quote - (substring - (format-time-string - (car org-time-stamp-formats) - (apply 'encode-time ; DATE bound by calendar - (list 0 0 0 (nth 1 date) (car date) (nth 2 date)))) - 1 11)))) - (org-agenda-search-headline-for-time nil) - marker hdmarker priority category category-pos level tags closedp - statep clockp state ee txt extra timestr rest clocked inherited-tags) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (catch :skip - (org-agenda-skip) - (setq marker (org-agenda-new-marker (match-beginning 0)) - closedp (equal (match-string 1) org-closed-string) - statep (equal (string-to-char (match-string 1)) ?-) - clockp (not (or closedp statep)) - state (and statep (match-string 2)) - category (org-get-category (match-beginning 0)) - category-pos (get-text-property (match-beginning 0) 'org-category-position) - timestr (buffer-substring (match-beginning 0) (point-at-eol))) - (when (string-match "\\]" timestr) - ;; substring should only run to end of time stamp - (setq rest (substring timestr (match-end 0)) - timestr (substring timestr 0 (match-end 0))) - (if (and (not closedp) (not statep) - (string-match "\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)\\].*?\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" - rest)) - (progn (setq timestr (concat (substring timestr 0 -1) - "-" (match-string 1 rest) "]")) - (setq clocked (match-string 2 rest))) - (setq clocked "-"))) - (save-excursion - (setq extra - (cond - ((not org-agenda-log-mode-add-notes) nil) - (statep - (and (looking-at ".*\\\\\n[ \t]*\\([^-\n \t].*?\\)[ \t]*$") - (match-string 1))) - (clockp - (and (looking-at ".*\n[ \t]*-[ \t]+\\([^-\n \t].*?\\)[ \t]*$") - (match-string 1))))) - (if (not (re-search-backward org-outline-regexp-bol nil t)) - (throw :skip nil) - (goto-char (match-beginning 0)) - (setq hdmarker (org-agenda-new-marker) - inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'todo org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'todo org-agenda-use-tag-inheritance)))) - tags (org-get-tags-at nil (not inherited-tags)) - level (make-string (org-reduced-level (org-outline-level)) ? )) - (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") - (setq txt (match-string 1)) - (when extra - (if (string-match "\\([ \t]+\\)\\(:[^ \n\t]*?:\\)[ \t]*$" txt) - (setq txt (concat (substring txt 0 (match-beginning 1)) - " - " extra " " (match-string 2 txt))) - (setq txt (concat txt " - " extra)))) - (setq txt (org-agenda-format-item - (cond - (closedp "Closed: ") - (statep (concat "State: (" state ")")) - (t (concat "Clocked: (" clocked ")"))) - txt level category tags timestr))) - (setq priority 100000) - (org-add-props txt props - 'org-marker marker 'org-hd-marker hdmarker 'face 'org-agenda-done - 'priority priority 'org-category category - 'org-category-position category-pos - 'level level - 'type "closed" 'date date - 'undone-face 'org-warning 'done-face 'org-agenda-done) - (push txt ee)) - (goto-char (point-at-eol)))) - (nreverse ee))) - -(defun org-agenda-show-clocking-issues () - "Add overlays, showing issues with clocking. -See also the user option `org-agenda-clock-consistency-checks'." - (interactive) - (let* ((org-time-clocksum-use-effort-durations nil) - (pl org-agenda-clock-consistency-checks) - (re (concat "^[ \t]*" - org-clock-string - "[ \t]+" - "\\(\\[.*?\\]\\)" ; group 1 is first stamp - "\\(-\\{1,3\\}\\(\\[.*?\\]\\)\\)?")) ; group 3 is second - (tlstart 0.) - (tlend 0.) - (maxtime (org-hh:mm-string-to-minutes - (or (plist-get pl :max-duration) "24:00"))) - (mintime (org-hh:mm-string-to-minutes - (or (plist-get pl :min-duration) 0))) - (maxgap (org-hh:mm-string-to-minutes - ;; default 30:00 means never complain - (or (plist-get pl :max-gap) "30:00"))) - (gapok (mapcar 'org-hh:mm-string-to-minutes - (plist-get pl :gap-ok-around))) - (def-face (or (plist-get pl :default-face) - '((:background "DarkRed") (:foreground "white")))) - issue face m te ts dt ov) - (goto-char (point-min)) - (while (re-search-forward " Clocked: +(-\\|\\([0-9]+:[0-9]+\\))" nil t) - (setq issue nil face def-face) - (catch 'next - (setq m (org-get-at-bol 'org-marker) - te nil ts nil) - (unless (and m (markerp m)) - (setq issue "No valid clock line") (throw 'next t)) - (org-with-point-at m - (save-excursion - (goto-char (point-at-bol)) - (unless (looking-at re) - (error "No valid Clock line") - (throw 'next t)) - (unless (match-end 3) - (setq issue "No end time" - face (or (plist-get pl :no-end-time-face) face)) - (throw 'next t)) - (setq ts (match-string 1) - te (match-string 3) - ts (org-float-time - (apply 'encode-time (org-parse-time-string ts))) - te (org-float-time - (apply 'encode-time (org-parse-time-string te))) - dt (- te ts)))) - (cond - ((> dt (* 60 maxtime)) - ;; a very long clocking chunk - (setq issue (format "Clocking interval is very long: %s" - (org-minutes-to-clocksum-string - (floor (/ (float dt) 60.)))) - face (or (plist-get pl :long-face) face))) - ((< dt (* 60 mintime)) - ;; a very short clocking chunk - (setq issue (format "Clocking interval is very short: %s" - (org-minutes-to-clocksum-string - (floor (/ (float dt) 60.)))) - face (or (plist-get pl :short-face) face))) - ((and (> tlend 0) (< ts tlend)) - ;; Two clock entries are overlapping - (setq issue (format "Clocking overlap: %d minutes" - (/ (- tlend ts) 60)) - face (or (plist-get pl :overlap-face) face))) - ((and (> tlend 0) (> ts (+ tlend (* 60 maxgap)))) - ;; There is a gap, lets see if we need to report it - (unless (org-agenda-check-clock-gap tlend ts gapok) - (setq issue (format "Clocking gap: %d minutes" - (/ (- ts tlend) 60)) - face (or (plist-get pl :gap-face) face)))) - (t nil))) - (setq tlend (or te tlend) tlstart (or ts tlstart)) - (when issue - ;; OK, there was some issue, add an overlay to show the issue - (setq ov (make-overlay (point-at-bol) (point-at-eol))) - (overlay-put ov 'before-string - (concat - (org-add-props - (format "%-43s" (concat " " issue)) - nil - 'face face) - "\n")) - (overlay-put ov 'evaporate t))))) - -(defun org-agenda-check-clock-gap (t1 t2 ok-list) - "Check if gap T1 -> T2 contains one of the OK-LIST time-of-day values." - (catch 'exit - (unless ok-list - ;; there are no OK times for gaps... - (throw 'exit nil)) - (if (> (- (/ t2 36000) (/ t1 36000)) 24) - ;; This is more than 24 hours, so it is OK. - ;; because we have at least one OK time, that must be in the - ;; 24 hour interval. - (throw 'exit t)) - ;; We have a shorter gap. - ;; Now we have to get the minute of the day when these times are - (let* ((t1dec (decode-time (seconds-to-time t1))) - (t2dec (decode-time (seconds-to-time t2))) - ;; compute the minute on the day - (min1 (+ (nth 1 t1dec) (* 60 (nth 2 t1dec)))) - (min2 (+ (nth 1 t2dec) (* 60 (nth 2 t2dec))))) - (when (< min2 min1) - ;; if min2 is smaller than min1, this means it is on the next day. - ;; Wrap it to after midnight. - (setq min2 (+ min2 1440))) - ;; Now check if any of the OK times is in the gap - (mapc (lambda (x) - ;; Wrap the time to after midnight if necessary - (if (< x min1) (setq x (+ x 1440))) - ;; Check if in interval - (and (<= min1 x) (>= min2 x) (throw 'exit t))) - ok-list) - ;; Nope, this gap is not OK - nil))) - -(defun org-agenda-get-deadlines (&optional with-hour) - "Return the deadline information for agenda display. -When WITH-HOUR is non-nil, only return deadlines with an hour -specification like [h]h:mm." - (let* ((props (list 'mouse-face 'highlight - 'org-not-done-regexp org-not-done-regexp - 'org-todo-regexp org-todo-regexp - 'org-complex-heading-regexp org-complex-heading-regexp - 'help-echo - (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) - (regexp (if with-hour - org-deadline-time-hour-regexp - org-deadline-time-regexp)) - (todayp (org-agenda-todayp date)) ; DATE bound by calendar - (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar - (dl0 (car org-agenda-deadline-leaders)) - (dl1 (nth 1 org-agenda-deadline-leaders)) - (dl2 (or (nth 2 org-agenda-deadline-leaders) dl1)) - d2 diff dfrac wdays pos pos1 category category-pos level - tags suppress-prewarning ee txt head face s todo-state - show-all upcomingp donep timestr warntime inherited-tags ts-date) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (catch :skip - (org-agenda-skip) - (setq s (match-string 1) - txt nil - pos (1- (match-beginning 1)) - todo-state (save-match-data (org-get-todo-state)) - show-all (or (eq org-agenda-repeating-timestamp-show-all t) - (member todo-state - org-agenda-repeating-timestamp-show-all)) - d2 (org-time-string-to-absolute - s d1 'past show-all (current-buffer) pos) - diff (- d2 d1)) - (setq suppress-prewarning - (let ((ds (and org-agenda-skip-deadline-prewarning-if-scheduled - (let ((item (buffer-substring (point-at-bol) - (point-at-eol)))) - (save-match-data - (and (string-match - org-scheduled-time-regexp item) - (match-string 1 item))))))) - (cond - ((not ds) nil) - ;; The current item has a scheduled date (in ds), so - ;; evaluate its prewarning lead time. - ((integerp org-agenda-skip-deadline-prewarning-if-scheduled) - ;; Use global prewarning-restart lead time. - org-agenda-skip-deadline-prewarning-if-scheduled) - ((eq org-agenda-skip-deadline-prewarning-if-scheduled - 'pre-scheduled) - ;; Set prewarning to no earlier than scheduled. - (min (- d2 (org-time-string-to-absolute - ds d1 'past show-all (current-buffer) pos)) - org-deadline-warning-days)) - ;; Set prewarning to deadline. - (t 0)))) - (setq wdays (if suppress-prewarning - (let ((org-deadline-warning-days suppress-prewarning)) - (org-get-wdays s)) - (org-get-wdays s)) - dfrac (- 1 (/ (* 1.0 diff) (max wdays 1))) - upcomingp (and todayp (> diff 0))) - ;; When to show a deadline in the calendar: - ;; If the expiration is within wdays warning time. - ;; Past-due deadlines are only shown on the current date - (if (and (or (and (<= diff wdays) - (and todayp (not org-agenda-only-exact-dates))) - (= diff 0))) - (save-excursion - ;; (setq todo-state (org-get-todo-state)) - (setq donep (member todo-state org-done-keywords)) - (if (and donep - (or org-agenda-skip-deadline-if-done - (not (= diff 0)))) - (setq txt nil) - (setq category (org-get-category) - warntime (get-text-property (point) 'org-appt-warntime) - category-pos (get-text-property (point) 'org-category-position)) - (if (not (re-search-backward "^\\*+[ \t]+" nil t)) - (throw :skip nil) - (goto-char (match-end 0)) - (setq pos1 (match-beginning 0)) - (setq level (make-string (org-reduced-level (org-outline-level)) ? )) - (setq inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'agenda org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'agenda org-agenda-use-tag-inheritance)))) - tags (org-get-tags-at pos1 (not inherited-tags))) - (setq head (buffer-substring - (point) - (progn (skip-chars-forward "^\r\n") - (point)))) - (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) - (setq timestr - (concat (substring s (match-beginning 1)) " ")) - (setq timestr 'time)) - (setq txt (org-agenda-format-item - (cond ((= diff 0) dl0) - ((> diff 0) - (if (functionp dl1) - (funcall dl1 diff date) - (format dl1 diff))) - (t - (if (functionp dl2) - (funcall dl2 diff date) - (format dl2 (if (string= dl2 dl1) - diff (abs diff)))))) - head level category tags - (if (not (= diff 0)) nil timestr))))) - (when txt - (setq face (org-agenda-deadline-face dfrac)) - (org-add-props txt props - 'org-marker (org-agenda-new-marker pos) - 'warntime warntime - 'level level - 'ts-date d2 - 'org-hd-marker (org-agenda-new-marker pos1) - 'priority (+ (- diff) - (org-get-priority txt)) - 'org-category category - 'org-category-position category-pos - 'todo-state todo-state - 'type (if upcomingp "upcoming-deadline" "deadline") - 'date (if upcomingp date d2) - 'face (if donep 'org-agenda-done face) - 'undone-face face 'done-face 'org-agenda-done) - (push txt ee)))))) - (nreverse ee))) - -(defun org-agenda-deadline-face (fraction) - "Return the face to displaying a deadline item. -FRACTION is what fraction of the head-warning time has passed." - (let ((faces org-agenda-deadline-faces) f) - (catch 'exit - (while (setq f (pop faces)) - (if (>= fraction (car f)) (throw 'exit (cdr f))))))) - -(defun org-agenda-get-scheduled (&optional deadline-results with-hour) - "Return the scheduled information for agenda display. -When WITH-HOUR is non-nil, only return scheduled items with -an hour specification like [h]h:mm." - (let* ((props (list 'org-not-done-regexp org-not-done-regexp - 'org-todo-regexp org-todo-regexp - 'org-complex-heading-regexp org-complex-heading-regexp - 'done-face 'org-agenda-done - 'mouse-face 'highlight - 'help-echo - (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) - (regexp (if with-hour - org-scheduled-time-hour-regexp - org-scheduled-time-regexp)) - (todayp (org-agenda-todayp date)) ; DATE bound by calendar - (d1 (calendar-absolute-from-gregorian date)) ; DATE bound by calendar - mm - (deadline-position-alist - (mapcar (lambda (a) (and (setq mm (get-text-property - 0 'org-hd-marker a)) - (cons (marker-position mm) a))) - deadline-results)) - d2 diff pos pos1 category category-pos level tags donep - ee txt head pastschedp todo-state face timestr s habitp show-all - did-habit-check-p warntime inherited-tags ts-date suppress-delay - ddays) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (catch :skip - (org-agenda-skip) - (setq s (match-string 1) - txt nil - pos (1- (match-beginning 1)) - todo-state (save-match-data (org-get-todo-state)) - show-all (or (eq org-agenda-repeating-timestamp-show-all t) - (member todo-state - org-agenda-repeating-timestamp-show-all)) - d2 (org-time-string-to-absolute - s d1 'past show-all (current-buffer) pos) - diff (- d2 d1) - warntime (get-text-property (point) 'org-appt-warntime)) - (setq pastschedp (and todayp (< diff 0))) - (setq did-habit-check-p nil) - (setq suppress-delay - (let ((ds (and org-agenda-skip-scheduled-delay-if-deadline - (let ((item (buffer-substring (point-at-bol) (point-at-eol)))) - (save-match-data - (and (string-match - org-deadline-time-regexp item) - (match-string 1 item))))))) - (cond - ((not ds) nil) - ;; The current item has a deadline date (in ds), so - ;; evaluate its delay time. - ((integerp org-agenda-skip-scheduled-delay-if-deadline) - ;; Use global delay time. - (- org-agenda-skip-scheduled-delay-if-deadline)) - ((eq org-agenda-skip-scheduled-delay-if-deadline - 'post-deadline) - ;; Set delay to no later than deadline. - (min (- d2 (org-time-string-to-absolute - ds d1 'past show-all (current-buffer) pos)) - org-scheduled-delay-days)) - (t 0)))) - (setq ddays (if suppress-delay - (let ((org-scheduled-delay-days suppress-delay)) - (org-get-wdays s t t)) - (org-get-wdays s t))) - ;; Use a delay of 0 when there is a repeater and the delay is - ;; of the form --3d - (when (and (save-match-data (string-match "--[0-9]+[hdwmy]" s)) - (< (org-time-string-to-absolute s) - (org-time-string-to-absolute - s d2 'past nil (current-buffer) pos))) - (setq ddays 0)) - ;; When to show a scheduled item in the calendar: - ;; If it is on or past the date. - (when (or (and (> ddays 0) (= diff (- ddays))) - (and (zerop ddays) (= diff 0)) - (and (< (+ diff ddays) 0) - (< (abs diff) org-scheduled-past-days) - (and todayp (not org-agenda-only-exact-dates))) - ;; org-is-habit-p uses org-entry-get, which is expansive - ;; so we go extra mile to only call it once - (and todayp - (boundp 'org-habit-show-all-today) - org-habit-show-all-today - (setq did-habit-check-p t) - (setq habitp (and (functionp 'org-is-habit-p) - (org-is-habit-p))))) - (save-excursion - (setq donep (member todo-state org-done-keywords)) - (if (and donep - (or org-agenda-skip-scheduled-if-done - (not (= diff 0)) - (and (functionp 'org-is-habit-p) - (org-is-habit-p)))) - (setq txt nil) - (setq habitp (if did-habit-check-p habitp - (and (functionp 'org-is-habit-p) - (org-is-habit-p)))) - (setq category (org-get-category) - category-pos (get-text-property (point) 'org-category-position)) - (if (and (eq org-agenda-skip-scheduled-if-deadline-is-shown - 'repeated-after-deadline) - (<= 0 (- d2 (time-to-days (org-get-deadline-time (point)))))) - (throw :skip nil)) - (if (not (re-search-backward "^\\*+[ \t]+" nil t)) - (throw :skip nil) - (goto-char (match-end 0)) - (setq pos1 (match-beginning 0)) - (if habitp - (if (or (not org-habit-show-habits) - (and (not todayp) - (boundp 'org-habit-show-habits-only-for-today) - org-habit-show-habits-only-for-today)) - (throw :skip nil)) - (if (and - (or (eq t org-agenda-skip-scheduled-if-deadline-is-shown) - (and (eq org-agenda-skip-scheduled-if-deadline-is-shown 'not-today) - pastschedp)) - (setq mm (assoc pos1 deadline-position-alist))) - (throw :skip nil))) - (setq inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'agenda org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'agenda org-agenda-use-tag-inheritance)))) - - tags (org-get-tags-at nil (not inherited-tags))) - (setq level (make-string (org-reduced-level (org-outline-level)) ? )) - (setq head (buffer-substring - (point) - (progn (skip-chars-forward "^\r\n") (point)))) - (if (string-match " \\([012]?[0-9]:[0-9][0-9]\\)" s) - (setq timestr - (concat (substring s (match-beginning 1)) " ")) - (setq timestr 'time)) - (setq txt (org-agenda-format-item - (if (= diff 0) - (car org-agenda-scheduled-leaders) - (format (nth 1 org-agenda-scheduled-leaders) - (- 1 diff))) - head level category tags - (if (not (= diff 0)) nil timestr) - nil habitp)))) - (when txt - (setq face - (cond - ((and (not habitp) pastschedp) - 'org-scheduled-previously) - (todayp 'org-scheduled-today) - (t 'org-scheduled)) - habitp (and habitp (org-habit-parse-todo))) - (org-add-props txt props - 'undone-face face - 'face (if donep 'org-agenda-done face) - 'org-marker (org-agenda-new-marker pos) - 'org-hd-marker (org-agenda-new-marker pos1) - 'type (if pastschedp "past-scheduled" "scheduled") - 'date (if pastschedp d2 date) - 'ts-date d2 - 'warntime warntime - 'level level - 'priority (if habitp - (org-habit-get-priority habitp) - (+ 94 (- 5 diff) (org-get-priority txt))) - 'org-category category - 'category-position category-pos - 'org-habit-p habitp - 'todo-state todo-state) - (push txt ee)))))) - (nreverse ee))) - -(defun org-agenda-get-blocks () - "Return the date-range information for agenda display." - (let* ((props (list 'face nil - 'org-not-done-regexp org-not-done-regexp - 'org-todo-regexp org-todo-regexp - 'org-complex-heading-regexp org-complex-heading-regexp - 'mouse-face 'highlight - 'help-echo - (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name buffer-file-name)))) - (regexp org-tr-regexp) - (d0 (calendar-absolute-from-gregorian date)) - marker hdmarker ee txt d1 d2 s1 s2 category category-pos - level todo-state tags pos head donep inherited-tags) - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (catch :skip - (org-agenda-skip) - (setq pos (point)) - (let ((start-time (match-string 1)) - (end-time (match-string 2))) - (setq s1 (match-string 1) - s2 (match-string 2) - d1 (time-to-days (org-time-string-to-time s1 (current-buffer) pos)) - d2 (time-to-days (org-time-string-to-time s2 (current-buffer) pos))) - (if (and (> (- d0 d1) -1) (> (- d2 d0) -1)) - ;; Only allow days between the limits, because the normal - ;; date stamps will catch the limits. - (save-excursion - (setq todo-state (org-get-todo-state)) - (setq donep (member todo-state org-done-keywords)) - (if (and donep org-agenda-skip-timestamp-if-done) - (throw :skip t)) - (setq marker (org-agenda-new-marker (point))) - (setq category (org-get-category) - category-pos (get-text-property (point) 'org-category-position)) - (if (not (re-search-backward org-outline-regexp-bol nil t)) - (throw :skip nil) - (goto-char (match-beginning 0)) - (setq hdmarker (org-agenda-new-marker (point)) - inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'agenda org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'agenda org-agenda-use-tag-inheritance)))) - - tags (org-get-tags-at nil (not inherited-tags))) - (setq level (make-string (org-reduced-level (org-outline-level)) ? )) - (looking-at "\\*+[ \t]+\\([^\r\n]+\\)") - (setq head (match-string 1)) - (let ((remove-re - (if org-agenda-remove-timeranges-from-blocks - (concat - "<" (regexp-quote s1) ".*?>" - "--" - "<" (regexp-quote s2) ".*?>") - nil))) - (setq txt (org-agenda-format-item - (format - (nth (if (= d1 d2) 0 1) - org-agenda-timerange-leaders) - (1+ (- d0 d1)) (1+ (- d2 d1))) - head level category tags - (cond ((and (= d1 d0) (= d2 d0)) - (concat "<" start-time ">--<" end-time ">")) - ((= d1 d0) - (concat "<" start-time ">")) - ((= d2 d0) - (concat "<" end-time ">"))) - remove-re)))) - (org-add-props txt props - 'org-marker marker 'org-hd-marker hdmarker - 'type "block" 'date date - 'level level - 'todo-state todo-state - 'priority (org-get-priority txt) 'org-category category - 'org-category-position category-pos) - (push txt ee)))) - (goto-char pos))) - ;; Sort the entries by expiration date. - (nreverse ee))) - -;;; Agenda presentation and sorting - -(defvar org-prefix-has-time nil - "A flag, set by `org-compile-prefix-format'. -The flag is set if the currently compiled format contains a `%t'.") -(defvar org-prefix-has-tag nil - "A flag, set by `org-compile-prefix-format'. -The flag is set if the currently compiled format contains a `%T'.") -(defvar org-prefix-has-effort nil - "A flag, set by `org-compile-prefix-format'. -The flag is set if the currently compiled format contains a `%e'.") -(defvar org-prefix-has-breadcrumbs nil - "A flag, set by `org-compile-prefix-format'. -The flag is set if the currently compiled format contains a `%b'.") -(defvar org-prefix-category-length nil - "Used by `org-compile-prefix-format' to remember the category field width.") -(defvar org-prefix-category-max-length nil - "Used by `org-compile-prefix-format' to remember the category field width.") - -(defun org-agenda-get-category-icon (category) - "Return an image for CATEGORY according to `org-agenda-category-icon-alist'." - (dolist (entry org-agenda-category-icon-alist) - (when (org-string-match-p (car entry) category) - (if (listp (cadr entry)) - (return (cadr entry)) - (return (apply 'create-image (cdr entry))))))) - -(defun org-agenda-format-item (extra txt &optional level category tags dotime - remove-re habitp) - "Format TXT to be inserted into the agenda buffer. -In particular, add the prefix and corresponding text properties. - -EXTRA must be a string to replace the `%s' specifier in the prefix format. -LEVEL may be a string to replace the `%l' specifier. -CATEGORY (a string, a symbol or nil) may be used to overrule the default -category taken from local variable or file name. It will replace the `%c' -specifier in the format. -DOTIME, when non-nil, indicates that a time-of-day should be extracted from -TXT for sorting of this entry, and for the `%t' specifier in the format. -When DOTIME is a string, this string is searched for a time before TXT is. -TAGS can be the tags of the headline. -Any match of REMOVE-RE will be removed from TXT." - ;; We keep the org-prefix-* variable values along with a compiled - ;; formatter, so that multiple agendas existing at the same time do - ;; not step on each other toes. - ;; - ;; It was inconvenient to make these variables buffer local in - ;; Agenda buffers, because this function expects to be called with - ;; the buffer where item comes from being current, and not agenda - ;; buffer - (let* ((bindings (car org-prefix-format-compiled)) - (formatter (cadr org-prefix-format-compiled))) - (loop for (var value) in bindings - do (set var value)) - (save-match-data - ;; Diary entries sometimes have extra whitespace at the beginning - (setq txt (org-trim txt)) - - ;; Fix the tags part in txt - (setq txt (org-agenda-fix-displayed-tags - txt tags - org-agenda-show-inherited-tags - org-agenda-hide-tags-regexp)) - - (let* ((category (or category - (if (stringp org-category) - org-category - (and org-category (symbol-name org-category))) - (if buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - ""))) - (category-icon (org-agenda-get-category-icon category)) - (category-icon (if category-icon - (propertize " " 'display category-icon) - "")) - ;; time, tag, effort are needed for the eval of the prefix format - (tag (if tags (nth (1- (length tags)) tags) "")) - time effort neffort - (ts (if dotime (concat - (if (stringp dotime) dotime "") - (and org-agenda-search-headline-for-time txt)))) - (time-of-day (and dotime (org-get-time-of-day ts))) - stamp plain s0 s1 s2 rtn srp l - duration thecategory breadcrumbs) - (and (derived-mode-p 'org-mode) buffer-file-name - (add-to-list 'org-agenda-contributing-files buffer-file-name)) - (when (and dotime time-of-day) - ;; Extract starting and ending time and move them to prefix - (when (or (setq stamp (string-match org-stamp-time-of-day-regexp ts)) - (setq plain (string-match org-plain-time-of-day-regexp ts))) - (setq s0 (match-string 0 ts) - srp (and stamp (match-end 3)) - s1 (match-string (if plain 1 2) ts) - s2 (match-string (if plain 8 (if srp 4 6)) ts)) - - ;; If the times are in TXT (not in DOTIMES), and the prefix will list - ;; them, we might want to remove them there to avoid duplication. - ;; The user can turn this off with a variable. - (if (and org-prefix-has-time - org-agenda-remove-times-when-in-prefix (or stamp plain) - (string-match (concat (regexp-quote s0) " *") txt) - (not (equal ?\] (string-to-char (substring txt (match-end 0))))) - (if (eq org-agenda-remove-times-when-in-prefix 'beg) - (= (match-beginning 0) 0) - t)) - (setq txt (replace-match "" nil nil txt)))) - ;; Normalize the time(s) to 24 hour - (if s1 (setq s1 (org-get-time-of-day s1 'string t))) - (if s2 (setq s2 (org-get-time-of-day s2 'string t))) - - ;; Try to set s2 if s1 and `org-agenda-default-appointment-duration' are set - (let (org-time-clocksum-use-effort-durations) - (when (and s1 (not s2) org-agenda-default-appointment-duration) - (setq s2 - (org-minutes-to-clocksum-string - (+ (org-hh:mm-string-to-minutes s1) - org-agenda-default-appointment-duration))))) - - ;; Compute the duration - (when s2 - (setq duration (- (org-hh:mm-string-to-minutes s2) - (org-hh:mm-string-to-minutes s1))))) - - (when (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") - txt) - ;; Tags are in the string - (if (or (eq org-agenda-remove-tags t) - (and org-agenda-remove-tags - org-prefix-has-tag)) - (setq txt (replace-match "" t t txt)) - (setq txt (replace-match - (concat (make-string (max (- 50 (length txt)) 1) ?\ ) - (match-string 2 txt)) - t t txt)))) - (when (derived-mode-p 'org-mode) - (setq effort (ignore-errors (get-text-property 0 'org-effort txt)))) - - ;; org-agenda-add-time-grid-maybe calls us with *Agenda* as - ;; current buffer, so move this check outside of above - (if effort - (setq neffort (org-duration-string-to-minutes effort) - effort (setq effort (concat "[" effort "]"))) - ;; prevent erroring out with %e format when there is no effort - (setq effort "")) - - (when remove-re - (while (string-match remove-re txt) - (setq txt (replace-match "" t t txt)))) - - ;; Set org-heading property on `txt' to mark the start of the - ;; heading. - (add-text-properties 0 (length txt) '(org-heading t) txt) - - ;; Prepare the variables needed in the eval of the compiled format - (if org-prefix-has-breadcrumbs - (setq breadcrumbs (org-with-point-at (org-get-at-bol 'org-marker) - (let ((s (org-display-outline-path nil nil "->" t))) - (if (eq "" s) "" (concat s "->")))))) - (setq time (cond (s2 (concat - (org-agenda-time-of-day-to-ampm-maybe s1) - "-" (org-agenda-time-of-day-to-ampm-maybe s2) - (if org-agenda-timegrid-use-ampm " "))) - (s1 (concat - (org-agenda-time-of-day-to-ampm-maybe s1) - (if org-agenda-timegrid-use-ampm - "........ " - "......"))) - (t "")) - extra (or (and (not habitp) extra) "") - category (if (symbolp category) (symbol-name category) category) - thecategory (copy-sequence category) - level (or level "")) - (if (string-match org-bracket-link-regexp category) - (progn - (setq l (if (match-end 3) - (- (match-end 3) (match-beginning 3)) - (- (match-end 1) (match-beginning 1)))) - (when (< l (or org-prefix-category-length 0)) - (setq category (copy-sequence category)) - (org-add-props category nil - 'extra-space (make-string - (- org-prefix-category-length l 1) ?\ )))) - (if (and org-prefix-category-max-length - (>= (length category) org-prefix-category-max-length)) - (setq category (substring category 0 (1- org-prefix-category-max-length))))) - ;; Evaluate the compiled format - (setq rtn (concat (eval formatter) txt)) - - ;; And finally add the text properties - (remove-text-properties 0 (length rtn) '(line-prefix t wrap-prefix t) rtn) - (org-add-props rtn nil - 'org-category (if thecategory (downcase thecategory) category) - 'tags (mapcar 'org-downcase-keep-props tags) - 'org-highest-priority org-highest-priority - 'org-lowest-priority org-lowest-priority - 'time-of-day time-of-day - 'duration duration - 'effort effort - 'effort-minutes neffort - 'breadcrumbs breadcrumbs - 'txt txt - 'level level - 'time time - 'extra extra - 'format org-prefix-format-compiled - 'dotime dotime))))) - -(defun org-agenda-fix-displayed-tags (txt tags add-inherited hide-re) - "Remove tags string from TXT, and add a modified list of tags. -The modified list may contain inherited tags, and tags matched by -`org-agenda-hide-tags-regexp' will be removed." - (when (or add-inherited hide-re) - (if (string-match (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") txt) - (setq txt (substring txt 0 (match-beginning 0)))) - (setq tags - (delq nil - (mapcar (lambda (tg) - (if (or (and hide-re (string-match hide-re tg)) - (and (not add-inherited) - (get-text-property 0 'inherited tg))) - nil - tg)) - tags))) - (when tags - (let ((have-i (get-text-property 0 'inherited (car tags))) - i) - (setq txt (concat txt " :" - (mapconcat - (lambda (x) - (setq i (get-text-property 0 'inherited x)) - (if (and have-i (not i)) - (progn - (setq have-i nil) - (concat ":" x)) - x)) - tags ":") - (if have-i "::" ":")))))) - txt) - -(defun org-downcase-keep-props (s) - (let ((props (text-properties-at 0 s))) - (setq s (downcase s)) - (add-text-properties 0 (length s) props s) - s)) - -(defvar org-agenda-sorting-strategy) ;; because the def is in a let form - -(defun org-agenda-add-time-grid-maybe (list ndays todayp) - "Add a time-grid for agenda items which need it. - -LIST is the list of agenda items formatted by `org-agenda-list'. -NDAYS is the span of the current agenda view. -TODAYP is `t' when the current agenda view is on today." - (catch 'exit - (cond ((not org-agenda-use-time-grid) (throw 'exit list)) - ((and todayp (member 'today (car org-agenda-time-grid)))) - ((and (= ndays 1) (member 'daily (car org-agenda-time-grid)))) - ((member 'weekly (car org-agenda-time-grid))) - (t (throw 'exit list))) - (let* ((have (delq nil (mapcar - (lambda (x) (get-text-property 1 'time-of-day x)) - list))) - (string (nth 1 org-agenda-time-grid)) - (gridtimes (nth 2 org-agenda-time-grid)) - (req (car org-agenda-time-grid)) - (remove (member 'remove-match req)) - new time) - (if (and (member 'require-timed req) (not have)) - ;; don't show empty grid - (throw 'exit list)) - (while (setq time (pop gridtimes)) - (unless (and remove (member time have)) - (setq time (replace-regexp-in-string " " "0" (format "%04s" time))) - (push (org-agenda-format-item - nil string nil "" nil - (concat (substring time 0 -2) ":" (substring time -2))) - new) - (put-text-property - 2 (length (car new)) 'face 'org-time-grid (car new)))) - (when (and todayp org-agenda-show-current-time-in-grid) - (push (org-agenda-format-item - nil org-agenda-current-time-string nil "" nil - (format-time-string "%H:%M ")) - new) - (put-text-property - 2 (length (car new)) 'face 'org-agenda-current-time (car new))) - - (if (member 'time-up org-agenda-sorting-strategy-selected) - (append new list) - (append list new))))) - -(defun org-compile-prefix-format (key) - "Compile the prefix format into a Lisp form that can be evaluated. -The resulting form and associated variable bindings is returned -and stored in the variable `org-prefix-format-compiled'." - (setq org-prefix-has-time nil - org-prefix-has-tag nil - org-prefix-category-length nil - org-prefix-has-effort nil - org-prefix-has-breadcrumbs nil) - (let ((s (cond - ((stringp org-agenda-prefix-format) - org-agenda-prefix-format) - ((assq key org-agenda-prefix-format) - (cdr (assq key org-agenda-prefix-format))) - (t " %-12:c%?-12t% s"))) - (start 0) - varform vars var e c f opt) - (while (string-match "%\\(\\?\\)?\\([-+]?[0-9.]*\\)\\([ .;,:!?=|/<>]?\\)\\([cltseib]\\|(.+)\\)" - s start) - (setq var (or (cdr (assoc (match-string 4 s) - '(("c" . category) ("t" . time) ("l" . level) ("s" . extra) - ("i" . category-icon) ("T" . tag) ("e" . effort) ("b" . breadcrumbs)))) - 'eval) - c (or (match-string 3 s) "") - opt (match-beginning 1) - start (1+ (match-beginning 0))) - (if (equal var 'time) (setq org-prefix-has-time t)) - (if (equal var 'tag) (setq org-prefix-has-tag t)) - (if (equal var 'effort) (setq org-prefix-has-effort t)) - (if (equal var 'breadcrumbs) (setq org-prefix-has-breadcrumbs t)) - (setq f (concat "%" (match-string 2 s) "s")) - (when (equal var 'category) - (setq org-prefix-category-length - (floor (abs (string-to-number (match-string 2 s))))) - (setq org-prefix-category-max-length - (let ((x (match-string 2 s))) - (save-match-data - (if (string-match "\\.[0-9]+" x) - (string-to-number (substring (match-string 0 x) 1))))))) - (if (eq var 'eval) - (setq varform `(format ,f (org-eval ,(read (match-string 4 s))))) - (if opt - (setq varform - `(if (equal "" ,var) - "" - (format ,f (if (equal "" ,var) "" (concat ,var ,c))))) - (setq varform `(format ,f (if (equal ,var "") "" (concat ,var ,c (get-text-property 0 'extra-space ,var))))))) - (setq s (replace-match "%s" t nil s)) - (push varform vars)) - (setq vars (nreverse vars)) - (with-current-buffer (or org-agenda-buffer (current-buffer)) - (setq org-prefix-format-compiled - (list - `((org-prefix-has-time ,org-prefix-has-time) - (org-prefix-has-tag ,org-prefix-has-tag) - (org-prefix-category-length ,org-prefix-category-length) - (org-prefix-has-effort ,org-prefix-has-effort) - (org-prefix-has-breadcrumbs ,org-prefix-has-breadcrumbs)) - `(format ,s ,@vars)))))) - -(defun org-set-sorting-strategy (key) - (if (symbolp (car org-agenda-sorting-strategy)) - ;; the old format - (setq org-agenda-sorting-strategy-selected org-agenda-sorting-strategy) - (setq org-agenda-sorting-strategy-selected - (or (cdr (assq key org-agenda-sorting-strategy)) - (cdr (assq 'agenda org-agenda-sorting-strategy)) - '(time-up category-keep priority-down))))) - -(defun org-get-time-of-day (s &optional string mod24) - "Check string S for a time of day. -If found, return it as a military time number between 0 and 2400. -If not found, return nil. -The optional STRING argument forces conversion into a 5 character wide string -HH:MM." - (save-match-data - (when - (or (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)\\([AaPp][Mm]\\)?\\> *" s) - (string-match "\\<\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\([AaPp][Mm]\\)\\> *" s)) - (let* ((h (string-to-number (match-string 1 s))) - (m (if (match-end 3) (string-to-number (match-string 3 s)) 0)) - (ampm (if (match-end 4) (downcase (match-string 4 s)))) - (am-p (equal ampm "am")) - (h1 (cond ((not ampm) h) - ((= h 12) (if am-p 0 12)) - (t (+ h (if am-p 0 12))))) - (h2 (if (and string mod24 (not (and (= m 0) (= h1 24)))) - (mod h1 24) h1)) - (t0 (+ (* 100 h2) m)) - (t1 (concat (if (>= h1 24) "+" " ") - (if (and org-agenda-time-leading-zero - (< t0 1000)) "0" "") - (if (< t0 100) "0" "") - (if (< t0 10) "0" "") - (int-to-string t0)))) - (if string (concat (substring t1 -4 -2) ":" (substring t1 -2)) t0))))) - -(defvar org-agenda-before-sorting-filter-function nil - "Function to be applied to agenda items prior to sorting. -Prior to sorting also means just before they are inserted into the agenda. - -To aid sorting, you may revisit the original entries and add more text -properties which will later be used by the sorting functions. - -The function should take a string argument, an agenda line. -It has access to the text properties in that line, which contain among -other things, the property `org-hd-marker' that points to the entry -where the line comes from. Note that not all lines going into the agenda -have this property, only most. - -The function should return the modified string. It is probably best -to ONLY change text properties. - -You can also use this function as a filter, by returning nil for lines -you don't want to have in the agenda at all. For this application, you -could bind the variable in the options section of a custom command.") - -(defun org-agenda-finalize-entries (list &optional type) - "Sort, limit and concatenate the LIST of agenda items. -The optional argument TYPE tells the agenda type." - (let ((max-effort (cond ((listp org-agenda-max-effort) - (cdr (assoc type org-agenda-max-effort))) - (t org-agenda-max-effort))) - (max-todo (cond ((listp org-agenda-max-todos) - (cdr (assoc type org-agenda-max-todos))) - (t org-agenda-max-todos))) - (max-tags (cond ((listp org-agenda-max-tags) - (cdr (assoc type org-agenda-max-tags))) - (t org-agenda-max-tags))) - (max-entries (cond ((listp org-agenda-max-entries) - (cdr (assoc type org-agenda-max-entries))) - (t org-agenda-max-entries))) l) - (when org-agenda-before-sorting-filter-function - (setq list - (delq nil - (mapcar - org-agenda-before-sorting-filter-function list)))) - (setq list (mapcar 'org-agenda-highlight-todo list) - list (mapcar 'identity (sort list 'org-entries-lessp))) - (when max-effort - (setq list (org-agenda-limit-entries - list 'effort-minutes max-effort 'identity))) - (when max-todo - (setq list (org-agenda-limit-entries list 'todo-state max-todo))) - (when max-tags - (setq list (org-agenda-limit-entries list 'tags max-tags))) - (when max-entries - (setq list (org-agenda-limit-entries list 'org-hd-marker max-entries))) - (mapconcat 'identity list "\n"))) - -(defun org-agenda-limit-entries (list prop limit &optional fn) - "Limit the number of agenda entries." - (let ((include (and limit (< limit 0)))) - (if limit - (let ((fun (or fn (lambda (p) (if p 1)))) - (lim 0)) - (delq nil - (mapcar - (lambda (e) - (let ((pval (funcall fun (get-text-property 1 prop e)))) - (if pval (setq lim (+ lim pval))) - (cond ((and pval (<= lim (abs limit))) e) - ((and include (not pval)) e)))) - list))) - list))) - -(defun org-agenda-limit-interactively () - "In agenda, interactively limit entries to various maximums." - (interactive) - (let* ((max (read-char "Number of [e]ntries [t]odos [T]ags [E]ffort? ")) - (num (string-to-number (read-from-minibuffer "How many? ")))) - (cond ((equal max ?e) - (let ((org-agenda-max-entries num)) (org-agenda-redo))) - ((equal max ?t) - (let ((org-agenda-max-todos num)) (org-agenda-redo))) - ((equal max ?T) - (let ((org-agenda-max-tags num)) (org-agenda-redo))) - ((equal max ?E) - (let ((org-agenda-max-effort num)) (org-agenda-redo))))) - (org-agenda-fit-window-to-buffer)) - -(defun org-agenda-highlight-todo (x) - (let ((org-done-keywords org-done-keywords-for-agenda) - (case-fold-search nil) - re) - (if (eq x 'line) - (save-excursion - (beginning-of-line 1) - (setq re (org-get-at-bol 'org-todo-regexp)) - (goto-char (or (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) (point))) - (when (looking-at (concat "[ \t]*\\.*\\(" re "\\) +")) - (add-text-properties (match-beginning 0) (match-end 1) - (list 'face (org-get-todo-face 1))) - (let ((s (buffer-substring (match-beginning 1) (match-end 1)))) - (delete-region (match-beginning 1) (1- (match-end 0))) - (goto-char (match-beginning 1)) - (insert (format org-agenda-todo-keyword-format s))))) - (let ((pl (text-property-any 0 (length x) 'org-heading t x))) - (setq re (get-text-property 0 'org-todo-regexp x)) - (when (and re - ;; Test `pl' because if there's no heading content, - ;; there's no point matching to highlight. Note - ;; that if we didn't test `pl' first, and there - ;; happened to be no keyword from `org-todo-regexp' - ;; on this heading line, then the `equal' comparison - ;; afterwards would spuriously succeed in the case - ;; where `pl' is nil -- causing an args-out-of-range - ;; error when we try to add text properties to text - ;; that isn't there. - pl - (equal (string-match (concat "\\(\\.*\\)" re "\\( +\\)") - x pl) pl)) - (add-text-properties - (or (match-end 1) (match-end 0)) (match-end 0) - (list 'face (org-get-todo-face (match-string 2 x))) - x) - (when (match-end 1) - (setq x (concat (substring x 0 (match-end 1)) - (format org-agenda-todo-keyword-format - (match-string 2 x)) - (org-add-props " " (text-properties-at 0 x)) - (substring x (match-end 3))))))) - x))) - -(defsubst org-cmp-priority (a b) - "Compare the priorities of string A and B." - (let ((pa (or (get-text-property 1 'priority a) 0)) - (pb (or (get-text-property 1 'priority b) 0))) - (cond ((> pa pb) +1) - ((< pa pb) -1)))) - -(defsubst org-cmp-effort (a b) - "Compare the effort values of string A and B." - (let* ((def (if org-sort-agenda-noeffort-is-high 32767 -1)) - (ea (or (get-text-property 1 'effort-minutes a) def)) - (eb (or (get-text-property 1 'effort-minutes b) def))) - (cond ((> ea eb) +1) - ((< ea eb) -1)))) - -(defsubst org-cmp-category (a b) - "Compare the string values of categories of strings A and B." - (let ((ca (or (get-text-property 1 'org-category a) "")) - (cb (or (get-text-property 1 'org-category b) ""))) - (cond ((string-lessp ca cb) -1) - ((string-lessp cb ca) +1)))) - -(defsubst org-cmp-todo-state (a b) - "Compare the todo states of strings A and B." - (let* ((ma (or (get-text-property 1 'org-marker a) - (get-text-property 1 'org-hd-marker a))) - (mb (or (get-text-property 1 'org-marker b) - (get-text-property 1 'org-hd-marker b))) - (fa (and ma (marker-buffer ma))) - (fb (and mb (marker-buffer mb))) - (todo-kwds - (or (and fa (with-current-buffer fa org-todo-keywords-1)) - (and fb (with-current-buffer fb org-todo-keywords-1)))) - (ta (or (get-text-property 1 'todo-state a) "")) - (tb (or (get-text-property 1 'todo-state b) "")) - (la (- (length (member ta todo-kwds)))) - (lb (- (length (member tb todo-kwds)))) - (donepa (member ta org-done-keywords-for-agenda)) - (donepb (member tb org-done-keywords-for-agenda))) - (cond ((and donepa (not donepb)) -1) - ((and (not donepa) donepb) +1) - ((< la lb) -1) - ((< lb la) +1)))) - -(defsubst org-cmp-alpha (a b) - "Compare the headlines, alphabetically." - (let* ((pla (text-property-any 0 (length a) 'org-heading t a)) - (plb (text-property-any 0 (length b) 'org-heading t b)) - (ta (and pla (substring a pla))) - (tb (and plb (substring b plb)))) - (when pla - (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp a) "") - "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") ta) - (setq ta (substring ta (match-end 0)))) - (setq ta (downcase ta))) - (when plb - (if (string-match (concat "\\`[ \t]*" (or (get-text-property 0 'org-todo-regexp b) "") - "\\([ \t]*\\[[a-zA-Z0-9]\\]\\)? *") tb) - (setq tb (substring tb (match-end 0)))) - (setq tb (downcase tb))) - (cond ((not ta) +1) - ((not tb) -1) - ((string-lessp ta tb) -1) - ((string-lessp tb ta) +1)))) - -(defsubst org-cmp-tag (a b) - "Compare the string values of the first tags of A and B." - (let ((ta (car (last (get-text-property 1 'tags a)))) - (tb (car (last (get-text-property 1 'tags b))))) - (cond ((not ta) +1) - ((not tb) -1) - ((string-lessp ta tb) -1) - ((string-lessp tb ta) +1)))) - -(defsubst org-cmp-time (a b) - "Compare the time-of-day values of strings A and B." - (let* ((def (if org-sort-agenda-notime-is-late 9901 -1)) - (ta (or (get-text-property 1 'time-of-day a) def)) - (tb (or (get-text-property 1 'time-of-day b) def))) - (cond ((< ta tb) -1) - ((< tb ta) +1)))) - -(defsubst org-cmp-ts (a b &optional type) - "Compare the timestamps values of entries A and B. -When TYPE is \"scheduled\", \"deadline\", \"timestamp\" or -\"timestamp_ia\", compare within each of these type. When TYPE -is the empty string, compare all timestamps without respect of -their type." - (let* ((def (if org-sort-agenda-notime-is-late 9901 -1)) - (ta (or (and (string-match type (or (get-text-property 1 'type a) "")) - (get-text-property 1 'ts-date a)) def)) - (tb (or (and (string-match type (or (get-text-property 1 'type b) "")) - (get-text-property 1 'ts-date b)) def))) - (cond ((< ta tb) -1) - ((< tb ta) +1)))) - -(defsubst org-cmp-habit-p (a b) - "Compare the todo states of strings A and B." - (let ((ha (get-text-property 1 'org-habit-p a)) - (hb (get-text-property 1 'org-habit-p b))) - (cond ((and ha (not hb)) -1) - ((and (not ha) hb) +1)))) - -(defun org-entries-lessp (a b) - "Predicate for sorting agenda entries." - ;; The following variables will be used when the form is evaluated. - ;; So even though the compiler complains, keep them. - (let* ((ss org-agenda-sorting-strategy-selected) - (timestamp-up (and (org-em 'timestamp-up 'timestamp-down ss) - (org-cmp-ts a b ""))) - (timestamp-down (if timestamp-up (- timestamp-up) nil)) - (scheduled-up (and (org-em 'scheduled-up 'scheduled-down ss) - (org-cmp-ts a b "scheduled"))) - (scheduled-down (if scheduled-up (- scheduled-up) nil)) - (deadline-up (and (org-em 'deadline-up 'deadline-down ss) - (org-cmp-ts a b "deadline"))) - (deadline-down (if deadline-up (- deadline-up) nil)) - (tsia-up (and (org-em 'tsia-up 'tsia-down ss) - (org-cmp-ts a b "iatimestamp_ia"))) - (tsia-down (if tsia-up (- tsia-up) nil)) - (ts-up (and (org-em 'ts-up 'ts-down ss) - (org-cmp-ts a b "timestamp"))) - (ts-down (if ts-up (- ts-up) nil)) - (time-up (and (org-em 'time-up 'time-down ss) - (org-cmp-time a b))) - (time-down (if time-up (- time-up) nil)) - (priority-up (and (org-em 'priority-up 'priority-down ss) - (org-cmp-priority a b))) - (priority-down (if priority-up (- priority-up) nil)) - (effort-up (and (org-em 'effort-up 'effort-down ss) - (org-cmp-effort a b))) - (effort-down (if effort-up (- effort-up) nil)) - (category-up (and (or (org-em 'category-up 'category-down ss) - (memq 'category-keep ss)) - (org-cmp-category a b))) - (category-down (if category-up (- category-up) nil)) - (category-keep (if category-up +1 nil)) - (tag-up (and (org-em 'tag-up 'tag-down ss) - (org-cmp-tag a b))) - (tag-down (if tag-up (- tag-up) nil)) - (todo-state-up (and (org-em 'todo-state-up 'todo-state-down ss) - (org-cmp-todo-state a b))) - (todo-state-down (if todo-state-up (- todo-state-up) nil)) - (habit-up (and (org-em 'habit-up 'habit-down ss) - (org-cmp-habit-p a b))) - (habit-down (if habit-up (- habit-up) nil)) - (alpha-up (and (org-em 'alpha-up 'alpha-down ss) - (org-cmp-alpha a b))) - (alpha-down (if alpha-up (- alpha-up) nil)) - (need-user-cmp (org-em 'user-defined-up 'user-defined-down ss)) - user-defined-up user-defined-down) - (if (and need-user-cmp org-agenda-cmp-user-defined - (functionp org-agenda-cmp-user-defined)) - (setq user-defined-up - (funcall org-agenda-cmp-user-defined a b) - user-defined-down (if user-defined-up (- user-defined-up) nil))) - (cdr (assoc - (eval (cons 'or org-agenda-sorting-strategy-selected)) - '((-1 . t) (1 . nil) (nil . nil)))))) - -;;; Agenda restriction lock - -(defvar org-agenda-restriction-lock-overlay (make-overlay 1 1) - "Overlay to mark the headline to which agenda commands are restricted.") -(overlay-put org-agenda-restriction-lock-overlay - 'face 'org-agenda-restriction-lock) -(overlay-put org-agenda-restriction-lock-overlay - 'help-echo "Agendas are currently limited to this subtree.") -(org-detach-overlay org-agenda-restriction-lock-overlay) - -;;;###autoload -(defun org-agenda-set-restriction-lock (&optional type) - "Set restriction lock for agenda, to current subtree or file. -Restriction will be the file if TYPE is `file', or if type is the -universal prefix '(4), or if the cursor is before the first headline -in the file. Otherwise, restriction will be to the current subtree." - (interactive "P") - (and (equal type '(4)) (setq type 'file)) - (setq type (cond - (type type) - ((org-at-heading-p) 'subtree) - ((condition-case nil (org-back-to-heading t) (error nil)) - 'subtree) - (t 'file))) - (if (eq type 'subtree) - (progn - (setq org-agenda-restrict (current-buffer)) - (setq org-agenda-overriding-restriction 'subtree) - (put 'org-agenda-files 'org-restrict - (list (buffer-file-name (buffer-base-buffer)))) - (org-back-to-heading t) - (move-overlay org-agenda-restriction-lock-overlay - (point) - (if org-agenda-restriction-lock-highlight-subtree - (save-excursion (org-end-of-subtree t t) (point)) - (point-at-eol))) - (move-marker org-agenda-restrict-begin (point)) - (move-marker org-agenda-restrict-end - (save-excursion (org-end-of-subtree t t))) - (message "Locking agenda restriction to subtree")) - (put 'org-agenda-files 'org-restrict - (list (buffer-file-name (buffer-base-buffer)))) - (setq org-agenda-restrict nil) - (setq org-agenda-overriding-restriction 'file) - (move-marker org-agenda-restrict-begin nil) - (move-marker org-agenda-restrict-end nil) - (message "Locking agenda restriction to file")) - (setq current-prefix-arg nil) - (org-agenda-maybe-redo)) - -(defun org-agenda-remove-restriction-lock (&optional noupdate) - "Remove the agenda restriction lock." - (interactive "P") - (org-detach-overlay org-agenda-restriction-lock-overlay) - (org-detach-overlay org-speedbar-restriction-lock-overlay) - (setq org-agenda-overriding-restriction nil) - (setq org-agenda-restrict nil) - (put 'org-agenda-files 'org-restrict nil) - (move-marker org-agenda-restrict-begin nil) - (move-marker org-agenda-restrict-end nil) - (setq current-prefix-arg nil) - (message "Agenda restriction lock removed") - (or noupdate (org-agenda-maybe-redo))) - -(defun org-agenda-maybe-redo () - "If there is any window showing the agenda view, update it." - (let ((w (get-buffer-window org-agenda-buffer-name t)) - (w0 (selected-window))) - (when w - (select-window w) - (org-agenda-redo) - (select-window w0) - (if org-agenda-overriding-restriction - (message "Agenda view shifted to new %s restriction" - org-agenda-overriding-restriction) - (message "Agenda restriction lock removed"))))) - -;;; Agenda commands - -(defun org-agenda-check-type (error &rest types) - "Check if agenda buffer is of allowed type. -If ERROR is non-nil, throw an error, otherwise just return nil. -Allowed types are 'agenda 'timeline 'todo 'tags 'search." - (if (not org-agenda-type) - (error "No Org agenda currently displayed") - (if (memq org-agenda-type types) - t - (if error - (error "Not allowed in %s-type agenda buffers" org-agenda-type) - nil)))) - -(defun org-agenda-Quit () - "Exit the agenda and kill buffers loaded by `org-agenda'. -Also restore the window configuration." - (interactive) - (if org-agenda-columns-active - (org-columns-quit) - (let ((buf (current-buffer))) - (if (eq org-agenda-window-setup 'other-frame) - (progn - (org-agenda-reset-markers) - (kill-buffer buf) - (org-columns-remove-overlays) - (setq org-agenda-archives-mode nil) - (delete-frame)) - (and (not (eq org-agenda-window-setup 'current-window)) - (not (one-window-p)) - (delete-window)) - (org-agenda-reset-markers) - (kill-buffer buf) - (org-columns-remove-overlays) - (setq org-agenda-archives-mode nil))) - (setq org-agenda-buffer nil) - ;; Maybe restore the pre-agenda window configuration. - (and org-agenda-restore-windows-after-quit - (not (eq org-agenda-window-setup 'other-frame)) - org-agenda-pre-window-conf - (set-window-configuration org-agenda-pre-window-conf) - (setq org-agenda-pre-window-conf nil)))) - -(defun org-agenda-quit () - "Exit the agenda and restore the window configuration. -When `org-agenda-sticky' is non-nil, only bury the agenda." - (interactive) - (if (and (eq org-indirect-buffer-display 'other-window) - org-last-indirect-buffer) - (let ((org-last-indirect-window - (get-buffer-window org-last-indirect-buffer))) - (if org-last-indirect-window - (delete-window org-last-indirect-window)))) - (if org-agenda-columns-active - (org-columns-quit) - (if org-agenda-sticky - (let ((buf (current-buffer))) - (if (eq org-agenda-window-setup 'other-frame) - (progn - (delete-frame)) - (and (not (eq org-agenda-window-setup 'current-window)) - (not (one-window-p)) - (delete-window))) - (with-current-buffer buf - (bury-buffer) - ;; Maybe restore the pre-agenda window configuration. - (and org-agenda-restore-windows-after-quit - (not (eq org-agenda-window-setup 'other-frame)) - org-agenda-pre-window-conf - (set-window-configuration org-agenda-pre-window-conf) - (setq org-agenda-pre-window-conf nil)))) - (org-agenda-Quit)))) - -(defun org-agenda-exit () - "Exit the agenda and restore the window configuration. -Also kill Org-mode buffers loaded by `org-agenda'. Org-mode -buffers visited directly by the user will not be touched." - (interactive) - (org-release-buffers org-agenda-new-buffers) - (setq org-agenda-new-buffers nil) - (org-agenda-Quit)) - -(defun org-agenda-kill-all-agenda-buffers () - "Kill all buffers in `org-agenda-mode'. -This is used when toggling sticky agendas. -You can also explicitly invoke it with `C-c a C-k'." - (interactive) - (let (blist) - (dolist (buf (buffer-list)) - (when (with-current-buffer buf (eq major-mode 'org-agenda-mode)) - (push buf blist))) - (mapc 'kill-buffer blist))) - -(defun org-agenda-execute (arg) - "Execute another agenda command, keeping same window. -So this is just a shortcut for \\`\\[org-agenda]', available -in the agenda." - (interactive "P") - (let ((org-agenda-window-setup 'current-window)) - (org-agenda arg))) - -(defun org-agenda-redo (&optional all) - "Rebuild possibly ALL agenda view(s) in the current buffer." - (interactive "P") - (let* ((p (or (and (looking-at "\\'") (1- (point))) (point))) - (cpa (unless (eq all t) current-prefix-arg)) - (org-agenda-doing-sticky-redo org-agenda-sticky) - (org-agenda-sticky nil) - (org-agenda-buffer-name (or org-agenda-this-buffer-name - org-agenda-buffer-name)) - (org-agenda-keep-modes t) - (tag-filter org-agenda-tag-filter) - (tag-preset (get 'org-agenda-tag-filter :preset-filter)) - (top-hl-filter org-agenda-top-headline-filter) - (cat-filter org-agenda-category-filter) - (cat-preset (get 'org-agenda-category-filter :preset-filter)) - (re-filter org-agenda-regexp-filter) - (re-preset (get 'org-agenda-regexp-filter :preset-filter)) - (org-agenda-tag-filter-while-redo (or tag-filter tag-preset)) - (cols org-agenda-columns-active) - (line (org-current-line)) - (window-line (- line (org-current-line (window-start)))) - (lprops (get 'org-agenda-redo-command 'org-lprops)) - (redo-cmd (get-text-property p 'org-redo-cmd)) - (last-args (get-text-property p 'org-last-args)) - (org-agenda-overriding-cmd (get-text-property p 'org-series-cmd)) - (org-agenda-overriding-cmd-arguments - (unless (eq all t) - (cond ((listp last-args) - (cons (or cpa (car last-args)) (cdr last-args))) - ((stringp last-args) - last-args)))) - (series-redo-cmd (get-text-property p 'org-series-redo-cmd))) - (put 'org-agenda-tag-filter :preset-filter nil) - (put 'org-agenda-category-filter :preset-filter nil) - (put 'org-agenda-regexp-filter :preset-filter nil) - (and cols (org-columns-quit)) - (message "Rebuilding agenda buffer...") - (if series-redo-cmd - (eval series-redo-cmd) - (org-let lprops redo-cmd)) - (setq org-agenda-undo-list nil - org-agenda-pending-undo-list nil - org-agenda-tag-filter tag-filter - org-agenda-category-filter cat-filter - org-agenda-regexp-filter re-filter - org-agenda-top-headline-filter top-hl-filter) - (message "Rebuilding agenda buffer...done") - (put 'org-agenda-tag-filter :preset-filter tag-preset) - (put 'org-agenda-category-filter :preset-filter cat-preset) - (put 'org-agenda-regexp-filter :preset-filter re-preset) - (and (or tag-filter tag-preset) (org-agenda-filter-apply tag-filter 'tag)) - (and (or cat-filter cat-preset) (org-agenda-filter-apply cat-filter 'category)) - (and (or re-filter re-preset) (org-agenda-filter-apply re-filter 'regexp)) - (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter)) - (and cols (org-called-interactively-p 'any) (org-agenda-columns)) - (org-goto-line line) - (recenter window-line))) - -(defvar org-global-tags-completion-table nil) -(defvar org-agenda-filter-form nil) -(defvar org-agenda-filtered-by-category nil) - -(defun org-agenda-filter-by-category (strip) - "Keep only those lines in the agenda buffer that have a specific category. -The category is that of the current line." - (interactive "P") - (if (and org-agenda-filtered-by-category - org-agenda-category-filter) - (org-agenda-filter-show-all-cat) - (let ((cat (org-no-properties (get-text-property (point) 'org-category)))) - (cond - ((and cat strip) - (org-agenda-filter-apply - (push (concat "-" cat) org-agenda-category-filter) 'category)) - ((and cat) - (org-agenda-filter-apply - (setq org-agenda-category-filter - (list (concat "+" cat))) 'category)) - ((error "No category at point")))))) - -(defun org-find-top-headline (&optional pos) - "Find the topmost parent headline and return it." - (save-excursion - (with-current-buffer (if pos (marker-buffer pos) (current-buffer)) - (if pos (goto-char pos)) - ;; Skip up to the topmost parent - (while (ignore-errors (outline-up-heading 1) t)) - (ignore-errors - (nth 4 (org-heading-components)))))) - -(defvar org-agenda-filtered-by-top-headline nil) -(defun org-agenda-filter-by-top-headline (strip) - "Keep only those lines that are descendants from the same top headline. -The top headline is that of the current line." - (interactive "P") - (if org-agenda-filtered-by-top-headline - (progn - (setq org-agenda-filtered-by-top-headline nil - org-agenda-top-headline-filter nil) - (org-agenda-filter-show-all-cat)) - (let ((cat (org-find-top-headline (org-get-at-bol 'org-hd-marker)))) - (if cat (org-agenda-filter-top-headline-apply cat strip) - (error "No top-level category at point"))))) - -(defvar org-agenda-regexp-filter nil) -(defun org-agenda-filter-by-regexp (strip) - "Filter agenda entries by a regular expression. -Regexp filters are cumulative. -With no prefix argument, keep entries matching the regexp. -With one prefix argument, filter out entries matching the regexp. -With two prefix arguments, remove the regexp filters." - (interactive "P") - (if (not (equal strip '(16))) - (let ((flt (concat (if (equal strip '(4)) "-" "+") - (read-from-minibuffer - (if (equal strip '(4)) - "Filter out entries matching regexp: " - "Narrow to entries matching regexp: "))))) - (push flt org-agenda-regexp-filter) - (org-agenda-filter-apply org-agenda-regexp-filter 'regexp)) - (org-agenda-filter-show-all-re) - (message "Regexp filter removed"))) - -(defun org-agenda-filter-remove-all () - "Remove all filters from the current agenda buffer." - (interactive) - (when org-agenda-tag-filter - (org-agenda-filter-show-all-tag)) - (when org-agenda-category-filter - (org-agenda-filter-show-all-cat)) - (when org-agenda-regexp-filter - (org-agenda-filter-show-all-re))) - -(defun org-agenda-filter-by-tag (strip &optional char narrow) - "Keep only those lines in the agenda buffer that have a specific tag. -The tag is selected with its fast selection letter, as configured. -With prefix argument STRIP, remove all lines that do have the tag. -A lisp caller can specify CHAR. NARROW means that the new tag should be -used to narrow the search - the interactive user can also press `-' or `+' -to switch to narrowing." - (interactive "P") - (let* ((alist org-tag-alist-for-agenda) - (tag-chars (mapconcat - (lambda (x) (if (and (not (symbolp (car x))) - (cdr x)) - (char-to-string (cdr x)) - "")) - alist "")) - (efforts (org-split-string - (or (cdr (assoc (concat org-effort-property "_ALL") - org-global-properties)) - "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00 8:00" - ""))) - (effort-op org-agenda-filter-effort-default-operator) - (effort-prompt "") - (inhibit-read-only t) - (current org-agenda-tag-filter) - maybe-refresh a n tag) - (unless char - (message - "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>==<]:effort: " tag-chars) - (setq char (read-char-exclusive))) - (when (member char '(?< ?> ?= ??)) - ;; An effort operator - (setq effort-op (char-to-string char)) - (setq alist nil) ; to make sure it will be interpreted as effort. - (unless (equal char ??) - (loop for i from 0 to 9 do - (setq effort-prompt - (concat - effort-prompt " [" - (if (= i 9) "0" (int-to-string (1+ i))) - "]" (nth i efforts)))) - (message "Effort%s: %s " effort-op effort-prompt) - (setq char (read-char-exclusive)) - (when (or (< char ?0) (> char ?9)) - (error "Need 1-9,0 to select effort")))) - (when (equal char ?\t) - (unless (local-variable-p 'org-global-tags-completion-table (current-buffer)) - (org-set-local 'org-global-tags-completion-table - (org-global-tags-completion-table))) - (let ((completion-ignore-case t)) - (setq tag (org-icompleting-read - "Tag: " org-global-tags-completion-table)))) - (cond - ((equal char ?\r) - (org-agenda-filter-show-all-tag) - (when org-agenda-auto-exclude-function - (setq org-agenda-tag-filter nil) - (dolist (tag (org-agenda-get-represented-tags)) - (let ((modifier (funcall org-agenda-auto-exclude-function tag))) - (if modifier - (push modifier org-agenda-tag-filter)))) - (if (not (null org-agenda-tag-filter)) - (org-agenda-filter-apply org-agenda-tag-filter 'tag))) - (setq maybe-refresh t)) - ((equal char ?/) - (org-agenda-filter-show-all-tag) - (when (get 'org-agenda-tag-filter :preset-filter) - (org-agenda-filter-apply org-agenda-tag-filter 'tag)) - (setq maybe-refresh t)) - ((equal char ?. ) - (setq org-agenda-tag-filter - (mapcar (lambda(tag) (concat "+" tag)) - (org-get-at-bol 'tags))) - (org-agenda-filter-apply org-agenda-tag-filter 'tag) - (setq maybe-refresh t)) - ((or (equal char ?\ ) - (setq a (rassoc char alist)) - (and (>= char ?0) (<= char ?9) - (setq n (if (= char ?0) 9 (- char ?0 1)) - tag (concat effort-op (nth n efforts)) - a (cons tag nil))) - (and (= char ??) - (setq tag "?eff") - a (cons tag nil)) - (and tag (setq a (cons tag nil)))) - (org-agenda-filter-show-all-tag) - (setq tag (car a)) - (setq org-agenda-tag-filter - (cons (concat (if strip "-" "+") tag) - (if narrow current nil))) - (org-agenda-filter-apply org-agenda-tag-filter 'tag) - (setq maybe-refresh t)) - (t (error "Invalid tag selection character %c" char))) - (when (and maybe-refresh - (eq org-agenda-clockreport-mode 'with-filter)) - (org-agenda-redo)))) - -(defun org-agenda-get-represented-tags () - "Get a list of all tags currently represented in the agenda." - (let (p tags) - (save-excursion - (goto-char (point-min)) - (while (setq p (next-single-property-change (point) 'tags)) - (goto-char p) - (mapc (lambda (x) (add-to-list 'tags x)) - (get-text-property (point) 'tags)))) - tags)) - -(defun org-agenda-filter-by-tag-refine (strip &optional char) - "Refine the current filter. See `org-agenda-filter-by-tag'." - (interactive "P") - (org-agenda-filter-by-tag strip char 'refine)) - -(defun org-agenda-filter-make-matcher (filter type) - "Create the form that tests a line for agenda filter." - (let (f f1) - (cond - ;; Tag filter - ((eq type 'tag) - (setq filter - (delete-dups - (append (get 'org-agenda-tag-filter :preset-filter) - filter))) - (dolist (x filter) - (let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1 - (ffunc - (lambda (nf0 nf01 fltr notgroup op) - (dolist (x fltr) - (if (member x '("-" "+")) - (setq nf01 (if (equal x "-") 'tags '(not tags))) - (if (string-match "[<=>?]" x) - (setq nf01 (org-agenda-filter-effort-form x)) - (setq nf01 (list 'member (downcase (substring x 1)) - 'tags))) - (when (equal (string-to-char x) ?-) - (setq nf01 (list 'not nf01)) - (when (not notgroup) (setq op 'and)))) - (push nf01 nf0)) - (if notgroup - (push (cons 'and nf0) f) - (push (cons (or op 'or) nf0) f))))) - (cond ((equal filter '("+")) - (setq f (list (list 'not 'tags)))) - ((equal nfilter filter) - (funcall ffunc f1 f filter t nil)) - (t (funcall ffunc nf1 nf nfilter nil nil)))))) - ;; Category filter - ((eq type 'category) - (setq filter - (delete-dups - (append (get 'org-agenda-category-filter :preset-filter) - filter))) - (dolist (x filter) - (if (equal "-" (substring x 0 1)) - (setq f1 (list 'not (list 'equal (substring x 1) 'cat))) - (setq f1 (list 'equal (substring x 1) 'cat))) - (push f1 f))) - ;; Regexp filter - ((eq type 'regexp) - (setq filter - (delete-dups - (append (get 'org-agenda-regexp-filter :preset-filter) - filter))) - (dolist (x filter) - (if (equal "-" (substring x 0 1)) - (setq f1 (list 'not (list 'string-match (substring x 1) 'txt))) - (setq f1 (list 'string-match (substring x 1) 'txt))) - (push f1 f)))) - (cons 'and (nreverse f)))) - -(defun org-agenda-filter-effort-form (e) - "Return the form to compare the effort of the current line with what E says. -E looks like \"+<2:25\"." - (let (op) - (setq e (substring e 1)) - (setq op (string-to-char e) e (substring e 1)) - (setq op (cond ((equal op ?<) '<=) - ((equal op ?>) '>=) - ((equal op ??) op) - (t '=))) - (list 'org-agenda-compare-effort (list 'quote op) - (org-duration-string-to-minutes e)))) - -(defun org-agenda-compare-effort (op value) - "Compare the effort of the current line with VALUE, using OP. -If the line does not have an effort defined, return nil." - (let ((eff (org-get-at-bol 'effort-minutes))) - (if (equal op ??) - (not eff) - (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0)) - value)))) - -(defun org-agenda-filter-expand-tags (filter &optional no-operator) - "Expand group tags in FILTER for the agenda. -When NO-OPERATOR is non-nil, do not add the + operator to returned tags." - (if org-group-tags - (let ((case-fold-search t) rtn) - (mapc - (lambda (f) - (let (f0 dir) - (if (string-match "^\\([+-]\\)\\(.+\\)" f) - (setq dir (match-string 1 f) f0 (match-string 2 f)) - (setq dir (if no-operator "" "+") f0 f)) - (setq rtn (append (mapcar (lambda(f1) (concat dir f1)) - (org-tags-expand f0 t t)) - rtn)))) - filter) - (reverse rtn)) - filter)) - -(defun org-agenda-filter-apply (filter type) - "Set FILTER as the new agenda filter and apply it." - ;; Deactivate `org-agenda-entry-text-mode' when filtering - (if org-agenda-entry-text-mode (org-agenda-entry-text-mode)) - (let (tags cat txt) - (setq org-agenda-filter-form - (org-agenda-filter-make-matcher filter type)) - (if (and (eq type 'category) - (not (equal (substring (car filter) 0 1) "-"))) - ;; Only set `org-agenda-filtered-by-category' to t - ;; when a unique category is used as the filter - (setq org-agenda-filtered-by-category t)) - (org-agenda-set-mode-name) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (if (org-get-at-bol 'org-marker) - (progn - (setq tags ; used in eval - (apply 'append - (mapcar (lambda (f) - (org-agenda-filter-expand-tags (list f) t)) - (org-get-at-bol 'tags))) - cat (get-text-property (point) 'org-category) - txt (get-text-property (point) 'txt)) - (if (not (eval org-agenda-filter-form)) - (org-agenda-filter-hide-line type)) - (beginning-of-line 2)) - (beginning-of-line 2)))) - (if (get-char-property (point) 'invisible) - (ignore-errors (org-agenda-previous-line))))) - -(defun org-agenda-filter-top-headline-apply (hl &optional negative) - "Filter by top headline HL." - (org-agenda-set-mode-name) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (let* ((pos (org-get-at-bol 'org-hd-marker)) - (tophl (and pos (org-find-top-headline pos)))) - (if (and tophl (funcall (if negative 'identity 'not) - (string= hl tophl))) - (org-agenda-filter-hide-line 'category))) - (beginning-of-line 2))) - (if (get-char-property (point) 'invisible) - (org-agenda-previous-line)) - (setq org-agenda-top-headline-filter hl - org-agenda-filtered-by-top-headline t)) - -(defun org-agenda-filter-hide-line (type) - "Hide lines with TYPE in the agenda buffer." - (let (ov) - (setq ov (make-overlay (max (point-min) (1- (point-at-bol))) - (point-at-eol))) - (overlay-put ov 'invisible t) - (overlay-put ov 'type type) - (cond ((eq type 'tag) (push ov org-agenda-tag-filter-overlays)) - ((eq type 'category) (push ov org-agenda-cat-filter-overlays)) - ((eq type 'regexp) (push ov org-agenda-re-filter-overlays))))) - -(defun org-agenda-fix-tags-filter-overlays-at (&optional pos) - (setq pos (or pos (point))) - (save-excursion - (dolist (ov (overlays-at pos)) - (when (and (overlay-get ov 'invisible) - (eq (overlay-get ov 'type) 'tag)) - (goto-char pos) - (if (< (overlay-start ov) (point-at-eol)) - (move-overlay ov (point-at-eol) - (overlay-end ov))))))) - -(defun org-agenda-filter-show-all-tag nil - "Remove tag filter overlays from the agenda buffer." - (mapc 'delete-overlay org-agenda-tag-filter-overlays) - (setq org-agenda-tag-filter-overlays nil - org-agenda-tag-filter nil - org-agenda-filter-form nil) - (org-agenda-set-mode-name)) - -(defun org-agenda-filter-show-all-re nil - "Remove regexp filter overlays from the agenda buffer." - (mapc 'delete-overlay org-agenda-re-filter-overlays) - (setq org-agenda-re-filter-overlays nil - org-agenda-regexp-filter nil - org-agenda-filter-form nil) - (org-agenda-set-mode-name)) - -(defun org-agenda-filter-show-all-cat nil - "Remove category filter overlays from the agenda buffer." - (mapc 'delete-overlay org-agenda-cat-filter-overlays) - (setq org-agenda-cat-filter-overlays nil - org-agenda-filtered-by-category nil - org-agenda-category-filter nil - org-agenda-filter-form nil) - (org-agenda-set-mode-name)) - -(defun org-agenda-manipulate-query-add () - "Manipulate the query by adding a search term with positive selection. -Positive selection means the term must be matched for selection of an entry." - (interactive) - (org-agenda-manipulate-query ?\[)) -(defun org-agenda-manipulate-query-subtract () - "Manipulate the query by adding a search term with negative selection. -Negative selection means term must not be matched for selection of an entry." - (interactive) - (org-agenda-manipulate-query ?\])) -(defun org-agenda-manipulate-query-add-re () - "Manipulate the query by adding a search regexp with positive selection. -Positive selection means the regexp must match for selection of an entry." - (interactive) - (org-agenda-manipulate-query ?\{)) -(defun org-agenda-manipulate-query-subtract-re () - "Manipulate the query by adding a search regexp with negative selection. -Negative selection means regexp must not match for selection of an entry." - (interactive) - (org-agenda-manipulate-query ?\})) -(defun org-agenda-manipulate-query (char) - (cond - ((memq org-agenda-type '(timeline agenda)) - (let ((org-agenda-include-inactive-timestamps t)) - (org-agenda-redo)) - (message "Display now includes inactive timestamps as well")) - ((eq org-agenda-type 'search) - (org-add-to-string - 'org-agenda-query-string - (if org-agenda-last-search-view-search-was-boolean - (cdr (assoc char '((?\[ . " +") (?\] . " -") - (?\{ . " +{}") (?\} . " -{}")))) - " ")) - (setq org-agenda-redo-command - (list 'org-search-view - (car (get-text-property (min (1- (point-max)) (point)) - 'org-last-args)) - org-agenda-query-string - (+ (length org-agenda-query-string) - (if (member char '(?\{ ?\})) 0 1)))) - (set-register org-agenda-query-register org-agenda-query-string) - (let ((org-agenda-overriding-arguments - (cdr org-agenda-redo-command))) - (org-agenda-redo))) - (t (error "Cannot manipulate query for %s-type agenda buffers" - org-agenda-type)))) - -(defun org-add-to-string (var string) - (set var (concat (symbol-value var) string))) - -(defun org-agenda-goto-date (span) - "Jump to DATE in agenda." - (interactive "P") - (let* ((org-read-date-prefer-future - (eval org-agenda-jump-prefer-future)) - (date (org-read-date)) - (day (time-to-days (org-time-string-to-time date))) - (org-agenda-sticky-orig org-agenda-sticky) - (org-agenda-buffer-tmp-name (buffer-name)) - (args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) - (0-arg (or current-prefix-arg (car args))) - (2-arg (nth 2 args)) - (with-hour-p (nth 4 org-agenda-redo-command)) - (newcmd (list 'org-agenda-list 0-arg date - (org-agenda-span-to-ndays - 2-arg (org-time-string-to-absolute date)) - with-hour-p)) - (newargs (cdr newcmd)) - (inhibit-read-only t) - org-agenda-sticky) - (if (not (org-agenda-check-type t 'agenda)) - (error "Not available in non-agenda views") - (add-text-properties (point-min) (point-max) - `(org-redo-cmd ,newcmd org-last-args ,newargs)) - (org-agenda-redo) - (goto-char (point-min)) - (while (not (or (= (or (get-text-property (point) 'day) 0) day) - (save-excursion (move-beginning-of-line 2) (eobp)))) - (move-beginning-of-line 2)) - (setq org-agenda-sticky org-agenda-sticky-orig - org-agenda-this-buffer-is-sticky org-agenda-sticky)))) - -(defun org-agenda-goto-today () - "Go to today." - (interactive) - (org-agenda-check-type t 'timeline 'agenda) - (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) - (curspan (nth 2 args)) - (tdpos (text-property-any (point-min) (point-max) 'org-today t))) - (cond - (tdpos (goto-char tdpos)) - ((eq org-agenda-type 'agenda) - (let* ((sd (org-agenda-compute-starting-span - (org-today) (or curspan org-agenda-ndays org-agenda-span))) - (org-agenda-overriding-arguments args)) - (setf (nth 1 org-agenda-overriding-arguments) sd) - (org-agenda-redo) - (org-agenda-find-same-or-today-or-agenda))) - (t (error "Cannot find today"))))) - -(defun org-agenda-find-same-or-today-or-agenda (&optional cnt) - (goto-char - (or (and cnt (text-property-any (point-min) (point-max) 'org-day-cnt cnt)) - (text-property-any (point-min) (point-max) 'org-today t) - (text-property-any (point-min) (point-max) 'org-agenda-type 'agenda) - (and (get-text-property (min (1- (point-max)) (point)) 'org-series) - (org-agenda-goto-block-beginning)) - (point-min)))) - -(defun org-agenda-goto-block-beginning () - "Go the agenda block beginning." - (interactive) - (if (not (derived-mode-p 'org-agenda-mode)) - (error "Cannot execute this command outside of org-agenda-mode buffers") - (let (dest) - (save-excursion - (unless (looking-at "\\'") - (forward-char)) - (let* ((prop 'org-agenda-structural-header) - (p (previous-single-property-change (point) prop)) - (n (next-single-property-change (or (and (looking-at "\\`") 1) - (1- (point))) prop))) - (setq dest (cond ((eq n (point-at-eol)) (1- n)) (p (1- p)))))) - (if (not dest) - (error "Cannot find the beginning of the blog") - (goto-char dest) - (move-beginning-of-line 1))))) - -(defun org-agenda-later (arg) - "Go forward in time by the current span. -With prefix ARG, go forward that many times the current span." - (interactive "p") - (org-agenda-check-type t 'agenda) - (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) - (span (or (nth 2 args) org-agenda-current-span)) - (sd (or (nth 1 args) (org-get-at-bol 'day) org-starting-day)) - (greg (calendar-gregorian-from-absolute sd)) - (cnt (org-get-at-bol 'org-day-cnt)) - greg2) - (cond - ((numberp span) - (setq sd (+ (* span arg) sd))) - ((eq span 'day) - (setq sd (+ arg sd))) - ((eq span 'week) - (setq sd (+ (* 7 arg) sd))) - ((eq span 'fortnight) - (setq sd (+ (* 14 arg) sd))) - ((eq span 'month) - (setq greg2 (list (+ (car greg) arg) (nth 1 greg) (nth 2 greg)) - sd (calendar-absolute-from-gregorian greg2)) - (setcar greg2 (1+ (car greg2)))) - ((eq span 'year) - (setq greg2 (list (car greg) (nth 1 greg) (+ arg (nth 2 greg))) - sd (calendar-absolute-from-gregorian greg2)) - (setcar (nthcdr 2 greg2) (1+ (nth 2 greg2)))) - (t - (setq sd (+ (* span arg) sd)))) - (let ((org-agenda-overriding-cmd - ;; `cmd' may have been set by `org-agenda-run-series' which - ;; uses `org-agenda-overriding-cmd' to decide whether - ;; overriding is allowed for `cmd' - (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd)) - (org-agenda-overriding-arguments - (list (car args) sd span))) - (org-agenda-redo) - (org-agenda-find-same-or-today-or-agenda cnt)))) - -(defun org-agenda-earlier (arg) - "Go backward in time by the current span. -With prefix ARG, go backward that many times the current span." - (interactive "p") - (org-agenda-later (- arg))) - -(defun org-agenda-view-mode-dispatch () - "Call one of the view mode commands." - (interactive) - (message "View: [d]ay [w]eek for[t]night [m]onth [y]ear [SPC]reset [q]uit/abort - time[G]rid [[]inactive [f]ollow [l]og [L]og-all [c]lockcheck - [a]rch-trees [A]rch-files clock[R]eport include[D]iary [E]ntryText") - (let ((a (read-char-exclusive))) - (case a - (?\ (call-interactively 'org-agenda-reset-view)) - (?d (call-interactively 'org-agenda-day-view)) - (?w (call-interactively 'org-agenda-week-view)) - (?t (call-interactively 'org-agenda-fortnight-view)) - (?m (call-interactively 'org-agenda-month-view)) - (?y (call-interactively 'org-agenda-year-view)) - (?l (call-interactively 'org-agenda-log-mode)) - (?L (org-agenda-log-mode '(4))) - (?c (org-agenda-log-mode 'clockcheck)) - ((?F ?f) (call-interactively 'org-agenda-follow-mode)) - (?a (call-interactively 'org-agenda-archives-mode)) - (?A (org-agenda-archives-mode 'files)) - ((?R ?r) (call-interactively 'org-agenda-clockreport-mode)) - ((?E ?e) (call-interactively 'org-agenda-entry-text-mode)) - (?G (call-interactively 'org-agenda-toggle-time-grid)) - (?D (call-interactively 'org-agenda-toggle-diary)) - (?\! (call-interactively 'org-agenda-toggle-deadlines)) - (?\[ (let ((org-agenda-include-inactive-timestamps t)) - (org-agenda-check-type t 'timeline 'agenda) - (org-agenda-redo)) - (message "Display now includes inactive timestamps as well")) - (?q (message "Abort")) - (otherwise (error "Invalid key" ))))) - -(defun org-agenda-reset-view () - "Switch to default view for agenda." - (interactive) - (org-agenda-change-time-span (or org-agenda-ndays org-agenda-span))) -(defun org-agenda-day-view (&optional day-of-month) - "Switch to daily view for agenda. -With argument DAY-OF-MONTH, switch to that day of the month." - (interactive "P") - (org-agenda-change-time-span 'day day-of-month)) -(defun org-agenda-week-view (&optional iso-week) - "Switch to daily view for agenda. -With argument ISO-WEEK, switch to the corresponding ISO week. -If ISO-WEEK has more then 2 digits, only the last two encode the -week. Any digits before this encode a year. So 200712 means -week 12 of year 2007. Years in the range 1938-2037 can also be -written as 2-digit years." - (interactive "P") - (org-agenda-change-time-span 'week iso-week)) -(defun org-agenda-fortnight-view (&optional iso-week) - "Switch to daily view for agenda. -With argument ISO-WEEK, switch to the corresponding ISO week. -If ISO-WEEK has more then 2 digits, only the last two encode the -week. Any digits before this encode a year. So 200712 means -week 12 of year 2007. Years in the range 1938-2037 can also be -written as 2-digit years." - (interactive "P") - (org-agenda-change-time-span 'fortnight iso-week)) -(defun org-agenda-month-view (&optional month) - "Switch to monthly view for agenda. -With argument MONTH, switch to that month." - (interactive "P") - (org-agenda-change-time-span 'month month)) -(defun org-agenda-year-view (&optional year) - "Switch to yearly view for agenda. -With argument YEAR, switch to that year. -If MONTH has more then 2 digits, only the last two encode the -month. Any digits before this encode a year. So 200712 means -December year 2007. Years in the range 1938-2037 can also be -written as 2-digit years." - (interactive "P") - (when year - (setq year (org-small-year-to-year year))) - (if (y-or-n-p "Are you sure you want to compute the agenda for an entire year? ") - (org-agenda-change-time-span 'year year) - (error "Abort"))) - -(defun org-agenda-change-time-span (span &optional n) - "Change the agenda view to SPAN. -SPAN may be `day', `week', `fortnight', `month', `year'." - (org-agenda-check-type t 'agenda) - (let* ((args (get-text-property (min (1- (point-max)) (point)) 'org-last-args)) - (curspan (nth 2 args))) - (if (and (not n) (equal curspan span)) - (error "Viewing span is already \"%s\"" span)) - (let* ((sd (or (org-get-at-bol 'day) - (nth 1 args) - org-starting-day)) - (sd (org-agenda-compute-starting-span sd span n)) - (org-agenda-overriding-cmd - (get-text-property (min (1- (point-max)) (point)) 'org-series-cmd)) - (org-agenda-overriding-arguments - (list (car args) sd span))) - (org-agenda-redo) - (org-agenda-find-same-or-today-or-agenda)) - (org-agenda-set-mode-name) - (message "Switched to %s view" span))) - -(defun org-agenda-compute-starting-span (sd span &optional n) - "Compute starting date for agenda. -SPAN may be `day', `week', `fortnight', `month', `year'. The return value -is a cons cell with the starting date and the number of days, -so that the date SD will be in that range." - (let* ((greg (calendar-gregorian-from-absolute sd)) - (dg (nth 1 greg)) - (mg (car greg)) - (yg (nth 2 greg))) - (cond - ((eq span 'day) - (when n - (setq sd (+ (calendar-absolute-from-gregorian - (list mg 1 yg)) - n -1)))) - ((or (eq span 'week) (eq span 'fortnight)) - (let* ((nt (calendar-day-of-week - (calendar-gregorian-from-absolute sd))) - (d (if org-agenda-start-on-weekday - (- nt org-agenda-start-on-weekday) - 0)) - y1) - (setq sd (- sd (+ (if (< d 0) 7 0) d))) - (when n - (require 'cal-iso) - (when (> n 99) - (setq y1 (org-small-year-to-year (/ n 100)) - n (mod n 100))) - (setq sd - (calendar-absolute-from-iso - (list n 1 - (or y1 (nth 2 (calendar-iso-from-absolute sd))))))))) - ((eq span 'month) - (let (y1) - (when (and n (> n 99)) - (setq y1 (org-small-year-to-year (/ n 100)) - n (mod n 100))) - (setq sd (calendar-absolute-from-gregorian - (list (or n mg) 1 (or y1 yg)))))) - ((eq span 'year) - (setq sd (calendar-absolute-from-gregorian - (list 1 1 (or n yg)))))) - sd)) - -(defun org-agenda-next-date-line (&optional arg) - "Jump to the next line indicating a date in agenda buffer." - (interactive "p") - (org-agenda-check-type t 'agenda 'timeline) - (beginning-of-line 1) - ;; This does not work if user makes date format that starts with a blank - (if (looking-at "^\\S-") (forward-char 1)) - (if (not (re-search-forward "^\\S-" nil t arg)) - (progn - (backward-char 1) - (error "No next date after this line in this buffer"))) - (goto-char (match-beginning 0))) - -(defun org-agenda-previous-date-line (&optional arg) - "Jump to the previous line indicating a date in agenda buffer." - (interactive "p") - (org-agenda-check-type t 'agenda 'timeline) - (beginning-of-line 1) - (if (not (re-search-backward "^\\S-" nil t arg)) - (error "No previous date before this line in this buffer"))) - -;; Initialize the highlight -(defvar org-hl (make-overlay 1 1)) -(overlay-put org-hl 'face 'highlight) - -(defun org-highlight (begin end &optional buffer) - "Highlight a region with overlay." - (move-overlay org-hl begin end (or buffer (current-buffer)))) - -(defun org-unhighlight () - "Detach overlay INDEX." - (org-detach-overlay org-hl)) - -(defun org-unhighlight-once () - "Remove the highlight from its position, and this function from the hook." - (remove-hook 'pre-command-hook 'org-unhighlight-once) - (org-unhighlight)) - -(defvar org-agenda-pre-follow-window-conf nil) -(defun org-agenda-follow-mode () - "Toggle follow mode in an agenda buffer." - (interactive) - (unless org-agenda-follow-mode - (setq org-agenda-pre-follow-window-conf - (current-window-configuration))) - (setq org-agenda-follow-mode (not org-agenda-follow-mode)) - (unless org-agenda-follow-mode - (set-window-configuration org-agenda-pre-follow-window-conf)) - (org-agenda-set-mode-name) - (org-agenda-do-context-action) - (message "Follow mode is %s" - (if org-agenda-follow-mode "on" "off"))) - -(defun org-agenda-entry-text-mode (&optional arg) - "Toggle entry text mode in an agenda buffer." - (interactive "P") - (if (or org-agenda-tag-filter - org-agenda-category-filter - org-agenda-regexp-filter - org-agenda-top-headline-filter) - (user-error "Can't show entry text in filtered views") - (setq org-agenda-entry-text-mode (or (integerp arg) - (not org-agenda-entry-text-mode))) - (org-agenda-entry-text-hide) - (and org-agenda-entry-text-mode - (let ((org-agenda-entry-text-maxlines - (if (integerp arg) arg org-agenda-entry-text-maxlines))) - (org-agenda-entry-text-show))) - (org-agenda-set-mode-name) - (message "Entry text mode is %s%s" - (if org-agenda-entry-text-mode "on" "off") - (if (not org-agenda-entry-text-mode) "" - (format " (maximum number of lines is %d)" - (if (integerp arg) arg org-agenda-entry-text-maxlines)))))) - -(defun org-agenda-clockreport-mode (&optional with-filter) - "Toggle clocktable mode in an agenda buffer. -With prefix arg WITH-FILTER, make the clocktable respect the current -agenda filter." - (interactive "P") - (org-agenda-check-type t 'agenda) - (if with-filter - (setq org-agenda-clockreport-mode 'with-filter) - (setq org-agenda-clockreport-mode (not org-agenda-clockreport-mode))) - (org-agenda-set-mode-name) - (org-agenda-redo) - (message "Clocktable mode is %s" - (if org-agenda-clockreport-mode "on" "off"))) - -(defun org-agenda-log-mode (&optional special) - "Toggle log mode in an agenda buffer. -With argument SPECIAL, show all possible log items, not only the ones -configured in `org-agenda-log-mode-items'. -With a double `C-u' prefix arg, show *only* log items, nothing else." - (interactive "P") - (org-agenda-check-type t 'agenda 'timeline) - (setq org-agenda-show-log - (cond - ((equal special '(16)) 'only) - ((eq special 'clockcheck) - (if (eq org-agenda-show-log 'clockcheck) - nil 'clockcheck)) - (special '(closed clock state)) - (t (not org-agenda-show-log)))) - (org-agenda-set-mode-name) - (org-agenda-redo) - (message "Log mode is %s" - (if org-agenda-show-log "on" "off"))) - -(defun org-agenda-archives-mode (&optional with-files) - "Toggle inclusion of items in trees marked with :ARCHIVE:. -When called with a prefix argument, include all archive files as well." - (interactive "P") - (setq org-agenda-archives-mode - (if with-files t (if org-agenda-archives-mode nil 'trees))) - (org-agenda-set-mode-name) - (org-agenda-redo) - (message - "%s" - (cond - ((eq org-agenda-archives-mode nil) - "No archives are included") - ((eq org-agenda-archives-mode 'trees) - (format "Trees with :%s: tag are included" org-archive-tag)) - ((eq org-agenda-archives-mode t) - (format "Trees with :%s: tag and all active archive files are included" - org-archive-tag))))) - -(defun org-agenda-toggle-diary () - "Toggle diary inclusion in an agenda buffer." - (interactive) - (org-agenda-check-type t 'agenda) - (setq org-agenda-include-diary (not org-agenda-include-diary)) - (org-agenda-redo) - (org-agenda-set-mode-name) - (message "Diary inclusion turned %s" - (if org-agenda-include-diary "on" "off"))) - -(defun org-agenda-toggle-deadlines () - "Toggle inclusion of entries with a deadline in an agenda buffer." - (interactive) - (org-agenda-check-type t 'agenda) - (setq org-agenda-include-deadlines (not org-agenda-include-deadlines)) - (org-agenda-redo) - (org-agenda-set-mode-name) - (message "Deadlines inclusion turned %s" - (if org-agenda-include-deadlines "on" "off"))) - -(defun org-agenda-toggle-time-grid () - "Toggle time grid in an agenda buffer." - (interactive) - (org-agenda-check-type t 'agenda) - (setq org-agenda-use-time-grid (not org-agenda-use-time-grid)) - (org-agenda-redo) - (org-agenda-set-mode-name) - (message "Time-grid turned %s" - (if org-agenda-use-time-grid "on" "off"))) - -(defun org-agenda-set-mode-name () - "Set the mode name to indicate all the small mode settings." - (setq mode-name - (list "Org-Agenda" - (if (get 'org-agenda-files 'org-restrict) " []" "") - " " - '(:eval (org-agenda-span-name org-agenda-current-span)) - (if org-agenda-follow-mode " Follow" "") - (if org-agenda-entry-text-mode " ETxt" "") - (if org-agenda-include-diary " Diary" "") - (if org-agenda-include-deadlines " Ddl" "") - (if org-agenda-use-time-grid " Grid" "") - (if (and (boundp 'org-habit-show-habits) - org-habit-show-habits) " Habit" "") - (cond - ((consp org-agenda-show-log) " LogAll") - ((eq org-agenda-show-log 'clockcheck) " ClkCk") - (org-agenda-show-log " Log") - (t "")) - (if (or org-agenda-category-filter - (get 'org-agenda-category-filter :preset-filter)) - '(:eval (org-propertize - (concat " <" - (mapconcat - 'identity - (append - (get 'org-agenda-category-filter :preset-filter) - org-agenda-category-filter) - "") - ">") - 'face 'org-agenda-filter-category - 'help-echo "Category used in filtering")) "") - (if (or org-agenda-tag-filter - (get 'org-agenda-tag-filter :preset-filter)) - '(:eval (org-propertize - (concat " {" - (mapconcat - 'identity - (append - (get 'org-agenda-tag-filter :preset-filter) - org-agenda-tag-filter) - "") - "}") - 'face 'org-agenda-filter-tags - 'help-echo "Tags used in filtering")) "") - (if (or org-agenda-regexp-filter - (get 'org-agenda-regexp-filter :preset-filter)) - '(:eval (org-propertize - (concat " [" - (mapconcat - 'identity - (append - (get 'org-agenda-regexp-filter :preset-filter) - org-agenda-regexp-filter) - "") - "]") - 'face 'org-agenda-filter-regexp - 'help-echo "Regexp used in filtering")) "") - (if org-agenda-archives-mode - (if (eq org-agenda-archives-mode t) - " Archives" - (format " :%s:" org-archive-tag)) - "") - (if org-agenda-clockreport-mode - (if (eq org-agenda-clockreport-mode 'with-filter) - " Clock{}" " Clock") - ""))) - (force-mode-line-update)) - -(define-obsolete-function-alias - 'org-agenda-post-command-hook 'org-agenda-update-agenda-type "24.3") - -(defun org-agenda-update-agenda-type () - "Update the agenda type after each command." - (setq org-agenda-type - (or (get-text-property (point) 'org-agenda-type) - (get-text-property (max (point-min) (1- (point))) 'org-agenda-type)))) - -(defun org-agenda-next-line () - "Move cursor to the next line, and show if follow mode is active." - (interactive) - (call-interactively 'next-line) - (org-agenda-do-context-action)) - -(defun org-agenda-previous-line () - "Move cursor to the previous line, and show if follow-mode is active." - (interactive) - (call-interactively 'previous-line) - (org-agenda-do-context-action)) - -(defun org-agenda-next-item (n) - "Move cursor to next agenda item." - (interactive "p") - (let ((col (current-column))) - (dotimes (c n) - (when (next-single-property-change (point-at-eol) 'org-marker) - (move-end-of-line 1) - (goto-char (next-single-property-change (point) 'org-marker)))) - (org-move-to-column col)) - (org-agenda-do-context-action)) - -(defun org-agenda-previous-item (n) - "Move cursor to next agenda item." - (interactive "p") - (dotimes (c n) - (let ((col (current-column)) - (goto (save-excursion - (move-end-of-line 0) - (previous-single-property-change (point) 'org-marker)))) - (if goto (goto-char goto)) - (org-move-to-column col))) - (org-agenda-do-context-action)) - -(defun org-agenda-do-context-action () - "Show outline path and, maybe, follow mode window." - (let ((m (org-get-at-bol 'org-marker))) - (when (and (markerp m) (marker-buffer m)) - (and org-agenda-follow-mode - (if org-agenda-follow-indirect - (org-agenda-tree-to-indirect-buffer nil) - (org-agenda-show))) - (and org-agenda-show-outline-path - (org-with-point-at m (org-display-outline-path t)))))) - -(defun org-agenda-show-tags () - "Show the tags applicable to the current item." - (interactive) - (let* ((tags (org-get-at-bol 'tags))) - (if tags - (message "Tags are :%s:" - (org-no-properties (mapconcat 'identity tags ":"))) - (message "No tags associated with this line")))) - -(defun org-agenda-goto (&optional highlight) - "Go to the Org-mode file which contains the item at point." - (interactive) - (let* ((marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker))) - (switch-to-buffer-other-window buffer) - (widen) - (push-mark) - (goto-char pos) - (when (derived-mode-p 'org-mode) - (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil)))) ; show the next heading - (when (outline-invisible-p) - (show-entry)) ; display invisible text - (recenter (/ (window-height) 2)) - (run-hooks 'org-agenda-after-show-hook) - (and highlight (org-highlight (point-at-bol) (point-at-eol))))) - -(defvar org-agenda-after-show-hook nil - "Normal hook run after an item has been shown from the agenda. -Point is in the buffer where the item originated.") - -(defun org-agenda-kill () - "Kill the entry or subtree belonging to the current agenda entry." - (interactive) - (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) - (let* ((bufname-orig (buffer-name)) - (marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker)) - (type (org-get-at-bol 'type)) - dbeg dend (n 0) conf) - (org-with-remote-undo buffer - (with-current-buffer buffer - (save-excursion - (goto-char pos) - (if (and (derived-mode-p 'org-mode) (not (member type '("sexp")))) - (setq dbeg (progn (org-back-to-heading t) (point)) - dend (org-end-of-subtree t t)) - (setq dbeg (point-at-bol) - dend (min (point-max) (1+ (point-at-eol))))) - (goto-char dbeg) - (while (re-search-forward "^[ \t]*\\S-" dend t) (setq n (1+ n))))) - (setq conf (or (eq t org-agenda-confirm-kill) - (and (numberp org-agenda-confirm-kill) - (> n org-agenda-confirm-kill)))) - (and conf - (not (y-or-n-p - (format "Delete entry with %d lines in buffer \"%s\"? " - n (buffer-name buffer)))) - (error "Abort")) - (let ((org-agenda-buffer-name bufname-orig)) - (org-remove-subtree-entries-from-agenda buffer dbeg dend)) - (with-current-buffer buffer (delete-region dbeg dend)) - (message "Agenda item and source killed")))) - -(defvar org-archive-default-command) ; defined in org-archive.el -(defun org-agenda-archive-default () - "Archive the entry or subtree belonging to the current agenda entry." - (interactive) - (require 'org-archive) - (org-agenda-archive-with org-archive-default-command)) - -(defun org-agenda-archive-default-with-confirmation () - "Archive the entry or subtree belonging to the current agenda entry." - (interactive) - (require 'org-archive) - (org-agenda-archive-with org-archive-default-command 'confirm)) - -(defun org-agenda-archive () - "Archive the entry or subtree belonging to the current agenda entry." - (interactive) - (org-agenda-archive-with 'org-archive-subtree)) - -(defun org-agenda-archive-to-archive-sibling () - "Move the entry to the archive sibling." - (interactive) - (org-agenda-archive-with 'org-archive-to-archive-sibling)) - -(defun org-agenda-archive-with (cmd &optional confirm) - "Move the entry to the archive sibling." - (interactive) - (or (eq major-mode 'org-agenda-mode) (error "Not in agenda")) - (let* ((bufname-orig (buffer-name)) - (marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker))) - (org-with-remote-undo buffer - (with-current-buffer buffer - (if (derived-mode-p 'org-mode) - (if (and confirm - (not (y-or-n-p "Archive this subtree or entry? "))) - (error "Abort") - (save-window-excursion - (goto-char pos) - (let ((org-agenda-buffer-name bufname-orig)) - (org-remove-subtree-entries-from-agenda)) - (org-back-to-heading t) - (funcall cmd))) - (error "Archiving works only in Org-mode files")))))) - -(defun org-remove-subtree-entries-from-agenda (&optional buf beg end) - "Remove all lines in the agenda that correspond to a given subtree. -The subtree is the one in buffer BUF, starting at BEG and ending at END. -If this information is not given, the function uses the tree at point." - (let ((buf (or buf (current-buffer))) m p) - (save-excursion - (unless (and beg end) - (org-back-to-heading t) - (setq beg (point)) - (org-end-of-subtree t) - (setq end (point))) - (set-buffer (get-buffer org-agenda-buffer-name)) - (save-excursion - (goto-char (point-max)) - (beginning-of-line 1) - (while (not (bobp)) - (when (and (setq m (org-get-at-bol 'org-marker)) - (equal buf (marker-buffer m)) - (setq p (marker-position m)) - (>= p beg) - (< p end)) - (let ((inhibit-read-only t)) - (delete-region (point-at-bol) (1+ (point-at-eol))))) - (beginning-of-line 0)))))) - -(defun org-agenda-refile (&optional goto rfloc no-update) - "Refile the item at point. - -When GOTO is 0 or '(64), clear the refile cache. -When GOTO is '(16), go to the location of the last refiled item. -RFLOC can be a refile location obtained in a different way. -When NO-UPDATE is non-nil, don't redo the agenda buffer." - (interactive "P") - (cond - ((member goto '(0 (64))) - (org-refile-cache-clear)) - ((equal goto '(16)) - (org-refile-goto-last-stored)) - (t - (let* ((buffer-orig (buffer-name)) - (marker (or (org-get-at-bol 'org-hd-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker)) - (rfloc (or rfloc - (org-refile-get-location - (if goto "Goto" "Refile to") buffer - org-refile-allow-creating-parent-nodes)))) - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char marker) - (let ((org-agenda-buffer-name buffer-orig)) - (org-remove-subtree-entries-from-agenda)) - (org-refile goto buffer rfloc))))) - (unless no-update (org-agenda-redo))))) - -(defun org-agenda-open-link (&optional arg) - "Open the link(s) in the current entry, if any. -This looks for a link in the displayed line in the agenda. -It also looks at the text of the entry itself." - (interactive "P") - (let* ((marker (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker))) - (buffer (and marker (marker-buffer marker))) - (prefix (buffer-substring (point-at-bol) (point-at-eol))) - (lkall (org-offer-links-in-entry buffer marker arg prefix)) - (lk0 (car lkall)) - (lk (if (stringp lk0) (list lk0) lk0)) - (lkend (cdr lkall)) - trg) - (cond - ((and buffer lk) - (mapcar (lambda(l) - (with-current-buffer buffer - (setq trg (and (string-match org-bracket-link-regexp l) - (match-string 1 l))) - (if (or (not trg) (string-match org-any-link-re trg)) - (save-excursion - (save-restriction - (widen) - (goto-char marker) - (when (search-forward l nil lkend) - (goto-char (match-beginning 0)) - (org-open-at-point)))) - ;; This is an internal link, widen the buffer - (switch-to-buffer-other-window buffer) - (widen) - (goto-char marker) - (when (search-forward l nil lkend) - (goto-char (match-beginning 0)) - (org-open-at-point))))) - lk)) - ((or (org-in-regexp (concat "\\(" org-bracket-link-regexp "\\)")) - (save-excursion - (beginning-of-line 1) - (looking-at (concat ".*?\\(" org-bracket-link-regexp "\\)")))) - (org-open-link-from-string (match-string 1))) - (t (message "No link to open here"))))) - -(defun org-agenda-copy-local-variable (var) - "Get a variable from a referenced buffer and install it here." - (let ((m (org-get-at-bol 'org-marker))) - (when (and m (buffer-live-p (marker-buffer m))) - (org-set-local var (with-current-buffer (marker-buffer m) - (symbol-value var)))))) - -(defun org-agenda-switch-to (&optional delete-other-windows) - "Go to the Org-mode file which contains the item at point." - (interactive) - (if (and org-return-follows-link - (not (org-get-at-bol 'org-marker)) - (org-in-regexp org-bracket-link-regexp)) - (org-open-link-from-string (match-string 0)) - (let* ((marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker))) - (org-pop-to-buffer-same-window buffer) - (and delete-other-windows (delete-other-windows)) - (widen) - (goto-char pos) - (when (derived-mode-p 'org-mode) - (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (when (outline-invisible-p) - (show-entry)) ; display invisible text - (run-hooks 'org-agenda-after-show-hook))))) - -(defun org-agenda-goto-mouse (ev) - "Go to the Org-mode file which contains the item at the mouse click." - (interactive "e") - (mouse-set-point ev) - (org-agenda-goto)) - -(defun org-agenda-show (&optional full-entry) - "Display the Org-mode file which contains the item at point. -With prefix argument FULL-ENTRY, make the entire entry visible -if it was hidden in the outline." - (interactive "P") - (let ((win (selected-window))) - (if full-entry - (let ((org-show-entry-below t)) - (org-agenda-goto t)) - (org-agenda-goto t)) - (select-window win))) - -(defvar org-agenda-show-window nil) -(defun org-agenda-show-and-scroll-up (&optional arg) - "Display the Org-mode file which contains the item at point. -When called repeatedly, scroll the window that is displaying the buffer. -With a \\[universal-argument] prefix, use `org-show-entry' instead of -`show-subtree' to display the item, so that drawers and logbooks stay -folded." - (interactive "P") - (let ((win (selected-window))) - (if (and (window-live-p org-agenda-show-window) - (eq this-command last-command)) - (progn - (select-window org-agenda-show-window) - (ignore-errors (scroll-up))) - (org-agenda-goto t) - (if arg (org-show-entry) (show-subtree)) - (setq org-agenda-show-window (selected-window))) - (select-window win))) - -(defun org-agenda-show-scroll-down () - "Scroll down the window showing the agenda." - (interactive) - (let ((win (selected-window))) - (when (window-live-p org-agenda-show-window) - (select-window org-agenda-show-window) - (ignore-errors (scroll-down)) - (select-window win)))) - -(defun org-agenda-show-1 (&optional more) - "Display the Org-mode file which contains the item at point. -The prefix arg selects the amount of information to display: - -0 hide the subtree -1 just show the entry according to defaults. -2 show the children view -3 show the subtree view -4 show the entire subtree and any LOGBOOK drawers -5 show the entire subtree and any drawers -With prefix argument FULL-ENTRY, make the entire entry visible -if it was hidden in the outline." - (interactive "p") - (let ((win (selected-window))) - (org-agenda-goto t) - (org-recenter-heading 1) - (cond - ((= more 0) - (hide-subtree) - (save-excursion - (org-back-to-heading) - (run-hook-with-args 'org-cycle-hook 'folded)) - (message "Remote: FOLDED")) - ((and (org-called-interactively-p 'any) (= more 1)) - (message "Remote: show with default settings")) - ((= more 2) - (show-entry) - (show-children) - (save-excursion - (org-back-to-heading) - (run-hook-with-args 'org-cycle-hook 'children)) - (message "Remote: CHILDREN")) - ((= more 3) - (show-subtree) - (save-excursion - (org-back-to-heading) - (run-hook-with-args 'org-cycle-hook 'subtree)) - (message "Remote: SUBTREE")) - ((= more 4) - (let* ((org-drawers (delete "LOGBOOK" (copy-sequence org-drawers))) - (org-drawer-regexp - (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$"))) - (show-subtree) - (save-excursion - (org-back-to-heading) - (org-cycle-hide-drawers 'subtree))) - (message "Remote: SUBTREE AND LOGBOOK")) - ((> more 4) - (show-subtree) - (message "Remote: SUBTREE AND ALL DRAWERS"))) - (select-window win))) - -(defun org-recenter-heading (n) - (save-excursion - (org-back-to-heading) - (recenter n))) - -(defvar org-agenda-cycle-counter nil) -(defun org-agenda-cycle-show (&optional n) - "Show the current entry in another window, with default settings. -Default settings are taken from `org-show-hierarchy-above' and siblings. -When use repeatedly in immediate succession, the remote entry will cycle -through visibility - -children -> subtree -> folded - -When called with a numeric prefix arg, that arg will be passed through to -`org-agenda-show-1'. For the interpretation of that argument, see the -docstring of `org-agenda-show-1'." - (interactive "P") - (if (integerp n) - (setq org-agenda-cycle-counter n) - (if (not (eq last-command this-command)) - (setq org-agenda-cycle-counter 1) - (if (equal org-agenda-cycle-counter 0) - (setq org-agenda-cycle-counter 2) - (setq org-agenda-cycle-counter (1+ org-agenda-cycle-counter)) - (if (> org-agenda-cycle-counter 3) - (setq org-agenda-cycle-counter 0))))) - (org-agenda-show-1 org-agenda-cycle-counter)) - -(defun org-agenda-recenter (arg) - "Display the Org-mode file which contains the item at point and recenter." - (interactive "P") - (let ((win (selected-window))) - (org-agenda-goto t) - (recenter arg) - (select-window win))) - -(defun org-agenda-show-mouse (ev) - "Display the Org-mode file which contains the item at the mouse click." - (interactive "e") - (mouse-set-point ev) - (org-agenda-show)) - -(defun org-agenda-check-no-diary () - "Check if the entry is a diary link and abort if yes." - (if (org-get-at-bol 'org-agenda-diary-link) - (org-agenda-error))) - -(defun org-agenda-error () - (error "Command not allowed in this line")) - -(defun org-agenda-tree-to-indirect-buffer (arg) - "Show the subtree corresponding to the current entry in an indirect buffer. -This calls the command `org-tree-to-indirect-buffer' from the original buffer. - -With a numerical prefix ARG, go up to this level and then take that tree. -With a negative numeric ARG, go up by this number of levels. -With a \\[universal-argument] prefix, make a separate frame for this tree (i.e. don't -use the dedicated frame)." - (interactive "P") - (if current-prefix-arg - (org-agenda-do-tree-to-indirect-buffer arg) - (let ((agenda-buffer (buffer-name)) - (agenda-window (selected-window)) - (indirect-window - (and org-last-indirect-buffer - (get-buffer-window org-last-indirect-buffer)))) - (save-window-excursion (org-agenda-do-tree-to-indirect-buffer arg)) - (unless (or (eq org-indirect-buffer-display 'new-frame) - (eq org-indirect-buffer-display 'dedicated-frame)) - (unwind-protect - (unless (and indirect-window (window-live-p indirect-window)) - (setq indirect-window (split-window agenda-window))) - (and indirect-window (select-window indirect-window)) - (switch-to-buffer org-last-indirect-buffer :norecord) - (fit-window-to-buffer indirect-window))) - (select-window (get-buffer-window agenda-buffer))))) - -(defun org-agenda-do-tree-to-indirect-buffer (arg) - "Same as `org-agenda-tree-to-indirect-buffer' without saving window." - (org-agenda-check-no-diary) - (let* ((marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker))) - (with-current-buffer buffer - (save-excursion - (goto-char pos) - (funcall 'org-tree-to-indirect-buffer arg))))) - -(defvar org-last-heading-marker (make-marker) - "Marker pointing to the headline that last changed its TODO state -by a remote command from the agenda.") - -(defun org-agenda-todo-nextset () - "Switch TODO entry to next sequence." - (interactive) - (org-agenda-todo 'nextset)) - -(defun org-agenda-todo-previousset () - "Switch TODO entry to previous sequence." - (interactive) - (org-agenda-todo 'previousset)) - -(defun org-agenda-todo (&optional arg) - "Cycle TODO state of line at point, also in Org-mode file. -This changes the line at point, all other lines in the agenda referring to -the same tree node, and the headline of the tree node in the Org-mode file." - (interactive "P") - (org-agenda-check-no-diary) - (let* ((col (current-column)) - (marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker)) - (hdmarker (org-get-at-bol 'org-hd-marker)) - (todayp (org-agenda-todayp (org-get-at-bol 'day))) - (inhibit-read-only t) - org-agenda-headline-snapshot-before-repeat newhead just-one) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (let ((current-prefix-arg arg)) - (call-interactively 'org-todo)) - (and (bolp) (forward-char 1)) - (setq newhead (org-get-heading)) - (when (and (org-bound-and-true-p - org-agenda-headline-snapshot-before-repeat) - (not (equal org-agenda-headline-snapshot-before-repeat - newhead)) - todayp) - (setq newhead org-agenda-headline-snapshot-before-repeat - just-one t)) - (save-excursion - (org-back-to-heading) - (move-marker org-last-heading-marker (point)))) - (beginning-of-line 1) - (save-excursion - (org-agenda-change-all-lines newhead hdmarker 'fixface just-one)) - (org-move-to-column col)))) - -(defun org-agenda-add-note (&optional arg) - "Add a time-stamped note to the entry at point." - (interactive "P") - (org-agenda-check-no-diary) - (let* ((marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker)) - (hdmarker (org-get-at-bol 'org-hd-marker)) - (inhibit-read-only t)) - (with-current-buffer buffer - (widen) - (goto-char pos) - (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (org-add-note)))) - -(defun org-agenda-change-all-lines (newhead hdmarker - &optional fixface just-this) - "Change all lines in the agenda buffer which match HDMARKER. -The new content of the line will be NEWHEAD (as modified by -`org-agenda-format-item'). HDMARKER is checked with -`equal' against all `org-hd-marker' text properties in the file. -If FIXFACE is non-nil, the face of each item is modified according to -the new TODO state. -If JUST-THIS is non-nil, change just the current line, not all. -If FORCE-TAGS is non nil, the car of it returns the new tags." - (let* ((inhibit-read-only t) - (line (org-current-line)) - (org-agenda-buffer (current-buffer)) - (thetags (with-current-buffer (marker-buffer hdmarker) - (save-excursion (save-restriction (widen) - (goto-char hdmarker) - (org-get-tags-at))))) - props m pl undone-face done-face finish new dotime level cat tags) - (save-excursion - (goto-char (point-max)) - (beginning-of-line 1) - (while (not finish) - (setq finish (bobp)) - (when (and (setq m (org-get-at-bol 'org-hd-marker)) - (or (not just-this) (= (org-current-line) line)) - (equal m hdmarker)) - (setq props (text-properties-at (point)) - dotime (org-get-at-bol 'dotime) - cat (org-get-at-bol 'org-category) - level (org-get-at-bol 'level) - tags thetags - new - (let ((org-prefix-format-compiled - (or (get-text-property (min (1- (point-max)) (point)) 'format) - org-prefix-format-compiled)) - (extra (org-get-at-bol 'extra))) - (with-current-buffer (marker-buffer hdmarker) - (save-excursion - (save-restriction - (widen) - (org-agenda-format-item extra newhead level cat tags dotime))))) - pl (text-property-any (point-at-bol) (point-at-eol) 'org-heading t) - undone-face (org-get-at-bol 'undone-face) - done-face (org-get-at-bol 'done-face)) - (beginning-of-line 1) - (cond - ((equal new "") - (and (looking-at ".*\n?") (replace-match ""))) - ((looking-at ".*") - (replace-match new t t) - (beginning-of-line 1) - (add-text-properties (point-at-bol) (point-at-eol) props) - (when fixface - (add-text-properties - (point-at-bol) (point-at-eol) - (list 'face - (if org-last-todo-state-is-todo - undone-face done-face)))) - (org-agenda-highlight-todo 'line) - (beginning-of-line 1)) - (t (error "Line update did not work"))) - (save-restriction - (narrow-to-region (point-at-bol) (point-at-eol)) - (org-agenda-finalize))) - (beginning-of-line 0))))) - -(defun org-agenda-align-tags (&optional line) - "Align all tags in agenda items to `org-agenda-tags-column'." - (let ((inhibit-read-only t) l c) - (save-excursion - (goto-char (if line (point-at-bol) (point-min))) - (while (re-search-forward (org-re "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$") - (if line (point-at-eol) nil) t) - (add-text-properties - (match-beginning 2) (match-end 2) - (list 'face (delq nil (let ((prop (get-text-property - (match-beginning 2) 'face))) - (or (listp prop) (setq prop (list prop))) - (if (memq 'org-tag prop) - prop - (cons 'org-tag prop)))))) - (setq l (- (match-end 2) (match-beginning 2)) - c (if (< org-agenda-tags-column 0) - (- (abs org-agenda-tags-column) l) - org-agenda-tags-column)) - (delete-region (match-beginning 1) (match-end 1)) - (goto-char (match-beginning 1)) - (insert (org-add-props - (make-string (max 1 (- c (current-column))) ?\ ) - (plist-put (copy-sequence (text-properties-at (point))) - 'face nil)))) - (goto-char (point-min)) - (org-font-lock-add-tag-faces (point-max))))) - -(defun org-agenda-priority-up () - "Increase the priority of line at point, also in Org-mode file." - (interactive) - (org-agenda-priority 'up)) - -(defun org-agenda-priority-down () - "Decrease the priority of line at point, also in Org-mode file." - (interactive) - (org-agenda-priority 'down)) - -(defun org-agenda-priority (&optional force-direction) - "Set the priority of line at point, also in Org-mode file. -This changes the line at point, all other lines in the agenda referring to -the same tree node, and the headline of the tree node in the Org-mode file. -Called with a universal prefix arg, show the priority instead of setting it." - (interactive "P") - (if (equal force-direction '(4)) - (org-show-priority) - (unless org-enable-priority-commands - (error "Priority commands are disabled")) - (org-agenda-check-no-diary) - (let* ((marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (hdmarker (org-get-at-bol 'org-hd-marker)) - (buffer (marker-buffer hdmarker)) - (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (funcall 'org-priority force-direction) - (end-of-line 1) - (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker) - (beginning-of-line 1))))) - -;; FIXME: should fix the tags property of the agenda line. -(defun org-agenda-set-tags (&optional tag onoff) - "Set tags for the current headline." - (interactive) - (org-agenda-check-no-diary) - (if (and (org-region-active-p) (org-called-interactively-p 'any)) - (call-interactively 'org-change-tag-in-region) - (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) - (org-agenda-error))) - (buffer (marker-buffer hdmarker)) - (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (save-excursion - (org-show-context 'agenda)) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (goto-char pos) - (if tag - (org-toggle-tag tag onoff) - (call-interactively 'org-set-tags)) - (end-of-line 1) - (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker) - (beginning-of-line 1))))) - -(defun org-agenda-set-property () - "Set a property for the current headline." - (interactive) - (org-agenda-check-no-diary) - (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) - (org-agenda-error))) - (buffer (marker-buffer hdmarker)) - (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (save-excursion - (org-show-context 'agenda)) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (goto-char pos) - (call-interactively 'org-set-property))))) - -(defun org-agenda-set-effort () - "Set the effort property for the current headline." - (interactive) - (org-agenda-check-no-diary) - (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) - (org-agenda-error))) - (buffer (marker-buffer hdmarker)) - (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (save-excursion - (org-show-context 'agenda)) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (goto-char pos) - (call-interactively 'org-set-effort) - (end-of-line 1) - (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker)))) - -(defun org-agenda-toggle-archive-tag () - "Toggle the archive tag for the current entry." - (interactive) - (org-agenda-check-no-diary) - (let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) - (org-agenda-error))) - (buffer (marker-buffer hdmarker)) - (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (org-show-context 'agenda) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (call-interactively 'org-toggle-archive-tag) - (end-of-line 1) - (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker) - (beginning-of-line 1)))) - -(defun org-agenda-do-date-later (arg) - (interactive "P") - (cond - ((or (equal arg '(16)) - (memq last-command - '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) - (setq this-command 'org-agenda-date-later-minutes) - (org-agenda-date-later-minutes 1)) - ((or (equal arg '(4)) - (memq last-command - '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) - (setq this-command 'org-agenda-date-later-hours) - (org-agenda-date-later-hours 1)) - (t - (org-agenda-date-later (prefix-numeric-value arg))))) - -(defun org-agenda-do-date-earlier (arg) - (interactive "P") - (cond - ((or (equal arg '(16)) - (memq last-command - '(org-agenda-date-later-minutes org-agenda-date-earlier-minutes))) - (setq this-command 'org-agenda-date-earlier-minutes) - (org-agenda-date-earlier-minutes 1)) - ((or (equal arg '(4)) - (memq last-command - '(org-agenda-date-later-hours org-agenda-date-earlier-hours))) - (setq this-command 'org-agenda-date-earlier-hours) - (org-agenda-date-earlier-hours 1)) - (t - (org-agenda-date-earlier (prefix-numeric-value arg))))) - -(defun org-agenda-date-later (arg &optional what) - "Change the date of this item to ARG day(s) later." - (interactive "p") - (org-agenda-check-type t 'agenda 'timeline) - (org-agenda-check-no-diary) - (let* ((marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker)) - cdate today) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (if (not (org-at-timestamp-p)) - (error "Cannot find time stamp")) - (when (and org-agenda-move-date-from-past-immediately-to-today - (equal arg 1) - (or (not what) (eq what 'day)) - (not (save-match-data (org-at-date-range-p)))) - (setq cdate (org-parse-time-string (match-string 0) 'nodefault) - cdate (calendar-absolute-from-gregorian - (list (nth 4 cdate) (nth 3 cdate) (nth 5 cdate))) - today (org-today)) - (if (> today cdate) - ;; immediately shift to today - (setq arg (- today cdate)))) - (org-timestamp-change arg (or what 'day)) - (when (and (org-at-date-range-p) - (re-search-backward org-tr-regexp-both (point-at-bol))) - (let ((end org-last-changed-timestamp)) - (org-timestamp-change arg (or what 'day)) - (setq org-last-changed-timestamp - (concat org-last-changed-timestamp "--" end))))) - (org-agenda-show-new-time marker org-last-changed-timestamp)) - (message "Time stamp changed to %s" org-last-changed-timestamp))) - -(defun org-agenda-date-earlier (arg &optional what) - "Change the date of this item to ARG day(s) earlier." - (interactive "p") - (org-agenda-date-later (- arg) what)) - -(defun org-agenda-date-later-minutes (arg) - "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." - (interactive "p") - (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) - (org-agenda-date-later arg 'minute)) - -(defun org-agenda-date-earlier-minutes (arg) - "Change the time of this item, in units of `org-time-stamp-rounding-minutes'." - (interactive "p") - (setq arg (* arg (cadr org-time-stamp-rounding-minutes))) - (org-agenda-date-earlier arg 'minute)) - -(defun org-agenda-date-later-hours (arg) - "Change the time of this item, in hour steps." - (interactive "p") - (org-agenda-date-later arg 'hour)) - -(defun org-agenda-date-earlier-hours (arg) - "Change the time of this item, in hour steps." - (interactive "p") - (org-agenda-date-earlier arg 'hour)) - -(defun org-agenda-show-new-time (marker stamp &optional prefix) - "Show new date stamp via text properties." - ;; We use text properties to make this undoable - (let ((inhibit-read-only t)) - (setq stamp (concat prefix " => " stamp " ")) - (save-excursion - (goto-char (point-max)) - (while (not (bobp)) - (when (equal marker (org-get-at-bol 'org-marker)) - (org-move-to-column (- (window-width) (length stamp)) t nil t) - (org-agenda-fix-tags-filter-overlays-at (point)) - (if (featurep 'xemacs) - ;; Use `duplicable' property to trigger undo recording - (let ((ex (make-extent nil nil)) - (gl (make-glyph stamp))) - (set-glyph-face gl 'secondary-selection) - (set-extent-properties - ex (list 'invisible t 'end-glyph gl 'duplicable t)) - (insert-extent ex (1- (point)) (point-at-eol))) - (add-text-properties - (1- (point)) (point-at-eol) - (list 'display (org-add-props stamp nil - 'face 'secondary-selection)))) - (beginning-of-line 1)) - (beginning-of-line 0))))) - -(defun org-agenda-date-prompt (arg) - "Change the date of this item. Date is prompted for, with default today. -The prefix ARG is passed to the `org-time-stamp' command and can therefore -be used to request time specification in the time stamp." - (interactive "P") - (org-agenda-check-type t 'agenda 'timeline) - (org-agenda-check-no-diary) - (let* ((marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker))) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (if (not (org-at-timestamp-p t)) - (error "Cannot find time stamp")) - (org-time-stamp arg (equal (char-after (match-beginning 0)) ?\[))) - (org-agenda-show-new-time marker org-last-changed-timestamp)) - (message "Time stamp changed to %s" org-last-changed-timestamp))) - -(defun org-agenda-schedule (arg &optional time) - "Schedule the item at point. -ARG is passed through to `org-schedule'." - (interactive "P") - (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) - (org-agenda-check-no-diary) - (let* ((marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (type (marker-insertion-type marker)) - (buffer (marker-buffer marker)) - (pos (marker-position marker)) - (org-insert-labeled-timestamps-at-point nil) - ts) - (set-marker-insertion-type marker t) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (setq ts (org-schedule arg time))) - (org-agenda-show-new-time marker ts " S")) - (message "%s" ts))) - -(defun org-agenda-deadline (arg &optional time) - "Schedule the item at point. -ARG is passed through to `org-deadline'." - (interactive "P") - (org-agenda-check-type t 'agenda 'timeline 'todo 'tags 'search) - (org-agenda-check-no-diary) - (let* ((marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (buffer (marker-buffer marker)) - (pos (marker-position marker)) - (org-insert-labeled-timestamps-at-point nil) - ts) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (setq ts (org-deadline arg time))) - (org-agenda-show-new-time marker ts " D")) - (message "%s" ts))) - -(defun org-agenda-clock-in (&optional arg) - "Start the clock on the currently selected item." - (interactive "P") - (org-agenda-check-no-diary) - (if (equal arg '(4)) - (org-clock-in arg) - (let* ((marker (or (org-get-at-bol 'org-marker) - (org-agenda-error))) - (hdmarker (or (org-get-at-bol 'org-hd-marker) marker)) - (pos (marker-position marker)) - (col (current-column)) - newhead) - (org-with-remote-undo (marker-buffer marker) - (with-current-buffer (marker-buffer marker) - (widen) - (goto-char pos) - (org-show-context 'agenda) - (org-show-entry) - (org-cycle-hide-drawers 'children) - (org-clock-in arg) - (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead hdmarker)) - (org-move-to-column col)))) - -(defun org-agenda-clock-out () - "Stop the currently running clock." - (interactive) - (unless (marker-buffer org-clock-marker) - (error "No running clock")) - (let ((marker (make-marker)) (col (current-column)) newhead) - (org-with-remote-undo (marker-buffer org-clock-marker) - (with-current-buffer (marker-buffer org-clock-marker) - (save-excursion - (save-restriction - (widen) - (goto-char org-clock-marker) - (org-back-to-heading t) - (move-marker marker (point)) - (org-clock-out) - (setq newhead (org-get-heading)))))) - (org-agenda-change-all-lines newhead marker) - (move-marker marker nil) - (org-move-to-column col) - (org-agenda-unmark-clocking-task))) - -(defun org-agenda-clock-cancel (&optional arg) - "Cancel the currently running clock." - (interactive "P") - (unless (marker-buffer org-clock-marker) - (user-error "No running clock")) - (org-with-remote-undo (marker-buffer org-clock-marker) - (org-clock-cancel))) - -(defun org-agenda-clock-goto () - "Jump to the currently clocked in task within the agenda. -If the currently clocked in task is not listed in the agenda -buffer, display it in another window." - (interactive) - (let (pos) - (mapc (lambda (o) - (if (eq (overlay-get o 'type) 'org-agenda-clocking) - (setq pos (overlay-start o)))) - (overlays-in (point-min) (point-max))) - (cond (pos (goto-char pos)) - ;; If the currently clocked entry is not in the agenda - ;; buffer, we visit it in another window: - (org-clock-current-task - (org-switch-to-buffer-other-window (org-clock-goto))) - (t (message "No running clock, use `C-c C-x C-j' to jump to the most recent one"))))) - -(defun org-agenda-diary-entry-in-org-file () - "Make a diary entry in the file `org-agenda-diary-file'." - (let (d1 d2 char (text "") dp1 dp2) - (if (equal (buffer-name) "*Calendar*") - (setq d1 (calendar-cursor-to-date t) - d2 (car calendar-mark-ring)) - (setq dp1 (get-text-property (point-at-bol) 'day)) - (unless dp1 (user-error "No date defined in current line")) - (setq d1 (calendar-gregorian-from-absolute dp1) - d2 (and (ignore-errors (mark)) - (save-excursion - (goto-char (mark)) - (setq dp2 (get-text-property (point-at-bol) 'day))) - (calendar-gregorian-from-absolute dp2)))) - (message "Diary entry: [d]ay [a]nniversary [b]lock [j]ump to date tree") - (setq char (read-char-exclusive)) - (cond - ((equal char ?d) - (setq text (read-string "Day entry: ")) - (org-agenda-add-entry-to-org-agenda-diary-file 'day text d1) - (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) - ((equal char ?a) - (setq d1 (list (car d1) (nth 1 d1) - (read-number (format "Reference year [%d]: " (nth 2 d1)) - (nth 2 d1)))) - (setq text (read-string "Anniversary (use %d to show years): ")) - (org-agenda-add-entry-to-org-agenda-diary-file 'anniversary text d1) - (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) - ((equal char ?b) - (setq text (read-string "Block entry: ")) - (unless (and d1 d2 (not (equal d1 d2))) - (user-error "No block of days selected")) - (org-agenda-add-entry-to-org-agenda-diary-file 'block text d1 d2) - (and (equal (buffer-name) org-agenda-buffer-name) (org-agenda-redo))) - ((equal char ?j) - (org-switch-to-buffer-other-window - (find-file-noselect org-agenda-diary-file)) - (require 'org-datetree) - (org-datetree-find-date-create d1) - (org-reveal t)) - (t (user-error "Invalid selection character `%c'" char))))) - -(defcustom org-agenda-insert-diary-strategy 'date-tree - "Where in `org-agenda-diary-file' should new entries be added? -Valid values: - -date-tree in the date tree, as child of the date -top-level as top-level entries at the end of the file." - :group 'org-agenda - :type '(choice - (const :tag "in a date tree" date-tree) - (const :tag "as top level at end of file" top-level))) - -(defcustom org-agenda-insert-diary-extract-time nil - "Non-nil means extract any time specification from the diary entry." - :group 'org-agenda - :version "24.1" - :type 'boolean) - -(defcustom org-agenda-bulk-mark-char ">" - "A single-character string to be used as the bulk mark." - :group 'org-agenda - :version "24.1" - :type 'string) - -(defun org-agenda-add-entry-to-org-agenda-diary-file (type text &optional d1 d2) - "Add a diary entry with TYPE to `org-agenda-diary-file'. -If TEXT is not empty, it will become the headline of the new entry, and -the resulting entry will not be shown. When TEXT is empty, switch to -`org-agenda-diary-file' and let the user finish the entry there." - (let ((cw (current-window-configuration))) - (org-switch-to-buffer-other-window - (find-file-noselect org-agenda-diary-file)) - (widen) - (goto-char (point-min)) - (cond - ((eq type 'anniversary) - (or (re-search-forward "^*[ \t]+Anniversaries" nil t) - (progn - (or (org-at-heading-p t) - (progn - (outline-next-heading) - (insert "* Anniversaries\n\n") - (beginning-of-line -1))))) - (outline-next-heading) - (org-back-over-empty-lines) - (backward-char 1) - (insert "\n") - (insert (format "%%%%(org-anniversary %d %2d %2d) %s" - (nth 2 d1) (car d1) (nth 1 d1) text))) - ((eq type 'day) - (let ((org-prefix-has-time t) - (org-agenda-time-leading-zero t) - fmt time time2) - (if org-agenda-insert-diary-extract-time - ;; Use org-agenda-format-item to parse text for a time-range and - ;; remove it. FIXME: This is a hack, we should refactor - ;; that function to make time extraction available separately - (setq fmt (org-agenda-format-item nil text nil nil nil t) - time (get-text-property 0 'time fmt) - time2 (if (> (length time) 0) - ;; split-string removes trailing ...... if - ;; no end time given. First space - ;; separates time from date. - (concat " " (car (split-string time "\\."))) - nil) - text (get-text-property 0 'txt fmt))) - (if (eq org-agenda-insert-diary-strategy 'top-level) - (org-agenda-insert-diary-as-top-level text) - (require 'org-datetree) - (org-datetree-find-date-create d1) - (org-agenda-insert-diary-make-new-entry text)) - (org-insert-time-stamp (org-time-from-absolute - (calendar-absolute-from-gregorian d1)) - nil nil nil nil time2)) - (end-of-line 0)) - ((eq type 'block) - (if (> (calendar-absolute-from-gregorian d1) - (calendar-absolute-from-gregorian d2)) - (setq d1 (prog1 d2 (setq d2 d1)))) - (if (eq org-agenda-insert-diary-strategy 'top-level) - (org-agenda-insert-diary-as-top-level text) - (require 'org-datetree) - (org-datetree-find-date-create d1) - (org-agenda-insert-diary-make-new-entry text)) - (org-insert-time-stamp (org-time-from-absolute - (calendar-absolute-from-gregorian d1))) - (insert "--") - (org-insert-time-stamp (org-time-from-absolute - (calendar-absolute-from-gregorian d2))) - (end-of-line 0))) - (if (string-match "\\S-" text) - (progn - (set-window-configuration cw) - (message "%s entry added to %s" - (capitalize (symbol-name type)) - (abbreviate-file-name org-agenda-diary-file))) - (org-reveal t) - (message "Please finish entry here")))) - -(defun org-agenda-insert-diary-as-top-level (text) - "Make new entry as a top-level entry at the end of the file. -Add TEXT as headline, and position the cursor in the second line so that -a timestamp can be added there." - (widen) - (goto-char (point-max)) - (or (bolp) (insert "\n")) - (insert "* " text "\n") - (if org-adapt-indentation (org-indent-to-column 2))) - -(defun org-agenda-insert-diary-make-new-entry (text) - "Make new entry as last child of current entry. -Add TEXT as headline, and position the cursor in the second line so that -a timestamp can be added there." - (let ((org-show-following-heading t) - (org-show-siblings t) - (org-show-hierarchy-above t) - (org-show-entry-below t) - col) - (outline-next-heading) - (org-back-over-empty-lines) - (or (looking-at "[ \t]*$") - (progn (insert "\n") (backward-char 1))) - (org-insert-heading nil t) - (org-do-demote) - (setq col (current-column)) - (insert text "\n") - (if org-adapt-indentation (org-indent-to-column col)) - (let ((org-show-following-heading t) - (org-show-siblings t) - (org-show-hierarchy-above t) - (org-show-entry-below t)) - (org-show-context)))) - -(defun org-agenda-diary-entry () - "Make a diary entry, like the `i' command from the calendar. -All the standard commands work: block, weekly etc. -When `org-agenda-diary-file' points to a file, -`org-agenda-diary-entry-in-org-file' is called instead to create -entries in that Org-mode file." - (interactive) - (if (not (eq org-agenda-diary-file 'diary-file)) - (org-agenda-diary-entry-in-org-file) - (require 'diary-lib) - (let* ((char (progn - (message "Diary entry: [d]ay [w]eekly [m]onthly [y]early [a]nniversary [b]lock [c]yclic") - (read-char-exclusive))) - (cmd (cdr (assoc char - '((?d . insert-diary-entry) - (?w . insert-weekly-diary-entry) - (?m . insert-monthly-diary-entry) - (?y . insert-yearly-diary-entry) - (?a . insert-anniversary-diary-entry) - (?b . insert-block-diary-entry) - (?c . insert-cyclic-diary-entry))))) - (oldf (symbol-function 'calendar-cursor-to-date)) - ;; (buf (get-file-buffer (substitute-in-file-name diary-file))) - (point (point)) - (mark (or (mark t) (point)))) - (unless cmd - (user-error "No command associated with <%c>" char)) - (unless (and (get-text-property point 'day) - (or (not (equal ?b char)) - (get-text-property mark 'day))) - (user-error "Don't know which date to use for diary entry")) - ;; We implement this by hacking the `calendar-cursor-to-date' function - ;; and the `calendar-mark-ring' variable. Saves a lot of code. - (let ((calendar-mark-ring - (list (calendar-gregorian-from-absolute - (or (get-text-property mark 'day) - (get-text-property point 'day)))))) - (unwind-protect - (progn - (fset 'calendar-cursor-to-date - (lambda (&optional error dummy) - (calendar-gregorian-from-absolute - (get-text-property point 'day)))) - (call-interactively cmd)) - (fset 'calendar-cursor-to-date oldf)))))) - -(defun org-agenda-execute-calendar-command (cmd) - "Execute a calendar command from the agenda with date from cursor." - (org-agenda-check-type t 'agenda 'timeline) - (require 'diary-lib) - (unless (get-text-property (min (1- (point-max)) (point)) 'day) - (user-error "Don't know which date to use for the calendar command")) - (let* ((oldf (symbol-function 'calendar-cursor-to-date)) - (point (point)) - (date (calendar-gregorian-from-absolute - (get-text-property point 'day))) - ;; the following 2 vars are needed in the calendar - (displayed-month (car date)) - (displayed-year (nth 2 date))) - (unwind-protect - (progn - (fset 'calendar-cursor-to-date - (lambda (&optional error dummy) - (calendar-gregorian-from-absolute - (get-text-property point 'day)))) - (call-interactively cmd)) - (fset 'calendar-cursor-to-date oldf)))) - -(defun org-agenda-phases-of-moon () - "Display the phases of the moon for the 3 months around the cursor date." - (interactive) - (org-agenda-execute-calendar-command 'calendar-phases-of-moon)) - -(defun org-agenda-holidays () - "Display the holidays for the 3 months around the cursor date." - (interactive) - (org-agenda-execute-calendar-command 'list-calendar-holidays)) - -(defvar calendar-longitude) ; defined in calendar.el -(defvar calendar-latitude) ; defined in calendar.el -(defvar calendar-location-name) ; defined in calendar.el - -(defun org-agenda-sunrise-sunset (arg) - "Display sunrise and sunset for the cursor date. -Latitude and longitude can be specified with the variables -`calendar-latitude' and `calendar-longitude'. When called with prefix -argument, latitude and longitude will be prompted for." - (interactive "P") - (require 'solar) - (let ((calendar-longitude (if arg nil calendar-longitude)) - (calendar-latitude (if arg nil calendar-latitude)) - (calendar-location-name - (if arg "the given coordinates" calendar-location-name))) - (org-agenda-execute-calendar-command 'calendar-sunrise-sunset))) - -(defun org-agenda-goto-calendar () - "Open the Emacs calendar with the date at the cursor." - (interactive) - (org-agenda-check-type t 'agenda 'timeline) - (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day) - (user-error "Don't know which date to open in calendar"))) - (date (calendar-gregorian-from-absolute day)) - (calendar-move-hook nil) - (calendar-view-holidays-initially-flag nil) - (calendar-view-diary-initially-flag nil)) - (calendar) - (calendar-goto-date date))) - -;;;###autoload -(defun org-calendar-goto-agenda () - "Compute the Org-mode agenda for the calendar date displayed at the cursor. -This is a command that has to be installed in `calendar-mode-map'." - (interactive) - (org-agenda-list nil (calendar-absolute-from-gregorian - (calendar-cursor-to-date)) - nil)) - -(defun org-agenda-convert-date () - (interactive) - (org-agenda-check-type t 'agenda 'timeline) - (let ((day (get-text-property (min (1- (point-max)) (point)) 'day)) - date s) - (unless day - (user-error "Don't know which date to convert")) - (setq date (calendar-gregorian-from-absolute day)) - (setq s (concat - "Gregorian: " (calendar-date-string date) "\n" - "ISO: " (calendar-iso-date-string date) "\n" - "Day of Yr: " (calendar-day-of-year-string date) "\n" - "Julian: " (calendar-julian-date-string date) "\n" - "Astron. JD: " (calendar-astro-date-string date) - " (Julian date number at noon UTC)\n" - "Hebrew: " (calendar-hebrew-date-string date) " (until sunset)\n" - "Islamic: " (calendar-islamic-date-string date) " (until sunset)\n" - "French: " (calendar-french-date-string date) "\n" - "Baha'i: " (calendar-bahai-date-string date) " (until sunset)\n" - "Mayan: " (calendar-mayan-date-string date) "\n" - "Coptic: " (calendar-coptic-date-string date) "\n" - "Ethiopic: " (calendar-ethiopic-date-string date) "\n" - "Persian: " (calendar-persian-date-string date) "\n" - "Chinese: " (calendar-chinese-date-string date) "\n")) - (with-output-to-temp-buffer "*Dates*" - (princ s)) - (org-fit-window-to-buffer (get-buffer-window "*Dates*")))) - -;;; Bulk commands - -(defun org-agenda-bulk-marked-p () - (eq (get-char-property (point-at-bol) 'type) - 'org-marked-entry-overlay)) - -(defun org-agenda-bulk-mark (&optional arg) - "Mark the entry at point for future bulk action." - (interactive "p") - (dotimes (i (or arg 1)) - (unless (org-get-at-bol 'org-agenda-diary-link) - (let* ((m (org-get-at-bol 'org-hd-marker)) - ov) - (unless (org-agenda-bulk-marked-p) - (unless m (user-error "Nothing to mark at point")) - (push m org-agenda-bulk-marked-entries) - (setq ov (make-overlay (point-at-bol) (+ 2 (point-at-bol)))) - (org-overlay-display ov (concat org-agenda-bulk-mark-char " ") - (org-get-todo-face "TODO") - 'evaporate) - (overlay-put ov 'type 'org-marked-entry-overlay)) - (end-of-line 1) - (or (ignore-errors - (goto-char (next-single-property-change (point) 'txt))) - (beginning-of-line 2)) - (while (and (get-char-property (point) 'invisible) (not (eobp))) - (beginning-of-line 2)) - (message "%d entries marked for bulk action" - (length org-agenda-bulk-marked-entries)))))) - -(defun org-agenda-bulk-mark-all () - "Mark all entries for future agenda bulk action." - (interactive) - (org-agenda-bulk-mark-regexp ".")) - -(defun org-agenda-bulk-mark-regexp (regexp) - "Mark entries matching REGEXP for future agenda bulk action." - (interactive "sMark entries matching regexp: ") - (let ((entries-marked 0) txt-at-point) - (save-excursion - (goto-char (point-min)) - (goto-char (next-single-property-change (point) 'txt)) - (while (and (re-search-forward regexp nil t) - (setq txt-at-point (get-text-property (point) 'txt))) - (when (string-match regexp txt-at-point) - (setq entries-marked (1+ entries-marked)) - (call-interactively 'org-agenda-bulk-mark)))) - (if (not entries-marked) - (message "No entry matching this regexp.")))) - -(defun org-agenda-bulk-unmark (&optional arg) - "Unmark the entry at point for future bulk action." - (interactive "P") - (if arg - (org-agenda-bulk-unmark-all) - (cond ((org-agenda-bulk-marked-p) - (org-agenda-bulk-remove-overlays - (point-at-bol) (+ 2 (point-at-bol))) - (setq org-agenda-bulk-marked-entries - (delete (org-get-at-bol 'org-hd-marker) - org-agenda-bulk-marked-entries)) - (end-of-line 1) - (or (ignore-errors - (goto-char (next-single-property-change (point) 'txt))) - (beginning-of-line 2)) - (while (and (get-char-property (point) 'invisible) (not (eobp))) - (beginning-of-line 2)) - (message "%d entries left marked for bulk action" - (length org-agenda-bulk-marked-entries))) - (t (message "No entry to unmark here"))))) - -(defun org-agenda-bulk-toggle-all () - "Toggle all marks for bulk action." - (interactive) - (save-excursion - (goto-char (point-min)) - (while (ignore-errors - (goto-char (next-single-property-change (point) 'txt))) - (org-agenda-bulk-toggle)))) - -(defun org-agenda-bulk-toggle () - "Toggle the mark at point for bulk action." - (interactive) - (if (org-agenda-bulk-marked-p) - (org-agenda-bulk-unmark) - (org-agenda-bulk-mark))) - -(defun org-agenda-bulk-remove-overlays (&optional beg end) - "Remove the mark overlays between BEG and END in the agenda buffer. -BEG and END default to the buffer limits. - -This only removes the overlays, it does not remove the markers -from the list in `org-agenda-bulk-marked-entries'." - (interactive) - (mapc (lambda (ov) - (and (eq (overlay-get ov 'type) 'org-marked-entry-overlay) - (delete-overlay ov))) - (overlays-in (or beg (point-min)) (or end (point-max))))) - -(defun org-agenda-bulk-unmark-all () - "Remove all marks in the agenda buffer. -This will remove the markers and the overlays." - (interactive) - (if (null org-agenda-bulk-marked-entries) - (message "No entry to unmark") - (mapc (lambda (m) (move-marker m nil)) org-agenda-bulk-marked-entries) - (setq org-agenda-bulk-marked-entries nil) - (org-agenda-bulk-remove-overlays (point-min) (point-max)))) - -(defcustom org-agenda-persistent-marks nil - "Non-nil means marked items will stay marked after a bulk action. -You can toggle this interactively by typing `p' when prompted for a -bulk action." - :group 'org-agenda - :version "24.1" - :type 'boolean) - -(defun org-agenda-bulk-action (&optional arg) - "Execute an remote-editing action on all marked entries. -The prefix arg is passed through to the command if possible." - (interactive "P") - ;; Make sure we have markers, and only valid ones - (unless org-agenda-bulk-marked-entries (user-error "No entries are marked")) - (mapc - (lambda (m) - (unless (and (markerp m) - (marker-buffer m) - (buffer-live-p (marker-buffer m)) - (marker-position m)) - (user-error "Marker %s for bulk command is invalid" m))) - org-agenda-bulk-marked-entries) - - ;; Prompt for the bulk command - (let* ((msg (if org-agenda-persistent-marks "Bulk (persistent): " "Bulk: "))) - (message (concat msg "[$]arch [A]rch->sib [t]odo [+/-]tag [s]chd [d]eadline [r]efile " - "[S]catter [f]unction " - (when org-agenda-bulk-custom-functions - (concat " Custom: [" - (mapconcat (lambda(f) (char-to-string (car f))) - org-agenda-bulk-custom-functions "") - "]")))) - (catch 'exit - (let* ((action (read-char-exclusive)) - (org-log-refile (if org-log-refile 'time nil)) - (entries (reverse org-agenda-bulk-marked-entries)) - (org-overriding-default-time - (if (get-text-property (point) 'org-agenda-date-header) - (org-get-cursor-date))) - redo-at-end - cmd rfloc state e tag pos (cnt 0) (cntskip 0)) - (cond - ((equal action ?p) - (let ((org-agenda-persistent-marks - (not org-agenda-persistent-marks))) - (org-agenda-bulk-action) - (throw 'exit nil))) - - ((equal action ?$) - (setq cmd '(org-agenda-archive))) - - ((equal action ?A) - (setq cmd '(org-agenda-archive-to-archive-sibling))) - - ((member action '(?r ?w)) - (setq rfloc (org-refile-get-location - "Refile to" - (marker-buffer (car entries)) - org-refile-allow-creating-parent-nodes)) - (if (nth 3 rfloc) - (setcar (nthcdr 3 rfloc) - (move-marker (make-marker) (nth 3 rfloc) - (or (get-file-buffer (nth 1 rfloc)) - (find-buffer-visiting (nth 1 rfloc)) - (error "This should not happen"))))) - - (setq cmd (list 'org-agenda-refile nil (list 'quote rfloc) t) - redo-at-end t)) - - ((equal action ?t) - (setq state (org-icompleting-read - "Todo state: " - (with-current-buffer (marker-buffer (car entries)) - (mapcar 'list org-todo-keywords-1)))) - (setq cmd `(let ((org-inhibit-blocking t) - (org-inhibit-logging 'note)) - (org-agenda-todo ,state)))) - - ((memq action '(?- ?+)) - (setq tag (org-icompleting-read - (format "Tag to %s: " (if (eq action ?+) "add" "remove")) - (with-current-buffer (marker-buffer (car entries)) - (delq nil - (mapcar (lambda (x) - (if (stringp (car x)) x)) org-tag-alist))))) - (setq cmd `(org-agenda-set-tags ,tag ,(if (eq action ?+) ''on ''off)))) - - ((memq action '(?s ?d)) - (let* ((time - (unless arg - (org-read-date - nil nil nil - (if (eq action ?s) "(Re)Schedule to" "(Re)Set Deadline to") - org-overriding-default-time))) - (c1 (if (eq action ?s) 'org-agenda-schedule 'org-agenda-deadline))) - (setq cmd `(eval '(,c1 arg ,time))))) - - ((equal action ?S) - (if (not (org-agenda-check-type nil 'agenda 'timeline 'todo)) - (user-error "Can't scatter tasks in \"%s\" agenda view" org-agenda-type) - (let ((days (read-number - (format "Scatter tasks across how many %sdays: " - (if arg "week" "")) 7))) - (setq cmd - `(let ((distance (1+ (random ,days)))) - (if arg - (let ((dist distance) - (day-of-week - (calendar-day-of-week - (calendar-gregorian-from-absolute (org-today))))) - (dotimes (i (1+ dist)) - (while (member day-of-week org-agenda-weekend-days) - (incf distance) - (incf day-of-week) - (if (= day-of-week 7) - (setq day-of-week 0))) - (incf day-of-week) - (if (= day-of-week 7) - (setq day-of-week 0))))) - ;; silently fail when try to replan a sexp entry - (condition-case nil - (let* ((date (calendar-gregorian-from-absolute - (+ (org-today) distance))) - (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) - (nth 2 date)))) - (org-agenda-schedule nil time)) - (error nil))))))) - - ((assoc action org-agenda-bulk-custom-functions) - (setq cmd (list (cadr (assoc action org-agenda-bulk-custom-functions))) - redo-at-end t)) - - ((equal action ?f) - (setq cmd (list (intern - (org-icompleting-read "Function: " - obarray 'fboundp t nil nil))))) - - (t (user-error "Invalid bulk action"))) - - ;; Sort the markers, to make sure that parents are handled before children - (setq entries (sort entries - (lambda (a b) - (cond - ((equal (marker-buffer a) (marker-buffer b)) - (< (marker-position a) (marker-position b))) - (t - (string< (buffer-name (marker-buffer a)) - (buffer-name (marker-buffer b)))))))) - - ;; Now loop over all markers and apply cmd - (while (setq e (pop entries)) - (setq pos (text-property-any (point-min) (point-max) 'org-hd-marker e)) - (if (not pos) - (progn (message "Skipping removed entry at %s" e) - (setq cntskip (1+ cntskip))) - (goto-char pos) - (let (org-loop-over-headlines-in-active-region) - (eval cmd)) - (setq cnt (1+ cnt)))) - (when redo-at-end (org-agenda-redo)) - (unless org-agenda-persistent-marks - (org-agenda-bulk-unmark-all)) - (message "Acted on %d entries%s%s" - cnt - (if (= cntskip 0) - "" - (format ", skipped %d (disappeared before their turn)" - cntskip)) - (if (not org-agenda-persistent-marks) - "" " (kept marked)")))))) - -(defun org-agenda-capture (&optional with-time) - "Call `org-capture' with the date at point. -With a `C-1' prefix, use the HH:MM value at point (if any) or the -current HH:MM time." - (interactive "P") - (if (not (eq major-mode 'org-agenda-mode)) - (user-error "You cannot do this outside of agenda buffers") - (let ((org-overriding-default-time - (org-get-cursor-date (equal with-time 1)))) - (call-interactively 'org-capture)))) - -;;; Dragging agenda lines forward/backward - -(defun org-agenda-drag-line-forward (arg) - "Drag an agenda line forward by ARG lines." - (interactive "p") - (let ((inhibit-read-only t) lst) - (if (or (not (get-text-property (point) 'txt)) - (save-excursion - (dotimes (n arg) - (move-beginning-of-line 2) - (push (not (get-text-property (point) 'txt)) lst)) - (delq nil lst))) - (message "Cannot move line forward") - (org-drag-line-forward arg)))) - -(defun org-agenda-drag-line-backward (arg) - "Drag an agenda line backward by ARG lines." - (interactive "p") - (let ((inhibit-read-only t) lst) - (if (or (not (get-text-property (point) 'txt)) - (save-excursion - (dotimes (n arg) - (move-beginning-of-line 0) - (push (not (get-text-property (point) 'txt)) lst)) - (delq nil lst))) - (message "Cannot move line backward") - (org-drag-line-backward arg)))) - -;;; Flagging notes - -(defun org-agenda-show-the-flagging-note () - "Display the flagging note in the other window. -When called a second time in direct sequence, offer to remove the FLAGGING -tag and (if present) the flagging note." - (interactive) - (let ((hdmarker (org-get-at-bol 'org-hd-marker)) - (win (selected-window)) - note heading newhead) - (unless hdmarker - (user-error "No linked entry at point")) - (if (and (eq this-command last-command) - (y-or-n-p "Unflag and remove any flagging note? ")) - (progn - (org-agenda-remove-flag hdmarker) - (let ((win (get-buffer-window "*Flagging Note*"))) - (and win (delete-window win))) - (message "Entry unflagged")) - (setq note (org-entry-get hdmarker "THEFLAGGINGNOTE")) - (unless note - (user-error "No flagging note")) - (org-kill-new note) - (org-switch-to-buffer-other-window "*Flagging Note*") - (erase-buffer) - (insert note) - (goto-char (point-min)) - (while (re-search-forward "\\\\n" nil t) - (replace-match "\n" t t)) - (goto-char (point-min)) - (select-window win) - (message "Flagging note pushed to kill ring. Press [?] again to remove tag and note")))) - -(defun org-agenda-remove-flag (marker) - "Remove the FLAGGED tag and any flagging note in the entry." - (let (newhead) - (org-with-point-at marker - (org-toggle-tag "FLAGGED" 'off) - (org-entry-delete nil "THEFLAGGINGNOTE") - (setq newhead (org-get-heading))) - (org-agenda-change-all-lines newhead marker) - (message "Entry unflagged"))) - -(defun org-agenda-get-any-marker (&optional pos) - (or (get-text-property (or pos (point-at-bol)) 'org-hd-marker) - (get-text-property (or pos (point-at-bol)) 'org-marker))) - -;;; Appointment reminders - -(defvar appt-time-msg-list) ; defined in appt.el - -;;;###autoload -(defun org-agenda-to-appt (&optional refresh filter &rest args) - "Activate appointments found in `org-agenda-files'. -With a \\[universal-argument] prefix, refresh the list of -appointments. - -If FILTER is t, interactively prompt the user for a regular -expression, and filter out entries that don't match it. - -If FILTER is a string, use this string as a regular expression -for filtering entries out. - -If FILTER is a function, filter out entries against which -calling the function returns nil. This function takes one -argument: an entry from `org-agenda-get-day-entries'. - -FILTER can also be an alist with the car of each cell being -either 'headline or 'category. For example: - - '((headline \"IMPORTANT\") - (category \"Work\")) - -will only add headlines containing IMPORTANT or headlines -belonging to the \"Work\" category. - -ARGS are symbols indicating what kind of entries to consider. -By default `org-agenda-to-appt' will use :deadline*, :scheduled* -\(i.e., deadlines and scheduled items with a hh:mm specification) -and :timestamp entries. See the docstring of `org-diary' for -details and examples. - -If an entry has a APPT_WARNTIME property, its value will be used -to override `appt-message-warning-time'." - (interactive "P") - (if refresh (setq appt-time-msg-list nil)) - (if (eq filter t) - (setq filter (read-from-minibuffer "Regexp filter: "))) - (let* ((cnt 0) ; count added events - (scope (or args '(:deadline* :scheduled* :timestamp))) - (org-agenda-new-buffers nil) - (org-deadline-warning-days 0) - ;; Do not use `org-today' here because appt only takes - ;; time and without date as argument, so it may pass wrong - ;; information otherwise - (today (org-date-to-gregorian - (time-to-days (current-time)))) - (org-agenda-restrict nil) - (files (org-agenda-files 'unrestricted)) entries file - (org-agenda-buffer nil)) - ;; Get all entries which may contain an appt - (org-agenda-prepare-buffers files) - (while (setq file (pop files)) - (setq entries - (delq nil - (append entries - (apply 'org-agenda-get-day-entries - file today scope))))) - ;; Map thru entries and find if we should filter them out - (mapc - (lambda(x) - (let* ((evt (org-trim - (replace-regexp-in-string - org-bracket-link-regexp "\\3" - (or (get-text-property 1 'txt x) "")))) - (cat (get-text-property 1 'org-category x)) - (tod (get-text-property 1 'time-of-day x)) - (ok (or (null filter) - (and (stringp filter) (string-match filter evt)) - (and (functionp filter) (funcall filter x)) - (and (listp filter) - (let ((cat-filter (cadr (assoc 'category filter))) - (evt-filter (cadr (assoc 'headline filter)))) - (or (and (stringp cat-filter) - (string-match cat-filter cat)) - (and (stringp evt-filter) - (string-match evt-filter evt))))))) - (wrn (get-text-property 1 'warntime x))) - ;; FIXME: Shall we remove text-properties for the appt text? - ;; (setq evt (set-text-properties 0 (length evt) nil evt)) - (when (and ok tod) - (setq tod (concat "00" (number-to-string tod)) - tod (when (string-match - "\\([0-9]\\{1,2\\}\\)\\([0-9]\\{2\\}\\)\\'" tod) - (concat (match-string 1 tod) ":" - (match-string 2 tod)))) - (if (version< emacs-version "23.3") - (appt-add tod evt) - (appt-add tod evt wrn)) - (setq cnt (1+ cnt))))) entries) - (org-release-buffers org-agenda-new-buffers) - (if (eq cnt 0) - (message "No event to add") - (message "Added %d event%s for today" cnt (if (> cnt 1) "s" ""))))) - -(defun org-agenda-todayp (date) - "Does DATE mean today, when considering `org-extend-today-until'?" - (let ((today (org-today)) - (date (if (and date (listp date)) (calendar-absolute-from-gregorian date) - date))) - (eq date today))) - -(defun org-agenda-todo-yesterday (&optional arg) - "Like `org-agenda-todo' but the time of change will be 23:59 of yesterday." - (interactive "P") - (let* ((hour (third (decode-time - (org-current-time)))) - (org-extend-today-until (1+ hour))) - (org-agenda-todo arg))) - -(provide 'org-agenda) - -;;; org-agenda.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-archive.el b/xemacs-packages/lisp/org-8.2.3c/org-archive.el deleted file mode 100644 index 3dc52c1c..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-archive.el +++ /dev/null @@ -1,557 +0,0 @@ -;;; org-archive.el --- Archiving for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file contains the face definitions for Org. - -;;; Code: - -(require 'org) - -(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) -(declare-function org-datetree-find-date-create "org-datetree" (date &optional keep-restriction)) - -(defcustom org-archive-default-command 'org-archive-subtree - "The default archiving command." - :group 'org-archive - :type '(choice - (const org-archive-subtree) - (const org-archive-to-archive-sibling) - (const org-archive-set-tag))) - -(defcustom org-archive-reversed-order nil - "Non-nil means make the tree first child under the archive heading, not last." - :group 'org-archive - :version "24.1" - :type 'boolean) - -(defcustom org-archive-sibling-heading "Archive" - "Name of the local archive sibling that is used to archive entries locally. -Locally means: in the tree, under a sibling. -See `org-archive-to-archive-sibling' for more information." - :group 'org-archive - :type 'string) - -(defcustom org-archive-mark-done nil - "Non-nil means mark entries as DONE when they are moved to the archive file. -This can be a string to set the keyword to use. When t, Org-mode will -use the first keyword in its list that means done." - :group 'org-archive - :type '(choice - (const :tag "No" nil) - (const :tag "Yes" t) - (string :tag "Use this keyword"))) - -(defcustom org-archive-stamp-time t - "Non-nil means add a time stamp to entries moved to an archive file. -This variable is obsolete and has no effect anymore, instead add or remove -`time' from the variable `org-archive-save-context-info'." - :group 'org-archive - :type 'boolean) - -(defcustom org-archive-file-header-format "\nArchived entries from file %s\n\n" - "The header format string for newly created archive files. -When nil, no header will be inserted. -When a string, a %s formatter will be replaced by the file name." - :group 'org-archive - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defcustom org-archive-subtree-add-inherited-tags 'infile - "Non-nil means append inherited tags when archiving a subtree." - :group 'org-archive - :version "24.1" - :type '(choice - (const :tag "Never" nil) - (const :tag "When archiving a subtree to the same file" infile) - (const :tag "Always" t))) - -(defcustom org-archive-save-context-info '(time file olpath category todo itags) - "Parts of context info that should be stored as properties when archiving. -When a subtree is moved to an archive file, it loses information given by -context, like inherited tags, the category, and possibly also the TODO -state (depending on the variable `org-archive-mark-done'). -This variable can be a list of any of the following symbols: - -time The time of archiving. -file The file where the entry originates. -ltags The local tags, in the headline of the subtree. -itags The tags the subtree inherits from further up the hierarchy. -todo The pre-archive TODO state. -category The category, taken from file name or #+CATEGORY lines. -olpath The outline path to the item. These are all headlines above - the current item, separated by /, like a file path. - -For each symbol present in the list, a property will be created in -the archived entry, with a prefix \"ARCHIVE_\", to remember this -information." - :group 'org-archive - :type '(set :greedy t - (const :tag "Time" time) - (const :tag "File" file) - (const :tag "Category" category) - (const :tag "TODO state" todo) - (const :tag "Priority" priority) - (const :tag "Inherited tags" itags) - (const :tag "Outline path" olpath) - (const :tag "Local tags" ltags))) - -(defun org-get-local-archive-location () - "Get the archive location applicable at point." - (let ((re "^#\\+ARCHIVE:[ \t]+\\(\\S-.*\\S-\\)[ \t]*$") - prop) - (save-excursion - (save-restriction - (widen) - (setq prop (org-entry-get nil "ARCHIVE" 'inherit)) - (cond - ((and prop (string-match "\\S-" prop)) - prop) - ((or (re-search-backward re nil t) - (re-search-forward re nil t)) - (match-string 1)) - (t org-archive-location)))))) - -;;;###autoload -(defun org-add-archive-files (files) - "Splice the archive files into the list of files. -This implies visiting all these files and finding out what the -archive file is." - (org-uniquify - (apply - 'append - (mapcar - (lambda (f) - (if (not (file-exists-p f)) - nil - (with-current-buffer (org-get-agenda-file-buffer f) - (cons f (org-all-archive-files))))) - files)))) - -(defun org-all-archive-files () - "Get a list of all archive files used in the current buffer." - (let (file files) - (save-excursion - (save-restriction - (goto-char (point-min)) - (while (re-search-forward - "^\\(#\\+\\|[ \t]*:\\)ARCHIVE:[ \t]+\\(.*\\)" - nil t) - (setq file (org-extract-archive-file - (org-match-string-no-properties 2))) - (and file (> (length file) 0) (file-exists-p file) - (add-to-list 'files file))))) - (setq files (nreverse files)) - (setq file (org-extract-archive-file)) - (and file (> (length file) 0) (file-exists-p file) - (add-to-list 'files file)) - files)) - -(defun org-extract-archive-file (&optional location) - "Extract and expand the file name from archive LOCATION. -if LOCATION is not given, the value of `org-archive-location' is used." - (setq location (or location org-archive-location)) - (if (string-match "\\(.*\\)::\\(.*\\)" location) - (if (= (match-beginning 1) (match-end 1)) - (buffer-file-name (buffer-base-buffer)) - (expand-file-name - (format (match-string 1 location) - (file-name-nondirectory - (buffer-file-name (buffer-base-buffer)))))))) - -(defun org-extract-archive-heading (&optional location) - "Extract the heading from archive LOCATION. -if LOCATION is not given, the value of `org-archive-location' is used." - (setq location (or location org-archive-location)) - (if (string-match "\\(.*\\)::\\(.*\\)" location) - (format (match-string 2 location) - (file-name-nondirectory - (buffer-file-name (buffer-base-buffer)))))) - -;;;###autoload -(defun org-archive-subtree (&optional find-done) - "Move the current subtree to the archive. -The archive can be a certain top-level heading in the current file, or in -a different file. The tree will be moved to that location, the subtree -heading be marked DONE, and the current time will be added. - -When called with prefix argument FIND-DONE, find whole trees without any -open TODO items and archive them (after getting confirmation from the user). -If the cursor is not at a headline when this command is called, try all level -1 trees. If the cursor is on a headline, only try the direct children of -this heading." - (interactive "P") - (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) - (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - `(progn (setq org-map-continue-from (progn (org-back-to-heading) (point))) - (org-archive-subtree ,find-done)) - org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (if find-done - (org-archive-all-done) - ;; Save all relevant TODO keyword-relatex variables - (let ((tr-org-todo-line-regexp org-todo-line-regexp) ; keep despite compiler - (tr-org-todo-keywords-1 org-todo-keywords-1) - (tr-org-todo-kwd-alist org-todo-kwd-alist) - (tr-org-done-keywords org-done-keywords) - (tr-org-todo-regexp org-todo-regexp) - (tr-org-todo-line-regexp org-todo-line-regexp) - (tr-org-odd-levels-only org-odd-levels-only) - (this-buffer (current-buffer)) - ;; start of variables that will be used for saving context - ;; The compiler complains about them - keep them anyway! - (file (abbreviate-file-name - (or (buffer-file-name (buffer-base-buffer)) - (error "No file associated to buffer")))) - (olpath (mapconcat 'identity (org-get-outline-path) "/")) - (time (format-time-string - (substring (cdr org-time-stamp-formats) 1 -1) - (current-time))) - category todo priority ltags itags atags - ;; end of variables that will be used for saving context - location afile heading buffer level newfile-p infile-p visiting - datetree-date datetree-subheading-p) - - ;; Find the local archive location - (setq location (org-get-local-archive-location) - afile (org-extract-archive-file location) - heading (org-extract-archive-heading location) - infile-p (equal file (abbreviate-file-name (or afile "")))) - (unless afile - (error "Invalid `org-archive-location'")) - - (if (> (length afile) 0) - (setq newfile-p (not (file-exists-p afile)) - visiting (find-buffer-visiting afile) - buffer (or visiting (find-file-noselect afile))) - (setq buffer (current-buffer))) - (unless buffer - (error "Cannot access file \"%s\"" afile)) - (when (string-match "\\`datetree/" heading) - ;; Replace with ***, to represent the 3 levels of headings the - ;; datetree has. - (setq heading (replace-regexp-in-string "\\`datetree/" "***" heading)) - (setq datetree-subheading-p (> (length heading) 3)) - (setq datetree-date (org-date-to-gregorian - (or (org-entry-get nil "CLOSED" t) time)))) - (if (and (> (length heading) 0) - (string-match "^\\*+" heading)) - (setq level (match-end 0)) - (setq heading nil level 0)) - (save-excursion - (org-back-to-heading t) - ;; Get context information that will be lost by moving the tree - (setq category (org-get-category nil 'force-refresh) - todo (and (looking-at org-todo-line-regexp) - (match-string 2)) - priority (org-get-priority - (if (match-end 3) (match-string 3) "")) - ltags (org-get-tags) - itags (org-delete-all ltags (org-get-tags-at)) - atags (org-get-tags-at)) - (setq ltags (mapconcat 'identity ltags " ") - itags (mapconcat 'identity itags " ")) - ;; We first only copy, in case something goes wrong - ;; we need to protect `this-command', to avoid kill-region sets it, - ;; which would lead to duplication of subtrees - (let (this-command) (org-copy-subtree 1 nil t)) - (set-buffer buffer) - ;; Enforce org-mode for the archive buffer - (if (not (derived-mode-p 'org-mode)) - ;; Force the mode for future visits. - (let ((org-insert-mode-line-in-empty-file t) - (org-inhibit-startup t)) - (call-interactively 'org-mode))) - (when (and newfile-p org-archive-file-header-format) - (goto-char (point-max)) - (insert (format org-archive-file-header-format - (buffer-file-name this-buffer)))) - (when datetree-date - (require 'org-datetree) - (org-datetree-find-date-create datetree-date) - (org-narrow-to-subtree)) - ;; Force the TODO keywords of the original buffer - (let ((org-todo-line-regexp tr-org-todo-line-regexp) - (org-todo-keywords-1 tr-org-todo-keywords-1) - (org-todo-kwd-alist tr-org-todo-kwd-alist) - (org-done-keywords tr-org-done-keywords) - (org-todo-regexp tr-org-todo-regexp) - (org-todo-line-regexp tr-org-todo-line-regexp) - (org-odd-levels-only - (if (local-variable-p 'org-odd-levels-only (current-buffer)) - org-odd-levels-only - tr-org-odd-levels-only))) - (goto-char (point-min)) - (show-all) - (if (and heading (not (and datetree-date (not datetree-subheading-p)))) - (progn - (if (re-search-forward - (concat "^" (regexp-quote heading) - (org-re "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)")) - nil t) - (goto-char (match-end 0)) - ;; Heading not found, just insert it at the end - (goto-char (point-max)) - (or (bolp) (insert "\n")) - ;; datetrees don't need too much spacing - (insert (if datetree-date "" "\n") heading "\n") - (end-of-line 0)) - ;; Make the subtree visible - (show-subtree) - (if org-archive-reversed-order - (progn - (org-back-to-heading t) - (outline-next-heading)) - (org-end-of-subtree t)) - (skip-chars-backward " \t\r\n") - (and (looking-at "[ \t\r\n]*") - ;; datetree archives don't need so much spacing. - (replace-match (if datetree-date "\n" "\n\n")))) - ;; No specific heading, just go to end of file. - (goto-char (point-max)) (unless datetree-date (insert "\n"))) - ;; Paste - (org-paste-subtree (org-get-valid-level level (and heading 1))) - ;; Shall we append inherited tags? - (and itags - (or (and (eq org-archive-subtree-add-inherited-tags 'infile) - infile-p) - (eq org-archive-subtree-add-inherited-tags t)) - (org-set-tags-to atags)) - ;; Mark the entry as done - (when (and org-archive-mark-done - (looking-at org-todo-line-regexp) - (or (not (match-end 2)) - (not (member (match-string 2) org-done-keywords)))) - (let (org-log-done org-todo-log-states) - (org-todo - (car (or (member org-archive-mark-done org-done-keywords) - org-done-keywords))))) - - ;; Add the context info - (when org-archive-save-context-info - (let ((l org-archive-save-context-info) e n v) - (while (setq e (pop l)) - (when (and (setq v (symbol-value e)) - (stringp v) (string-match "\\S-" v)) - (setq n (concat "ARCHIVE_" (upcase (symbol-name e)))) - (org-entry-put (point) n v))))) - - (widen) - ;; Save and kill the buffer, if it is not the same buffer. - (when (not (eq this-buffer buffer)) - (save-buffer)))) - ;; Here we are back in the original buffer. Everything seems to have - ;; worked. So now cut the tree and finish up. - (let (this-command) (org-cut-subtree)) - (when (featurep 'org-inlinetask) - (org-inlinetask-remove-END-maybe)) - (setq org-markers-to-move nil) - (message "Subtree archived %s" - (if (eq this-buffer buffer) - (concat "under heading: " heading) - (concat "in file: " (abbreviate-file-name afile)))))) - (org-reveal) - (if (looking-at "^[ \t]*$") - (outline-next-visible-heading 1)))) - -;;;###autoload -(defun org-archive-to-archive-sibling () - "Archive the current heading by moving it under the archive sibling. -The archive sibling is a sibling of the heading with the heading name -`org-archive-sibling-heading' and an `org-archive-tag' tag. If this -sibling does not exist, it will be created at the end of the subtree." - (interactive) - (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) - (let ((cl (when (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - '(progn (setq org-map-continue-from - (progn (org-back-to-heading) - (if (looking-at (concat "^.*:" org-archive-tag ":.*$")) - (org-end-of-subtree t) - (point)))) - (when (org-at-heading-p) - (org-archive-to-archive-sibling))) - org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (save-restriction - (widen) - (let (b e pos leader level) - (org-back-to-heading t) - (looking-at org-outline-regexp) - (setq leader (match-string 0) - level (funcall outline-level)) - (setq pos (point)) - (condition-case nil - (outline-up-heading 1 t) - (error (setq e (point-max)) (goto-char (point-min)))) - (setq b (point)) - (unless e - (condition-case nil - (org-end-of-subtree t t) - (error (goto-char (point-max)))) - (setq e (point))) - (goto-char b) - (unless (re-search-forward - (concat "^" (regexp-quote leader) - "[ \t]*" - org-archive-sibling-heading - "[ \t]*:" - org-archive-tag ":") e t) - (goto-char e) - (or (bolp) (newline)) - (insert leader org-archive-sibling-heading "\n") - (beginning-of-line 0) - (org-toggle-tag org-archive-tag 'on)) - (beginning-of-line 1) - (if org-archive-reversed-order - (outline-next-heading) - (org-end-of-subtree t t)) - (save-excursion - (goto-char pos) - (let ((this-command this-command)) (org-cut-subtree))) - (org-paste-subtree (org-get-valid-level level 1)) - (org-set-property - "ARCHIVE_TIME" - (format-time-string - (substring (cdr org-time-stamp-formats) 1 -1) - (current-time))) - (outline-up-heading 1 t) - (hide-subtree) - (org-cycle-show-empty-lines 'folded) - (goto-char pos))) - (org-reveal) - (if (looking-at "^[ \t]*$") - (outline-next-visible-heading 1)))) - -(defun org-archive-all-done (&optional tag) - "Archive sublevels of the current tree without open TODO items. -If the cursor is not on a headline, try all level 1 trees. If -it is on a headline, try all direct children. -When TAG is non-nil, don't move trees, but mark them with the ARCHIVE tag." - (let ((re org-not-done-heading-regexp) re1 - (rea (concat ".*:" org-archive-tag ":")) - (begm (make-marker)) - (endm (make-marker)) - (question (if tag "Set ARCHIVE tag (no open TODO items)? " - "Move subtree to archive (no open TODO items)? ")) - beg end (cntarch 0)) - (if (org-at-heading-p) - (progn - (setq re1 (concat "^" (regexp-quote - (make-string - (+ (- (match-end 0) (match-beginning 0) 1) - (if org-odd-levels-only 2 1)) - ?*)) - " ")) - (move-marker begm (point)) - (move-marker endm (org-end-of-subtree t))) - (setq re1 "^* ") - (move-marker begm (point-min)) - (move-marker endm (point-max))) - (save-excursion - (goto-char begm) - (while (re-search-forward re1 endm t) - (setq beg (match-beginning 0) - end (save-excursion (org-end-of-subtree t) (point))) - (goto-char beg) - (if (re-search-forward re end t) - (goto-char end) - (goto-char beg) - (if (and (or (not tag) (not (looking-at rea))) - (y-or-n-p question)) - (progn - (if tag - (org-toggle-tag org-archive-tag 'on) - (org-archive-subtree)) - (setq cntarch (1+ cntarch))) - (goto-char end))))) - (message "%d trees archived" cntarch))) - -;;;###autoload -(defun org-toggle-archive-tag (&optional find-done) - "Toggle the archive tag for the current headline. -With prefix ARG, check all children of current headline and offer tagging -the children that do not contain any open TODO items." - (interactive "P") - (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) - (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - `(org-toggle-archive-tag ,find-done) - org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (if find-done - (org-archive-all-done 'tag) - (let (set) - (save-excursion - (org-back-to-heading t) - (setq set (org-toggle-tag org-archive-tag)) - (when set (hide-subtree))) - (and set (beginning-of-line 1)) - (message "Subtree %s" (if set "archived" "unarchived")))))) - -(defun org-archive-set-tag () - "Set the ARCHIVE tag." - (interactive) - (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) - (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - 'org-archive-set-tag - org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (org-toggle-tag org-archive-tag 'on))) - -;;;###autoload -(defun org-archive-subtree-default () - "Archive the current subtree with the default command. -This command is set with the variable `org-archive-default-command'." - (interactive) - (call-interactively org-archive-default-command)) - -;;;###autoload -(defun org-archive-subtree-default-with-confirmation () - "Archive the current subtree with the default command. -This command is set with the variable `org-archive-default-command'." - (interactive) - (if (y-or-n-p "Archive this subtree or entry? ") - (call-interactively org-archive-default-command) - (error "Abort"))) - -(provide 'org-archive) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-archive.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-attach.el b/xemacs-packages/lisp/org-8.2.3c/org-attach.el deleted file mode 100644 index 898d9116..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-attach.el +++ /dev/null @@ -1,483 +0,0 @@ -;;; org-attach.el --- Manage file attachments to org-mode tasks - -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. - -;; Author: John Wiegley -;; Keywords: org data task - -;; 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 . - -;;; Commentary: - -;; See the Org-mode manual for information on how to use it. -;; -;; Attachments are managed in a special directory called "data", which -;; lives in the same directory as the org file itself. If this data -;; directory is initialized as a Git repository, then org-attach will -;; automatically commit changes when it sees them. -;; -;; Attachment directories are identified using a UUID generated for the -;; task which has the attachments. These are added as property to the -;; task when necessary, and should not be deleted or changed by the -;; user, ever. UUIDs are generated by a mechanism defined in the variable -;; `org-id-method'. - -;;; Code: - -(eval-when-compile - (require 'cl)) -(require 'org-id) -(require 'org) - -(declare-function vc-git-root "vc-git" (file)) - -(defgroup org-attach nil - "Options concerning entry attachments in Org-mode." - :tag "Org Attach" - :group 'org) - -(defcustom org-attach-directory "data/" - "The directory where attachments are stored. -If this is a relative path, it will be interpreted relative to the directory -where the Org file lives." - :group 'org-attach - :type 'directory) - -(defcustom org-attach-git-annex-cutoff (* 32 1024) - "If non-nil, files larger than this will be annexed instead of stored." - :group 'org-attach - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (const :tag "None" nil) - (integer :tag "Bytes"))) - -(defcustom org-attach-auto-tag "ATTACH" - "Tag that will be triggered automatically when an entry has an attachment." - :group 'org-attach - :type '(choice - (const :tag "None" nil) - (string :tag "Tag"))) - -(defcustom org-attach-file-list-property "Attachments" - "The property used to keep a list of attachment belonging to this entry. -This is not really needed, so you may set this to nil if you don't want it. -Also, for entries where children inherit the directory, the list of -attachments is not kept in this property." - :group 'org-attach - :type '(choice - (const :tag "None" nil) - (string :tag "Tag"))) - -(defcustom org-attach-method 'cp - "The preferred method to attach a file. -Allowed values are: - -mv rename the file to move it into the attachment directory -cp copy the file -ln create a hard link. Note that this is not supported - on all systems, and then the result is not defined. -lns create a symbol link. Note that this is not supported - on all systems, and then the result is not defined." - :group 'org-attach - :type '(choice - (const :tag "Copy" cp) - (const :tag "Move/Rename" mv) - (const :tag "Hard Link" ln) - (const :tag "Symbol Link" lns))) - -(defcustom org-attach-expert nil - "Non-nil means do not show the splash buffer with the attach dispatcher." - :group 'org-attach - :type 'boolean) - -(defcustom org-attach-allow-inheritance t - "Non-nil means allow attachment directories be inherited." - :group 'org-attach - :type 'boolean) - -(defvar org-attach-inherited nil - "Indicates if the last access to the attachment directory was inherited.") - -(defcustom org-attach-store-link-p nil - "Non-nil means store a link to a file when attaching it." - :group 'org-attach - :version "24.1" - :type '(choice - (const :tag "Don't store link" nil) - (const :tag "Link to origin location" t) - (const :tag "Link to the attach-dir location" attached))) - -;;;###autoload -(defun org-attach () - "The dispatcher for attachment commands. -Shows a list of commands and prompts for another key to execute a command." - (interactive) - (let (c marker) - (when (eq major-mode 'org-agenda-mode) - (setq marker (or (get-text-property (point) 'org-hd-marker) - (get-text-property (point) 'org-marker))) - (unless marker - (error "No task in current line"))) - (save-excursion - (when marker - (set-buffer (marker-buffer marker)) - (goto-char marker)) - (org-back-to-heading t) - (save-excursion - (save-window-excursion - (unless org-attach-expert - (with-output-to-temp-buffer "*Org Attach*" - (princ "Select an Attachment Command: - -a Select a file and attach it to the task, using `org-attach-method'. -c/m/l/y Attach a file using copy/move/link/symbolic-link method. -n Create a new attachment, as an Emacs buffer. -z Synchronize the current task with its attachment - directory, in case you added attachments yourself. - -o Open current task's attachments. -O Like \"o\", but force opening in Emacs. -f Open current task's attachment directory. -F Like \"f\", but force using dired in Emacs. - -d Delete one attachment, you will be prompted for a file name. -D Delete all of a task's attachments. A safer way is - to open the directory in dired and delete from there. - -s Set a specific attachment directory for this entry. -i Make children of the current entry inherit its attachment directory."))) - (org-fit-window-to-buffer (get-buffer-window "*Org Attach*")) - (message "Select command: [acmlzoOfFdD]") - (setq c (read-char-exclusive)) - (and (get-buffer "*Org Attach*") (kill-buffer "*Org Attach*")))) - (cond - ((memq c '(?a ?\C-a)) (call-interactively 'org-attach-attach)) - ((memq c '(?c ?\C-c)) - (let ((org-attach-method 'cp)) (call-interactively 'org-attach-attach))) - ((memq c '(?m ?\C-m)) - (let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach))) - ((memq c '(?l ?\C-l)) - (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach))) - ((memq c '(?y ?\C-y)) - (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach))) - ((memq c '(?n ?\C-n)) (call-interactively 'org-attach-new)) - ((memq c '(?z ?\C-z)) (call-interactively 'org-attach-sync)) - ((memq c '(?o ?\C-o)) (call-interactively 'org-attach-open)) - ((eq c ?O) (call-interactively 'org-attach-open-in-emacs)) - ((memq c '(?f ?\C-f)) (call-interactively 'org-attach-reveal)) - ((memq c '(?F)) (call-interactively 'org-attach-reveal-in-emacs)) - ((memq c '(?d ?\C-d)) (call-interactively - 'org-attach-delete-one)) - ((eq c ?D) (call-interactively 'org-attach-delete-all)) - ((eq c ?q) (message "Abort")) - ((memq c '(?s ?\C-s)) (call-interactively - 'org-attach-set-directory)) - ((memq c '(?i ?\C-i)) (call-interactively - 'org-attach-set-inherit)) - (t (error "No such attachment command %c" c)))))) - -(defun org-attach-dir (&optional create-if-not-exists-p) - "Return the directory associated with the current entry. -This first checks for a local property ATTACH_DIR, and then for an inherited -property ATTACH_DIR_INHERIT. If neither exists, the default mechanism -using the entry ID will be invoked to access the unique directory for the -current entry. -If the directory does not exist and CREATE-IF-NOT-EXISTS-P is non-nil, -the directory and (if necessary) the corresponding ID will be created." - (let (attach-dir uuid inherit) - (setq org-attach-inherited (org-entry-get nil "ATTACH_DIR_INHERIT")) - (cond - ((setq attach-dir (org-entry-get nil "ATTACH_DIR")) - (org-attach-check-absolute-path attach-dir)) - ((and org-attach-allow-inheritance - (setq inherit (org-entry-get nil "ATTACH_DIR_INHERIT" t))) - (setq attach-dir - (save-excursion - (save-restriction - (widen) - (goto-char org-entry-property-inherited-from) - (let (org-attach-allow-inheritance) - (org-attach-dir create-if-not-exists-p))))) - (org-attach-check-absolute-path attach-dir) - (setq org-attach-inherited t)) - (t ; use the ID - (org-attach-check-absolute-path nil) - (setq uuid (org-id-get (point) create-if-not-exists-p)) - (when (or uuid create-if-not-exists-p) - (unless uuid (error "ID retrieval/creation failed")) - (setq attach-dir (expand-file-name - (format "%s/%s" - (substring uuid 0 2) - (substring uuid 2)) - (expand-file-name org-attach-directory)))))) - (when attach-dir - (if (and create-if-not-exists-p - (not (file-directory-p attach-dir))) - (make-directory attach-dir t)) - (and (file-exists-p attach-dir) - attach-dir)))) - -(defun org-attach-check-absolute-path (dir) - "Check if we have enough information to root the attachment directory. -When DIR is given, check also if it is already absolute. Otherwise, -assume that it will be relative, and check if `org-attach-directory' is -absolute, or if at least the current buffer has a file name. -Throw an error if we cannot root the directory." - (or (and dir (file-name-absolute-p dir)) - (file-name-absolute-p org-attach-directory) - (buffer-file-name (buffer-base-buffer)) - (error "Need absolute `org-attach-directory' to attach in buffers without filename"))) - -(defun org-attach-set-directory () - "Set the ATTACH_DIR property of the current entry. -The property defines the directory that is used for attachments -of the entry." - (interactive) - (let ((dir (org-entry-get nil "ATTACH_DIR"))) - (setq dir (read-directory-name "Attachment directory: " dir)) - (org-entry-put nil "ATTACH_DIR" dir))) - -(defun org-attach-set-inherit () - "Set the ATTACH_DIR_INHERIT property of the current entry. -The property defines the directory that is used for attachments -of the entry and any children that do not explicitly define (by setting -the ATTACH_DIR property) their own attachment directory." - (interactive) - (org-entry-put nil "ATTACH_DIR_INHERIT" "t") - (message "Children will inherit attachment directory")) - -(defun org-attach-commit () - "Commit changes to git if `org-attach-directory' is properly initialized. -This checks for the existence of a \".git\" directory in that directory." - (let* ((dir (expand-file-name org-attach-directory)) - (git-dir (vc-git-root dir)) - (changes 0)) - (when git-dir - (with-temp-buffer - (cd dir) - (let ((have-annex - (and org-attach-git-annex-cutoff - (file-exists-p (expand-file-name "annex" git-dir))))) - (dolist (new-or-modified - (split-string - (shell-command-to-string - "git ls-files -zmo --exclude-standard") "\0" t)) - (if (and have-annex - (>= (nth 7 (file-attributes new-or-modified)) - org-attach-git-annex-cutoff)) - (call-process "git" nil nil nil "annex" "add" new-or-modified) - (call-process "git" nil nil nil "add" new-or-modified)) - (incf changes))) - (dolist (deleted - (split-string - (shell-command-to-string "git ls-files -z --deleted") "\0" t)) - (call-process "git" nil nil nil "rm" deleted) - (incf changes)) - (when (> changes 0) - (shell-command "git commit -m 'Synchronized attachments'")))))) - -(defun org-attach-tag (&optional off) - "Turn the autotag on or (if OFF is set) off." - (when org-attach-auto-tag - (save-excursion - (org-back-to-heading t) - (org-toggle-tag org-attach-auto-tag (if off 'off 'on))))) - -(defun org-attach-untag () - "Turn the autotag off." - (org-attach-tag 'off)) - -(defun org-attach-store-link (file) - "Add a link to `org-stored-link' when attaching a file. -Only do this when `org-attach-store-link-p' is non-nil." - (setq org-stored-links - (cons (list (org-attach-expand-link file) - (file-name-nondirectory file)) - org-stored-links))) - -(defun org-attach-attach (file &optional visit-dir method) - "Move/copy/link FILE into the attachment directory of the current task. -If VISIT-DIR is non-nil, visit the directory with dired. -METHOD may be `cp', `mv', `ln', or `lns' default taken from -`org-attach-method'." - (interactive "fFile to keep as an attachment: \nP") - (setq method (or method org-attach-method)) - (let ((basename (file-name-nondirectory file))) - (when (and org-attach-file-list-property (not org-attach-inherited)) - (org-entry-add-to-multivalued-property - (point) org-attach-file-list-property basename)) - (let* ((attach-dir (org-attach-dir t)) - (fname (expand-file-name basename attach-dir))) - (cond - ((eq method 'mv) (rename-file file fname)) - ((eq method 'cp) (copy-file file fname)) - ((eq method 'ln) (add-name-to-file file fname)) - ((eq method 'lns) (make-symbolic-link file fname))) - (org-attach-commit) - (org-attach-tag) - (cond ((eq org-attach-store-link-p 'attached) - (org-attach-store-link fname)) - ((eq org-attach-store-link-p t) - (org-attach-store-link file))) - (if visit-dir - (dired attach-dir) - (message "File \"%s\" is now a task attachment." basename))))) - -(defun org-attach-attach-cp () - "Attach a file by copying it." - (interactive) - (let ((org-attach-method 'cp)) (call-interactively 'org-attach-attach))) -(defun org-attach-attach-mv () - "Attach a file by moving (renaming) it." - (interactive) - (let ((org-attach-method 'mv)) (call-interactively 'org-attach-attach))) -(defun org-attach-attach-ln () - "Attach a file by creating a hard link to it. -Beware that this does not work on systems that do not support hard links. -On some systems, this apparently does copy the file instead." - (interactive) - (let ((org-attach-method 'ln)) (call-interactively 'org-attach-attach))) -(defun org-attach-attach-lns () - "Attach a file by creating a symbolic link to it. - -Beware that this does not work on systems that do not support symbolic links. -On some systems, this apparently does copy the file instead." - (interactive) - (let ((org-attach-method 'lns)) (call-interactively 'org-attach-attach))) - -(defun org-attach-new (file) - "Create a new attachment FILE for the current task. -The attachment is created as an Emacs buffer." - (interactive "sCreate attachment named: ") - (when (and org-attach-file-list-property (not org-attach-inherited)) - (org-entry-add-to-multivalued-property - (point) org-attach-file-list-property file)) - (let ((attach-dir (org-attach-dir t))) - (org-attach-tag) - (find-file (expand-file-name file attach-dir)) - (message "New attachment %s" file))) - -(defun org-attach-delete-one (&optional file) - "Delete a single attachment." - (interactive) - (let* ((attach-dir (org-attach-dir t)) - (files (org-attach-file-list attach-dir)) - (file (or file - (org-icompleting-read - "Delete attachment: " - (mapcar (lambda (f) - (list (file-name-nondirectory f))) - files))))) - (setq file (expand-file-name file attach-dir)) - (unless (file-exists-p file) - (error "No such attachment: %s" file)) - (delete-file file) - (org-attach-commit))) - -(defun org-attach-delete-all (&optional force) - "Delete all attachments from the current task. -This actually deletes the entire attachment directory. -A safer way is to open the directory in dired and delete from there." - (interactive "P") - (when (and org-attach-file-list-property (not org-attach-inherited)) - (org-entry-delete (point) org-attach-file-list-property)) - (let ((attach-dir (org-attach-dir))) - (when - (and attach-dir - (or force - (y-or-n-p "Are you sure you want to remove all attachments of this entry? "))) - (shell-command (format "rm -fr %s" attach-dir)) - (message "Attachment directory removed") - (org-attach-commit) - (org-attach-untag)))) - -(defun org-attach-sync () - "Synchronize the current tasks with its attachments. -This can be used after files have been added externally." - (interactive) - (org-attach-commit) - (when (and org-attach-file-list-property (not org-attach-inherited)) - (org-entry-delete (point) org-attach-file-list-property)) - (let ((attach-dir (org-attach-dir))) - (when attach-dir - (let ((files (org-attach-file-list attach-dir))) - (and files (org-attach-tag)) - (when org-attach-file-list-property - (dolist (file files) - (unless (string-match "^\\." file) - (org-entry-add-to-multivalued-property - (point) org-attach-file-list-property file)))))))) - -(defun org-attach-file-list (dir) - "Return a list of files in the attachment directory. -This ignores files starting with a \".\", and files ending in \"~\"." - (delq nil - (mapcar (lambda (x) (if (string-match "^\\." x) nil x)) - (directory-files dir nil "[^~]\\'")))) - -(defun org-attach-reveal (&optional if-exists) - "Show the attachment directory of the current task. -This will attempt to use an external program to show the directory." - (interactive "P") - (let ((attach-dir (org-attach-dir (not if-exists)))) - (and attach-dir (org-open-file attach-dir)))) - -(defun org-attach-reveal-in-emacs () - "Show the attachment directory of the current task in dired." - (interactive) - (let ((attach-dir (org-attach-dir t))) - (dired attach-dir))) - -(defun org-attach-open (&optional in-emacs) - "Open an attachment of the current task. -If there are more than one attachment, you will be prompted for the file name. -This command will open the file using the settings in `org-file-apps' -and in the system-specific variants of this variable. -If IN-EMACS is non-nil, force opening in Emacs." - (interactive "P") - (let* ((attach-dir (org-attach-dir t)) - (files (org-attach-file-list attach-dir)) - (file (if (= (length files) 1) - (car files) - (org-icompleting-read "Open attachment: " - (mapcar 'list files) nil t)))) - (org-open-file (expand-file-name file attach-dir) in-emacs))) - -(defun org-attach-open-in-emacs () - "Open attachment, force opening in Emacs. -See `org-attach-open'." - (interactive) - (org-attach-open 'in-emacs)) - -(defun org-attach-expand (file) - "Return the full path to the current entry's attachment file FILE. -Basically, this adds the path to the attachment directory." - (expand-file-name file (org-attach-dir))) - -(defun org-attach-expand-link (file) - "Return a file link pointing to the current entry's attachment file FILE. -Basically, this adds the path to the attachment directory, and a \"file:\" -prefix." - (concat "file:" (org-attach-expand file))) - -(provide 'org-attach) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-attach.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-bbdb.el b/xemacs-packages/lisp/org-8.2.3c/org-bbdb.el deleted file mode 100644 index f122b67e..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-bbdb.el +++ /dev/null @@ -1,445 +0,0 @@ -;;; org-bbdb.el --- Support for links to BBDB entries from within Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Authors: Carsten Dominik -;; Thomas Baumann -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file implements links to BBDB database entries from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;; It also implements an interface (based on Ivar Rummelhoff's -;; bbdb-anniv.el) for those org-mode users, who do not use the diary -;; but who do want to include the anniversaries stored in the BBDB -;; into the org-agenda. If you already include the `diary' into the -;; agenda, you might want to prefer to include the anniversaries in -;; the diary using bbdb-anniv.el. -;; -;; Put the following in /somewhere/at/home/diary.org and make sure -;; that this file is in `org-agenda-files` -;; -;; %%(org-bbdb-anniversaries) -;; -;; For example my diary.org looks like: -;; * Anniversaries -;; #+CATEGORY: Anniv -;; %%(org-bbdb-anniversaries) -;; -;; -;; To add an anniversary to a BBDB record, press `C-o' in the record. -;; You will be prompted for the field name, in this case it must be -;; "anniversary". If this is the first time you are using this field, -;; you need to confirm that it should be created. -;; -;; The format of an anniversary field stored in BBDB is the following -;; (items in {} are optional): -;; -;; YYYY-MM-DD{ CLASS-OR-FORMAT-STRING} -;; {\nYYYY-MM-DD CLASS-OR-FORMAT-STRING}... -;; -;; CLASS-OR-FORMAT-STRING is one of two things: -;; -;; - an identifier for a class of anniversaries (eg. birthday or -;; wedding) from `org-bbdb-anniversary-format-alist' which then -;; defines the format string for this class -;; - the (format) string displayed in the diary. -;; -;; You can enter multiple anniversaries for a single BBDB record by -;; separating them with a newline character. At the BBDB prompt for -;; the field value, type `C-q C-j' to enter a newline between two -;; anniversaries. -;; -;; If you omit the CLASS-OR-FORMAT-STRING entirely, it defaults to the -;; value of `org-bbdb-default-anniversary-format' ("birthday" by -;; default). -;; -;; The substitutions in the format string are (in order): -;; - the name of the record containing this anniversary -;; - the number of years -;; - an ordinal suffix (st, nd, rd, th) for the year -;; -;; See the documentation of `org-bbdb-anniversary-format-alist' for -;; further options. -;; -;; Example -;; -;; 1973-06-22 -;; 20??-??-?? wedding -;; 1998-03-12 %s created bbdb-anniv.el %d years ago -;; -;; From Org's agenda, you can use `C-c C-o' to jump to the BBDB -;; link from which the entry at point originates. -;; -;;; Code: - -(require 'org) -(eval-when-compile - (require 'cl)) - -;; Declare external functions and variables - -(declare-function bbdb "ext:bbdb-com" (string elidep)) -(declare-function bbdb-company "ext:bbdb-com" (string elidep)) -(declare-function bbdb-current-record "ext:bbdb-com" - (&optional planning-on-modifying)) -(declare-function bbdb-name "ext:bbdb-com" (string elidep)) -(declare-function bbdb-completing-read-record "ext:bbdb-com" - (prompt &optional omit-records)) -(declare-function bbdb-record-getprop "ext:bbdb" (record property)) -(declare-function bbdb-record-name "ext:bbdb" (record)) -(declare-function bbdb-records "ext:bbdb" - (&optional dont-check-disk already-in-db-buffer)) -(declare-function bbdb-split "ext:bbdb" (string separators)) -(declare-function bbdb-string-trim "ext:bbdb" (string)) -(declare-function bbdb-record-get-field "ext:bbdb" (record field)) -(declare-function bbdb-search-name "ext:bbdb-com" (regexp &optional layout)) -(declare-function bbdb-search-organization "ext:bbdb-com" (regexp &optional layout)) - -;; `bbdb-record-note' was part of BBDB v3.x -(declare-function bbdb-record-note "ext:bbdb" (record label)) -;; `bbdb-record-xfield' replaces it in recent BBDB v3.x+ -(declare-function bbdb-record-xfield "ext:bbdb" (record label)) - -(declare-function calendar-leap-year-p "calendar" (year)) -(declare-function diary-ordinal-suffix "diary-lib" (n)) - -(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el - -;; Customization - -(defgroup org-bbdb-anniversaries nil - "Customizations for including anniversaries from BBDB into Agenda." - :group 'org-bbdb) - -(defcustom org-bbdb-default-anniversary-format "birthday" - "Default anniversary class." - :type 'string - :group 'org-bbdb-anniversaries - :require 'bbdb) - -(defcustom org-bbdb-anniversary-format-alist - '(("birthday" . - (lambda (name years suffix) - (concat "Birthday: [[bbdb:" name "][" name " (" - (format "%s" years) ; handles numbers as well as strings - suffix ")]]"))) - ("wedding" . - (lambda (name years suffix) - (concat "[[bbdb:" name "][" name "'s " - (format "%s" years) - suffix " wedding anniversary]]")))) - "How different types of anniversaries should be formatted. -An alist of elements (STRING . FORMAT) where STRING is the name of an -anniversary class and format is either: -1) A format string with the following substitutions (in order): - - the name of the record containing this anniversary - - the number of years - - an ordinal suffix (st, nd, rd, th) for the year - -2) A function to be called with three arguments: NAME YEARS SUFFIX - (string int string) returning a string for the diary or nil. - -3) An Emacs Lisp form that should evaluate to a string (or nil) in the - scope of variables NAME, YEARS and SUFFIX (among others)." - :type '(alist :key-type (string :tag "Class") - :value-type (function :tag "Function")) - :group 'org-bbdb-anniversaries - :require 'bbdb) - -(defcustom org-bbdb-anniversary-field 'anniversary - "The BBDB field which contains anniversaries. -The anniversaries are stored in the following format - -YYYY-MM-DD Class-or-Format-String - -where class is one of the customized classes for anniversaries; -birthday and wedding are predefined. Format-String can take three -substitutions 1) the name of the record containing this -anniversary, 2) the number of years, and 3) an ordinal suffix for -the year. - -Multiple anniversaries can be separated by \\n." - :type 'symbol - :group 'org-bbdb-anniversaries - :require 'bbdb) - -(defcustom org-bbdb-extract-date-fun 'org-bbdb-anniv-extract-date - "How to retrieve `month date year' from the anniversary field. - -Customize if you have already filled your BBDB with dates -different from YYYY-MM-DD. The function must return a list (month -date year)." - :type 'function - :group 'org-bbdb-anniversaries - :require 'bbdb) - - -;; Install the link type -(org-add-link-type "bbdb" 'org-bbdb-open 'org-bbdb-export) -(add-hook 'org-store-link-functions 'org-bbdb-store-link) - -;; Implementation -(defun org-bbdb-store-link () - "Store a link to a BBDB database entry." - (when (eq major-mode 'bbdb-mode) - ;; This is BBDB, we make this link! - (let* ((rec (bbdb-current-record)) - (name (bbdb-record-name rec)) - (company (if (fboundp 'bbdb-record-getprop) - (bbdb-record-getprop rec 'company) - (car (bbdb-record-get-field rec 'organization)))) - (link (concat "bbdb:" name))) - (org-store-link-props :type "bbdb" :name name :company company - :link link :description name) - link))) - -(defun org-bbdb-export (path desc format) - "Create the export version of a BBDB link specified by PATH or DESC. -If exporting to either HTML or LaTeX FORMAT the link will be -italicized, in all other cases it is left unchanged." - (when (string= desc (format "bbdb:%s" path)) - (setq desc path)) - (cond - ((eq format 'html) (format "%s" desc)) - ((eq format 'latex) (format "\\textit{%s}" desc)) - ((eq format 'odt) - (format "%s" desc)) - (t desc))) - -(defun org-bbdb-open (name) - "Follow a BBDB link to NAME." - (require 'bbdb-com) - (let ((inhibit-redisplay (not debug-on-error)) - (bbdb-electric-p nil)) - (if (fboundp 'bbdb-name) - (org-bbdb-open-old name) - (org-bbdb-open-new name)))) - -(defun org-bbdb-open-old (name) - (catch 'exit - ;; Exact match on name - (bbdb-name (concat "\\`" name "\\'") nil) - (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) - ;; Exact match on name - (bbdb-company (concat "\\`" name "\\'") nil) - (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) - ;; Partial match on name - (bbdb-name name nil) - (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) - ;; Partial match on company - (bbdb-company name nil) - (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) - ;; General match including network address and notes - (bbdb name nil) - (when (= 0 (buffer-size (get-buffer "*BBDB*"))) - (delete-window (get-buffer-window "*BBDB*")) - (error "No matching BBDB record")))) - -(defun org-bbdb-open-new (name) - (catch 'exit - ;; Exact match on name - (bbdb-search-name (concat "\\`" name "\\'") nil) - (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) - ;; Exact match on name - (bbdb-search-organization (concat "\\`" name "\\'") nil) - (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) - ;; Partial match on name - (bbdb-search-name name nil) - (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) - ;; Partial match on company - (bbdb-search-organization name nil) - (if (< 0 (buffer-size (get-buffer "*BBDB*"))) (throw 'exit nil)) - ;; General match including network address and notes - (bbdb name nil) - (when (= 0 (buffer-size (get-buffer "*BBDB*"))) - (delete-window (get-buffer-window "*BBDB*")) - (error "No matching BBDB record")))) - -(defun org-bbdb-anniv-extract-date (time-str) - "Convert YYYY-MM-DD to (month date year). -Argument TIME-STR is the value retrieved from BBDB. If YYYY- is omitted -it will be considered unknown." - (multiple-value-bind (a b c) (values-list (org-split-string time-str "-")) - (if (eq c nil) - (list (string-to-number a) - (string-to-number b) - nil) - (list (string-to-number b) - (string-to-number c) - (string-to-number a))))) - -(defun org-bbdb-anniv-split (str) - "Split multiple entries in the BBDB anniversary field. -Argument STR is the anniversary field in BBDB." - (let ((pos (string-match "[ \t]" str))) - (if pos (list (substring str 0 pos) - (bbdb-string-trim (substring str pos))) - (list str nil)))) - -(defvar org-bbdb-anniv-hash nil - "A hash holding anniversaries extracted from BBDB. -The hash table is created on first use.") - -(defvar org-bbdb-updated-p t - "This is non-nil if BBDB has been updated since we last built the hash.") - -(defun org-bbdb-make-anniv-hash () - "Create a hash with anniversaries extracted from BBDB, for fast access. -The anniversaries are assumed to be stored `org-bbdb-anniversary-field'." - (let ((old-bbdb (fboundp 'bbdb-record-getprop)) - (record-func (if (fboundp 'bbdb-record-xfield) - 'bbdb-record-xfield - 'bbdb-record-note)) - split tmp annivs) - (clrhash org-bbdb-anniv-hash) - (dolist (rec (bbdb-records)) - (when (setq annivs (if old-bbdb - (bbdb-record-getprop - rec org-bbdb-anniversary-field) - (funcall record-func - rec org-bbdb-anniversary-field))) - (setq annivs (if old-bbdb - (bbdb-split annivs "\n") - ;; parameter order is reversed in new bbdb - (bbdb-split "\n" annivs))) - (while annivs - (setq split (org-bbdb-anniv-split (pop annivs))) - (multiple-value-bind (m d y) - (values-list (funcall org-bbdb-extract-date-fun (car split))) - (setq tmp (gethash (list m d) org-bbdb-anniv-hash)) - (puthash (list m d) (cons (list y - (bbdb-record-name rec) - (cadr split)) - tmp) - org-bbdb-anniv-hash)))))) - (setq org-bbdb-updated-p nil)) - -(defun org-bbdb-updated (rec) - "Record the fact that BBDB has been updated. -This is used by Org to re-create the anniversary hash table." - (setq org-bbdb-updated-p t)) - -(add-hook 'bbdb-after-change-hook 'org-bbdb-updated) - -;;;###autoload -(defun org-bbdb-anniversaries () - "Extract anniversaries from BBDB for display in the agenda." - (require 'bbdb) - (require 'diary-lib) - (unless (hash-table-p org-bbdb-anniv-hash) - (setq org-bbdb-anniv-hash - (make-hash-table :test 'equal :size 366))) - - (when (or org-bbdb-updated-p - (= 0 (hash-table-count org-bbdb-anniv-hash))) - (org-bbdb-make-anniv-hash)) - - (let* ((m (car date)) ; month - (d (nth 1 date)) ; day - (y (nth 2 date)) ; year - (annivs (gethash (list m d) org-bbdb-anniv-hash)) - (text ()) - rec recs) - - ;; we don't want to miss people born on Feb. 29th - (when (and (= m 3) (= d 1) - (not (null (gethash (list 2 29) org-bbdb-anniv-hash))) - (not (calendar-leap-year-p y))) - (setq recs (gethash (list 2 29) org-bbdb-anniv-hash)) - (while (setq rec (pop recs)) - (push rec annivs))) - - (when annivs - (while (setq rec (pop annivs)) - (when rec - (let* ((class (or (nth 2 rec) - org-bbdb-default-anniversary-format)) - (form (or (cdr (assoc-string - class org-bbdb-anniversary-format-alist t)) - class)) ; (as format string) - (name (nth 1 rec)) - (years (if (eq (car rec) nil) - "unknown" - (- y (car rec)))) - (suffix (if (eq (car rec) nil) - "" - (diary-ordinal-suffix years))) - (tmp (cond - ((functionp form) - (funcall form name years suffix)) - ((listp form) (eval form)) - (t (format form name years suffix))))) - (org-add-props tmp nil 'org-bbdb-name name) - (if text - (setq text (append text (list tmp))) - (setq text (list tmp))))) - )) - text)) - -(defun org-bbdb-complete-link () - "Read a bbdb link with name completion." - (require 'bbdb-com) - (concat "bbdb:" - (bbdb-record-name (car (bbdb-completing-read-record "Name: "))))) - -(defun org-bbdb-anniv-export-ical () - "Extract anniversaries from BBDB and convert them to icalendar format." - (require 'bbdb) - (require 'diary-lib) - (unless (hash-table-p org-bbdb-anniv-hash) - (setq org-bbdb-anniv-hash - (make-hash-table :test 'equal :size 366))) - (when (or org-bbdb-updated-p - (= 0 (hash-table-count org-bbdb-anniv-hash))) - (org-bbdb-make-anniv-hash)) - (maphash 'org-bbdb-format-vevent org-bbdb-anniv-hash)) - -(defun org-bbdb-format-vevent (key recs) - (let (rec categ) - (while (setq rec (pop recs)) - (setq categ (or (nth 2 rec) org-bbdb-default-anniversary-format)) - (princ (format "BEGIN:VEVENT -UID: ANNIV-%4i%02i%02i-%s -DTSTART:%4i%02i%02i -SUMMARY:%s -DESCRIPTION:%s -CATEGORIES:%s -RRULE:FREQ=YEARLY -END:VEVENT\n" - (nth 0 rec) (nth 0 key) (nth 1 key) - (mapconcat 'identity - (org-split-string (nth 1 rec) "[^a-zA-Z0-90]+") - "-") - (nth 0 rec) (nth 0 key) (nth 1 key) - (nth 1 rec) - (concat (capitalize categ) " " (nth 1 rec)) - categ))))) - -(provide 'org-bbdb) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-bbdb.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-bibtex.el b/xemacs-packages/lisp/org-8.2.3c/org-bibtex.el deleted file mode 100644 index 52643994..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-bibtex.el +++ /dev/null @@ -1,719 +0,0 @@ -;;; org-bibtex.el --- Org links to BibTeX entries -;; -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. -;; -;; Authors: Bastien Guerry -;; Carsten Dominik -;; Eric Schulte -;; Keywords: org, wp, capture -;; -;; 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 . -;; -;;; Commentary: -;; -;; This file implements links to database entries in BibTeX files. -;; Instead of defining a special link prefix, it uses the normal file -;; links combined with a custom search mechanism to find entries -;; by reference key. And it constructs a nice description tag for -;; the link that contains the author name, the year and a short title. -;; -;; It also stores detailed information about the entry so that -;; capture templates can access and enter this information easily. -;; -;; The available properties for each entry are listed here: -;; -;; :author :publisher :volume :pages -;; :editor :url :number :journal -;; :title :year :series :address -;; :booktitle :month :annote :abstract -;; :key :btype -;; -;; Here is an example of a capture template that use some of this -;; information (:author :year :title :journal :pages): -;; -;; (setq org-capure-templates -;; '((?b "* READ %?\n\n%a\n\n%:author (%:year): %:title\n \ -;; In %:journal, %:pages."))) -;; -;; Let's say you want to capture this BibTeX entry: -;; -;; @Article{dolev83, -;; author = {Danny Dolev and Andrew C. Yao}, -;; title = {On the security of public-key protocols}, -;; journal = {IEEE Transaction on Information Theory}, -;; year = 1983, -;; volume = 2, -;; number = 29, -;; pages = {198--208}, -;; month = {Mars} -;; } -;; -;; M-x `org-capture' on this entry will produce this buffer: -;; -;; ===================================================================== -;; * READ <== [point here] -;; -;; [[file:file.bib::dolev83][Dolev & Yao 1983: security of public key protocols]] -;; -;; Danny Dolev and Andrew C. Yao (1983): On the security of public-key protocols -;; In IEEE Transaction on Information Theory, 198--208. -;; ===================================================================== -;; -;; Additionally, the following functions are now available for storing -;; bibtex entries within Org-mode documents. -;; -;; - Run `org-bibtex' to export the current file to a .bib. -;; -;; - Run `org-bibtex-check' or `org-bibtex-check-all' to check and -;; fill in missing field of either the current, or all headlines -;; -;; - Run `org-bibtex-create' to add a bibtex entry -;; -;; - Use `org-bibtex-read' to read a bibtex entry after `point' or in -;; the active region, then call `org-bibtex-write' in a .org file to -;; insert a heading for the read bibtex entry -;; -;; - All Bibtex information is taken from the document compiled by -;; Andrew Roberts from the Bibtex manual, available at -;; http://www.andy-roberts.net/res/writing/latex/bibentries.pdf -;; -;;; History: -;; -;; The link creation part has been part of Org-mode for a long time. -;; -;; Creating better capture template information was inspired by a request -;; of Austin Frank: http://article.gmane.org/gmane.emacs.orgmode/4112 -;; and then implemented by Bastien Guerry. -;; -;; Eric Schulte eventually added the functions for translating between -;; Org-mode headlines and Bibtex entries, and for fleshing out the Bibtex -;; fields of existing Org-mode headlines. -;; -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org) -(require 'bibtex) -(eval-when-compile - (require 'cl)) -(require 'org-compat) - -(defvar org-bibtex-description nil) ; dynamically scoped from org.el -(defvar org-id-locations) - -(declare-function bibtex-beginning-of-entry "bibtex" ()) -(declare-function bibtex-generate-autokey "bibtex" ()) -(declare-function bibtex-parse-entry "bibtex" (&optional content)) -(declare-function bibtex-url "bibtex" (&optional pos no-browse)) -(declare-function org-babel-trim "ob" (string &optional regexp)) - - -;;; Bibtex data -(defvar org-bibtex-types - '((:article - (:description . "An article from a journal or magazine") - (:required :author :title :journal :year) - (:optional :volume :number :pages :month :note)) - (:book - (:description . "A book with an explicit publisher") - (:required (:editor :author) :title :publisher :year) - (:optional (:volume :number) :series :address :edition :month :note)) - (:booklet - (:description . "A work that is printed and bound, but without a named publisher or sponsoring institution.") - (:required :title) - (:optional :author :howpublished :address :month :year :note)) - (:conference - (:description . "") - (:required :author :title :booktitle :year) - (:optional :editor :pages :organization :publisher :address :month :note)) - (:inbook - (:description . "A part of a book, which may be a chapter (or section or whatever) and/or a range of pages.") - (:required (:author :editor) :title (:chapter :pages) :publisher :year) - (:optional :crossref (:volume :number) :series :type :address :edition :month :note)) - (:incollection - (:description . "A part of a book having its own title.") - (:required :author :title :booktitle :publisher :year) - (:optional :crossref :editor (:volume :number) :series :type :chapter :pages :address :edition :month :note)) - (:inproceedings - (:description . "An article in a conference proceedings") - (:required :author :title :booktitle :year) - (:optional :crossref :editor (:volume :number) :series :pages :address :month :organization :publisher :note)) - (:manual - (:description . "Technical documentation.") - (:required :title) - (:optional :author :organization :address :edition :month :year :note)) - (:mastersthesis - (:description . "A Master’s thesis.") - (:required :author :title :school :year) - (:optional :type :address :month :note)) - (:misc - (:description . "Use this type when nothing else fits.") - (:required) - (:optional :author :title :howpublished :month :year :note)) - (:phdthesis - (:description . "A PhD thesis.") - (:required :author :title :school :year) - (:optional :type :address :month :note)) - (:proceedings - (:description . "The proceedings of a conference.") - (:required :title :year) - (:optional :editor (:volume :number) :series :address :month :organization :publisher :note)) - (:techreport - (:description . "A report published by a school or other institution.") - (:required :author :title :institution :year) - (:optional :type :address :month :note)) - (:unpublished - (:description . "A document having an author and title, but not formally published.") - (:required :author :title :note) - (:optional :month :year))) - "Bibtex entry types with required and optional parameters.") - -(defvar org-bibtex-fields - '((:address . "Usually the address of the publisher or other type of institution. For major publishing houses, van Leunen recommends omitting the information entirely. For small publishers, on the other hand, you can help the reader by giving the complete address.") - (:annote . "An annotation. It is not used by the standard bibliography styles, but may be used by others that produce an annotated bibliography.") - (:author . "The name(s) of the author(s), in the format described in the LaTeX book. Remember, all names are separated with the and keyword, and not commas.") - (:booktitle . "Title of a book, part of which is being cited. See the LaTeX book for how to type titles. For book entries, use the title field instead.") - (:chapter . "A chapter (or section or whatever) number.") - (:crossref . "The database key of the entry being cross referenced.") - (:edition . "The edition of a book for example, 'Second'. This should be an ordinal, and should have the first letter capitalized, as shown here; the standard styles convert to lower case when necessary.") - (:editor . "Name(s) of editor(s), typed as indicated in the LaTeX book. If there is also an author field, then the editor field gives the editor of the book or collection in which the reference appears.") - (:howpublished . "How something strange has been published. The first word should be capitalized.") - (:institution . "The sponsoring institution of a technical report.") - (:journal . "A journal name.") - (:key . "Used for alphabetizing, cross-referencing, and creating a label when the author information is missing. This field should not be confused with the key that appears in the \cite command and at the beginning of the database entry.") - (:month . "The month in which the work was published or, for an unpublished work, in which it was written. You should use the standard three-letter abbreviation,") - (:note . "Any additional information that can help the reader. The first word should be capitalized.") - (:number . "Any additional information that can help the reader. The first word should be capitalized.") - (:organization . "The organization that sponsors a conference or that publishes a manual.") - (:pages . "One or more page numbers or range of numbers, such as 42-111 or 7,41,73-97 or 43+ (the ‘+’ in this last example indicates pages following that don’t form simple range). BibTEX requires double dashes for page ranges (--).") - (:publisher . "The publisher’s name.") - (:school . "The name of the school where a thesis was written.") - (:series . "The name of a series or set of books. When citing an entire book, the the title field gives its title and an optional series field gives the name of a series or multi-volume set in which the book is published.") - (:title . "The work’s title, typed as explained in the LaTeX book.") - (:type . "The type of a technical report for example, 'Research Note'.") - (:volume . "The volume of a journal or multi-volume book.") - (:year . "The year of publication or, for an unpublished work, the year it was written. Generally it should consist of four numerals, such as 1984, although the standard styles can handle any year whose last four nonpunctuation characters are numerals, such as '(about 1984)'")) - "Bibtex fields with descriptions.") - -(defvar org-bibtex-entries nil - "List to hold parsed bibtex entries.") - -(defcustom org-bibtex-autogen-keys nil - "Set to a truth value to use `bibtex-generate-autokey' to generate keys." - :group 'org-bibtex - :version "24.1" - :type 'boolean) - -(defcustom org-bibtex-prefix nil - "Optional prefix for all bibtex property names. -For example setting to 'BIB_' would allow interoperability with fireforg." - :group 'org-bibtex - :version "24.1" - :type '(choice - (const nil) - (string))) - -(defcustom org-bibtex-treat-headline-as-title t - "Treat headline text as title if title property is absent. -If an entry is missing a title property, use the headline text as -the property. If this value is t, `org-bibtex-check' will ignore -a missing title field." - :group 'org-bibtex - :version "24.1" - :type 'boolean) - -(defcustom org-bibtex-export-arbitrary-fields nil - "When converting to bibtex allow fields not defined in `org-bibtex-fields'. -This only has effect if `org-bibtex-prefix' is defined, so as to -ensure that other org-properties, such as CATEGORY or LOGGING are -not placed in the exported bibtex entry." - :group 'org-bibtex - :version "24.1" - :type 'boolean) - -(defcustom org-bibtex-key-property "CUSTOM_ID" - "Property that holds the bibtex key. -By default, this is CUSTOM_ID, which enables easy linking to -bibtex headlines from within an org file. This can be set to ID -to enable global links, but only with great caution, as global -IDs must be unique." - :group 'org-bibtex - :version "24.1" - :type 'string) - -(defcustom org-bibtex-tags nil - "List of tag(s) that should be added to new bib entries." - :group 'org-bibtex - :version "24.1" - :type '(repeat :tag "Tag" (string))) - -(defcustom org-bibtex-tags-are-keywords nil - "Convert the value of the keywords field to tags and vice versa. -If set to t, comma-separated entries in a bibtex entry's keywords -field will be converted to org tags. Note: spaces will be escaped -with underscores, and characters that are not permitted in org -tags will be removed. - -If t, local tags in an org entry will be exported as a -comma-separated string of keywords when exported to bibtex. Tags -defined in `org-bibtex-tags' or `org-bibtex-no-export-tags' will -not be exported." - :group 'org-bibtex - :version "24.1" - :type 'boolean) - -(defcustom org-bibtex-no-export-tags nil - "List of tag(s) that should not be converted to keywords. -This variable is relevant only if `org-bibtex-export-tags-as-keywords' is t." - :group 'org-bibtex - :version "24.1" - :type '(repeat :tag "Tag" (string))) - -(defcustom org-bibtex-type-property-name "btype" - "Property in which to store bibtex entry type (e.g., article)." - :group 'org-bibtex - :version "24.1" - :type 'string) - - -;;; Utility functions -(defun org-bibtex-get (property) - (let ((it (let ((org-special-properties - (delete "FILE" (copy-sequence org-special-properties)))) - (or - (org-entry-get (point) (upcase property)) - (org-entry-get (point) (concat org-bibtex-prefix - (upcase property))))))) - (when it (org-babel-trim it)))) - -(defun org-bibtex-put (property value) - (let ((prop (upcase (if (keywordp property) - (substring (symbol-name property) 1) - property)))) - (org-set-property - (concat (unless (string= org-bibtex-key-property prop) org-bibtex-prefix) - prop) - value))) - -(defun org-bibtex-headline () - "Return a bibtex entry of the given headline as a string." - (let* ((val (lambda (key lst) (cdr (assoc key lst)))) - (to (lambda (string) (intern (concat ":" string)))) - (from (lambda (key) (substring (symbol-name key) 1))) - flatten ; silent compiler warning - (flatten (lambda (&rest lsts) - (apply #'append (mapcar - (lambda (e) - (if (listp e) (apply flatten e) (list e))) - lsts)))) - (notes (buffer-string)) - (id (org-bibtex-get org-bibtex-key-property)) - (type (org-bibtex-get org-bibtex-type-property-name)) - (tags (when org-bibtex-tags-are-keywords - (delq nil - (mapcar - (lambda (tag) - (unless (member tag - (append org-bibtex-tags - org-bibtex-no-export-tags)) - tag)) - (org-get-local-tags-at)))))) - (when type - (let ((entry (format - "@%s{%s,\n%s\n}\n" type id - (mapconcat - (lambda (pair) - (format " %s={%s}" (car pair) (cdr pair))) - (remove nil - (if (and org-bibtex-export-arbitrary-fields - org-bibtex-prefix) - (mapcar - (lambda (kv) - (let ((key (car kv)) (val0 (cdr kv))) - (when (and - (string-match org-bibtex-prefix key) - (not (string= - (downcase (concat org-bibtex-prefix - org-bibtex-type-property-name)) - (downcase key)))) - (cons (downcase (replace-regexp-in-string - org-bibtex-prefix "" key)) - val0)))) - (org-entry-properties nil 'standard)) - (mapcar - (lambda (field) - (let ((value (or (org-bibtex-get (funcall from field)) - (and (equal :title field) - (nth 4 (org-heading-components)))))) - (when value (cons (funcall from field) value)))) - (funcall flatten - (funcall val :required (funcall val (funcall to type) org-bibtex-types)) - (funcall val :optional (funcall val (funcall to type) org-bibtex-types)))))) - ",\n")))) - (with-temp-buffer - (insert entry) - (when tags - (bibtex-beginning-of-entry) - (if (re-search-forward "keywords.*=.*{\\(.*\\)}" nil t) - (progn (goto-char (match-end 1)) (insert ", ")) - (bibtex-make-field "keywords" t t)) - (insert (mapconcat #'identity tags ", "))) - (buffer-string)))))) - -(defun org-bibtex-ask (field) - (unless (assoc field org-bibtex-fields) - (error "Field:%s is not known" field)) - (save-window-excursion - (let* ((name (substring (symbol-name field) 1)) - (buf-name (format "*Bibtex Help %s*" name))) - (with-output-to-temp-buffer buf-name - (princ (cdr (assoc field org-bibtex-fields)))) - (with-current-buffer buf-name (visual-line-mode 1)) - (org-fit-window-to-buffer (get-buffer-window buf-name)) - (let ((result (read-from-minibuffer (format "%s: " name)))) - (when (> (length result) 0) result))))) - -(defun org-bibtex-autokey () - "Generate an autokey for the current headline." - (org-bibtex-put org-bibtex-key-property - (if org-bibtex-autogen-keys - (let* ((entry (org-bibtex-headline)) - (key - (with-temp-buffer - (insert entry) - (bibtex-generate-autokey)))) - ;; test for duplicate IDs if using global ID - (when (and - (equal org-bibtex-key-property "ID") - (featurep 'org-id) - (hash-table-p org-id-locations) - (gethash key org-id-locations)) - (warn "Another entry has the same ID")) - key) - (read-from-minibuffer "id: ")))) - -(defun org-bibtex-fleshout (type &optional optional) - "Fleshout current heading, ensuring all required fields are present. -With optional argument OPTIONAL, also prompt for optional fields." - (let ((val (lambda (key lst) (cdr (assoc key lst)))) - (keyword (lambda (name) (intern (concat ":" (downcase name))))) - (name (lambda (keyword) (substring (symbol-name keyword) 1)))) - (dolist (field (append - (if org-bibtex-treat-headline-as-title - (remove :title (funcall val :required (funcall val type org-bibtex-types))) - (funcall val :required (funcall val type org-bibtex-types))) - (when optional (funcall val :optional (funcall val type org-bibtex-types))))) - (when (consp field) ; or'd pair of fields e.g., (:editor :author) - (let ((present (first (remove - nil - (mapcar - (lambda (f) (when (org-bibtex-get (funcall name f)) f)) - field))))) - (setf field (or present (funcall keyword - (org-icompleting-read - "Field: " (mapcar name field))))))) - (let ((name (funcall name field))) - (unless (org-bibtex-get name) - (let ((prop (org-bibtex-ask field))) - (when prop (org-bibtex-put name prop))))))) - (when (and type (assoc type org-bibtex-types) - (not (org-bibtex-get org-bibtex-key-property))) - (org-bibtex-autokey))) - - -;;; Bibtex link functions -(org-add-link-type "bibtex" 'org-bibtex-open) -(add-hook 'org-store-link-functions 'org-bibtex-store-link) - -(defun org-bibtex-open (path) - "Visit the bibliography entry on 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-bibtex-store-link () - "Store a link to a BibTeX entry." - (when (eq major-mode 'bibtex-mode) - (let* ((search (org-create-file-search-in-bibtex)) - (link (concat "file:" (abbreviate-file-name buffer-file-name) - "::" search)) - (entry (mapcar ; repair strings enclosed in "..." or {...} - (lambda(c) - (if (string-match - "^\\(?:{\\|\"\\)\\(.*\\)\\(?:}\\|\"\\)$" (cdr c)) - (cons (car c) (match-string 1 (cdr c))) c)) - (save-excursion - (bibtex-beginning-of-entry) - (bibtex-parse-entry))))) - (org-store-link-props - :key (cdr (assoc "=key=" entry)) - :author (or (cdr (assoc "author" entry)) "[no author]") - :editor (or (cdr (assoc "editor" entry)) "[no editor]") - :title (or (cdr (assoc "title" entry)) "[no title]") - :booktitle (or (cdr (assoc "booktitle" entry)) "[no booktitle]") - :journal (or (cdr (assoc "journal" entry)) "[no journal]") - :publisher (or (cdr (assoc "publisher" entry)) "[no publisher]") - :pages (or (cdr (assoc "pages" entry)) "[no pages]") - :url (or (cdr (assoc "url" entry)) "[no url]") - :year (or (cdr (assoc "year" entry)) "[no year]") - :month (or (cdr (assoc "month" entry)) "[no month]") - :address (or (cdr (assoc "address" entry)) "[no address]") - :volume (or (cdr (assoc "volume" entry)) "[no volume]") - :number (or (cdr (assoc "number" entry)) "[no number]") - :annote (or (cdr (assoc "annote" entry)) "[no annotation]") - :series (or (cdr (assoc "series" entry)) "[no series]") - :abstract (or (cdr (assoc "abstract" entry)) "[no abstract]") - :btype (or (cdr (assoc "=type=" entry)) "[no type]") - :type "bibtex" - :link link - :description org-bibtex-description)))) - -(defun org-create-file-search-in-bibtex () - "Create the search string and description for a BibTeX database entry." - ;; Make a good description for this entry, using names, year and the title - ;; Put it into the `description' variable which is dynamically scoped. - (let ((bibtex-autokey-names 1) - (bibtex-autokey-names-stretch 1) - (bibtex-autokey-name-case-convert-function 'identity) - (bibtex-autokey-name-separator " & ") - (bibtex-autokey-additional-names " et al.") - (bibtex-autokey-year-length 4) - (bibtex-autokey-name-year-separator " ") - (bibtex-autokey-titlewords 3) - (bibtex-autokey-titleword-separator " ") - (bibtex-autokey-titleword-case-convert-function 'identity) - (bibtex-autokey-titleword-length 'infty) - (bibtex-autokey-year-title-separator ": ")) - (setq org-bibtex-description (bibtex-generate-autokey))) - ;; Now parse the entry, get the key and return it. - (save-excursion - (bibtex-beginning-of-entry) - (cdr (assoc "=key=" (bibtex-parse-entry))))) - -(defun org-execute-file-search-in-bibtex (s) - "Find the link search string S as a key for a database entry." - (when (eq major-mode 'bibtex-mode) - ;; Yes, we want to do the search in this file. - ;; We construct a regexp that searches for "@entrytype{" followed by the key - (goto-char (point-min)) - (and (re-search-forward (concat "@[a-zA-Z]+[ \t\n]*{[ \t\n]*" - (regexp-quote s) "[ \t\n]*,") nil t) - (goto-char (match-beginning 0))) - (if (and (match-beginning 0) (equal current-prefix-arg '(16))) - ;; Use double prefix to indicate that any web link should be browsed - (let ((b (current-buffer)) (p (point))) - ;; Restore the window configuration because we just use the web link - (set-window-configuration org-window-config-before-follow-link) - (with-current-buffer b - (goto-char p) - (bibtex-url))) - (recenter 0)) ; Move entry start to beginning of window - ;; return t to indicate that the search is done. - t)) - -;; Finally add the link search function to the right hook. -(add-hook 'org-execute-file-search-functions 'org-execute-file-search-in-bibtex) - - -;;; Bibtex <-> Org-mode headline translation functions -(defun org-bibtex (&optional filename) - "Export each headline in the current file to a bibtex entry. -Headlines are exported using `org-bibtex-export-headline'." - (interactive - (list (read-file-name - "Bibtex file: " nil nil nil - (file-name-nondirectory - (concat (file-name-sans-extension (buffer-file-name)) ".bib"))))) - (let ((error-point - (catch 'bib - (let ((bibtex-entries - (remove nil (org-map-entries - (lambda () - (condition-case foo - (org-bibtex-headline) - (error (throw 'bib (point))))))))) - (with-temp-file filename - (insert (mapconcat #'identity bibtex-entries "\n"))) - (message "Successfully exported %d BibTeX entries to %s" - (length bibtex-entries) filename) nil)))) - (when error-point - (goto-char error-point) - (message "Bibtex error at %S" (nth 4 (org-heading-components)))))) - -(defun org-bibtex-check (&optional optional) - "Check the current headline for required fields. -With prefix argument OPTIONAL also prompt for optional fields." - (interactive "P") - (save-restriction - (org-narrow-to-subtree) - (let ((type (let ((name (org-bibtex-get org-bibtex-type-property-name))) - (when name (intern (concat ":" name)))))) - (when type (org-bibtex-fleshout type optional))))) - -(defun org-bibtex-check-all (&optional optional) - "Check all headlines in the current file. -With prefix argument OPTIONAL also prompt for optional fields." - (interactive) (org-map-entries (lambda () (org-bibtex-check optional)))) - -(defun org-bibtex-create (&optional arg nonew) - "Create a new entry at the given level. -With a prefix arg, query for optional fields as well. -If nonew is t, add data to the headline of the entry at point." - (interactive "P") - (let* ((type (org-icompleting-read - "Type: " (mapcar (lambda (type) - (substring (symbol-name (car type)) 1)) - org-bibtex-types) - nil nil (when nonew - (org-bibtex-get org-bibtex-type-property-name)))) - (type (if (keywordp type) type (intern (concat ":" type)))) - (org-bibtex-treat-headline-as-title (if nonew nil t))) - (unless (assoc type org-bibtex-types) - (error "Type:%s is not known" type)) - (if nonew - (org-back-to-heading) - (org-insert-heading) - (let ((title (org-bibtex-ask :title))) - (insert title) - (org-bibtex-put "TITLE" title))) - (org-bibtex-put org-bibtex-type-property-name - (substring (symbol-name type) 1)) - (org-bibtex-fleshout type arg) - (mapc (lambda (tag) (org-toggle-tag tag 'on)) org-bibtex-tags))) - -(defun org-bibtex-create-in-current-entry (&optional arg) - "Add bibliographical data to the current entry. -With a prefix arg, query for optional fields." - (interactive "P") - (org-bibtex-create arg t)) - -(defun org-bibtex-read () - "Read a bibtex entry and save to `org-bibtex-entries'. -This uses `bibtex-parse-entry'." - (interactive) - (let ((keyword (lambda (str) (intern (concat ":" (downcase str))))) - (clean-space (lambda (str) (replace-regexp-in-string - "[[:space:]\n\r]+" " " str))) - (strip-delim - (lambda (str) ; strip enclosing "..." and {...} - (dolist (pair '((34 . 34) (123 . 125) (123 . 125))) - (when (and (= (aref str 0) (car pair)) - (= (aref str (1- (length str))) (cdr pair))) - (setf str (substring str 1 (1- (length str)))))) str))) - (push (mapcar - (lambda (pair) - (cons (let ((field (funcall keyword (car pair)))) - (case field - (:=type= :type) - (:=key= :key) - (otherwise field))) - (funcall clean-space (funcall strip-delim (cdr pair))))) - (save-excursion (bibtex-beginning-of-entry) (bibtex-parse-entry))) - org-bibtex-entries))) - -(defun org-bibtex-read-buffer (buffer) - "Read all bibtex entries in BUFFER and save to `org-bibtex-entries'. -Return the number of saved entries." - (interactive "bbuffer: ") - (let ((start-length (length org-bibtex-entries))) - (with-current-buffer buffer - (save-excursion - (goto-char (point-max)) - (while (not (= (point) (point-min))) - (backward-char 1) - (org-bibtex-read) - (bibtex-beginning-of-entry)))) - (let ((added (- (length org-bibtex-entries) start-length))) - (message "parsed %d entries" added) - added))) - -(defun org-bibtex-read-file (file) - "Read FILE with `org-bibtex-read-buffer'." - (interactive "ffile: ") - (org-bibtex-read-buffer (find-file-noselect file 'nowarn 'rawfile))) - -(defun org-bibtex-write () - "Insert a heading built from the first element of `org-bibtex-entries'." - (interactive) - (when (= (length org-bibtex-entries) 0) - (error "No entries in `org-bibtex-entries'")) - (let* ((entry (pop org-bibtex-entries)) - (org-special-properties nil) ; avoids errors with `org-entry-put' - (val (lambda (field) (cdr (assoc field entry)))) - (togtag (lambda (tag) (org-toggle-tag tag 'on)))) - (org-insert-heading) - (insert (funcall val :title)) - (org-bibtex-put "TITLE" (funcall val :title)) - (org-bibtex-put org-bibtex-type-property-name - (downcase (funcall val :type))) - (dolist (pair entry) - (case (car pair) - (:title nil) - (:type nil) - (:key (org-bibtex-put org-bibtex-key-property (cdr pair))) - (:keywords (if org-bibtex-tags-are-keywords - (mapc - (lambda (kw) - (funcall - togtag - (replace-regexp-in-string - "[^[:alnum:]_@#%]" "" - (replace-regexp-in-string "[ \t]+" "_" kw)))) - (split-string (cdr pair) ", *")) - (org-bibtex-put (car pair) (cdr pair)))) - (otherwise (org-bibtex-put (car pair) (cdr pair))))) - (mapc togtag org-bibtex-tags))) - -(defun org-bibtex-yank () - "If kill ring holds a bibtex entry yank it as an Org-mode headline." - (interactive) - (let (entry) - (with-temp-buffer (yank 1) (setf entry (org-bibtex-read))) - (if entry - (org-bibtex-write) - (error "Yanked text does not appear to contain a BibTeX entry")))) - -(defun org-bibtex-import-from-file (file) - "Read bibtex entries from FILE and insert as Org-mode headlines after point." - (interactive "ffile: ") - (dotimes (_ (org-bibtex-read-file file)) - (save-excursion (org-bibtex-write)) - (re-search-forward org-property-end-re) - (open-line 1) (forward-char 1))) - -(defun org-bibtex-export-to-kill-ring () - "Export current headline to kill ring as bibtex entry." - (interactive) - (let ((result (org-bibtex-headline))) - (kill-new result) result)) - -(defun org-bibtex-search (string) - "Search for bibliographical entries in agenda files. -This function relies `org-search-view' to locate results." - (interactive "sSearch string: ") - (let ((org-agenda-overriding-header "Bib search results:") - (org-agenda-search-view-always-boolean t)) - (org-search-view nil - (format "%s +{:%s%s:}" - string (or org-bibtex-prefix "") - org-bibtex-type-property-name)))) - -(provide 'org-bibtex) - -;;; org-bibtex.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-capture.el b/xemacs-packages/lisp/org-8.2.3c/org-capture.el deleted file mode 100644 index 39804ac3..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-capture.el +++ /dev/null @@ -1,1830 +0,0 @@ -;;; org-capture.el --- Fast note taking in Org-mode - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file contains an alternative implementation of the functionality -;; that used to be provided by org-remember.el. The implementation is more -;; streamlined, can produce more target types (e.g. plain list items or -;; table lines). Also, it does not use a temporary buffer for editing -;; the captured entry - instead it uses an indirect buffer that visits -;; the new entry already in the target buffer (this was an idea by Samuel -;; Wales). John Wiegley's excellent `remember.el' is not needed anymore -;; for this implementation, even though we borrow heavily from its ideas. - -;; This implementation heavily draws on ideas by James TD Smith and -;; Samuel Wales, and, of cause, uses John Wiegley's remember.el as inspiration. - -;;; TODO - -;; - find a clever way to not always insert an annotation maybe a -;; predicate function that can check for conditions for %a to be -;; used. This could be one of the properties. - -;; - Should there be plist members that arrange for properties to be -;; asked for, like James proposed in his RFC? - -;;; Code: - -(eval-when-compile - (require 'cl)) -(require 'org) - -(declare-function org-datetree-find-date-create "org-datetree" - (date &optional keep-restriction)) -(declare-function org-table-get-specials "org-table" ()) -(declare-function org-table-goto-line "org-table" (N)) -(declare-function org-pop-to-buffer-same-window "org-compat" - (&optional buffer-or-name norecord label)) -(declare-function org-at-encrypted-entry-p "org-crypt" ()) -(declare-function org-encrypt-entry "org-crypt" ()) -(declare-function org-decrypt-entry "org-crypt" ()) - -(defvar org-remember-default-headline) -(defvar org-remember-templates) -(defvar org-table-hlines) -(defvar dired-buffers) - -(defvar org-capture-clock-was-started nil - "Internal flag, noting if the clock was started.") - -(defvar org-capture-last-stored-marker (make-marker) - "Marker pointing to the entry most recently stored with `org-capture'.") - -;; The following variable is scoped dynamically by org-protocol -;; to indicate that the link properties have already been stored -(defvar org-capture-link-is-already-stored nil) - -(defgroup org-capture nil - "Options concerning capturing new entries." - :tag "Org Capture" - :group 'org) - -(defcustom org-capture-templates nil - "Templates for the creation of new entries. - -Each entry is a list with the following items: - -keys The keys that will select the template, as a string, characters - only, for example \"a\" for a template to be selected with a - single key, or \"bt\" for selection with two keys. When using - several keys, keys using the same prefix key must be together - in the list and preceded by a 2-element entry explaining the - prefix key, for example - - (\"b\" \"Templates for marking stuff to buy\") - - The \"C\" key is used by default for quick access to the - customization of the template variable. But if you want to use - that key for a template, you can. - -description A short string describing the template, will be shown during - selection. - -type The type of entry. Valid types are: - entry an Org-mode node, with a headline. Will be - filed as the child of the target entry or as - a top-level entry. - item a plain list item, will be placed in the - first plain list at the target - location. - checkitem a checkbox item. This differs from the - plain list item only is so far as it uses a - different default template. - table-line a new line in the first table at target location. - plain text to be inserted as it is. - -target Specification of where the captured item should be placed. - In Org-mode files, targets usually define a node. Entries will - become children of this node, other types will be added to the - table or list in the body of this node. - - Most target specifications contain a file name. If that file - name is the empty string, it defaults to `org-default-notes-file'. - A file can also be given as a variable, function, or Emacs Lisp - form. - - Valid values are: - - (file \"path/to/file\") - Text will be placed at the beginning or end of that file - - (id \"id of existing org entry\") - File as child of this entry, or in the body of the entry - - (file+headline \"path/to/file\" \"node headline\") - Fast configuration if the target heading is unique in the file - - (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...) - For non-unique headings, the full path is safer - - (file+regexp \"path/to/file\" \"regexp to find location\") - File to the entry matching regexp - - (file+datetree \"path/to/file\") - Will create a heading in a date tree for today's date - - (file+datetree+prompt \"path/to/file\") - Will create a heading in a date tree, prompts for date - - (file+function \"path/to/file\" function-finding-location) - A function to find the right location in the file - - (clock) - File to the entry that is currently being clocked - - (function function-finding-location) - Most general way, write your own function to find both - file and location - -template The template for creating the capture item. If you leave this - empty, an appropriate default template will be used. See below - for more details. Instead of a string, this may also be one of - - (file \"/path/to/template-file\") - (function function-returning-the-template) - - in order to get a template from a file, or dynamically - from a function. - -The rest of the entry is a property list of additional options. Recognized -properties are: - - :prepend Normally newly captured information will be appended at - the target location (last child, last table line, - last list item...). Setting this property will - change that. - - :immediate-finish When set, do not offer to edit the information, just - file it away immediately. This makes sense if the - template only needs information that can be added - automatically. - - :jump-to-captured When set, jump to the captured entry when finished. - - :empty-lines Set this to the number of lines the should be inserted - before and after the new item. Default 0, only common - other value is 1. - - :empty-lines-before Set this to the number of lines the should be inserted - before the new item. Overrides :empty-lines for the - number lines inserted before. - - :empty-lines-after Set this to the number of lines the should be inserted - after the new item. Overrides :empty-lines for the - number of lines inserted after. - - :clock-in Start the clock in this item. - - :clock-keep Keep the clock running when filing the captured entry. - - :clock-resume Start the interrupted clock when finishing the capture. - Note that :clock-keep has precedence over :clock-resume. - When setting both to `t', the current clock will run and - the previous one will not be resumed. - - :unnarrowed Do not narrow the target buffer, simply show the - full buffer. Default is to narrow it so that you - only see the new stuff. - - :table-line-pos Specification of the location in the table where the - new line should be inserted. It should be a string like - \"II-3\", meaning that the new line should become the - third line before the second horizontal separator line. - - :kill-buffer If the target file was not yet visited by a buffer when - capture was invoked, kill the buffer again after capture - is finalized. - -The template defines the text to be inserted. Often this is an -org-mode entry (so the first line should start with a star) that -will be filed as a child of the target headline. It can also be -freely formatted text. Furthermore, the following %-escapes will -be replaced with content and expanded in this order: - - %[pathname] Insert the contents of the file given by `pathname'. - %(sexp) Evaluate elisp `(sexp)' and replace it with the results. - For convenience, %:keyword (see below) placeholders within - the expression will be expanded prior to this. - %<...> The result of format-time-string on the ... format specification. - %t Time stamp, date only. - %T Time stamp with date and time. - %u, %U Like the above, but inactive time stamps. - %i Initial content, copied from the active region. If %i is - indented, the entire inserted text will be indented as well. - %a Annotation, normally the link created with `org-store-link'. - %A Like %a, but prompt for the description part. - %l Like %a, but only insert the literal link. - %c Current kill ring head. - %x Content of the X clipboard. - %k Title of currently clocked task. - %K Link to currently clocked task. - %n User name (taken from the variable `user-full-name'). - %f File visited by current buffer when org-capture was called. - %F Full path of the file or directory visited by current buffer. - %:keyword Specific information for certain link types, see below. - %^g Prompt for tags, with completion on tags in target file. - %^G Prompt for tags, with completion on all tags in all agenda files. - %^t Like %t, but prompt for date. Similarly %^T, %^u, %^U. - You may define a prompt like: %^{Please specify birthday}t - %^C Interactive selection of which kill or clip to use. - %^L Like %^C, but insert as link. - %^{prop}p Prompt the user for a value for property `prop'. - %^{prompt} Prompt the user for a string and replace this sequence with it. - A default value and a completion table ca be specified like this: - %^{prompt|default|completion2|completion3|...}. - %? After completing the template, position cursor here. - %\\n Insert the text entered at the nth %^{prompt}, where `n' is - a number, starting from 1. - -Apart from these general escapes, you can access information specific to -the link type that is created. For example, calling `org-capture' in emails -or in Gnus will record the author and the subject of the message, which you -can access with \"%:from\" and \"%:subject\", respectively. Here is a -complete list of what is recorded for each link type. - -Link type | Available information -------------------------+------------------------------------------------------ -bbdb | %:type %:name %:company -vm, wl, mh, mew, rmail, | %:type %:subject %:message-id -gnus | %:from %:fromname %:fromaddress - | %:to %:toname %:toaddress - | %:fromto (either \"to NAME\" or \"from NAME\") - | %:date %:date-timestamp (as active timestamp) - | %:date-timestamp-inactive (as inactive timestamp) -gnus | %:group, for messages also all email fields -w3, w3m | %:type %:url -info | %:type %:file %:node -calendar | %:type %:date" - :group 'org-capture - :version "24.1" - :type - '(repeat - (choice :value ("" "" entry (file "~/org/notes.org") "") - (list :tag "Multikey description" - (string :tag "Keys ") - (string :tag "Description")) - (list :tag "Template entry" - (string :tag "Keys ") - (string :tag "Description ") - (choice :tag "Capture Type " :value entry - (const :tag "Org entry" entry) - (const :tag "Plain list item" item) - (const :tag "Checkbox item" checkitem) - (const :tag "Plain text" plain) - (const :tag "Table line" table-line)) - (choice :tag "Target location" - (list :tag "File" - (const :format "" file) - (file :tag " File")) - (list :tag "ID" - (const :format "" id) - (string :tag " ID")) - (list :tag "File & Headline" - (const :format "" file+headline) - (file :tag " File ") - (string :tag " Headline")) - (list :tag "File & Outline path" - (const :format "" file+olp) - (file :tag " File ") - (repeat :tag "Outline path" :inline t - (string :tag "Headline"))) - (list :tag "File & Regexp" - (const :format "" file+regexp) - (file :tag " File ") - (regexp :tag " Regexp")) - (list :tag "File & Date tree" - (const :format "" file+datetree) - (file :tag " File")) - (list :tag "File & Date tree, prompt for date" - (const :format "" file+datetree+prompt) - (file :tag " File")) - (list :tag "File & function" - (const :format "" file+function) - (file :tag " File ") - (sexp :tag " Function")) - (list :tag "Current clocking task" - (const :format "" clock)) - (list :tag "Function" - (const :format "" function) - (sexp :tag " Function"))) - (choice :tag "Template" - (string) - (list :tag "File" - (const :format "" file) - (file :tag "Template file")) - (list :tag "Function" - (const :format "" function) - (function :tag "Template function"))) - (plist :inline t - ;; Give the most common options as checkboxes - :options (((const :format "%v " :prepend) (const t)) - ((const :format "%v " :immediate-finish) (const t)) - ((const :format "%v " :jump-to-captured) (const t)) - ((const :format "%v " :empty-lines) (const 1)) - ((const :format "%v " :empty-lines-before) (const 1)) - ((const :format "%v " :empty-lines-after) (const 1)) - ((const :format "%v " :clock-in) (const t)) - ((const :format "%v " :clock-keep) (const t)) - ((const :format "%v " :clock-resume) (const t)) - ((const :format "%v " :unnarrowed) (const t)) - ((const :format "%v " :table-line-pos) (const t)) - ((const :format "%v " :kill-buffer) (const t)))))))) - -(defcustom org-capture-before-finalize-hook nil - "Hook that is run right before a capture process is finalized. -The capture buffer is still current when this hook runs and it is -widened to the entire buffer." - :group 'org-capture - :version "24.1" - :type 'hook) - -(defcustom org-capture-after-finalize-hook nil - "Hook that is run right after a capture process is finalized. -Suitable for window cleanup." - :group 'org-capture - :version "24.1" - :type 'hook) - -(defcustom org-capture-prepare-finalize-hook nil - "Hook that is run before the finalization starts. -The capture buffer is current and still narrowed." - :group 'org-capture - :version "24.1" - :type 'hook) - -(defcustom org-capture-bookmark t - "When non-nil, add a bookmark pointing at the last stored -position when capturing." - :group 'org-capture - :version "24.3" - :type 'boolean) - -;;; The property list for keeping information about the capture process - -(defvar org-capture-plist nil - "Plist for the current capture process, global, to avoid having to pass it.") - -(defvar org-capture-current-plist nil - "Local variable holding the plist in a capture buffer. -This is used to store the plist for use when finishing a capture process -because another such process might have changed the global variable by then. - -Each time a new capture buffer has been set up, the global `org-capture-plist' -is copied to this variable, which is local in the indirect buffer.") - -(defvar org-capture-clock-keep nil - "Local variable to store the value of the :clock-keep parameter. -This is needed in case org-capture-finalize is called interactively.") - -(defun org-capture-put (&rest stuff) - "Add properties to the capture property list `org-capture-plist'." - (while stuff - (setq org-capture-plist (plist-put org-capture-plist - (pop stuff) (pop stuff))))) -(defun org-capture-get (prop &optional local) - "Get properties from the capture property list `org-capture-plist'. -When LOCAL is set, use the local variable `org-capture-current-plist', -this is necessary after initialization of the capture process, -to avoid conflicts with other active capture processes." - (plist-get (if local org-capture-current-plist org-capture-plist) prop)) - -(defun org-capture-member (prop &optional local) - "Is PROP a property in `org-capture-plist'. -When LOCAL is set, use the local variable `org-capture-current-plist', -this is necessary after initialization of the capture process, -to avoid conflicts with other active capture processes." - (plist-get (if local org-capture-current-plist org-capture-plist) prop)) - -;;; The minor mode - -(defvar org-capture-mode-map (make-sparse-keymap) - "Keymap for `org-capture-mode', a minor mode. -Use this map to set additional keybindings for when Org-mode is used -for a capture buffer.") - -(defvar org-capture-mode-hook nil - "Hook for the minor `org-capture-mode'.") - -(define-minor-mode org-capture-mode - "Minor mode for special key bindings in a capture buffer. - -Turning on this mode runs the normal hook `org-capture-mode-hook'." - nil " Rem" org-capture-mode-map - (org-set-local - 'header-line-format - "Capture buffer. Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.")) -(define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize) -(define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill) -(define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile) - -;;; The main commands - -(defvar org-capture-initial nil) -(defvar org-capture-entry nil) - -;;;###autoload -(defun org-capture-string (string &optional keys) - "Capture STRING with the template selected by KEYS." - (interactive "sInitial text: \n") - (let ((org-capture-initial string) - (org-capture-entry (org-capture-select-template keys))) - (org-capture))) - -(defcustom org-capture-templates-contexts nil - "Alist of capture templates and valid contexts. - -For example, if you have a capture template \"c\" and you want -this template to be accessible only from `message-mode' buffers, -use this: - - '((\"c\" ((in-mode . \"message-mode\")))) - -Here are the available contexts definitions: - - in-file: command displayed only in matching files - in-mode: command displayed only in matching modes - not-in-file: command not displayed in matching files - not-in-mode: command not displayed in matching modes - in-buffer: command displayed only in matching buffers -not-in-buffer: command not displayed in matching buffers - [function]: a custom function taking no argument - -If you define several checks, the agenda command will be -accessible if there is at least one valid check. - -You can also bind a key to another agenda custom command -depending on contextual rules. - - '((\"c\" \"d\" ((in-mode . \"message-mode\")))) - -Here it means: in `message-mode buffers', use \"c\" as the -key for the capture template otherwise associated with \"d\". -\(The template originally associated with \"d\" is not displayed -to avoid duplicates.)" - :version "24.3" - :group 'org-capture - :type '(repeat (list :tag "Rule" - (string :tag " Capture key") - (string :tag "Replace by template") - (repeat :tag "Available when" - (choice - (cons :tag "Condition" - (choice - (const :tag "In file" in-file) - (const :tag "Not in file" not-in-file) - (const :tag "In buffer" in-buffer) - (const :tag "Not in buffer" not-in-buffer) - (const :tag "In mode" in-mode) - (const :tag "Not in mode" not-in-mode)) - (regexp)) - (function :tag "Custom function")))))) - -(defcustom org-capture-use-agenda-date nil - "Non-nil means use the date at point when capturing from agendas. -When nil, you can still capture using the date at point with \\[org-agenda-capture]." - :group 'org-capture - :version "24.3" - :type 'boolean) - -;;;###autoload -(defun org-capture (&optional goto keys) - "Capture something. -\\ -This will let you select a template from `org-capture-templates', and then -file the newly captured information. The text is immediately inserted -at the target location, and an indirect buffer is shown where you can -edit it. Pressing \\[org-capture-finalize] brings you back to the previous state -of Emacs, so that you can continue your work. - -When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture -anything, just go to the file/headline where the selected template -stores its notes. With a double prefix argument \ -\\[universal-argument] \\[universal-argument], go to the last note -stored. - -When called with a `C-0' (zero) prefix, insert a template at point. - -ELisp programs can set KEYS to a string associated with a template -in `org-capture-templates'. In this case, interactive selection -will be bypassed. - -If `org-capture-use-agenda-date' is non-nil, capturing from the -agenda will use the date at point as the default date. Then, a -`C-1' prefix will tell the capture process to use the HH:MM time -of the day at point (if any) or the current HH:MM time." - (interactive "P") - (when (and org-capture-use-agenda-date - (eq major-mode 'org-agenda-mode)) - (setq org-overriding-default-time - (org-get-cursor-date (equal goto 1)))) - (cond - ((equal goto '(4)) (org-capture-goto-target)) - ((equal goto '(16)) (org-capture-goto-last-stored)) - (t - ;; FIXME: Are these needed? - (let* ((orig-buf (current-buffer)) - (annotation (if (and (boundp 'org-capture-link-is-already-stored) - org-capture-link-is-already-stored) - (plist-get org-store-link-plist :annotation) - (ignore-errors (org-store-link nil)))) - (entry (or org-capture-entry (org-capture-select-template keys))) - initial) - (setq initial (or org-capture-initial - (and (org-region-active-p) - (buffer-substring (point) (mark))))) - (when (stringp initial) - (remove-text-properties 0 (length initial) '(read-only t) initial)) - (when (stringp annotation) - (remove-text-properties 0 (length annotation) - '(read-only t) annotation)) - (cond - ((equal entry "C") - (customize-variable 'org-capture-templates)) - ((equal entry "q") - (error "Abort")) - (t - (org-capture-set-plist entry) - (org-capture-get-template) - (org-capture-put :original-buffer orig-buf - :original-file (or (buffer-file-name orig-buf) - (and (featurep 'dired) - (car (rassq orig-buf - dired-buffers)))) - :original-file-nondirectory - (and (buffer-file-name orig-buf) - (file-name-nondirectory - (buffer-file-name orig-buf))) - :annotation annotation - :initial initial - :return-to-wconf (current-window-configuration) - :default-time - (or org-overriding-default-time - (org-current-time))) - (org-capture-set-target-location) - (condition-case error - (org-capture-put :template (org-capture-fill-template)) - ((error quit) - (if (get-buffer "*Capture*") (kill-buffer "*Capture*")) - (error "Capture abort: %s" error))) - - (setq org-capture-clock-keep (org-capture-get :clock-keep)) - (if (equal goto 0) - ;;insert at point - (org-capture-insert-template-here) - (condition-case error - (org-capture-place-template - (equal (car (org-capture-get :target)) 'function)) - ((error quit) - (if (and (buffer-base-buffer (current-buffer)) - (string-match "\\`CAPTURE-" (buffer-name))) - (kill-buffer (current-buffer))) - (set-window-configuration (org-capture-get :return-to-wconf)) - (error "Capture template `%s': %s" - (org-capture-get :key) - (nth 1 error)))) - (if (and (derived-mode-p 'org-mode) - (org-capture-get :clock-in)) - (condition-case nil - (progn - (if (org-clock-is-active) - (org-capture-put :interrupted-clock - (copy-marker org-clock-marker))) - (org-clock-in) - (org-set-local 'org-capture-clock-was-started t)) - (error - "Could not start the clock in this capture buffer"))) - (if (org-capture-get :immediate-finish) - (org-capture-finalize))))))))) - -(defun org-capture-get-template () - "Get the template from a file or a function if necessary." - (let ((txt (org-capture-get :template)) file) - (cond - ((and (listp txt) (eq (car txt) 'file)) - (if (file-exists-p - (setq file (expand-file-name (nth 1 txt) org-directory))) - (setq txt (org-file-contents file)) - (setq txt (format "* Template file %s not found" (nth 1 txt))))) - ((and (listp txt) (eq (car txt) 'function)) - (if (fboundp (nth 1 txt)) - (setq txt (funcall (nth 1 txt))) - (setq txt (format "* Template function %s not found" (nth 1 txt))))) - ((not txt) (setq txt "")) - ((stringp txt)) - (t (setq txt "* Invalid capture template"))) - (org-capture-put :template txt))) - -(defun org-capture-finalize (&optional stay-with-capture) - "Finalize the capture process. -With prefix argument STAY-WITH-CAPTURE, jump to the location of the -captured item after finalizing." - (interactive "P") - (when (org-capture-get :jump-to-captured) - (setq stay-with-capture t)) - (unless (and org-capture-mode - (buffer-base-buffer (current-buffer))) - (error "This does not seem to be a capture buffer for Org-mode")) - - (run-hooks 'org-capture-prepare-finalize-hook) - - ;; Did we start the clock in this capture buffer? - (when (and org-capture-clock-was-started - org-clock-marker (marker-buffer org-clock-marker) - (equal (marker-buffer org-clock-marker) (buffer-base-buffer)) - (> org-clock-marker (point-min)) - (< org-clock-marker (point-max))) - ;; Looks like the clock we started is still running. Clock out. - (when (not org-capture-clock-keep) (let (org-log-note-clock-out) (org-clock-out))) - (when (and (not org-capture-clock-keep) - (org-capture-get :clock-resume 'local) - (markerp (org-capture-get :interrupted-clock 'local)) - (buffer-live-p (marker-buffer - (org-capture-get :interrupted-clock 'local)))) - (let ((clock-in-task (org-capture-get :interrupted-clock 'local))) - (org-with-point-at clock-in-task - (org-clock-in))) - (message "Interrupted clock has been resumed"))) - - (let ((beg (point-min)) - (end (point-max)) - (abort-note nil)) - ;; Store the size of the capture buffer - (org-capture-put :captured-entry-size (- (point-max) (point-min))) - (widen) - ;; Store the insertion point in the target buffer - (org-capture-put :insertion-point (point)) - - (if org-note-abort - (let ((m1 (org-capture-get :begin-marker 'local)) - (m2 (org-capture-get :end-marker 'local))) - (if (and m1 m2 (= m1 beg) (= m2 end)) - (progn - (setq m2 (if (cdr (assoc 'heading org-blank-before-new-entry)) - m2 (1+ m2)) - m2 (if (< (point-max) m2) (point-max) m2)) - (setq abort-note 'clean) - (kill-region m1 m2)) - (setq abort-note 'dirty))) - - ;; Make sure that the empty lines after are correct - (when (and (> (point-max) end) ; indeed, the buffer was still narrowed - (member (org-capture-get :type 'local) - '(entry item checkitem plain))) - (save-excursion - (goto-char end) - (or (bolp) (newline)) - (org-capture-empty-lines-after - (or (org-capture-get :empty-lines-after 'local) - (org-capture-get :empty-lines 'local) 0)))) - ;; Postprocessing: Update Statistics cookies, do the sorting - (when (derived-mode-p 'org-mode) - (save-excursion - (when (ignore-errors (org-back-to-heading)) - (org-update-parent-todo-statistics) - (org-update-checkbox-count))) - ;; FIXME Here we should do the sorting - ;; If we have added a table line, maybe recompute? - (when (and (eq (org-capture-get :type 'local) 'table-line) - (org-at-table-p)) - (if (org-table-get-stored-formulas) - (org-table-recalculate 'all) ;; FIXME: Should we iterate??? - (org-table-align)))) - ;; Store this place as the last one where we stored something - ;; Do the marking in the base buffer, so that it makes sense after - ;; the indirect buffer has been killed. - (when org-capture-bookmark - (org-capture-bookmark-last-stored-position)) - - ;; Run the hook - (run-hooks 'org-capture-before-finalize-hook)) - - (when (org-capture-get :decrypted) - (save-excursion - (goto-char (org-capture-get :decrypted)) - (org-encrypt-entry))) - - ;; Kill the indirect buffer - (save-buffer) - (let ((return-wconf (org-capture-get :return-to-wconf 'local)) - (new-buffer (org-capture-get :new-buffer 'local)) - (kill-buffer (org-capture-get :kill-buffer 'local)) - (base-buffer (buffer-base-buffer (current-buffer)))) - - ;; Kill the indirect buffer - (kill-buffer (current-buffer)) - - ;; Narrow back the target buffer to its previous state - (with-current-buffer (org-capture-get :buffer) - (let ((reg (org-capture-get :initial-target-region)) - (pos (org-capture-get :initial-target-position)) - (ipt (org-capture-get :insertion-point)) - (size (org-capture-get :captured-entry-size))) - (when reg - (cond ((< ipt (car reg)) - ;; insertion point is before the narrowed region - (narrow-to-region (+ size (car reg)) (+ size (cdr reg)))) - ((> ipt (cdr reg)) - ;; insertion point is after the narrowed region - (narrow-to-region (car reg) (cdr reg))) - (t - ;; insertion point is within the narrowed region - (narrow-to-region (car reg) (+ size (cdr reg))))) - ;; now place back the point at its original position - (if (< ipt (car reg)) - (goto-char (+ size pos)) - (goto-char (if (< ipt pos) (+ size pos) pos)))))) - - ;; Kill the target buffer if that is desired - (when (and base-buffer new-buffer kill-buffer) - (with-current-buffer base-buffer (save-buffer)) - (kill-buffer base-buffer)) - - ;; Restore the window configuration before capture - (set-window-configuration return-wconf)) - - (run-hooks 'org-capture-after-finalize-hook) - ;; Special cases - (cond - (abort-note - (cond - ((equal abort-note 'clean) - (message "Capture process aborted and target buffer cleaned up")) - ((equal abort-note 'dirty) - (error "Capture process aborted, but target buffer could not be cleaned up correctly")))) - (stay-with-capture - (org-capture-goto-last-stored))) - ;; Return if we did store something - (not abort-note))) - -(defun org-capture-refile () - "Finalize the current capture and then refile the entry. -Refiling is done from the base buffer, because the indirect buffer is then -already gone. Any prefix argument will be passed to the refile command." - (interactive) - (unless (eq (org-capture-get :type 'local) 'entry) - (error - "Refiling from a capture buffer makes only sense for `entry'-type templates")) - (let ((pos (point)) - (base (buffer-base-buffer (current-buffer))) - (org-refile-for-capture t)) - (save-window-excursion - (with-current-buffer (or base (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char pos) - (call-interactively 'org-refile))))) - (org-capture-finalize))) - -(defun org-capture-kill () - "Abort the current capture process." - (interactive) - ;; FIXME: This does not do the right thing, we need to remove the - ;; new stuff by hand it is easy: undo, then kill the buffer - (let ((org-note-abort t) - (org-capture-before-finalize-hook nil)) - (org-capture-finalize))) - -(defun org-capture-goto-last-stored () - "Go to the location where the last capture note was stored." - (interactive) - (org-goto-marker-or-bmk org-capture-last-stored-marker - "org-capture-last-stored") - (message "This is the last note stored by a capture process")) - -;;; Supporting functions for handling the process - -(defun org-capture-put-target-region-and-position () - "Store the initial region with `org-capture-put'." - (org-capture-put - :initial-target-region - ;; Check if the buffer is currently narrowed - (when (/= (buffer-size) (- (point-max) (point-min))) - (cons (point-min) (point-max)))) - ;; store the current point - (org-capture-put :initial-target-position (point))) - -(defvar org-time-was-given) ; dynamically scoped parameter -(defun org-capture-set-target-location (&optional target) - "Find TARGET buffer and position. -Store them in the capture property list." - (let ((target-entry-p t) decrypted-hl-pos) - (setq target (or target (org-capture-get :target))) - (save-excursion - (cond - ((eq (car target) 'file) - (set-buffer (org-capture-target-buffer (nth 1 target))) - (org-capture-put-target-region-and-position) - (widen) - (setq target-entry-p nil)) - - ((eq (car target) 'id) - (let ((loc (org-id-find (nth 1 target)))) - (if (not loc) - (error "Cannot find target ID \"%s\"" (nth 1 target)) - (set-buffer (org-capture-target-buffer (car loc))) - (widen) - (org-capture-put-target-region-and-position) - (goto-char (cdr loc))))) - - ((eq (car target) 'file+headline) - (set-buffer (org-capture-target-buffer (nth 1 target))) - (org-capture-put-target-region-and-position) - (widen) - (let ((hd (nth 2 target))) - (goto-char (point-min)) - (unless (derived-mode-p 'org-mode) - (error - "Target buffer \"%s\" for file+headline should be in Org mode" - (current-buffer))) - (if (re-search-forward - (format org-complex-heading-regexp-format (regexp-quote hd)) - nil t) - (goto-char (point-at-bol)) - (goto-char (point-max)) - (or (bolp) (insert "\n")) - (insert "* " hd "\n") - (beginning-of-line 0)))) - - ((eq (car target) 'file+olp) - (let ((m (org-find-olp - (cons (org-capture-expand-file (nth 1 target)) - (cddr target))))) - (set-buffer (marker-buffer m)) - (org-capture-put-target-region-and-position) - (widen) - (goto-char m))) - - ((eq (car target) 'file+regexp) - (set-buffer (org-capture-target-buffer (nth 1 target))) - (org-capture-put-target-region-and-position) - (widen) - (goto-char (point-min)) - (if (re-search-forward (nth 2 target) nil t) - (progn - (goto-char (if (org-capture-get :prepend) - (match-beginning 0) (match-end 0))) - (org-capture-put :exact-position (point)) - (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) - (error "No match for target regexp in file %s" (nth 1 target)))) - - ((memq (car target) '(file+datetree file+datetree+prompt)) - (require 'org-datetree) - (set-buffer (org-capture-target-buffer (nth 1 target))) - (org-capture-put-target-region-and-position) - (widen) - ;; Make a date tree entry, with the current date (or yesterday, - ;; if we are extending dates for a couple of hours) - (org-datetree-find-date-create - (calendar-gregorian-from-absolute - (cond - (org-overriding-default-time - ;; use the overriding default time - (time-to-days org-overriding-default-time)) - - ((eq (car target) 'file+datetree+prompt) - ;; prompt for date - (let ((prompt-time (org-read-date - nil t nil "Date for tree entry:" - (current-time)))) - (org-capture-put - :default-time - (cond ((and (or (not (boundp 'org-time-was-given)) - (not org-time-was-given)) - (not (= (time-to-days prompt-time) (org-today)))) - ;; Use 00:00 when no time is given for another date than today? - (apply 'encode-time (append '(0 0 0) (cdddr (decode-time prompt-time))))) - ((string-match "\\([^ ]+\\)--?[^ ]+[ ]+\\(.*\\)" org-read-date-final-answer) - ;; Replace any time range by its start - (apply 'encode-time - (org-read-date-analyze - (replace-match "\\1 \\2" nil nil org-read-date-final-answer) - prompt-time (decode-time prompt-time)))) - (t prompt-time))) - (time-to-days prompt-time))) - (t - ;; current date, possibly corrected for late night workers - (org-today)))))) - - ((eq (car target) 'file+function) - (set-buffer (org-capture-target-buffer (nth 1 target))) - (org-capture-put-target-region-and-position) - (widen) - (funcall (nth 2 target)) - (org-capture-put :exact-position (point)) - (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) - - ((eq (car target) 'function) - (funcall (nth 1 target)) - (org-capture-put :exact-position (point)) - (setq target-entry-p (and (derived-mode-p 'org-mode) (org-at-heading-p)))) - - ((eq (car target) 'clock) - (if (and (markerp org-clock-hd-marker) - (marker-buffer org-clock-hd-marker)) - (progn (set-buffer (marker-buffer org-clock-hd-marker)) - (org-capture-put-target-region-and-position) - (widen) - (goto-char org-clock-hd-marker)) - (error "No running clock that could be used as capture target"))) - - (t (error "Invalid capture target specification"))) - - (when (and (featurep 'org-crypt) (org-at-encrypted-entry-p)) - (org-decrypt-entry) - (setq decrypted-hl-pos - (save-excursion (and (org-back-to-heading t) (point))))) - - (org-capture-put :buffer (current-buffer) :pos (point) - :target-entry-p target-entry-p - :decrypted decrypted-hl-pos)))) - -(defun org-capture-expand-file (file) - "Expand functions and symbols for FILE. -When FILE is a function, call it. When it is a form, evaluate -it. When it is a variable, retrieve the value. Return whatever we get." - (cond - ((org-string-nw-p file) file) - ((functionp file) (funcall file)) - ((and (symbolp file) (boundp file)) (symbol-value file)) - ((and file (consp file)) (eval file)) - (t file))) - -(defun org-capture-target-buffer (file) - "Get a buffer for FILE." - (setq file (org-capture-expand-file file)) - (setq file (or (org-string-nw-p file) - org-default-notes-file - (error "No notes file specified, and no default available"))) - (or (org-find-base-buffer-visiting file) - (progn (org-capture-put :new-buffer t) - (find-file-noselect (expand-file-name file org-directory))))) - -(defun org-capture-steal-local-variables (buffer) - "Install Org-mode local variables of BUFFER." - (mapc (lambda (v) - (ignore-errors (org-set-local (car v) (cdr v)))) - (buffer-local-variables buffer))) - -(defun org-capture-place-template (&optional inhibit-wconf-store) - "Insert the template at the target location, and display the buffer. -When `inhibit-wconf-store', don't store the window configuration, as it -may have been stored before." - (unless inhibit-wconf-store - (org-capture-put :return-to-wconf (current-window-configuration))) - (delete-other-windows) - (org-switch-to-buffer-other-window - (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE")) - (widen) - (show-all) - (goto-char (org-capture-get :pos)) - (org-set-local 'org-capture-target-marker - (point-marker)) - (org-set-local 'outline-level 'org-outline-level) - (let* ((template (org-capture-get :template)) - (type (org-capture-get :type))) - (case type - ((nil entry) (org-capture-place-entry)) - (table-line (org-capture-place-table-line)) - (plain (org-capture-place-plain-text)) - (item (org-capture-place-item)) - (checkitem (org-capture-place-item)))) - (org-capture-mode 1) - (org-set-local 'org-capture-current-plist org-capture-plist)) - -(defun org-capture-place-entry () - "Place the template as a new Org entry." - (let* ((txt (org-capture-get :template)) - (reversed (org-capture-get :prepend)) - (target-entry-p (org-capture-get :target-entry-p)) - level beg end file) - - (cond - ((org-capture-get :exact-position) - (goto-char (org-capture-get :exact-position))) - ((not target-entry-p) - ;; Insert as top-level entry, either at beginning or at end of file - (setq level 1) - (if reversed - (progn (goto-char (point-min)) - (or (org-at-heading-p) - (outline-next-heading))) - (goto-char (point-max)) - (or (bolp) (insert "\n")))) - (t - ;; Insert as a child of the current entry - (and (looking-at "\\*+") - (setq level (- (match-end 0) (match-beginning 0)))) - (setq level (org-get-valid-level (or level 1) 1)) - (if reversed - (progn - (outline-next-heading) - (or (bolp) (insert "\n"))) - (org-end-of-subtree t nil) - (or (bolp) (insert "\n"))))) - (org-capture-empty-lines-before) - (setq beg (point)) - (org-capture-verify-tree txt) - (org-paste-subtree level txt 'for-yank) - (org-capture-empty-lines-after 1) - (org-capture-position-for-last-stored beg) - (outline-next-heading) - (setq end (point)) - (org-capture-mark-kill-region beg (1- end)) - (org-capture-narrow beg (1- end)) - (if (or (re-search-backward "%\\?" beg t) - (re-search-forward "%\\?" end t)) - (replace-match "")))) - -(defun org-capture-place-item () - "Place the template as a new plain list item." - (let* ((txt (org-capture-get :template)) - (target-entry-p (org-capture-get :target-entry-p)) - (ind 0) - beg end) - (if (org-capture-get :exact-position) - (goto-char (org-capture-get :exact-position)) - (cond - ((not target-entry-p) - ;; Insert as top-level entry, either at beginning or at end of file - (setq beg (point-min) end (point-max))) - (t - (setq beg (1+ (point-at-eol)) - end (save-excursion (outline-next-heading) (point))))) - (if (org-capture-get :prepend) - (progn - (goto-char beg) - (if (org-list-search-forward (org-item-beginning-re) end t) - (progn - (goto-char (match-beginning 0)) - (setq ind (org-get-indentation))) - (goto-char end) - (setq ind 0))) - (goto-char end) - (if (org-list-search-backward (org-item-beginning-re) beg t) - (progn - (setq ind (org-get-indentation)) - (org-end-of-item)) - (setq ind 0)))) - ;; Remove common indentation - (setq txt (org-remove-indentation txt)) - ;; Make sure this is indeed an item - (unless (string-match (concat "\\`" (org-item-re)) txt) - (setq txt (concat "- " - (mapconcat 'identity (split-string txt "\n") - "\n ")))) - ;; Set the correct indentation, depending on context - (setq ind (make-string ind ?\ )) - (setq txt (concat ind - (mapconcat 'identity (split-string txt "\n") - (concat "\n" ind)) - "\n")) - ;; Insert, with surrounding empty lines - (org-capture-empty-lines-before) - (setq beg (point)) - (insert txt) - (or (bolp) (insert "\n")) - (org-capture-empty-lines-after 1) - (org-capture-position-for-last-stored beg) - (forward-char 1) - (setq end (point)) - (org-capture-mark-kill-region beg (1- end)) - (org-capture-narrow beg (1- end)) - (if (or (re-search-backward "%\\?" beg t) - (re-search-forward "%\\?" end t)) - (replace-match "")))) - -(defun org-capture-place-table-line () - "Place the template as a table line." - (require 'org-table) - (let* ((txt (org-capture-get :template)) - (target-entry-p (org-capture-get :target-entry-p)) - (table-line-pos (org-capture-get :table-line-pos)) - ind beg end) - (cond - ((org-capture-get :exact-position) - (goto-char (org-capture-get :exact-position))) - ((not target-entry-p) - ;; Table is not necessarily under a heading - (setq beg (point-min) end (point-max))) - (t - ;; WE are at a heading, limit search to the body - (setq beg (1+ (point-at-eol)) - end (save-excursion (outline-next-heading) (point))))) - (if (re-search-forward org-table-dataline-regexp end t) - (let ((b (org-table-begin)) (e (org-table-end)) (case-fold-search t)) - (goto-char e) - (if (looking-at "[ \t]*#\\+tblfm:") - (forward-line 1)) - (narrow-to-region b (point))) - (goto-char end) - (insert "\n| |\n|----|\n| |\n") - (narrow-to-region (1+ end) (point))) - ;; We are narrowed to the table, or to an empty line if there was no table - - ;; Check if the template is good - (if (not (string-match org-table-dataline-regexp txt)) - (setq txt "| %?Bad template |\n")) - (cond - ((and table-line-pos - (string-match "\\(I+\\)\\([-+][0-9]\\)" table-line-pos)) - ;; we have a complex line specification - (goto-char (point-min)) - (let ((nh (- (match-end 1) (match-beginning 1))) - (delta (string-to-number (match-string 2 table-line-pos))) - ll) - ;; The user wants a special position in the table - (org-table-get-specials) - (setq ll (ignore-errors (aref org-table-hlines nh))) - (unless ll (error "Invalid table line specification \"%s\"" - table-line-pos)) - (setq ll (+ ll delta (if (< delta 0) 0 -1))) - (org-goto-line ll) - (org-table-insert-row 'below) - (beginning-of-line 1) - (delete-region (point) (1+ (point-at-eol))) - (setq beg (point)) - (insert txt) - (setq end (point)))) - ((org-capture-get :prepend) - (goto-char (point-min)) - (re-search-forward org-table-hline-regexp nil t) - (beginning-of-line 1) - (re-search-forward org-table-dataline-regexp nil t) - (beginning-of-line 1) - (setq beg (point)) - (org-table-insert-row) - (beginning-of-line 1) - (delete-region (point) (1+ (point-at-eol))) - (insert txt) - (setq end (point))) - (t - (goto-char (point-max)) - (re-search-backward org-table-dataline-regexp nil t) - (beginning-of-line 1) - (org-table-insert-row 'below) - (beginning-of-line 1) - (delete-region (point) (1+ (point-at-eol))) - (setq beg (point)) - (insert txt) - (setq end (point)))) - (goto-char beg) - (org-capture-position-for-last-stored 'table-line) - (if (or (re-search-backward "%\\?" beg t) - (re-search-forward "%\\?" end t)) - (replace-match "")) - (org-table-align))) - -(defun org-capture-place-plain-text () - "Place the template plainly. -If the target locator points at an Org node, place the template into -the text of the entry, before the first child. If not, place the -template at the beginning or end of the file. -Of course, if exact position has been required, just put it there." - (let* ((txt (org-capture-get :template)) - beg end) - (cond - ((org-capture-get :exact-position) - (goto-char (org-capture-get :exact-position))) - ((and (org-capture-get :target-entry-p) - (bolp) - (looking-at org-outline-regexp)) - ;; we should place the text into this entry - (if (org-capture-get :prepend) - ;; Skip meta data and drawers - (org-end-of-meta-data-and-drawers) - ;; go to ent of the entry text, before the next headline - (outline-next-heading))) - (t - ;; beginning or end of file - (goto-char (if (org-capture-get :prepend) (point-min) (point-max))))) - (or (bolp) (newline)) - (org-capture-empty-lines-before) - (setq beg (point)) - (insert txt) - (org-capture-empty-lines-after 1) - (org-capture-position-for-last-stored beg) - (setq end (point)) - (org-capture-mark-kill-region beg (1- end)) - (org-capture-narrow beg (1- end)) - (if (or (re-search-backward "%\\?" beg t) - (re-search-forward "%\\?" end t)) - (replace-match "")))) - -(defun org-capture-mark-kill-region (beg end) - "Mark the region that will have to be killed when aborting capture." - (let ((m1 (move-marker (make-marker) beg)) - (m2 (move-marker (make-marker) end))) - (org-capture-put :begin-marker m1) - (org-capture-put :end-marker m2))) - -(defun org-capture-position-for-last-stored (where) - "Memorize the position that should later become the position of last capture." - (cond - ((integerp where) - (org-capture-put :position-for-last-stored - (move-marker (make-marker) where - (or (buffer-base-buffer (current-buffer)) - (current-buffer))))) - ((eq where 'table-line) - (org-capture-put :position-for-last-stored - (list 'table-line - (org-table-current-dline)))) - (t (error "This should not happen")))) - -(defun org-capture-bookmark-last-stored-position () - "Bookmark the last-captured position." - (let* ((where (org-capture-get :position-for-last-stored 'local)) - (pos (cond - ((markerp where) - (prog1 (marker-position where) - (move-marker where nil))) - ((and (listp where) (eq (car where) 'table-line)) - (if (org-at-table-p) - (save-excursion - (org-table-goto-line (nth 1 where)) - (point-at-bol)) - (point)))))) - (with-current-buffer (buffer-base-buffer (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char pos) - (let ((bookmark-name (plist-get org-bookmark-names-plist - :last-capture))) - (when bookmark-name - (with-demoted-errors - (bookmark-set bookmark-name)))) - (move-marker org-capture-last-stored-marker (point))))))) - -(defun org-capture-narrow (beg end) - "Narrow, unless configuration says not to narrow." - (unless (org-capture-get :unnarrowed) - (narrow-to-region beg end) - (goto-char beg))) - -(defun org-capture-empty-lines-before (&optional n) - "Set the correct number of empty lines before the insertion point. -Point will be after the empty lines, so insertion can directly be done." - (setq n (or n (org-capture-get :empty-lines-before) - (org-capture-get :empty-lines) 0)) - (let ((pos (point))) - (org-back-over-empty-lines) - (delete-region (point) pos) - (if (> n 0) (newline n)))) - -(defun org-capture-empty-lines-after (&optional n) - "Set the correct number of empty lines after the inserted string. -Point will remain at the first line after the inserted text." - (setq n (or n (org-capture-get :empty-lines-after) - (org-capture-get :empty-lines) 0)) - (org-back-over-empty-lines) - (while (looking-at "[ \t]*\n") (replace-match "")) - (let ((pos (point))) - (if (> n 0) (newline n)) - (goto-char pos))) - -(defvar org-clock-marker) ; Defined in org.el - -(defun org-capture-insert-template-here () - "Insert the capture template at point." - (let* ((template (org-capture-get :template)) - (type (org-capture-get :type)) - beg end pp) - (or (bolp) (newline)) - (setq beg (point)) - (cond - ((and (eq type 'entry) (derived-mode-p 'org-mode)) - (org-capture-verify-tree (org-capture-get :template)) - (org-paste-subtree nil template t)) - ((and (memq type '(item checkitem)) - (derived-mode-p 'org-mode) - (save-excursion (skip-chars-backward " \t\n") - (setq pp (point)) - (org-in-item-p))) - (goto-char pp) - (org-insert-item) - (skip-chars-backward " ") - (skip-chars-backward "-+*0123456789).") - (delete-region (point) (point-at-eol)) - (setq beg (point)) - (org-remove-indentation template) - (insert template) - (org-capture-empty-lines-after) - (goto-char beg) - (org-list-repair) - (org-end-of-item) - (setq end (point))) - (t (insert template))) - (setq end (point)) - (goto-char beg) - (if (re-search-forward "%\\?" end t) - (replace-match "")))) - -(defun org-capture-set-plist (entry) - "Initialize the property list from the template definition." - (setq org-capture-plist (copy-sequence (nthcdr 5 entry))) - (org-capture-put :key (car entry) :description (nth 1 entry) - :target (nth 3 entry)) - (let ((txt (nth 4 entry)) (type (or (nth 2 entry) 'entry))) - (when (or (not txt) (and (stringp txt) (not (string-match "\\S-" txt)))) - ;; The template may be empty or omitted for special types. - ;; Here we insert the default templates for such cases. - (cond - ((eq type 'item) (setq txt "- %?")) - ((eq type 'checkitem) (setq txt "- [ ] %?")) - ((eq type 'table-line) (setq txt "| %? |")) - ((member type '(nil entry)) (setq txt "* %?\n %a")))) - (org-capture-put :template txt :type type))) - -(defun org-capture-goto-target (&optional template-key) - "Go to the target location of a capture template. -The user is queried for the template." - (interactive) - (let* (org-select-template-temp-major-mode - (entry (org-capture-select-template template-key))) - (unless entry - (error "No capture template selected")) - (org-capture-set-plist entry) - (org-capture-set-target-location) - (org-pop-to-buffer-same-window (org-capture-get :buffer)) - (goto-char (org-capture-get :pos)))) - -(defun org-capture-get-indirect-buffer (&optional buffer prefix) - "Make an indirect buffer for a capture process. -Use PREFIX as a prefix for the name of the indirect buffer." - (setq buffer (or buffer (current-buffer))) - (let ((n 1) (base (buffer-name buffer)) bname) - (setq bname (concat prefix "-" base)) - (while (buffer-live-p (get-buffer bname)) - (setq bname (concat prefix "-" (number-to-string (incf n)) "-" base))) - (condition-case nil - (make-indirect-buffer buffer bname 'clone) - (error - (let ((buf (make-indirect-buffer buffer bname))) - (with-current-buffer buf (org-mode)) - buf))))) - -(defun org-capture-verify-tree (tree) - "Throw error if TREE is not a valid tree." - (unless (org-kill-is-subtree-p tree) - (error "Template is not a valid Org entry or tree"))) - -(defun org-mks (table title &optional prompt specials) - "Select a member of an alist with multiple keys. -TABLE is the alist which should contain entries where the car is a string. -There should be two types of entries. - -1. prefix descriptions like (\"a\" \"Description\") - This indicates that `a' is a prefix key for multi-letter selection, and - that there are entries following with keys like \"ab\", \"ax\"... - -2. Selectable members must have more than two elements, with the first - being the string of keys that lead to selecting it, and the second a - short description string of the item. - -The command will then make a temporary buffer listing all entries -that can be selected with a single key, and all the single key -prefixes. When you press the key for a single-letter entry, it is selected. -When you press a prefix key, the commands (and maybe further prefixes) -under this key will be shown and offered for selection. - -TITLE will be placed over the selection in the temporary buffer, -PROMPT will be used when prompting for a key. SPECIAL is an alist with -also (\"key\" \"description\") entries. When one of these is selection, -only the bare key is returned." - (setq prompt (or prompt "Select: ")) - (let (tbl orig-table dkey ddesc des-keys allowed-keys - current prefix rtn re pressed buffer (inhibit-quit t)) - (save-window-excursion - (setq buffer (org-switch-to-buffer-other-window "*Org Select*")) - (setq orig-table table) - (catch 'exit - (while t - (erase-buffer) - (insert title "\n\n") - (setq tbl table - des-keys nil - allowed-keys nil - cursor-type nil) - (setq prefix (if current (concat current " ") "")) - (while tbl - (cond - ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1)) - ;; This is a description on this level - (setq dkey (caar tbl) ddesc (cadar tbl)) - (pop tbl) - (push dkey des-keys) - (push dkey allowed-keys) - (insert prefix "[" dkey "]" "..." " " ddesc "..." "\n") - ;; Skip keys which are below this prefix - (setq re (concat "\\`" (regexp-quote dkey))) - (let (case-fold-search) - (while (and tbl (string-match re (caar tbl))) (pop tbl)))) - ((= 2 (length (car tbl))) - ;; Not yet a usable description, skip it - ) - (t - ;; usable entry on this level - (insert prefix "[" (caar tbl) "]" " " (nth 1 (car tbl)) "\n") - (push (caar tbl) allowed-keys) - (pop tbl)))) - (when specials - (insert "-------------------------------------------------------------------------------\n") - (let ((sp specials)) - (while sp - (insert (format "[%s] %s\n" - (caar sp) (nth 1 (car sp)))) - (push (caar sp) allowed-keys) - (pop sp)))) - (push "\C-g" allowed-keys) - (goto-char (point-min)) - (if (not (pos-visible-in-window-p (point-max))) - (org-fit-window-to-buffer)) - (message prompt) - (setq pressed (char-to-string (read-char-exclusive))) - (while (not (member pressed allowed-keys)) - (message "Invalid key `%s'" pressed) (sit-for 1) - (message prompt) - (setq pressed (char-to-string (read-char-exclusive)))) - (when (equal pressed "\C-g") - (kill-buffer buffer) - (error "Abort")) - (when (and (not (assoc pressed table)) - (not (member pressed des-keys)) - (assoc pressed specials)) - (throw 'exit (setq rtn pressed))) - (unless (member pressed des-keys) - (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table)) - orig-table)))) - (setq current (concat current pressed)) - (setq table (mapcar - (lambda (x) - (if (and (> (length (car x)) 1) - (equal (substring (car x) 0 1) pressed)) - (cons (substring (car x) 1) (cdr x)) - nil)) - table)) - (setq table (remove nil table))))) - (when buffer (kill-buffer buffer)) - rtn)) - -;;; The template code -(defun org-capture-select-template (&optional keys) - "Select a capture template. -Lisp programs can force the template by setting KEYS to a string." - (let ((org-capture-templates - (or (org-contextualize-keys - org-capture-templates org-capture-templates-contexts) - '(("t" "Task" entry (file+headline "" "Tasks") - "* TODO %?\n %u\n %a"))))) - (if keys - (or (assoc keys org-capture-templates) - (error "No capture template referred to by \"%s\" keys" keys)) - (org-mks org-capture-templates - "Select a capture template\n=========================" - "Template key: " - '(("C" "Customize org-capture-templates") - ("q" "Abort")))))) - -(defun org-capture-fill-template (&optional template initial annotation) - "Fill a template and return the filled template as a string. -The template may still contain \"%?\" for cursor positioning." - (setq template (or template (org-capture-get :template))) - (when (stringp initial) - (setq initial (org-no-properties initial))) - (let* ((buffer (org-capture-get :buffer)) - (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) - (ct (org-capture-get :default-time)) - (dct (decode-time ct)) - (ct1 - (if (< (nth 2 dct) org-extend-today-until) - (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct)) - ct)) - (plist-p (if org-store-link-plist t nil)) - (v-c (and (> (length kill-ring) 0) (current-kill 0))) - (v-x (or (org-get-x-clipboard 'PRIMARY) - (org-get-x-clipboard 'CLIPBOARD) - (org-get-x-clipboard 'SECONDARY))) - (v-t (format-time-string (car org-time-stamp-formats) ct)) - (v-T (format-time-string (cdr org-time-stamp-formats) ct)) - (v-u (concat "[" (substring v-t 1 -1) "]")) - (v-U (concat "[" (substring v-T 1 -1) "]")) - ;; `initial' and `annotation' might habe been passed. - ;; But if the property list has them, we prefer those values - (v-i (or (plist-get org-store-link-plist :initial) - initial - (org-capture-get :initial) - "")) - (v-a (or (plist-get org-store-link-plist :annotation) - annotation - (org-capture-get :annotation) - "")) - ;; Is the link empty? Then we do not want it... - (v-a (if (equal v-a "[[]]") "" v-a)) - (clipboards (remove nil (list v-i - (org-get-x-clipboard 'PRIMARY) - (org-get-x-clipboard 'CLIPBOARD) - (org-get-x-clipboard 'SECONDARY) - v-c))) - (l-re "\\[\\[\\(.*?\\)\\]\\(\\[.*?\\]\\)?\\]") - (v-A (if (and v-a (string-match l-re v-a)) - (replace-match "[[\\1][%^{Link description}]]" nil nil v-a) - v-a)) - (v-l (if (and v-a (string-match l-re v-a)) - (replace-match "\\1" nil nil v-a) - v-a)) - (v-n user-full-name) - (v-k (if (marker-buffer org-clock-marker) - (org-no-properties org-clock-heading))) - (v-K (if (marker-buffer org-clock-marker) - (org-make-link-string - (buffer-file-name (marker-buffer org-clock-marker)) - org-clock-heading))) - (v-f (or (org-capture-get :original-file-nondirectory) "")) - (v-F (or (org-capture-get :original-file) "")) - v-I - (org-startup-folded nil) - (org-inhibit-startup t) - org-time-was-given org-end-time-was-given x - prompt completions char time pos default histvar strings) - - (setq org-store-link-plist - (plist-put org-store-link-plist :annotation v-a) - org-store-link-plist - (plist-put org-store-link-plist :initial v-i)) - (setq initial v-i) - - (unless template (setq template "") (message "No template") (ding) - (sit-for 1)) - (save-window-excursion - (delete-other-windows) - (org-pop-to-buffer-same-window (get-buffer-create "*Capture*")) - (erase-buffer) - (insert template) - (goto-char (point-min)) - (org-capture-steal-local-variables buffer) - (setq buffer-file-name nil) - - ;; %[] Insert contents of a file. - (goto-char (point-min)) - (while (re-search-forward "%\\[\\(.+\\)\\]" nil t) - (unless (org-capture-escaped-%) - (let ((start (match-beginning 0)) - (end (match-end 0)) - (filename (expand-file-name (match-string 1)))) - (goto-char start) - (delete-region start end) - (condition-case error - (insert-file-contents filename) - (error (insert (format "%%![Couldn't insert %s: %s]" - filename error))))))) - ;; %() embedded elisp - (org-capture-expand-embedded-elisp) - - ;; The current time - (goto-char (point-min)) - (while (re-search-forward "%<\\([^>\n]+\\)>" nil t) - (replace-match (format-time-string (match-string 1)) t t)) - - ;; Simple %-escapes - (goto-char (point-min)) - (while (re-search-forward "%\\([tTuUaliAcxkKInfF]\\)" nil t) - (unless (org-capture-escaped-%) - (when (and initial (equal (match-string 0) "%i")) - (save-match-data - (let* ((lead (buffer-substring - (point-at-bol) (match-beginning 0)))) - (setq v-i (mapconcat 'identity - (org-split-string initial "\n") - (concat "\n" lead)))))) - (replace-match (or (eval (intern (concat "v-" (match-string 1)))) "") - t t))) - - ;; From the property list - (when plist-p - (goto-char (point-min)) - (while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t) - (unless (org-capture-escaped-%) - (and (setq x (or (plist-get org-store-link-plist - (intern (match-string 1))) "")) - (replace-match x t t))))) - - ;; Turn on org-mode in temp buffer, set local variables - ;; This is to support completion in interactive prompts - (let ((org-inhibit-startup t)) (org-mode)) - ;; Interactive template entries - (goto-char (point-min)) - (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?" nil t) - (unless (org-capture-escaped-%) - (setq char (if (match-end 3) (match-string-no-properties 3)) - prompt (if (match-end 2) (match-string-no-properties 2))) - (goto-char (match-beginning 0)) - (replace-match "") - (setq completions nil default nil) - (when prompt - (setq completions (org-split-string prompt "|") - prompt (pop completions) - default (car completions) - histvar (intern (concat - "org-capture-template-prompt-history::" - (or prompt ""))) - completions (mapcar 'list completions))) - (unless (boundp histvar) (set histvar nil)) - (cond - ((member char '("G" "g")) - (let* ((org-last-tags-completion-table - (org-global-tags-completion-table - (if (equal char "G") - (org-agenda-files) - (and file (list file))))) - (org-add-colon-after-tag-completion t) - (ins (org-icompleting-read - (if prompt (concat prompt ": ") "Tags: ") - 'org-tags-completion-function nil nil nil - 'org-tags-history))) - (setq ins (mapconcat 'identity - (org-split-string - ins (org-re "[^[:alnum:]_@#%]+")) - ":")) - (when (string-match "\\S-" ins) - (or (equal (char-before) ?:) (insert ":")) - (insert ins) - (or (equal (char-after) ?:) (insert ":")) - (and (org-at-heading-p) (org-set-tags nil 'align))))) - ((equal char "C") - (cond ((= (length clipboards) 1) (insert (car clipboards))) - ((> (length clipboards) 1) - (insert (read-string "Clipboard/kill value: " - (car clipboards) '(clipboards . 1) - (car clipboards)))))) - ((equal char "L") - (cond ((= (length clipboards) 1) - (org-insert-link 0 (car clipboards))) - ((> (length clipboards) 1) - (org-insert-link 0 (read-string "Clipboard/kill value: " - (car clipboards) - '(clipboards . 1) - (car clipboards)))))) - ((equal char "p") - (org-set-property (org-no-properties prompt) nil)) - (char - ;; These are the date/time related ones - (setq org-time-was-given (equal (upcase char) char)) - (setq time (org-read-date (equal (upcase char) char) t nil - prompt)) - (if (equal (upcase char) char) (setq org-time-was-given t)) - (org-insert-time-stamp time org-time-was-given - (member char '("u" "U")) - nil nil (list org-end-time-was-given))) - (t - (let (org-completion-use-ido) - (push (org-completing-read-no-i - (concat (if prompt prompt "Enter string") - (if default (concat " [" default "]")) - ": ") - completions nil nil nil histvar default) - strings) - (insert (car strings))))))) - ;; Replace %n escapes with nth %^{...} string - (setq strings (nreverse strings)) - (goto-char (point-min)) - (while (re-search-forward "%\\\\\\([1-9][0-9]*\\)" nil t) - (unless (org-capture-escaped-%) - (replace-match - (nth (1- (string-to-number (match-string 1))) strings) - nil t))) - ;; Make sure there are no empty lines before the text, and that - ;; it ends with a newline character - (goto-char (point-min)) - (while (looking-at "[ \t]*\n") (replace-match "")) - (if (re-search-forward "[ \t\n]*\\'" nil t) (replace-match "\n")) - ;; Return the expanded template and kill the temporary buffer - (untabify (point-min) (point-max)) - (set-buffer-modified-p nil) - (prog1 (buffer-string) (kill-buffer (current-buffer)))))) - -(defun org-capture-escaped-% () - "Check if % was escaped - if yes, unescape it now." - (if (equal (char-before (match-beginning 0)) ?\\) - (progn - (delete-region (1- (match-beginning 0)) (match-beginning 0)) - t) - nil)) - -(defun org-capture-expand-embedded-elisp () - "Evaluate embedded elisp %(sexp) and replace with the result." - (goto-char (point-min)) - (while (re-search-forward "%(" nil t) - (unless (org-capture-escaped-%) - (goto-char (match-beginning 0)) - (let ((template-start (point))) - (forward-char 1) - (let* ((sexp (read (current-buffer))) - (result (org-eval - (org-capture--expand-keyword-in-embedded-elisp sexp)))) - (delete-region template-start (point)) - (when result - (if (stringp result) - (insert result) - (error "Capture template sexp `%s' must evaluate to string or nil" - sexp)))))))) - -(defun org-capture--expand-keyword-in-embedded-elisp (attr) - "Recursively replace capture link keywords in ATTR sexp. -Such keywords are prefixed with \"%:\". See -`org-capture-template' for more information." - (cond ((consp attr) - (mapcar 'org-capture--expand-keyword-in-embedded-elisp attr)) - ((symbolp attr) - (let* ((attr-symbol (symbol-name attr)) - (key (and (string-match "%\\(:.*\\)" attr-symbol) - (intern (match-string 1 attr-symbol))))) - (or (plist-get org-store-link-plist key) - attr))) - (t attr))) - -(defun org-capture-inside-embedded-elisp-p () - "Return non-nil if point is inside of embedded elisp %(sexp)." - (let (beg end) - (with-syntax-table emacs-lisp-mode-syntax-table - (save-excursion - ;; `looking-at' and `search-backward' below do not match the "%(" if - ;; point is in its middle - (when (equal (char-before) ?%) - (backward-char)) - (save-match-data - (when (or (looking-at "%(") (search-backward "%(" nil t)) - (setq beg (point)) - (setq end (progn (forward-char) (forward-sexp) (1- (point))))))) - (when (and beg end) - (and (<= (point) end) (>= (point) beg)))))) - -;;;###autoload -(defun org-capture-import-remember-templates () - "Set `org-capture-templates' to be similar to `org-remember-templates'." - (interactive) - (when (and (yes-or-no-p - "Import old remember templates into org-capture-templates? ") - (yes-or-no-p - "Note that this will remove any templates currently defined in `org-capture-templates'. Do you still want to go ahead? ")) - (require 'org-remember) - (setq org-capture-templates - (mapcar - (lambda (entry) - (let ((desc (car entry)) - (key (char-to-string (nth 1 entry))) - (template (nth 2 entry)) - (file (or (nth 3 entry) org-default-notes-file)) - (position (or (nth 4 entry) org-remember-default-headline)) - (type 'entry) - (prepend org-reverse-note-order) - immediate target jump-to-captured) - (cond - ((member position '(top bottom)) - (setq target (list 'file file) - prepend (eq position 'top))) - ((eq position 'date-tree) - (setq target (list 'file+datetree file) - prepend nil)) - (t (setq target (list 'file+headline file position)))) - - (when (string-match "%!" template) - (setq template (replace-match "" t t template) - immediate t)) - - (when (string-match "%&" template) - (setq jump-to-captured t)) - - (append (list key desc type target template) - (if prepend '(:prepend t)) - (if immediate '(:immediate-finish t)) - (if jump-to-captured '(:jump-to-captured t))))) - - org-remember-templates)))) - -(provide 'org-capture) - -;;; org-capture.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-clock.el b/xemacs-packages/lisp/org-8.2.3c/org-clock.el deleted file mode 100644 index 2340ffc7..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-clock.el +++ /dev/null @@ -1,2898 +0,0 @@ -;;; org-clock.el --- The time clocking code for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file contains the time clocking code for Org-mode - -;;; Code: - -(eval-when-compile - (require 'cl)) -(require 'org) - -(declare-function calendar-absolute-from-iso "cal-iso" (&optional date)) -(declare-function notifications-notify "notifications" (&rest params)) -(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) -(declare-function org-refresh-properties "org" (dprop tprop)) -(defvar org-time-stamp-formats) -(defvar org-ts-what) -(defvar org-frame-title-format-backup frame-title-format) - -(defgroup org-clock nil - "Options concerning clocking working time in Org-mode." - :tag "Org Clock" - :group 'org-progress) - -(defcustom org-clock-into-drawer org-log-into-drawer - "Should clocking info be wrapped into a drawer? -When t, clocking info will always be inserted into a :LOGBOOK: drawer. -If necessary, the drawer will be created. -When nil, the drawer will not be created, but used when present. -When an integer and the number of clocking entries in an item -reaches or exceeds this number, a drawer will be created. -When a string, it names the drawer to be used. - -The default for this variable is the value of `org-log-into-drawer', -which see." - :group 'org-todo - :group 'org-clock - :type '(choice - (const :tag "Always" t) - (const :tag "Only when drawer exists" nil) - (integer :tag "When at least N clock entries") - (const :tag "Into LOGBOOK drawer" "LOGBOOK") - (string :tag "Into Drawer named..."))) - -(defun org-clock-into-drawer () - "Return the value of `org-clock-into-drawer', but let properties overrule. -If the current entry has or inherits a CLOCK_INTO_DRAWER -property, it will be used instead of the default value; otherwise -if the current entry has or inherits a LOG_INTO_DRAWER property, -it will be used instead of the default value. -The default is the value of the customizable variable `org-clock-into-drawer', -which see." - (let ((p (org-entry-get nil "CLOCK_INTO_DRAWER" 'inherit)) - (q (org-entry-get nil "LOG_INTO_DRAWER" 'inherit))) - (cond - ((or (not (or p q)) (equal p "nil") (equal q "nil")) org-clock-into-drawer) - ((or (equal p "t") (equal q "t")) "LOGBOOK") - ((not p) q) - (t p)))) - -(defcustom org-clock-out-when-done t - "When non-nil, clock will be stopped when the clocked entry is marked DONE. -DONE here means any DONE-like state. -A nil value means clock will keep running until stopped explicitly with -`C-c C-x C-o', or until the clock is started in a different item. -Instead of t, this can also be a list of TODO states that should trigger -clocking out." - :group 'org-clock - :type '(choice - (const :tag "No" nil) - (const :tag "Yes, when done" t) - (repeat :tag "State list" - (string :tag "TODO keyword")))) - -(defcustom org-clock-rounding-minutes 0 - "Rounding minutes when clocking in or out. -The default value is 0 so that no rounding is done. -When set to a non-integer value, use the car of -`org-time-stamp-rounding-minutes', like for setting a time-stamp. - -E.g. if `org-clock-rounding-minutes' is set to 5, time is 14:47 -and you clock in: then the clock starts at 14:45. If you clock -out within the next 5 minutes, the clock line will be removed; -if you clock out 8 minutes after your clocked in, the clock -out time will be 14:50." - :group 'org-clock - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (integer :tag "Minutes (0 for no rounding)") - (symbol :tag "Use `org-time-stamp-rounding-minutes'" 'same-as-time-stamp))) - -(defcustom org-clock-out-remove-zero-time-clocks nil - "Non-nil means remove the clock line when the resulting time is zero." - :group 'org-clock - :type 'boolean) - -(defcustom org-clock-in-switch-to-state nil - "Set task to a special todo state while clocking it. -The value should be the state to which the entry should be -switched. If the value is a function, it must take one -parameter (the current TODO state of the item) and return the -state to switch it to." - :group 'org-clock - :group 'org-todo - :type '(choice - (const :tag "Don't force a state" nil) - (string :tag "State") - (symbol :tag "Function"))) - -(defcustom org-clock-out-switch-to-state nil - "Set task to a special todo state after clocking out. -The value should be the state to which the entry should be -switched. If the value is a function, it must take one -parameter (the current TODO state of the item) and return the -state to switch it to." - :group 'org-clock - :group 'org-todo - :type '(choice - (const :tag "Don't force a state" nil) - (string :tag "State") - (symbol :tag "Function"))) - -(defcustom org-clock-history-length 5 - "Number of clock tasks to remember in history." - :group 'org-clock - :type 'integer) - -(defcustom org-clock-goto-may-find-recent-task t - "Non-nil means `org-clock-goto' can go to recent task if no active clock." - :group 'org-clock - :type 'boolean) - -(defcustom org-clock-heading-function nil - "When non-nil, should be a function to create `org-clock-heading'. -This is the string shown in the mode line when a clock is running. -The function is called with point at the beginning of the headline." - :group 'org-clock - :type '(choice (const nil) (function))) - -(defcustom org-clock-string-limit 0 - "Maximum length of clock strings in the mode line. 0 means no limit." - :group 'org-clock - :type 'integer) - -(defcustom org-clock-in-resume nil - "If non-nil, resume clock when clocking into task with open clock. -When clocking into a task with a clock entry which has not been closed, -the clock can be resumed from that point." - :group 'org-clock - :type 'boolean) - -(defcustom org-clock-persist nil - "When non-nil, save the running clock when Emacs is closed. -The clock is resumed when Emacs restarts. -When this is t, both the running clock, and the entire clock -history are saved. When this is the symbol `clock', only the -running clock is saved. When this is the symbol `history', only -the clock history is saved. - -When Emacs restarts with saved clock information, the file containing -the running clock as well as all files mentioned in the clock history -will be visited. - -All this depends on running `org-clock-persistence-insinuate' in your -Emacs initialization file." - :group 'org-clock - :type '(choice - (const :tag "Just the running clock" clock) - (const :tag "Just the history" history) - (const :tag "Clock and history" t) - (const :tag "No persistence" nil))) - -(defcustom org-clock-persist-file (convert-standard-filename - (concat user-emacs-directory "org-clock-save.el")) - "File to save clock data to." - :group 'org-clock - :type 'string) - -(defcustom org-clock-persist-query-save nil - "When non-nil, ask before saving the current clock on exit." - :group 'org-clock - :type 'boolean) - -(defcustom org-clock-persist-query-resume t - "When non-nil, ask before resuming any stored clock during load." - :group 'org-clock - :type 'boolean) - -(defcustom org-clock-sound nil - "Sound to use for notifications. -Possible values are: - -nil No sound played -t Standard Emacs beep -file name Play this sound file, fall back to beep" - :group 'org-clock - :type '(choice - (const :tag "No sound" nil) - (const :tag "Standard beep" t) - (file :tag "Play sound file"))) - -(define-obsolete-variable-alias 'org-clock-modeline-total - 'org-clock-mode-line-total "24.3") - -(defcustom org-clock-mode-line-total 'auto - "Default setting for the time included for the mode line clock. -This can be overruled locally using the CLOCK_MODELINE_TOTAL property. -Allowed values are: - -current Only the time in the current instance of the clock -today All time clocked into this task today -repeat All time clocked into this task since last repeat -all All time ever recorded for this task -auto Automatically, either `all', or `repeat' for repeating tasks" - :group 'org-clock - :type '(choice - (const :tag "Current clock" current) - (const :tag "Today's task time" today) - (const :tag "Since last repeat" repeat) - (const :tag "All task time" all) - (const :tag "Automatically, `all' or since `repeat'" auto))) - -(org-defvaralias 'org-task-overrun-text 'org-clock-task-overrun-text) -(defcustom org-clock-task-overrun-text nil - "Extra mode line text to indicate that the clock is overrun. -The can be nil to indicate that instead of adding text, the clock time -should get a different face (`org-mode-line-clock-overrun'). -When this is a string, it is prepended to the clock string as an indication, -also using the face `org-mode-line-clock-overrun'." - :group 'org-clock - :version "24.1" - :type '(choice - (const :tag "Just mark the time string" nil) - (string :tag "Text to prepend"))) - -(defcustom org-show-notification-handler nil - "Function or program to send notification with. -The function or program will be called with the notification -string as argument." - :group 'org-clock - :type '(choice - (const nil) - (string :tag "Program") - (function :tag "Function"))) - -(defgroup org-clocktable nil - "Options concerning the clock table in Org-mode." - :tag "Org Clock Table" - :group 'org-clock) - -(defcustom org-clocktable-defaults - (list - :maxlevel 2 - :lang (or (org-bound-and-true-p org-export-default-language) "en") - :scope 'file - :block nil - :wstart 1 - :mstart 1 - :tstart nil - :tend nil - :step nil - :stepskip0 nil - :fileskip0 nil - :tags nil - :emphasize nil - :link nil - :narrow '40! - :indent t - :formula nil - :timestamp nil - :level nil - :tcolumns nil - :formatter nil) - "Default properties for clock tables." - :group 'org-clock - :version "24.1" - :type 'plist) - -(defcustom org-clock-clocktable-formatter 'org-clocktable-write-default - "Function to turn clocking data into a table. -For more information, see `org-clocktable-write-default'." - :group 'org-clocktable - :version "24.1" - :type 'function) - -;; FIXME: translate es and nl last string "Clock summary at" -(defcustom org-clock-clocktable-language-setup - '(("en" "File" "L" "Timestamp" "Headline" "Time" "ALL" "Total time" "File time" "Clock summary at") - ("es" "Archivo" "N" "Fecha y hora" "Tarea" "Tiempo" "TODO" "Tiempo total" "Tiempo archivo" "Clock summary at") - ("fr" "Fichier" "N" "Horodatage" "En-tête" "Durée" "TOUT" "Durée totale" "Durée fichier" "Horodatage sommaire à") - ("nl" "Bestand" "N" "Tijdstip" "Hoofding" "Duur" "ALLES" "Totale duur" "Bestandstijd" "Clock summary at")) - "Terms used in clocktable, translated to different languages." - :group 'org-clocktable - :version "24.1" - :type 'alist) - -(defcustom org-clock-clocktable-default-properties '(:maxlevel 2 :scope file) - "Default properties for new clocktables. -These will be inserted into the BEGIN line, to make it easy for users to -play with them." - :group 'org-clocktable - :type 'plist) - -(defcustom org-clock-idle-time nil - "When non-nil, resolve open clocks if the user is idle more than X minutes." - :group 'org-clock - :type '(choice - (const :tag "Never" nil) - (integer :tag "After N minutes"))) - -(defcustom org-clock-auto-clock-resolution 'when-no-clock-is-running - "When to automatically resolve open clocks found in Org buffers." - :group 'org-clock - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "When no clock is running" when-no-clock-is-running))) - -(defcustom org-clock-report-include-clocking-task nil - "When non-nil, include the current clocking task time in clock reports." - :group 'org-clock - :version "24.1" - :type 'boolean) - -(defcustom org-clock-resolve-expert nil - "Non-nil means do not show the splash buffer with the clock resolver." - :group 'org-clock - :version "24.1" - :type 'boolean) - -(defcustom org-clock-continuously nil - "Non-nil means to start clocking from the last clock-out time, if any." - :type 'boolean - :version "24.1" - :group 'org-clock) - -(defcustom org-clock-total-time-cell-format "*%s*" - "Format string for the total time cells." - :group 'org-clock - :version "24.1" - :type 'string) - -(defcustom org-clock-file-time-cell-format "*%s*" - "Format string for the file time cells." - :group 'org-clock - :version "24.1" - :type 'string) - -(defcustom org-clock-clocked-in-display 'mode-line - "When clocked in for a task, org-mode can display the current -task and accumulated time in the mode line and/or frame title. -Allowed values are: - -both displays in both mode line and frame title -mode-line displays only in mode line (default) -frame-title displays only in frame title -nil current clock is not displayed" - :group 'org-clock - :type '(choice - (const :tag "Mode line" mode-line) - (const :tag "Frame title" frame-title) - (const :tag "Both" both) - (const :tag "None" nil))) - -(defcustom org-clock-frame-title-format '(t org-mode-line-string) - "The value for `frame-title-format' when clocking in. - -When `org-clock-clocked-in-display' is set to 'frame-title -or 'both, clocking in will replace `frame-title-format' with -this value. Clocking out will restore `frame-title-format'. - -`org-frame-title-string' is a format string using the same -specifications than `frame-title-format', which see." - :version "24.1" - :group 'org-clock - :type 'sexp) - -(defcustom org-clock-x11idle-program-name "x11idle" - "Name of the program which prints X11 idle time in milliseconds. - -You can find x11idle.c in the contrib/scripts directory of the -Org git distribution. Or, you can do: - - sudo apt-get install xprintidle - -if you are using Debian." - :group 'org-clock - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defvar org-clock-in-prepare-hook nil - "Hook run when preparing the clock. -This hook is run before anything happens to the task that -you want to clock in. For example, you can use this hook -to add an effort property.") -(defvar org-clock-in-hook nil - "Hook run when starting the clock.") -(defvar org-clock-out-hook nil - "Hook run when stopping the current clock.") - -(defvar org-clock-cancel-hook nil - "Hook run when cancelling the current clock.") -(defvar org-clock-goto-hook nil - "Hook run when selecting the currently clocked-in entry.") -(defvar org-clock-has-been-used nil - "Has the clock been used during the current Emacs session?") - -;;; The clock for measuring work time. - -(defvar org-mode-line-string "") -(put 'org-mode-line-string 'risky-local-variable t) - -(defvar org-clock-mode-line-timer nil) -(defvar org-clock-idle-timer nil) -(defvar org-clock-heading) ; defined in org.el -(defvar org-clock-start-time "") - -(defvar org-clock-leftover-time nil - "If non-nil, user cancelled a clock; this is when leftover time started.") - -(defvar org-clock-effort "" - "Effort estimate of the currently clocking task.") - -(defvar org-clock-total-time nil - "Holds total time, spent previously on currently clocked item. -This does not include the time in the currently running clock.") - -(defvar org-clock-history nil - "List of marker pointing to recent clocked tasks.") - -(defvar org-clock-default-task (make-marker) - "Marker pointing to the default task that should clock time. -The clock can be made to switch to this task after clocking out -of a different task.") - -(defvar org-clock-interrupted-task (make-marker) - "Marker pointing to the task that has been interrupted by the current clock.") - -(defvar org-clock-mode-line-map (make-sparse-keymap)) -(define-key org-clock-mode-line-map [mode-line mouse-2] 'org-clock-goto) -(define-key org-clock-mode-line-map [mode-line mouse-1] 'org-clock-menu) - -(defun org-clock-menu () - (interactive) - (popup-menu - '("Clock" - ["Clock out" org-clock-out t] - ["Change effort estimate" org-clock-modify-effort-estimate t] - ["Go to clock entry" org-clock-goto t] - ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"]))) - -(defun org-clock-history-push (&optional pos buffer) - "Push a marker to the clock history." - (setq org-clock-history-length (max 1 (min 35 org-clock-history-length))) - (let ((m (move-marker (make-marker) - (or pos (point)) (org-base-buffer - (or buffer (current-buffer))))) - n l) - (while (setq n (member m org-clock-history)) - (move-marker (car n) nil)) - (setq org-clock-history - (delq nil - (mapcar (lambda (x) (if (marker-buffer x) x nil)) - org-clock-history))) - (when (>= (setq l (length org-clock-history)) org-clock-history-length) - (setq org-clock-history - (nreverse - (nthcdr (- l org-clock-history-length -1) - (nreverse org-clock-history))))) - (push m org-clock-history))) - -(defun org-clock-save-markers-for-cut-and-paste (beg end) - "Save relative positions of markers in region." - (org-check-and-save-marker org-clock-marker beg end) - (org-check-and-save-marker org-clock-hd-marker beg end) - (org-check-and-save-marker org-clock-default-task beg end) - (org-check-and-save-marker org-clock-interrupted-task beg end) - (mapc (lambda (m) (org-check-and-save-marker m beg end)) - org-clock-history)) - -(defun org-clocking-buffer () - "Return the clocking buffer if we are currently clocking a task or nil." - (marker-buffer org-clock-marker)) - -(defun org-clocking-p () - "Return t when clocking a task." - (not (equal (org-clocking-buffer) nil))) - -(defvar org-clock-before-select-task-hook nil - "Hook called in task selection just before prompting the user.") - -(defun org-clock-select-task (&optional prompt) - "Select a task that was recently associated with clocking." - (interactive) - (let (och chl sel-list rpl (i 0) s) - ;; Remove successive dups from the clock history to consider - (mapc (lambda (c) (if (not (equal c (car och))) (push c och))) - org-clock-history) - (setq och (reverse och) chl (length och)) - (if (zerop chl) - (user-error "No recent clock") - (save-window-excursion - (org-switch-to-buffer-other-window - (get-buffer-create "*Clock Task Select*")) - (erase-buffer) - (when (marker-buffer org-clock-default-task) - (insert (org-add-props "Default Task\n" nil 'face 'bold)) - (setq s (org-clock-insert-selection-line ?d org-clock-default-task)) - (push s sel-list)) - (when (marker-buffer org-clock-interrupted-task) - (insert (org-add-props "The task interrupted by starting the last one\n" nil 'face 'bold)) - (setq s (org-clock-insert-selection-line ?i org-clock-interrupted-task)) - (push s sel-list)) - (when (org-clocking-p) - (insert (org-add-props "Current Clocking Task\n" nil 'face 'bold)) - (setq s (org-clock-insert-selection-line ?c org-clock-marker)) - (push s sel-list)) - (insert (org-add-props "Recent Tasks\n" nil 'face 'bold)) - (mapc - (lambda (m) - (when (marker-buffer m) - (setq i (1+ i) - s (org-clock-insert-selection-line - (if (< i 10) - (+ i ?0) - (+ i (- ?A 10))) m)) - (if (fboundp 'int-to-char) (setf (car s) (int-to-char (car s)))) - (push s sel-list))) - och) - (run-hooks 'org-clock-before-select-task-hook) - (goto-char (point-min)) - ;; Set min-height relatively to circumvent a possible but in - ;; `fit-window-to-buffer' - (fit-window-to-buffer nil nil (if (< chl 10) chl (+ 5 chl))) - (message (or prompt "Select task for clocking:")) - (setq cursor-type nil rpl (read-char-exclusive)) - (cond - ((eq rpl ?q) nil) - ((eq rpl ?x) nil) - ((assoc rpl sel-list) (cdr (assoc rpl sel-list))) - (t (user-error "Invalid task choice %c" rpl))))))) - -(defun org-clock-insert-selection-line (i marker) - "Insert a line for the clock selection menu. -And return a cons cell with the selection character integer and the marker -pointing to it." - (when (marker-buffer marker) - (let (file cat task heading prefix) - (with-current-buffer (org-base-buffer (marker-buffer marker)) - (save-excursion - (save-restriction - (widen) - (ignore-errors - (goto-char marker) - (setq file (buffer-file-name (marker-buffer marker)) - cat (org-get-category) - heading (org-get-heading 'notags) - prefix (save-excursion - (org-back-to-heading t) - (looking-at org-outline-regexp) - (match-string 0)) - task (substring - (org-fontify-like-in-org-mode - (concat prefix heading) - org-odd-levels-only) - (length prefix))))))) - (when (and cat task) - (insert (format "[%c] %-12s %s\n" i cat task)) - (cons i marker))))) - -(defvar org-clock-task-overrun nil - "Internal flag indicating if the clock has overrun the planned time.") -(defvar org-clock-update-period 60 - "Number of seconds between mode line clock string updates.") - -(defun org-clock-get-clock-string () - "Form a clock-string, that will be shown in the mode line. -If an effort estimate was defined for the current item, use -01:30/01:50 format (clocked/estimated). -If not, show simply the clocked time like 01:50." - (let ((clocked-time (org-clock-get-clocked-time))) - (if org-clock-effort - (let* ((effort-in-minutes - (org-duration-string-to-minutes org-clock-effort)) - (work-done-str - (org-propertize - (org-minutes-to-clocksum-string clocked-time) - 'face (if (and org-clock-task-overrun (not org-clock-task-overrun-text)) - 'org-mode-line-clock-overrun 'org-mode-line-clock))) - (effort-str (org-minutes-to-clocksum-string effort-in-minutes)) - (clockstr (org-propertize - (concat " [%s/" effort-str - "] (" (replace-regexp-in-string "%" "%%" org-clock-heading) ")") - 'face 'org-mode-line-clock))) - (format clockstr work-done-str)) - (org-propertize (concat "[" (org-minutes-to-clocksum-string clocked-time) - (format " (%s)" org-clock-heading) "]") - 'face 'org-mode-line-clock)))) - -(defun org-clock-get-last-clock-out-time () - "Get the last clock-out time for the current subtree." - (save-excursion - (let ((end (save-excursion (org-end-of-subtree)))) - (when (re-search-forward (concat org-clock-string - ".*\\]--\\(\\[[^]]+\\]\\)") end t) - (org-time-string-to-time (match-string 1)))))) - -(defun org-clock-update-mode-line () - (if org-clock-effort - (org-clock-notify-once-if-expired) - (setq org-clock-task-overrun nil)) - (setq org-mode-line-string - (org-propertize - (let ((clock-string (org-clock-get-clock-string)) - (help-text "Org-mode clock is running.\nmouse-1 shows a menu\nmouse-2 will jump to task")) - (if (and (> org-clock-string-limit 0) - (> (length clock-string) org-clock-string-limit)) - (org-propertize - (substring clock-string 0 org-clock-string-limit) - 'help-echo (concat help-text ": " org-clock-heading)) - (org-propertize clock-string 'help-echo help-text))) - 'local-map org-clock-mode-line-map - 'mouse-face (if (featurep 'xemacs) 'highlight 'mode-line-highlight))) - (if (and org-clock-task-overrun org-clock-task-overrun-text) - (setq org-mode-line-string - (concat (org-propertize - org-clock-task-overrun-text - 'face 'org-mode-line-clock-overrun) org-mode-line-string))) - (force-mode-line-update)) - -(defun org-clock-get-clocked-time () - "Get the clocked time for the current item in minutes. -The time returned includes the time spent on this task in -previous clocking intervals." - (let ((currently-clocked-time - (floor (- (org-float-time) - (org-float-time org-clock-start-time)) 60))) - (+ currently-clocked-time (or org-clock-total-time 0)))) - -(defun org-clock-modify-effort-estimate (&optional value) - "Add to or set the effort estimate of the item currently being clocked. -VALUE can be a number of minutes, or a string with format hh:mm or mm. -When the string starts with a + or a - sign, the current value of the effort -property will be changed by that amount. If the effort value is expressed -as an `org-effort-durations' (e.g. \"3h\"), the modificied value will be -converted to a hh:mm duration. - -This command will update the \"Effort\" property of the currently -clocked item, and the value displayed in the mode line." - (interactive) - (if (org-clock-is-active) - (let ((current org-clock-effort) sign) - (unless value - ;; Prompt user for a value or a change - (setq value - (read-string - (format "Set effort (hh:mm or mm%s): " - (if current - (format ", prefix + to add to %s" org-clock-effort) - ""))))) - (when (stringp value) - ;; A string. See if it is a delta - (setq sign (string-to-char value)) - (if (member sign '(?- ?+)) - (setq current (org-duration-string-to-minutes current) - value (substring value 1)) - (setq current 0)) - (setq value (org-duration-string-to-minutes value)) - (if (equal ?- sign) - (setq value (- current value)) - (if (equal ?+ sign) (setq value (+ current value))))) - (setq value (max 0 value) - org-clock-effort (org-minutes-to-clocksum-string value)) - (org-entry-put org-clock-marker "Effort" org-clock-effort) - (org-clock-update-mode-line) - (message "Effort is now %s" org-clock-effort)) - (message "Clock is not currently active"))) - -(defvar org-clock-notification-was-shown nil - "Shows if we have shown notification already.") - -(defun org-clock-notify-once-if-expired () - "Show notification if we spent more time than we estimated before. -Notification is shown only once." - (when (org-clocking-p) - (let ((effort-in-minutes (org-duration-string-to-minutes org-clock-effort)) - (clocked-time (org-clock-get-clocked-time))) - (if (setq org-clock-task-overrun - (if (or (null effort-in-minutes) (zerop effort-in-minutes)) - nil - (>= clocked-time effort-in-minutes))) - (unless org-clock-notification-was-shown - (setq org-clock-notification-was-shown t) - (org-notify - (format "Task '%s' should be finished by now. (%s)" - org-clock-heading org-clock-effort) org-clock-sound)) - (setq org-clock-notification-was-shown nil))))) - -(defun org-notify (notification &optional play-sound) - "Send a NOTIFICATION and maybe PLAY-SOUND. -If PLAY-SOUND is non-nil, it overrides `org-clock-sound'." - (org-show-notification notification) - (if play-sound (org-clock-play-sound play-sound))) - -(defun org-show-notification (notification) - "Show notification. -Use `org-show-notification-handler' if defined, -use libnotify if available, or fall back on a message." - (cond ((functionp org-show-notification-handler) - (funcall org-show-notification-handler notification)) - ((stringp org-show-notification-handler) - (start-process "emacs-timer-notification" nil - org-show-notification-handler notification)) - ((fboundp 'notifications-notify) - (notifications-notify - :title "Org-mode message" - :body notification - ;; FIXME how to link to the Org icon? - ;; :app-icon "~/.emacs.d/icons/mail.png" - :urgency 'low)) - ((executable-find "notify-send") - (start-process "emacs-timer-notification" nil - "notify-send" notification)) - ;; Maybe the handler will send a message, so only use message as - ;; a fall back option - (t (message "%s" notification)))) - -(defun org-clock-play-sound (&optional clock-sound) - "Play sound as configured by `org-clock-sound'. -Use alsa's aplay tool if available. -If CLOCK-SOUND is non-nil, it overrides `org-clock-sound'." - (let ((org-clock-sound (or clock-sound org-clock-sound))) - (cond - ((not org-clock-sound)) - ((eq org-clock-sound t) (beep t) (beep t)) - ((stringp org-clock-sound) - (let ((file (expand-file-name org-clock-sound))) - (if (file-exists-p file) - (if (executable-find "aplay") - (start-process "org-clock-play-notification" nil - "aplay" file) - (condition-case nil - (play-sound-file file) - (error (beep t) (beep t)))))))))) - -(defvar org-clock-mode-line-entry nil - "Information for the mode line about the running clock.") - -(defun org-find-open-clocks (file) - "Search through the given file and find all open clocks." - (let ((buf (or (get-file-buffer file) - (find-file-noselect file))) - clocks) - (with-current-buffer buf - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "CLOCK: \\(\\[.*?\\]\\)$" nil t) - (push (cons (copy-marker (match-end 1) t) - (org-time-string-to-time (match-string 1))) clocks)))) - clocks)) - -(defsubst org-is-active-clock (clock) - "Return t if CLOCK is the currently active clock." - (and (org-clock-is-active) - (= org-clock-marker (car clock)))) - -(defmacro org-with-clock-position (clock &rest forms) - "Evaluate FORMS with CLOCK as the current active clock." - `(with-current-buffer (marker-buffer (car ,clock)) - (save-excursion - (save-restriction - (widen) - (goto-char (car ,clock)) - (beginning-of-line) - ,@forms)))) -(def-edebug-spec org-with-clock-position (form body)) -(put 'org-with-clock-position 'lisp-indent-function 1) - -(defmacro org-with-clock (clock &rest forms) - "Evaluate FORMS with CLOCK as the current active clock. -This macro also protects the current active clock from being altered." - `(org-with-clock-position ,clock - (let ((org-clock-start-time (cdr ,clock)) - (org-clock-total-time) - (org-clock-history) - (org-clock-effort) - (org-clock-marker (car ,clock)) - (org-clock-hd-marker (save-excursion - (outline-back-to-heading t) - (point-marker)))) - ,@forms))) -(def-edebug-spec org-with-clock (form body)) -(put 'org-with-clock 'lisp-indent-function 1) - -(defsubst org-clock-clock-in (clock &optional resume start-time) - "Clock in to the clock located by CLOCK. -If necessary, clock-out of the currently active clock." - (org-with-clock-position clock - (let ((org-clock-in-resume (or resume org-clock-in-resume))) - (org-clock-in nil start-time)))) - -(defsubst org-clock-clock-out (clock &optional fail-quietly at-time) - "Clock out of the clock located by CLOCK." - (let ((temp (copy-marker (car clock) - (marker-insertion-type (car clock))))) - (if (org-is-active-clock clock) - (org-clock-out nil fail-quietly at-time) - (org-with-clock clock - (org-clock-out nil fail-quietly at-time))) - (setcar clock temp))) - -(defsubst org-clock-clock-cancel (clock) - "Cancel the clock located by CLOCK." - (let ((temp (copy-marker (car clock) - (marker-insertion-type (car clock))))) - (if (org-is-active-clock clock) - (org-clock-cancel) - (org-with-clock clock - (org-clock-cancel))) - (setcar clock temp))) - -(defvar org-clock-clocking-in nil) -(defvar org-clock-resolving-clocks nil) -(defvar org-clock-resolving-clocks-due-to-idleness nil) - -(defun org-clock-resolve-clock (clock resolve-to clock-out-time - &optional close-p restart-p fail-quietly) - "Resolve `CLOCK' given the time `RESOLVE-TO', and the present. -`CLOCK' is a cons cell of the form (MARKER START-TIME)." - (let ((org-clock-resolving-clocks t)) - (cond - ((null resolve-to) - (org-clock-clock-cancel clock) - (if (and restart-p (not org-clock-clocking-in)) - (org-clock-clock-in clock))) - - ((eq resolve-to 'now) - (if restart-p - (error "RESTART-P is not valid here")) - (if (or close-p org-clock-clocking-in) - (org-clock-clock-out clock fail-quietly) - (unless (org-is-active-clock clock) - (org-clock-clock-in clock t)))) - - ((not (time-less-p resolve-to (current-time))) - (error "RESOLVE-TO must refer to a time in the past")) - - (t - (if restart-p - (error "RESTART-P is not valid here")) - (org-clock-clock-out clock fail-quietly (or clock-out-time - resolve-to)) - (unless org-clock-clocking-in - (if close-p - (setq org-clock-leftover-time (and (null clock-out-time) - resolve-to)) - (org-clock-clock-in clock nil (and clock-out-time - resolve-to)))))))) - -(defun org-clock-jump-to-current-clock (&optional effective-clock) - (interactive) - (let ((org-clock-into-drawer (org-clock-into-drawer)) - (clock (or effective-clock (cons org-clock-marker - org-clock-start-time)))) - (unless (marker-buffer (car clock)) - (error "No clock is currently running")) - (org-with-clock clock (org-clock-goto)) - (with-current-buffer (marker-buffer (car clock)) - (goto-char (car clock)) - (if org-clock-into-drawer - (let ((logbook - (if (stringp org-clock-into-drawer) - (concat ":" org-clock-into-drawer ":") - ":LOGBOOK:"))) - (ignore-errors - (outline-flag-region - (save-excursion - (outline-back-to-heading t) - (search-forward logbook) - (goto-char (match-beginning 0))) - (save-excursion - (outline-back-to-heading t) - (search-forward logbook) - (search-forward ":END:") - (goto-char (match-end 0))) - nil))))))) - -(defun org-clock-resolve (clock &optional prompt-fn last-valid fail-quietly) - "Resolve an open org-mode clock. -An open clock was found, with `dangling' possibly being non-nil. -If this function was invoked with a prefix argument, non-dangling -open clocks are ignored. The given clock requires some sort of -user intervention to resolve it, either because a clock was left -dangling or due to an idle timeout. The clock resolution can -either be: - - (a) deleted, the user doesn't care about the clock - (b) restarted from the current time (if no other clock is open) - (c) closed, giving the clock X minutes - (d) closed and then restarted - (e) resumed, as if the user had never left - -The format of clock is (CONS MARKER START-TIME), where MARKER -identifies the buffer and position the clock is open at (and -thus, the heading it's under), and START-TIME is when the clock -was started." - (assert clock) - (let* ((ch - (save-window-excursion - (save-excursion - (unless org-clock-resolving-clocks-due-to-idleness - (org-clock-jump-to-current-clock clock)) - (unless org-clock-resolve-expert - (with-output-to-temp-buffer "*Org Clock*" - (princ "Select a Clock Resolution Command: - -i/q Ignore this question; the same as keeping all the idle time. - -k/K Keep X minutes of the idle time (default is all). If this - amount is less than the default, you will be clocked out - that many minutes after the time that idling began, and then - clocked back in at the present time. - -g/G Indicate that you \"got back\" X minutes ago. This is quite - different from 'k': it clocks you out from the beginning of - the idle period and clock you back in X minutes ago. - -s/S Subtract the idle time from the current clock. This is the - same as keeping 0 minutes. - -C Cancel the open timer altogether. It will be as though you - never clocked in. - -j/J Jump to the current clock, to make manual adjustments. - -For all these options, using uppercase makes your final state -to be CLOCKED OUT."))) - (org-fit-window-to-buffer (get-buffer-window "*Org Clock*")) - (let (char-pressed) - (when (featurep 'xemacs) - (message (concat (funcall prompt-fn clock) - " [jkKgGsScCiq]? ")) - (setq char-pressed (read-char-exclusive))) - (while (or (null char-pressed) - (and (not (memq char-pressed - '(?k ?K ?g ?G ?s ?S ?C - ?j ?J ?i ?q))) - (or (ding) t))) - (setq char-pressed - (read-char (concat (funcall prompt-fn clock) - " [jkKgGSscCiq]? ") - nil 45))) - (and (not (memq char-pressed '(?i ?q))) char-pressed))))) - (default - (floor (/ (org-float-time - (time-subtract (current-time) last-valid)) 60))) - (keep - (and (memq ch '(?k ?K)) - (read-number "Keep how many minutes? " default))) - (gotback - (and (memq ch '(?g ?G)) - (read-number "Got back how many minutes ago? " default))) - (subtractp (memq ch '(?s ?S))) - (barely-started-p (< (- (org-float-time last-valid) - (org-float-time (cdr clock))) 45)) - (start-over (and subtractp barely-started-p))) - (cond - ((memq ch '(?j ?J)) - (if (eq ch ?J) - (org-clock-resolve-clock clock 'now nil t nil fail-quietly)) - (org-clock-jump-to-current-clock clock)) - ((or (null ch) - (not (memq ch '(?k ?K ?g ?G ?s ?S ?C)))) - (message "")) - (t - (org-clock-resolve-clock - clock (cond - ((or (eq ch ?C) - ;; If the time on the clock was less than a minute before - ;; the user went away, and they've ask to subtract all the - ;; time... - start-over) - nil) - ((or subtractp - (and gotback (= gotback 0))) - last-valid) - ((or (and keep (= keep default)) - (and gotback (= gotback default))) - 'now) - (keep - (time-add last-valid (seconds-to-time (* 60 keep)))) - (gotback - (time-subtract (current-time) - (seconds-to-time (* 60 gotback)))) - (t - (error "Unexpected, please report this as a bug"))) - (and gotback last-valid) - (memq ch '(?K ?G ?S)) - (and start-over - (not (memq ch '(?K ?G ?S ?C)))) - fail-quietly))))) - -;;;###autoload -(defun org-resolve-clocks (&optional only-dangling-p prompt-fn last-valid) - "Resolve all currently open org-mode clocks. -If `only-dangling-p' is non-nil, only ask to resolve dangling -\(i.e., not currently open and valid) clocks." - (interactive "P") - (unless org-clock-resolving-clocks - (let ((org-clock-resolving-clocks t)) - (dolist (file (org-files-list)) - (let ((clocks (org-find-open-clocks file))) - (dolist (clock clocks) - (let ((dangling (or (not (org-clock-is-active)) - (/= (car clock) org-clock-marker)))) - (if (or (not only-dangling-p) dangling) - (org-clock-resolve - clock - (or prompt-fn - (function - (lambda (clock) - (format - "Dangling clock started %d mins ago" - (floor - (/ (- (org-float-time (current-time)) - (org-float-time (cdr clock))) 60)))))) - (or last-valid - (cdr clock))))))))))) - -(defun org-emacs-idle-seconds () - "Return the current Emacs idle time in seconds, or nil if not idle." - (let ((idle-time (current-idle-time))) - (if idle-time - (org-float-time idle-time) - 0))) - -(defun org-mac-idle-seconds () - "Return the current Mac idle time in seconds." - (string-to-number (shell-command-to-string "ioreg -c IOHIDSystem | perl -ane 'if (/Idle/) {$idle=(pop @F)/1000000000; print $idle; last}'"))) - -(defvar org-x11idle-exists-p - ;; Check that x11idle exists - (and (eq window-system 'x) - (eq (call-process-shell-command "command" nil nil nil "-v" org-clock-x11idle-program-name) 0) - ;; Check that x11idle can retrieve the idle time - (eq (call-process-shell-command org-clock-x11idle-program-name nil nil nil) 0))) - -(defun org-x11-idle-seconds () - "Return the current X11 idle time in seconds." - (/ (string-to-number (shell-command-to-string org-clock-x11idle-program-name)) 1000)) - -(defun org-user-idle-seconds () - "Return the number of seconds the user has been idle for. -This routine returns a floating point number." - (cond - ((eq system-type 'darwin) - (org-mac-idle-seconds)) - ((and (eq window-system 'x) org-x11idle-exists-p) - (org-x11-idle-seconds)) - (t - (org-emacs-idle-seconds)))) - -(defvar org-clock-user-idle-seconds) - -(defun org-resolve-clocks-if-idle () - "Resolve all currently open org-mode clocks. -This is performed after `org-clock-idle-time' minutes, to check -if the user really wants to stay clocked in after being idle for -so long." - (when (and org-clock-idle-time (not org-clock-resolving-clocks) - org-clock-marker (marker-buffer org-clock-marker)) - (let* ((org-clock-user-idle-seconds (org-user-idle-seconds)) - (org-clock-user-idle-start - (time-subtract (current-time) - (seconds-to-time org-clock-user-idle-seconds))) - (org-clock-resolving-clocks-due-to-idleness t)) - (if (> org-clock-user-idle-seconds (* 60 org-clock-idle-time)) - (org-clock-resolve - (cons org-clock-marker - org-clock-start-time) - (function - (lambda (clock) - (format "Clocked in & idle for %.1f mins" - (/ (org-float-time - (time-subtract (current-time) - org-clock-user-idle-start)) - 60.0)))) - org-clock-user-idle-start))))) - -(defvar org-clock-current-task nil "Task currently clocked in.") -(defvar org-clock-out-time nil) ; store the time of the last clock-out -(defvar org--msg-extra) - -;;;###autoload -(defun org-clock-in (&optional select start-time) - "Start the clock on the current item. -If necessary, clock-out of the currently active clock. -With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked -tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task -and mark it as the default task, a special task that will always be offered -in the clocking selection, associated with the letter `d'. -When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], \ -clock in by using the last clock-out -time as the start time \(see `org-clock-continuously' to -make this the default behavior.)" - (interactive "P") - (setq org-clock-notification-was-shown nil) - (org-refresh-properties org-effort-property 'org-effort) - (catch 'abort - (let ((interrupting (and (not org-clock-resolving-clocks-due-to-idleness) - (org-clocking-p))) - ts selected-task target-pos (org--msg-extra "") - (leftover (and (not org-clock-resolving-clocks) - org-clock-leftover-time))) - - (when (and org-clock-auto-clock-resolution - (or (not interrupting) - (eq t org-clock-auto-clock-resolution)) - (not org-clock-clocking-in) - (not org-clock-resolving-clocks)) - (setq org-clock-leftover-time nil) - (let ((org-clock-clocking-in t)) - (org-resolve-clocks))) ; check if any clocks are dangling - - (when (equal select '(64)) - ;; Set start-time to `org-clock-out-time' - (let ((org-clock-continuously t)) - (org-clock-in nil org-clock-out-time))) - - (when (equal select '(4)) - (setq selected-task (org-clock-select-task "Clock-in on task: ")) - (if selected-task - (setq selected-task (copy-marker selected-task)) - (error "Abort"))) - - (when (equal select '(16)) - ;; Mark as default clocking task - (org-clock-mark-default-task)) - - (when interrupting - ;; We are interrupting the clocking of a different task. - ;; Save a marker to this task, so that we can go back. - ;; First check if we are trying to clock into the same task! - (when (save-excursion - (unless selected-task - (org-back-to-heading t)) - (and (equal (marker-buffer org-clock-hd-marker) - (if selected-task - (marker-buffer selected-task) - (current-buffer))) - (= (marker-position org-clock-hd-marker) - (if selected-task - (marker-position selected-task) - (point))) - (equal org-clock-current-task (nth 4 (org-heading-components))))) - (message "Clock continues in \"%s\"" org-clock-heading) - (throw 'abort nil)) - (move-marker org-clock-interrupted-task - (marker-position org-clock-marker) - (marker-buffer org-clock-marker)) - (let ((org-clock-clocking-in t)) - (org-clock-out nil t))) - - ;; Clock in at which position? - (setq target-pos - (if (and (eobp) (not (org-at-heading-p))) - (point-at-bol 0) - (point))) - (save-excursion - (when (and selected-task (marker-buffer selected-task)) - ;; There is a selected task, move to the correct buffer - ;; and set the new target position. - (set-buffer (org-base-buffer (marker-buffer selected-task))) - (setq target-pos (marker-position selected-task)) - (move-marker selected-task nil)) - (save-excursion - (save-restriction - (widen) - (goto-char target-pos) - (org-back-to-heading t) - (or interrupting (move-marker org-clock-interrupted-task nil)) - (run-hooks 'org-clock-in-prepare-hook) - (org-clock-history-push) - (setq org-clock-current-task (nth 4 (org-heading-components))) - (cond ((functionp org-clock-in-switch-to-state) - (looking-at org-complex-heading-regexp) - (let ((newstate (funcall org-clock-in-switch-to-state - (match-string 2)))) - (if newstate (org-todo newstate)))) - ((and org-clock-in-switch-to-state - (not (looking-at (concat org-outline-regexp "[ \t]*" - org-clock-in-switch-to-state - "\\>")))) - (org-todo org-clock-in-switch-to-state))) - (setq org-clock-heading - (cond ((and org-clock-heading-function - (functionp org-clock-heading-function)) - (funcall org-clock-heading-function)) - ((nth 4 (org-heading-components)) - (replace-regexp-in-string - "\\[\\[.*?\\]\\[\\(.*?\\)\\]\\]" "\\1" - (match-string-no-properties 4))) - (t "???"))) - (org-clock-find-position org-clock-in-resume) - (cond - ((and org-clock-in-resume - (looking-at - (concat "^[ \t]*" org-clock-string - " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" - " *\\sw+\.? +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$"))) - (message "Matched %s" (match-string 1)) - (setq ts (concat "[" (match-string 1) "]")) - (goto-char (match-end 1)) - (setq org-clock-start-time - (apply 'encode-time - (org-parse-time-string (match-string 1)))) - (setq org-clock-effort (org-entry-get (point) org-effort-property)) - (setq org-clock-total-time (org-clock-sum-current-item - (org-clock-get-sum-start)))) - ((eq org-clock-in-resume 'auto-restart) - ;; called from org-clock-load during startup, - ;; do not interrupt, but warn! - (message "Cannot restart clock because task does not contain unfinished clock") - (ding) - (sit-for 2) - (throw 'abort nil)) - (t - (insert-before-markers "\n") - (backward-char 1) - (org-indent-line) - (when (and (save-excursion - (end-of-line 0) - (org-in-item-p))) - (beginning-of-line 1) - (org-indent-line-to (- (org-get-indentation) 2))) - (insert org-clock-string " ") - (setq org-clock-effort (org-entry-get (point) org-effort-property)) - (setq org-clock-total-time (org-clock-sum-current-item - (org-clock-get-sum-start))) - (setq org-clock-start-time - (or (and org-clock-continuously org-clock-out-time) - (and leftover - (y-or-n-p - (format - "You stopped another clock %d mins ago; start this one from then? " - (/ (- (org-float-time - (org-current-time org-clock-rounding-minutes t)) - (org-float-time leftover)) 60))) - leftover) - start-time - (org-current-time org-clock-rounding-minutes t))) - (setq ts (org-insert-time-stamp org-clock-start-time - 'with-hm 'inactive)))) - (move-marker org-clock-marker (point) (buffer-base-buffer)) - (move-marker org-clock-hd-marker - (save-excursion (org-back-to-heading t) (point)) - (buffer-base-buffer)) - (setq org-clock-has-been-used t) - ;; add to mode line - (when (or (eq org-clock-clocked-in-display 'mode-line) - (eq org-clock-clocked-in-display 'both)) - (or global-mode-string (setq global-mode-string '(""))) - (or (memq 'org-mode-line-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(org-mode-line-string))))) - ;; add to frame title - (when (or (eq org-clock-clocked-in-display 'frame-title) - (eq org-clock-clocked-in-display 'both)) - (setq frame-title-format org-clock-frame-title-format)) - (org-clock-update-mode-line) - (when org-clock-mode-line-timer - (cancel-timer org-clock-mode-line-timer) - (setq org-clock-mode-line-timer nil)) - (when org-clock-clocked-in-display - (setq org-clock-mode-line-timer - (run-with-timer org-clock-update-period - org-clock-update-period - 'org-clock-update-mode-line))) - (when org-clock-idle-timer - (cancel-timer org-clock-idle-timer) - (setq org-clock-idle-timer nil)) - (setq org-clock-idle-timer - (run-with-timer 60 60 'org-resolve-clocks-if-idle)) - (message "Clock starts at %s - %s" ts org--msg-extra) - (run-hooks 'org-clock-in-hook))))))) - -;;;###autoload -(defun org-clock-in-last (&optional arg) - "Clock in the last closed clocked item. -When already clocking in, send an warning. -With a universal prefix argument, select the task you want to -clock in from the last clocked in tasks. -With two universal prefix arguments, start clocking using the -last clock-out time, if any. -With three universal prefix arguments, interactively prompt -for a todo state to switch to, overriding the existing value -`org-clock-in-switch-to-state'." - (interactive "P") - (if (equal arg '(4)) - (org-clock-in (org-clock-select-task)) - (let ((start-time (if (or org-clock-continuously (equal arg '(16))) - (or org-clock-out-time - (org-current-time org-clock-rounding-minutes t)) - (org-current-time org-clock-rounding-minutes t)))) - (if (null org-clock-history) - (message "No last clock") - (let ((org-clock-in-switch-to-state - (if (and (not org-clock-current-task) (equal arg '(64))) - (completing-read "Switch to state: " - (and org-clock-history - (with-current-buffer - (marker-buffer (car org-clock-history)) - org-todo-keywords-1))) - org-clock-in-switch-to-state)) - (already-clocking org-clock-current-task)) - (org-clock-clock-in (list (car org-clock-history)) nil start-time) - (or already-clocking - ;; Don't display a message if we are already clocking in - (message "Clocking back: %s (in %s)" - org-clock-current-task - (buffer-name (marker-buffer org-clock-marker))))))))) - -(defun org-clock-mark-default-task () - "Mark current task as default task." - (interactive) - (save-excursion - (org-back-to-heading t) - (move-marker org-clock-default-task (point)))) - -(defun org-clock-get-sum-start () - "Return the time from which clock times should be counted. -This is for the currently running clock as it is displayed -in the mode line. This function looks at the properties -LAST_REPEAT and in particular CLOCK_MODELINE_TOTAL and the -corresponding variable `org-clock-mode-line-total' and then -decides which time to use." - (let ((cmt (or (org-entry-get nil "CLOCK_MODELINE_TOTAL") - (symbol-name org-clock-mode-line-total))) - (lr (org-entry-get nil "LAST_REPEAT"))) - (cond - ((equal cmt "current") - (setq org--msg-extra "showing time in current clock instance") - (current-time)) - ((equal cmt "today") - (setq org--msg-extra "showing today's task time.") - (let* ((dt (decode-time (current-time)))) - (setq dt (append (list 0 0 0) (nthcdr 3 dt))) - (if org-extend-today-until - (setf (nth 2 dt) org-extend-today-until)) - (apply 'encode-time dt))) - ((or (equal cmt "all") - (and (or (not cmt) (equal cmt "auto")) - (not lr))) - (setq org--msg-extra "showing entire task time.") - nil) - ((or (equal cmt "repeat") - (and (or (not cmt) (equal cmt "auto")) - lr)) - (setq org--msg-extra "showing task time since last repeat.") - (if (not lr) - nil - (org-time-string-to-time lr))) - (t nil)))) - -(defun org-clock-find-position (find-unclosed) - "Find the location where the next clock line should be inserted. -When FIND-UNCLOSED is non-nil, first check if there is an unclosed clock -line and position cursor in that line." - (org-back-to-heading t) - (catch 'exit - (let* ((org-clock-into-drawer (org-clock-into-drawer)) - (beg (save-excursion - (beginning-of-line 2) - (or (bolp) (newline)) - (point))) - (end (progn (outline-next-heading) (point))) - (re (concat "^[ \t]*" org-clock-string)) - (cnt 0) - (drawer (if (stringp org-clock-into-drawer) - org-clock-into-drawer "LOGBOOK")) - first last ind-last) - (goto-char beg) - (when (and find-unclosed - (re-search-forward - (concat "^[ \t]*" org-clock-string - " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" - " *\\sw+ +[012][0-9]:[0-5][0-9]\\)\\][ \t]*$") - end t)) - (beginning-of-line 1) - (throw 'exit t)) - (when (eobp) (newline) (setq end (max (point) end))) - (when (re-search-forward (concat "^[ \t]*:" drawer ":") end t) - ;; we seem to have a CLOCK drawer, so go there. - (beginning-of-line 2) - (or org-log-states-order-reversed - (and (re-search-forward org-property-end-re nil t) - (goto-char (match-beginning 0)))) - (throw 'exit t)) - ;; Lets count the CLOCK lines - (goto-char beg) - (while (re-search-forward re end t) - (setq first (or first (match-beginning 0)) - last (match-beginning 0) - cnt (1+ cnt))) - (when (and (integerp org-clock-into-drawer) - last - (>= (1+ cnt) org-clock-into-drawer)) - ;; Wrap current entries into a new drawer - (goto-char last) - (setq ind-last (org-get-indentation)) - (beginning-of-line 2) - (if (and (>= (org-get-indentation) ind-last) - (org-at-item-p)) - (when (and (>= (org-get-indentation) ind-last) - (org-at-item-p)) - (let ((struct (org-list-struct))) - (goto-char (org-list-get-bottom-point struct))))) - (insert ":END:\n") - (beginning-of-line 0) - (org-indent-line-to ind-last) - (goto-char first) - (insert ":" drawer ":\n") - (beginning-of-line 0) - (org-indent-line) - (org-flag-drawer t) - (beginning-of-line 2) - (or org-log-states-order-reversed - (and (re-search-forward org-property-end-re nil t) - (goto-char (match-beginning 0)))) - (throw 'exit nil)) - - (goto-char beg) - (while (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) - (not (equal (match-string 1) org-clock-string))) - ;; Planning info, skip to after it - (beginning-of-line 2) - (or (bolp) (newline))) - (when (or (eq org-clock-into-drawer t) - (stringp org-clock-into-drawer) - (and (integerp org-clock-into-drawer) - (< org-clock-into-drawer 2))) - (insert ":" drawer ":\n:END:\n") - (beginning-of-line -1) - (org-indent-line) - (org-flag-drawer t) - (beginning-of-line 2) - (org-indent-line) - (beginning-of-line) - (or org-log-states-order-reversed - (and (re-search-forward org-property-end-re nil t) - (goto-char (match-beginning 0)))))))) - -;;;###autoload -(defun org-clock-out (&optional switch-to-state fail-quietly at-time) - "Stop the currently running clock. -Throw an error if there is no running clock and FAIL-QUIETLY is nil. -With a universal prefix, prompt for a state to switch the clocked out task -to, overriding the existing value of `org-clock-out-switch-to-state'." - (interactive "P") - (catch 'exit - (when (not (org-clocking-p)) - (setq global-mode-string - (delq 'org-mode-line-string global-mode-string)) - (setq frame-title-format org-frame-title-format-backup) - (force-mode-line-update) - (if fail-quietly (throw 'exit t) (user-error "No active clock"))) - (let ((org-clock-out-switch-to-state - (if switch-to-state - (completing-read "Switch to state: " - (with-current-buffer - (marker-buffer org-clock-marker) - org-todo-keywords-1) - nil t "DONE") - org-clock-out-switch-to-state)) - (now (org-current-time org-clock-rounding-minutes)) - ts te s h m remove) - (setq org-clock-out-time now) - (save-excursion ; Do not replace this with `with-current-buffer'. - (org-no-warnings (set-buffer (org-clocking-buffer))) - (save-restriction - (widen) - (goto-char org-clock-marker) - (beginning-of-line 1) - (if (and (looking-at (concat "[ \t]*" org-keyword-time-regexp)) - (equal (match-string 1) org-clock-string)) - (setq ts (match-string 2)) - (if fail-quietly (throw 'exit nil) (error "Clock start time is gone"))) - (goto-char (match-end 0)) - (delete-region (point) (point-at-eol)) - (insert "--") - (setq te (org-insert-time-stamp (or at-time now) 'with-hm 'inactive)) - (setq s (- (org-float-time (apply 'encode-time (org-parse-time-string te))) - (org-float-time (apply 'encode-time (org-parse-time-string ts)))) - h (floor (/ s 3600)) - s (- s (* 3600 h)) - m (floor (/ s 60)) - s (- s (* 60 s))) - (insert " => " (format "%2d:%02d" h m)) - (when (setq remove (and org-clock-out-remove-zero-time-clocks - (= (+ h m) 0))) - (beginning-of-line 1) - (delete-region (point) (point-at-eol)) - (and (looking-at "\n") (> (point-max) (1+ (point))) - (delete-char 1))) - (move-marker org-clock-marker nil) - (move-marker org-clock-hd-marker nil) - (when org-log-note-clock-out - (org-add-log-setup 'clock-out nil nil nil nil - (concat "# Task: " (org-get-heading t) "\n\n"))) - (when org-clock-mode-line-timer - (cancel-timer org-clock-mode-line-timer) - (setq org-clock-mode-line-timer nil)) - (when org-clock-idle-timer - (cancel-timer org-clock-idle-timer) - (setq org-clock-idle-timer nil)) - (setq global-mode-string - (delq 'org-mode-line-string global-mode-string)) - (setq frame-title-format org-frame-title-format-backup) - (when org-clock-out-switch-to-state - (save-excursion - (org-back-to-heading t) - (let ((org-inhibit-logging t) - (org-clock-out-when-done nil)) - (cond - ((functionp org-clock-out-switch-to-state) - (looking-at org-complex-heading-regexp) - (let ((newstate (funcall org-clock-out-switch-to-state - (match-string 2)))) - (if newstate (org-todo newstate)))) - ((and org-clock-out-switch-to-state - (not (looking-at (concat org-outline-regexp "[ \t]*" - org-clock-out-switch-to-state - "\\>")))) - (org-todo org-clock-out-switch-to-state)))))) - (force-mode-line-update) - (message (concat "Clock stopped at %s after " - (org-minutes-to-clocksum-string (+ (* 60 h) m)) "%s") - te (if remove " => LINE REMOVED" "")) - (let ((h org-clock-out-hook)) - ;; If a closing note needs to be stored in the drawer - ;; where clocks are stored, let's temporarily disable - ;; `org-clock-remove-empty-clock-drawer' - (if (and (equal org-clock-into-drawer org-log-into-drawer) - (eq org-log-done 'note) - org-clock-out-when-done) - (setq h (delq 'org-clock-remove-empty-clock-drawer h))) - (mapc (lambda (f) (funcall f)) h)) - (unless (org-clocking-p) - (setq org-clock-current-task nil))))))) - -(add-hook 'org-clock-out-hook 'org-clock-remove-empty-clock-drawer) - -(defun org-clock-remove-empty-clock-drawer nil - "Remove empty clock drawer in the current subtree." - (let* ((olid (or (org-entry-get (point) "LOG_INTO_DRAWER") - org-log-into-drawer)) - (clock-drawer (if (eq t olid) "LOGBOOK" olid)) - (end (save-excursion (org-end-of-subtree t t)))) - (when clock-drawer - (save-excursion - (org-back-to-heading t) - (while (and (< (point) end) - (search-forward clock-drawer end t)) - (goto-char (match-beginning 0)) - (org-remove-empty-drawer-at clock-drawer (point)) - (forward-line 1)))))) - -(defun org-clock-timestamps-up (&optional n) - "Increase CLOCK timestamps at cursor. -Optional argument N tells to change by that many units." - (interactive "P") - (org-clock-timestamps-change 'up n)) - -(defun org-clock-timestamps-down (&optional n) - "Increase CLOCK timestamps at cursor. -Optional argument N tells to change by that many units." - (interactive "P") - (org-clock-timestamps-change 'down n)) - -(defun org-clock-timestamps-change (updown &optional n) - "Change CLOCK timestamps synchronously at cursor. -UPDOWN tells whether to change 'up or 'down. -Optional argument N tells to change by that many units." - (setq org-ts-what nil) - (when (org-at-timestamp-p t) - (let ((tschange (if (eq updown 'up) 'org-timestamp-up - 'org-timestamp-down)) - ts1 begts1 ts2 begts2 updatets1 tdiff) - (save-excursion - (move-beginning-of-line 1) - (re-search-forward org-ts-regexp3 nil t) - (setq ts1 (match-string 0) begts1 (match-beginning 0)) - (when (re-search-forward org-ts-regexp3 nil t) - (setq ts2 (match-string 0) begts2 (match-beginning 0)))) - ;; Are we on the second timestamp? - (if (<= begts2 (point)) (setq updatets1 t)) - (if (not ts2) - ;; fall back on org-timestamp-up if there is only one - (funcall tschange n) - ;; setq this so that (boundp 'org-ts-what is non-nil) - (funcall tschange n) - (let ((ts (if updatets1 ts2 ts1)) - (begts (if updatets1 begts1 begts2))) - (setq tdiff - (subtract-time - (org-time-string-to-time org-last-changed-timestamp) - (org-time-string-to-time ts))) - (save-excursion - (goto-char begts) - (org-timestamp-change - (round (/ (org-float-time tdiff) - (cond ((eq org-ts-what 'minute) 60) - ((eq org-ts-what 'hour) 3600) - ((eq org-ts-what 'day) (* 24 3600)) - ((eq org-ts-what 'month) (* 24 3600 31)) - ((eq org-ts-what 'year) (* 24 3600 365.2))))) - org-ts-what 'updown))))))) - -;;;###autoload -(defun org-clock-cancel () - "Cancel the running clock by removing the start timestamp." - (interactive) - (when (not (org-clocking-p)) - (setq global-mode-string - (delq 'org-mode-line-string global-mode-string)) - (setq frame-title-format org-frame-title-format-backup) - (force-mode-line-update) - (error "No active clock")) - (save-excursion ; Do not replace this with `with-current-buffer'. - (org-no-warnings (set-buffer (org-clocking-buffer))) - (goto-char org-clock-marker) - (if (org-looking-back (concat "^[ \t]*" org-clock-string ".*")) - (progn (delete-region (1- (point-at-bol)) (point-at-eol)) - (org-remove-empty-drawer-at "LOGBOOK" (point))) - (message "Clock gone, cancel the timer anyway") - (sit-for 2))) - (move-marker org-clock-marker nil) - (move-marker org-clock-hd-marker nil) - (setq global-mode-string - (delq 'org-mode-line-string global-mode-string)) - (setq frame-title-format org-frame-title-format-backup) - (force-mode-line-update) - (message "Clock canceled") - (run-hooks 'org-clock-cancel-hook)) - -(defcustom org-clock-goto-before-context 2 - "Number of lines of context to display before currently clocked-in entry. -This applies when using `org-clock-goto'." - :group 'org-clock - :type 'integer) - -;;;###autoload -(defun org-clock-goto (&optional select) - "Go to the currently clocked-in entry, or to the most recently clocked one. -With prefix arg SELECT, offer recently clocked tasks for selection." - (interactive "@P") - (let* ((recent nil) - (m (cond - (select - (or (org-clock-select-task "Select task to go to: ") - (error "No task selected"))) - ((org-clocking-p) org-clock-marker) - ((and org-clock-goto-may-find-recent-task - (car org-clock-history) - (marker-buffer (car org-clock-history))) - (setq recent t) - (car org-clock-history)) - (t (error "No active or recent clock task"))))) - (org-pop-to-buffer-same-window (marker-buffer m)) - (if (or (< m (point-min)) (> m (point-max))) (widen)) - (goto-char m) - (org-show-entry) - (org-back-to-heading t) - (org-cycle-hide-drawers 'children) - (recenter org-clock-goto-before-context) - (org-reveal) - (if recent - (message "No running clock, this is the most recently clocked task")) - (run-hooks 'org-clock-goto-hook))) - -(defvar org-clock-file-total-minutes nil - "Holds the file total time in minutes, after a call to `org-clock-sum'.") -(make-variable-buffer-local 'org-clock-file-total-minutes) - -(defun org-clock-sum-today (&optional headline-filter) - "Sum the times for each subtree for today." - (interactive) - (let ((range (org-clock-special-range 'today))) - (org-clock-sum (car range) (cadr range) nil :org-clock-minutes-today))) - -;;;###autoload -(defun org-clock-sum (&optional tstart tend headline-filter propname) - "Sum the times for each subtree. -Puts the resulting times in minutes as a text property on each headline. -TSTART and TEND can mark a time range to be considered. -HEADLINE-FILTER is a zero-arg function that, if specified, is called for -each headline in the time range with point at the headline. Headlines for -which HEADLINE-FILTER returns nil are excluded from the clock summation. -PROPNAME lets you set a custom text property instead of :org-clock-minutes." - (interactive) - (org-with-silent-modifications - (let* ((re (concat "^\\(\\*+\\)[ \t]\\|^[ \t]*" - org-clock-string - "[ \t]*\\(?:\\(\\[.*?\\]\\)-+\\(\\[.*?\\]\\)\\|=>[ \t]+\\([0-9]+\\):\\([0-9]+\\)\\)")) - (lmax 30) - (ltimes (make-vector lmax 0)) - (t1 0) - (level 0) - ts te dt - time) - (if (stringp tstart) (setq tstart (org-time-string-to-seconds tstart))) - (if (stringp tend) (setq tend (org-time-string-to-seconds tend))) - (if (consp tstart) (setq tstart (org-float-time tstart))) - (if (consp tend) (setq tend (org-float-time tend))) - (remove-text-properties (point-min) (point-max) - `(,(or propname :org-clock-minutes) t - :org-clock-force-headline-inclusion t)) - (save-excursion - (goto-char (point-max)) - (while (re-search-backward re nil t) - (cond - ((match-end 2) - ;; Two time stamps - (setq ts (match-string 2) - te (match-string 3) - ts (org-float-time - (apply 'encode-time (org-parse-time-string ts))) - te (org-float-time - (apply 'encode-time (org-parse-time-string te))) - ts (if tstart (max ts tstart) ts) - te (if tend (min te tend) te) - dt (- te ts) - t1 (if (> dt 0) (+ t1 (floor (/ dt 60))) t1))) - ((match-end 4) - ;; A naked time - (setq t1 (+ t1 (string-to-number (match-string 5)) - (* 60 (string-to-number (match-string 4)))))) - (t ;; A headline - ;; Add the currently clocking item time to the total - (when (and org-clock-report-include-clocking-task - (equal (org-clocking-buffer) (current-buffer)) - (equal (marker-position org-clock-hd-marker) (point)) - tstart - tend - (>= (org-float-time org-clock-start-time) tstart) - (<= (org-float-time org-clock-start-time) tend)) - (let ((time (floor (- (org-float-time) - (org-float-time org-clock-start-time)) 60))) - (setq t1 (+ t1 time)))) - (let* ((headline-forced - (get-text-property (point) - :org-clock-force-headline-inclusion)) - (headline-included - (or (null headline-filter) - (save-excursion - (save-match-data (funcall headline-filter)))))) - (setq level (- (match-end 1) (match-beginning 1))) - (when (or (> t1 0) (> (aref ltimes level) 0)) - (when (or headline-included headline-forced) - (if headline-included - (loop for l from 0 to level do - (aset ltimes l (+ (aref ltimes l) t1)))) - (setq time (aref ltimes level)) - (goto-char (match-beginning 0)) - (put-text-property (point) (point-at-eol) - (or propname :org-clock-minutes) time) - (if headline-filter - (save-excursion - (save-match-data - (while - (> (funcall outline-level) 1) - (outline-up-heading 1 t) - (put-text-property - (point) (point-at-eol) - :org-clock-force-headline-inclusion t)))))) - (setq t1 0) - (loop for l from level to (1- lmax) do - (aset ltimes l 0))))))) - (setq org-clock-file-total-minutes (aref ltimes 0)))))) - -(defun org-clock-sum-current-item (&optional tstart) - "Return time, clocked on current item in total." - (save-excursion - (save-restriction - (org-narrow-to-subtree) - (org-clock-sum tstart) - org-clock-file-total-minutes))) - -;;;###autoload -(defun org-clock-display (&optional total-only) - "Show subtree times in the entire buffer. -If TOTAL-ONLY is non-nil, only show the total time for the entire file -in the echo area. - -Use \\[org-clock-remove-overlays] to remove the subtree times." - (interactive) - (org-clock-remove-overlays) - (let (time h m p) - (org-clock-sum) - (unless total-only - (save-excursion - (goto-char (point-min)) - (while (or (and (equal (setq p (point)) (point-min)) - (get-text-property p :org-clock-minutes)) - (setq p (next-single-property-change - (point) :org-clock-minutes))) - (goto-char p) - (when (setq time (get-text-property p :org-clock-minutes)) - (org-clock-put-overlay time (funcall outline-level)))) - (setq h (/ org-clock-file-total-minutes 60) - m (- org-clock-file-total-minutes (* 60 h))) - ;; Arrange to remove the overlays upon next change. - (when org-remove-highlights-with-change - (org-add-hook 'before-change-functions 'org-clock-remove-overlays - nil 'local)))) - (message (concat "Total file time: " - (org-minutes-to-clocksum-string org-clock-file-total-minutes) - " (%d hours and %d minutes)") h m))) - -(defvar org-clock-overlays nil) -(make-variable-buffer-local 'org-clock-overlays) - -(defun org-clock-put-overlay (time &optional level) - "Put an overlays on the current line, displaying TIME. -If LEVEL is given, prefix time with a corresponding number of stars. -This creates a new overlay and stores it in `org-clock-overlays', so that it -will be easy to remove." - (let* ((c 60) (h (floor (/ time 60))) (m (- time (* 60 h))) - (l (if level (org-get-valid-level level 0) 0)) - (off 0) - ov tx) - (org-move-to-column c) - (unless (eolp) (skip-chars-backward "^ \t")) - (skip-chars-backward " \t") - (setq ov (make-overlay (point-at-bol) (point-at-eol)) - tx (concat (buffer-substring (point-at-bol) (point)) - (make-string (+ off (max 0 (- c (current-column)))) ?.) - (org-add-props (concat (make-string l ?*) " " - (org-minutes-to-clocksum-string time) - (make-string (- 16 l) ?\ )) - (list 'face 'org-clock-overlay)) - "")) - (if (not (featurep 'xemacs)) - (overlay-put ov 'display tx) - (overlay-put ov 'invisible t) - (overlay-put ov 'end-glyph (make-glyph tx))) - (push ov org-clock-overlays))) - -;;;###autoload -(defun org-clock-remove-overlays (&optional beg end noremove) - "Remove the occur highlights from the buffer. -BEG and END are ignored. If NOREMOVE is nil, remove this function -from the `before-change-functions' in the current buffer." - (interactive) - (unless org-inhibit-highlight-removal - (mapc 'delete-overlay org-clock-overlays) - (setq org-clock-overlays nil) - (unless noremove - (remove-hook 'before-change-functions - 'org-clock-remove-overlays 'local)))) - -(defvar org-state) ;; dynamically scoped into this function -(defun org-clock-out-if-current () - "Clock out if the current entry contains the running clock. -This is used to stop the clock after a TODO entry is marked DONE, -and is only done if the variable `org-clock-out-when-done' is not nil." - (when (and (org-clocking-p) - org-clock-out-when-done - (marker-buffer org-clock-marker) - (or (and (eq t org-clock-out-when-done) - (member org-state org-done-keywords)) - (and (listp org-clock-out-when-done) - (member org-state org-clock-out-when-done))) - (equal (or (buffer-base-buffer (org-clocking-buffer)) - (org-clocking-buffer)) - (or (buffer-base-buffer (current-buffer)) - (current-buffer))) - (< (point) org-clock-marker) - (> (save-excursion (outline-next-heading) (point)) - org-clock-marker)) - ;; Clock out, but don't accept a logging message for this. - (let ((org-log-note-clock-out nil) - (org-clock-out-switch-to-state nil)) - (org-clock-out)))) - -(add-hook 'org-after-todo-state-change-hook - 'org-clock-out-if-current) - -;;;###autoload -(defun org-clock-get-clocktable (&rest props) - "Get a formatted clocktable with parameters according to PROPS. -The table is created in a temporary buffer, fully formatted and -fontified, and then returned." - ;; Set the defaults - (setq props (plist-put props :name "clocktable")) - (unless (plist-member props :maxlevel) - (setq props (plist-put props :maxlevel 2))) - (unless (plist-member props :scope) - (setq props (plist-put props :scope 'agenda))) - (with-temp-buffer - (org-mode) - (org-create-dblock props) - (org-update-dblock) - (font-lock-fontify-buffer) - (forward-line 2) - (buffer-substring (point) (progn - (re-search-forward "^[ \t]*#\\+END" nil t) - (point-at-bol))))) - -;;;###autoload -(defun org-clock-report (&optional arg) - "Create a table containing a report about clocked time. -If the cursor is inside an existing clocktable block, then the table -will be updated. If not, a new clocktable will be inserted. The scope -of the new clock will be subtree when called from within a subtree, and -file elsewhere. - -When called with a prefix argument, move to the first clock table in the -buffer and update it." - (interactive "P") - (org-clock-remove-overlays) - (when arg - (org-find-dblock "clocktable") - (org-show-entry)) - (if (org-in-clocktable-p) - (goto-char (org-in-clocktable-p)) - (let ((props (if (ignore-errors - (save-excursion (org-back-to-heading))) - (list :name "clocktable" :scope 'subtree) - (list :name "clocktable")))) - (org-create-dblock - (org-combine-plists org-clock-clocktable-default-properties props)))) - (org-update-dblock)) - -(defun org-day-of-week (day month year) - "Returns the day of the week as an integer." - (nth 6 - (decode-time - (date-to-time - (format "%d-%02d-%02dT00:00:00" year month day))))) - -(defun org-quarter-to-date (quarter year) - "Get the date (week day year) of the first day of a given quarter." - (let (startday) - (cond - ((= quarter 1) - (setq startday (org-day-of-week 1 1 year)) - (cond - ((= startday 0) - (list 52 7 (- year 1))) - ((= startday 6) - (list 52 6 (- year 1))) - ((<= startday 4) - (list 1 startday year)) - ((> startday 4) - (list 53 startday (- year 1))) - ) - ) - ((= quarter 2) - (setq startday (org-day-of-week 1 4 year)) - (cond - ((= startday 0) - (list 13 startday year)) - ((< startday 4) - (list 14 startday year)) - ((>= startday 4) - (list 13 startday year)) - ) - ) - ((= quarter 3) - (setq startday (org-day-of-week 1 7 year)) - (cond - ((= startday 0) - (list 26 startday year)) - ((< startday 4) - (list 27 startday year)) - ((>= startday 4) - (list 26 startday year)) - ) - ) - ((= quarter 4) - (setq startday (org-day-of-week 1 10 year)) - (cond - ((= startday 0) - (list 39 startday year)) - ((<= startday 4) - (list 40 startday year)) - ((> startday 4) - (list 39 startday year))))))) - -(defun org-clock-special-range (key &optional time as-strings wstart mstart) - "Return two times bordering a special time range. -Key is a symbol specifying the range and can be one of `today', `yesterday', -`thisweek', `lastweek', `thismonth', `lastmonth', `thisyear', `lastyear'. -By default, a week starts Monday 0:00 and ends Sunday 24:00. -The range is determined relative to TIME, which defaults to current time. -The return value is a cons cell with two internal times like the ones -returned by `current time' or `encode-time'. -If AS-STRINGS is non-nil, the returned times will be formatted strings. -If WSTART is non-nil, use this number to specify the starting day of a -week (monday is 1). -If MSTART is non-nil, use this number to specify the starting day of a -month (1 is the first day of the month). -If you can combine both, the month starting day will have priority." - (if (integerp key) (setq key (intern (number-to-string key)))) - (let* ((tm (decode-time (or time (current-time)))) - (s 0) (m (nth 1 tm)) (h (nth 2 tm)) - (d (nth 3 tm)) (month (nth 4 tm)) (y (nth 5 tm)) - (dow (nth 6 tm)) - (ws (or wstart 1)) - (ms (or mstart 1)) - (skey (symbol-name key)) - (shift 0) - (q (cond ((>= (nth 4 tm) 10) 4) - ((>= (nth 4 tm) 7) 3) - ((>= (nth 4 tm) 4) 2) - ((>= (nth 4 tm) 1) 1))) - s1 m1 h1 d1 month1 y1 diff ts te fm txt w date - interval tmp shiftedy shiftedm shiftedq) - (cond - ((string-match "^[0-9]+$" skey) - (setq y (string-to-number skey) m 1 d 1 key 'year)) - ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)$" skey) - (setq y (string-to-number (match-string 1 skey)) - month (string-to-number (match-string 2 skey)) - d 1 key 'month)) - ((string-match "^\\([0-9]+\\)-[wW]\\([0-9]\\{1,2\\}\\)$" skey) - (require 'cal-iso) - (setq y (string-to-number (match-string 1 skey)) - w (string-to-number (match-string 2 skey))) - (setq date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso (list w 1 y)))) - (setq d (nth 1 date) month (car date) y (nth 2 date) - dow 1 - key 'week)) - ((string-match "^\\([0-9]+\\)-[qQ]\\([1-4]\\)$" skey) - (require 'cal-iso) - (setq y (string-to-number (match-string 1 skey))) - (setq q (string-to-number (match-string 2 skey))) - (setq date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso (org-quarter-to-date q y)))) - (setq d (nth 1 date) month (car date) y (nth 2 date) - dow 1 - key 'quarter)) - ((string-match "^\\([0-9]+\\)-\\([0-9]\\{1,2\\}\\)-\\([0-9]\\{1,2\\}\\)$" skey) - (setq y (string-to-number (match-string 1 skey)) - month (string-to-number (match-string 2 skey)) - d (string-to-number (match-string 3 skey)) - key 'day)) - ((string-match "\\([-+][0-9]+\\)$" skey) - (setq shift (string-to-number (match-string 1 skey)) - key (intern (substring skey 0 (match-beginning 1)))) - (if (and (memq key '(quarter thisq)) (> shift 0)) - (error "Looking forward with quarters isn't implemented")))) - - (when (= shift 0) - (cond ((eq key 'yesterday) (setq key 'today shift -1)) - ((eq key 'lastweek) (setq key 'week shift -1)) - ((eq key 'lastmonth) (setq key 'month shift -1)) - ((eq key 'lastyear) (setq key 'year shift -1)) - ((eq key 'lastq) (setq key 'quarter shift -1)))) - (cond - ((memq key '(day today)) - (setq d (+ d shift) h 0 m 0 h1 24 m1 0)) - ((memq key '(week thisweek)) - (setq diff (+ (* -7 shift) (if (= dow 0) (- 7 ws) (- dow ws))) - m 0 h 0 d (- d diff) d1 (+ 7 d))) - ((memq key '(month thismonth)) - (setq d (or ms 1) h 0 m 0 d1 (or ms 1) - month (+ month shift) month1 (1+ month) h1 0 m1 0)) - ((memq key '(quarter thisq)) - ;; Compute if this shift remains in this year. If not, compute - ;; how many years and quarters we have to shift (via floor*) and - ;; compute the shifted years, months and quarters. - (cond - ((< (+ (- q 1) shift) 0) ; shift not in this year - (setq interval (* -1 (+ (- q 1) shift))) - ;; Set tmp to ((years to shift) (quarters to shift)). - (setq tmp (org-floor* interval 4)) - ;; Due to the use of floor, 0 quarters actually means 4. - (if (= 0 (nth 1 tmp)) - (setq shiftedy (- y (nth 0 tmp)) - shiftedm 1 - shiftedq 1) - (setq shiftedy (- y (+ 1 (nth 0 tmp))) - shiftedm (- 13 (* 3 (nth 1 tmp))) - shiftedq (- 5 (nth 1 tmp)))) - (setq d 1 h 0 m 0 d1 1 month shiftedm month1 (+ 3 shiftedm) h1 0 m1 0 y shiftedy)) - ((> (+ q shift) 0) ; shift is within this year - (setq shiftedq (+ q shift)) - (setq shiftedy y) - (setq d 1 h 0 m 0 d1 1 month (+ 1 (* 3 (- (+ q shift) 1))) month1 (+ 4 (* 3 (- (+ q shift) 1))) h1 0 m1 0)))) - ((memq key '(year thisyear)) - (setq m 0 h 0 d 1 month 1 y (+ y shift) y1 (1+ y))) - (t (error "No such time block %s" key))) - (setq ts (encode-time s m h d month y) - te (encode-time (or s1 s) (or m1 m) (or h1 h) - (or d1 d) (or month1 month) (or y1 y))) - (setq fm (cdr org-time-stamp-formats)) - (cond - ((memq key '(day today)) - (setq txt (format-time-string "%A, %B %d, %Y" ts))) - ((memq key '(week thisweek)) - (setq txt (format-time-string "week %G-W%V" ts))) - ((memq key '(month thismonth)) - (setq txt (format-time-string "%B %Y" ts))) - ((memq key '(year thisyear)) - (setq txt (format-time-string "the year %Y" ts))) - ((memq key '(quarter thisq)) - (setq txt (concat (org-count-quarter shiftedq) " quarter of " (number-to-string shiftedy))))) - (if as-strings - (list (format-time-string fm ts) (format-time-string fm te) txt) - (list ts te txt)))) - -(defun org-count-quarter (n) - (cond - ((= n 1) "1st") - ((= n 2) "2nd") - ((= n 3) "3rd") - ((= n 4) "4th"))) - -;;;###autoload -(defun org-clocktable-shift (dir n) - "Try to shift the :block date of the clocktable at point. -Point must be in the #+BEGIN: line of a clocktable, or this function -will throw an error. -DIR is a direction, a symbol `left', `right', `up', or `down'. -Both `left' and `down' shift the block toward the past, `up' and `right' -push it toward the future. -N is the number of shift steps to take. The size of the step depends on -the currently selected interval size." - (setq n (prefix-numeric-value n)) - (and (memq dir '(left down)) (setq n (- n))) - (save-excursion - (goto-char (point-at-bol)) - (if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)")) - (error "Line needs a :block definition before this command works") - (let* ((b (match-beginning 1)) (e (match-end 1)) - (s (match-string 1)) - block shift ins y mw d date wp m) - (cond - ((equal s "yesterday") (setq s "today-1")) - ((equal s "lastweek") (setq s "thisweek-1")) - ((equal s "lastmonth") (setq s "thismonth-1")) - ((equal s "lastyear") (setq s "thisyear-1")) - ((equal s "lastq") (setq s "thisq-1"))) - - (cond - ((string-match "^\\(today\\|thisweek\\|thismonth\\|thisyear\\|thisq\\)\\([-+][0-9]+\\)?$" s) - (setq block (match-string 1 s) - shift (if (match-end 2) - (string-to-number (match-string 2 s)) - 0)) - (setq shift (+ shift n)) - (setq ins (if (= shift 0) block (format "%s%+d" block shift)))) - ((string-match "\\([0-9]+\\)\\(-\\([wWqQ]?\\)\\([0-9]\\{1,2\\}\\)\\(-\\([0-9]\\{1,2\\}\\)\\)?\\)?" s) - ;; 1 1 2 3 3 4 4 5 6 6 5 2 - (setq y (string-to-number (match-string 1 s)) - wp (and (match-end 3) (match-string 3 s)) - mw (and (match-end 4) (string-to-number (match-string 4 s))) - d (and (match-end 6) (string-to-number (match-string 6 s)))) - (cond - (d (setq ins (format-time-string - "%Y-%m-%d" - (encode-time 0 0 0 (+ d n) m y)))) - ((and wp (string-match "w\\|W" wp) mw (> (length wp) 0)) - (require 'cal-iso) - (setq date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso (list (+ mw n) 1 y)))) - (setq ins (format-time-string - "%G-W%V" - (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) - ((and wp (string-match "q\\|Q" wp) mw (> (length wp) 0)) - (require 'cal-iso) - ; if the 4th + 1 quarter is requested we flip to the 1st quarter of the next year - (if (> (+ mw n) 4) - (setq mw 0 - y (+ 1 y)) - ()) - ; if the 1st - 1 quarter is requested we flip to the 4th quarter of the previous year - (if (= (+ mw n) 0) - (setq mw 5 - y (- y 1)) - ()) - (setq date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso (org-quarter-to-date (+ mw n) y)))) - (setq ins (format-time-string - (concat (number-to-string y) "-Q" (number-to-string (+ mw n))) - (encode-time 0 0 0 (nth 1 date) (car date) (nth 2 date))))) - (mw - (setq ins (format-time-string - "%Y-%m" - (encode-time 0 0 0 1 (+ mw n) y)))) - (y - (setq ins (number-to-string (+ y n)))))) - (t (error "Cannot shift clocktable block"))) - (when ins - (goto-char b) - (insert ins) - (delete-region (point) (+ (point) (- e b))) - (beginning-of-line 1) - (org-update-dblock) - t))))) - -;;;###autoload -(defun org-dblock-write:clocktable (params) - "Write the standard clocktable." - (setq params (org-combine-plists org-clocktable-defaults params)) - (catch 'exit - (let* ((scope (plist-get params :scope)) - (block (plist-get params :block)) - (ts (plist-get params :tstart)) - (te (plist-get params :tend)) - (link (plist-get params :link)) - (maxlevel (or (plist-get params :maxlevel) 3)) - (ws (plist-get params :wstart)) - (ms (plist-get params :mstart)) - (step (plist-get params :step)) - (timestamp (plist-get params :timestamp)) - (formatter (or (plist-get params :formatter) - org-clock-clocktable-formatter - 'org-clocktable-write-default)) - cc range-text ipos pos one-file-with-archives - scope-is-list tbls level) - ;; Check if we need to do steps - (when block - ;; Get the range text for the header - (setq cc (org-clock-special-range block nil t ws ms) - ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) - (when step - ;; Write many tables, in steps - (unless (or block (and ts te)) - (error "Clocktable `:step' can only be used with `:block' or `:tstart,:end'")) - (org-clocktable-steps params) - (throw 'exit nil)) - - (setq ipos (point)) ; remember the insertion position - - ;; Get the right scope - (setq pos (point)) - (cond - ((and scope (listp scope) (symbolp (car scope))) - (setq scope (eval scope))) - ((eq scope 'agenda) - (setq scope (org-agenda-files t))) - ((eq scope 'agenda-with-archives) - (setq scope (org-agenda-files t)) - (setq scope (org-add-archive-files scope))) - ((eq scope 'file-with-archives) - (setq scope (org-add-archive-files (list (buffer-file-name))) - one-file-with-archives t))) - (setq scope-is-list (and scope (listp scope))) - (if scope-is-list - ;; we collect from several files - (let* ((files scope) - file) - (org-agenda-prepare-buffers files) - (while (setq file (pop files)) - (with-current-buffer (find-buffer-visiting file) - (save-excursion - (save-restriction - (push (org-clock-get-table-data file params) tbls)))))) - ;; Just from the current file - (save-restriction - ;; get the right range into the restriction - (org-agenda-prepare-buffers (list (buffer-file-name))) - (cond - ((not scope)) ; use the restriction as it is now - ((eq scope 'file) (widen)) - ((eq scope 'subtree) (org-narrow-to-subtree)) - ((eq scope 'tree) - (while (org-up-heading-safe)) - (org-narrow-to-subtree)) - ((and (symbolp scope) (string-match "^tree\\([0-9]+\\)$" - (symbol-name scope))) - (setq level (string-to-number (match-string 1 (symbol-name scope)))) - (catch 'exit - (while (org-up-heading-safe) - (looking-at org-outline-regexp) - (if (<= (org-reduced-level (funcall outline-level)) level) - (throw 'exit nil)))) - (org-narrow-to-subtree))) - ;; do the table, with no file name. - (push (org-clock-get-table-data nil params) tbls))) - - ;; OK, at this point we tbls as a list of tables, one per file - (setq tbls (nreverse tbls)) - - (setq params (plist-put params :multifile scope-is-list)) - (setq params (plist-put params :one-file-with-archives - one-file-with-archives)) - - (funcall formatter ipos tbls params)))) - -(defun org-clocktable-write-default (ipos tables params) - "Write out a clock table at position IPOS in the current buffer. -TABLES is a list of tables with clocking data as produced by -`org-clock-get-table-data'. PARAMS is the parameter property list obtained -from the dynamic block definition." - ;; This function looks quite complicated, mainly because there are a - ;; lot of options which can add or remove columns. I have massively - ;; commented this function, the I hope it is understandable. If - ;; someone wants to write their own special formatter, this maybe - ;; much easier because there can be a fixed format with a - ;; well-defined number of columns... - (let* ((hlchars '((1 . "*") (2 . "/"))) - (lwords (assoc (or (plist-get params :lang) - (org-bound-and-true-p org-export-default-language) - "en") - org-clock-clocktable-language-setup)) - (multifile (plist-get params :multifile)) - (block (plist-get params :block)) - (ts (plist-get params :tstart)) - (te (plist-get params :tend)) - (header (plist-get params :header)) - (narrow (plist-get params :narrow)) - (ws (or (plist-get params :wstart) 1)) - (ms (or (plist-get params :mstart) 1)) - (link (plist-get params :link)) - (maxlevel (or (plist-get params :maxlevel) 3)) - (emph (plist-get params :emphasize)) - (level-p (plist-get params :level)) - (org-time-clocksum-use-effort-durations - (plist-get params :effort-durations)) - (timestamp (plist-get params :timestamp)) - (properties (plist-get params :properties)) - (ntcol (max 1 (or (plist-get params :tcolumns) 100))) - (rm-file-column (plist-get params :one-file-with-archives)) - (indent (plist-get params :indent)) - (case-fold-search t) - range-text total-time tbl level hlc formula pcol - file-time entries entry headline - recalc content narrow-cut-p tcol) - - ;; Implement abbreviations - (when (plist-get params :compact) - (setq level nil indent t narrow (or narrow '40!) ntcol 1)) - - ;; Some consistency test for parameters - (unless (integerp ntcol) - (setq params (plist-put params :tcolumns (setq ntcol 100)))) - - (when (and narrow (integerp narrow) link) - ;; We cannot have both integer narrow and link - (message - "Using hard narrowing in clocktable to allow for links") - (setq narrow (intern (format "%d!" narrow)))) - - (when narrow - (cond - ((integerp narrow)) - ((and (symbolp narrow) - (string-match "\\`[0-9]+!\\'" (symbol-name narrow))) - (setq narrow-cut-p t - narrow (string-to-number (substring (symbol-name narrow) - 0 -1)))) - (t - (error "Invalid value %s of :narrow property in clock table" - narrow)))) - - (when block - ;; Get the range text for the header - (setq range-text (nth 2 (org-clock-special-range block nil t ws ms)))) - - ;; Compute the total time - (setq total-time (apply '+ (mapcar 'cadr tables))) - - ;; Now we need to output this tsuff - (goto-char ipos) - - ;; Insert the text *before* the actual table - (insert-before-markers - (or header - ;; Format the standard header - (concat - "#+CAPTION: " - (nth 9 lwords) " [" - (substring - (format-time-string (cdr org-time-stamp-formats)) - 1 -1) - "]" - (if block (concat ", for " range-text ".") "") - "\n"))) - - ;; Insert the narrowing line - (when (and narrow (integerp narrow) (not narrow-cut-p)) - (insert-before-markers - "|" ; table line starter - (if multifile "|" "") ; file column, maybe - (if level-p "|" "") ; level column, maybe - (if timestamp "|" "") ; timestamp column, maybe - (if properties (make-string (length properties) ?|) "") ;properties columns, maybe - (format "<%d>| |\n" narrow))) ; headline and time columns - - ;; Insert the table header line - (insert-before-markers - "|" ; table line starter - (if multifile (concat (nth 1 lwords) "|") "") ; file column, maybe - (if level-p (concat (nth 2 lwords) "|") "") ; level column, maybe - (if timestamp (concat (nth 3 lwords) "|") "") ; timestamp column, maybe - (if properties (concat (mapconcat 'identity properties "|") "|") "") ;properties columns, maybe - (concat (nth 4 lwords) "|" - (nth 5 lwords) "|\n")) ; headline and time columns - - ;; Insert the total time in the table - (insert-before-markers - "|-\n" ; a hline - "|" ; table line starter - (if multifile (concat "| " (nth 6 lwords) " ") "") - ; file column, maybe - (if level-p "|" "") ; level column, maybe - (if timestamp "|" "") ; timestamp column, maybe - (if properties (make-string (length properties) ?|) "") ; properties columns, maybe - (concat (format org-clock-total-time-cell-format (nth 7 lwords)) "| ") ; instead of a headline - (format org-clock-total-time-cell-format - (org-minutes-to-clocksum-string (or total-time 0))) ; the time - "|\n") ; close line - - ;; Now iterate over the tables and insert the data - ;; but only if any time has been collected - (when (and total-time (> total-time 0)) - - (while (setq tbl (pop tables)) - ;; now tbl is the table resulting from one file. - (setq file-time (nth 1 tbl)) - (when (or (and file-time (> file-time 0)) - (not (plist-get params :fileskip0))) - (insert-before-markers "|-\n") ; a hline because a new file starts - ;; First the file time, if we have multiple files - (when multifile - ;; Summarize the time collected from this file - (insert-before-markers - (format (concat "| %s %s | %s%s" - (format org-clock-file-time-cell-format (nth 8 lwords)) - " | *%s*|\n") - (file-name-nondirectory (car tbl)) - (if level-p "| " "") ; level column, maybe - (if timestamp "| " "") ; timestamp column, maybe - (if properties (make-string (length properties) ?|) "") ;properties columns, maybe - (org-minutes-to-clocksum-string (nth 1 tbl))))) ; the time - - ;; Get the list of node entries and iterate over it - (setq entries (nth 2 tbl)) - (while (setq entry (pop entries)) - (setq level (car entry) - headline (nth 1 entry) - hlc (if emph (or (cdr (assoc level hlchars)) "") "")) - (when narrow-cut-p - (if (and (string-match (concat "\\`" org-bracket-link-regexp - "\\'") - headline) - (match-end 3)) - (setq headline - (format "[[%s][%s]]" - (match-string 1 headline) - (org-shorten-string (match-string 3 headline) - narrow))) - (setq headline (org-shorten-string headline narrow)))) - (insert-before-markers - "|" ; start the table line - (if multifile "|" "") ; free space for file name column? - (if level-p (format "%d|" (car entry)) "") ; level, maybe - (if timestamp (concat (nth 2 entry) "|") "") ; timestamp, maybe - (if properties - (concat - (mapconcat - (lambda (p) (or (cdr (assoc p (nth 4 entry))) "")) - properties "|") "|") "") ;properties columns, maybe - (if indent (org-clocktable-indent-string level) "") ; indentation - hlc headline hlc "|" ; headline - (make-string (min (1- ntcol) (or (- level 1))) ?|) - ; empty fields for higher levels - hlc (org-minutes-to-clocksum-string (nth 3 entry)) hlc ; time - "|\n" ; close line - ))))) - ;; When exporting subtrees or regions the region might be - ;; activated, so let's disable ̀delete-active-region' - (let ((delete-active-region nil)) (backward-delete-char 1)) - (if (setq formula (plist-get params :formula)) - (cond - ((eq formula '%) - ;; compute the column where the % numbers need to go - (setq pcol (+ 2 - (if multifile 1 0) - (if level-p 1 0) - (if timestamp 1 0) - (min maxlevel (or ntcol 100)))) - ;; compute the column where the total time is - (setq tcol (+ 2 - (if multifile 1 0) - (if level-p 1 0) - (if timestamp 1 0))) - (insert - (format - "\n#+TBLFM: $%d='(org-clock-time%% @%d$%d $%d..$%d);%%.1f" - pcol ; the column where the % numbers should go - (if (and narrow (not narrow-cut-p)) 3 2) ; row of the total time - tcol ; column of the total time - tcol (1- pcol) ; range of columns where times can be found - )) - (setq recalc t)) - ((stringp formula) - (insert "\n#+TBLFM: " formula) - (setq recalc t)) - (t (error "Invalid formula in clocktable"))) - ;; Should we rescue an old formula? - (when (stringp (setq content (plist-get params :content))) - (when (string-match "^\\([ \t]*#\\+tblfm:.*\\)" content) - (setq recalc t) - (insert "\n" (match-string 1 (plist-get params :content))) - (beginning-of-line 0)))) - ;; Back to beginning, align the table, recalculate if necessary - (goto-char ipos) - (skip-chars-forward "^|") - (org-table-align) - (when org-hide-emphasis-markers - ;; we need to align a second time - (org-table-align)) - (when recalc - (if (eq formula '%) - (save-excursion - (if (and narrow (not narrow-cut-p)) (beginning-of-line 2)) - (org-table-goto-column pcol nil 'force) - (insert "%"))) - (org-table-recalculate 'all)) - (when rm-file-column - ;; The file column is actually not wanted - (forward-char 1) - (org-table-delete-column)) - total-time)) - -(defun org-clocktable-indent-string (level) - (if (= level 1) - "" - (let ((str "\\__")) - (while (> level 2) - (setq level (1- level) - str (concat str "___"))) - (concat str " ")))) - -(defun org-clocktable-steps (params) - "Step through the range to make a number of clock tables." - (let* ((p1 (copy-sequence params)) - (ts (plist-get p1 :tstart)) - (te (plist-get p1 :tend)) - (ws (plist-get p1 :wstart)) - (ms (plist-get p1 :mstart)) - (step0 (plist-get p1 :step)) - (step (cdr (assoc step0 '((day . 86400) (week . 604800))))) - (stepskip0 (plist-get p1 :stepskip0)) - (block (plist-get p1 :block)) - cc range-text step-time tsb) - (when block - (setq cc (org-clock-special-range block nil t ws ms) - ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) - (cond - ((numberp ts) - ;; If ts is a number, it's an absolute day number from org-agenda. - (destructuring-bind (month day year) (calendar-gregorian-from-absolute ts) - (setq ts (org-float-time (encode-time 0 0 0 day month year))))) - (ts - (setq ts (org-float-time - (apply 'encode-time (org-parse-time-string ts)))))) - (cond - ((numberp te) - ;; Likewise for te. - (destructuring-bind (month day year) (calendar-gregorian-from-absolute te) - (setq te (org-float-time (encode-time 0 0 0 day month year))))) - (te - (setq te (org-float-time - (apply 'encode-time (org-parse-time-string te)))))) - (setq tsb - (if (eq step0 'week) - (- ts (* 86400 (- (nth 6 (decode-time (seconds-to-time ts))) ws))) - ts)) - (setq p1 (plist-put p1 :header "")) - (setq p1 (plist-put p1 :step nil)) - (setq p1 (plist-put p1 :block nil)) - (while (< tsb te) - (or (bolp) (insert "\n")) - (setq p1 (plist-put p1 :tstart (format-time-string - (org-time-stamp-format nil t) - (seconds-to-time (max tsb ts))))) - (setq p1 (plist-put p1 :tend (format-time-string - (org-time-stamp-format nil t) - (seconds-to-time (min te (setq tsb (+ tsb step))))))) - (insert "\n" (if (eq step0 'day) "Daily report: " - "Weekly report starting on: ") - (plist-get p1 :tstart) "\n") - (setq step-time (org-dblock-write:clocktable p1)) - (re-search-forward "^[ \t]*#\\+END:") - (when (and (equal step-time 0) stepskip0) - ;; Remove the empty table - (delete-region (point-at-bol) - (save-excursion - (re-search-backward "^\\(Daily\\|Weekly\\) report" - nil t) - (point)))) - (end-of-line 0)))) - -(defun org-clock-get-table-data (file params) - "Get the clocktable data for file FILE, with parameters PARAMS. -FILE is only for identification - this function assumes that -the correct buffer is current, and that the wanted restriction is -in place. -The return value will be a list with the file name and the total -file time (in minutes) as 1st and 2nd elements. The third element -of this list will be a list of headline entries. Each entry has the -following structure: - - (LEVEL HEADLINE TIMESTAMP TIME) - -LEVEL: The level of the headline, as an integer. This will be - the reduced leve, so 1,2,3,... even if only odd levels - are being used. -HEADLINE: The text of the headline. Depending on PARAMS, this may - already be formatted like a link. -TIMESTAMP: If PARAMS require it, this will be a time stamp found in the - entry, any of SCHEDULED, DEADLINE, NORMAL, or first inactive, - in this sequence. -TIME: The sum of all time spend in this tree, in minutes. This time - will of cause be restricted to the time block and tags match - specified in PARAMS." - (let* ((maxlevel (or (plist-get params :maxlevel) 3)) - (timestamp (plist-get params :timestamp)) - (ts (plist-get params :tstart)) - (te (plist-get params :tend)) - (ws (plist-get params :wstart)) - (ms (plist-get params :mstart)) - (block (plist-get params :block)) - (link (plist-get params :link)) - (tags (plist-get params :tags)) - (properties (plist-get params :properties)) - (inherit-property-p (plist-get params :inherit-props)) - todo-only - (matcher (if tags (cdr (org-make-tags-matcher tags)))) - cc range-text st p time level hdl props tsp tbl) - - (setq org-clock-file-total-minutes nil) - (when block - (setq cc (org-clock-special-range block nil t ws ms) - ts (car cc) te (nth 1 cc) range-text (nth 2 cc))) - (when (integerp ts) (setq ts (calendar-gregorian-from-absolute ts))) - (when (integerp te) (setq te (calendar-gregorian-from-absolute te))) - (when (and ts (listp ts)) - (setq ts (format "%4d-%02d-%02d" (nth 2 ts) (car ts) (nth 1 ts)))) - (when (and te (listp te)) - (setq te (format "%4d-%02d-%02d" (nth 2 te) (car te) (nth 1 te)))) - ;; Now the times are strings we can parse. - (if ts (setq ts (org-float-time - (seconds-to-time (org-matcher-time ts))))) - (if te (setq te (org-float-time - (seconds-to-time (org-matcher-time te))))) - (save-excursion - (org-clock-sum ts te - (unless (null matcher) - (lambda () - (let* ((tags-list (org-get-tags-at)) - (org-scanner-tags tags-list) - (org-trust-scanner-tags t)) - (eval matcher))))) - (goto-char (point-min)) - (setq st t) - (while (or (and (bobp) (prog1 st (setq st nil)) - (get-text-property (point) :org-clock-minutes) - (setq p (point-min))) - (setq p (next-single-property-change - (point) :org-clock-minutes))) - (goto-char p) - (when (setq time (get-text-property p :org-clock-minutes)) - (save-excursion - (beginning-of-line 1) - (when (and (looking-at (org-re "\\(\\*+\\)[ \t]+\\(.*?\\)\\([ \t]+:[[:alnum:]_@#%:]+:\\)?[ \t]*$")) - (setq level (org-reduced-level - (- (match-end 1) (match-beginning 1)))) - (<= level maxlevel)) - (setq hdl (if (not link) - (match-string 2) - (org-make-link-string - (format "file:%s::%s" - (buffer-file-name) - (save-match-data - (org-make-org-heading-search-string - (match-string 2)))) - (match-string 2))) - tsp (when timestamp - (setq props (org-entry-properties (point))) - (or (cdr (assoc "SCHEDULED" props)) - (cdr (assoc "DEADLINE" props)) - (cdr (assoc "TIMESTAMP" props)) - (cdr (assoc "TIMESTAMP_IA" props)))) - props (when properties - (remove nil - (mapcar - (lambda (p) - (when (org-entry-get (point) p inherit-property-p) - (cons p (org-entry-get (point) p inherit-property-p)))) - properties)))) - (when (> time 0) (push (list level hdl tsp time props) tbl)))))) - (setq tbl (nreverse tbl)) - (list file org-clock-file-total-minutes tbl)))) - -(defun org-clock-time% (total &rest strings) - "Compute a time fraction in percent. -TOTAL s a time string like 10:21 specifying the total times. -STRINGS is a list of strings that should be checked for a time. -The first string that does have a time will be used. -This function is made for clock tables." - (let ((re "\\([0-9]+\\):\\([0-9]+\\)") - tot s) - (save-match-data - (catch 'exit - (if (not (string-match re total)) - (throw 'exit 0.) - (setq tot (+ (string-to-number (match-string 2 total)) - (* 60 (string-to-number (match-string 1 total))))) - (if (= tot 0.) (throw 'exit 0.))) - (while (setq s (pop strings)) - (if (string-match "\\([0-9]+\\):\\([0-9]+\\)" s) - (throw 'exit - (/ (* 100.0 (+ (string-to-number (match-string 2 s)) - (* 60 (string-to-number - (match-string 1 s))))) - tot)))) - 0)))) - -;; Saving and loading the clock - -(defvar org-clock-loaded nil - "Was the clock file loaded?") - -;;;###autoload -(defun org-clock-update-time-maybe () - "If this is a CLOCK line, update it and return t. -Otherwise, return nil." - (interactive) - (save-excursion - (beginning-of-line 1) - (skip-chars-forward " \t") - (when (looking-at org-clock-string) - (let ((re (concat "[ \t]*" org-clock-string - " *[[<]\\([^]>]+\\)[]>]\\(-+[[<]\\([^]>]+\\)[]>]" - "\\([ \t]*=>.*\\)?\\)?")) - ts te h m s neg) - (cond - ((not (looking-at re)) - nil) - ((not (match-end 2)) - (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) - (> org-clock-marker (point)) - (<= org-clock-marker (point-at-eol))) - ;; The clock is running here - (setq org-clock-start-time - (apply 'encode-time - (org-parse-time-string (match-string 1)))) - (org-clock-update-mode-line))) - (t - (and (match-end 4) (delete-region (match-beginning 4) (match-end 4))) - (end-of-line 1) - (setq ts (match-string 1) - te (match-string 3)) - (setq s (- (org-float-time - (apply 'encode-time (org-parse-time-string te))) - (org-float-time - (apply 'encode-time (org-parse-time-string ts)))) - neg (< s 0) - s (abs s) - h (floor (/ s 3600)) - s (- s (* 3600 h)) - m (floor (/ s 60)) - s (- s (* 60 s))) - (insert " => " (format (if neg "-%d:%02d" "%2d:%02d") h m)) - t)))))) - -(defun org-clock-save () - "Persist various clock-related data to disk. -The details of what will be saved are regulated by the variable -`org-clock-persist'." - (when (and org-clock-persist - (or org-clock-loaded - org-clock-has-been-used - (not (file-exists-p org-clock-persist-file)))) - (let (b) - (with-current-buffer (find-file (expand-file-name org-clock-persist-file)) - (progn - (delete-region (point-min) (point-max)) - ;;Store clock - (insert (format ";; org-persist.el - %s at %s\n" - system-name (format-time-string - (cdr org-time-stamp-formats)))) - (if (and (memq org-clock-persist '(t clock)) - (setq b (org-clocking-buffer)) - (setq b (or (buffer-base-buffer b) b)) - (buffer-live-p b) - (buffer-file-name b) - (or (not org-clock-persist-query-save) - (y-or-n-p (concat "Save current clock (" - org-clock-heading ") ")))) - (insert "(setq resume-clock '(\"" - (buffer-file-name (org-clocking-buffer)) - "\" . " (int-to-string (marker-position org-clock-marker)) - "))\n")) - ;; Store clocked task history. Tasks are stored reversed to make - ;; reading simpler - (when (and (memq org-clock-persist '(t history)) - org-clock-history) - (insert - "(setq stored-clock-history '(" - (mapconcat - (lambda (m) - (when (and (setq b (marker-buffer m)) - (setq b (or (buffer-base-buffer b) b)) - (buffer-live-p b) - (buffer-file-name b)) - (concat "(\"" (buffer-file-name b) - "\" . " (int-to-string (marker-position m)) - ")"))) - (reverse org-clock-history) " ") "))\n")) - (save-buffer) - (kill-buffer (current-buffer))))))) - -(defun org-clock-load () - "Load clock-related data from disk, maybe resuming a stored clock." - (when (and org-clock-persist (not org-clock-loaded)) - (let ((filename (expand-file-name org-clock-persist-file)) - (org-clock-in-resume 'auto-restart) - resume-clock stored-clock-history) - (if (not (file-readable-p filename)) - (message "Not restoring clock data; %s not found" - org-clock-persist-file) - (message "%s" "Restoring clock data") - (setq org-clock-loaded t) - (load-file filename) - ;; load history - (when stored-clock-history - (save-window-excursion - (mapc (lambda (task) - (if (file-exists-p (car task)) - (org-clock-history-push (cdr task) - (find-file (car task))))) - stored-clock-history))) - ;; resume clock - (when (and resume-clock org-clock-persist - (file-exists-p (car resume-clock)) - (or (not org-clock-persist-query-resume) - (y-or-n-p - (concat - "Resume clock (" - (with-current-buffer (find-file (car resume-clock)) - (save-excursion - (goto-char (cdr resume-clock)) - (org-back-to-heading t) - (and (looking-at org-complex-heading-regexp) - (match-string 4)))) - ") ")))) - (when (file-exists-p (car resume-clock)) - (with-current-buffer (find-file (car resume-clock)) - (goto-char (cdr resume-clock)) - (let ((org-clock-auto-clock-resolution nil)) - (org-clock-in) - (if (outline-invisible-p) - (org-show-context)))))))))) - -;; Suggested bindings -(org-defkey org-mode-map "\C-c\C-x\C-e" 'org-clock-modify-effort-estimate) - -(provide 'org-clock) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-clock.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-colview.el b/xemacs-packages/lisp/org-8.2.3c/org-colview.el deleted file mode 100644 index 361560dc..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-colview.el +++ /dev/null @@ -1,1583 +0,0 @@ -;;; org-colview.el --- Column View in Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file contains the column view for Org. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'org) - -(declare-function org-agenda-redo "org-agenda" ()) -(declare-function org-agenda-do-context-action "org-agenda" ()) -(declare-function org-clock-sum-today "org-clock" (&optional headline-filter)) - -(when (featurep 'xemacs) - (error "Do not load this file into XEmacs, use `org-colview-xemacs.el' from the contrib/ directory")) - -;;; Column View - -(defvar org-columns-overlays nil - "Holds the list of current column overlays.") - -(defvar org-columns-current-fmt nil - "Local variable, holds the currently active column format.") -(make-variable-buffer-local 'org-columns-current-fmt) -(defvar org-columns-current-fmt-compiled nil - "Local variable, holds the currently active column format. -This is the compiled version of the format.") -(make-variable-buffer-local 'org-columns-current-fmt-compiled) -(defvar org-columns-current-widths nil - "Loval variable, holds the currently widths of fields.") -(make-variable-buffer-local 'org-columns-current-widths) -(defvar org-columns-current-maxwidths nil - "Loval variable, holds the currently active maximum column widths.") -(make-variable-buffer-local 'org-columns-current-maxwidths) -(defvar org-columns-begin-marker (make-marker) - "Points to the position where last a column creation command was called.") -(defvar org-columns-top-level-marker (make-marker) - "Points to the position where current columns region starts.") - -(defvar org-columns-map (make-sparse-keymap) - "The keymap valid in column display.") - -(defun org-columns-content () - "Switch to contents view while in columns view." - (interactive) - (org-overview) - (org-content)) - -(org-defkey org-columns-map "c" 'org-columns-content) -(org-defkey org-columns-map "o" 'org-overview) -(org-defkey org-columns-map "e" 'org-columns-edit-value) -(org-defkey org-columns-map "\C-c\C-t" 'org-columns-todo) -(org-defkey org-columns-map "\C-c\C-c" 'org-columns-set-tags-or-toggle) -(org-defkey org-columns-map "\C-c\C-o" 'org-columns-open-link) -(org-defkey org-columns-map "v" 'org-columns-show-value) -(org-defkey org-columns-map "q" 'org-columns-quit) -(org-defkey org-columns-map "r" 'org-columns-redo) -(org-defkey org-columns-map "g" 'org-columns-redo) -(org-defkey org-columns-map [left] 'backward-char) -(org-defkey org-columns-map "\M-b" 'backward-char) -(org-defkey org-columns-map "a" 'org-columns-edit-allowed) -(org-defkey org-columns-map "s" 'org-columns-edit-attributes) -(org-defkey org-columns-map "\M-f" - (lambda () (interactive) (goto-char (1+ (point))))) -(org-defkey org-columns-map [right] - (lambda () (interactive) (goto-char (1+ (point))))) -(org-defkey org-columns-map [down] - (lambda () (interactive) - (let ((col (current-column))) - (beginning-of-line 2) - (while (and (org-invisible-p2) (not (eobp))) - (beginning-of-line 2)) - (move-to-column col) - (if (eq major-mode 'org-agenda-mode) - (org-agenda-do-context-action))))) -(org-defkey org-columns-map [up] - (lambda () (interactive) - (let ((col (current-column))) - (beginning-of-line 0) - (while (and (org-invisible-p2) (not (bobp))) - (beginning-of-line 0)) - (move-to-column col) - (if (eq major-mode 'org-agenda-mode) - (org-agenda-do-context-action))))) -(org-defkey org-columns-map [(shift right)] 'org-columns-next-allowed-value) -(org-defkey org-columns-map "n" 'org-columns-next-allowed-value) -(org-defkey org-columns-map [(shift left)] 'org-columns-previous-allowed-value) -(org-defkey org-columns-map "p" 'org-columns-previous-allowed-value) -(org-defkey org-columns-map "<" 'org-columns-narrow) -(org-defkey org-columns-map ">" 'org-columns-widen) -(org-defkey org-columns-map [(meta right)] 'org-columns-move-right) -(org-defkey org-columns-map [(meta left)] 'org-columns-move-left) -(org-defkey org-columns-map [(shift meta right)] 'org-columns-new) -(org-defkey org-columns-map [(shift meta left)] 'org-columns-delete) -(dotimes (i 10) - (org-defkey org-columns-map (number-to-string i) - `(lambda () (interactive) - (org-columns-next-allowed-value nil ,i)))) - -(easy-menu-define org-columns-menu org-columns-map "Org Column Menu" - '("Column" - ["Edit property" org-columns-edit-value t] - ["Next allowed value" org-columns-next-allowed-value t] - ["Previous allowed value" org-columns-previous-allowed-value t] - ["Show full value" org-columns-show-value t] - ["Edit allowed values" org-columns-edit-allowed t] - "--" - ["Edit column attributes" org-columns-edit-attributes t] - ["Increase column width" org-columns-widen t] - ["Decrease column width" org-columns-narrow t] - "--" - ["Move column right" org-columns-move-right t] - ["Move column left" org-columns-move-left t] - ["Add column" org-columns-new t] - ["Delete column" org-columns-delete t] - "--" - ["CONTENTS" org-columns-content t] - ["OVERVIEW" org-overview t] - ["Refresh columns display" org-columns-redo t] - "--" - ["Open link" org-columns-open-link t] - "--" - ["Quit" org-columns-quit t])) - -(defun org-columns-new-overlay (beg end &optional string face) - "Create a new column overlay and add it to the list." - (let ((ov (make-overlay beg end))) - (overlay-put ov 'face (or face 'secondary-selection)) - (remove-text-properties 0 (length string) '(face nil) string) - (org-overlay-display ov string face) - (push ov org-columns-overlays) - ov)) - -(defun org-columns-display-here (&optional props dateline) - "Overlay the current line with column display." - (interactive) - (let* ((fmt org-columns-current-fmt-compiled) - (beg (point-at-bol)) - (level-face (save-excursion - (beginning-of-line 1) - (and (looking-at "\\(\\**\\)\\(\\* \\)") - (org-get-level-face 2)))) - (ref-face (or level-face - (and (eq major-mode 'org-agenda-mode) - (get-text-property (point-at-bol) 'face)) - 'default)) - (color (list :foreground (face-attribute ref-face :foreground))) - (font (list :height (face-attribute 'default :height) - :family (face-attribute 'default :family))) - (face (list color font 'org-column ref-face)) - (face1 (list color font 'org-agenda-column-dateline ref-face)) - (cphr (get-text-property (point-at-bol) 'org-complex-heading-regexp)) - pom property ass width f string ov column val modval s2 title calc) - ;; Check if the entry is in another buffer. - (unless props - (if (eq major-mode 'org-agenda-mode) - (setq pom (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker)) - props (if pom (org-entry-properties pom) nil)) - (setq props (org-entry-properties nil)))) - ;; Walk the format - (while (setq column (pop fmt)) - (setq property (car column) - title (nth 1 column) - ass (if (equal property "ITEM") - (cons "ITEM" - ;; When in a buffer, get the whole line, - ;; we'll clean it later… - (if (derived-mode-p 'org-mode) - (save-match-data - (org-remove-tabs - (buffer-substring-no-properties - (point-at-bol) (point-at-eol)))) - ;; In agenda, just get the `txt' property - (or (org-get-at-bol 'txt) - (buffer-substring-no-properties - (point) (progn (end-of-line) (point)))))) - (assoc property props)) - width (or (cdr (assoc property org-columns-current-maxwidths)) - (nth 2 column) - (length property)) - f (format "%%-%d.%ds | " width width) - calc (nth 7 column) - val (or (cdr ass) "") - modval (cond ((and org-columns-modify-value-for-display-function - (functionp - org-columns-modify-value-for-display-function)) - (funcall org-columns-modify-value-for-display-function - title val)) - ((equal property "ITEM") - (org-columns-cleanup-item - val org-columns-current-fmt-compiled - (or org-complex-heading-regexp cphr))) - ((and calc (functionp calc) - (not (string= val "")) - (not (get-text-property 0 'org-computed val))) - (org-columns-number-to-string - (funcall calc (org-columns-string-to-number - val (nth 4 column))) - (nth 4 column))))) - (setq s2 (org-columns-add-ellipses (or modval val) width)) - (setq string (format f s2)) - ;; Create the overlay - (org-with-silent-modifications - (setq ov (org-columns-new-overlay - beg (setq beg (1+ beg)) string (if dateline face1 face))) - (overlay-put ov 'keymap org-columns-map) - (overlay-put ov 'org-columns-key property) - (overlay-put ov 'org-columns-value (cdr ass)) - (overlay-put ov 'org-columns-value-modified modval) - (overlay-put ov 'org-columns-pom pom) - (overlay-put ov 'org-columns-format f) - (overlay-put ov 'line-prefix "") - (overlay-put ov 'wrap-prefix "")) - (if (or (not (char-after beg)) - (equal (char-after beg) ?\n)) - (let ((inhibit-read-only t)) - (save-excursion - (goto-char beg) - (org-unmodified (insert " ")))))) ;; FIXME: add props and remove later? - ;; Make the rest of the line disappear. - (org-unmodified - (setq ov (org-columns-new-overlay beg (point-at-eol))) - (overlay-put ov 'invisible t) - (overlay-put ov 'keymap org-columns-map) - (overlay-put ov 'intangible t) - (overlay-put ov 'line-prefix "") - (overlay-put ov 'wrap-prefix "") - (push ov org-columns-overlays) - (setq ov (make-overlay (1- (point-at-eol)) (1+ (point-at-eol)))) - (overlay-put ov 'keymap org-columns-map) - (push ov org-columns-overlays) - (let ((inhibit-read-only t)) - (put-text-property (max (point-min) (1- (point-at-bol))) - (min (point-max) (1+ (point-at-eol))) - 'read-only "Type `e' to edit property"))))) - -(defun org-columns-add-ellipses (string width) - "Truncate STRING with WIDTH characters, with ellipses." - (cond - ((<= (length string) width) string) - ((<= width (length org-columns-ellipses)) - (substring org-columns-ellipses 0 width)) - (t (concat (substring string 0 (- width (length org-columns-ellipses))) - org-columns-ellipses)))) - -(defvar org-columns-full-header-line-format nil - "The full header line format, will be shifted by horizontal scrolling." ) -(defvar org-previous-header-line-format nil - "The header line format before column view was turned on.") -(defvar org-columns-inhibit-recalculation nil - "Inhibit recomputing of columns on column view startup.") -(defvar org-columns-flyspell-was-active nil - "Remember the state of `flyspell-mode' before column view. -Flyspell-mode can cause problems in columns view, so it is turned off -for the duration of the command.") - -(defvar header-line-format) -(defvar org-columns-previous-hscroll 0) - -(defun org-columns-display-here-title () - "Overlay the newline before the current line with the table title." - (interactive) - (let ((fmt org-columns-current-fmt-compiled) - string (title "") - property width f column str widths) - (while (setq column (pop fmt)) - (setq property (car column) - str (or (nth 1 column) property) - width (or (cdr (assoc property org-columns-current-maxwidths)) - (nth 2 column) - (length str)) - widths (push width widths) - f (format "%%-%d.%ds | " width width) - string (format f str) - title (concat title string))) - (setq title (concat - (org-add-props " " nil 'display '(space :align-to 0)) - ;;(org-add-props title nil 'face '(:weight bold :underline t :inherit default)))) - (org-add-props title nil 'face 'org-column-title))) - (org-set-local 'org-previous-header-line-format header-line-format) - (org-set-local 'org-columns-current-widths (nreverse widths)) - (setq org-columns-full-header-line-format title) - (setq org-columns-previous-hscroll -1) - ; (org-columns-hscoll-title) - (org-add-hook 'post-command-hook 'org-columns-hscoll-title nil 'local))) - -(defun org-columns-hscoll-title () - "Set the `header-line-format' so that it scrolls along with the table." - (sit-for .0001) ; need to force a redisplay to update window-hscroll - (when (not (= (window-hscroll) org-columns-previous-hscroll)) - (setq header-line-format - (concat (substring org-columns-full-header-line-format 0 1) - (substring org-columns-full-header-line-format - (1+ (window-hscroll)))) - org-columns-previous-hscroll (window-hscroll)) - (force-mode-line-update))) - -(defvar org-colview-initial-truncate-line-value nil - "Remember the value of `truncate-lines' across colview.") - -;;;###autoload -(defun org-columns-remove-overlays () - "Remove all currently active column overlays." - (interactive) - (when (marker-buffer org-columns-begin-marker) - (with-current-buffer (marker-buffer org-columns-begin-marker) - (when (local-variable-p 'org-previous-header-line-format) - (setq header-line-format org-previous-header-line-format) - (kill-local-variable 'org-previous-header-line-format) - (remove-hook 'post-command-hook 'org-columns-hscoll-title 'local)) - (move-marker org-columns-begin-marker nil) - (move-marker org-columns-top-level-marker nil) - (org-with-silent-modifications - (mapc 'delete-overlay org-columns-overlays) - (setq org-columns-overlays nil) - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(read-only t)))) - (when org-columns-flyspell-was-active - (flyspell-mode 1)) - (when (local-variable-p 'org-colview-initial-truncate-line-value) - (setq truncate-lines org-colview-initial-truncate-line-value))))) - -(defun org-columns-cleanup-item (item fmt cphr) - "Remove from ITEM what is a column in the format FMT. -CPHR is the complex heading regexp to use for parsing ITEM." - (let (fixitem) - (if (not cphr) - item - (unless (string-match "^\*+ " item) - (setq item (concat "* " item) fixitem t)) - (if (string-match cphr item) - (setq item - (concat - (org-add-props (match-string 1 item) nil - 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1)))))) - (and (match-end 2) (not (assoc "TODO" fmt)) (concat " " (match-string 2 item))) - (and (match-end 3) (not (assoc "PRIORITY" fmt)) (concat " " (match-string 3 item))) - " " (save-match-data (org-columns-compact-links (or (match-string 4 item) ""))) - (and (match-end 5) (not (assoc "TAGS" fmt)) (concat " " (match-string 5 item))))) - (add-text-properties - 0 (1+ (match-end 1)) - (list 'org-whitespace (* 2 (1- (org-reduced-level (- (match-end 1) (match-beginning 1)))))) - item)) - (if fixitem (replace-regexp-in-string "^\*+ " "" item) item)))) - -(defun org-columns-compact-links (s) - "Replace [[link][desc]] with [desc] or [link]." - (while (string-match org-bracket-link-regexp s) - (setq s (replace-match - (concat "[" (match-string (if (match-end 3) 3 1) s) "]") - t t s))) - s) - -(defun org-columns-show-value () - "Show the full value of the property." - (interactive) - (let ((value (get-char-property (point) 'org-columns-value))) - (message "Value is: %s" (or value "")))) - -(defvar org-agenda-columns-active) ;; defined in org-agenda.el - -(defun org-columns-quit () - "Remove the column overlays and in this way exit column editing." - (interactive) - (org-with-silent-modifications - (org-columns-remove-overlays) - (let ((inhibit-read-only t)) - (remove-text-properties (point-min) (point-max) '(read-only t)))) - (when (eq major-mode 'org-agenda-mode) - (setq org-agenda-columns-active nil) - (message - "Modification not yet reflected in Agenda buffer, use `r' to refresh"))) - -(defun org-columns-check-computed () - "Check if this column value is computed. -If yes, throw an error indicating that changing it does not make sense." - (let ((val (get-char-property (point) 'org-columns-value))) - (when (and (stringp val) - (get-char-property 0 'org-computed val)) - (error "This value is computed from the entry's children")))) - -(defun org-columns-todo (&optional arg) - "Change the TODO state during column view." - (interactive "P") - (org-columns-edit-value "TODO")) - -(defun org-columns-set-tags-or-toggle (&optional arg) - "Toggle checkbox at point, or set tags for current headline." - (interactive "P") - (if (string-match "\\`\\[[ xX-]\\]\\'" - (get-char-property (point) 'org-columns-value)) - (org-columns-next-allowed-value) - (org-columns-edit-value "TAGS"))) - -(defvar org-agenda-overriding-columns-format nil - "When set, overrides any other format definition for the agenda. -Don't set this, this is meant for dynamic scoping.") - -(defun org-columns-edit-value (&optional key) - "Edit the value of the property at point in column view. -Where possible, use the standard interface for changing this line." - (interactive) - (org-columns-check-computed) - (let* ((col (current-column)) - (key (or key (get-char-property (point) 'org-columns-key))) - (value (get-char-property (point) 'org-columns-value)) - (bol (point-at-bol)) (eol (point-at-eol)) - (pom (or (get-text-property bol 'org-hd-marker) - (point))) ; keep despite of compiler waring - (line-overlays - (delq nil (mapcar (lambda (x) - (and (eq (overlay-buffer x) (current-buffer)) - (>= (overlay-start x) bol) - (<= (overlay-start x) eol) - x)) - org-columns-overlays))) - (org-columns-time (time-to-number-of-days (current-time))) - nval eval allowed) - (cond - ((equal key "CLOCKSUM") - (error "This special column cannot be edited")) - ((equal key "ITEM") - (setq eval '(org-with-point-at pom - (org-edit-headline)))) - ((equal key "TODO") - (setq eval '(org-with-point-at - pom - (call-interactively 'org-todo)))) - ((equal key "PRIORITY") - (setq eval '(org-with-point-at pom - (call-interactively 'org-priority)))) - ((equal key "TAGS") - (setq eval '(org-with-point-at pom - (let ((org-fast-tag-selection-single-key - (if (eq org-fast-tag-selection-single-key 'expert) - t org-fast-tag-selection-single-key))) - (call-interactively 'org-set-tags))))) - ((equal key "DEADLINE") - (setq eval '(org-with-point-at pom - (call-interactively 'org-deadline)))) - ((equal key "SCHEDULED") - (setq eval '(org-with-point-at pom - (call-interactively 'org-schedule)))) - ((equal key "BEAMER_env") - (setq eval '(org-with-point-at pom - (call-interactively 'org-beamer-select-environment)))) - (t - (setq allowed (org-property-get-allowed-values pom key 'table)) - (if allowed - (setq nval (org-icompleting-read - "Value: " allowed nil - (not (get-text-property 0 'org-unrestricted - (caar allowed))))) - (setq nval (read-string "Edit: " value))) - (setq nval (org-trim nval)) - (when (not (equal nval value)) - (setq eval '(org-entry-put pom key nval))))) - (when eval - - (cond - ((equal major-mode 'org-agenda-mode) - (org-columns-eval eval) - ;; The following let preserves the current format, and makes sure - ;; that in only a single file things need to be updated. - (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) - (buffer (marker-buffer pom)) - (org-agenda-contributing-files - (list (with-current-buffer buffer - (buffer-file-name (buffer-base-buffer)))))) - (org-agenda-columns))) - (t - (let ((inhibit-read-only t)) - (org-with-silent-modifications - (remove-text-properties - (max (point-min) (1- bol)) eol '(read-only t))) - (unwind-protect - (progn - (setq org-columns-overlays - (org-delete-all line-overlays org-columns-overlays)) - (mapc 'delete-overlay line-overlays) - (org-columns-eval eval)) - (org-columns-display-here))) - (org-move-to-column col) - (if (and (derived-mode-p 'org-mode) - (nth 3 (assoc key org-columns-current-fmt-compiled))) - (org-columns-update key))))))) - -(defun org-edit-headline () ; FIXME: this is not columns specific. Make interactive????? Use from agenda???? - "Edit the current headline, the part without TODO keyword, TAGS." - (org-back-to-heading) - (when (looking-at org-todo-line-regexp) - (let ((pos (point)) - (pre (buffer-substring (match-beginning 0) (match-beginning 3))) - (txt (match-string 3)) - (post "") - txt2) - (if (string-match (org-re "[ \t]+:[[:alnum:]:_@#%]+:[ \t]*$") txt) - (setq post (match-string 0 txt) - txt (substring txt 0 (match-beginning 0)))) - (setq txt2 (read-string "Edit: " txt)) - (when (not (equal txt txt2)) - (goto-char pos) - (insert pre txt2 post) - (delete-region (point) (point-at-eol)) - (org-set-tags nil t))))) - -(defun org-columns-edit-allowed () - "Edit the list of allowed values for the current property." - (interactive) - (let* ((pom (or (org-get-at-bol 'org-marker) - (org-get-at-bol 'org-hd-marker) - (point))) - (key (get-char-property (point) 'org-columns-key)) - (key1 (concat key "_ALL")) - (allowed (org-entry-get pom key1 t)) - nval) - ;; FIXME: Cover editing TODO, TAGS etc in-buffer settings.???? - ;; FIXME: Write back to #+PROPERTY setting if that is needed. - (setq nval (read-string "Allowed: " allowed)) - (org-entry-put - (cond ((marker-position org-entry-property-inherited-from) - org-entry-property-inherited-from) - ((marker-position org-columns-top-level-marker) - org-columns-top-level-marker) - (t pom)) - key1 nval))) - -(defun org-columns-eval (form) - (let (hidep) - (save-excursion - (beginning-of-line 1) - ;; `next-line' is needed here, because it skips invisible line. - (condition-case nil (org-no-warnings (next-line 1)) (error nil)) - (setq hidep (org-at-heading-p 1))) - (eval form) - (and hidep (hide-entry)))) - -(defun org-columns-previous-allowed-value () - "Switch to the previous allowed value for this column." - (interactive) - (org-columns-next-allowed-value t)) - -(defun org-columns-next-allowed-value (&optional previous nth) - "Switch to the next allowed value for this column. -When PREVIOUS is set, go to the previous value. When NTH is -an integer, select that value." - (interactive) - (org-columns-check-computed) - (let* ((col (current-column)) - (key (get-char-property (point) 'org-columns-key)) - (value (get-char-property (point) 'org-columns-value)) - (bol (point-at-bol)) (eol (point-at-eol)) - (pom (or (get-text-property bol 'org-hd-marker) - (point))) ; keep despite of compiler waring - (line-overlays - (delq nil (mapcar (lambda (x) - (and (eq (overlay-buffer x) (current-buffer)) - (>= (overlay-start x) bol) - (<= (overlay-start x) eol) - x)) - org-columns-overlays))) - (allowed (or (org-property-get-allowed-values pom key) - (and (memq - (nth 4 (assoc key org-columns-current-fmt-compiled)) - '(checkbox checkbox-n-of-m checkbox-percent)) - '("[ ]" "[X]")) - (org-colview-construct-allowed-dates value))) - nval) - (when (integerp nth) - (setq nth (1- nth)) - (if (= nth -1) (setq nth 9))) - (when (equal key "ITEM") - (error "Cannot edit item headline from here")) - (unless (or allowed (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM"))) - (error "Allowed values for this property have not been defined")) - (if (member key '("SCHEDULED" "DEADLINE" "CLOCKSUM")) - (setq nval (if previous 'earlier 'later)) - (if previous (setq allowed (reverse allowed))) - (cond - (nth - (setq nval (nth nth allowed)) - (if (not nval) - (error "There are only %d allowed values for property `%s'" - (length allowed) key))) - ((member value allowed) - (setq nval (or (car (cdr (member value allowed))) - (car allowed))) - (if (equal nval value) - (error "Only one allowed value for this property"))) - (t (setq nval (car allowed))))) - (cond - ((equal major-mode 'org-agenda-mode) - (org-columns-eval '(org-entry-put pom key nval)) - ;; The following let preserves the current format, and makes sure - ;; that in only a single file things need to be updated. - (let* ((org-agenda-overriding-columns-format org-columns-current-fmt) - (buffer (marker-buffer pom)) - (org-agenda-contributing-files - (list (with-current-buffer buffer - (buffer-file-name (buffer-base-buffer)))))) - (org-agenda-columns))) - (t - (let ((inhibit-read-only t)) - (remove-text-properties (1- bol) eol '(read-only t)) - (unwind-protect - (progn - (setq org-columns-overlays - (org-delete-all line-overlays org-columns-overlays)) - (mapc 'delete-overlay line-overlays) - (org-columns-eval '(org-entry-put pom key nval))) - (org-columns-display-here))) - (org-move-to-column col) - (and (nth 3 (assoc key org-columns-current-fmt-compiled)) - (org-columns-update key)))))) - -(defun org-colview-construct-allowed-dates (s) - "Construct a list of three dates around the date in S. -This respects the format of the time stamp in S, active or non-active, -and also including time or not. S must be just a time stamp, no text -around it." - (when (and s (string-match (concat "^" org-ts-regexp3 "$") s)) - (let* ((time (org-parse-time-string s 'nodefaults)) - (active (equal (string-to-char s) ?<)) - (fmt (funcall (if (nth 1 time) 'cdr 'car) org-time-stamp-formats)) - time-before time-after) - (unless active (setq fmt (concat "[" (substring fmt 1 -1) "]"))) - (setf (car time) (or (car time) 0)) - (setf (nth 1 time) (or (nth 1 time) 0)) - (setf (nth 2 time) (or (nth 2 time) 0)) - (setq time-before (copy-sequence time)) - (setq time-after (copy-sequence time)) - (setf (nth 3 time-before) (1- (nth 3 time))) - (setf (nth 3 time-after) (1+ (nth 3 time))) - (mapcar (lambda (x) (format-time-string fmt (apply 'encode-time x))) - (list time-before time time-after))))) - -(defun org-verify-version (task) - (cond - ((eq task 'columns) - (if (or (featurep 'xemacs) - (< emacs-major-version 22)) - (error "Emacs 22 is required for the columns feature"))))) - -(defun org-columns-open-link (&optional arg) - (interactive "P") - (let ((value (get-char-property (point) 'org-columns-value))) - (org-open-link-from-string value arg))) - -;;;###autoload -(defun org-columns-get-format-and-top-level () - (let ((fmt (org-columns-get-format))) - (org-columns-goto-top-level) - fmt)) - -(defun org-columns-get-format (&optional fmt-string) - (interactive) - (let (fmt-as-property fmt) - (when (condition-case nil (org-back-to-heading) (error nil)) - (setq fmt-as-property (org-entry-get nil "COLUMNS" t))) - (setq fmt (or fmt-string fmt-as-property org-columns-default-format)) - (org-set-local 'org-columns-current-fmt fmt) - (org-columns-compile-format fmt) - fmt)) - -(defun org-columns-goto-top-level () - (when (condition-case nil (org-back-to-heading) (error nil)) - (org-entry-get nil "COLUMNS" t)) - (if (marker-position org-entry-property-inherited-from) - (move-marker org-columns-top-level-marker org-entry-property-inherited-from) - (move-marker org-columns-top-level-marker (point)))) - -;;;###autoload -(defun org-columns (&optional columns-fmt-string) - "Turn on column view on an org-mode file. -When COLUMNS-FMT-STRING is non-nil, use it as the column format." - (interactive) - (org-verify-version 'columns) - (org-columns-remove-overlays) - (move-marker org-columns-begin-marker (point)) - (let ((org-columns-time (time-to-number-of-days (current-time))) - beg end fmt cache maxwidths) - (org-columns-goto-top-level) - (setq fmt (org-columns-get-format columns-fmt-string)) - (save-excursion - (goto-char org-columns-top-level-marker) - (setq beg (point)) - (unless org-columns-inhibit-recalculation - (org-columns-compute-all)) - (setq end (or (condition-case nil (org-end-of-subtree t t) (error nil)) - (point-max))) - ;; Get and cache the properties - (goto-char beg) - (when (assoc "CLOCKSUM" org-columns-current-fmt-compiled) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (org-clock-sum)))) - (when (assoc "CLOCKSUM_T" org-columns-current-fmt-compiled) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (org-clock-sum-today)))) - (while (re-search-forward org-outline-regexp-bol end t) - (if (and org-columns-skip-archived-trees - (looking-at (concat ".*:" org-archive-tag ":"))) - (org-end-of-subtree t) - (push (cons (org-current-line) (org-entry-properties)) cache))) - (when cache - (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) - (org-set-local 'org-columns-current-maxwidths maxwidths) - (org-columns-display-here-title) - (when (org-set-local 'org-columns-flyspell-was-active - (org-bound-and-true-p flyspell-mode)) - (flyspell-mode 0)) - (unless (local-variable-p 'org-colview-initial-truncate-line-value) - (org-set-local 'org-colview-initial-truncate-line-value - truncate-lines)) - (setq truncate-lines t) - (mapc (lambda (x) - (org-goto-line (car x)) - (org-columns-display-here (cdr x))) - cache))))) - -(eval-when-compile (defvar org-columns-time)) - -(defvar org-columns-compile-map - '(("none" none +) - (":" add_times +) - ("+" add_numbers +) - ("$" currency +) - ("X" checkbox +) - ("X/" checkbox-n-of-m +) - ("X%" checkbox-percent +) - ("max" max_numbers max) - ("min" min_numbers min) - ("mean" mean_numbers - (lambda (&rest x) (/ (apply '+ x) (float (length x))))) - (":max" max_times max) - (":min" min_times min) - (":mean" mean_times - (lambda (&rest x) (/ (apply '+ x) (float (length x))))) - ("@min" min_age min (lambda (x) (- org-columns-time x))) - ("@max" max_age max (lambda (x) (- org-columns-time x))) - ("@mean" mean_age - (lambda (&rest x) (/ (apply '+ x) (float (length x)))) - (lambda (x) (- org-columns-time x))) - ("est+" estimate org-estimate-combine)) - "Operator <-> format,function,calc map. -Used to compile/uncompile columns format and completing read in -interactive function `org-columns-new'. - -operator string used in #+COLUMNS definition describing the - summary type -format symbol describing summary type selected interactively in - `org-columns-new' and internally in - `org-columns-number-to-string' and - `org-columns-string-to-number' -function called with a list of values as argument to calculate - the summary value -calc function called on every element before summarizing. This is - optional and should only be specified if needed") - -(defun org-columns-new (&optional prop title width op fmt fun &rest rest) - "Insert a new column, to the left of the current column." - (interactive) - (let ((editp (and prop (assoc prop org-columns-current-fmt-compiled))) - cell) - (setq prop (org-icompleting-read - "Property: " (mapcar 'list (org-buffer-property-keys t nil t)) - nil nil prop)) - (setq title (read-string (concat "Column title [" prop "]: ") (or title prop))) - (setq width (read-string "Column width: " (if width (number-to-string width)))) - (if (string-match "\\S-" width) - (setq width (string-to-number width)) - (setq width nil)) - (setq fmt (org-icompleting-read - "Summary [none]: " - (mapcar (lambda (x) (list (symbol-name (cadr x)))) - org-columns-compile-map) - nil t)) - (setq fmt (intern fmt) - fun (cdr (assoc fmt (mapcar 'cdr org-columns-compile-map)))) - (if (eq fmt 'none) (setq fmt nil)) - (if editp - (progn - (setcar editp prop) - (setcdr editp (list title width nil fmt nil fun))) - (setq cell (nthcdr (1- (current-column)) - org-columns-current-fmt-compiled)) - (setcdr cell (cons (list prop title width nil fmt nil - (car fun) (cadr fun)) - (cdr cell)))) - (org-columns-store-format) - (org-columns-redo))) - -(defun org-columns-delete () - "Delete the column at point from columns view." - (interactive) - (let* ((n (current-column)) - (title (nth 1 (nth n org-columns-current-fmt-compiled)))) - (when (y-or-n-p - (format "Are you sure you want to remove column \"%s\"? " title)) - (setq org-columns-current-fmt-compiled - (delq (nth n org-columns-current-fmt-compiled) - org-columns-current-fmt-compiled)) - (org-columns-store-format) - (org-columns-redo) - (if (>= (current-column) (length org-columns-current-fmt-compiled)) - (backward-char 1))))) - -(defun org-columns-edit-attributes () - "Edit the attributes of the current column." - (interactive) - (let* ((n (current-column)) - (info (nth n org-columns-current-fmt-compiled))) - (apply 'org-columns-new info))) - -(defun org-columns-widen (arg) - "Make the column wider by ARG characters." - (interactive "p") - (let* ((n (current-column)) - (entry (nth n org-columns-current-fmt-compiled)) - (width (or (nth 2 entry) - (cdr (assoc (car entry) org-columns-current-maxwidths))))) - (setq width (max 1 (+ width arg))) - (setcar (nthcdr 2 entry) width) - (org-columns-store-format) - (org-columns-redo))) - -(defun org-columns-narrow (arg) - "Make the column narrower by ARG characters." - (interactive "p") - (org-columns-widen (- arg))) - -(defun org-columns-move-right () - "Swap this column with the one to the right." - (interactive) - (let* ((n (current-column)) - (cell (nthcdr n org-columns-current-fmt-compiled)) - e) - (when (>= n (1- (length org-columns-current-fmt-compiled))) - (error "Cannot shift this column further to the right")) - (setq e (car cell)) - (setcar cell (car (cdr cell))) - (setcdr cell (cons e (cdr (cdr cell)))) - (org-columns-store-format) - (org-columns-redo) - (forward-char 1))) - -(defun org-columns-move-left () - "Swap this column with the one to the left." - (interactive) - (let* ((n (current-column))) - (when (= n 0) - (error "Cannot shift this column further to the left")) - (backward-char 1) - (org-columns-move-right) - (backward-char 1))) - -(defun org-columns-store-format () - "Store the text version of the current columns format in appropriate place. -This is either in the COLUMNS property of the node starting the current column -display, or in the #+COLUMNS line of the current buffer." - (let (fmt (cnt 0)) - (setq fmt (org-columns-uncompile-format org-columns-current-fmt-compiled)) - (org-set-local 'org-columns-current-fmt fmt) - (if (marker-position org-columns-top-level-marker) - (save-excursion - (goto-char org-columns-top-level-marker) - (if (and (org-at-heading-p) - (org-entry-get nil "COLUMNS")) - (org-entry-put nil "COLUMNS" fmt) - (goto-char (point-min)) - ;; Overwrite all #+COLUMNS lines.... - (while (re-search-forward "^#\\+COLUMNS:.*" nil t) - (setq cnt (1+ cnt)) - (replace-match (concat "#+COLUMNS: " fmt) t t)) - (unless (> cnt 0) - (goto-char (point-min)) - (or (org-at-heading-p t) (outline-next-heading)) - (let ((inhibit-read-only t)) - (insert-before-markers "#+COLUMNS: " fmt "\n"))) - (org-set-local 'org-columns-default-format fmt)))))) - -(defun org-columns-get-autowidth-alist (s cache) - "Derive the maximum column widths from the format and the cache." - (let ((start 0) rtn) - (while (string-match (org-re "%\\([[:alpha:]][[:alnum:]_-]*\\)") s start) - (push (cons (match-string 1 s) 1) rtn) - (setq start (match-end 0))) - (mapc (lambda (x) - (setcdr x (apply 'max - (mapcar - (lambda (y) - (length (or (cdr (assoc (car x) (cdr y))) " "))) - cache)))) - rtn) - rtn)) - -(defun org-columns-compute-all () - "Compute all columns that have operators defined." - (org-with-silent-modifications - (remove-text-properties (point-min) (point-max) '(org-summaries t))) - (let ((columns org-columns-current-fmt-compiled) - (org-columns-time (time-to-number-of-days (current-time))) - col) - (while (setq col (pop columns)) - (when (nth 3 col) - (save-excursion - (org-columns-compute (car col))))))) - -(defun org-columns-update (property) - "Recompute PROPERTY, and update the columns display for it." - (org-columns-compute property) - (let (fmt val pos) - (save-excursion - (mapc (lambda (ov) - (when (equal (overlay-get ov 'org-columns-key) property) - (setq pos (overlay-start ov)) - (goto-char pos) - (when (setq val (cdr (assoc property - (get-text-property - (point-at-bol) 'org-summaries)))) - (setq fmt (overlay-get ov 'org-columns-format)) - (overlay-put ov 'org-columns-value val) - (overlay-put ov 'display (format fmt val))))) - org-columns-overlays)))) - -(defvar org-inlinetask-min-level - (if (featurep 'org-inlinetask) org-inlinetask-min-level 15)) - -;;;###autoload -(defun org-columns-compute (property) - "Sum the values of property PROPERTY hierarchically, for the entire buffer." - (interactive) - (let* ((re org-outline-regexp-bol) - (lmax 30) ; Does anyone use deeper levels??? - (lvals (make-vector lmax nil)) - (lflag (make-vector lmax nil)) - (level 0) - (ass (assoc property org-columns-current-fmt-compiled)) - (format (nth 4 ass)) - (printf (nth 5 ass)) - (fun (nth 6 ass)) - (calc (or (nth 7 ass) 'identity)) - (beg org-columns-top-level-marker) - (inminlevel org-inlinetask-min-level) - (last-level org-inlinetask-min-level) - val valflag flag end sumpos sum-alist sum str str1 useval) - (save-excursion - ;; Find the region to compute - (goto-char beg) - (setq end (condition-case nil (org-end-of-subtree t) (error (point-max)))) - (goto-char end) - ;; Walk the tree from the back and do the computations - (while (re-search-backward re beg t) - (setq sumpos (match-beginning 0) - last-level (if (not (or (zerop level) (eq level inminlevel))) - level last-level) - level (org-outline-level) - val (org-entry-get nil property) - valflag (and val (string-match "\\S-" val))) - (cond - ((< level last-level) - ;; put the sum of lower levels here as a property - (setq sum (+ (if (and (/= last-level inminlevel) - (aref lvals last-level)) - (apply fun (aref lvals last-level)) 0) - (if (aref lvals inminlevel) - (apply fun (aref lvals inminlevel)) 0)) - flag (or (aref lflag last-level) ; any valid entries from children? - (aref lflag inminlevel)) ; or inline tasks? - str (org-columns-number-to-string sum format printf) - str1 (org-add-props (copy-sequence str) nil 'org-computed t 'face 'bold) - useval (if flag str1 (if valflag val "")) - sum-alist (get-text-property sumpos 'org-summaries)) - (if (assoc property sum-alist) - (setcdr (assoc property sum-alist) useval) - (push (cons property useval) sum-alist) - (org-with-silent-modifications - (add-text-properties sumpos (1+ sumpos) - (list 'org-summaries sum-alist)))) - (when (and val (not (equal val (if flag str val)))) - (org-entry-put nil property (if flag str val))) - ;; add current to current level accumulator - (when (or flag valflag) - (push (if flag - sum - (funcall calc (org-columns-string-to-number - (if flag str val) format))) - (aref lvals level)) - (aset lflag level t)) - ;; clear accumulators for deeper levels - (loop for l from (1+ level) to (1- lmax) do - (aset lvals l nil) - (aset lflag l nil))) - ((>= level last-level) - ;; add what we have here to the accumulator for this level - (when valflag - (push (funcall calc (org-columns-string-to-number val format)) - (aref lvals level)) - (aset lflag level t))) - (t (error "This should not happen"))))))) - -(defun org-columns-redo () - "Construct the column display again." - (interactive) - (message "Recomputing columns...") - (let ((line (org-current-line)) - (col (current-column))) - (save-excursion - (if (marker-position org-columns-begin-marker) - (goto-char org-columns-begin-marker)) - (org-columns-remove-overlays) - (if (derived-mode-p 'org-mode) - (call-interactively 'org-columns) - (org-agenda-redo) - (call-interactively 'org-agenda-columns))) - (org-goto-line line) - (move-to-column col)) - (message "Recomputing columns...done")) - -(defun org-columns-not-in-agenda () - (if (eq major-mode 'org-agenda-mode) - (error "This command is only allowed in Org-mode buffers"))) - -(defun org-string-to-number (s) - "Convert string to number, and interpret hh:mm:ss." - (if (not (string-match ":" s)) - (string-to-number s) - (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) - (while l - (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) - sum))) - -;;;###autoload -(defun org-columns-number-to-string (n fmt &optional printf) - "Convert a computed column number to a string value, according to FMT." - (cond - ((memq fmt '(estimate)) (org-estimate-print n printf)) - ((not (numberp n)) "") - ((memq fmt '(add_times max_times min_times mean_times)) - (org-hours-to-clocksum-string n)) - ((eq fmt 'checkbox) - (cond ((= n (floor n)) "[X]") - ((> n 1.) "[-]") - (t "[ ]"))) - ((memq fmt '(checkbox-n-of-m checkbox-percent)) - (let* ((n1 (floor n)) (n2 (floor (+ .5 (* 1000000 (- n n1)))))) - (org-nofm-to-completion n1 (+ n2 n1) (eq fmt 'checkbox-percent)))) - (printf (format printf n)) - ((eq fmt 'currency) - (format "%.2f" n)) - ((memq fmt '(min_age max_age mean_age)) - (org-format-time-period n)) - (t (number-to-string n)))) - -(defun org-nofm-to-completion (n m &optional percent) - (if (not percent) - (format "[%d/%d]" n m) - (format "[%d%%]"(floor (+ 0.5 (* 100. (/ (* 1.0 n) m))))))) - - -(defun org-columns-string-to-number (s fmt) - "Convert a column value to a number that can be used for column computing." - (if s - (cond - ((memq fmt '(min_age max_age mean_age)) - (cond ((string= s "") org-columns-time) - ((string-match - "\\([0-9]+\\)d \\([0-9]+\\)h \\([0-9]+\\)m \\([0-9]+\\)s" - s) - (+ (* 60 (+ (* 60 (+ (* 24 (string-to-number (match-string 1 s))) - (string-to-number (match-string 2 s)))) - (string-to-number (match-string 3 s)))) - (string-to-number (match-string 4 s)))) - (t (time-to-number-of-days (apply 'encode-time - (org-parse-time-string s t)))))) - ((string-match ":" s) - (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) - (while l - (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) - sum)) - ((string-match (concat "\\([0-9.]+\\) *\\(" - (regexp-opt (mapcar 'car org-effort-durations)) - "\\)") s) - (setq s (concat "0:" (org-duration-string-to-minutes s t))) - (let ((l (nreverse (org-split-string s ":"))) (sum 0.0)) - (while l - (setq sum (+ (string-to-number (pop l)) (/ sum 60)))) - sum)) - ((memq fmt '(checkbox checkbox-n-of-m checkbox-percent)) - (if (equal s "[X]") 1. 0.000001)) - ((memq fmt '(estimate)) (org-string-to-estimate s)) - (t (string-to-number s))))) - -(defun org-columns-uncompile-format (cfmt) - "Turn the compiled columns format back into a string representation." - (let ((rtn "") e s prop title op op-match width fmt printf fun calc) - (while (setq e (pop cfmt)) - (setq prop (car e) - title (nth 1 e) - width (nth 2 e) - op (nth 3 e) - fmt (nth 4 e) - printf (nth 5 e) - fun (nth 6 e) - calc (nth 7 e)) - (when (setq op-match (rassoc (list fmt fun calc) org-columns-compile-map)) - (setq op (car op-match))) - (if (and op printf) (setq op (concat op ";" printf))) - (if (equal title prop) (setq title nil)) - (setq s (concat "%" (if width (number-to-string width)) - prop - (if title (concat "(" title ")")) - (if op (concat "{" op "}")))) - (setq rtn (concat rtn " " s))) - (org-trim rtn))) - -(defun org-columns-compile-format (fmt) - "Turn a column format string into an alist of specifications. -The alist has one entry for each column in the format. The elements of -that list are: -property the property -title the title field for the columns -width the column width in characters, can be nil for automatic -operator the operator if any -format the output format for computed results, derived from operator -printf a printf format for computed values -fun the lisp function to compute summary values, derived from operator -calc function to get values from base elements" - (let ((start 0) width prop title op op-match f printf fun calc) - (setq org-columns-current-fmt-compiled nil) - (while (string-match - (org-re "%\\([0-9]+\\)?\\([[:alnum:]_-]+\\)\\(?:(\\([^)]+\\))\\)?\\(?:{\\([^}]+\\)}\\)?\\s-*") - fmt start) - (setq start (match-end 0) - width (match-string 1 fmt) - prop (match-string 2 fmt) - title (or (match-string 3 fmt) prop) - op (match-string 4 fmt) - f nil - printf nil - fun '+ - calc nil) - (if width (setq width (string-to-number width))) - (when (and op (string-match ";" op)) - (setq printf (substring op (match-end 0)) - op (substring op 0 (match-beginning 0)))) - (when (setq op-match (assoc op org-columns-compile-map)) - (setq f (cadr op-match) - fun (caddr op-match) - calc (cadddr op-match))) - (push (list prop title width op f printf fun calc) - org-columns-current-fmt-compiled)) - (setq org-columns-current-fmt-compiled - (nreverse org-columns-current-fmt-compiled)))) - - -;;; Dynamic block for Column view - -(defvar org-heading-regexp) ; defined in org.el -(defvar org-heading-keyword-regexp-format) ; defined in org.el -(defun org-columns-capture-view (&optional maxlevel skip-empty-rows) - "Get the column view of the current buffer or subtree. -The first optional argument MAXLEVEL sets the level limit. A -second optional argument SKIP-EMPTY-ROWS tells whether to skip -empty rows, an empty row being one where all the column view -specifiers except ITEM are empty. This function returns a list -containing the title row and all other rows. Each row is a list -of fields." - (save-excursion - (let* ((title (mapcar 'cadr org-columns-current-fmt-compiled)) - (re-comment (format org-heading-keyword-regexp-format - org-comment-string)) - (re-archive (concat ".*:" org-archive-tag ":")) - (n (length title)) row tbl) - (goto-char (point-min)) - (while (re-search-forward org-heading-regexp nil t) - (catch 'next - (when (and (or (null maxlevel) - (>= maxlevel - (if org-odd-levels-only - (/ (1+ (length (match-string 1))) 2) - (length (match-string 1))))) - (get-char-property (match-beginning 0) 'org-columns-key)) - (when (save-excursion - (goto-char (point-at-bol)) - (or (looking-at re-comment) - (looking-at re-archive))) - (org-end-of-subtree t) - (throw 'next t)) - (setq row nil) - (loop for i from 0 to (1- n) do - (push - (org-quote-vert - (or (get-char-property (+ (match-beginning 0) i) 'org-columns-value-modified) - (get-char-property (+ (match-beginning 0) i) 'org-columns-value) - "")) - row)) - (setq row (nreverse row)) - (unless (and skip-empty-rows - (eq 1 (length (delete "" (delete-dups (copy-sequence row)))))) - (push row tbl))))) - (append (list title 'hline) (nreverse tbl))))) - -;;;###autoload -(defun org-dblock-write:columnview (params) - "Write the column view table. -PARAMS is a property list of parameters: - -:width enforce same column widths with specifiers. -:id the :ID: property of the entry where the columns view - should be built. When the symbol `local', call locally. - When `global' call column view with the cursor at the beginning - of the buffer (usually this means that the whole buffer switches - to column view). When \"file:path/to/file.org\", invoke column - view at the start of that file. Otherwise, the ID is located - using `org-id-find'. -:hlines When t, insert a hline before each item. When a number, insert - a hline before each level <= that number. -:vlines When t, make each column a colgroup to enforce vertical lines. -:maxlevel When set to a number, don't capture headlines below this level. -:skip-empty-rows - When t, skip rows where all specifiers other than ITEM are empty. -:format When non-nil, specify the column view format to use." - (let ((pos (point-marker)) - (hlines (plist-get params :hlines)) - (vlines (plist-get params :vlines)) - (maxlevel (plist-get params :maxlevel)) - (content-lines (org-split-string (plist-get params :content) "\n")) - (skip-empty-rows (plist-get params :skip-empty-rows)) - (columns-fmt (plist-get params :format)) - (case-fold-search t) - tbl id idpos nfields tmp recalc line - id-as-string view-file view-pos) - (when (setq id (plist-get params :id)) - (setq id-as-string (cond ((numberp id) (number-to-string id)) - ((symbolp id) (symbol-name id)) - ((stringp id) id) - (t ""))) - (cond ((not id) nil) - ((eq id 'global) (setq view-pos (point-min))) - ((eq id 'local)) - ((string-match "^file:\\(.*\\)" id-as-string) - (setq view-file (match-string 1 id-as-string) - view-pos 1) - (unless (file-exists-p view-file) - (error "No such file: \"%s\"" id-as-string))) - ((setq idpos (org-find-entry-with-id id)) - (setq view-pos idpos)) - ((setq idpos (org-id-find id)) - (setq view-file (car idpos)) - (setq view-pos (cdr idpos))) - (t (error "Cannot find entry with :ID: %s" id)))) - (with-current-buffer (if view-file - (get-file-buffer view-file) - (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char (or view-pos (point))) - (org-columns columns-fmt) - (setq tbl (org-columns-capture-view maxlevel skip-empty-rows)) - (setq nfields (length (car tbl))) - (org-columns-quit)))) - (goto-char pos) - (move-marker pos nil) - (when tbl - (when (plist-get params :hlines) - (setq tmp nil) - (while tbl - (if (eq (car tbl) 'hline) - (push (pop tbl) tmp) - (if (string-match "\\` *\\(\\*+\\)" (caar tbl)) - (if (and (not (eq (car tmp) 'hline)) - (or (eq hlines t) - (and (numberp hlines) - (<= (- (match-end 1) (match-beginning 1)) - hlines)))) - (push 'hline tmp))) - (push (pop tbl) tmp))) - (setq tbl (nreverse tmp))) - (when vlines - (setq tbl (mapcar (lambda (x) - (if (eq 'hline x) x (cons "" x))) - tbl)) - (setq tbl (append tbl (list (cons "/" (make-list nfields "<>")))))) - (when content-lines - (while (string-match "^#" (car content-lines)) - (insert (pop content-lines) "\n"))) - (setq pos (point)) - (insert (org-listtable-to-string tbl)) - (when (plist-get params :width) - (insert "\n|" (mapconcat (lambda (x) (format "<%d>" (max 3 x))) - org-columns-current-widths "|"))) - (while (setq line (pop content-lines)) - (when (string-match "^#" line) - (insert "\n" line) - (when (string-match "^[ \t]*#\\+tblfm" line) - (setq recalc t)))) - (if recalc - (progn (goto-char pos) (org-table-recalculate 'all)) - (goto-char pos) - (org-table-align))))) - -(defun org-listtable-to-string (tbl) - "Convert a listtable TBL to a string that contains the Org-mode table. -The table still need to be aligned. The resulting string has no leading -and tailing newline characters." - (mapconcat - (lambda (x) - (cond - ((listp x) - (concat "|" (mapconcat 'identity x "|") "|")) - ((eq x 'hline) "|-|") - (t (error "Garbage in listtable: %s" x)))) - tbl "\n")) - -;;;###autoload -(defun org-insert-columns-dblock () - "Create a dynamic block capturing a column view table." - (interactive) - (let ((defaults '(:name "columnview" :hlines 1)) - (id (org-icompleting-read - "Capture columns (local, global, entry with :ID: property) [local]: " - (append '(("global") ("local")) - (mapcar 'list (org-property-values "ID")))))) - (if (equal id "") (setq id 'local)) - (if (equal id "global") (setq id 'global)) - (setq defaults (append defaults (list :id id))) - (org-create-dblock defaults) - (org-update-dblock))) - -;;; Column view in the agenda - -(defvar org-agenda-view-columns-initially nil - "When set, switch to columns view immediately after creating the agenda.") - -(defvar org-agenda-columns-show-summaries) ; defined in org-agenda.el -(defvar org-agenda-columns-compute-summary-properties); defined in org-agenda.el -(defvar org-agenda-columns-add-appointments-to-effort-sum); as well - -;;;###autoload -(defun org-agenda-columns () - "Turn on or update column view in the agenda." - (interactive) - (org-verify-version 'columns) - (org-columns-remove-overlays) - (move-marker org-columns-begin-marker (point)) - (let ((org-columns-time (time-to-number-of-days (current-time))) - cache maxwidths m p a d fmt) - (cond - ((and (boundp 'org-agenda-overriding-columns-format) - org-agenda-overriding-columns-format) - (setq fmt org-agenda-overriding-columns-format)) - ((setq m (org-get-at-bol 'org-hd-marker)) - (setq fmt (or (org-entry-get m "COLUMNS" t) - (with-current-buffer (marker-buffer m) - org-columns-default-format)))) - ((and (boundp 'org-columns-current-fmt) - (local-variable-p 'org-columns-current-fmt) - org-columns-current-fmt) - (setq fmt org-columns-current-fmt)) - ((setq m (next-single-property-change (point-min) 'org-hd-marker)) - (setq m (get-text-property m 'org-hd-marker)) - (setq fmt (or (org-entry-get m "COLUMNS" t) - (with-current-buffer (marker-buffer m) - org-columns-default-format))))) - (setq fmt (or fmt org-columns-default-format)) - (org-set-local 'org-columns-current-fmt fmt) - (org-columns-compile-format fmt) - (when org-agenda-columns-compute-summary-properties - (org-agenda-colview-compute org-columns-current-fmt-compiled)) - (save-excursion - ;; Get and cache the properties - (goto-char (point-min)) - (while (not (eobp)) - (when (setq m (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker))) - (setq p (org-entry-properties m)) - - (when (or (not (setq a (assoc org-effort-property p))) - (not (string-match "\\S-" (or (cdr a) "")))) - ;; OK, the property is not defined. Use appointment duration? - (when (and org-agenda-columns-add-appointments-to-effort-sum - (setq d (get-text-property (point) 'duration))) - (setq d (org-minutes-to-clocksum-string d)) - (put-text-property 0 (length d) 'face 'org-warning d) - (push (cons org-effort-property d) p))) - (push (cons (org-current-line) p) cache)) - (beginning-of-line 2)) - (when cache - (setq maxwidths (org-columns-get-autowidth-alist fmt cache)) - (org-set-local 'org-columns-current-maxwidths maxwidths) - (org-columns-display-here-title) - (when (org-set-local 'org-columns-flyspell-was-active - (org-bound-and-true-p flyspell-mode)) - (flyspell-mode 0)) - (mapc (lambda (x) - (org-goto-line (car x)) - (org-columns-display-here (cdr x))) - cache) - (when org-agenda-columns-show-summaries - (org-agenda-colview-summarize cache)))))) - -(defun org-agenda-colview-summarize (cache) - "Summarize the summarizable columns in column view in the agenda. -This will add overlays to the date lines, to show the summary for each day." - (let* ((fmt (mapcar (lambda (x) - (if (string-match "CLOCKSUM.*" (car x)) - (list (match-string 0 (car x)) - (nth 1 x) (nth 2 x) ":" 'add_times - nil '+ nil) - x)) - org-columns-current-fmt-compiled)) - line c c1 stype calc sumfunc props lsum entries prop v title) - (catch 'exit - (when (delq nil (mapcar 'cadr fmt)) - ;; OK, at least one summation column, it makes sense to try this - (goto-char (point-max)) - (while t - (when (or (get-text-property (point) 'org-date-line) - (eq (get-text-property (point) 'face) - 'org-agenda-structure)) - ;; OK, this is a date line that should be used - (setq line (org-current-line)) - (setq entries nil c cache cache nil) - (while (setq c1 (pop c)) - (if (> (car c1) line) - (push c1 entries) - (push c1 cache))) - ;; now ENTRIES are the ones we want to use, CACHE is the rest - ;; Compute the summaries for the properties we want, - ;; set nil properties for the rest. - (when (setq entries (mapcar 'cdr entries)) - (setq props - (mapcar - (lambda (f) - (setq prop (car f) - title (nth 1 f) - stype (nth 4 f) - sumfunc (nth 6 f) - calc (or (nth 7 f) 'identity)) - (cond - ((equal prop "ITEM") - (cons prop (buffer-substring (point-at-bol) - (point-at-eol)))) - ((not stype) (cons prop "")) - (t ;; do the summary - (setq lsum nil) - (dolist (x entries) - (setq v (cdr (assoc prop x))) - (if v - (push - (funcall - (if (not (get-text-property 0 'org-computed v)) - calc - 'identity) - (org-columns-string-to-number - v stype)) - lsum))) - (setq lsum (remove nil lsum)) - (setq lsum - (cond ((> (length lsum) 1) - (org-columns-number-to-string - (apply sumfunc lsum) stype)) - ((eq (length lsum) 1) - (org-columns-number-to-string - (car lsum) stype)) - (t ""))) - (put-text-property 0 (length lsum) 'face 'bold lsum) - (unless (eq calc 'identity) - (put-text-property 0 (length lsum) 'org-computed t lsum)) - (cons prop lsum)))) - fmt)) - (org-columns-display-here props 'dateline) - (org-set-local 'org-agenda-columns-active t))) - (if (bobp) (throw 'exit t)) - (beginning-of-line 0)))))) - -(defun org-agenda-colview-compute (fmt) - "Compute the relevant columns in the contributing source buffers." - (let ((files org-agenda-contributing-files) - (org-columns-begin-marker (make-marker)) - (org-columns-top-level-marker (make-marker)) - f fm a b) - (while (setq f (pop files)) - (setq b (find-buffer-visiting f)) - (with-current-buffer (or (buffer-base-buffer b) b) - (save-excursion - (save-restriction - (widen) - (org-with-silent-modifications - (remove-text-properties (point-min) (point-max) '(org-summaries t))) - (goto-char (point-min)) - (org-columns-get-format-and-top-level) - (while (setq fm (pop fmt)) - (cond ((equal (car fm) "CLOCKSUM") - (org-clock-sum)) - ((equal (car fm) "CLOCKSUM_T") - (org-clock-sum-today)) - ((and (nth 4 fm) - (setq a (assoc (car fm) - org-columns-current-fmt-compiled)) - (equal (nth 4 a) (nth 4 fm))) - (org-columns-compute (car fm))))))))))) - -(defun org-format-time-period (interval) - "Convert time in fractional days to days/hours/minutes/seconds." - (if (numberp interval) - (let* ((days (floor interval)) - (frac-hours (* 24 (- interval days))) - (hours (floor frac-hours)) - (minutes (floor (* 60 (- frac-hours hours)))) - (seconds (floor (* 60 (- (* 60 (- frac-hours hours)) minutes))))) - (format "%dd %02dh %02dm %02ds" days hours minutes seconds)) - "")) - -(defun org-estimate-mean-and-var (v) - "Return the mean and variance of an estimate." - (let* ((low (float (car v))) - (high (float (cadr v))) - (mean (/ (+ low high) 2.0)) - (var (/ (+ (expt (- mean low) 2.0) (expt (- high mean) 2.0)) 2.0))) - (list mean var))) - -(defun org-estimate-combine (&rest el) - "Combine a list of estimates, using mean and variance. -The mean and variance of the result will be the sum of the means -and variances (respectively) of the individual estimates." - (let ((mean 0) - (var 0)) - (mapc (lambda (e) - (let ((stats (org-estimate-mean-and-var e))) - (setq mean (+ mean (car stats))) - (setq var (+ var (cadr stats))))) - el) - (let ((stdev (sqrt var))) - (list (- mean stdev) (+ mean stdev))))) - -(defun org-estimate-print (e &optional fmt) - "Prepare a string representation of an estimate. -This formats these numbers as two numbers with a \"-\" between them." - (if (null fmt) (set 'fmt "%.0f")) - (format "%s" (mapconcat (lambda (n) (format fmt n)) e "-"))) - -(defun org-string-to-estimate (s) - "Convert a string to an estimate. -The string should be two numbers joined with a \"-\"." - (if (string-match "\\(.*\\)-\\(.*\\)" s) - (list (string-to-number (match-string 1 s)) - (string-to-number(match-string 2 s))) - (list (string-to-number s) (string-to-number s)))) - -(provide 'org-colview) - -;;; org-colview.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-compat.el b/xemacs-packages/lisp/org-8.2.3c/org-compat.el deleted file mode 100644 index b714f13a..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-compat.el +++ /dev/null @@ -1,548 +0,0 @@ -;;; org-compat.el --- Compatibility code for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file contains code needed for compatibility with XEmacs and older -;; versions of GNU Emacs. - -;;; Code: - -(eval-when-compile - (require 'cl)) - -(require 'org-macs) - -(declare-function w32-focus-frame "term/w32-win" (frame)) - -;; The following constant is for backward compatibility. We do not use -;; it in org-mode, because the Byte compiler evaluates (featurep 'xemacs) -;; at compilation time and can therefore optimize code better. -(defconst org-xemacs-p (featurep 'xemacs)) -(defconst org-format-transports-properties-p - (let ((x "a")) - (add-text-properties 0 1 '(test t) x) - (get-text-property 0 'test (format "%s" x))) - "Does format transport text properties?") - -(defun org-compatible-face (inherits specs) - "Make a compatible face specification. -If INHERITS is an existing face and if the Emacs version supports it, -just inherit the face. If INHERITS is set and the Emacs version does -not support it, copy the face specification from the inheritance face. -If INHERITS is not given and SPECS is, use SPECS to define the face. -XEmacs and Emacs 21 do not know about the `min-colors' attribute. -For them we convert a (min-colors 8) entry to a `tty' entry and move it -to the top of the list. The `min-colors' attribute will be removed from -any other entries, and any resulting duplicates will be removed entirely." - (when (and inherits (facep inherits) (not specs)) - (setq specs (or specs - (get inherits 'saved-face) - (get inherits 'face-defface-spec)))) - (cond - ((and inherits (facep inherits) - (not (featurep 'xemacs)) - (>= emacs-major-version 22) - ;; do not inherit outline faces before Emacs 23 - (or (>= emacs-major-version 23) - (not (string-match "\\`outline-[0-9]+" - (symbol-name inherits))))) - (list (list t :inherit inherits))) - ((or (featurep 'xemacs) (< emacs-major-version 22)) - ;; These do not understand the `min-colors' attribute. - (let (r e a) - (while (setq e (pop specs)) - (cond - ((memq (car e) '(t default)) (push e r)) - ((setq a (member '(min-colors 8) (car e))) - (nconc r (list (cons (cons '(type tty) (delq (car a) (car e))) - (cdr e))))) - ((setq a (assq 'min-colors (car e))) - (setq e (cons (delq a (car e)) (cdr e))) - (or (assoc (car e) r) (push e r))) - (t (or (assoc (car e) r) (push e r))))) - (nreverse r))) - (t specs))) -(put 'org-compatible-face 'lisp-indent-function 1) - -(defun org-version-check (version feature level) - (let* ((v1 (mapcar 'string-to-number (split-string version "[.]"))) - (v2 (mapcar 'string-to-number (split-string emacs-version "[.]"))) - (rmaj (or (nth 0 v1) 99)) - (rmin (or (nth 1 v1) 99)) - (rbld (or (nth 2 v1) 99)) - (maj (or (nth 0 v2) 0)) - (min (or (nth 1 v2) 0)) - (bld (or (nth 2 v2) 0))) - (if (or (< maj rmaj) - (and (= maj rmaj) - (< min rmin)) - (and (= maj rmaj) - (= min rmin) - (< bld rbld))) - (if (eq level :predicate) - ;; just return if we have the version - nil - (let ((msg (format "Emacs %s or greater is recommended for %s" - version feature))) - (display-warning 'org msg level) - t)) - t))) - - -;;;; Emacs/XEmacs compatibility - -(eval-and-compile - (defun org-defvaralias (new-alias base-variable &optional docstring) - "Compatibility function for defvaralias. -Don't do the aliasing when `defvaralias' is not bound." - (declare (indent 1)) - (when (fboundp 'defvaralias) - (defvaralias new-alias base-variable docstring))) - - (when (and (not (boundp 'user-emacs-directory)) - (boundp 'user-init-directory)) - (org-defvaralias 'user-emacs-directory 'user-init-directory))) - -(when (featurep 'xemacs) - (defadvice custom-handle-keyword - (around org-custom-handle-keyword - activate preactivate) - "Remove custom keywords not recognized to avoid producing an error." - (cond - ((eq (ad-get-arg 1) :package-version)) - (t ad-do-it))) - (defadvice define-obsolete-variable-alias - (around org-define-obsolete-variable-alias - (obsolete-name current-name &optional when docstring) - activate preactivate) - "Declare arguments defined in later versions of Emacs." - ad-do-it) - (defadvice define-obsolete-function-alias - (around org-define-obsolete-function-alias - (obsolete-name current-name &optional when docstring) - activate preactivate) - "Declare arguments defined in later versions of Emacs." - ad-do-it) - (defvar customize-package-emacs-version-alist nil) - (defvar temporary-file-directory (temp-directory))) - -;; Keys -(defconst org-xemacs-key-equivalents - '(([mouse-1] . [button1]) - ([mouse-2] . [button2]) - ([mouse-3] . [button3]) - ([C-mouse-4] . [(control mouse-4)]) - ([C-mouse-5] . [(control mouse-5)])) - "Translation alist for a couple of keys.") - -;; Overlay compatibility functions -(defun org-detach-overlay (ovl) - (if (featurep 'xemacs) (detach-extent ovl) (delete-overlay ovl))) -(defun org-overlay-display (ovl text &optional face evap) - "Make overlay OVL display TEXT with face FACE." - (if (featurep 'xemacs) - (let ((gl (make-glyph text))) - (and face (set-glyph-face gl face)) - (set-extent-property ovl 'invisible t) - (set-extent-property ovl 'end-glyph gl)) - (overlay-put ovl 'display text) - (if face (overlay-put ovl 'face face)) - (if evap (overlay-put ovl 'evaporate t)))) -(defun org-overlay-before-string (ovl text &optional face evap) - "Make overlay OVL display TEXT with face FACE." - (if (featurep 'xemacs) - (let ((gl (make-glyph text))) - (and face (set-glyph-face gl face)) - (set-extent-property ovl 'begin-glyph gl)) - (if face (org-add-props text nil 'face face)) - (overlay-put ovl 'before-string text) - (if evap (overlay-put ovl 'evaporate t)))) -(defun org-find-overlays (prop &optional pos delete) - "Find all overlays specifying PROP at POS or point. -If DELETE is non-nil, delete all those overlays." - (let ((overlays (overlays-at (or pos (point)))) - ov found) - (while (setq ov (pop overlays)) - (if (overlay-get ov prop) - (if delete (delete-overlay ov) (push ov found)))) - found)) - -(defun org-get-x-clipboard (value) - "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21." - (if (eq window-system 'x) - (let ((x (org-get-x-clipboard-compat value))) - (if x (org-no-properties x))))) - -(defsubst org-decompose-region (beg end) - "Decompose from BEG to END." - (if (featurep 'xemacs) - (let ((modified-p (buffer-modified-p)) - (buffer-read-only nil)) - (remove-text-properties beg end '(composition nil)) - (set-buffer-modified-p modified-p)) - (decompose-region beg end))) - -;; Miscellaneous functions - -(defun org-add-hook (hook function &optional append local) - "Add-hook, compatible with both Emacsen." - (if (and local (featurep 'xemacs)) - (add-local-hook hook function append) - (add-hook hook function append local))) - -(defun org-add-props (string plist &rest props) - "Add text properties to entire string, from beginning to end. -PLIST may be a list of properties, PROPS are individual properties and values -that will be added to PLIST. Returns the string that was modified." - (add-text-properties - 0 (length string) (if props (append plist props) plist) string) - string) -(put 'org-add-props 'lisp-indent-function 2) - -(defun org-fit-window-to-buffer (&optional window max-height min-height - shrink-only) - "Fit WINDOW to the buffer, but only if it is not a side-by-side window. -WINDOW defaults to the selected window. MAX-HEIGHT and MIN-HEIGHT are -passed through to `fit-window-to-buffer'. If SHRINK-ONLY is set, call -`shrink-window-if-larger-than-buffer' instead, the height limit is -ignored in this case." - (cond ((if (fboundp 'window-full-width-p) - (not (window-full-width-p window)) - ;; do nothing if another window would suffer - (> (frame-width) (window-width window)))) - ((and (fboundp 'fit-window-to-buffer) (not shrink-only)) - (fit-window-to-buffer window max-height min-height)) - ((fboundp 'shrink-window-if-larger-than-buffer) - (shrink-window-if-larger-than-buffer window))) - (or window (selected-window))) - -(defun org-number-sequence (from &optional to inc) - "Call `number-sequence or emulate it." - (if (fboundp 'number-sequence) - (number-sequence from to inc) - (if (or (not to) (= from to)) - (list from) - (or inc (setq inc 1)) - (when (zerop inc) (error "The increment can not be zero")) - (let (seq (n 0) (next from)) - (if (> inc 0) - (while (<= next to) - (setq seq (cons next seq) - n (1+ n) - next (+ from (* n inc)))) - (while (>= next to) - (setq seq (cons next seq) - n (1+ n) - next (+ from (* n inc))))) - (nreverse seq))))) - -;; Region compatibility - -(defvar org-ignore-region nil - "Non-nil means temporarily disable the active region.") - -(defun org-region-active-p () - "Is `transient-mark-mode' on and the region active? -Works on both Emacs and XEmacs." - (if org-ignore-region - nil - (if (featurep 'xemacs) - (and zmacs-regions (region-active-p)) - (if (fboundp 'use-region-p) - (use-region-p) - (and transient-mark-mode mark-active))))) ; Emacs 22 and before - -(defun org-cursor-to-region-beginning () - (when (and (org-region-active-p) - (> (point) (region-beginning))) - (exchange-point-and-mark))) - -;; Emacs 22 misses `activate-mark' -(if (fboundp 'activate-mark) - (defalias 'org-activate-mark 'activate-mark) - (defun org-activate-mark () - (when (mark t) - (setq mark-active t) - (when (and (boundp 'transient-mark-mode) - (not transient-mark-mode)) - (setq transient-mark-mode 'lambda)) - (when (boundp 'zmacs-regions) - (setq zmacs-regions t))))) - -;; Invisibility compatibility - -(defun org-remove-from-invisibility-spec (arg) - "Remove elements from `buffer-invisibility-spec'." - (if (fboundp 'remove-from-invisibility-spec) - (remove-from-invisibility-spec arg) - (if (consp buffer-invisibility-spec) - (setq buffer-invisibility-spec - (delete arg buffer-invisibility-spec))))) - -(defun org-in-invisibility-spec-p (arg) - "Is ARG a member of `buffer-invisibility-spec'?" - (if (consp buffer-invisibility-spec) - (member arg buffer-invisibility-spec) - nil)) - -(defmacro org-xemacs-without-invisibility (&rest body) - "Turn off extents with invisibility while executing BODY." - `(let ((ext-inv (extent-list nil (point-at-bol) (point-at-eol) - 'all-extents-closed-open 'invisible)) - ext-inv-specs) - (dolist (ext ext-inv) - (when (extent-property ext 'invisible) - (add-to-list 'ext-inv-specs (list ext (extent-property - ext 'invisible))) - (set-extent-property ext 'invisible nil))) - ,@body - (dolist (ext-inv-spec ext-inv-specs) - (set-extent-property (car ext-inv-spec) 'invisible - (cadr ext-inv-spec))))) -(def-edebug-spec org-xemacs-without-invisibility (body)) - -(defun org-indent-to-column (column &optional minimum buffer) - "Work around a bug with extents with invisibility in XEmacs." - (if (featurep 'xemacs) - (org-xemacs-without-invisibility (indent-to-column column minimum buffer)) - (indent-to-column column minimum))) - -(defun org-indent-line-to (column) - "Work around a bug with extents with invisibility in XEmacs." - (if (featurep 'xemacs) - (org-xemacs-without-invisibility (indent-line-to column)) - (indent-line-to column))) - -(defun org-move-to-column (column &optional force buffer ignore-invisible) - (let ((buffer-invisibility-spec ignore-invisible)) - (if (featurep 'xemacs) - (org-xemacs-without-invisibility (move-to-column column force buffer)) - (move-to-column column force)))) - -(defun org-get-x-clipboard-compat (value) - "Get the clipboard value on XEmacs or Emacs 21." - (cond ((featurep 'xemacs) - (org-no-warnings (get-selection-no-error value))) - ((fboundp 'x-get-selection) - (condition-case nil - (or (x-get-selection value 'UTF8_STRING) - (x-get-selection value 'COMPOUND_TEXT) - (x-get-selection value 'STRING) - (x-get-selection value 'TEXT)) - (error nil))))) - -(defun org-propertize (string &rest properties) - (if (featurep 'xemacs) - (progn - (add-text-properties 0 (length string) properties string) - string) - (apply 'propertize string properties))) - -(defmacro org-find-library-dir (library) - `(file-name-directory (or (locate-library ,library) ""))) - -(defun org-count-lines (s) - "How many lines in string S?" - (let ((start 0) (n 1)) - (while (string-match "\n" s start) - (setq start (match-end 0) n (1+ n))) - (if (and (> (length s) 0) (= (aref s (1- (length s))) ?\n)) - (setq n (1- n))) - n)) - -(defun org-kill-new (string &rest args) - (remove-text-properties 0 (length string) '(line-prefix t wrap-prefix t) - string) - (apply 'kill-new string args)) - -(defun org-select-frame-set-input-focus (frame) - "Select FRAME, raise it, and set input focus, if possible." - (cond ((featurep 'xemacs) - (if (fboundp 'select-frame-set-input-focus) - (select-frame-set-input-focus frame) - (raise-frame frame) - (select-frame frame) - (focus-frame frame))) - ;; `select-frame-set-input-focus' defined in Emacs 21 will not - ;; set the input focus. - ((>= emacs-major-version 22) - (select-frame-set-input-focus frame)) - (t - (raise-frame frame) - (select-frame frame) - (cond ((memq window-system '(x ns mac)) - (x-focus-frame frame)) - ((eq window-system 'w32) - (w32-focus-frame frame))) - (when focus-follows-mouse - (set-mouse-position frame (1- (frame-width frame)) 0))))) - -(defun org-float-time (&optional time) - "Convert time value TIME to a floating point number. -TIME defaults to the current time." - (if (featurep 'xemacs) - (time-to-seconds (or time (current-time))) - (float-time time))) - -;; `user-error' is only available from 24.2.50 on -(unless (fboundp 'user-error) - (defalias 'user-error 'error)) - -(defmacro org-no-popups (&rest body) - "Suppress popup windows. -Let-bind some variables to nil around BODY to achieve the desired -effect, which variables to use depends on the Emacs version." - (if (org-version-check "24.2.50" "" :predicate) - `(let (pop-up-frames display-buffer-alist) - ,@body) - `(let (pop-up-frames special-display-buffer-names special-display-regexps special-display-function) - ,@body))) - -(if (fboundp 'string-match-p) - (defalias 'org-string-match-p 'string-match-p) - (defun org-string-match-p (regexp string &optional start) - (save-match-data - (funcall 'string-match regexp string start)))) - -(if (fboundp 'looking-at-p) - (defalias 'org-looking-at-p 'looking-at-p) - (defun org-looking-at-p (&rest args) - (save-match-data - (apply 'looking-at args)))) - -;; XEmacs does not have `looking-back'. -(if (fboundp 'looking-back) - (defalias 'org-looking-back 'looking-back) - (defun org-looking-back (regexp &optional limit greedy) - "Return non-nil if text before point matches regular expression REGEXP. -Like `looking-at' except matches before point, and is slower. -LIMIT if non-nil speeds up the search by specifying a minimum -starting position, to avoid checking matches that would start -before LIMIT. - -If GREEDY is non-nil, extend the match backwards as far as -possible, stopping when a single additional previous character -cannot be part of a match for REGEXP. When the match is -extended, its starting position is allowed to occur before -LIMIT." - (let ((start (point)) - (pos - (save-excursion - (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t) - (point))))) - (if (and greedy pos) - (save-restriction - (narrow-to-region (point-min) start) - (while (and (> pos (point-min)) - (save-excursion - (goto-char pos) - (backward-char 1) - (looking-at (concat "\\(?:" regexp "\\)\\'")))) - (setq pos (1- pos))) - (save-excursion - (goto-char pos) - (looking-at (concat "\\(?:" regexp "\\)\\'"))))) - (not (null pos))))) - -(defun org-floor* (x &optional y) - "Return a list of the floor of X and the fractional part of X. -With two arguments, return floor and remainder of their quotient." - (let ((q (floor x y))) - (list q (- x (if y (* y q) q))))) - -;; `pop-to-buffer-same-window' has been introduced in Emacs 24.1. -(defun org-pop-to-buffer-same-window - (&optional buffer-or-name norecord label) - "Pop to buffer specified by BUFFER-OR-NAME in the selected window." - (if (fboundp 'pop-to-buffer-same-window) - (funcall - 'pop-to-buffer-same-window buffer-or-name norecord) - (funcall 'switch-to-buffer buffer-or-name norecord))) - -;; RECURSIVE has been introduced with Emacs 23.2. -;; This is copying and adapted from `tramp-compat-delete-directory' -(defun org-delete-directory (directory &optional recursive) - "Compatibility function for `delete-directory'." - (if (null recursive) - (delete-directory directory) - (condition-case nil - (funcall 'delete-directory directory recursive) - ;; This Emacs version does not support the RECURSIVE flag. We - ;; use the implementation from Emacs 23.2. - (wrong-number-of-arguments - (setq directory (directory-file-name (expand-file-name directory))) - (if (not (file-symlink-p directory)) - (mapc (lambda (file) - (if (eq t (car (file-attributes file))) - (org-delete-directory file recursive) - (delete-file file))) - (directory-files - directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) - (delete-directory directory))))) - -;;;###autoload -(defmacro org-check-version () - "Try very hard to provide sensible version strings." - (let* ((org-dir (org-find-library-dir "org")) - (org-version.el (concat org-dir "org-version.el")) - (org-fixup.el (concat org-dir "../mk/org-fixup.el"))) - (if (require 'org-version org-version.el 'noerror) - '(progn - (autoload 'org-release "org-version.el") - (autoload 'org-git-version "org-version.el")) - (if (require 'org-fixup org-fixup.el 'noerror) - '(org-fixup) - ;; provide fallback definitions and complain - (warn "Could not define org version correctly. Check installation!") - '(progn - (defun org-release () "N/A") - (defun org-git-version () "N/A !!check installation!!")))))) - -(defun org-file-equal-p (f1 f2) - "Return t if files F1 and F2 are the same. -Implements `file-equal-p' for older emacsen and XEmacs." - (if (fboundp 'file-equal-p) - (file-equal-p f1 f2) - (let (f1-attr f2-attr) - (and (setq f1-attr (file-attributes (file-truename f1))) - (setq f2-attr (file-attributes (file-truename f2))) - (equal f1-attr f2-attr))))) - -;; `buffer-narrowed-p' is available for Emacs >=24.3 -(defun org-buffer-narrowed-p () - "Compatibility function for `buffer-narrowed-p'." - (if (fboundp 'buffer-narrowed-p) - (buffer-narrowed-p) - (/= (- (point-max) (point-min)) (buffer-size)))) - -(defmacro org-with-silent-modifications (&rest body) - (if (fboundp 'with-silent-modifications) - `(with-silent-modifications ,@body) - `(org-unmodified ,@body))) -(def-edebug-spec org-with-silent-modifications (body)) - -(provide 'org-compat) - -;;; org-compat.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-crypt.el b/xemacs-packages/lisp/org-8.2.3c/org-crypt.el deleted file mode 100644 index b02a7cef..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-crypt.el +++ /dev/null @@ -1,273 +0,0 @@ -;;; org-crypt.el --- Public key encryption for org-mode entries - -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. - -;; Emacs Lisp Archive Entry -;; Filename: org-crypt.el -;; Keywords: org-mode -;; Author: John Wiegley -;; Maintainer: Peter Jones -;; Description: Adds public key encryption to org-mode buffers -;; URL: http://www.newartisans.com/software/emacs.html -;; Compatibility: Emacs22 - -;; 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 . - -;;; Commentary: - -;; Right now this is just a set of functions to play with. It depends -;; on the epg library. Here's how you would use it: -;; -;; 1. To mark an entry for encryption, tag the heading with "crypt". -;; You can change the tag to any complex tag matching string by -;; setting the `org-crypt-tag-matcher' variable. -;; -;; 2. Set the encryption key to use in the `org-crypt-key' variable, -;; or use `M-x org-set-property' to set the property CRYPTKEY to -;; any address in your public keyring. The text of the entry (but -;; not its properties or headline) will be encrypted for this user. -;; For them to read it, the corresponding secret key must be -;; located in the secret key ring of the account where you try to -;; decrypt it. This makes it possible to leave secure notes that -;; only the intended recipient can read in a shared-org-mode-files -;; scenario. -;; If the key is not set, org-crypt will default to symmetric encryption. -;; -;; 3. To later decrypt an entry, use `org-decrypt-entries' or -;; `org-decrypt-entry'. It might be useful to bind this to a key, -;; like C-c C-/. I hope that in the future, C-c C-r can be might -;; overloaded to also decrypt an entry if it's encrypted, since -;; that fits nicely with the meaning of "reveal". -;; -;; 4. To automatically encrypt all necessary entries when saving a -;; file, call `org-crypt-use-before-save-magic' after loading -;; org-crypt.el. - -;;; Thanks: - -;; - Carsten Dominik -;; - Vitaly Ostanin - -(require 'org) - -;;; Code: - -(declare-function epg-decrypt-string "epg" (context cipher)) -(declare-function epg-list-keys "epg" (context &optional name mode)) -(declare-function epg-make-context "epg" - (&optional protocol armor textmode include-certs - cipher-algorithm digest-algorithm - compress-algorithm)) -(declare-function epg-encrypt-string "epg" - (context plain recipients &optional sign always-trust)) - -(defgroup org-crypt nil - "Org Crypt." - :tag "Org Crypt" - :group 'org) - -(defcustom org-crypt-tag-matcher "crypt" - "The tag matcher used to find headings whose contents should be encrypted. - -See the \"Match syntax\" section of the org manual for more details." - :type 'string - :group 'org-crypt) - -(defcustom org-crypt-key "" - "The default key to use when encrypting the contents of a heading. - -This setting can also be overridden in the CRYPTKEY property." - :type 'string - :group 'org-crypt) - -(defcustom org-crypt-disable-auto-save 'ask - "What org-decrypt should do if `auto-save-mode' is enabled. - -t : Disable auto-save-mode for the current buffer - prior to decrypting an entry. - -nil : Leave auto-save-mode enabled. - This may cause data to be written to disk unencrypted! - -'ask : Ask user whether or not to disable auto-save-mode - for the current buffer. - -'encrypt : Leave auto-save-mode enabled for the current buffer, - but automatically re-encrypt all decrypted entries - *before* auto-saving. - NOTE: This only works for entries which have a tag - that matches `org-crypt-tag-matcher'." - :group 'org-crypt - :version "24.1" - :type '(choice (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "Ask" ask) - (const :tag "Encrypt" encrypt))) - -(defun org-crypt-check-auto-save () - "Check whether auto-save-mode is enabled for the current buffer. - -`auto-save-mode' may cause leakage when decrypting entries, so -check whether it's enabled, and decide what to do about it. - -See `org-crypt-disable-auto-save'." - (when buffer-auto-save-file-name - (cond - ((or - (eq org-crypt-disable-auto-save t) - (and - (eq org-crypt-disable-auto-save 'ask) - (y-or-n-p "org-decrypt: auto-save-mode may cause leakage. Disable it for current buffer? "))) - (message (concat "org-decrypt: Disabling auto-save-mode for " (or (buffer-file-name) (current-buffer)))) - ; The argument to auto-save-mode has to be "-1", since - ; giving a "nil" argument toggles instead of disabling. - (auto-save-mode -1)) - ((eq org-crypt-disable-auto-save nil) - (message "org-decrypt: Decrypting entry with auto-save-mode enabled. This may cause leakage.")) - ((eq org-crypt-disable-auto-save 'encrypt) - (message "org-decrypt: Enabling re-encryption on auto-save.") - (org-add-hook 'auto-save-hook - (lambda () - (message "org-crypt: Re-encrypting all decrypted entries due to auto-save.") - (org-encrypt-entries)) - nil t)) - (t nil)))) - -(defun org-crypt-key-for-heading () - "Return the encryption key for the current heading." - (save-excursion - (org-back-to-heading t) - (or (org-entry-get nil "CRYPTKEY" 'selective) - org-crypt-key - (and (boundp 'epa-file-encrypt-to) epa-file-encrypt-to) - (message "No crypt key set, using symmetric encryption.")))) - -(defun org-encrypt-string (str crypt-key) - "Return STR encrypted with CRYPT-KEY." - ;; Text and key have to be identical, otherwise we re-crypt. - (if (and (string= crypt-key (get-text-property 0 'org-crypt-key str)) - (string= (sha1 str) (get-text-property 0 'org-crypt-checksum str))) - (get-text-property 0 'org-crypt-text str) - (let ((epg-context (epg-make-context nil t t))) - (epg-encrypt-string epg-context str (epg-list-keys epg-context crypt-key))))) - -(defun org-encrypt-entry () - "Encrypt the content of the current headline." - (interactive) - (require 'epg) - (save-excursion - (org-back-to-heading t) - (let ((start-heading (point))) - (forward-line) - (when (not (looking-at "-----BEGIN PGP MESSAGE-----")) - (let ((folded (outline-invisible-p)) - (epg-context (epg-make-context nil t t)) - (crypt-key (org-crypt-key-for-heading)) - (beg (point)) - end encrypted-text) - (goto-char start-heading) - (org-end-of-subtree t t) - (org-back-over-empty-lines) - (setq end (point) - encrypted-text - (org-encrypt-string (buffer-substring beg end) crypt-key)) - (delete-region beg end) - (insert encrypted-text) - (when folded - (goto-char start-heading) - (hide-subtree)) - nil))))) - -(defun org-decrypt-entry () - "Decrypt the content of the current headline." - (interactive) - (require 'epg) - (unless (org-before-first-heading-p) - (save-excursion - (org-back-to-heading t) - (let ((heading-point (point)) - (heading-was-invisible-p - (save-excursion - (outline-end-of-heading) - (outline-invisible-p)))) - (forward-line) - (when (looking-at "-----BEGIN PGP MESSAGE-----") - (org-crypt-check-auto-save) - (let* ((end (save-excursion - (search-forward "-----END PGP MESSAGE-----") - (forward-line) - (point))) - (epg-context (epg-make-context nil t t)) - (encrypted-text (buffer-substring-no-properties (point) end)) - (decrypted-text - (decode-coding-string - (epg-decrypt-string - epg-context - encrypted-text) - 'utf-8))) - ;; Delete region starting just before point, because the - ;; outline property starts at the \n of the heading. - (delete-region (1- (point)) end) - ;; Store a checksum of the decrypted and the encrypted - ;; text value. This allow to reuse the same encrypted text - ;; if the text does not change, and therefore avoid a - ;; re-encryption process. - (insert "\n" (propertize decrypted-text - 'org-crypt-checksum (sha1 decrypted-text) - 'org-crypt-key (org-crypt-key-for-heading) - 'org-crypt-text encrypted-text)) - (when heading-was-invisible-p - (goto-char heading-point) - (org-flag-subtree t)) - nil)))))) - -(defun org-encrypt-entries () - "Encrypt all top-level entries in the current buffer." - (interactive) - (let (todo-only) - (org-scan-tags - 'org-encrypt-entry - (cdr (org-make-tags-matcher org-crypt-tag-matcher)) - todo-only))) - -(defun org-decrypt-entries () - "Decrypt all entries in the current buffer." - (interactive) - (let (todo-only) - (org-scan-tags - 'org-decrypt-entry - (cdr (org-make-tags-matcher org-crypt-tag-matcher)) - todo-only))) - -(defun org-at-encrypted-entry-p () - "Is the current entry encrypted?" - (unless (org-before-first-heading-p) - (save-excursion - (org-back-to-heading t) - (search-forward "-----BEGIN PGP MESSAGE-----" - (save-excursion (outline-next-heading)) t)))) - -(defun org-crypt-use-before-save-magic () - "Add a hook to automatically encrypt entries before a file is saved to disk." - (add-hook - 'org-mode-hook - (lambda () (org-add-hook 'before-save-hook 'org-encrypt-entries nil t)))) - -(add-hook 'org-reveal-start-hook 'org-decrypt-entry) - -(provide 'org-crypt) - -;;; org-crypt.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-ctags.el b/xemacs-packages/lisp/org-8.2.3c/org-ctags.el deleted file mode 100644 index 9d8ed6c6..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-ctags.el +++ /dev/null @@ -1,541 +0,0 @@ -;;; org-ctags.el - Integrate Emacs "tags" facility with org mode. -;; -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. - -;; Author: Paul Sexton - - -;; Keywords: org, wp -;; -;; 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 . - -;; -;; Synopsis -;; ======== -;; -;; Allows org-mode to make use of the Emacs `etags' system. Defines tag -;; destinations in org-mode files as any text between <>. This allows the tags-generation program `exuberant ctags' to -;; parse these files and create tag tables that record where these -;; destinations are found. Plain [[links]] in org mode files which do not have -;; <> within the same file will then be interpreted as -;; links to these 'tagged' destinations, allowing seamless navigation between -;; multiple org-mode files. Topics can be created in any org mode file and -;; will always be found by plain links from other files. Other file types -;; recognized by ctags (source code files, latex files, etc) will also be -;; available as destinations for plain links, and similarly, org-mode links -;; will be available as tags from source files. Finally, the function -;; `org-ctags-find-tag-interactive' lets you choose any known tag, using -;; autocompletion, and quickly jump to it. -;; -;; Installation -;; ============ -;; -;; Install org mode -;; Ensure org-ctags.el is somewhere in your emacs load path. -;; Download and install Exuberant ctags -- "http://ctags.sourceforge.net/" -;; Edit your .emacs file (see next section) and load emacs. - -;; To put in your init file (.emacs): -;; ================================== -;; -;; Assuming you already have org mode installed and set up: -;; -;; (setq org-ctags-path-to-ctags "/path/to/ctags/executable") -;; (add-hook 'org-mode-hook -;; (lambda () -;; (define-key org-mode-map "\C-co" 'org-ctags-find-tag-interactive))) -;; -;; By default, with org-ctags loaded, org will first try and visit the tag -;; with the same name as the link; then, if unsuccessful, ask the user if -;; he/she wants to rebuild the 'TAGS' database and try again; then ask if -;; the user wishes to append 'tag' as a new toplevel heading at the end of -;; the buffer; and finally, defer to org's default behaviour which is to -;; search the entire text of the current buffer for 'tag'. -;; -;; This behaviour can be modified by changing the value of -;; ORG-CTAGS-OPEN-LINK-FUNCTIONS. For example I have the following in my -;; .emacs, which describes the same behaviour as the above paragraph with -;; one difference: -;; -;; (setq org-ctags-open-link-functions -;; '(org-ctags-find-tag -;; org-ctags-ask-rebuild-tags-file-then-find-tag -;; org-ctags-ask-append-topic -;; org-ctags-fail-silently)) ; <-- prevents org default behaviour -;; -;; -;; Usage -;; ===== -;; -;; When you click on a link "[[foo]]" and org cannot find a matching "<>" -;; in the current buffer, the tags facility will take over. The file TAGS in -;; the active directory is examined to see if the tags facility knows about -;; "<>" in any other files. If it does, the matching file will be opened -;; and the cursor will jump to the position of "<>" in that file. -;; -;; User-visible functions: -;; - `org-ctags-find-tag-interactive': type a tag (plain link) name and visit -;; it. With autocompletion. Bound to ctrl-O in the above setup. -;; - All the etags functions should work. These include: -;; -;; M-. `find-tag' -- finds the tag at point -;; -;; C-M-. find-tag based on regular expression -;; -;; M-x tags-search RET -- like C-M-. but searches through ENTIRE TEXT -;; of ALL the files referenced in the TAGS file. A quick way to -;; search through an entire 'project'. -;; -;; M-* "go back" from a tag jump. Like `org-mark-ring-goto'. -;; You may need to bind this key yourself with (eg) -;; (global-set-key (kbd "") 'pop-tag-mark) -;; -;; (see etags chapter in Emacs manual for more) -;; -;; -;; Keeping the TAGS file up to date -;; ================================ -;; -;; Tags mode has no way of knowing that you have created new tags by typing in -;; your org-mode buffer. New tags make it into the TAGS file in 3 ways: -;; -;; 1. You re-run (org-ctags-create-tags "directory") to rebuild the file. -;; 2. You put the function `org-ctags-ask-rebuild-tags-file-then-find-tag' in -;; your `org-open-link-functions' list, as is done in the setup -;; above. This will cause the TAGS file to be rebuilt whenever a link -;; cannot be found. This may be slow with large file collections however. -;; 3. You run the following from the command line (all 1 line): -;; -;; ctags --langdef=orgmode --langmap=orgmode:.org -;; --regex-orgmode="/<<([^>]+)>>/\1/d,definition/" -;; -f /your/path/TAGS -e -R /your/path/*.org -;; -;; If you are paranoid, you might want to run (org-ctags-create-tags -;; "/path/to/org/files") at startup, by including the following toplevel form -;; in .emacs. However this can cause a pause of several seconds if ctags has -;; to scan lots of files. -;; -;; (progn -;; (message "-- rebuilding tags tables...") -;; (mapc 'org-ctags-create-tags tags-table-list)) - -;;; Code: - -(eval-when-compile (require 'cl)) - -(require 'org) - -(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) - -(defgroup org-ctags nil - "Options concerning use of ctags within org mode." - :tag "Org-Ctags" - :group 'org-link) - -(defvar org-ctags-enabled-p t - "Activate ctags support in org mode?") - -(defvar org-ctags-tag-regexp "/<<([^>]+)>>/\\1/d,definition/" - "Regexp expression used by ctags external program. -The regexp matches tag destinations in org-mode files. -Format is: /REGEXP/TAGNAME/FLAGS,TAGTYPE/ -See the ctags documentation for more information.") - -(defcustom org-ctags-path-to-ctags - (if (executable-find "ctags-exuberant") "ctags-exuberant" "ctags") - "Name of the ctags executable file." - :group 'org-ctags - :version "24.1" - :type 'file) - -(defcustom org-ctags-open-link-functions - '(org-ctags-find-tag - org-ctags-ask-rebuild-tags-file-then-find-tag - org-ctags-ask-append-topic) - "List of functions to be prepended to ORG-OPEN-LINK-FUNCTIONS when ORG-CTAGS is active." - :group 'org-ctags - :version "24.1" - :type 'hook - :options '(org-ctags-find-tag - org-ctags-ask-rebuild-tags-file-then-find-tag - org-ctags-rebuild-tags-file-then-find-tag - org-ctags-ask-append-topic - org-ctags-append-topic - org-ctags-ask-visit-buffer-or-file - org-ctags-visit-buffer-or-file - org-ctags-fail-silently)) - - -(defvar org-ctags-tag-list nil - "List of all tags in the active TAGS file. -Created as a local variable in each buffer.") - -(defcustom org-ctags-new-topic-template - "* <<%t>>\n\n\n\n\n\n" - "Text to insert when creating a new org file via opening a hyperlink. -The following patterns are replaced in the string: - `%t' - replaced with the capitalized title of the hyperlink" - :group 'org-ctags - :version "24.1" - :type 'string) - - -(add-hook 'org-mode-hook - (lambda () - (when (and org-ctags-enabled-p - (buffer-file-name)) - ;; Make sure this file's directory is added to default - ;; directories in which to search for tags. - (let ((tags-filename - (expand-file-name - (concat (file-name-directory (buffer-file-name)) - "/TAGS")))) - (when (file-exists-p tags-filename) - (visit-tags-table tags-filename)))))) - - -(defadvice visit-tags-table (after org-ctags-load-tag-list activate compile) - (when (and org-ctags-enabled-p tags-file-name) - (set (make-local-variable 'org-ctags-tag-list) - (org-ctags-all-tags-in-current-tags-table)))) - - -(defun org-ctags-enable () - (put 'org-mode 'find-tag-default-function 'org-ctags-find-tag-at-point) - (setq org-ctags-enabled-p t) - (dolist (fn org-ctags-open-link-functions) - (add-hook 'org-open-link-functions fn t))) - - -;;; General utility functions. =============================================== -;; These work outside org-ctags mode. - -(defun org-ctags-get-filename-for-tag (tag) - "TAG is a string. Search the active TAGS file for a matching tag. -If the tag is found, return a list containing the filename, line number, and -buffer position where the tag is found." - (interactive "sTag: ") - (unless tags-file-name - (call-interactively (visit-tags-table))) - (save-excursion - (visit-tags-table-buffer 'same) - (when tags-file-name - (with-current-buffer (get-file-buffer tags-file-name) - (goto-char (point-min)) - (cond - ((re-search-forward (format "^.*%s\\([0-9]+\\),\\([0-9]+\\)$" - (regexp-quote tag)) nil t) - (let ((line (string-to-number (match-string 1))) - (pos (string-to-number (match-string 2)))) - (cond - ((re-search-backward " \n\\(.*\\),[0-9]+\n") - (list (match-string 1) line pos)) - (t ; can't find a file name preceding the matched - ; tag?? - (error "Malformed TAGS file: %s" (buffer-name)))))) - (t ; tag not found - nil)))))) - - -(defun org-ctags-all-tags-in-current-tags-table () - "Read all tags defined in the active TAGS file, into a list of strings. -Return the list." - (interactive) - (let ((taglist nil)) - (unless tags-file-name - (call-interactively (visit-tags-table))) - (save-excursion - (visit-tags-table-buffer 'same) - (with-current-buffer (get-file-buffer tags-file-name) - (goto-char (point-min)) - (while (re-search-forward "^.*\\(.*\\)\\([0-9]+\\),\\([0-9]+\\)$" - nil t) - (push (substring-no-properties (match-string 1)) taglist))) - taglist))) - - -(defun org-ctags-string-search-and-replace (search replace string) - "Replace all instances of SEARCH with REPLACE in STRING." - (replace-regexp-in-string (regexp-quote search) replace string t t)) - - -(defun y-or-n-minibuffer (prompt) - (let ((use-dialog-box nil)) - (y-or-n-p prompt))) - - -;;; Internal functions ======================================================= - - -(defun org-ctags-open-file (name &optional title) - "Visit or create a file called `NAME.org', and insert a new topic. -The new topic will be titled NAME (or TITLE if supplied)." - (interactive "sFile name: ") - (let ((filename (substitute-in-file-name (expand-file-name name)))) - (condition-case v - (progn - (org-open-file name t) - (message "Opened file OK") - (goto-char (point-max)) - (insert (org-ctags-string-search-and-replace - "%t" (capitalize (or title name)) - org-ctags-new-topic-template)) - (message "Inserted new file text OK") - (org-mode-restart)) - (error (error "Error %S in org-ctags-open-file" v))))) - - -;;;; Misc interoperability with etags system ================================= - - -(defadvice find-tag (before org-ctags-set-org-mark-before-finding-tag - activate compile) - "Before trying to find a tag, save our current position on org mark ring." - (save-excursion - (if (and (derived-mode-p 'org-mode) org-ctags-enabled-p) - (org-mark-ring-push)))) - - - -(defun org-ctags-find-tag-at-point () - "Determine default tag to search for, based on text at point. -If there is no plausible default, return nil." - (let (from to bound) - (when (or (ignore-errors - ;; Look for hyperlink around `point'. - (save-excursion - (search-backward "[[") (setq from (+ 2 (point)))) - (save-excursion - (goto-char from) - (search-forward "]") (setq to (- (point) 1))) - (and (> to from) (>= (point) from) (<= (point) to))) - (progn - ;; Look at text around `point'. - (save-excursion - (skip-syntax-backward "w_") (setq from (point))) - (save-excursion - (skip-syntax-forward "w_") (setq to (point))) - (> to from)) - ;; Look between `line-beginning-position' and `point'. - (save-excursion - (and (setq bound (line-beginning-position)) - (skip-syntax-backward "^w_" bound) - (> (setq to (point)) bound) - (skip-syntax-backward "w_") - (setq from (point)))) - ;; Look between `point' and `line-end-position'. - (save-excursion - (and (setq bound (line-end-position)) - (skip-syntax-forward "^w_" bound) - (< (setq from (point)) bound) - (skip-syntax-forward "w_") - (setq to (point))))) - (buffer-substring-no-properties from to)))) - - -;;; Functions for use with 'org-open-link-functions' hook ================= - - -(defun org-ctags-find-tag (name) - "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Look for a tag called `NAME' in the current TAGS table. If it is found, -visit the file and location where the tag is found." - (interactive "sTag: ") - (let ((old-buf (current-buffer)) - (old-pnt (point-marker)) - (old-mark (copy-marker (mark-marker)))) - (condition-case nil - (progn (find-tag name) - t) - (error - ;; only restore old location if find-tag raises error - (set-buffer old-buf) - (goto-char old-pnt) - (set-marker (mark-marker) old-mark) - nil)))) - - -(defun org-ctags-visit-buffer-or-file (name &optional create) - "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Visit buffer named `NAME.org'. If there is no such buffer, visit the file -with the same name if it exists. If the file does not exist, then behavior -depends on the value of CREATE. - -If CREATE is nil (default), then return nil. Do not create a new file. -If CREATE is t, create the new file and visit it. -If CREATE is the symbol `ask', then ask the user if they wish to create -the new file." - (interactive) - (let ((filename (concat (substitute-in-file-name - (expand-file-name name)) - ".org"))) - (cond - ((get-buffer (concat name ".org")) - ;; Buffer is already open - (org-pop-to-buffer-same-window (get-buffer (concat name ".org")))) - ((file-exists-p filename) - ;; File exists but is not open --> open it - (message "Opening existing org file `%S'..." - filename) - (org-open-file filename t)) - ((or (eql create t) - (and (eql create 'ask) - (y-or-n-p (format "File `%s.org' not found; create?" name)))) - (org-ctags-open-file filename name)) - (t ;; File does not exist, and we don't want to create it. - nil)))) - - -(defun org-ctags-ask-visit-buffer-or-file (name) - "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Wrapper for org-ctags-visit-buffer-or-file, which ensures the user is -asked before creating a new file." - (org-ctags-visit-buffer-or-file name 'ask)) - - -(defun org-ctags-append-topic (name &optional narrowp) - "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Append a new toplevel heading to the end of the current buffer. The -heading contains NAME surrounded by <>, thus making -the heading a destination for the tag `NAME'." - (interactive "sTopic: ") - (widen) - (goto-char (point-max)) - (newline 2) - (message "Adding topic in buffer %s" (buffer-name)) - (insert (org-ctags-string-search-and-replace - "%t" (capitalize name) org-ctags-new-topic-template)) - (backward-char 4) - (org-update-radio-target-regexp) - (end-of-line) - (forward-line 2) - (when narrowp - ;;(org-tree-to-indirect-buffer 1) ;; opens new frame - (org-narrow-to-subtree)) - t) - - -(defun org-ctags-ask-append-topic (name &optional narrowp) - "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Wrapper for org-ctags-append-topic, which first asks the user if they want -to append a new topic." - (if (y-or-n-p (format "Topic `%s' not found; append to end of buffer?" - name)) - (org-ctags-append-topic name narrowp) - nil)) - - -(defun org-ctags-rebuild-tags-file-then-find-tag (name) - "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Like ORG-CTAGS-FIND-TAG, but calls the external ctags program first, -to rebuild (update) the TAGS file." - (unless tags-file-name - (call-interactively (visit-tags-table))) - (when (buffer-file-name) - (org-ctags-create-tags)) - (org-ctags-find-tag name)) - - -(defun org-ctags-ask-rebuild-tags-file-then-find-tag (name) - "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Wrapper for org-ctags-rebuild-tags-file-then-find-tag." - (if (and (buffer-file-name) - (y-or-n-p - (format - "Tag `%s' not found. Rebuild table `%s/TAGS' and look again?" - name - (file-name-directory (buffer-file-name))))) - (org-ctags-rebuild-tags-file-then-find-tag name) - nil)) - - -(defun org-ctags-fail-silently (name) - "This function is intended to be used in ORG-OPEN-LINK-FUNCTIONS. -Put as the last function in the list if you want to prevent org's default -behavior of free text search." - t) - - -;;; User-visible functions =================================================== - - -(defun org-ctags-create-tags (&optional directory-name) - "(Re)create tags file in the directory of the active buffer. -The file will contain tag definitions for all the files in the -directory and its subdirectories which are recognized by ctags. -This will include files ending in `.org' as well as most other -source files (.C, .H, .EL, .LISP, etc). All the resulting tags -end up in one file, called TAGS, located in the directory. This -function may take several seconds to finish if the directory or -its subdirectories contain large numbers of taggable files." - (interactive) - (assert (buffer-file-name)) - (let ((dir-name (or directory-name - (file-name-directory (buffer-file-name)))) - (exitcode nil)) - (save-excursion - (setq exitcode - (shell-command - (format (concat "%s --langdef=orgmode --langmap=orgmode:.org " - "--regex-orgmode=\"%s\" -f \"%s\" -e -R \"%s\"") - org-ctags-path-to-ctags - org-ctags-tag-regexp - (expand-file-name (concat dir-name "/TAGS")) - (expand-file-name (concat dir-name "/*"))))) - (cond - ((eql 0 exitcode) - (set (make-local-variable 'org-ctags-tag-list) - (org-ctags-all-tags-in-current-tags-table))) - (t - ;; This seems to behave differently on Linux, so just ignore - ;; error codes for now - ;;(error "Calling ctags executable resulted in error code: %s" - ;; exitcode) - nil))))) - - -(defvar org-ctags-find-tag-history nil - "History of tags visited by org-ctags-find-tag-interactive.") - -(defun org-ctags-find-tag-interactive () - "Prompt for the name of a tag, with autocompletion, then visit the named tag. -Uses `ido-mode' if available. -If the user enters a string that does not match an existing tag, create -a new topic." - (interactive) - (let* ((completing-read-fn (if (fboundp 'ido-completing-read) - 'ido-completing-read - 'completing-read)) - (tag (funcall completing-read-fn "Topic: " org-ctags-tag-list - nil 'confirm nil 'org-ctags-find-tag-history))) - (when tag - (cond - ((member tag org-ctags-tag-list) - ;; Existing tag - (push tag org-ctags-find-tag-history) - (find-tag tag)) - (t - ;; New tag - (run-hook-with-args-until-success - 'org-open-link-functions tag)))))) - - -(org-ctags-enable) - -(provide 'org-ctags) - -;;; org-ctags.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-datetree.el b/xemacs-packages/lisp/org-8.2.3c/org-datetree.el deleted file mode 100644 index dd4b1b0e..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-datetree.el +++ /dev/null @@ -1,217 +0,0 @@ -;;; org-datetree.el --- Create date entries in a tree - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file contains code to create entries in a tree where the top-level -;; nodes represent years, the level 2 nodes represent the months, and the -;; level 1 entries days. - -;;; Code: - -(require 'org) - -(defvar org-datetree-base-level 1 - "The level at which years should be placed in the date tree. -This is normally one, but if the buffer has an entry with a DATE_TREE -property (any value), the date tree will become a subtree under that entry, -so the base level will be properly adjusted.") - -(defcustom org-datetree-add-timestamp nil - "When non-nil, add a time stamp when create a datetree entry." - :group 'org-capture - :version "24.3" - :type '(choice - (const :tag "Do not add a time stamp" nil) - (const :tag "Add an inactive time stamp" inactive) - (const :tag "Add an active time stamp" active))) - -;;;###autoload -(defun org-datetree-find-date-create (date &optional keep-restriction) - "Find or create an entry for DATE. -If KEEP-RESTRICTION is non-nil, do not widen the buffer. -When it is nil, the buffer will be widened to make sure an existing date -tree can be found." - (let ((year (nth 2 date)) - (month (car date)) - (day (nth 1 date))) - (org-set-local 'org-datetree-base-level 1) - (or keep-restriction (widen)) - (goto-char (point-min)) - (save-restriction - (when (re-search-forward "^[ \t]*:DATE_TREE:[ \t]+\\S-" nil t) - (org-back-to-heading t) - (org-set-local 'org-datetree-base-level - (org-get-valid-level (funcall outline-level) 1)) - (org-narrow-to-subtree)) - (goto-char (point-min)) - (org-datetree-find-year-create year) - (org-datetree-find-month-create year month) - (org-datetree-find-day-create year month day) - (goto-char (prog1 (point) (widen)))))) - -(defun org-datetree-find-year-create (year) - "Find the YEAR datetree or create it." - (let ((re "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\\([ \t]:[[:alnum:]:_@#%]+:\\)?\\s-*$\\)") - match) - (goto-char (point-min)) - (while (and (setq match (re-search-forward re nil t)) - (goto-char (match-beginning 1)) - (< (string-to-number (match-string 1)) year))) - (cond - ((not match) - (goto-char (point-max)) - (or (bolp) (newline)) - (org-datetree-insert-line year)) - ((= (string-to-number (match-string 1)) year) - (goto-char (point-at-bol))) - (t - (beginning-of-line 1) - (org-datetree-insert-line year))))) - -(defun org-datetree-find-month-create (year month) - "Find the datetree for YEAR and MONTH or create it." - (org-narrow-to-subtree) - (let ((re (format "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$" year)) - match) - (goto-char (point-min)) - (while (and (setq match (re-search-forward re nil t)) - (goto-char (match-beginning 1)) - (< (string-to-number (match-string 1)) month))) - (cond - ((not match) - (goto-char (point-max)) - (or (bolp) (newline)) - (org-datetree-insert-line year month)) - ((= (string-to-number (match-string 1)) month) - (goto-char (point-at-bol))) - (t - (beginning-of-line 1) - (org-datetree-insert-line year month))))) - -(defun org-datetree-find-day-create (year month day) - "Find the datetree for YEAR, MONTH and DAY or create it." - (org-narrow-to-subtree) - (let ((re (format "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$" year month)) - match) - (goto-char (point-min)) - (while (and (setq match (re-search-forward re nil t)) - (goto-char (match-beginning 1)) - (< (string-to-number (match-string 1)) day))) - (cond - ((not match) - (goto-char (point-max)) - (or (bolp) (newline)) - (org-datetree-insert-line year month day)) - ((= (string-to-number (match-string 1)) day) - (goto-char (point-at-bol))) - (t - (beginning-of-line 1) - (org-datetree-insert-line year month day))))) - -(defun org-datetree-insert-line (year &optional month day) - (let ((pos (point)) ts-type) - (skip-chars-backward " \t\n") - (delete-region (point) pos) - (insert "\n" (make-string org-datetree-base-level ?*) " \n") - (backward-char 1) - (if month (org-do-demote)) - (if day (org-do-demote)) - (insert (format "%d" year)) - (when month - (insert (format "-%02d" month)) - (if day - (insert (format "-%02d %s" - day (format-time-string - "%A" (encode-time 0 0 0 day month year)))) - (insert (format " %s" - (format-time-string - "%B" (encode-time 0 0 0 1 month year)))))) - (when (and day (setq ts-type org-datetree-add-timestamp)) - (insert "\n") - (org-indent-line) - (org-insert-time-stamp (encode-time 0 0 0 day month year) nil ts-type)) - (beginning-of-line 1))) - -(defun org-datetree-file-entry-under (txt date) - "Insert a node TXT into the date tree under DATE." - (org-datetree-find-date-create date) - (let ((level (org-get-valid-level (funcall outline-level) 1))) - (org-end-of-subtree t t) - (org-back-over-empty-lines) - (org-paste-subtree level txt))) - -(defun org-datetree-cleanup () - "Make sure all entries in the current tree are under the correct date. -It may be useful to restrict the buffer to the applicable portion -before running this command, even though the command tries to be smart." - (interactive) - (goto-char (point-min)) - (let ((dre (concat "\\<" org-deadline-string "\\>[ \t]*\\'")) - (sre (concat "\\<" org-scheduled-string "\\>[ \t]*\\'")) - dct ts tmp date year month day pos hdl-pos) - (while (re-search-forward org-ts-regexp nil t) - (catch 'next - (setq ts (match-string 0)) - (setq tmp (buffer-substring - (max (point-at-bol) (- (match-beginning 0) - org-ds-keyword-length)) - (match-beginning 0))) - (if (or (string-match "-\\'" tmp) - (string-match dre tmp) - (string-match sre tmp)) - (throw 'next nil)) - (setq dct (decode-time (org-time-string-to-time (match-string 0))) - date (list (nth 4 dct) (nth 3 dct) (nth 5 dct)) - year (nth 2 date) - month (car date) - day (nth 1 date) - pos (point)) - (org-back-to-heading t) - (setq hdl-pos (point)) - (unless (org-up-heading-safe) - ;; No parent, we are not in a date tree - (goto-char pos) - (throw 'next nil)) - (unless (looking-at "\\*+[ \t]+[0-9]+-[0-1][0-9]-[0-3][0-9]") - ;; Parent looks wrong, we are not in a date tree - (goto-char pos) - (throw 'next nil)) - (when (looking-at (format "\\*+[ \t]+%d-%02d-%02d" year month day)) - ;; At correct date already, do nothing - (progn (goto-char pos) (throw 'next nil))) - ;; OK, we need to refile this entry - (goto-char hdl-pos) - (org-cut-subtree) - (save-excursion - (save-restriction - (org-datetree-file-entry-under (current-kill 0) date))))))) - -(provide 'org-datetree) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-datetree.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-docview.el b/xemacs-packages/lisp/org-8.2.3c/org-docview.el deleted file mode 100644 index 8e61c8ab..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-docview.el +++ /dev/null @@ -1,101 +0,0 @@ -;;; org-docview.el --- support for links to doc-view-mode buffers - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: Jan Böcker -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file implements links to open files in doc-view-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;; The links take the form -;; -;; docview::: -;; -;; for example: [[docview:~/.elisp/org/doc/org.pdf::1][Org-Mode Manual]] -;; -;; Autocompletion for inserting links is supported; you will be -;; prompted for a file and a page number. -;; -;; If you use org-store-link in a doc-view mode buffer, the stored -;; link will point to the current page. - -;;; Code: - - -(require 'org) -(require 'doc-view) - -(declare-function doc-view-goto-page "doc-view" (page)) -(declare-function image-mode-window-get "image-mode" (prop &optional winprops)) - -(org-add-link-type "docview" 'org-docview-open 'org-docview-export) -(add-hook 'org-store-link-functions 'org-docview-store-link) - -(defun org-docview-export (link description format) - "Export a docview link from Org files." - (let* ((path (when (string-match "\\(.+\\)::.+" link) - (match-string 1 link))) - (desc (or description link))) - (when (stringp path) - (setq path (org-link-escape (expand-file-name path))) - (cond - ((eq format 'html) (format "%s" path desc)) - ((eq format 'latex) (format "\href{%s}{%s}" path desc)) - ((eq format 'ascii) (format "%s (%s)" desc path)) - (t path))))) - -(defun org-docview-open (link) - (when (string-match "\\(.*\\)::\\([0-9]+\\)$" link) - (let* ((path (match-string 1 link)) - (page (string-to-number (match-string 2 link)))) - (org-open-file path 1) ;; let org-mode open the file (in-emacs = 1) - ;; to ensure org-link-frame-setup is respected - (doc-view-goto-page page) - ))) - -(defun org-docview-store-link () - "Store a link to a docview buffer." - (when (eq major-mode 'doc-view-mode) - ;; This buffer is in doc-view-mode - (let* ((path buffer-file-name) - (page (image-mode-window-get 'page)) - (link (concat "docview:" path "::" (number-to-string page))) - (description "")) - (org-store-link-props - :type "docview" - :link link - :description path)))) - -(defun org-docview-complete-link () - "Use the existing file name completion for file. -Links to get the file name, then ask the user for the page number -and append it." - (concat (replace-regexp-in-string "^file:" "docview:" (org-file-complete-link)) - "::" - (read-from-minibuffer "Page:" "1"))) - - -(provide 'org-docview) - -;;; org-docview.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-element.el b/xemacs-packages/lisp/org-8.2.3c/org-element.el deleted file mode 100644 index 55efb500..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-element.el +++ /dev/null @@ -1,5008 +0,0 @@ -;;; org-element.el --- Parser And Applications for Org syntax - -;; Copyright (C) 2012-2013 Free Software Foundation, Inc. - -;; Author: Nicolas Goaziou -;; Keywords: outlines, hypermedia, calendar, wp - -;; 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 . - -;;; Commentary: -;; -;; Org syntax can be divided into three categories: "Greater -;; elements", "Elements" and "Objects". -;; -;; Elements are related to the structure of the document. Indeed, all -;; elements are a cover for the document: each position within belongs -;; to at least one element. -;; -;; An element always starts and ends at the beginning of a line. With -;; a few exceptions (`clock', `headline', `inlinetask', `item', -;; `planning', `node-property', `quote-section' `section' and -;; `table-row' types), it can also accept a fixed set of keywords as -;; attributes. Those are called "affiliated keywords" to distinguish -;; them from other keywords, which are full-fledged elements. Almost -;; all affiliated keywords are referenced in -;; `org-element-affiliated-keywords'; the others are export attributes -;; and start with "ATTR_" prefix. -;; -;; Element containing other elements (and only elements) are called -;; greater elements. Concerned types are: `center-block', `drawer', -;; `dynamic-block', `footnote-definition', `headline', `inlinetask', -;; `item', `plain-list', `property-drawer', `quote-block', `section' -;; and `special-block'. -;; -;; Other element types are: `babel-call', `clock', `comment', -;; `comment-block', `diary-sexp', `example-block', `export-block', -;; `fixed-width', `horizontal-rule', `keyword', `latex-environment', -;; `node-property', `paragraph', `planning', `quote-section', -;; `src-block', `table', `table-row' and `verse-block'. Among them, -;; `paragraph' and `verse-block' types can contain Org objects and -;; plain text. -;; -;; Objects are related to document's contents. Some of them are -;; recursive. Associated types are of the following: `bold', `code', -;; `entity', `export-snippet', `footnote-reference', -;; `inline-babel-call', `inline-src-block', `italic', -;; `latex-fragment', `line-break', `link', `macro', `radio-target', -;; `statistics-cookie', `strike-through', `subscript', `superscript', -;; `table-cell', `target', `timestamp', `underline' and `verbatim'. -;; -;; Some elements also have special properties whose value can hold -;; objects themselves (i.e. an item tag or a headline name). Such -;; values are called "secondary strings". Any object belongs to -;; either an element or a secondary string. -;; -;; Notwithstanding affiliated keywords, each greater element, element -;; and object has a fixed set of properties attached to it. Among -;; them, four are shared by all types: `:begin' and `:end', which -;; refer to the beginning and ending buffer positions of the -;; considered element or object, `:post-blank', which holds the number -;; of blank lines, or white spaces, at its end and `:parent' which -;; refers to the element or object containing it. Greater elements, -;; elements and objects containing objects will also have -;; `:contents-begin' and `:contents-end' properties to delimit -;; contents. Eventually, greater elements and elements accepting -;; affiliated keywords will have a `:post-affiliated' property, -;; referring to the buffer position after all such keywords. -;; -;; At the lowest level, a `:parent' property is also attached to any -;; string, as a text property. -;; -;; Lisp-wise, an element or an object can be represented as a list. -;; It follows the pattern (TYPE PROPERTIES CONTENTS), where: -;; TYPE is a symbol describing the Org element or object. -;; PROPERTIES is the property list attached to it. See docstring of -;; appropriate parsing function to get an exhaustive -;; list. -;; CONTENTS is a list of elements, objects or raw strings contained -;; in the current element or object, when applicable. -;; -;; An Org buffer is a nested list of such elements and objects, whose -;; type is `org-data' and properties is nil. -;; -;; The first part of this file defines Org syntax, while the second -;; one provide accessors and setters functions. -;; -;; The next part implements a parser and an interpreter for each -;; element and object type in Org syntax. -;; -;; The following part creates a fully recursive buffer parser. It -;; also provides a tool to map a function to elements or objects -;; matching some criteria in the parse tree. Functions of interest -;; are `org-element-parse-buffer', `org-element-map' and, to a lesser -;; extent, `org-element-parse-secondary-string'. -;; -;; The penultimate part is the cradle of an interpreter for the -;; obtained parse tree: `org-element-interpret-data'. -;; -;; The library ends by furnishing `org-element-at-point' function, and -;; a way to give information about document structure around point -;; with `org-element-context'. - - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'org) - - - -;;; Definitions And Rules -;; -;; Define elements, greater elements and specify recursive objects, -;; along with the affiliated keywords recognized. Also set up -;; restrictions on recursive objects combinations. -;; -;; These variables really act as a control center for the parsing -;; process. - -(defconst org-element-paragraph-separate - (concat "^\\(?:" - ;; Headlines, inlinetasks. - org-outline-regexp "\\|" - ;; Footnote definitions. - "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|" - ;; Diary sexps. - "%%(" "\\|" - "[ \t]*\\(?:" - ;; Empty lines. - "$" "\\|" - ;; Tables (any type). - "\\(?:|\\|\\+-[-+]\\)" "\\|" - ;; Blocks (any type), Babel calls, drawers (any type), - ;; fixed-width areas and keywords. Note: this is only an - ;; indication and need some thorough check. - "[#:]" "\\|" - ;; Horizontal rules. - "-\\{5,\\}[ \t]*$" "\\|" - ;; LaTeX environments. - "\\\\begin{\\([A-Za-z0-9]+\\*?\\)}" "\\|" - ;; Planning and Clock lines. - (regexp-opt (list org-scheduled-string - org-deadline-string - org-closed-string - org-clock-string)) - "\\|" - ;; Lists. - (let ((term (case org-plain-list-ordered-item-terminator - (?\) ")") (?. "\\.") (otherwise "[.)]"))) - (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]"))) - (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)" - "\\(?:[ \t]\\|$\\)")) - "\\)\\)") - "Regexp to separate paragraphs in an Org buffer. -In the case of lines starting with \"#\" and \":\", this regexp -is not sufficient to know if point is at a paragraph ending. See -`org-element-paragraph-parser' for more information.") - -(defconst org-element-all-elements - '(babel-call center-block clock comment comment-block diary-sexp drawer - dynamic-block example-block export-block fixed-width - footnote-definition headline horizontal-rule inlinetask item - keyword latex-environment node-property paragraph plain-list - planning property-drawer quote-block quote-section section - special-block src-block table table-row verse-block) - "Complete list of element types.") - -(defconst org-element-greater-elements - '(center-block drawer dynamic-block footnote-definition headline inlinetask - item plain-list property-drawer quote-block section - special-block table) - "List of recursive element types aka Greater Elements.") - -(defconst org-element-all-successors - '(export-snippet footnote-reference inline-babel-call inline-src-block - latex-or-entity line-break link macro plain-link radio-target - statistics-cookie sub/superscript table-cell target - text-markup timestamp) - "Complete list of successors.") - -(defconst org-element-object-successor-alist - '((subscript . sub/superscript) (superscript . sub/superscript) - (bold . text-markup) (code . text-markup) (italic . text-markup) - (strike-through . text-markup) (underline . text-markup) - (verbatim . text-markup) (entity . latex-or-entity) - (latex-fragment . latex-or-entity)) - "Alist of translations between object type and successor name. -Sharing the same successor comes handy when, for example, the -regexp matching one object can also match the other object.") - -(defconst org-element-all-objects - '(bold code entity export-snippet footnote-reference inline-babel-call - inline-src-block italic line-break latex-fragment link macro - radio-target statistics-cookie strike-through subscript superscript - table-cell target timestamp underline verbatim) - "Complete list of object types.") - -(defconst org-element-recursive-objects - '(bold italic link subscript radio-target strike-through superscript - table-cell underline) - "List of recursive object types.") - -(defvar org-element-block-name-alist - '(("CENTER" . org-element-center-block-parser) - ("COMMENT" . org-element-comment-block-parser) - ("EXAMPLE" . org-element-example-block-parser) - ("QUOTE" . org-element-quote-block-parser) - ("SRC" . org-element-src-block-parser) - ("VERSE" . org-element-verse-block-parser)) - "Alist between block names and the associated parsing function. -Names must be uppercase. Any block whose name has no association -is parsed with `org-element-special-block-parser'.") - -(defconst org-element-link-type-is-file - '("file" "file+emacs" "file+sys" "docview") - "List of link types equivalent to \"file\". -Only these types can accept search options and an explicit -application to open them.") - -(defconst org-element-affiliated-keywords - '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT" - "RESULTS" "SOURCE" "SRCNAME" "TBLNAME") - "List of affiliated keywords as strings. -By default, all keywords setting attributes (i.e. \"ATTR_LATEX\") -are affiliated keywords and need not to be in this list.") - -(defconst org-element--affiliated-re - (format "[ \t]*#\\+%s:" - ;; Regular affiliated keywords. - (format "\\(%s\\|ATTR_[-_A-Za-z0-9]+\\)\\(?:\\[\\(.*\\)\\]\\)?" - (regexp-opt org-element-affiliated-keywords))) - "Regexp matching any affiliated keyword. - -Keyword name is put in match group 1. Moreover, if keyword -belongs to `org-element-dual-keywords', put the dual value in -match group 2. - -Don't modify it, set `org-element-affiliated-keywords' instead.") - -(defconst org-element-keyword-translation-alist - '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME") - ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME") - ("RESULT" . "RESULTS") ("HEADERS" . "HEADER")) - "Alist of usual translations for keywords. -The key is the old name and the value the new one. The property -holding their value will be named after the translated name.") - -(defconst org-element-multiple-keywords '("CAPTION" "HEADER") - "List of affiliated keywords that can occur more than once in an element. - -Their value will be consed into a list of strings, which will be -returned as the value of the property. - -This list is checked after translations have been applied. See -`org-element-keyword-translation-alist'. - -By default, all keywords setting attributes (i.e. \"ATTR_LATEX\") -allow multiple occurrences and need not to be in this list.") - -(defconst org-element-parsed-keywords '("CAPTION") - "List of affiliated keywords whose value can be parsed. - -Their value will be stored as a secondary string: a list of -strings and objects. - -This list is checked after translations have been applied. See -`org-element-keyword-translation-alist'.") - -(defconst org-element-dual-keywords '("CAPTION" "RESULTS") - "List of affiliated keywords which can have a secondary value. - -In Org syntax, they can be written with optional square brackets -before the colons. For example, RESULTS keyword can be -associated to a hash value with the following: - - #+RESULTS[hash-string]: some-source - -This list is checked after translations have been applied. See -`org-element-keyword-translation-alist'.") - -(defconst org-element-document-properties '("AUTHOR" "DATE" "TITLE") - "List of properties associated to the whole document. -Any keyword in this list will have its value parsed and stored as -a secondary string.") - -(defconst org-element-object-restrictions - (let* ((standard-set - (remq 'plain-link (remq 'table-cell org-element-all-successors))) - (standard-set-no-line-break (remq 'line-break standard-set))) - `((bold ,@standard-set) - (footnote-reference ,@standard-set) - (headline ,@standard-set-no-line-break) - (inlinetask ,@standard-set-no-line-break) - (italic ,@standard-set) - (item ,@standard-set-no-line-break) - (keyword ,@standard-set) - ;; Ignore all links excepted plain links in a link description. - ;; Also ignore radio-targets and line breaks. - (link export-snippet inline-babel-call inline-src-block latex-or-entity - macro plain-link statistics-cookie sub/superscript text-markup) - (paragraph ,@standard-set) - ;; Remove any variable object from radio target as it would - ;; prevent it from being properly recognized. - (radio-target latex-or-entity sub/superscript) - (strike-through ,@standard-set) - (subscript ,@standard-set) - (superscript ,@standard-set) - ;; Ignore inline babel call and inline src block as formulas are - ;; possible. Also ignore line breaks and statistics cookies. - (table-cell export-snippet footnote-reference latex-or-entity link macro - radio-target sub/superscript target text-markup timestamp) - (table-row table-cell) - (underline ,@standard-set) - (verse-block ,@standard-set))) - "Alist of objects restrictions. - -CAR is an element or object type containing objects and CDR is -a list of successors that will be called within an element or -object of such type. - -For example, in a `radio-target' object, one can only find -entities, latex-fragments, subscript and superscript. - -This alist also applies to secondary string. For example, an -`headline' type element doesn't directly contain objects, but -still has an entry since one of its properties (`:title') does.") - -(defconst org-element-secondary-value-alist - '((headline . :title) - (inlinetask . :title) - (item . :tag) - (footnote-reference . :inline-definition)) - "Alist between element types and location of secondary value.") - -(defconst org-element-object-variables '(org-link-abbrev-alist-local) - "List of buffer-local variables used when parsing objects. -These variables are copied to the temporary buffer created by -`org-export-secondary-string'.") - - - -;;; Accessors and Setters -;; -;; Provide four accessors: `org-element-type', `org-element-property' -;; `org-element-contents' and `org-element-restriction'. -;; -;; Setter functions allow to modify elements by side effect. There is -;; `org-element-put-property', `org-element-set-contents', -;; `org-element-set-element' and `org-element-adopt-element'. Note -;; that `org-element-set-element' and `org-element-adopt-elements' are -;; higher level functions since also update `:parent' property. - -(defsubst org-element-type (element) - "Return type of ELEMENT. - -The function returns the type of the element or object provided. -It can also return the following special value: - `plain-text' for a string - `org-data' for a complete document - nil in any other case." - (cond - ((not (consp element)) (and (stringp element) 'plain-text)) - ((symbolp (car element)) (car element)))) - -(defsubst org-element-property (property element) - "Extract the value from the PROPERTY of an ELEMENT." - (if (stringp element) (get-text-property 0 property element) - (plist-get (nth 1 element) property))) - -(defsubst org-element-contents (element) - "Extract contents from an ELEMENT." - (cond ((not (consp element)) nil) - ((symbolp (car element)) (nthcdr 2 element)) - (t element))) - -(defsubst org-element-restriction (element) - "Return restriction associated to ELEMENT. -ELEMENT can be an element, an object or a symbol representing an -element or object type." - (cdr (assq (if (symbolp element) element (org-element-type element)) - org-element-object-restrictions))) - -(defsubst org-element-put-property (element property value) - "In ELEMENT set PROPERTY to VALUE. -Return modified element." - (if (stringp element) (org-add-props element nil property value) - (setcar (cdr element) (plist-put (nth 1 element) property value)) - element)) - -(defsubst org-element-set-contents (element &rest contents) - "Set ELEMENT contents to CONTENTS. -Return modified element." - (cond ((not element) (list contents)) - ((not (symbolp (car element))) contents) - ((cdr element) (setcdr (cdr element) contents)) - (t (nconc element contents)))) - -(defsubst org-element-set-element (old new) - "Replace element or object OLD with element or object NEW. -The function takes care of setting `:parent' property for NEW." - ;; Since OLD is going to be changed into NEW by side-effect, first - ;; make sure that every element or object within NEW has OLD as - ;; parent. - (mapc (lambda (blob) (org-element-put-property blob :parent old)) - (org-element-contents new)) - ;; Transfer contents. - (apply 'org-element-set-contents old (org-element-contents new)) - ;; Ensure NEW has same parent as OLD, then overwrite OLD properties - ;; with NEW's. - (org-element-put-property new :parent (org-element-property :parent old)) - (setcar (cdr old) (nth 1 new)) - ;; Transfer type. - (setcar old (car new))) - -(defsubst org-element-adopt-elements (parent &rest children) - "Append elements to the contents of another element. - -PARENT is an element or object. CHILDREN can be elements, -objects, or a strings. - -The function takes care of setting `:parent' property for CHILD. -Return parent element." - ;; Link every child to PARENT. If PARENT is nil, it is a secondary - ;; string: parent is the list itself. - (mapc (lambda (child) - (org-element-put-property child :parent (or parent children))) - children) - ;; Add CHILDREN at the end of PARENT contents. - (when parent - (apply 'org-element-set-contents - parent - (nconc (org-element-contents parent) children))) - ;; Return modified PARENT element. - (or parent children)) - - - -;;; Greater elements -;; -;; For each greater element type, we define a parser and an -;; interpreter. -;; -;; A parser returns the element or object as the list described above. -;; Most of them accepts no argument. Though, exceptions exist. Hence -;; every element containing a secondary string (see -;; `org-element-secondary-value-alist') will accept an optional -;; argument to toggle parsing of that secondary string. Moreover, -;; `item' parser requires current list's structure as its first -;; element. -;; -;; An interpreter accepts two arguments: the list representation of -;; the element or object, and its contents. The latter may be nil, -;; depending on the element or object considered. It returns the -;; appropriate Org syntax, as a string. -;; -;; Parsing functions must follow the naming convention: -;; org-element-TYPE-parser, where TYPE is greater element's type, as -;; defined in `org-element-greater-elements'. -;; -;; Similarly, interpreting functions must follow the naming -;; convention: org-element-TYPE-interpreter. -;; -;; With the exception of `headline' and `item' types, greater elements -;; cannot contain other greater elements of their own type. -;; -;; Beside implementing a parser and an interpreter, adding a new -;; greater element requires to tweak `org-element--current-element'. -;; Moreover, the newly defined type must be added to both -;; `org-element-all-elements' and `org-element-greater-elements'. - - -;;;; Center Block - -(defun org-element-center-block-parser (limit affiliated) - "Parse a center block. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `center-block' and CDR is a plist -containing `:begin', `:end', `:hiddenp', `:contents-begin', -`:contents-end', `:post-blank' and `:post-affiliated' keywords. - -Assume point is at the beginning of the block." - (let ((case-fold-search t)) - (if (not (save-excursion - (re-search-forward "^[ \t]*#\\+END_CENTER[ \t]*$" limit t))) - ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit affiliated) - (let ((block-end-line (match-beginning 0))) - (let* ((begin (car affiliated)) - (post-affiliated (point)) - ;; Empty blocks have no contents. - (contents-begin (progn (forward-line) - (and (< (point) block-end-line) - (point)))) - (contents-end (and contents-begin block-end-line)) - (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char block-end-line) - (forward-line) - (point))) - (end (save-excursion - (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'center-block - (nconc - (list :begin begin - :end end - :hiddenp hidden - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))))) - -(defun org-element-center-block-interpreter (center-block contents) - "Interpret CENTER-BLOCK element as Org syntax. -CONTENTS is the contents of the element." - (format "#+BEGIN_CENTER\n%s#+END_CENTER" contents)) - - -;;;; Drawer - -(defun org-element-drawer-parser (limit affiliated) - "Parse a drawer. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `drawer' and CDR is a plist containing -`:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin', -`:contents-end', `:post-blank' and `:post-affiliated' keywords. - -Assume point is at beginning of drawer." - (let ((case-fold-search t)) - (if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) - ;; Incomplete drawer: parse it as a paragraph. - (org-element-paragraph-parser limit affiliated) - (save-excursion - (let* ((drawer-end-line (match-beginning 0)) - (name (progn (looking-at org-drawer-regexp) - (org-match-string-no-properties 1))) - (begin (car affiliated)) - (post-affiliated (point)) - ;; Empty drawers have no contents. - (contents-begin (progn (forward-line) - (and (< (point) drawer-end-line) - (point)))) - (contents-end (and contents-begin drawer-end-line)) - (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char drawer-end-line) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'drawer - (nconc - (list :begin begin - :end end - :drawer-name name - :hiddenp hidden - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))))) - -(defun org-element-drawer-interpreter (drawer contents) - "Interpret DRAWER element as Org syntax. -CONTENTS is the contents of the element." - (format ":%s:\n%s:END:" - (org-element-property :drawer-name drawer) - contents)) - - -;;;; Dynamic Block - -(defun org-element-dynamic-block-parser (limit affiliated) - "Parse a dynamic block. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `dynamic-block' and CDR is a plist -containing `:block-name', `:begin', `:end', `:hiddenp', -`:contents-begin', `:contents-end', `:arguments', `:post-blank' -and `:post-affiliated' keywords. - -Assume point is at beginning of dynamic block." - (let ((case-fold-search t)) - (if (not (save-excursion - (re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t))) - ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit affiliated) - (let ((block-end-line (match-beginning 0))) - (save-excursion - (let* ((name (progn (looking-at org-dblock-start-re) - (org-match-string-no-properties 1))) - (arguments (org-match-string-no-properties 3)) - (begin (car affiliated)) - (post-affiliated (point)) - ;; Empty blocks have no contents. - (contents-begin (progn (forward-line) - (and (< (point) block-end-line) - (point)))) - (contents-end (and contents-begin block-end-line)) - (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char block-end-line) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'dynamic-block - (nconc - (list :begin begin - :end end - :block-name name - :arguments arguments - :hiddenp hidden - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) - -(defun org-element-dynamic-block-interpreter (dynamic-block contents) - "Interpret DYNAMIC-BLOCK element as Org syntax. -CONTENTS is the contents of the element." - (format "#+BEGIN: %s%s\n%s#+END:" - (org-element-property :block-name dynamic-block) - (let ((args (org-element-property :arguments dynamic-block))) - (and args (concat " " args))) - contents)) - - -;;;; Footnote Definition - -(defun org-element-footnote-definition-parser (limit affiliated) - "Parse a footnote definition. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `footnote-definition' and CDR is -a plist containing `:label', `:begin' `:end', `:contents-begin', -`:contents-end', `:post-blank' and `:post-affiliated' keywords. - -Assume point is at the beginning of the footnote definition." - (save-excursion - (let* ((label (progn (looking-at org-footnote-definition-re) - (org-match-string-no-properties 1))) - (begin (car affiliated)) - (post-affiliated (point)) - (ending (save-excursion - (if (progn - (end-of-line) - (re-search-forward - (concat org-outline-regexp-bol "\\|" - org-footnote-definition-re "\\|" - "^\\([ \t]*\n\\)\\{2,\\}") limit 'move)) - (match-beginning 0) - (point)))) - (contents-begin (progn - (search-forward "]") - (skip-chars-forward " \r\t\n" ending) - (cond ((= (point) ending) nil) - ((= (line-beginning-position) begin) (point)) - (t (line-beginning-position))))) - (contents-end (and contents-begin ending)) - (end (progn (goto-char ending) - (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'footnote-definition - (nconc - (list :label label - :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines ending end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) - -(defun org-element-footnote-definition-interpreter (footnote-definition contents) - "Interpret FOOTNOTE-DEFINITION element as Org syntax. -CONTENTS is the contents of the footnote-definition." - (concat (format "[%s]" (org-element-property :label footnote-definition)) - " " - contents)) - - -;;;; Headline - -(defun org-element-headline-parser (limit &optional raw-secondary-p) - "Parse a headline. - -Return a list whose CAR is `headline' and CDR is a plist -containing `:raw-value', `:title', `:alt-title', `:begin', -`:end', `:pre-blank', `:hiddenp', `:contents-begin' and -`:contents-end', `:level', `:priority', `:tags', -`:todo-keyword',`:todo-type', `:scheduled', `:deadline', -`:closed', `:quotedp', `:archivedp', `:commentedp' and -`:footnote-section-p' keywords. - -The plist also contains any property set in the property drawer, -with its name in upper cases and colons added at the -beginning (i.e. `:CUSTOM_ID'). - -When RAW-SECONDARY-P is non-nil, headline's title will not be -parsed as a secondary string, but as a plain string instead. - -Assume point is at beginning of the headline." - (save-excursion - (let* ((components (org-heading-components)) - (level (nth 1 components)) - (todo (nth 2 components)) - (todo-type - (and todo (if (member todo org-done-keywords) 'done 'todo))) - (tags (let ((raw-tags (nth 5 components))) - (and raw-tags (org-split-string raw-tags ":")))) - (raw-value (or (nth 4 components) "")) - (quotedp - (let ((case-fold-search nil)) - (string-match (format "^%s\\( \\|$\\)" org-quote-string) - raw-value))) - (commentedp - (let ((case-fold-search nil)) - (string-match (format "^%s\\( \\|$\\)" org-comment-string) - raw-value))) - (archivedp (member org-archive-tag tags)) - (footnote-section-p (and org-footnote-section - (string= org-footnote-section raw-value))) - ;; Upcase property names. It avoids confusion between - ;; properties obtained through property drawer and default - ;; properties from the parser (e.g. `:end' and :END:) - (standard-props - (let (plist) - (mapc - (lambda (p) - (setq plist - (plist-put plist - (intern (concat ":" (upcase (car p)))) - (cdr p)))) - (org-entry-properties nil 'standard)) - plist)) - (time-props - ;; Read time properties on the line below the headline. - (save-excursion - (when (progn (forward-line) - (looking-at org-planning-or-clock-line-re)) - (let ((end (line-end-position)) plist) - (while (re-search-forward - org-keyword-time-not-clock-regexp end t) - (goto-char (match-end 1)) - (skip-chars-forward " \t") - (let ((keyword (match-string 1)) - (time (org-element-timestamp-parser))) - (cond ((equal keyword org-scheduled-string) - (setq plist (plist-put plist :scheduled time))) - ((equal keyword org-deadline-string) - (setq plist (plist-put plist :deadline time))) - (t (setq plist (plist-put plist :closed time)))))) - plist)))) - (begin (point)) - (end (save-excursion (goto-char (org-end-of-subtree t t)))) - (pos-after-head (progn (forward-line) (point))) - (contents-begin (save-excursion - (skip-chars-forward " \r\t\n" end) - (and (/= (point) end) (line-beginning-position)))) - (hidden (org-invisible-p2)) - (contents-end (and contents-begin - (progn (goto-char end) - (skip-chars-backward " \r\t\n") - (forward-line) - (point))))) - ;; Clean RAW-VALUE from any quote or comment string. - (when (or quotedp commentedp) - (let ((case-fold-search nil)) - (setq raw-value - (replace-regexp-in-string - (concat - (regexp-opt (list org-quote-string org-comment-string)) - "\\(?: \\|$\\)") - "" - raw-value)))) - ;; Clean TAGS from archive tag, if any. - (when archivedp (setq tags (delete org-archive-tag tags))) - (let ((headline - (list 'headline - (nconc - (list :raw-value raw-value - :begin begin - :end end - :pre-blank - (if (not contents-begin) 0 - (count-lines pos-after-head contents-begin)) - :hiddenp hidden - :contents-begin contents-begin - :contents-end contents-end - :level level - :priority (nth 3 components) - :tags tags - :todo-keyword todo - :todo-type todo-type - :post-blank (count-lines - (if (not contents-end) pos-after-head - (goto-char contents-end) - (forward-line) - (point)) - end) - :footnote-section-p footnote-section-p - :archivedp archivedp - :commentedp commentedp - :quotedp quotedp) - time-props - standard-props)))) - (let ((alt-title (org-element-property :ALT_TITLE headline))) - (when alt-title - (org-element-put-property - headline :alt-title - (if raw-secondary-p alt-title - (org-element-parse-secondary-string - alt-title (org-element-restriction 'headline) headline))))) - (org-element-put-property - headline :title - (if raw-secondary-p raw-value - (org-element-parse-secondary-string - raw-value (org-element-restriction 'headline) headline))))))) - -(defun org-element-headline-interpreter (headline contents) - "Interpret HEADLINE element as Org syntax. -CONTENTS is the contents of the element." - (let* ((level (org-element-property :level headline)) - (todo (org-element-property :todo-keyword headline)) - (priority (org-element-property :priority headline)) - (title (org-element-interpret-data - (org-element-property :title headline))) - (tags (let ((tag-list (if (org-element-property :archivedp headline) - (cons org-archive-tag - (org-element-property :tags headline)) - (org-element-property :tags headline)))) - (and tag-list - (format ":%s:" (mapconcat 'identity tag-list ":"))))) - (commentedp (org-element-property :commentedp headline)) - (quotedp (org-element-property :quotedp headline)) - (pre-blank (or (org-element-property :pre-blank headline) 0)) - (heading (concat (make-string (org-reduced-level level) ?*) - (and todo (concat " " todo)) - (and quotedp (concat " " org-quote-string)) - (and commentedp (concat " " org-comment-string)) - (and priority - (format " [#%s]" (char-to-string priority))) - (cond ((and org-footnote-section - (org-element-property - :footnote-section-p headline)) - (concat " " org-footnote-section)) - (title (concat " " title)))))) - (concat heading - ;; Align tags. - (when tags - (cond - ((zerop org-tags-column) (format " %s" tags)) - ((< org-tags-column 0) - (concat - (make-string - (max (- (+ org-tags-column (length heading) (length tags))) 1) - ? ) - tags)) - (t - (concat - (make-string (max (- org-tags-column (length heading)) 1) ? ) - tags)))) - (make-string (1+ pre-blank) 10) - contents))) - - -;;;; Inlinetask - -(defun org-element-inlinetask-parser (limit &optional raw-secondary-p) - "Parse an inline task. - -Return a list whose CAR is `inlinetask' and CDR is a plist -containing `:title', `:begin', `:end', `:hiddenp', -`:contents-begin' and `:contents-end', `:level', `:priority', -`:raw-value', `:tags', `:todo-keyword', `:todo-type', -`:scheduled', `:deadline', `:closed' and `:post-blank' keywords. - -The plist also contains any property set in the property drawer, -with its name in upper cases and colons added at the -beginning (i.e. `:CUSTOM_ID'). - -When optional argument RAW-SECONDARY-P is non-nil, inline-task's -title will not be parsed as a secondary string, but as a plain -string instead. - -Assume point is at beginning of the inline task." - (save-excursion - (let* ((begin (point)) - (components (org-heading-components)) - (todo (nth 2 components)) - (todo-type (and todo - (if (member todo org-done-keywords) 'done 'todo))) - (tags (let ((raw-tags (nth 5 components))) - (and raw-tags (org-split-string raw-tags ":")))) - (raw-value (or (nth 4 components) "")) - ;; Upcase property names. It avoids confusion between - ;; properties obtained through property drawer and default - ;; properties from the parser (e.g. `:end' and :END:) - (standard-props - (let (plist) - (mapc - (lambda (p) - (setq plist - (plist-put plist - (intern (concat ":" (upcase (car p)))) - (cdr p)))) - (org-entry-properties nil 'standard)) - plist)) - (time-props - ;; Read time properties on the line below the inlinetask - ;; opening string. - (save-excursion - (when (progn (forward-line) - (looking-at org-planning-or-clock-line-re)) - (let ((end (line-end-position)) plist) - (while (re-search-forward - org-keyword-time-not-clock-regexp end t) - (goto-char (match-end 1)) - (skip-chars-forward " \t") - (let ((keyword (match-string 1)) - (time (org-element-timestamp-parser))) - (cond ((equal keyword org-scheduled-string) - (setq plist (plist-put plist :scheduled time))) - ((equal keyword org-deadline-string) - (setq plist (plist-put plist :deadline time))) - (t (setq plist (plist-put plist :closed time)))))) - plist)))) - (task-end (save-excursion - (end-of-line) - (and (re-search-forward "^\\*+ END" limit t) - (match-beginning 0)))) - (contents-begin (progn (forward-line) - (and task-end (< (point) task-end) (point)))) - (hidden (and contents-begin (org-invisible-p2))) - (contents-end (and contents-begin task-end)) - (before-blank (if (not task-end) (point) - (goto-char task-end) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position)))) - (inlinetask - (list 'inlinetask - (nconc - (list :raw-value raw-value - :begin begin - :end end - :hiddenp hidden - :contents-begin contents-begin - :contents-end contents-end - :level (nth 1 components) - :priority (nth 3 components) - :tags tags - :todo-keyword todo - :todo-type todo-type - :post-blank (count-lines before-blank end)) - time-props - standard-props)))) - (org-element-put-property - inlinetask :title - (if raw-secondary-p raw-value - (org-element-parse-secondary-string - raw-value - (org-element-restriction 'inlinetask) - inlinetask)))))) - -(defun org-element-inlinetask-interpreter (inlinetask contents) - "Interpret INLINETASK element as Org syntax. -CONTENTS is the contents of inlinetask." - (let* ((level (org-element-property :level inlinetask)) - (todo (org-element-property :todo-keyword inlinetask)) - (priority (org-element-property :priority inlinetask)) - (title (org-element-interpret-data - (org-element-property :title inlinetask))) - (tags (let ((tag-list (org-element-property :tags inlinetask))) - (and tag-list - (format ":%s:" (mapconcat 'identity tag-list ":"))))) - (task (concat (make-string level ?*) - (and todo (concat " " todo)) - (and priority - (format " [#%s]" (char-to-string priority))) - (and title (concat " " title))))) - (concat task - ;; Align tags. - (when tags - (cond - ((zerop org-tags-column) (format " %s" tags)) - ((< org-tags-column 0) - (concat - (make-string - (max (- (+ org-tags-column (length task) (length tags))) 1) - ? ) - tags)) - (t - (concat - (make-string (max (- org-tags-column (length task)) 1) ? ) - tags)))) - ;; Prefer degenerate inlinetasks when there are no - ;; contents. - (when contents - (concat "\n" - contents - (make-string level ?*) " END"))))) - - -;;;; Item - -(defun org-element-item-parser (limit struct &optional raw-secondary-p) - "Parse an item. - -STRUCT is the structure of the plain list. - -Return a list whose CAR is `item' and CDR is a plist containing -`:bullet', `:begin', `:end', `:contents-begin', `:contents-end', -`:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and -`:post-blank' keywords. - -When optional argument RAW-SECONDARY-P is non-nil, item's tag, if -any, will not be parsed as a secondary string, but as a plain -string instead. - -Assume point is at the beginning of the item." - (save-excursion - (beginning-of-line) - (looking-at org-list-full-item-re) - (let* ((begin (point)) - (bullet (org-match-string-no-properties 1)) - (checkbox (let ((box (org-match-string-no-properties 3))) - (cond ((equal "[ ]" box) 'off) - ((equal "[X]" box) 'on) - ((equal "[-]" box) 'trans)))) - (counter (let ((c (org-match-string-no-properties 2))) - (save-match-data - (cond - ((not c) nil) - ((string-match "[A-Za-z]" c) - (- (string-to-char (upcase (match-string 0 c))) - 64)) - ((string-match "[0-9]+" c) - (string-to-number (match-string 0 c))))))) - (end (save-excursion (goto-char (org-list-get-item-end begin struct)) - (unless (bolp) (forward-line)) - (point))) - (contents-begin - (progn (goto-char - ;; Ignore tags in un-ordered lists: they are just - ;; a part of item's body. - (if (and (match-beginning 4) - (save-match-data (string-match "[.)]" bullet))) - (match-beginning 4) - (match-end 0))) - (skip-chars-forward " \r\t\n" limit) - ;; If first line isn't empty, contents really start - ;; at the text after item's meta-data. - (if (= (point-at-bol) begin) (point) (point-at-bol)))) - (hidden (progn (forward-line) - (and (not (= (point) end)) (org-invisible-p2)))) - (contents-end (progn (goto-char end) - (skip-chars-backward " \r\t\n") - (forward-line) - (point))) - (item - (list 'item - (list :bullet bullet - :begin begin - :end end - ;; CONTENTS-BEGIN and CONTENTS-END may be - ;; mixed up in the case of an empty item - ;; separated from the next by a blank line. - ;; Thus ensure the former is always the - ;; smallest. - :contents-begin (min contents-begin contents-end) - :contents-end (max contents-begin contents-end) - :checkbox checkbox - :counter counter - :hiddenp hidden - :structure struct - :post-blank (count-lines contents-end end))))) - (org-element-put-property - item :tag - (let ((raw-tag (org-list-get-tag begin struct))) - (and raw-tag - (if raw-secondary-p raw-tag - (org-element-parse-secondary-string - raw-tag (org-element-restriction 'item) item)))))))) - -(defun org-element-item-interpreter (item contents) - "Interpret ITEM element as Org syntax. -CONTENTS is the contents of the element." - (let* ((bullet (let ((bullet (org-element-property :bullet item))) - (org-list-bullet-string - (cond ((not (string-match "[0-9a-zA-Z]" bullet)) "- ") - ((eq org-plain-list-ordered-item-terminator ?\)) "1)") - (t "1."))))) - (checkbox (org-element-property :checkbox item)) - (counter (org-element-property :counter item)) - (tag (let ((tag (org-element-property :tag item))) - (and tag (org-element-interpret-data tag)))) - ;; Compute indentation. - (ind (make-string (length bullet) 32)) - (item-starts-with-par-p - (eq (org-element-type (car (org-element-contents item))) - 'paragraph))) - ;; Indent contents. - (concat - bullet - (and counter (format "[@%d] " counter)) - (case checkbox - (on "[X] ") - (off "[ ] ") - (trans "[-] ")) - (and tag (format "%s :: " tag)) - (when contents - (let ((contents (replace-regexp-in-string - "\\(^\\)[ \t]*\\S-" ind contents nil nil 1))) - (if item-starts-with-par-p (org-trim contents) - (concat "\n" contents))))))) - - -;;;; Plain List - -(defun org-element--list-struct (limit) - ;; Return structure of list at point. Internal function. See - ;; `org-list-struct' for details. - (let ((case-fold-search t) - (top-ind limit) - (item-re (org-item-re)) - (drawers-re (concat ":\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) - (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ ")) - items struct) - (save-excursion - (catch 'exit - (while t - (cond - ;; At limit: end all items. - ((>= (point) limit) - (throw 'exit - (let ((end (progn (skip-chars-backward " \r\t\n") - (forward-line) - (point)))) - (dolist (item items (sort (nconc items struct) - 'car-less-than-car)) - (setcar (nthcdr 6 item) end))))) - ;; At list end: end all items. - ((looking-at org-list-end-re) - (throw 'exit (dolist (item items (sort (nconc items struct) - 'car-less-than-car)) - (setcar (nthcdr 6 item) (point))))) - ;; At a new item: end previous sibling. - ((looking-at item-re) - (let ((ind (save-excursion (skip-chars-forward " \t") - (current-column)))) - (setq top-ind (min top-ind ind)) - (while (and items (<= ind (nth 1 (car items)))) - (let ((item (pop items))) - (setcar (nthcdr 6 item) (point)) - (push item struct))) - (push (progn (looking-at org-list-full-item-re) - (let ((bullet (match-string-no-properties 1))) - (list (point) - ind - bullet - (match-string-no-properties 2) ; counter - (match-string-no-properties 3) ; checkbox - ;; Description tag. - (and (save-match-data - (string-match "[-+*]" bullet)) - (match-string-no-properties 4)) - ;; Ending position, unknown so far. - nil))) - items)) - (forward-line 1)) - ;; Skip empty lines. - ((looking-at "^[ \t]*$") (forward-line)) - ;; Skip inline tasks and blank lines along the way. - ((and inlinetask-re (looking-at inlinetask-re)) - (forward-line) - (let ((origin (point))) - (when (re-search-forward inlinetask-re limit t) - (if (looking-at "^\\*+ END[ \t]*$") (forward-line) - (goto-char origin))))) - ;; At some text line. Check if it ends any previous item. - (t - (let ((ind (progn (skip-chars-forward " \t") (current-column)))) - (when (<= ind top-ind) - (skip-chars-backward " \r\t\n") - (forward-line)) - (while (<= ind (nth 1 (car items))) - (let ((item (pop items))) - (setcar (nthcdr 6 item) (line-beginning-position)) - (push item struct) - (unless items - (throw 'exit (sort struct 'car-less-than-car)))))) - ;; Skip blocks (any type) and drawers contents. - (cond - ((and (looking-at "#\\+BEGIN\\(:\\|_\\S-+\\)") - (re-search-forward - (format "^[ \t]*#\\+END%s[ \t]*$" - (org-match-string-no-properties 1)) - limit t))) - ((and (looking-at drawers-re) - (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))) - (forward-line)))))))) - -(defun org-element-plain-list-parser (limit affiliated structure) - "Parse a plain list. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. STRUCTURE is the structure of the plain list being -parsed. - -Return a list whose CAR is `plain-list' and CDR is a plist -containing `:type', `:begin', `:end', `:contents-begin' and -`:contents-end', `:structure', `:post-blank' and -`:post-affiliated' keywords. - -Assume point is at the beginning of the list." - (save-excursion - (let* ((struct (or structure (org-element--list-struct limit))) - (prevs (org-list-prevs-alist struct)) - (type (org-list-get-list-type (point) struct prevs)) - (contents-begin (point)) - (begin (car affiliated)) - (contents-end - (progn (goto-char (org-list-get-list-end (point) struct prevs)) - (unless (bolp) (forward-line)) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (= (point) limit) limit (line-beginning-position))))) - ;; Return value. - (list 'plain-list - (nconc - (list :type type - :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :structure struct - :post-blank (count-lines contents-end end) - :post-affiliated contents-begin) - (cdr affiliated)))))) - -(defun org-element-plain-list-interpreter (plain-list contents) - "Interpret PLAIN-LIST element as Org syntax. -CONTENTS is the contents of the element." - (with-temp-buffer - (insert contents) - (goto-char (point-min)) - (org-list-repair) - (buffer-string))) - - -;;;; Property Drawer - -(defun org-element-property-drawer-parser (limit affiliated) - "Parse a property drawer. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `property-drawer' and CDR is a plist -containing `:begin', `:end', `:hiddenp', `:contents-begin', -`:contents-end', `:post-blank' and `:post-affiliated' keywords. - -Assume point is at the beginning of the property drawer." - (save-excursion - (let ((case-fold-search t)) - (if (not (save-excursion - (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) - ;; Incomplete drawer: parse it as a paragraph. - (org-element-paragraph-parser limit affiliated) - (save-excursion - (let* ((drawer-end-line (match-beginning 0)) - (begin (car affiliated)) - (post-affiliated (point)) - (contents-begin (progn (forward-line) - (and (< (point) drawer-end-line) - (point)))) - (contents-end (and contents-begin drawer-end-line)) - (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char drawer-end-line) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'property-drawer - (nconc - (list :begin begin - :end end - :hiddenp hidden - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) - -(defun org-element-property-drawer-interpreter (property-drawer contents) - "Interpret PROPERTY-DRAWER element as Org syntax. -CONTENTS is the properties within the drawer." - (format ":PROPERTIES:\n%s:END:" contents)) - - -;;;; Quote Block - -(defun org-element-quote-block-parser (limit affiliated) - "Parse a quote block. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `quote-block' and CDR is a plist -containing `:begin', `:end', `:hiddenp', `:contents-begin', -`:contents-end', `:post-blank' and `:post-affiliated' keywords. - -Assume point is at the beginning of the block." - (let ((case-fold-search t)) - (if (not (save-excursion - (re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*$" limit t))) - ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit affiliated) - (let ((block-end-line (match-beginning 0))) - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - ;; Empty blocks have no contents. - (contents-begin (progn (forward-line) - (and (< (point) block-end-line) - (point)))) - (contents-end (and contents-begin block-end-line)) - (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char block-end-line) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'quote-block - (nconc - (list :begin begin - :end end - :hiddenp hidden - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) - -(defun org-element-quote-block-interpreter (quote-block contents) - "Interpret QUOTE-BLOCK element as Org syntax. -CONTENTS is the contents of the element." - (format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents)) - - -;;;; Section - -(defun org-element-section-parser (limit) - "Parse a section. - -LIMIT bounds the search. - -Return a list whose CAR is `section' and CDR is a plist -containing `:begin', `:end', `:contents-begin', `contents-end' -and `:post-blank' keywords." - (save-excursion - ;; Beginning of section is the beginning of the first non-blank - ;; line after previous headline. - (let ((begin (point)) - (end (progn (org-with-limited-levels (outline-next-heading)) - (point))) - (pos-before-blank (progn (skip-chars-backward " \r\t\n") - (forward-line) - (point)))) - (list 'section - (list :begin begin - :end end - :contents-begin begin - :contents-end pos-before-blank - :post-blank (count-lines pos-before-blank end)))))) - -(defun org-element-section-interpreter (section contents) - "Interpret SECTION element as Org syntax. -CONTENTS is the contents of the element." - contents) - - -;;;; Special Block - -(defun org-element-special-block-parser (limit affiliated) - "Parse a special block. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `special-block' and CDR is a plist -containing `:type', `:begin', `:end', `:hiddenp', -`:contents-begin', `:contents-end', `:post-blank' and -`:post-affiliated' keywords. - -Assume point is at the beginning of the block." - (let* ((case-fold-search t) - (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") - (upcase (match-string-no-properties 1))))) - (if (not (save-excursion - (re-search-forward - (format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type)) - limit t))) - ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit affiliated) - (let ((block-end-line (match-beginning 0))) - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - ;; Empty blocks have no contents. - (contents-begin (progn (forward-line) - (and (< (point) block-end-line) - (point)))) - (contents-end (and contents-begin block-end-line)) - (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char block-end-line) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'special-block - (nconc - (list :type type - :begin begin - :end end - :hiddenp hidden - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) - -(defun org-element-special-block-interpreter (special-block contents) - "Interpret SPECIAL-BLOCK element as Org syntax. -CONTENTS is the contents of the element." - (let ((block-type (org-element-property :type special-block))) - (format "#+BEGIN_%s\n%s#+END_%s" block-type contents block-type))) - - - -;;; Elements -;; -;; For each element, a parser and an interpreter are also defined. -;; Both follow the same naming convention used for greater elements. -;; -;; Also, as for greater elements, adding a new element type is done -;; through the following steps: implement a parser and an interpreter, -;; tweak `org-element--current-element' so that it recognizes the new -;; type and add that new type to `org-element-all-elements'. -;; -;; As a special case, when the newly defined type is a block type, -;; `org-element-block-name-alist' has to be modified accordingly. - - -;;;; Babel Call - -(defun org-element-babel-call-parser (limit affiliated) - "Parse a babel call. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `babel-call' and CDR is a plist -containing `:begin', `:end', `:info', `:post-blank' and -`:post-affiliated' as keywords." - (save-excursion - (let ((case-fold-search t) - (info (progn (looking-at org-babel-block-lob-one-liner-regexp) - (org-babel-lob-get-info))) - (begin (car affiliated)) - (post-affiliated (point)) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'babel-call - (nconc - (list :begin begin - :end end - :info info - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) - -(defun org-element-babel-call-interpreter (babel-call contents) - "Interpret BABEL-CALL element as Org syntax. -CONTENTS is nil." - (let* ((babel-info (org-element-property :info babel-call)) - (main (car babel-info)) - (post-options (nth 1 babel-info))) - (concat "#+CALL: " - (if (not (string-match "\\[\\(\\[.*?\\]\\)\\]" main)) main - ;; Remove redundant square brackets. - (replace-match (match-string 1 main) nil nil main)) - (and post-options (format "[%s]" post-options))))) - - -;;;; Clock - -(defun org-element-clock-parser (limit) - "Parse a clock. - -LIMIT bounds the search. - -Return a list whose CAR is `clock' and CDR is a plist containing -`:status', `:value', `:time', `:begin', `:end' and `:post-blank' -as keywords." - (save-excursion - (let* ((case-fold-search nil) - (begin (point)) - (value (progn (search-forward org-clock-string (line-end-position) t) - (skip-chars-forward " \t") - (org-element-timestamp-parser))) - (duration (and (search-forward " => " (line-end-position) t) - (progn (skip-chars-forward " \t") - (looking-at "\\(\\S-+\\)[ \t]*$")) - (org-match-string-no-properties 1))) - (status (if duration 'closed 'running)) - (post-blank (let ((before-blank (progn (forward-line) (point)))) - (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (unless (bolp) (end-of-line)) - (count-lines before-blank (point)))) - (end (point))) - (list 'clock - (list :status status - :value value - :duration duration - :begin begin - :end end - :post-blank post-blank))))) - -(defun org-element-clock-interpreter (clock contents) - "Interpret CLOCK element as Org syntax. -CONTENTS is nil." - (concat org-clock-string " " - (org-element-timestamp-interpreter - (org-element-property :value clock) nil) - (let ((duration (org-element-property :duration clock))) - (and duration - (concat " => " - (apply 'format - "%2s:%02s" - (org-split-string duration ":"))))))) - - -;;;; Comment - -(defun org-element-comment-parser (limit affiliated) - "Parse a comment. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `comment' and CDR is a plist -containing `:begin', `:end', `:value', `:post-blank', -`:post-affiliated' keywords. - -Assume point is at comment beginning." - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - (value (prog2 (looking-at "[ \t]*# ?") - (buffer-substring-no-properties - (match-end 0) (line-end-position)) - (forward-line))) - (com-end - ;; Get comments ending. - (progn - (while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)")) - ;; Accumulate lines without leading hash and first - ;; whitespace. - (setq value - (concat value - "\n" - (buffer-substring-no-properties - (match-end 0) (line-end-position)))) - (forward-line)) - (point))) - (end (progn (goto-char com-end) - (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'comment - (nconc - (list :begin begin - :end end - :value value - :post-blank (count-lines com-end end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) - -(defun org-element-comment-interpreter (comment contents) - "Interpret COMMENT element as Org syntax. -CONTENTS is nil." - (replace-regexp-in-string "^" "# " (org-element-property :value comment))) - - -;;;; Comment Block - -(defun org-element-comment-block-parser (limit affiliated) - "Parse an export block. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `comment-block' and CDR is a plist -containing `:begin', `:end', `:hiddenp', `:value', `:post-blank' -and `:post-affiliated' keywords. - -Assume point is at comment block beginning." - (let ((case-fold-search t)) - (if (not (save-excursion - (re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t))) - ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit affiliated) - (let ((contents-end (match-beginning 0))) - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - (contents-begin (progn (forward-line) (point))) - (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char contents-end) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position)))) - (value (buffer-substring-no-properties - contents-begin contents-end))) - (list 'comment-block - (nconc - (list :begin begin - :end end - :value value - :hiddenp hidden - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) - -(defun org-element-comment-block-interpreter (comment-block contents) - "Interpret COMMENT-BLOCK element as Org syntax. -CONTENTS is nil." - (format "#+BEGIN_COMMENT\n%s#+END_COMMENT" - (org-remove-indentation (org-element-property :value comment-block)))) - - -;;;; Diary Sexp - -(defun org-element-diary-sexp-parser (limit affiliated) - "Parse a diary sexp. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `diary-sexp' and CDR is a plist -containing `:begin', `:end', `:value', `:post-blank' and -`:post-affiliated' keywords." - (save-excursion - (let ((begin (car affiliated)) - (post-affiliated (point)) - (value (progn (looking-at "\\(%%(.*\\)[ \t]*$") - (org-match-string-no-properties 1))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'diary-sexp - (nconc - (list :value value - :begin begin - :end end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) - -(defun org-element-diary-sexp-interpreter (diary-sexp contents) - "Interpret DIARY-SEXP as Org syntax. -CONTENTS is nil." - (org-element-property :value diary-sexp)) - - -;;;; Example Block - -(defun org-element--remove-indentation (s &optional n) - "Remove maximum common indentation in string S and return it. -When optional argument N is a positive integer, remove exactly -that much characters from indentation, if possible, or return -S as-is otherwise. Unlike to `org-remove-indentation', this -function doesn't call `untabify' on S." - (catch 'exit - (with-temp-buffer - (insert s) - (goto-char (point-min)) - ;; Find maximum common indentation, if not specified. - (setq n (or n - (let ((min-ind (point-max))) - (save-excursion - (while (re-search-forward "^[ \t]*\\S-" nil t) - (let ((ind (1- (current-column)))) - (if (zerop ind) (throw 'exit s) - (setq min-ind (min min-ind ind)))))) - min-ind))) - (if (zerop n) s - ;; Remove exactly N indentation, but give up if not possible. - (while (not (eobp)) - (let ((ind (progn (skip-chars-forward " \t") (current-column)))) - (cond ((eolp) (delete-region (line-beginning-position) (point))) - ((< ind n) (throw 'exit s)) - (t (org-indent-line-to (- ind n)))) - (forward-line))) - (buffer-string))))) - -(defun org-element-example-block-parser (limit affiliated) - "Parse an example block. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `example-block' and CDR is a plist -containing `:begin', `:end', `:number-lines', `:preserve-indent', -`:retain-labels', `:use-labels', `:label-fmt', `:hiddenp', -`:switches', `:value', `:post-blank' and `:post-affiliated' -keywords." - (let ((case-fold-search t)) - (if (not (save-excursion - (re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t))) - ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit affiliated) - (let ((contents-end (match-beginning 0))) - (save-excursion - (let* ((switches - (progn - (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?") - (org-match-string-no-properties 1))) - ;; Switches analysis - (number-lines - (cond ((not switches) nil) - ((string-match "-n\\>" switches) 'new) - ((string-match "+n\\>" switches) 'continued))) - (preserve-indent - (or org-src-preserve-indentation - (and switches (string-match "-i\\>" switches)))) - ;; Should labels be retained in (or stripped from) example - ;; blocks? - (retain-labels - (or (not switches) - (not (string-match "-r\\>" switches)) - (and number-lines (string-match "-k\\>" switches)))) - ;; What should code-references use - labels or - ;; line-numbers? - (use-labels - (or (not switches) - (and retain-labels - (not (string-match "-k\\>" switches))))) - (label-fmt - (and switches - (string-match "-l +\"\\([^\"\n]+\\)\"" switches) - (match-string 1 switches))) - ;; Standard block parsing. - (begin (car affiliated)) - (post-affiliated (point)) - (block-ind (progn (skip-chars-forward " \t") (current-column))) - (contents-begin (progn (forward-line) (point))) - (hidden (org-invisible-p2)) - (value (org-element--remove-indentation - (org-unescape-code-in-string - (buffer-substring-no-properties - contents-begin contents-end)) - (and preserve-indent block-ind))) - (pos-before-blank (progn (goto-char contents-end) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'example-block - (nconc - (list :begin begin - :end end - :value value - :switches switches - :number-lines number-lines - :preserve-indent preserve-indent - :retain-labels retain-labels - :use-labels use-labels - :label-fmt label-fmt - :hiddenp hidden - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) - -(defun org-element-example-block-interpreter (example-block contents) - "Interpret EXAMPLE-BLOCK element as Org syntax. -CONTENTS is nil." - (let ((switches (org-element-property :switches example-block))) - (concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n" - (org-escape-code-in-string - (org-element-property :value example-block)) - "#+END_EXAMPLE"))) - - -;;;; Export Block - -(defun org-element-export-block-parser (limit affiliated) - "Parse an export block. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `export-block' and CDR is a plist -containing `:begin', `:end', `:type', `:hiddenp', `:value', -`:post-blank' and `:post-affiliated' keywords. - -Assume point is at export-block beginning." - (let* ((case-fold-search t) - (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") - (upcase (org-match-string-no-properties 1))))) - (if (not (save-excursion - (re-search-forward - (format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t))) - ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit affiliated) - (let ((contents-end (match-beginning 0))) - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - (contents-begin (progn (forward-line) (point))) - (hidden (org-invisible-p2)) - (pos-before-blank (progn (goto-char contents-end) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position)))) - (value (buffer-substring-no-properties contents-begin - contents-end))) - (list 'export-block - (nconc - (list :begin begin - :end end - :type type - :value value - :hiddenp hidden - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) - -(defun org-element-export-block-interpreter (export-block contents) - "Interpret EXPORT-BLOCK element as Org syntax. -CONTENTS is nil." - (let ((type (org-element-property :type export-block))) - (concat (format "#+BEGIN_%s\n" type) - (org-element-property :value export-block) - (format "#+END_%s" type)))) - - -;;;; Fixed-width - -(defun org-element-fixed-width-parser (limit affiliated) - "Parse a fixed-width section. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `fixed-width' and CDR is a plist -containing `:begin', `:end', `:value', `:post-blank' and -`:post-affiliated' keywords. - -Assume point is at the beginning of the fixed-width area." - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - value - (end-area - (progn - (while (and (< (point) limit) - (looking-at "[ \t]*:\\( \\|$\\)")) - ;; Accumulate text without starting colons. - (setq value - (concat value - (buffer-substring-no-properties - (match-end 0) (point-at-eol)) - "\n")) - (forward-line)) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'fixed-width - (nconc - (list :begin begin - :end end - :value value - :post-blank (count-lines end-area end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) - -(defun org-element-fixed-width-interpreter (fixed-width contents) - "Interpret FIXED-WIDTH element as Org syntax. -CONTENTS is nil." - (let ((value (org-element-property :value fixed-width))) - (and value - (replace-regexp-in-string - "^" ": " - (if (string-match "\n\\'" value) (substring value 0 -1) value))))) - - -;;;; Horizontal Rule - -(defun org-element-horizontal-rule-parser (limit affiliated) - "Parse an horizontal rule. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `horizontal-rule' and CDR is a plist -containing `:begin', `:end', `:post-blank' and `:post-affiliated' -keywords." - (save-excursion - (let ((begin (car affiliated)) - (post-affiliated (point)) - (post-hr (progn (forward-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'horizontal-rule - (nconc - (list :begin begin - :end end - :post-blank (count-lines post-hr end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) - -(defun org-element-horizontal-rule-interpreter (horizontal-rule contents) - "Interpret HORIZONTAL-RULE element as Org syntax. -CONTENTS is nil." - "-----") - - -;;;; Keyword - -(defun org-element-keyword-parser (limit affiliated) - "Parse a keyword at point. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `keyword' and CDR is a plist -containing `:key', `:value', `:begin', `:end', `:post-blank' and -`:post-affiliated' keywords." - (save-excursion - (let ((begin (car affiliated)) - (post-affiliated (point)) - (key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):") - (upcase (org-match-string-no-properties 1)))) - (value (org-trim (buffer-substring-no-properties - (match-end 0) (point-at-eol)))) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'keyword - (nconc - (list :key key - :value value - :begin begin - :end end - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated)))))) - -(defun org-element-keyword-interpreter (keyword contents) - "Interpret KEYWORD element as Org syntax. -CONTENTS is nil." - (format "#+%s: %s" - (org-element-property :key keyword) - (org-element-property :value keyword))) - - -;;;; Latex Environment - -(defun org-element-latex-environment-parser (limit affiliated) - "Parse a LaTeX environment. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `latex-environment' and CDR is a plist -containing `:begin', `:end', `:value', `:post-blank' and -`:post-affiliated' keywords. - -Assume point is at the beginning of the latex environment." - (save-excursion - (let ((case-fold-search t) - (code-begin (point))) - (looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}") - (if (not (re-search-forward (format "^[ \t]*\\\\end{%s}[ \t]*$" - (regexp-quote (match-string 1))) - limit t)) - ;; Incomplete latex environment: parse it as a paragraph. - (org-element-paragraph-parser limit affiliated) - (let* ((code-end (progn (forward-line) (point))) - (begin (car affiliated)) - (value (buffer-substring-no-properties code-begin code-end)) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'latex-environment - (nconc - (list :begin begin - :end end - :value value - :post-blank (count-lines code-end end) - :post-affiliated code-begin) - (cdr affiliated)))))))) - -(defun org-element-latex-environment-interpreter (latex-environment contents) - "Interpret LATEX-ENVIRONMENT element as Org syntax. -CONTENTS is nil." - (org-element-property :value latex-environment)) - - -;;;; Node Property - -(defun org-element-node-property-parser (limit) - "Parse a node-property at point. - -LIMIT bounds the search. - -Return a list whose CAR is `node-property' and CDR is a plist -containing `:key', `:value', `:begin', `:end' and `:post-blank' -keywords." - (save-excursion - (looking-at org-property-re) - (let ((case-fold-search t) - (begin (point)) - (key (org-match-string-no-properties 2)) - (value (org-match-string-no-properties 3)) - (pos-before-blank (progn (forward-line) (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (point-at-bol))))) - (list 'node-property - (list :key key - :value value - :begin begin - :end end - :post-blank (count-lines pos-before-blank end)))))) - -(defun org-element-node-property-interpreter (node-property contents) - "Interpret NODE-PROPERTY element as Org syntax. -CONTENTS is nil." - (format org-property-format - (format ":%s:" (org-element-property :key node-property)) - (org-element-property :value node-property))) - - -;;;; Paragraph - -(defun org-element-paragraph-parser (limit affiliated) - "Parse a paragraph. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `paragraph' and CDR is a plist -containing `:begin', `:end', `:contents-begin' and -`:contents-end', `:post-blank' and `:post-affiliated' keywords. - -Assume point is at the beginning of the paragraph." - (save-excursion - (let* ((begin (car affiliated)) - (contents-begin (point)) - (before-blank - (let ((case-fold-search t)) - (end-of-line) - (if (not (re-search-forward - org-element-paragraph-separate limit 'm)) - limit - ;; A matching `org-element-paragraph-separate' is not - ;; necessarily the end of the paragraph. In - ;; particular, lines starting with # or : as a first - ;; non-space character are ambiguous. We have check - ;; if they are valid Org syntax (i.e. not an - ;; incomplete keyword). - (beginning-of-line) - (while (not - (or - ;; There's no ambiguity for other symbols or - ;; empty lines: stop here. - (looking-at "[ \t]*\\(?:[^:#]\\|$\\)") - ;; Stop at valid fixed-width areas. - (looking-at "[ \t]*:\\(?: \\|$\\)") - ;; Stop at drawers. - (and (looking-at org-drawer-regexp) - (save-excursion - (re-search-forward - "^[ \t]*:END:[ \t]*$" limit t))) - ;; Stop at valid comments. - (looking-at "[ \t]*#\\(?: \\|$\\)") - ;; Stop at valid dynamic blocks. - (and (looking-at org-dblock-start-re) - (save-excursion - (re-search-forward - "^[ \t]*#\\+END:?[ \t]*$" limit t))) - ;; Stop at valid blocks. - (and (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") - (save-excursion - (re-search-forward - (format "^[ \t]*#\\+END_%s[ \t]*$" - (regexp-quote - (org-match-string-no-properties 1))) - limit t))) - ;; Stop at valid latex environments. - (and (looking-at - "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}") - (save-excursion - (re-search-forward - (format "^[ \t]*\\\\end{%s}[ \t]*$" - (regexp-quote - (org-match-string-no-properties 1))) - limit t))) - ;; Stop at valid keywords. - (looking-at "[ \t]*#\\+\\S-+:") - ;; Skip everything else. - (not - (progn - (end-of-line) - (re-search-forward org-element-paragraph-separate - limit 'm))))) - (beginning-of-line))) - (if (= (point) limit) limit - (goto-char (line-beginning-position))))) - (contents-end (progn (skip-chars-backward " \r\t\n" contents-begin) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'paragraph - (nconc - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank (count-lines before-blank end) - :post-affiliated contents-begin) - (cdr affiliated)))))) - -(defun org-element-paragraph-interpreter (paragraph contents) - "Interpret PARAGRAPH element as Org syntax. -CONTENTS is the contents of the element." - contents) - - -;;;; Planning - -(defun org-element-planning-parser (limit) - "Parse a planning. - -LIMIT bounds the search. - -Return a list whose CAR is `planning' and CDR is a plist -containing `:closed', `:deadline', `:scheduled', `:begin', `:end' -and `:post-blank' keywords." - (save-excursion - (let* ((case-fold-search nil) - (begin (point)) - (post-blank (let ((before-blank (progn (forward-line) (point)))) - (skip-chars-forward " \r\t\n" limit) - (skip-chars-backward " \t") - (unless (bolp) (end-of-line)) - (count-lines before-blank (point)))) - (end (point)) - closed deadline scheduled) - (goto-char begin) - (while (re-search-forward org-keyword-time-not-clock-regexp end t) - (goto-char (match-end 1)) - (skip-chars-forward " \t" end) - (let ((keyword (match-string 1)) - (time (org-element-timestamp-parser))) - (cond ((equal keyword org-closed-string) (setq closed time)) - ((equal keyword org-deadline-string) (setq deadline time)) - (t (setq scheduled time))))) - (list 'planning - (list :closed closed - :deadline deadline - :scheduled scheduled - :begin begin - :end end - :post-blank post-blank))))) - -(defun org-element-planning-interpreter (planning contents) - "Interpret PLANNING element as Org syntax. -CONTENTS is nil." - (mapconcat - 'identity - (delq nil - (list (let ((deadline (org-element-property :deadline planning))) - (when deadline - (concat org-deadline-string " " - (org-element-timestamp-interpreter deadline nil)))) - (let ((scheduled (org-element-property :scheduled planning))) - (when scheduled - (concat org-scheduled-string " " - (org-element-timestamp-interpreter scheduled nil)))) - (let ((closed (org-element-property :closed planning))) - (when closed - (concat org-closed-string " " - (org-element-timestamp-interpreter closed nil)))))) - " ")) - - -;;;; Quote Section - -(defun org-element-quote-section-parser (limit) - "Parse a quote section. - -LIMIT bounds the search. - -Return a list whose CAR is `quote-section' and CDR is a plist -containing `:begin', `:end', `:value' and `:post-blank' keywords. - -Assume point is at beginning of the section." - (save-excursion - (let* ((begin (point)) - (end (progn (org-with-limited-levels (outline-next-heading)) - (point))) - (pos-before-blank (progn (skip-chars-backward " \r\t\n") - (forward-line) - (point))) - (value (buffer-substring-no-properties begin pos-before-blank))) - (list 'quote-section - (list :begin begin - :end end - :value value - :post-blank (count-lines pos-before-blank end)))))) - -(defun org-element-quote-section-interpreter (quote-section contents) - "Interpret QUOTE-SECTION element as Org syntax. -CONTENTS is nil." - (org-element-property :value quote-section)) - - -;;;; Src Block - -(defun org-element-src-block-parser (limit affiliated) - "Parse a src block. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `src-block' and CDR is a plist -containing `:language', `:switches', `:parameters', `:begin', -`:end', `:hiddenp', `:number-lines', `:retain-labels', -`:use-labels', `:label-fmt', `:preserve-indent', `:value', -`:post-blank' and `:post-affiliated' keywords. - -Assume point is at the beginning of the block." - (let ((case-fold-search t)) - (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC[ \t]*$" - limit t))) - ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit affiliated) - (let ((contents-end (match-beginning 0))) - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - ;; Get language as a string. - (language - (progn - (looking-at - (concat "^[ \t]*#\\+BEGIN_SRC" - "\\(?: +\\(\\S-+\\)\\)?" - "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?" - "\\(.*\\)[ \t]*$")) - (org-match-string-no-properties 1))) - ;; Get switches. - (switches (org-match-string-no-properties 2)) - ;; Get parameters. - (parameters (org-match-string-no-properties 3)) - ;; Switches analysis - (number-lines - (cond ((not switches) nil) - ((string-match "-n\\>" switches) 'new) - ((string-match "+n\\>" switches) 'continued))) - (preserve-indent (or org-src-preserve-indentation - (and switches - (string-match "-i\\>" switches)))) - (label-fmt - (and switches - (string-match "-l +\"\\([^\"\n]+\\)\"" switches) - (match-string 1 switches))) - ;; Should labels be retained in (or stripped from) - ;; src blocks? - (retain-labels - (or (not switches) - (not (string-match "-r\\>" switches)) - (and number-lines (string-match "-k\\>" switches)))) - ;; What should code-references use - labels or - ;; line-numbers? - (use-labels - (or (not switches) - (and retain-labels - (not (string-match "-k\\>" switches))))) - ;; Indentation. - (block-ind (progn (skip-chars-forward " \t") (current-column))) - ;; Get visibility status. - (hidden (progn (forward-line) (org-invisible-p2))) - ;; Retrieve code. - (value (org-element--remove-indentation - (org-unescape-code-in-string - (buffer-substring-no-properties - (point) contents-end)) - (and preserve-indent block-ind))) - (pos-before-blank (progn (goto-char contents-end) - (forward-line) - (point))) - ;; Get position after ending blank lines. - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'src-block - (nconc - (list :language language - :switches (and (org-string-nw-p switches) - (org-trim switches)) - :parameters (and (org-string-nw-p parameters) - (org-trim parameters)) - :begin begin - :end end - :number-lines number-lines - :preserve-indent preserve-indent - :retain-labels retain-labels - :use-labels use-labels - :label-fmt label-fmt - :hiddenp hidden - :value value - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) - -(defun org-element-src-block-interpreter (src-block contents) - "Interpret SRC-BLOCK element as Org syntax. -CONTENTS is nil." - (let ((lang (org-element-property :language src-block)) - (switches (org-element-property :switches src-block)) - (params (org-element-property :parameters src-block)) - (value (let ((val (org-element-property :value src-block))) - (cond - ((org-element-property :preserve-indent src-block) val) - ((zerop org-edit-src-content-indentation) val) - (t - (let ((ind (make-string - org-edit-src-content-indentation 32))) - (replace-regexp-in-string - "\\(^\\)[ \t]*\\S-" ind val nil nil 1))))))) - (concat (format "#+BEGIN_SRC%s\n" - (concat (and lang (concat " " lang)) - (and switches (concat " " switches)) - (and params (concat " " params)))) - (org-escape-code-in-string value) - "#+END_SRC"))) - - -;;;; Table - -(defun org-element-table-parser (limit affiliated) - "Parse a table at point. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `table' and CDR is a plist containing -`:begin', `:end', `:tblfm', `:type', `:contents-begin', -`:contents-end', `:value', `:post-blank' and `:post-affiliated' -keywords. - -Assume point is at the beginning of the table." - (save-excursion - (let* ((case-fold-search t) - (table-begin (point)) - (type (if (org-at-table.el-p) 'table.el 'org)) - (begin (car affiliated)) - (table-end - (if (re-search-forward org-table-any-border-regexp limit 'm) - (goto-char (match-beginning 0)) - (point))) - (tblfm (let (acc) - (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$") - (push (org-match-string-no-properties 1) acc) - (forward-line)) - acc)) - (pos-before-blank (point)) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'table - (nconc - (list :begin begin - :end end - :type type - :tblfm tblfm - ;; Only `org' tables have contents. `table.el' tables - ;; use a `:value' property to store raw table as - ;; a string. - :contents-begin (and (eq type 'org) table-begin) - :contents-end (and (eq type 'org) table-end) - :value (and (eq type 'table.el) - (buffer-substring-no-properties - table-begin table-end)) - :post-blank (count-lines pos-before-blank end) - :post-affiliated table-begin) - (cdr affiliated)))))) - -(defun org-element-table-interpreter (table contents) - "Interpret TABLE element as Org syntax. -CONTENTS is nil." - (if (eq (org-element-property :type table) 'table.el) - (org-remove-indentation (org-element-property :value table)) - (concat (with-temp-buffer (insert contents) - (org-table-align) - (buffer-string)) - (mapconcat (lambda (fm) (concat "#+TBLFM: " fm)) - (reverse (org-element-property :tblfm table)) - "\n")))) - - -;;;; Table Row - -(defun org-element-table-row-parser (limit) - "Parse table row at point. - -LIMIT bounds the search. - -Return a list whose CAR is `table-row' and CDR is a plist -containing `:begin', `:end', `:contents-begin', `:contents-end', -`:type' and `:post-blank' keywords." - (save-excursion - (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard)) - (begin (point)) - ;; A table rule has no contents. In that case, ensure - ;; CONTENTS-BEGIN matches CONTENTS-END. - (contents-begin (and (eq type 'standard) - (search-forward "|") - (point))) - (contents-end (and (eq type 'standard) - (progn - (end-of-line) - (skip-chars-backward " \t") - (point)))) - (end (progn (forward-line) (point)))) - (list 'table-row - (list :type type - :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank 0))))) - -(defun org-element-table-row-interpreter (table-row contents) - "Interpret TABLE-ROW element as Org syntax. -CONTENTS is the contents of the table row." - (if (eq (org-element-property :type table-row) 'rule) "|-" - (concat "| " contents))) - - -;;;; Verse Block - -(defun org-element-verse-block-parser (limit affiliated) - "Parse a verse block. - -LIMIT bounds the search. AFFILIATED is a list of which CAR is -the buffer position at the beginning of the first affiliated -keyword and CDR is a plist of affiliated keywords along with -their value. - -Return a list whose CAR is `verse-block' and CDR is a plist -containing `:begin', `:end', `:contents-begin', `:contents-end', -`:hiddenp', `:post-blank' and `:post-affiliated' keywords. - -Assume point is at beginning of the block." - (let ((case-fold-search t)) - (if (not (save-excursion - (re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t))) - ;; Incomplete block: parse it as a paragraph. - (org-element-paragraph-parser limit affiliated) - (let ((contents-end (match-beginning 0))) - (save-excursion - (let* ((begin (car affiliated)) - (post-affiliated (point)) - (hidden (progn (forward-line) (org-invisible-p2))) - (contents-begin (point)) - (pos-before-blank (progn (goto-char contents-end) - (forward-line) - (point))) - (end (progn (skip-chars-forward " \r\t\n" limit) - (if (eobp) (point) (line-beginning-position))))) - (list 'verse-block - (nconc - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :hiddenp hidden - :post-blank (count-lines pos-before-blank end) - :post-affiliated post-affiliated) - (cdr affiliated))))))))) - -(defun org-element-verse-block-interpreter (verse-block contents) - "Interpret VERSE-BLOCK element as Org syntax. -CONTENTS is verse block contents." - (format "#+BEGIN_VERSE\n%s#+END_VERSE" contents)) - - - -;;; Objects -;; -;; Unlike to elements, interstices can be found between objects. -;; That's why, along with the parser, successor functions are provided -;; for each object. Some objects share the same successor (i.e. `code' -;; and `verbatim' objects). -;; -;; A successor must accept a single argument bounding the search. It -;; will return either a cons cell whose CAR is the object's type, as -;; a symbol, and CDR the position of its next occurrence, or nil. -;; -;; Successors follow the naming convention: -;; org-element-NAME-successor, where NAME is the name of the -;; successor, as defined in `org-element-all-successors'. -;; -;; Some object types (i.e. `italic') are recursive. Restrictions on -;; object types they can contain will be specified in -;; `org-element-object-restrictions'. -;; -;; Adding a new type of object is simple. Implement a successor, -;; a parser, and an interpreter for it, all following the naming -;; convention. Register type in `org-element-all-objects' and -;; successor in `org-element-all-successors'. Maybe tweak -;; restrictions about it, and that's it. - - -;;;; Bold - -(defun org-element-bold-parser () - "Parse bold object at point. - -Return a list whose CAR is `bold' and CDR is a plist with -`:begin', `:end', `:contents-begin' and `:contents-end' and -`:post-blank' keywords. - -Assume point is at the first star marker." - (save-excursion - (unless (bolp) (backward-char 1)) - (looking-at org-emph-re) - (let ((begin (match-beginning 2)) - (contents-begin (match-beginning 4)) - (contents-end (match-end 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'bold - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank))))) - -(defun org-element-bold-interpreter (bold contents) - "Interpret BOLD object as Org syntax. -CONTENTS is the contents of the object." - (format "*%s*" contents)) - -(defun org-element-text-markup-successor () - "Search for the next text-markup object. - -Return value is a cons cell whose CAR is a symbol among `bold', -`italic', `underline', `strike-through', `code' and `verbatim' -and CDR is beginning position." - (save-excursion - (unless (bolp) (backward-char)) - (when (re-search-forward org-emph-re nil t) - (let ((marker (match-string 3))) - (cons (cond - ((equal marker "*") 'bold) - ((equal marker "/") 'italic) - ((equal marker "_") 'underline) - ((equal marker "+") 'strike-through) - ((equal marker "~") 'code) - ((equal marker "=") 'verbatim) - (t (error "Unknown marker at %d" (match-beginning 3)))) - (match-beginning 2)))))) - - -;;;; Code - -(defun org-element-code-parser () - "Parse code object at point. - -Return a list whose CAR is `code' and CDR is a plist with -`:value', `:begin', `:end' and `:post-blank' keywords. - -Assume point is at the first tilde marker." - (save-excursion - (unless (bolp) (backward-char 1)) - (looking-at org-emph-re) - (let ((begin (match-beginning 2)) - (value (org-match-string-no-properties 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'code - (list :value value - :begin begin - :end end - :post-blank post-blank))))) - -(defun org-element-code-interpreter (code contents) - "Interpret CODE object as Org syntax. -CONTENTS is nil." - (format "~%s~" (org-element-property :value code))) - - -;;;; Entity - -(defun org-element-entity-parser () - "Parse entity at point. - -Return a list whose CAR is `entity' and CDR a plist with -`:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1', -`:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as -keywords. - -Assume point is at the beginning of the entity." - (save-excursion - (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)") - (let* ((value (org-entity-get (match-string 1))) - (begin (match-beginning 0)) - (bracketsp (string= (match-string 2) "{}")) - (post-blank (progn (goto-char (match-end 1)) - (when bracketsp (forward-char 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'entity - (list :name (car value) - :latex (nth 1 value) - :latex-math-p (nth 2 value) - :html (nth 3 value) - :ascii (nth 4 value) - :latin1 (nth 5 value) - :utf-8 (nth 6 value) - :begin begin - :end end - :use-brackets-p bracketsp - :post-blank post-blank))))) - -(defun org-element-entity-interpreter (entity contents) - "Interpret ENTITY object as Org syntax. -CONTENTS is nil." - (concat "\\" - (org-element-property :name entity) - (when (org-element-property :use-brackets-p entity) "{}"))) - -(defun org-element-latex-or-entity-successor () - "Search for the next latex-fragment or entity object. - -Return value is a cons cell whose CAR is `entity' or -`latex-fragment' and CDR is beginning position." - (save-excursion - (unless (bolp) (backward-char)) - (let ((matchers (cdr org-latex-regexps)) - ;; ENTITY-RE matches both LaTeX commands and Org entities. - (entity-re - "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")) - (when (re-search-forward - (concat (mapconcat #'cadr matchers "\\|") "\\|" entity-re) nil t) - (goto-char (match-beginning 0)) - (if (looking-at entity-re) - ;; Determine if it's a real entity or a LaTeX command. - (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment) - (match-beginning 0)) - ;; No entity nor command: point is at a LaTeX fragment. - ;; Determine its type to get the correct beginning position. - (cons 'latex-fragment - (catch 'return - (dolist (e matchers) - (when (looking-at (nth 1 e)) - (throw 'return (match-beginning (nth 2 e))))) - (point)))))))) - - -;;;; Export Snippet - -(defun org-element-export-snippet-parser () - "Parse export snippet at point. - -Return a list whose CAR is `export-snippet' and CDR a plist with -`:begin', `:end', `:back-end', `:value' and `:post-blank' as -keywords. - -Assume point is at the beginning of the snippet." - (save-excursion - (re-search-forward "@@\\([-A-Za-z0-9]+\\):" nil t) - (let* ((begin (match-beginning 0)) - (back-end (org-match-string-no-properties 1)) - (value (buffer-substring-no-properties - (point) - (progn (re-search-forward "@@" nil t) (match-beginning 0)))) - (post-blank (skip-chars-forward " \t")) - (end (point))) - (list 'export-snippet - (list :back-end back-end - :value value - :begin begin - :end end - :post-blank post-blank))))) - -(defun org-element-export-snippet-interpreter (export-snippet contents) - "Interpret EXPORT-SNIPPET object as Org syntax. -CONTENTS is nil." - (format "@@%s:%s@@" - (org-element-property :back-end export-snippet) - (org-element-property :value export-snippet))) - -(defun org-element-export-snippet-successor () - "Search for the next export-snippet object. - -Return value is a cons cell whose CAR is `export-snippet' and CDR -its beginning position." - (save-excursion - (let (beg) - (when (and (re-search-forward "@@[-A-Za-z0-9]+:" nil t) - (setq beg (match-beginning 0)) - (search-forward "@@" nil t)) - (cons 'export-snippet beg))))) - - -;;;; Footnote Reference - -(defun org-element-footnote-reference-parser () - "Parse footnote reference at point. - -Return a list whose CAR is `footnote-reference' and CDR a plist -with `:label', `:type', `:inline-definition', `:begin', `:end' -and `:post-blank' as keywords." - (save-excursion - (looking-at org-footnote-re) - (let* ((begin (point)) - (label (or (org-match-string-no-properties 2) - (org-match-string-no-properties 3) - (and (match-string 1) - (concat "fn:" (org-match-string-no-properties 1))))) - (type (if (or (not label) (match-string 1)) 'inline 'standard)) - (inner-begin (match-end 0)) - (inner-end - (let ((count 1)) - (forward-char) - (while (and (> count 0) (re-search-forward "[][]" nil t)) - (if (equal (match-string 0) "[") (incf count) (decf count))) - (1- (point)))) - (post-blank (progn (goto-char (1+ inner-end)) - (skip-chars-forward " \t"))) - (end (point)) - (footnote-reference - (list 'footnote-reference - (list :label label - :type type - :begin begin - :end end - :post-blank post-blank)))) - (org-element-put-property - footnote-reference :inline-definition - (and (eq type 'inline) - (org-element-parse-secondary-string - (buffer-substring inner-begin inner-end) - (org-element-restriction 'footnote-reference) - footnote-reference)))))) - -(defun org-element-footnote-reference-interpreter (footnote-reference contents) - "Interpret FOOTNOTE-REFERENCE object as Org syntax. -CONTENTS is nil." - (let ((label (or (org-element-property :label footnote-reference) "fn:")) - (def - (let ((inline-def - (org-element-property :inline-definition footnote-reference))) - (if (not inline-def) "" - (concat ":" (org-element-interpret-data inline-def)))))) - (format "[%s]" (concat label def)))) - -(defun org-element-footnote-reference-successor () - "Search for the next footnote-reference object. - -Return value is a cons cell whose CAR is `footnote-reference' and -CDR is beginning position." - (save-excursion - (catch 'exit - (while (re-search-forward org-footnote-re nil t) - (save-excursion - (let ((beg (match-beginning 0)) - (count 1)) - (backward-char) - (while (re-search-forward "[][]" nil t) - (if (equal (match-string 0) "[") (incf count) (decf count)) - (when (zerop count) - (throw 'exit (cons 'footnote-reference beg)))))))))) - - -;;;; Inline Babel Call - -(defun org-element-inline-babel-call-parser () - "Parse inline babel call at point. - -Return a list whose CAR is `inline-babel-call' and CDR a plist -with `:begin', `:end', `:info' and `:post-blank' as keywords. - -Assume point is at the beginning of the babel call." - (save-excursion - (unless (bolp) (backward-char)) - (looking-at org-babel-inline-lob-one-liner-regexp) - (let ((info (save-match-data (org-babel-lob-get-info))) - (begin (match-end 1)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'inline-babel-call - (list :begin begin - :end end - :info info - :post-blank post-blank))))) - -(defun org-element-inline-babel-call-interpreter (inline-babel-call contents) - "Interpret INLINE-BABEL-CALL object as Org syntax. -CONTENTS is nil." - (let* ((babel-info (org-element-property :info inline-babel-call)) - (main-source (car babel-info)) - (post-options (nth 1 babel-info))) - (concat "call_" - (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source) - ;; Remove redundant square brackets. - (replace-match - (match-string 1 main-source) nil nil main-source) - main-source) - (and post-options (format "[%s]" post-options))))) - -(defun org-element-inline-babel-call-successor () - "Search for the next inline-babel-call object. - -Return value is a cons cell whose CAR is `inline-babel-call' and -CDR is beginning position." - (save-excursion - ;; Use a simplified version of - ;; `org-babel-inline-lob-one-liner-regexp'. - (when (re-search-forward - "call_\\([^()\n]+?\\)\\(?:\\[.*?\\]\\)?([^\n]*?)\\(\\[.*?\\]\\)?" - nil t) - (cons 'inline-babel-call (match-beginning 0))))) - - -;;;; Inline Src Block - -(defun org-element-inline-src-block-parser () - "Parse inline source block at point. - -Return a list whose CAR is `inline-src-block' and CDR a plist -with `:begin', `:end', `:language', `:value', `:parameters' and -`:post-blank' as keywords. - -Assume point is at the beginning of the inline src block." - (save-excursion - (unless (bolp) (backward-char)) - (looking-at org-babel-inline-src-block-regexp) - (let ((begin (match-beginning 1)) - (language (org-match-string-no-properties 2)) - (parameters (org-match-string-no-properties 4)) - (value (org-match-string-no-properties 5)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'inline-src-block - (list :language language - :value value - :parameters parameters - :begin begin - :end end - :post-blank post-blank))))) - -(defun org-element-inline-src-block-interpreter (inline-src-block contents) - "Interpret INLINE-SRC-BLOCK object as Org syntax. -CONTENTS is nil." - (let ((language (org-element-property :language inline-src-block)) - (arguments (org-element-property :parameters inline-src-block)) - (body (org-element-property :value inline-src-block))) - (format "src_%s%s{%s}" - language - (if arguments (format "[%s]" arguments) "") - body))) - -(defun org-element-inline-src-block-successor () - "Search for the next inline-babel-call element. - -Return value is a cons cell whose CAR is `inline-babel-call' and -CDR is beginning position." - (save-excursion - (unless (bolp) (backward-char)) - (when (re-search-forward org-babel-inline-src-block-regexp nil t) - (cons 'inline-src-block (match-beginning 1))))) - -;;;; Italic - -(defun org-element-italic-parser () - "Parse italic object at point. - -Return a list whose CAR is `italic' and CDR is a plist with -`:begin', `:end', `:contents-begin' and `:contents-end' and -`:post-blank' keywords. - -Assume point is at the first slash marker." - (save-excursion - (unless (bolp) (backward-char 1)) - (looking-at org-emph-re) - (let ((begin (match-beginning 2)) - (contents-begin (match-beginning 4)) - (contents-end (match-end 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'italic - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank))))) - -(defun org-element-italic-interpreter (italic contents) - "Interpret ITALIC object as Org syntax. -CONTENTS is the contents of the object." - (format "/%s/" contents)) - - -;;;; Latex Fragment - -(defun org-element-latex-fragment-parser () - "Parse LaTeX fragment at point. - -Return a list whose CAR is `latex-fragment' and CDR a plist with -`:value', `:begin', `:end', and `:post-blank' as keywords. - -Assume point is at the beginning of the LaTeX fragment." - (save-excursion - (let* ((begin (point)) - (substring-match - (catch 'exit - (dolist (e (cdr org-latex-regexps)) - (let ((latex-regexp (nth 1 e))) - (when (or (looking-at latex-regexp) - (and (not (bobp)) - (save-excursion - (backward-char) - (looking-at latex-regexp)))) - (throw 'exit (nth 2 e))))) - ;; None found: it's a macro. - (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*") - 0)) - (value (org-match-string-no-properties substring-match)) - (post-blank (progn (goto-char (match-end substring-match)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'latex-fragment - (list :value value - :begin begin - :end end - :post-blank post-blank))))) - -(defun org-element-latex-fragment-interpreter (latex-fragment contents) - "Interpret LATEX-FRAGMENT object as Org syntax. -CONTENTS is nil." - (org-element-property :value latex-fragment)) - -;;;; Line Break - -(defun org-element-line-break-parser () - "Parse line break at point. - -Return a list whose CAR is `line-break', and CDR a plist with -`:begin', `:end' and `:post-blank' keywords. - -Assume point is at the beginning of the line break." - (list 'line-break - (list :begin (point) - :end (progn (forward-line) (point)) - :post-blank 0))) - -(defun org-element-line-break-interpreter (line-break contents) - "Interpret LINE-BREAK object as Org syntax. -CONTENTS is nil." - "\\\\\n") - -(defun org-element-line-break-successor () - "Search for the next line-break object. - -Return value is a cons cell whose CAR is `line-break' and CDR is -beginning position." - (save-excursion - (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" nil t) - (goto-char (match-beginning 1))))) - ;; A line break can only happen on a non-empty line. - (when (and beg (re-search-backward "\\S-" (point-at-bol) t)) - (cons 'line-break beg))))) - - -;;;; Link - -(defun org-element-link-parser () - "Parse link at point. - -Return a list whose CAR is `link' and CDR a plist with `:type', -`:path', `:raw-link', `:application', `:search-option', `:begin', -`:end', `:contents-begin', `:contents-end' and `:post-blank' as -keywords. - -Assume point is at the beginning of the link." - (save-excursion - (let ((begin (point)) - end contents-begin contents-end link-end post-blank path type - raw-link link search-option application) - (cond - ;; Type 1: Text targeted from a radio target. - ((and org-target-link-regexp (looking-at org-target-link-regexp)) - (setq type "radio" - link-end (match-end 0) - path (org-match-string-no-properties 0))) - ;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]] - ((looking-at org-bracket-link-regexp) - (setq contents-begin (match-beginning 3) - contents-end (match-end 3) - link-end (match-end 0) - ;; RAW-LINK is the original link. Expand any - ;; abbreviation in it. - raw-link (org-translate-link - (org-link-expand-abbrev - (org-match-string-no-properties 1)))) - ;; Determine TYPE of link and set PATH accordingly. - (cond - ;; File type. - ((or (file-name-absolute-p raw-link) - (string-match "^\\.\\.?/" raw-link)) - (setq type "file" path raw-link)) - ;; Explicit type (http, irc, bbdb...). See `org-link-types'. - ((string-match org-link-re-with-space3 raw-link) - (setq type (match-string 1 raw-link) path (match-string 2 raw-link))) - ;; Id type: PATH is the id. - ((string-match "^id:\\([-a-f0-9]+\\)" raw-link) - (setq type "id" path (match-string 1 raw-link))) - ;; Code-ref type: PATH is the name of the reference. - ((string-match "^(\\(.*\\))$" raw-link) - (setq type "coderef" path (match-string 1 raw-link))) - ;; Custom-id type: PATH is the name of the custom id. - ((= (aref raw-link 0) ?#) - (setq type "custom-id" path (substring raw-link 1))) - ;; Fuzzy type: Internal link either matches a target, an - ;; headline name or nothing. PATH is the target or - ;; headline's name. - (t (setq type "fuzzy" path raw-link)))) - ;; Type 3: Plain link, i.e. http://orgmode.org - ((looking-at org-plain-link-re) - (setq raw-link (org-match-string-no-properties 0) - type (org-match-string-no-properties 1) - link-end (match-end 0) - path (org-match-string-no-properties 2))) - ;; Type 4: Angular link, i.e. - ((looking-at org-angle-link-re) - (setq raw-link (buffer-substring-no-properties - (match-beginning 1) (match-end 2)) - type (org-match-string-no-properties 1) - link-end (match-end 0) - path (org-match-string-no-properties 2)))) - ;; In any case, deduce end point after trailing white space from - ;; LINK-END variable. - (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t")) - end (point)) - ;; Extract search option and opening application out of - ;; "file"-type links. - (when (member type org-element-link-type-is-file) - ;; Application. - (cond ((string-match "^file\\+\\(.*\\)$" type) - (setq application (match-string 1 type))) - ((not (string-match "^file" type)) - (setq application type))) - ;; Extract search option from PATH. - (when (string-match "::\\(.*\\)$" path) - (setq search-option (match-string 1 path) - path (replace-match "" nil nil path))) - ;; Make sure TYPE always reports "file". - (setq type "file")) - (list 'link - (list :type type - :path path - :raw-link (or raw-link path) - :application application - :search-option search-option - :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank))))) - -(defun org-element-link-interpreter (link contents) - "Interpret LINK object as Org syntax. -CONTENTS is the contents of the object, or nil." - (let ((type (org-element-property :type link)) - (raw-link (org-element-property :raw-link link))) - (if (string= type "radio") raw-link - (format "[[%s]%s]" - raw-link - (if contents (format "[%s]" contents) ""))))) - -(defun org-element-link-successor () - "Search for the next link object. - -Return value is a cons cell whose CAR is `link' and CDR is -beginning position." - (save-excursion - (let ((link-regexp - (if (not org-target-link-regexp) org-any-link-re - (concat org-any-link-re "\\|" org-target-link-regexp)))) - (when (re-search-forward link-regexp nil t) - (cons 'link (match-beginning 0)))))) - -(defun org-element-plain-link-successor () - "Search for the next plain link object. - -Return value is a cons cell whose CAR is `link' and CDR is -beginning position." - (and (save-excursion (re-search-forward org-plain-link-re nil t)) - (cons 'link (match-beginning 0)))) - - -;;;; Macro - -(defun org-element-macro-parser () - "Parse macro at point. - -Return a list whose CAR is `macro' and CDR a plist with `:key', -`:args', `:begin', `:end', `:value' and `:post-blank' as -keywords. - -Assume point is at the macro." - (save-excursion - (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}") - (let ((begin (point)) - (key (downcase (org-match-string-no-properties 1))) - (value (org-match-string-no-properties 0)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point)) - (args (let ((args (org-match-string-no-properties 3))) - (when args - ;; Do not use `org-split-string' since empty - ;; strings are meaningful here. - (split-string - (replace-regexp-in-string - "\\(\\\\*\\)\\(,\\)" - (lambda (str) - (let ((len (length (match-string 1 str)))) - (concat (make-string (/ len 2) ?\\) - (if (zerop (mod len 2)) "\000" ",")))) - args nil t) - "\000"))))) - (list 'macro - (list :key key - :value value - :args args - :begin begin - :end end - :post-blank post-blank))))) - -(defun org-element-macro-interpreter (macro contents) - "Interpret MACRO object as Org syntax. -CONTENTS is nil." - (org-element-property :value macro)) - -(defun org-element-macro-successor () - "Search for the next macro object. - -Return value is cons cell whose CAR is `macro' and CDR is -beginning position." - (save-excursion - (when (re-search-forward - "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}" - nil t) - (cons 'macro (match-beginning 0))))) - - -;;;; Radio-target - -(defun org-element-radio-target-parser () - "Parse radio target at point. - -Return a list whose CAR is `radio-target' and CDR a plist with -`:begin', `:end', `:contents-begin', `:contents-end', `:value' -and `:post-blank' as keywords. - -Assume point is at the radio target." - (save-excursion - (looking-at org-radio-target-regexp) - (let ((begin (point)) - (contents-begin (match-beginning 1)) - (contents-end (match-end 1)) - (value (org-match-string-no-properties 1)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'radio-target - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank - :value value))))) - -(defun org-element-radio-target-interpreter (target contents) - "Interpret TARGET object as Org syntax. -CONTENTS is the contents of the object." - (concat "<<<" contents ">>>")) - -(defun org-element-radio-target-successor () - "Search for the next radio-target object. - -Return value is a cons cell whose CAR is `radio-target' and CDR -is beginning position." - (save-excursion - (when (re-search-forward org-radio-target-regexp nil t) - (cons 'radio-target (match-beginning 0))))) - - -;;;; Statistics Cookie - -(defun org-element-statistics-cookie-parser () - "Parse statistics cookie at point. - -Return a list whose CAR is `statistics-cookie', and CDR a plist -with `:begin', `:end', `:value' and `:post-blank' keywords. - -Assume point is at the beginning of the statistics-cookie." - (save-excursion - (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]") - (let* ((begin (point)) - (value (buffer-substring-no-properties - (match-beginning 0) (match-end 0))) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'statistics-cookie - (list :begin begin - :end end - :value value - :post-blank post-blank))))) - -(defun org-element-statistics-cookie-interpreter (statistics-cookie contents) - "Interpret STATISTICS-COOKIE object as Org syntax. -CONTENTS is nil." - (org-element-property :value statistics-cookie)) - -(defun org-element-statistics-cookie-successor () - "Search for the next statistics cookie object. - -Return value is a cons cell whose CAR is `statistics-cookie' and -CDR is beginning position." - (save-excursion - (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" nil t) - (cons 'statistics-cookie (match-beginning 0))))) - - -;;;; Strike-Through - -(defun org-element-strike-through-parser () - "Parse strike-through object at point. - -Return a list whose CAR is `strike-through' and CDR is a plist -with `:begin', `:end', `:contents-begin' and `:contents-end' and -`:post-blank' keywords. - -Assume point is at the first plus sign marker." - (save-excursion - (unless (bolp) (backward-char 1)) - (looking-at org-emph-re) - (let ((begin (match-beginning 2)) - (contents-begin (match-beginning 4)) - (contents-end (match-end 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'strike-through - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank))))) - -(defun org-element-strike-through-interpreter (strike-through contents) - "Interpret STRIKE-THROUGH object as Org syntax. -CONTENTS is the contents of the object." - (format "+%s+" contents)) - - -;;;; Subscript - -(defun org-element-subscript-parser () - "Parse subscript at point. - -Return a list whose CAR is `subscript' and CDR a plist with -`:begin', `:end', `:contents-begin', `:contents-end', -`:use-brackets-p' and `:post-blank' as keywords. - -Assume point is at the underscore." - (save-excursion - (unless (bolp) (backward-char)) - (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) - t - (not (looking-at org-match-substring-regexp)))) - (begin (match-beginning 2)) - (contents-begin (or (match-beginning 5) - (match-beginning 3))) - (contents-end (or (match-end 5) (match-end 3))) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'subscript - (list :begin begin - :end end - :use-brackets-p bracketsp - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank))))) - -(defun org-element-subscript-interpreter (subscript contents) - "Interpret SUBSCRIPT object as Org syntax. -CONTENTS is the contents of the object." - (format - (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s") - contents)) - -(defun org-element-sub/superscript-successor () - "Search for the next sub/superscript object. - -Return value is a cons cell whose CAR is either `subscript' or -`superscript' and CDR is beginning position." - (save-excursion - (unless (bolp) (backward-char)) - (when (re-search-forward org-match-substring-regexp nil t) - (cons (if (string= (match-string 2) "_") 'subscript 'superscript) - (match-beginning 2))))) - - -;;;; Superscript - -(defun org-element-superscript-parser () - "Parse superscript at point. - -Return a list whose CAR is `superscript' and CDR a plist with -`:begin', `:end', `:contents-begin', `:contents-end', -`:use-brackets-p' and `:post-blank' as keywords. - -Assume point is at the caret." - (save-excursion - (unless (bolp) (backward-char)) - (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) t - (not (looking-at org-match-substring-regexp)))) - (begin (match-beginning 2)) - (contents-begin (or (match-beginning 5) - (match-beginning 3))) - (contents-end (or (match-end 5) (match-end 3))) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'superscript - (list :begin begin - :end end - :use-brackets-p bracketsp - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank))))) - -(defun org-element-superscript-interpreter (superscript contents) - "Interpret SUPERSCRIPT object as Org syntax. -CONTENTS is the contents of the object." - (format - (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s") - contents)) - - -;;;; Table Cell - -(defun org-element-table-cell-parser () - "Parse table cell at point. - -Return a list whose CAR is `table-cell' and CDR is a plist -containing `:begin', `:end', `:contents-begin', `:contents-end' -and `:post-blank' keywords." - (looking-at "[ \t]*\\(.*?\\)[ \t]*|") - (let* ((begin (match-beginning 0)) - (end (match-end 0)) - (contents-begin (match-beginning 1)) - (contents-end (match-end 1))) - (list 'table-cell - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank 0)))) - -(defun org-element-table-cell-interpreter (table-cell contents) - "Interpret TABLE-CELL element as Org syntax. -CONTENTS is the contents of the cell, or nil." - (concat " " contents " |")) - -(defun org-element-table-cell-successor () - "Search for the next table-cell object. - -Return value is a cons cell whose CAR is `table-cell' and CDR is -beginning position." - (when (looking-at "[ \t]*.*?[ \t]*|") (cons 'table-cell (point)))) - - -;;;; Target - -(defun org-element-target-parser () - "Parse target at point. - -Return a list whose CAR is `target' and CDR a plist with -`:begin', `:end', `:value' and `:post-blank' as keywords. - -Assume point is at the target." - (save-excursion - (looking-at org-target-regexp) - (let ((begin (point)) - (value (org-match-string-no-properties 1)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'target - (list :begin begin - :end end - :value value - :post-blank post-blank))))) - -(defun org-element-target-interpreter (target contents) - "Interpret TARGET object as Org syntax. -CONTENTS is nil." - (format "<<%s>>" (org-element-property :value target))) - -(defun org-element-target-successor () - "Search for the next target object. - -Return value is a cons cell whose CAR is `target' and CDR is -beginning position." - (save-excursion - (when (re-search-forward org-target-regexp nil t) - (cons 'target (match-beginning 0))))) - - -;;;; Timestamp - -(defun org-element-timestamp-parser () - "Parse time stamp at point. - -Return a list whose CAR is `timestamp', and CDR a plist with -`:type', `:raw-value', `:year-start', `:month-start', -`:day-start', `:hour-start', `:minute-start', `:year-end', -`:month-end', `:day-end', `:hour-end', `:minute-end', -`:repeater-type', `:repeater-value', `:repeater-unit', -`:warning-type', `:warning-value', `:warning-unit', `:begin', -`:end', `:value' and `:post-blank' keywords. - -Assume point is at the beginning of the timestamp." - (save-excursion - (let* ((begin (point)) - (activep (eq (char-after) ?<)) - (raw-value - (progn - (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?") - (match-string-no-properties 0))) - (date-start (match-string-no-properties 1)) - (date-end (match-string 3)) - (diaryp (match-beginning 2)) - (post-blank (progn (goto-char (match-end 0)) - (skip-chars-forward " \t"))) - (end (point)) - (time-range - (and (not diaryp) - (string-match - "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)" - date-start) - (cons (string-to-number (match-string 2 date-start)) - (string-to-number (match-string 3 date-start))))) - (type (cond (diaryp 'diary) - ((and activep (or date-end time-range)) 'active-range) - (activep 'active) - ((or date-end time-range) 'inactive-range) - (t 'inactive))) - (repeater-props - (and (not diaryp) - (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)" - raw-value) - (list - :repeater-type - (let ((type (match-string 1 raw-value))) - (cond ((equal "++" type) 'catch-up) - ((equal ".+" type) 'restart) - (t 'cumulate))) - :repeater-value (string-to-number (match-string 2 raw-value)) - :repeater-unit - (case (string-to-char (match-string 3 raw-value)) - (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year))))) - (warning-props - (and (not diaryp) - (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value) - (list - :warning-type (if (match-string 1 raw-value) 'first 'all) - :warning-value (string-to-number (match-string 2 raw-value)) - :warning-unit - (case (string-to-char (match-string 3 raw-value)) - (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year))))) - year-start month-start day-start hour-start minute-start year-end - month-end day-end hour-end minute-end) - ;; Parse date-start. - (unless diaryp - (let ((date (org-parse-time-string date-start t))) - (setq year-start (nth 5 date) - month-start (nth 4 date) - day-start (nth 3 date) - hour-start (nth 2 date) - minute-start (nth 1 date)))) - ;; Compute date-end. It can be provided directly in time-stamp, - ;; or extracted from time range. Otherwise, it defaults to the - ;; same values as date-start. - (unless diaryp - (let ((date (and date-end (org-parse-time-string date-end t)))) - (setq year-end (or (nth 5 date) year-start) - month-end (or (nth 4 date) month-start) - day-end (or (nth 3 date) day-start) - hour-end (or (nth 2 date) (car time-range) hour-start) - minute-end (or (nth 1 date) (cdr time-range) minute-start)))) - (list 'timestamp - (nconc (list :type type - :raw-value raw-value - :year-start year-start - :month-start month-start - :day-start day-start - :hour-start hour-start - :minute-start minute-start - :year-end year-end - :month-end month-end - :day-end day-end - :hour-end hour-end - :minute-end minute-end - :begin begin - :end end - :post-blank post-blank) - repeater-props - warning-props))))) - -(defun org-element-timestamp-interpreter (timestamp contents) - "Interpret TIMESTAMP object as Org syntax. -CONTENTS is nil." - ;; Use `:raw-value' if specified. - (or (org-element-property :raw-value timestamp) - ;; Otherwise, build timestamp string. - (let* ((repeat-string - (concat - (case (org-element-property :repeater-type timestamp) - (cumulate "+") (catch-up "++") (restart ".+")) - (let ((val (org-element-property :repeater-value timestamp))) - (and val (number-to-string val))) - (case (org-element-property :repeater-unit timestamp) - (hour "h") (day "d") (week "w") (month "m") (year "y")))) - (warning-string - (concat - (case (org-element-property :warning-type timestamp) - (first "--") - (all "-")) - (let ((val (org-element-property :warning-value timestamp))) - (and val (number-to-string val))) - (case (org-element-property :warning-unit timestamp) - (hour "h") (day "d") (week "w") (month "m") (year "y")))) - (build-ts-string - ;; Build an Org timestamp string from TIME. ACTIVEP is - ;; non-nil when time stamp is active. If WITH-TIME-P is - ;; non-nil, add a time part. HOUR-END and MINUTE-END - ;; specify a time range in the timestamp. REPEAT-STRING - ;; is the repeater string, if any. - (lambda (time activep &optional with-time-p hour-end minute-end) - (let ((ts (format-time-string - (funcall (if with-time-p 'cdr 'car) - org-time-stamp-formats) - time))) - (when (and hour-end minute-end) - (string-match "[012]?[0-9]:[0-5][0-9]" ts) - (setq ts - (replace-match - (format "\\&-%02d:%02d" hour-end minute-end) - nil nil ts))) - (unless activep (setq ts (format "[%s]" (substring ts 1 -1)))) - (dolist (s (list repeat-string warning-string)) - (when (org-string-nw-p s) - (setq ts (concat (substring ts 0 -1) - " " - s - (substring ts -1))))) - ;; Return value. - ts))) - (type (org-element-property :type timestamp))) - (case type - ((active inactive) - (let* ((minute-start (org-element-property :minute-start timestamp)) - (minute-end (org-element-property :minute-end timestamp)) - (hour-start (org-element-property :hour-start timestamp)) - (hour-end (org-element-property :hour-end timestamp)) - (time-range-p (and hour-start hour-end minute-start minute-end - (or (/= hour-start hour-end) - (/= minute-start minute-end))))) - (funcall - build-ts-string - (encode-time 0 - (or minute-start 0) - (or hour-start 0) - (org-element-property :day-start timestamp) - (org-element-property :month-start timestamp) - (org-element-property :year-start timestamp)) - (eq type 'active) - (and hour-start minute-start) - (and time-range-p hour-end) - (and time-range-p minute-end)))) - ((active-range inactive-range) - (let ((minute-start (org-element-property :minute-start timestamp)) - (minute-end (org-element-property :minute-end timestamp)) - (hour-start (org-element-property :hour-start timestamp)) - (hour-end (org-element-property :hour-end timestamp))) - (concat - (funcall - build-ts-string (encode-time - 0 - (or minute-start 0) - (or hour-start 0) - (org-element-property :day-start timestamp) - (org-element-property :month-start timestamp) - (org-element-property :year-start timestamp)) - (eq type 'active-range) - (and hour-start minute-start)) - "--" - (funcall build-ts-string - (encode-time 0 - (or minute-end 0) - (or hour-end 0) - (org-element-property :day-end timestamp) - (org-element-property :month-end timestamp) - (org-element-property :year-end timestamp)) - (eq type 'active-range) - (and hour-end minute-end))))))))) - -(defun org-element-timestamp-successor () - "Search for the next timestamp object. - -Return value is a cons cell whose CAR is `timestamp' and CDR is -beginning position." - (save-excursion - (when (re-search-forward - (concat org-ts-regexp-both - "\\|" - "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" - "\\|" - "\\(?:<%%\\(?:([^>\n]+)\\)>\\)") - nil t) - (cons 'timestamp (match-beginning 0))))) - - -;;;; Underline - -(defun org-element-underline-parser () - "Parse underline object at point. - -Return a list whose CAR is `underline' and CDR is a plist with -`:begin', `:end', `:contents-begin' and `:contents-end' and -`:post-blank' keywords. - -Assume point is at the first underscore marker." - (save-excursion - (unless (bolp) (backward-char 1)) - (looking-at org-emph-re) - (let ((begin (match-beginning 2)) - (contents-begin (match-beginning 4)) - (contents-end (match-end 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'underline - (list :begin begin - :end end - :contents-begin contents-begin - :contents-end contents-end - :post-blank post-blank))))) - -(defun org-element-underline-interpreter (underline contents) - "Interpret UNDERLINE object as Org syntax. -CONTENTS is the contents of the object." - (format "_%s_" contents)) - - -;;;; Verbatim - -(defun org-element-verbatim-parser () - "Parse verbatim object at point. - -Return a list whose CAR is `verbatim' and CDR is a plist with -`:value', `:begin', `:end' and `:post-blank' keywords. - -Assume point is at the first equal sign marker." - (save-excursion - (unless (bolp) (backward-char 1)) - (looking-at org-emph-re) - (let ((begin (match-beginning 2)) - (value (org-match-string-no-properties 4)) - (post-blank (progn (goto-char (match-end 2)) - (skip-chars-forward " \t"))) - (end (point))) - (list 'verbatim - (list :value value - :begin begin - :end end - :post-blank post-blank))))) - -(defun org-element-verbatim-interpreter (verbatim contents) - "Interpret VERBATIM object as Org syntax. -CONTENTS is nil." - (format "=%s=" (org-element-property :value verbatim))) - - - -;;; Parsing Element Starting At Point -;; -;; `org-element--current-element' is the core function of this section. -;; It returns the Lisp representation of the element starting at -;; point. -;; -;; `org-element--current-element' makes use of special modes. They -;; are activated for fixed element chaining (i.e. `plain-list' > -;; `item') or fixed conditional element chaining (i.e. `headline' > -;; `section'). Special modes are: `first-section', `item', -;; `node-property', `quote-section', `section' and `table-row'. - -(defun org-element--current-element - (limit &optional granularity special structure) - "Parse the element starting at point. - -Return value is a list like (TYPE PROPS) where TYPE is the type -of the element and PROPS a plist of properties associated to the -element. - -Possible types are defined in `org-element-all-elements'. - -LIMIT bounds the search. - -Optional argument GRANULARITY determines the depth of the -recursion. Allowed values are `headline', `greater-element', -`element', `object' or nil. When it is broader than `object' (or -nil), secondary values will not be parsed, since they only -contain objects. - -Optional argument SPECIAL, when non-nil, can be either -`first-section', `item', `node-property', `quote-section', -`section', and `table-row'. - -If STRUCTURE isn't provided but SPECIAL is set to `item', it will -be computed. - -This function assumes point is always at the beginning of the -element it has to parse." - (save-excursion - (let ((case-fold-search t) - ;; Determine if parsing depth allows for secondary strings - ;; parsing. It only applies to elements referenced in - ;; `org-element-secondary-value-alist'. - (raw-secondary-p (and granularity (not (eq granularity 'object))))) - (cond - ;; Item. - ((eq special 'item) - (org-element-item-parser limit structure raw-secondary-p)) - ;; Table Row. - ((eq special 'table-row) (org-element-table-row-parser limit)) - ;; Node Property. - ((eq special 'node-property) (org-element-node-property-parser limit)) - ;; Headline. - ((org-with-limited-levels (org-at-heading-p)) - (org-element-headline-parser limit raw-secondary-p)) - ;; Sections (must be checked after headline). - ((eq special 'section) (org-element-section-parser limit)) - ((eq special 'quote-section) (org-element-quote-section-parser limit)) - ((eq special 'first-section) - (org-element-section-parser - (or (save-excursion (org-with-limited-levels (outline-next-heading))) - limit))) - ;; When not at bol, point is at the beginning of an item or - ;; a footnote definition: next item is always a paragraph. - ((not (bolp)) (org-element-paragraph-parser limit (list (point)))) - ;; Planning and Clock. - ((looking-at org-planning-or-clock-line-re) - (if (equal (match-string 1) org-clock-string) - (org-element-clock-parser limit) - (org-element-planning-parser limit))) - ;; Inlinetask. - ((org-at-heading-p) - (org-element-inlinetask-parser limit raw-secondary-p)) - ;; From there, elements can have affiliated keywords. - (t (let ((affiliated (org-element--collect-affiliated-keywords limit))) - (cond - ;; Jumping over affiliated keywords put point off-limits. - ;; Parse them as regular keywords. - ((and (cdr affiliated) (>= (point) limit)) - (goto-char (car affiliated)) - (org-element-keyword-parser limit nil)) - ;; LaTeX Environment. - ((looking-at - "[ \t]*\\\\begin{[A-Za-z0-9*]+}\\(\\[.*?\\]\\|{.*?}\\)*[ \t]*$") - (org-element-latex-environment-parser limit affiliated)) - ;; Drawer and Property Drawer. - ((looking-at org-drawer-regexp) - (if (equal (match-string 1) "PROPERTIES") - (org-element-property-drawer-parser limit affiliated) - (org-element-drawer-parser limit affiliated))) - ;; Fixed Width - ((looking-at "[ \t]*:\\( \\|$\\)") - (org-element-fixed-width-parser limit affiliated)) - ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and - ;; Keywords. - ((looking-at "[ \t]*#") - (goto-char (match-end 0)) - (cond ((looking-at "\\(?: \\|$\\)") - (beginning-of-line) - (org-element-comment-parser limit affiliated)) - ((looking-at "\\+BEGIN_\\(\\S-+\\)") - (beginning-of-line) - (let ((parser (assoc (upcase (match-string 1)) - org-element-block-name-alist))) - (if parser (funcall (cdr parser) limit affiliated) - (org-element-special-block-parser limit affiliated)))) - ((looking-at "\\+CALL:") - (beginning-of-line) - (org-element-babel-call-parser limit affiliated)) - ((looking-at "\\+BEGIN:? ") - (beginning-of-line) - (org-element-dynamic-block-parser limit affiliated)) - ((looking-at "\\+\\S-+:") - (beginning-of-line) - (org-element-keyword-parser limit affiliated)) - (t - (beginning-of-line) - (org-element-paragraph-parser limit affiliated)))) - ;; Footnote Definition. - ((looking-at org-footnote-definition-re) - (org-element-footnote-definition-parser limit affiliated)) - ;; Horizontal Rule. - ((looking-at "[ \t]*-\\{5,\\}[ \t]*$") - (org-element-horizontal-rule-parser limit affiliated)) - ;; Diary Sexp. - ((looking-at "%%(") - (org-element-diary-sexp-parser limit affiliated)) - ;; Table. - ((org-at-table-p t) (org-element-table-parser limit affiliated)) - ;; List. - ((looking-at (org-item-re)) - (org-element-plain-list-parser - limit affiliated - (or structure (org-element--list-struct limit)))) - ;; Default element: Paragraph. - (t (org-element-paragraph-parser limit affiliated))))))))) - - -;; Most elements can have affiliated keywords. When looking for an -;; element beginning, we want to move before them, as they belong to -;; that element, and, in the meantime, collect information they give -;; into appropriate properties. Hence the following function. - -(defun org-element--collect-affiliated-keywords (limit) - "Collect affiliated keywords from point down to LIMIT. - -Return a list whose CAR is the position at the first of them and -CDR a plist of keywords and values and move point to the -beginning of the first line after them. - -As a special case, if element doesn't start at the beginning of -the line (i.e. a paragraph starting an item), CAR is current -position of point and CDR is nil." - (if (not (bolp)) (list (point)) - (let ((case-fold-search t) - (origin (point)) - ;; RESTRICT is the list of objects allowed in parsed - ;; keywords value. - (restrict (org-element-restriction 'keyword)) - output) - (while (and (< (point) limit) (looking-at org-element--affiliated-re)) - (let* ((raw-kwd (upcase (match-string 1))) - ;; Apply translation to RAW-KWD. From there, KWD is - ;; the official keyword. - (kwd (or (cdr (assoc raw-kwd - org-element-keyword-translation-alist)) - raw-kwd)) - ;; Find main value for any keyword. - (value - (save-match-data - (org-trim - (buffer-substring-no-properties - (match-end 0) (point-at-eol))))) - ;; PARSEDP is non-nil when keyword should have its - ;; value parsed. - (parsedp (member kwd org-element-parsed-keywords)) - ;; If KWD is a dual keyword, find its secondary - ;; value. Maybe parse it. - (dualp (member kwd org-element-dual-keywords)) - (dual-value - (and dualp - (let ((sec (org-match-string-no-properties 2))) - (if (or (not sec) (not parsedp)) sec - (org-element-parse-secondary-string sec restrict))))) - ;; Attribute a property name to KWD. - (kwd-sym (and kwd (intern (concat ":" (downcase kwd)))))) - ;; Now set final shape for VALUE. - (when parsedp - (setq value (org-element-parse-secondary-string value restrict))) - (when dualp - (setq value (and (or value dual-value) (cons value dual-value)))) - (when (or (member kwd org-element-multiple-keywords) - ;; Attributes can always appear on multiple lines. - (string-match "^ATTR_" kwd)) - (setq value (cons value (plist-get output kwd-sym)))) - ;; Eventually store the new value in OUTPUT. - (setq output (plist-put output kwd-sym value)) - ;; Move to next keyword. - (forward-line))) - ;; If affiliated keywords are orphaned: move back to first one. - ;; They will be parsed as a paragraph. - (when (looking-at "[ \t]*$") (goto-char origin) (setq output nil)) - ;; Return value. - (cons origin output)))) - - - -;;; The Org Parser -;; -;; The two major functions here are `org-element-parse-buffer', which -;; parses Org syntax inside the current buffer, taking into account -;; region, narrowing, or even visibility if specified, and -;; `org-element-parse-secondary-string', which parses objects within -;; a given string. -;; -;; The (almost) almighty `org-element-map' allows to apply a function -;; on elements or objects matching some type, and accumulate the -;; resulting values. In an export situation, it also skips unneeded -;; parts of the parse tree. - -(defun org-element-parse-buffer (&optional granularity visible-only) - "Recursively parse the buffer and return structure. -If narrowing is in effect, only parse the visible part of the -buffer. - -Optional argument GRANULARITY determines the depth of the -recursion. It can be set to the following symbols: - -`headline' Only parse headlines. -`greater-element' Don't recurse into greater elements excepted - headlines and sections. Thus, elements - parsed are the top-level ones. -`element' Parse everything but objects and plain text. -`object' Parse the complete buffer (default). - -When VISIBLE-ONLY is non-nil, don't parse contents of hidden -elements. - -An element or an objects is represented as a list with the -pattern (TYPE PROPERTIES CONTENTS), where : - - TYPE is a symbol describing the element or object. See - `org-element-all-elements' and `org-element-all-objects' for an - exhaustive list of such symbols. One can retrieve it with - `org-element-type' function. - - PROPERTIES is the list of attributes attached to the element or - object, as a plist. Although most of them are specific to the - element or object type, all types share `:begin', `:end', - `:post-blank' and `:parent' properties, which respectively - refer to buffer position where the element or object starts, - ends, the number of white spaces or blank lines after it, and - the element or object containing it. Properties values can be - obtained by using `org-element-property' function. - - CONTENTS is a list of elements, objects or raw strings - contained in the current element or object, when applicable. - One can access them with `org-element-contents' function. - -The Org buffer has `org-data' as type and nil as properties. -`org-element-map' function can be used to find specific elements -or objects within the parse tree. - -This function assumes that current major mode is `org-mode'." - (save-excursion - (goto-char (point-min)) - (org-skip-whitespace) - (org-element--parse-elements - (point-at-bol) (point-max) - ;; Start in `first-section' mode so text before the first - ;; headline belongs to a section. - 'first-section nil granularity visible-only (list 'org-data nil)))) - -(defun org-element-parse-secondary-string (string restriction &optional parent) - "Recursively parse objects in STRING and return structure. - -RESTRICTION is a symbol limiting the object types that will be -looked after. - -Optional argument PARENT, when non-nil, is the element or object -containing the secondary string. It is used to set correctly -`:parent' property within the string." - ;; Copy buffer-local variables listed in - ;; `org-element-object-variables' into temporary buffer. This is - ;; required since object parsing is dependent on these variables. - (let ((pairs (delq nil (mapcar (lambda (var) - (when (boundp var) - (cons var (symbol-value var)))) - org-element-object-variables)))) - (with-temp-buffer - (mapc (lambda (pair) (org-set-local (car pair) (cdr pair))) pairs) - (insert string) - (let ((secondary (org-element--parse-objects - (point-min) (point-max) nil restriction))) - (when parent - (mapc (lambda (obj) (org-element-put-property obj :parent parent)) - secondary)) - secondary)))) - -(defun org-element-map - (data types fun &optional info first-match no-recursion with-affiliated) - "Map a function on selected elements or objects. - -DATA is a parse tree, an element, an object, a string, or a list -of such constructs. TYPES is a symbol or list of symbols of -elements or objects types (see `org-element-all-elements' and -`org-element-all-objects' for a complete list of types). FUN is -the function called on the matching element or object. It has to -accept one argument: the element or object itself. - -When optional argument INFO is non-nil, it should be a plist -holding export options. In that case, parts of the parse tree -not exportable according to that property list will be skipped. - -When optional argument FIRST-MATCH is non-nil, stop at the first -match for which FUN doesn't return nil, and return that value. - -Optional argument NO-RECURSION is a symbol or a list of symbols -representing elements or objects types. `org-element-map' won't -enter any recursive element or object whose type belongs to that -list. Though, FUN can still be applied on them. - -When optional argument WITH-AFFILIATED is non-nil, FUN will also -apply to matching objects within parsed affiliated keywords (see -`org-element-parsed-keywords'). - -Nil values returned from FUN do not appear in the results. - - -Examples: ---------- - -Assuming TREE is a variable containing an Org buffer parse tree, -the following example will return a flat list of all `src-block' -and `example-block' elements in it: - - \(org-element-map tree '(example-block src-block) 'identity) - -The following snippet will find the first headline with a level -of 1 and a \"phone\" tag, and will return its beginning position: - - \(org-element-map tree 'headline - \(lambda (hl) - \(and (= (org-element-property :level hl) 1) - \(member \"phone\" (org-element-property :tags hl)) - \(org-element-property :begin hl))) - nil t) - -The next example will return a flat list of all `plain-list' type -elements in TREE that are not a sub-list themselves: - - \(org-element-map tree 'plain-list 'identity nil nil 'plain-list) - -Eventually, this example will return a flat list of all `bold' -type objects containing a `latex-snippet' type object, even -looking into captions: - - \(org-element-map tree 'bold - \(lambda (b) - \(and (org-element-map b 'latex-snippet 'identity nil t) b)) - nil nil nil t)" - ;; Ensure TYPES and NO-RECURSION are a list, even of one element. - (unless (listp types) (setq types (list types))) - (unless (listp no-recursion) (setq no-recursion (list no-recursion))) - ;; Recursion depth is determined by --CATEGORY. - (let* ((--category - (catch 'found - (let ((category 'greater-elements)) - (mapc (lambda (type) - (cond ((or (memq type org-element-all-objects) - (eq type 'plain-text)) - ;; If one object is found, the function - ;; has to recurse into every object. - (throw 'found 'objects)) - ((not (memq type org-element-greater-elements)) - ;; If one regular element is found, the - ;; function has to recurse, at least, - ;; into every element it encounters. - (and (not (eq category 'elements)) - (setq category 'elements))))) - types) - category))) - ;; Compute properties for affiliated keywords if necessary. - (--affiliated-alist - (and with-affiliated - (mapcar (lambda (kwd) - (cons kwd (intern (concat ":" (downcase kwd))))) - org-element-affiliated-keywords))) - --acc - --walk-tree - (--walk-tree - (function - (lambda (--data) - ;; Recursively walk DATA. INFO, if non-nil, is a plist - ;; holding contextual information. - (let ((--type (org-element-type --data))) - (cond - ((not --data)) - ;; Ignored element in an export context. - ((and info (memq --data (plist-get info :ignore-list)))) - ;; List of elements or objects. - ((not --type) (mapc --walk-tree --data)) - ;; Unconditionally enter parse trees. - ((eq --type 'org-data) - (mapc --walk-tree (org-element-contents --data))) - (t - ;; Check if TYPE is matching among TYPES. If so, - ;; apply FUN to --DATA and accumulate return value - ;; into --ACC (or exit if FIRST-MATCH is non-nil). - (when (memq --type types) - (let ((result (funcall fun --data))) - (cond ((not result)) - (first-match (throw '--map-first-match result)) - (t (push result --acc))))) - ;; If --DATA has a secondary string that can contain - ;; objects with their type among TYPES, look into it. - (when (and (eq --category 'objects) (not (stringp --data))) - (let ((sec-prop - (assq --type org-element-secondary-value-alist))) - (when sec-prop - (funcall --walk-tree - (org-element-property (cdr sec-prop) --data))))) - ;; If --DATA has any affiliated keywords and - ;; WITH-AFFILIATED is non-nil, look for objects in - ;; them. - (when (and with-affiliated - (eq --category 'objects) - (memq --type org-element-all-elements)) - (mapc (lambda (kwd-pair) - (let ((kwd (car kwd-pair)) - (value (org-element-property - (cdr kwd-pair) --data))) - ;; Pay attention to the type of value. - ;; Preserve order for multiple keywords. - (cond - ((not value)) - ((and (member kwd org-element-multiple-keywords) - (member kwd org-element-dual-keywords)) - (mapc (lambda (line) - (funcall --walk-tree (cdr line)) - (funcall --walk-tree (car line))) - (reverse value))) - ((member kwd org-element-multiple-keywords) - (mapc (lambda (line) (funcall --walk-tree line)) - (reverse value))) - ((member kwd org-element-dual-keywords) - (funcall --walk-tree (cdr value)) - (funcall --walk-tree (car value))) - (t (funcall --walk-tree value))))) - --affiliated-alist)) - ;; Determine if a recursion into --DATA is possible. - (cond - ;; --TYPE is explicitly removed from recursion. - ((memq --type no-recursion)) - ;; --DATA has no contents. - ((not (org-element-contents --data))) - ;; Looking for greater elements but --DATA is simply - ;; an element or an object. - ((and (eq --category 'greater-elements) - (not (memq --type org-element-greater-elements)))) - ;; Looking for elements but --DATA is an object. - ((and (eq --category 'elements) - (memq --type org-element-all-objects))) - ;; In any other case, map contents. - (t (mapc --walk-tree (org-element-contents --data))))))))))) - (catch '--map-first-match - (funcall --walk-tree data) - ;; Return value in a proper order. - (nreverse --acc)))) -(put 'org-element-map 'lisp-indent-function 2) - -;; The following functions are internal parts of the parser. -;; -;; The first one, `org-element--parse-elements' acts at the element's -;; level. -;; -;; The second one, `org-element--parse-objects' applies on all objects -;; of a paragraph or a secondary string. It uses -;; `org-element--get-next-object-candidates' to optimize the search of -;; the next object in the buffer. -;; -;; More precisely, that function looks for every allowed object type -;; first. Then, it discards failed searches, keeps further matches, -;; and searches again types matched behind point, for subsequent -;; calls. Thus, searching for a given type fails only once, and every -;; object is searched only once at top level (but sometimes more for -;; nested types). - -(defun org-element--parse-elements - (beg end special structure granularity visible-only acc) - "Parse elements between BEG and END positions. - -SPECIAL prioritize some elements over the others. It can be set -to `first-section', `quote-section', `section' `item' or -`table-row'. - -When value is `item', STRUCTURE will be used as the current list -structure. - -GRANULARITY determines the depth of the recursion. See -`org-element-parse-buffer' for more information. - -When VISIBLE-ONLY is non-nil, don't parse contents of hidden -elements. - -Elements are accumulated into ACC." - (save-excursion - (goto-char beg) - ;; Visible only: skip invisible parts at the beginning of the - ;; element. - (when (and visible-only (org-invisible-p2)) - (goto-char (min (1+ (org-find-visible)) end))) - ;; When parsing only headlines, skip any text before first one. - (when (and (eq granularity 'headline) (not (org-at-heading-p))) - (org-with-limited-levels (outline-next-heading))) - ;; Main loop start. - (while (< (point) end) - ;; Find current element's type and parse it accordingly to - ;; its category. - (let* ((element (org-element--current-element - end granularity special structure)) - (type (org-element-type element)) - (cbeg (org-element-property :contents-begin element))) - (goto-char (org-element-property :end element)) - ;; Visible only: skip invisible parts between siblings. - (when (and visible-only (org-invisible-p2)) - (goto-char (min (1+ (org-find-visible)) end))) - ;; Fill ELEMENT contents by side-effect. - (cond - ;; If element has no contents, don't modify it. - ((not cbeg)) - ;; Greater element: parse it between `contents-begin' and - ;; `contents-end'. Make sure GRANULARITY allows the - ;; recursion, or ELEMENT is a headline, in which case going - ;; inside is mandatory, in order to get sub-level headings. - ((and (memq type org-element-greater-elements) - (or (memq granularity '(element object nil)) - (and (eq granularity 'greater-element) - (eq type 'section)) - (eq type 'headline))) - (org-element--parse-elements - cbeg (org-element-property :contents-end element) - ;; Possibly switch to a special mode. - (case type - (headline - (if (org-element-property :quotedp element) 'quote-section - 'section)) - (plain-list 'item) - (property-drawer 'node-property) - (table 'table-row)) - (and (memq type '(item plain-list)) - (org-element-property :structure element)) - granularity visible-only element)) - ;; ELEMENT has contents. Parse objects inside, if - ;; GRANULARITY allows it. - ((memq granularity '(object nil)) - (org-element--parse-objects - cbeg (org-element-property :contents-end element) element - (org-element-restriction type)))) - (org-element-adopt-elements acc element))) - ;; Return result. - acc)) - -(defun org-element--parse-objects (beg end acc restriction) - "Parse objects between BEG and END and return recursive structure. - -Objects are accumulated in ACC. - -RESTRICTION is a list of object successors which are allowed in -the current object." - (let ((candidates 'initial)) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (goto-char (point-min)) - (while (and (not (eobp)) - (setq candidates - (org-element--get-next-object-candidates - restriction candidates))) - (let ((next-object - (let ((pos (apply 'min (mapcar 'cdr candidates)))) - (save-excursion - (goto-char pos) - (funcall (intern (format "org-element-%s-parser" - (car (rassq pos candidates))))))))) - ;; 1. Text before any object. Untabify it. - (let ((obj-beg (org-element-property :begin next-object))) - (unless (= (point) obj-beg) - (setq acc - (org-element-adopt-elements - acc - (replace-regexp-in-string - "\t" (make-string tab-width ? ) - (buffer-substring-no-properties (point) obj-beg)))))) - ;; 2. Object... - (let ((obj-end (org-element-property :end next-object)) - (cont-beg (org-element-property :contents-begin next-object))) - ;; Fill contents of NEXT-OBJECT by side-effect, if it has - ;; a recursive type. - (when (and cont-beg - (memq (car next-object) org-element-recursive-objects)) - (org-element--parse-objects - cont-beg (org-element-property :contents-end next-object) - next-object (org-element-restriction next-object))) - (setq acc (org-element-adopt-elements acc next-object)) - (goto-char obj-end)))) - ;; 3. Text after last object. Untabify it. - (unless (eobp) - (setq acc - (org-element-adopt-elements - acc - (replace-regexp-in-string - "\t" (make-string tab-width ? ) - (buffer-substring-no-properties (point) end))))) - ;; Result. - acc)))) - -(defun org-element--get-next-object-candidates (restriction objects) - "Return an alist of candidates for the next object. - -RESTRICTION is a list of object types, as symbols. Only -candidates with such types are looked after. - -OBJECTS is the previous candidates alist. If it is set to -`initial', no search has been done before, and all symbols in -RESTRICTION should be looked after. - -Return value is an alist whose CAR is the object type and CDR its -beginning position." - (delq - nil - (if (eq objects 'initial) - ;; When searching for the first time, look for every successor - ;; allowed in RESTRICTION. - (mapcar - (lambda (res) - (funcall (intern (format "org-element-%s-successor" res)))) - restriction) - ;; Focus on objects returned during last search. Keep those - ;; still after point. Search again objects before it. - (mapcar - (lambda (obj) - (if (>= (cdr obj) (point)) obj - (let* ((type (car obj)) - (succ (or (cdr (assq type org-element-object-successor-alist)) - type))) - (and succ - (funcall (intern (format "org-element-%s-successor" succ))))))) - objects)))) - - - -;;; Towards A Bijective Process -;; -;; The parse tree obtained with `org-element-parse-buffer' is really -;; a snapshot of the corresponding Org buffer. Therefore, it can be -;; interpreted and expanded into a string with canonical Org syntax. -;; Hence `org-element-interpret-data'. -;; -;; The function relies internally on -;; `org-element--interpret-affiliated-keywords'. - -;;;###autoload -(defun org-element-interpret-data (data &optional parent) - "Interpret DATA as Org syntax. - -DATA is a parse tree, an element, an object or a secondary string -to interpret. - -Optional argument PARENT is used for recursive calls. It contains -the element or object containing data, or nil. - -Return Org syntax as a string." - (let* ((type (org-element-type data)) - (results - (cond - ;; Secondary string. - ((not type) - (mapconcat - (lambda (obj) (org-element-interpret-data obj parent)) - data "")) - ;; Full Org document. - ((eq type 'org-data) - (mapconcat - (lambda (obj) (org-element-interpret-data obj parent)) - (org-element-contents data) "")) - ;; Plain text: remove `:parent' text property from output. - ((stringp data) (org-no-properties data)) - ;; Element/Object without contents. - ((not (org-element-contents data)) - (funcall (intern (format "org-element-%s-interpreter" type)) - data nil)) - ;; Element/Object with contents. - (t - (let* ((greaterp (memq type org-element-greater-elements)) - (objectp (and (not greaterp) - (memq type org-element-recursive-objects))) - (contents - (mapconcat - (lambda (obj) (org-element-interpret-data obj data)) - (org-element-contents - (if (or greaterp objectp) data - ;; Elements directly containing objects must - ;; have their indentation normalized first. - (org-element-normalize-contents - data - ;; When normalizing first paragraph of an - ;; item or a footnote-definition, ignore - ;; first line's indentation. - (and (eq type 'paragraph) - (equal data (car (org-element-contents parent))) - (memq (org-element-type parent) - '(footnote-definition item)))))) - ""))) - (funcall (intern (format "org-element-%s-interpreter" type)) - data - (if greaterp (org-element-normalize-contents contents) - contents))))))) - (if (memq type '(org-data plain-text nil)) results - ;; Build white spaces. If no `:post-blank' property is - ;; specified, assume its value is 0. - (let ((post-blank (or (org-element-property :post-blank data) 0))) - (if (memq type org-element-all-objects) - (concat results (make-string post-blank 32)) - (concat - (org-element--interpret-affiliated-keywords data) - (org-element-normalize-string results) - (make-string post-blank 10))))))) - -(defun org-element--interpret-affiliated-keywords (element) - "Return ELEMENT's affiliated keywords as Org syntax. -If there is no affiliated keyword, return the empty string." - (let ((keyword-to-org - (function - (lambda (key value) - (let (dual) - (when (member key org-element-dual-keywords) - (setq dual (cdr value) value (car value))) - (concat "#+" key - (and dual - (format "[%s]" (org-element-interpret-data dual))) - ": " - (if (member key org-element-parsed-keywords) - (org-element-interpret-data value) - value) - "\n")))))) - (mapconcat - (lambda (prop) - (let ((value (org-element-property prop element)) - (keyword (upcase (substring (symbol-name prop) 1)))) - (when value - (if (or (member keyword org-element-multiple-keywords) - ;; All attribute keywords can have multiple lines. - (string-match "^ATTR_" keyword)) - (mapconcat (lambda (line) (funcall keyword-to-org keyword line)) - (reverse value) - "") - (funcall keyword-to-org keyword value))))) - ;; List all ELEMENT's properties matching an attribute line or an - ;; affiliated keyword, but ignore translated keywords since they - ;; cannot belong to the property list. - (loop for prop in (nth 1 element) by 'cddr - when (let ((keyword (upcase (substring (symbol-name prop) 1)))) - (or (string-match "^ATTR_" keyword) - (and - (member keyword org-element-affiliated-keywords) - (not (assoc keyword - org-element-keyword-translation-alist))))) - collect prop) - ""))) - -;; Because interpretation of the parse tree must return the same -;; number of blank lines between elements and the same number of white -;; space after objects, some special care must be given to white -;; spaces. -;; -;; The first function, `org-element-normalize-string', ensures any -;; string different from the empty string will end with a single -;; newline character. -;; -;; The second function, `org-element-normalize-contents', removes -;; global indentation from the contents of the current element. - -(defun org-element-normalize-string (s) - "Ensure string S ends with a single newline character. - -If S isn't a string return it unchanged. If S is the empty -string, return it. Otherwise, return a new string with a single -newline character at its end." - (cond - ((not (stringp s)) s) - ((string= "" s) "") - (t (and (string-match "\\(\n[ \t]*\\)*\\'" s) - (replace-match "\n" nil nil s))))) - -(defun org-element-normalize-contents (element &optional ignore-first) - "Normalize plain text in ELEMENT's contents. - -ELEMENT must only contain plain text and objects. - -If optional argument IGNORE-FIRST is non-nil, ignore first line's -indentation to compute maximal common indentation. - -Return the normalized element that is element with global -indentation removed from its contents. The function assumes that -indentation is not done with TAB characters." - (let* (ind-list ; for byte-compiler - collect-inds ; for byte-compiler - (collect-inds - (function - ;; Return list of indentations within BLOB. This is done by - ;; walking recursively BLOB and updating IND-LIST along the - ;; way. FIRST-FLAG is non-nil when the first string hasn't - ;; been seen yet. It is required as this string is the only - ;; one whose indentation doesn't happen after a newline - ;; character. - (lambda (blob first-flag) - (mapc - (lambda (object) - (when (and first-flag (stringp object)) - (setq first-flag nil) - (string-match "\\`\\( *\\)" object) - (let ((len (length (match-string 1 object)))) - ;; An indentation of zero means no string will be - ;; modified. Quit the process. - (if (zerop len) (throw 'zero (setq ind-list nil)) - (push len ind-list)))) - (cond - ((stringp object) - (let ((start 0)) - ;; Avoid matching blank or empty lines. - (while (and (string-match "\n\\( *\\)\\(.\\)" object start) - (not (equal (match-string 2 object) " "))) - (setq start (match-end 0)) - (push (length (match-string 1 object)) ind-list)))) - ((memq (org-element-type object) org-element-recursive-objects) - (funcall collect-inds object first-flag)))) - (org-element-contents blob)))))) - ;; Collect indentation list in ELEMENT. Possibly remove first - ;; value if IGNORE-FIRST is non-nil. - (catch 'zero (funcall collect-inds element (not ignore-first))) - (if (not ind-list) element - ;; Build ELEMENT back, replacing each string with the same - ;; string minus common indentation. - (let* (build ; For byte compiler. - (build - (function - (lambda (blob mci first-flag) - ;; Return BLOB with all its strings indentation - ;; shortened from MCI white spaces. FIRST-FLAG is - ;; non-nil when the first string hasn't been seen - ;; yet. - (setcdr (cdr blob) - (mapcar - (lambda (object) - (when (and first-flag (stringp object)) - (setq first-flag nil) - (setq object - (replace-regexp-in-string - (format "\\` \\{%d\\}" mci) "" object))) - (cond - ((stringp object) - (replace-regexp-in-string - (format "\n \\{%d\\}" mci) "\n" object)) - ((memq (org-element-type object) - org-element-recursive-objects) - (funcall build object mci first-flag)) - (t object))) - (org-element-contents blob))) - blob)))) - (funcall build element (apply 'min ind-list) (not ignore-first)))))) - - - -;;; The Toolbox -;; -;; The first move is to implement a way to obtain the smallest element -;; containing point. This is the job of `org-element-at-point'. It -;; basically jumps back to the beginning of section containing point -;; and moves, element after element, with -;; `org-element--current-element' until the container is found. Note: -;; When using `org-element-at-point', secondary values are never -;; parsed since the function focuses on elements, not on objects. -;; -;; At a deeper level, `org-element-context' lists all elements and -;; objects containing point. -;; -;; `org-element-nested-p' and `org-element-swap-A-B' may be used -;; internally by navigation and manipulation tools. - -;;;###autoload -(defun org-element-at-point (&optional keep-trail) - "Determine closest element around point. - -Return value is a list like (TYPE PROPS) where TYPE is the type -of the element and PROPS a plist of properties associated to the -element. - -Possible types are defined in `org-element-all-elements'. -Properties depend on element or object type, but always include -`:begin', `:end', `:parent' and `:post-blank' properties. - -As a special case, if point is at the very beginning of a list or -sub-list, returned element will be that list instead of the first -item. In the same way, if point is at the beginning of the first -row of a table, returned element will be the table instead of the -first row. - -If optional argument KEEP-TRAIL is non-nil, the function returns -a list of elements leading to element at point. The list's CAR -is always the element at point. The following positions contain -element's siblings, then parents, siblings of parents, until the -first element of current section." - (org-with-wide-buffer - ;; If at a headline, parse it. It is the sole element that - ;; doesn't require to know about context. Be sure to disallow - ;; secondary string parsing, though. - (if (org-with-limited-levels (org-at-heading-p)) - (progn - (beginning-of-line) - (if (not keep-trail) (org-element-headline-parser (point-max) t) - (list (org-element-headline-parser (point-max) t)))) - ;; Otherwise move at the beginning of the section containing - ;; point. - (catch 'exit - (let ((origin (point)) - (end (save-excursion - (org-with-limited-levels (outline-next-heading)) (point))) - element type special-flag trail struct prevs parent) - (org-with-limited-levels - (if (org-before-first-heading-p) - ;; In empty lines at buffer's beginning, return nil. - (progn (goto-char (point-min)) - (org-skip-whitespace) - (when (or (eobp) (> (line-beginning-position) origin)) - (throw 'exit nil))) - (org-back-to-heading) - (forward-line) - (org-skip-whitespace) - (when (or (eobp) (> (line-beginning-position) origin)) - ;; In blank lines just after the headline, point still - ;; belongs to the headline. - (throw 'exit - (progn (skip-chars-backward " \r\t\n") - (beginning-of-line) - (if (not keep-trail) - (org-element-headline-parser (point-max) t) - (list (org-element-headline-parser - (point-max) t)))))))) - (beginning-of-line) - ;; Parse successively each element, skipping those ending - ;; before original position. - (while t - (setq element - (org-element--current-element end 'element special-flag struct) - type (car element)) - (org-element-put-property element :parent parent) - (when keep-trail (push element trail)) - (cond - ;; 1. Skip any element ending before point. Also skip - ;; element ending at point when we're sure that another - ;; element has started. - ((let ((elem-end (org-element-property :end element))) - (when (or (< elem-end origin) - (and (= elem-end origin) (/= elem-end end))) - (goto-char elem-end)))) - ;; 2. An element containing point is always the element at - ;; point. - ((not (memq type org-element-greater-elements)) - (throw 'exit (if keep-trail trail element))) - ;; 3. At any other greater element type, if point is - ;; within contents, move into it. - (t - (let ((cbeg (org-element-property :contents-begin element)) - (cend (org-element-property :contents-end element))) - (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin) - ;; Create an anchor for tables and plain lists: - ;; when point is at the very beginning of these - ;; elements, ignoring affiliated keywords, - ;; target them instead of their contents. - (and (= cbeg origin) (memq type '(plain-list table))) - ;; When point is at contents end, do not move - ;; into elements with an explicit ending, but - ;; return that element instead. - (and (= cend origin) - (or (memq type - '(center-block - drawer dynamic-block inlinetask - property-drawer quote-block - special-block)) - ;; Corner case: if a list ends at the - ;; end of a buffer without a final new - ;; line, return last element in last - ;; item instead. - (and (memq type '(item plain-list)) - (progn (goto-char cend) - (or (bolp) (not (eobp)))))))) - (throw 'exit (if keep-trail trail element)) - (setq parent element) - (case type - (plain-list - (setq special-flag 'item - struct (org-element-property :structure element))) - (item (setq special-flag nil)) - (property-drawer - (setq special-flag 'node-property struct nil)) - (table (setq special-flag 'table-row struct nil)) - (otherwise (setq special-flag nil struct nil))) - (setq end cend) - (goto-char cbeg))))))))))) - -;;;###autoload -(defun org-element-context (&optional element) - "Return closest element or object around point. - -Return value is a list like (TYPE PROPS) where TYPE is the type -of the element or object and PROPS a plist of properties -associated to it. - -Possible types are defined in `org-element-all-elements' and -`org-element-all-objects'. Properties depend on element or -object type, but always include `:begin', `:end', `:parent' and -`:post-blank'. - -Optional argument ELEMENT, when non-nil, is the closest element -containing point, as returned by `org-element-at-point'. -Providing it allows for quicker computation." - (catch 'objects-forbidden - (org-with-wide-buffer - (let* ((origin (point)) - (element (or element (org-element-at-point))) - (type (org-element-type element)) - context) - ;; Check if point is inside an element containing objects or at - ;; a secondary string. In that case, narrow buffer to the - ;; containing area. Otherwise, return ELEMENT. - (cond - ;; At a parsed affiliated keyword, check if we're inside main - ;; or dual value. - ((let ((post (org-element-property :post-affiliated element))) - (and post (< origin post))) - (beginning-of-line) - (let ((case-fold-search t)) (looking-at org-element--affiliated-re)) - (cond - ((not (member-ignore-case (match-string 1) - org-element-parsed-keywords)) - (throw 'objects-forbidden element)) - ((< (match-end 0) origin) - (narrow-to-region (match-end 0) (line-end-position))) - ((and (match-beginning 2) - (>= origin (match-beginning 2)) - (< origin (match-end 2))) - (narrow-to-region (match-beginning 2) (match-end 2))) - (t (throw 'objects-forbidden element))) - ;; Also change type to retrieve correct restrictions. - (setq type 'keyword)) - ;; At an item, objects can only be located within tag, if any. - ((eq type 'item) - (let ((tag (org-element-property :tag element))) - (if (not tag) (throw 'objects-forbidden element) - (beginning-of-line) - (search-forward tag (line-end-position)) - (goto-char (match-beginning 0)) - (if (and (>= origin (point)) (< origin (match-end 0))) - (narrow-to-region (point) (match-end 0)) - (throw 'objects-forbidden element))))) - ;; At an headline or inlinetask, objects are located within - ;; their title. - ((memq type '(headline inlinetask)) - (goto-char (org-element-property :begin element)) - (skip-chars-forward "* ") - (if (and (>= origin (point)) (< origin (line-end-position))) - (narrow-to-region (point) (line-end-position)) - (throw 'objects-forbidden element))) - ;; At a paragraph, a table-row or a verse block, objects are - ;; located within their contents. - ((memq type '(paragraph table-row verse-block)) - (let ((cbeg (org-element-property :contents-begin element)) - (cend (org-element-property :contents-end element))) - ;; CBEG is nil for table rules. - (if (and cbeg cend (>= origin cbeg) (< origin cend)) - (narrow-to-region cbeg cend) - (throw 'objects-forbidden element)))) - ;; At a parsed keyword, objects are located within value. - ((eq type 'keyword) - (if (not (member (org-element-property :key element) - org-element-document-properties)) - (throw 'objects-forbidden element) - (beginning-of-line) - (search-forward ":") - (if (and (>= origin (point)) (< origin (line-end-position))) - (narrow-to-region (point) (line-end-position)) - (throw 'objects-forbidden element)))) - (t (throw 'objects-forbidden element))) - (goto-char (point-min)) - (let ((restriction (org-element-restriction type)) - (parent element) - (candidates 'initial)) - (catch 'exit - (while (setq candidates - (org-element--get-next-object-candidates - restriction candidates)) - (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates)) - candidates))) - ;; If ORIGIN is before next object in element, there's - ;; no point in looking further. - (if (> (cdr closest-cand) origin) (throw 'exit parent) - (let* ((object - (progn (goto-char (cdr closest-cand)) - (funcall (intern (format "org-element-%s-parser" - (car closest-cand)))))) - (cbeg (org-element-property :contents-begin object)) - (cend (org-element-property :contents-end object)) - (obj-end (org-element-property :end object))) - (cond - ;; ORIGIN is after OBJECT, so skip it. - ((<= obj-end origin) (goto-char obj-end)) - ;; ORIGIN is within a non-recursive object or at - ;; an object boundaries: Return that object. - ((or (not cbeg) (< origin cbeg) (>= origin cend)) - (throw 'exit - (org-element-put-property object :parent parent))) - ;; Otherwise, move within current object and - ;; restrict search to the end of its contents. - (t (goto-char cbeg) - (narrow-to-region (point) cend) - (org-element-put-property object :parent parent) - (setq parent object - restriction (org-element-restriction object) - candidates 'initial))))))) - parent)))))) - -(defun org-element-nested-p (elem-A elem-B) - "Non-nil when elements ELEM-A and ELEM-B are nested." - (let ((beg-A (org-element-property :begin elem-A)) - (beg-B (org-element-property :begin elem-B)) - (end-A (org-element-property :end elem-A)) - (end-B (org-element-property :end elem-B))) - (or (and (>= beg-A beg-B) (<= end-A end-B)) - (and (>= beg-B beg-A) (<= end-B end-A))))) - -(defun org-element-swap-A-B (elem-A elem-B) - "Swap elements ELEM-A and ELEM-B. -Assume ELEM-B is after ELEM-A in the buffer. Leave point at the -end of ELEM-A." - (goto-char (org-element-property :begin elem-A)) - ;; There are two special cases when an element doesn't start at bol: - ;; the first paragraph in an item or in a footnote definition. - (let ((specialp (not (bolp)))) - ;; Only a paragraph without any affiliated keyword can be moved at - ;; ELEM-A position in such a situation. Note that the case of - ;; a footnote definition is impossible: it cannot contain two - ;; paragraphs in a row because it cannot contain a blank line. - (if (and specialp - (or (not (eq (org-element-type elem-B) 'paragraph)) - (/= (org-element-property :begin elem-B) - (org-element-property :contents-begin elem-B)))) - (error "Cannot swap elements")) - ;; In a special situation, ELEM-A will have no indentation. We'll - ;; give it ELEM-B's (which will in, in turn, have no indentation). - (let* ((ind-B (when specialp - (goto-char (org-element-property :begin elem-B)) - (org-get-indentation))) - (beg-A (org-element-property :begin elem-A)) - (end-A (save-excursion - (goto-char (org-element-property :end elem-A)) - (skip-chars-backward " \r\t\n") - (point-at-eol))) - (beg-B (org-element-property :begin elem-B)) - (end-B (save-excursion - (goto-char (org-element-property :end elem-B)) - (skip-chars-backward " \r\t\n") - (point-at-eol))) - ;; Store overlays responsible for visibility status. We - ;; also need to store their boundaries as they will be - ;; removed from buffer. - (overlays - (cons - (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov))) - (overlays-in beg-A end-A)) - (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov))) - (overlays-in beg-B end-B)))) - ;; Get contents. - (body-A (buffer-substring beg-A end-A)) - (body-B (delete-and-extract-region beg-B end-B))) - (goto-char beg-B) - (when specialp - (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B)) - (org-indent-to-column ind-B)) - (insert body-A) - ;; Restore ex ELEM-A overlays. - (let ((offset (- beg-B beg-A))) - (mapc (lambda (ov) - (move-overlay - (car ov) (+ (nth 1 ov) offset) (+ (nth 2 ov) offset))) - (car overlays)) - (goto-char beg-A) - (delete-region beg-A end-A) - (insert body-B) - ;; Restore ex ELEM-B overlays. - (mapc (lambda (ov) - (move-overlay - (car ov) (- (nth 1 ov) offset) (- (nth 2 ov) offset))) - (cdr overlays))) - (goto-char (org-element-property :end elem-B))))) - -(provide 'org-element) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-element.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-entities.el b/xemacs-packages/lisp/org-8.2.3c/org-entities.el deleted file mode 100644 index 638da786..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-entities.el +++ /dev/null @@ -1,617 +0,0 @@ -;;; org-entities.el --- Support for special entities in Org-mode - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik , -;; Ulf Stegemann -;; Keywords: outlines, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;;; Code: - -(require 'org-macs) - -(declare-function org-table-align "org-table" ()) - -(eval-when-compile - (require 'cl)) - -(defgroup org-entities nil - "Options concerning entities in Org-mode." - :tag "Org Entities" - :group 'org) - -(defcustom org-entities-ascii-explanatory nil - "Non-nil means replace special entities in ASCII. -For example, this will replace \"\\nsup\" with \"[not a superset of]\" -in backends where the corresponding character is not available." - :group 'org-entities - :version "24.1" - :type 'boolean) - -(defcustom org-entities-user nil - "User-defined entities used in Org-mode to produce special characters. -Each entry in this list is a list of strings. It associates the name -of the entity that can be inserted into an Org file as \\name with the -appropriate replacements for the different export backends. The order -of the fields is the following - -name As a string, without the leading backslash -LaTeX replacement In ready LaTeX, no further processing will take place -LaTeX mathp A Boolean, either t or nil. t if this entity needs - to be in math mode. -HTML replacement In ready HTML, no further processing will take place. - Usually this will be an &...; entity. -ASCII replacement Plain ASCII, no extensions. Symbols that cannot be - represented will be left as they are, but see the. - variable `org-entities-ascii-explanatory'. -Latin1 replacement Use the special characters available in latin1. -utf-8 replacement Use the special characters available in utf-8. - -If you define new entities here that require specific LaTeX -packages to be loaded, add these packages to `org-latex-packages-alist'." - :group 'org-entities - :version "24.1" - :type '(repeat - (list - (string :tag "name ") - (string :tag "LaTeX ") - (boolean :tag "Require LaTeX math?") - (string :tag "HTML ") - (string :tag "ASCII ") - (string :tag "Latin1") - (string :tag "utf-8 ")))) - -(defconst org-entities - '( - "* Letters" - "** Latin" - ("Agrave" "\\`{A}" nil "À" "A" "À" "À") - ("agrave" "\\`{a}" nil "à" "a" "à" "à") - ("Aacute" "\\'{A}" nil "Á" "A" "Á" "Á") - ("aacute" "\\'{a}" nil "á" "a" "á" "á") - ("Acirc" "\\^{A}" nil "Â" "A" "Â" "Â") - ("acirc" "\\^{a}" nil "â" "a" "â" "â") - ("Atilde" "\\~{A}" nil "Ã" "A" "Ã" "Ã") - ("atilde" "\\~{a}" nil "ã" "a" "ã" "ã") - ("Auml" "\\\"{A}" nil "Ä" "Ae" "Ä" "Ä") - ("auml" "\\\"{a}" nil "ä" "ae" "ä" "ä") - ("Aring" "\\AA{}" nil "Å" "A" "Å" "Å") - ("AA" "\\AA{}" nil "Å" "A" "Å" "Å") - ("aring" "\\aa{}" nil "å" "a" "Ã¥" "Ã¥") - ("AElig" "\\AE{}" nil "Æ" "AE" "Æ" "Æ") - ("aelig" "\\ae{}" nil "æ" "ae" "æ" "æ") - ("Ccedil" "\\c{C}" nil "Ç" "C" "Ç" "Ç") - ("ccedil" "\\c{c}" nil "ç" "c" "ç" "ç") - ("Egrave" "\\`{E}" nil "È" "E" "È" "È") - ("egrave" "\\`{e}" nil "è" "e" "è" "è") - ("Eacute" "\\'{E}" nil "É" "E" "É" "É") - ("eacute" "\\'{e}" nil "é" "e" "é" "é") - ("Ecirc" "\\^{E}" nil "Ê" "E" "Ê" "Ê") - ("ecirc" "\\^{e}" nil "ê" "e" "ê" "ê") - ("Euml" "\\\"{E}" nil "Ë" "E" "Ë" "Ë") - ("euml" "\\\"{e}" nil "ë" "e" "ë" "ë") - ("Igrave" "\\`{I}" nil "Ì" "I" "Ì" "Ì") - ("igrave" "\\`{i}" nil "ì" "i" "ì" "ì") - ("Iacute" "\\'{I}" nil "Í" "I" "Í" "Í") - ("iacute" "\\'{i}" nil "í" "i" "í" "í") - ("Icirc" "\\^{I}" nil "Î" "I" "Î" "Î") - ("icirc" "\\^{i}" nil "î" "i" "î" "î") - ("Iuml" "\\\"{I}" nil "Ï" "I" "Ï" "Ï") - ("iuml" "\\\"{i}" nil "ï" "i" "ï" "ï") - ("Ntilde" "\\~{N}" nil "Ñ" "N" "Ñ" "Ñ") - ("ntilde" "\\~{n}" nil "ñ" "n" "ñ" "ñ") - ("Ograve" "\\`{O}" nil "Ò" "O" "Ò" "Ò") - ("ograve" "\\`{o}" nil "ò" "o" "ò" "ò") - ("Oacute" "\\'{O}" nil "Ó" "O" "Ó" "Ó") - ("oacute" "\\'{o}" nil "ó" "o" "ó" "ó") - ("Ocirc" "\\^{O}" nil "Ô" "O" "Ô" "Ô") - ("ocirc" "\\^{o}" nil "ô" "o" "ô" "ô") - ("Otilde" "\\~{O}" nil "Õ" "O" "Õ" "Õ") - ("otilde" "\\~{o}" nil "õ" "o" "õ" "õ") - ("Ouml" "\\\"{O}" nil "Ö" "Oe" "Ö" "Ö") - ("ouml" "\\\"{o}" nil "ö" "oe" "ö" "ö") - ("Oslash" "\\O" nil "Ø" "O" "Ø" "Ø") - ("oslash" "\\o{}" nil "ø" "o" "ø" "ø") - ("OElig" "\\OE{}" nil "Œ" "OE" "OE" "Œ") - ("oelig" "\\oe{}" nil "œ" "oe" "oe" "œ") - ("Scaron" "\\v{S}" nil "Š" "S" "S" "Å ") - ("scaron" "\\v{s}" nil "š" "s" "s" "Å¡") - ("szlig" "\\ss{}" nil "ß" "ss" "ß" "ß") - ("Ugrave" "\\`{U}" nil "Ù" "U" "Ù" "Ù") - ("ugrave" "\\`{u}" nil "ù" "u" "ù" "ù") - ("Uacute" "\\'{U}" nil "Ú" "U" "Ú" "Ú") - ("uacute" "\\'{u}" nil "ú" "u" "ú" "ú") - ("Ucirc" "\\^{U}" nil "Û" "U" "Û" "Û") - ("ucirc" "\\^{u}" nil "û" "u" "û" "û") - ("Uuml" "\\\"{U}" nil "Ü" "Ue" "Ü" "Ü") - ("uuml" "\\\"{u}" nil "ü" "ue" "ü" "ü") - ("Yacute" "\\'{Y}" nil "Ý" "Y" "Ý" "Ý") - ("yacute" "\\'{y}" nil "ý" "y" "ý" "ý") - ("Yuml" "\\\"{Y}" nil "Ÿ" "Y" "Y" "Ÿ") - ("yuml" "\\\"{y}" nil "ÿ" "y" "ÿ" "ÿ") - - "** Latin (special face)" - ("fnof" "\\textit{f}" nil "ƒ" "f" "f" "ƒ") - ("real" "\\Re" t "ℜ" "R" "R" "ℜ") - ("image" "\\Im" t "ℑ" "I" "I" "ℑ") - ("weierp" "\\wp" t "℘" "P" "P" "℘") - ("ell" "\\ell" t "ℓ" "ell" "ell" "ℓ") - ("imath" "\\imath" t "ı" "[dotless i]" "dotless i" "ı") - ("jmath" "\\jmath" t "ȷ" "[dotless j]" "dotless j" "È·") - - "** Greek" - ("Alpha" "A" nil "Α" "Alpha" "Alpha" "Α") - ("alpha" "\\alpha" t "α" "alpha" "alpha" "α") - ("Beta" "B" nil "Β" "Beta" "Beta" "Β") - ("beta" "\\beta" t "β" "beta" "beta" "β") - ("Gamma" "\\Gamma" t "Γ" "Gamma" "Gamma" "Γ") - ("gamma" "\\gamma" t "γ" "gamma" "gamma" "γ") - ("Delta" "\\Delta" t "Δ" "Delta" "Gamma" "Δ") - ("delta" "\\delta" t "δ" "delta" "delta" "δ") - ("Epsilon" "E" nil "Ε" "Epsilon" "Epsilon" "Ε") - ("epsilon" "\\epsilon" t "ε" "epsilon" "epsilon" "ε") - ("varepsilon" "\\varepsilon" t "ε" "varepsilon" "varepsilon" "ε") - ("Zeta" "Z" nil "Ζ" "Zeta" "Zeta" "Ζ") - ("zeta" "\\zeta" t "ζ" "zeta" "zeta" "ζ") - ("Eta" "H" nil "Η" "Eta" "Eta" "Η") - ("eta" "\\eta" t "η" "eta" "eta" "η") - ("Theta" "\\Theta" t "Θ" "Theta" "Theta" "Θ") - ("theta" "\\theta" t "θ" "theta" "theta" "θ") - ("thetasym" "\\vartheta" t "ϑ" "theta" "theta" "ϑ") - ("vartheta" "\\vartheta" t "ϑ" "theta" "theta" "ϑ") - ("Iota" "I" nil "Ι" "Iota" "Iota" "Ι") - ("iota" "\\iota" t "ι" "iota" "iota" "ι") - ("Kappa" "K" nil "Κ" "Kappa" "Kappa" "Κ") - ("kappa" "\\kappa" t "κ" "kappa" "kappa" "κ") - ("Lambda" "\\Lambda" t "Λ" "Lambda" "Lambda" "Λ") - ("lambda" "\\lambda" t "λ" "lambda" "lambda" "λ") - ("Mu" "M" nil "Μ" "Mu" "Mu" "Μ") - ("mu" "\\mu" t "μ" "mu" "mu" "μ") - ("nu" "\\nu" t "ν" "nu" "nu" "ν") - ("Nu" "N" nil "Ν" "Nu" "Nu" "Ν") - ("Xi" "\\Xi" t "Ξ" "Xi" "Xi" "Ξ") - ("xi" "\\xi" t "ξ" "xi" "xi" "ξ") - ("Omicron" "O" nil "Ο" "Omicron" "Omicron" "Ο") - ("omicron" "\\textit{o}" nil "ο" "omicron" "omicron" "ο") - ("Pi" "\\Pi" t "Π" "Pi" "Pi" "Π") - ("pi" "\\pi" t "π" "pi" "pi" "π") - ("Rho" "P" nil "Ρ" "Rho" "Rho" "Ρ") - ("rho" "\\rho" t "ρ" "rho" "rho" "ρ") - ("Sigma" "\\Sigma" t "Σ" "Sigma" "Sigma" "Σ") - ("sigma" "\\sigma" t "σ" "sigma" "sigma" "σ") - ("sigmaf" "\\varsigma" t "ς" "sigmaf" "sigmaf" "ς") - ("varsigma" "\\varsigma" t "ς" "varsigma" "varsigma" "ς") - ("Tau" "T" nil "Τ" "Tau" "Tau" "Τ") - ("Upsilon" "\\Upsilon" t "Υ" "Upsilon" "Upsilon" "Î¥") - ("upsih" "\\Upsilon" t "ϒ" "upsilon" "upsilon" "ϒ") - ("upsilon" "\\upsilon" t "υ" "upsilon" "upsilon" "υ") - ("Phi" "\\Phi" t "Φ" "Phi" "Phi" "Φ") - ("phi" "\\phi" t "φ" "phi" "phi" "φ") - ("varphi" "\\varphi" t "ϕ" "varphi" "varphi" "ɸ") - ("Chi" "X" nil "Χ" "Chi" "Chi" "Χ") - ("chi" "\\chi" t "χ" "chi" "chi" "χ") - ("acutex" "\\acute x" t "´x" "'x" "'x" "𝑥́") - ("Psi" "\\Psi" t "Ψ" "Psi" "Psi" "Ψ") - ("psi" "\\psi" t "ψ" "psi" "psi" "ψ") - ("tau" "\\tau" t "τ" "tau" "tau" "τ") - ("Omega" "\\Omega" t "Ω" "Omega" "Omega" "Ω") - ("omega" "\\omega" t "ω" "omega" "omega" "ω") - ("piv" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "ϖ") - ("varpi" "\\varpi" t "ϖ" "omega-pi" "omega-pi" "ϖ") - ("partial" "\\partial" t "∂" "[partial differential]" "[partial differential]" "∂") - - "** Hebrew" - ("alefsym" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") - ("aleph" "\\aleph" t "ℵ" "aleph" "aleph" "ℵ") - ("gimel" "\\gimel" t "ℷ" "gimel" "gimel" "ℷ") - ("beth" "\\beth" t "ℶ" "beth" "beth" "ב") - ("dalet" "\\daleth" t "ℸ" "dalet" "dalet" "ד") - - "** Dead languages" - ("ETH" "\\DH{}" nil "Ð" "D" "Ð" "Ð") - ("eth" "\\dh{}" nil "ð" "dh" "ð" "ð") - ("THORN" "\\TH{}" nil "Þ" "TH" "Þ" "Þ") - ("thorn" "\\th{}" nil "þ" "th" "þ" "þ") - - "* Punctuation" - "** Dots and Marks" - ("dots" "\\dots{}" nil "…" "..." "..." "…") - ("cdots" "\\cdots{}" t "⋯" "..." "..." "⋯") - ("hellip" "\\dots{}" nil "…" "..." "..." "…") - ("middot" "\\textperiodcentered{}" nil "·" "." "·" "·") - ("iexcl" "!`" nil "¡" "!" "¡" "¡") - ("iquest" "?`" nil "¿" "?" "¿" "¿") - - "** Dash-like" - ("shy" "\\-" nil "­" "" "" "") - ("ndash" "--" nil "–" "-" "-" "–") - ("mdash" "---" nil "—" "--" "--" "—") - - "** Quotations" - ("quot" "\\textquotedbl{}" nil """ "\"" "\"" "\"") - ("acute" "\\textasciiacute{}" nil "´" "'" "´" "´") - ("ldquo" "\\textquotedblleft{}" nil "“" "\"" "\"" "“") - ("rdquo" "\\textquotedblright{}" nil "”" "\"" "\"" "”") - ("bdquo" "\\quotedblbase{}" nil "„" "\"" "\"" "„") - ("lsquo" "\\textquoteleft{}" nil "‘" "`" "`" "‘") - ("rsquo" "\\textquoteright{}" nil "’" "'" "'" "’") - ("sbquo" "\\quotesinglbase{}" nil "‚" "," "," "‚") - ("laquo" "\\guillemotleft{}" nil "«" "<<" "«" "«") - ("raquo" "\\guillemotright{}" nil "»" ">>" "»" "»") - ("lsaquo" "\\guilsinglleft{}" nil "‹" "<" "<" "‹") - ("rsaquo" "\\guilsinglright{}" nil "›" ">" ">" "›") - - "* Other" - "** Misc. (often used)" - ("circ" "\\^{}" nil "ˆ" "^" "^" "ˆ") - ("vert" "\\vert{}" t "|" "|" "|" "|") - ("brvbar" "\\textbrokenbar{}" nil "¦" "|" "¦" "¦") - ("S" "\\S" nil "§" "paragraph" "§" "§") - ("sect" "\\S" nil "§" "paragraph" "§" "§") - ("amp" "\\&" nil "&" "&" "&" "&") - ("lt" "\\textless{}" nil "<" "<" "<" "<") - ("gt" "\\textgreater{}" nil ">" ">" ">" ">") - ("tilde" "\\textasciitilde{}" nil "~" "~" "~" "~") - ("slash" "/" nil "/" "/" "/" "/") - ("plus" "+" nil "+" "+" "+" "+") - ("under" "\\_" nil "_" "_" "_" "_") - ("equal" "=" nil "=" "=" "=" "=") - ("asciicirc" "\\textasciicircum{}" nil "^" "^" "^" "^") - ("dagger" "\\textdagger{}" nil "†" "[dagger]" "[dagger]" "†") - ("dag" "\\dag{}" nil "†" "[dagger]" "[dagger]" "†") - ("Dagger" "\\textdaggerdbl{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") - ("ddag" "\\ddag{}" nil "‡" "[doubledagger]" "[doubledagger]" "‡") - - "** Whitespace" - ("nbsp" "~" nil " " " " " " " ") - ("ensp" "\\hspace*{.5em}" nil " " " " " " " ") - ("emsp" "\\hspace*{1em}" nil " " " " " " " ") - ("thinsp" "\\hspace*{.2em}" nil " " " " " " " ") - - "** Currency" - ("curren" "\\textcurrency{}" nil "¤" "curr." "¤" "¤") - ("cent" "\\textcent{}" nil "¢" "cent" "¢" "¢") - ("pound" "\\pounds{}" nil "£" "pound" "£" "£") - ("yen" "\\textyen{}" nil "¥" "yen" "Â¥" "Â¥") - ("euro" "\\texteuro{}" nil "€" "EUR" "EUR" "€") - ("EUR" "\\EUR{}" nil "€" "EUR" "EUR" "€") - ("EURdig" "\\EURdig{}" nil "€" "EUR" "EUR" "€") - ("EURhv" "\\EURhv{}" nil "€" "EUR" "EUR" "€") - ("EURcr" "\\EURcr{}" nil "€" "EUR" "EUR" "€") - ("EURtm" "\\EURtm{}" nil "€" "EUR" "EUR" "€") - - "** Property Marks" - ("copy" "\\textcopyright{}" nil "©" "(c)" "©" "©") - ("reg" "\\textregistered{}" nil "®" "(r)" "®" "®") - ("trade" "\\texttrademark{}" nil "™" "TM" "TM" "™") - - "** Science et al." - ("minus" "\\minus" t "−" "-" "-" "−") - ("pm" "\\textpm{}" nil "±" "+-" "±" "±") - ("plusmn" "\\textpm{}" nil "±" "+-" "±" "±") - ("times" "\\texttimes{}" nil "×" "*" "×" "×") - ("frasl" "/" nil "⁄" "/" "/" "⁄") - ("colon" "\\colon" t ":" ":" ":" ":") - ("div" "\\textdiv{}" nil "÷" "/" "÷" "÷") - ("frac12" "\\textonehalf{}" nil "½" "1/2" "½" "½") - ("frac14" "\\textonequarter{}" nil "¼" "1/4" "¼" "¼") - ("frac34" "\\textthreequarters{}" nil "¾" "3/4" "¾" "¾") - ("permil" "\\textperthousand{}" nil "‰" "per thousand" "per thousand" "‰") - ("sup1" "\\textonesuperior{}" nil "¹" "^1" "¹" "¹") - ("sup2" "\\texttwosuperior{}" nil "²" "^2" "²" "²") - ("sup3" "\\textthreesuperior{}" nil "³" "^3" "³" "³") - ("radic" "\\sqrt{\\,}" t "√" "[square root]" "[square root]" "√") - ("sum" "\\sum" t "∑" "[sum]" "[sum]" "∑") - ("prod" "\\prod" t "∏" "[product]" "[n-ary product]" "∏") - ("micro" "\\textmu{}" nil "µ" "micro" "µ" "µ") - ("macr" "\\textasciimacron{}" nil "¯" "[macron]" "¯" "¯") - ("deg" "\\textdegree{}" nil "°" "degree" "°" "°") - ("prime" "\\prime" t "′" "'" "'" "′") - ("Prime" "\\prime{}\\prime" t "″" "''" "''" "″") - ("infin" "\\propto" t "∞" "[infinity]" "[infinity]" "∞") - ("infty" "\\infty" t "∞" "[infinity]" "[infinity]" "∞") - ("prop" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") - ("proptp" "\\propto" t "∝" "[proportional to]" "[proportional to]" "∝") - ("not" "\\textlnot{}" nil "¬" "[angled dash]" "¬" "¬") - ("neg" "\\neg{}" t "¬" "[angled dash]" "¬" "¬") - ("land" "\\land" t "∧" "[logical and]" "[logical and]" "∧") - ("wedge" "\\wedge" t "∧" "[logical and]" "[logical and]" "∧") - ("lor" "\\lor" t "∨" "[logical or]" "[logical or]" "∨") - ("vee" "\\vee" t "∨" "[logical or]" "[logical or]" "∨") - ("cap" "\\cap" t "∩" "[intersection]" "[intersection]" "∩") - ("cup" "\\cup" t "∪" "[union]" "[union]" "∪") - ("int" "\\int" t "∫" "[integral]" "[integral]" "∫") - ("therefore" "\\therefore" t "∴" "[therefore]" "[therefore]" "∴") - ("there4" "\\therefore" t "∴" "[therefore]" "[therefore]" "∴") - ("because" "\\because" t "∵" "[because]" "[because]" "∵") - ("sim" "\\sim" t "∼" "~" "~" "∼") - ("cong" "\\cong" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") - ("simeq" "\\simeq" t "≅" "[approx. equal to]" "[approx. equal to]" "≅") - ("asymp" "\\asymp" t "≈" "[almost equal to]" "[almost equal to]" "≈") - ("approx" "\\approx" t "≈" "[almost equal to]" "[almost equal to]" "≈") - ("ne" "\\ne" t "≠" "[not equal to]" "[not equal to]" "≠") - ("neq" "\\neq" t "≠" "[not equal to]" "[not equal to]" "≠") - ("equiv" "\\equiv" t "≡" "[identical to]" "[identical to]" "≡") - - ("triangleq" "\\triangleq" t "≜" "[defined to]" "[defined to]" "≜") - ("le" "\\le" t "≤" "<=" "<=" "≤") - ("leq" "\\le" t "≤" "<=" "<=" "≤") - ("ge" "\\ge" t "≥" ">=" ">=" "≥") - ("geq" "\\ge" t "≥" ">=" ">=" "≥") - ("lessgtr" "\\lessgtr" t "≶" "[less than or greater than]" "[less than or greater than]" "≶") - ("lesseqgtr" "\\lesseqgtr" t "⋚" "[less than or equal or greater than or equal]" "[less than or equal or greater than or equal]" "⋚") - ("ll" "\\ll" t "≪" "<<" "<<" "≪") - ("Ll" "\lll" t "⋘" "<<<" "<<<" "⋘") - ("lll" "\lll" t "⋘" "<<<" "<<<" "⋘") - ("gg" "\\gg" t "≫" ">>" ">>" "≫") - ("Gg" "\\ggg" t "⋙" ">>>" ">>>" "⋙") - ("ggg" "\\ggg" t "⋙" ">>>" ">>>" "⋙") - ("prec" "\\prec" t "≺" "[precedes]" "[precedes]" "≺") - ("preceq" "\\preceq" t "≼" "[precedes or equal]" "[precedes or equal]" "≼") - ("preccurlyeq" "\\preccurlyeq" t "≼" "[precedes or equal]" "[precedes or equal]" "≼") - ("succ" "\\succ" t "≻" "[succeeds]" "[succeeds]" "≻") - ("succeq" "\\succeq" t "≽" "[succeeds or equal]" "[succeeds or equal]" "≽") - ("succcurlyeq" "\\succcurlyeq" t "≽" "[succeeds or equal]" "[succeeds or equal]" "≽") - ("sub" "\\subset" t "⊂" "[subset of]" "[subset of]" "⊂") - ("subset" "\\subset" t "⊂" "[subset of]" "[subset of]" "⊂") - ("sup" "\\supset" t "⊃" "[superset of]" "[superset of]" "⊃") - ("supset" "\\supset" t "⊃" "[superset of]" "[superset of]" "⊃") - ("nsub" "\\not\\subset" t "⊄" "[not a subset of]" "[not a subset of" "⊄") - ("sube" "\\subseteq" t "⊆" "[subset of or equal to]" "[subset of or equal to]" "⊆") - ("nsup" "\\not\\supset" t "⊅" "[not a superset of]" "[not a superset of]" "⊅") - ("supe" "\\supseteq" t "⊇" "[superset of or equal to]" "[superset of or equal to]" "⊇") - ("setminus" "\\setminus" t "∖" "\" "\" "â§µ") - ("forall" "\\forall" t "∀" "[for all]" "[for all]" "∀") - ("exist" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") - ("exists" "\\exists" t "∃" "[there exists]" "[there exists]" "∃") - ("nexist" "\\nexists" t "∃" "[there does not exists]" "[there does not exists]" "∄") - ("nexists" "\\nexists" t "∃" "[there does not exists]" "[there does not exists]" "∄") - ("empty" "\\empty" t "∅" "[empty set]" "[empty set]" "∅") - ("emptyset" "\\emptyset" t "∅" "[empty set]" "[empty set]" "∅") - ("isin" "\\in" t "∈" "[element of]" "[element of]" "∈") - ("in" "\\in" t "∈" "[element of]" "[element of]" "∈") - ("notin" "\\notin" t "∉" "[not an element of]" "[not an element of]" "∉") - ("ni" "\\ni" t "∋" "[contains as member]" "[contains as member]" "∋") - ("nabla" "\\nabla" t "∇" "[nabla]" "[nabla]" "∇") - ("ang" "\\angle" t "∠" "[angle]" "[angle]" "∠") - ("angle" "\\angle" t "∠" "[angle]" "[angle]" "∠") - ("perp" "\\perp" t "⊥" "[up tack]" "[up tack]" "⊥") - ("sdot" "\\cdot" t "⋅" "[dot]" "[dot]" "⋅") - ("cdot" "\\cdot" t "⋅" "[dot]" "[dot]" "⋅") - ("lceil" "\\lceil" t "⌈" "[left ceiling]" "[left ceiling]" "⌈") - ("rceil" "\\rceil" t "⌉" "[right ceiling]" "[right ceiling]" "⌉") - ("lfloor" "\\lfloor" t "⌊" "[left floor]" "[left floor]" "⌊") - ("rfloor" "\\rfloor" t "⌋" "[right floor]" "[right floor]" "⌋") - ("lang" "\\langle" t "⟨" "<" "<" "⟨") - ("rang" "\\rangle" t "⟩" ">" ">" "⟩") - ("hbar" "\\hbar" t "ℏ" "hbar" "hbar" "ℏ") - ("mho" "\\mho" t "℧" "mho" "mho" "℧") - - "** Arrows" - ("larr" "\\leftarrow" t "←" "<-" "<-" "←") - ("leftarrow" "\\leftarrow" t "←" "<-" "<-" "←") - ("gets" "\\gets" t "←" "<-" "<-" "←") - ("lArr" "\\Leftarrow" t "⇐" "<=" "<=" "⇐") - ("Leftarrow" "\\Leftarrow" t "⇐" "<=" "<=" "⇐") - ("uarr" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") - ("uparrow" "\\uparrow" t "↑" "[uparrow]" "[uparrow]" "↑") - ("uArr" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") - ("Uparrow" "\\Uparrow" t "⇑" "[dbluparrow]" "[dbluparrow]" "⇑") - ("rarr" "\\rightarrow" t "→" "->" "->" "→") - ("to" "\\to" t "→" "->" "->" "→") - ("rightarrow" "\\rightarrow" t "→" "->" "->" "→") - ("rArr" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") - ("Rightarrow" "\\Rightarrow" t "⇒" "=>" "=>" "⇒") - ("darr" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") - ("downarrow" "\\downarrow" t "↓" "[downarrow]" "[downarrow]" "↓") - ("dArr" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") - ("Downarrow" "\\Downarrow" t "⇓" "[dbldownarrow]" "[dbldownarrow]" "⇓") - ("harr" "\\leftrightarrow" t "↔" "<->" "<->" "↔") - ("leftrightarrow" "\\leftrightarrow" t "↔" "<->" "<->" "↔") - ("hArr" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") - ("Leftrightarrow" "\\Leftrightarrow" t "⇔" "<=>" "<=>" "⇔") - ("crarr" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") - ("hookleftarrow" "\\hookleftarrow" t "↵" "<-'" "<-'" "↵") - - "** Function names" - ("arccos" "\\arccos" t "arccos" "arccos" "arccos" "arccos") - ("arcsin" "\\arcsin" t "arcsin" "arcsin" "arcsin" "arcsin") - ("arctan" "\\arctan" t "arctan" "arctan" "arctan" "arctan") - ("arg" "\\arg" t "arg" "arg" "arg" "arg") - ("cos" "\\cos" t "cos" "cos" "cos" "cos") - ("cosh" "\\cosh" t "cosh" "cosh" "cosh" "cosh") - ("cot" "\\cot" t "cot" "cot" "cot" "cot") - ("coth" "\\coth" t "coth" "coth" "coth" "coth") - ("csc" "\\csc" t "csc" "csc" "csc" "csc") - ("deg" "\\deg" t "°" "deg" "deg" "deg") - ("det" "\\det" t "det" "det" "det" "det") - ("dim" "\\dim" t "dim" "dim" "dim" "dim") - ("exp" "\\exp" t "exp" "exp" "exp" "exp") - ("gcd" "\\gcd" t "gcd" "gcd" "gcd" "gcd") - ("hom" "\\hom" t "hom" "hom" "hom" "hom") - ("inf" "\\inf" t "inf" "inf" "inf" "inf") - ("ker" "\\ker" t "ker" "ker" "ker" "ker") - ("lg" "\\lg" t "lg" "lg" "lg" "lg") - ("lim" "\\lim" t "lim" "lim" "lim" "lim") - ("liminf" "\\liminf" t "liminf" "liminf" "liminf" "liminf") - ("limsup" "\\limsup" t "limsup" "limsup" "limsup" "limsup") - ("ln" "\\ln" t "ln" "ln" "ln" "ln") - ("log" "\\log" t "log" "log" "log" "log") - ("max" "\\max" t "max" "max" "max" "max") - ("min" "\\min" t "min" "min" "min" "min") - ("Pr" "\\Pr" t "Pr" "Pr" "Pr" "Pr") - ("sec" "\\sec" t "sec" "sec" "sec" "sec") - ("sin" "\\sin" t "sin" "sin" "sin" "sin") - ("sinh" "\\sinh" t "sinh" "sinh" "sinh" "sinh") - ("sup" "\\sup" t "⊃" "sup" "sup" "sup") - ("tan" "\\tan" t "tan" "tan" "tan" "tan") - ("tanh" "\\tanh" t "tanh" "tanh" "tanh" "tanh") - - "** Signs & Symbols" - ("bull" "\\textbullet{}" nil "•" "*" "*" "•") - ("bullet" "\\textbullet{}" nil "•" "*" "*" "•") - ("star" "\\star" t "*" "*" "*" "⋆") - ("lowast" "\\ast" t "∗" "*" "*" "∗") - ("ast" "\\ast" t "∗" "*" "*" "*") - ("odot" "\\odot" t "o" "[circled dot]" "[circled dot]" "ʘ") - ("oplus" "\\oplus" t "⊕" "[circled plus]" "[circled plus]" "⊕") - ("otimes" "\\otimes" t "⊗" "[circled times]" "[circled times]" "⊗") - ("check" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") - ("checkmark" "\\checkmark" t "✓" "[checkmark]" "[checkmark]" "✓") - - "** Miscellaneous (seldom used)" - ("para" "\\P{}" nil "¶" "[pilcrow]" "¶" "¶") - ("ordf" "\\textordfeminine{}" nil "ª" "_a_" "ª" "ª") - ("ordm" "\\textordmasculine{}" nil "º" "_o_" "º" "º") - ("cedil" "\\c{}" nil "¸" "[cedilla]" "¸" "¸") - ("oline" "\\overline{~}" t "‾" "[overline]" "¯" "‾") - ("uml" "\\textasciidieresis{}" nil "¨" "[diaeresis]" "¨" "¨") - ("zwnj" "\\/{}" nil "‌" "" "" "‌") - ("zwj" "" nil "‍" "" "" "‍") - ("lrm" "" nil "‎" "" "" "‎") - ("rlm" "" nil "‏" "" "" "‏") - - "** Smilies" - ("smile" "\\smile" t "⌣" ":-)" ":-)" "⌣") - ("frown" "\\frown" t "⌢" ":-(" ":-(" "⌢") - ("smiley" "\\smiley{}" nil "☺" ":-)" ":-)" "☺") - ("blacksmile" "\\blacksmiley{}" nil "☻" ":-)" ":-)" "☻") - ("sad" "\\frownie{}" nil "☹" ":-(" ":-(" "☹") - - "** Suits" - ("clubs" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") - ("clubsuit" "\\clubsuit" t "♣" "[clubs]" "[clubs]" "♣") - ("spades" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") - ("spadesuit" "\\spadesuit" t "♠" "[spades]" "[spades]" "♠") - ("hearts" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") - ("heartsuit" "\\heartsuit" t "♥" "[hearts]" "[hearts]" "♥") - ("diams" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "◆") - ("diamondsuit" "\\diamondsuit" t "♦" "[diamonds]" "[diamonds]" "◆") - ("diamond" "\\diamondsuit" t "⋄" "[diamond]" "[diamond]" "◆") - ("Diamond" "\\diamondsuit" t "⋄" "[diamond]" "[diamond]" "◆") - ("loz" "\\lozenge" t "◊" "[lozenge]" "[lozenge]" "â§«") - ) - "Default entities used in Org-mode to produce special characters. -For details see `org-entities-user'.") - -(defsubst org-entity-get (name) - "Get the proper association for NAME from the entity lists. -This first checks the user list, then the built-in list." - (or (assoc name org-entities-user) - (assoc name org-entities))) - -(defun org-entity-get-representation (name kind) - "Get the correct representation of entity NAME for export type KIND. -Kind can be any of `latex', `html', `ascii', `latin1', or `utf8'." - (let* ((e (org-entity-get name)) - (n (cdr (assq kind '((latex . 1) (html . 3) (ascii . 4) - (latin1 . 5) (utf8 . 6))))) - (r (and e n (nth n e)))) - (if (and e r - (not org-entities-ascii-explanatory) - (memq kind '(ascii latin1 utf8)) - (= (string-to-char r) ?\[)) - (concat "\\" name) - r))) - -(defsubst org-entity-latex-math-p (name) - "Does entity NAME require math mode in LaTeX?" - (nth 2 (org-entity-get name))) - -;; Helpfunctions to create a table for orgmode.org/worg/org-symbols.org - -(defun org-entities-create-table () - "Create an Org mode table with all entities." - (interactive) - (let ((pos (point)) e latex mathp html latin utf8 name ascii) - (insert "|Name|LaTeX code|LaTeX|HTML code |HTML|ASCII|Latin1|UTF-8\n|-\n") - (mapc (lambda (e) (when (listp e) - (setq name (car e) - latex (nth 1 e) - mathp (nth 2 e) - html (nth 3 e) - ascii (nth 4 e) - latin (nth 5 e) - utf8 (nth 6 e)) - (if (equal ascii "|") (setq ascii "\\vert")) - (if (equal latin "|") (setq latin "\\vert")) - (if (equal utf8 "|") (setq utf8 "\\vert")) - (if (equal ascii "=>") (setq ascii "= >")) - (if (equal latin "=>") (setq latin "= >")) - (insert "|" name - "|" (format "=%s=" latex) - "|" (format (if mathp "$%s$" "$\\mbox{%s}$") - latex) - "|" (format "=%s=" html) "|" html - "|" ascii "|" latin "|" utf8 - "|\n"))) - org-entities) - (goto-char pos) - (org-table-align))) - -(defun org-entities-help () - "Create a Help buffer with all available entities." - (interactive) - (with-output-to-temp-buffer "*Org Entity Help*" - (princ "Org-mode entities\n=================\n\n") - (let ((ll (append '("* User-defined additions (variable org-entities-user)") - org-entities-user - org-entities)) - e latex mathp html latin utf8 name ascii - (lastwasstring t) - (head (concat - "\n" - " Symbol Org entity LaTeX code HTML code\n" - " -----------------------------------------------------------\n"))) - (while ll - (setq e (pop ll)) - (if (stringp e) - (progn - (princ e) - (princ "\n") - (setq lastwasstring t)) - (if lastwasstring (princ head)) - (setq lastwasstring nil) - (setq name (car e) - latex (nth 1 e) - html (nth 3 e) - utf8 (nth 6 e)) - (princ (format " %-8s \\%-16s %-22s %-13s\n" - utf8 name latex html)))))) - (with-current-buffer "*Org Entity Help*" - (org-mode)) - (select-window (get-buffer-window "*Org Entity Help*"))) - - -(defun replace-amp () - "Postprocess HTML file to unescape the ampersand." - (interactive) - (while (re-search-forward "&\\([^<;]+;\\)" nil t) - (replace-match (concat "&" (match-string 1)) t t))) - -(provide 'org-entities) - -;; Local variables: -;; coding: utf-8 -;; End: - -;;; org-entities.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-eshell.el b/xemacs-packages/lisp/org-8.2.3c/org-eshell.el deleted file mode 100644 index 5c264000..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-eshell.el +++ /dev/null @@ -1,65 +0,0 @@ -;;; org-eshell.el - Support for links to working directories in eshell - -;; Copyright (C) 2011-2013 Free Software Foundation, Inc. - -;; Author: Konrad Hinsen - -;; 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 . - -;;; Commentary: - -;;; Code: - -(require 'org) -(require 'eshell) -(require 'esh-mode) - -(org-add-link-type "eshell" 'org-eshell-open) -(add-hook 'org-store-link-functions 'org-eshell-store-link) - -(defun org-eshell-open (link) - "Switch to am eshell buffer and execute a command line. - The link can be just a command line (executed in the default - eshell buffer) or a command line prefixed by a buffer name - followed by a colon." - (let* ((buffer-and-command - (if (string-match "\\([A-Za-z0-9-+*]+\\):\\(.*\\)" link) - (list (match-string 1 link) - (match-string 2 link)) - (list eshell-buffer-name link))) - (eshell-buffer-name (car buffer-and-command)) - (command (cadr buffer-and-command))) - (if (get-buffer eshell-buffer-name) - (org-pop-to-buffer-same-window eshell-buffer-name) - (eshell)) - (goto-char (point-max)) - (eshell-kill-input) - (insert command) - (eshell-send-input))) - -(defun org-eshell-store-link () - "Store a link that, when opened, switches back to the current eshell buffer - and the current working directory." - (when (eq major-mode 'eshell-mode) - (let* ((command (concat "cd " dired-directory)) - (link (concat (buffer-name) ":" command))) - (org-store-link-props - :link (concat "eshell:" link) - :description command)))) - -(provide 'org-eshell) - -;;; org-eshell.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-faces.el b/xemacs-packages/lisp/org-8.2.3c/org-faces.el deleted file mode 100644 index d64fd0e1..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-faces.el +++ /dev/null @@ -1,802 +0,0 @@ -;;; org-faces.el --- Face definitions for Org-mode. - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file contains the face definitions for Org. - -;;; Code: - -(require 'org-macs) -(require 'org-compat) - -(defun org-copy-face (old-face new-face docstring &rest attributes) - (unless (facep new-face) - (if (fboundp 'set-face-attribute) - (progn - (make-face new-face) - (set-face-attribute new-face nil :inherit old-face) - (apply 'set-face-attribute new-face nil attributes) - (set-face-doc-string new-face docstring)) - (copy-face old-face new-face) - (if (fboundp 'set-face-doc-string) - (set-face-doc-string new-face docstring))))) -(put 'org-copy-face 'lisp-indent-function 2) - -(when (featurep 'xemacs) - (put 'mode-line 'face-alias 'modeline)) - -(defgroup org-faces nil - "Faces in Org-mode." - :tag "Org Faces" - :group 'org-appearance) - -(defface org-default - (org-compatible-face 'default nil) - "Face used for default text." - :group 'org-faces) - -(defface org-hide - '((((background light)) (:foreground "white")) - (((background dark)) (:foreground "black"))) - "Face used to hide leading stars in headlines. -The foreground color of this face should be equal to the background -color of the frame." - :group 'org-faces) - -(defface org-level-1 ;; originally copied from font-lock-function-name-face - (org-compatible-face 'outline-1 - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) - "Face used for level 1 headlines." - :group 'org-faces) - -(defface org-level-2 ;; originally copied from font-lock-variable-name-face - (org-compatible-face 'outline-2 - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8) (background light)) (:foreground "yellow")) - (((class color) (min-colors 8) (background dark)) (:foreground "yellow" :bold t)) - (t (:bold t)))) - "Face used for level 2 headlines." - :group 'org-faces) - -(defface org-level-3 ;; originally copied from font-lock-keyword-face - (org-compatible-face 'outline-3 - '((((class color) (min-colors 88) (background light)) (:foreground "Purple")) - (((class color) (min-colors 88) (background dark)) (:foreground "Cyan1")) - (((class color) (min-colors 16) (background light)) (:foreground "Purple")) - (((class color) (min-colors 16) (background dark)) (:foreground "Cyan")) - (((class color) (min-colors 8) (background light)) (:foreground "purple" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "cyan" :bold t)) - (t (:bold t)))) - "Face used for level 3 headlines." - :group 'org-faces) - -(defface org-level-4 ;; originally copied from font-lock-comment-face - (org-compatible-face 'outline-4 - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 16) (background light)) (:foreground "red")) - (((class color) (min-colors 16) (background dark)) (:foreground "red1")) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face used for level 4 headlines." - :group 'org-faces) - -(defface org-level-5 ;; originally copied from font-lock-type-face - (org-compatible-face 'outline-5 - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")))) - "Face used for level 5 headlines." - :group 'org-faces) - -(defface org-level-6 ;; originally copied from font-lock-constant-face - (org-compatible-face 'outline-6 - '((((class color) (min-colors 16) (background light)) (:foreground "CadetBlue")) - (((class color) (min-colors 16) (background dark)) (:foreground "Aquamarine")) - (((class color) (min-colors 8)) (:foreground "magenta")))) - "Face used for level 6 headlines." - :group 'org-faces) - -(defface org-level-7 ;; originally copied from font-lock-builtin-face - (org-compatible-face 'outline-7 - '((((class color) (min-colors 16) (background light)) (:foreground "Orchid")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSteelBlue")) - (((class color) (min-colors 8)) (:foreground "blue")))) - "Face used for level 7 headlines." - :group 'org-faces) - -(defface org-level-8 ;; originally copied from font-lock-string-face - (org-compatible-face 'outline-8 - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8)) (:foreground "green")))) - "Face used for level 8 headlines." - :group 'org-faces) - -(defface org-special-keyword ;; originally copied from font-lock-string-face - (org-compatible-face 'font-lock-keyword-face - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (t (:italic t)))) - "Face used for special keywords." - :group 'org-faces) - -(defface org-drawer ;; originally copied from font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) - "Face used for drawers." - :group 'org-faces) - -(defface org-property-value nil - "Face used for the value of a property." - :group 'org-faces) - -(defface org-column - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) - (:background "grey90" :weight normal :slant normal :strike-through nil - :underline nil)) - (((class color) (min-colors 16) (background dark)) - (:background "grey30" :weight normal :slant normal :strike-through nil - :underline nil)) - (((class color) (min-colors 8)) - (:background "cyan" :foreground "black" - :weight normal :slant normal :strike-through nil - :underline nil)) - (t (:inverse-video t)))) - "Face for column display of entry properties. -This is actually only part of the face definition for the text in column view. -The following faces apply, with this priority. - -1. The color of the reference face. This is normally the level fact that - is used in the outline. In agenda-mode, it will be the face of the - first character in the line. The color is explicitly retained to - make sure that the column line still looks a bit like the structure - line it is masking. - -2. The `org-column' face. - -3. The remaining properties of the reference face. - -Since column view works by putting overlays with a display property -over individual characters in the buffer, the face of the underlining -character (this might for example be the a TODO keyword) might still -shine through in some properties. So when your column view looks -funny, with \"random\" colors, weight, strike-through, try to explicitly -set the properties in the `org-column' face. For example, set -:underline to nil, or the :slant to `normal'. - -Under XEmacs, the rules are simpler, because the XEmacs version of -column view defines special faces for each outline level. See the file -`org-colview-xemacs.el' in Org's contrib/ directory for details." - :group 'org-faces) - -(defface org-column-title - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) - (:background "grey90" :underline t :weight bold)) - (((class color) (min-colors 16) (background dark)) - (:background "grey30" :underline t :weight bold)) - (((class color) (min-colors 8)) - (:background "cyan" :foreground "black" :underline t :weight bold)) - (t (:inverse-video t)))) - "Face for column display of entry properties." - :group 'org-faces) - -(defface org-agenda-column-dateline - (org-compatible-face 'org-column - '((t nil))) - "Face used in agenda column view for datelines with summaries." - :group 'org-faces) - -(defface org-warning - (org-compatible-face 'font-lock-warning-face - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face for deadlines and TODO keywords." - :group 'org-faces) - -(defface org-archived ; 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 headline with the ARCHIVE tag." - :group 'org-faces) - -(defface org-link - (org-compatible-face 'link - '((((class color) (background light)) (:foreground "Purple" :underline t)) - (((class color) (background dark)) (:foreground "Cyan" :underline t)) - (t (:underline t)))) - "Face for links." - :group 'org-faces) - -(defface org-footnote - '((((class color) (background light)) (:foreground "Purple" :underline t)) - (((class color) (background dark)) (:foreground "Cyan" :underline t)) - (t (:underline t))) - "Face for footnotes." - :group 'org-faces) - -(defface org-ellipsis - '((((class color) (background light)) (:foreground "DarkGoldenrod" :underline t)) - (((class color) (background dark)) (:foreground "LightGoldenrod" :underline t)) - (t (:strike-through t))) - "Face for the ellipsis in folded text." - :group 'org-faces) - -(defface org-target - '((((class color) (background light)) (:underline t)) - (((class color) (background dark)) (:underline t)) - (t (:underline t))) - "Face for link targets." - :group 'org-faces) - -(defface org-date - '((((class color) (background light)) (:foreground "Purple" :underline t)) - (((class color) (background dark)) (:foreground "Cyan" :underline t)) - (t (:underline t))) - "Face for date/time stamps." - :group 'org-faces) - -(defface org-date-selected - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :inverse-video t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :inverse-video t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :inverse-video t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :inverse-video t)) - (t (:inverse-video t)))) - "Face for highlighting the calendar day when using `org-read-date'. -Using a bold face here might cause discrepancies while displaying the -calendar." - :group 'org-faces) - -(defface org-sexp-date - '((((class color) (background light)) (:foreground "Purple")) - (((class color) (background dark)) (:foreground "Cyan")) - (t (:underline t))) - "Face for diary-like sexp date specifications." - :group 'org-faces) - -(defface org-tag - '((t (:bold t))) - "Default face for tags. -Note that the variable `org-tag-faces' can be used to overrule this face for -specific tags." - :group 'org-faces) - -(defface org-list-dt - '((t (:bold t))) - "Default face for definition terms in lists." - :group 'org-faces) - -(defface org-todo ; font-lock-warning-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "Red1" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "Pink" :bold t)) - (((class color) (min-colors 8) (background light)) (:foreground "red" :bold t)) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:inverse-video t :bold t)))) - "Face for TODO keywords." - :group 'org-faces) - -(defface org-done ;; originally copied from font-lock-type-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen" :bold t)) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen" :bold t)) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t)))) - "Face used for todo keywords that indicate DONE items." - :group 'org-faces) - -(defface org-agenda-done ;; originally copied from font-lock-type-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "ForestGreen")) - (((class color) (min-colors 16) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold nil)))) - "Face used in agenda, to indicate lines switched to DONE. -This face is used to de-emphasize items that where brightly colored in the -agenda because they were things to do, or overdue. The DONE state itself -is of course immediately visible, but for example a passed deadline is -\(by default) very bright read. This face could be simply the default face -of the frame, for example." - :group 'org-faces) - -(defface org-headline-done ;; originally copied from font-lock-string-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (((class color) (min-colors 8) (background light)) (:bold nil)))) - "Face used to indicate that a headline is DONE. -This face is only used if `org-fontify-done-headline' is set. If applies -to the part of the headline after the DONE keyword." - :group 'org-faces) - -(defcustom org-faces-easy-properties - '((todo . :foreground) (tag . :foreground) (priority . :foreground)) - "The property changes by easy faces. -This is an alist, the keys show the area of application, the values -can be `:foreground' or `:background'. A color string for special -keywords will then be interpreted as either foreground or background -color." - :group 'org-faces - :group 'org-todo - :version "24.1" - :type '(repeat - (cons (choice (const todo) (const tag) (const priority)) - (choice (const :foreground) (const :background))))) - -(defcustom org-todo-keyword-faces nil - "Faces for specific TODO keywords. -This is a list of cons cells, with TODO keywords in the car -and faces in the cdr. The face can be a symbol, a color -as a string (in which case the rest is inherited from the `org-todo' face), -or a property list of attributes, like - (:foreground \"blue\" :weight bold :underline t). -If it is a color string, the variable `org-faces-easy-properties' -determines if it is a foreground or a background color." - :group 'org-faces - :group 'org-todo - :type '(repeat - (cons - (string :tag "Keyword") - (choice :tag "Face " - (string :tag "Color") - (sexp :tag "Face"))))) - -(defface org-priority ;; originally copied from font-lock-string-face - (org-compatible-face 'font-lock-keyword-face - '((((class color) (min-colors 16) (background light)) (:foreground "RosyBrown")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSalmon")) - (t (:italic t)))) - "Face used for priority cookies." - :group 'org-faces) - -(defcustom org-priority-faces nil - "Faces for specific Priorities. -This is a list of cons cells, with priority character in the car -and faces in the cdr. The face can be a symbol, a color as -as a string, or a property list of attributes, like - (:foreground \"blue\" :weight bold :underline t). -If it is a color string, the variable `org-faces-easy-properties' -determines if it is a foreground or a background color." - :group 'org-faces - :group 'org-todo - :type '(repeat - (cons - (character :tag "Priority") - (choice :tag "Face " - (string :tag "Color") - (sexp :tag "Face"))))) - -(defvar org-tags-special-faces-re nil) -(defun org-set-tag-faces (var value) - (set var value) - (if (not value) - (setq org-tags-special-faces-re nil) - (setq org-tags-special-faces-re - (concat ":\\(" (mapconcat 'car value "\\|") "\\):")))) - -(defface org-checkbox - (org-compatible-face 'bold - '((t (:bold t)))) - "Face for checkboxes." - :group 'org-faces) - - -(org-copy-face 'org-todo 'org-checkbox-statistics-todo - "Face used for unfinished checkbox statistics.") - -(org-copy-face 'org-done 'org-checkbox-statistics-done - "Face used for finished checkbox statistics.") - -(defcustom org-tag-faces nil - "Faces for specific tags. -This is a list of cons cells, with tags in the car and faces in the cdr. -The face can be a symbol, a foreground color (in which case the rest is -inherited from the `org-tag' face) or a property list of attributes, -like (:foreground \"blue\" :weight bold :underline t). -If you set this variable through customize, it will immediately be effective -in new buffers and in modified lines. -If you set it with Lisp, a restart of Emacs is required to activate the -changes." - :group 'org-faces - :group 'org-tags - :set 'org-set-tag-faces - :type '(repeat - (cons - (string :tag "Tag ") - (choice :tag "Face" - (string :tag "Foreground color") - (sexp :tag "Face"))))) - -(defface org-table ;; originally copied from font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8) (background light)) (:foreground "blue")) - (((class color) (min-colors 8) (background dark))))) - "Face used for tables." - :group 'org-faces) - -(defface org-formula - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red")) - (t (:bold t :italic t)))) - "Face for formulas." - :group 'org-faces) - -(defface org-code - (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 fixed-width text like code snippets." - :group 'org-faces - :version "22.1") - -(defface org-meta-line - (org-compatible-face 'font-lock-comment-face nil) - "Face for meta lines startin with \"#+\"." - :group 'org-faces - :version "22.1") - -(defface org-document-title - '((((class color) (background light)) (:foreground "midnight blue" :weight bold)) - (((class color) (background dark)) (:foreground "pale turquoise" :weight bold)) - (t (:weight bold))) - "Face for document title, i.e. that which follows the #+TITLE: keyword." - :group 'org-faces) - -(defface org-document-info - '((((class color) (background light)) (:foreground "midnight blue")) - (((class color) (background dark)) (:foreground "pale turquoise")) - (t nil)) - "Face for document date, author and email; i.e. that which -follows a #+DATE:, #+AUTHOR: or #+EMAIL: keyword." - :group 'org-faces) - -(defface org-document-info-keyword - (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 #+TITLE:, #+AUTHOR:, #+EMAIL: and #+DATE: keywords." - :group 'org-faces) - -(defface org-block - (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 text in #+begin ... #+end blocks." - :group 'org-faces - :version "22.1") - -(defface org-block-background '((t ())) - "Face used for the source block background.") - -(org-copy-face 'org-meta-line 'org-block-begin-line - "Face used for the line delimiting the begin of source blocks.") - -(org-copy-face 'org-meta-line 'org-block-end-line - "Face used for the line delimiting the end of source blocks.") - -(defface org-verbatim - (org-compatible-face 'shadow - '((((class color grayscale) (min-colors 88) (background light)) - (:foreground "grey50" :underline t)) - (((class color grayscale) (min-colors 88) (background dark)) - (:foreground "grey70" :underline t)) - (((class color) (min-colors 8) (background light)) - (:foreground "green" :underline t)) - (((class color) (min-colors 8) (background dark)) - (:foreground "yellow" :underline t)))) - "Face for fixed-with text like code snippets." - :group 'org-faces - :version "22.1") - -(org-copy-face 'org-block 'org-quote - "Face for #+BEGIN_QUOTE ... #+END_QUOTE blocks.") -(org-copy-face 'org-block 'org-verse - "Face for #+BEGIN_VERSE ... #+END_VERSE blocks.") - -(defcustom org-fontify-quote-and-verse-blocks nil - "Non-nil means, add a special face to #+begin_quote and #+begin_verse block. -When nil, format these as normal Org. This is the default, because the -content of these blocks will still be treated as Org syntax." - :group 'org-faces - :version "24.1" - :type 'boolean) - -(defface org-clock-overlay ;; copied from secondary-selection - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) - (:background "yellow1")) - (((class color) (min-colors 88) (background dark)) - (:background "SkyBlue4")) - (((class color) (min-colors 16) (background light)) - (:background "yellow")) - (((class color) (min-colors 16) (background dark)) - (:background "SkyBlue4")) - (((class color) (min-colors 8)) - (:background "cyan" :foreground "black")) - (t (:inverse-video t)))) - "Basic face for displaying the secondary selection." - :group 'org-faces) - -(defface org-agenda-structure ;; originally copied from font-lock-function-name-face - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) - (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 16) (background light)) (:foreground "Blue")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) - (((class color) (min-colors 8)) (:foreground "blue" :bold t)) - (t (:bold t)))) - "Face used in agenda for captions and dates." - :group 'org-faces) - -(org-copy-face 'org-agenda-structure 'org-agenda-date - "Face used in agenda for normal days.") - -(org-copy-face 'org-agenda-date 'org-agenda-date-today - "Face used in agenda for today." - :weight 'bold :italic 't) - -(org-copy-face 'secondary-selection 'org-agenda-clocking - "Face marking the current clock item in the agenda.") - -(org-copy-face 'org-agenda-date 'org-agenda-date-weekend - "Face used in agenda for weekend days. -See the variable `org-agenda-weekend-days' for a definition of which days -belong to the weekend." - :weight 'bold) - -(defface org-scheduled - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) - (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t :italic t)))) - "Face for items scheduled for a certain day." - :group 'org-faces) - -(defface org-scheduled-today - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "DarkGreen")) - (((class color) (min-colors 88) (background dark)) (:foreground "PaleGreen")) - (((class color) (min-colors 8)) (:foreground "green")) - (t (:bold t :italic t)))) - "Face for items scheduled for a certain day." - :group 'org-faces) - -(defface org-agenda-dimmed-todo-face - '((((background light)) (:foreground "grey50")) - (((background dark)) (:foreground "grey50"))) - "Face used to dim blocked tasks in the agenda." - :group 'org-faces) - -(defface org-scheduled-previously - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face for items scheduled previously, and not yet done." - :group 'org-faces) - -(defface org-upcoming-deadline - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) - (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) - (((class color) (min-colors 8) (background light)) (:foreground "red")) - (((class color) (min-colors 8) (background dark)) (:foreground "red" :bold t)) - (t (:bold t)))) - "Face for items scheduled previously, and not yet done." - :group 'org-faces) - -(defcustom org-agenda-deadline-faces - '((1.0 . org-warning) - (0.5 . org-upcoming-deadline) - (0.0 . default)) - "Faces for showing deadlines in the agenda. -This is a list of cons cells. The cdr of each cell is a face to be used, -and it can also just be like '(:foreground \"yellow\"). -Each car is a fraction of the head-warning time that must have passed for -this the face in the cdr to be used for display. The numbers must be -given in descending order. The head-warning time is normally taken -from `org-deadline-warning-days', but can also be specified in the deadline -timestamp itself, like this: - - DEADLINE: <2007-08-13 Mon -8d> - -You may use d for days, w for weeks, m for months and y for years. Months -and years will only be treated in an approximate fashion (30.4 days for a -month and 365.24 days for a year)." - :group 'org-faces - :group 'org-agenda-daily/weekly - :type '(repeat - (cons - (number :tag "Fraction of head-warning time passed") - (sexp :tag "Face")))) - -(defface org-agenda-restriction-lock - (org-compatible-face nil - '((((class color) (min-colors 88) (background light)) (:background "#eeeeee")) - (((class color) (min-colors 88) (background dark)) (:background "#1C1C1C")) - (((class color) (min-colors 16) (background light)) (:background "#eeeeee")) - (((class color) (min-colors 16) (background dark)) (:background "#1C1C1C")) - (((class color) (min-colors 8)) (:background "cyan" :foreground "black")) - (t (:inverse-video t)))) - "Face for showing the agenda restriction lock." - :group 'org-faces) - -(defface org-agenda-filter-tags - (org-compatible-face 'mode-line nil) - "Face for tag(s) in the mode-line when filtering the agenda." - :group 'org-faces) - -(defface org-agenda-filter-regexp - (org-compatible-face 'mode-line nil) - "Face for regexp(s) in the mode-line when filtering the agenda." - :group 'org-faces) - -(defface org-agenda-filter-category - (org-compatible-face 'mode-line nil) - "Face for categories(s) in the mode-line when filtering the agenda." - :group 'org-faces) - -(defface org-time-grid ;; originally copied from font-lock-variable-name-face - (org-compatible-face nil - '((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod")) - (((class color) (min-colors 16) (background dark)) (:foreground "LightGoldenrod")) - (((class color) (min-colors 8)) (:foreground "yellow" :weight light)))) - "Face used for time grids." - :group 'org-faces) - -(org-copy-face 'org-time-grid 'org-agenda-current-time - "Face used to show the current time in the time grid.") - -(defface org-agenda-diary - (org-compatible-face 'default nil) - "Face used for agenda entries that come from the Emacs diary." - :group 'org-faces) - -(defface org-agenda-calendar-event - (org-compatible-face 'default nil) - "Face used to show events and appointments in the agenda." - :group 'org-faces) - -(defface org-agenda-calendar-sexp - (org-compatible-face 'default nil) - "Face used to show events computed from a S-expression." - :group 'org-faces) - -(defconst org-level-faces - '(org-level-1 org-level-2 org-level-3 org-level-4 - org-level-5 org-level-6 org-level-7 org-level-8 - )) - -(defcustom org-n-level-faces (length org-level-faces) - "The number of different faces to be used for headlines. -Org-mode defines 8 different headline faces, so this can be at most 8. -If it is less than 8, the level-1 face gets re-used for level N+1 etc." - :type 'integer - :group 'org-faces) - -(defcustom org-cycle-level-faces t - "Non-nil means level styles cycle after level `org-n-level-faces'. -Then so level org-n-level-faces+1 is styled like level 1. -If nil, then all levels >=org-n-level-faces are styled like -level org-n-level-faces" - :group 'org-appearance - :group 'org-faces - :version "24.1" - :type 'boolean) - -(defface org-latex-and-related - (let ((font (cond ((assq :inherit custom-face-attributes) - '(:inherit underline)) - (t '(:underline t))))) - `((((class grayscale) (background light)) - (:foreground "DimGray" ,@font)) - (((class grayscale) (background dark)) - (:foreground "LightGray" ,@font)) - (((class color) (background light)) - (:foreground "SaddleBrown")) - (((class color) (background dark)) - (:foreground "burlywood")) - (t (,@font)))) - "Face used to highlight LaTeX data, entities and sub/superscript." - :group 'org-faces - :version "24.4" - :package-version '(Org . "8.0")) - -(defface org-macro - (org-compatible-face 'org-latex-and-related nil) - "Face for macros." - :group 'org-faces - :version "24.4" - :package-version '(Org . "8.0")) - -(defface org-tag-group - (org-compatible-face 'org-tag nil) - "Face for group tags." - :group 'org-faces - :version "24.4" - :package-version '(Org . "8.0")) - -(org-copy-face 'mode-line 'org-mode-line-clock - "Face used for clock display in mode line.") -(org-copy-face 'mode-line 'org-mode-line-clock-overrun - "Face used for clock display for overrun tasks in mode line." - :background "red") - -(provide 'org-faces) - -;;; org-faces.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-feed.el b/xemacs-packages/lisp/org-8.2.3c/org-feed.el deleted file mode 100644 index 05ead8f0..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-feed.el +++ /dev/null @@ -1,702 +0,0 @@ -;;; org-feed.el --- Add RSS feed items to Org files -;; -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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 . -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: -;; -;; This module allows to create and change entries in an Org-mode -;; file triggered by items in an RSS feed. The basic functionality is -;; geared toward simply adding new items found in a feed as outline nodes -;; to an Org file. Using hooks, arbitrary actions can be triggered for -;; new or changed items. -;; -;; Selecting feeds and target locations -;; ------------------------------------ -;; -;; This module is configured through a single variable, `org-feed-alist'. -;; Here is an example, using a notes/tasks feed from reQall.com. -;; -;; (setq org-feed-alist -;; '(("ReQall" -;; "http://www.reqall.com/user/feeds/rss/a1b2c3....." -;; "~/org/feeds.org" "ReQall Entries") -;; -;; With this setup, the command `M-x org-feed-update-all' will -;; collect new entries in the feed at the given URL and create -;; entries as subheadings under the "ReQall Entries" heading in the -;; file "~/org/feeds.org". Each feed should normally have its own -;; heading - however see the `:drawer' parameter. -;; -;; Besides these standard elements that need to be specified for each -;; feed, keyword-value pairs can set additional options. For example, -;; to de-select transitional entries with a title containing -;; -;; "reQall is typing what you said", -;; -;; you could use the `:filter' argument: -;; -;; (setq org-feed-alist -;; '(("ReQall" -;; "http://www.reqall.com/user/feeds/rss/a1b2c3....." -;; "~/org/feeds.org" "ReQall Entries" -;; :filter my-reqall-filter))) -;; -;; (defun my-reqall-filter (e) -;; (if (string-match "reQall is typing what you said" -;; (plist-get e :title)) -;; nil -;; e)) -;; -;; See the docstring for `org-feed-alist' for more details. -;; -;; -;; Keeping track of previously added entries -;; ----------------------------------------- -;; -;; Since Org allows you to delete, archive, or move outline nodes, -;; org-feed.el needs to keep track of which feed items have been handled -;; before, so that they will not be handled again. For this, org-feed.el -;; stores information in a special drawer, FEEDSTATUS, under the heading -;; that received the input of the feed. You should add FEEDSTATUS -;; to your list of drawers in the files that receive feed input: -;; -;; #+DRAWERS: PROPERTIES CLOCK LOGBOOK RESULTS FEEDSTATUS -;; -;; Acknowledgments -;; --------------- -;; -;; org-feed.el is based on ideas by Brad Bozarth who implemented a -;; similar mechanism using shell and awk scripts. - -;;; Code: - -(require 'org) -(require 'sha1) - -(declare-function url-retrieve-synchronously "url" (url)) -(declare-function xml-node-children "xml" (node)) -(declare-function xml-get-children "xml" (node child-name)) -(declare-function xml-get-attribute "xml" (node attribute)) -(declare-function xml-get-attribute-or-nil "xml" (node attribute)) -(declare-function xml-substitute-special "xml" (string)) - -(declare-function org-capture-escaped-% "org-capture" ()) -(declare-function org-capture-inside-embedded-elisp-p "org-capture" ()) -(declare-function org-capture-expand-embedded-elisp "org-capture" ()) - -(defgroup org-feed nil - "Options concerning RSS feeds as inputs for Org files." - :tag "Org Feed" - :group 'org) - -(defcustom org-feed-alist nil - "Alist specifying RSS feeds that should create inputs for Org. -Each entry in this list specified an RSS feed tat should be queried -to create inbox items in Org. Each entry is a list with the following items: - -name a custom name for this feed -URL the Feed URL -file the target Org file where entries should be listed -headline the headline under which entries should be listed - -Additional arguments can be given using keyword-value pairs. Many of these -specify functions that receive one or a list of \"entries\" as their single -argument. An entry is a property list that describes a feed item. The -property list has properties for each field in the item, for example `:title' -for the `' field and `:pubDate' for the publication date. In addition, -it contains the following properties: - -`:item-full-text' the full text in the <item> tag -`:guid-permalink' t when the guid property is a permalink - -Here are the keyword-value pair allows in `org-feed-alist'. - -:drawer drawer-name - The name of the drawer for storing feed information. The default is - \"FEEDSTATUS\". Using different drawers for different feeds allows - several feeds to target the same inbox heading. - -:filter filter-function - A function to select interesting entries in the feed. It gets a single - entry as parameter. It should return the entry if it is relevant, or - nil if it is not. - -:template template-string - The default action on new items in the feed is to add them as children - under the headline for the feed. The template describes how the entry - should be formatted. If not given, it defaults to - `org-feed-default-template'. - -:formatter formatter-function - Instead of relying on a template, you may specify a function to format - the outline node to be inserted as a child. This function gets passed - a property list describing a single feed item, and it should return a - string that is a properly formatted Org outline node of level 1. - -:new-handler function - If adding new items as children to the outline is not what you want - to do with new items, define a handler function that is called with - a list of all new items in the feed, each one represented as a property - list. The handler should do what needs to be done, and org-feed will - mark all items given to this handler as \"handled\", i.e. they will not - be passed to this handler again in future readings of the feed. - When the handler is called, point will be at the feed headline. - -:changed-handler function - This function gets passed a list of all entries that have been - handled before, but are now still in the feed and have *changed* - since last handled (as evidenced by a different sha1 hash). - When the handler is called, point will be at the feed headline. - -:parse-feed function - This function gets passed a buffer, and should return a list - of entries, each being a property list containing the - `:guid' and `:item-full-text' keys. The default is - `org-feed-parse-rss-feed'; `org-feed-parse-atom-feed' is an - alternative. - -:parse-entry function - This function gets passed an entry as returned by the parse-feed - function, and should return the entry with interesting properties added. - The default is `org-feed-parse-rss-entry'; `org-feed-parse-atom-entry' - is an alternative." - :group 'org-feed - :type '(repeat - (list :value ("" "http://" "" "") - (string :tag "Name") - (string :tag "Feed URL") - (file :tag "File for inbox") - (string :tag "Headline for inbox") - (repeat :inline t - (choice - (list :inline t :tag "Filter" - (const :filter) - (symbol :tag "Filter Function")) - (list :inline t :tag "Template" - (const :template) - (string :tag "Template")) - (list :inline t :tag "Formatter" - (const :formatter) - (symbol :tag "Formatter Function")) - (list :inline t :tag "New items handler" - (const :new-handler) - (symbol :tag "Handler Function")) - (list :inline t :tag "Changed items" - (const :changed-handler) - (symbol :tag "Handler Function")) - (list :inline t :tag "Parse Feed" - (const :parse-feed) - (symbol :tag "Parse Feed Function")) - (list :inline t :tag "Parse Entry" - (const :parse-entry) - (symbol :tag "Parse Entry Function")) - ))))) - -(defcustom org-feed-drawer "FEEDSTATUS" - "The name of the drawer for feed status information. -Each feed may also specify its own drawer name using the `:drawer' -parameter in `org-feed-alist'. -Note that in order to make these drawers behave like drawers, they must -be added to the variable `org-drawers' or configured with a #+DRAWERS -line." - :group 'org-feed - :type '(string :tag "Drawer Name")) - -(defcustom org-feed-default-template "\n* %h\n %U\n %description\n %a\n" - "Template for the Org node created from RSS feed items. -This is just the default, each feed can specify its own. -Any fields from the feed item can be interpolated into the template with -%name, for example %title, %description, %pubDate etc. In addition, the -following special escapes are valid as well: - -%h The title, or the first line of the description -%t The date as a stamp, either from <pubDate> (if present), or - the current date -%T Date and time -%u,%U Like %t,%T, but inactive time stamps -%a A link, from <guid> if that is a permalink, else from <link> -%(sexp) Evaluate elisp `(sexp)' and replace with the result, the simple - %-escapes above can be used as arguments, e.g. %(capitalize \\\"%h\\\")" - :group 'org-feed - :type '(string :tag "Template")) - -(defcustom org-feed-save-after-adding t - "Non-nil means save buffer after adding new feed items." - :group 'org-feed - :type 'boolean) - -(defcustom org-feed-retrieve-method 'url-retrieve-synchronously - "The method to be used to retrieve a feed URL. -This can be `curl' or `wget' to call these external programs, or it can be -an Emacs Lisp function that will return a buffer containing the content -of the file pointed to by the URL." - :group 'org-feed - :type '(choice - (const :tag "Internally with url.el" url-retrieve-synchronously) - (const :tag "Externally with curl" curl) - (const :tag "Externally with wget" wget) - (function :tag "Function"))) - -(defcustom org-feed-before-adding-hook nil - "Hook that is run before adding new feed items to a file. -You might want to commit the file in its current state to version control, -for example." - :group 'org-feed - :type 'hook) - -(defcustom org-feed-after-adding-hook nil - "Hook that is run after new items have been added to a file. -Depending on `org-feed-save-after-adding', the buffer will already -have been saved." - :group 'org-feed - :type 'hook) - -(defvar org-feed-buffer "*Org feed*" - "The buffer used to retrieve a feed.") - -;;;###autoload -(defun org-feed-update-all () - "Get inbox items from all feeds in `org-feed-alist'." - (interactive) - (let ((nfeeds (length org-feed-alist)) - (nnew (apply '+ (mapcar 'org-feed-update org-feed-alist)))) - (message "%s from %d %s" - (cond ((= nnew 0) "No new entries") - ((= nnew 1) "1 new entry") - (t (format "%d new entries" nnew))) - nfeeds - (if (= nfeeds 1) "feed" "feeds")))) - -;;;###autoload -(defun org-feed-update (feed &optional retrieve-only) - "Get inbox items from FEED. -FEED can be a string with an association in `org-feed-alist', or -it can be a list structured like an entry in `org-feed-alist'." - (interactive (list (org-completing-read "Feed name: " org-feed-alist))) - (if (stringp feed) (setq feed (assoc feed org-feed-alist))) - (unless feed - (error "No such feed in `org-feed-alist")) - (catch 'exit - (let ((name (car feed)) - (url (nth 1 feed)) - (file (nth 2 feed)) - (headline (nth 3 feed)) - (filter (nth 1 (memq :filter feed))) - (formatter (nth 1 (memq :formatter feed))) - (new-handler (nth 1 (memq :new-handler feed))) - (changed-handler (nth 1 (memq :changed-handler feed))) - (template (or (nth 1 (memq :template feed)) - org-feed-default-template)) - (drawer (or (nth 1 (memq :drawer feed)) - org-feed-drawer)) - (parse-feed (or (nth 1 (memq :parse-feed feed)) - 'org-feed-parse-rss-feed)) - (parse-entry (or (nth 1 (memq :parse-entry feed)) - 'org-feed-parse-rss-entry)) - feed-buffer inbox-pos new-formatted - entries old-status status new changed guid-alist e guid olds) - (setq feed-buffer (org-feed-get-feed url)) - (unless (and feed-buffer (bufferp (get-buffer feed-buffer))) - (error "Cannot get feed %s" name)) - (when retrieve-only - (throw 'exit feed-buffer)) - (setq entries (funcall parse-feed feed-buffer)) - (ignore-errors (kill-buffer feed-buffer)) - (save-excursion - (save-window-excursion - (setq inbox-pos (org-feed-goto-inbox-internal file headline)) - (setq old-status (org-feed-read-previous-status inbox-pos drawer)) - ;; Add the "handled" status to the appropriate entries - (setq entries (mapcar (lambda (e) - (setq e - (plist-put e :handled - (nth 1 (assoc - (plist-get e :guid) - old-status))))) - entries)) - ;; Find out which entries are new and which are changed - (dolist (e entries) - (if (not (plist-get e :handled)) - (push e new) - (setq olds (nth 2 (assoc (plist-get e :guid) old-status))) - (if (and olds - (not (string= (sha1 - (plist-get e :item-full-text)) - olds))) - (push e changed)))) - - ;; Parse the relevant entries fully - (setq new (mapcar parse-entry new) - changed (mapcar parse-entry changed)) - - ;; Run the filter - (when filter - (setq new (delq nil (mapcar filter new)) - changed (delq nil (mapcar filter new)))) - - (when (not (or new changed)) - (message "No new items in feed %s" name) - (throw 'exit 0)) - - ;; Get alist based on guid, to look up entries - (setq guid-alist - (append - (mapcar (lambda (e) (list (plist-get e :guid) e)) new) - (mapcar (lambda (e) (list (plist-get e :guid) e)) changed))) - - ;; Construct the new status - (setq status - (mapcar - (lambda (e) - (setq guid (plist-get e :guid)) - (list guid - ;; things count as handled if we handle them now, - ;; or if they were handled previously - (if (assoc guid guid-alist) t (plist-get e :handled)) - ;; A hash, to detect changes - (sha1 (plist-get e :item-full-text)))) - entries)) - - ;; Handle new items in the feed - (when new - (if new-handler - (progn - (goto-char inbox-pos) - (funcall new-handler new)) - ;; No custom handler, do the default adding - ;; Format the new entries into an alist with GUIDs in the car - (setq new-formatted - (mapcar - (lambda (e) (org-feed-format-entry e template formatter)) - new))) - - ;; Insert the new items - (org-feed-add-items inbox-pos new-formatted)) - - ;; Handle changed items in the feed - (when (and changed-handler changed) - (goto-char inbox-pos) - (funcall changed-handler changed)) - - ;; Write the new status - ;; We do this only now, in case something goes wrong above, so - ;; that would would end up with a status that does not reflect - ;; which items truely have been handled - (org-feed-write-status inbox-pos drawer status) - - ;; Normalize the visibility of the inbox tree - (goto-char inbox-pos) - (hide-subtree) - (show-children) - (org-cycle-hide-drawers 'children) - - ;; Hooks and messages - (when org-feed-save-after-adding (save-buffer)) - (message "Added %d new item%s from feed %s to file %s, heading %s" - (length new) (if (> (length new) 1) "s" "") - name - (file-name-nondirectory file) headline) - (run-hooks 'org-feed-after-adding-hook) - (length new)))))) - -;;;###autoload -(defun org-feed-goto-inbox (feed) - "Go to the inbox that captures the feed named FEED." - (interactive - (list (if (= (length org-feed-alist) 1) - (car org-feed-alist) - (org-completing-read "Feed name: " org-feed-alist)))) - (if (stringp feed) (setq feed (assoc feed org-feed-alist))) - (unless feed - (error "No such feed in `org-feed-alist")) - (org-feed-goto-inbox-internal (nth 2 feed) (nth 3 feed))) - -;;;###autoload -(defun org-feed-show-raw-feed (feed) - "Show the raw feed buffer of a feed." - (interactive - (list (if (= (length org-feed-alist) 1) - (car org-feed-alist) - (org-completing-read "Feed name: " org-feed-alist)))) - (if (stringp feed) (setq feed (assoc feed org-feed-alist))) - (unless feed - (error "No such feed in `org-feed-alist")) - (org-pop-to-buffer-same-window - (org-feed-update feed 'retrieve-only)) - (goto-char (point-min))) - -(defun org-feed-goto-inbox-internal (file heading) - "Find or create HEADING in FILE. -Switch to that buffer, and return the position of that headline." - (find-file file) - (widen) - (goto-char (point-min)) - (if (re-search-forward - (concat "^\\*+[ \t]+" heading "[ \t]*\\(:.*?:[ \t]*\\)?$") - nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max)) - (insert "\n\n* " heading "\n\n") - (org-back-to-heading t)) - (point)) - -(defun org-feed-read-previous-status (pos drawer) - "Get the alist of old GUIDs from the entry at POS. -This will find DRAWER and extract the alist." - (save-excursion - (goto-char pos) - (let ((end (save-excursion (org-end-of-subtree t t)))) - (if (re-search-forward - (concat "^[ \t]*:" drawer ":[ \t]*\n\\([^\000]*?\\)\n[ \t]*:END:") - end t) - (read (match-string 1)) - nil)))) - -(defun org-feed-write-status (pos drawer status) - "Write the feed STATUS to DRAWER in entry at POS." - (save-excursion - (goto-char pos) - (let ((end (save-excursion (org-end-of-subtree t t))) - guid) - (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*\n") - end t) - (progn - (goto-char (match-end 0)) - (delete-region (point) - (save-excursion - (and (re-search-forward "^[ \t]*:END:" nil t) - (match-beginning 0))))) - (outline-next-heading) - (insert " :" drawer ":\n :END:\n") - (beginning-of-line 0)) - (insert (pp-to-string status))))) - -(defun org-feed-add-items (pos entries) - "Add the formatted items to the headline as POS." - (let (entry level) - (save-excursion - (goto-char pos) - (unless (looking-at org-complex-heading-regexp) - (error "Wrong position")) - (setq level (org-get-valid-level (length (match-string 1)) 1)) - (org-end-of-subtree t t) - (skip-chars-backward " \t\n") - (beginning-of-line 2) - (setq pos (point)) - (while (setq entry (pop entries)) - (org-paste-subtree level entry 'yank)) - (org-mark-ring-push pos)))) - -(defun org-feed-format-entry (entry template formatter) - "Format ENTRY so that it can be inserted into an Org file. -ENTRY is a property list. This function adds a `:formatted-for-org' property -and returns the full property list. -If that property is already present, nothing changes." - (require 'org-capture) - (if formatter - (funcall formatter entry) - (let (dlines time escape name tmp - v-h v-t v-T v-u v-U v-a) - (setq dlines (org-split-string (or (plist-get entry :description) "???") - "\n") - v-h (or (plist-get entry :title) (car dlines) "???") - time (or (if (plist-get entry :pubDate) - (org-read-date t t (plist-get entry :pubDate))) - (current-time)) - v-t (format-time-string (org-time-stamp-format nil nil) time) - v-T (format-time-string (org-time-stamp-format t nil) time) - v-u (format-time-string (org-time-stamp-format nil t) time) - v-U (format-time-string (org-time-stamp-format t t) time) - v-a (if (setq tmp (or (and (plist-get entry :guid-permalink) - (plist-get entry :guid)) - (plist-get entry :link))) - (concat "[[" tmp "]]\n") - "")) - (with-temp-buffer - (insert template) - - ;; Simple %-escapes - ;; before embedded elisp to support simple %-escapes as - ;; arguments for embedded elisp - (goto-char (point-min)) - (while (re-search-forward "%\\([a-zA-Z]+\\)" nil t) - (unless (org-capture-escaped-%) - (setq name (match-string 1) - escape (org-capture-inside-embedded-elisp-p)) - (cond - ((member name '("h" "t" "T" "u" "U" "a")) - (setq tmp (symbol-value (intern (concat "v-" name))))) - ((setq tmp (plist-get entry (intern (concat ":" name)))) - (save-excursion - (save-match-data - (beginning-of-line 1) - (when (looking-at - (concat "^\\([ \t]*\\)%" name "[ \t]*$")) - (setq tmp (org-feed-make-indented-block - tmp (org-get-indentation)))))))) - (when tmp - ;; escape string delimiters `"' when inside %() embedded lisp - (when escape - (setq tmp (replace-regexp-in-string "\"" "\\\\\"" tmp))) - (replace-match tmp t t)))) - - ;; %() embedded elisp - (org-capture-expand-embedded-elisp) - - (decode-coding-string - (buffer-string) (detect-coding-region (point-min) (point-max) t)))))) - -(defun org-feed-make-indented-block (s n) - "Add indentation of N spaces to a multiline string S." - (if (not (string-match "\n" s)) - s - (mapconcat 'identity - (org-split-string s "\n") - (concat "\n" (make-string n ?\ ))))) - -(defun org-feed-skip-http-headers (buffer) - "Remove HTTP headers from BUFFER, and return it. -Assumes headers are indeed present!" - (with-current-buffer buffer - (widen) - (goto-char (point-min)) - (search-forward "\n\n") - (delete-region (point-min) (point)) - buffer)) - -(defun org-feed-get-feed (url) - "Get the RSS feed file at URL and return the buffer." - (cond - ((eq org-feed-retrieve-method 'url-retrieve-synchronously) - (org-feed-skip-http-headers (url-retrieve-synchronously url))) - ((eq org-feed-retrieve-method 'curl) - (ignore-errors (kill-buffer org-feed-buffer)) - (call-process "curl" nil org-feed-buffer nil "--silent" url) - org-feed-buffer) - ((eq org-feed-retrieve-method 'wget) - (ignore-errors (kill-buffer org-feed-buffer)) - (call-process "wget" nil org-feed-buffer nil "-q" "-O" "-" url) - org-feed-buffer) - ((functionp org-feed-retrieve-method) - (funcall org-feed-retrieve-method url)))) - -(defun org-feed-parse-rss-feed (buffer) - "Parse BUFFER for RSS feed entries. -Returns a list of entries, with each entry a property list, -containing the properties `:guid' and `:item-full-text'." - (let ((case-fold-search t) - entries beg end item guid entry) - (with-current-buffer buffer - (widen) - (goto-char (point-min)) - (while (re-search-forward "<item\\>.*?>" nil t) - (setq beg (point) - end (and (re-search-forward "</item>" nil t) - (match-beginning 0))) - (setq item (buffer-substring beg end) - guid (if (string-match "<guid\\>.*?>\\(.*?\\)</guid>" item) - (org-match-string-no-properties 1 item))) - (setq entry (list :guid guid :item-full-text item)) - (push entry entries) - (widen) - (goto-char end)) - (nreverse entries)))) - -(defun org-feed-parse-rss-entry (entry) - "Parse the `:item-full-text' field for xml tags and create new properties." - (require 'xml) - (with-temp-buffer - (insert (plist-get entry :item-full-text)) - (goto-char (point-min)) - (while (re-search-forward "<\\([a-zA-Z]+\\>\\).*?>\\([^\000]*?\\)</\\1>" - nil t) - (setq entry (plist-put entry - (intern (concat ":" (match-string 1))) - (xml-substitute-special (match-string 2))))) - (goto-char (point-min)) - (unless (re-search-forward "isPermaLink[ \t]*=[ \t]*\"false\"" nil t) - (setq entry (plist-put entry :guid-permalink t)))) - entry) - -(defun org-feed-parse-atom-feed (buffer) - "Parse BUFFER for Atom feed entries. -Returns a list of entries, with each entry a property list, -containing the properties `:guid' and `:item-full-text'. - -The `:item-full-text' property actually contains the sexp -formatted as a string, not the original XML data." - (require 'xml) - (with-current-buffer buffer - (widen) - (let ((feed (car (xml-parse-region (point-min) (point-max))))) - (mapcar - (lambda (entry) - (list - :guid (car (xml-node-children (car (xml-get-children entry 'id)))) - :item-full-text (prin1-to-string entry))) - (xml-get-children feed 'entry))))) - -(defun org-feed-parse-atom-entry (entry) - "Parse the `:item-full-text' as a sexp and create new properties." - (let ((xml (car (read-from-string (plist-get entry :item-full-text))))) - ;; Get first <link href='foo'/>. - (setq entry (plist-put entry :link - (xml-get-attribute - (car (xml-get-children xml 'link)) - 'href))) - ;; Add <title/> as :title. - (setq entry (plist-put entry :title - (xml-substitute-special - (car (xml-node-children - (car (xml-get-children xml 'title))))))) - (let* ((content (car (xml-get-children xml 'content))) - (type (xml-get-attribute-or-nil content 'type))) - (when content - (cond - ((string= type "text") - ;; We like plain text. - (setq entry (plist-put entry :description - (xml-substitute-special - (car (xml-node-children content)))))) - ((string= type "html") - ;; TODO: convert HTML to Org markup. - (setq entry (plist-put entry :description - (xml-substitute-special - (car (xml-node-children content)))))) - ((string= type "xhtml") - ;; TODO: convert XHTML to Org markup. - (setq entry (plist-put entry :description - (prin1-to-string - (xml-node-children content))))) - (t - (setq entry (plist-put entry :description - (format "Unknown '%s' content." type))))))) - entry)) - -(provide 'org-feed) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-feed.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-footnote.el b/xemacs-packages/lisp/org-8.2.3c/org-footnote.el deleted file mode 100644 index 3c0d97c3..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-footnote.el +++ /dev/null @@ -1,885 +0,0 @@ -;;; org-footnote.el --- Footnote support in Org and elsewhere -;; -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;; This file contains the code dealing with footnotes in Org-mode. -;; The code can also be used in arbitrary text modes to provide -;; footnotes. Compared to Steven L Baur's footnote.el it provides -;; better support for resuming editing. It is less configurable than -;; Steve's code, though. - -;;; Code: - -(eval-when-compile - (require 'cl)) -(require 'org-macs) -(require 'org-compat) - -(declare-function message-point-in-header-p "message" ()) -(declare-function org-back-over-empty-lines "org" ()) -(declare-function org-back-to-heading "org" (&optional invisible-ok)) -(declare-function org-combine-plists "org" (&rest plists)) -(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) -(declare-function org-fill-paragraph "org" (&optional justify)) -(declare-function org-icompleting-read "org" (&rest args)) -(declare-function org-id-uuid "org-id" ()) -(declare-function org-in-block-p "org" (names)) -(declare-function org-in-commented-line "org" ()) -(declare-function org-in-indented-comment-line "org" ()) -(declare-function org-in-regexp "org" (re &optional nlines visually)) -(declare-function org-in-verbatim-emphasis "org" ()) -(declare-function org-inside-LaTeX-fragment-p "org" ()) -(declare-function org-inside-latex-macro-p "org" ()) -(declare-function org-mark-ring-push "org" (&optional pos buffer)) -(declare-function org-show-context "org" (&optional key)) -(declare-function org-trim "org" (s)) -(declare-function org-skip-whitespace "org" ()) -(declare-function outline-next-heading "outline") -(declare-function org-skip-whitespace "org" ()) - -(defvar org-outline-regexp-bol) ; defined in org.el -(defvar org-odd-levels-only) ; defined in org.el -(defvar org-bracket-link-regexp) ; defined in org.el -(defvar message-cite-prefix-regexp) ; defined in message.el -(defvar message-signature-separator) ; defined in message.el - -(defconst org-footnote-re - ;; Only [1]-like footnotes are closed in this regexp, as footnotes - ;; from other types might contain square brackets (i.e. links) in - ;; their definition. - ;; - ;; `org-re' is used for regexp compatibility with XEmacs. - (concat "\\[\\(?:" - ;; Match inline footnotes. - (org-re "fn:\\([-_[:word:]]+\\)?:\\|") - ;; Match other footnotes. - "\\(?:\\([0-9]+\\)\\]\\)\\|" - (org-re "\\(fn:[-_[:word:]]+\\)") - "\\)") - "Regular expression for matching footnotes.") - -(defconst org-footnote-definition-re - (org-re "^\\[\\([0-9]+\\|fn:[-_[:word:]]+\\)\\]") - "Regular expression matching the definition of a footnote.") - -(defconst org-footnote-forbidden-blocks - '("ascii" "beamer" "comment" "example" "html" "latex" "odt" "src") - "Names of blocks where footnotes are not allowed.") - -(defgroup org-footnote nil - "Footnotes in Org-mode." - :tag "Org Footnote" - :group 'org) - -(defcustom org-footnote-section "Footnotes" - "Outline heading containing footnote definitions. - -This can be nil, to place footnotes locally at the end of the -current outline node. If can also be the name of a special -outline heading under which footnotes should be put. - -This variable defines the place where Org puts the definition -automatically, i.e. when creating the footnote, and when sorting -the notes. However, by hand you may place definitions -*anywhere*. - -If this is a string, during export, all subtrees starting with -this heading will be ignored." - :group 'org-footnote - :type '(choice - (string :tag "Collect footnotes under heading") - (const :tag "Define footnotes locally" nil))) - -(defcustom org-footnote-tag-for-non-org-mode-files "Footnotes:" - "Tag marking the beginning of footnote section. -The Org footnote engine can be used in arbitrary text files as well -as in Org-mode. Outside Org mode, new footnotes are always placed at -the end of the file. When you normalize the notes, any line containing -only this tag will be removed, a new one will be inserted at the end -of the file, followed by the collected and normalized footnotes. - -If you don't want any tag in such buffers, set this variable to nil." - :group 'org-footnote - :type '(choice - (string :tag "Collect footnotes under tag") - (const :tag "Don't use a tag" nil))) - -(defcustom org-footnote-define-inline nil - "Non-nil means define footnotes inline, at reference location. -When nil, footnotes will be defined in a special section near -the end of the document. When t, the [fn:label:definition] notation -will be used to define the footnote at the reference position." - :group 'org-footnote - :type 'boolean) - -(defcustom org-footnote-auto-label t - "Non-nil means define automatically new labels for footnotes. -Possible values are: - -nil Prompt the user for each label. -t Create unique labels of the form [fn:1], [fn:2], etc. -confirm Like t, but let the user edit the created value. - The label can be removed from the minibuffer to create - an anonymous footnote. -random Automatically generate a unique, random label. -plain Automatically create plain number labels like [1]." - :group 'org-footnote - :type '(choice - (const :tag "Prompt for label" nil) - (const :tag "Create automatic [fn:N]" t) - (const :tag "Offer automatic [fn:N] for editing" confirm) - (const :tag "Create a random label" random) - (const :tag "Create automatic [N]" plain))) - -(defcustom org-footnote-auto-adjust nil - "Non-nil means automatically adjust footnotes after insert/delete. -When this is t, after each insertion or deletion of a footnote, -simple fn:N footnotes will be renumbered, and all footnotes will be sorted. -If you want to have just sorting or just renumbering, set this variable -to `sort' or `renumber'. - -The main values of this variable can be set with in-buffer options: - -#+STARTUP: fnadjust -#+STARTUP: nofnadjust" - :group 'org-footnote - :type '(choice - (const :tag "No adjustment" nil) - (const :tag "Renumber" renumber) - (const :tag "Sort" sort) - (const :tag "Renumber and Sort" t))) - -(defcustom org-footnote-fill-after-inline-note-extraction nil - "Non-nil means fill paragraphs after extracting footnotes. -When extracting inline footnotes, the lengths of lines can change a lot. -When this option is set, paragraphs from which an inline footnote has been -extracted will be filled again." - :group 'org-footnote - :type 'boolean) - -(defun org-footnote-in-valid-context-p () - "Is point in a context where footnotes are allowed?" - (save-match-data - (not (or (org-in-commented-line) - (org-in-indented-comment-line) - (org-inside-LaTeX-fragment-p) - ;; Avoid literal example. - (org-in-verbatim-emphasis) - (save-excursion - (beginning-of-line) - (looking-at "[ \t]*:[ \t]+")) - ;; Avoid cited text and headers in message-mode. - (and (derived-mode-p 'message-mode) - (or (save-excursion - (beginning-of-line) - (looking-at message-cite-prefix-regexp)) - (message-point-in-header-p))) - ;; Avoid forbidden blocks. - (org-in-block-p org-footnote-forbidden-blocks))))) - -(defun org-footnote-at-reference-p () - "Is the cursor at a footnote reference? - -If so, return a list containing its label, beginning and ending -positions, and the definition, when inlined." - (when (and (org-footnote-in-valid-context-p) - (or (looking-at org-footnote-re) - (org-in-regexp org-footnote-re) - (save-excursion (re-search-backward org-footnote-re nil t))) - (/= (match-beginning 0) (point-at-bol))) - (let* ((beg (match-beginning 0)) - (label (or (org-match-string-no-properties 2) - (org-match-string-no-properties 3) - ;; Anonymous footnotes don't have labels - (and (match-string 1) - (concat "fn:" (org-match-string-no-properties 1))))) - ;; Inline footnotes don't end at (match-end 0) as - ;; `org-footnote-re' stops just after the second colon. - ;; Find the real ending with `scan-sexps', so Org doesn't - ;; get fooled by unrelated closing square brackets. - (end (ignore-errors (scan-sexps beg 1)))) - ;; Point is really at a reference if it's located before true - ;; ending of the footnote. - (when (and end (< (point) end) - ;; Verify match isn't a part of a link. - (not (save-excursion - (goto-char beg) - (let ((linkp - (save-match-data - (org-in-regexp org-bracket-link-regexp)))) - (and linkp (< (point) (cdr linkp)))))) - ;; Verify point doesn't belong to a LaTeX macro. - (not (org-inside-latex-macro-p))) - (list label beg end - ;; Definition: ensure this is an inline footnote first. - (and (or (not label) (match-string 1)) - (org-trim (buffer-substring-no-properties - (match-end 0) (1- end))))))))) - -(defun org-footnote-at-definition-p () - "Is point within a footnote definition? - -This matches only pure definitions like [1] or [fn:name] at the -beginning of a line. It does not match references like -\[fn:name:definition], where the footnote text is included and -defined locally. - -The return value will be nil if not at a footnote definition, and -a list with label, start, end and definition of the footnote -otherwise." - (when (save-excursion (beginning-of-line) (org-footnote-in-valid-context-p)) - (save-excursion - (end-of-line) - ;; Footnotes definitions are separated by new headlines, another - ;; footnote definition or 2 blank lines. - (let ((lim (save-excursion - (re-search-backward - (concat org-outline-regexp-bol - "\\|^\\([ \t]*\n\\)\\{2,\\}") nil t)))) - (when (re-search-backward org-footnote-definition-re lim t) - (let ((label (org-match-string-no-properties 1)) - (beg (match-beginning 0)) - (beg-def (match-end 0)) - ;; In message-mode, do not search after signature. - (end (let ((bound (and (derived-mode-p 'message-mode) - (save-excursion - (goto-char (point-max)) - (re-search-backward - message-signature-separator nil t))))) - (if (progn - (end-of-line) - (re-search-forward - (concat org-outline-regexp-bol "\\|" - org-footnote-definition-re "\\|" - "^\\([ \t]*\n\\)\\{2,\\}") bound 'move)) - (match-beginning 0) - (point))))) - (list label beg end - (org-trim (buffer-substring-no-properties beg-def end))))))))) - -(defun org-footnote-get-next-reference (&optional label backward limit) - "Return complete reference of the next footnote. - -If LABEL is provided, get the next reference of that footnote. If -BACKWARD is non-nil, find previous reference instead. LIMIT is -the buffer position bounding the search. - -Return value is a list like those provided by `org-footnote-at-reference-p'. -If no footnote is found, return nil." - (save-excursion - (let* ((label-fmt (if label (format "\\[%s[]:]" label) org-footnote-re))) - (catch 'exit - (while t - (unless (funcall (if backward #'re-search-backward #'re-search-forward) - label-fmt limit t) - (throw 'exit nil)) - (unless backward (backward-char)) - (let ((ref (org-footnote-at-reference-p))) - (when ref (throw 'exit ref)))))))) - -(defun org-footnote-next-reference-or-definition (limit) - "Move point to next footnote reference or definition. - -LIMIT is the buffer position bounding the search. - -Return value is a list like those provided by -`org-footnote-at-reference-p' or `org-footnote-at-definition-p'. -If no footnote is found, return nil." - (let* (ref (origin (point))) - (catch 'exit - (while t - (unless (re-search-forward org-footnote-re limit t) - (goto-char origin) - (throw 'exit nil)) - ;; Beware: with [1]-like footnotes point will be just after - ;; the closing square bracket. - (backward-char) - (cond - ((setq ref (org-footnote-at-reference-p)) - (throw 'exit ref)) - ;; Definition: also grab the last square bracket, only - ;; matched in `org-footnote-re' for [1]-like footnotes. - ((save-match-data (org-footnote-at-definition-p)) - (let ((end (match-end 0))) - (throw 'exit - (list nil (match-beginning 0) - (if (eq (char-before end) 93) end (1+ end))))))))))) - -(defun org-footnote-get-definition (label) - "Return label, boundaries and definition of the footnote LABEL." - (let* ((label (regexp-quote (org-footnote-normalize-label label))) - (re (format "^\\[%s\\]\\|.\\[%s:" label label)) - pos) - (save-excursion - (save-restriction - (when (or (re-search-forward re nil t) - (and (goto-char (point-min)) - (re-search-forward re nil t)) - (and (progn (widen) t) - (goto-char (point-min)) - (re-search-forward re nil t))) - (let ((refp (org-footnote-at-reference-p))) - (cond - ((and (nth 3 refp) refp)) - ((org-footnote-at-definition-p))))))))) - -(defun org-footnote-goto-definition (label) - "Move point to the definition of the footnote LABEL. -Return a non-nil value when a definition has been found." - (interactive "sLabel: ") - (org-mark-ring-push) - (let ((def (org-footnote-get-definition label))) - (if (not def) - (error "Cannot find definition of footnote %s" label) - (goto-char (nth 1 def)) - (looking-at (format "\\[%s\\]\\|\\[%s:" label label)) - (goto-char (match-end 0)) - (org-show-context 'link-search) - (when (derived-mode-p 'org-mode) - (message "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")) - t))) - -(defun org-footnote-goto-previous-reference (label) - "Find the first closest (to point) reference of footnote with label LABEL." - (interactive "sLabel: ") - (org-mark-ring-push) - (let* ((label (org-footnote-normalize-label label)) ref) - (save-excursion - (setq ref (or (org-footnote-get-next-reference label t) - (org-footnote-get-next-reference label) - (save-restriction - (widen) - (or - (org-footnote-get-next-reference label t) - (org-footnote-get-next-reference label)))))) - (if (not ref) - (error "Cannot find reference of footnote %s" label) - (goto-char (nth 1 ref)) - (org-show-context 'link-search)))) - -(defun org-footnote-normalize-label (label) - "Return LABEL as an appropriate string." - (cond - ((numberp label) (number-to-string label)) - ((equal "" label) nil) - ((not (string-match "^[0-9]+$\\|^fn:" label)) - (concat "fn:" label)) - (t label))) - -(defun org-footnote-all-labels (&optional with-defs) - "Return list with all defined foot labels used in the buffer. - -If WITH-DEFS is non-nil, also associate the definition to each -label. The function will then return an alist whose key is label -and value definition." - (let* (rtn - (push-to-rtn - (function - ;; Depending on WITH-DEFS, store label or (label . def) of - ;; footnote reference/definition given as argument in RTN. - (lambda (el) - (let ((lbl (car el))) - (push (if with-defs (cons lbl (nth 3 el)) lbl) rtn)))))) - (save-excursion - (save-restriction - (widen) - ;; Find all labels found in definitions. - (goto-char (point-min)) - (let (def) - (while (re-search-forward org-footnote-definition-re nil t) - (when (setq def (org-footnote-at-definition-p)) - (funcall push-to-rtn def)))) - ;; Find all labels found in references. - (goto-char (point-min)) - (let (ref) - (while (setq ref (org-footnote-get-next-reference)) - (goto-char (nth 2 ref)) - (and (car ref) ; ignore anonymous footnotes - (not (funcall (if with-defs #'assoc #'member) (car ref) rtn)) - (funcall push-to-rtn ref)))))) - rtn)) - -(defun org-footnote-unique-label (&optional current) - "Return a new unique footnote label. - -The function returns the first \"fn:N\" or \"N\" label that is -currently not used. - -Optional argument CURRENT is the list of labels active in the -buffer." - (unless current (setq current (org-footnote-all-labels))) - (let ((fmt (if (eq org-footnote-auto-label 'plain) "%d" "fn:%d")) - (cnt 1)) - (while (member (format fmt cnt) current) - (incf cnt)) - (format fmt cnt))) - -(defun org-footnote-new () - "Insert a new footnote. -This command prompts for a label. If this is a label referencing an -existing label, only insert the label. If the footnote label is empty -or new, let the user edit the definition of the footnote." - (interactive) - (unless (org-footnote-in-valid-context-p) - (error "Cannot insert a footnote here")) - (let* ((lbls (and (not (equal org-footnote-auto-label 'random)) - (org-footnote-all-labels))) - (propose (and (not (equal org-footnote-auto-label 'random)) - (org-footnote-unique-label lbls))) - (label - (org-footnote-normalize-label - (cond - ((member org-footnote-auto-label '(t plain)) - propose) - ((equal org-footnote-auto-label 'random) - (require 'org-id) - (substring (org-id-uuid) 0 8)) - (t - (org-icompleting-read - "Label (leave empty for anonymous): " - (mapcar 'list lbls) nil nil - (if (eq org-footnote-auto-label 'confirm) propose nil))))))) - (cond - ((bolp) (error "Cannot create a footnote reference at left margin")) - ((not label) - (insert "[fn:: ]") - (backward-char 1)) - ((member label lbls) - (insert "[" label "]") - (message "New reference to existing note")) - (org-footnote-define-inline - (insert "[" label ": ]") - (backward-char 1) - (org-footnote-auto-adjust-maybe)) - (t - (insert "[" label "]") - (org-footnote-create-definition label) - (org-footnote-auto-adjust-maybe))))) - -(defvar org-blank-before-new-entry) ; silence byte-compiler -(defun org-footnote-create-definition (label) - "Start the definition of a footnote with label LABEL." - (interactive "sLabel: ") - (let ((label (org-footnote-normalize-label label)) - electric-indent-mode) ;; Prevent wrong indentation - (cond - ;; In an Org file. - ((derived-mode-p 'org-mode) - ;; If `org-footnote-section' is defined, find it, or create it - ;; at the end of the buffer. - (when org-footnote-section - (goto-char (point-min)) - (let ((re (concat "^\\*+[ \t]+" org-footnote-section "[ \t]*$"))) - (unless (or (re-search-forward re nil t) - (and (progn (widen) t) - (re-search-forward re nil t))) - (goto-char (point-max)) - (skip-chars-backward " \t\r\n") - (unless (bolp) (newline)) - ;; Insert new section. Separate it from the previous one - ;; with a blank line, unless `org-blank-before-new-entry' - ;; explicitly says no. - (when (and (cdr (assq 'heading org-blank-before-new-entry)) - (zerop (save-excursion (org-back-over-empty-lines)))) - (insert "\n")) - (insert "* " org-footnote-section "\n")))) - ;; Move to the end of this entry (which may be - ;; `org-footnote-section' or the current one). - (org-footnote-goto-local-insertion-point) - (org-show-context 'link-search)) - (t - ;; In a non-Org file. Search for footnote tag, or create it if - ;; specified (at the end of buffer, or before signature if in - ;; Message mode). Set point after any definition already there. - (let ((tag (and org-footnote-tag-for-non-org-mode-files - (concat "^" (regexp-quote - org-footnote-tag-for-non-org-mode-files) - "[ \t]*$"))) - (max (if (and (derived-mode-p 'message-mode) - (goto-char (point-max)) - (re-search-backward - message-signature-separator nil t)) - (progn - ;; Ensure one blank line separates last - ;; footnote from signature. - (beginning-of-line) - (open-line 2) - (point-marker)) - (point-max-marker)))) - (set-marker-insertion-type max t) - (goto-char max) - ;; Check if the footnote tag is defined but missing. In this - ;; case, insert it, before any footnote or one blank line - ;; after any previous text. - (when (and tag (not (re-search-backward tag nil t))) - (skip-chars-backward " \t\r\n") - (while (re-search-backward org-footnote-definition-re nil t)) - (unless (bolp) (newline 2)) - (insert org-footnote-tag-for-non-org-mode-files "\n\n")) - ;; Remove superfluous white space and clear marker. - (goto-char max) - (skip-chars-backward " \t\r\n") - (delete-region (point) max) - (unless (bolp) (newline)) - (set-marker max nil)))) - ;; Insert footnote label. - (when (zerop (org-back-over-empty-lines)) (newline)) - (insert "[" label "] \n") - (backward-char) - ;; Only notify user about next possible action when in an Org - ;; buffer, as the bindings may have different meanings otherwise. - (when (derived-mode-p 'org-mode) - (message - "Edit definition and go back with `C-c &' or, if unique, with `C-c C-c'.")))) - -;;;###autoload -(defun org-footnote-action (&optional special) - "Do the right thing for footnotes. - -When at a footnote reference, jump to the definition. - -When at a definition, jump to the references if they exist, offer -to create them otherwise. - -When neither at definition or reference, create a new footnote, -interactively. - -With prefix arg SPECIAL, offer additional commands in a menu." - (interactive "P") - (let (tmp c) - (cond - (special - (message "Footnotes: [s]ort | [r]enumber fn:N | [S]=r+s |->[n]umeric | [d]elete") - (setq c (read-char-exclusive)) - (cond - ((eq c ?s) (org-footnote-normalize 'sort)) - ((eq c ?r) (org-footnote-renumber-fn:N)) - ((eq c ?S) - (org-footnote-renumber-fn:N) - (org-footnote-normalize 'sort)) - ((eq c ?n) (org-footnote-normalize)) - ((eq c ?d) (org-footnote-delete)) - (t (error "No such footnote command %c" c)))) - ((setq tmp (org-footnote-at-reference-p)) - (cond - ;; Anonymous footnote: move point at the beginning of its - ;; definition. - ((not (car tmp)) - (goto-char (nth 1 tmp)) - (forward-char 5)) - ;; A definition exists: move to it. - ((ignore-errors (org-footnote-goto-definition (car tmp)))) - ;; No definition exists: offer to create it. - ((yes-or-no-p (format "No definition for %s. Create one? " (car tmp))) - (org-footnote-create-definition (car tmp))))) - ((setq tmp (org-footnote-at-definition-p)) - (org-footnote-goto-previous-reference (car tmp))) - (t (org-footnote-new))))) - -;;;###autoload -(defun org-footnote-normalize (&optional sort-only) - "Collect the footnotes in various formats and normalize them. - -This finds the different sorts of footnotes allowed in Org, and -normalizes them to the usual [N] format. - -When SORT-ONLY is set, only sort the footnote definitions into the -referenced sequence." - ;; This is based on Paul's function, but rewritten. - ;; - ;; Re-create `org-with-limited-levels', but not limited to Org - ;; buffers. - (let* ((limit-level - (and (boundp 'org-inlinetask-min-level) - org-inlinetask-min-level - (1- org-inlinetask-min-level))) - (nstars (and limit-level - (if org-odd-levels-only (1- (* limit-level 2)) - limit-level))) - (org-outline-regexp - (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ "))) - (count 0) - ins-point ref ref-table) - (save-excursion - ;; 1. Find every footnote reference, extract the definition, and - ;; collect that data in REF-TABLE. If SORT-ONLY is nil, also - ;; normalize references. - (goto-char (point-min)) - (while (setq ref (org-footnote-get-next-reference)) - (let* ((lbl (car ref)) - (pos (nth 1 ref)) - ;; When footnote isn't anonymous, check if it's label - ;; (REF) is already stored in REF-TABLE. In that case, - ;; extract number used to identify it (MARKER). If - ;; footnote is unknown, increment the global counter - ;; (COUNT) to create an unused identifier. - (a (and lbl (assoc lbl ref-table))) - (marker (or (nth 1 a) (incf count))) - ;; Is the reference inline or pointing to an inline - ;; footnote? - (inlinep (or (stringp (nth 3 ref)) (nth 3 a)))) - ;; Replace footnote reference with [MARKER]. Maybe fill - ;; paragraph once done. If SORT-ONLY is non-nil, only move - ;; to the end of reference found to avoid matching it twice. - (if sort-only (goto-char (nth 2 ref)) - (delete-region (nth 1 ref) (nth 2 ref)) - (goto-char (nth 1 ref)) - (insert (format "[%d]" marker)) - (and inlinep - org-footnote-fill-after-inline-note-extraction - (org-fill-paragraph))) - ;; Add label (REF), identifier (MARKER), definition (DEF) - ;; type (INLINEP) and position (POS) to REF-TABLE if data - ;; was unknown. - (unless a - (let ((def (or (nth 3 ref) ; Inline definition. - (nth 3 (org-footnote-get-definition lbl))))) - (push (list lbl marker def - ;; Reference beginning position is a marker - ;; to preserve it during further buffer - ;; modifications. - inlinep (copy-marker pos)) ref-table))))) - ;; 2. Find and remove the footnote section, if any. Also - ;; determine where footnotes shall be inserted (INS-POINT). - (cond - ((and org-footnote-section (derived-mode-p 'org-mode)) - (goto-char (point-min)) - (if (re-search-forward - (concat "^\\*[ \t]+" (regexp-quote org-footnote-section) - "[ \t]*$") nil t) - (delete-region (match-beginning 0) (org-end-of-subtree t t))) - ;; A new footnote section is inserted by default at the end of - ;; the buffer. - (goto-char (point-max)) - (skip-chars-backward " \r\t\n") - (forward-line) - (unless (bolp) (newline))) - ;; No footnote section set: Footnotes will be added at the end - ;; of the section containing their first reference. - ((derived-mode-p 'org-mode)) - (t - ;; Remove any left-over tag in the buffer, if one is set up. - (when org-footnote-tag-for-non-org-mode-files - (let ((tag (concat "^" (regexp-quote - org-footnote-tag-for-non-org-mode-files) - "[ \t]*$"))) - (goto-char (point-min)) - (while (re-search-forward tag nil t) - (replace-match "") - (delete-region (point) (progn (forward-line) (point)))))) - ;; In Message mode, ensure footnotes are inserted before the - ;; signature. - (if (and (derived-mode-p 'message-mode) - (goto-char (point-max)) - (re-search-backward message-signature-separator nil t)) - (beginning-of-line) - (goto-char (point-max))))) - (setq ins-point (point-marker)) - ;; 3. Clean-up REF-TABLE. - (setq ref-table - (delq nil - (mapcar - (lambda (x) - (cond - ;; When only sorting, ignore inline footnotes. - ;; Also clear position marker. - ((and sort-only (nth 3 x)) - (set-marker (nth 4 x) nil) nil) - ;; No definition available: provide one. - ((not (nth 2 x)) - (append - (list (car x) (nth 1 x) - (format "DEFINITION NOT FOUND: %s" (car x))) - (nthcdr 3 x))) - (t x))) - ref-table))) - (setq ref-table (nreverse ref-table)) - ;; 4. Remove left-over definitions in the buffer. - (mapc (lambda (x) - (unless (nth 3 x) (org-footnote-delete-definitions (car x)))) - ref-table) - ;; 5. Insert the footnotes again in the buffer, at the - ;; appropriate spot. - (goto-char ins-point) - (cond - ;; No footnote: exit. - ((not ref-table)) - ;; Cases when footnotes should be inserted in one place. - ((or (not (derived-mode-p 'org-mode)) org-footnote-section) - ;; Insert again the section title, if any. Ensure that title, - ;; or the subsequent footnotes, will be separated by a blank - ;; lines from the rest of the document. In an Org buffer, - ;; separate section with a blank line, unless explicitly - ;; stated in `org-blank-before-new-entry'. - (if (not (derived-mode-p 'org-mode)) - (progn (skip-chars-backward " \t\n\r") - (delete-region (point) ins-point) - (unless (bolp) (newline)) - (when org-footnote-tag-for-non-org-mode-files - (insert "\n" org-footnote-tag-for-non-org-mode-files "\n"))) - (when (and (cdr (assq 'heading org-blank-before-new-entry)) - (zerop (save-excursion (org-back-over-empty-lines)))) - (insert "\n")) - (insert "* " org-footnote-section "\n")) - (set-marker ins-point nil) - ;; Insert the footnotes, separated by a blank line. - (insert - (mapconcat - (lambda (x) - ;; Clean markers. - (set-marker (nth 4 x) nil) - (format "\n[%s] %s" (nth (if sort-only 0 1) x) (nth 2 x))) - ref-table "\n")) - (unless (eobp) (insert "\n\n"))) - ;; Each footnote definition has to be inserted at the end of - ;; the section where its first reference belongs. - (t - (mapc - (lambda (x) - (let ((pos (nth 4 x))) - (goto-char pos) - ;; Clean marker. - (set-marker pos nil)) - (org-footnote-goto-local-insertion-point) - (insert (format "\n[%s] %s\n" - (if sort-only (car x) (nth 1 x)) - (nth 2 x)))) - ref-table)))))) - -(defun org-footnote-goto-local-insertion-point () - "Find insertion point for footnote, just before next outline heading." - (org-with-limited-levels (outline-next-heading)) - (or (bolp) (newline)) - (beginning-of-line 0) - (while (and (not (bobp)) (= (char-after) ?#)) - (beginning-of-line 0)) - (if (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) (beginning-of-line 2)) - (end-of-line 1) - (skip-chars-backward "\n\r\t ") - (forward-line)) - -(defun org-footnote-delete-references (label) - "Delete every reference to footnote LABEL. -Return the number of footnotes removed." - (save-excursion - (goto-char (point-min)) - (let (ref (nref 0)) - (while (setq ref (org-footnote-get-next-reference label)) - (goto-char (nth 1 ref)) - (delete-region (nth 1 ref) (nth 2 ref)) - (incf nref)) - nref))) - -(defun org-footnote-delete-definitions (label) - "Delete every definition of the footnote LABEL. -Return the number of footnotes removed." - (save-excursion - (goto-char (point-min)) - (let ((def-re (concat "^\\[" (regexp-quote label) "\\]")) - (ndef 0)) - (while (re-search-forward def-re nil t) - (let ((full-def (org-footnote-at-definition-p))) - (when full-def - ;; Remove the footnote, and all blank lines before it. - (goto-char (nth 1 full-def)) - (skip-chars-backward " \r\t\n") - (unless (bolp) (forward-line)) - (delete-region (point) (nth 2 full-def)) - (incf ndef)))) - ndef))) - -(defun org-footnote-delete (&optional label) - "Delete the footnote at point. -This will remove the definition (even multiple definitions if they exist) -and all references of a footnote label. - -If LABEL is non-nil, delete that footnote instead." - (catch 'done - (let* ((nref 0) (ndef 0) x - ;; 1. Determine LABEL of footnote at point. - (label (cond - ;; LABEL is provided as argument. - (label) - ;; Footnote reference at point. If the footnote is - ;; anonymous, delete it and exit instead. - ((setq x (org-footnote-at-reference-p)) - (or (car x) - (progn - (delete-region (nth 1 x) (nth 2 x)) - (message "Anonymous footnote removed") - (throw 'done t)))) - ;; Footnote definition at point. - ((setq x (org-footnote-at-definition-p)) - (car x)) - (t (error "Don't know which footnote to remove"))))) - ;; 2. Now that LABEL is non-nil, find every reference and every - ;; definition, and delete them. - (setq nref (org-footnote-delete-references label) - ndef (org-footnote-delete-definitions label)) - ;; 3. Verify consistency of footnotes and notify user. - (org-footnote-auto-adjust-maybe) - (message "%d definition(s) of and %d reference(s) of footnote %s removed" - ndef nref label)))) - -(defun org-footnote-renumber-fn:N () - "Renumber the simple footnotes like fn:17 into a sequence in the document." - (interactive) - (let (map (n 0)) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward "\\[fn:\\([0-9]+\\)[]:]" nil t) - (save-excursion - (goto-char (match-beginning 0)) - ;; Ensure match is a footnote reference or definition. - (when (save-match-data (if (bolp) - (org-footnote-at-definition-p) - (org-footnote-at-reference-p))) - (let ((new-val (or (cdr (assoc (match-string 1) map)) - (number-to-string (incf n))))) - (unless (assoc (match-string 1) map) - (push (cons (match-string 1) new-val) map)) - (replace-match new-val nil nil nil 1)))))))) - -(defun org-footnote-auto-adjust-maybe () - "Renumber and/or sort footnotes according to user settings." - (when (memq org-footnote-auto-adjust '(t renumber)) - (org-footnote-renumber-fn:N)) - (when (memq org-footnote-auto-adjust '(t sort)) - (let ((label (car (org-footnote-at-definition-p)))) - (org-footnote-normalize 'sort) - (when label - (goto-char (point-min)) - (and (re-search-forward (concat "^\\[" (regexp-quote label) "\\]") - nil t) - (progn (insert " ") - (just-one-space))))))) - -(provide 'org-footnote) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-footnote.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-gnus.el b/xemacs-packages/lisp/org-8.2.3c/org-gnus.el deleted file mode 100644 index e368a14e..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-gnus.el +++ /dev/null @@ -1,300 +0,0 @@ -;;; org-gnus.el --- Support for links to Gnus groups and messages from within Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Tassilo Horn <tassilo at member dot fsf dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;; This file implements links to Gnus groups and messages from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org) -(require 'gnus-util) -(eval-when-compile (require 'gnus-sum)) - -;; Declare external functions and variables -(declare-function message-fetch-field "message" (header &optional not-all)) -(declare-function message-narrow-to-head-1 "message" nil) -(declare-function nnimap-group-overview-filename "nnimap" (group server)) -;; The following line suppresses a compiler warning stemming from gnus-sum.el -(declare-function gnus-summary-last-subject "gnus-sum" nil) -;; Customization variables - -(org-defvaralias 'org-usenet-links-prefer-google 'org-gnus-prefer-web-links) - -(defcustom org-gnus-prefer-web-links nil - "If non-nil, `org-store-link' creates web links to Google groups or Gmane. -When nil, Gnus will be used for such links. -Using a prefix arg to the command \\[org-store-link] (`org-store-link') -negates this setting for the duration of the command." - :group 'org-link-store - :type 'boolean) - -(defcustom org-gnus-nnimap-query-article-no-from-file nil - "If non-nil, `org-gnus-follow-link' will try to translate -Message-Ids to article numbers by querying the .overview file. -Normally, this translation is done by querying the IMAP server, -which is usually very fast. Unfortunately, some (maybe badly -configured) IMAP servers don't support this operation quickly. -So if following a link to a Gnus article takes ages, try setting -this variable to `t'." - :group 'org-link-store - :version "24.1" - :type 'boolean) - -(defcustom org-gnus-no-server nil - "Should Gnus be started using `gnus-no-server'?" - :group 'org-gnus - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -;; Install the link type -(org-add-link-type "gnus" 'org-gnus-open) -(add-hook 'org-store-link-functions 'org-gnus-store-link) - -;; Implementation - -(defun org-gnus-nnimap-cached-article-number (group server message-id) - "Return cached article number (uid) of message in GROUP on SERVER. -MESSAGE-ID is the message-id header field that identifies the -message. If the uid is not cached, return nil." - (with-temp-buffer - (let ((nov (nnimap-group-overview-filename group server))) - (when (file-exists-p nov) - (mm-insert-file-contents nov) - (set-buffer-modified-p nil) - (goto-char (point-min)) - (catch 'found - (while (search-forward message-id nil t) - (let ((hdr (split-string (thing-at-point 'line) "\t"))) - (if (string= (nth 4 hdr) message-id) - (throw 'found (nth 0 hdr)))))))))) - -(defun org-gnus-group-link (group) - "Create a link to the Gnus group GROUP. -If GROUP is a newsgroup and `org-gnus-prefer-web-links' is -non-nil, create a link to groups.google.com or gmane.org. -Otherwise create a link to the group inside Gnus. - -If `org-store-link' was called with a prefix arg the meaning of -`org-gnus-prefer-web-links' is reversed." - (let ((unprefixed-group (replace-regexp-in-string "^[^:]+:" "" group))) - (if (and (string-match "^nntp" group) ;; Only for nntp groups - (org-xor current-prefix-arg - org-gnus-prefer-web-links)) - (concat (if (string-match "gmane" unprefixed-group) - "http://news.gmane.org/" - "http://groups.google.com/group/") - unprefixed-group) - (concat "gnus:" group)))) - -(defun org-gnus-article-link (group newsgroups message-id x-no-archive) - "Create a link to a Gnus article. -The article is specified by its MESSAGE-ID. Additional -parameters are the Gnus GROUP, the NEWSGROUPS the article was -posted to and the X-NO-ARCHIVE header value of that article. - -If GROUP is a newsgroup and `org-gnus-prefer-web-links' is -non-nil, create a link to groups.google.com or gmane.org. -Otherwise create a link to the article inside Gnus. - -If `org-store-link' was called with a prefix arg the meaning of -`org-gnus-prefer-web-links' is reversed." - (if (and (org-xor current-prefix-arg org-gnus-prefer-web-links) - newsgroups ;; Make web links only for nntp groups - (not x-no-archive)) ;; and if X-No-Archive isn't set. - (format (if (string-match "gmane\\." newsgroups) - "http://mid.gmane.org/%s" - "http://groups.google.com/groups/search?as_umsgid=%s") - (org-fixup-message-id-for-http message-id)) - (concat "gnus:" group "#" message-id))) - -(defun org-gnus-store-link () - "Store a link to a Gnus folder or message." - (cond - ((eq major-mode 'gnus-group-mode) - (let* ((group (cond ((fboundp 'gnus-group-group-name) ; depending on Gnus - (gnus-group-group-name)) ; version - ((fboundp 'gnus-group-name) - (gnus-group-name)) - (t "???"))) - desc link) - (when group - (org-store-link-props :type "gnus" :group group) - (setq desc (org-gnus-group-link group) - link desc) - (org-add-link-props :link link :description desc) - link))) - - ((memq major-mode '(gnus-summary-mode gnus-article-mode)) - (let* ((group gnus-newsgroup-name) - (header (with-current-buffer gnus-summary-buffer - (gnus-summary-article-header))) - (from (mail-header-from header)) - (message-id (org-remove-angle-brackets (mail-header-id header))) - (date (org-trim (mail-header-date header))) - (date-ts (and date - (ignore-errors - (format-time-string - (org-time-stamp-format t) - (date-to-time date))))) - (date-ts-ia (and date - (ignore-errors - (format-time-string - (org-time-stamp-format t t) - (date-to-time date))))) - (subject (copy-sequence (mail-header-subject header))) - (to (cdr (assq 'To (mail-header-extra header)))) - newsgroups x-no-archive desc link) - ;; Remove text properties of subject string to avoid Emacs bug - ;; #3506 - (set-text-properties 0 (length subject) nil subject) - - ;; Fetching an article is an expensive operation; newsgroup and - ;; x-no-archive are only needed for web links. - (when (org-xor current-prefix-arg org-gnus-prefer-web-links) - ;; Make sure the original article buffer is up-to-date - (save-window-excursion (gnus-summary-select-article)) - (setq to (or to (gnus-fetch-original-field "To")) - newsgroups (gnus-fetch-original-field "Newsgroups") - x-no-archive (gnus-fetch-original-field "x-no-archive"))) - (org-store-link-props :type "gnus" :from from :subject subject - :message-id message-id :group group :to to) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) - (setq desc (org-email-link-description) - link (org-gnus-article-link - group newsgroups message-id x-no-archive)) - (org-add-link-props :link link :description desc) - link)) - ((eq major-mode 'message-mode) - (setq org-store-link-plist nil) ; reset - (save-excursion - (save-restriction - (message-narrow-to-headers) - (and (not (message-fetch-field "Message-ID")) - (message-generate-headers '(Message-ID))) - (goto-char (point-min)) - (re-search-forward "^Message-ID: *.*$" nil t) - (put-text-property (match-beginning 0) (match-end 0) 'message-deletable nil) - (let ((gcc (car (last - (message-unquote-tokens - (message-tokenize-header (mail-fetch-field "gcc" nil t) " ,"))))) - (id (org-remove-angle-brackets (mail-fetch-field "Message-ID"))) - (to (mail-fetch-field "To")) - (from (mail-fetch-field "From")) - (subject (mail-fetch-field "Subject")) - desc link - newsgroup xarchive) ; those are always nil for gcc - (and (not gcc) - (error "Can not create link: No Gcc header found")) - (org-store-link-props :type "gnus" :from from :subject subject - :message-id id :group gcc :to to) - (setq desc (org-email-link-description) - link (org-gnus-article-link - gcc newsgroup id xarchive)) - (org-add-link-props :link link :description desc) - link)))))) - -(defun org-gnus-open-nntp (path) - "Follow the nntp: link specified by PATH." - (let* ((spec (split-string path "/")) - (server (split-string (nth 2 spec) "@")) - (group (nth 3 spec)) - (article (nth 4 spec))) - (org-gnus-follow-link - (format "nntp+%s:%s" (or (cdr server) (car server)) group) - article))) - -(defun org-gnus-open (path) - "Follow the Gnus message or folder link specified by PATH." - (let (group article) - (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in Gnus link")) - (setq group (match-string 1 path) - article (match-string 3 path)) - (when group - (setq group (org-no-properties group))) - (when article - (setq article (org-no-properties article))) - (org-gnus-follow-link group article))) - -(defun org-gnus-follow-link (&optional group article) - "Follow a Gnus link to GROUP and ARTICLE." - (require 'gnus) - (funcall (cdr (assq 'gnus org-link-frame-setup))) - (if gnus-other-frame-object (select-frame gnus-other-frame-object)) - (when group - (setq group (org-no-properties group))) - (when article - (setq article (org-no-properties article))) - (cond ((and group article) - (gnus-activate-group group) - (condition-case nil - (let* ((method (gnus-find-method-for-group group)) - (backend (car method)) - (server (cadr method))) - (cond - ((eq backend 'nndoc) - (if (gnus-group-read-group t nil group) - (gnus-summary-goto-article article nil t) - (message "Couldn't follow gnus link. %s" - "The summary couldn't be opened."))) - (t - (let ((articles 1) - group-opened) - (when (and (eq backend 'nnimap) - org-gnus-nnimap-query-article-no-from-file) - (setq article - (or (org-gnus-nnimap-cached-article-number - (nth 1 (split-string group ":")) - server (concat "<" article ">")) article))) - (while (and (not group-opened) - ;; stop on integer overflows - (> articles 0)) - (setq group-opened (gnus-group-read-group - articles t group) - articles (if (< articles 16) - (1+ articles) - (* articles 2)))) - (if group-opened - (gnus-summary-goto-article article nil t) - (message "Couldn't follow gnus link. %s" - "The summary couldn't be opened.")))))) - (quit (message "Couldn't follow gnus link. %s" - "The linked group is empty.")))) - (group (gnus-group-jump-to-group group)))) - -(defun org-gnus-no-new-news () - "Like `M-x gnus' but doesn't check for new news." - (if (not (gnus-alive-p)) (if org-gnus-no-server (gnus-no-server) (gnus)))) - -(provide 'org-gnus) - - -;;; org-gnus.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-habit.el b/xemacs-packages/lisp/org-8.2.3c/org-habit.el deleted file mode 100644 index eba90376..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-habit.el +++ /dev/null @@ -1,393 +0,0 @@ -;;; org-habit.el --- The habit tracking code for Org-mode - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. - -;; Author: John Wiegley <johnw at gnu dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;; This file contains the habit tracking code for Org-mode - -;;; Code: - -(require 'org) -(require 'org-agenda) - -(eval-when-compile - (require 'cl)) - -(defgroup org-habit nil - "Options concerning habit tracking in Org-mode." - :tag "Org Habit" - :group 'org-progress) - -(defcustom org-habit-graph-column 40 - "The absolute column at which to insert habit consistency graphs. -Note that consistency graphs will overwrite anything else in the buffer." - :group 'org-habit - :type 'integer) - -(defcustom org-habit-preceding-days 21 - "Number of days before today to appear in consistency graphs." - :group 'org-habit - :type 'integer) - -(defcustom org-habit-following-days 7 - "Number of days after today to appear in consistency graphs." - :group 'org-habit - :type 'integer) - -(defcustom org-habit-show-habits t - "If non-nil, show habits in agenda buffers." - :group 'org-habit - :type 'boolean) - -(defcustom org-habit-show-habits-only-for-today t - "If non-nil, only show habits on today's agenda, and not for future days. -Note that even when shown for future days, the graph is always -relative to the current effective date." - :group 'org-habit - :type 'boolean) - -(defcustom org-habit-show-all-today nil - "If non-nil, will show the consistency graph of all habits on -today's agenda, even if they are not scheduled." - :group 'org-habit - :type 'boolean) - -(defcustom org-habit-today-glyph ?! - "Glyph character used to identify today." - :group 'org-habit - :version "24.1" - :type 'character) - -(defcustom org-habit-completed-glyph ?* - "Glyph character used to show completed days on which a task was done." - :group 'org-habit - :version "24.1" - :type 'character) - -(defcustom org-habit-show-done-always-green nil - "Non-nil means DONE days will always be green in the consistency graph. -It will be green even if it was done after the deadline." - :group 'org-habit - :type 'boolean) - -(defface org-habit-clear-face - '((((background light)) (:background "#8270f9")) - (((background dark)) (:background "blue"))) - "Face for days on which a task shouldn't be done yet." - :group 'org-habit - :group 'org-faces) -(defface org-habit-clear-future-face - '((((background light)) (:background "#d6e4fc")) - (((background dark)) (:background "midnightblue"))) - "Face for future days on which a task shouldn't be done yet." - :group 'org-habit - :group 'org-faces) - -(defface org-habit-ready-face - '((((background light)) (:background "#4df946")) - (((background dark)) (:background "forestgreen"))) - "Face for days on which a task should start to be done." - :group 'org-habit - :group 'org-faces) -(defface org-habit-ready-future-face - '((((background light)) (:background "#acfca9")) - (((background dark)) (:background "darkgreen"))) - "Face for days on which a task should start to be done." - :group 'org-habit - :group 'org-faces) - -(defface org-habit-alert-face - '((((background light)) (:background "#f5f946")) - (((background dark)) (:background "gold"))) - "Face for days on which a task is due." - :group 'org-habit - :group 'org-faces) -(defface org-habit-alert-future-face - '((((background light)) (:background "#fafca9")) - (((background dark)) (:background "darkgoldenrod"))) - "Face for days on which a task is due." - :group 'org-habit - :group 'org-faces) - -(defface org-habit-overdue-face - '((((background light)) (:background "#f9372d")) - (((background dark)) (:background "firebrick"))) - "Face for days on which a task is overdue." - :group 'org-habit - :group 'org-faces) -(defface org-habit-overdue-future-face - '((((background light)) (:background "#fc9590")) - (((background dark)) (:background "darkred"))) - "Face for days on which a task is overdue." - :group 'org-habit - :group 'org-faces) - -(defun org-habit-duration-to-days (ts) - (if (string-match "\\([0-9]+\\)\\([dwmy]\\)" ts) - ;; lead time is specified. - (floor (* (string-to-number (match-string 1 ts)) - (cdr (assoc (match-string 2 ts) - '(("d" . 1) ("w" . 7) - ("m" . 30.4) ("y" . 365.25)))))) - (error "Invalid duration string: %s" ts))) - -(defun org-is-habit-p (&optional pom) - "Is the task at POM or point a habit?" - (string= "habit" (org-entry-get (or pom (point)) "STYLE"))) - -(defun org-habit-parse-todo (&optional pom) - "Parse the TODO surrounding point for its habit-related data. -Returns a list with the following elements: - - 0: Scheduled date for the habit (may be in the past) - 1: \".+\"-style repeater for the schedule, in days - 2: Optional deadline (nil if not present) - 3: If deadline, the repeater for the deadline, otherwise nil - 4: A list of all the past dates this todo was mark closed - -This list represents a \"habit\" for the rest of this module." - (save-excursion - (if pom (goto-char pom)) - (assert (org-is-habit-p (point))) - (let* ((scheduled (org-get-scheduled-time (point))) - (scheduled-repeat (org-get-repeat org-scheduled-string)) - (end (org-entry-end-position)) - (habit-entry (org-no-properties (nth 4 (org-heading-components)))) - closed-dates deadline dr-days sr-days) - (if scheduled - (setq scheduled (time-to-days scheduled)) - (error "Habit %s has no scheduled date" habit-entry)) - (unless scheduled-repeat - (error - "Habit '%s' has no scheduled repeat period or has an incorrect one" - habit-entry)) - (setq sr-days (org-habit-duration-to-days scheduled-repeat)) - (unless (> sr-days 0) - (error "Habit %s scheduled repeat period is less than 1d" habit-entry)) - (when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat) - (setq dr-days (org-habit-duration-to-days - (match-string-no-properties 1 scheduled-repeat))) - (if (<= dr-days sr-days) - (error "Habit %s deadline repeat period is less than or equal to scheduled (%s)" - habit-entry scheduled-repeat)) - (setq deadline (+ scheduled (- dr-days sr-days)))) - (org-back-to-heading t) - (let* ((maxdays (+ org-habit-preceding-days org-habit-following-days)) - (reversed org-log-states-order-reversed) - (search (if reversed 're-search-forward 're-search-backward)) - (limit (if reversed end (point))) - (count 0)) - (unless reversed (goto-char end)) - (while (and (< count maxdays) - (funcall search "- State \"DONE\".*\\[\\([^]]+\\)\\]" limit t)) - (push (time-to-days - (org-time-string-to-time (match-string-no-properties 1))) - closed-dates) - (setq count (1+ count)))) - (list scheduled sr-days deadline dr-days closed-dates)))) - -(defsubst org-habit-scheduled (habit) - (nth 0 habit)) -(defsubst org-habit-scheduled-repeat (habit) - (nth 1 habit)) -(defsubst org-habit-deadline (habit) - (let ((deadline (nth 2 habit))) - (or deadline - (if (nth 3 habit) - (+ (org-habit-scheduled habit) - (1- (org-habit-scheduled-repeat habit))) - (org-habit-scheduled habit))))) -(defsubst org-habit-deadline-repeat (habit) - (or (nth 3 habit) - (org-habit-scheduled-repeat habit))) -(defsubst org-habit-done-dates (habit) - (nth 4 habit)) - -(defsubst org-habit-get-priority (habit &optional moment) - "Determine the relative priority of a habit. -This must take into account not just urgency, but consistency as well." - (let ((pri 1000) - (now (if moment (time-to-days moment) (org-today))) - (scheduled (org-habit-scheduled habit)) - (deadline (org-habit-deadline habit))) - ;; add 10 for every day past the scheduled date, and subtract for every - ;; day before it - (setq pri (+ pri (* (- now scheduled) 10))) - ;; add 50 if the deadline is today - (if (and (/= scheduled deadline) - (= now deadline)) - (setq pri (+ pri 50))) - ;; add 100 for every day beyond the deadline date, and subtract 10 for - ;; every day before it - (let ((slip (- now (1- deadline)))) - (if (> slip 0) - (setq pri (+ pri (* slip 100))) - (setq pri (+ pri (* slip 10))))) - pri)) - -(defun org-habit-get-faces (habit &optional now-days scheduled-days donep) - "Return faces for HABIT relative to NOW-DAYS and SCHEDULED-DAYS. -NOW-DAYS defaults to the current time's days-past-the-epoch if nil. -SCHEDULED-DAYS defaults to the habit's actual scheduled days if nil. - -Habits are assigned colors on the following basis: - Blue Task is before the scheduled date. - Green Task is on or after scheduled date, but before the - end of the schedule's repeat period. - Yellow If the task has a deadline, then it is after schedule's - repeat period, but before the deadline. - Orange The task has reached the deadline day, or if there is - no deadline, the end of the schedule's repeat period. - Red The task has gone beyond the deadline day or the - schedule's repeat period." - (let* ((scheduled (or scheduled-days (org-habit-scheduled habit))) - (s-repeat (org-habit-scheduled-repeat habit)) - (scheduled-end (+ scheduled (1- s-repeat))) - (d-repeat (org-habit-deadline-repeat habit)) - (deadline (if scheduled-days - (+ scheduled-days (- d-repeat s-repeat)) - (org-habit-deadline habit))) - (m-days (or now-days (time-to-days (current-time))))) - (cond - ((< m-days scheduled) - '(org-habit-clear-face . org-habit-clear-future-face)) - ((< m-days deadline) - '(org-habit-ready-face . org-habit-ready-future-face)) - ((= m-days deadline) - (if donep - '(org-habit-ready-face . org-habit-ready-future-face) - '(org-habit-alert-face . org-habit-alert-future-face))) - ((and org-habit-show-done-always-green donep) - '(org-habit-ready-face . org-habit-ready-future-face)) - (t '(org-habit-overdue-face . org-habit-overdue-future-face))))) - -(defun org-habit-build-graph (habit starting current ending) - "Build a graph for the given HABIT, from STARTING to ENDING. -CURRENT gives the current time between STARTING and ENDING, for -the purpose of drawing the graph. It need not be the actual -current time." - (let* ((done-dates (sort (org-habit-done-dates habit) '<)) - (scheduled (org-habit-scheduled habit)) - (s-repeat (org-habit-scheduled-repeat habit)) - (start (time-to-days starting)) - (now (time-to-days current)) - (end (time-to-days ending)) - (graph (make-string (1+ (- end start)) ?\ )) - (index 0) - last-done-date) - (while (and done-dates (< (car done-dates) start)) - (setq last-done-date (car done-dates) - done-dates (cdr done-dates))) - (while (< start end) - (let* ((in-the-past-p (< start now)) - (todayp (= start now)) - (donep (and done-dates - (= start (car done-dates)))) - (faces (if (and in-the-past-p - (not last-done-date) - (not (< scheduled now))) - '(org-habit-clear-face . org-habit-clear-future-face) - (org-habit-get-faces - habit start (and in-the-past-p - (if last-done-date - (+ last-done-date s-repeat) - scheduled)) - donep))) - markedp face) - (if donep - (let ((done-time (time-add - starting - (days-to-time - (- start (time-to-days starting)))))) - - (aset graph index org-habit-completed-glyph) - (setq markedp t) - (put-text-property - index (1+ index) 'help-echo - (format-time-string (org-time-stamp-format) done-time) graph) - (while (and done-dates - (= start (car done-dates))) - (setq last-done-date (car done-dates) - done-dates (cdr done-dates)))) - (if todayp - (aset graph index org-habit-today-glyph))) - (setq face (if (or in-the-past-p todayp) - (car faces) - (cdr faces))) - (if (and in-the-past-p - (not (eq face 'org-habit-overdue-face)) - (not markedp)) - (setq face (cdr faces))) - (put-text-property index (1+ index) 'face face graph)) - (setq start (1+ start) - index (1+ index))) - graph)) - -(defun org-habit-insert-consistency-graphs (&optional line) - "Insert consistency graph for any habitual tasks." - (let ((inhibit-read-only t) l c - (buffer-invisibility-spec '(org-link)) - (moment (time-subtract (current-time) - (list 0 (* 3600 org-extend-today-until) 0))) - disabled-overlays) - ;; Disable filters; this helps with alignment if there are links. - (mapc (lambda (ol) - (when (overlay-get ol 'invisible) - (overlay-put ol 'invisible nil) - (setq disabled-overlays (cons ol disabled-overlays)))) - (overlays-in (point-min) (point-max))) - (save-excursion - (goto-char (if line (point-at-bol) (point-min))) - (while (not (eobp)) - (let ((habit (get-text-property (point) 'org-habit-p))) - (when habit - (move-to-column org-habit-graph-column t) - (delete-char (min (+ 1 org-habit-preceding-days - org-habit-following-days) - (- (line-end-position) (point)))) - (insert-before-markers - (org-habit-build-graph - habit - (time-subtract moment (days-to-time org-habit-preceding-days)) - moment - (time-add moment (days-to-time org-habit-following-days)))))) - (forward-line))) - (mapc (lambda (ol) (overlay-put ol 'invisible t)) - disabled-overlays))) - -(defun org-habit-toggle-habits () - "Toggle display of habits in an agenda buffer." - (interactive) - (org-agenda-check-type t 'agenda) - (setq org-habit-show-habits (not org-habit-show-habits)) - (org-agenda-redo) - (org-agenda-set-mode-name) - (message "Habits turned %s" - (if org-habit-show-habits "on" "off"))) - -(org-defkey org-agenda-mode-map "K" 'org-habit-toggle-habits) - -(provide 'org-habit) - -;;; org-habit.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-id.el b/xemacs-packages/lisp/org-8.2.3c/org-id.el deleted file mode 100644 index 37f6e70e..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-id.el +++ /dev/null @@ -1,689 +0,0 @@ -;;; org-id.el --- Global identifiers for Org-mode entries -;; -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;; This file implements globally unique identifiers for Org-mode entries. -;; Identifiers are stored in the entry as an :ID: property. Functions -;; are provided that create and retrieve such identifiers, and that find -;; entries based on the identifier. - -;; Identifiers consist of a prefix (default "Org" given by the variable -;; `org-id-prefix') and a unique part that can be created by a number -;; of different methods, see the variable `org-id-method'. -;; Org has a builtin method that uses a compact encoding of the creation -;; time of the ID, with microsecond accuracy. This virtually -;; guarantees globally unique identifiers, even if several people are -;; creating IDs at the same time in files that will eventually be used -;; together. -;; -;; By default Org uses UUIDs as global unique identifiers. -;; -;; This file defines the following API: -;; -;; org-id-get-create -;; Create an ID for the entry at point if it does not yet have one. -;; Returns the ID (old or new). This function can be used -;; interactively, with prefix argument the creation of a new ID is -;; forced, even if there was an old one. -;; -;; org-id-get -;; Get the ID property of an entry. Using appropriate arguments -;; to the function, it can also create the ID for this entry. -;; -;; org-id-goto -;; Command to go to a specific ID, this command can be used -;; interactively. -;; -;; org-id-get-with-outline-path-completion -;; Retrieve the ID of an entry, using outline path completion. -;; This function can work for multiple files. -;; -;; org-id-get-with-outline-drilling -;; Retrieve the ID of an entry, using outline path completion. -;; This function only works for the current file. -;; -;; org-id-find -;; Find the location of an entry with specific id. -;; - -;;; Code: - -(require 'org) - -(declare-function message-make-fqdn "message" ()) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) - -;;; Customization - -(defgroup org-id nil - "Options concerning global entry identifiers in Org-mode." - :tag "Org ID" - :group 'org) - -(define-obsolete-variable-alias - 'org-link-to-org-use-id 'org-id-link-to-org-use-id "24.3") -(defcustom org-id-link-to-org-use-id nil - "Non-nil means storing a link to an Org file will use entry IDs. - -The variable can have the following values: - -t Create an ID if needed to make a link to the current entry. - -create-if-interactive - If `org-store-link' is called directly (interactively, as a user - command), do create an ID to support the link. But when doing the - job for capture, only use the ID if it already exists. The - purpose of this setting is to avoid proliferation of unwanted - IDs, just because you happen to be in an Org file when you - call `org-capture' that automatically and preemptively creates a - link. If you do want to get an ID link in a capture template to - an entry not having an ID, create it first by explicitly creating - a link to it, using `C-c C-l' first. - -create-if-interactive-and-no-custom-id - Like create-if-interactive, but do not create an ID if there is - a CUSTOM_ID property defined in the entry. - -use-existing - Use existing ID, do not create one. - -nil Never use an ID to make a link, instead link using a text search for - the headline text." - :group 'org-link-store - :group 'org-id - :version "24.3" - :type '(choice - (const :tag "Create ID to make link" t) - (const :tag "Create if storing link interactively" - create-if-interactive) - (const :tag "Create if storing link interactively and no CUSTOM_ID is present" - create-if-interactive-and-no-custom-id) - (const :tag "Only use existing" use-existing) - (const :tag "Do not use ID to create link" nil))) - -(defcustom org-id-uuid-program "uuidgen" - "The uuidgen program." - :group 'org-id - :type 'string) - -(defcustom org-id-method 'uuid - "The method that should be used to create new IDs. - -An ID will consist of the optional prefix specified in `org-id-prefix', -and a unique part created by the method this variable specifies. - -Allowed values are: - -org Org's own internal method, using an encoding of the current time to - microsecond accuracy, and optionally the current domain of the - computer. See the variable `org-id-include-domain'. - -uuid Create random (version 4) UUIDs. If the program defined in - `org-id-uuid-program' is available it is used to create the ID. - Otherwise an internal functions is used." - :group 'org-id - :type '(choice - (const :tag "Org's internal method" org) - (const :tag "external: uuidgen" uuid))) - -(defcustom org-id-prefix nil - "The prefix for IDs. - -This may be a string, or it can be nil to indicate that no prefix is required. -When a string, the string should have no space characters as IDs are expected -to have no space characters in them." - :group 'org-id - :type '(choice - (const :tag "No prefix") - (string :tag "Prefix"))) - -(defcustom org-id-include-domain nil - "Non-nil means add the domain name to new IDs. -This ensures global uniqueness of IDs, and is also suggested by -RFC 2445 in combination with RFC 822. This is only relevant if -`org-id-method' is `org'. When uuidgen is used, the domain will never -be added. -The default is to not use this because we have no really good way to get -the true domain, and Org entries will normally not be shared with enough -people to make this necessary." - :group 'org-id - :type 'boolean) - -(defcustom org-id-track-globally t - "Non-nil means track IDs through files, so that links work globally. -This work by maintaining a hash table for IDs and writing this table -to disk when exiting Emacs. Because of this, it works best if you use -a single Emacs process, not many. - -When nil, IDs are not tracked. Links to IDs will still work within -a buffer, but not if the entry is located in another file. -IDs can still be used if the entry with the id is in the same file as -the link." - :group 'org-id - :type 'boolean) - -(defcustom org-id-locations-file (convert-standard-filename - (concat user-emacs-directory ".org-id-locations")) - "The file for remembering in which file an ID was defined. -This variable is only relevant when `org-id-track-globally' is set." - :group 'org-id - :type 'file) - -(defvar org-id-locations nil - "List of files with IDs in those files.") - -(defvar org-id-files nil - "List of files that contain IDs.") - -(defcustom org-id-extra-files 'org-agenda-text-search-extra-files - "Files to be searched for IDs, besides the agenda files. -When Org reparses files to remake the list of files and IDs it is tracking, -it will normally scan the agenda files, the archives related to agenda files, -any files that are listed as ID containing in the current register, and -any Org-mode files currently visited by Emacs. -You can list additional files here. -This variable is only relevant when `org-id-track-globally' is set." - :group 'org-id - :type - '(choice - (symbol :tag "Variable") - (repeat :tag "List of files" - (file)))) - -(defcustom org-id-search-archives t - "Non-nil means search also the archive files of agenda files for entries. -This is a possibility to reduce overhead, but it means that entries moved -to the archives can no longer be found by ID. -This variable is only relevant when `org-id-track-globally' is set." - :group 'org-id - :type 'boolean) - -;;; The API functions - -;;;###autoload -(defun org-id-get-create (&optional force) - "Create an ID for the current entry and return it. -If the entry already has an ID, just return it. -With optional argument FORCE, force the creation of a new ID." - (interactive "P") - (when force - (org-entry-put (point) "ID" nil)) - (org-id-get (point) 'create)) - -;;;###autoload -(defun org-id-copy () - "Copy the ID of the entry at point to the kill ring. -Create an ID if necessary." - (interactive) - (org-kill-new (org-id-get nil 'create))) - -;;;###autoload -(defun org-id-get (&optional pom create prefix) - "Get the ID property of the entry at point-or-marker POM. -If POM is nil, refer to the entry at point. -If the entry does not have an ID, the function returns nil. -However, when CREATE is non nil, create an ID if none is present already. -PREFIX will be passed through to `org-id-new'. -In any case, the ID of the entry is returned." - (org-with-point-at pom - (let ((id (org-entry-get nil "ID"))) - (cond - ((and id (stringp id) (string-match "\\S-" id)) - id) - (create - (setq id (org-id-new prefix)) - (org-entry-put pom "ID" id) - (org-id-add-location id (buffer-file-name (buffer-base-buffer))) - id))))) - -;;;###autoload -(defun org-id-get-with-outline-path-completion (&optional targets) - "Use `outline-path-completion' to retrieve the ID of an entry. -TARGETS may be a setting for `org-refile-targets' to define -eligible headlines. When omitted, all headlines in the current -file are eligible. This function returns the ID of the entry. -If necessary, the ID is created." - (let* ((org-refile-targets (or targets '((nil . (:maxlevel . 10))))) - (org-refile-use-outline-path - (if (caar org-refile-targets) 'file t)) - (org-refile-target-verify-function nil) - (spos (org-refile-get-location "Entry")) - (pom (and spos (move-marker (make-marker) (nth 3 spos) - (get-file-buffer (nth 1 spos)))))) - (prog1 (org-id-get pom 'create) - (move-marker pom nil)))) - -;;;###autoload -(defun org-id-get-with-outline-drilling (&optional targets) - "Use an outline-cycling interface to retrieve the ID of an entry. -This only finds entries in the current buffer, using `org-get-location'. -It returns the ID of the entry. If necessary, the ID is created." - (let* ((spos (org-get-location (current-buffer) org-goto-help)) - (pom (and spos (move-marker (make-marker) (car spos))))) - (prog1 (org-id-get pom 'create) - (move-marker pom nil)))) - -;;;###autoload -(defun org-id-goto (id) - "Switch to the buffer containing the entry with id ID. -Move the cursor to that entry in that buffer." - (interactive "sID: ") - (let ((m (org-id-find id 'marker))) - (unless m - (error "Cannot find entry with ID \"%s\"" id)) - (org-pop-to-buffer-same-window (marker-buffer m)) - (goto-char m) - (move-marker m nil) - (org-show-context))) - -;;;###autoload -(defun org-id-find (id &optional markerp) - "Return the location of the entry with the id ID. -The return value is a cons cell (file-name . position), or nil -if there is no entry with that ID. -With optional argument MARKERP, return the position as a new marker." - (cond - ((symbolp id) (setq id (symbol-name id))) - ((numberp id) (setq id (number-to-string id)))) - (let ((file (org-id-find-id-file id)) - org-agenda-new-buffers where) - (when file - (setq where (org-id-find-id-in-file id file markerp))) - (unless where - (org-id-update-id-locations nil t) - (setq file (org-id-find-id-file id)) - (when file - (setq where (org-id-find-id-in-file id file markerp)))) - where)) - -;;; Internal functions - -;; Creating new IDs - -;;;###autoload -(defun org-id-new (&optional prefix) - "Create a new globally unique ID. - -An ID consists of two parts separated by a colon: -- a prefix -- a unique part that will be created according to `org-id-method'. - -PREFIX can specify the prefix, the default is given by the variable -`org-id-prefix'. However, if PREFIX is the symbol `none', don't use any -prefix even if `org-id-prefix' specifies one. - -So a typical ID could look like \"Org:4nd91V40HI\"." - (let* ((prefix (if (eq prefix 'none) - "" - (concat (or prefix org-id-prefix) ":"))) - unique) - (if (equal prefix ":") (setq prefix "")) - (cond - ((memq org-id-method '(uuidgen uuid)) - (setq unique (org-trim (shell-command-to-string org-id-uuid-program))) - (unless (org-uuidgen-p unique) - (setq unique (org-id-uuid)))) - ((eq org-id-method 'org) - (let* ((etime (org-reverse-string (org-id-time-to-b36))) - (postfix (if org-id-include-domain - (progn - (require 'message) - (concat "@" (message-make-fqdn)))))) - (setq unique (concat etime postfix)))) - (t (error "Invalid `org-id-method'"))) - (concat prefix unique))) - -(defun org-id-uuid () - "Return string with random (version 4) UUID." - (let ((rnd (md5 (format "%s%s%s%s%s%s%s" - (random) - (current-time) - (user-uid) - (emacs-pid) - (user-full-name) - user-mail-address - (recent-keys))))) - (format "%s-%s-4%s-%s%s-%s" - (substring rnd 0 8) - (substring rnd 8 12) - (substring rnd 13 16) - (format "%x" - (logior - #b10000000 - (logand - #b10111111 - (string-to-number - (substring rnd 16 18) 16)))) - (substring rnd 18 20) - (substring rnd 20 32)))) - -(defun org-id-int-to-b36-one-digit (i) - "Turn an integer between 0 and 61 into a single character 0..9, A..Z, a..z." - (cond - ((< i 10) (+ ?0 i)) - ((< i 36) (+ ?a i -10)) - (t (error "Larger that 35")))) - -(defun org-id-b36-to-int-one-digit (i) - "Turn a character 0..9, A..Z, a..z into a number 0..61. -The input I may be a character, or a single-letter string." - (and (stringp i) (setq i (string-to-char i))) - (cond - ((and (>= i ?0) (<= i ?9)) (- i ?0)) - ((and (>= i ?a) (<= i ?z)) (+ (- i ?a) 10)) - (t (error "Invalid b36 letter")))) - -(defun org-id-int-to-b36 (i &optional length) - "Convert an integer to a base-36 number represented as a string." - (let ((s "")) - (while (> i 0) - (setq s (concat (char-to-string - (org-id-int-to-b36-one-digit (mod i 36))) s) - i (/ i 36))) - (setq length (max 1 (or length 1))) - (if (< (length s) length) - (setq s (concat (make-string (- length (length s)) ?0) s))) - s)) - -(defun org-id-b36-to-int (s) - "Convert a base-36 string into the corresponding integer." - (let ((r 0)) - (mapc (lambda (i) (setq r (+ (* r 36) (org-id-b36-to-int-one-digit i)))) - s) - r)) - -(defun org-id-time-to-b36 (&optional time) - "Encode TIME as a 10-digit string. -This string holds the time to micro-second accuracy, and can be decoded -using `org-id-decode'." - (setq time (or time (current-time))) - (concat (org-id-int-to-b36 (nth 0 time) 4) - (org-id-int-to-b36 (nth 1 time) 4) - (org-id-int-to-b36 (or (nth 2 time) 0) 4))) - -(defun org-id-decode (id) - "Split ID into the prefix and the time value that was used to create it. -The return value is (prefix . time) where PREFIX is nil or a string, -and time is the usual three-integer representation of time." - (let (prefix time parts) - (setq parts (org-split-string id ":")) - (if (= 2 (length parts)) - (setq prefix (car parts) time (nth 1 parts)) - (setq prefix nil time (nth 0 parts))) - (setq time (org-reverse-string time)) - (setq time (list (org-id-b36-to-int (substring time 0 4)) - (org-id-b36-to-int (substring time 4 8)) - (org-id-b36-to-int (substring time 8 12)))) - (cons prefix time))) - -;; Storing ID locations (files) - -;;;###autoload -(defun org-id-update-id-locations (&optional files silent) - "Scan relevant files for IDs. -Store the relation between files and corresponding IDs. -This will scan all agenda files, all associated archives, and all -files currently mentioned in `org-id-locations'. -When FILES is given, scan these files instead. -When CHECK is given, prepare detailed information about duplicate IDs." - (interactive) - (if (not org-id-track-globally) - (error "Please turn on `org-id-track-globally' if you want to track IDs") - (let* ((org-id-search-archives - (or org-id-search-archives - (and (symbolp org-id-extra-files) - (symbol-value org-id-extra-files) - (member 'agenda-archives org-id-extra-files)))) - (files - (or files - (append - ;; Agenda files and all associated archives - (org-agenda-files t org-id-search-archives) - ;; Explicit extra files - (if (symbolp org-id-extra-files) - (symbol-value org-id-extra-files) - org-id-extra-files) - ;; Files associated with live org-mode buffers - (delq nil - (mapcar (lambda (b) - (with-current-buffer b - (and (derived-mode-p 'org-mode) (buffer-file-name)))) - (buffer-list))) - ;; All files known to have IDs - org-id-files))) - org-agenda-new-buffers - file nfiles tfile ids reg found id seen (ndup 0)) - (when (member 'agenda-archives files) - (setq files (delq 'agenda-archives (copy-sequence files)))) - (setq nfiles (length files)) - (while (setq file (pop files)) - (unless silent - (message "Finding ID locations (%d/%d files): %s" - (- nfiles (length files)) nfiles file)) - (setq tfile (file-truename file)) - (when (and (file-exists-p file) (not (member tfile seen))) - (push tfile seen) - (setq ids nil) - (with-current-buffer (org-get-agenda-file-buffer file) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*:ID:[ \t]+\\(\\S-+\\)[ \t]*$" - nil t) - (setq id (org-match-string-no-properties 1)) - (if (member id found) - (progn - (message "Duplicate ID \"%s\", also in file %s" - id (or (car (delq - nil - (mapcar - (lambda (x) - (if (member id (cdr x)) - (car x))) - reg))) - (buffer-file-name))) - (when (= ndup 0) - (ding) - (sit-for 2)) - (setq ndup (1+ ndup))) - (push id found) - (push id ids))) - (push (cons (abbreviate-file-name file) ids) reg)))))) - (org-release-buffers org-agenda-new-buffers) - (setq org-agenda-new-buffers nil) - (setq org-id-locations reg) - (setq org-id-files (mapcar 'car org-id-locations)) - (org-id-locations-save) ;; this function can also handle the alist form - ;; now convert to a hash - (setq org-id-locations (org-id-alist-to-hash org-id-locations)) - (if (> ndup 0) - (message "WARNING: %d duplicate IDs found, check *Messages* buffer" ndup) - (message "%d unique files scanned for IDs" (length org-id-files))) - org-id-locations))) - -(defun org-id-locations-save () - "Save `org-id-locations' in `org-id-locations-file'." - (when (and org-id-track-globally org-id-locations) - (let ((out (if (hash-table-p org-id-locations) - (org-id-hash-to-alist org-id-locations) - org-id-locations))) - (with-temp-file org-id-locations-file - (let ((print-level nil) - (print-length nil)) - (print out (current-buffer))))))) - -(defun org-id-locations-load () - "Read the data from `org-id-locations-file'." - (setq org-id-locations nil) - (when org-id-track-globally - (with-temp-buffer - (condition-case nil - (progn - (insert-file-contents-literally org-id-locations-file) - (goto-char (point-min)) - (setq org-id-locations (read (current-buffer)))) - (error - (message "Could not read org-id-values from %s. Setting it to nil." - org-id-locations-file)))) - (setq org-id-files (mapcar 'car org-id-locations)) - (setq org-id-locations (org-id-alist-to-hash org-id-locations)))) - -(defun org-id-add-location (id file) - "Add the ID with location FILE to the database of ID locations." - ;; Only if global tracking is on, and when the buffer has a file - (when (and org-id-track-globally id file) - (unless org-id-locations (org-id-locations-load)) - (puthash id (abbreviate-file-name file) org-id-locations) - (add-to-list 'org-id-files (abbreviate-file-name file)))) - -(unless noninteractive - (add-hook 'kill-emacs-hook 'org-id-locations-save)) - -(defun org-id-hash-to-alist (hash) - "Turn an org-id hash into an alist, so that it can be written to a file." - (let (res x) - (maphash - (lambda (k v) - (if (setq x (member v res)) - (setcdr x (cons k (cdr x))) - (push (list v k) res))) - hash) - res)) - -(defun org-id-alist-to-hash (list) - "Turn an org-id location list into a hash table." - (let ((res (make-hash-table - :test 'equal - :size (apply '+ (mapcar 'length list)))) - f) - (mapc - (lambda (x) - (setq f (car x)) - (mapc (lambda (i) (puthash i f res)) (cdr x))) - list) - res)) - -(defun org-id-paste-tracker (txt &optional buffer-or-file) - "Update any IDs in TXT and assign BUFFER-OR-FILE to them." - (when org-id-track-globally - (save-match-data - (setq buffer-or-file (or buffer-or-file (current-buffer))) - (when (bufferp buffer-or-file) - (setq buffer-or-file (or (buffer-base-buffer buffer-or-file) - buffer-or-file)) - (setq buffer-or-file (buffer-file-name buffer-or-file))) - (when buffer-or-file - (let ((fname (abbreviate-file-name buffer-or-file)) - (s 0)) - (while (string-match "^[ \t]*:ID:[ \t]+\\([^ \t\n\r]+\\)" txt s) - (setq s (match-end 0)) - (org-id-add-location (match-string 1 txt) fname))))))) - -;; Finding entries with specified id - -;;;###autoload -(defun org-id-find-id-file (id) - "Query the id database for the file in which this ID is located." - (unless org-id-locations (org-id-locations-load)) - (or (and org-id-locations - (hash-table-p org-id-locations) - (gethash id org-id-locations)) - ;; ball back on current buffer - (buffer-file-name (or (buffer-base-buffer (current-buffer)) - (current-buffer))))) - -(defun org-id-find-id-in-file (id file &optional markerp) - "Return the position of the entry ID in FILE. -If that files does not exist, or if it does not contain this ID, -return nil. -The position is returned as a cons cell (file-name . position). With -optional argument MARKERP, return the position as a new marker." - (let (org-agenda-new-buffers buf pos) - (cond - ((not file) nil) - ((not (file-exists-p file)) nil) - (t (with-current-buffer (setq buf (org-get-agenda-file-buffer file)) - (setq pos (org-find-entry-with-id id)) - (when pos - (if markerp - (move-marker (make-marker) pos buf) - (cons file pos)))))))) - -;; id link type - -;; Calling the following function is hard-coded into `org-store-link', -;; so we do have to add it to `org-store-link-functions'. - -;;;###autoload -(defun org-id-store-link () - "Store a link to the current entry, using its ID." - (interactive) - (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) - (let* ((link (concat "id:" (org-id-get-create))) - (case-fold-search nil) - (desc (save-excursion - (org-back-to-heading t) - (or (and (looking-at org-complex-heading-regexp) - (if (match-end 4) - (match-string 4) - (match-string 0))) - link)))) - (org-store-link-props :link link :description desc :type "id") - link))) - -(defun org-id-open (id) - "Go to the entry with id ID." - (org-mark-ring-push) - (let ((m (org-id-find id 'marker)) - cmd) - (unless m - (error "Cannot find entry with ID \"%s\"" id)) - ;; Use a buffer-switching command in analogy to finding files - (setq cmd - (or - (cdr - (assq - (cdr (assq 'file org-link-frame-setup)) - '((find-file . switch-to-buffer) - (find-file-other-window . switch-to-buffer-other-window) - (find-file-other-frame . switch-to-buffer-other-frame)))) - 'switch-to-buffer-other-window)) - (if (not (equal (current-buffer) (marker-buffer m))) - (funcall cmd (marker-buffer m))) - (goto-char m) - (move-marker m nil) - (org-show-context))) - -(org-add-link-type "id" 'org-id-open) - -(provide 'org-id) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-id.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-indent.el b/xemacs-packages/lisp/org-8.2.3c/org-indent.el deleted file mode 100644 index 44311e38..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-indent.el +++ /dev/null @@ -1,437 +0,0 @@ -;;; org-indent.el --- Dynamic indentation for Org-mode -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;; This is an implementation of dynamic virtual indentation. It works -;; by adding text properties to a buffer to make sure lines are -;; indented according to outline structure. -;; -;; The process is synchronous, toggled at every buffer modification. -;; Though, the initialization (indentation of text already in the -;; buffer), which can take a few seconds in large buffers, happens on -;; idle time. -;; -;;; Code: - -(require 'org-macs) -(require 'org-compat) -(require 'org) - -(eval-when-compile - (require 'cl)) - -(declare-function org-inlinetask-get-task-level "org-inlinetask" ()) -(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) -(declare-function org-list-item-body-column "org-list" (item)) -(defvar org-inlinetask-show-first-star) - -(defgroup org-indent nil - "Options concerning dynamic virtual outline indentation." - :tag "Org Indent" - :group 'org) - -(defconst org-indent-max 40 - "Maximum indentation in characters.") -(defconst org-indent-max-levels 20 - "Maximum added level through virtual indentation, in characters. - -It is computed by multiplying `org-indent-indentation-per-level' -minus one by actual level of the headline minus one.") - -(defvar org-indent-strings nil - "Vector with all indentation strings. -It will be set in `org-indent-initialize'.") -(defvar org-indent-stars nil - "Vector with all indentation star strings. -It will be set in `org-indent-initialize'.") -(defvar org-indent-inlinetask-first-star (org-add-props "*" '(face org-warning)) - "First star of inline tasks, with correct face.") -(defvar org-indent-agent-timer nil - "Timer running the initialize agent.") -(defvar org-indent-agentized-buffers nil - "List of buffers watched by the initialize agent.") -(defvar org-indent-agent-resume-timer nil - "Timer to reschedule agent after switching to other idle processes.") -(defvar org-indent-agent-active-delay '(0 2 0) - "Time to run agent before switching to other idle processes. -Delay used when the buffer to initialize is current.") -(defvar org-indent-agent-passive-delay '(0 0 400000) - "Time to run agent before switching to other idle processes. -Delay used when the buffer to initialize isn't current.") -(defvar org-indent-agent-resume-delay '(0 0 100000) - "Minimal time for other idle processes before switching back to agent.") -(defvar org-indent-initial-marker nil - "Position of initialization before interrupt. -This is used locally in each buffer being initialized.") -(defvar org-hide-leading-stars-before-indent-mode nil - "Used locally.") -(defvar org-indent-modified-headline-flag nil - "Non-nil means the last deletion operated on a headline. -It is modified by `org-indent-notify-modified-headline'.") - - -(defcustom org-indent-boundary-char ?\ ; comment to protect space char - "The end of the virtual indentation strings, a single-character string. -The default is just a space, but if you wish, you can use \"|\" or so. -This can be useful on a terminal window - under a windowing system, -it may be prettier to customize the org-indent face." - :group 'org-indent - :set (lambda (var val) - (set var val) - (and org-indent-strings (org-indent-initialize))) - :type 'character) - -(defcustom org-indent-mode-turns-off-org-adapt-indentation t - "Non-nil means setting the variable `org-indent-mode' will \ -turn off indentation adaptation. -For details see the variable `org-adapt-indentation'." - :group 'org-indent - :type 'boolean) - -(defcustom org-indent-mode-turns-on-hiding-stars t - "Non-nil means setting the variable `org-indent-mode' will \ -turn on `org-hide-leading-stars'." - :group 'org-indent - :type 'boolean) - -(defcustom org-indent-indentation-per-level 2 - "Indentation per level in number of characters." - :group 'org-indent - :type 'integer) - -(defface org-indent - (org-compatible-face nil nil) - "Face for outline indentation. -The default is to make it look like whitespace. But you may find it -useful to make it ever so slightly different." - :group 'org-faces) - -(defun org-indent-initialize () - "Initialize the indentation strings." - (setq org-indent-strings (make-vector (1+ org-indent-max) nil)) - (setq org-indent-stars (make-vector (1+ org-indent-max) nil)) - (aset org-indent-strings 0 nil) - (aset org-indent-stars 0 nil) - (loop for i from 1 to org-indent-max do - (aset org-indent-strings i - (org-add-props - (concat (make-string (1- i) ?\ ) - (char-to-string org-indent-boundary-char)) - nil 'face 'org-indent))) - (loop for i from 1 to org-indent-max-levels do - (aset org-indent-stars i - (org-add-props (make-string i ?*) - nil 'face 'org-hide)))) - -(defsubst org-indent-remove-properties (beg end) - "Remove indentations between BEG and END." - (org-with-silent-modifications - (remove-text-properties beg end '(line-prefix nil wrap-prefix nil)))) - -;;;###autoload -(define-minor-mode org-indent-mode - "When active, indent text according to outline structure. - -Internally this works by adding `line-prefix' and `wrap-prefix' -properties, after each buffer modification, on the modified zone. - -The process is synchronous. Though, initial indentation of -buffer, which can take a few seconds on large buffers, is done -during idle time." - nil " Ind" nil - (cond - ((and org-indent-mode (featurep 'xemacs)) - (message "org-indent-mode does not work in XEmacs - refusing to turn it on") - (setq org-indent-mode nil)) - ((and org-indent-mode - (not (org-version-check "23.1.50" "Org Indent mode" :predicate))) - (message "org-indent-mode can crash Emacs 23.1 - refusing to turn it on!") - (ding) - (sit-for 1) - (setq org-indent-mode nil)) - (org-indent-mode - ;; mode was turned on. - (org-set-local 'indent-tabs-mode nil) - (or org-indent-strings (org-indent-initialize)) - (org-set-local 'org-indent-initial-marker (copy-marker 1)) - (when org-indent-mode-turns-off-org-adapt-indentation - (org-set-local 'org-adapt-indentation nil)) - (when org-indent-mode-turns-on-hiding-stars - (org-set-local 'org-hide-leading-stars-before-indent-mode - org-hide-leading-stars) - (org-set-local 'org-hide-leading-stars t)) - (org-add-hook 'filter-buffer-substring-functions - (lambda (fun start end delete) - (org-indent-remove-properties-from-string - (funcall fun start end delete))) - nil t) - (org-add-hook 'after-change-functions 'org-indent-refresh-maybe nil 'local) - (org-add-hook 'before-change-functions - 'org-indent-notify-modified-headline nil 'local) - (and font-lock-mode (org-restart-font-lock)) - (org-indent-remove-properties (point-min) (point-max)) - ;; Submit current buffer to initialize agent. If it's the first - ;; buffer submitted, also start the agent. Current buffer is - ;; pushed in both cases to avoid a race condition. - (if org-indent-agentized-buffers - (push (current-buffer) org-indent-agentized-buffers) - (push (current-buffer) org-indent-agentized-buffers) - (setq org-indent-agent-timer - (run-with-idle-timer 0.2 t #'org-indent-initialize-agent)))) - (t - ;; mode was turned off (or we refused to turn it on) - (kill-local-variable 'org-adapt-indentation) - (setq org-indent-agentized-buffers - (delq (current-buffer) org-indent-agentized-buffers)) - (when (markerp org-indent-initial-marker) - (set-marker org-indent-initial-marker nil)) - (when (boundp 'org-hide-leading-stars-before-indent-mode) - (org-set-local 'org-hide-leading-stars - org-hide-leading-stars-before-indent-mode)) - (remove-hook 'filter-buffer-substring-functions - (lambda (fun start end delete) - (org-indent-remove-properties-from-string - (funcall fun start end delete)))) - (remove-hook 'after-change-functions 'org-indent-refresh-maybe 'local) - (remove-hook 'before-change-functions - 'org-indent-notify-modified-headline 'local) - (org-with-wide-buffer - (org-indent-remove-properties (point-min) (point-max))) - (and font-lock-mode (org-restart-font-lock)) - (redraw-display)))) - -(defun org-indent-indent-buffer () - "Add indentation properties to the accessible part of the buffer." - (interactive) - (if (not (derived-mode-p 'org-mode)) - (error "Not in Org mode") - (message "Setting buffer indentation. It may take a few seconds...") - (org-indent-remove-properties (point-min) (point-max)) - (org-indent-add-properties (point-min) (point-max)) - (message "Indentation of buffer set."))) - -(defun org-indent-remove-properties-from-string (string) - "Remove indentation properties from STRING." - (remove-text-properties 0 (length string) - '(line-prefix nil wrap-prefix nil) string) - string) - -(defun org-indent-initialize-agent () - "Start or resume current buffer initialization. -Only buffers in `org-indent-agentized-buffers' trigger an action. -When no more buffer is being watched, the agent suppress itself." - (when org-indent-agent-resume-timer - (cancel-timer org-indent-agent-resume-timer)) - (setq org-indent-agentized-buffers - (org-remove-if-not #'buffer-live-p org-indent-agentized-buffers)) - (cond - ;; Job done: kill agent. - ((not org-indent-agentized-buffers) (cancel-timer org-indent-agent-timer)) - ;; Current buffer is agentized: start/resume initialization - ;; somewhat aggressively. - ((memq (current-buffer) org-indent-agentized-buffers) - (org-indent-initialize-buffer (current-buffer) - org-indent-agent-active-delay)) - ;; Else, start/resume initialization of the last agentized buffer, - ;; softly. - (t (org-indent-initialize-buffer (car org-indent-agentized-buffers) - org-indent-agent-passive-delay)))) - -(defun org-indent-initialize-buffer (buffer delay) - "Set virtual indentation for the buffer BUFFER, asynchronously. -Give hand to other idle processes if it takes longer than DELAY, -a time value." - (with-current-buffer buffer - (when org-indent-mode - (org-with-wide-buffer - (let ((interruptp - ;; Always nil unless interrupted. - (catch 'interrupt - (and org-indent-initial-marker - (marker-position org-indent-initial-marker) - (org-indent-add-properties org-indent-initial-marker - (point-max) - delay) - nil)))) - (move-marker org-indent-initial-marker interruptp) - ;; Job is complete: un-agentize buffer. - (unless interruptp - (setq org-indent-agentized-buffers - (delq buffer org-indent-agentized-buffers)))))))) - -(defsubst org-indent-set-line-properties (l w h) - "Set prefix properties on current line an move to next one. - -Prefix properties `line-prefix' and `wrap-prefix' in current line -are set to, respectively, length L and W. - -If H is non-nil, `line-prefix' will be starred. If H is -`inline', the first star will have `org-warning' face. - -Assume point is at beginning of line." - (let ((line (cond - ((eq 'inline h) - (let ((stars (aref org-indent-stars - (min l org-indent-max-levels)))) - (and stars - (if (org-bound-and-true-p org-inlinetask-show-first-star) - (concat org-indent-inlinetask-first-star - (substring stars 1)) - stars)))) - (h (aref org-indent-stars - (min l org-indent-max-levels))) - (t (aref org-indent-strings - (min l org-indent-max))))) - (wrap (aref org-indent-strings (min w org-indent-max)))) - ;; Add properties down to the next line to indent empty lines. - (add-text-properties (point) (min (1+ (point-at-eol)) (point-max)) - `(line-prefix ,line wrap-prefix ,wrap))) - (forward-line 1)) - -(defun org-indent-add-properties (beg end &optional delay) - "Add indentation properties between BEG and END. - -When DELAY is non-nil, it must be a time value. In that case, -the process is asynchronous and can be interrupted, either by -user request, or after DELAY. This is done by throwing the -`interrupt' tag along with the buffer position where the process -stopped." - (save-match-data - (org-with-wide-buffer - (goto-char beg) - (beginning-of-line) - ;; 1. Initialize prefix at BEG. This is done by storing two - ;; variables: INLINE-PF and PF, representing respectively - ;; length of current `line-prefix' when line is inside an - ;; inline task or not. - (let* ((case-fold-search t) - (limited-re (org-get-limited-outline-regexp)) - (added-ind-per-lvl (abs (1- org-indent-indentation-per-level))) - (pf (save-excursion - (and (ignore-errors (let ((outline-regexp limited-re)) - (org-back-to-heading t))) - (+ (* org-indent-indentation-per-level - (- (match-end 0) (match-beginning 0) 2)) 2)))) - (pf-inline (and (featurep 'org-inlinetask) - (org-inlinetask-in-task-p) - (+ (* org-indent-indentation-per-level - (1- (org-inlinetask-get-task-level))) 2))) - (time-limit (and delay (time-add (current-time) delay)))) - ;; 2. For each line, set `line-prefix' and `wrap-prefix' - ;; properties depending on the type of line (headline, - ;; inline task, item or other). - (org-with-silent-modifications - (while (and (<= (point) end) (not (eobp))) - (cond - ;; When in asynchronous mode, check if interrupt is - ;; required. - ((and delay (input-pending-p)) (throw 'interrupt (point))) - ;; In asynchronous mode, take a break of - ;; `org-indent-agent-resume-delay' every DELAY to avoid - ;; blocking any other idle timer or process output. - ((and delay (time-less-p time-limit (current-time))) - (setq org-indent-agent-resume-timer - (run-with-idle-timer - (time-add (current-idle-time) - org-indent-agent-resume-delay) - nil #'org-indent-initialize-agent)) - (throw 'interrupt (point))) - ;; Headline or inline task. - ((looking-at org-outline-regexp) - (let* ((nstars (- (match-end 0) (match-beginning 0) 1)) - (line (* added-ind-per-lvl (1- nstars))) - (wrap (+ line (1+ nstars)))) - (cond - ;; Headline: new value for PF. - ((looking-at limited-re) - (org-indent-set-line-properties line wrap t) - (setq pf wrap)) - ;; End of inline task: PF-INLINE is now nil. - ((looking-at "\\*+ end[ \t]*$") - (org-indent-set-line-properties line wrap 'inline) - (setq pf-inline nil)) - ;; Start of inline task. Determine if it contains - ;; text, or if it is only one line long. Set - ;; PF-INLINE accordingly. - (t (org-indent-set-line-properties line wrap 'inline) - (setq pf-inline (and (org-inlinetask-in-task-p) wrap)))))) - ;; List item: `wrap-prefix' is set where body starts. - ((org-at-item-p) - (let* ((line (or pf-inline pf 0)) - (wrap (+ (org-list-item-body-column (point)) line))) - (org-indent-set-line-properties line wrap nil))) - ;; Normal line: use PF-INLINE, PF or nil as prefixes. - (t (let* ((line (or pf-inline pf 0)) - (wrap (+ line (org-get-indentation)))) - (org-indent-set-line-properties line wrap nil)))))))))) - -(defun org-indent-notify-modified-headline (beg end) - "Set `org-indent-modified-headline-flag' depending on context. - -BEG and END are the positions of the beginning and end of the -range of deleted text. - -This function is meant to be called by `before-change-functions'. -Flag will be non-nil if command is going to modify or delete an -headline." - (when org-indent-mode - (setq org-indent-modified-headline-flag - (save-excursion - (goto-char beg) - (save-match-data - (or (and (org-at-heading-p) (< beg (match-end 0))) - (re-search-forward org-outline-regexp-bol end t))))))) - -(defun org-indent-refresh-maybe (beg end dummy) - "Refresh indentation properties in an adequate portion of buffer. -BEG and END are the positions of the beginning and end of the -range of inserted text. DUMMY is an unused argument. - -This function is meant to be called by `after-change-functions'." - (when org-indent-mode - (save-match-data - ;; If a headline was modified or inserted, set properties until - ;; next headline. - (if (or org-indent-modified-headline-flag - (save-excursion - (goto-char beg) - (beginning-of-line) - (re-search-forward org-outline-regexp-bol end t))) - (let ((end (save-excursion - (goto-char end) - (org-with-limited-levels (outline-next-heading)) - (point)))) - (setq org-indent-modified-headline-flag nil) - (org-indent-add-properties beg end)) - ;; Otherwise, only set properties on modified area. - (org-indent-add-properties beg end))))) - -(provide 'org-indent) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-indent.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-info.el b/xemacs-packages/lisp/org-8.2.3c/org-info.el deleted file mode 100644 index 421dde8e..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-info.el +++ /dev/null @@ -1,79 +0,0 @@ -;;; org-info.el --- Support for links to Info nodes from within Org-Mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;; This file implements links to Info nodes from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org) - -;; Declare external functions and variables - -(declare-function Info-find-node "info" (filename nodename - &optional no-going-back)) -(defvar Info-current-file) -(defvar Info-current-node) - -;; Install the link type -(org-add-link-type "info" 'org-info-open) -(add-hook 'org-store-link-functions 'org-info-store-link) - -;; Implementation -(defun org-info-store-link () - "Store a link to an Info file and node." - (when (eq major-mode 'Info-mode) - (let (link desc) - (setq link (concat "info:" - (file-name-nondirectory Info-current-file) - "#" Info-current-node)) - (setq desc (concat (file-name-nondirectory Info-current-file) - "#" Info-current-node)) - (org-store-link-props :type "info" :file Info-current-file - :node Info-current-node - :link link :desc desc) - link))) - -(defun org-info-open (path) - "Follow an Info file and node link specified by PATH." - (org-info-follow-link path)) - - -(defun org-info-follow-link (name) - "Follow an Info file and node link specified by NAME." - (if (or (string-match "\\(.*\\)[#:]:?\\(.*\\)" name) - (string-match "\\(.*\\)" name)) - (progn - (require 'info) - (if (match-string 2 name) ; If there isn't a node, choose "Top" - (Info-find-node (match-string 1 name) (match-string 2 name)) - (Info-find-node (match-string 1 name) "Top"))) - (message "Could not open: %s" name))) - -(provide 'org-info) - -;;; org-info.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-inlinetask.el b/xemacs-packages/lisp/org-8.2.3c/org-inlinetask.el deleted file mode 100644 index ca7572bc..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-inlinetask.el +++ /dev/null @@ -1,333 +0,0 @@ -;;; org-inlinetask.el --- Tasks independent of outline hierarchy - -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org - -;; 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: -;; -;; This module implements inline tasks in Org-mode. Inline tasks are -;; tasks that have all the properties of normal outline nodes, -;; including the ability to store meta data like scheduling dates, -;; TODO state, tags and properties. However, these nodes are treated -;; specially by the visibility cycling. -;; -;; Visibility cycling exempts these nodes from cycling. So whenever -;; their parent is opened, so are these tasks. This will only work -;; with `org-cycle', so if you are also using other commands to -;; show/hide entries, you will occasionally find these tasks to behave -;; like all other outline nodes, seemingly splitting the text of the -;; parent into children. -;; -;; Special fontification of inline tasks, so that they can be -;; immediately recognized. From the stars of the headline, only the -;; first and the last two will be visible, the others will be hidden -;; using the `org-hide' face. -;; -;; An inline task is identified solely by a minimum outline level, -;; given by the variable `org-inlinetask-min-level', default 15. -;; -;; If you need to have a time planning line (DEADLINE etc), drawers, -;; for example LOGBOOK of PROPERTIES, or even normal text as part of -;; the inline task, you must add an "END" headline with the same -;; number of stars. -;; -;; As an example, here are two valid inline tasks: -;; -;; **************** TODO a small task -;; -;; and -;; -;; **************** TODO another small task -;; DEADLINE: <2009-03-30 Mon> -;; :PROPERTIES: -;; :SOMETHING: or other -;; :END: -;; And here is some extra text -;; **************** END -;; -;; Also, if you want to use refiling and archiving for inline tasks, -;; The END line must be present to make things work properly. -;; -;; Note that you should not try to use inline tasks within plain list, -;; visibility cycling is known to be problematic when doing so. -;; -;; This package installs one new command: -;; -;; C-c C-x t Insert a new inline task with END line - -;;; Code: - -(require 'org) - -(defgroup org-inlinetask nil - "Options concerning inline tasks in Org mode." - :tag "Org Inline Tasks" - :group 'org-structure) - -(defcustom org-inlinetask-min-level 15 - "Minimum level a headline must have before it is treated as an inline task. -Don't set it to something higher than `29' or clocking will break since this -is the hardcoded maximum number of stars `org-clock-sum' will work with. - -It is strongly recommended that you set `org-cycle-max-level' not at all, -or to a number smaller than this one. In fact, when `org-cycle-max-level' is -not set, it will be assumed to be one less than the value of smaller than -the value of this variable." - :group 'org-inlinetask - :type '(choice - (const :tag "Off" nil) - (integer))) - -(defcustom org-inlinetask-show-first-star nil - "Non-nil means display the first star of an inline task as additional marker. -When nil, the first star is not shown." - :tag "Org Inline Tasks" - :group 'org-structure) - -(defvar org-odd-levels-only) -(defvar org-keyword-time-regexp) -(defvar org-drawer-regexp) -(defvar org-complex-heading-regexp) -(defvar org-property-end-re) - -(defcustom org-inlinetask-default-state nil - "Non-nil means make inline tasks have a TODO keyword initially. -This should be the state `org-inlinetask-insert-task' should use by -default, or nil of no state should be assigned." - :group 'org-inlinetask - :version "24.1" - :type '(choice - (const :tag "No state" nil) - (string :tag "Specific state"))) - -(defun org-inlinetask-insert-task (&optional no-state) - "Insert an inline task. -If prefix arg NO-STATE is set, ignore `org-inlinetask-default-state'." - (interactive "P") - ;; Error when inside an inline task, except if point was at its very - ;; beginning, in which case the new inline task will be inserted - ;; before this one. - (when (and (org-inlinetask-in-task-p) - (not (and (org-inlinetask-at-task-p) (bolp)))) - (error "Cannot nest inline tasks")) - (or (bolp) (newline)) - (let* ((indent (if org-odd-levels-only - (1- (* 2 org-inlinetask-min-level)) - org-inlinetask-min-level)) - (indent-string (concat (make-string indent ?*) " "))) - (insert indent-string - (if (or no-state (not org-inlinetask-default-state)) - "\n" - (concat org-inlinetask-default-state " \n")) - indent-string "END\n")) - (end-of-line -1)) -(define-key org-mode-map "\C-c\C-xt" 'org-inlinetask-insert-task) - -(defun org-inlinetask-outline-regexp () - "Return string matching an inline task heading. -The number of levels is controlled by `org-inlinetask-min-level'." - (let ((nstars (if org-odd-levels-only - (1- (* org-inlinetask-min-level 2)) - org-inlinetask-min-level))) - (format "^\\(\\*\\{%d,\\}\\)[ \t]+" nstars))) - -(defun org-inlinetask-at-task-p () - "Return true if point is at beginning of an inline task." - (save-excursion - (beginning-of-line) - (and (looking-at (concat (org-inlinetask-outline-regexp) "\\(.*\\)")) - (not (string-match "^end[ \t]*$" (downcase (match-string 2))))))) - -(defun org-inlinetask-in-task-p () - "Return true if point is inside an inline task." - (save-excursion - (beginning-of-line) - (let* ((case-fold-search t) - (stars-re (org-inlinetask-outline-regexp)) - (task-beg-re (concat stars-re "\\(?:.*\\)")) - (task-end-re (concat stars-re "END[ \t]*$"))) - (or (org-looking-at-p task-beg-re) - (and (re-search-forward "^\\*+[ \t]+" nil t) - (progn (beginning-of-line) (org-looking-at-p task-end-re))))))) - -(defun org-inlinetask-goto-beginning () - "Go to the beginning of the inline task at point." - (end-of-line) - (let ((case-fold-search t) - (inlinetask-re (org-inlinetask-outline-regexp))) - (re-search-backward inlinetask-re nil t) - (when (org-looking-at-p (concat inlinetask-re "END[ \t]*$")) - (re-search-backward inlinetask-re nil t)))) - -(defun org-inlinetask-goto-end () - "Go to the end of the inline task at point. -Return point." - (save-match-data - (beginning-of-line) - (let* ((case-fold-search t) - (inlinetask-re (org-inlinetask-outline-regexp)) - (task-end-re (concat inlinetask-re "END[ \t]*$"))) - (cond - ((looking-at task-end-re) (forward-line)) - ((looking-at inlinetask-re) - (forward-line) - (cond - ((looking-at task-end-re) (forward-line)) - ((looking-at inlinetask-re)) - ((org-inlinetask-in-task-p) - (re-search-forward inlinetask-re nil t) - (forward-line)))) - (t (re-search-forward inlinetask-re nil t) - (forward-line))) - (point)))) - -(defun org-inlinetask-get-task-level () - "Get the level of the inline task around. -This assumes the point is inside an inline task." - (save-excursion - (end-of-line) - (re-search-backward (org-inlinetask-outline-regexp) nil t) - (- (match-end 1) (match-beginning 1)))) - -(defun org-inlinetask-promote () - "Promote the inline task at point. -If the task has an end part, promote it. Also, prevents level from -going below `org-inlinetask-min-level'." - (interactive) - (if (not (org-inlinetask-in-task-p)) - (error "Not in an inline task") - (save-excursion - (let* ((lvl (org-inlinetask-get-task-level)) - (next-lvl (org-get-valid-level lvl -1)) - (diff (- next-lvl lvl)) - (down-task (concat (make-string next-lvl ?*))) - beg) - (if (< next-lvl org-inlinetask-min-level) - (error "Cannot promote an inline task at minimum level") - (org-inlinetask-goto-beginning) - (setq beg (point)) - (replace-match down-task nil t nil 1) - (org-inlinetask-goto-end) - (if (eobp) (beginning-of-line) (forward-line -1)) - (unless (= (point) beg) - (replace-match down-task nil t nil 1) - (when org-adapt-indentation - (goto-char beg) - (org-fixup-indentation diff)))))))) - -(defun org-inlinetask-demote () - "Demote the inline task at point. -If the task has an end part, also demote it." - (interactive) - (if (not (org-inlinetask-in-task-p)) - (error "Not in an inline task") - (save-excursion - (let* ((lvl (org-inlinetask-get-task-level)) - (next-lvl (org-get-valid-level lvl 1)) - (diff (- next-lvl lvl)) - (down-task (concat (make-string next-lvl ?*))) - beg) - (org-inlinetask-goto-beginning) - (setq beg (point)) - (replace-match down-task nil t nil 1) - (org-inlinetask-goto-end) - (if (eobp) (beginning-of-line) (forward-line -1)) - (unless (= (point) beg) - (replace-match down-task nil t nil 1) - (when org-adapt-indentation - (goto-char beg) - (org-fixup-indentation diff))))))) - -(defun org-inlinetask-get-current-indentation () - "Get the indentation of the last non-while line above this one." - (save-excursion - (beginning-of-line 1) - (skip-chars-backward " \t\n") - (beginning-of-line 1) - (or (org-at-item-p) - (looking-at "[ \t]*")) - (goto-char (match-end 0)) - (current-column))) - -(defvar org-indent-indentation-per-level) ; defined in org-indent.el - -(defface org-inlinetask - (org-compatible-face 'shadow '((t (:bold t)))) - "Face for inlinetask headlines." - :group 'org-faces) - -(defun org-inlinetask-fontify (limit) - "Fontify the inline tasks down to LIMIT." - (let* ((nstars (if org-odd-levels-only - (1- (* 2 (or org-inlinetask-min-level 200))) - (or org-inlinetask-min-level 200))) - (re (concat "^\\(\\*\\)\\(\\*\\{" - (format "%d" (- nstars 3)) - ",\\}\\)\\(\\*\\* .*\\)")) - ;; Virtual indentation will add the warning face on the first - ;; star. Thus, in that case, only hide it. - (start-face (if (and (org-bound-and-true-p org-indent-mode) - (> org-indent-indentation-per-level 1)) - 'org-hide - 'org-warning))) - (while (re-search-forward re limit t) - (if org-inlinetask-show-first-star - (add-text-properties (match-beginning 1) (match-end 1) - `(face ,start-face font-lock-fontified t))) - (add-text-properties (match-beginning - (if org-inlinetask-show-first-star 2 1)) - (match-end 2) - '(face org-hide font-lock-fontified t)) - (add-text-properties (match-beginning 3) (match-end 3) - '(face org-inlinetask font-lock-fontified t))))) - -(defun org-inlinetask-toggle-visibility () - "Toggle visibility of inline task at point." - (let ((end (save-excursion - (org-inlinetask-goto-end) - (if (bolp) (1- (point)) (point)))) - (start (save-excursion - (org-inlinetask-goto-beginning) - (point-at-eol)))) - (cond - ;; Nothing to show/hide. - ((= end start)) - ;; Inlinetask was folded: expand it. - ((get-char-property (1+ start) 'invisible) - (outline-flag-region start end nil) - (org-cycle-hide-drawers 'children)) - (t (outline-flag-region start end t))))) - -(defun org-inlinetask-remove-END-maybe () - "Remove an END line when present." - (when (looking-at (format "\\([ \t]*\n\\)*\\*\\{%d,\\}[ \t]+END[ \t]*$" - org-inlinetask-min-level)) - (replace-match ""))) - -(eval-after-load "org" - '(add-hook 'org-font-lock-hook 'org-inlinetask-fontify)) - -(provide 'org-inlinetask) - -;;; org-inlinetask.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-install.el b/xemacs-packages/lisp/org-8.2.3c/org-install.el deleted file mode 100644 index 58359597..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-install.el +++ /dev/null @@ -1,17 +0,0 @@ -;;; org-install.el --- backward compatibility file for obsolete configuration -;; -;;; Code: -;; -;; The file org-install is obsolete. -;; -;; It is provided here so that (require 'org-install) does not -;; trigger an error for users with obsolete Emacs configuration. -;; You can safely remove (require 'org-install) from your config." - -(provide 'org-install) - -;; Local Variables: -;; no-byte-compile: t -;; coding: utf-8 -;; End: -;;; org-install.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-irc.el b/xemacs-packages/lisp/org-8.2.3c/org-irc.el deleted file mode 100644 index afacae3e..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-irc.el +++ /dev/null @@ -1,259 +0,0 @@ -;;; org-irc.el --- Store links to IRC sessions -;; -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. -;; -;; Author: Philip Jackson <emacs@shellarchive.co.uk> -;; Keywords: erc, irc, link, org -;; -;; 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: - -;; This file implements links to an IRC session from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. -;; -;; Please customize the variable `org-modules' to select -;; extensions you would like to use, and to deselect those which you don't -;; want. -;; -;; Please note that at the moment only ERC is supported. Other clients -;; shouldn't be difficult to add though. -;; -;; Then set `org-irc-link-to-logs' to non-nil if you would like a -;; file:/ type link to be created to the current line in the logs or -;; to t if you would like to create an irc:/ style link. -;; -;; Links within an org buffer might look like this: -;; -;; [[irc:/irc.freenode.net/#emacs/bob][chat with bob in #emacs on freenode]] -;; [[irc:/irc.freenode.net/#emacs][#emacs on freenode]] -;; [[irc:/irc.freenode.net/]] -;; -;; If, when the resulting link is visited, there is no connection to a -;; requested server then one will be created. - -;;; Code: - -(require 'org) - -;; Declare the function form ERC that we use. -(declare-function erc-current-logfile "erc-log" (&optional buffer)) -(declare-function erc-prompt "erc" ()) -(declare-function erc-default-target "erc" ()) -(declare-function erc-channel-p "erc" (channel)) -(declare-function erc-buffer-filter "erc" (predicate &optional proc)) -(declare-function erc-server-buffer "erc" ()) -(declare-function erc-get-server-nickname-list "erc" ()) -(declare-function erc-cmd-JOIN "erc" (channel &optional key)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) - -(defvar org-irc-client 'erc - "The IRC client to act on.") -(defvar org-irc-link-to-logs nil - "Non-nil will store a link to the logs, nil will store an irc: style link.") - -(defvar erc-default-port) ; dynamically scoped from erc.el -(defvar erc-session-port) ; dynamically scoped form erc-backend.el -(defvar erc-session-server) ; dynamically scoped form erc-backend.el - -;; Generic functions/config (extend these for other clients) - -(add-to-list 'org-store-link-functions 'org-irc-store-link) - -(org-add-link-type "irc" 'org-irc-visit nil) - -(defun org-irc-visit (link) - "Parse LINK and dispatch to the correct function based on the client found." - (let ((link (org-irc-parse-link link))) - (cond - ((eq org-irc-client 'erc) - (org-irc-visit-erc link)) - (t - (error "ERC only known client"))))) - -(defun org-irc-parse-link (link) - "Parse an IRC LINK and return the attributes found. -Parse a LINK that looks like server:port/chan/user (port, chan -and user being optional) and return any of the port, channel or user -attributes that are found." - (let* ((parts (split-string link "/" t)) - (len (length parts))) - (when (or (< len 1) (> len 3)) - (error "Failed to parse link needed 1-3 parts, got %d" len)) - (setcar parts (split-string (car parts) ":" t)) - parts)) - -;;;###autoload -(defun org-irc-store-link () - "Dispatch to the appropriate function to store a link to an IRC session." - (cond - ((eq major-mode 'erc-mode) - (org-irc-erc-store-link)))) - -(defun org-irc-elipsify-description (string &optional after) - "Remove unnecessary white space from STRING and add ellipses if necessary. -Strip starting and ending white space from STRING and replace any -chars that the value 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)) - -;; ERC specific functions - -(defun org-irc-erc-get-line-from-log (erc-line) - "Find the best line to link to from the ERC logs given ERC-LINE as a start. -If the user is on the ERC-prompt then search backward for the -first non-blank line, otherwise return the current line. The -result is a cons of the filename and search string." - (erc-save-buffer-in-logs) - (require 'erc-log) - (with-current-buffer (find-file-noselect (erc-current-logfile)) - (goto-char (point-max)) - (list - (abbreviate-file-name buffer-file-name) - ;; can we get a '::' part? - (if (string= erc-line (erc-prompt)) - (progn - (goto-char (point-at-bol)) - (when (search-backward-regexp "^[^ ]" nil t) - (buffer-substring-no-properties (point-at-bol) - (point-at-eol)))) - (when (search-backward erc-line nil t) - (buffer-substring-no-properties (point-at-bol) - (point-at-eol))))))) - -(defun org-irc-erc-store-link () - "Store a link to the IRC log file or the session itself. -Depending on the variable `org-irc-link-to-logs' store either a -link to the log file for the current session or an irc: link to -the session itself." - (require 'erc-log) - (if org-irc-link-to-logs - (let* ((erc-line (buffer-substring-no-properties - (point-at-bol) (point-at-eol))) - (parsed-line (org-irc-erc-get-line-from-log erc-line))) - (if (erc-logging-enabled nil) - (progn - (org-store-link-props - :type "file" - :description (concat "'" (org-irc-elipsify-description - (cadr parsed-line) 20) - "' from an IRC conversation") - :link (concat "file:" (car parsed-line) "::" - (cadr parsed-line))) - t) - (error "This ERC session is not being logged"))) - (let* ((link-text (org-irc-get-erc-link)) - (link (org-irc-parse-link link-text))) - (if link-text - (progn - (org-store-link-props - :type "irc" - :link (concat "irc:/" link-text) - :description (concat "irc session '" link-text "'") - :server (car (car link)) - :port (or (string-to-number (cadr (pop link))) erc-default-port) - :nick (pop link)) - t) - (error "Failed to create ('irc:/' style) ERC link"))))) - -(defun org-irc-get-erc-link () - "Return an org compatible irc:/ link from an ERC buffer." - (let* ((session-port (if (numberp erc-session-port) - (number-to-string erc-session-port) - erc-session-port)) - (link (concat erc-session-server ":" session-port))) - (concat link "/" - (if (and (erc-default-target) - (erc-channel-p (erc-default-target)) - (car (get-text-property (point) 'erc-data))) - ;; we can get a nick - (let ((nick (car (get-text-property (point) 'erc-data)))) - (concat (erc-default-target) "/" nick)) - (erc-default-target))))) - -(defun org-irc-get-current-erc-port () - "Return the current port as a number. -Return the current port number or, if none is set, return the ERC -default." - (cond - ((stringp erc-session-port) - (string-to-number erc-session-port)) - ((numberp erc-session-port) - erc-session-port) - (t - erc-default-port))) - -(defun org-irc-visit-erc (link) - "Visit an ERC buffer based on criteria found in LINK." - (require 'erc) - (require 'erc-log) - (let* ((server (car (car link))) - (port (or (string-to-number (cadr (pop link))) erc-default-port)) - (server-buffer) - (buffer-list - (erc-buffer-filter - (lambda nil - (let ((tmp-server-buf (erc-server-buffer))) - (and tmp-server-buf - (with-current-buffer tmp-server-buf - (and - (eq (org-irc-get-current-erc-port) port) - (string= erc-session-server server) - (setq server-buffer tmp-server-buf))))))))) - (if buffer-list - (let ((chan-name (pop link))) - ;; if we got a channel name then switch to it or join it - (if chan-name - (let ((chan-buf (catch 'found - (dolist (x buffer-list) - (if (string= (buffer-name x) chan-name) - (throw 'found x)))))) - (if chan-buf - (progn - (org-pop-to-buffer-same-window chan-buf) - ;; if we got a nick, and they're in the chan, - ;; then start a chat with them - (let ((nick (pop link))) - (when nick - (if (member nick (erc-get-server-nickname-list)) - (progn - (goto-char (point-max)) - (insert (concat nick ": "))) - (error "%s not found in %s" nick chan-name))))) - (progn - (org-pop-to-buffer-same-window server-buffer) - (erc-cmd-JOIN chan-name)))) - (org-pop-to-buffer-same-window server-buffer))) - ;; no server match, make new connection - (erc-select :server server :port port)))) - -(provide 'org-irc) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-irc.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-list.el b/xemacs-packages/lisp/org-8.2.3c/org-list.el deleted file mode 100644 index 4a3d471f..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-list.el +++ /dev/null @@ -1,3290 +0,0 @@ -;;; org-list.el --- Plain lists for Org-mode -;; -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Bastien Guerry <bzg@gnu.org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;; This file contains the code dealing with plain lists in Org-mode. - -;; The core concept behind lists is their structure. A structure is -;; a snapshot of the list, in the shape of a data tree (see -;; `org-list-struct'). - -;; Once the list structure is stored, it is possible to make changes -;; on it that will be mirrored to the real list or to get information -;; about the list, using accessors and methods provided in the -;; library. Most of them require the use of one or two helper -;; functions, namely `org-list-parents-alist' and -;; `org-list-prevs-alist'. - -;; Structure is eventually applied to the buffer with -;; `org-list-write-struct'. This function repairs (bullets, -;; indentation, checkboxes) the list in the process. It should be -;; called near the end of any function working on structures. - -;; Thus, a function applying to lists should usually follow this -;; template: - -;; 1. Verify point is in a list and grab item beginning (with the same -;; function `org-in-item-p'). If the function requires the cursor -;; to be at item's bullet, `org-at-item-p' is more selective. It -;; is also possible to move point to the closest item with -;; `org-list-search-backward', or `org-list-search-forward', -;; applied to the function `org-item-beginning-re'. - -;; 2. Get list structure with `org-list-struct'. - -;; 3. Compute one, or both, helper functions, -;; (`org-list-parents-alist', `org-list-prevs-alist') depending on -;; needed accessors. - -;; 4. Proceed with the modifications, using methods and accessors. - -;; 5. Verify and apply structure to buffer, using -;; `org-list-write-struct'. - -;; 6. If changes made to the list might have modified check-boxes, -;; call `org-update-checkbox-count-maybe'. - -;; Computing a structure can be a costly operation on huge lists (a -;; few thousand lines long). Thus, code should follow the rule: -;; "collect once, use many". As a corollary, it is usually a bad idea -;; to use directly an interactive function inside the code, as those, -;; being independent entities, read the whole list structure another -;; time. - -;;; Code: - -(eval-when-compile - (require 'cl)) -(require 'org-macs) -(require 'org-compat) - -(defvar org-M-RET-may-split-line) -(defvar org-auto-align-tags) -(defvar org-blank-before-new-entry) -(defvar org-clock-string) -(defvar org-closed-string) -(defvar org-deadline-string) -(defvar org-description-max-indent) -(defvar org-drawers) -(defvar org-odd-levels-only) -(defvar org-scheduled-string) -(defvar org-ts-regexp) -(defvar org-ts-regexp-both) - -(declare-function outline-invisible-p "outline" (&optional pos)) -(declare-function outline-flag-region "outline" (from to flag)) -(declare-function outline-next-heading "outline" ()) -(declare-function outline-previous-heading "outline" ()) - -(declare-function org-at-heading-p "org" (&optional ignored)) -(declare-function org-before-first-heading-p "org" ()) -(declare-function org-back-to-heading "org" (&optional invisible-ok)) -(declare-function org-combine-plists "org" (&rest plists)) -(declare-function org-count "org" (cl-item cl-seq)) -(declare-function org-current-level "org" ()) -(declare-function org-entry-get "org" - (pom property &optional inherit literal-nil)) -(declare-function org-fix-tags-on-the-fly "org" ()) -(declare-function org-get-indentation "org" (&optional line)) -(declare-function org-icompleting-read "org" (&rest args)) -(declare-function org-in-block-p "org" (names)) -(declare-function org-in-regexp "org" (re &optional nlines visually)) -(declare-function org-level-increment "org" ()) -(declare-function org-narrow-to-subtree "org" ()) -(declare-function org-at-heading-p "org" (&optional invisible-ok)) -(declare-function org-previous-line-empty-p "org" ()) -(declare-function org-remove-if "org" (predicate seq)) -(declare-function org-reduced-level "org" (L)) -(declare-function org-show-subtree "org" ()) -(declare-function org-sort-remove-invisible "org" (S)) -(declare-function org-time-string-to-seconds "org" (s)) -(declare-function org-timer-hms-to-secs "org-timer" (hms)) -(declare-function org-timer-item "org-timer" (&optional arg)) -(declare-function org-trim "org" (s)) -(declare-function org-uniquify "org" (list)) - -(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) -(declare-function org-inlinetask-goto-end "org-inlinetask" ()) -(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) -(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) - -(declare-function org-export-string-as "ox" - (string backend &optional body-only ext-plist)) - - - - -;;; Configuration variables - -(defgroup org-plain-lists nil - "Options concerning plain lists in Org-mode." - :tag "Org Plain lists" - :group 'org-structure) - -(defcustom org-cycle-include-plain-lists t - "When t, make TAB cycle visibility on plain list items. -Cycling plain lists works only when the cursor is on a plain list -item. When the cursor is on an outline heading, plain lists are -treated as text. This is the most stable way of handling this, -which is why it is the default. - -When this is the symbol `integrate', then integrate plain list -items when cycling, as if they were children of outline headings. - -This setting can lead to strange effects when switching visibility -to `children', because the first \"child\" in a subtree decides -what children should be listed. If that first \"child\" is a -plain list item with an implied large level number, all true -children and grand children of the outline heading will be -exposed in a children' view." - :group 'org-plain-lists - :group 'org-cycle - :type '(choice - (const :tag "Never" nil) - (const :tag "With cursor in plain list (recommended)" t) - (const :tag "As children of outline headings" integrate))) - -(defcustom org-list-demote-modify-bullet nil - "Default bullet type installed when demoting an item. -This is an association list, for each bullet type, this alist will point -to the bullet that should be used when this item is demoted. -For example, - - (setq org-list-demote-modify-bullet - '((\"+\" . \"-\") (\"-\" . \"+\") (\"*\" . \"+\"))) - -will make - - + Movies - + Silence of the Lambs - + My Cousin Vinny - + Books - + The Hunt for Red October - + The Road to Omaha - -into - - + Movies - - Silence of the Lambs - - My Cousin Vinny - + Books - - The Hunt for Red October - - The Road to Omaha" - :group 'org-plain-lists - :type '(repeat - (cons - (choice :tag "If the current bullet is " - (const "-") - (const "+") - (const "*") - (const "1.") - (const "1)")) - (choice :tag "demotion will change it to" - (const "-") - (const "+") - (const "*") - (const "1.") - (const "1)"))))) - -(defcustom org-plain-list-ordered-item-terminator t - "The character that makes a line with leading number an ordered list item. -Valid values are ?. and ?\). To get both terminators, use t." - :group 'org-plain-lists - :type '(choice (const :tag "dot like in \"2.\"" ?.) - (const :tag "paren like in \"2)\"" ?\)) - (const :tag "both" t))) - -(define-obsolete-variable-alias 'org-alphabetical-lists - 'org-list-allow-alphabetical "24.4") ; Since 8.0 -(defcustom org-list-allow-alphabetical nil - "Non-nil means single character alphabetical bullets are allowed. - -Both uppercase and lowercase are handled. Lists with more than -26 items will fallback to standard numbering. Alphabetical -counters like \"[@c]\" will be recognized. - -This variable needs to be set before org.el is loaded. If you -need to make a change while Emacs is running, use the customize -interface or run the following code after updating it: - - \(when (featurep 'org-element) (load \"org-element\" t t))" - :group 'org-plain-lists - :version "24.1" - :type 'boolean - :set (lambda (var val) - (when (featurep 'org-element) (load "org-element" t t)) - (set var val))) - -(defcustom org-list-two-spaces-after-bullet-regexp nil - "A regular expression matching bullets that should have 2 spaces after them. -When nil, no bullet will have two spaces after them. When -a string, it will be used as a regular expression. When the -bullet type of a list is changed, the new bullet type will be -matched against this regexp. If it matches, there will be two -spaces instead of one after the bullet in each item of the list." - :group 'org-plain-lists - :type '(choice - (const :tag "never" nil) - (regexp))) - -(define-obsolete-variable-alias 'org-empty-line-terminates-plain-lists - 'org-list-empty-line-terminates-plain-lists "24.4") ;; Since 8.0 -(defcustom org-list-empty-line-terminates-plain-lists nil - "Non-nil means an empty line ends all plain list levels. -Otherwise, two of them will be necessary." - :group 'org-plain-lists - :type 'boolean) - -(defcustom org-list-automatic-rules '((checkbox . t) - (indent . t)) - "Non-nil means apply set of rules when acting on lists. -By default, automatic actions are taken when using - \\[org-meta-return], \\[org-metaright], \\[org-metaleft], - \\[org-shiftmetaright], \\[org-shiftmetaleft], - \\[org-ctrl-c-minus], \\[org-toggle-checkbox] or - \\[org-insert-todo-heading]. You can disable individually these - rules by setting them to nil. Valid rules are: - -checkbox when non-nil, checkbox statistics is updated each time - you either insert a new checkbox or toggle a checkbox. -indent when non-nil, indenting or outdenting list top-item - with its subtree will move the whole list and - outdenting a list whose bullet is * to column 0 will - change that bullet to \"-\"." - :group 'org-plain-lists - :version "24.1" - :type '(alist :tag "Sets of rules" - :key-type - (choice - (const :tag "Checkbox" checkbox) - (const :tag "Indent" indent)) - :value-type - (boolean :tag "Activate" :value t))) - -(defcustom org-list-use-circular-motion nil - "Non-nil means commands implying motion in lists should be cyclic. - -In that case, the item following the last item is the first one, -and the item preceding the first item is the last one. - -This affects the behavior of \\[org-move-item-up], - \\[org-move-item-down], \\[org-next-item] and - \\[org-previous-item]." - :group 'org-plain-lists - :version "24.1" - :type 'boolean) - -(defvar org-checkbox-statistics-hook nil - "Hook that is run whenever Org thinks checkbox statistics should be updated. -This hook runs even if checkbox rule in -`org-list-automatic-rules' does not apply, so it can be used to -implement alternative ways of collecting statistics -information.") - -(define-obsolete-variable-alias 'org-hierarchical-checkbox-statistics - 'org-checkbox-hierarchical-statistics "24.4") ;; Since 8.0 -(defcustom org-checkbox-hierarchical-statistics t - "Non-nil means checkbox statistics counts only the state of direct children. -When nil, all boxes below the cookie are counted. -This can be set to nil on a per-node basis using a COOKIE_DATA property -with the word \"recursive\" in the value." - :group 'org-plain-lists - :type 'boolean) - -(org-defvaralias 'org-description-max-indent - 'org-list-description-max-indent) ;; Since 8.0 -(defcustom org-list-description-max-indent 20 - "Maximum indentation for the second line of a description list. -When the indentation would be larger than this, it will become -5 characters instead." - :group 'org-plain-lists - :type 'integer) - -(defcustom org-list-indent-offset 0 - "Additional indentation for sub-items in a list. -By setting this to a small number, usually 1 or 2, one can more -clearly distinguish sub-items in a list." - :group 'org-plain-lists - :version "24.1" - :type 'integer) - -(defcustom org-list-radio-list-templates - '((latex-mode "% BEGIN RECEIVE ORGLST %n -% END RECEIVE ORGLST %n -\\begin{comment} -#+ORGLST: SEND %n org-list-to-latex -- -\\end{comment}\n") - (texinfo-mode "@c BEGIN RECEIVE ORGLST %n -@c END RECEIVE ORGLST %n -@ignore -#+ORGLST: SEND %n org-list-to-texinfo -- -@end ignore\n") - (html-mode "<!-- BEGIN RECEIVE ORGLST %n --> -<!-- END RECEIVE ORGLST %n --> -<!-- -#+ORGLST: SEND %n org-list-to-html -- --->\n")) - "Templates for radio lists in different major modes. -All occurrences of %n in a template will be replaced with the name of the -list, obtained by prompting the user." - :group 'org-plain-lists - :type '(repeat - (list (symbol :tag "Major mode") - (string :tag "Format")))) - -(defvar org-list-forbidden-blocks '("example" "verse" "src" "ascii" "beamer" - "html" "latex" "odt") - "Names of blocks where lists are not allowed. -Names must be in lower case.") - -(defvar org-list-export-context '(block inlinetask) - "Context types where lists will be interpreted during export. - -Valid types are `drawer', `inlinetask' and `block'. More -specifically, type `block' is determined by the variable -`org-list-forbidden-blocks'.") - - - -;;; Predicates and regexps - -(defconst org-list-end-re (if org-list-empty-line-terminates-plain-lists "^[ \t]*\n" - "^[ \t]*\n[ \t]*\n") - "Regex corresponding to the end of a list. -It depends on `org-list-empty-line-terminates-plain-lists'.") - -(defconst org-list-full-item-re - (concat "^[ \t]*\\(\\(?:[-+*]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)\\(?:[ \t]+\\|$\\)\\)" - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" - "\\(?:\\(\\[[ X-]\\]\\)\\(?:[ \t]+\\|$\\)\\)?" - "\\(?:\\(.*\\)[ \t]+::\\(?:[ \t]+\\|$\\)\\)?") - "Matches a list item and puts everything into groups: -group 1: bullet -group 2: counter -group 3: checkbox -group 4: description tag") - -(defun org-item-re () - "Return the correct regular expression for plain lists." - (let ((term (cond - ((eq org-plain-list-ordered-item-terminator t) "[.)]") - ((= org-plain-list-ordered-item-terminator ?\)) ")") - ((= org-plain-list-ordered-item-terminator ?.) "\\.") - (t "[.)]"))) - (alpha (if org-list-allow-alphabetical "\\|[A-Za-z]" ""))) - (concat "\\([ \t]*\\([-+]\\|\\(\\([0-9]+" alpha "\\)" term - "\\)\\)\\|[ \t]+\\*\\)\\([ \t]+\\|$\\)"))) - -(defsubst org-item-beginning-re () - "Regexp matching the beginning of a plain list item." - (concat "^" (org-item-re))) - -(defun org-list-at-regexp-after-bullet-p (regexp) - "Is point at a list item with REGEXP after bullet?" - (and (org-at-item-p) - (save-excursion - (goto-char (match-end 0)) - (let ((counter-re (concat "\\(?:\\[@\\(?:start:\\)?" - (if org-list-allow-alphabetical - "\\([0-9]+\\|[A-Za-z]\\)" - "[0-9]+") - "\\][ \t]*\\)"))) - ;; Ignore counter if any - (when (looking-at counter-re) (goto-char (match-end 0)))) - (looking-at regexp)))) - -(defun org-list-in-valid-context-p () - "Is point in a context where lists are allowed?" - (not (org-in-block-p org-list-forbidden-blocks))) - -(defun org-in-item-p () - "Return item beginning position when in a plain list, nil otherwise." - (save-excursion - (beginning-of-line) - (let* ((case-fold-search t) - (context (org-list-context)) - (lim-up (car context)) - (drawers-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) - (inlinetask-re (and (featurep 'org-inlinetask) - (org-inlinetask-outline-regexp))) - (item-re (org-item-re)) - ;; Indentation isn't meaningful when point starts at an empty - ;; line or an inline task. - (ind-ref (if (or (looking-at "^[ \t]*$") - (and inlinetask-re (looking-at inlinetask-re))) - 10000 - (org-get-indentation)))) - (cond - ((eq (nth 2 context) 'invalid) nil) - ((looking-at item-re) (point)) - (t - ;; Detect if cursor in amidst `org-list-end-re'. First, count - ;; number HL of hard lines it takes, then call `org-in-regexp' - ;; to compute its boundaries END-BOUNDS. When point is - ;; in-between, move cursor before regexp beginning. - (let ((hl 0) (i -1) end-bounds) - (when (and (progn - (while (setq i (string-match - "[\r\n]" org-list-end-re (1+ i))) - (setq hl (1+ hl))) - (setq end-bounds (org-in-regexp org-list-end-re hl))) - (>= (point) (car end-bounds)) - (< (point) (cdr end-bounds))) - (goto-char (car end-bounds)) - (forward-line -1))) - ;; Look for an item, less indented that reference line. - (catch 'exit - (while t - (let ((ind (org-get-indentation))) - (cond - ;; This is exactly what we want. - ((and (looking-at item-re) (< ind ind-ref)) - (throw 'exit (point))) - ;; At upper bound of search or looking at the end of a - ;; previous list: search is over. - ((<= (point) lim-up) (throw 'exit nil)) - ((looking-at org-list-end-re) (throw 'exit nil)) - ;; Skip blocks, drawers, inline-tasks, blank lines - ((and (looking-at "^[ \t]*#\\+end_") - (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) - ((and (looking-at "^[ \t]*:END:") - (re-search-backward drawers-re lim-up t)) - (beginning-of-line)) - ((and inlinetask-re (looking-at inlinetask-re)) - (org-inlinetask-goto-beginning) - (forward-line -1)) - ((looking-at "^[ \t]*$") (forward-line -1)) - ;; Text at column 0 cannot belong to a list: stop. - ((zerop ind) (throw 'exit nil)) - ;; Normal text less indented than reference line, take - ;; it as new reference. - ((< ind ind-ref) - (setq ind-ref ind) - (forward-line -1)) - (t (forward-line -1))))))))))) - -(defun org-at-item-p () - "Is point in a line starting a hand-formatted item?" - (save-excursion - (beginning-of-line) - (and (looking-at (org-item-re)) (org-list-in-valid-context-p)))) - -(defun org-at-item-bullet-p () - "Is point at the bullet of a plain list item?" - (and (org-at-item-p) - (not (member (char-after) '(?\ ?\t))) - (< (point) (match-end 0)))) - -(defun org-at-item-timer-p () - "Is point at a line starting a plain list item with a timer?" - (org-list-at-regexp-after-bullet-p - "\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]+::[ \t]+")) - -(defun org-at-item-description-p () - "Is point at a description list item?" - (org-list-at-regexp-after-bullet-p "\\(\\S-.+\\)[ \t]+::\\([ \t]+\\|$\\)")) - -(defun org-at-item-checkbox-p () - "Is point at a line starting a plain-list item with a checklet?" - (org-list-at-regexp-after-bullet-p "\\(\\[[- X]\\]\\)[ \t]+")) - -(defun org-at-item-counter-p () - "Is point at a line starting a plain-list item with a counter?" - (and (org-at-item-p) - (looking-at org-list-full-item-re) - (match-string 2))) - - - -;;; Structures and helper functions - -(defun org-list-context () - "Determine context, and its boundaries, around point. - -Context will be a cell like (MIN MAX CONTEXT) where MIN and MAX -are boundaries and CONTEXT is a symbol among `drawer', `block', -`invalid', `inlinetask' and nil. - -Contexts `block' and `invalid' refer to `org-list-forbidden-blocks'." - (save-match-data - (save-excursion - (org-with-limited-levels - (beginning-of-line) - (let ((case-fold-search t) (pos (point)) beg end context-type - ;; Get positions of surrounding headings. This is the - ;; default context. - (lim-up (or (save-excursion (and (ignore-errors (org-back-to-heading t)) - (point))) - (point-min))) - (lim-down (or (save-excursion (outline-next-heading)) (point-max)))) - ;; Is point inside a drawer? - (let ((end-re "^[ \t]*:END:") - ;; Can't use org-drawers-regexp as this function might - ;; be called in buffers not in Org mode. - (beg-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$"))) - (when (save-excursion - (and (not (looking-at beg-re)) - (not (looking-at end-re)) - (setq beg (and (re-search-backward beg-re lim-up t) - (1+ (point-at-eol)))) - (setq end (or (and (re-search-forward end-re lim-down t) - (1- (match-beginning 0))) - lim-down)) - (>= end pos))) - (setq lim-up beg lim-down end context-type 'drawer))) - ;; Is point strictly in a block, and of which type? - (let ((block-re "^[ \t]*#\\+\\(begin\\|end\\)_") type) - (when (save-excursion - (and (not (looking-at block-re)) - (setq beg (and (re-search-backward block-re lim-up t) - (1+ (point-at-eol)))) - (looking-at "^[ \t]*#\\+begin_\\(\\S-+\\)") - (setq type (downcase (match-string 1))) - (goto-char beg) - (setq end (or (and (re-search-forward block-re lim-down t) - (1- (point-at-bol))) - lim-down)) - (>= end pos) - (equal (downcase (match-string 1)) "end"))) - (setq lim-up beg lim-down end - context-type (if (member type org-list-forbidden-blocks) - 'invalid 'block)))) - ;; Is point in an inlinetask? - (when (and (featurep 'org-inlinetask) - (save-excursion - (let* ((beg-re (org-inlinetask-outline-regexp)) - (end-re (concat beg-re "END[ \t]*$"))) - (and (not (looking-at "^\\*+")) - (setq beg (and (re-search-backward beg-re lim-up t) - (1+ (point-at-eol)))) - (not (looking-at end-re)) - (setq end (and (re-search-forward end-re lim-down t) - (1- (match-beginning 0)))) - (> (point) pos))))) - (setq lim-up beg lim-down end context-type 'inlinetask)) - ;; Return context boundaries and type. - (list lim-up lim-down context-type)))))) - -(defun org-list-struct () - "Return structure of list at point. - -A list structure is an alist where key is point at item, and -values are: -1. indentation, -2. bullet with trailing whitespace, -3. bullet counter, if any, -4. checkbox, if any, -5. description tag, if any, -6. position at item end. - -Thus the following list, where numbers in parens are -point-at-bol: - -- [X] first item (1) - 1. sub-item 1 (18) - 5. [@5] sub-item 2 (34) - some other text belonging to first item (55) -- last item (97) - + tag :: description (109) - (131) - -will get the following structure: - -\(\(1 0 \"- \" nil \"[X]\" nil 97\) - \(18 2 \"1. \" nil nil nil 34\) - \(34 2 \"5. \" \"5\" nil nil 55\) - \(97 0 \"- \" nil nil nil 131\) - \(109 2 \"+ \" nil nil \"tag\" 131\) - -Assume point is at an item." - (save-excursion - (beginning-of-line) - (let* ((case-fold-search t) - (context (org-list-context)) - (lim-up (car context)) - (lim-down (nth 1 context)) - (text-min-ind 10000) - (item-re (org-item-re)) - (drawers-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) - (inlinetask-re (and (featurep 'org-inlinetask) - (org-inlinetask-outline-regexp))) - (beg-cell (cons (point) (org-get-indentation))) - ind itm-lst itm-lst-2 end-lst end-lst-2 struct - (assoc-at-point - (function - ;; Return association at point. - (lambda (ind) - (looking-at org-list-full-item-re) - (let ((bullet (match-string-no-properties 1))) - (list (point) - ind - bullet - (match-string-no-properties 2) ; counter - (match-string-no-properties 3) ; checkbox - ;; Description tag. - (and (save-match-data (string-match "[-+*]" bullet)) - (match-string-no-properties 4))))))) - (end-before-blank - (function - ;; Ensure list ends at the first blank line. - (lambda () - (skip-chars-backward " \r\t\n") - (min (1+ (point-at-eol)) lim-down))))) - ;; 1. Read list from starting item to its beginning, and save - ;; top item position and indentation in BEG-CELL. Also store - ;; ending position of items in END-LST. - (save-excursion - (catch 'exit - (while t - (let ((ind (org-get-indentation))) - (cond - ((<= (point) lim-up) - ;; At upward limit: if we ended at an item, store it, - ;; else dismiss useless data recorded above BEG-CELL. - ;; Jump to part 2. - (throw 'exit - (setq itm-lst - (if (not (looking-at item-re)) - (memq (assq (car beg-cell) itm-lst) itm-lst) - (setq beg-cell (cons (point) ind)) - (cons (funcall assoc-at-point ind) itm-lst))))) - ;; Looking at a list ending regexp. Dismiss useless - ;; data recorded above BEG-CELL. Jump to part 2. - ((looking-at org-list-end-re) - (throw 'exit - (setq itm-lst - (memq (assq (car beg-cell) itm-lst) itm-lst)))) - ;; Point is at an item. Add data to ITM-LST. It may - ;; also end a previous item: save it in END-LST. If - ;; ind is less or equal than BEG-CELL and there is no - ;; end at this ind or lesser, this item becomes the new - ;; BEG-CELL. - ((looking-at item-re) - (push (funcall assoc-at-point ind) itm-lst) - (push (cons ind (point)) end-lst) - (when (< ind text-min-ind) (setq beg-cell (cons (point) ind))) - (forward-line -1)) - ;; Skip blocks, drawers, inline tasks, blank lines. - ((and (looking-at "^[ \t]*#\\+end_") - (re-search-backward "^[ \t]*#\\+begin_" lim-up t))) - ((and (looking-at "^[ \t]*:END:") - (re-search-backward drawers-re lim-up t)) - (beginning-of-line)) - ((and inlinetask-re (looking-at inlinetask-re)) - (org-inlinetask-goto-beginning) - (forward-line -1)) - ((looking-at "^[ \t]*$") - (forward-line -1)) - ;; From there, point is not at an item. Interpret - ;; line's indentation: - ;; - text at column 0 is necessarily out of any list. - ;; Dismiss data recorded above BEG-CELL. Jump to - ;; part 2. - ;; - any other case may be an ending position for an - ;; hypothetical item above. Store it and proceed. - ((zerop ind) - (throw 'exit - (setq itm-lst - (memq (assq (car beg-cell) itm-lst) itm-lst)))) - (t - (when (< ind text-min-ind) (setq text-min-ind ind)) - (push (cons ind (point)) end-lst) - (forward-line -1))))))) - ;; 2. Read list from starting point to its end, that is until we - ;; get out of context, or that a non-item line is less or - ;; equally indented than BEG-CELL's cdr. Also, store ending - ;; position of items in END-LST-2. - (catch 'exit - (while t - (let ((ind (org-get-indentation))) - (cond - ((>= (point) lim-down) - ;; At downward limit: this is de facto the end of the - ;; list. Save point as an ending position, and jump to - ;; part 3. - (throw 'exit - (push (cons 0 (funcall end-before-blank)) end-lst-2))) - ;; Looking at a list ending regexp. Save point as an - ;; ending position and jump to part 3. - ((looking-at org-list-end-re) - (throw 'exit (push (cons 0 (point)) end-lst-2))) - ((looking-at item-re) - ;; Point is at an item. Add data to ITM-LST-2. It may - ;; also end a previous item, so save it in END-LST-2. - (push (funcall assoc-at-point ind) itm-lst-2) - (push (cons ind (point)) end-lst-2) - (forward-line 1)) - ;; Skip inline tasks and blank lines along the way - ((and inlinetask-re (looking-at inlinetask-re)) - (org-inlinetask-goto-end)) - ((looking-at "^[ \t]*$") - (forward-line 1)) - ;; Ind is lesser or equal than BEG-CELL's. The list is - ;; over: store point as an ending position and jump to - ;; part 3. - ((<= ind (cdr beg-cell)) - (throw 'exit - (push (cons 0 (funcall end-before-blank)) end-lst-2))) - ;; Else, if ind is lesser or equal than previous item's, - ;; this is an ending position: store it. In any case, - ;; skip block or drawer at point, and move to next line. - (t - (when (<= ind (nth 1 (car itm-lst-2))) - (push (cons ind (point)) end-lst-2)) - (cond - ((and (looking-at "^[ \t]*#\\+begin_") - (re-search-forward "^[ \t]*#\\+end_" lim-down t))) - ((and (looking-at drawers-re) - (re-search-forward "^[ \t]*:END:" lim-down t)))) - (forward-line 1)))))) - (setq struct (append itm-lst (cdr (nreverse itm-lst-2))) - end-lst (append end-lst (cdr (nreverse end-lst-2)))) - ;; 3. Associate each item to its end position. - (org-list-struct-assoc-end struct end-lst) - ;; 4. Return STRUCT - struct))) - -(defun org-list-struct-assoc-end (struct end-list) - "Associate proper ending point to items in STRUCT. - -END-LIST is a pseudo-alist where car is indentation and cdr is -ending position. - -This function modifies STRUCT." - (let ((endings end-list)) - (mapc - (lambda (elt) - (let ((pos (car elt)) - (ind (nth 1 elt))) - ;; Remove end candidates behind current item. - (while (or (<= (cdar endings) pos)) - (pop endings)) - ;; Add end position to item assoc. - (let ((old-end (nthcdr 6 elt)) - (new-end (assoc-default ind endings '<=))) - (if old-end - (setcar old-end new-end) - (setcdr elt (append (cdr elt) (list new-end))))))) - struct))) - -(defun org-list-prevs-alist (struct) - "Return alist between item and previous item in STRUCT." - (let ((item-end-alist (mapcar (lambda (e) (cons (car e) (nth 6 e))) - struct))) - (mapcar (lambda (e) - (let ((prev (car (rassq (car e) item-end-alist)))) - (cons (car e) prev))) - struct))) - -(defun org-list-parents-alist (struct) - "Return alist between item and parent in STRUCT." - (let* ((ind-to-ori (list (list (nth 1 (car struct))))) - (top-item (org-list-get-top-point struct)) - (prev-pos (list top-item))) - (cons prev-pos - (mapcar (lambda (item) - (let ((pos (car item)) - (ind (nth 1 item)) - (prev-ind (caar ind-to-ori))) - (push pos prev-pos) - (cond - ((> prev-ind ind) - ;; A sub-list is over. Find the associated - ;; origin in IND-TO-ORI. If it cannot be - ;; found (ill-formed list), set its parent as - ;; the first item less indented. If there is - ;; none, make it a top-level item. - (setq ind-to-ori - (or (member (assq ind ind-to-ori) ind-to-ori) - (catch 'exit - (mapc - (lambda (e) - (when (< (car e) ind) - (throw 'exit (member e ind-to-ori)))) - ind-to-ori) - (list (list ind))))) - (cons pos (cdar ind-to-ori))) - ;; A sub-list starts. Every item at IND will - ;; have previous item as its parent. - ((< prev-ind ind) - (let ((origin (nth 1 prev-pos))) - (push (cons ind origin) ind-to-ori) - (cons pos origin))) - ;; Another item in the same sub-list: it shares - ;; the same parent as the previous item. - (t (cons pos (cdar ind-to-ori)))))) - (cdr struct))))) - - - -;;; Accessors - -(defsubst org-list-get-nth (n key struct) - "Return the Nth value of KEY in STRUCT." - (nth n (assq key struct))) - -(defun org-list-set-nth (n key struct new) - "Set the Nth value of KEY in STRUCT to NEW. -\nThis function modifies STRUCT." - (setcar (nthcdr n (assq key struct)) new)) - -(defsubst org-list-get-ind (item struct) - "Return indentation of ITEM in STRUCT." - (org-list-get-nth 1 item struct)) - -(defun org-list-set-ind (item struct ind) - "Set indentation of ITEM in STRUCT to IND. -\nThis function modifies STRUCT." - (org-list-set-nth 1 item struct ind)) - -(defsubst org-list-get-bullet (item struct) - "Return bullet of ITEM in STRUCT." - (org-list-get-nth 2 item struct)) - -(defun org-list-set-bullet (item struct bullet) - "Set bullet of ITEM in STRUCT to BULLET. -\nThis function modifies STRUCT." - (org-list-set-nth 2 item struct bullet)) - -(defsubst org-list-get-counter (item struct) - "Return counter of ITEM in STRUCT." - (org-list-get-nth 3 item struct)) - -(defsubst org-list-get-checkbox (item struct) - "Return checkbox of ITEM in STRUCT or nil." - (org-list-get-nth 4 item struct)) - -(defun org-list-set-checkbox (item struct checkbox) - "Set checkbox of ITEM in STRUCT to CHECKBOX. -\nThis function modifies STRUCT." - (org-list-set-nth 4 item struct checkbox)) - -(defsubst org-list-get-tag (item struct) - "Return end position of ITEM in STRUCT." - (org-list-get-nth 5 item struct)) - -(defun org-list-get-item-end (item struct) - "Return end position of ITEM in STRUCT." - (org-list-get-nth 6 item struct)) - -(defun org-list-get-item-end-before-blank (item struct) - "Return point at end of ITEM in STRUCT, before any blank line. -Point returned is at end of line." - (save-excursion - (goto-char (org-list-get-item-end item struct)) - (skip-chars-backward " \r\t\n") - (point-at-eol))) - -(defun org-list-get-parent (item struct parents) - "Return parent of ITEM or nil. -STRUCT is the list structure. PARENTS is the alist of parents, -as returned by `org-list-parents-alist'." - (let ((parents (or parents (org-list-parents-alist struct)))) - (cdr (assq item parents)))) - -(defun org-list-has-child-p (item struct) - "Non-nil if ITEM has a child. - -STRUCT is the list structure. - -Value returned is the position of the first child of ITEM." - (let ((ind (org-list-get-ind item struct)) - (child-maybe (car (nth 1 (member (assq item struct) struct))))) - (when (and child-maybe - (< ind (org-list-get-ind child-maybe struct))) - child-maybe))) - -(defun org-list-get-next-item (item struct prevs) - "Return next item in same sub-list as ITEM, or nil. -STRUCT is the list structure. PREVS is the alist of previous -items, as returned by `org-list-prevs-alist'." - (car (rassq item prevs))) - -(defun org-list-get-prev-item (item struct prevs) - "Return previous item in same sub-list as ITEM, or nil. -STRUCT is the list structure. PREVS is the alist of previous -items, as returned by `org-list-prevs-alist'." - (cdr (assq item prevs))) - -(defun org-list-get-subtree (item struct) - "List all items having ITEM as a common ancestor, or nil. -STRUCT is the list structure." - (let* ((item-end (org-list-get-item-end item struct)) - (sub-struct (cdr (member (assq item struct) struct))) - subtree) - (catch 'exit - (mapc (lambda (e) - (let ((pos (car e))) - (if (< pos item-end) (push pos subtree) (throw 'exit nil)))) - sub-struct)) - (nreverse subtree))) - -(defun org-list-get-all-items (item struct prevs) - "List all items in the same sub-list as ITEM. -STRUCT is the list structure. PREVS is the alist of previous -items, as returned by `org-list-prevs-alist'." - (let ((prev-item item) - (next-item item) - before-item after-item) - (while (setq prev-item (org-list-get-prev-item prev-item struct prevs)) - (push prev-item before-item)) - (while (setq next-item (org-list-get-next-item next-item struct prevs)) - (push next-item after-item)) - (append before-item (list item) (nreverse after-item)))) - -(defun org-list-get-children (item struct parents) - "List all children of ITEM, or nil. -STRUCT is the list structure. PARENTS is the alist of parents, -as returned by `org-list-parents-alist'." - (let (all child) - (while (setq child (car (rassq item parents))) - (setq parents (cdr (member (assq child parents) parents))) - (push child all)) - (nreverse all))) - -(defun org-list-get-top-point (struct) - "Return point at beginning of list. -STRUCT is the list structure." - (caar struct)) - -(defun org-list-get-bottom-point (struct) - "Return point at bottom of list. -STRUCT is the list structure." - (apply 'max - (mapcar (lambda (e) (org-list-get-item-end (car e) struct)) struct))) - -(defun org-list-get-list-begin (item struct prevs) - "Return point at beginning of sub-list ITEM belongs. -STRUCT is the list structure. PREVS is the alist of previous -items, as returned by `org-list-prevs-alist'." - (let ((first-item item) prev-item) - (while (setq prev-item (org-list-get-prev-item first-item struct prevs)) - (setq first-item prev-item)) - first-item)) - -(defalias 'org-list-get-first-item 'org-list-get-list-begin) - -(defun org-list-get-last-item (item struct prevs) - "Return point at last item of sub-list ITEM belongs. -STRUCT is the list structure. PREVS is the alist of previous -items, as returned by `org-list-prevs-alist'." - (let ((last-item item) next-item) - (while (setq next-item (org-list-get-next-item last-item struct prevs)) - (setq last-item next-item)) - last-item)) - -(defun org-list-get-list-end (item struct prevs) - "Return point at end of sub-list ITEM belongs. -STRUCT is the list structure. PREVS is the alist of previous -items, as returned by `org-list-prevs-alist'." - (org-list-get-item-end (org-list-get-last-item item struct prevs) struct)) - -(defun org-list-get-list-type (item struct prevs) - "Return the type of the list containing ITEM, as a symbol. - -STRUCT is the list structure. PREVS is the alist of previous -items, as returned by `org-list-prevs-alist'. - -Possible types are `descriptive', `ordered' and `unordered'. The -type is determined by the first item of the list." - (let ((first (org-list-get-list-begin item struct prevs))) - (cond - ((string-match "[[:alnum:]]" (org-list-get-bullet first struct)) 'ordered) - ((org-list-get-tag first struct) 'descriptive) - (t 'unordered)))) - -(defun org-list-get-item-number (item struct prevs parents) - "Return ITEM's sequence number. - -STRUCT is the list structure. PREVS is the alist of previous -items, as returned by `org-list-prevs-alist'. PARENTS is the -alist of ancestors, as returned by `org-list-parents-alist'. - -Return value is a list of integers. Counters have an impact on -that value." - (let ((get-relative-number - (function - (lambda (item struct prevs) - ;; Return relative sequence number of ITEM in the sub-list - ;; it belongs. STRUCT is the list structure. PREVS is - ;; the alist of previous items. - (let ((seq 0) (pos item) counter) - (while (and (not (setq counter (org-list-get-counter pos struct))) - (setq pos (org-list-get-prev-item pos struct prevs))) - (incf seq)) - (if (not counter) (1+ seq) - (cond - ((string-match "[A-Za-z]" counter) - (+ (- (string-to-char (upcase (match-string 0 counter))) 64) - seq)) - ((string-match "[0-9]+" counter) - (+ (string-to-number (match-string 0 counter)) seq)) - (t (1+ seq))))))))) - ;; Cons each parent relative number into return value (OUT). - (let ((out (list (funcall get-relative-number item struct prevs))) - (parent item)) - (while (setq parent (org-list-get-parent parent struct parents)) - (push (funcall get-relative-number parent struct prevs) out)) - ;; Return value. - out))) - - - -;;; Searching - -(defun org-list-search-generic (search re bound noerr) - "Search a string in valid contexts for lists. -Arguments SEARCH, RE, BOUND and NOERR are similar to those used -in `re-search-forward'." - (catch 'exit - (let ((origin (point))) - (while t - ;; 1. No match: return to origin or bound, depending on NOERR. - (unless (funcall search re bound noerr) - (throw 'exit (and (goto-char (if (memq noerr '(t nil)) origin bound)) - nil))) - ;; 2. Match in valid context: return point. Else, continue - ;; searching. - (when (org-list-in-valid-context-p) (throw 'exit (point))))))) - -(defun org-list-search-backward (regexp &optional bound noerror) - "Like `re-search-backward' but stop only where lists are recognized. -Arguments REGEXP, BOUND and NOERROR are similar to those used in -`re-search-backward'." - (org-list-search-generic #'re-search-backward - regexp (or bound (point-min)) noerror)) - -(defun org-list-search-forward (regexp &optional bound noerror) - "Like `re-search-forward' but stop only where lists are recognized. -Arguments REGEXP, BOUND and NOERROR are similar to those used in -`re-search-forward'." - (org-list-search-generic #'re-search-forward - regexp (or bound (point-max)) noerror)) - - - -;;; Methods on structures - -(defsubst org-list-bullet-string (bullet) - "Return BULLET with the correct number of whitespaces. -It determines the number of whitespaces to append by looking at -`org-list-two-spaces-after-bullet-regexp'." - (save-match-data - (let ((spaces (if (and org-list-two-spaces-after-bullet-regexp - (string-match - org-list-two-spaces-after-bullet-regexp bullet)) - " " - " "))) - (if (string-match "\\S-+\\([ \t]*\\)" bullet) - (replace-match spaces nil nil bullet 1) - bullet)))) - -(defun org-list-swap-items (beg-A beg-B struct) - "Swap item starting at BEG-A with item starting at BEG-B in STRUCT. - -Blank lines at the end of items are left in place. Item -visibility is preserved. Return the new structure after the -changes. - -Assume BEG-A is lesser than BEG-B and that BEG-A and BEG-B belong -to the same sub-list. - -This function modifies STRUCT." - (save-excursion - (let* ((end-A-no-blank (org-list-get-item-end-before-blank beg-A struct)) - (end-B-no-blank (org-list-get-item-end-before-blank beg-B struct)) - (end-A (org-list-get-item-end beg-A struct)) - (end-B (org-list-get-item-end beg-B struct)) - (size-A (- end-A-no-blank beg-A)) - (size-B (- end-B-no-blank beg-B)) - (body-A (buffer-substring beg-A end-A-no-blank)) - (body-B (buffer-substring beg-B end-B-no-blank)) - (between-A-no-blank-and-B (buffer-substring end-A-no-blank beg-B)) - (sub-A (cons beg-A (org-list-get-subtree beg-A struct))) - (sub-B (cons beg-B (org-list-get-subtree beg-B struct))) - ;; Store overlays responsible for visibility status. We - ;; also need to store their boundaries as they will be - ;; removed from buffer. - (overlays (cons - (mapcar (lambda (ov) - (list ov (overlay-start ov) (overlay-end ov))) - (overlays-in beg-A end-A)) - (mapcar (lambda (ov) - (list ov (overlay-start ov) (overlay-end ov))) - (overlays-in beg-B end-B))))) - ;; 1. Move effectively items in buffer. - (goto-char beg-A) - (delete-region beg-A end-B-no-blank) - (insert (concat body-B between-A-no-blank-and-B body-A)) - ;; 2. Now modify struct. No need to re-read the list, the - ;; transformation is just a shift of positions. Some special - ;; attention is required for items ending at END-A and END-B - ;; as empty spaces are not moved there. In others words, - ;; item BEG-A will end with whitespaces that were at the end - ;; of BEG-B and the same applies to BEG-B. - (mapc (lambda (e) - (let ((pos (car e))) - (cond - ((< pos beg-A)) - ((memq pos sub-A) - (let ((end-e (nth 6 e))) - (setcar e (+ pos (- end-B-no-blank end-A-no-blank))) - (setcar (nthcdr 6 e) - (+ end-e (- end-B-no-blank end-A-no-blank))) - (when (= end-e end-A) (setcar (nthcdr 6 e) end-B)))) - ((memq pos sub-B) - (let ((end-e (nth 6 e))) - (setcar e (- (+ pos beg-A) beg-B)) - (setcar (nthcdr 6 e) (+ end-e (- beg-A beg-B))) - (when (= end-e end-B) - (setcar (nthcdr 6 e) - (+ beg-A size-B (- end-A end-A-no-blank)))))) - ((< pos beg-B) - (let ((end-e (nth 6 e))) - (setcar e (+ pos (- size-B size-A))) - (setcar (nthcdr 6 e) (+ end-e (- size-B size-A)))))))) - struct) - (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2))))) - ;; Restore visibility status, by moving overlays to their new - ;; position. - (mapc (lambda (ov) - (move-overlay - (car ov) - (+ (nth 1 ov) (- (+ beg-B (- size-B size-A)) beg-A)) - (+ (nth 2 ov) (- (+ beg-B (- size-B size-A)) beg-A)))) - (car overlays)) - (mapc (lambda (ov) - (move-overlay (car ov) - (+ (nth 1 ov) (- beg-A beg-B)) - (+ (nth 2 ov) (- beg-A beg-B)))) - (cdr overlays)) - ;; Return structure. - struct))) - -(defun org-list-separating-blank-lines-number (pos struct prevs) - "Return number of blank lines that should separate items in list. - -POS is the position of point where `org-list-insert-item' was called. - -STRUCT is the list structure. PREVS is the alist of previous -items, as returned by `org-list-prevs-alist'. - -Assume point is at item's beginning. If the item is alone, apply -some heuristics to guess the result." - (save-excursion - (let ((item (point)) - (insert-blank-p - (cdr (assq 'plain-list-item org-blank-before-new-entry))) - usr-blank - (count-blanks - (function - (lambda () - ;; Count blank lines above beginning of line. - (save-excursion - (count-lines (goto-char (point-at-bol)) - (progn (skip-chars-backward " \r\t\n") - (forward-line) - (point)))))))) - (cond - ;; Trivial cases where there should be none. - ((or org-list-empty-line-terminates-plain-lists (not insert-blank-p)) 0) - ;; When `org-blank-before-new-entry' says so, it is 1. - ((eq insert-blank-p t) 1) - ;; `plain-list-item' is 'auto. Count blank lines separating - ;; neighbours items in list. - (t (let ((next-p (org-list-get-next-item item struct prevs))) - (cond - ;; Is there a next item? - (next-p (goto-char next-p) - (funcall count-blanks)) - ;; Is there a previous item? - ((org-list-get-prev-item item struct prevs) - (funcall count-blanks)) - ;; User inserted blank lines, trust him. - ((and (> pos (org-list-get-item-end-before-blank item struct)) - (> (save-excursion (goto-char pos) - (setq usr-blank (funcall count-blanks))) - 0)) - usr-blank) - ;; Are there blank lines inside the list so far? - ((save-excursion - (goto-char (org-list-get-top-point struct)) - ;; Do not use `org-list-search-forward' so blank lines - ;; in blocks can be counted in. - (re-search-forward - "^[ \t]*$" (org-list-get-item-end-before-blank item struct) t)) - 1) - ;; Default choice: no blank line. - (t 0)))))))) - -(defun org-list-insert-item (pos struct prevs &optional checkbox after-bullet) - "Insert a new list item at POS and return the new structure. -If POS is before first character after bullet of the item, the -new item will be created before the current one. - -STRUCT is the list structure. PREVS is the the alist of previous -items, as returned by `org-list-prevs-alist'. - -Insert a checkbox if CHECKBOX is non-nil, and string AFTER-BULLET -after the bullet. Cursor will be after this text once the -function ends. - -This function modifies STRUCT." - (let ((case-fold-search t)) - ;; 1. Get information about list: position of point with regards - ;; to item start (BEFOREP), blank lines number separating items - ;; (BLANK-NB), if we're allowed to (SPLIT-LINE-P). - (let* ((item (progn (goto-char pos) (goto-char (org-list-get-item-begin)))) - (item-end (org-list-get-item-end item struct)) - (item-end-no-blank (org-list-get-item-end-before-blank item struct)) - (beforep - (progn - (looking-at org-list-full-item-re) - ;; Do not count tag in a non-descriptive list. - (<= pos (if (and (match-beginning 4) - (save-match-data - (string-match "[.)]" (match-string 1)))) - (match-beginning 4) - (match-end 0))))) - (split-line-p (org-get-alist-option org-M-RET-may-split-line 'item)) - (blank-nb (org-list-separating-blank-lines-number - pos struct prevs)) - ;; 2. Build the new item to be created. Concatenate same - ;; bullet as item, checkbox, text AFTER-BULLET if - ;; provided, and text cut from point to end of item - ;; (TEXT-CUT) to form item's BODY. TEXT-CUT depends on - ;; BEFOREP and SPLIT-LINE-P. The difference of size - ;; between what was cut and what was inserted in buffer - ;; is stored in SIZE-OFFSET. - (ind (org-list-get-ind item struct)) - (ind-size (if indent-tabs-mode - (+ (/ ind tab-width) (mod ind tab-width)) - ind)) - (bullet (org-list-bullet-string (org-list-get-bullet item struct))) - (box (when checkbox "[ ]")) - (text-cut - (and (not beforep) split-line-p - (progn - (goto-char pos) - ;; If POS is greater than ITEM-END, then point is - ;; in some white lines after the end of the list. - ;; Those must be removed, or they will be left, - ;; stacking up after the list. - (when (< item-end pos) - (delete-region (1- item-end) (point-at-eol))) - (skip-chars-backward " \r\t\n") - (setq pos (point)) - (delete-and-extract-region pos item-end-no-blank)))) - (body (concat bullet (when box (concat box " ")) after-bullet - (and text-cut - (if (string-match "\\`[ \t]+" text-cut) - (replace-match "" t t text-cut) - text-cut)))) - (item-sep (make-string (1+ blank-nb) ?\n)) - (item-size (+ ind-size (length body) (length item-sep))) - (size-offset (- item-size (length text-cut)))) - ;; 4. Insert effectively item into buffer. - (goto-char item) - (org-indent-to-column ind) - (insert body item-sep) - ;; 5. Add new item to STRUCT. - (mapc (lambda (e) - (let ((p (car e)) (end (nth 6 e))) - (cond - ;; Before inserted item, positions don't change but - ;; an item ending after insertion has its end shifted - ;; by SIZE-OFFSET. - ((< p item) - (when (> end item) (setcar (nthcdr 6 e) (+ end size-offset)))) - ;; Trivial cases where current item isn't split in - ;; two. Just shift every item after new one by - ;; ITEM-SIZE. - ((or beforep (not split-line-p)) - (setcar e (+ p item-size)) - (setcar (nthcdr 6 e) (+ end item-size))) - ;; Item is split in two: elements before POS are just - ;; shifted by ITEM-SIZE. In the case item would end - ;; after split POS, ending is only shifted by - ;; SIZE-OFFSET. - ((< p pos) - (setcar e (+ p item-size)) - (if (< end pos) - (setcar (nthcdr 6 e) (+ end item-size)) - (setcar (nthcdr 6 e) (+ end size-offset)))) - ;; Elements after POS are moved into new item. - ;; Length of ITEM-SEP has to be removed as ITEM-SEP - ;; doesn't appear in buffer yet. - ((< p item-end) - (setcar e (+ p size-offset (- item pos (length item-sep)))) - (if (= end item-end) - (setcar (nthcdr 6 e) (+ item item-size)) - (setcar (nthcdr 6 e) - (+ end size-offset - (- item pos (length item-sep)))))) - ;; Elements at ITEM-END or after are only shifted by - ;; SIZE-OFFSET. - (t (setcar e (+ p size-offset)) - (setcar (nthcdr 6 e) (+ end size-offset)))))) - struct) - (push (list item ind bullet nil box nil (+ item item-size)) struct) - (setq struct (sort struct (lambda (e1 e2) (< (car e1) (car e2))))) - ;; 6. If not BEFOREP, new item must appear after ITEM, so - ;; exchange ITEM with the next item in list. Position cursor - ;; after bullet, counter, checkbox, and label. - (if beforep - (goto-char item) - (setq struct (org-list-swap-items item (+ item item-size) struct)) - (goto-char (org-list-get-next-item - item struct (org-list-prevs-alist struct)))) - struct))) - -(defun org-list-delete-item (item struct) - "Remove ITEM from the list and return the new structure. - -STRUCT is the list structure." - (let* ((end (org-list-get-item-end item struct)) - (beg (if (= (org-list-get-bottom-point struct) end) - ;; If ITEM ends with the list, delete blank lines - ;; before it. - (save-excursion - (goto-char item) - (skip-chars-backward " \r\t\n") - (min (1+ (point-at-eol)) (point-max))) - item))) - ;; Remove item from buffer. - (delete-region beg end) - ;; Remove item from structure and shift others items accordingly. - ;; Don't forget to shift also ending position when appropriate. - (let ((size (- end beg))) - (delq nil (mapcar (lambda (e) - (let ((pos (car e))) - (cond - ((< pos item) - (let ((end-e (nth 6 e))) - (cond - ((< end-e item) e) - ((= end-e item) - (append (butlast e) (list beg))) - (t - (append (butlast e) (list (- end-e size))))))) - ((< pos end) nil) - (t - (cons (- pos size) - (append (butlast (cdr e)) - (list (- (nth 6 e) size)))))))) - struct))))) - -(defun org-list-send-item (item dest struct) - "Send ITEM to destination DEST. - -STRUCT is the list structure. - -DEST can have various values. - -If DEST is a buffer position, the function will assume it points -to another item in the same list as ITEM, and will move the -latter just before the former. - -If DEST is `begin' (respectively `end'), ITEM will be moved at -the beginning (respectively end) of the list it belongs to. - -If DEST is a string like \"N\", where N is an integer, ITEM will -be moved at the Nth position in the list. - -If DEST is `kill', ITEM will be deleted and its body will be -added to the kill-ring. - -If DEST is `delete', ITEM will be deleted. - -Visibility of item is preserved. - -This function returns, destructively, the new list structure." - (let* ((prevs (org-list-prevs-alist struct)) - (item-end (org-list-get-item-end item struct)) - ;; Grab full item body minus its bullet. - (body (org-trim - (buffer-substring - (save-excursion - (goto-char item) - (looking-at - (concat "[ \t]*" - (regexp-quote (org-list-get-bullet item struct)))) - (match-end 0)) - item-end))) - ;; Change DEST into a buffer position. A trick is needed - ;; when ITEM is meant to be sent at the end of the list. - ;; Indeed, by setting locally `org-M-RET-may-split-line' to - ;; nil and insertion point (INS-POINT) to the first line's - ;; end of the last item, we ensure the new item will be - ;; inserted after the last item, and not after any of its - ;; hypothetical sub-items. - (ins-point (cond - ((or (eq dest 'kill) (eq dest 'delete))) - ((eq dest 'begin) - (setq dest (org-list-get-list-begin item struct prevs))) - ((eq dest 'end) - (setq dest (org-list-get-list-end item struct prevs)) - (save-excursion - (goto-char (org-list-get-last-item item struct prevs)) - (point-at-eol))) - ((string-match "\\`[0-9]+\\'" dest) - (let* ((all (org-list-get-all-items item struct prevs)) - (len (length all)) - (index (mod (string-to-number dest) len))) - (if (not (zerop index)) - (setq dest (nth (1- index) all)) - ;; Send ITEM at the end of the list. - (setq dest (org-list-get-list-end item struct prevs)) - (save-excursion - (goto-char - (org-list-get-last-item item struct prevs)) - (point-at-eol))))) - (t dest))) - (org-M-RET-may-split-line nil) - ;; Store visibility. - (visibility (overlays-in item item-end))) - (cond - ((eq dest 'delete) (org-list-delete-item item struct)) - ((eq dest 'kill) - (kill-new body) - (org-list-delete-item item struct)) - ((and (integerp dest) (/= item ins-point)) - (setq item (copy-marker item)) - (setq struct (org-list-insert-item ins-point struct prevs nil body)) - ;; 1. Structure returned by `org-list-insert-item' may not be - ;; accurate, as it cannot see sub-items included in BODY. - ;; Thus, first compute the real structure so far. - (let ((moved-items - (cons (marker-position item) - (org-list-get-subtree (marker-position item) struct))) - (new-end (org-list-get-item-end (point) struct)) - (old-end (org-list-get-item-end (marker-position item) struct)) - (new-item (point)) - (shift (- (point) item))) - ;; 1.1. Remove the item just created in structure. - (setq struct (delete (assq new-item struct) struct)) - ;; 1.2. Copy ITEM and any of its sub-items at NEW-ITEM. - (setq struct (sort - (append - struct - (mapcar (lambda (e) - (let* ((cell (assq e struct)) - (pos (car cell)) - (end (nth 6 cell))) - (cons (+ pos shift) - (append (butlast (cdr cell)) - (list (if (= end old-end) - new-end - (+ end shift))))))) - moved-items)) - (lambda (e1 e2) (< (car e1) (car e2)))))) - ;; 2. Restore visibility. - (mapc (lambda (ov) - (move-overlay ov - (+ (overlay-start ov) (- (point) item)) - (+ (overlay-end ov) (- (point) item)))) - visibility) - ;; 3. Eventually delete extra copy of the item and clean marker. - (prog1 (org-list-delete-item (marker-position item) struct) - (move-marker item nil))) - (t struct)))) - -(defun org-list-struct-outdent (start end struct parents) - "Outdent items between positions START and END. - -STRUCT is the list structure. PARENTS is the alist of items' -parents, as returned by `org-list-parents-alist'. - -START is included, END excluded." - (let* (acc - (out (lambda (cell) - (let* ((item (car cell)) - (parent (cdr cell))) - (cond - ;; Item not yet in zone: keep association. - ((< item start) cell) - ;; Item out of zone: follow associations in ACC. - ((>= item end) - (let ((convert (and parent (assq parent acc)))) - (if convert (cons item (cdr convert)) cell))) - ;; Item has no parent: error - ((not parent) - (error "Cannot outdent top-level items")) - ;; Parent is outdented: keep association. - ((>= parent start) - (push (cons parent item) acc) cell) - (t - ;; Parent isn't outdented: reparent to grand-parent. - (let ((grand-parent (org-list-get-parent - parent struct parents))) - (push (cons parent item) acc) - (cons item grand-parent)))))))) - (mapcar out parents))) - -(defun org-list-struct-indent (start end struct parents prevs) - "Indent items between positions START and END. - -STRUCT is the list structure. PARENTS is the alist of parents -and PREVS is the alist of previous items, returned by, -respectively, `org-list-parents-alist' and -`org-list-prevs-alist'. - -START is included and END excluded. - -STRUCT may be modified if `org-list-demote-modify-bullet' matches -bullets between START and END." - (let* (acc - (set-assoc (lambda (cell) (push cell acc) cell)) - (change-bullet-maybe - (function - (lambda (item) - (let ((new-bul-p - (cdr (assoc - ;; Normalize ordered bullets. - (let ((bul (org-trim - (org-list-get-bullet item struct)))) - (cond ((string-match "[A-Z]\\." bul) "A.") - ((string-match "[A-Z])" bul) "A)") - ((string-match "[a-z]\\." bul) "a.") - ((string-match "[a-z])" bul) "a)") - ((string-match "[0-9]\\." bul) "1.") - ((string-match "[0-9])" bul) "1)") - (t bul))) - org-list-demote-modify-bullet)))) - (when new-bul-p (org-list-set-bullet item struct new-bul-p)))))) - (ind - (lambda (cell) - (let* ((item (car cell)) - (parent (cdr cell))) - (cond - ;; Item not yet in zone: keep association. - ((< item start) cell) - ((>= item end) - ;; Item out of zone: follow associations in ACC. - (let ((convert (assq parent acc))) - (if convert (cons item (cdr convert)) cell))) - (t - ;; Item is in zone... - (let ((prev (org-list-get-prev-item item struct prevs))) - ;; Check if bullet needs to be changed. - (funcall change-bullet-maybe item) - (cond - ;; First item indented but not parent: error - ((and (not prev) (< parent start)) - (error "Cannot indent the first item of a list")) - ;; First item and parent indented: keep same - ;; parent. - ((not prev) (funcall set-assoc cell)) - ;; Previous item not indented: reparent to it. - ((< prev start) (funcall set-assoc (cons item prev))) - ;; Previous item indented: reparent like it. - (t - (funcall set-assoc - (cons item (cdr (assq prev acc))))))))))))) - (mapcar ind parents))) - - - -;;; Repairing structures - -(defun org-list-use-alpha-bul-p (first struct prevs) - "Non-nil if list starting at FIRST can have alphabetical bullets. - -STRUCT is list structure. PREVS is the alist of previous items, -as returned by `org-list-prevs-alist'." - (and org-list-allow-alphabetical - (catch 'exit - (let ((item first) (ascii 64) (case-fold-search nil)) - ;; Pretend that bullets are uppercase and check if alphabet - ;; is sufficient, taking counters into account. - (while item - (let ((bul (org-list-get-bullet item struct)) - (count (org-list-get-counter item struct))) - ;; Virtually determine current bullet - (if (and count (string-match "[a-zA-Z]" count)) - ;; Counters are not case-sensitive. - (setq ascii (string-to-char (upcase count))) - (setq ascii (1+ ascii))) - ;; Test if bullet would be over z or Z. - (if (> ascii 90) - (throw 'exit nil) - (setq item (org-list-get-next-item item struct prevs))))) - ;; All items checked. All good. - t)))) - -(defun org-list-inc-bullet-maybe (bullet) - "Increment BULLET if applicable." - (let ((case-fold-search nil)) - (cond - ;; Num bullet: increment it. - ((string-match "[0-9]+" bullet) - (replace-match - (number-to-string (1+ (string-to-number (match-string 0 bullet)))) - nil nil bullet)) - ;; Alpha bullet: increment it. - ((string-match "[A-Za-z]" bullet) - (replace-match - (char-to-string (1+ (string-to-char (match-string 0 bullet)))) - nil nil bullet)) - ;; Unordered bullet: leave it. - (t bullet)))) - -(defun org-list-struct-fix-bul (struct prevs) - "Verify and correct bullets in STRUCT. -PREVS is the alist of previous items, as returned by -`org-list-prevs-alist'. - -This function modifies STRUCT." - (let ((case-fold-search nil) - (fix-bul - (function - ;; Set bullet of ITEM in STRUCT, depending on the type of - ;; first item of the list, the previous bullet and counter - ;; if any. - (lambda (item) - (let* ((prev (org-list-get-prev-item item struct prevs)) - (prev-bul (and prev (org-list-get-bullet prev struct))) - (counter (org-list-get-counter item struct)) - (bullet (org-list-get-bullet item struct)) - (alphap (and (not prev) - (org-list-use-alpha-bul-p item struct prevs)))) - (org-list-set-bullet - item struct - (org-list-bullet-string - (cond - ;; Alpha counter in alpha list: use counter. - ((and prev counter - (string-match "[a-zA-Z]" counter) - (string-match "[a-zA-Z]" prev-bul)) - ;; Use cond to be sure `string-match' is used in - ;; both cases. - (let ((real-count - (cond - ((string-match "[a-z]" prev-bul) (downcase counter)) - ((string-match "[A-Z]" prev-bul) (upcase counter))))) - (replace-match real-count nil nil prev-bul))) - ;; Num counter in a num list: use counter. - ((and prev counter - (string-match "[0-9]+" counter) - (string-match "[0-9]+" prev-bul)) - (replace-match counter nil nil prev-bul)) - ;; No counter: increase, if needed, previous bullet. - (prev - (org-list-inc-bullet-maybe (org-list-get-bullet prev struct))) - ;; Alpha counter at first item: use counter. - ((and counter (org-list-use-alpha-bul-p item struct prevs) - (string-match "[A-Za-z]" counter) - (string-match "[A-Za-z]" bullet)) - (let ((real-count - (cond - ((string-match "[a-z]" bullet) (downcase counter)) - ((string-match "[A-Z]" bullet) (upcase counter))))) - (replace-match real-count nil nil bullet))) - ;; Num counter at first item: use counter. - ((and counter - (string-match "[0-9]+" counter) - (string-match "[0-9]+" bullet)) - (replace-match counter nil nil bullet)) - ;; First bullet is alpha uppercase: use "A". - ((and alphap (string-match "[A-Z]" bullet)) - (replace-match "A" nil nil bullet)) - ;; First bullet is alpha lowercase: use "a". - ((and alphap (string-match "[a-z]" bullet)) - (replace-match "a" nil nil bullet)) - ;; First bullet is num: use "1". - ((string-match "\\([0-9]+\\|[A-Za-z]\\)" bullet) - (replace-match "1" nil nil bullet)) - ;; Not an ordered list: keep bullet. - (t bullet))))))))) - (mapc fix-bul (mapcar 'car struct)))) - -(defun org-list-struct-fix-ind (struct parents &optional bullet-size) - "Verify and correct indentation in STRUCT. - -PARENTS is the alist of parents, as returned by -`org-list-parents-alist'. - -If numeric optional argument BULLET-SIZE is set, assume all -bullets in list have this length to determine new indentation. - -This function modifies STRUCT." - (let* ((ancestor (org-list-get-top-point struct)) - (top-ind (org-list-get-ind ancestor struct)) - (new-ind - (lambda (item) - (let ((parent (org-list-get-parent item struct parents))) - (if parent - ;; Indent like parent + length of parent's bullet + - ;; sub-list offset. - (org-list-set-ind - item struct (+ (or bullet-size - (length - (org-list-get-bullet parent struct))) - (org-list-get-ind parent struct) - org-list-indent-offset)) - ;; If no parent, indent like top-point. - (org-list-set-ind item struct top-ind)))))) - (mapc new-ind (mapcar 'car (cdr struct))))) - -(defun org-list-struct-fix-box (struct parents prevs &optional ordered) - "Verify and correct checkboxes in STRUCT. - -PARENTS is the alist of parents and PREVS is the alist of -previous items, as returned by, respectively, -`org-list-parents-alist' and `org-list-prevs-alist'. - -If ORDERED is non-nil, a checkbox can only be checked when every -checkbox before it is checked too. If there was an attempt to -break this rule, the function will return the blocking item. In -all others cases, the return value will be nil. - -This function modifies STRUCT." - (let ((all-items (mapcar 'car struct)) - (set-parent-box - (function - (lambda (item) - (let* ((box-list - (mapcar (lambda (child) - (org-list-get-checkbox child struct)) - (org-list-get-children item struct parents)))) - (org-list-set-checkbox - item struct - (cond - ((and (member "[ ]" box-list) (member "[X]" box-list)) "[-]") - ((member "[-]" box-list) "[-]") - ((member "[X]" box-list) "[X]") - ((member "[ ]" box-list) "[ ]") - ;; Parent has no boxed child: leave box as-is. - (t (org-list-get-checkbox item struct)))))))) - parent-list) - ;; 1. List all parents with a checkbox. - (mapc - (lambda (e) - (let* ((parent (org-list-get-parent e struct parents)) - (parent-box-p (org-list-get-checkbox parent struct))) - (when (and parent-box-p (not (memq parent parent-list))) - (push parent parent-list)))) - all-items) - ;; 2. Sort those parents by decreasing indentation. - (setq parent-list (sort parent-list - (lambda (e1 e2) - (> (org-list-get-ind e1 struct) - (org-list-get-ind e2 struct))))) - ;; 3. For each parent, get all children's checkboxes to determine - ;; and set its checkbox accordingly. - (mapc set-parent-box parent-list) - ;; 4. If ORDERED is set, see if we need to uncheck some boxes. - (when ordered - (let* ((box-list - (mapcar (lambda (e) (org-list-get-checkbox e struct)) all-items)) - (after-unchecked (member "[ ]" box-list))) - ;; There are boxes checked after an unchecked one: fix that. - (when (member "[X]" after-unchecked) - (let ((index (- (length struct) (length after-unchecked)))) - (mapc (lambda (e) - (when (org-list-get-checkbox e struct) - (org-list-set-checkbox e struct "[ ]"))) - (nthcdr index all-items)) - ;; Verify once again the structure, without ORDERED. - (org-list-struct-fix-box struct parents prevs nil) - ;; Return blocking item. - (nth index all-items))))))) - -(defun org-list-struct-fix-item-end (struct) - "Verify and correct each item end position in STRUCT. - -This function modifies STRUCT." - (let (end-list acc-end) - (mapc (lambda (e) - (let* ((pos (car e)) - (ind-pos (org-list-get-ind pos struct)) - (end-pos (org-list-get-item-end pos struct))) - (unless (assq end-pos struct) - ;; To determine real ind of an ending position that is - ;; not at an item, we have to find the item it belongs - ;; to: it is the last item (ITEM-UP), whose ending is - ;; further than the position we're interested in. - (let ((item-up (assoc-default end-pos acc-end '>))) - (push (cons - ;; Else part is for the bottom point. - (if item-up (+ (org-list-get-ind item-up struct) 2) 0) - end-pos) - end-list))) - (push (cons ind-pos pos) end-list) - (push (cons end-pos pos) acc-end))) - struct) - (setq end-list (sort end-list (lambda (e1 e2) (< (cdr e1) (cdr e2))))) - (org-list-struct-assoc-end struct end-list))) - -(defun org-list-struct-apply-struct (struct old-struct) - "Apply set difference between STRUCT and OLD-STRUCT to the buffer. - -OLD-STRUCT is the structure before any modifications, and STRUCT -the structure to be applied. The function will only modify parts -of the list which have changed. - -Initial position of cursor is restored after the changes." - (let* ((origin (point-marker)) - (inlinetask-re (and (featurep 'org-inlinetask) - (org-inlinetask-outline-regexp))) - (item-re (org-item-re)) - (shift-body-ind - (function - ;; Shift the indentation between END and BEG by DELTA. If - ;; MAX-IND is non-nil, ensure that no line will be indented - ;; more than that number. Start from the line before END. - (lambda (end beg delta max-ind) - (goto-char end) - (skip-chars-backward " \r\t\n") - (beginning-of-line) - (while (or (> (point) beg) - (and (= (point) beg) - (not (looking-at item-re)))) - (cond - ;; Skip inline tasks. - ((and inlinetask-re (looking-at inlinetask-re)) - (org-inlinetask-goto-beginning)) - ;; Shift only non-empty lines. - ((org-looking-at-p "^[ \t]*\\S-") - (let ((i (org-get-indentation))) - (org-indent-line-to - (if max-ind (min (+ i delta) max-ind) (+ i delta)))))) - (forward-line -1))))) - (modify-item - (function - ;; Replace ITEM first line elements with new elements from - ;; STRUCT, if appropriate. - (lambda (item) - (goto-char item) - (let* ((new-ind (org-list-get-ind item struct)) - (old-ind (org-get-indentation)) - (new-bul (org-list-bullet-string - (org-list-get-bullet item struct))) - (old-bul (org-list-get-bullet item old-struct)) - (new-box (org-list-get-checkbox item struct))) - (looking-at org-list-full-item-re) - ;; a. Replace bullet - (unless (equal old-bul new-bul) - (replace-match new-bul nil nil nil 1)) - ;; b. Replace checkbox. - (cond - ((equal (match-string 3) new-box)) - ((and (match-string 3) new-box) - (replace-match new-box nil nil nil 3)) - ((match-string 3) - (looking-at ".*?\\([ \t]*\\[[ X-]\\]\\)") - (replace-match "" nil nil nil 1)) - (t (let ((counterp (match-end 2))) - (goto-char (if counterp (1+ counterp) (match-end 1))) - (insert (concat new-box (unless counterp " ")))))) - ;; c. Indent item to appropriate column. - (unless (= new-ind old-ind) - (delete-region (goto-char (point-at-bol)) - (progn (skip-chars-forward " \t") (point))) - (indent-to new-ind))))))) - ;; 1. First get list of items and position endings. We maintain - ;; two alists: ITM-SHIFT, determining indentation shift needed - ;; at item, and END-LIST, a pseudo-alist where key is ending - ;; position and value point. - (let (end-list acc-end itm-shift all-ends sliced-struct) - (dolist (e old-struct) - (let* ((pos (car e)) - (ind-pos (org-list-get-ind pos struct)) - (ind-old (org-list-get-ind pos old-struct)) - (bul-pos (org-list-get-bullet pos struct)) - (bul-old (org-list-get-bullet pos old-struct)) - (ind-shift (- (+ ind-pos (length bul-pos)) - (+ ind-old (length bul-old)))) - (end-pos (org-list-get-item-end pos old-struct))) - (push (cons pos ind-shift) itm-shift) - (unless (assq end-pos old-struct) - ;; To determine real ind of an ending position that - ;; is not at an item, we have to find the item it - ;; belongs to: it is the last item (ITEM-UP), whose - ;; ending is further than the position we're - ;; interested in. - (let ((item-up (assoc-default end-pos acc-end '>))) - (push (cons end-pos item-up) end-list))) - (push (cons end-pos pos) acc-end))) - ;; 2. Slice the items into parts that should be shifted by the - ;; same amount of indentation. Each slice follow the pattern - ;; (END BEG DELTA MAX-IND-OR-NIL). Slices are returned in - ;; reverse order. - (setq all-ends (sort (append (mapcar 'car itm-shift) - (org-uniquify (mapcar 'car end-list))) - '<)) - (while (cdr all-ends) - (let* ((up (pop all-ends)) - (down (car all-ends)) - (itemp (assq up struct)) - (item (if itemp up (cdr (assq up end-list)))) - (ind (cdr (assq item itm-shift))) - ;; If we're not at an item, there's a child of the item - ;; point belongs to above. Make sure this slice isn't - ;; moved within that child by specifying a maximum - ;; indentation. - (max-ind (and (not itemp) - (+ (org-list-get-ind item struct) - (length (org-list-get-bullet item struct)) - org-list-indent-offset)))) - (push (list down up ind max-ind) sliced-struct))) - ;; 3. Shift each slice in buffer, provided delta isn't 0, from - ;; end to beginning. Take a special action when beginning is - ;; at item bullet. - (dolist (e sliced-struct) - (unless (and (zerop (nth 2 e)) (not (nth 3 e))) - (apply shift-body-ind e)) - (let* ((beg (nth 1 e)) - (cell (assq beg struct))) - (unless (or (not cell) (equal cell (assq beg old-struct))) - (funcall modify-item beg))))) - ;; 4. Go back to initial position and clean marker. - (goto-char origin) - (move-marker origin nil))) - -(defun org-list-write-struct (struct parents &optional old-struct) - "Correct bullets, checkboxes and indentation in list at point. - -STRUCT is the list structure. PARENTS is the alist of parents, -as returned by `org-list-parents-alist'. - -When non-nil, optional argument OLD-STRUCT is the reference -structure of the list. It should be provided whenever STRUCT -doesn't correspond anymore to the real list in buffer." - ;; Order of functions matters here: checkboxes and endings need - ;; correct indentation to be set, and indentation needs correct - ;; bullets. - ;; - ;; 0. Save a copy of structure before modifications - (let ((old-struct (or old-struct (copy-tree struct)))) - ;; 1. Set a temporary, but coherent with PARENTS, indentation in - ;; order to get items endings and bullets properly - (org-list-struct-fix-ind struct parents 2) - ;; 2. Fix each item end to get correct prevs alist. - (org-list-struct-fix-item-end struct) - ;; 3. Get bullets right. - (let ((prevs (org-list-prevs-alist struct))) - (org-list-struct-fix-bul struct prevs) - ;; 4. Now get real indentation. - (org-list-struct-fix-ind struct parents) - ;; 5. Eventually fix checkboxes. - (org-list-struct-fix-box struct parents prevs)) - ;; 6. Apply structure modifications to buffer. - (org-list-struct-apply-struct struct old-struct))) - - - -;;; Misc Tools - -(defun org-apply-on-list (function init-value &rest args) - "Call FUNCTION on each item of the list at point. -FUNCTION must be called with at least one argument: INIT-VALUE, -that will contain the value returned by the function at the -previous item, plus ARGS extra arguments. - -FUNCTION is applied on items in reverse order. - -As an example, \(org-apply-on-list \(lambda \(result\) \(1+ result\)\) 0\) -will return the number of items in the current list. - -Sublists of the list are skipped. Cursor is always at the -beginning of the item." - (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct)) - (item (copy-marker (point-at-bol))) - (all (org-list-get-all-items (marker-position item) struct prevs)) - (value init-value)) - (mapc (lambda (e) - (goto-char e) - (setq value (apply function value args))) - (nreverse all)) - (goto-char item) - (move-marker item nil) - value)) - -(defun org-list-set-item-visibility (item struct view) - "Set visibility of ITEM in STRUCT to VIEW. - -Possible values are: `folded', `children' or `subtree'. See -`org-cycle' for more information." - (cond - ((eq view 'folded) - (let ((item-end (org-list-get-item-end-before-blank item struct))) - ;; Hide from eol - (outline-flag-region (save-excursion (goto-char item) (point-at-eol)) - item-end t))) - ((eq view 'children) - ;; First show everything. - (org-list-set-item-visibility item struct 'subtree) - ;; Then fold every child. - (let* ((parents (org-list-parents-alist struct)) - (children (org-list-get-children item struct parents))) - (mapc (lambda (e) - (org-list-set-item-visibility e struct 'folded)) - children))) - ((eq view 'subtree) - ;; Show everything - (let ((item-end (org-list-get-item-end item struct))) - (outline-flag-region item item-end nil))))) - -(defun org-list-item-body-column (item) - "Return column at which body of ITEM should start." - (let (bpos bcol tpos tcol) - (save-excursion - (goto-char item) - (looking-at "[ \t]*\\(\\S-+\\)\\(.*[ \t]+::\\)?\\([ \t]+\\|$\\)") - (setq bpos (match-beginning 1) tpos (match-end 0) - bcol (progn (goto-char bpos) (current-column)) - tcol (progn (goto-char tpos) (current-column))) - (when (> tcol (+ bcol org-description-max-indent)) - (setq tcol (+ bcol 5)))) - tcol)) - - - -;;; Interactive functions - -(defalias 'org-list-get-item-begin 'org-in-item-p) - -(defun org-beginning-of-item () - "Go to the beginning of the current item. -Throw an error when not in a list." - (interactive) - (let ((begin (org-in-item-p))) - (if begin (goto-char begin) (error "Not in an item")))) - -(defun org-beginning-of-item-list () - "Go to the beginning item of the current list or sublist. -Throw an error when not in a list." - (interactive) - (let ((begin (org-in-item-p))) - (if (not begin) - (error "Not in an item") - (goto-char begin) - (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct))) - (goto-char (org-list-get-list-begin begin struct prevs)))))) - -(defun org-end-of-item-list () - "Go to the end of the current list or sublist. -Throw an error when not in a list." - (interactive) - (let ((begin (org-in-item-p))) - (if (not begin) - (error "Not in an item") - (goto-char begin) - (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct))) - (goto-char (org-list-get-list-end begin struct prevs)))))) - -(defun org-end-of-item () - "Go to the end of the current item. -Throw an error when not in a list." - (interactive) - (let ((begin (org-in-item-p))) - (if (not begin) - (error "Not in an item") - (goto-char begin) - (let ((struct (org-list-struct))) - (goto-char (org-list-get-item-end begin struct)))))) - -(defun org-previous-item () - "Move to the beginning of the previous item. -Throw an error when not in a list. Also throw an error when at -first item, unless `org-list-use-circular-motion' is non-nil." - (interactive) - (let ((item (org-in-item-p))) - (if (not item) - (error "Not in an item") - (goto-char item) - (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct)) - (prevp (org-list-get-prev-item item struct prevs))) - (cond - (prevp (goto-char prevp)) - (org-list-use-circular-motion - (goto-char (org-list-get-last-item item struct prevs))) - (t (error "On first item"))))))) - -(defun org-next-item () - "Move to the beginning of the next item. -Throw an error when not in a list. Also throw an error when at -last item, unless `org-list-use-circular-motion' is non-nil." - (interactive) - (let ((item (org-in-item-p))) - (if (not item) - (error "Not in an item") - (goto-char item) - (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct)) - (prevp (org-list-get-next-item item struct prevs))) - (cond - (prevp (goto-char prevp)) - (org-list-use-circular-motion - (goto-char (org-list-get-first-item item struct prevs))) - (t (error "On last item"))))))) - -(defun org-move-item-down () - "Move the item at point down, i.e. swap with following item. -Sub-items (items with larger indentation) are considered part of -the item, so this really moves item trees." - (interactive) - (unless (org-at-item-p) (error "Not at an item")) - (let* ((col (current-column)) - (item (point-at-bol)) - (struct (org-list-struct)) - (prevs (org-list-prevs-alist struct)) - (next-item (org-list-get-next-item (point-at-bol) struct prevs))) - (unless (or next-item org-list-use-circular-motion) - (user-error "Cannot move this item further down")) - (if (not next-item) - (setq struct (org-list-send-item item 'begin struct)) - (setq struct (org-list-swap-items item next-item struct)) - (goto-char - (org-list-get-next-item item struct (org-list-prevs-alist struct)))) - (org-list-write-struct struct (org-list-parents-alist struct)) - (org-move-to-column col))) - -(defun org-move-item-up () - "Move the item at point up, i.e. swap with previous item. -Sub-items (items with larger indentation) are considered part of -the item, so this really moves item trees." - (interactive) - (unless (org-at-item-p) (error "Not at an item")) - (let* ((col (current-column)) - (item (point-at-bol)) - (struct (org-list-struct)) - (prevs (org-list-prevs-alist struct)) - (prev-item (org-list-get-prev-item (point-at-bol) struct prevs))) - (unless (or prev-item org-list-use-circular-motion) - (user-error "Cannot move this item further up")) - (if (not prev-item) - (setq struct (org-list-send-item item 'end struct)) - (setq struct (org-list-swap-items prev-item item struct))) - (org-list-write-struct struct (org-list-parents-alist struct)) - (org-move-to-column col))) - -(defun org-insert-item (&optional checkbox) - "Insert a new item at the current level. -If cursor is before first character after bullet of the item, the -new item will be created before the current one. - -If CHECKBOX is non-nil, add a checkbox next to the bullet. - -Return t when things worked, nil when we are not in an item, or -item is invisible." - (let ((itemp (org-in-item-p)) - (pos (point))) - ;; If cursor isn't is a list or if list is invisible, return nil. - (unless (or (not itemp) - (save-excursion - (goto-char itemp) - (outline-invisible-p))) - (if (save-excursion - (goto-char itemp) - (org-at-item-timer-p)) - ;; Timer list: delegate to `org-timer-item'. - (progn (org-timer-item) t) - (let* ((struct (save-excursion (goto-char itemp) - (org-list-struct))) - (prevs (org-list-prevs-alist struct)) - ;; If we're in a description list, ask for the new term. - (desc (when (eq (org-list-get-list-type itemp struct prevs) - 'descriptive) - " :: "))) - (setq struct (org-list-insert-item pos struct prevs checkbox desc)) - (org-list-write-struct struct (org-list-parents-alist struct)) - (when checkbox (org-update-checkbox-count-maybe)) - (looking-at org-list-full-item-re) - (goto-char (if (and (match-beginning 4) - (save-match-data - (string-match "[.)]" (match-string 1)))) - (match-beginning 4) - (match-end 0))) - (if desc (backward-char 1)) - t))))) - -(defun org-list-repair () - "Fix indentation, bullets and checkboxes is the list at point." - (interactive) - (unless (org-at-item-p) (error "This is not a list")) - (let* ((struct (org-list-struct)) - (parents (org-list-parents-alist struct))) - (org-list-write-struct struct parents))) - -(defun org-cycle-list-bullet (&optional which) - "Cycle through the different itemize/enumerate bullets. -This cycle the entire list level through the sequence: - - `-' -> `+' -> `*' -> `1.' -> `1)' - -If WHICH is a valid string, use that as the new bullet. If WHICH -is an integer, 0 means `-', 1 means `+' etc. If WHICH is -`previous', cycle backwards." - (interactive "P") - (unless (org-at-item-p) (error "Not at an item")) - (save-excursion - (beginning-of-line) - (let* ((struct (org-list-struct)) - (parents (org-list-parents-alist struct)) - (prevs (org-list-prevs-alist struct)) - (list-beg (org-list-get-first-item (point) struct prevs)) - (bullet (org-list-get-bullet list-beg struct)) - (alpha-p (org-list-use-alpha-bul-p list-beg struct prevs)) - (case-fold-search nil) - (current (cond - ((string-match "[a-z]\\." bullet) "a.") - ((string-match "[a-z])" bullet) "a)") - ((string-match "[A-Z]\\." bullet) "A.") - ((string-match "[A-Z])" bullet) "A)") - ((string-match "\\." bullet) "1.") - ((string-match ")" bullet) "1)") - (t (org-trim bullet)))) - ;; Compute list of possible bullets, depending on context. - (bullet-list - (append '("-" "+" ) - ;; *-bullets are not allowed at column 0. - (unless (looking-at "\\S-") '("*")) - ;; Description items cannot be numbered. - (unless (or (eq org-plain-list-ordered-item-terminator ?\)) - (org-at-item-description-p)) - '("1.")) - (unless (or (eq org-plain-list-ordered-item-terminator ?.) - (org-at-item-description-p)) - '("1)")) - (unless (or (not alpha-p) - (eq org-plain-list-ordered-item-terminator ?\)) - (org-at-item-description-p)) - '("a." "A.")) - (unless (or (not alpha-p) - (eq org-plain-list-ordered-item-terminator ?.) - (org-at-item-description-p)) - '("a)" "A)")))) - (len (length bullet-list)) - (item-index (- len (length (member current bullet-list)))) - (get-value (lambda (index) (nth (mod index len) bullet-list))) - (new (cond - ((member which bullet-list) which) - ((numberp which) (funcall get-value which)) - ((eq 'previous which) (funcall get-value (1- item-index))) - (t (funcall get-value (1+ item-index)))))) - ;; Use a short variation of `org-list-write-struct' as there's - ;; no need to go through all the steps. - (let ((old-struct (copy-tree struct))) - (org-list-set-bullet list-beg struct (org-list-bullet-string new)) - (org-list-struct-fix-bul struct prevs) - (org-list-struct-fix-ind struct parents) - (org-list-struct-apply-struct struct old-struct))))) - -(defun org-toggle-checkbox (&optional toggle-presence) - "Toggle the checkbox in the current line. -With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With -double prefix, set checkbox to [-]. - -When there is an active region, toggle status or presence of the -first checkbox there, and make every item inside have the same -status or presence, respectively. - -If the cursor is in a headline, apply this to all checkbox items -in the text below the heading, taking as reference the first item -in subtree, ignoring drawers." - (interactive "P") - (save-excursion - (let* (singlep - block-item - lim-up - lim-down - (drawer-re (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$")) - (keyword-re (concat "^[ \t]*\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\|" org-clock-string "\\)" - " *[[<]\\([^]>]+\\)[]>]")) - (orderedp (org-entry-get nil "ORDERED")) - (bounds - ;; In a region, start at first item in region. - (cond - ((org-region-active-p) - (let ((limit (region-end))) - (goto-char (region-beginning)) - (if (org-list-search-forward (org-item-beginning-re) limit t) - (setq lim-up (point-at-bol)) - (error "No item in region")) - (setq lim-down (copy-marker limit)))) - ((org-at-heading-p) - ;; On an heading, start at first item after drawers and - ;; time-stamps (scheduled, etc.). - (let ((limit (save-excursion (outline-next-heading) (point)))) - (forward-line 1) - (while (or (looking-at drawer-re) (looking-at keyword-re)) - (if (looking-at keyword-re) - (forward-line 1) - (re-search-forward "^[ \t]*:END:" limit nil))) - (if (org-list-search-forward (org-item-beginning-re) limit t) - (setq lim-up (point-at-bol)) - (error "No item in subtree")) - (setq lim-down (copy-marker limit)))) - ;; Just one item: set SINGLEP flag. - ((org-at-item-p) - (setq singlep t) - (setq lim-up (point-at-bol) - lim-down (copy-marker (point-at-eol)))) - (t (error "Not at an item or heading, and no active region")))) - ;; Determine the checkbox going to be applied to all items - ;; within bounds. - (ref-checkbox - (progn - (goto-char lim-up) - (let ((cbox (and (org-at-item-checkbox-p) (match-string 1)))) - (cond - ((equal toggle-presence '(16)) "[-]") - ((equal toggle-presence '(4)) - (unless cbox "[ ]")) - ((equal "[X]" cbox) "[ ]") - (t "[X]")))))) - ;; When an item is found within bounds, grab the full list at - ;; point structure, then: (1) set check-box of all its items - ;; within bounds to REF-CHECKBOX, (2) fix check-boxes of the - ;; whole list, (3) move point after the list. - (goto-char lim-up) - (while (and (< (point) lim-down) - (org-list-search-forward (org-item-beginning-re) - lim-down 'move)) - (let* ((struct (org-list-struct)) - (struct-copy (copy-tree struct)) - (parents (org-list-parents-alist struct)) - (prevs (org-list-prevs-alist struct)) - (bottom (copy-marker (org-list-get-bottom-point struct))) - (items-to-toggle (org-remove-if - (lambda (e) (or (< e lim-up) (> e lim-down))) - (mapcar 'car struct)))) - (mapc (lambda (e) (org-list-set-checkbox - e struct - ;; If there is no box at item, leave as-is - ;; unless function was called with C-u prefix. - (let ((cur-box (org-list-get-checkbox e struct))) - (if (or cur-box (equal toggle-presence '(4))) - ref-checkbox - cur-box)))) - items-to-toggle) - (setq block-item (org-list-struct-fix-box - struct parents prevs orderedp)) - ;; Report some problems due to ORDERED status of subtree. - ;; If only one box was being checked, throw an error, else, - ;; only signal problems. - (cond - ((and singlep block-item (> lim-up block-item)) - (error - "Checkbox blocked because of unchecked box at line %d" - (org-current-line block-item))) - (block-item - (message - "Checkboxes were removed due to unchecked box at line %d" - (org-current-line block-item)))) - (goto-char bottom) - (move-marker bottom nil) - (org-list-struct-apply-struct struct struct-copy))) - (move-marker lim-down nil))) - (org-update-checkbox-count-maybe)) - -(defun org-reset-checkbox-state-subtree () - "Reset all checkboxes in an entry subtree." - (interactive "*") - (if (org-before-first-heading-p) - (error "Not inside a tree") - (save-restriction - (save-excursion - (org-narrow-to-subtree) - (org-show-subtree) - (goto-char (point-min)) - (let ((end (point-max))) - (while (< (point) end) - (when (org-at-item-checkbox-p) - (replace-match "[ ]" t t nil 1)) - (beginning-of-line 2))) - (org-update-checkbox-count-maybe 'all))))) - -(defun org-update-checkbox-count (&optional all) - "Update the checkbox statistics in the current section. -This will find all statistic cookies like [57%] and [6/12] and -update them with the current numbers. - -With optional prefix argument ALL, do this for the whole buffer." - (interactive "P") - (save-excursion - (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") - (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)") - (recursivep - (or (not org-checkbox-hierarchical-statistics) - (string-match "\\<recursive\\>" - (or (org-entry-get nil "COOKIE_DATA") "")))) - (bounds (if all - (cons (point-min) (point-max)) - (cons (or (ignore-errors (org-back-to-heading t) (point)) - (point-min)) - (save-excursion (outline-next-heading) (point))))) - (count-boxes - (function - ;; Return number of checked boxes and boxes of all types - ;; in all structures in STRUCTS. If RECURSIVEP is - ;; non-nil, also count boxes in sub-lists. If ITEM is - ;; nil, count across the whole structure, else count only - ;; across subtree whose ancestor is ITEM. - (lambda (item structs recursivep) - (let ((c-on 0) (c-all 0)) - (mapc - (lambda (s) - (let* ((pre (org-list-prevs-alist s)) - (par (org-list-parents-alist s)) - (items - (cond - ((and recursivep item) (org-list-get-subtree item s)) - (recursivep (mapcar 'car s)) - (item (org-list-get-children item s par)) - (t (org-list-get-all-items - (org-list-get-top-point s) s pre)))) - (cookies (delq nil (mapcar - (lambda (e) - (org-list-get-checkbox e s)) - items)))) - (setq c-all (+ (length cookies) c-all) - c-on (+ (org-count "[X]" cookies) c-on)))) - structs) - (cons c-on c-all))))) - (backup-end 1) - cookies-list structs-bak box-num) - (goto-char (car bounds)) - ;; 1. Build an alist for each cookie found within BOUNDS. The - ;; key will be position at beginning of cookie and values - ;; ending position, format of cookie, and a cell whose car is - ;; number of checked boxes to report, and cdr total number of - ;; boxes. - (while (re-search-forward cookie-re (cdr bounds) t) - (catch 'skip - (save-excursion - (push - (list - (match-beginning 1) ; cookie start - (match-end 1) ; cookie end - (match-string 2) ; percent? - (cond ; boxes count - ;; Cookie is at an heading, but specifically for todo, - ;; not for checkboxes: skip it. - ((and (org-at-heading-p) - (string-match "\\<todo\\>" - (downcase - (or (org-entry-get nil "COOKIE_DATA") "")))) - (throw 'skip nil)) - ;; Cookie is at an heading, but all lists before next - ;; heading already have been read. Use data collected - ;; in STRUCTS-BAK. This should only happen when - ;; heading has more than one cookie on it. - ((and (org-at-heading-p) - (<= (save-excursion (outline-next-heading) (point)) - backup-end)) - (funcall count-boxes nil structs-bak recursivep)) - ;; Cookie is at a fresh heading. Grab structure of - ;; every list containing a checkbox between point and - ;; next headline, and save them in STRUCTS-BAK. - ((org-at-heading-p) - (setq backup-end (save-excursion - (outline-next-heading) (point)) - structs-bak nil) - (while (org-list-search-forward box-re backup-end 'move) - (let* ((struct (org-list-struct)) - (bottom (org-list-get-bottom-point struct))) - (push struct structs-bak) - (goto-char bottom))) - (funcall count-boxes nil structs-bak recursivep)) - ;; Cookie is at an item, and we already have list - ;; structure stored in STRUCTS-BAK. - ((and (org-at-item-p) - (< (point-at-bol) backup-end) - ;; Only lists in no special context are stored. - (not (nth 2 (org-list-context)))) - (funcall count-boxes (point-at-bol) structs-bak recursivep)) - ;; Cookie is at an item, but we need to compute list - ;; structure. - ((org-at-item-p) - (let ((struct (org-list-struct))) - (setq backup-end (org-list-get-bottom-point struct) - structs-bak (list struct))) - (funcall count-boxes (point-at-bol) structs-bak recursivep)) - ;; Else, cookie found is at a wrong place. Skip it. - (t (throw 'skip nil)))) - cookies-list)))) - ;; 2. Apply alist to buffer, in reverse order so positions stay - ;; unchanged after cookie modifications. - (mapc (lambda (cookie) - (let* ((beg (car cookie)) - (end (nth 1 cookie)) - (percentp (nth 2 cookie)) - (checked (car (nth 3 cookie))) - (total (cdr (nth 3 cookie))) - (new (if percentp - (format "[%d%%]" (/ (* 100 checked) - (max 1 total))) - (format "[%d/%d]" checked total)))) - (goto-char beg) - (insert new) - (delete-region (point) (+ (point) (- end beg))) - (when org-auto-align-tags (org-fix-tags-on-the-fly)))) - cookies-list)))) - -(defun org-get-checkbox-statistics-face () - "Select the face for checkbox statistics. -The face will be `org-done' when all relevant boxes are checked. -Otherwise it will be `org-todo'." - (if (match-end 1) - (if (equal (match-string 1) "100%") - 'org-checkbox-statistics-done - 'org-checkbox-statistics-todo) - (if (and (> (match-end 2) (match-beginning 2)) - (equal (match-string 2) (match-string 3))) - 'org-checkbox-statistics-done - 'org-checkbox-statistics-todo))) - -(defun org-update-checkbox-count-maybe (&optional all) - "Update checkbox statistics unless turned off by user. -With an optional argument ALL, update them in the whole buffer." - (when (cdr (assq 'checkbox org-list-automatic-rules)) - (org-update-checkbox-count all)) - (run-hooks 'org-checkbox-statistics-hook)) - -(defvar org-last-indent-begin-marker (make-marker)) -(defvar org-last-indent-end-marker (make-marker)) -(defun org-list-indent-item-generic (arg no-subtree struct) - "Indent a local list item including its children. -When number ARG is a negative, item will be outdented, otherwise -it will be indented. - -If a region is active, all items inside will be moved. - -If NO-SUBTREE is non-nil, only indent the item itself, not its -children. - -STRUCT is the list structure. - -Return t if successful." - (save-excursion - (let* ((regionp (org-region-active-p)) - (rbeg (and regionp (region-beginning))) - (rend (and regionp (region-end))) - (top (org-list-get-top-point struct)) - (parents (org-list-parents-alist struct)) - (prevs (org-list-prevs-alist struct)) - ;; Are we going to move the whole list? - (specialp - (and (not regionp) - (= top (point-at-bol)) - (cdr (assq 'indent org-list-automatic-rules)) - (if no-subtree - (error - "First item of list cannot move without its subtree") - t)))) - ;; Determine begin and end points of zone to indent. If moving - ;; more than one item, save them for subsequent moves. - (unless (and (memq last-command '(org-shiftmetaright org-shiftmetaleft)) - (memq this-command '(org-shiftmetaright org-shiftmetaleft))) - (if regionp - (progn - (set-marker org-last-indent-begin-marker rbeg) - (set-marker org-last-indent-end-marker rend)) - (set-marker org-last-indent-begin-marker (point-at-bol)) - (set-marker org-last-indent-end-marker - (cond - (specialp (org-list-get-bottom-point struct)) - (no-subtree (1+ (point-at-bol))) - (t (org-list-get-item-end (point-at-bol) struct)))))) - (let* ((beg (marker-position org-last-indent-begin-marker)) - (end (marker-position org-last-indent-end-marker))) - (cond - ;; Special case: moving top-item with indent rule. - (specialp - (let* ((level-skip (org-level-increment)) - (offset (if (< arg 0) (- level-skip) level-skip)) - (top-ind (org-list-get-ind beg struct)) - (old-struct (copy-tree struct))) - (if (< (+ top-ind offset) 0) - (error "Cannot outdent beyond margin") - ;; Change bullet if necessary. - (when (and (= (+ top-ind offset) 0) - (string-match "*" - (org-list-get-bullet beg struct))) - (org-list-set-bullet beg struct - (org-list-bullet-string "-"))) - ;; Shift every item by OFFSET and fix bullets. Then - ;; apply changes to buffer. - (mapc (lambda (e) - (let ((ind (org-list-get-ind (car e) struct))) - (org-list-set-ind (car e) struct (+ ind offset)))) - struct) - (org-list-struct-fix-bul struct prevs) - (org-list-struct-apply-struct struct old-struct)))) - ;; Forbidden move: - ((and (< arg 0) - ;; If only one item is moved, it mustn't have a child. - (or (and no-subtree - (not regionp) - (org-list-has-child-p beg struct)) - ;; If a subtree or region is moved, the last item - ;; of the subtree mustn't have a child. - (let ((last-item (caar - (reverse - (org-remove-if - (lambda (e) (>= (car e) end)) - struct))))) - (org-list-has-child-p last-item struct)))) - (error "Cannot outdent an item without its children")) - ;; Normal shifting - (t - (let* ((new-parents - (if (< arg 0) - (org-list-struct-outdent beg end struct parents) - (org-list-struct-indent beg end struct parents prevs)))) - (org-list-write-struct struct new-parents)) - (org-update-checkbox-count-maybe)))))) - t) - -(defun org-outdent-item () - "Outdent a local list item, but not its children. -If a region is active, all items inside will be moved." - (interactive) - (let ((regionp (org-region-active-p))) - (cond - ((or (org-at-item-p) - (and regionp - (save-excursion (goto-char (region-beginning)) - (org-at-item-p)))) - (let ((struct (if (not regionp) (org-list-struct) - (save-excursion (goto-char (region-beginning)) - (org-list-struct))))) - (org-list-indent-item-generic -1 t struct))) - (regionp (error "Region not starting at an item")) - (t (error "Not at an item"))))) - -(defun org-indent-item () - "Indent a local list item, but not its children. -If a region is active, all items inside will be moved." - (interactive) - (let ((regionp (org-region-active-p))) - (cond - ((or (org-at-item-p) - (and regionp - (save-excursion (goto-char (region-beginning)) - (org-at-item-p)))) - (let ((struct (if (not regionp) (org-list-struct) - (save-excursion (goto-char (region-beginning)) - (org-list-struct))))) - (org-list-indent-item-generic 1 t struct))) - (regionp (error "Region not starting at an item")) - (t (error "Not at an item"))))) - -(defun org-outdent-item-tree () - "Outdent a local list item including its children. -If a region is active, all items inside will be moved." - (interactive) - (let ((regionp (org-region-active-p))) - (cond - ((or (org-at-item-p) - (and regionp - (save-excursion (goto-char (region-beginning)) - (org-at-item-p)))) - (let ((struct (if (not regionp) (org-list-struct) - (save-excursion (goto-char (region-beginning)) - (org-list-struct))))) - (org-list-indent-item-generic -1 nil struct))) - (regionp (error "Region not starting at an item")) - (t (error "Not at an item"))))) - -(defun org-indent-item-tree () - "Indent a local list item including its children. -If a region is active, all items inside will be moved." - (interactive) - (let ((regionp (org-region-active-p))) - (cond - ((or (org-at-item-p) - (and regionp - (save-excursion (goto-char (region-beginning)) - (org-at-item-p)))) - (let ((struct (if (not regionp) (org-list-struct) - (save-excursion (goto-char (region-beginning)) - (org-list-struct))))) - (org-list-indent-item-generic 1 nil struct))) - (regionp (error "Region not starting at an item")) - (t (error "Not at an item"))))) - -(defvar org-tab-ind-state) -(defun org-cycle-item-indentation () - "Cycle levels of indentation of an empty item. -The first run indents the item, if applicable. Subsequent runs -outdent it at meaningful levels in the list. When done, item is -put back at its original position with its original bullet. - -Return t at each successful move." - (when (org-at-item-p) - (let* ((org-adapt-indentation nil) - (struct (org-list-struct)) - (ind (org-list-get-ind (point-at-bol) struct)) - (bullet (org-trim (buffer-substring (point-at-bol) (point-at-eol))))) - ;; Accept empty items or if cycle has already started. - (when (or (eq last-command 'org-cycle-item-indentation) - (and (save-excursion - (beginning-of-line) - (looking-at org-list-full-item-re)) - (>= (match-end 0) (save-excursion - (goto-char (org-list-get-item-end - (point-at-bol) struct)) - (skip-chars-backward " \r\t\n") - (point))))) - (setq this-command 'org-cycle-item-indentation) - ;; When in the middle of the cycle, try to outdent first. If - ;; it fails, and point is still at initial position, indent. - ;; Else, re-create it at its original position. - (if (eq last-command 'org-cycle-item-indentation) - (cond - ((ignore-errors (org-list-indent-item-generic -1 t struct))) - ((and (= ind (car org-tab-ind-state)) - (ignore-errors (org-list-indent-item-generic 1 t struct)))) - (t (delete-region (point-at-bol) (point-at-eol)) - (org-indent-to-column (car org-tab-ind-state)) - (insert (cdr org-tab-ind-state) " ") - ;; Break cycle - (setq this-command 'identity))) - ;; If a cycle is starting, remember indentation and bullet, - ;; then try to indent. If it fails, try to outdent. - (setq org-tab-ind-state (cons ind bullet)) - (cond - ((ignore-errors (org-list-indent-item-generic 1 t struct))) - ((ignore-errors (org-list-indent-item-generic -1 t struct))) - (t (user-error "Cannot move item")))) - t)))) - -(defun org-sort-list (&optional with-case sorting-type getkey-func compare-func) - "Sort list items. -The cursor may be at any item of the list that should be sorted. -Sublists are not sorted. Checkboxes, if any, are ignored. - -Sorting can be alphabetically, numerically, by date/time as given -by a time stamp, by a property or by priority. - -Comparing entries ignores case by default. However, with an -optional argument WITH-CASE, the sorting considers case as well. - -The command prompts for the sorting type unless it has been given -to the function through the SORTING-TYPE argument, which needs to -be a character, \(?n ?N ?a ?A ?t ?T ?f ?F ?x ?X). Here is the -detailed meaning of each character: - -n Numerically, by converting the beginning of the item to a number. -a Alphabetically. Only the first line of item is checked. -t By date/time, either the first active time stamp in the entry, if - any, or by the first inactive one. In a timer list, sort the timers. -x By \"checked\" status of a check list. - -Capital letters will reverse the sort order. - -If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies -a function to be called with point at the beginning of the -record. It must return either a string or a number that should -serve as the sorting key for that record. It will then use -COMPARE-FUNC to compare entries. - -Sorting is done against the visible part of the headlines, it -ignores hidden links." - (interactive "P") - (let* ((case-func (if with-case 'identity 'downcase)) - (struct (org-list-struct)) - (prevs (org-list-prevs-alist struct)) - (start (org-list-get-list-begin (point-at-bol) struct prevs)) - (end (org-list-get-list-end (point-at-bol) struct prevs)) - (sorting-type - (or sorting-type - (progn - (message - "Sort plain list: [a]lpha [n]umeric [t]ime [f]unc [x]checked A/N/T/F/X means reversed:") - (read-char-exclusive)))) - (getkey-func - (or getkey-func - (and (= (downcase sorting-type) ?f) - (intern (org-icompleting-read "Sort using function: " - obarray 'fboundp t nil nil)))))) - (message "Sorting items...") - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (let* ((dcst (downcase sorting-type)) - (case-fold-search nil) - (now (current-time)) - (sort-func (cond - ((= dcst ?a) 'string<) - ((= dcst ?f) compare-func) - ((= dcst ?t) '<) - ((= dcst ?x) 'string<))) - (next-record (lambda () - (skip-chars-forward " \r\t\n") - (or (eobp) (beginning-of-line)))) - (end-record (lambda () - (goto-char (org-list-get-item-end-before-blank - (point) struct)))) - (value-to-sort - (lambda () - (when (looking-at "[ \t]*[-+*0-9.)]+\\([ \t]+\\[[- X]\\]\\)?[ \t]+") - (cond - ((= dcst ?n) - (string-to-number - (org-sort-remove-invisible - (buffer-substring (match-end 0) (point-at-eol))))) - ((= dcst ?a) - (funcall case-func - (org-sort-remove-invisible - (buffer-substring - (match-end 0) (point-at-eol))))) - ((= dcst ?t) - (cond - ;; If it is a timer list, convert timer to seconds - ((org-at-item-timer-p) - (org-timer-hms-to-secs (match-string 1))) - ((or (save-excursion - (re-search-forward org-ts-regexp (point-at-eol) t)) - (save-excursion (re-search-forward org-ts-regexp-both - (point-at-eol) t))) - (org-time-string-to-seconds (match-string 0))) - (t (org-float-time now)))) - ((= dcst ?x) (or (and (stringp (match-string 1)) - (match-string 1)) - "")) - ((= dcst ?f) - (if getkey-func - (let ((value (funcall getkey-func))) - (if (stringp value) - (funcall case-func value) - value)) - (error "Invalid key function `%s'" getkey-func))) - (t (error "Invalid sorting type `%c'" sorting-type))))))) - (sort-subr (/= dcst sorting-type) - next-record - end-record - value-to-sort - nil - sort-func) - ;; Read and fix list again, as `sort-subr' probably destroyed - ;; its structure. - (org-list-repair) - (run-hooks 'org-after-sorting-entries-or-items-hook) - (message "Sorting items...done"))))) - - - -;;; Send and receive lists - -(defun org-list-parse-list (&optional delete) - "Parse the list at point and maybe DELETE it. - -Return a list whose car is a symbol of list type, among -`ordered', `unordered' and `descriptive'. Then, each item is -a list whose car is counter, and cdr are strings and other -sub-lists. Inside strings, check-boxes are replaced by -\"[CBON]\", \"[CBOFF]\" and \"[CBTRANS]\". - -For example, the following list: - -1. first item - + sub-item one - + [X] sub-item two - more text in first item -2. [@3] last item - -will be parsed as: - -\(ordered - \(nil \"first item\" - \(unordered - \(nil \"sub-item one\"\) - \(nil \"[CBON] sub-item two\"\)\) - \"more text in first item\"\) - \(3 \"last item\"\)\) - -Point is left at list end." - (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct)) - (parents (org-list-parents-alist struct)) - (top (org-list-get-top-point struct)) - (bottom (org-list-get-bottom-point struct)) - out - parse-item ; for byte-compiler - (get-text - (function - ;; Return text between BEG and END, trimmed, with - ;; checkboxes replaced. - (lambda (beg end) - (let ((text (org-trim (buffer-substring beg end)))) - (if (string-match "\\`\\[\\([-X ]\\)\\]" text) - (replace-match - (let ((box (match-string 1 text))) - (cond - ((equal box " ") "CBOFF") - ((equal box "-") "CBTRANS") - (t "CBON"))) - t nil text 1) - text))))) - (parse-sublist - (function - ;; Return a list whose car is list type and cdr a list of - ;; items' body. - (lambda (e) - (cons (org-list-get-list-type (car e) struct prevs) - (mapcar parse-item e))))) - (parse-item - (function - ;; Return a list containing counter of item, if any, text - ;; and any sublist inside it. - (lambda (e) - (let ((start (save-excursion - (goto-char e) - (looking-at "[ \t]*\\S-+\\([ \t]+\\[@\\(start:\\)?\\([0-9]+\\|[a-zA-Z]\\)\\]\\)?[ \t]*") - (match-end 0))) - ;; Get counter number. For alphabetic counter, get - ;; its position in the alphabet. - (counter (let ((c (org-list-get-counter e struct))) - (cond - ((not c) nil) - ((string-match "[A-Za-z]" c) - (- (string-to-char (upcase (match-string 0 c))) - 64)) - ((string-match "[0-9]+" c) - (string-to-number (match-string 0 c)))))) - (childp (org-list-has-child-p e struct)) - (end (org-list-get-item-end e struct))) - ;; If item has a child, store text between bullet and - ;; next child, then recursively parse all sublists. At - ;; the end of each sublist, check for the presence of - ;; text belonging to the original item. - (if childp - (let* ((children (org-list-get-children e struct parents)) - (body (list (funcall get-text start childp)))) - (while children - (let* ((first (car children)) - (sub (org-list-get-all-items first struct prevs)) - (last-c (car (last sub))) - (last-end (org-list-get-item-end last-c struct))) - (push (funcall parse-sublist sub) body) - ;; Remove children from the list just parsed. - (setq children (cdr (member last-c children))) - ;; There is a chunk of text belonging to the - ;; item if last child doesn't end where next - ;; child starts or where item ends. - (unless (= (or (car children) end) last-end) - (push (funcall get-text - last-end (or (car children) end)) - body)))) - (cons counter (nreverse body))) - (list counter (funcall get-text start end)))))))) - ;; Store output, take care of cursor position and deletion of - ;; list, then return output. - (setq out (funcall parse-sublist (org-list-get-all-items top struct prevs))) - (goto-char top) - (when delete - (delete-region top bottom) - (when (and (not (looking-at "[ \t]*$")) (looking-at org-list-end-re)) - (replace-match ""))) - out)) - -(defun org-list-make-subtree () - "Convert the plain list at point into a subtree." - (interactive) - (if (not (ignore-errors (goto-char (org-in-item-p)))) - (error "Not in a list") - (let ((list (save-excursion (org-list-parse-list t)))) - (insert (org-list-to-subtree list))))) - -(defun org-list-insert-radio-list () - "Insert a radio list template appropriate for this major mode." - (interactive) - (let* ((e (assq major-mode org-list-radio-list-templates)) - (txt (nth 1 e)) - name pos) - (unless e (error "No radio list setup defined for %s" major-mode)) - (setq name (read-string "List name: ")) - (while (string-match "%n" txt) - (setq txt (replace-match name t t txt))) - (or (bolp) (insert "\n")) - (setq pos (point)) - (insert txt) - (goto-char pos))) - -(defun org-list-send-list (&optional maybe) - "Send a transformed version of this list to the receiver position. -With argument MAYBE, fail quietly if no transformation is defined -for this list." - (interactive) - (catch 'exit - (unless (org-at-item-p) (error "Not at a list item")) - (save-excursion - (re-search-backward "#\\+ORGLST" nil t) - (unless (looking-at "#\\+ORGLST:[ \t]+SEND[ \t]+\\(\\S-+\\)[ \t]+\\(\\S-+\\)") - (if maybe (throw 'exit nil) - (error "Don't know how to transform this list")))) - (let* ((name (match-string 1)) - (transform (intern (match-string 2))) - (bottom-point - (save-excursion - (re-search-forward - "\\(\\\\end{comment}\\|@end ignore\\|-->\\)" nil t) - (match-beginning 0))) - (top-point - (progn - (re-search-backward "#\\+ORGLST" nil t) - (re-search-forward (org-item-beginning-re) bottom-point t) - (match-beginning 0))) - (plain-list (buffer-substring-no-properties top-point bottom-point)) - beg txt) - (unless (fboundp transform) - (error "No such transformation function %s" transform)) - (let ((txt (funcall transform plain-list))) - ;; Find the insertion place - (save-excursion - (goto-char (point-min)) - (unless (re-search-forward - (concat "BEGIN RECEIVE ORGLST +" - name - "\\([ \t]\\|$\\)") nil t) - (error "Don't know where to insert translated list")) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (setq beg (point)) - (unless (re-search-forward (concat "END RECEIVE ORGLST +" name) nil t) - (error "Cannot find end of insertion region")) - (delete-region beg (point-at-bol)) - (goto-char beg) - (insert txt "\n"))) - (message "List converted and installed at receiver location")))) - -(defsubst org-list-item-trim-br (item) - "Trim line breaks in a list ITEM." - (setq item (replace-regexp-in-string "\n +" " " item))) - -(defun org-list-to-generic (list params) - "Convert a LIST parsed through `org-list-parse-list' to other formats. -Valid parameters PARAMS are: - -:ustart String to start an unordered list -:uend String to end an unordered list - -:ostart String to start an ordered list -:oend String to end an ordered list - -:dstart String to start a descriptive list -:dend String to end a descriptive list -:dtstart String to start a descriptive term -:dtend String to end a descriptive term -:ddstart String to start a description -:ddend String to end a description - -:splice When set to t, return only list body lines, don't wrap - them into :[u/o]start and :[u/o]end. Default is nil. - -:istart String to start a list item. -:icount String to start an item with a counter. -:iend String to end a list item -:isep String to separate items -:lsep String to separate sublists -:csep String to separate text from a sub-list - -:cboff String to insert for an unchecked check-box -:cbon String to insert for a checked check-box -:cbtrans String to insert for a check-box in transitional state - -:nobr Non-nil means remove line breaks in lists items. - -Alternatively, each parameter can also be a form returning -a string. These sexp can use keywords `counter' and `depth', -representing respectively counter associated to the current -item, and depth of the current sub-list, starting at 0. -Obviously, `counter' is only available for parameters applying to -items." - (interactive) - (let* ((p params) - (splicep (plist-get p :splice)) - (ostart (plist-get p :ostart)) - (oend (plist-get p :oend)) - (ustart (plist-get p :ustart)) - (uend (plist-get p :uend)) - (dstart (plist-get p :dstart)) - (dend (plist-get p :dend)) - (dtstart (plist-get p :dtstart)) - (dtend (plist-get p :dtend)) - (ddstart (plist-get p :ddstart)) - (ddend (plist-get p :ddend)) - (istart (plist-get p :istart)) - (icount (plist-get p :icount)) - (iend (plist-get p :iend)) - (isep (plist-get p :isep)) - (lsep (plist-get p :lsep)) - (csep (plist-get p :csep)) - (cbon (plist-get p :cbon)) - (cboff (plist-get p :cboff)) - (cbtrans (plist-get p :cbtrans)) - (nobr (plist-get p :nobr)) - export-sublist ; for byte-compiler - (export-item - (function - ;; Export an item ITEM of type TYPE, at DEPTH. First - ;; string in item is treated in a special way as it can - ;; bring extra information that needs to be processed. - (lambda (item type depth) - (let* ((counter (pop item)) - (fmt (concat - (cond - ((eq type 'descriptive) - ;; Stick DTSTART to ISTART by - ;; left-trimming the latter. - (concat (let ((s (eval istart))) - (or (and (string-match "[ \t\n\r]+\\'" s) - (replace-match "" t t s)) - istart)) - "%s" (eval ddend))) - ((and counter (eq type 'ordered)) - (concat (eval icount) "%s")) - (t (concat (eval istart) "%s"))) - (eval iend))) - (first (car item))) - ;; Replace checkbox if any is found. - (cond - ((string-match "\\[CBON\\]" first) - (setq first (replace-match cbon t t first))) - ((string-match "\\[CBOFF\\]" first) - (setq first (replace-match cboff t t first))) - ((string-match "\\[CBTRANS\\]" first) - (setq first (replace-match cbtrans t t first)))) - ;; Replace line breaks if required - (when nobr (setq first (org-list-item-trim-br first))) - ;; Insert descriptive term if TYPE is `descriptive'. - (when (eq type 'descriptive) - (let* ((complete (string-match "^\\(.*\\)[ \t]+::" first)) - (term (if complete - (save-match-data - (org-trim (match-string 1 first))) - "???")) - (desc (if complete - (org-trim (substring first (match-end 0))) - first))) - (setq first (concat (eval dtstart) term (eval dtend) - (eval ddstart) desc)))) - (setcar item first) - (format fmt - (mapconcat (lambda (e) - (if (stringp e) e - (funcall export-sublist e (1+ depth)))) - item (or (eval csep) ""))))))) - (export-sublist - (function - ;; Export sublist SUB at DEPTH. - (lambda (sub depth) - (let* ((type (car sub)) - (items (cdr sub)) - (fmt (concat (cond - (splicep "%s") - ((eq type 'ordered) - (concat (eval ostart) "%s" (eval oend))) - ((eq type 'descriptive) - (concat (eval dstart) "%s" (eval dend))) - (t (concat (eval ustart) "%s" (eval uend)))) - (eval lsep)))) - (format fmt (mapconcat (lambda (e) - (funcall export-item e type depth)) - items (or (eval isep) "")))))))) - (concat (funcall export-sublist list 0) "\n"))) - -(defun org-list-to-latex (list &optional params) - "Convert LIST into a LaTeX list. -LIST is as string representing the list to transform, as Org -syntax. Return converted list as a string." - (require 'ox-latex) - (org-export-string-as list 'latex t)) - -(defun org-list-to-html (list) - "Convert LIST into a HTML list. -LIST is as string representing the list to transform, as Org -syntax. Return converted list as a string." - (require 'ox-html) - (org-export-string-as list 'html t)) - -(defun org-list-to-texinfo (list &optional params) - "Convert LIST into a Texinfo list. -LIST is as string representing the list to transform, as Org -syntax. Return converted list as a string." - (require 'ox-texinfo) - (org-export-string-as list 'texinfo t)) - -(defun org-list-to-subtree (list &optional params) - "Convert LIST into an Org subtree. -LIST is as returned by `org-list-parse-list'. PARAMS is a property list -with overruling parameters for `org-list-to-generic'." - (let* ((rule (cdr (assq 'heading org-blank-before-new-entry))) - (level (org-reduced-level (or (org-current-level) 0))) - (blankp (or (eq rule t) - (and (eq rule 'auto) - (save-excursion - (outline-previous-heading) - (org-previous-line-empty-p))))) - (get-stars - (function - ;; Return the string for the heading, depending on depth D - ;; of current sub-list. - (lambda (d) - (let ((oddeven-level (+ level d 1))) - (concat (make-string (if org-odd-levels-only - (1- (* 2 oddeven-level)) - oddeven-level) - ?*) - " ")))))) - (org-list-to-generic - list - (org-combine-plists - '(:splice t - :dtstart " " :dtend " " - :istart (funcall get-stars depth) - :icount (funcall get-stars depth) - :isep (if blankp "\n\n" "\n") - :csep (if blankp "\n\n" "\n") - :cbon "DONE" :cboff "TODO" :cbtrans "TODO") - params)))) - -(provide 'org-list) - -;;; org-list.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-loaddefs.el b/xemacs-packages/lisp/org-8.2.3c/org-loaddefs.el deleted file mode 100644 index 393fee77..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-loaddefs.el +++ /dev/null @@ -1,3115 +0,0 @@ -;;; org-loaddefs.el --- autogenerated file, do not edit -;; -;;; Code: - -;;;### (autoloads (org-babel-mark-block org-babel-previous-src-block -;;;;;; org-babel-next-src-block org-babel-goto-named-result org-babel-goto-named-src-block -;;;;;; org-babel-goto-src-block-head org-babel-hide-result-toggle-maybe -;;;;;; org-babel-sha1-hash org-babel-execute-subtree org-babel-execute-buffer -;;;;;; org-babel-map-executables org-babel-map-call-lines org-babel-map-inline-src-blocks -;;;;;; org-babel-map-src-blocks org-babel-open-src-block-result -;;;;;; org-babel-switch-to-session-with-code org-babel-switch-to-session -;;;;;; org-babel-initiate-session org-babel-load-in-session org-babel-insert-header-arg -;;;;;; org-babel-check-src-block org-babel-expand-src-block org-babel-execute-src-block -;;;;;; org-babel-pop-to-session-maybe org-babel-load-in-session-maybe -;;;;;; org-babel-expand-src-block-maybe org-babel-view-src-block-info -;;;;;; org-babel-execute-maybe org-babel-execute-safely-maybe) "ob-core" -;;;;;; "ob-core.el" "a4f6521b05dcb8c040c0e5aeef52cc32") -;;; Generated autoloads from ob-core.el - -(autoload 'org-babel-execute-safely-maybe "ob-core" "\ -Not documented - -\(fn)" nil nil) - -(autoload 'org-babel-execute-maybe "ob-core" "\ -Not documented - -\(fn)" t nil) - -(autoload 'org-babel-view-src-block-info "ob-core" "\ -Display information on the current source block. -This includes header arguments, language and name, and is largely -a window into the `org-babel-get-src-block-info' function. - -\(fn)" t nil) - -(autoload 'org-babel-expand-src-block-maybe "ob-core" "\ -Conditionally expand a source block. -Detect if this is context for a org-babel src-block and if so -then run `org-babel-expand-src-block'. - -\(fn)" t nil) - -(autoload 'org-babel-load-in-session-maybe "ob-core" "\ -Conditionally load a source block in a session. -Detect if this is context for a org-babel src-block and if so -then run `org-babel-load-in-session'. - -\(fn)" t nil) - -(autoload 'org-babel-pop-to-session-maybe "ob-core" "\ -Conditionally pop to a session. -Detect if this is context for a org-babel src-block and if so -then run `org-babel-switch-to-session'. - -\(fn)" t nil) - -(autoload 'org-babel-execute-src-block "ob-core" "\ -Execute the current source code block. -Insert the results of execution into the buffer. Source code -execution and the collection and formatting of results can be -controlled through a variety of header arguments. - -With prefix argument ARG, force re-execution even if an existing -result cached in the buffer would otherwise have been returned. - -Optionally supply a value for INFO in the form returned by -`org-babel-get-src-block-info'. - -Optionally supply a value for PARAMS which will be merged with -the header arguments specified at the front of the source code -block. - -\(fn &optional ARG INFO PARAMS)" t nil) - -(autoload 'org-babel-expand-src-block "ob-core" "\ -Expand the current source code block. -Expand according to the source code block's header -arguments and pop open the results in a preview buffer. - -\(fn &optional ARG INFO PARAMS)" t nil) - -(autoload 'org-babel-check-src-block "ob-core" "\ -Check for misspelled header arguments in the current code block. - -\(fn)" t nil) - -(autoload 'org-babel-insert-header-arg "ob-core" "\ -Insert a header argument selecting from lists of common args and values. - -\(fn)" t nil) - -(autoload 'org-babel-load-in-session "ob-core" "\ -Load the body of the current source-code block. -Evaluate the header arguments for the source block before -entering the session. After loading the body this pops open the -session. - -\(fn &optional ARG INFO)" t nil) - -(autoload 'org-babel-initiate-session "ob-core" "\ -Initiate session for current code block. -If called with a prefix argument then resolve any variable -references in the header arguments and assign these variables in -the session. Copy the body of the code block to the kill ring. - -\(fn &optional ARG INFO)" t nil) - -(autoload 'org-babel-switch-to-session "ob-core" "\ -Switch to the session of the current code block. -Uses `org-babel-initiate-session' to start the session. If called -with a prefix argument then this is passed on to -`org-babel-initiate-session'. - -\(fn &optional ARG INFO)" t nil) - -(autoload 'org-babel-switch-to-session-with-code "ob-core" "\ -Switch to code buffer and display session. - -\(fn &optional ARG INFO)" t nil) - -(autoload 'org-babel-open-src-block-result "ob-core" "\ -If `point' is on a src block then open the results of the -source code block, otherwise return nil. With optional prefix -argument RE-RUN the source-code block is evaluated even if -results already exist. - -\(fn &optional RE-RUN)" t nil) - -(autoload 'org-babel-map-src-blocks "ob-core" "\ -Evaluate BODY forms on each source-block in FILE. -If FILE is nil evaluate BODY forms on source blocks in current -buffer. During evaluation of BODY the following local variables -are set relative to the currently matched code block. - -full-block ------- string holding the entirety of the code block -beg-block -------- point at the beginning of the code block -end-block -------- point at the end of the matched code block -lang ------------- string holding the language of the code block -beg-lang --------- point at the beginning of the lang -end-lang --------- point at the end of the lang -switches --------- string holding the switches -beg-switches ----- point at the beginning of the switches -end-switches ----- point at the end of the switches -header-args ------ string holding the header-args -beg-header-args -- point at the beginning of the header-args -end-header-args -- point at the end of the header-args -body ------------- string holding the body of the code block -beg-body --------- point at the beginning of the body -end-body --------- point at the end of the body - -\(fn FILE &rest BODY)" nil (quote macro)) - -(autoload 'org-babel-map-inline-src-blocks "ob-core" "\ -Evaluate BODY forms on each inline source-block in FILE. -If FILE is nil evaluate BODY forms on source blocks in current -buffer. - -\(fn FILE &rest BODY)" nil (quote macro)) - -(autoload 'org-babel-map-call-lines "ob-core" "\ -Evaluate BODY forms on each call line in FILE. -If FILE is nil evaluate BODY forms on source blocks in current -buffer. - -\(fn FILE &rest BODY)" nil (quote macro)) - -(autoload 'org-babel-map-executables "ob-core" "\ -Not documented - -\(fn FILE &rest BODY)" nil (quote macro)) - -(autoload 'org-babel-execute-buffer "ob-core" "\ -Execute source code blocks in a buffer. -Call `org-babel-execute-src-block' on every source block in -the current buffer. - -\(fn &optional ARG)" t nil) - -(autoload 'org-babel-execute-subtree "ob-core" "\ -Execute source code blocks in a subtree. -Call `org-babel-execute-src-block' on every source block in -the current subtree. - -\(fn &optional ARG)" t nil) - -(autoload 'org-babel-sha1-hash "ob-core" "\ -Generate an sha1 hash based on the value of info. - -\(fn &optional INFO)" t nil) - -(autoload 'org-babel-hide-result-toggle-maybe "ob-core" "\ -Toggle visibility of result at point. - -\(fn)" t nil) - -(autoload 'org-babel-goto-src-block-head "ob-core" "\ -Go to the beginning of the current code block. - -\(fn)" t nil) - -(autoload 'org-babel-goto-named-src-block "ob-core" "\ -Go to a named source-code block. - -\(fn NAME)" t nil) - -(autoload 'org-babel-goto-named-result "ob-core" "\ -Go to a named result. - -\(fn NAME)" t nil) - -(autoload 'org-babel-next-src-block "ob-core" "\ -Jump to the next source block. -With optional prefix argument ARG, jump forward ARG many source blocks. - -\(fn &optional ARG)" t nil) - -(autoload 'org-babel-previous-src-block "ob-core" "\ -Jump to the previous source block. -With optional prefix argument ARG, jump backward ARG many source blocks. - -\(fn &optional ARG)" t nil) - -(autoload 'org-babel-mark-block "ob-core" "\ -Mark current src block. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (org-babel-describe-bindings) "ob-keys" "ob-keys.el" -;;;;;; "f41a561a02eb66238c2824e76e3f8cc8") -;;; Generated autoloads from ob-keys.el - -(autoload 'org-babel-describe-bindings "ob-keys" "\ -Describe all keybindings behind `org-babel-key-prefix'. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe) -;;;;;; "ob-lob" "ob-lob.el" "d94d0930566ed1471ffe0d04603ac1bc") -;;; Generated autoloads from ob-lob.el - -(autoload 'org-babel-lob-execute-maybe "ob-lob" "\ -Execute a Library of Babel source block, if appropriate. -Detect if this is context for a Library Of Babel source block and -if so then run the appropriate source block from the Library. - -\(fn)" t nil) - -(autoload 'org-babel-lob-get-info "ob-lob" "\ -Return a Library of Babel function call as a string. - -\(fn)" nil nil) - -;;;*** - -;;;### (autoloads (org-babel-tangle org-babel-tangle-file) "ob-tangle" -;;;;;; "ob-tangle.el" "a8b8d21349eceb9147ddab7f6e5f1696") -;;; Generated autoloads from ob-tangle.el - -(autoload 'org-babel-tangle-file "ob-tangle" "\ -Extract the bodies of source code blocks in FILE. -Source code blocks are extracted with `org-babel-tangle'. -Optional argument TARGET-FILE can be used to specify a default -export file for all source blocks. Optional argument LANG can be -used to limit the exported source code blocks by language. -Return a list whose CAR is the tangled file name. - -\(fn FILE &optional TARGET-FILE LANG)" t nil) - -(autoload 'org-babel-tangle "ob-tangle" "\ -Write code blocks to source-specific files. -Extract the bodies of all source code blocks from the current -file into their own source-specific files. -With one universal prefix argument, only tangle the block at point. -When two universal prefix arguments, only tangle blocks for the -tangle file of the block at point. -Optional argument TARGET-FILE can be used to specify a default -export file for all source blocks. Optional argument LANG can be -used to limit the exported source code blocks by language. - -\(fn &optional ARG TARGET-FILE LANG)" t nil) - -;;;*** - -;;;### (autoloads (org-agenda-to-appt org-calendar-goto-agenda org-agenda-set-restriction-lock -;;;;;; org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item -;;;;;; org-diary org-agenda-list-stuck-projects org-tags-view org-todo-list -;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views -;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda -;;;;;; org-agenda org-toggle-sticky-agenda) "org-agenda" "org-agenda.el" -;;;;;; (21125 47146)) -;;; Generated autoloads from org-agenda.el - -(autoload 'org-toggle-sticky-agenda "org-agenda" "\ -Toggle `org-agenda-sticky'. - -\(fn &optional ARG)" t nil) - -(autoload 'org-agenda "org-agenda" "\ -Dispatch agenda commands to collect entries to the agenda buffer. -Prompts for a command to execute. Any prefix arg will be passed -on to the selected command. The default selections are: - -a Call `org-agenda-list' to display the agenda for current day or week. -t Call `org-todo-list' to display the global todo list. -T Call `org-todo-list' to display the global todo list, select only - entries with a specific TODO keyword (the user gets a prompt). -m Call `org-tags-view' to display headlines with tags matching - a condition (the user is prompted for the condition). -M Like `m', but select only TODO entries, no ordinary headlines. -L Create a timeline for the current buffer. -e Export views to associated files. -s Search entries for keywords. -S Search entries for keywords, only with TODO keywords. -/ Multi occur across all agenda files and also files listed - in `org-agenda-text-search-extra-files'. -< Restrict agenda commands to buffer, subtree, or region. - Press several times to get the desired effect. -> Remove a previous restriction. -# List \"stuck\" projects. -! Configure what \"stuck\" means. -C Configure custom agenda commands. - -More commands can be added by configuring the variable -`org-agenda-custom-commands'. In particular, specific tags and TODO keyword -searches can be pre-defined in this way. - -If the current buffer is in Org-mode and visiting a file, you can also -first press `<' once to indicate that the agenda should be temporarily -\(until the next use of \\[org-agenda]) restricted to the current file. -Pressing `<' twice means to restrict to the current subtree or region -\(if active). - -\(fn &optional ARG ORG-KEYS RESTRICTION)" t nil) - -(autoload 'org-batch-agenda "org-agenda" "\ -Run an agenda command in batch mode and send the result to STDOUT. -If CMD-KEY is a string of length 1, it is used as a key in -`org-agenda-custom-commands' and triggers this command. If it is a -longer string it is used as a tags/todo match string. -Parameters are alternating variable names and values that will be bound -before running the agenda command. - -\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro)) - -(autoload 'org-batch-agenda-csv "org-agenda" "\ -Run an agenda command in batch mode and send the result to STDOUT. -If CMD-KEY is a string of length 1, it is used as a key in -`org-agenda-custom-commands' and triggers this command. If it is a -longer string it is used as a tags/todo match string. -Parameters are alternating variable names and values that will be bound -before running the agenda command. - -The output gives a line for each selected agenda item. Each -item is a list of comma-separated values, like this: - -category,head,type,todo,tags,date,time,extra,priority-l,priority-n - -category The category of the item -head The headline, without TODO kwd, TAGS and PRIORITY -type The type of the agenda entry, can be - todo selected in TODO match - tagsmatch selected in tags match - diary imported from diary - deadline a deadline on given date - scheduled scheduled on given date - timestamp entry has timestamp on given date - closed entry was closed on given date - upcoming-deadline warning about deadline - past-scheduled forwarded scheduled item - block entry has date block including g. date -todo The todo keyword, if any -tags All tags including inherited ones, separated by colons -date The relevant date, like 2007-2-14 -time The time, like 15:00-16:50 -extra Sting with extra planning info -priority-l The priority letter if any was given -priority-n The computed numerical priority -agenda-day The day in the agenda where this is listed - -\(fn CMD-KEY &rest PARAMETERS)" nil (quote macro)) - -(autoload 'org-store-agenda-views "org-agenda" "\ -Store agenda views. - -\(fn &rest PARAMETERS)" t nil) - -(autoload 'org-batch-store-agenda-views "org-agenda" "\ -Run all custom agenda commands that have a file argument. - -\(fn &rest PARAMETERS)" nil (quote macro)) - -(autoload 'org-agenda-list "org-agenda" "\ -Produce a daily/weekly view from all files in variable `org-agenda-files'. -The view will be for the current day or week, but from the overview buffer -you will be able to go to other days/weeks. - -With a numeric prefix argument in an interactive call, the agenda will -span ARG days. Lisp programs should instead specify SPAN to change -the number of days. SPAN defaults to `org-agenda-span'. - -START-DAY defaults to TODAY, or to the most recent match for the weekday -given in `org-agenda-start-on-weekday'. - -When WITH-HOUR is non-nil, only include scheduled and deadline -items if they have an hour specification like [h]h:mm. - -\(fn &optional ARG START-DAY SPAN WITH-HOUR)" t nil) - -(autoload 'org-search-view "org-agenda" "\ -Show all entries that contain a phrase or words or regular expressions. - -With optional prefix argument TODO-ONLY, only consider entries that are -TODO entries. The argument STRING can be used to pass a default search -string into this function. If EDIT-AT is non-nil, it means that the -user should get a chance to edit this string, with cursor at position -EDIT-AT. - -The search string can be viewed either as a phrase that should be found as -is, or it can be broken into a number of snippets, each of which must match -in a Boolean way to select an entry. The default depends on the variable -`org-agenda-search-view-always-boolean'. -Even if this is turned off (the default) you can always switch to -Boolean search dynamically by preceding the first word with \"+\" or \"-\". - -The default is a direct search of the whole phrase, where each space in -the search string can expand to an arbitrary amount of whitespace, -including newlines. - -If using a Boolean search, the search string is split on whitespace and -each snippet is searched separately, with logical AND to select an entry. -Words prefixed with a minus must *not* occur in the entry. Words without -a prefix or prefixed with a plus must occur in the entry. Matching is -case-insensitive. Words are enclosed by word delimiters (i.e. they must -match whole words, not parts of a word) if -`org-agenda-search-view-force-full-words' is set (default is nil). - -Boolean search snippets enclosed by curly braces are interpreted as -regular expressions that must or (when preceded with \"-\") must not -match in the entry. Snippets enclosed into double quotes will be taken -as a whole, to include whitespace. - -- If the search string starts with an asterisk, search only in headlines. -- If (possibly after the leading star) the search string starts with an - exclamation mark, this also means to look at TODO entries only, an effect - that can also be achieved with a prefix argument. -- If (possibly after star and exclamation mark) the search string starts - with a colon, this will mean that the (non-regexp) snippets of the - Boolean search must match as full words. - -This command searches the agenda files, and in addition the files listed -in `org-agenda-text-search-extra-files'. - -\(fn &optional TODO-ONLY STRING EDIT-AT)" t nil) - -(autoload 'org-todo-list "org-agenda" "\ -Show all (not done) TODO entries from all agenda file in a single list. -The prefix arg can be used to select a specific TODO keyword and limit -the list to these. When using \\[universal-argument], you will be prompted -for a keyword. A numeric prefix directly selects the Nth keyword in -`org-todo-keywords-1'. - -\(fn &optional ARG)" t nil) - -(autoload 'org-tags-view "org-agenda" "\ -Show all headlines for all `org-agenda-files' matching a TAGS criterion. -The prefix arg TODO-ONLY limits the search to TODO entries. - -\(fn &optional TODO-ONLY MATCH)" t nil) - -(autoload 'org-agenda-list-stuck-projects "org-agenda" "\ -Create agenda view for projects that are stuck. -Stuck projects are project that have no next actions. For the definitions -of what a project is and how to check if it stuck, customize the variable -`org-stuck-projects'. - -\(fn &rest IGNORE)" t nil) - -(autoload 'org-diary "org-agenda" "\ -Return diary information from org files. -This function can be used in a \"sexp\" diary entry in the Emacs calendar. -It accesses org files and extracts information from those files to be -listed in the diary. The function accepts arguments specifying what -items should be listed. For a list of arguments allowed here, see the -variable `org-agenda-entry-types'. - -The call in the diary file should look like this: - - &%%(org-diary) ~/path/to/some/orgfile.org - -Use a separate line for each org file to check. Or, if you omit the file name, -all files listed in `org-agenda-files' will be checked automatically: - - &%%(org-diary) - -If you don't give any arguments (as in the example above), the default value -of `org-agenda-entry-types' is used: (:deadline :scheduled :timestamp :sexp). -So the example above may also be written as - - &%%(org-diary :deadline :timestamp :sexp :scheduled) - -The function expects the lisp variables `entry' and `date' to be provided -by the caller, because this is how the calendar works. Don't use this -function from a program - use `org-agenda-get-day-entries' instead. - -\(fn &rest ARGS)" nil nil) - -(autoload 'org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item "org-agenda" "\ -Do we have a reason to ignore this TODO entry because it has a time stamp? - -\(fn &optional END)" nil nil) - -(autoload 'org-agenda-set-restriction-lock "org-agenda" "\ -Set restriction lock for agenda, to current subtree or file. -Restriction will be the file if TYPE is `file', or if type is the -universal prefix '(4), or if the cursor is before the first headline -in the file. Otherwise, restriction will be to the current subtree. - -\(fn &optional TYPE)" t nil) - -(autoload 'org-calendar-goto-agenda "org-agenda" "\ -Compute the Org-mode agenda for the calendar date displayed at the cursor. -This is a command that has to be installed in `calendar-mode-map'. - -\(fn)" t nil) - -(autoload 'org-agenda-to-appt "org-agenda" "\ -Activate appointments found in `org-agenda-files'. -With a \\[universal-argument] prefix, refresh the list of -appointments. - -If FILTER is t, interactively prompt the user for a regular -expression, and filter out entries that don't match it. - -If FILTER is a string, use this string as a regular expression -for filtering entries out. - -If FILTER is a function, filter out entries against which -calling the function returns nil. This function takes one -argument: an entry from `org-agenda-get-day-entries'. - -FILTER can also be an alist with the car of each cell being -either 'headline or 'category. For example: - - '((headline \"IMPORTANT\") - (category \"Work\")) - -will only add headlines containing IMPORTANT or headlines -belonging to the \"Work\" category. - -ARGS are symbols indicating what kind of entries to consider. -By default `org-agenda-to-appt' will use :deadline*, :scheduled* -\(i.e., deadlines and scheduled items with a hh:mm specification) -and :timestamp entries. See the docstring of `org-diary' for -details and examples. - -If an entry has a APPT_WARNTIME property, its value will be used -to override `appt-message-warning-time'. - -\(fn &optional REFRESH FILTER &rest ARGS)" t nil) - -;;;*** - -;;;### (autoloads (org-archive-subtree-default-with-confirmation -;;;;;; org-archive-subtree-default org-toggle-archive-tag org-archive-to-archive-sibling -;;;;;; org-archive-subtree org-add-archive-files) "org-archive" -;;;;;; "org-archive.el" "459396977488bc201173789dc42a9c37") -;;; Generated autoloads from org-archive.el - -(autoload 'org-add-archive-files "org-archive" "\ -Splice the archive files into the list of files. -This implies visiting all these files and finding out what the -archive file is. - -\(fn FILES)" nil nil) - -(autoload 'org-archive-subtree "org-archive" "\ -Move the current subtree to the archive. -The archive can be a certain top-level heading in the current file, or in -a different file. The tree will be moved to that location, the subtree -heading be marked DONE, and the current time will be added. - -When called with prefix argument FIND-DONE, find whole trees without any -open TODO items and archive them (after getting confirmation from the user). -If the cursor is not at a headline when this command is called, try all level -1 trees. If the cursor is on a headline, only try the direct children of -this heading. - -\(fn &optional FIND-DONE)" t nil) - -(autoload 'org-archive-to-archive-sibling "org-archive" "\ -Archive the current heading by moving it under the archive sibling. -The archive sibling is a sibling of the heading with the heading name -`org-archive-sibling-heading' and an `org-archive-tag' tag. If this -sibling does not exist, it will be created at the end of the subtree. - -\(fn)" t nil) - -(autoload 'org-toggle-archive-tag "org-archive" "\ -Toggle the archive tag for the current headline. -With prefix ARG, check all children of current headline and offer tagging -the children that do not contain any open TODO items. - -\(fn &optional FIND-DONE)" t nil) - -(autoload 'org-archive-subtree-default "org-archive" "\ -Archive the current subtree with the default command. -This command is set with the variable `org-archive-default-command'. - -\(fn)" t nil) - -(autoload 'org-archive-subtree-default-with-confirmation "org-archive" "\ -Archive the current subtree with the default command. -This command is set with the variable `org-archive-default-command'. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (org-attach) "org-attach" "org-attach.el" "2acf3dc22dcf986b2dbf07e1c0f4bba4") -;;; Generated autoloads from org-attach.el - -(autoload 'org-attach "org-attach" "\ -The dispatcher for attachment commands. -Shows a list of commands and prompts for another key to execute a command. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (org-bbdb-anniversaries) "org-bbdb" "org-bbdb.el" -;;;;;; "867e99974c8aab087ba115fc8f89e956") -;;; Generated autoloads from org-bbdb.el - -(autoload 'org-bbdb-anniversaries "org-bbdb" "\ -Extract anniversaries from BBDB for display in the agenda. - -\(fn)" nil nil) - -;;;*** - -;;;### (autoloads (org-capture-import-remember-templates org-capture -;;;;;; org-capture-string) "org-capture" "org-capture.el" (21115 -;;;;;; 11994)) -;;; Generated autoloads from org-capture.el - -(autoload 'org-capture-string "org-capture" "\ -Capture STRING with the template selected by KEYS. - -\(fn STRING &optional KEYS)" t nil) - -(autoload 'org-capture "org-capture" "\ -Capture something. -\\<org-capture-mode-map> -This will let you select a template from `org-capture-templates', and then -file the newly captured information. The text is immediately inserted -at the target location, and an indirect buffer is shown where you can -edit it. Pressing \\[org-capture-finalize] brings you back to the previous state -of Emacs, so that you can continue your work. - -When called interactively with a \\[universal-argument] prefix argument GOTO, don't capture -anything, just go to the file/headline where the selected template -stores its notes. With a double prefix argument \\[universal-argument] \\[universal-argument], go to the last note -stored. - -When called with a `C-0' (zero) prefix, insert a template at point. - -ELisp programs can set KEYS to a string associated with a template -in `org-capture-templates'. In this case, interactive selection -will be bypassed. - -If `org-capture-use-agenda-date' is non-nil, capturing from the -agenda will use the date at point as the default date. Then, a -`C-1' prefix will tell the capture process to use the HH:MM time -of the day at point (if any) or the current HH:MM time. - -\(fn &optional GOTO KEYS)" t nil) - -(autoload 'org-capture-import-remember-templates "org-capture" "\ -Set `org-capture-templates' to be similar to `org-remember-templates'. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (org-clock-update-time-maybe org-dblock-write:clocktable -;;;;;; org-clocktable-shift org-clock-report org-clock-get-clocktable -;;;;;; org-clock-remove-overlays org-clock-display org-clock-sum -;;;;;; org-clock-goto org-clock-cancel org-clock-out org-clock-in-last -;;;;;; org-clock-in org-resolve-clocks) "org-clock" "org-clock.el" -;;;;;; "183405e8569b9377eaf55b3eea915a06") -;;; Generated autoloads from org-clock.el - -(autoload 'org-resolve-clocks "org-clock" "\ -Resolve all currently open org-mode clocks. -If `only-dangling-p' is non-nil, only ask to resolve dangling -\(i.e., not currently open and valid) clocks. - -\(fn &optional ONLY-DANGLING-P PROMPT-FN LAST-VALID)" t nil) - -(autoload 'org-clock-in "org-clock" "\ -Start the clock on the current item. -If necessary, clock-out of the currently active clock. -With a prefix argument SELECT (\\[universal-argument]), offer a list of recently clocked -tasks to clock into. When SELECT is \\[universal-argument] \\[universal-argument], clock into the current task -and mark it as the default task, a special task that will always be offered -in the clocking selection, associated with the letter `d'. -When SELECT is \\[universal-argument] \\[universal-argument] \\[universal-argument], clock in by using the last clock-out -time as the start time (see `org-clock-continuously' to -make this the default behavior.) - -\(fn &optional SELECT START-TIME)" t nil) - -(autoload 'org-clock-in-last "org-clock" "\ -Clock in the last closed clocked item. -When already clocking in, send an warning. -With a universal prefix argument, select the task you want to -clock in from the last clocked in tasks. -With two universal prefix arguments, start clocking using the -last clock-out time, if any. -With three universal prefix arguments, interactively prompt -for a todo state to switch to, overriding the existing value -`org-clock-in-switch-to-state'. - -\(fn &optional ARG)" t nil) - -(autoload 'org-clock-out "org-clock" "\ -Stop the currently running clock. -Throw an error if there is no running clock and FAIL-QUIETLY is nil. -With a universal prefix, prompt for a state to switch the clocked out task -to, overriding the existing value of `org-clock-out-switch-to-state'. - -\(fn &optional SWITCH-TO-STATE FAIL-QUIETLY AT-TIME)" t nil) - -(autoload 'org-clock-cancel "org-clock" "\ -Cancel the running clock by removing the start timestamp. - -\(fn)" t nil) - -(autoload 'org-clock-goto "org-clock" "\ -Go to the currently clocked-in entry, or to the most recently clocked one. -With prefix arg SELECT, offer recently clocked tasks for selection. - -\(fn &optional SELECT)" t nil) - -(autoload 'org-clock-sum "org-clock" "\ -Sum the times for each subtree. -Puts the resulting times in minutes as a text property on each headline. -TSTART and TEND can mark a time range to be considered. -HEADLINE-FILTER is a zero-arg function that, if specified, is called for -each headline in the time range with point at the headline. Headlines for -which HEADLINE-FILTER returns nil are excluded from the clock summation. -PROPNAME lets you set a custom text property instead of :org-clock-minutes. - -\(fn &optional TSTART TEND HEADLINE-FILTER PROPNAME)" t nil) - -(autoload 'org-clock-display "org-clock" "\ -Show subtree times in the entire buffer. -If TOTAL-ONLY is non-nil, only show the total time for the entire file -in the echo area. - -Use \\[org-clock-remove-overlays] to remove the subtree times. - -\(fn &optional TOTAL-ONLY)" t nil) - -(autoload 'org-clock-remove-overlays "org-clock" "\ -Remove the occur highlights from the buffer. -BEG and END are ignored. If NOREMOVE is nil, remove this function -from the `before-change-functions' in the current buffer. - -\(fn &optional BEG END NOREMOVE)" t nil) - -(autoload 'org-clock-get-clocktable "org-clock" "\ -Get a formatted clocktable with parameters according to PROPS. -The table is created in a temporary buffer, fully formatted and -fontified, and then returned. - -\(fn &rest PROPS)" nil nil) - -(autoload 'org-clock-report "org-clock" "\ -Create a table containing a report about clocked time. -If the cursor is inside an existing clocktable block, then the table -will be updated. If not, a new clocktable will be inserted. The scope -of the new clock will be subtree when called from within a subtree, and -file elsewhere. - -When called with a prefix argument, move to the first clock table in the -buffer and update it. - -\(fn &optional ARG)" t nil) - -(autoload 'org-clocktable-shift "org-clock" "\ -Try to shift the :block date of the clocktable at point. -Point must be in the #+BEGIN: line of a clocktable, or this function -will throw an error. -DIR is a direction, a symbol `left', `right', `up', or `down'. -Both `left' and `down' shift the block toward the past, `up' and `right' -push it toward the future. -N is the number of shift steps to take. The size of the step depends on -the currently selected interval size. - -\(fn DIR N)" nil nil) - -(autoload 'org-dblock-write:clocktable "org-clock" "\ -Write the standard clocktable. - -\(fn PARAMS)" nil nil) - -(autoload 'org-clock-update-time-maybe "org-clock" "\ -If this is a CLOCK line, update it and return t. -Otherwise, return nil. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (org-agenda-columns org-insert-columns-dblock org-dblock-write:columnview -;;;;;; org-columns-number-to-string org-columns-compute org-columns -;;;;;; org-columns-get-format-and-top-level org-columns-remove-overlays) -;;;;;; "org-colview" "org-colview.el" (21125 47146)) -;;; Generated autoloads from org-colview.el - -(autoload 'org-columns-remove-overlays "org-colview" "\ -Remove all currently active column overlays. - -\(fn)" t nil) - -(autoload 'org-columns-get-format-and-top-level "org-colview" "\ -Not documented - -\(fn)" nil nil) - -(autoload 'org-columns "org-colview" "\ -Turn on column view on an org-mode file. -When COLUMNS-FMT-STRING is non-nil, use it as the column format. - -\(fn &optional COLUMNS-FMT-STRING)" t nil) - -(autoload 'org-columns-compute "org-colview" "\ -Sum the values of property PROPERTY hierarchically, for the entire buffer. - -\(fn PROPERTY)" t nil) - -(autoload 'org-columns-number-to-string "org-colview" "\ -Convert a computed column number to a string value, according to FMT. - -\(fn N FMT &optional PRINTF)" nil nil) - -(autoload 'org-dblock-write:columnview "org-colview" "\ -Write the column view table. -PARAMS is a property list of parameters: - -:width enforce same column widths with <N> specifiers. -:id the :ID: property of the entry where the columns view - should be built. When the symbol `local', call locally. - When `global' call column view with the cursor at the beginning - of the buffer (usually this means that the whole buffer switches - to column view). When \"file:path/to/file.org\", invoke column - view at the start of that file. Otherwise, the ID is located - using `org-id-find'. -:hlines When t, insert a hline before each item. When a number, insert - a hline before each level <= that number. -:vlines When t, make each column a colgroup to enforce vertical lines. -:maxlevel When set to a number, don't capture headlines below this level. -:skip-empty-rows - When t, skip rows where all specifiers other than ITEM are empty. -:format When non-nil, specify the column view format to use. - -\(fn PARAMS)" nil nil) - -(autoload 'org-insert-columns-dblock "org-colview" "\ -Create a dynamic block capturing a column view table. - -\(fn)" t nil) - -(autoload 'org-agenda-columns "org-colview" "\ -Turn on or update column view in the agenda. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (org-check-version) "org-compat" "org-compat.el" -;;;;;; (21115 11994)) -;;; Generated autoloads from org-compat.el - -(autoload 'org-check-version "org-compat" "\ -Try very hard to provide sensible version strings. - -\(fn)" nil (quote macro)) - -;;;*** - -;;;### (autoloads (org-datetree-find-date-create) "org-datetree" -;;;;;; "org-datetree.el" "954f9d30ea6ea9b72b310bba030ca9a4") -;;; Generated autoloads from org-datetree.el - -(autoload 'org-datetree-find-date-create "org-datetree" "\ -Find or create an entry for DATE. -If KEEP-RESTRICTION is non-nil, do not widen the buffer. -When it is nil, the buffer will be widened to make sure an existing date -tree can be found. - -\(fn DATE &optional KEEP-RESTRICTION)" nil nil) - -;;;*** - -;;;### (autoloads (org-element-context org-element-at-point org-element-interpret-data) -;;;;;; "org-element" "org-element.el" "42a311969f9a6740f0212bc9d06ff408") -;;; Generated autoloads from org-element.el - -(autoload 'org-element-interpret-data "org-element" "\ -Interpret DATA as Org syntax. - -DATA is a parse tree, an element, an object or a secondary string -to interpret. - -Optional argument PARENT is used for recursive calls. It contains -the element or object containing data, or nil. - -Return Org syntax as a string. - -\(fn DATA &optional PARENT)" nil nil) - -(autoload 'org-element-at-point "org-element" "\ -Determine closest element around point. - -Return value is a list like (TYPE PROPS) where TYPE is the type -of the element and PROPS a plist of properties associated to the -element. - -Possible types are defined in `org-element-all-elements'. -Properties depend on element or object type, but always include -`:begin', `:end', `:parent' and `:post-blank' properties. - -As a special case, if point is at the very beginning of a list or -sub-list, returned element will be that list instead of the first -item. In the same way, if point is at the beginning of the first -row of a table, returned element will be the table instead of the -first row. - -If optional argument KEEP-TRAIL is non-nil, the function returns -a list of elements leading to element at point. The list's CAR -is always the element at point. The following positions contain -element's siblings, then parents, siblings of parents, until the -first element of current section. - -\(fn &optional KEEP-TRAIL)" nil nil) - -(autoload 'org-element-context "org-element" "\ -Return closest element or object around point. - -Return value is a list like (TYPE PROPS) where TYPE is the type -of the element or object and PROPS a plist of properties -associated to it. - -Possible types are defined in `org-element-all-elements' and -`org-element-all-objects'. Properties depend on element or -object type, but always include `:begin', `:end', `:parent' and -`:post-blank'. - -Optional argument ELEMENT, when non-nil, is the closest element -containing point, as returned by `org-element-at-point'. -Providing it allows for quicker computation. - -\(fn &optional ELEMENT)" nil nil) - -;;;*** - -;;;### (autoloads (org-feed-show-raw-feed org-feed-goto-inbox org-feed-update -;;;;;; org-feed-update-all) "org-feed" "org-feed.el" "f5f190118c0e7321f88972d9a4749f5f") -;;; Generated autoloads from org-feed.el - -(autoload 'org-feed-update-all "org-feed" "\ -Get inbox items from all feeds in `org-feed-alist'. - -\(fn)" t nil) - -(autoload 'org-feed-update "org-feed" "\ -Get inbox items from FEED. -FEED can be a string with an association in `org-feed-alist', or -it can be a list structured like an entry in `org-feed-alist'. - -\(fn FEED &optional RETRIEVE-ONLY)" t nil) - -(autoload 'org-feed-goto-inbox "org-feed" "\ -Go to the inbox that captures the feed named FEED. - -\(fn FEED)" t nil) - -(autoload 'org-feed-show-raw-feed "org-feed" "\ -Show the raw feed buffer of a feed. - -\(fn FEED)" t nil) - -;;;*** - -;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote" -;;;;;; "org-footnote.el" "498ce4bcc019503ef9657f915606b130") -;;; Generated autoloads from org-footnote.el - -(autoload 'org-footnote-action "org-footnote" "\ -Do the right thing for footnotes. - -When at a footnote reference, jump to the definition. - -When at a definition, jump to the references if they exist, offer -to create them otherwise. - -When neither at definition or reference, create a new footnote, -interactively. - -With prefix arg SPECIAL, offer additional commands in a menu. - -\(fn &optional SPECIAL)" t nil) - -(autoload 'org-footnote-normalize "org-footnote" "\ -Collect the footnotes in various formats and normalize them. - -This finds the different sorts of footnotes allowed in Org, and -normalizes them to the usual [N] format. - -When SORT-ONLY is set, only sort the footnote definitions into the -referenced sequence. - -\(fn &optional SORT-ONLY)" nil nil) - -;;;*** - -;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-update-id-locations -;;;;;; org-id-new org-id-find org-id-goto org-id-get-with-outline-drilling -;;;;;; org-id-get-with-outline-path-completion org-id-get org-id-copy -;;;;;; org-id-get-create) "org-id" "org-id.el" "62f25628049e4355bfa47d9ce6068de6") -;;; Generated autoloads from org-id.el - -(autoload 'org-id-get-create "org-id" "\ -Create an ID for the current entry and return it. -If the entry already has an ID, just return it. -With optional argument FORCE, force the creation of a new ID. - -\(fn &optional FORCE)" t nil) - -(autoload 'org-id-copy "org-id" "\ -Copy the ID of the entry at point to the kill ring. -Create an ID if necessary. - -\(fn)" t nil) - -(autoload 'org-id-get "org-id" "\ -Get the ID property of the entry at point-or-marker POM. -If POM is nil, refer to the entry at point. -If the entry does not have an ID, the function returns nil. -However, when CREATE is non nil, create an ID if none is present already. -PREFIX will be passed through to `org-id-new'. -In any case, the ID of the entry is returned. - -\(fn &optional POM CREATE PREFIX)" nil nil) - -(autoload 'org-id-get-with-outline-path-completion "org-id" "\ -Use `outline-path-completion' to retrieve the ID of an entry. -TARGETS may be a setting for `org-refile-targets' to define -eligible headlines. When omitted, all headlines in the current -file are eligible. This function returns the ID of the entry. -If necessary, the ID is created. - -\(fn &optional TARGETS)" nil nil) - -(autoload 'org-id-get-with-outline-drilling "org-id" "\ -Use an outline-cycling interface to retrieve the ID of an entry. -This only finds entries in the current buffer, using `org-get-location'. -It returns the ID of the entry. If necessary, the ID is created. - -\(fn &optional TARGETS)" nil nil) - -(autoload 'org-id-goto "org-id" "\ -Switch to the buffer containing the entry with id ID. -Move the cursor to that entry in that buffer. - -\(fn ID)" t nil) - -(autoload 'org-id-find "org-id" "\ -Return the location of the entry with the id ID. -The return value is a cons cell (file-name . position), or nil -if there is no entry with that ID. -With optional argument MARKERP, return the position as a new marker. - -\(fn ID &optional MARKERP)" nil nil) - -(autoload 'org-id-new "org-id" "\ -Create a new globally unique ID. - -An ID consists of two parts separated by a colon: -- a prefix -- a unique part that will be created according to `org-id-method'. - -PREFIX can specify the prefix, the default is given by the variable -`org-id-prefix'. However, if PREFIX is the symbol `none', don't use any -prefix even if `org-id-prefix' specifies one. - -So a typical ID could look like \"Org:4nd91V40HI\". - -\(fn &optional PREFIX)" nil nil) - -(autoload 'org-id-update-id-locations "org-id" "\ -Scan relevant files for IDs. -Store the relation between files and corresponding IDs. -This will scan all agenda files, all associated archives, and all -files currently mentioned in `org-id-locations'. -When FILES is given, scan these files instead. -When CHECK is given, prepare detailed information about duplicate IDs. - -\(fn &optional FILES SILENT)" t nil) - -(autoload 'org-id-find-id-file "org-id" "\ -Query the id database for the file in which this ID is located. - -\(fn ID)" nil nil) - -(autoload 'org-id-store-link "org-id" "\ -Store a link to the current entry, using its ID. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (org-indent-mode) "org-indent" "org-indent.el" -;;;;;; "5257f4635c377537f302a83dc69419dd") -;;; Generated autoloads from org-indent.el - -(autoload 'org-indent-mode "org-indent" "\ -When active, indent text according to outline structure. - -Internally this works by adding `line-prefix' and `wrap-prefix' -properties, after each buffer modification, on the modified zone. - -The process is synchronous. Though, initial indentation of -buffer, which can take a few seconds on large buffers, is done -during idle time. - -\(fn &optional ARG)" t nil) - -;;;*** - -;;;### (autoloads (org-irc-store-link) "org-irc" "org-irc.el" "f5d45d21f475b63408f333384ce1cc61") -;;; Generated autoloads from org-irc.el - -(autoload 'org-irc-store-link "org-irc" "\ -Dispatch to the appropriate function to store a link to an IRC session. - -\(fn)" nil nil) - -;;;*** - -;;;### (autoloads (org-load-noerror-mustsuffix) "org-macs" "org-macs.el" -;;;;;; (21125 47146)) -;;; Generated autoloads from org-macs.el - -(autoload 'org-load-noerror-mustsuffix "org-macs" "\ -Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it. - -\(fn FILE)" nil (quote macro)) - -;;;*** - -;;;### (autoloads (org-mobile-pull org-mobile-push) "org-mobile" -;;;;;; "org-mobile.el" "c69640ad752b53de4ac6874cbf252ec2") -;;; Generated autoloads from org-mobile.el - -(autoload 'org-mobile-push "org-mobile" "\ -Push the current state of Org affairs to the target directory. -This will create the index file, copy all agenda files there, and also -create all custom agenda views, for upload to the mobile phone. - -\(fn)" t nil) - -(autoload 'org-mobile-pull "org-mobile" "\ -Pull the contents of `org-mobile-capture-file' and integrate them. -Apply all flagged actions, flag entries to be flagged and then call an -agenda view showing the flagged items. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (org-plot/gnuplot) "org-plot" "org-plot.el" "99a279b8b25fe56779d7c49fc617f1bf") -;;; Generated autoloads from org-plot.el - -(autoload 'org-plot/gnuplot "org-plot" "\ -Plot table using gnuplot. Gnuplot options can be specified with PARAMS. -If not given options will be taken from the +PLOT -line directly before or after the table. - -\(fn &optional PARAMS)" t nil) - -;;;*** - -;;;### (autoloads (orgtbl-to-orgtbl orgtbl-to-texinfo orgtbl-to-html -;;;;;; orgtbl-to-latex orgtbl-to-csv orgtbl-to-tsv orgtbl-to-generic -;;;;;; org-table-to-lisp orgtbl-mode org-table-toggle-formula-debugger -;;;;;; org-table-toggle-coordinate-overlays org-table-edit-formulas -;;;;;; org-table-iterate-buffer-tables org-table-recalculate-buffer-tables -;;;;;; org-table-iterate org-table-recalculate org-table-set-constants -;;;;;; org-table-eval-formula org-table-maybe-recalculate-line org-table-rotate-recalc-marks -;;;;;; org-table-maybe-eval-formula org-table-get-stored-formulas -;;;;;; org-table-sum org-table-edit-field org-table-wrap-region -;;;;;; org-table-convert org-table-paste-rectangle org-table-copy-region -;;;;;; org-table-cut-region org-table-sort-lines org-table-kill-row -;;;;;; org-table-hline-and-move org-table-insert-hline org-table-insert-row -;;;;;; org-table-move-row org-table-move-row-up org-table-move-row-down -;;;;;; org-table-move-column org-table-move-column-left org-table-move-column-right -;;;;;; org-table-delete-column org-table-insert-column org-table-goto-column -;;;;;; org-table-current-dline org-table-field-info org-table-blank-field -;;;;;; org-table-copy-down org-table-next-row org-table-previous-field -;;;;;; org-table-next-field org-table-justify-field-maybe org-table-end -;;;;;; org-table-begin org-table-align org-table-export org-table-import -;;;;;; org-table-convert-region org-table-create org-table-create-or-convert-from-region -;;;;;; org-table-create-with-table\.el) "org-table" "org-table.el" -;;;;;; "f0f693017b9d0664b74f5f59a58195e5") -;;; Generated autoloads from org-table.el - -(autoload 'org-table-create-with-table\.el "org-table" "\ -Use the table.el package to insert a new table. -If there is already a table at point, convert between Org-mode tables -and table.el tables. - -\(fn)" t nil) - -(autoload 'org-table-create-or-convert-from-region "org-table" "\ -Convert region to table, or create an empty table. -If there is an active region, convert it to a table, using the function -`org-table-convert-region'. See the documentation of that function -to learn how the prefix argument is interpreted to determine the field -separator. -If there is no such region, create an empty table with `org-table-create'. - -\(fn ARG)" t nil) - -(autoload 'org-table-create "org-table" "\ -Query for a size and insert a table skeleton. -SIZE is a string Columns x Rows like for example \"3x2\". - -\(fn &optional SIZE)" t nil) - -(autoload 'org-table-convert-region "org-table" "\ -Convert region to a table. -The region goes from BEG0 to END0, but these borders will be moved -slightly, to make sure a beginning of line in the first line is included. - -SEPARATOR specifies the field separator in the lines. It can have the -following values: - -'(4) Use the comma as a field separator -'(16) Use a TAB as field separator -integer When a number, use that many spaces as field separator -nil When nil, the command tries to be smart and figure out the - separator in the following way: - - when each line contains a TAB, assume TAB-separated material - - when each line contains a comma, assume CSV material - - else, assume one or more SPACE characters as separator. - -\(fn BEG0 END0 &optional SEPARATOR)" t nil) - -(autoload 'org-table-import "org-table" "\ -Import FILE as a table. -The file is assumed to be tab-separated. Such files can be produced by most -spreadsheet and database applications. If no tabs (at least one per line) -are found, lines will be split on whitespace into fields. - -\(fn FILE ARG)" t nil) - -(autoload 'org-table-export "org-table" "\ -Export table to a file, with configurable format. -Such a file can be imported into usual spreadsheet programs. - -FILE can be the output file name. If not given, it will be taken -from a TABLE_EXPORT_FILE property in the current entry or higher -up in the hierarchy, or the user will be prompted for a file -name. FORMAT can be an export format, of the same kind as it -used when `orgtbl-mode' sends a table in a different format. - -The command suggests a format depending on TABLE_EXPORT_FORMAT, -whether it is set locally or up in the hierarchy, then on the -extension of the given file name, and finally on the variable -`org-table-export-default-format'. - -\(fn &optional FILE FORMAT)" t nil) - -(autoload 'org-table-align "org-table" "\ -Align the table at point by aligning all vertical bars. - -\(fn)" t nil) - -(autoload 'org-table-begin "org-table" "\ -Find the beginning of the table and return its position. -With argument TABLE-TYPE, go to the beginning of a table.el-type table. - -\(fn &optional TABLE-TYPE)" nil nil) - -(autoload 'org-table-end "org-table" "\ -Find the end of the table and return its position. -With argument TABLE-TYPE, go to the end of a table.el-type table. - -\(fn &optional TABLE-TYPE)" nil nil) - -(autoload 'org-table-justify-field-maybe "org-table" "\ -Justify the current field, text to left, number to right. -Optional argument NEW may specify text to replace the current field content. - -\(fn &optional NEW)" nil nil) - -(autoload 'org-table-next-field "org-table" "\ -Go to the next field in the current table, creating new lines as needed. -Before doing so, re-align the table if necessary. - -\(fn)" t nil) - -(autoload 'org-table-previous-field "org-table" "\ -Go to the previous field in the table. -Before doing so, re-align the table if necessary. - -\(fn)" t nil) - -(autoload 'org-table-next-row "org-table" "\ -Go to the next row (same column) in the current table. -Before doing so, re-align the table if necessary. - -\(fn)" t nil) - -(autoload 'org-table-copy-down "org-table" "\ -Copy a field down in the current column. -If the field at the cursor is empty, copy into it the content of -the nearest non-empty field above. With argument N, use the Nth -non-empty field. If the current field is not empty, it is copied -down to the next row, and the cursor is moved with it. -Therefore, repeating this command causes the column to be filled -row-by-row. -If the variable `org-table-copy-increment' is non-nil and the -field is an integer or a timestamp, it will be incremented while -copying. In the case of a timestamp, increment by one day. - -\(fn N)" t nil) - -(autoload 'org-table-blank-field "org-table" "\ -Blank the current table field or active region. - -\(fn)" t nil) - -(autoload 'org-table-field-info "org-table" "\ -Show info about the current field, and highlight any reference at point. - -\(fn ARG)" t nil) - -(autoload 'org-table-current-dline "org-table" "\ -Find out what table data line we are in. -Only data lines count for this. - -\(fn)" t nil) - -(autoload 'org-table-goto-column "org-table" "\ -Move the cursor to the Nth column in the current table line. -With optional argument ON-DELIM, stop with point before the left delimiter -of the field. -If there are less than N fields, just go to after the last delimiter. -However, when FORCE is non-nil, create new columns if necessary. - -\(fn N &optional ON-DELIM FORCE)" t nil) - -(autoload 'org-table-insert-column "org-table" "\ -Insert a new column into the table. - -\(fn)" t nil) - -(autoload 'org-table-delete-column "org-table" "\ -Delete a column from the table. - -\(fn)" t nil) - -(autoload 'org-table-move-column-right "org-table" "\ -Move column to the right. - -\(fn)" t nil) - -(autoload 'org-table-move-column-left "org-table" "\ -Move column to the left. - -\(fn)" t nil) - -(autoload 'org-table-move-column "org-table" "\ -Move the current column to the right. With arg LEFT, move to the left. - -\(fn &optional LEFT)" t nil) - -(autoload 'org-table-move-row-down "org-table" "\ -Move table row down. - -\(fn)" t nil) - -(autoload 'org-table-move-row-up "org-table" "\ -Move table row up. - -\(fn)" t nil) - -(autoload 'org-table-move-row "org-table" "\ -Move the current table line down. With arg UP, move it up. - -\(fn &optional UP)" t nil) - -(autoload 'org-table-insert-row "org-table" "\ -Insert a new row above the current line into the table. -With prefix ARG, insert below the current line. - -\(fn &optional ARG)" t nil) - -(autoload 'org-table-insert-hline "org-table" "\ -Insert a horizontal-line below the current line into the table. -With prefix ABOVE, insert above the current line. - -\(fn &optional ABOVE)" t nil) - -(autoload 'org-table-hline-and-move "org-table" "\ -Insert a hline and move to the row below that line. - -\(fn &optional SAME-COLUMN)" t nil) - -(autoload 'org-table-kill-row "org-table" "\ -Delete the current row or horizontal line from the table. - -\(fn)" t nil) - -(autoload 'org-table-sort-lines "org-table" "\ -Sort table lines according to the column at point. - -The position of point indicates the column to be used for -sorting, and the range of lines is the range between the nearest -horizontal separator lines, or the entire table of no such lines -exist. If point is before the first column, you will be prompted -for the sorting column. If there is an active region, the mark -specifies the first line and the sorting column, while point -should be in the last line to be included into the sorting. - -The command then prompts for the sorting type which can be -alphabetically, numerically, or by time (as given in a time stamp -in the field). Sorting in reverse order is also possible. - -With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive. - -If SORTING-TYPE is specified when this function is called from a Lisp -program, no prompting will take place. SORTING-TYPE must be a character, -any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting -should be done in reverse order. - -\(fn WITH-CASE &optional SORTING-TYPE)" t nil) - -(autoload 'org-table-cut-region "org-table" "\ -Copy region in table to the clipboard and blank all relevant fields. -If there is no active region, use just the field at point. - -\(fn BEG END)" t nil) - -(autoload 'org-table-copy-region "org-table" "\ -Copy rectangular region in table to clipboard. -A special clipboard is used which can only be accessed -with `org-table-paste-rectangle'. - -\(fn BEG END &optional CUT)" t nil) - -(autoload 'org-table-paste-rectangle "org-table" "\ -Paste a rectangular region into a table. -The upper right corner ends up in the current field. All involved fields -will be overwritten. If the rectangle does not fit into the present table, -the table is enlarged as needed. The process ignores horizontal separator -lines. - -\(fn)" t nil) - -(autoload 'org-table-convert "org-table" "\ -Convert from `org-mode' table to table.el and back. -Obviously, this only works within limits. When an Org-mode table is -converted to table.el, all horizontal separator lines get lost, because -table.el uses these as cell boundaries and has no notion of horizontal lines. -A table.el table can be converted to an Org-mode table only if it does not -do row or column spanning. Multiline cells will become multiple cells. -Beware, Org-mode does not test if the table can be successfully converted - it -blindly applies a recipe that works for simple tables. - -\(fn)" t nil) - -(autoload 'org-table-wrap-region "org-table" "\ -Wrap several fields in a column like a paragraph. -This is useful if you'd like to spread the contents of a field over several -lines, in order to keep the table compact. - -If there is an active region, and both point and mark are in the same column, -the text in the column is wrapped to minimum width for the given number of -lines. Generally, this makes the table more compact. A prefix ARG may be -used to change the number of desired lines. For example, `C-2 \\[org-table-wrap]' -formats the selected text to two lines. If the region was longer than two -lines, the remaining lines remain empty. A negative prefix argument reduces -the current number of lines by that amount. The wrapped text is pasted back -into the table. If you formatted it to more lines than it was before, fields -further down in the table get overwritten - so you might need to make space in -the table first. - -If there is no region, the current field is split at the cursor position and -the text fragment to the right of the cursor is prepended to the field one -line down. - -If there is no region, but you specify a prefix ARG, the current field gets -blank, and the content is appended to the field above. - -\(fn ARG)" t nil) - -(autoload 'org-table-edit-field "org-table" "\ -Edit table field in a different window. -This is mainly useful for fields that contain hidden parts. -When called with a \\[universal-argument] prefix, just make the full field visible so that -it can be edited in place. - -\(fn ARG)" t nil) - -(autoload 'org-table-sum "org-table" "\ -Sum numbers in region of current table column. -The result will be displayed in the echo area, and will be available -as kill to be inserted with \\[yank]. - -If there is an active region, it is interpreted as a rectangle and all -numbers in that rectangle will be summed. If there is no active -region and point is located in a table column, sum all numbers in that -column. - -If at least one number looks like a time HH:MM or HH:MM:SS, all other -numbers are assumed to be times as well (in decimal hours) and the -numbers are added as such. - -If NLAST is a number, only the NLAST fields will actually be summed. - -\(fn &optional BEG END NLAST)" t nil) - -(autoload 'org-table-get-stored-formulas "org-table" "\ -Return an alist with the stored formulas directly after current table. - -\(fn &optional NOERROR)" t nil) - -(autoload 'org-table-maybe-eval-formula "org-table" "\ -Check if the current field starts with \"=\" or \":=\". -If yes, store the formula and apply it. - -\(fn)" nil nil) - -(autoload 'org-table-rotate-recalc-marks "org-table" "\ -Rotate the recalculation mark in the first column. -If in any row, the first field is not consistent with a mark, -insert a new column for the markers. -When there is an active region, change all the lines in the region, -after prompting for the marking character. -After each change, a message will be displayed indicating the meaning -of the new mark. - -\(fn &optional NEWCHAR)" t nil) - -(autoload 'org-table-maybe-recalculate-line "org-table" "\ -Recompute the current line if marked for it, and if we haven't just done it. - -\(fn)" t nil) - -(autoload 'org-table-eval-formula "org-table" "\ -Replace the table field value at the cursor by the result of a calculation. - -This function makes use of Dave Gillespie's Calc package, in my view the -most exciting program ever written for GNU Emacs. So you need to have Calc -installed in order to use this function. - -In a table, this command replaces the value in the current field with the -result of a formula. It also installs the formula as the \"current\" column -formula, by storing it in a special line below the table. When called -with a `C-u' prefix, the current field must be a named field, and the -formula is installed as valid in only this specific field. - -When called with two `C-u' prefixes, insert the active equation -for the field back into the current field, so that it can be -edited there. This is useful in order to use \\[org-table-show-reference] -to check the referenced fields. - -When called, the command first prompts for a formula, which is read in -the minibuffer. Previously entered formulas are available through the -history list, and the last used formula is offered as a default. -These stored formulas are adapted correctly when moving, inserting, or -deleting columns with the corresponding commands. - -The formula can be any algebraic expression understood by the Calc package. -For details, see the Org-mode manual. - -This function can also be called from Lisp programs and offers -additional arguments: EQUATION can be the formula to apply. If this -argument is given, the user will not be prompted. SUPPRESS-ALIGN is -used to speed-up recursive calls by by-passing unnecessary aligns. -SUPPRESS-CONST suppresses the interpretation of constants in the -formula, assuming that this has been done already outside the function. -SUPPRESS-STORE means the formula should not be stored, either because -it is already stored, or because it is a modified equation that should -not overwrite the stored one. - -\(fn &optional ARG EQUATION SUPPRESS-ALIGN SUPPRESS-CONST SUPPRESS-STORE SUPPRESS-ANALYSIS)" t nil) - -(autoload 'org-table-set-constants "org-table" "\ -Set `org-table-formula-constants-local' in the current buffer. - -\(fn)" nil nil) - -(autoload 'org-table-recalculate "org-table" "\ -Recalculate the current table line by applying all stored formulas. -With prefix arg ALL, do this for all lines in the table. -With the prefix argument ALL is `(16)' (a double \\[universal-prefix] \\[universal-prefix] prefix), or if -it is the symbol `iterate', recompute the table until it no longer changes. -If NOALIGN is not nil, do not re-align the table after the computations -are done. This is typically used internally to save time, if it is -known that the table will be realigned a little later anyway. - -\(fn &optional ALL NOALIGN)" t nil) - -(autoload 'org-table-iterate "org-table" "\ -Recalculate the table until it does not change anymore. -The maximum number of iterations is 10, but you can choose a different value -with the prefix ARG. - -\(fn &optional ARG)" t nil) - -(autoload 'org-table-recalculate-buffer-tables "org-table" "\ -Recalculate all tables in the current buffer. - -\(fn)" t nil) - -(autoload 'org-table-iterate-buffer-tables "org-table" "\ -Iterate all tables in the buffer, to converge inter-table dependencies. - -\(fn)" t nil) - -(autoload 'org-table-edit-formulas "org-table" "\ -Edit the formulas of the current table in a separate buffer. - -\(fn)" t nil) - -(autoload 'org-table-toggle-coordinate-overlays "org-table" "\ -Toggle the display of Row/Column numbers in tables. - -\(fn)" t nil) - -(autoload 'org-table-toggle-formula-debugger "org-table" "\ -Toggle the formula debugger in tables. - -\(fn)" t nil) - -(autoload 'orgtbl-mode "org-table" "\ -The `org-mode' table editor as a minor mode for use in other modes. - -\(fn &optional ARG)" t nil) - -(autoload 'org-table-to-lisp "org-table" "\ -Convert the table at point to a Lisp structure. -The structure will be a list. Each item is either the symbol `hline' -for a horizontal separator line, or a list of field values as strings. -The table is taken from the parameter TXT, or from the buffer at point. - -\(fn &optional TXT)" nil nil) - -(autoload 'orgtbl-to-generic "org-table" "\ -Convert the orgtbl-mode TABLE to some other format. -This generic routine can be used for many standard cases. -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. -A third optional argument BACKEND can be used to convert the content of -the cells using a specific export back-end. - -For the generic converter, some parameters are obligatory: you need to -specify either :lfmt, or all of (:lstart :lend :sep). - -Valid parameters are: - -:splice When set to t, return only table body lines, don't wrap - them into :tstart and :tend. Default is nil. When :splice - is non-nil, this also means that the exporter should not look - for and interpret header and footer sections. - -:hline String to be inserted on horizontal separation lines. - May be nil to ignore hlines. - -:sep Separator between two fields -:remove-nil-lines Do not include lines that evaluate to nil. - -Each in the following group may be either a string or a function -of no arguments returning a string: - -:tstart String to start the table. Ignored when :splice is t. -:tend String to end the table. Ignored when :splice is t. -:lstart String to start a new table line. -:llstart String to start the last table line, defaults to :lstart. -:lend String to end a table line -:llend String to end the last table line, defaults to :lend. - -Each in the following group may be a string, a function of one -argument (the field or line) returning a string, or a plist -mapping columns to either of the above: - -:lfmt Format for entire line, with enough %s to capture all fields. - If this is present, :lstart, :lend, and :sep are ignored. -:llfmt Format for the entire last line, defaults to :lfmt. -:fmt A format to be used to wrap the field, should contain - %s for the original field value. For example, to wrap - everything in dollars, you could use :fmt \"$%s$\". - This may also be a property list with column numbers and - formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\") -:hlstart :hllstart :hlend :hllend :hlsep :hlfmt :hllfmt :hfmt - Same as above, specific for the header lines in the table. - All lines before the first hline are treated as header. - If any of these is not present, the data line value is used. - -This may be either a string or a function of two arguments: - -:efmt Use this format to print numbers with exponentials. - The format should have %s twice for inserting mantissa - and exponent, for example \"%s\\\\times10^{%s}\". This - may also be a property list with column numbers and - formats. :fmt will still be applied after :efmt. - -In addition to this, the parameters :skip and :skipcols are always handled -directly by `orgtbl-send-table'. See manual. - -\(fn TABLE PARAMS &optional BACKEND)" nil nil) - -(autoload 'orgtbl-to-tsv "org-table" "\ -Convert the orgtbl-mode table to TAB separated material. - -\(fn TABLE PARAMS)" nil nil) - -(autoload 'orgtbl-to-csv "org-table" "\ -Convert the orgtbl-mode table to CSV material. -This does take care of the proper quoting of fields with comma or quotes. - -\(fn TABLE PARAMS)" nil nil) - -(autoload 'orgtbl-to-latex "org-table" "\ -Convert the orgtbl-mode TABLE to LaTeX. -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. -Supports all parameters from `orgtbl-to-generic'. Most important for -LaTeX are: - -:splice When set to t, return only table body lines, don't wrap - them into a tabular environment. Default is nil. - -:fmt A format to be used to wrap the field, should contain %s for the - original field value. For example, to wrap everything in dollars, - use :fmt \"$%s$\". This may also be a property list with column - numbers and formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\") - The format may also be a function that formats its one argument. - -:efmt Format for transforming numbers with exponentials. The format - should have %s twice for inserting mantissa and exponent, for - example \"%s\\\\times10^{%s}\". LaTeX default is \"%s\\\\,(%s)\". - This may also be a property list with column numbers and formats. - The format may also be a function that formats its two arguments. - -:llend If you find too much space below the last line of a table, - pass a value of \"\" for :llend to suppress the final \\\\. - -The general parameters :skip and :skipcols have already been applied when -this function is called. - -\(fn TABLE PARAMS)" nil nil) - -(autoload 'orgtbl-to-html "org-table" "\ -Convert the orgtbl-mode TABLE to HTML. -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. -Currently this function recognizes the following parameters: - -:splice When set to t, return only table body lines, don't wrap - them into a <table> environment. Default is nil. - -The general parameters :skip and :skipcols have already been applied when -this function is called. The function does *not* use `orgtbl-to-generic', -so you cannot specify parameters for it. - -\(fn TABLE PARAMS)" nil nil) - -(autoload 'orgtbl-to-texinfo "org-table" "\ -Convert the orgtbl-mode TABLE to TeXInfo. -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. -Supports all parameters from `orgtbl-to-generic'. Most important for -TeXInfo are: - -:splice nil/t When set to t, return only table body lines, don't wrap - them into a multitable environment. Default is nil. - -:fmt fmt A format to be used to wrap the field, should contain - %s for the original field value. For example, to wrap - everything in @kbd{}, you could use :fmt \"@kbd{%s}\". - This may also be a property list with column numbers and - formats. For example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). - Each format also may be a function that formats its one - argument. - -:cf \"f1 f2..\" The column fractions for the table. By default these - are computed automatically from the width of the columns - under org-mode. - -The general parameters :skip and :skipcols have already been applied when -this function is called. - -\(fn TABLE PARAMS)" nil nil) - -(autoload 'orgtbl-to-orgtbl "org-table" "\ -Convert the orgtbl-mode TABLE into another orgtbl-mode table. -Useful when slicing one table into many. The :hline, :sep, -:lstart, and :lend provide orgtbl framing. The default nil :tstart -and :tend suppress strings without splicing; they can be set to -provide ORGTBL directives for the generated table. - -\(fn TABLE PARAMS)" nil nil) - -;;;*** - -;;;### (autoloads (org-timer-set-timer org-timer-item org-timer-change-times-in-region -;;;;;; org-timer org-timer-start) "org-timer" "org-timer.el" "c0a04a9b6c18954e7eadb2f39ca2e805") -;;; Generated autoloads from org-timer.el - -(autoload 'org-timer-start "org-timer" "\ -Set the starting time for the relative timer to now. -When called with prefix argument OFFSET, prompt the user for an offset time, -with the default taken from a timer stamp at point, if any. -If OFFSET is a string or an integer, it is directly taken to be the offset -without user interaction. -When called with a double prefix arg, all timer strings in the active -region will be shifted by a specific amount. You will be prompted for -the amount, with the default to make the first timer string in -the region 0:00:00. - -\(fn &optional OFFSET)" t nil) - -(autoload 'org-timer "org-timer" "\ -Insert a H:MM:SS string from the timer into the buffer. -The first time this command is used, the timer is started. When used with -a \\[universal-argument] prefix, force restarting the timer. -When used with a double prefix argument \\[universal-argument], change all the timer string -in the region by a fixed amount. This can be used to recalibrate a timer -that was not started at the correct moment. - -If NO-INSERT-P is non-nil, return the string instead of inserting -it in the buffer. - -\(fn &optional RESTART NO-INSERT-P)" t nil) - -(autoload 'org-timer-change-times-in-region "org-timer" "\ -Change all h:mm:ss time in region by a DELTA. - -\(fn BEG END DELTA)" t nil) - -(autoload 'org-timer-item "org-timer" "\ -Insert a description-type item with the current timer value. - -\(fn &optional ARG)" t nil) - -(autoload 'org-timer-set-timer "org-timer" "\ -Prompt for a duration and set a timer. - -If `org-timer-default-timer' is not zero, suggest this value as -the default duration for the timer. If a timer is already set, -prompt the user if she wants to replace it. - -Called with a numeric prefix argument, use this numeric value as -the duration of the timer. - -Called with a `C-u' prefix arguments, use `org-timer-default-timer' -without prompting the user for a duration. - -With two `C-u' prefix arguments, use `org-timer-default-timer' -without prompting the user for a duration and automatically -replace any running timer. - -\(fn &optional OPT)" t nil) - -;;;*** - -;;;### (autoloads (org-git-version org-release) "org-version" "org-version.el" -;;;;;; (21139 43013)) -;;; Generated autoloads from org-version.el - -(autoload 'org-release "org-version" "\ -The release version of org-mode. - Inserted by installing org-mode or when a release is made. - -\(fn)" nil nil) - -(autoload 'org-git-version "org-version" "\ -The Git version of org-mode. - Inserted by installing org-mode or when a release is made. - -\(fn)" nil nil) - -(defvar org-odt-data-dir "/usr/share/emacs/etc/org" "\ -The location of ODT styles.") - -;;;*** - -;;;### (autoloads (org-customize org-reload org-submit-bug-report -;;;;;; org-cycle-agenda-files org-switchb org-open-link-from-string -;;;;;; org-open-at-point-global org-insert-link-global org-store-link -;;;;;; org-run-like-in-org-mode turn-on-orgstruct++ turn-on-orgstruct -;;;;;; orgstruct-mode org-global-cycle org-cycle org-mode org-clock-persistence-insinuate -;;;;;; turn-on-orgtbl org-version org-babel-load-file org-babel-do-load-languages) -;;;;;; "org" "org.el" (21125 47146)) -;;; Generated autoloads from org.el - -(autoload 'org-babel-do-load-languages "org" "\ -Load the languages defined in `org-babel-load-languages'. - -\(fn SYM VALUE)" nil nil) - -(autoload 'org-babel-load-file "org" "\ -Load Emacs Lisp source code blocks in the Org-mode FILE. -This function exports the source code using `org-babel-tangle' -and then loads the resulting file using `load-file'. With prefix -arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp -file to byte-code before it is loaded. - -\(fn FILE &optional COMPILE)" t nil) - -(autoload 'org-version "org" "\ -Show the org-mode version in the echo area. -With prefix argument HERE, insert it at point. -When FULL is non-nil, use a verbose version string. -When MESSAGE is non-nil, display a message with the version. - -\(fn &optional HERE FULL MESSAGE)" t nil) - -(autoload 'turn-on-orgtbl "org" "\ -Unconditionally turn on `orgtbl-mode'. - -\(fn)" nil nil) - -(autoload 'org-clock-persistence-insinuate "org" "\ -Set up hooks for clock persistence. - -\(fn)" nil nil) - -(autoload 'org-mode "org" "\ -Outline-based notes management and organizer, alias -\"Carsten's outline-mode for keeping track of everything.\" - -Org-mode develops organizational tasks around a NOTES file which -contains information about projects as plain text. Org-mode is -implemented on top of outline-mode, which is ideal to keep the content -of large files well structured. It supports ToDo items, deadlines and -time stamps, which magically appear in the diary listing of the Emacs -calendar. Tables are easily created with a built-in table editor. -Plain text URL-like links connect to websites, emails (VM), Usenet -messages (Gnus), BBDB entries, and any files related to the project. -For printing and sharing of notes, an Org-mode file (or a part of it) -can be exported as a structured ASCII or HTML file. - -The following commands are available: - -\\{org-mode-map} - -\(fn)" t nil) - -(autoload 'org-cycle "org" "\ -TAB-action and visibility cycling for Org-mode. - -This is the command invoked in Org-mode by the TAB key. Its main purpose -is outline visibility cycling, but it also invokes other actions -in special contexts. - -- When this function is called with a prefix argument, rotate the entire - buffer through 3 states (global cycling) - 1. OVERVIEW: Show only top-level headlines. - 2. CONTENTS: Show all headlines of all levels, but no body text. - 3. SHOW ALL: Show everything. - When called with two `C-u C-u' prefixes, switch to the startup visibility, - determined by the variable `org-startup-folded', and by any VISIBILITY - properties in the buffer. - When called with three `C-u C-u C-u' prefixed, show the entire buffer, - including any drawers. - -- When inside a table, re-align the table and move to the next field. - -- When point is at the beginning of a headline, rotate the subtree started - by this line through 3 different states (local cycling) - 1. FOLDED: Only the main headline is shown. - 2. CHILDREN: The main headline and the direct children are shown. - From this state, you can move to one of the children - and zoom in further. - 3. SUBTREE: Show the entire subtree, including body text. - If there is no subtree, switch directly from CHILDREN to FOLDED. - -- When point is at the beginning of an empty headline and the variable - `org-cycle-level-after-item/entry-creation' is set, cycle the level - of the headline by demoting and promoting it to likely levels. This - speeds up creation document structure by pressing TAB once or several - times right after creating a new headline. - -- When there is a numeric prefix, go up to a heading with level ARG, do - a `show-subtree' and return to the previous cursor position. If ARG - is negative, go up that many levels. - -- When point is not at the beginning of a headline, execute the global - binding for TAB, which is re-indenting the line. See the option - `org-cycle-emulate-tab' for details. - -- Special case: if point is at the beginning of the buffer and there is - no headline in line 1, this function will act as if called with prefix arg - (C-u TAB, same as S-TAB) also when called without prefix arg. - But only if also the variable `org-cycle-global-at-bob' is t. - -\(fn &optional ARG)" t nil) - -(autoload 'org-global-cycle "org" "\ -Cycle the global visibility. For details see `org-cycle'. -With \\[universal-argument] prefix arg, switch to startup visibility. -With a numeric prefix, show all headlines up to that level. - -\(fn &optional ARG)" t nil) -(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp) - -(autoload 'orgstruct-mode "org" "\ -Toggle the minor mode `orgstruct-mode'. -This mode is for using Org-mode structure commands in other -modes. The following keys behave as if Org-mode were active, if -the cursor is on a headline, or on a plain list item (both as -defined by Org-mode). - -\(fn &optional ARG)" t nil) - -(autoload 'turn-on-orgstruct "org" "\ -Unconditionally turn on `orgstruct-mode'. - -\(fn)" nil nil) - -(autoload 'turn-on-orgstruct++ "org" "\ -Unconditionally turn on `orgstruct++-mode'. - -\(fn)" nil nil) - -(autoload 'org-run-like-in-org-mode "org" "\ -Run a command, pretending that the current buffer is in Org-mode. -This will temporarily bind local variables that are typically bound in -Org-mode to the values they have in Org-mode, and then interactively -call CMD. - -\(fn CMD)" nil nil) - -(autoload 'org-store-link "org" "\ -\\<org-mode-map>Store an org-link to the current location. -This link is added to `org-stored-links' and can later be inserted -into an org-buffer with \\[org-insert-link]. - -For some link types, a prefix arg is interpreted. -For links to Usenet articles, arg negates `org-gnus-prefer-web-links'. -For file links, arg negates `org-context-in-file-links'. - -A double prefix arg force skipping storing functions that are not -part of Org's core. - -A triple prefix arg force storing a link for each line in the -active region. - -\(fn ARG)" t nil) - -(autoload 'org-insert-link-global "org" "\ -Insert a link like Org-mode does. -This command can be called in any mode to insert a link in Org-mode syntax. - -\(fn)" t nil) - -(autoload 'org-open-at-point-global "org" "\ -Follow a link like Org-mode does. -This command can be called in any mode to follow a link that has -Org-mode syntax. - -\(fn)" t nil) - -(autoload 'org-open-link-from-string "org" "\ -Open a link in the string S, as if it was in Org-mode. - -\(fn S &optional ARG REFERENCE-BUFFER)" t nil) - -(autoload 'org-switchb "org" "\ -Switch between Org buffers. -With one prefix argument, restrict available buffers to files. -With two prefix arguments, restrict available buffers to agenda files. - -Defaults to `iswitchb' for buffer name completion. -Set `org-completion-use-ido' to make it use ido instead. - -\(fn &optional ARG)" t nil) - -(defalias 'org-ido-switchb 'org-switchb) - -(defalias 'org-iswitchb 'org-switchb) - -(autoload 'org-cycle-agenda-files "org" "\ -Cycle through the files in `org-agenda-files'. -If the current buffer visits an agenda file, find the next one in the list. -If the current buffer does not, find the first agenda file. - -\(fn)" t nil) - -(autoload 'org-submit-bug-report "org" "\ -Submit a bug report on Org-mode via mail. - -Don't hesitate to report any problems or inaccurate documentation. - -If you don't have setup sending mail from (X)Emacs, please copy the -output buffer into your mail program, as it gives us important -information about your Org-mode version and configuration. - -\(fn)" t nil) - -(autoload 'org-reload "org" "\ -Reload all org lisp files. -With prefix arg UNCOMPILED, load the uncompiled versions. - -\(fn &optional UNCOMPILED)" t nil) - -(autoload 'org-customize "org" "\ -Call the customize function with org as argument. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (org-ascii-publish-to-utf8 org-ascii-publish-to-latin1 -;;;;;; org-ascii-publish-to-ascii org-ascii-export-to-ascii org-ascii-export-as-ascii) -;;;;;; "ox-ascii" "ox-ascii.el" "447720ba2ecf9c62dd16363ae7b3e4f2") -;;; Generated autoloads from ox-ascii.el - -(autoload 'org-ascii-export-as-ascii "ox-ascii" "\ -Export current buffer to a text buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should be accessible -through the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, strip title and -table of contents from output. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Export is done in a buffer named \"*Org ASCII Export*\", which -will be displayed when `org-export-show-temporary-export-buffer' -is non-nil. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) - -(autoload 'org-ascii-export-to-ascii "ox-ascii" "\ -Export current buffer to a text file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, strip title and -table of contents from output. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return output file's name. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) - -(autoload 'org-ascii-publish-to-ascii "ox-ascii" "\ -Publish an Org file to ASCII. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name. - -\(fn PLIST FILENAME PUB-DIR)" nil nil) - -(autoload 'org-ascii-publish-to-latin1 "ox-ascii" "\ -Publish an Org file to Latin-1. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name. - -\(fn PLIST FILENAME PUB-DIR)" nil nil) - -(autoload 'org-ascii-publish-to-utf8 "ox-ascii" "\ -Publish an org file to UTF-8. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name. - -\(fn PLIST FILENAME PUB-DIR)" nil nil) - -;;;*** - -;;;### (autoloads (org-beamer-publish-to-pdf org-beamer-publish-to-latex -;;;;;; org-beamer-insert-options-template org-beamer-select-environment -;;;;;; org-beamer-export-to-pdf org-beamer-export-to-latex org-beamer-export-as-latex -;;;;;; org-beamer-mode) "ox-beamer" "ox-beamer.el" "0cc5c809a9e8a88b4f9157d4e1ab8799") -;;; Generated autoloads from ox-beamer.el - -(autoload 'org-beamer-mode "ox-beamer" "\ -Support for editing Beamer oriented Org mode files. - -\(fn &optional ARG)" t nil) - -(autoload 'org-beamer-export-as-latex "ox-beamer" "\ -Export current buffer as a Beamer buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should be accessible -through the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Export is done in a buffer named \"*Org BEAMER Export*\", which -will be displayed when `org-export-show-temporary-export-buffer' -is non-nil. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) - -(autoload 'org-beamer-export-to-latex "ox-beamer" "\ -Export current buffer as a Beamer presentation (tex). - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return output file's name. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) - -(autoload 'org-beamer-export-to-pdf "ox-beamer" "\ -Export current buffer as a Beamer presentation (PDF). - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return PDF file's name. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) - -(autoload 'org-beamer-select-environment "ox-beamer" "\ -Select the environment to be used by beamer for this entry. -While this uses (for convenience) a tag selection interface, the -result of this command will be that the BEAMER_env *property* of -the entry is set. - -In addition to this, the command will also set a tag as a visual -aid, but the tag does not have any semantic meaning. - -\(fn)" t nil) - -(autoload 'org-beamer-insert-options-template "ox-beamer" "\ -Insert a settings template, to make sure users do this right. - -\(fn &optional KIND)" t nil) - -(autoload 'org-beamer-publish-to-latex "ox-beamer" "\ -Publish an Org file to a Beamer presentation (LaTeX). - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name. - -\(fn PLIST FILENAME PUB-DIR)" nil nil) - -(autoload 'org-beamer-publish-to-pdf "ox-beamer" "\ -Publish an Org file to a Beamer presentation (PDF, via LaTeX). - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name. - -\(fn PLIST FILENAME PUB-DIR)" nil nil) - -;;;*** - -;;;### (autoloads (org-html-publish-to-html org-html-export-to-html -;;;;;; org-html-convert-region-to-html org-html-export-as-html org-html-htmlize-generate-css) -;;;;;; "ox-html" "ox-html.el" "85c845b7c8a04a7193754f359ac6f000") -;;; Generated autoloads from ox-html.el - -(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp) - -(put 'org-html-head 'safe-local-variable 'stringp) - -(put 'org-html-head-extra 'safe-local-variable 'stringp) - -(autoload 'org-html-htmlize-generate-css "ox-html" "\ -Create the CSS for all font definitions in the current Emacs session. -Use this to create face definitions in your CSS style file that can then -be used by code snippets transformed by htmlize. -This command just produces a buffer that contains class definitions for all -faces used in the current Emacs session. You can copy and paste the ones you -need into your CSS file. - -If you then set `org-html-htmlize-output-type' to `css', calls -to the function `org-html-htmlize-region-for-paste' will -produce code that uses these same face definitions. - -\(fn)" t nil) - -(autoload 'org-html-export-as-html "ox-html" "\ -Export current buffer to an HTML buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should be accessible -through the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"<body>\" and \"</body>\" tags. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Export is done in a buffer named \"*Org HTML Export*\", which -will be displayed when `org-export-show-temporary-export-buffer' -is non-nil. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) - -(autoload 'org-html-convert-region-to-html "ox-html" "\ -Assume the current region has org-mode syntax, and convert it to HTML. -This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in an HTML buffer and use this -command to convert it. - -\(fn)" t nil) - -(autoload 'org-html-export-to-html "ox-html" "\ -Export current buffer to a HTML file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"<body>\" and \"</body>\" tags. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return output file's name. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) - -(autoload 'org-html-publish-to-html "ox-html" "\ -Publish an org file to HTML. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name. - -\(fn PLIST FILENAME PUB-DIR)" nil nil) - -;;;*** - -;;;### (autoloads (org-icalendar-combine-agenda-files org-icalendar-export-agenda-files -;;;;;; org-icalendar-export-to-ics) "ox-icalendar" "ox-icalendar.el" -;;;;;; "6a6f72bc83138debb70bccf3be2f4e5f") -;;; Generated autoloads from ox-icalendar.el - -(autoload 'org-icalendar-export-to-ics "ox-icalendar" "\ -Export current buffer to an iCalendar file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"BEGIN:VCALENDAR\" and \"END:VCALENDAR\". - -Return ICS file name. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY)" t nil) - -(autoload 'org-icalendar-export-agenda-files "ox-icalendar" "\ -Export all agenda files to iCalendar files. -When optional argument ASYNC is non-nil, export happens in an -external process. - -\(fn &optional ASYNC)" t nil) - -(autoload 'org-icalendar-combine-agenda-files "ox-icalendar" "\ -Combine all agenda files into a single iCalendar file. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -The file is stored under the name chosen in -`org-icalendar-combined-agenda-file'. - -\(fn &optional ASYNC)" t nil) - -;;;*** - -;;;### (autoloads (org-latex-publish-to-pdf org-latex-publish-to-latex -;;;;;; org-latex-export-to-pdf org-latex-export-to-latex org-latex-convert-region-to-latex -;;;;;; org-latex-export-as-latex) "ox-latex" "ox-latex.el" "0e49f54b683fd1727a3a29c21156a48d") -;;; Generated autoloads from ox-latex.el - -(autoload 'org-latex-export-as-latex "ox-latex" "\ -Export current buffer as a LaTeX buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should be accessible -through the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Export is done in a buffer named \"*Org LATEX Export*\", which -will be displayed when `org-export-show-temporary-export-buffer' -is non-nil. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) - -(autoload 'org-latex-convert-region-to-latex "ox-latex" "\ -Assume the current region has org-mode syntax, and convert it to LaTeX. -This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in an LaTeX buffer and use this -command to convert it. - -\(fn)" t nil) - -(autoload 'org-latex-export-to-latex "ox-latex" "\ -Export current buffer to a LaTeX file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) - -(autoload 'org-latex-export-to-pdf "ox-latex" "\ -Export current buffer to LaTeX then process through to PDF. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return PDF file's name. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" t nil) - -(autoload 'org-latex-publish-to-latex "ox-latex" "\ -Publish an Org file to LaTeX. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name. - -\(fn PLIST FILENAME PUB-DIR)" nil nil) - -(autoload 'org-latex-publish-to-pdf "ox-latex" "\ -Publish an Org file to PDF (via LaTeX). - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name. - -\(fn PLIST FILENAME PUB-DIR)" nil nil) - -;;;*** - -;;;### (autoloads (org-md-export-to-markdown org-md-convert-region-to-md -;;;;;; org-md-export-as-markdown) "ox-md" "ox-md.el" "1c4ede28f75ffb336a5abe02ab748bd6") -;;; Generated autoloads from ox-md.el - -(autoload 'org-md-export-as-markdown "ox-md" "\ -Export current buffer to a Markdown buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should be accessible -through the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -Export is done in a buffer named \"*Org MD Export*\", which will -be displayed when `org-export-show-temporary-export-buffer' is -non-nil. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY)" t nil) - -(autoload 'org-md-convert-region-to-md "ox-md" "\ -Assume the current region has org-mode syntax, and convert it to Markdown. -This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in a Markdown buffer and use -this command to convert it. - -\(fn)" t nil) - -(autoload 'org-md-export-to-markdown "ox-md" "\ -Export current buffer to a Markdown file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -Return output file's name. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY)" t nil) - -;;;*** - -;;;### (autoloads (org-odt-convert org-odt-export-to-odt org-odt-export-as-odf-and-open -;;;;;; org-odt-export-as-odf) "ox-odt" "ox-odt.el" "8c434e65153b17f1200119d1f3dfa2c6") -;;; Generated autoloads from ox-odt.el - -(put 'org-odt-preferred-output-format 'safe-local-variable 'stringp) - -(autoload 'org-odt-export-as-odf "ox-odt" "\ -Export LATEX-FRAG as OpenDocument formula file ODF-FILE. -Use `org-create-math-formula' to convert LATEX-FRAG first to -MathML. When invoked as an interactive command, use -`org-latex-regexps' to infer LATEX-FRAG from currently active -region. If no LaTeX fragments are found, prompt for it. Push -MathML source to kill ring depending on the value of -`org-export-copy-to-kill-ring'. - -\(fn LATEX-FRAG &optional ODF-FILE)" t nil) - -(autoload 'org-odt-export-as-odf-and-open "ox-odt" "\ -Export LaTeX fragment as OpenDocument formula and immediately open it. -Use `org-odt-export-as-odf' to read LaTeX fragment and OpenDocument -formula file. - -\(fn)" t nil) - -(autoload 'org-odt-export-to-odt "ox-odt" "\ -Export current buffer to a ODT file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return output file's name. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY EXT-PLIST)" t nil) - -(autoload 'org-odt-convert "ox-odt" "\ -Convert IN-FILE to format OUT-FMT using a command line converter. -IN-FILE is the file to be converted. If unspecified, it defaults -to variable `buffer-file-name'. OUT-FMT is the desired output -format. Use `org-odt-convert-process' as the converter. -If PREFIX-ARG is non-nil then the newly converted file is opened -using `org-open-file'. - -\(fn &optional IN-FILE OUT-FMT PREFIX-ARG)" t nil) - -;;;*** - -;;;### (autoloads (org-org-publish-to-org org-org-export-to-org org-org-export-as-org) -;;;;;; "ox-org" "ox-org.el" "6e1a106b8efe79c352cc72ac77ad8d91") -;;; Generated autoloads from ox-org.el - -(autoload 'org-org-export-as-org "ox-org" "\ -Export current buffer to an Org buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should be accessible -through the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Export is done in a buffer named \"*Org ORG Export*\", which will -be displayed when `org-export-show-temporary-export-buffer' is -non-nil. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY EXT-PLIST)" t nil) - -(autoload 'org-org-export-to-org "ox-org" "\ -Export current buffer to an org file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return output file name. - -\(fn &optional ASYNC SUBTREEP VISIBLE-ONLY EXT-PLIST)" t nil) - -(autoload 'org-org-publish-to-org "ox-org" "\ -Publish an org file to org. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name. - -\(fn PLIST FILENAME PUB-DIR)" nil nil) - -;;;*** - -;;;### (autoloads (org-publish-current-project org-publish-current-file -;;;;;; org-publish-all org-publish) "ox-publish" "ox-publish.el" -;;;;;; "5cc5fa1fa56e97dcb858997fd9cbaced") -;;; Generated autoloads from ox-publish.el - -(defalias 'org-publish-project 'org-publish) - -(autoload 'org-publish "ox-publish" "\ -Publish PROJECT. - -PROJECT is either a project name, as a string, or a project -alist (see `org-publish-project-alist' variable). - -When optional argument FORCE is non-nil, force publishing all -files in PROJECT. With a non-nil optional argument ASYNC, -publishing will be done asynchronously, in another process. - -\(fn PROJECT &optional FORCE ASYNC)" t nil) - -(autoload 'org-publish-all "ox-publish" "\ -Publish all projects. -With prefix argument FORCE, remove all files in the timestamp -directory and force publishing all projects. With a non-nil -optional argument ASYNC, publishing will be done asynchronously, -in another process. - -\(fn &optional FORCE ASYNC)" t nil) - -(autoload 'org-publish-current-file "ox-publish" "\ -Publish the current file. -With prefix argument FORCE, force publish the file. When -optional argument ASYNC is non-nil, publishing will be done -asynchronously, in another process. - -\(fn &optional FORCE ASYNC)" t nil) - -(autoload 'org-publish-current-project "ox-publish" "\ -Publish the project associated with the current file. -With a prefix argument, force publishing of all files in -the project. - -\(fn &optional FORCE ASYNC)" t nil) - -;;;*** - -;;;### (autoloads (org-texinfo-convert-region-to-texinfo org-texinfo-publish-to-texinfo) -;;;;;; "ox-texinfo" "ox-texinfo.el" "90b063b241343b3d9e9f2481425b2d9d") -;;; Generated autoloads from ox-texinfo.el - -(autoload 'org-texinfo-publish-to-texinfo "ox-texinfo" "\ -Publish an org file to Texinfo. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name. - -\(fn PLIST FILENAME PUB-DIR)" nil nil) - -(autoload 'org-texinfo-convert-region-to-texinfo "ox-texinfo" "\ -Assume the current region has org-mode syntax, and convert it to Texinfo. -This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in an Texinfo buffer and use -this command to convert it. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (org-export-dispatch org-export-to-file org-export-to-buffer -;;;;;; org-export-insert-default-template org-export-replace-region-by -;;;;;; org-export-string-as org-export-as) "ox" "ox.el" "683956bcfd9a00f67855e18db64893c1") -;;; Generated autoloads from ox.el - -(autoload 'org-export-as "ox" "\ -Transcode current Org buffer into BACKEND code. - -BACKEND is either an export back-end, as returned by, e.g., -`org-export-create-backend', or a symbol referring to -a registered back-end. - -If narrowing is active in the current buffer, only transcode its -narrowed part. - -If a region is active, transcode that region. - -When optional argument SUBTREEP is non-nil, transcode the -sub-tree at point, extracting information from the headline -properties first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only return body -code, without surrounding template. - -Optional argument EXT-PLIST, when provided, is a property list -with external parameters overriding Org default settings, but -still inferior to file-local settings. - -Return code as a string. - -\(fn BACKEND &optional SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST)" nil nil) - -(autoload 'org-export-string-as "ox" "\ -Transcode STRING into BACKEND code. - -BACKEND is either an export back-end, as returned by, e.g., -`org-export-create-backend', or a symbol referring to -a registered back-end. - -When optional argument BODY-ONLY is non-nil, only return body -code, without preamble nor postamble. - -Optional argument EXT-PLIST, when provided, is a property list -with external parameters overriding Org default settings, but -still inferior to file-local settings. - -Return code as a string. - -\(fn STRING BACKEND &optional BODY-ONLY EXT-PLIST)" nil nil) - -(autoload 'org-export-replace-region-by "ox" "\ -Replace the active region by its export to BACKEND. -BACKEND is either an export back-end, as returned by, e.g., -`org-export-create-backend', or a symbol referring to -a registered back-end. - -\(fn BACKEND)" nil nil) - -(autoload 'org-export-insert-default-template "ox" "\ -Insert all export keywords with default values at beginning of line. - -BACKEND is a symbol referring to the name of a registered export -back-end, for which specific export options should be added to -the template, or `default' for default template. When it is nil, -the user will be prompted for a category. - -If SUBTREEP is non-nil, export configuration will be set up -locally for the subtree through node properties. - -\(fn &optional BACKEND SUBTREEP)" t nil) - -(autoload 'org-export-to-buffer "ox" "\ -Call `org-export-as' with output to a specified buffer. - -BACKEND is either an export back-end, as returned by, e.g., -`org-export-create-backend', or a symbol referring to -a registered back-end. - -BUFFER is the name of the output buffer. If it already exists, -it will be erased first, otherwise, it will be created. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should then be accessible -through the `org-export-stack' interface. When ASYNC is nil, the -buffer is displayed if `org-export-show-temporary-export-buffer' -is non-nil. - -Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and -EXT-PLIST are similar to those used in `org-export-as', which -see. - -Optional argument POST-PROCESS is a function which should accept -no argument. It is always called within the current process, -from BUFFER, with point at its beginning. Export back-ends can -use it to set a major mode there, e.g, - - (defun org-latex-export-as-latex - (&optional async subtreep visible-only body-only ext-plist) - (interactive) - (org-export-to-buffer 'latex \"*Org LATEX Export*\" - async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) - -This function returns BUFFER. - -\(fn BACKEND BUFFER &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST POST-PROCESS)" nil nil) - -(autoload 'org-export-to-file "ox" "\ -Call `org-export-as' with output to a specified file. - -BACKEND is either an export back-end, as returned by, e.g., -`org-export-create-backend', or a symbol referring to -a registered back-end. FILE is the name of the output file, as -a string. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer file then be accessible -through the `org-export-stack' interface. - -Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and -EXT-PLIST are similar to those used in `org-export-as', which -see. - -Optional argument POST-PROCESS is called with FILE as its -argument and happens asynchronously when ASYNC is non-nil. It -has to return a file name, or nil. Export back-ends can use this -to send the output file through additional processing, e.g, - - (defun org-latex-export-to-latex - (&optional async subtreep visible-only body-only ext-plist) - (interactive) - (let ((outfile (org-export-output-file-name \".tex\" subtreep))) - (org-export-to-file 'latex outfile - async subtreep visible-only body-only ext-plist - (lambda (file) (org-latex-compile file))) - -The function returns either a file name returned by POST-PROCESS, -or FILE. - -\(fn BACKEND FILE &optional ASYNC SUBTREEP VISIBLE-ONLY BODY-ONLY EXT-PLIST POST-PROCESS)" nil nil) - -(autoload 'org-export-dispatch "ox" "\ -Export dispatcher for Org mode. - -It provides an access to common export related tasks in a buffer. -Its interface comes in two flavours: standard and expert. - -While both share the same set of bindings, only the former -displays the valid keys associations in a dedicated buffer. -Scrolling (resp. line-wise motion) in this buffer is done with -SPC and DEL (resp. C-n and C-p) keys. - -Set variable `org-export-dispatch-use-expert-ui' to switch to one -flavour or the other. - -When ARG is \\[universal-argument], repeat the last export action, with the same set -of options used back then, on the current buffer. - -When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack. - -\(fn &optional ARG)" t nil) - -;;;*** - -(provide 'org-loaddefs) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; coding: utf-8 -;; End: -;;; org-loaddefs.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-macro.el b/xemacs-packages/lisp/org-8.2.3c/org-macro.el deleted file mode 100644 index 61e9243b..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-macro.el +++ /dev/null @@ -1,193 +0,0 @@ -;;; org-macro.el --- Macro Replacement Code for Org Mode - -;; Copyright (C) 2013 Free Software Foundation, Inc. - -;; Author: Nicolas Goaziou <n.goaziou@gmail.com> -;; Keywords: outlines, hypermedia, calendar, wp - -;; 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: - -;; Macros are expanded with `org-macro-replace-all', which relies -;; internally on `org-macro-expand'. - -;; Default templates for expansion are stored in the buffer-local -;; variable `org-macro-templates'. This variable is updated by -;; `org-macro-initialize-templates', which recursively calls -;; `org-macro--collect-macros' in order to read setup files. - -;; Along with macros defined through #+MACRO: keyword, default -;; templates include the following hard-coded macros: -;; {{{time(format-string)}}}, {{{property(node-property)}}}, -;; {{{input-file}}} and {{{modification-time(format-string)}}}. - -;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}}, -;; {{{email}}} and {{{title}}} macros. - -;;; Code: -(require 'org-macs) - -(declare-function org-element-at-point "org-element" (&optional keep-trail)) -(declare-function org-element-context "org-element" (&optional element)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-type "org-element" (element)) -(declare-function org-remove-double-quotes "org" (s)) -(declare-function org-mode "org" ()) -(declare-function org-file-contents "org" (file &optional noerror)) -(declare-function org-with-wide-buffer "org-macs" (&rest body)) - -;;; Variables - -(defvar org-macro-templates nil - "Alist containing all macro templates in current buffer. -Associations are in the shape of (NAME . TEMPLATE) where NAME -stands for macro's name and template for its replacement value, -both as strings. This is an internal variable. Do not set it -directly, use instead: - - #+MACRO: name template") -(make-variable-buffer-local 'org-macro-templates) - - -;;; Functions - -(defun org-macro--collect-macros () - "Collect macro definitions in current buffer and setup files. -Return an alist containing all macro templates found." - (let* (collect-macros ; For byte-compiler. - (collect-macros - (lambda (files templates) - ;; Return an alist of macro templates. FILES is a list of - ;; setup files names read so far, used to avoid circular - ;; dependencies. TEMPLATES is the alist collected so far. - (let ((case-fold-search t)) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) - (let ((val (org-element-property :value element))) - (if (equal (org-element-property :key element) "MACRO") - ;; Install macro in TEMPLATES. - (when (string-match - "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val) - (let* ((name (match-string 1 val)) - (template (or (match-string 2 val) "")) - (old-cell (assoc name templates))) - (if old-cell (setcdr old-cell template) - (push (cons name template) templates)))) - ;; Enter setup file. - (let ((file (expand-file-name - (org-remove-double-quotes val)))) - (unless (member file files) - (with-temp-buffer - (org-mode) - (insert (org-file-contents file 'noerror)) - (setq templates - (funcall collect-macros (cons file files) - templates))))))))))) - templates)))) - (funcall collect-macros nil nil))) - -(defun org-macro-initialize-templates () - "Collect macro templates defined in current buffer. -Templates are stored in buffer-local variable -`org-macro-templates'. In addition to buffer-defined macros, the -function installs the following ones: \"property\", -\"time\". and, if the buffer is associated to a file, -\"input-file\" and \"modification-time\"." - (let* ((templates (org-macro--collect-macros)) - (update-templates - (lambda (cell) - (let ((old-template (assoc (car cell) templates))) - (if old-template (setcdr old-template (cdr cell)) - (push cell templates)))))) - ;; Install hard-coded macros. - (mapc (lambda (cell) (funcall update-templates cell)) - (list (cons "property" "(eval (org-entry-get nil \"$1\" 'selective))") - (cons "time" "(eval (format-time-string \"$1\"))"))) - (let ((visited-file (buffer-file-name (buffer-base-buffer)))) - (when (and visited-file (file-exists-p visited-file)) - (mapc (lambda (cell) (funcall update-templates cell)) - (list (cons "input-file" (file-name-nondirectory visited-file)) - (cons "modification-time" - (format "(eval (format-time-string \"$1\" '%s))" - (prin1-to-string - (nth 5 (file-attributes visited-file))))))))) - (setq org-macro-templates templates))) - -(defun org-macro-expand (macro templates) - "Return expanded MACRO, as a string. -MACRO is an object, obtained, for example, with -`org-element-context'. TEMPLATES is an alist of templates used -for expansion. See `org-macro-templates' for a buffer-local -default value. Return nil if no template was found." - (let ((template - ;; Macro names are case-insensitive. - (cdr (assoc-string (org-element-property :key macro) templates t)))) - (when template - (let ((value (replace-regexp-in-string - "\\$[0-9]+" - (lambda (arg) - (or (nth (1- (string-to-number (substring arg 1))) - (org-element-property :args macro)) - ;; No argument: remove place-holder. - "")) - template nil 'literal))) - ;; VALUE starts with "(eval": it is a s-exp, `eval' it. - (when (string-match "\\`(eval\\>" value) - (setq value (eval (read value)))) - ;; Return string. - (format "%s" (or value "")))))) - -(defun org-macro-replace-all (templates) - "Replace all macros in current buffer by their expansion. -TEMPLATES is an alist of templates used for expansion. See -`org-macro-templates' for a buffer-local default value." - (save-excursion - (goto-char (point-min)) - (let (record) - (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) - (let ((object (org-element-context))) - (when (eq (org-element-type object) 'macro) - (let* ((value (org-macro-expand object templates)) - (begin (org-element-property :begin object)) - (signature (list begin - object - (org-element-property :args object)))) - ;; Avoid circular dependencies by checking if the same - ;; macro with the same arguments is expanded at the same - ;; position twice. - (if (member signature record) - (error "Circular macro expansion: %s" - (org-element-property :key object)) - (when value - (push signature record) - (delete-region - begin - ;; Preserve white spaces after the macro. - (progn (goto-char (org-element-property :end object)) - (skip-chars-backward " \t") - (point))) - ;; Leave point before replacement in case of recursive - ;; expansions. - (save-excursion (insert value))))))))))) - - -(provide 'org-macro) -;;; org-macro.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-macs.el b/xemacs-packages/lisp/org-8.2.3c/org-macs.el deleted file mode 100644 index 4afbace5..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-macs.el +++ /dev/null @@ -1,390 +0,0 @@ -;;; org-macs.el --- Top-level definitions for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;; This file contains macro definitions, defsubst definitions, other -;; stuff needed for compilation and top-level forms in Org-mode, as well -;; lots of small functions that are not org-mode specific but simply -;; generally useful stuff. - -;;; Code: - -(eval-and-compile - (unless (fboundp 'declare-function) - (defmacro declare-function (fn file &optional arglist fileonly) - `(autoload ',fn ,file))) - - (if (>= emacs-major-version 23) - (defsubst org-char-to-string(c) - "Defsubst to decode UTF-8 character values in emacs 23 and beyond." - (char-to-string c)) - (defsubst org-char-to-string (c) - "Defsubst to decode UTF-8 character values in emacs 22." - (string (decode-char 'ucs c))))) - -(declare-function org-add-props "org-compat" (string plist &rest props)) -(declare-function org-string-match-p "org-compat" (&rest args)) - -(defmacro org-with-gensyms (symbols &rest body) - `(let ,(mapcar (lambda (s) - `(,s (make-symbol (concat "--" (symbol-name ',s))))) symbols) - ,@body)) -(def-edebug-spec org-with-gensyms (sexp body)) -(put 'org-with-gensyms 'lisp-indent-function 1) - -(defmacro org-called-interactively-p (&optional kind) - (if (featurep 'xemacs) - `(interactive-p) - (if (or (> emacs-major-version 23) - (and (>= emacs-major-version 23) - (>= emacs-minor-version 2))) - ;; defined with no argument in <=23.1 - `(with-no-warnings (called-interactively-p ,kind)) - `(interactive-p)))) -(def-edebug-spec org-called-interactively-p (&optional ("quote" symbolp))) - -(defmacro org-bound-and-true-p (var) - "Return the value of symbol VAR if it is bound, else nil." - `(and (boundp (quote ,var)) ,var)) -(def-edebug-spec org-bound-and-true-p (symbolp)) - -(defun org-string-nw-p (s) - "Is S a string with a non-white character?" - (and (stringp s) - (org-string-match-p "\\S-" s) - s)) - -(defun org-not-nil (v) - "If V not nil, and also not the string \"nil\", then return V. -Otherwise return nil." - (and v (not (equal v "nil")) v)) - -(defun org-substitute-posix-classes (re) - "Substitute posix classes in regular expression RE." - (let ((ss re)) - (save-match-data - (while (string-match "\\[:alnum:\\]" ss) - (setq ss (replace-match "a-zA-Z0-9" t t ss))) - (while (string-match "\\[:word:\\]" ss) - (setq ss (replace-match "a-zA-Z0-9" t t ss))) - (while (string-match "\\[:alpha:\\]" ss) - (setq ss (replace-match "a-zA-Z" t t ss))) - (while (string-match "\\[:punct:\\]" ss) - (setq ss (replace-match "\001-@[-`{-~" t t ss))) - ss))) - -(defmacro org-re (s) - "Replace posix classes in regular expression." - (if (featurep 'xemacs) `(org-substitute-posix-classes ,s) s)) -(def-edebug-spec org-re (form)) - -(defmacro org-preserve-lc (&rest body) - (org-with-gensyms (line col) - `(let ((,line (org-current-line)) - (,col (current-column))) - (unwind-protect - (progn ,@body) - (org-goto-line ,line) - (org-move-to-column ,col))))) -(def-edebug-spec org-preserve-lc (body)) - -;; Use `org-with-silent-modifications' to ignore cosmetic changes and -;; `org-unmodified' to ignore real text modifications -(defmacro org-unmodified (&rest body) - "Run BODY while preserving the buffer's `buffer-modified-p' state." - (org-with-gensyms (was-modified) - `(let ((,was-modified (buffer-modified-p))) - (unwind-protect - (let ((buffer-undo-list t) - (inhibit-modification-hooks t)) - ,@body) - (set-buffer-modified-p ,was-modified))))) -(def-edebug-spec org-unmodified (body)) - -(defmacro org-without-partial-completion (&rest body) - `(if (and (boundp 'partial-completion-mode) - partial-completion-mode - (fboundp 'partial-completion-mode)) - (unwind-protect - (progn - (partial-completion-mode -1) - ,@body) - (partial-completion-mode 1)) - ,@body)) -(def-edebug-spec org-without-partial-completion (body)) - -;; FIXME: Slated for removal. Current Org mode does not support Emacs < 22 -(defmacro org-maybe-intangible (props) - "Add '(intangible t) to PROPS if Emacs version is earlier than Emacs 22. -In Emacs 21, invisible text is not avoided by the command loop, so the -intangible property is needed to make sure point skips this text. -In Emacs 22, this is not necessary. The intangible text property has -led to problems with flyspell. These problems are fixed in flyspell.el, -but we still avoid setting the property in Emacs 22 and later. -We use a macro so that the test can happen at compilation time." - (if (< emacs-major-version 22) - `(append '(intangible t) ,props) - props)) - -(defmacro org-with-point-at (pom &rest body) - "Move to buffer and point of point-or-marker POM for the duration of BODY." - (org-with-gensyms (mpom) - `(let ((,mpom ,pom)) - (save-excursion - (if (markerp ,mpom) (set-buffer (marker-buffer ,mpom))) - (save-excursion - (goto-char (or ,mpom (point))) - ,@body))))) -(def-edebug-spec org-with-point-at (form body)) -(put 'org-with-point-at 'lisp-indent-function 1) - -(defmacro org-no-warnings (&rest body) - (cons (if (fboundp 'with-no-warnings) 'with-no-warnings 'progn) body)) -(def-edebug-spec org-no-warnings (body)) - -(defmacro org-with-remote-undo (buffer &rest body) - "Execute BODY while recording undo information in two buffers." - (org-with-gensyms (cline cmd buf1 buf2 undo1 undo2 c1 c2) - `(let ((,cline (org-current-line)) - (,cmd this-command) - (,buf1 (current-buffer)) - (,buf2 ,buffer) - (,undo1 buffer-undo-list) - (,undo2 (with-current-buffer ,buffer buffer-undo-list)) - ,c1 ,c2) - ,@body - (when org-agenda-allow-remote-undo - (setq ,c1 (org-verify-change-for-undo - ,undo1 (with-current-buffer ,buf1 buffer-undo-list)) - ,c2 (org-verify-change-for-undo - ,undo2 (with-current-buffer ,buf2 buffer-undo-list))) - (when (or ,c1 ,c2) - ;; make sure there are undo boundaries - (and ,c1 (with-current-buffer ,buf1 (undo-boundary))) - (and ,c2 (with-current-buffer ,buf2 (undo-boundary))) - ;; remember which buffer to undo - (push (list ,cmd ,cline ,buf1 ,c1 ,buf2 ,c2) - org-agenda-undo-list)))))) -(def-edebug-spec org-with-remote-undo (form body)) -(put 'org-with-remote-undo 'lisp-indent-function 1) - -(defmacro org-no-read-only (&rest body) - "Inhibit read-only for BODY." - `(let ((inhibit-read-only t)) ,@body)) -(def-edebug-spec org-no-read-only (body)) - -(defconst org-rm-props '(invisible t face t keymap t intangible t mouse-face t - rear-nonsticky t mouse-map t fontified t - org-emphasis t) - "Properties to remove when a string without properties is wanted.") - -(defsubst org-match-string-no-properties (num &optional string) - (if (featurep 'xemacs) - (let ((s (match-string num string))) - (and s (remove-text-properties 0 (length s) org-rm-props s)) - s) - (match-string-no-properties num string))) - -(defsubst org-no-properties (s &optional restricted) - "Remove all text properties from string S. -When RESTRICTED is non-nil, only remove the properties listed -in `org-rm-props'." - (if (fboundp 'set-text-properties) - (set-text-properties 0 (length s) nil s) - (if restricted - (remove-text-properties 0 (length s) org-rm-props s) - (set-text-properties 0 (length s) nil s))) - s) - -(defsubst org-get-alist-option (option key) - (cond ((eq key t) t) - ((eq option t) t) - ((assoc key option) (cdr (assoc key option))) - (t (let ((r (cdr (assq 'default option)))) - (if (listp r) (delq nil r) r))))) - -(defsubst org-check-external-command (cmd &optional use no-error) - "Check if external program CMD for USE exists, error if not. -When the program does exist, return its path. -When it does not exist and NO-ERROR is set, return nil. -Otherwise, throw an error. The optional argument USE can describe what this -program is needed for, so that the error message can be more informative." - (or (executable-find cmd) - (if no-error - nil - (error "Can't find `%s'%s" cmd - (if use (format " (%s)" use) ""))))) - -(defsubst org-inhibit-invisibility () - "Modified `buffer-invisibility-spec' for Emacs 21. -Some ops with invisible text do not work correctly on Emacs 21. For these -we turn off invisibility temporarily. Use this in a `let' form." - (if (< emacs-major-version 22) nil buffer-invisibility-spec)) - -(defsubst org-set-local (var value) - "Make VAR local in current buffer and set it to VALUE." - (set (make-local-variable var) value)) - -(defsubst org-last (list) - "Return the last element of LIST." - (car (last list))) - -(defun org-let (list &rest body) - (eval (cons 'let (cons list body)))) -(put 'org-let 'lisp-indent-function 1) - -(defun org-let2 (list1 list2 &rest body) - (eval (cons 'let (cons list1 (list (cons 'let (cons list2 body))))))) -(put 'org-let2 'lisp-indent-function 2) - -(defsubst org-call-with-arg (command arg) - "Call COMMAND interactively, but pretend prefix arg was ARG." - (let ((current-prefix-arg arg)) (call-interactively command))) - -(defsubst org-current-line (&optional pos) - (save-excursion - (and pos (goto-char pos)) - ;; works also in narrowed buffer, because we start at 1, not point-min - (+ (if (bolp) 1 0) (count-lines 1 (point))))) - -(defsubst org-goto-line (N) - (save-restriction - (widen) - (goto-char (point-min)) - (forward-line (1- N)))) - -(defsubst org-current-line-string (&optional to-here) - (buffer-substring (point-at-bol) (if to-here (point) (point-at-eol)))) - -(defsubst org-pos-in-match-range (pos n) - (and (match-beginning n) - (<= (match-beginning n) pos) - (>= (match-end n) pos))) - -(defun org-match-line (re) - "Looking-at at the beginning of the current line." - (save-excursion - (goto-char (point-at-bol)) - (looking-at re))) - -(defun org-plist-delete (plist property) - "Delete PROPERTY from PLIST. -This is in contrast to merely setting it to 0." - (let (p) - (while plist - (if (not (eq property (car plist))) - (setq p (plist-put p (car plist) (nth 1 plist)))) - (setq plist (cddr plist))) - p)) - -(defun org-replace-match-keep-properties (newtext &optional fixedcase - literal string) - "Like `replace-match', but add the text properties found original text." - (setq newtext (org-add-props newtext (text-properties-at - (match-beginning 0) string))) - (replace-match newtext fixedcase literal string)) - -(defmacro org-save-outline-visibility (use-markers &rest body) - "Save and restore outline visibility around BODY. -If USE-MARKERS is non-nil, use markers for the positions. -This means that the buffer may change while running BODY, -but it also means that the buffer should stay alive -during the operation, because otherwise all these markers will -point nowhere." - (declare (indent 1)) - (org-with-gensyms (data rtn) - `(let ((,data (org-outline-overlay-data ,use-markers)) - ,rtn) - (unwind-protect - (progn - (setq ,rtn (progn ,@body)) - (org-set-outline-overlay-data ,data)) - (when ,use-markers - (mapc (lambda (c) - (and (markerp (car c)) (move-marker (car c) nil)) - (and (markerp (cdr c)) (move-marker (cdr c) nil))) - ,data))) - ,rtn))) -(def-edebug-spec org-save-outline-visibility (form body)) - -(defmacro org-with-wide-buffer (&rest body) - "Execute body while temporarily widening the buffer." - `(save-excursion - (save-restriction - (widen) - ,@body))) -(def-edebug-spec org-with-wide-buffer (body)) - -(defmacro org-with-limited-levels (&rest body) - "Execute BODY with limited number of outline levels." - `(let* ((org-called-with-limited-levels t) - (org-outline-regexp (org-get-limited-outline-regexp)) - (outline-regexp org-outline-regexp) - (org-outline-regexp-bol (concat "^" org-outline-regexp))) - ,@body)) -(def-edebug-spec org-with-limited-levels (body)) - -(defvar org-outline-regexp) ; defined in org.el -(defvar org-odd-levels-only) ; defined in org.el -(defvar org-inlinetask-min-level) ; defined in org-inlinetask.el -(defun org-get-limited-outline-regexp () - "Return outline-regexp with limited number of levels. -The number of levels is controlled by `org-inlinetask-min-level'" - (if (or (not (derived-mode-p 'org-mode)) (not (featurep 'org-inlinetask))) - org-outline-regexp - (let* ((limit-level (1- org-inlinetask-min-level)) - (nstars (if org-odd-levels-only (1- (* limit-level 2)) limit-level))) - (format "\\*\\{1,%d\\} " nstars)))) - -(defun org-format-seconds (string seconds) - "Compatibility function replacing format-seconds." - (if (fboundp 'format-seconds) - (format-seconds string seconds) - (format-time-string string (seconds-to-time seconds)))) - -(defmacro org-eval-in-environment (environment form) - `(eval (list 'let ,environment ',form))) -(def-edebug-spec org-eval-in-environment (form form)) -(put 'org-eval-in-environment 'lisp-indent-function 1) - -(defun org-make-parameter-alist (flat) - "Return alist based on FLAT. -FLAT is a list with alternating symbol names and values. The -returned alist is a list of lists with the symbol name in car and -the value in cdr." - (when flat - (cons (list (car flat) (cadr flat)) - (org-make-parameter-alist (cddr flat))))) - -;;;###autoload -(defmacro org-load-noerror-mustsuffix (file) - "Load FILE with optional arguments NOERROR and MUSTSUFFIX. Drop the MUSTSUFFIX argument for XEmacs, which doesn't recognize it." - (if (featurep 'xemacs) - `(load ,file 'noerror) - `(load ,file 'noerror nil nil 'mustsuffix))) - -(provide 'org-macs) - -;;; org-macs.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-mhe.el b/xemacs-packages/lisp/org-8.2.3c/org-mhe.el deleted file mode 100644 index 7d6e4ec9..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-mhe.el +++ /dev/null @@ -1,228 +0,0 @@ -;;; org-mhe.el --- Support for links to MH-E messages from within Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Thomas Baumann <thomas dot baumann at ch dot tum dot de> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;; This file implements links to MH-E messages from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org-macs) -(require 'org) - -;; Customization variables - -(defcustom org-mhe-search-all-folders nil - "Non-nil means the search for the mh-message may extend to all folders. -When non-nil, the search for a message will extend to all other -folders if it cannot be found in the folder given in the link. -Searching all folders may be slow with the default pick based -search but is very efficient with one of the other search engines -supported by MH-E." - :group 'org-link-follow - :type 'boolean) - -;; Declare external functions and variables -(declare-function mh-display-msg "mh-show" (msg-num folder-name)) -(declare-function mh-find-path "mh-utils" ()) -(declare-function mh-get-header-field "mh-utils" (field)) -(declare-function mh-get-msg-num "mh-utils" (error-if-no-message)) -(declare-function mh-header-display "mh-show" ()) -(declare-function mh-index-previous-folder "mh-search" ()) -(declare-function mh-normalize-folder-name "mh-utils" - (folder &optional empty-string-okay dont-remove-trailing-slash - return-nil-if-folder-empty)) -(declare-function mh-search "mh-search" - (folder search-regexp &optional redo-search-flag - window-config)) -(declare-function mh-search-choose "mh-search" (&optional searcher)) -(declare-function mh-show "mh-show" (&optional message redisplay-flag)) -(declare-function mh-show-buffer-message-number "mh-comp" (&optional buffer)) -(declare-function mh-show-header-display "mh-show" t t) -(declare-function mh-show-msg "mh-show" (msg)) -(declare-function mh-show-show "mh-show" t t) -(declare-function mh-visit-folder "mh-folder" (folder &optional - range index-data)) -(defvar mh-progs) -(defvar mh-current-folder) -(defvar mh-show-folder-buffer) -(defvar mh-index-folder) -(defvar mh-searcher) -(defvar mh-search-regexp-builder) - -;; Install the link type -(org-add-link-type "mhe" 'org-mhe-open) -(add-hook 'org-store-link-functions 'org-mhe-store-link) - -;; Implementation -(defun org-mhe-store-link () - "Store a link to an MH-E folder or message." - (when (or (equal major-mode 'mh-folder-mode) - (equal major-mode 'mh-show-mode)) - (save-window-excursion - (let* ((from (org-mhe-get-header "From:")) - (to (org-mhe-get-header "To:")) - (message-id (org-mhe-get-header "Message-Id:")) - (subject (org-mhe-get-header "Subject:")) - (date (org-mhe-get-header "Date:")) - (date-ts (and date (format-time-string - (org-time-stamp-format t) (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) - link desc) - (org-store-link-props :type "mh" :from from :to to - :subject subject :message-id message-id) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) - (setq desc (org-email-link-description)) - (setq link (concat "mhe:" (org-mhe-get-message-real-folder) "#" - (org-remove-angle-brackets message-id))) - (org-add-link-props :link link :description desc) - link)))) - -(defun org-mhe-open (path) - "Follow an MH-E message link specified by PATH." - (let (folder article) - (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in MH-E link")) - (setq folder (match-string 1 path) - article (match-string 3 path)) - (org-mhe-follow-link folder article))) - -;;; mh-e integration based on planner-mode -(defun org-mhe-get-message-real-folder () - "Return the name of the real folder for the current message. -So if you use sequences, it will now work." - (save-excursion - (let* ((folder - (if (equal major-mode 'mh-folder-mode) - mh-current-folder - ;; Refer to the show buffer - mh-show-folder-buffer)) - (end-index - (if (boundp 'mh-index-folder) - (min (length mh-index-folder) (length folder)))) - ) - ;; a simple test on mh-index-data does not work, because - ;; mh-index-data is always nil in a show buffer. - (if (and (boundp 'mh-index-folder) - (string= mh-index-folder (substring folder 0 end-index))) - (if (equal major-mode 'mh-show-mode) - (save-window-excursion - (let (pop-up-frames) - (when (buffer-live-p (get-buffer folder)) - (progn - (pop-to-buffer folder) - (org-mhe-get-message-folder-from-index) - ) - ))) - (org-mhe-get-message-folder-from-index) - ) - folder - ) - ))) - -(defun org-mhe-get-message-folder-from-index () - "Return the name of the message folder in an index folder buffer." - (save-excursion - (mh-index-previous-folder) - (if (re-search-forward "^\\(+.*\\)$" nil t) - (message "%s" (match-string 1))))) - -(defun org-mhe-get-message-folder () - "Return the name of the current message folder. -Be careful if you use sequences." - (save-excursion - (if (equal major-mode 'mh-folder-mode) - mh-current-folder - ;; Refer to the show buffer - mh-show-folder-buffer))) - -(defun org-mhe-get-message-num () - "Return the number of the current message. -Be careful if you use sequences." - (save-excursion - (if (equal major-mode 'mh-folder-mode) - (mh-get-msg-num nil) - ;; Refer to the show buffer - (mh-show-buffer-message-number)))) - -(defun org-mhe-get-header (header) - "Return the field for HEADER of the message in folder mode. -This will create a show buffer for the corresponding message. If -you have a better idea of how to do this then please let us know." - (let* ((folder (org-mhe-get-message-folder)) - (num (org-mhe-get-message-num)) - (buffer (get-buffer-create (concat "show-" folder))) - (header-field)) - (with-current-buffer buffer - (mh-display-msg num folder) - (if (equal major-mode 'mh-folder-mode) - (mh-header-display) - (mh-show-header-display)) - (set-buffer buffer) - (setq header-field (mh-get-header-field header)) - (if (equal major-mode 'mh-folder-mode) - (mh-show) - (mh-show-show)) - (org-trim header-field)))) - -(defun org-mhe-follow-link (folder article) - "Follow an MH-E link to FOLDER and ARTICLE. -If ARTICLE is nil FOLDER is shown. If the configuration variable -`org-mhe-search-all-folders' is t and `mh-searcher' is pick, -ARTICLE is searched in all folders. Indexed searches (swish++, -namazu, and others supported by MH-E) will always search in all -folders." - (require 'mh-e) - (require 'mh-search) - (require 'mh-utils) - (mh-find-path) - (if (not article) - (mh-visit-folder (mh-normalize-folder-name folder)) - (mh-search-choose) - (if (equal mh-searcher 'pick) - (progn - (setq article (org-add-angle-brackets article)) - (mh-search folder (list "--message-id" article)) - (when (and org-mhe-search-all-folders - (not (org-mhe-get-message-real-folder))) - (kill-this-buffer) - (mh-search "+" (list "--message-id" article)))) - (if mh-search-regexp-builder - (mh-search "+" (funcall mh-search-regexp-builder - (list (cons 'message-id article)))) - (mh-search "+" article))) - (if (org-mhe-get-message-real-folder) - (mh-show-msg 1) - (kill-this-buffer) - (error "Message not found")))) - -(provide 'org-mhe) - -;;; org-mhe.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-mobile.el b/xemacs-packages/lisp/org-8.2.3c/org-mobile.el deleted file mode 100644 index a43896bd..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-mobile.el +++ /dev/null @@ -1,1147 +0,0 @@ -;;; org-mobile.el --- Code for asymmetric sync with a mobile device -;; Copyright (C) 2009-2013 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: -;; -;; This file contains the code to interact with Richard Moreland's iPhone -;; application MobileOrg, as well as with the Android version by Matthew Jones. -;; This code is documented in Appendix B of the Org-mode manual. The code is -;; not specific for the iPhone and Android - any external -;; viewer/flagging/editing application that uses the same conventions could -;; be used. - -(require 'org) -(require 'org-agenda) -;;; Code: - -(eval-when-compile (require 'cl)) - -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) - -(defgroup org-mobile nil - "Options concerning support for a viewer/editor on a mobile device." - :tag "Org Mobile" - :group 'org) - -(defcustom org-mobile-files '(org-agenda-files) - "Files to be staged for MobileOrg. -This is basically a list of files and directories. Files will be staged -directly. Directories will be search for files with the extension `.org'. -In addition to this, the list may also contain the following symbols: - -org-agenda-files - This means include the complete, unrestricted list of files given in - the variable `org-agenda-files'. -org-agenda-text-search-extra-files - Include the files given in the variable - `org-agenda-text-search-extra-files'" - :group 'org-mobile - :type '(list :greedy t - (option (const :tag "org-agenda-files" org-agenda-files)) - (option (const :tag "org-agenda-text-search-extra-files" - org-agenda-text-search-extra-files)) - (repeat :inline t :tag "Additional files" - (file)))) - -(defcustom org-mobile-files-exclude-regexp "" - "A regexp to exclude files from `org-mobile-files'." - :group 'org-mobile - :version "24.1" - :type 'regexp) - -(defcustom org-mobile-directory "" - "The WebDAV directory where the interaction with the mobile takes place." - :group 'org-mobile - :type 'directory) - -(defcustom org-mobile-allpriorities "A B C" - "Default set of priority cookies for the index file." - :version "24.4" - :package-version '(Org . "8.0") - :type 'string - :group 'org-mobile) - -(defcustom org-mobile-use-encryption nil - "Non-nil means keep only encrypted files on the WebDAV server. -Encryption uses AES-256, with a password given in -`org-mobile-encryption-password'. -When nil, plain files are kept on the server. -Turning on encryption requires to set the same password in the MobileOrg -application. Before turning this on, check of MobileOrg does already -support it - at the time of this writing it did not yet." - :group 'org-mobile - :version "24.1" - :type 'boolean) - -(defcustom org-mobile-encryption-tempfile "~/orgtmpcrypt" - "File that is being used as a temporary file for encryption. -This must be local file on your local machine (not on the WebDAV server). -You might want to put this file into a directory where only you have access." - :group 'org-mobile - :version "24.1" - :type 'directory) - -(defcustom org-mobile-encryption-password "" - "Password for encrypting files uploaded to the server. -This is a single password which is used for AES-256 encryption. The same -password must also be set in the MobileOrg application. All Org files, -including mobileorg.org will be encrypted using this password. - -SECURITY CONSIDERATIONS: - -Note that, when Org runs the encryption commands, the password could -be visible briefly on your system with the `ps' command. So this method is -only intended to keep the files secure on the server, not on your own machine. - -Also, if you set this variable in an init file (.emacs or .emacs.d/init.el -or custom.el...) and if that file is stored in a way so that other can read -it, this also limits the security of this approach. You can also leave -this variable empty - Org will then ask for the password once per Emacs -session." - :group 'org-mobile - :version "24.1" - :type '(string :tag "Password")) - -(defvar org-mobile-encryption-password-session nil) - -(defun org-mobile-encryption-password () - (or (org-string-nw-p org-mobile-encryption-password) - (org-string-nw-p org-mobile-encryption-password-session) - (setq org-mobile-encryption-password-session - (read-passwd "Password for MobileOrg: " t)))) - -(defcustom org-mobile-inbox-for-pull "~/org/from-mobile.org" - "The file where captured notes and flags will be appended to. -During the execution of `org-mobile-pull', the file -`org-mobile-capture-file' will be emptied it's contents have -been appended to the file given here. This file should be in -`org-directory', and not in the staging area or on the web server." - :group 'org-mobile - :type 'file) - -(defconst org-mobile-capture-file "mobileorg.org" - "The capture file where the mobile stores captured notes and flags. -This should not be changed, because MobileOrg assumes this name.") - -(defcustom org-mobile-index-file "index.org" - "The index file with links to all Org files that should be loaded by MobileOrg. -Relative to `org-mobile-directory'. The Address field in the MobileOrg setup -should point to this file." - :group 'org-mobile - :type 'file) - -(defcustom org-mobile-agendas 'all - "The agendas that should be pushed to MobileOrg. -Allowed values: - -default the weekly agenda and the global TODO list -custom all custom agendas defined by the user -all the custom agendas and the default ones -list a list of selection key(s) as string." - :group 'org-mobile - :version "24.1" - :type '(choice - (const :tag "Default Agendas" default) - (const :tag "Custom Agendas" custom) - (const :tag "Default and Custom Agendas" all) - (repeat :tag "Selected" - (string :tag "Selection Keys")))) - -(defcustom org-mobile-force-id-on-agenda-items t - "Non-nil means make all agenda items carry an ID." - :group 'org-mobile - :type 'boolean) - -(defcustom org-mobile-force-mobile-change nil - "Non-nil means force the change made on the mobile device. -So even if there have been changes to the computer version of the entry, -force the new value set on the mobile. -When nil, mark the entry from the mobile with an error message. -Instead of nil or t, this variable can also be a list of symbols, indicating -the editing types for which the mobile version should always dominate." - :group 'org-mobile - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (set :greedy t :tag "Specify" - (const todo) - (const tags) - (const priority) - (const heading) - (const body)))) - -(defcustom org-mobile-action-alist - '(("edit" . (org-mobile-edit data old new))) - "Alist with flags and actions for mobile sync. -When flagging an entry, MobileOrg will create entries that look like - - * F(action:data) [[id:entry-id][entry title]] - -This alist defines that the ACTION in the parentheses of F() should mean, -i.e. what action should be taken. The :data part in the parenthesis is -optional. If present, the string after the colon will be passed to the -action form as the `data' variable. -The car of each elements of the alist is an actions string. The cdr is -an Emacs Lisp form that will be evaluated with the cursor on the headline -of that entry. - -For now, it is not recommended to change this variable." - :group 'org-mobile - :type '(repeat - (cons (string :tag "Action flag") - (sexp :tag "Action form")))) - -(defcustom org-mobile-checksum-binary (or (executable-find "shasum") - (executable-find "sha1sum") - (executable-find "md5sum") - (executable-find "md5")) - "Executable used for computing checksums of agenda files." - :group 'org-mobile - :type 'string) - -(defvar org-mobile-pre-push-hook nil - "Hook run before running `org-mobile-push'. -This could be used to clean up `org-mobile-directory', for example to -remove files that used to be included in the agenda but no longer are. -The presence of such files would not really be a problem, but after time -they may accumulate.") - -(defvar org-mobile-post-push-hook nil - "Hook run after running `org-mobile-push'. -If Emacs does not have direct write access to the WebDAV directory used -by the mobile device, this hook should be used to copy all files from the -local staging directory `org-mobile-directory' to the WebDAV directory, -for example using `rsync' or `scp'.") - -(defvar org-mobile-pre-pull-hook nil - "Hook run before executing `org-mobile-pull'. -If Emacs does not have direct write access to the WebDAV directory used -by the mobile device, this hook should be used to copy the capture file -`mobileorg.org' from the WebDAV location to the local staging -directory `org-mobile-directory'.") - -(defvar org-mobile-post-pull-hook nil - "Hook run after running `org-mobile-pull', only if new items were found. -If Emacs does not have direct write access to the WebDAV directory used -by the mobile device, this hook should be used to copy the emptied -capture file `mobileorg.org' back to the WebDAV directory, for example -using `rsync' or `scp'.") - -(defvar org-mobile-last-flagged-files nil - "List of files containing entries flagged in the latest pull.") - -(defvar org-mobile-files-alist nil) -(defvar org-mobile-checksum-files nil) - -(defun org-mobile-prepare-file-lists () - (setq org-mobile-files-alist (org-mobile-files-alist)) - (setq org-mobile-checksum-files nil)) - -(defun org-mobile-files-alist () - "Expand the list in `org-mobile-files' to a list of existing files. -Also exclude files matching `org-mobile-files-exclude-regexp'." - (let* ((include-archives - (and (member 'org-agenda-text-search-extra-files org-mobile-files) - (member 'agenda-archives org-agenda-text-search-extra-files) - t)) - (files - (apply 'append - (mapcar - (lambda (f) - (cond - ((eq f 'org-agenda-files) - (org-agenda-files t include-archives)) - ((eq f 'org-agenda-text-search-extra-files) - (delq 'agenda-archives - (copy-sequence - org-agenda-text-search-extra-files))) - ((and (stringp f) (file-directory-p f)) - (directory-files f 'full "\\.org\\'")) - ((and (stringp f) (file-exists-p f)) - (list f)) - (t nil))) - org-mobile-files))) - (files (delq - nil - (mapcar (lambda (f) - (unless (and (not (string= org-mobile-files-exclude-regexp "")) - (string-match org-mobile-files-exclude-regexp f)) - (identity f))) - files))) - (orgdir-uname (file-name-as-directory (file-truename org-directory))) - (orgdir-re (concat "\\`" (regexp-quote orgdir-uname))) - uname seen rtn file link-name) - ;; Make the files unique, and determine the name under which they will - ;; be listed. - (while (setq file (pop files)) - (if (not (file-name-absolute-p file)) - (setq file (expand-file-name file org-directory))) - (setq uname (file-truename file)) - (unless (member uname seen) - (push uname seen) - (if (string-match orgdir-re uname) - (setq link-name (substring uname (match-end 0))) - (setq link-name (file-name-nondirectory uname))) - (push (cons file link-name) rtn))) - (nreverse rtn))) - -;;;###autoload -(defun org-mobile-push () - "Push the current state of Org affairs to the target directory. -This will create the index file, copy all agenda files there, and also -create all custom agenda views, for upload to the mobile phone." - (interactive) - (let ((a-buffer (get-buffer org-agenda-buffer-name))) - (let ((org-agenda-curbuf-name org-agenda-buffer-name) - (org-agenda-buffer-name "*SUMO*") - (org-agenda-tag-filter org-agenda-tag-filter) - (org-agenda-redo-command org-agenda-redo-command)) - (save-excursion - (save-restriction - (save-window-excursion - (run-hooks 'org-mobile-pre-push-hook) - (org-mobile-check-setup) - (org-mobile-prepare-file-lists) - (message "Creating agendas...") - (let ((inhibit-redisplay t) - (org-agenda-files (mapcar 'car org-mobile-files-alist))) - (org-mobile-create-sumo-agenda)) - (message "Creating agendas...done") - (org-save-all-org-buffers) ; to save any IDs created by this process - (message "Copying files...") - (org-mobile-copy-agenda-files) - (message "Writing index file...") - (org-mobile-create-index-file) - (message "Writing checksums...") - (org-mobile-write-checksums) - (run-hooks 'org-mobile-post-push-hook)))) - (setq org-agenda-buffer-name org-agenda-curbuf-name - org-agenda-this-buffer-name org-agenda-curbuf-name)) - (redraw-display) - (when (buffer-live-p a-buffer) - (if (not (get-buffer-window a-buffer)) - (kill-buffer a-buffer) - (let ((cw (selected-window))) - (select-window (get-buffer-window a-buffer)) - (org-agenda-redo) - (select-window cw))))) - (message "Files for mobile viewer staged")) - -(defvar org-mobile-before-process-capture-hook nil - "Hook that is run after content was moved to `org-mobile-inbox-for-pull'. -The inbox file is visited by the current buffer, and the buffer is -narrowed to the newly captured data.") - -;;;###autoload -(defun org-mobile-pull () - "Pull the contents of `org-mobile-capture-file' and integrate them. -Apply all flagged actions, flag entries to be flagged and then call an -agenda view showing the flagged items." - (interactive) - (org-mobile-check-setup) - (run-hooks 'org-mobile-pre-pull-hook) - (let ((insertion-marker (org-mobile-move-capture))) - (if (not (markerp insertion-marker)) - (message "No new items") - (org-with-point-at insertion-marker - (save-restriction - (narrow-to-region (point) (point-max)) - (run-hooks 'org-mobile-before-process-capture-hook))) - (org-with-point-at insertion-marker - (org-mobile-apply (point) (point-max))) - (move-marker insertion-marker nil) - (run-hooks 'org-mobile-post-pull-hook) - (when org-mobile-last-flagged-files - ;; Make an agenda view of flagged entries, but only in the files - ;; where stuff has been added. - (put 'org-agenda-files 'org-restrict org-mobile-last-flagged-files) - (let ((org-agenda-keep-restricted-file-list t)) - (org-agenda nil "?")))))) - -(defun org-mobile-check-setup () - "Check if org-mobile-directory has been set up." - (org-mobile-cleanup-encryption-tempfile) - (unless (and org-directory - (stringp org-directory) - (string-match "\\S-" org-directory) - (file-exists-p org-directory) - (file-directory-p org-directory)) - (error - "Please set `org-directory' to the directory where your org files live")) - (unless (and org-mobile-directory - (stringp org-mobile-directory) - (string-match "\\S-" org-mobile-directory) - (file-exists-p org-mobile-directory) - (file-directory-p org-mobile-directory)) - (error - "Variable `org-mobile-directory' must point to an existing directory")) - (unless (and org-mobile-inbox-for-pull - (stringp org-mobile-inbox-for-pull) - (string-match "\\S-" org-mobile-inbox-for-pull) - (file-exists-p - (file-name-directory org-mobile-inbox-for-pull))) - (error - "Variable `org-mobile-inbox-for-pull' must point to a file in an existing directory")) - (unless (and org-mobile-checksum-binary - (string-match "\\S-" org-mobile-checksum-binary)) - (error "No executable found to compute checksums")) - (when org-mobile-use-encryption - (unless (string-match "\\S-" (org-mobile-encryption-password)) - (error - "To use encryption, you must set `org-mobile-encryption-password'")) - (unless (file-writable-p org-mobile-encryption-tempfile) - (error "Cannot write to encryption tempfile %s" - org-mobile-encryption-tempfile)) - (unless (executable-find "openssl") - (error "OpenSSL is needed to encrypt files")))) - -(defun org-mobile-create-index-file () - "Write the index file in the WebDAV directory." - (let ((files-alist (sort (copy-sequence org-mobile-files-alist) - (lambda (a b) (string< (cdr a) (cdr b))))) - (def-todo (default-value 'org-todo-keywords)) - (def-tags (default-value 'org-tag-alist)) - (target-file (expand-file-name org-mobile-index-file - org-mobile-directory)) - file link-name todo-kwds done-kwds tags drawers entry kwds dwds twds) - (when (stringp (car def-todo)) - (setq def-todo (list (cons 'sequence def-todo)))) - (org-agenda-prepare-buffers (mapcar 'car files-alist)) - (setq done-kwds (org-uniquify org-done-keywords-for-agenda)) - (setq todo-kwds (org-delete-all - done-kwds - (org-uniquify org-todo-keywords-for-agenda))) - (setq drawers (org-uniquify org-drawers-for-agenda)) - (setq tags (mapcar 'car (org-global-tags-completion-table - (mapcar 'car files-alist)))) - (with-temp-file - (if org-mobile-use-encryption - org-mobile-encryption-tempfile - target-file) - (while (setq entry (pop def-todo)) - (insert "#+READONLY\n") - (setq kwds (mapcar (lambda (x) (if (string-match "(" x) - (substring x 0 (match-beginning 0)) - x)) - (cdr entry))) - (insert "#+TODO: " (mapconcat 'identity kwds " ") "\n") - (setq dwds (member "|" kwds) - twds (org-delete-all dwds kwds) - todo-kwds (org-delete-all twds todo-kwds) - done-kwds (org-delete-all dwds done-kwds))) - (when (or todo-kwds done-kwds) - (insert "#+TODO: " (mapconcat 'identity todo-kwds " ") " | " - (mapconcat 'identity done-kwds " ") "\n")) - (setq def-tags (mapcar - (lambda (x) - (cond ((null x) nil) - ((stringp x) x) - ((eq (car x) :startgroup) "{") - ((eq (car x) :endgroup) "}") - ((eq (car x) :newline) nil) - ((listp x) (car x)))) - def-tags)) - (setq def-tags (delq nil def-tags)) - (setq tags (org-delete-all def-tags tags)) - (setq tags (sort tags (lambda (a b) (string< (downcase a) (downcase b))))) - (setq tags (append def-tags tags nil)) - (insert "#+TAGS: " (mapconcat 'identity tags " ") "\n") - (insert "#+DRAWERS: " (mapconcat 'identity drawers " ") "\n") - (insert "#+ALLPRIORITIES: " org-mobile-allpriorities "\n") - (when (file-exists-p (expand-file-name - org-mobile-directory "agendas.org")) - (insert "* [[file:agendas.org][Agenda Views]]\n")) - (while (setq entry (pop files-alist)) - (setq file (car entry) - link-name (cdr entry)) - (insert (format "* [[file:%s][%s]]\n" - link-name link-name))) - (push (cons org-mobile-index-file (md5 (buffer-string))) - org-mobile-checksum-files)) - (when org-mobile-use-encryption - (org-mobile-encrypt-and-move org-mobile-encryption-tempfile - target-file) - (org-mobile-cleanup-encryption-tempfile)))) - -(defun org-mobile-copy-agenda-files () - "Copy all agenda files to the stage or WebDAV directory." - (let ((files-alist org-mobile-files-alist) - file buf entry link-name target-path target-dir check) - (while (setq entry (pop files-alist)) - (setq file (car entry) link-name (cdr entry)) - (when (file-exists-p file) - (setq target-path (expand-file-name link-name org-mobile-directory) - target-dir (file-name-directory target-path)) - (unless (file-directory-p target-dir) - (make-directory target-dir 'parents)) - (if org-mobile-use-encryption - (org-mobile-encrypt-and-move file target-path) - (copy-file file target-path 'ok-if-exists)) - (setq check (shell-command-to-string - (concat org-mobile-checksum-binary " " - (shell-quote-argument (expand-file-name file))))) - (when (string-match "[a-fA-F0-9]\\{30,40\\}" check) - (push (cons link-name (match-string 0 check)) - org-mobile-checksum-files)))) - - (setq file (expand-file-name org-mobile-capture-file - org-mobile-directory)) - (save-excursion - (setq buf (find-file file)) - (when (and (= (point-min) (point-max))) - (insert "\n") - (save-buffer) - (when org-mobile-use-encryption - (write-file org-mobile-encryption-tempfile) - (org-mobile-encrypt-and-move org-mobile-encryption-tempfile file))) - (push (cons org-mobile-capture-file (md5 (buffer-string))) - org-mobile-checksum-files)) - (org-mobile-cleanup-encryption-tempfile) - (kill-buffer buf))) - -(defun org-mobile-write-checksums () - "Create checksums for all files in `org-mobile-directory'. -The table of checksums is written to the file mobile-checksums." - (let ((sumfile (expand-file-name "checksums.dat" org-mobile-directory)) - (files org-mobile-checksum-files) - entry file sum) - (with-temp-file sumfile - (set-buffer-file-coding-system 'undecided-unix nil) - (while (setq entry (pop files)) - (setq file (car entry) sum (cdr entry)) - (insert (format "%s %s\n" sum file)))))) - -(defun org-mobile-sumo-agenda-command () - "Return an agenda custom command that comprises all custom commands." - (let ((custom-list - ;; normalize different versions - (delq nil - (mapcar - (lambda (x) - (cond ((stringp (cdr x)) nil) - ((stringp (nth 1 x)) x) - ((not (nth 1 x)) (cons (car x) (cons "" (cddr x)))) - (t (cons (car x) (cons "" (cdr x)))))) - org-agenda-custom-commands))) - (default-list '(("a" "Agenda" agenda) ("t" "All TODO" alltodo))) - thelist atitle new e key desc type match settings cmds gkey gdesc gsettings cnt) - (cond - ((eq org-mobile-agendas 'custom) - (setq thelist custom-list)) - ((eq org-mobile-agendas 'default) - (setq thelist default-list)) - ((eq org-mobile-agendas 'all) - (setq thelist custom-list) - (unless (assoc "t" thelist) (push '("t" "ALL TODO" alltodo) thelist)) - (unless (assoc "a" thelist) (push '("a" "Agenda" agenda) thelist))) - ((listp org-mobile-agendas) - (setq thelist (append custom-list default-list)) - (setq thelist (delq nil (mapcar (lambda (k) (assoc k thelist)) - org-mobile-agendas))))) - (while (setq e (pop thelist)) - (cond - ((stringp (cdr e)) - ;; this is a description entry - skip it - ) - ((eq (nth 2 e) 'search) - ;; Search view is interactive, skip - ) - ((memq (nth 2 e) '(todo-tree tags-tree occur-tree)) - ;; These are trees, not really agenda commands - ) - ((and (memq (nth 2 e) '(todo tags tags-todo)) - (or (null (nth 3 e)) - (not (string-match "\\S-" (nth 3 e))))) - ;; These would be interactive because the match string is empty - ) - ((memq (nth 2 e) '(agenda alltodo todo tags tags-todo)) - ;; a normal command - (setq key (car e) desc (nth 1 e) type (nth 2 e) match (nth 3 e) - settings (nth 4 e)) - (setq settings - (cons (list 'org-agenda-title-append - (concat "<after>KEYS=" key " TITLE: " - (if (and (stringp desc) (> (length desc) 0)) - desc (symbol-name type)) - "</after>")) - settings)) - (push (list type match settings) new)) - ((or (functionp (nth 2 e)) (symbolp (nth 2 e))) - ;; A user-defined function, which can do anything, so simply - ;; ignore it. - ) - (t - ;; a block agenda - (setq gkey (car e) gdesc (nth 1 e) gsettings (nth 3 e) cmds (nth 2 e)) - (setq cnt 0) - (while (setq e (pop cmds)) - (setq type (car e) match (nth 1 e) settings (nth 2 e)) - (setq atitle (if (string= "" gdesc) match gdesc)) - (setq settings (append gsettings settings)) - (setq settings - (cons (list 'org-agenda-title-append - (concat "<after>KEYS=" gkey "#" (number-to-string - (setq cnt (1+ cnt))) - " TITLE: " atitle "</after>")) - settings)) - (push (list type match settings) new))))) - (and new (list "X" "SUMO" (reverse new) - '((org-agenda-compact-blocks nil)))))) - -(defvar org-mobile-creating-agendas nil) -(defun org-mobile-write-agenda-for-mobile (file) - (let ((all (buffer-string)) in-date id pl prefix line app short m sexp) - (with-temp-file file - (org-mode) - (insert "#+READONLY\n") - (insert all) - (goto-char (point-min)) - (while (not (eobp)) - (cond - ((looking-at "[ \t]*$")) ; keep empty lines - ((looking-at "=+$") - ;; remove underlining - (delete-region (point) (point-at-eol))) - ((get-text-property (point) 'org-agenda-structural-header) - (setq in-date nil) - (setq app (get-text-property (point) 'org-agenda-title-append)) - (setq short (get-text-property (point) 'short-heading)) - (when (and short (looking-at ".+")) - (replace-match short nil t) - (beginning-of-line 1)) - (when app - (end-of-line 1) - (insert app) - (beginning-of-line 1)) - (insert "* ")) - ((get-text-property (point) 'org-agenda-date-header) - (setq in-date t) - (insert "** ")) - ((setq m (or (get-text-property (point) 'org-hd-marker) - (get-text-property (point) 'org-marker))) - (setq sexp (member (get-text-property (point) 'type) - '("diary" "sexp"))) - (if (setq pl (text-property-any (point) (point-at-eol) 'org-heading t)) - (progn - (setq prefix (org-trim (buffer-substring - (point) pl)) - line (org-trim (buffer-substring - pl - (point-at-eol)))) - (delete-region (point-at-bol) (point-at-eol)) - (insert line "<before>" prefix "</before>") - (beginning-of-line 1)) - (and (looking-at "[ \t]+") (replace-match ""))) - (insert (if in-date "*** " "** ")) - (end-of-line 1) - (insert "\n") - (unless sexp - (insert (org-agenda-get-some-entry-text - m 10 " " 'planning) - "\n") - (when (setq id - (if (org-bound-and-true-p - org-mobile-force-id-on-agenda-items) - (org-id-get m 'create) - (or (org-entry-get m "ID") - (org-mobile-get-outline-path-link m)))) - (insert " :PROPERTIES:\n :ORIGINAL_ID: " id - "\n :END:\n"))))) - (beginning-of-line 2)) - (push (cons "agendas.org" (md5 (buffer-string))) - org-mobile-checksum-files)) - (message "Agenda written to Org file %s" file))) - -(defun org-mobile-get-outline-path-link (pom) - (org-with-point-at pom - (concat "olp:" - (org-mobile-escape-olp (file-name-nondirectory buffer-file-name)) - "/" - (mapconcat 'org-mobile-escape-olp - (org-get-outline-path) - "/") - "/" - (org-mobile-escape-olp (nth 4 (org-heading-components)))))) - -(defun org-mobile-escape-olp (s) - (let ((table '(?: ?/))) - (org-link-escape s table))) - -(defun org-mobile-create-sumo-agenda () - "Create a file that contains all custom agenda views." - (interactive) - (let* ((file (expand-file-name "agendas.org" - org-mobile-directory)) - (file1 (if org-mobile-use-encryption - org-mobile-encryption-tempfile - file)) - (sumo (org-mobile-sumo-agenda-command)) - (org-agenda-custom-commands - (list (append sumo (list (list file1))))) - (org-mobile-creating-agendas t)) - (unless (file-writable-p file1) - (error "Cannot write to file %s" file1)) - (when sumo - (org-store-agenda-views)) - (when org-mobile-use-encryption - (org-mobile-encrypt-and-move file1 file) - (delete-file file1) - (org-mobile-cleanup-encryption-tempfile)))) - -(defun org-mobile-encrypt-and-move (infile outfile) - "Encrypt INFILE locally to INFILE_enc, then move it to OUTFILE. -We do this in two steps so that remote paths will work, even if the -encryption program does not understand them." - (let ((encfile (concat infile "_enc"))) - (org-mobile-encrypt-file infile encfile) - (when outfile - (copy-file encfile outfile 'ok-if-exists) - (delete-file encfile)))) - -(defun org-mobile-encrypt-file (infile outfile) - "Encrypt INFILE to OUTFILE, using `org-mobile-encryption-password'." - (shell-command - (format "openssl enc -aes-256-cbc -salt -pass %s -in %s -out %s" - (shell-quote-argument (concat "pass:" - (org-mobile-encryption-password))) - (shell-quote-argument (expand-file-name infile)) - (shell-quote-argument (expand-file-name outfile))))) - -(defun org-mobile-decrypt-file (infile outfile) - "Decrypt INFILE to OUTFILE, using `org-mobile-encryption-password'." - (shell-command - (format "openssl enc -d -aes-256-cbc -salt -pass %s -in %s -out %s" - (shell-quote-argument (concat "pass:" - (org-mobile-encryption-password))) - (shell-quote-argument (expand-file-name infile)) - (shell-quote-argument (expand-file-name outfile))))) - -(defun org-mobile-cleanup-encryption-tempfile () - "Remove the encryption tempfile if it exists." - (and (stringp org-mobile-encryption-tempfile) - (file-exists-p org-mobile-encryption-tempfile) - (delete-file org-mobile-encryption-tempfile))) - -(defun org-mobile-move-capture () - "Move the contents of the capture file to the inbox file. -Return a marker to the location where the new content has been added. -If nothing new has been added, return nil." - (interactive) - (let* ((encfile nil) - (capture-file (expand-file-name org-mobile-capture-file - org-mobile-directory)) - (inbox-buffer (find-file-noselect org-mobile-inbox-for-pull)) - (capture-buffer - (if (not org-mobile-use-encryption) - (find-file-noselect capture-file) - (org-mobile-cleanup-encryption-tempfile) - (setq encfile (concat org-mobile-encryption-tempfile "_enc")) - (copy-file capture-file encfile) - (org-mobile-decrypt-file encfile org-mobile-encryption-tempfile) - (find-file-noselect org-mobile-encryption-tempfile))) - (insertion-point (make-marker)) - not-empty content) - (with-current-buffer capture-buffer - (setq content (buffer-string)) - (setq not-empty (string-match "\\S-" content)) - (when not-empty - (set-buffer inbox-buffer) - (widen) - (goto-char (point-max)) - (or (bolp) (newline)) - (move-marker insertion-point - (prog1 (point) (insert content))) - (save-buffer) - (set-buffer capture-buffer) - (erase-buffer) - (save-buffer) - (org-mobile-update-checksum-for-capture-file (buffer-string)))) - (kill-buffer capture-buffer) - (when org-mobile-use-encryption - (org-mobile-encrypt-and-move org-mobile-encryption-tempfile - capture-file) - (org-mobile-cleanup-encryption-tempfile)) - (if not-empty insertion-point))) - -(defun org-mobile-update-checksum-for-capture-file (buffer-string) - "Find the checksum line and modify it to match BUFFER-STRING." - (let* ((file (expand-file-name "checksums.dat" org-mobile-directory)) - (buffer (find-file-noselect file))) - (when buffer - (with-current-buffer buffer - (when (re-search-forward (concat "\\([0-9a-fA-F]\\{30,\\}\\).*?" - (regexp-quote org-mobile-capture-file) - "[ \t]*$") nil t) - (goto-char (match-beginning 1)) - (delete-region (match-beginning 1) (match-end 1)) - (insert (md5 buffer-string)) - (save-buffer))) - (kill-buffer buffer)))) - -(defun org-mobile-apply (&optional beg end) - "Apply all change requests in the current buffer. -If BEG and END are given, only do this in that region." - (interactive) - (require 'org-archive) - (setq org-mobile-last-flagged-files nil) - (setq beg (or beg (point-min)) end (or end (point-max))) - - ;; Remove all Note IDs - (goto-char beg) - (while (re-search-forward "^\\*\\* Note ID: [-0-9A-F]+[ \t]*\n" end t) - (replace-match "")) - - ;; Find all the referenced entries, without making any changes yet - (let ((marker (make-marker)) - (bos-marker (make-marker)) - (end (move-marker (make-marker) end)) - (cnt-new 0) - (cnt-edit 0) - (cnt-flag 0) - (cnt-error 0) - buf-list - id-pos org-mobile-error) - - ;; Count the new captures - (goto-char beg) - (while (re-search-forward "^\\* \\(.*\\)" end t) - (and (>= (- (match-end 1) (match-beginning 1)) 2) - (not (equal (downcase (substring (match-string 1) 0 2)) "f(")) - (incf cnt-new))) - - ;; Find and apply the edits - (goto-char beg) - (while (re-search-forward - "^\\*+[ \t]+F(\\([^():\n]*\\)\\(:\\([^()\n]*\\)\\)?)[ \t]+\\[\\[\\(\\(id\\|olp\\):\\([^]\n]+\\)\\)" end t) - (catch 'next - (let* ((action (match-string 1)) - (data (and (match-end 3) (match-string 3))) - (id-pos (condition-case msg - (org-mobile-locate-entry (match-string 4)) - (error (nth 1 msg)))) - (bos (point-at-bol)) - (eos (save-excursion (org-end-of-subtree t t))) - (cmd (if (equal action "") - '(progn - (incf cnt-flag) - (org-toggle-tag "FLAGGED" 'on) - (and note - (org-entry-put nil "THEFLAGGINGNOTE" note))) - (incf cnt-edit) - (cdr (assoc action org-mobile-action-alist)))) - (note (and (equal action "") - (buffer-substring (1+ (point-at-eol)) eos))) - (org-inhibit-logging 'note) ;; Do not take notes interactively - old new) - - (goto-char bos) - (when (and (markerp id-pos) - (not (member (marker-buffer id-pos) buf-list))) - (org-mobile-timestamp-buffer (marker-buffer id-pos)) - (push (marker-buffer id-pos) buf-list)) - (unless (markerp id-pos) - (goto-char (+ 2 (point-at-bol))) - (if (stringp id-pos) - (insert id-pos " ") - (insert "BAD REFERENCE ")) - (incf cnt-error) - (throw 'next t)) - (unless cmd - (insert "BAD FLAG ") - (incf cnt-error) - (throw 'next t)) - (move-marker bos-marker (point)) - (if (re-search-forward "^** Old value[ \t]*$" eos t) - (setq old (buffer-substring - (1+ (match-end 0)) - (progn (outline-next-heading) (point))))) - (if (re-search-forward "^** New value[ \t]*$" eos t) - (setq new (buffer-substring - (1+ (match-end 0)) - (progn (outline-next-heading) - (if (eobp) (org-back-over-empty-lines)) - (point))))) - (setq old (and old (if (string-match "\\S-" old) old nil))) - (setq new (and new (if (string-match "\\S-" new) new nil))) - (if (and note (> (length note) 0)) - ;; Make Note into a single line, to fit into a property - (setq note (mapconcat 'identity - (org-split-string (org-trim note) "\n") - "\\n"))) - (unless (equal data "body") - (setq new (and new (org-trim new)) - old (and old (org-trim old)))) - (goto-char (+ 2 bos-marker)) - ;; Remember this place so that we can return - (move-marker marker (point)) - (setq org-mobile-error nil) - (save-excursion - (condition-case msg - (org-with-point-at id-pos - (progn - (eval cmd) - (unless (member data (list "delete" "archive" "archive-sibling" "addheading")) - (if (member "FLAGGED" (org-get-tags)) - (add-to-list 'org-mobile-last-flagged-files - (buffer-file-name (current-buffer))))))) - (error (setq org-mobile-error msg)))) - (when org-mobile-error - (org-pop-to-buffer-same-window (marker-buffer marker)) - (goto-char marker) - (incf cnt-error) - (insert (if (stringp (nth 1 org-mobile-error)) - (nth 1 org-mobile-error) - "EXECUTION FAILED") - " ") - (throw 'next t)) - ;; If we get here, the action has been applied successfully - ;; So remove the entry - (goto-char bos-marker) - (delete-region (point) (org-end-of-subtree t t))))) - (save-buffer) - (move-marker marker nil) - (move-marker end nil) - (message "%d new, %d edits, %d flags, %d errors" cnt-new - cnt-edit cnt-flag cnt-error) - (sit-for 1))) - -(defun org-mobile-timestamp-buffer (buf) - "Time stamp buffer BUF, just to make sure its checksum will change." - (with-current-buffer buf - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (if (re-search-forward - "^\\([ \t]*\\)#\\+LAST_MOBILE_CHANGE:.*\n?" nil t) - (progn - (goto-char (match-end 1)) - (delete-region (point) (match-end 0))) - (if (looking-at ".*?-\\*-.*-\\*-") - (forward-line 1))) - (insert "#+LAST_MOBILE_CHANGE: " - (format-time-string "%Y-%m-%d %T") "\n"))))) - -(defun org-mobile-smart-read () - "Parse the entry at point for shortcuts and expand them. -These shortcuts are meant for fast and easy typing on the limited -keyboards of a mobile device. Below we show a list of the shortcuts -currently implemented. - -The entry is expected to contain an inactive time stamp indicating when -the entry was created. When setting dates and -times (for example for deadlines), the time strings are interpreted -relative to that creation date. -Abbreviations are expected to take up entire lines, just because it is so -easy to type RET on a mobile device. Abbreviations start with one or two -letters, followed immediately by a dot and then additional information. -Generally the entire shortcut line is removed after action have been taken. -Time stamps will be constructed using `org-read-date'. So for example a -line \"dd. 2tue\" will set a deadline on the second Tuesday after the -creation date. - -Here are the shortcuts currently implemented: - -dd. string set deadline -ss. string set scheduling -tt. string set time tamp, here. -ti. string set inactive time - -tg. tag1 tag2 tag3 set all these tags, change case where necessary -td. kwd set this todo keyword, change case where necessary - -FIXME: Hmmm, not sure if we can make his work against the -auto-correction feature. Needs a bit more thinking. So this function -is currently a noop.") - -(defun org-mobile-locate-entry (link) - (if (string-match "\\`id:\\(.*\\)$" link) - (org-id-find (match-string 1 link) 'marker) - (if (not (string-match "\\`olp:\\(.*?\\):\\(.*\\)$" link)) - ; not found with path, but maybe it is to be inserted - ; in top level of the file? - (if (not (string-match "\\`olp:\\(.*?\\)$" link)) - nil - (let ((file (match-string 1 link))) - (setq file (org-link-unescape file)) - (setq file (expand-file-name file org-directory)) - (save-excursion - (find-file file) - (goto-char (point-max)) - (newline) - (goto-char (point-max)) - (point-marker)))) - (let ((file (match-string 1 link)) - (path (match-string 2 link))) - (setq file (org-link-unescape file)) - (setq file (expand-file-name file org-directory)) - (setq path (mapcar 'org-link-unescape - (org-split-string path "/"))) - (org-find-olp (cons file path)))))) - -(defun org-mobile-edit (what old new) - "Edit item WHAT in the current entry by replacing OLD with NEW. -WHAT can be \"heading\", \"todo\", \"tags\", \"priority\", or \"body\". -The edit only takes place if the current value is equal (except for -white space) the OLD. If this is so, OLD will be replace by NEW -and the command will return t. If something goes wrong, a string will -be returned that indicates what went wrong." - (let (current old1 new1 level) - (if (stringp what) (setq what (intern what))) - - (cond - - ((memq what '(todo todostate)) - (setq current (org-get-todo-state)) - (cond - ((equal new "DONEARCHIVE") - (org-todo 'done) - (org-archive-subtree-default)) - ((equal new current) t) ; nothing needs to be done - ((or (equal current old) - (eq org-mobile-force-mobile-change t) - (memq 'todo org-mobile-force-mobile-change)) - (org-todo (or new 'none)) t) - (t (error "State before change was expected as \"%s\", but is \"%s\"" - old current)))) - - ((eq what 'tags) - (setq current (org-get-tags) - new1 (and new (org-split-string new ":+")) - old1 (and old (org-split-string old ":+"))) - (cond - ((org-mobile-tags-same-p current new1) t) ; no change needed - ((or (org-mobile-tags-same-p current old1) - (eq org-mobile-force-mobile-change t) - (memq 'tags org-mobile-force-mobile-change)) - (org-set-tags-to new1) t) - (t (error "Tags before change were expected as \"%s\", but are \"%s\"" - (or old "") (or current ""))))) - - ((eq what 'priority) - (when (looking-at org-complex-heading-regexp) - (setq current (and (match-end 3) (substring (match-string 3) 2 3))) - (cond - ((equal current new) t) ; no action required - ((or (equal current old) - (eq org-mobile-force-mobile-change t) - (memq 'tags org-mobile-force-mobile-change)) - (org-priority (and new (string-to-char new)))) - (t (error "Priority was expected to be %s, but is %s" - old current))))) - - ((eq what 'heading) - (when (looking-at org-complex-heading-regexp) - (setq current (match-string 4)) - (cond - ((equal current new) t) ; no action required - ((or (equal current old) - (eq org-mobile-force-mobile-change t) - (memq 'heading org-mobile-force-mobile-change)) - (goto-char (match-beginning 4)) - (insert new) - (delete-region (point) (+ (point) (length current))) - (org-set-tags nil 'align)) - (t (error "Heading changed in MobileOrg and on the computer"))))) - - ((eq what 'addheading) - (if (org-at-heading-p) ; if false we are in top-level of file - (progn - ;; Workaround a `org-insert-heading-respect-content' bug - ;; which prevents correct insertion when point is invisible - (org-show-subtree) - (end-of-line 1) - (org-insert-heading-respect-content '(16) t) - (org-demote)) - (beginning-of-line) - (insert "* ")) - (insert new)) - - ((eq what 'refile) - (org-copy-subtree) - (org-with-point-at (org-mobile-locate-entry new) - (if (org-at-heading-p) ; if false we are in top-level of file - (progn - (setq level (org-get-valid-level (funcall outline-level) 1)) - (org-end-of-subtree t t) - (org-paste-subtree level)) - (org-paste-subtree 1))) - (org-cut-subtree)) - - ((eq what 'delete) - (org-cut-subtree)) - - ((eq what 'archive) - (org-archive-subtree)) - - ((eq what 'archive-sibling) - (org-archive-to-archive-sibling)) - - ((eq what 'body) - (setq current (buffer-substring (min (1+ (point-at-eol)) (point-max)) - (save-excursion (outline-next-heading) - (point)))) - (if (not (string-match "\\S-" current)) (setq current nil)) - (cond - ((org-mobile-bodies-same-p current new) t) ; no action necessary - ((or (org-mobile-bodies-same-p current old) - (eq org-mobile-force-mobile-change t) - (memq 'body org-mobile-force-mobile-change)) - (save-excursion - (end-of-line 1) - (insert "\n" new) - (or (bolp) (insert "\n")) - (delete-region (point) (progn (org-back-to-heading t) - (outline-next-heading) - (point)))) - t) - (t (error "Body was changed in MobileOrg and on the computer"))))))) - -(defun org-mobile-tags-same-p (list1 list2) - "Are the two tag lists the same?" - (not (or (org-delete-all list1 list2) - (org-delete-all list2 list1)))) - -(defun org-mobile-bodies-same-p (a b) - "Compare if A and B are visually equal strings. -We first remove leading and trailing white space from the entire strings. -Then we split the strings into lines and remove leading/trailing whitespace -from each line. Then we compare. -A and B must be strings or nil." - (cond - ((and (not a) (not b)) t) - ((or (not a) (not b)) nil) - (t (setq a (org-trim a) b (org-trim b)) - (setq a (mapconcat 'identity (org-split-string a "[ \t]*\n[ \t]*") "\n")) - (setq b (mapconcat 'identity (org-split-string b "[ \t]*\n[ \t]*") "\n")) - (equal a b)))) - -(provide 'org-mobile) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-mobile.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-mouse.el b/xemacs-packages/lisp/org-8.2.3c/org-mouse.el deleted file mode 100644 index c8a6c86c..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-mouse.el +++ /dev/null @@ -1,1107 +0,0 @@ -;;; org-mouse.el --- Better mouse support for org-mode - -;; Copyright (C) 2006-2013 Free Software Foundation, Inc. - -;; Author: Piotr Zielinski <piotr dot zielinski at gmail dot com> -;; Maintainer: Carsten Dominik <carsten at orgmode dot org> - -;; 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: -;; -;; Org-mouse provides mouse support for org-mode. -;; -;; http://orgmode.org -;; -;; Org-mouse implements the following features: -;; * following links with the left mouse button (in Emacs 22) -;; * subtree expansion/collapse (org-cycle) with the left mouse button -;; * several context menus on the right mouse button: -;; + general text -;; + headlines -;; + timestamps -;; + priorities -;; + links -;; + tags -;; * promoting/demoting/moving subtrees with mouse-3 -;; + if the drag starts and ends in the same line then promote/demote -;; + otherwise move the subtree -;; -;; Use -;; --- -;; -;; To use this package, put the following line in your .emacs: -;; -;; (require 'org-mouse) -;; - -;; FIXME: -;; + deal with folding / unfolding issues - -;; TODO (This list is only theoretical, if you'd like to have some -;; feature implemented or a bug fix please send me an email, even if -;; something similar appears in the list below. This will help me get -;; the priorities right.): -;; -;; + org-store-link, insert link -;; + org tables -;; + occur with the current word/tag (same menu item) -;; + ctrl-c ctrl-c, for example, renumber the current list -;; + internal links - -;; Please email the maintainer with new feature suggestions / bugs - -;; History: -;; -;; Since version 5.10: Changes are listed in the general org-mode docs. -;; -;; Version 5.09;; + Version number synchronization with Org-mode. -;; -;; Version 0.25 -;; + made compatible with org-mode 4.70 (thanks to Carsten for the patch) -;; -;; Version 0.24 -;; + minor changes to the table menu -;; -;; Version 0.23 -;; + preliminary support for tables and calculation marks -;; + context menu support for org-agenda-undo & org-sort-entries -;; -;; Version 0.22 -;; + handles undo support for the agenda buffer (requires org-mode >=4.58) -;; -;; Version 0.21 -;; + selected text activates its context menu -;; + shift-middleclick or right-drag inserts the text from the clipboard in the form of a link -;; -;; Version 0.20 -;; + the new "TODO Status" submenu replaces the "Cycle TODO" menu item -;; + the TODO menu can now list occurrences of a specific TODO keyword -;; + #+STARTUP line is now recognized -;; -;; Version 0.19 -;; + added support for dragging URLs to the org-buffer -;; -;; Version 0.18 -;; + added support for agenda blocks -;; -;; Version 0.17 -;; + toggle checkboxes with a single click -;; -;; Version 0.16 -;; + added support for checkboxes -;; -;; Version 0.15 -;; + org-mode now works with the Agenda buffer as well -;; -;; Version 0.14 -;; + added a menu option that converts plain list items to outline items -;; -;; Version 0.13 -;; + "Insert Heading" now inserts a sibling heading if the point is -;; on "***" and a child heading otherwise -;; -;; Version 0.12 -;; + compatible with Emacs 21 -;; + custom agenda commands added to the main menu -;; + moving trees should now work between windows in the same frame -;; -;; Version 0.11 -;; + fixed org-mouse-at-link (thanks to Carsten) -;; + removed [follow-link] bindings -;; -;; Version 0.10 -;; + added a menu option to remove highlights -;; + compatible with org-mode 4.21 now -;; -;; Version 0.08: -;; + trees can be moved/promoted/demoted by dragging with the right -;; mouse button (mouse-3) -;; + small changes in the above function -;; -;; Versions 0.01 -- 0.07: (I don't remember) - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'org) - -(defvar org-agenda-allow-remote-undo) -(defvar org-agenda-undo-list) -(defvar org-agenda-custom-commands) -(declare-function org-agenda-change-all-lines "org-agenda" - (newhead hdmarker &optional fixface just-this)) -(declare-function org-verify-change-for-undo "org-agenda" (l1 l2)) -(declare-function org-apply-on-list "org-list" (function init-value &rest args)) -(declare-function org-agenda-earlier "org-agenda" (arg)) -(declare-function org-agenda-later "org-agenda" (arg)) - -(defvar org-mouse-plain-list-regexp "\\([ \t]*\\)\\([-+*]\\|[0-9]+[.)]\\) " - "Regular expression that matches a plain list.") -(defvar org-mouse-direct t - "Internal variable indicating whether the current action is direct. - -If t, then the current action has been invoked directly through the buffer -it is intended to operate on. If nil, then the action has been invoked -indirectly, for example, through the agenda buffer.") - -(defgroup org-mouse nil - "Mouse support for org-mode." - :tag "Org Mouse" - :group 'org) - -(defcustom org-mouse-punctuation ":" - "Punctuation used when inserting text by drag and drop." - :group 'org-mouse - :type 'string) - -(defcustom org-mouse-features - '(context-menu yank-link activate-stars activate-bullets activate-checkboxes) - "The features of org-mouse that should be activated. -Changing this variable requires a restart of Emacs to get activated." - :group 'org-mouse - :type '(set :greedy t - (const :tag "Mouse-3 shows context menu" context-menu) - (const :tag "C-mouse-1 and mouse-3 move trees" move-tree) - (const :tag "S-mouse-2 and drag-mouse-3 yank link" yank-link) - (const :tag "Activate headline stars" activate-stars) - (const :tag "Activate item bullets" activate-bullets) - (const :tag "Activate checkboxes" activate-checkboxes))) - -(defun org-mouse-re-search-line (regexp) - "Search the current line for a given regular expression." - (beginning-of-line) - (re-search-forward regexp (point-at-eol) t)) - -(defun org-mouse-end-headline () - "Go to the end of current headline (ignoring tags)." - (interactive) - (end-of-line) - (skip-chars-backward "\t ") - (when (org-looking-back ":[A-Za-z]+:") - (skip-chars-backward ":A-Za-z") - (skip-chars-backward "\t "))) - -(defvar org-mouse-context-menu-function nil - "Function to create the context menu. -The value of this variable is the function invoked by -`org-mouse-context-menu' as the context menu.") -(make-variable-buffer-local 'org-mouse-context-menu-function) - -(defun org-mouse-show-context-menu (event prefix) - "Invoke the context menu. - -If the value of `org-mouse-context-menu-function' is a function, then -this function is called. Otherwise, the current major mode menu is used." - (interactive "@e \nP") - (if (and (= (event-click-count event) 1) - (or (not mark-active) - (sit-for (/ double-click-time 1000.0)))) - (progn - (select-window (posn-window (event-start event))) - (when (not (org-mouse-mark-active)) - (goto-char (posn-point (event-start event))) - (when (not (eolp)) (save-excursion (run-hooks 'post-command-hook))) - (let ((redisplay-dont-pause t)) - (sit-for 0))) - (if (functionp org-mouse-context-menu-function) - (funcall org-mouse-context-menu-function event) - (if (fboundp 'mouse-menu-major-mode-map) - (popup-menu (mouse-menu-major-mode-map) event prefix) - (org-no-warnings ; don't warn about fallback, obsolete since 23.1 - (mouse-major-mode-menu event prefix))))) - (setq this-command 'mouse-save-then-kill) - (mouse-save-then-kill event))) - -(defun org-mouse-line-position () - "Return `:beginning' or `:middle' or `:end', depending on the point position. - -If the point is at the end of the line, return `:end'. -If the point is separated from the beginning of the line only by white -space and *'s (`org-mouse-bolp'), return `:beginning'. Otherwise, -return `:middle'." - (cond - ((eolp) :end) - ((org-mouse-bolp) :beginning) - (t :middle))) - -(defun org-mouse-empty-line () - "Return non-nil iff the line contains only white space." - (save-excursion (beginning-of-line) (looking-at "[ \t]*$"))) - -(defun org-mouse-next-heading () - "Go to the next heading. -If there is none, ensure that the point is at the beginning of an empty line." - (unless (outline-next-heading) - (beginning-of-line) - (unless (org-mouse-empty-line) - (end-of-line) - (newline)))) - -(defun org-mouse-insert-heading () - "Insert a new heading, as `org-insert-heading'. - -If the point is at the :beginning (`org-mouse-line-position') of the line, -insert the new heading before the current line. Otherwise, insert it -after the current heading." - (interactive) - (case (org-mouse-line-position) - (:beginning (beginning-of-line) - (org-insert-heading)) - (t (org-mouse-next-heading) - (org-insert-heading)))) - -(defun org-mouse-timestamp-today (&optional shift units) - "Change the timestamp into SHIFT UNITS in the future. - -For the acceptable UNITS, see `org-timestamp-change'." - (interactive) - (org-time-stamp nil) - (when shift (org-timestamp-change shift units))) - -(defun org-mouse-keyword-menu (keywords function &optional selected itemformat) - "A helper function. - -Returns a menu fragment consisting of KEYWORDS. When a keyword -is selected by the user, FUNCTION is called with the selected -keyword as the only argument. - -If SELECTED is nil, then all items are normal menu items. If -SELECTED is a function, then each item is a checkbox, which is -enabled for a given keyword iff (funcall SELECTED keyword) return -non-nil. If SELECTED is neither nil nor a function, then the -items are radio buttons. A radio button is enabled for the -keyword `equal' to SELECTED. - -ITEMFORMAT governs formatting of the elements of KEYWORDS. If it -is a function, it is invoked with the keyword as the only -argument. If it is a string, it is interpreted as the format -string to (format ITEMFORMAT keyword). If it is neither a string -nor a function, elements of KEYWORDS are used directly." - (mapcar - `(lambda (keyword) - (vector (cond - ((functionp ,itemformat) (funcall ,itemformat keyword)) - ((stringp ,itemformat) (format ,itemformat keyword)) - (t keyword)) - (list 'funcall ,function keyword) - :style (cond - ((null ,selected) t) - ((functionp ,selected) 'toggle) - (t 'radio)) - :selected (if (functionp ,selected) - (and (funcall ,selected keyword) t) - (equal ,selected keyword)))) - keywords)) - -(defun org-mouse-remove-match-and-spaces () - "Remove the match, make just one space around the point." - (interactive) - (replace-match "") - (just-one-space)) - -(defvar org-mouse-rest) -(defun org-mouse-replace-match-and-surround (newtext &optional fixedcase - literal string subexp) - "The same as `replace-match', but surrounds the replacement with spaces." - (apply 'replace-match org-mouse-rest) - (save-excursion - (goto-char (match-beginning (or subexp 0))) - (just-one-space) - (goto-char (match-end (or subexp 0))) - (just-one-space))) - -(defun org-mouse-keyword-replace-menu (keywords &optional group itemformat - nosurround) - "A helper function. - -Returns a menu fragment consisting of KEYWORDS. When a keyword -is selected, group GROUP of the current match is replaced by the -keyword. The method ensures that both ends of the replacement -are separated from the rest of the text in the buffer by -individual spaces (unless NOSURROUND is non-nil). - -The final entry of the menu is always \"None\", which removes the -match. - -ITEMFORMAT governs formatting of the elements of KEYWORDS. If it -is a function, it is invoked with the keyword as the only -argument. If it is a string, it is interpreted as the format -string to (format ITEMFORMAT keyword). If it is neither a string -nor a function, elements of KEYWORDS are used directly." - (setq group (or group 0)) - (let ((replace (org-mouse-match-closure - (if nosurround 'replace-match - 'org-mouse-replace-match-and-surround)))) - (append - (org-mouse-keyword-menu - keywords - `(lambda (keyword) (funcall ,replace keyword t t nil ,group)) - (match-string group) - itemformat) - `(["None" org-mouse-remove-match-and-spaces - :style radio - :selected ,(not (member (match-string group) keywords))])))) - -(defun org-mouse-show-headlines () - "Change the visibility of the current org buffer to only show headlines." - (interactive) - (let ((this-command 'org-cycle) - (last-command 'org-cycle) - (org-cycle-global-status nil)) - (org-cycle '(4)) - (org-cycle '(4)))) - -(defun org-mouse-show-overview () - "Change visibility of current org buffer to first-level headlines only." - (interactive) - (let ((org-cycle-global-status nil)) - (org-cycle '(4)))) - -(defun org-mouse-set-priority (priority) - "Set the priority of the current headline to PRIORITY." - (org-priority priority)) - -(defvar org-mouse-priority-regexp "\\[#\\([A-Z]\\)\\]" - "Regular expression matching the priority indicator. -Differs from `org-priority-regexp' in that it doesn't contain the -leading '.*?'.") - -(defun org-mouse-get-priority (&optional default) - "Return the priority of the current headline. -DEFAULT is returned if no priority is given in the headline." - (save-excursion - (if (org-mouse-re-search-line org-mouse-priority-regexp) - (match-string 1) - (when default (char-to-string org-default-priority))))) - -(defun org-mouse-delete-timestamp () - "Deletes the current timestamp as well as the preceding keyword. -SCHEDULED: or DEADLINE: or ANYTHINGLIKETHIS:" - (when (or (org-at-date-range-p) (org-at-timestamp-p)) - (replace-match "") ; delete the timestamp - (skip-chars-backward " :A-Z") - (when (looking-at " *[A-Z][A-Z]+:") - (replace-match "")))) - -(defun org-mouse-looking-at (regexp skipchars &optional movechars) - (save-excursion - (let ((point (point))) - (if (looking-at regexp) t - (skip-chars-backward skipchars) - (forward-char (or movechars 0)) - (when (looking-at regexp) - (> (match-end 0) point)))))) - -(defun org-mouse-priority-list () - (loop for priority from ?A to org-lowest-priority - collect (char-to-string priority))) - -(defun org-mouse-todo-menu (state) - "Create the menu with TODO keywords." - (append - (let ((kwds org-todo-keywords-1)) - (org-mouse-keyword-menu - kwds - `(lambda (kwd) (org-todo kwd)) - (lambda (kwd) (equal state kwd)))))) - -(defun org-mouse-tag-menu () ;todo - "Create the tags menu." - (append - (let ((tags (org-get-tags))) - (org-mouse-keyword-menu - (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) - `(lambda (tag) - (org-mouse-set-tags - (sort (if (member tag (quote ,tags)) - (delete tag (quote ,tags)) - (cons tag (quote ,tags))) - 'string-lessp))) - `(lambda (tag) (member tag (quote ,tags))) - )) - '("--" - ["Align Tags Here" (org-set-tags nil t) t] - ["Align Tags in Buffer" (org-set-tags t t) t] - ["Set Tags ..." (org-set-tags) t]))) - -(defun org-mouse-set-tags (tags) - (save-excursion - ;; remove existing tags first - (beginning-of-line) - (when (org-mouse-re-search-line ":\\(\\([A-Za-z_]+:\\)+\\)") - (replace-match "")) - - ;; set new tags if any - (when tags - (end-of-line) - (insert " :" (mapconcat 'identity tags ":") ":") - (org-set-tags nil t)))) - -(defun org-mouse-insert-checkbox () - (interactive) - (and (org-at-item-p) - (goto-char (match-end 0)) - (unless (org-at-item-checkbox-p) - (delete-horizontal-space) - (insert " [ ] ")))) - -(defun org-mouse-agenda-type (type) - (case type - ('tags "Tags: ") - ('todo "TODO: ") - ('tags-tree "Tags tree: ") - ('todo-tree "TODO tree: ") - ('occur-tree "Occur tree: ") - (t "Agenda command ???"))) - -(defun org-mouse-list-options-menu (alloptions &optional function) - (let ((options (save-match-data - (split-string (match-string-no-properties 1))))) - (print options) - (loop for name in alloptions - collect - (vector name - `(progn - (replace-match - (mapconcat 'identity - (sort (if (member ',name ',options) - (delete ',name ',options) - (cons ',name ',options)) - 'string-lessp) - " ") - nil nil nil 1) - (when (functionp ',function) (funcall ',function))) - :style 'toggle - :selected (and (member name options) t))))) - -(defun org-mouse-clip-text (text maxlength) - (if (> (length text) maxlength) - (concat (substring text 0 (- maxlength 3)) "...") - text)) - -(defun org-mouse-popup-global-menu () - (popup-menu - `("Main Menu" - ["Show Overview" org-mouse-show-overview t] - ["Show Headlines" org-mouse-show-headlines t] - ["Show All" show-all t] - ["Remove Highlights" org-remove-occur-highlights - :visible org-occur-highlights] - "--" - ["Check Deadlines" - (if (functionp 'org-check-deadlines-and-todos) - (org-check-deadlines-and-todos org-deadline-warning-days) - (org-check-deadlines org-deadline-warning-days)) t] - ["Check TODOs" org-show-todo-tree t] - ("Check Tags" - ,@(org-mouse-keyword-menu - (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) - #'(lambda (tag) (org-tags-sparse-tree nil tag))) - "--" - ["Custom Tag ..." org-tags-sparse-tree t]) - ["Check Phrase ..." org-occur] - "--" - ["Display Agenda" org-agenda-list t] - ["Display Timeline" org-timeline t] - ["Display TODO List" org-todo-list t] - ("Display Tags" - ,@(org-mouse-keyword-menu - (sort (mapcar 'car (org-get-buffer-tags)) 'string-lessp) - #'(lambda (tag) (org-tags-view nil tag))) - "--" - ["Custom Tag ..." org-tags-view t]) - ["Display Calendar" org-goto-calendar t] - "--" - ,@(org-mouse-keyword-menu - (mapcar 'car org-agenda-custom-commands) - #'(lambda (key) - (eval `(org-agenda nil (string-to-char ,key)))) - nil - #'(lambda (key) - (let ((entry (assoc key org-agenda-custom-commands))) - (org-mouse-clip-text - (cond - ((stringp (nth 1 entry)) (nth 1 entry)) - ((stringp (nth 2 entry)) - (concat (org-mouse-agenda-type (nth 1 entry)) - (nth 2 entry))) - (t "Agenda Command '%s'")) - 30)))) - "--" - ["Delete Blank Lines" delete-blank-lines - :visible (org-mouse-empty-line)] - ["Insert Checkbox" org-mouse-insert-checkbox - :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))] - ["Insert Checkboxes" - (org-mouse-for-each-item 'org-mouse-insert-checkbox) - :visible (and (org-at-item-p) (not (org-at-item-checkbox-p)))] - ["Plain List to Outline" org-mouse-transform-to-outline - :visible (org-at-item-p)]))) - -(defun org-mouse-get-context (contextlist context) - (let ((contextdata (assq context contextlist))) - (when contextdata - (save-excursion - (goto-char (second contextdata)) - (re-search-forward ".*" (third contextdata)))))) - -(defun org-mouse-for-each-item (funct) - ;; Functions called by `org-apply-on-list' need an argument - (let ((wrap-fun (lambda (c) (funcall funct)))) - (when (ignore-errors (goto-char (org-in-item-p))) - (save-excursion (org-apply-on-list wrap-fun nil))))) - -(defun org-mouse-bolp () - "Return true if there only spaces, tabs, and '*' before point. -This means, between the beginning of line and the point." - (save-excursion - (skip-chars-backward " \t*") (bolp))) - -(defun org-mouse-insert-item (text) - (case (org-mouse-line-position) - (:beginning ; insert before - (beginning-of-line) - (looking-at "[ \t]*") - (open-line 1) - (org-indent-to-column (- (match-end 0) (match-beginning 0))) - (insert "+ ")) - (:middle ; insert after - (end-of-line) - (newline t) - (indent-relative) - (insert "+ ")) - (:end ; insert text here - (skip-chars-backward " \t") - (kill-region (point) (point-at-eol)) - (unless (org-looking-back org-mouse-punctuation) - (insert (concat org-mouse-punctuation " "))))) - (insert text) - (beginning-of-line)) - -(defadvice dnd-insert-text (around org-mouse-dnd-insert-text activate) - (if (derived-mode-p 'org-mode) - (org-mouse-insert-item text) - ad-do-it)) - -(defadvice dnd-open-file (around org-mouse-dnd-open-file activate) - (if (derived-mode-p 'org-mode) - (org-mouse-insert-item uri) - ad-do-it)) - -(defun org-mouse-match-closure (function) - (let ((match (match-data t))) - `(lambda (&rest rest) - (save-match-data - (set-match-data ',match) - (apply ',function rest))))) - -(defun org-mouse-yank-link (click) - (interactive "e") - ;; Give temporary modes such as isearch a chance to turn off. - (run-hooks 'mouse-leave-buffer-hook) - (mouse-set-point click) - (setq mouse-selection-click-count 0) - (delete-horizontal-space) - (insert-for-yank (concat " [[" (current-kill 0) "]] "))) - -(defun org-mouse-context-menu (&optional event) - (let* ((stamp-prefixes (list org-deadline-string org-scheduled-string)) - (contextlist (org-context)) - (get-context (lambda (context) (org-mouse-get-context contextlist context)))) - (cond - ((org-mouse-mark-active) - (let ((region-string (buffer-substring (region-beginning) (region-end)))) - (popup-menu - `(nil - ["Sparse Tree" (org-occur ',region-string)] - ["Find in Buffer" (occur ',region-string)] - ["Grep in Current Dir" - (grep (format "grep -rnH -e '%s' *" ',region-string))] - ["Grep in Parent Dir" - (grep (format "grep -rnH -e '%s' ../*" ',region-string))] - "--" - ["Convert to Link" - (progn (save-excursion (goto-char (region-beginning)) (insert "[[")) - (save-excursion (goto-char (region-end)) (insert "]]")))] - ["Insert Link Here" (org-mouse-yank-link ',event)])))) - ((save-excursion (beginning-of-line) (looking-at "#\\+STARTUP: \\(.*\\)")) - (popup-menu - `(nil - ,@(org-mouse-list-options-menu (mapcar 'car org-startup-options) - 'org-mode-restart)))) - ((or (eolp) - (and (looking-at "\\( \\|\t\\)\\(+:[0-9a-zA-Z_:]+\\)?\\( \\|\t\\)+$") - (org-looking-back " \\|\t"))) - (org-mouse-popup-global-menu)) - ((funcall get-context :checkbox) - (popup-menu - '(nil - ["Toggle" org-toggle-checkbox t] - ["Remove" org-mouse-remove-match-and-spaces t] - "" - ["All Clear" (org-mouse-for-each-item - (lambda () - (when (save-excursion (org-at-item-checkbox-p)) - (replace-match "[ ] "))))] - ["All Set" (org-mouse-for-each-item - (lambda () - (when (save-excursion (org-at-item-checkbox-p)) - (replace-match "[X] "))))] - ["All Toggle" (org-mouse-for-each-item 'org-toggle-checkbox) t] - ["All Remove" (org-mouse-for-each-item - (lambda () - (when (save-excursion (org-at-item-checkbox-p)) - (org-mouse-remove-match-and-spaces))))] - ))) - ((and (org-mouse-looking-at "\\b\\w+" "a-zA-Z0-9_") - (member (match-string 0) org-todo-keywords-1)) - (popup-menu - `(nil - ,@(org-mouse-todo-menu (match-string 0)) - "--" - ["Check TODOs" org-show-todo-tree t] - ["List all TODO keywords" org-todo-list t] - [,(format "List only %s" (match-string 0)) - (org-todo-list (match-string 0)) t] - ))) - ((and (org-mouse-looking-at "\\b[A-Z]+:" "A-Z") - (member (match-string 0) stamp-prefixes)) - (popup-menu - `(nil - ,@(org-mouse-keyword-replace-menu stamp-prefixes) - "--" - ["Check Deadlines" org-check-deadlines t] - ))) - ((org-mouse-looking-at org-mouse-priority-regexp "[]A-Z#") ; priority - (popup-menu `(nil ,@(org-mouse-keyword-replace-menu - (org-mouse-priority-list) 1 "Priority %s" t)))) - ((funcall get-context :link) - (popup-menu - '(nil - ["Open" org-open-at-point t] - ["Open in Emacs" (org-open-at-point t) t] - "--" - ["Copy link" (org-kill-new (match-string 0))] - ["Cut link" - (progn - (kill-region (match-beginning 0) (match-end 0)) - (just-one-space))] - "--" - ["Grep for TODOs" - (grep (format "grep -nH -i 'todo\\|fixme' %s*" (match-string 2)))] - ; ["Paste file link" ((insert "file:") (yank))] - ))) - ((org-mouse-looking-at ":\\([A-Za-z0-9_]+\\):" "A-Za-z0-9_" -1) ;tags - (popup-menu - `(nil - [,(format "Display '%s'" (match-string 1)) - (org-tags-view nil ,(match-string 1))] - [,(format "Sparse Tree '%s'" (match-string 1)) - (org-tags-sparse-tree nil ,(match-string 1))] - "--" - ,@(org-mouse-tag-menu)))) - ((org-at-timestamp-p) - (popup-menu - '(nil - ["Show Day" org-open-at-point t] - ["Change Timestamp" org-time-stamp t] - ["Delete Timestamp" (org-mouse-delete-timestamp) t] - ["Compute Time Range" org-evaluate-time-range (org-at-date-range-p)] - "--" - ["Set for Today" org-mouse-timestamp-today] - ["Set for Tomorrow" (org-mouse-timestamp-today 1 'day)] - ["Set in 1 Week" (org-mouse-timestamp-today 7 'day)] - ["Set in 2 Weeks" (org-mouse-timestamp-today 14 'day)] - ["Set in a Month" (org-mouse-timestamp-today 1 'month)] - "--" - ["+ 1 Day" (org-timestamp-change 1 'day)] - ["+ 1 Week" (org-timestamp-change 7 'day)] - ["+ 1 Month" (org-timestamp-change 1 'month)] - "--" - ["- 1 Day" (org-timestamp-change -1 'day)] - ["- 1 Week" (org-timestamp-change -7 'day)] - ["- 1 Month" (org-timestamp-change -1 'month)]))) - ((funcall get-context :table-special) - (let ((mdata (match-data))) - (incf (car mdata) 2) - (store-match-data mdata)) - (message "match: %S" (match-string 0)) - (popup-menu `(nil ,@(org-mouse-keyword-replace-menu - '(" " "!" "^" "_" "$" "#" "*" "'") 0 - (lambda (mark) - (case (string-to-char mark) - (? "( ) Nothing Special") - (?! "(!) Column Names") - (?^ "(^) Field Names Above") - (?_ "(^) Field Names Below") - (?$ "($) Formula Parameters") - (?# "(#) Recalculation: Auto") - (?* "(*) Recalculation: Manual") - (?' "(') Recalculation: None"))) t)))) - ((assq :table contextlist) - (popup-menu - '(nil - ["Align Table" org-ctrl-c-ctrl-c] - ["Blank Field" org-table-blank-field] - ["Edit Field" org-table-edit-field] - "--" - ("Column" - ["Move Column Left" org-metaleft] - ["Move Column Right" org-metaright] - ["Delete Column" org-shiftmetaleft] - ["Insert Column" org-shiftmetaright] - "--" - ["Enable Narrowing" (setq org-table-limit-column-width (not org-table-limit-column-width)) :selected org-table-limit-column-width :style toggle]) - ("Row" - ["Move Row Up" org-metaup] - ["Move Row Down" org-metadown] - ["Delete Row" org-shiftmetaup] - ["Insert Row" org-shiftmetadown] - ["Sort lines in region" org-table-sort-lines (org-at-table-p)] - "--" - ["Insert Hline" org-table-insert-hline]) - ("Rectangle" - ["Copy Rectangle" org-copy-special] - ["Cut Rectangle" org-cut-special] - ["Paste Rectangle" org-paste-special] - ["Fill Rectangle" org-table-wrap-region]) - "--" - ["Set Column Formula" org-table-eval-formula] - ["Set Field Formula" (org-table-eval-formula '(4))] - ["Edit Formulas" org-table-edit-formulas] - "--" - ["Recalculate Line" org-table-recalculate] - ["Recalculate All" (org-table-recalculate '(4))] - ["Iterate All" (org-table-recalculate '(16))] - "--" - ["Toggle Recalculate Mark" org-table-rotate-recalc-marks] - ["Sum Column/Rectangle" org-table-sum - :active (or (org-at-table-p) (org-region-active-p))] - ["Field Info" org-table-field-info] - ["Debug Formulas" - (setq org-table-formula-debug (not org-table-formula-debug)) - :style toggle :selected org-table-formula-debug] - ))) - ((and (assq :headline contextlist) (not (eolp))) - (let ((priority (org-mouse-get-priority t))) - (popup-menu - `("Headline Menu" - ("Tags and Priorities" - ,@(org-mouse-keyword-menu - (org-mouse-priority-list) - #'(lambda (keyword) - (org-mouse-set-priority (string-to-char keyword))) - priority "Priority %s") - "--" - ,@(org-mouse-tag-menu)) - ("TODO Status" - ,@(org-mouse-todo-menu (org-get-todo-state))) - ["Show Tags" - (with-current-buffer org-mouse-main-buffer (org-agenda-show-tags)) - :visible (not org-mouse-direct)] - ["Show Priority" - (with-current-buffer org-mouse-main-buffer (org-agenda-show-priority)) - :visible (not org-mouse-direct)] - ,@(if org-mouse-direct '("--") nil) - ["New Heading" org-mouse-insert-heading :visible org-mouse-direct] - ["Set Deadline" - (progn (org-mouse-end-headline) (insert " ") (org-deadline)) - :active (not (save-excursion - (org-mouse-re-search-line org-deadline-regexp)))] - ["Schedule Task" - (progn (org-mouse-end-headline) (insert " ") (org-schedule)) - :active (not (save-excursion - (org-mouse-re-search-line org-scheduled-regexp)))] - ["Insert Timestamp" - (progn (org-mouse-end-headline) (insert " ") (org-time-stamp nil)) t] - ; ["Timestamp (inactive)" org-time-stamp-inactive t] - "--" - ["Archive Subtree" org-archive-subtree] - ["Cut Subtree" org-cut-special] - ["Copy Subtree" org-copy-special] - ["Paste Subtree" org-paste-special :visible org-mouse-direct] - ("Sort Children" - ["Alphabetically" (org-sort-entries nil ?a)] - ["Numerically" (org-sort-entries nil ?n)] - ["By Time/Date" (org-sort-entries nil ?t)] - "--" - ["Reverse Alphabetically" (org-sort-entries nil ?A)] - ["Reverse Numerically" (org-sort-entries nil ?N)] - ["Reverse By Time/Date" (org-sort-entries nil ?T)]) - "--" - ["Move Trees" org-mouse-move-tree :active nil] - )))) - (t - (org-mouse-popup-global-menu))))) - -(defun org-mouse-mark-active () - (and mark-active transient-mark-mode)) - -(defun org-mouse-in-region-p (pos) - (and (org-mouse-mark-active) - (>= pos (region-beginning)) - (< pos (region-end)))) - -(defun org-mouse-down-mouse (event) - (interactive "e") - (setq this-command last-command) - (unless (and (= 1 (event-click-count event)) - (org-mouse-in-region-p (posn-point (event-start event)))) - (mouse-drag-region event))) - -(add-hook 'org-mode-hook - #'(lambda () - (setq org-mouse-context-menu-function 'org-mouse-context-menu) - - (when (memq 'context-menu org-mouse-features) - (org-defkey org-mouse-map [mouse-3] nil) - (org-defkey org-mode-map [mouse-3] 'org-mouse-show-context-menu)) - (org-defkey org-mode-map [down-mouse-1] 'org-mouse-down-mouse) - (when (memq 'context-menu org-mouse-features) - (org-defkey org-mouse-map [C-drag-mouse-1] 'org-mouse-move-tree) - (org-defkey org-mouse-map [C-down-mouse-1] 'org-mouse-move-tree-start)) - (when (memq 'yank-link org-mouse-features) - (org-defkey org-mode-map [S-mouse-2] 'org-mouse-yank-link) - (org-defkey org-mode-map [drag-mouse-3] 'org-mouse-yank-link)) - (when (memq 'move-tree org-mouse-features) - (org-defkey org-mouse-map [drag-mouse-3] 'org-mouse-move-tree) - (org-defkey org-mouse-map [down-mouse-3] 'org-mouse-move-tree-start)) - - (when (memq 'activate-stars org-mouse-features) - (font-lock-add-keywords - nil - `((,org-outline-regexp - 0 `(face org-link mouse-face highlight keymap ,org-mouse-map) - 'prepend)) - t)) - - (when (memq 'activate-bullets org-mouse-features) - (font-lock-add-keywords - nil - `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +" - (1 `(face org-link keymap ,org-mouse-map mouse-face highlight) - 'prepend))) - t)) - - (when (memq 'activate-checkboxes org-mouse-features) - (font-lock-add-keywords - nil - `(("^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[ X]\\]\\)" - (2 `(face bold keymap ,org-mouse-map mouse-face highlight) t))) - t)) - - (defadvice org-open-at-point (around org-mouse-open-at-point activate) - (let ((context (org-context))) - (cond - ((assq :headline-stars context) (org-cycle)) - ((assq :checkbox context) (org-toggle-checkbox)) - ((assq :item-bullet context) - (let ((org-cycle-include-plain-lists t)) (org-cycle))) - ((org-footnote-at-reference-p) nil) - (t ad-do-it)))))) - -(defun org-mouse-move-tree-start (event) - (interactive "e") - (message "Same line: promote/demote, (***):move before, (text): make a child")) - - -(defun org-mouse-make-marker (position) - (with-current-buffer (window-buffer (posn-window position)) - (copy-marker (posn-point position)))) - -(defun org-mouse-move-tree (event) - ;; todo: handle movements between different buffers - (interactive "e") - (save-excursion - (let* ((start (org-mouse-make-marker (event-start event))) - (end (org-mouse-make-marker (event-end event))) - (sbuf (marker-buffer start)) - (ebuf (marker-buffer end))) - - (when (and sbuf ebuf) - (set-buffer sbuf) - (goto-char start) - (org-back-to-heading) - (if (and (eq sbuf ebuf) - (equal - (point) - (save-excursion (goto-char end) (org-back-to-heading) (point)))) - ;; if the same line then promote/demote - (if (>= end start) (org-demote-subtree) (org-promote-subtree)) - ;; if different lines then move - (org-cut-subtree) - - (set-buffer ebuf) - (goto-char end) - (org-back-to-heading) - (when (and (eq sbuf ebuf) - (equal - (point) - (save-excursion (goto-char start) - (org-back-to-heading) (point)))) - (outline-end-of-subtree) - (end-of-line) - (if (eobp) (newline) (forward-char))) - - (when (looking-at org-outline-regexp) - (let ((level (- (match-end 0) (match-beginning 0)))) - (when (> end (match-end 0)) - (outline-end-of-subtree) - (end-of-line) - (if (eobp) (newline) (forward-char)) - (setq level (1+ level))) - (org-paste-subtree level) - (save-excursion - (outline-end-of-subtree) - (when (bolp) (delete-char -1)))))))))) - - -(defun org-mouse-transform-to-outline () - (interactive) - (org-back-to-heading) - (let ((minlevel 1000) - (replace-text (concat (match-string 0) "* "))) - (beginning-of-line 2) - (save-excursion - (while (not (or (eobp) (looking-at org-outline-regexp))) - (when (looking-at org-mouse-plain-list-regexp) - (setq minlevel (min minlevel (- (match-end 1) (match-beginning 1))))) - (forward-line))) - (while (not (or (eobp) (looking-at org-outline-regexp))) - (when (and (looking-at org-mouse-plain-list-regexp) - (eq minlevel (- (match-end 1) (match-beginning 1)))) - (replace-match replace-text)) - (forward-line)))) - -(defvar org-mouse-cmd) ;dynamically scoped from `org-with-remote-undo'. - -(defun org-mouse-do-remotely (command) - ; (org-agenda-check-no-diary) - (when (get-text-property (point) 'org-marker) - (let* ((anticol (- (point-at-eol) (point))) - (marker (get-text-property (point) 'org-marker)) - (buffer (marker-buffer marker)) - (pos (marker-position marker)) - (hdmarker (get-text-property (point) 'org-hd-marker)) - (buffer-read-only nil) - (newhead "--- removed ---") - (org-mouse-direct nil) - (org-mouse-main-buffer (current-buffer))) - (when (eq (with-current-buffer buffer major-mode) 'org-mode) - (let ((endmarker (with-current-buffer buffer - (outline-end-of-subtree) - (forward-char 1) - (copy-marker (point))))) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (org-show-hidden-entry) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil))) ; show the next heading - (org-back-to-heading) - (setq marker (copy-marker (point))) - (goto-char (max (point-at-bol) (- (point-at-eol) anticol))) - (funcall command) - (message "_cmd: %S" org-mouse-cmd) - (message "this-command: %S" this-command) - (unless (eq (marker-position marker) (marker-position endmarker)) - (setq newhead (org-get-heading)))) - - (beginning-of-line 1) - (save-excursion - (org-agenda-change-all-lines newhead hdmarker 'fixface)))) - t)))) - -(defun org-mouse-agenda-context-menu (&optional event) - (or (org-mouse-do-remotely 'org-mouse-context-menu) - (popup-menu - '("Agenda" - ("Agenda Files") - "--" - ["Undo" (progn (message "last command: %S" last-command) (setq this-command 'org-agenda-undo) (org-agenda-undo)) - :visible (if (eq last-command 'org-agenda-undo) - org-agenda-pending-undo-list - org-agenda-undo-list)] - ["Rebuild Buffer" org-agenda-redo t] - ["New Diary Entry" - org-agenda-diary-entry (org-agenda-check-type nil 'agenda 'timeline) t] - "--" - ["Goto Today" org-agenda-goto-today - (org-agenda-check-type nil 'agenda 'timeline) t] - ["Display Calendar" org-agenda-goto-calendar - (org-agenda-check-type nil 'agenda 'timeline) t] - ("Calendar Commands" - ["Phases of the Moon" org-agenda-phases-of-moon - (org-agenda-check-type nil 'agenda 'timeline)] - ["Sunrise/Sunset" org-agenda-sunrise-sunset - (org-agenda-check-type nil 'agenda 'timeline)] - ["Holidays" org-agenda-holidays - (org-agenda-check-type nil 'agenda 'timeline)] - ["Convert" org-agenda-convert-date - (org-agenda-check-type nil 'agenda 'timeline)] - "--" - ["Create iCalendar file" org-icalendar-combine-agenda-files t]) - "--" - ["Day View" org-agenda-day-view - :active (org-agenda-check-type nil 'agenda) - :style radio :selected (eq org-agenda-current-span 'day)] - ["Week View" org-agenda-week-view - :active (org-agenda-check-type nil 'agenda) - :style radio :selected (eq org-agenda-current-span 'week)] - "--" - ["Show Logbook entries" org-agenda-log-mode - :style toggle :selected org-agenda-show-log - :active (org-agenda-check-type nil 'agenda 'timeline)] - ["Include Diary" org-agenda-toggle-diary - :style toggle :selected org-agenda-include-diary - :active (org-agenda-check-type nil 'agenda)] - ["Use Time Grid" org-agenda-toggle-time-grid - :style toggle :selected org-agenda-use-time-grid - :active (org-agenda-check-type nil 'agenda)] - ["Follow Mode" org-agenda-follow-mode - :style toggle :selected org-agenda-follow-mode] - "--" - ["Quit" org-agenda-quit t] - ["Exit and Release Buffers" org-agenda-exit t] - )))) - -(defun org-mouse-get-gesture (event) - (let ((startxy (posn-x-y (event-start event))) - (endxy (posn-x-y (event-end event)))) - (if (< (car startxy) (car endxy)) :right :left))) - - - ; (setq org-agenda-mode-hook nil) -(defvar org-agenda-mode-map) -(add-hook 'org-agenda-mode-hook - #'(lambda () - (setq org-mouse-context-menu-function 'org-mouse-agenda-context-menu) - (org-defkey org-agenda-mode-map [mouse-3] 'org-mouse-show-context-menu) - (org-defkey org-agenda-mode-map [down-mouse-3] 'org-mouse-move-tree-start) - (org-defkey org-agenda-mode-map [C-mouse-4] 'org-agenda-earlier) - (org-defkey org-agenda-mode-map [C-mouse-5] 'org-agenda-later) - (org-defkey org-agenda-mode-map [drag-mouse-3] - #'(lambda (event) (interactive "e") - (case (org-mouse-get-gesture event) - (:left (org-agenda-earlier 1)) - (:right (org-agenda-later 1))))))) - -(provide 'org-mouse) - -;;; org-mouse.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-pcomplete.el b/xemacs-packages/lisp/org-8.2.3c/org-pcomplete.el deleted file mode 100644 index 77f68f4d..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-pcomplete.el +++ /dev/null @@ -1,421 +0,0 @@ -;;; org-pcomplete.el --- In-buffer completion code - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; John Wiegley <johnw at gnu dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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/>. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Code: - -;;;; Require other packages - -(eval-when-compile - (require 'cl)) - -(require 'org-macs) -(require 'org-compat) -(require 'pcomplete) - -(declare-function org-split-string "org" (string &optional separators)) -(declare-function org-make-org-heading-search-string "org" - (&optional string)) -(declare-function org-get-buffer-tags "org" ()) -(declare-function org-get-tags "org" ()) -(declare-function org-buffer-property-keys "org" - (&optional include-specials include-defaults include-columns)) -(declare-function org-entry-properties "org" (&optional pom which specific)) - -;;;; Customization variables - -(defgroup org-complete nil - "Outline-based notes management and organizer." - :tag "Org" - :group 'org) - -(defvar org-drawer-regexp) -(defvar org-property-re) - -(defun org-thing-at-point () - "Examine the thing at point and let the caller know what it is. -The return value is a string naming the thing at point." - (let ((beg1 (save-excursion - (skip-chars-backward (org-re "[:alnum:]-_@")) - (point))) - (beg (save-excursion - (skip-chars-backward "a-zA-Z0-9-_:$") - (point))) - (line-to-here (buffer-substring (point-at-bol) (point)))) - (cond - ((string-match "\\`[ \t]*#\\+begin: clocktable[ \t]+" line-to-here) - (cons "block-option" "clocktable")) - ((string-match "\\`[ \t]*#\\+begin_src[ \t]+" line-to-here) - (cons "block-option" "src")) - ((save-excursion - (re-search-backward "^[ \t]*#\\+\\([A-Z_]+\\):.*" - (line-beginning-position) t)) - (cons "file-option" (match-string-no-properties 1))) - ((string-match "\\`[ \t]*#\\+[a-zA-Z_]*\\'" line-to-here) - (cons "file-option" nil)) - ((equal (char-before beg) ?\[) - (cons "link" nil)) - ((equal (char-before beg) ?\\) - (cons "tex" nil)) - ((string-match "\\`\\*+[ \t]+\\'" - (buffer-substring (point-at-bol) beg)) - (cons "todo" nil)) - ((equal (char-before beg) ?*) - (cons "searchhead" nil)) - ((and (equal (char-before beg1) ?:) - (equal (char-after (point-at-bol)) ?*)) - (cons "tag" nil)) - ((and (equal (char-before beg1) ?:) - (not (equal (char-after (point-at-bol)) ?*)) - (save-excursion - (move-beginning-of-line 1) - (skip-chars-backward "[ \t\n]") - ;; org-drawer-regexp matches a whole line but while - ;; looking-back, we just ignore trailing whitespaces - (or (org-looking-back (substring org-drawer-regexp 0 -1)) - (org-looking-back org-property-re)))) - (cons "prop" nil)) - ((and (equal (char-before beg1) ?:) - (not (equal (char-after (point-at-bol)) ?*))) - (cons "drawer" nil)) - (t nil)))) - -(defun org-command-at-point () - "Return the qualified name of the Org completion entity at point. -When completing for #+STARTUP, for example, this function returns -\"file-option/startup\"." - (let ((thing (org-thing-at-point))) - (cond - ((string= "file-option" (car thing)) - (concat (car thing) - (and (cdr thing) (concat "/" (downcase (cdr thing)))))) - ((string= "block-option" (car thing)) - (concat (car thing) "/" (downcase (cdr thing)))) - (t (car thing))))) - -(defun org-parse-arguments () - "Parse whitespace separated arguments in the current region." - (let ((begin (line-beginning-position)) - (end (line-end-position)) - begins args) - (save-restriction - (narrow-to-region begin end) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (skip-chars-forward " \t\n[") - (setq begins (cons (point) begins)) - (skip-chars-forward "^ \t\n[") - (setq args (cons (buffer-substring-no-properties - (car begins) (point)) - args))) - (cons (reverse args) (reverse begins)))))) - -(defun org-pcomplete-initial () - "Calls the right completion function for first argument completions." - (ignore - (funcall (or (pcomplete-find-completion-function - (car (org-thing-at-point))) - pcomplete-default-completion-function)))) - -(defvar org-options-keywords) ; From org.el -(defvar org-element-block-name-alist) ; From org-element.el -(defvar org-element-affiliated-keywords) ; From org-element.el -(declare-function org-get-export-keywords "org" ()) -(defun pcomplete/org-mode/file-option () - "Complete against all valid file options." - (require 'org-element) - (pcomplete-here - (org-pcomplete-case-double - (append (mapcar (lambda (keyword) (concat keyword " ")) - org-options-keywords) - (mapcar (lambda (keyword) (concat keyword ": ")) - org-element-affiliated-keywords) - (let (block-names) - (dolist (block-info org-element-block-name-alist block-names) - (let ((name (car block-info))) - (push (format "END_%s" name) block-names) - (push (concat "BEGIN_" - name - ;; Since language is compulsory in - ;; source blocks, add a space. - (and (equal name "SRC") " ")) - block-names) - (push (format "ATTR_%s: " name) block-names)))) - (mapcar (lambda (keyword) (concat keyword ": ")) - (org-get-export-keywords)))) - (substring pcomplete-stub 2))) - -(defun pcomplete/org-mode/file-option/author () - "Complete arguments for the #+AUTHOR file option." - (pcomplete-here (list user-full-name))) - -(defvar org-time-stamp-formats) -(defun pcomplete/org-mode/file-option/date () - "Complete arguments for the #+DATE file option." - (pcomplete-here (list (format-time-string (car org-time-stamp-formats))))) - -(defun pcomplete/org-mode/file-option/email () - "Complete arguments for the #+EMAIL file option." - (pcomplete-here (list user-mail-address))) - -(defvar org-export-exclude-tags) -(defun pcomplete/org-mode/file-option/exclude_tags () - "Complete arguments for the #+EXCLUDE_TAGS file option." - (require 'ox) - (pcomplete-here - (and org-export-exclude-tags - (list (mapconcat 'identity org-export-exclude-tags " "))))) - -(defvar org-file-tags) -(defun pcomplete/org-mode/file-option/filetags () - "Complete arguments for the #+FILETAGS file option." - (pcomplete-here (and org-file-tags (mapconcat 'identity org-file-tags " ")))) - -(defvar org-export-default-language) -(defun pcomplete/org-mode/file-option/language () - "Complete arguments for the #+LANGUAGE file option." - (require 'ox) - (pcomplete-here - (pcomplete-uniqify-list - (list org-export-default-language "en")))) - -(defvar org-default-priority) -(defvar org-highest-priority) -(defvar org-lowest-priority) -(defun pcomplete/org-mode/file-option/priorities () - "Complete arguments for the #+PRIORITIES file option." - (pcomplete-here (list (format "%c %c %c" - org-highest-priority - org-lowest-priority - org-default-priority)))) - -(defvar org-export-select-tags) -(defun pcomplete/org-mode/file-option/select_tags () - "Complete arguments for the #+SELECT_TAGS file option." - (require 'ox) - (pcomplete-here - (and org-export-select-tags - (list (mapconcat 'identity org-export-select-tags " "))))) - -(defvar org-startup-options) -(defun pcomplete/org-mode/file-option/startup () - "Complete arguments for the #+STARTUP file option." - (while (pcomplete-here - (let ((opts (pcomplete-uniqify-list - (mapcar 'car org-startup-options)))) - ;; Some options are mutually exclusive, and shouldn't be completed - ;; against if certain other options have already been seen. - (dolist (arg pcomplete-args) - (cond - ((string= arg "hidestars") - (setq opts (delete "showstars" opts))))) - opts)))) - -(defvar org-tag-alist) -(defun pcomplete/org-mode/file-option/tags () - "Complete arguments for the #+TAGS file option." - (pcomplete-here - (list - (mapconcat (lambda (x) - (cond - ((eq :startgroup (car x)) "{") - ((eq :endgroup (car x)) "}") - ((eq :grouptags (car x)) ":") - ((eq :newline (car x)) "\\n") - ((cdr x) (format "%s(%c)" (car x) (cdr x))) - (t (car x)))) - org-tag-alist " ")))) - -(defun pcomplete/org-mode/file-option/title () - "Complete arguments for the #+TITLE file option." - (pcomplete-here - (let ((visited-file (buffer-file-name (buffer-base-buffer)))) - (list (or (and visited-file - (file-name-sans-extension - (file-name-nondirectory visited-file))) - (buffer-name (buffer-base-buffer))))))) - - -(declare-function org-export-backend-options "org-export" (cl-x)) -(defun pcomplete/org-mode/file-option/options () - "Complete arguments for the #+OPTIONS file option." - (while (pcomplete-here - (pcomplete-uniqify-list - (append - ;; Hard-coded OPTION items always available. - '("H:" "\\n:" "num:" "timestamp:" "arch:" "author:" "c:" - "creator:" "date:" "d:" "email:" "*:" "e:" "::" "f:" - "inline:" "tex:" "p:" "pri:" "':" "-:" "stat:" "^:" "toc:" - "|:" "tags:" "tasks:" "<:" "todo:") - ;; OPTION items from registered back-ends. - (let (items) - (dolist (backend (org-bound-and-true-p - org-export--registered-backends)) - (dolist (option (org-export-backend-options backend)) - (let ((item (nth 2 option))) - (when item (push (concat item ":") items))))) - items)))))) - -(defun pcomplete/org-mode/file-option/infojs_opt () - "Complete arguments for the #+INFOJS_OPT file option." - (while (pcomplete-here - (pcomplete-uniqify-list - (mapcar (lambda (item) (format "%s:" (car item))) - (org-bound-and-true-p org-html-infojs-opts-table)))))) - -(defun pcomplete/org-mode/file-option/bind () - "Complete arguments for the #+BIND file option, which are variable names." - (let (vars) - (mapatoms - (lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars))))) - (pcomplete-here vars))) - -(defvar org-link-abbrev-alist-local) -(defvar org-link-abbrev-alist) -(defun pcomplete/org-mode/link () - "Complete against defined #+LINK patterns." - (pcomplete-here - (pcomplete-uniqify-list - (copy-sequence - (append (mapcar 'car org-link-abbrev-alist-local) - (mapcar 'car org-link-abbrev-alist)))))) - -(defvar org-entities) -(defun pcomplete/org-mode/tex () - "Complete against TeX-style HTML entity names." - (require 'org-entities) - (while (pcomplete-here - (pcomplete-uniqify-list (remove nil (mapcar 'car-safe org-entities))) - (substring pcomplete-stub 1)))) - -(defvar org-todo-keywords-1) -(defun pcomplete/org-mode/todo () - "Complete against known TODO keywords." - (pcomplete-here (pcomplete-uniqify-list (copy-sequence org-todo-keywords-1)))) - -(defvar org-todo-line-regexp) -(defun pcomplete/org-mode/searchhead () - "Complete against all headings. -This needs more work, to handle headings with lots of spaces in them." - (while - (pcomplete-here - (save-excursion - (goto-char (point-min)) - (let (tbl) - (while (re-search-forward org-todo-line-regexp nil t) - (push (org-make-org-heading-search-string - (match-string-no-properties 3)) - tbl)) - (pcomplete-uniqify-list tbl))) - (substring pcomplete-stub 1)))) - -(defvar org-tag-alist) -(defun pcomplete/org-mode/tag () - "Complete a tag name. Omit tags already set." - (while (pcomplete-here - (mapcar (lambda (x) - (concat x ":")) - (let ((lst (pcomplete-uniqify-list - (or (remove - nil - (mapcar (lambda (x) - (and (stringp (car x)) (car x))) - org-tag-alist)) - (mapcar 'car (org-get-buffer-tags)))))) - (dolist (tag (org-get-tags)) - (setq lst (delete tag lst))) - lst)) - (and (string-match ".*:" pcomplete-stub) - (substring pcomplete-stub (match-end 0)))))) - -(defun pcomplete/org-mode/prop () - "Complete a property name. Omit properties already set." - (pcomplete-here - (mapcar (lambda (x) - (concat x ": ")) - (let ((lst (pcomplete-uniqify-list - (copy-sequence - (org-buffer-property-keys nil t t))))) - (dolist (prop (org-entry-properties)) - (setq lst (delete (car prop) lst))) - lst)) - (substring pcomplete-stub 1))) - -(defvar org-drawers) - -(defun pcomplete/org-mode/drawer () - "Complete a drawer name." - (let ((spc (save-excursion - (move-beginning-of-line 1) - (looking-at "^\\([ \t]*\\):") - (match-string 1))) - (cpllist (mapcar (lambda (x) (concat x ": ")) org-drawers))) - (pcomplete-here cpllist - (substring pcomplete-stub 1) - (unless (or (not (delq - nil - (mapcar (lambda(x) - (string-match (substring pcomplete-stub 1) x)) - cpllist))) - (looking-at "[ \t]*\n.*:END:")) - (save-excursion (insert "\n" spc ":END:")))))) - -(defun pcomplete/org-mode/block-option/src () - "Complete the arguments of a begin_src block. -Complete a language in the first field, the header arguments and switches." - (pcomplete-here - (mapcar - (lambda(x) (symbol-name (nth 3 x))) - (cdr (car (cdr (memq :key-type (plist-get - (symbol-plist - 'org-babel-load-languages) - 'custom-type))))))) - (while (pcomplete-here - '("-n" "-r" "-l" - ":cache" ":colnames" ":comments" ":dir" ":eval" ":exports" - ":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames" - ":session" ":shebang" ":tangle" ":tangle-mode" ":var")))) - -(defun pcomplete/org-mode/block-option/clocktable () - "Complete keywords in a clocktable line." - (while (pcomplete-here '(":maxlevel" ":scope" ":lang" - ":tstart" ":tend" ":block" ":step" - ":stepskip0" ":fileskip0" - ":emphasize" ":link" ":narrow" ":indent" - ":tcolumns" ":level" ":compact" ":timestamp" - ":formula" ":formatter" ":wstart" ":mstart")))) - -(defun org-pcomplete-case-double (list) - "Return list with both upcase and downcase version of all strings in LIST." - (let (e res) - (while (setq e (pop list)) - (setq res (cons (downcase e) (cons (upcase e) res)))) - (nreverse res))) - -;;;; Finish up - -(provide 'org-pcomplete) - -;;; org-pcomplete.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-plot.el b/xemacs-packages/lisp/org-8.2.3c/org-plot.el deleted file mode 100644 index 384a6f68..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-plot.el +++ /dev/null @@ -1,357 +0,0 @@ -;;; org-plot.el --- Support for plotting from Org-mode - -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. -;; -;; Author: Eric Schulte <schulte dot eric at gmail dot com> -;; Keywords: tables, plotting -;; Homepage: http://orgmode.org -;; -;; 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: - -;; Borrows ideas and a couple of lines of code from org-exp.el. - -;; Thanks to the org-mode mailing list for testing and implementation -;; and feature suggestions - -;;; Code: -(require 'org) -(require 'org-table) -(eval-when-compile - (require 'cl)) - -(declare-function gnuplot-delchar-or-maybe-eof "ext:gnuplot" (arg)) -(declare-function gnuplot-mode "ext:gnuplot" ()) -(declare-function gnuplot-send-buffer-to-gnuplot "ext:gnuplot" ()) - -(defvar org-plot/gnuplot-default-options - '((:plot-type . 2d) - (:with . lines) - (:ind . 0)) - "Default options to gnuplot used by `org-plot/gnuplot'.") - -(defvar org-plot-timestamp-fmt nil) - -(defun org-plot/add-options-to-plist (p options) - "Parse an OPTIONS line and set values in the property list P. -Returns the resulting property list." - (let (o) - (when options - (let ((op '(("type" . :plot-type) - ("script" . :script) - ("line" . :line) - ("set" . :set) - ("title" . :title) - ("ind" . :ind) - ("deps" . :deps) - ("with" . :with) - ("file" . :file) - ("labels" . :labels) - ("map" . :map) - ("timeind" . :timeind) - ("timefmt" . :timefmt))) - (multiples '("set" "line")) - (regexp ":\\([\"][^\"]+?[\"]\\|[(][^)]+?[)]\\|[^ \t\n\r;,.]*\\)") - (start 0) - o) - (while (setq o (pop op)) - (if (member (car o) multiples) ;; keys with multiple values - (while (string-match - (concat (regexp-quote (car o)) regexp) - options start) - (setq start (match-end 0)) - (setq p (plist-put p (cdr o) - (cons (car (read-from-string - (match-string 1 options))) - (plist-get p (cdr o))))) - p) - (if (string-match (concat (regexp-quote (car o)) regexp) - options) - (setq p (plist-put p (cdr o) - (car (read-from-string - (match-string 1 options))))))))))) - p) - -(defun org-plot/goto-nearest-table () - "Move the point forward to the beginning of nearest table. -Return value is the point at the beginning of the table." - (interactive) (move-beginning-of-line 1) - (while (not (or (org-at-table-p) (< 0 (forward-line 1))))) - (goto-char (org-table-begin))) - -(defun org-plot/collect-options (&optional params) - "Collect options from an org-plot '#+Plot:' line. -Accepts an optional property list PARAMS, to which the options -will be added. Returns the resulting property list." - (interactive) - (let ((line (thing-at-point 'line))) - (if (string-match "#\\+PLOT: +\\(.*\\)$" line) - (org-plot/add-options-to-plist params (match-string 1 line)) - params))) - -(defun org-plot-quote-timestamp-field (s) - "Convert field S from timestamp to Unix time and export to gnuplot." - (format-time-string org-plot-timestamp-fmt (org-time-string-to-time s))) - -(defun org-plot-quote-tsv-field (s) - "Quote field S for export to gnuplot." - (if (string-match org-table-number-regexp s) s - (if (string-match org-ts-regexp3 s) - (org-plot-quote-timestamp-field s) - (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"")))) - -(defun org-plot/gnuplot-to-data (table data-file params) - "Export TABLE to DATA-FILE in a format readable by gnuplot. -Pass PARAMS through to `orgtbl-to-generic' when exporting TABLE." - (with-temp-file - data-file - (make-local-variable 'org-plot-timestamp-fmt) - (setq org-plot-timestamp-fmt (or - (plist-get params :timefmt) - "%Y-%m-%d-%H:%M:%S")) - (insert (orgtbl-to-generic - table - (org-combine-plists - '(:sep "\t" :fmt org-plot-quote-tsv-field) - params)))) - nil) - -(defun org-plot/gnuplot-to-grid-data (table data-file params) - "Export the data in TABLE to DATA-FILE for gnuplot. -This means in a format appropriate for grid plotting by gnuplot. -PARAMS specifies which columns of TABLE should be plotted as independent -and dependant variables." - (interactive) - (let* ((ind (- (plist-get params :ind) 1)) - (deps (if (plist-member params :deps) - (mapcar (lambda (val) (- val 1)) (plist-get params :deps)) - (let (collector) - (dotimes (col (length (first table))) - (setf collector (cons col collector))) - collector))) - (counter 0) - row-vals) - (when (>= ind 0) ;; collect values of ind col - (setf row-vals (mapcar (lambda (row) (setf counter (+ 1 counter)) - (cons counter (nth ind row))) table))) - (when (or deps (>= ind 0)) ;; remove non-plotting columns - (setf deps (delq ind deps)) - (setf table (mapcar (lambda (row) - (dotimes (col (length row)) - (unless (memq col deps) - (setf (nth col row) nil))) - (delq nil row)) - table))) - ;; write table to gnuplot grid datafile format - (with-temp-file data-file - (let ((num-rows (length table)) (num-cols (length (first table))) - (gnuplot-row (lambda (col row value) - (setf col (+ 1 col)) (setf row (+ 1 row)) - (format "%f %f %f\n%f %f %f\n" - col (- row 0.5) value ;; lower edge - col (+ row 0.5) value))) ;; upper edge - front-edge back-edge) - (dotimes (col num-cols) - (dotimes (row num-rows) - (setf back-edge - (concat back-edge - (funcall gnuplot-row (- col 1) row - (string-to-number (nth col (nth row table)))))) - (setf front-edge - (concat front-edge - (funcall gnuplot-row col row - (string-to-number (nth col (nth row table))))))) - ;; only insert once per row - (insert back-edge) (insert "\n") ;; back edge - (insert front-edge) (insert "\n") ;; front edge - (setf back-edge "") (setf front-edge "")))) - row-vals)) - -(defun org-plot/gnuplot-script (data-file num-cols params &optional preface) - "Write a gnuplot script to DATA-FILE respecting the options set in PARAMS. -NUM-COLS controls the number of columns plotted in a 2-d plot. -Optional argument PREFACE returns only option parameters in a -manner suitable for prepending to a user-specified script." - (let* ((type (plist-get params :plot-type)) - (with (if (equal type 'grid) - 'pm3d - (plist-get params :with))) - (sets (plist-get params :set)) - (lines (plist-get params :line)) - (map (plist-get params :map)) - (title (plist-get params :title)) - (file (plist-get params :file)) - (ind (plist-get params :ind)) - (time-ind (plist-get params :timeind)) - (timefmt (plist-get params :timefmt)) - (text-ind (plist-get params :textind)) - (deps (if (plist-member params :deps) (plist-get params :deps))) - (col-labels (plist-get params :labels)) - (x-labels (plist-get params :xlabels)) - (y-labels (plist-get params :ylabels)) - (plot-str "'%s' using %s%d%s with %s title '%s'") - (plot-cmd (case type - ('2d "plot") - ('3d "splot") - ('grid "splot"))) - (script "reset") - ; ats = add-to-script - (ats (lambda (line) (setf script (format "%s\n%s" script line)))) - plot-lines) - (when file ;; output file - (funcall ats (format "set term %s" (file-name-extension file))) - (funcall ats (format "set output '%s'" file))) - (case type ;; type - ('2d ()) - ('3d (if map (funcall ats "set map"))) - ('grid (if map (funcall ats "set pm3d map") - (funcall ats "set pm3d")))) - (when title (funcall ats (format "set title '%s'" title))) ;; title - (when lines (mapc (lambda (el) (funcall ats el)) lines)) ;; line - (when sets ;; set - (mapc (lambda (el) (funcall ats (format "set %s" el))) sets)) - (when x-labels ;; x labels (xtics) - (funcall ats - (format "set xtics (%s)" - (mapconcat (lambda (pair) - (format "\"%s\" %d" (cdr pair) (car pair))) - x-labels ", ")))) - (when y-labels ;; y labels (ytics) - (funcall ats - (format "set ytics (%s)" - (mapconcat (lambda (pair) - (format "\"%s\" %d" (cdr pair) (car pair))) - y-labels ", ")))) - (when time-ind ;; timestamp index - (funcall ats "set xdata time") - (funcall ats (concat "set timefmt \"" - (or timefmt ;; timefmt passed to gnuplot - "%Y-%m-%d-%H:%M:%S") "\""))) - (unless preface - (case type ;; plot command - ('2d (dotimes (col num-cols) - (unless (and (equal type '2d) - (or (and ind (equal (+ 1 col) ind)) - (and deps (not (member (+ 1 col) deps))))) - (setf plot-lines - (cons - (format plot-str data-file - (or (and ind (> ind 0) - (not text-ind) - (format "%d:" ind)) "") - (+ 1 col) - (if text-ind (format ":xticlabel(%d)" ind) "") - with - (or (nth col col-labels) (format "%d" (+ 1 col)))) - plot-lines))))) - ('3d - (setq plot-lines (list (format "'%s' matrix with %s title ''" - data-file with)))) - ('grid - (setq plot-lines (list (format "'%s' with %s title ''" - data-file with))))) - (funcall ats - (concat plot-cmd " " (mapconcat 'identity (reverse plot-lines) ",\\\n ")))) - script)) - -;;----------------------------------------------------------------------------- -;; facade functions -;;;###autoload -(defun org-plot/gnuplot (&optional params) - "Plot table using gnuplot. Gnuplot options can be specified with PARAMS. -If not given options will be taken from the +PLOT -line directly before or after the table." - (interactive) - (require 'gnuplot) - (save-window-excursion - (delete-other-windows) - (when (get-buffer "*gnuplot*") ;; reset *gnuplot* if it already running - (with-current-buffer "*gnuplot*" - (goto-char (point-max)) - (gnuplot-delchar-or-maybe-eof nil))) - (org-plot/goto-nearest-table) - ;; set default options - (mapc - (lambda (pair) - (unless (plist-member params (car pair)) - (setf params (plist-put params (car pair) (cdr pair))))) - org-plot/gnuplot-default-options) - ;; collect table and table information - (let* ((data-file (make-temp-file "org-plot")) - (table (org-table-to-lisp)) - (num-cols (length (if (eq (first table) 'hline) (second table) - (first table))))) - (while (equal 'hline (first table)) (setf table (cdr table))) - (when (equal (second table) 'hline) - (setf params (plist-put params :labels (first table))) ;; headers to labels - (setf table (delq 'hline (cdr table)))) ;; clean non-data from table - ;; collect options - (save-excursion (while (and (equal 0 (forward-line -1)) - (looking-at "[[:space:]]*#\\+")) - (setf params (org-plot/collect-options params)))) - ;; dump table to datafile (very different for grid) - (case (plist-get params :plot-type) - ('2d (org-plot/gnuplot-to-data table data-file params)) - ('3d (org-plot/gnuplot-to-data table data-file params)) - ('grid (let ((y-labels (org-plot/gnuplot-to-grid-data - table data-file params))) - (when y-labels (plist-put params :ylabels y-labels))))) - ;; check for timestamp ind column - (let ((ind (- (plist-get params :ind) 1))) - (when (and (>= ind 0) (equal '2d (plist-get params :plot-type))) - (if (= (length - (delq 0 (mapcar - (lambda (el) - (if (string-match org-ts-regexp3 el) - 0 1)) - (mapcar (lambda (row) (nth ind row)) table)))) 0) - (plist-put params :timeind t) - ;; check for text ind column - (if (or (string= (plist-get params :with) "hist") - (> (length - (delq 0 (mapcar - (lambda (el) - (if (string-match org-table-number-regexp el) - 0 1)) - (mapcar (lambda (row) (nth ind row)) table)))) 0)) - (plist-put params :textind t))))) - ;; write script - (with-temp-buffer - (if (plist-get params :script) ;; user script - (progn (insert - (org-plot/gnuplot-script data-file num-cols params t)) - (insert "\n") - (insert-file-contents (plist-get params :script)) - (goto-char (point-min)) - (while (re-search-forward "$datafile" nil t) - (replace-match data-file nil nil))) - (insert - (org-plot/gnuplot-script data-file num-cols params))) - ;; graph table - (gnuplot-mode) - (gnuplot-send-buffer-to-gnuplot)) - ;; cleanup - (bury-buffer (get-buffer "*gnuplot*")) - (run-with-idle-timer 0.1 nil (lambda () (delete-file data-file)))))) - -(provide 'org-plot) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-plot.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-protocol.el b/xemacs-packages/lisp/org-8.2.3c/org-protocol.el deleted file mode 100644 index 84b1176a..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-protocol.el +++ /dev/null @@ -1,638 +0,0 @@ -;;; org-protocol.el --- Intercept calls from emacsclient to trigger custom actions. -;; -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. -;; -;; Authors: Bastien Guerry <bzg@gnu.org> -;; Daniel M German <dmg AT uvic DOT org> -;; Sebastian Rose <sebastian_rose AT gmx DOT de> -;; Ross Patterson <me AT rpatterson DOT net> -;; Maintainer: Sebastian Rose <sebastian_rose AT gmx DOT de> -;; Keywords: org, emacsclient, wp - -;; 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: -;; -;; Intercept calls from emacsclient to trigger custom actions. -;; -;; This is done by advising `server-visit-files' to scan the list of filenames -;; for `org-protocol-the-protocol' and sub-protocols defined in -;; `org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'. -;; -;; Any application that supports calling external programs with an URL -;; as argument may be used with this functionality. -;; -;; -;; Usage: -;; ------ -;; -;; 1.) Add this to your init file (.emacs probably): -;; -;; (add-to-list 'load-path "/path/to/org-protocol/") -;; (require 'org-protocol) -;; -;; 3.) Ensure emacs-server is up and running. -;; 4.) Try this from the command line (adjust the URL as needed): -;; -;; $ emacsclient \ -;; org-protocol://store-link://http:%2F%2Flocalhost%2Findex.html/The%20title -;; -;; 5.) Optionally add custom sub-protocols and handlers: -;; -;; (setq org-protocol-protocol-alist -;; '(("my-protocol" -;; :protocol "my-protocol" -;; :function my-protocol-handler-function))) -;; -;; A "sub-protocol" will be found in URLs like this: -;; -;; org-protocol://sub-protocol://data -;; -;; If it works, you can now setup other applications for using this feature. -;; -;; -;; As of March 2009 Firefox users follow the steps documented on -;; http://kb.mozillazine.org/Register_protocol, Opera setup is described here: -;; http://www.opera.com/support/kb/view/535/ -;; -;; -;; Documentation -;; ------------- -;; -;; org-protocol.el comes with and installs handlers to open sources of published -;; online content, store and insert the browser's URLs and cite online content -;; by clicking on a bookmark in Firefox, Opera and probably other browsers and -;; applications: -;; -;; * `org-protocol-open-source' uses the sub-protocol \"open-source\" and maps -;; URLs to local filenames defined in `org-protocol-project-alist'. -;; -;; * `org-protocol-store-link' stores an Org-link (if Org-mode is present) and -;; pushes the browsers URL to the `kill-ring' for yanking. This handler is -;; triggered through the sub-protocol \"store-link\". -;; -;; * Call `org-protocol-capture' by using the sub-protocol \"capture\". If -;; Org-mode is loaded, Emacs will pop-up a capture buffer and fill the -;; template with the data provided. I.e. the browser's URL is inserted as an -;; Org-link of which the page title will be the description part. If text -;; was select in the browser, that text will be the body of the entry. -;; -;; You may use the same bookmark URL for all those standard handlers and just -;; adjust the sub-protocol used: -;; -;; location.href='org-protocol://sub-protocol://'+ -;; encodeURIComponent(location.href)+'/'+ -;; encodeURIComponent(document.title)+'/'+ -;; encodeURIComponent(window.getSelection()) -;; -;; The handler for the sub-protocol \"capture\" detects an optional template -;; char that, if present, triggers the use of a special template. -;; Example: -;; -;; location.href='org-protocol://sub-protocol://x/'+ ... -;; -;; use template ?x. -;; -;; Note, that using double slashes is optional from org-protocol.el's point of -;; view because emacsclient squashes the slashes to one. -;; -;; -;; provides: 'org-protocol -;; -;;; Code: - -(require 'org) -(eval-when-compile - (require 'cl)) - -(declare-function org-publish-get-project-from-filename "org-publish" - (filename &optional up)) -(declare-function server-edit "server" (&optional arg)) - -(define-obsolete-function-alias - 'org-protocol-unhex-compound 'org-link-unescape-compound - "2011-02-17") - -(define-obsolete-function-alias - 'org-protocol-unhex-string 'org-link-unescape - "2011-02-17") - -(define-obsolete-function-alias - 'org-protocol-unhex-single-byte-sequence - 'org-link-unescape-single-byte-sequence - "2011-02-17") - -(defgroup org-protocol nil - "Intercept calls from emacsclient to trigger custom actions. - -This is done by advising `server-visit-files' to scan the list of filenames -for `org-protocol-the-protocol' and sub-protocols defined in -`org-protocol-protocol-alist' and `org-protocol-protocol-alist-default'." - :version "22.1" - :group 'convenience - :group 'org) - - -;;; Variables: - -(defconst org-protocol-protocol-alist-default - '(("org-capture" :protocol "capture" :function org-protocol-capture :kill-client t) - ("org-store-link" :protocol "store-link" :function org-protocol-store-link) - ("org-open-source" :protocol "open-source" :function org-protocol-open-source)) - "Default protocols to use. -See `org-protocol-protocol-alist' for a description of this variable.") - -(defconst org-protocol-the-protocol "org-protocol" - "This is the protocol to detect if org-protocol.el is loaded. -`org-protocol-protocol-alist-default' and `org-protocol-protocol-alist' hold -the sub-protocols that trigger the required action. You will have to define -just one protocol handler OS-wide (MS-Windows) or per application (Linux). -That protocol handler should call emacsclient.") - -;;; User variables: - -(defcustom org-protocol-reverse-list-of-files t - "Non-nil means re-reverse the list of filenames passed on the command line. -The filenames passed on the command line are passed to the emacs-server in -reverse order. Set to t (default) to re-reverse the list, i.e. use the -sequence on the command line. If nil, the sequence of the filenames is -unchanged." - :group 'org-protocol - :type 'boolean) - -(defcustom org-protocol-project-alist nil - "Map URLs to local filenames for `org-protocol-open-source' (open-source). - -Each element of this list must be of the form: - - (module-name :property value property: value ...) - -where module-name is an arbitrary name. All the values are strings. - -Possible properties are: - - :online-suffix - the suffix to strip from the published URLs - :working-suffix - the replacement for online-suffix - :base-url - the base URL, e.g. http://www.example.com/project/ - Last slash required. - :working-directory - the local working directory. This is, what base-url will - be replaced with. - :redirects - A list of cons cells, each of which maps a regular - expression to match to a path relative to :working-directory. - -Example: - - (setq org-protocol-project-alist - '((\"http://orgmode.org/worg/\" - :online-suffix \".php\" - :working-suffix \".org\" - :base-url \"http://orgmode.org/worg/\" - :working-directory \"/home/user/org/Worg/\") - (\"http://localhost/org-notes/\" - :online-suffix \".html\" - :working-suffix \".org\" - :base-url \"http://localhost/org/\" - :working-directory \"/home/user/org/\" - :rewrites ((\"org/?$\" . \"index.php\"))))) - - The last line tells `org-protocol-open-source' to open - /home/user/org/index.php, if the URL cannot be mapped to an existing - file, and ends with either \"org\" or \"org/\". - -Consider using the interactive functions `org-protocol-create' and -`org-protocol-create-for-org' to help you filling this variable with valid contents." - :group 'org-protocol - :type 'alist) - -(defcustom org-protocol-protocol-alist nil - "Register custom handlers for org-protocol. - -Each element of this list must be of the form: - - (module-name :protocol protocol :function func :kill-client nil) - -protocol - protocol to detect in a filename without trailing colon and slashes. - See rfc1738 section 2.1 for more on this. - If you define a protocol \"my-protocol\", `org-protocol-check-filename-for-protocol' - will search filenames for \"org-protocol:/my-protocol:/\" - and trigger your action for every match. `org-protocol' is defined in - `org-protocol-the-protocol'. Double and triple slashes are compressed - to one by emacsclient. - -function - function that handles requests with protocol and takes exactly one - argument: the filename with all protocols stripped. If the function - returns nil, emacsclient and -server do nothing. Any non-nil return - value is considered a valid filename and thus passed to the server. - - `org-protocol.el provides some support for handling those filenames, - if you stay with the conventions used for the standard handlers in - `org-protocol-protocol-alist-default'. See `org-protocol-split-data'. - -kill-client - If t, kill the client immediately, once the sub-protocol is - detected. This is necessary for actions that can be interrupted by - `C-g' to avoid dangling emacsclients. Note, that all other command - line arguments but the this one will be discarded, greedy handlers - still receive the whole list of arguments though. - -Here is an example: - - (setq org-protocol-protocol-alist - '((\"my-protocol\" - :protocol \"my-protocol\" - :function my-protocol-handler-function) - (\"your-protocol\" - :protocol \"your-protocol\" - :function your-protocol-handler-function)))" - :group 'org-protocol - :type '(alist)) - -(defcustom org-protocol-default-template-key nil - "The default template key to use. -This is usually a single character string but can also be a -string with two characters." - :group 'org-protocol - :type '(choice (const nil) (string))) - -(defcustom org-protocol-data-separator "/+\\|\\?" - "The default data separator to use. - This should be a single regexp string." - :group 'org-protocol - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -;;; Helper functions: - -(defun org-protocol-sanitize-uri (uri) - "emacsclient compresses double and triple slashes. -Slashes are sanitized to double slashes here." - (when (string-match "^\\([a-z]+\\):/" uri) - (let* ((splitparts (split-string uri "/+"))) - (setq uri (concat (car splitparts) "//" (mapconcat 'identity (cdr splitparts) "/"))))) - uri) - -(defun org-protocol-split-data (data &optional unhexify separator) - "Split what an org-protocol handler function gets as only argument. -DATA is that one argument. DATA is split at each occurrence of -SEPARATOR (regexp). If no SEPARATOR is specified or SEPARATOR is -nil, assume \"/+\". The results of that splitting are returned -as a list. If UNHEXIFY is non-nil, hex-decode each split part. -If UNHEXIFY is a function, use that function to decode each split -part." - (let* ((sep (or separator "/+\\|\\?")) - (split-parts (split-string data sep))) - (if unhexify - (if (fboundp unhexify) - (mapcar unhexify split-parts) - (mapcar 'org-link-unescape split-parts)) - split-parts))) - -(defun org-protocol-flatten-greedy (param-list &optional strip-path replacement) - "Greedy handlers might receive a list like this from emacsclient: - '((\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") -where \"/dir/\" is the absolute path to emacsclients working directory. This -function transforms it into a flat list using `org-protocol-flatten' and -transforms the elements of that list as follows: - -If strip-path is non-nil, remove the \"/dir/\" prefix from all members of -param-list. - -If replacement is string, replace the \"/dir/\" prefix with it. - -The first parameter, the one that contains the protocols, is always changed. -Everything up to the end of the protocols is stripped. - -Note, that this function will always behave as if -`org-protocol-reverse-list-of-files' was set to t and the returned list will -reflect that. I.e. emacsclients first parameter will be the first one in the -returned list." - (let* ((l (org-protocol-flatten (if org-protocol-reverse-list-of-files - param-list - (reverse param-list)))) - (trigger (car l)) - (len 0) - dir - ret) - (when (string-match "^\\(.*\\)\\(org-protocol:/+[a-zA-z0-9][-_a-zA-z0-9]*:/+\\)\\(.*\\)" trigger) - (setq dir (match-string 1 trigger)) - (setq len (length dir)) - (setcar l (concat dir (match-string 3 trigger)))) - (if strip-path - (progn - (dolist (e l ret) - (setq ret - (append ret - (list - (if (stringp e) - (if (stringp replacement) - (setq e (concat replacement (substring e len))) - (setq e (substring e len))) - e))))) - ret) - l))) - -(defun org-protocol-flatten (l) - "Greedy handlers might receive a list like this from emacsclient: - '( (\"/dir/org-protocol:/greedy:/~/path1\" (23 . 12)) (\"/dir/param\") -where \"/dir/\" is the absolute path to emacsclients working directory. -This function transforms it into a flat list." - (if (null l) () - (if (listp l) - (append (org-protocol-flatten (car l)) (org-protocol-flatten (cdr l))) - (list l)))) - - -;;; Standard protocol handlers: - -(defun org-protocol-store-link (fname) - "Process an org-protocol://store-link:// style url. -Additionally store a browser URL as an org link. Also pushes the -link's URL to the `kill-ring'. - -The location for a browser's bookmark has to look like this: - - javascript:location.href='org-protocol://store-link://'+ \\ - encodeURIComponent(location.href) - encodeURIComponent(document.title)+'/'+ \\ - -Don't use `escape()'! Use `encodeURIComponent()' instead. The title of the page -could contain slashes and the location definitely will. - -The sub-protocol used to reach this function is set in -`org-protocol-protocol-alist'." - (let* ((splitparts (org-protocol-split-data fname t org-protocol-data-separator)) - (uri (org-protocol-sanitize-uri (car splitparts))) - (title (cadr splitparts)) - orglink) - (if (boundp 'org-stored-links) - (setq org-stored-links (cons (list uri title) org-stored-links))) - (kill-new uri) - (message "`%s' to insert new org-link, `%s' to insert `%s'" - (substitute-command-keys"\\[org-insert-link]") - (substitute-command-keys"\\[yank]") - uri)) - nil) - -(defun org-protocol-capture (info) - "Process an org-protocol://capture:// style url. - -The sub-protocol used to reach this function is set in -`org-protocol-protocol-alist'. - -This function detects an URL, title and optional text, separated -by '/'. The location for a browser's bookmark looks like this: - - javascript:location.href='org-protocol://capture://'+ \\ - encodeURIComponent(location.href)+'/' \\ - encodeURIComponent(document.title)+'/'+ \\ - encodeURIComponent(window.getSelection()) - -By default, it uses the character `org-protocol-default-template-key', -which should be associated with a template in `org-capture-templates'. -But you may prepend the encoded URL with a character and a slash like so: - - javascript:location.href='org-protocol://capture://b/'+ ... - -Now template ?b will be used." - (if (and (boundp 'org-stored-links) - (org-protocol-do-capture info)) - (message "Item captured.")) - nil) - -(defun org-protocol-convert-query-to-plist (query) - "Convert query string that is part of url to property list." - (if query - (apply 'append (mapcar (lambda (x) - (let ((c (split-string x "="))) - (list (intern (concat ":" (car c))) (cadr c)))) - (split-string query "&"))))) - -(defun org-protocol-do-capture (info) - "Support `org-capture'." - (let* ((parts (org-protocol-split-data info t org-protocol-data-separator)) - (template (or (and (>= 2 (length (car parts))) (pop parts)) - org-protocol-default-template-key)) - (url (org-protocol-sanitize-uri (car parts))) - (type (if (string-match "^\\([a-z]+\\):" url) - (match-string 1 url))) - (title (or (cadr parts) "")) - (region (or (caddr parts) "")) - (orglink (org-make-link-string - url (if (string-match "[^[:space:]]" title) title url))) - (query (or (org-protocol-convert-query-to-plist (cadddr parts)) "")) - (org-capture-link-is-already-stored t)) ;; avoid call to org-store-link - (setq org-stored-links - (cons (list url title) org-stored-links)) - (kill-new orglink) - (org-store-link-props :type type - :link url - :description title - :annotation orglink - :initial region - :query query) - (raise-frame) - (funcall 'org-capture nil template))) - -(defun org-protocol-open-source (fname) - "Process an org-protocol://open-source:// style url. - -Change a filename by mapping URLs to local filenames as set -in `org-protocol-project-alist'. - -The location for a browser's bookmark should look like this: - - javascript:location.href='org-protocol://open-source://'+ \\ - encodeURIComponent(location.href)" - ;; As we enter this function for a match on our protocol, the return value - ;; defaults to nil. - (let ((result nil) - (f (org-link-unescape fname))) - (catch 'result - (dolist (prolist org-protocol-project-alist) - (let* ((base-url (plist-get (cdr prolist) :base-url)) - (wsearch (regexp-quote base-url))) - - (when (string-match wsearch f) - (let* ((wdir (plist-get (cdr prolist) :working-directory)) - (strip-suffix (plist-get (cdr prolist) :online-suffix)) - (add-suffix (plist-get (cdr prolist) :working-suffix)) - ;; Strip "[?#].*$" if `f' is a redirect with another - ;; ending than strip-suffix here: - (f1 (substring f 0 (string-match "\\([\\?#].*\\)?$" f))) - (start-pos (+ (string-match wsearch f1) (length base-url))) - (end-pos (string-match - (regexp-quote strip-suffix) f1)) - ;; We have to compare redirects without suffix below: - (f2 (concat wdir (substring f1 start-pos end-pos))) - (the-file (concat f2 add-suffix))) - - ;; Note: the-file may still contain `%C3' et al here because browsers - ;; tend to encode `ä' in URLs to `%25C3' - `%25' being `%'. - ;; So the results may vary. - - ;; -- start redirects -- - (unless (file-exists-p the-file) - (message "File %s does not exist.\nTesting for rewritten URLs." the-file) - (let ((rewrites (plist-get (cdr prolist) :rewrites))) - (when rewrites - (message "Rewrites found: %S" rewrites) - (mapc - (lambda (rewrite) - "Try to match a rewritten URL and map it to a real file." - ;; Compare redirects without suffix: - (if (string-match (car rewrite) f2) - (throw 'result (concat wdir (cdr rewrite))))) - rewrites)))) - ;; -- end of redirects -- - - (if (file-readable-p the-file) - (throw 'result the-file)) - (if (file-exists-p the-file) - (message "%s: permission denied!" the-file) - (message "%s: no such file or directory." the-file)))))) - result))) - - -;;; Core functions: - -(defun org-protocol-check-filename-for-protocol (fname restoffiles client) - "Detect if `org-protocol-the-protocol' and a known sub-protocol is used in fname. -Sub-protocols are registered in `org-protocol-protocol-alist' and -`org-protocol-protocol-alist-default'. -This is, how the matching is done: - - (string-match \"protocol:/+sub-protocol:/+\" ...) - -protocol and sub-protocol are regexp-quoted. - -If a matching protocol is found, the protocol is stripped from fname and the -result is passed to the protocols function as the only parameter. If the -function returns nil, the filename is removed from the list of filenames -passed from emacsclient to the server. -If the function returns a non nil value, that value is passed to the server -as filename." - (let ((sub-protocols (append org-protocol-protocol-alist - org-protocol-protocol-alist-default))) - (catch 'fname - (let ((the-protocol (concat (regexp-quote org-protocol-the-protocol) ":/+"))) - (when (string-match the-protocol fname) - (dolist (prolist sub-protocols) - (let ((proto (concat the-protocol - (regexp-quote (plist-get (cdr prolist) :protocol)) ":/+"))) - (when (string-match proto fname) - (let* ((func (plist-get (cdr prolist) :function)) - (greedy (plist-get (cdr prolist) :greedy)) - (split (split-string fname proto)) - (result (if greedy restoffiles (cadr split)))) - (when (plist-get (cdr prolist) :kill-client) - (message "Greedy org-protocol handler. Killing client.") - (server-edit)) - (when (fboundp func) - (unless greedy - (throw 'fname (funcall func result))) - (funcall func result) - (throw 'fname t)))))))) - ;; (message "fname: %s" fname) - fname))) - -(defadvice server-visit-files (before org-protocol-detect-protocol-server activate) - "Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'." - (let ((flist (if org-protocol-reverse-list-of-files - (reverse (ad-get-arg 0)) - (ad-get-arg 0))) - (client (ad-get-arg 1))) - (catch 'greedy - (dolist (var flist) - ;; `\' to `/' on windows. FIXME: could this be done any better? - (let ((fname (expand-file-name (car var)))) - (setq fname (org-protocol-check-filename-for-protocol - fname (member var flist) client)) - (if (eq fname t) ;; greedy? We need the `t' return value. - (progn - (ad-set-arg 0 nil) - (throw 'greedy t)) - (if (stringp fname) ;; probably filename - (setcar var fname) - (ad-set-arg 0 (delq var (ad-get-arg 0)))))))))) - -;;; Org specific functions: - -(defun org-protocol-create-for-org () - "Create a org-protocol project for the current file's Org-mode project. -The visited file needs to be part of a publishing project in -`org-publish-project-alist' for this to work. The function -delegates most of the work to `org-protocol-create'." - (interactive) - (require 'org-publish) - (let ((all (or (org-publish-get-project-from-filename buffer-file-name)))) - (if all (org-protocol-create (cdr all)) - (message "Not in an org-project. Did mean %s?" - (substitute-command-keys"\\[org-protocol-create]"))))) - -(defun org-protocol-create (&optional project-plist) - "Create a new org-protocol project interactively. -An org-protocol project is an entry in -`org-protocol-project-alist' which is used by -`org-protocol-open-source'. Optionally use PROJECT-PLIST to -initialize the defaults for this project. If PROJECT-PLIST is -the cdr of an element in `org-publish-project-alist', reuse -:base-directory, :html-extension and :base-extension." - (interactive) - (let ((working-dir (expand-file-name - (or (plist-get project-plist :base-directory) - default-directory))) - (base-url "http://orgmode.org/worg/") - (strip-suffix (or (plist-get project-plist :html-extension) ".html")) - (working-suffix (if (plist-get project-plist :base-extension) - (concat "." (plist-get project-plist :base-extension)) - ".org")) - (worglet-buffer nil) - (insert-default-directory t) - (minibuffer-allow-text-properties nil)) - - (setq base-url (read-string "Base URL of published content: " base-url nil base-url t)) - (if (not (string-match "\\/$" base-url)) - (setq base-url (concat base-url "/"))) - - (setq working-dir - (expand-file-name - (read-directory-name "Local working directory: " working-dir working-dir t))) - (if (not (string-match "\\/$" working-dir)) - (setq working-dir (concat working-dir "/"))) - - (setq strip-suffix - (read-string - (concat "Extension to strip from published URLs (" strip-suffix "): ") - strip-suffix nil strip-suffix t)) - - (setq working-suffix - (read-string - (concat "Extension of editable files (" working-suffix "): ") - working-suffix nil working-suffix t)) - - (when (yes-or-no-p "Save the new org-protocol-project to your init file? ") - (setq org-protocol-project-alist - (cons `(,base-url . (:base-url ,base-url - :working-directory ,working-dir - :online-suffix ,strip-suffix - :working-suffix ,working-suffix)) - org-protocol-project-alist)) - (customize-save-variable 'org-protocol-project-alist org-protocol-project-alist)))) - -(provide 'org-protocol) - -;;; org-protocol.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-rmail.el b/xemacs-packages/lisp/org-8.2.3c/org-rmail.el deleted file mode 100644 index e2f9fbee..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-rmail.el +++ /dev/null @@ -1,121 +0,0 @@ -;;; org-rmail.el --- Support for links to Rmail messages from within Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;; This file implements links to Rmail messages from within Org-mode. -;; Org-mode loads this module by default - if this is not what you want, -;; configure the variable `org-modules'. - -;;; Code: - -(require 'org) - -;; Declare external functions and variables -(declare-function rmail-show-message "rmail" (&optional n no-summary)) -(declare-function rmail-what-message "rmail" (&optional pos)) -(declare-function rmail-toggle-header "rmail" (&optional arg)) -(declare-function rmail-widen "rmail" ()) -(defvar rmail-current-message) ; From rmail.el -(defvar rmail-header-style) ; From rmail.el - -;; Install the link type -(org-add-link-type "rmail" 'org-rmail-open) -(add-hook 'org-store-link-functions 'org-rmail-store-link) - -;; Implementation -(defun org-rmail-store-link () - "Store a link to an Rmail folder or message." - (when (or (eq major-mode 'rmail-mode) - (eq major-mode 'rmail-summary-mode)) - (save-window-excursion - (save-restriction - (when (eq major-mode 'rmail-summary-mode) - (rmail-show-message rmail-current-message)) - (when (fboundp 'rmail-narrow-to-non-pruned-header) - (rmail-narrow-to-non-pruned-header)) - (when (eq rmail-header-style 'normal) - (rmail-toggle-header -1)) - (let* ((folder buffer-file-name) - (message-id (mail-fetch-field "message-id")) - (from (mail-fetch-field "from")) - (to (mail-fetch-field "to")) - (subject (mail-fetch-field "subject")) - (date (mail-fetch-field "date")) - (date-ts (and date (format-time-string - (org-time-stamp-format t) - (date-to-time date)))) - (date-ts-ia (and date (format-time-string - (org-time-stamp-format t t) - (date-to-time date)))) - desc link) - (org-store-link-props - :type "rmail" :from from :to to - :subject subject :message-id message-id) - (when date - (org-add-link-props :date date :date-timestamp date-ts - :date-timestamp-inactive date-ts-ia)) - (setq message-id (org-remove-angle-brackets message-id)) - (setq desc (org-email-link-description)) - (setq link (concat "rmail:" folder "#" message-id)) - (org-add-link-props :link link :description desc) - (rmail-show-message rmail-current-message) - link))))) - -(defun org-rmail-open (path) - "Follow an Rmail message link to the specified PATH." - (let (folder article) - (if (not (string-match "\\`\\([^#]+\\)\\(#\\(.*\\)\\)?" path)) - (error "Error in Rmail link")) - (setq folder (match-string 1 path) - article (match-string 3 path)) - (org-rmail-follow-link folder article))) - -(defun org-rmail-follow-link (folder article) - "Follow an Rmail link to FOLDER and ARTICLE." - (require 'rmail) - (setq article (org-add-angle-brackets article)) - (let (message-number) - (save-excursion - (save-window-excursion - (rmail (if (string= folder "RMAIL") rmail-file-name folder)) - (setq message-number - (save-restriction - (rmail-widen) - (goto-char (point-max)) - (if (re-search-backward - (concat "^Message-ID:\\s-+" (regexp-quote - (or article ""))) - nil t) - (rmail-what-message)))))) - (if message-number - (progn - (rmail (if (string= folder "RMAIL") rmail-file-name folder)) - (rmail-show-message message-number) - message-number) - (error "Message not found")))) - -(provide 'org-rmail) - -;;; org-rmail.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-src.el b/xemacs-packages/lisp/org-8.2.3c/org-src.el deleted file mode 100644 index 99038576..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-src.el +++ /dev/null @@ -1,963 +0,0 @@ -;;; org-src.el --- Source code examples in Org -;; -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Bastien Guerry <bzg@gnu.org> -;; Dan Davison <davison at stats dot ox dot ac dot uk> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;; This file contains the code dealing with source code examples in Org-mode. - -;;; Code: - -(require 'org-macs) -(require 'org-compat) -(require 'ob-keys) -(require 'ob-comint) -(eval-when-compile - (require 'cl)) - -(declare-function org-do-remove-indentation "org" (&optional n)) -(declare-function org-at-table.el-p "org" ()) -(declare-function org-in-src-block-p "org" (&optional inside)) -(declare-function org-in-block-p "org" (names)) -(declare-function org-get-indentation "org" (&optional line)) -(declare-function org-switch-to-buffer-other-window "org" (&rest args)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) -(declare-function org-base-buffer "org" (buffer)) - -(defcustom org-edit-src-region-extra nil - "Additional regexps to identify regions for editing with `org-edit-src-code'. -For examples see the function `org-edit-src-find-region-and-lang'. -The regular expression identifying the begin marker should end with a newline, -and the regexp marking the end line should start with a newline, to make sure -there are kept outside the narrowed region." - :group 'org-edit-structure - :type '(repeat - (list - (regexp :tag "begin regexp") - (regexp :tag "end regexp") - (choice :tag "language" - (string :tag "specify") - (integer :tag "from match group") - (const :tag "from `lang' element") - (const :tag "from `style' element"))))) - -(defcustom org-edit-src-turn-on-auto-save nil - "Non-nil means turn `auto-save-mode' on when editing a source block. -This will save the content of the source code editing buffer into -a newly created file, not the base buffer for this source block. - -If you want to regularily save the base buffer instead of the source -code editing buffer, see `org-edit-src-auto-save-idle-delay' instead." - :group 'org-edit-structure - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-edit-src-auto-save-idle-delay 0 - "Delay before saving a source code buffer back into its base buffer. -When a positive integer N, save after N seconds of idle time. -When 0 (the default), don't auto-save. - -If you want to save the source code buffer itself, don't use this. -Check `org-edit-src-turn-on-auto-save' instead." - :group 'org-edit-structure - :version "24.4" - :package-version '(Org . "8.0") - :type 'integer) - -(defcustom org-coderef-label-format "(ref:%s)" - "The default coderef format. -This format string will be used to search for coderef labels in literal -examples (EXAMPLE and SRC blocks). The format can be overwritten in -an individual literal example with the -l option, like - -#+BEGIN_SRC pascal +n -r -l \"((%s))\" -... -#+END_SRC - -If you want to use this for HTML export, make sure that the format does -not introduce special font-locking, and avoid the HTML special -characters `<', `>', and `&'. The reason for this restriction is that -the labels are searched for only after htmlize has done its job." - :group 'org-edit-structure ; FIXME this is not in the right group - :type 'string) - -(defcustom org-edit-fixed-width-region-mode 'artist-mode - "The mode that should be used to edit fixed-width regions. -These are the regions where each line starts with a colon." - :group 'org-edit-structure - :type '(choice - (const artist-mode) - (const picture-mode) - (const fundamental-mode) - (function :tag "Other (specify)"))) - -(defcustom org-src-preserve-indentation nil - "If non-nil preserve leading whitespace characters on export. -If non-nil leading whitespace characters in source code blocks -are preserved on export, and when switching between the org -buffer and the language mode edit buffer. If this variable is nil -then, after editing with \\[org-edit-src-code], the -minimum (across-lines) number of leading whitespace characters -are removed from all lines, and the code block is uniformly -indented according to the value of `org-edit-src-content-indentation'." - :group 'org-edit-structure - :type 'boolean) - -(defcustom org-edit-src-content-indentation 2 - "Indentation for the content of a source code block. -This should be the number of spaces added to the indentation of the #+begin -line in order to compute the indentation of the block content after -editing it with \\[org-edit-src-code]. Has no effect if -`org-src-preserve-indentation' is non-nil." - :group 'org-edit-structure - :type 'integer) - -(defvar org-src-strip-leading-and-trailing-blank-lines nil - "If non-nil, blank lines are removed when exiting the code edit buffer.") - -(defcustom org-edit-src-persistent-message t - "Non-nil means show persistent exit help message while editing src examples. -The message is shown in the header-line, which will be created in the -first line of the window showing the editing buffer." - :group 'org-edit-structure - :type 'boolean) - -(defcustom org-src-window-setup 'reorganize-frame - "How the source code edit buffer should be displayed. -Possible values for this option are: - -current-window Show edit buffer in the current window, keeping all other - windows. -other-window Use `switch-to-buffer-other-window' to display edit buffer. -reorganize-frame Show only two windows on the current frame, the current - window and the edit buffer. When exiting the edit buffer, - return to one window. -other-frame Use `switch-to-buffer-other-frame' to display edit buffer. - Also, when exiting the edit buffer, kill that frame." - :group 'org-edit-structure - :type '(choice - (const current-window) - (const other-frame) - (const other-window) - (const reorganize-frame))) - -(defvar org-src-mode-hook nil - "Hook run after Org switched a source code snippet to its Emacs mode. -This hook will run - -- when editing a source code snippet with \"C-c '\". -- When formatting a source code snippet for export with htmlize. - -You may want to use this hook for example to turn off `outline-minor-mode' -or similar things which you want to have when editing a source code file, -but which mess up the display of a snippet in Org exported files.") - -(defcustom org-src-lang-modes - '(("ocaml" . tuareg) ("elisp" . emacs-lisp) ("ditaa" . artist) - ("asymptote" . asy) ("dot" . fundamental) ("sqlite" . sql) - ("calc" . fundamental) ("C" . c) ("cpp" . c++) ("C++" . c++) - ("screen" . shell-script)) - "Alist mapping languages to their major mode. -The key is the language name, the value is the string that should -be inserted as the name of the major mode. For many languages this is -simple, but for language where this is not the case, this variable -provides a way to simplify things on the user side. -For example, there is no ocaml-mode in Emacs, but the mode to use is -`tuareg-mode'." - :group 'org-edit-structure - :type '(repeat - (cons - (string "Language name") - (symbol "Major mode")))) - -;;; Editing source examples - -(defvar org-src-mode-map (make-sparse-keymap)) -(define-key org-src-mode-map "\C-c'" 'org-edit-src-exit) -(define-key org-src-mode-map "\C-c\C-k" 'org-edit-src-abort) -(define-key org-src-mode-map "\C-x\C-s" 'org-edit-src-save) - -(defvar org-edit-src-force-single-line nil) -(defvar org-edit-src-from-org-mode nil) -(defvar org-edit-src-allow-write-back-p t) -(defvar org-edit-src-picture nil) -(defvar org-edit-src-beg-marker nil) -(defvar org-edit-src-end-marker nil) -(defvar org-edit-src-overlay nil) -(defvar org-edit-src-block-indentation nil) -(defvar org-edit-src-saved-temp-window-config nil) - -(defcustom org-src-ask-before-returning-to-edit-buffer t - "If nil, when org-edit-src code is used on a block that already -has an active edit buffer, it will switch to that edit buffer -immediately; otherwise it will ask whether you want to return to -the existing edit buffer." - :group 'org-edit-structure - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defvar org-src-babel-info nil) - -(define-minor-mode org-src-mode - "Minor mode for language major mode buffers generated by org. -This minor mode is turned on in two situations: -- when editing a source code snippet with \"C-c '\". -- When formatting a source code snippet for export with htmlize. -There is a mode hook, and keybindings for `org-edit-src-exit' and -`org-edit-src-save'") - -(defvar org-edit-src-code-timer nil) -(defun org-edit-src-code (&optional context code edit-buffer-name) - "Edit the source CODE block at point. -The code is copied to a separate buffer and the appropriate mode -is turned on. When done, exit with \\[org-edit-src-exit]. This will -remove the original code in the Org buffer, and replace it with the -edited version. An optional argument CONTEXT is used by \\[org-edit-src-save] -when calling this function. See `org-src-window-setup' to configure -the display of windows containing the Org buffer and the code buffer." - (interactive) - (if (not (or (org-in-block-p '("src" "example" "latex" "html")) - (org-at-table.el-p))) - (user-error "Not in a source code or example block") - (unless (eq context 'save) - (setq org-edit-src-saved-temp-window-config (current-window-configuration))) - (let* ((mark (and (org-region-active-p) (mark))) - (case-fold-search t) - (info - ;; If the src region consists in no lines, we insert a blank - ;; line. - (let* ((temp (org-edit-src-find-region-and-lang)) - (beg (nth 0 temp)) - (end (nth 1 temp))) - (if (>= end beg) temp - (goto-char beg) - (insert "\n") - (org-edit-src-find-region-and-lang)))) - (full-info (org-babel-get-src-block-info 'light)) - (org-mode-p (derived-mode-p 'org-mode)) ;; derived-mode-p is reflexive - (beg (make-marker)) - ;; Move marker with inserted text for case when src block is - ;; just one empty line, i.e. beg == end. - (end (copy-marker (make-marker) t)) - (allow-write-back-p (null code)) - block-nindent total-nindent ovl lang lang-f single lfmt buffer msg - begline markline markcol line col transmitted-variables) - (setq beg (move-marker beg (nth 0 info)) - end (move-marker end (nth 1 info)) - msg (if allow-write-back-p - (substitute-command-keys - "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort") - "Exit with C-c ' (C-c and single quote) -- C-c C-k to abort") - code (or code (buffer-substring-no-properties beg end)) - lang (or (cdr (assoc (nth 2 info) org-src-lang-modes)) - (nth 2 info)) - lang (if (symbolp lang) (symbol-name lang) lang) - single (nth 3 info) - block-nindent (nth 5 info) - lang-f (intern (concat lang "-mode")) - begline (save-excursion (goto-char beg) (org-current-line)) - transmitted-variables - `((org-edit-src-content-indentation - ,org-edit-src-content-indentation) - (org-edit-src-force-single-line ,single) - (org-edit-src-from-org-mode ,org-mode-p) - (org-edit-src-allow-write-back-p ,allow-write-back-p) - (org-src-preserve-indentation ,org-src-preserve-indentation) - (org-src-babel-info ,(org-babel-get-src-block-info 'light)) - (org-coderef-label-format - ,(or (nth 4 info) org-coderef-label-format)) - (org-edit-src-beg-marker ,beg) - (org-edit-src-end-marker ,end) - (org-edit-src-block-indentation ,block-nindent))) - (if (and mark (>= mark beg) (<= mark (1+ end))) - (save-excursion (goto-char (min mark end)) - (setq markline (org-current-line) - markcol (current-column)))) - (if (equal lang-f 'table.el-mode) - (setq lang-f (lambda () - (text-mode) - (if (org-bound-and-true-p flyspell-mode) - (flyspell-mode -1)) - (table-recognize) - (org-set-local 'org-edit-src-content-indentation 0)))) - (unless (functionp lang-f) - (error "No such language mode: %s" lang-f)) - (save-excursion - (if (> (point) end) (goto-char end)) - (setq line (org-current-line) - col (current-column))) - (if (and (setq buffer (org-edit-src-find-buffer beg end)) - (or (eq context 'save) - (if org-src-ask-before-returning-to-edit-buffer - (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ") t))) - (org-src-switch-to-buffer buffer 'return) - (when buffer - (with-current-buffer buffer - (if (boundp 'org-edit-src-overlay) - (delete-overlay org-edit-src-overlay))) - (kill-buffer buffer)) - (setq buffer (generate-new-buffer - (or edit-buffer-name - (org-src-construct-edit-buffer-name (buffer-name) lang)))) - (setq ovl (make-overlay beg end)) - (overlay-put ovl 'edit-buffer buffer) - (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") - (overlay-put ovl 'face 'secondary-selection) - (overlay-put ovl - 'keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'org-edit-src-continue) - map)) - (overlay-put ovl :read-only "Leave me alone") - (setq transmitted-variables - (append transmitted-variables `((org-edit-src-overlay ,ovl)))) - (org-src-switch-to-buffer buffer 'edit) - (if (eq single 'macro-definition) - (setq code (replace-regexp-in-string "\\\\n" "\n" code t t))) - (insert code) - (remove-text-properties (point-min) (point-max) - '(display nil invisible nil intangible nil)) - (unless (cadr (assq 'org-src-preserve-indentation transmitted-variables)) - (setq total-nindent (or (org-do-remove-indentation) 0))) - (let ((org-inhibit-startup t)) - (condition-case e - (funcall lang-f) - (error - (error "Language mode `%s' fails with: %S" lang-f (nth 1 e))))) - (dolist (pair transmitted-variables) - (org-set-local (car pair) (cadr pair))) - ;; Remove protecting commas from visible part of buffer. - (org-unescape-code-in-region (point-min) (point-max)) - (when markline - (org-goto-line (1+ (- markline begline))) - (org-move-to-column - (if org-src-preserve-indentation markcol - (max 0 (- markcol total-nindent)))) - (push-mark (point) 'no-message t) - (setq deactivate-mark nil)) - (org-goto-line (1+ (- line begline))) - (org-move-to-column - (if org-src-preserve-indentation col (max 0 (- col total-nindent)))) - (org-src-mode) - (set-buffer-modified-p nil) - (setq buffer-file-name nil) - (when org-edit-src-turn-on-auto-save - (setq buffer-auto-save-file-name - (concat (make-temp-name "org-src-") - (format-time-string "-%Y-%d-%m") ".txt"))) - (and org-edit-src-persistent-message - (org-set-local 'header-line-format msg)) - (let ((edit-prep-func (intern (concat "org-babel-edit-prep:" lang)))) - (when (fboundp edit-prep-func) - (funcall edit-prep-func full-info))) - (or org-edit-src-code-timer - (setq org-edit-src-code-timer - (unless (zerop org-edit-src-auto-save-idle-delay) - (run-with-idle-timer - org-edit-src-auto-save-idle-delay t - (lambda () - (cond - ((and (string-match "\*Org Src" (buffer-name)) - (buffer-modified-p)) - (org-edit-src-save)) - ((not - (delq nil (mapcar - (lambda (b) - (string-match "\*Org Src" (buffer-name b))) - (buffer-list)))) - (cancel-timer org-edit-src-code-timer) - (setq org-edit-src-code-timer))))))))) - t))) - -(defun org-edit-src-continue (e) - "Continue editing source blocks." ;; Fixme: be more accurate - (interactive "e") - (mouse-set-point e) - (let ((buf (get-char-property (point) 'edit-buffer))) - (if buf (org-src-switch-to-buffer buf 'continue) - (error "Something is wrong here")))) - -(defun org-src-switch-to-buffer (buffer context) - (case org-src-window-setup - ('current-window - (org-pop-to-buffer-same-window buffer)) - ('other-window - (switch-to-buffer-other-window buffer)) - ('other-frame - (case context - ('exit - (let ((frame (selected-frame))) - (switch-to-buffer-other-frame buffer) - (delete-frame frame))) - ('save - (kill-buffer (current-buffer)) - (org-pop-to-buffer-same-window buffer)) - (t - (switch-to-buffer-other-frame buffer)))) - ('reorganize-frame - (if (eq context 'edit) (delete-other-windows)) - (org-switch-to-buffer-other-window buffer) - (if (eq context 'exit) (delete-other-windows))) - ('switch-invisibly - (set-buffer buffer)) - (t - (message "Invalid value %s for org-src-window-setup" - (symbol-name org-src-window-setup)) - (org-pop-to-buffer-same-window buffer)))) - -(defun org-src-construct-edit-buffer-name (org-buffer-name lang) - "Construct the buffer name for a source editing buffer." - (concat "*Org Src " org-buffer-name "[ " lang " ]*")) - -(defun org-src-edit-buffer-p (&optional buffer) - "Test whether BUFFER (or the current buffer if BUFFER is nil) -is a source block editing buffer." - (let ((buffer (org-base-buffer (or buffer (current-buffer))))) - (and (buffer-name buffer) - (string-match "\\`*Org Src " (buffer-name buffer)) - (local-variable-p 'org-edit-src-beg-marker buffer) - (local-variable-p 'org-edit-src-end-marker buffer)))) - -(defun org-edit-src-find-buffer (beg end) - "Find a source editing buffer that is already editing the region BEG to END." - (catch 'exit - (mapc - (lambda (b) - (with-current-buffer b - (if (and (string-match "\\`*Org Src " (buffer-name)) - (local-variable-p 'org-edit-src-beg-marker (current-buffer)) - (local-variable-p 'org-edit-src-end-marker (current-buffer)) - (equal beg org-edit-src-beg-marker) - (equal end org-edit-src-end-marker)) - (throw 'exit (current-buffer))))) - (buffer-list)) - nil)) - -(defun org-edit-fixed-width-region () - "Edit the fixed-width ascii drawing at point. -This must be a region where each line starts with a colon followed by -a space character. -An new buffer is created and the fixed-width region is copied into it, -and the buffer is switched into `artist-mode' for editing. When done, -exit with \\[org-edit-src-exit]. The edited text will then replace -the fragment in the Org-mode buffer." - (interactive) - (let ((line (org-current-line)) - (col (current-column)) - (case-fold-search t) - (msg (substitute-command-keys - "Edit, then exit with C-c ' (C-c and single quote) -- C-c C-k to abort")) - (org-mode-p (derived-mode-p 'org-mode)) - (beg (make-marker)) - (end (make-marker)) - (preserve-indentation org-src-preserve-indentation) - block-nindent ovl beg1 end1 code begline buffer) - (beginning-of-line 1) - (if (looking-at "[ \t]*[^:\n \t]") - nil - (if (looking-at "[ \t]*\\(\n\\|\\'\\)") - (setq beg1 (point) end1 beg1) - (save-excursion - (if (re-search-backward "^[ \t]*[^: \t]" nil 'move) - (setq beg1 (point-at-bol 2)) - (setq beg1 (point)))) - (save-excursion - (if (re-search-forward "^[ \t]*[^: \t]" nil 'move) - (setq end1 (1- (match-beginning 0))) - (setq end1 (point)))) - (org-goto-line line)) - (setq beg (move-marker beg beg1) - end (move-marker end end1) - code (buffer-substring-no-properties beg end) - begline (save-excursion (goto-char beg) (org-current-line))) - (if (and (setq buffer (org-edit-src-find-buffer beg end)) - (y-or-n-p "Return to existing edit buffer ([n] will revert changes)? ")) - (org-pop-to-buffer-same-window buffer) - (when buffer - (with-current-buffer buffer - (if (boundp 'org-edit-src-overlay) - (delete-overlay org-edit-src-overlay))) - (kill-buffer buffer)) - (setq buffer (generate-new-buffer - (org-src-construct-edit-buffer-name - (buffer-name) "Fixed Width"))) - (setq ovl (make-overlay beg end)) - (overlay-put ovl 'face 'secondary-selection) - (overlay-put ovl 'edit-buffer buffer) - (overlay-put ovl 'help-echo "Click with mouse-1 to switch to buffer editing this segment") - (overlay-put ovl 'face 'secondary-selection) - (overlay-put ovl - 'keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] 'org-edit-src-continue) - map)) - (overlay-put ovl :read-only "Leave me alone") - (org-pop-to-buffer-same-window buffer) - (insert code) - (remove-text-properties (point-min) (point-max) - '(display nil invisible nil intangible nil)) - (setq block-nindent (or (org-do-remove-indentation) 0)) - (cond - ((eq org-edit-fixed-width-region-mode 'artist-mode) - (fundamental-mode) - (artist-mode 1)) - (t (funcall org-edit-fixed-width-region-mode))) - (set (make-local-variable 'org-edit-src-force-single-line) nil) - (set (make-local-variable 'org-edit-src-from-org-mode) org-mode-p) - (set (make-local-variable 'org-edit-src-picture) t) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*: ?" nil t) - (replace-match "")) - (org-goto-line (1+ (- line begline))) - (org-move-to-column (max 0 (- col block-nindent 2))) - (org-set-local 'org-edit-src-beg-marker beg) - (org-set-local 'org-edit-src-end-marker end) - (org-set-local 'org-edit-src-overlay ovl) - (org-set-local 'org-edit-src-block-indentation block-nindent) - (org-set-local 'org-edit-src-content-indentation 0) - (org-set-local 'org-src-preserve-indentation nil) - (org-src-mode) - (set-buffer-modified-p nil) - (and org-edit-src-persistent-message - (org-set-local 'header-line-format msg))) - (message "%s" msg) - t))) - -(defun org-edit-src-find-region-and-lang () - "Find the region and language for a local edit. -Return a list with beginning and end of the region, a string representing -the language, a switch telling if the content should be in a single line." - (let ((re-list - (append - org-edit-src-region-extra - '( - ("<src\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</src>" lang) - ("<literal\\>[^<]*>[ \t]*\n?" "\n?[ \t]*</literal>" style) - ("<example>[ \t]*\n?" "\n?[ \t]*</example>" "fundamental") - ("<lisp>[ \t]*\n?" "\n?[ \t]*</lisp>" "emacs-lisp") - ("<perl>[ \t]*\n?" "\n?[ \t]*</perl>" "perl") - ("<python>[ \t]*\n?" "\n?[ \t]*</python>" "python") - ("<ruby>[ \t]*\n?" "\n?[ \t]*</ruby>" "ruby") - ("^[ \t]*#\\+begin_src\\( \\([^ \t\n]+\\)\\)?.*\n" "\n[ \t]*#\\+end_src" 2) - ("^[ \t]*#\\+begin_example.*\n" "\n[ \t]*#\\+end_example" "fundamental") - ("^[ \t]*#\\+html:" "\n" "html" single-line) - ("^[ \t]*#\\+begin_html.*\n" "\n[ \t]*#\\+end_html" "html") - ("^[ \t]*#\\+latex:" "\n" "latex" single-line) - ("^[ \t]*#\\+begin_latex.*\n" "\n[ \t]*#\\+end_latex" "latex") - ("^[ \t]*#\\+ascii:" "\n" "fundamental" single-line) - ("^[ \t]*#\\+begin_ascii.*\n" "\n[ \t]*#\\+end_ascii" "fundamental") - ("^[ \t]*#\\+macro:[ \t]+\\S-+\\( \\|$\\)" - "\n" "fundamental" macro-definition) - ))) - (pos (point)) - re1 re2 single beg end lang lfmt match-re1 ind entry) - (catch 'exit - (when (org-at-table.el-p) - (re-search-backward "^[\t]*[^ \t|\\+]" nil t) - (setq beg (1+ (point-at-eol))) - (goto-char beg) - (or (re-search-forward "^[\t]*[^ \t|\\+]" nil t) - (progn (goto-char (point-max)) (newline))) - (setq end (1- (point-at-bol))) - (throw 'exit (list beg end 'table.el nil nil 0))) - (while (setq entry (pop re-list)) - (setq re1 (car entry) re2 (nth 1 entry) lang (nth 2 entry) - single (nth 3 entry)) - (save-excursion - (if (or (looking-at re1) - (re-search-backward re1 nil t)) - (progn - (setq match-re1 (match-string 0)) - (setq beg (match-end 0) - lang (org-edit-src-get-lang lang) - lfmt (org-edit-src-get-label-format match-re1) - ind (org-edit-src-get-indentation (match-beginning 0))) - (if (and (re-search-forward re2 nil t) - (>= (match-end 0) pos)) - (throw 'exit (list beg (match-beginning 0) - lang single lfmt ind)))) - (if (or (looking-at re2) - (re-search-forward re2 nil t)) - (progn - (setq end (match-beginning 0)) - (if (and (re-search-backward re1 nil t) - (<= (match-beginning 0) pos)) - (progn - (setq lfmt (org-edit-src-get-label-format - (match-string 0)) - ind (org-edit-src-get-indentation - (match-beginning 0))) - (throw 'exit - (list (match-end 0) end - (org-edit-src-get-lang lang) - single lfmt ind)))))))))))) - -(defun org-edit-src-get-lang (lang) - "Extract the src language." - (let ((m (match-string 0))) - (cond - ((stringp lang) lang) - ((integerp lang) (match-string lang)) - ((and (eq lang 'lang) - (string-match "\\<lang=\"\\([^ \t\n\"]+\\)\"" m)) - (match-string 1 m)) - ((and (eq lang 'style) - (string-match "\\<style=\"\\([^ \t\n\"]+\\)\"" m)) - (match-string 1 m)) - (t "fundamental")))) - -(defun org-edit-src-get-label-format (s) - "Extract the label format." - (save-match-data - (if (string-match "-l[ \t]+\\\\?\"\\([^\t\r\n\"]+\\)\\\\?\"" s) - (match-string 1 s)))) - -(defun org-edit-src-get-indentation (pos) - "Count leading whitespace characters on line." - (save-match-data - (goto-char pos) - (org-get-indentation))) - -(defun org-escape-code-in-region (beg end) - "Escape lines between BEG and END. -Escaping happens when a line starts with \"*\", \"#+\", \",*\" or -\",#+\" by appending a comma to it." - (interactive "r") - (save-excursion - (goto-char beg) - (while (re-search-forward "^[ \t]*,?\\(\\*\\|#\\+\\)" end t) - (replace-match ",\\1" nil nil nil 1)))) - -(defun org-escape-code-in-string (s) - "Escape lines in string S. -Escaping happens when a line starts with \"*\", \"#+\", \",*\" or -\",#+\" by appending a comma to it." - (replace-regexp-in-string "^[ \t]*,?\\(\\*\\|#\\+\\)" ",\\1" s nil nil 1)) - -(defun org-unescape-code-in-region (beg end) - "Un-escape lines between BEG and END. -Un-escaping happens by removing the first comma on lines starting -with \",*\", \",#+\", \",,*\" and \",,#+\"." - (interactive "r") - (save-excursion - (goto-char beg) - (while (re-search-forward "^[ \t]*,?\\(,\\)\\(?:\\*\\|#\\+\\)" end t) - (replace-match "" nil nil nil 1)))) - -(defun org-unescape-code-in-string (s) - "Un-escape lines in string S. -Un-escaping happens by removing the first comma on lines starting -with \",*\", \",#+\", \",,*\" and \",,#+\"." - (replace-regexp-in-string - "^[ \t]*,?\\(,\\)\\(?:\\*\\|#\\+\\)" "" s nil nil 1)) - -(defun org-edit-src-exit (&optional context) - "Exit special edit and protect problematic lines." - (interactive) - (unless (org-bound-and-true-p org-edit-src-from-org-mode) - (error "This is not a sub-editing buffer, something is wrong")) - (widen) - (let* ((fixed-width-p (string-match "Fixed Width" (buffer-name))) - (beg org-edit-src-beg-marker) - (end org-edit-src-end-marker) - (ovl org-edit-src-overlay) - (bufstr (buffer-string)) - (buffer (current-buffer)) - (single (org-bound-and-true-p org-edit-src-force-single-line)) - (macro (eq single 'macro-definition)) - (total-nindent (+ (or org-edit-src-block-indentation 0) - org-edit-src-content-indentation)) - (preserve-indentation org-src-preserve-indentation) - (allow-write-back-p (org-bound-and-true-p org-edit-src-allow-write-back-p)) - (delta 0) code line col indent) - (when allow-write-back-p - (unless preserve-indentation (untabify (point-min) (point-max))) - (if org-src-strip-leading-and-trailing-blank-lines - (save-excursion - (goto-char (point-min)) - (if (looking-at "[ \t\n]*\n") (replace-match "")) - (unless macro - (if (re-search-forward "\n[ \t\n]*\\'" nil t) (replace-match "")))))) - (setq line (if (org-bound-and-true-p org-edit-src-force-single-line) - 1 - (org-current-line)) - col (current-column)) - (when allow-write-back-p - (when single - (goto-char (point-min)) - (if (re-search-forward "\\s-+\\'" nil t) (replace-match "")) - (goto-char (point-min)) - (let ((cnt 0)) - (while (re-search-forward "\n" nil t) - (setq cnt (1+ cnt)) - (replace-match (if macro "\\n" " ") t t)) - (when (and macro (> cnt 0)) - (goto-char (point-max)) (insert "\\n"))) - (goto-char (point-min)) - (if (looking-at "\\s-*") (replace-match " "))) - (when (and (org-bound-and-true-p org-edit-src-from-org-mode) - (not fixed-width-p)) - (org-escape-code-in-region (point-min) (point-max)) - (setq delta (+ delta - (save-excursion - (org-goto-line line) - (if (looking-at "[ \t]*\\(,,\\)?\\(\\*\\|#+\\)") 1 - 0))))) - (when (org-bound-and-true-p org-edit-src-picture) - (setq preserve-indentation nil) - (untabify (point-min) (point-max)) - (goto-char (point-min)) - (while (re-search-forward "^" nil t) - (replace-match ": "))) - (unless (or single preserve-indentation (= total-nindent 0)) - (setq indent (make-string total-nindent ?\ )) - (goto-char (point-min)) - (while (re-search-forward "^" nil t) - (replace-match indent))) - (if (org-bound-and-true-p org-edit-src-picture) - (setq total-nindent (+ total-nindent 2))) - (setq code (buffer-string)) - (when (eq context 'save) - (erase-buffer) - (insert bufstr)) - (set-buffer-modified-p nil)) - (org-src-switch-to-buffer (marker-buffer beg) (or context 'exit)) - (if (eq context 'save) (save-buffer) - (with-current-buffer buffer - (set-buffer-modified-p nil)) - (kill-buffer buffer)) - (goto-char beg) - (when allow-write-back-p - (let ((buffer-undo-list t)) - (delete-region beg (max beg end)) - (unless (string-match "\\`[ \t]*\\'" code) - (insert code)) - ;; Make sure the overlay stays in place - (when (eq context 'save) (move-overlay ovl beg (point))) - (goto-char beg) - (if single (just-one-space)))) - (if (memq t (mapcar (lambda (overlay) - (eq (overlay-get overlay 'invisible) - 'org-hide-block)) - (overlays-at (point)))) - ;; Block is hidden; put point at start of block - (beginning-of-line 0) - ;; Block is visible, put point where it was in the code buffer - (when allow-write-back-p - (org-goto-line (1- (+ (org-current-line) line))) - (org-move-to-column (if preserve-indentation col (+ col total-nindent delta))))) - (unless (eq context 'save) - (move-marker beg nil) - (move-marker end nil))) - (when org-edit-src-code-timer - (cancel-timer org-edit-src-code-timer) - (setq org-edit-src-code-timer nil)) - (unless (eq context 'save) - (when org-edit-src-saved-temp-window-config - (set-window-configuration org-edit-src-saved-temp-window-config) - (setq org-edit-src-saved-temp-window-config nil)))) - -(defun org-edit-src-abort () - "Abort editing of the src code and return to the Org buffer." - (interactive) - (let (org-edit-src-allow-write-back-p) - (org-edit-src-exit 'exit))) - -(defmacro org-src-in-org-buffer (&rest body) - `(let ((p (point)) (m (mark)) (ul buffer-undo-list) msg) - (save-window-excursion - (org-edit-src-exit 'save) - ,@body - (setq msg (current-message)) - (if (eq org-src-window-setup 'other-frame) - (let ((org-src-window-setup 'current-window)) - (org-edit-src-code 'save)) - (org-edit-src-code 'save))) - (setq buffer-undo-list ul) - (push-mark m 'nomessage) - (goto-char (min p (point-max))) - (message (or msg "")))) -(def-edebug-spec org-src-in-org-buffer (body)) - -(defun org-edit-src-save () - "Save parent buffer with current state source-code buffer." - (interactive) - (if (string-match "Fixed Width" (buffer-name)) - (user-error "Use C-c ' to save and exit, C-c C-k to abort editing") - (org-src-in-org-buffer (save-buffer)))) - -(declare-function org-babel-tangle "ob-tangle" (&optional arg target-file lang)) - -(defun org-src-tangle (arg) - "Tangle the parent buffer." - (interactive) - (org-src-in-org-buffer (org-babel-tangle arg))) - -(defun org-src-mode-configure-edit-buffer () - (when (org-bound-and-true-p org-edit-src-from-org-mode) - (org-add-hook 'kill-buffer-hook - #'(lambda () (delete-overlay org-edit-src-overlay)) nil 'local) - (if (org-bound-and-true-p org-edit-src-allow-write-back-p) - (progn - (setq buffer-offer-save t) - (setq buffer-file-name - (concat (buffer-file-name (marker-buffer org-edit-src-beg-marker)) - "[" (buffer-name) "]")) - (if (featurep 'xemacs) - (progn - (make-variable-buffer-local 'write-contents-hooks) ; needed only for 21.4 - (setq write-contents-hooks '(org-edit-src-save))) - (setq write-contents-functions '(org-edit-src-save)))) - (setq buffer-read-only t)))) - -(org-add-hook 'org-src-mode-hook 'org-src-mode-configure-edit-buffer) - - -(defun org-src-associate-babel-session (info) - "Associate edit buffer with comint session." - (interactive) - (let ((session (cdr (assoc :session (nth 2 info))))) - (and session (not (string= session "none")) - (org-babel-comint-buffer-livep session) - (let ((f (intern (format "org-babel-%s-associate-session" - (nth 0 info))))) - (and (fboundp f) (funcall f session)))))) - -(defun org-src-babel-configure-edit-buffer () - (when org-src-babel-info - (org-src-associate-babel-session org-src-babel-info))) - -(org-add-hook 'org-src-mode-hook 'org-src-babel-configure-edit-buffer) -(defmacro org-src-do-at-code-block (&rest body) - "Execute a command from an edit buffer in the Org-mode buffer." - `(let ((beg-marker org-edit-src-beg-marker)) - (if beg-marker - (with-current-buffer (marker-buffer beg-marker) - (goto-char (marker-position beg-marker)) - ,@body)))) -(def-edebug-spec org-src-do-at-code-block (body)) - -(defun org-src-do-key-sequence-at-code-block (&optional key) - "Execute key sequence at code block in the source Org buffer. -The command bound to KEY in the Org-babel key map is executed -remotely with point temporarily at the start of the code block in -the Org buffer. - -This command is not bound to a key by default, to avoid conflicts -with language major mode bindings. To bind it to C-c @ in all -language major modes, you could use - - (add-hook 'org-src-mode-hook - (lambda () (define-key org-src-mode-map \"\\C-c@\" - 'org-src-do-key-sequence-at-code-block))) - -In that case, for example, C-c @ t issued in code edit buffers -would tangle the current Org code block, C-c @ e would execute -the block and C-c @ h would display the other available -Org-babel commands." - (interactive "kOrg-babel key: ") - (if (equal key (kbd "C-g")) (keyboard-quit) - (org-edit-src-save) - (org-src-do-at-code-block - (call-interactively - (lookup-key org-babel-map key))))) - -(defcustom org-src-tab-acts-natively nil - "If non-nil, the effect of TAB in a code block is as if it were -issued in the language major mode buffer." - :type 'boolean - :version "24.1" - :group 'org-babel) - -(defun org-src-native-tab-command-maybe () - "Perform language-specific TAB action. -Alter code block according to what TAB does in the language major mode." - (and org-src-tab-acts-natively - (org-in-src-block-p) - (not (equal this-command 'org-shifttab)) - (let ((org-src-strip-leading-and-trailing-blank-lines nil)) - (org-babel-do-key-sequence-in-edit-buffer (kbd "TAB"))))) - -(add-hook 'org-tab-first-hook 'org-src-native-tab-command-maybe) - -(defun org-src-font-lock-fontify-block (lang start end) - "Fontify code block. -This function is called by emacs automatic fontification, as long -as `org-src-fontify-natively' is non-nil. For manual -fontification of code blocks see `org-src-fontify-block' and -`org-src-fontify-buffer'" - (let ((lang-mode (org-src-get-lang-mode lang))) - (if (fboundp lang-mode) - (let ((string (buffer-substring-no-properties start end)) - (modified (buffer-modified-p)) - (org-buffer (current-buffer)) pos next) - (remove-text-properties start end '(face nil)) - (with-current-buffer - (get-buffer-create - (concat " org-src-fontification:" (symbol-name lang-mode))) - (delete-region (point-min) (point-max)) - (insert string " ") ;; so there's a final property change - (unless (eq major-mode lang-mode) (funcall lang-mode)) - (font-lock-fontify-buffer) - (setq pos (point-min)) - (while (setq next (next-single-property-change pos 'face)) - (put-text-property - (+ start (1- pos)) (1- (+ start next)) 'face - (get-text-property pos 'face) org-buffer) - (setq pos next))) - (add-text-properties - start end - '(font-lock-fontified t fontified t font-lock-multiline t)) - (set-buffer-modified-p modified))))) - -(defun org-src-fontify-block () - "Fontify code block at point." - (interactive) - (save-excursion - (let ((org-src-fontify-natively t) - (info (org-edit-src-find-region-and-lang))) - (font-lock-fontify-region (nth 0 info) (nth 1 info))))) - -(defun org-src-fontify-buffer () - "Fontify all code blocks in the current buffer." - (interactive) - (org-babel-map-src-blocks nil - (org-src-fontify-block))) - -(defun org-src-get-lang-mode (lang) - "Return major mode that should be used for LANG. -LANG is a string, and the returned major mode is a symbol." - (intern - (concat - (let ((l (or (cdr (assoc lang org-src-lang-modes)) lang))) - (if (symbolp l) (symbol-name l) l)) - "-mode"))) - -(provide 'org-src) - -;;; org-src.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-table.el b/xemacs-packages/lisp/org-8.2.3c/org-table.el deleted file mode 100644 index c191345e..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-table.el +++ /dev/null @@ -1,5032 +0,0 @@ -;;; org-table.el --- The table editor for Org-mode - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;; This file contains the table editor and spreadsheet for Org-mode. - -;; Watch out: Here we are talking about two different kind of tables. -;; Most of the code is for the tables created with the Org-mode table editor. -;; Sometimes, we talk about tables created and edited with the table.el -;; Emacs package. We call the former org-type tables, and the latter -;; table.el-type tables. - -;;; Code: - -(eval-when-compile - (require 'cl)) -(require 'org) - -(declare-function org-export-string-as "ox" - (string backend &optional body-only ext-plist)) -(declare-function aa2u "ext:ascii-art-to-unicode" ()) -(defvar orgtbl-mode) ; defined below -(defvar orgtbl-mode-menu) ; defined when orgtbl mode get initialized -(defvar constants-unit-system) -(defvar org-table-follow-field-mode) - -(defvar orgtbl-after-send-table-hook nil - "Hook for functions attaching to `C-c C-c', if the table is sent. -This can be used to add additional functionality after the table is sent -to the receiver position, otherwise, if table is not sent, the functions -are not run.") - -(defvar org-table-TBLFM-begin-regexp "|\n[ \t]*#\\+TBLFM: ") - -(defcustom orgtbl-optimized (eq org-enable-table-editor 'optimized) - "Non-nil means use the optimized table editor version for `orgtbl-mode'. -In the optimized version, the table editor takes over all simple keys that -normally just insert a character. In tables, the characters are inserted -in a way to minimize disturbing the table structure (i.e. in overwrite mode -for empty fields). Outside tables, the correct binding of the keys is -restored. - -The default for this option is t if the optimized version is also used in -Org-mode. See the variable `org-enable-table-editor' for details. Changing -this variable requires a restart of Emacs to become effective." - :group 'org-table - :type 'boolean) - -(defcustom orgtbl-radio-table-templates - '((latex-mode "% BEGIN RECEIVE ORGTBL %n -% END RECEIVE ORGTBL %n -\\begin{comment} -#+ORGTBL: SEND %n orgtbl-to-latex :splice nil :skip 0 -| | | -\\end{comment}\n") - (texinfo-mode "@c BEGIN RECEIVE ORGTBL %n -@c END RECEIVE ORGTBL %n -@ignore -#+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0 -| | | -@end ignore\n") - (html-mode "<!-- BEGIN RECEIVE ORGTBL %n --> -<!-- END RECEIVE ORGTBL %n --> -<!-- -#+ORGTBL: SEND %n orgtbl-to-html :splice nil :skip 0 -| | | --->\n") - (org-mode "#+ BEGIN RECEIVE ORGTBL %n -#+ END RECEIVE ORGTBL %n - -#+ORGTBL: SEND %n orgtbl-to-orgtbl :splice nil :skip 0 -| | | -")) - "Templates for radio tables in different major modes. -Each template must define lines that will be treated as a comment and that -must contain the \"BEGIN RECEIVE ORGTBL %n\" and \"END RECEIVE ORGTBL\" -lines where \"%n\" will be replaced with the name of the table during -insertion of the tempate. The transformed table will later be inserted -between these lines. - -The template should also contain a minimal table in a multiline comment. -If multiline comments are not possible in the buffer language, -you can pack it into a string that will not be used when the code -is compiled or executed. Above the table will you need a line with -the fixed string \"#+ORGTBL: SEND\", followed by instruction on how to -convert the table into a data structure useful in the -language of the buffer. Check the manual for the section on -\"Translator functions\", and more generally check out -http://orgmode.org/manual/Tables-in-arbitrary-syntax.html#Tables-in-arbitrary-syntax - -All occurrences of %n in a template will be replaced with the name of the -table, obtained by prompting the user." - :group 'org-table - :type '(repeat - (list (symbol :tag "Major mode") - (string :tag "Format")))) - -(defgroup org-table-settings nil - "Settings for tables in Org-mode." - :tag "Org Table Settings" - :group 'org-table) - -(defcustom org-table-default-size "5x2" - "The default size for newly created tables, Columns x Rows." - :group 'org-table-settings - :type 'string) - -(defcustom org-table-number-regexp - "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%:]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$" - "Regular expression for recognizing numbers in table columns. -If a table column contains mostly numbers, it will be aligned to the -right. If not, it will be aligned to the left. - -The default value of this option is a regular expression which allows -anything which looks remotely like a number as used in scientific -context. For example, all of the following will be considered a -number: - 12 12.2 2.4e-08 2x10^12 4.034+-0.02 2.7(10) >3.5 - -Other options offered by the customize interface are more restrictive." - :group 'org-table-settings - :type '(choice - (const :tag "Positive Integers" - "^[0-9]+$") - (const :tag "Integers" - "^[-+]?[0-9]+$") - (const :tag "Floating Point Numbers" - "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.[0-9]*\\)$") - (const :tag "Floating Point Number or Integer" - "^[-+]?\\([0-9]*\\.[0-9]+\\|[0-9]+\\.?[0-9]*\\)$") - (const :tag "Exponential, Floating point, Integer" - "^[-+]?[0-9.]+\\([eEdD][-+0-9]+\\)?$") - (const :tag "Very General Number-Like, including hex and Calc radix" - "^\\([<>]?[-+^.0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") - (const :tag "Very General Number-Like, including hex and Calc radix, allows comma as decimal mark" - "^\\([<>]?[-+^.,0-9]*[0-9][-+^.0-9eEdDx()%]*\\|[<>]?[-+]?0[xX][0-9a-fA-F.]+\\|[<>]?[-+]?[0-9]+#[0-9a-zA-Z.]+\\|nan\\|[-+u]?inf\\)$") - (string :tag "Regexp:"))) - -(defcustom org-table-number-fraction 0.5 - "Fraction of numbers in a column required to make the column align right. -In a column all non-white fields are considered. If at least -this fraction of fields is matched by `org-table-number-regexp', -alignment to the right border applies." - :group 'org-table-settings - :type 'number) - -(defgroup org-table-editing nil - "Behavior of tables during editing in Org-mode." - :tag "Org Table Editing" - :group 'org-table) - -(defcustom org-table-automatic-realign t - "Non-nil means automatically re-align table when pressing TAB or RETURN. -When nil, aligning is only done with \\[org-table-align], or after column -removal/insertion." - :group 'org-table-editing - :type 'boolean) - -(defcustom org-table-auto-blank-field t - "Non-nil means automatically blank table field when starting to type into it. -This only happens when typing immediately after a field motion -command (TAB, S-TAB or RET). -Only relevant when `org-enable-table-editor' is equal to `optimized'." - :group 'org-table-editing - :type 'boolean) - -(defcustom org-table-exit-follow-field-mode-when-leaving-table t - "Non-nil means automatically exit the follow mode. -When nil, the follow mode will stay on and be active in any table -the cursor enters. Since the table follow filed mode messes with the -window configuration, it is not recommended to set this variable to nil, -except maybe locally in a special file that has mostly tables with long -fields." - :group 'org-table - :version "24.1" - :type 'boolean) - -(defcustom org-table-fix-formulas-confirm nil - "Whether the user should confirm when Org fixes formulas." - :group 'org-table-editing - :version "24.1" - :type '(choice - (const :tag "with yes-or-no" yes-or-no-p) - (const :tag "with y-or-n" y-or-n-p) - (const :tag "no confirmation" nil))) -(put 'org-table-fix-formulas-confirm - 'safe-local-variable - #'(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) - -(defcustom org-table-tab-jumps-over-hlines t - "Non-nil means tab in the last column of a table with jump over a hline. -If a horizontal separator line is following the current line, -`org-table-next-field' can either create a new row before that line, or jump -over the line. When this option is nil, a new line will be created before -this line." - :group 'org-table-editing - :type 'boolean) - -(defgroup org-table-calculation nil - "Options concerning tables in Org-mode." - :tag "Org Table Calculation" - :group 'org-table) - -(defcustom org-table-use-standard-references 'from - "Should org-mode work with table references like B3 instead of @3$2? -Possible values are: -nil never use them -from accept as input, do not present for editing -t accept as input and present for editing" - :group 'org-table-calculation - :type '(choice - (const :tag "Never, don't even check user input for them" nil) - (const :tag "Always, both as user input, and when editing" t) - (const :tag "Convert user input, don't offer during editing" from))) - -(defcustom org-table-copy-increment t - "Non-nil means increment when copying current field with \\[org-table-copy-down]." - :group 'org-table-calculation - :type 'boolean) - -(defcustom org-calc-default-modes - '(calc-internal-prec 12 - calc-float-format (float 8) - calc-angle-mode deg - calc-prefer-frac nil - calc-symbolic-mode nil - calc-date-format (YYYY "-" MM "-" DD " " Www (" " hh ":" mm)) - calc-display-working-message t - ) - "List with Calc mode settings for use in `calc-eval' for table formulas. -The list must contain alternating symbols (Calc modes variables and values). -Don't remove any of the default settings, just change the values. Org-mode -relies on the variables to be present in the list." - :group 'org-table-calculation - :type 'plist) - -(defcustom org-table-duration-custom-format 'hours - "Format for the output of calc computations like $1+$2;t. -The default value is 'hours, and will output the results as a -number of hours. Other allowed values are 'seconds, 'minutes and -'days, and the output will be a fraction of seconds, minutes or -days." - :group 'org-table-calculation - :version "24.1" - :type '(choice (symbol :tag "Seconds" 'seconds) - (symbol :tag "Minutes" 'minutes) - (symbol :tag "Hours " 'hours) - (symbol :tag "Days " 'days))) - -(defcustom org-table-formula-field-format "%s" - "Format for fields which contain the result of a formula. -For example, using \"~%s~\" will display the result within tilde -characters. Beware that modifying the display can prevent the -field from being used in another formula." - :group 'org-table-settings - :version "24.1" - :type 'string) - -(defcustom org-table-formula-evaluate-inline t - "Non-nil means TAB and RET evaluate a formula in current table field. -If the current field starts with an equal sign, it is assumed to be a formula -which should be evaluated as described in the manual and in the documentation -string of the command `org-table-eval-formula'. This feature requires the -Emacs calc package. -When this variable is nil, formula calculation is only available through -the command \\[org-table-eval-formula]." - :group 'org-table-calculation - :type 'boolean) - -(defcustom org-table-formula-use-constants t - "Non-nil means interpret constants in formulas in tables. -A constant looks like `$c' or `$Grav' and will be replaced before evaluation -by the value given in `org-table-formula-constants', or by a value obtained -from the `constants.el' package." - :group 'org-table-calculation - :type 'boolean) - -(defcustom org-table-formula-constants nil - "Alist with constant names and values, for use in table formulas. -The car of each element is a name of a constant, without the `$' before it. -The cdr is the value as a string. For example, if you'd like to use the -speed of light in a formula, you would configure - - (setq org-table-formula-constants '((\"c\" . \"299792458.\"))) - -and then use it in an equation like `$1*$c'. - -Constants can also be defined on a per-file basis using a line like - -#+CONSTANTS: c=299792458. pi=3.14 eps=2.4e-6" - :group 'org-table-calculation - :type '(repeat - (cons (string :tag "name") - (string :tag "value")))) - -(defcustom org-table-allow-automatic-line-recalculation t - "Non-nil means lines marked with |#| or |*| will be recomputed automatically. -Automatically means when TAB or RET or C-c C-c are pressed in the line." - :group 'org-table-calculation - :type 'boolean) - -(defcustom org-table-error-on-row-ref-crossing-hline t - "OBSOLETE VARIABLE, please see `org-table-relative-ref-may-cross-hline'." - :group 'org-table - :type 'boolean) - -(defcustom org-table-relative-ref-may-cross-hline t - "Non-nil means relative formula references may cross hlines. -Here are the allowed values: - -nil Relative references may not cross hlines. They will reference the - field next to the hline instead. Coming from below, the reference - will be to the field below the hline. Coming from above, it will be - to the field above. -t Relative references may cross hlines. -error An attempt to cross a hline will throw an error. - -It is probably good to never set this variable to nil, for the sake of -portability of tables." - :group 'org-table-calculation - :type '(choice - (const :tag "Allow to cross" t) - (const :tag "Stick to hline" nil) - (const :tag "Error on attempt to cross" error))) - -(defgroup org-table-import-export nil - "Options concerning table import and export in Org-mode." - :tag "Org Table Import Export" - :group 'org-table) - -(defcustom org-table-export-default-format "orgtbl-to-tsv" - "Default export parameters for `org-table-export'. -These can be overridden for a specific table by setting the -TABLE_EXPORT_FORMAT property. See the manual section on orgtbl -radio tables for the different export transformations and -available parameters." - :group 'org-table-import-export - :type 'string) - -(defconst org-table-auto-recalculate-regexp "^[ \t]*| *# *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") -(defconst org-table-recalculate-regexp "^[ \t]*| *[#*] *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") -(defconst org-table-calculate-mark-regexp "^[ \t]*| *[!$^_#*] *\\(|\\|$\\)" - "Detects a table line marked for automatic recalculation.") -(defconst org-table-border-regexp "^[ \t]*[^| \t]" - "Searching from within a table (any type) this finds the first line outside the table.") -(defvar org-table-last-highlighted-reference nil) -(defvar org-table-formula-history nil) - -(defvar org-table-column-names nil - "Alist with column names, derived from the `!' line.") -(defvar org-table-column-name-regexp nil - "Regular expression matching the current column names.") -(defvar org-table-local-parameters nil - "Alist with parameter names, derived from the `$' line.") -(defvar org-table-named-field-locations nil - "Alist with locations of named fields.") - -(defvar org-table-current-line-types nil - "Table row types, non-nil only for the duration of a command.") -(defvar org-table-current-begin-line nil - "Table begin line, non-nil only for the duration of a command.") -(defvar org-table-current-begin-pos nil - "Table begin position, non-nil only for the duration of a command.") -(defvar org-table-current-ncol nil - "Number of columns in table, non-nil only for the duration of a command.") -(defvar org-table-dlines nil - "Vector of data line line numbers in the current table.") -(defvar org-table-hlines nil - "Vector of hline line numbers in the current table.") - -(defconst org-table-range-regexp - "@\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\(\\.\\.@?\\([-+]?I*[-+]?[0-9]*\\)?\\(\\$[-+]?[0-9]+\\)?\\)?" - ;; 1 2 3 4 5 - "Regular expression for matching ranges in formulas.") - -(defconst org-table-range-regexp2 - (concat - "\\(" "@[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)" - "\\.\\." - "\\(" "@?[-0-9I$&]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\|" "\\$[a-zA-Z0-9]+" "\\)") - "Match a range for reference display.") - -(defun org-table-colgroup-line-p (line) - "Is this a table line colgroup information?" - (save-match-data - (and (string-match "[<>]\\|&[lg]t;" line) - (string-match "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lgt&;]+\\)\\'" - line) - (not (delq - nil - (mapcar - (lambda (s) - (not (member s '("" "<" ">" "<>" "<" ">" "<>")))) - (org-split-string (match-string 1 line) "[ \t]*|[ \t]*"))))))) - -(defun org-table-cookie-line-p (line) - "Is this a table line with only alignment/width cookies?" - (save-match-data - (and (string-match "[<>]\\|&[lg]t;" line) - (or (string-match - "\\`[ \t]*|[ \t]*/[ \t]*\\(|[ \t<>0-9|lrcgt&;]+\\)\\'" line) - (string-match "\\(\\`[ \t<>lrc0-9|gt&;]+\\'\\)" line)) - (not (delq nil (mapcar - (lambda (s) - (not (or (equal s "") - (string-match - "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" s) - (string-match - "\\`<\\([lrc]?[0-9]+\\|[lrc]\\)>\\'" - s)))) - (org-split-string (match-string 1 line) - "[ \t]*|[ \t]*"))))))) - -(defvar org-table-clean-did-remove-column nil) ; dynamically scoped -(defun org-table-clean-before-export (lines &optional maybe-quoted) - "Check if the table has a marking column. -If yes remove the column and the special lines." - (let ((special (if maybe-quoted - "^[ \t]*| *\\\\?[\#!$*_^/ ] *|" - "^[ \t]*| *[\#!$*_^/ ] *|")) - (ignore (if maybe-quoted - "^[ \t]*| *\\\\?[!$_^/] *|" - "^[ \t]*| *[!$_^/] *|"))) - (setq org-table-clean-did-remove-column - (not (memq nil - (mapcar - (lambda (line) - (or (string-match org-table-hline-regexp line) - (string-match special line))) - lines)))) - (delq nil - (mapcar - (lambda (line) - (cond - ((or (org-table-colgroup-line-p line) ;; colgroup info - (org-table-cookie-line-p line) ;; formatting cookies - (and org-table-clean-did-remove-column - (string-match ignore line))) ;; non-exportable data - nil) - ((and org-table-clean-did-remove-column - (or (string-match "^\\([ \t]*\\)|-+\\+" line) - (string-match "^\\([ \t]*\\)|[^|]*|" line))) - ;; remove the first column - (replace-match "\\1|" t nil line)) - (t line))) - lines)))) - -(defconst org-table-translate-regexp - (concat "\\(" "@[-0-9I$]+" "\\|" "[a-zA-Z]\\{1,2\\}\\([0-9]+\\|&\\)" "\\)") - "Match a reference that needs translation, for reference display.") - -;;;###autoload -(defun org-table-create-with-table.el () - "Use the table.el package to insert a new table. -If there is already a table at point, convert between Org-mode tables -and table.el tables." - (interactive) - (require 'table) - (cond - ((org-at-table.el-p) - (if (y-or-n-p "Convert table to Org-mode table? ") - (org-table-convert))) - ((org-at-table-p) - (when (y-or-n-p "Convert table to table.el table? ") - (org-table-align) - (org-table-convert))) - (t (call-interactively 'table-insert)))) - -;;;###autoload -(defun org-table-create-or-convert-from-region (arg) - "Convert region to table, or create an empty table. -If there is an active region, convert it to a table, using the function -`org-table-convert-region'. See the documentation of that function -to learn how the prefix argument is interpreted to determine the field -separator. -If there is no such region, create an empty table with `org-table-create'." - (interactive "P") - (if (org-region-active-p) - (org-table-convert-region (region-beginning) (region-end) arg) - (org-table-create arg))) - -;;;###autoload -(defun org-table-create (&optional size) - "Query for a size and insert a table skeleton. -SIZE is a string Columns x Rows like for example \"3x2\"." - (interactive "P") - (unless size - (setq size (read-string - (concat "Table size Columns x Rows [e.g. " - org-table-default-size "]: ") - "" nil org-table-default-size))) - - (let* ((pos (point)) - (indent (make-string (current-column) ?\ )) - (split (org-split-string size " *x *")) - (rows (string-to-number (nth 1 split))) - (columns (string-to-number (car split))) - (line (concat (apply 'concat indent "|" (make-list columns " |")) - "\n"))) - (if (string-match "^[ \t]*$" (buffer-substring-no-properties - (point-at-bol) (point))) - (beginning-of-line 1) - (newline)) - ;; (mapcar (lambda (x) (insert line)) (make-list rows t)) - (dotimes (i rows) (insert line)) - (goto-char pos) - (if (> rows 1) - ;; Insert a hline after the first row. - (progn - (end-of-line 1) - (insert "\n|-") - (goto-char pos))) - (org-table-align))) - -;;;###autoload -(defun org-table-convert-region (beg0 end0 &optional separator) - "Convert region to a table. -The region goes from BEG0 to END0, but these borders will be moved -slightly, to make sure a beginning of line in the first line is included. - -SEPARATOR specifies the field separator in the lines. It can have the -following values: - -'(4) Use the comma as a field separator -'(16) Use a TAB as field separator -integer When a number, use that many spaces as field separator -nil When nil, the command tries to be smart and figure out the - separator in the following way: - - when each line contains a TAB, assume TAB-separated material - - when each line contains a comma, assume CSV material - - else, assume one or more SPACE characters as separator." - (interactive "r\nP") - (let* ((beg (min beg0 end0)) - (end (max beg0 end0)) - re) - (goto-char beg) - (beginning-of-line 1) - (setq beg (point-marker)) - (goto-char end) - (if (bolp) (backward-char 1) (end-of-line 1)) - (setq end (point-marker)) - ;; Get the right field separator - (unless separator - (goto-char beg) - (setq separator - (cond - ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) - ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) - (t 1)))) - (goto-char beg) - (if (equal separator '(4)) - (while (< (point) end) - ;; parse the csv stuff - (cond - ((looking-at "^") (insert "| ")) - ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) - ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") - (replace-match "\\1") - (if (looking-at "\"") (insert "\""))) - ((looking-at "[^,\n]+") (goto-char (match-end 0))) - ((looking-at "[ \t]*,") (replace-match " | ")) - (t (beginning-of-line 2)))) - (setq re (cond - ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") - ((equal separator '(16)) "^\\|\t") - ((integerp separator) - (if (< separator 1) - (user-error "Number of spaces in separator must be >= 1") - (format "^ *\\| *\t *\\| \\{%d,\\}" separator))) - (t (error "This should not happen")))) - (while (re-search-forward re end t) - (replace-match "| " t t))) - (goto-char beg) - (org-table-align))) - -;;;###autoload -(defun org-table-import (file arg) - "Import FILE as a table. -The file is assumed to be tab-separated. Such files can be produced by most -spreadsheet and database applications. If no tabs (at least one per line) -are found, lines will be split on whitespace into fields." - (interactive "f\nP") - (or (bolp) (newline)) - (let ((beg (point)) - (pm (point-max))) - (insert-file-contents file) - (org-table-convert-region beg (+ (point) (- (point-max) pm)) arg))) - - -(defvar org-table-last-alignment) -(defvar org-table-last-column-widths) -;;;###autoload -(defun org-table-export (&optional file format) - "Export table to a file, with configurable format. -Such a file can be imported into usual spreadsheet programs. - -FILE can be the output file name. If not given, it will be taken -from a TABLE_EXPORT_FILE property in the current entry or higher -up in the hierarchy, or the user will be prompted for a file -name. FORMAT can be an export format, of the same kind as it -used when `orgtbl-mode' sends a table in a different format. - -The command suggests a format depending on TABLE_EXPORT_FORMAT, -whether it is set locally or up in the hierarchy, then on the -extension of the given file name, and finally on the variable -`org-table-export-default-format'." - (interactive) - (unless (org-at-table-p) (user-error "No table at point")) - (org-table-align) ;; make sure we have everything we need - (let* ((beg (org-table-begin)) - (end (org-table-end)) - (txt (buffer-substring-no-properties beg end)) - (file (or file (org-entry-get beg "TABLE_EXPORT_FILE" t))) - (formats '("orgtbl-to-tsv" "orgtbl-to-csv" - "orgtbl-to-latex" "orgtbl-to-html" - "orgtbl-to-generic" "orgtbl-to-texinfo" - "orgtbl-to-orgtbl")) - (format (or format - (org-entry-get beg "TABLE_EXPORT_FORMAT" t))) - buf deffmt-readable fileext) - (unless file - (setq file (read-file-name "Export table to: ")) - (unless (or (not (file-exists-p file)) - (y-or-n-p (format "Overwrite file %s? " file))) - (user-error "File not written"))) - (if (file-directory-p file) - (user-error "This is a directory path, not a file")) - (if (and (buffer-file-name) - (equal (file-truename file) - (file-truename (buffer-file-name)))) - (user-error "Please specify a file name that is different from current")) - (setq fileext (concat (file-name-extension file) "$")) - (unless format - (setq deffmt-readable - (or (car (delq nil (mapcar (lambda(f) (if (string-match fileext f) f)) formats))) - org-table-export-default-format)) - (while (string-match "\t" deffmt-readable) - (setq deffmt-readable (replace-match "\\t" t t deffmt-readable))) - (while (string-match "\n" deffmt-readable) - (setq deffmt-readable (replace-match "\\n" t t deffmt-readable))) - (setq format (org-completing-read "Format: " formats nil nil deffmt-readable))) - (if (string-match "\\([^ \t\r\n]+\\)\\( +.*\\)?" format) - (let* ((transform (intern (match-string 1 format))) - (params (if (match-end 2) - (read (concat "(" (match-string 2 format) ")")))) - (skip (plist-get params :skip)) - (skipcols (plist-get params :skipcols)) - (lines (nthcdr (or skip 0) (org-split-string txt "[ \t]*\n[ \t]*"))) - (lines (org-table-clean-before-export lines)) - (i0 (if org-table-clean-did-remove-column 2 1)) - (table (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-remove-by-index - (org-split-string (org-trim x) "\\s-*|\\s-*") - skipcols i0))) - lines)) - (fun (if (= i0 2) 'cdr 'identity)) - (org-table-last-alignment - (org-remove-by-index (funcall fun org-table-last-alignment) - skipcols i0)) - (org-table-last-column-widths - (org-remove-by-index (funcall fun org-table-last-column-widths) - skipcols i0))) - - (unless (fboundp transform) - (user-error "No such transformation function %s" transform)) - (setq txt (funcall transform table params)) - - (with-current-buffer (find-file-noselect file) - (setq buf (current-buffer)) - (erase-buffer) - (fundamental-mode) - (insert txt "\n") - (save-buffer)) - (kill-buffer buf) - (message "Export done.")) - (user-error "TABLE_EXPORT_FORMAT invalid")))) - -(defvar org-table-aligned-begin-marker (make-marker) - "Marker at the beginning of the table last aligned. -Used to check if cursor still is in that table, to minimize realignment.") -(defvar org-table-aligned-end-marker (make-marker) - "Marker at the end of the table last aligned. -Used to check if cursor still is in that table, to minimize realignment.") -(defvar org-table-last-alignment nil - "List of flags for flushright alignment, from the last re-alignment. -This is being used to correctly align a single field after TAB or RET.") -(defvar org-table-last-column-widths nil - "List of max width of fields in each column. -This is being used to correctly align a single field after TAB or RET.") -(defvar org-table-formula-debug nil - "Non-nil means debug table formulas. -When nil, simply write \"#ERROR\" in corrupted fields.") -(make-variable-buffer-local 'org-table-formula-debug) -(defvar org-table-overlay-coordinates nil - "Overlay coordinates after each align of a table.") -(make-variable-buffer-local 'org-table-overlay-coordinates) - -(defvar org-last-recalc-line nil) -(defvar org-table-do-narrow t) ; for dynamic scoping -(defconst org-narrow-column-arrow "=>" - "Used as display property in narrowed table columns.") - -;;;###autoload -(defun org-table-align () - "Align the table at point by aligning all vertical bars." - (interactive) - (let* ( - ;; Limits of table - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos (org-table-current-column)) - (winstart (window-start)) - (winstartline (org-current-line (min winstart (1- (point-max))))) - lines (new "") lengths l typenums ty fields maxfields i - column - (indent "") cnt frac - rfmt hfmt - (spaces '(1 . 1)) - (sp1 (car spaces)) - (sp2 (cdr spaces)) - (rfmt1 (concat - (make-string sp2 ?\ ) "%%%s%ds" (make-string sp1 ?\ ) "|")) - (hfmt1 (concat - (make-string sp2 ?-) "%s" (make-string sp1 ?-) "+")) - emptystrings links dates emph raise narrow - falign falign1 fmax f1 len c e space) - (untabify beg end) - (remove-text-properties beg end '(org-cwidth t org-dwidth t display t)) - ;; Check if we have links or dates - (goto-char beg) - (setq links (re-search-forward org-bracket-link-regexp end t)) - (goto-char beg) - (setq emph (and org-hide-emphasis-markers - (re-search-forward org-emph-re end t))) - (goto-char beg) - (setq raise (and org-use-sub-superscripts - (re-search-forward org-match-substring-regexp end t))) - (goto-char beg) - (setq dates (and org-display-custom-times - (re-search-forward org-ts-regexp-both end t))) - ;; Make sure the link properties are right - (when links (goto-char beg) (while (org-activate-bracket-links end))) - ;; Make sure the date properties are right - (when dates (goto-char beg) (while (org-activate-dates end))) - (when emph (goto-char beg) (while (org-do-emphasis-faces end))) - (when raise (goto-char beg) (while (org-raise-scripts end))) - - ;; Check if we are narrowing any columns - (goto-char beg) - (setq narrow (and org-table-do-narrow - org-format-transports-properties-p - (re-search-forward "<[lrc]?[0-9]+>" end t))) - (goto-char beg) - (setq falign (re-search-forward "<[lrc][0-9]*>" end t)) - (goto-char beg) - ;; Get the rows - (setq lines (org-split-string - (buffer-substring beg end) "\n")) - ;; Store the indentation of the first line - (if (string-match "^ *" (car lines)) - (setq indent (make-string (- (match-end 0) (match-beginning 0)) ?\ ))) - ;; Mark the hlines by setting the corresponding element to nil - ;; At the same time, we remove trailing space. - (setq lines (mapcar (lambda (l) - (if (string-match "^ *|-" l) - nil - (if (string-match "[ \t]+$" l) - (substring l 0 (match-beginning 0)) - l))) - lines)) - ;; Get the data fields by splitting the lines. - (setq fields (mapcar - (lambda (l) - (org-split-string l " *| *")) - (delq nil (copy-sequence lines)))) - ;; How many fields in the longest line? - (condition-case nil - (setq maxfields (apply 'max (mapcar 'length fields))) - (error - (kill-region beg end) - (org-table-create org-table-default-size) - (user-error "Empty table - created default table"))) - ;; A list of empty strings to fill any short rows on output - (setq emptystrings (make-list maxfields "")) - ;; Check for special formatting. - (setq i -1) - (while (< (setq i (1+ i)) maxfields) ;; Loop over all columns - (setq column (mapcar (lambda (x) (or (nth i x) "")) fields)) - ;; Check if there is an explicit width specified - (setq fmax nil) - (when (or narrow falign) - (setq c column fmax nil falign1 nil) - (while c - (setq e (pop c)) - (when (and (stringp e) (string-match "^<\\([lrc]\\)?\\([0-9]+\\)?>$" e)) - (if (match-end 1) (setq falign1 (match-string 1 e))) - (if (and org-table-do-narrow (match-end 2)) - (setq fmax (string-to-number (match-string 2 e)) c nil)))) - ;; Find fields that are wider than fmax, and shorten them - (when fmax - (loop for xx in column do - (when (and (stringp xx) - (> (org-string-width xx) fmax)) - (org-add-props xx nil - 'help-echo - (concat "Clipped table field, use C-c ` to edit. Full value is:\n" (org-no-properties (copy-sequence xx)))) - (setq f1 (min fmax (or (string-match org-bracket-link-regexp xx) fmax))) - (unless (> f1 1) - (user-error "Cannot narrow field starting with wide link \"%s\"" - (match-string 0 xx))) - (add-text-properties f1 (length xx) (list 'org-cwidth t) xx) - (add-text-properties (- f1 2) f1 - (list 'display org-narrow-column-arrow) - xx))))) - ;; Get the maximum width for each column - (push (apply 'max (or fmax 1) 1 (mapcar 'org-string-width column)) - lengths) - ;; Get the fraction of numbers, to decide about alignment of the column - (if falign1 - (push (equal (downcase falign1) "r") typenums) - (setq cnt 0 frac 0.0) - (loop for x in column do - (if (equal x "") - nil - (setq frac ( / (+ (* frac cnt) - (if (string-match org-table-number-regexp x) 1 0)) - (setq cnt (1+ cnt)))))) - (push (>= frac org-table-number-fraction) typenums))) - (setq lengths (nreverse lengths) typenums (nreverse typenums)) - - ;; Store the alignment of this table, for later editing of single fields - (setq org-table-last-alignment typenums - org-table-last-column-widths lengths) - - ;; With invisible characters, `format' does not get the field width right - ;; So we need to make these fields wide by hand. - (when (or links emph raise) - (loop for i from 0 upto (1- maxfields) do - (setq len (nth i lengths)) - (loop for j from 0 upto (1- (length fields)) do - (setq c (nthcdr i (car (nthcdr j fields)))) - (if (and (stringp (car c)) - (or (text-property-any 0 (length (car c)) - 'invisible 'org-link (car c)) - (text-property-any 0 (length (car c)) - 'org-dwidth t (car c))) - (< (org-string-width (car c)) len)) - (progn - (setq space (make-string (- len (org-string-width (car c))) ?\ )) - (setcar c (if (nth i typenums) - (concat space (car c)) - (concat (car c) space)))))))) - - ;; Compute the formats needed for output of the table - (setq rfmt (concat indent "|") hfmt (concat indent "|")) - (while (setq l (pop lengths)) - (setq ty (if (pop typenums) "" "-")) ; number types flushright - (setq rfmt (concat rfmt (format rfmt1 ty l)) - hfmt (concat hfmt (format hfmt1 (make-string l ?-))))) - (setq rfmt (concat rfmt "\n") - hfmt (concat (substring hfmt 0 -1) "|\n")) - - (setq new (mapconcat - (lambda (l) - (if l (apply 'format rfmt - (append (pop fields) emptystrings)) - hfmt)) - lines "")) - (move-marker org-table-aligned-begin-marker (point)) - (insert new) - ;; Replace the old one - (delete-region (point) end) - (move-marker end nil) - (move-marker org-table-aligned-end-marker (point)) - (when (and orgtbl-mode (not (derived-mode-p 'org-mode))) - (goto-char org-table-aligned-begin-marker) - (while (org-hide-wide-columns org-table-aligned-end-marker))) - ;; Try to move to the old location - (org-goto-line winstartline) - (setq winstart (point-at-bol)) - (org-goto-line linepos) - (when (eq (window-buffer (selected-window)) (current-buffer)) - (set-window-start (selected-window) winstart 'noforce)) - (org-table-goto-column colpos) - (and org-table-overlay-coordinates (org-table-overlay-coordinates)) - (setq org-table-may-need-update nil) - )) - -;;;###autoload -(defun org-table-begin (&optional table-type) - "Find the beginning of the table and return its position. -With argument TABLE-TYPE, go to the beginning of a table.el-type table." - (save-excursion - (if (not (re-search-backward - (if table-type org-table-any-border-regexp - org-table-border-regexp) - nil t)) - (progn (goto-char (point-min)) (point)) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (point)))) - -;;;###autoload -(defun org-table-end (&optional table-type) - "Find the end of the table and return its position. -With argument TABLE-TYPE, go to the end of a table.el-type table." - (save-excursion - (if (not (re-search-forward - (if table-type org-table-any-border-regexp - org-table-border-regexp) - nil t)) - (goto-char (point-max)) - (goto-char (match-beginning 0))) - (point-marker))) - -;;;###autoload -(defun org-table-justify-field-maybe (&optional new) - "Justify the current field, text to left, number to right. -Optional argument NEW may specify text to replace the current field content." - (cond - ((and (not new) org-table-may-need-update)) ; Realignment will happen anyway - ((org-at-table-hline-p)) - ((and (not new) - (or (not (equal (marker-buffer org-table-aligned-begin-marker) - (current-buffer))) - (< (point) org-table-aligned-begin-marker) - (>= (point) org-table-aligned-end-marker))) - ;; This is not the same table, force a full re-align - (setq org-table-may-need-update t)) - (t ;; realign the current field, based on previous full realign - (let* ((pos (point)) s - (col (org-table-current-column)) - (num (if (> col 0) (nth (1- col) org-table-last-alignment))) - l f n o e) - (when (> col 0) - (skip-chars-backward "^|\n") - (if (looking-at " *\\([^|\n]*?\\) *\\(|\\|$\\)") - (progn - (setq s (match-string 1) - o (match-string 0) - l (max 1 (- (match-end 0) (match-beginning 0) 3)) - e (not (= (match-beginning 2) (match-end 2)))) - (setq f (format (if num " %%%ds %s" " %%-%ds %s") - l (if e "|" (setq org-table-may-need-update t) "")) - n (format f s)) - (if new - (if (<= (length new) l) ;; FIXME: length -> str-width? - (setq n (format f new)) - (setq n (concat new "|") org-table-may-need-update t))) - (if (equal (string-to-char n) ?-) (setq n (concat " " n))) - (or (equal n o) - (let (org-table-may-need-update) - (replace-match n t t)))) - (setq org-table-may-need-update t)) - (goto-char pos)))))) - -;;;###autoload -(defun org-table-next-field () - "Go to the next field in the current table, creating new lines as needed. -Before doing so, re-align the table if necessary." - (interactive) - (org-table-maybe-eval-formula) - (org-table-maybe-recalculate-line) - (if (and org-table-automatic-realign - org-table-may-need-update) - (org-table-align)) - (let ((end (org-table-end))) - (if (org-at-table-hline-p) - (end-of-line 1)) - (condition-case nil - (progn - (re-search-forward "|" end) - (if (looking-at "[ \t]*$") - (re-search-forward "|" end)) - (if (and (looking-at "-") - org-table-tab-jumps-over-hlines - (re-search-forward "^[ \t]*|\\([^-]\\)" end t)) - (goto-char (match-beginning 1))) - (if (looking-at "-") - (progn - (beginning-of-line 0) - (org-table-insert-row 'below)) - (if (looking-at " ") (forward-char 1)))) - (error - (org-table-insert-row 'below))))) - -;;;###autoload -(defun org-table-previous-field () - "Go to the previous field in the table. -Before doing so, re-align the table if necessary." - (interactive) - (org-table-justify-field-maybe) - (org-table-maybe-recalculate-line) - (if (and org-table-automatic-realign - org-table-may-need-update) - (org-table-align)) - (if (org-at-table-hline-p) - (end-of-line 1)) - (condition-case nil - (progn - (re-search-backward "|" (org-table-begin)) - (re-search-backward "|" (org-table-begin))) - (error (user-error "Cannot move to previous table field"))) - (while (looking-at "|\\(-\\|[ \t]*$\\)") - (re-search-backward "|" (org-table-begin))) - (if (looking-at "| ?") - (goto-char (match-end 0)))) - -(defun org-table-beginning-of-field (&optional n) - "Move to the end of the current table field. -If already at or after the end, move to the end of the next table field. -With numeric argument N, move N-1 fields forward first." - (interactive "p") - (let ((pos (point))) - (while (> n 1) - (setq n (1- n)) - (org-table-previous-field)) - (if (not (re-search-backward "|" (point-at-bol 0) t)) - (user-error "No more table fields before the current") - (goto-char (match-end 0)) - (and (looking-at " ") (forward-char 1))) - (if (>= (point) pos) (org-table-beginning-of-field 2)))) - -(defun org-table-end-of-field (&optional n) - "Move to the beginning of the current table field. -If already at or before the beginning, move to the beginning of the -previous field. -With numeric argument N, move N-1 fields backward first." - (interactive "p") - (let ((pos (point))) - (while (> n 1) - (setq n (1- n)) - (org-table-next-field)) - (when (re-search-forward "|" (point-at-eol 1) t) - (backward-char 1) - (skip-chars-backward " ") - (if (and (equal (char-before (point)) ?|) (looking-at " ")) - (forward-char 1))) - (if (<= (point) pos) (org-table-end-of-field 2)))) - -;;;###autoload -(defun org-table-next-row () - "Go to the next row (same column) in the current table. -Before doing so, re-align the table if necessary." - (interactive) - (org-table-maybe-eval-formula) - (org-table-maybe-recalculate-line) - (if (or (looking-at "[ \t]*$") - (save-excursion (skip-chars-backward " \t") (bolp))) - (newline) - (if (and org-table-automatic-realign - org-table-may-need-update) - (org-table-align)) - (let ((col (org-table-current-column))) - (beginning-of-line 2) - (if (or (not (org-at-table-p)) - (org-at-table-hline-p)) - (progn - (beginning-of-line 0) - (org-table-insert-row 'below))) - (org-table-goto-column col) - (skip-chars-backward "^|\n\r") - (if (looking-at " ") (forward-char 1))))) - -;;;###autoload -(defun org-table-copy-down (n) - "Copy a field down in the current column. -If the field at the cursor is empty, copy into it the content of -the nearest non-empty field above. With argument N, use the Nth -non-empty field. If the current field is not empty, it is copied -down to the next row, and the cursor is moved with it. -Therefore, repeating this command causes the column to be filled -row-by-row. -If the variable `org-table-copy-increment' is non-nil and the -field is an integer or a timestamp, it will be incremented while -copying. In the case of a timestamp, increment by one day." - (interactive "p") - (let* ((colpos (org-table-current-column)) - (col (current-column)) - (field (save-excursion (org-table-get-field))) - (non-empty (string-match "[^ \t]" field)) - (beg (org-table-begin)) - (orig-n n) - txt) - (org-table-check-inside-data-field) - (if non-empty - (progn - (setq txt (org-trim field)) - (org-table-next-row) - (org-table-blank-field)) - (save-excursion - (setq txt - (catch 'exit - (while (progn (beginning-of-line 1) - (re-search-backward org-table-dataline-regexp - beg t)) - (org-table-goto-column colpos t) - (if (and (looking-at - "|[ \t]*\\([^| \t][^|]*?\\)[ \t]*|") - (<= (setq n (1- n)) 0)) - (throw 'exit (match-string 1)))))))) - (if txt - (progn - (if (and org-table-copy-increment - (not (equal orig-n 0)) - (string-match "^[0-9]+$" txt) - (< (string-to-number txt) 100000000)) - (setq txt (format "%d" (+ (string-to-number txt) 1)))) - (insert txt) - (org-move-to-column col) - (if (and org-table-copy-increment (org-at-timestamp-p t)) - (org-timestamp-up-day) - (org-table-maybe-recalculate-line)) - (org-table-align) - (org-move-to-column col)) - (user-error "No non-empty field found")))) - -(defun org-table-check-inside-data-field (&optional noerror) - "Is point inside a table data field? -I.e. not on a hline or before the first or after the last column? -This actually throws an error, so it aborts the current command." - (if (or (not (org-at-table-p)) - (= (org-table-current-column) 0) - (org-at-table-hline-p) - (looking-at "[ \t]*$")) - (if noerror - nil - (user-error "Not in table data field")) - t)) - -(defvar org-table-clip nil - "Clipboard for table regions.") - -(defun org-table-get (line column) - "Get the field in table line LINE, column COLUMN. -If LINE is larger than the number of data lines in the table, the function -returns nil. However, if COLUMN is too large, we will simply return an -empty string. -If LINE is nil, use the current line. -If column is nil, use the current column." - (setq column (or column (org-table-current-column))) - (save-excursion - (and (or (not line) (org-table-goto-line line)) - (org-trim (org-table-get-field column))))) - -(defun org-table-put (line column value &optional align) - "Put VALUE into line LINE, column COLUMN. -When ALIGN is set, also realign the table." - (setq column (or column (org-table-current-column))) - (prog1 (save-excursion - (and (or (not line) (org-table-goto-line line)) - (progn (org-table-goto-column column nil 'force) t) - (org-table-get-field column value))) - (and align (org-table-align)))) - -(defun org-table-current-line () - "Return the index of the current data line." - (let ((pos (point)) (end (org-table-end)) (cnt 0)) - (save-excursion - (goto-char (org-table-begin)) - (while (and (re-search-forward org-table-dataline-regexp end t) - (setq cnt (1+ cnt)) - (< (point-at-eol) pos)))) - cnt)) - -(defun org-table-goto-line (N) - "Go to the Nth data line in the current table. -Return t when the line exists, nil if it does not exist." - (goto-char (org-table-begin)) - (let ((end (org-table-end)) (cnt 0)) - (while (and (re-search-forward org-table-dataline-regexp end t) - (< (setq cnt (1+ cnt)) N))) - (= cnt N))) - -;;;###autoload -(defun org-table-blank-field () - "Blank the current table field or active region." - (interactive) - (org-table-check-inside-data-field) - (if (and (org-called-interactively-p 'any) (org-region-active-p)) - (let (org-table-clip) - (org-table-cut-region (region-beginning) (region-end))) - (skip-chars-backward "^|") - (backward-char 1) - (if (looking-at "|[^|\n]+") - (let* ((pos (match-beginning 0)) - (match (match-string 0)) - (len (org-string-width match))) - (replace-match (concat "|" (make-string (1- len) ?\ ))) - (goto-char (+ 2 pos)) - (substring match 1))))) - -(defun org-table-get-field (&optional n replace) - "Return the value of the field in column N of current row. -N defaults to current field. -If REPLACE is a string, replace field with this value. The return value -is always the old value." - (and n (org-table-goto-column n)) - (skip-chars-backward "^|\n") - (backward-char 1) - (if (looking-at "|[^|\r\n]*") - (let* ((pos (match-beginning 0)) - (val (buffer-substring (1+ pos) (match-end 0)))) - (if replace - (replace-match (concat "|" (if (equal replace "") " " replace)) - t t)) - (goto-char (min (point-at-eol) (+ 2 pos))) - val) - (forward-char 1) "")) - -;;;###autoload -(defun org-table-field-info (arg) - "Show info about the current field, and highlight any reference at point." - (interactive "P") - (org-table-get-specials) - (save-excursion - (let* ((pos (point)) - (col (org-table-current-column)) - (cname (car (rassoc (int-to-string col) org-table-column-names))) - (name (car (rassoc (list (org-current-line) col) - org-table-named-field-locations))) - (eql (org-table-expand-lhs-ranges - (mapcar - (lambda (e) - (cons (org-table-formula-handle-first/last-rc - (car e)) (cdr e))) - (org-table-get-stored-formulas)))) - (dline (org-table-current-dline)) - (ref (format "@%d$%d" dline col)) - (ref1 (org-table-convert-refs-to-an ref)) - (fequation (or (assoc name eql) (assoc ref eql))) - (cequation (assoc (int-to-string col) eql)) - (eqn (or fequation cequation))) - (if (and eqn (get-text-property 0 :orig-eqn (car eqn))) - (setq eqn (get-text-property 0 :orig-eqn (car eqn)))) - (goto-char pos) - (condition-case nil - (org-table-show-reference 'local) - (error nil)) - (message "line @%d, col $%s%s, ref @%d$%d or %s%s%s" - dline col - (if cname (concat " or $" cname) "") - dline col ref1 - (if name (concat " or $" name) "") - ;; FIXME: formula info not correct if special table line - (if eqn - (concat ", formula: " - (org-table-formula-to-user - (concat - (if (string-match "^[$@]"(car eqn)) "" "$") - (car eqn) "=" (cdr eqn)))) - ""))))) - -(defun org-table-current-column () - "Find out which column we are in." - (interactive) - (if (org-called-interactively-p 'any) (org-table-check-inside-data-field)) - (save-excursion - (let ((cnt 0) (pos (point))) - (beginning-of-line 1) - (while (search-forward "|" pos t) - (setq cnt (1+ cnt))) - (when (org-called-interactively-p 'interactive) - (message "In table column %d" cnt)) - cnt))) - -;;;###autoload -(defun org-table-current-dline () - "Find out what table data line we are in. -Only data lines count for this." - (interactive) - (when (org-called-interactively-p 'any) - (org-table-check-inside-data-field)) - (save-excursion - (let ((cnt 0) (pos (point))) - (goto-char (org-table-begin)) - (while (<= (point) pos) - (if (looking-at org-table-dataline-regexp) (setq cnt (1+ cnt))) - (beginning-of-line 2)) - (when (org-called-interactively-p 'any) - (message "This is table line %d" cnt)) - cnt))) - -;;;###autoload -(defun org-table-goto-column (n &optional on-delim force) - "Move the cursor to the Nth column in the current table line. -With optional argument ON-DELIM, stop with point before the left delimiter -of the field. -If there are less than N fields, just go to after the last delimiter. -However, when FORCE is non-nil, create new columns if necessary." - (interactive "p") - (beginning-of-line 1) - (when (> n 0) - (while (and (> (setq n (1- n)) -1) - (or (search-forward "|" (point-at-eol) t) - (and force - (progn (end-of-line 1) - (skip-chars-backward "^|") - (insert " | ") - t))))) - (when (and force (not (looking-at ".*|"))) - (save-excursion (end-of-line 1) (insert " | "))) - (if on-delim - (backward-char 1) - (if (looking-at " ") (forward-char 1))))) - -;;;###autoload -(defun org-table-insert-column () - "Insert a new column into the table." - (interactive) - (if (not (org-at-table-p)) - (user-error "Not at a table")) - (org-table-find-dataline) - (let* ((col (max 1 (org-table-current-column))) - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos col)) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col t) - (insert "| ")) - (beginning-of-line 2)) - (move-marker end nil) - (org-goto-line linepos) - (org-table-goto-column colpos) - (org-table-align) - (when (or (not org-table-fix-formulas-confirm) - (funcall org-table-fix-formulas-confirm "Fix formulas? ")) - (org-table-fix-formulas "$" nil (1- col) 1) - (org-table-fix-formulas "$LR" nil (1- col) 1)))) - -(defun org-table-find-dataline () - "Find a data line in the current table, which is needed for column commands." - (if (and (org-at-table-p) - (not (org-at-table-hline-p))) - t - (let ((col (current-column)) - (end (org-table-end))) - (org-move-to-column col) - (while (and (< (point) end) - (or (not (= (current-column) col)) - (org-at-table-hline-p))) - (beginning-of-line 2) - (org-move-to-column col)) - (if (and (org-at-table-p) - (not (org-at-table-hline-p))) - t - (user-error - "Please position cursor in a data line for column operations"))))) - -(defun org-table-line-to-dline (line &optional above) - "Turn a buffer line number into a data line number. -If there is no data line in this line, return nil. -If there is no matching dline (most likely te reference was a hline), the -first dline below it is used. When ABOVE is non-nil, the one above is used." - (catch 'exit - (let ((ll (length org-table-dlines)) - i) - (if above - (progn - (setq i (1- ll)) - (while (> i 0) - (if (<= (aref org-table-dlines i) line) - (throw 'exit i)) - (setq i (1- i)))) - (setq i 1) - (while (< i ll) - (if (>= (aref org-table-dlines i) line) - (throw 'exit i)) - (setq i (1+ i))))) - nil)) - -;;;###autoload -(defun org-table-delete-column () - "Delete a column from the table." - (interactive) - (if (not (org-at-table-p)) - (user-error "Not at a table")) - (org-table-find-dataline) - (org-table-check-inside-data-field) - (let* ((col (org-table-current-column)) - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos col)) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col t) - (and (looking-at "|[^|\n]+|") - (replace-match "|"))) - (beginning-of-line 2)) - (move-marker end nil) - (org-goto-line linepos) - (org-table-goto-column colpos) - (org-table-align) - (when (or (not org-table-fix-formulas-confirm) - (funcall org-table-fix-formulas-confirm "Fix formulas? ")) - (org-table-fix-formulas "$" (list (cons (number-to-string col) "INVALID")) - col -1 col) - (org-table-fix-formulas "$LR" (list (cons (number-to-string col) "INVALID")) - col -1 col)))) - -;;;###autoload -(defun org-table-move-column-right () - "Move column to the right." - (interactive) - (org-table-move-column nil)) -;;;###autoload -(defun org-table-move-column-left () - "Move column to the left." - (interactive) - (org-table-move-column 'left)) - -;;;###autoload -(defun org-table-move-column (&optional left) - "Move the current column to the right. With arg LEFT, move to the left." - (interactive "P") - (if (not (org-at-table-p)) - (user-error "Not at a table")) - (org-table-find-dataline) - (org-table-check-inside-data-field) - (let* ((col (org-table-current-column)) - (col1 (if left (1- col) col)) - (beg (org-table-begin)) - (end (org-table-end)) - ;; Current cursor position - (linepos (org-current-line)) - (colpos (if left (1- col) (1+ col)))) - (if (and left (= col 1)) - (user-error "Cannot move column further left")) - (if (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) - (user-error "Cannot move column further right")) - (goto-char beg) - (while (< (point) end) - (if (org-at-table-hline-p) - nil - (org-table-goto-column col1 t) - (and (looking-at "|\\([^|\n]+\\)|\\([^|\n]+\\)|") - (replace-match "|\\2|\\1|"))) - (beginning-of-line 2)) - (move-marker end nil) - (org-goto-line linepos) - (org-table-goto-column colpos) - (org-table-align) - (when (or (not org-table-fix-formulas-confirm) - (funcall org-table-fix-formulas-confirm "Fix formulas? ")) - (org-table-fix-formulas - "$" (list (cons (number-to-string col) (number-to-string colpos)) - (cons (number-to-string colpos) (number-to-string col)))) - (org-table-fix-formulas - "$LR" (list (cons (number-to-string col) (number-to-string colpos)) - (cons (number-to-string colpos) (number-to-string col))))))) - -;;;###autoload -(defun org-table-move-row-down () - "Move table row down." - (interactive) - (org-table-move-row nil)) -;;;###autoload -(defun org-table-move-row-up () - "Move table row up." - (interactive) - (org-table-move-row 'up)) - -;;;###autoload -(defun org-table-move-row (&optional up) - "Move the current table line down. With arg UP, move it up." - (interactive "P") - (let* ((col (current-column)) - (pos (point)) - (hline1p (save-excursion (beginning-of-line 1) - (looking-at org-table-hline-regexp))) - (dline1 (org-table-current-dline)) - (dline2 (+ dline1 (if up -1 1))) - (tonew (if up 0 2)) - txt hline2p) - (beginning-of-line tonew) - (unless (org-at-table-p) - (goto-char pos) - (user-error "Cannot move row further")) - (setq hline2p (looking-at org-table-hline-regexp)) - (goto-char pos) - (beginning-of-line 1) - (setq pos (point)) - (setq txt (buffer-substring (point) (1+ (point-at-eol)))) - (delete-region (point) (1+ (point-at-eol))) - (beginning-of-line tonew) - (insert txt) - (beginning-of-line 0) - (org-move-to-column col) - (unless (or hline1p hline2p - (not (or (not org-table-fix-formulas-confirm) - (funcall org-table-fix-formulas-confirm - "Fix formulas? ")))) - (org-table-fix-formulas - "@" (list (cons (number-to-string dline1) (number-to-string dline2)) - (cons (number-to-string dline2) (number-to-string dline1))))))) - -;;;###autoload -(defun org-table-insert-row (&optional arg) - "Insert a new row above the current line into the table. -With prefix ARG, insert below the current line." - (interactive "P") - (if (not (org-at-table-p)) - (user-error "Not at a table")) - (let* ((line (buffer-substring (point-at-bol) (point-at-eol))) - (new (org-table-clean-line line))) - ;; Fix the first field if necessary - (if (string-match "^[ \t]*| *[#$] *|" line) - (setq new (replace-match (match-string 0 line) t t new))) - (beginning-of-line (if arg 2 1)) - (let (org-table-may-need-update) (insert-before-markers new "\n")) - (beginning-of-line 0) - (re-search-forward "| ?" (point-at-eol) t) - (and (or org-table-may-need-update org-table-overlay-coordinates) - (org-table-align)) - (when (or (not org-table-fix-formulas-confirm) - (funcall org-table-fix-formulas-confirm "Fix formulas? ")) - (org-table-fix-formulas "@" nil (1- (org-table-current-dline)) 1)))) - -;;;###autoload -(defun org-table-insert-hline (&optional above) - "Insert a horizontal-line below the current line into the table. -With prefix ABOVE, insert above the current line." - (interactive "P") - (if (not (org-at-table-p)) - (user-error "Not at a table")) - (when (eobp) (insert "\n") (backward-char 1)) - (if (not (string-match "|[ \t]*$" (org-current-line-string))) - (org-table-align)) - (let ((line (org-table-clean-line - (buffer-substring (point-at-bol) (point-at-eol)))) - (col (current-column))) - (while (string-match "|\\( +\\)|" line) - (setq line (replace-match - (concat "+" (make-string (- (match-end 1) (match-beginning 1)) - ?-) "|") t t line))) - (and (string-match "\\+" line) (setq line (replace-match "|" t t line))) - (beginning-of-line (if above 1 2)) - (insert line "\n") - (beginning-of-line (if above 1 -1)) - (org-move-to-column col) - (and org-table-overlay-coordinates (org-table-align)))) - -;;;###autoload -(defun org-table-hline-and-move (&optional same-column) - "Insert a hline and move to the row below that line." - (interactive "P") - (let ((col (org-table-current-column))) - (org-table-maybe-eval-formula) - (org-table-maybe-recalculate-line) - (org-table-insert-hline) - (end-of-line 2) - (if (looking-at "\n[ \t]*|-") - (progn (insert "\n|") (org-table-align)) - (org-table-next-field)) - (if same-column (org-table-goto-column col)))) - -(defun org-table-clean-line (s) - "Convert a table line S into a string with only \"|\" and space. -In particular, this does handle wide and invisible characters." - (if (string-match "^[ \t]*|-" s) - ;; It's a hline, just map the characters - (setq s (mapconcat (lambda (x) (if (member x '(?| ?+)) "|" " ")) s "")) - (while (string-match "|\\([ \t]*?[^ \t\r\n|][^\r\n|]*\\)|" s) - (setq s (replace-match - (concat "|" (make-string (org-string-width (match-string 1 s)) - ?\ ) "|") - t t s))) - s)) - -;;;###autoload -(defun org-table-kill-row () - "Delete the current row or horizontal line from the table." - (interactive) - (if (not (org-at-table-p)) - (user-error "Not at a table")) - (let ((col (current-column)) - (dline (org-table-current-dline))) - (kill-region (point-at-bol) (min (1+ (point-at-eol)) (point-max))) - (if (not (org-at-table-p)) (beginning-of-line 0)) - (org-move-to-column col) - (when (or (not org-table-fix-formulas-confirm) - (funcall org-table-fix-formulas-confirm "Fix formulas? ")) - (org-table-fix-formulas "@" (list (cons (number-to-string dline) "INVALID")) - dline -1 dline)))) - -;;;###autoload -(defun org-table-sort-lines (with-case &optional sorting-type) - "Sort table lines according to the column at point. - -The position of point indicates the column to be used for -sorting, and the range of lines is the range between the nearest -horizontal separator lines, or the entire table of no such lines -exist. If point is before the first column, you will be prompted -for the sorting column. If there is an active region, the mark -specifies the first line and the sorting column, while point -should be in the last line to be included into the sorting. - -The command then prompts for the sorting type which can be -alphabetically, numerically, or by time (as given in a time stamp -in the field). Sorting in reverse order is also possible. - -With prefix argument WITH-CASE, alphabetic sorting will be case-sensitive. - -If SORTING-TYPE is specified when this function is called from a Lisp -program, no prompting will take place. SORTING-TYPE must be a character, -any of (?a ?A ?n ?N ?t ?T) where the capital letter indicate that sorting -should be done in reverse order." - (interactive "P") - (let* ((thisline (org-current-line)) - (thiscol (org-table-current-column)) - (otc org-table-overlay-coordinates) - beg end bcol ecol tend tbeg column lns pos) - (when (equal thiscol 0) - (if (org-called-interactively-p 'any) - (setq thiscol - (string-to-number - (read-string "Use column N for sorting: "))) - (setq thiscol 1)) - (org-table-goto-column thiscol)) - (org-table-check-inside-data-field) - (if (org-region-active-p) - (progn - (setq beg (region-beginning) end (region-end)) - (goto-char beg) - (setq column (org-table-current-column) - beg (point-at-bol)) - (goto-char end) - (setq end (point-at-bol 2))) - (setq column (org-table-current-column) - pos (point) - tbeg (org-table-begin) - tend (org-table-end)) - (if (re-search-backward org-table-hline-regexp tbeg t) - (setq beg (point-at-bol 2)) - (goto-char tbeg) - (setq beg (point-at-bol 1))) - (goto-char pos) - (if (re-search-forward org-table-hline-regexp tend t) - (setq end (point-at-bol 1)) - (goto-char tend) - (setq end (point-at-bol)))) - (setq beg (move-marker (make-marker) beg) - end (move-marker (make-marker) end)) - (untabify beg end) - (goto-char beg) - (org-table-goto-column column) - (skip-chars-backward "^|") - (setq bcol (current-column)) - (org-table-goto-column (1+ column)) - (skip-chars-backward "^|") - (setq ecol (1- (current-column))) - (org-table-goto-column column) - (setq lns (mapcar (lambda(x) (cons - (org-sort-remove-invisible - (nth (1- column) - (org-split-string x "[ \t]*|[ \t]*"))) - x)) - (org-split-string (buffer-substring beg end) "\n"))) - (setq lns (org-do-sort lns "Table" with-case sorting-type)) - (when org-table-overlay-coordinates - (org-table-toggle-coordinate-overlays)) - (delete-region beg end) - (move-marker beg nil) - (move-marker end nil) - (insert (mapconcat 'cdr lns "\n") "\n") - (org-goto-line thisline) - (org-table-goto-column thiscol) - (when otc (org-table-toggle-coordinate-overlays)) - (message "%d lines sorted, based on column %d" (length lns) column))) - -;;;###autoload -(defun org-table-cut-region (beg end) - "Copy region in table to the clipboard and blank all relevant fields. -If there is no active region, use just the field at point." - (interactive (list - (if (org-region-active-p) (region-beginning) (point)) - (if (org-region-active-p) (region-end) (point)))) - (org-table-copy-region beg end 'cut)) - -;;;###autoload -(defun org-table-copy-region (beg end &optional cut) - "Copy rectangular region in table to clipboard. -A special clipboard is used which can only be accessed -with `org-table-paste-rectangle'." - (interactive (list - (if (org-region-active-p) (region-beginning) (point)) - (if (org-region-active-p) (region-end) (point)) - current-prefix-arg)) - (let* (l01 c01 l02 c02 l1 c1 l2 c2 ic1 ic2 - region cols - (rpl (if cut " " nil))) - (goto-char beg) - (org-table-check-inside-data-field) - (setq l01 (org-current-line) - c01 (org-table-current-column)) - (goto-char end) - (org-table-check-inside-data-field) - (setq l02 (org-current-line) - c02 (org-table-current-column)) - (setq l1 (min l01 l02) l2 (max l01 l02) - c1 (min c01 c02) c2 (max c01 c02)) - (catch 'exit - (while t - (catch 'nextline - (if (> l1 l2) (throw 'exit t)) - (org-goto-line l1) - (if (org-at-table-hline-p) (throw 'nextline (setq l1 (1+ l1)))) - (setq cols nil ic1 c1 ic2 c2) - (while (< ic1 (1+ ic2)) - (push (org-table-get-field ic1 rpl) cols) - (setq ic1 (1+ ic1))) - (push (nreverse cols) region) - (setq l1 (1+ l1))))) - (setq org-table-clip (nreverse region)) - (if cut (org-table-align)) - org-table-clip)) - -;;;###autoload -(defun org-table-paste-rectangle () - "Paste a rectangular region into a table. -The upper right corner ends up in the current field. All involved fields -will be overwritten. If the rectangle does not fit into the present table, -the table is enlarged as needed. The process ignores horizontal separator -lines." - (interactive) - (unless (and org-table-clip (listp org-table-clip)) - (user-error "First cut/copy a region to paste!")) - (org-table-check-inside-data-field) - (let* ((clip org-table-clip) - (line (org-current-line)) - (col (org-table-current-column)) - (org-enable-table-editor t) - (org-table-automatic-realign nil) - c cols field) - (while (setq cols (pop clip)) - (while (org-at-table-hline-p) (beginning-of-line 2)) - (if (not (org-at-table-p)) - (progn (end-of-line 0) (org-table-next-field))) - (setq c col) - (while (setq field (pop cols)) - (org-table-goto-column c nil 'force) - (org-table-get-field nil field) - (setq c (1+ c))) - (beginning-of-line 2)) - (org-goto-line line) - (org-table-goto-column col) - (org-table-align))) - -;;;###autoload -(defun org-table-convert () - "Convert from `org-mode' table to table.el and back. -Obviously, this only works within limits. When an Org-mode table is -converted to table.el, all horizontal separator lines get lost, because -table.el uses these as cell boundaries and has no notion of horizontal lines. -A table.el table can be converted to an Org-mode table only if it does not -do row or column spanning. Multiline cells will become multiple cells. -Beware, Org-mode does not test if the table can be successfully converted - it -blindly applies a recipe that works for simple tables." - (interactive) - (require 'table) - (if (org-at-table.el-p) - ;; convert to Org-mode table - (let ((beg (move-marker (make-marker) (org-table-begin t))) - (end (move-marker (make-marker) (org-table-end t)))) - (table-unrecognize-region beg end) - (goto-char beg) - (while (re-search-forward "^\\([ \t]*\\)\\+-.*\n" end t) - (replace-match "")) - (goto-char beg)) - (if (org-at-table-p) - ;; convert to table.el table - (let ((beg (move-marker (make-marker) (org-table-begin))) - (end (move-marker (make-marker) (org-table-end)))) - ;; first, get rid of all horizontal lines - (goto-char beg) - (while (re-search-forward "^\\([ \t]*\\)|-.*\n" end t) - (replace-match "")) - ;; insert a hline before first - (goto-char beg) - (org-table-insert-hline 'above) - (beginning-of-line -1) - ;; insert a hline after each line - (while (progn (beginning-of-line 3) (< (point) end)) - (org-table-insert-hline)) - (goto-char beg) - (setq end (move-marker end (org-table-end))) - ;; replace "+" at beginning and ending of hlines - (while (re-search-forward "^\\([ \t]*\\)|-" end t) - (replace-match "\\1+-")) - (goto-char beg) - (while (re-search-forward "-|[ \t]*$" end t) - (replace-match "-+")) - (goto-char beg))))) - -(defun org-table-transpose-table-at-point () - "Transpose orgmode table at point and eliminate hlines. -So a table like - -| 1 | 2 | 4 | 5 | -|---+---+---+---| -| a | b | c | d | -| e | f | g | h | - -will be transposed as - -| 1 | a | e | -| 2 | b | f | -| 4 | c | g | -| 5 | d | h | - -Note that horizontal lines disappeared." - (interactive) - (let* ((table (delete 'hline (org-table-to-lisp))) - (contents (mapcar (lambda (p) - (let ((tp table)) - (mapcar - (lambda (rown) - (prog1 - (pop (car tp)) - (setq tp (cdr tp)))) - table))) - (car table)))) - (delete-region (org-table-begin) (org-table-end)) - (insert (mapconcat (lambda(x) (concat "| " (mapconcat 'identity x " | " ) " |\n" )) - contents "")) - (org-table-align))) - -;;;###autoload -(defun org-table-wrap-region (arg) - "Wrap several fields in a column like a paragraph. -This is useful if you'd like to spread the contents of a field over several -lines, in order to keep the table compact. - -If there is an active region, and both point and mark are in the same column, -the text in the column is wrapped to minimum width for the given number of -lines. Generally, this makes the table more compact. A prefix ARG may be -used to change the number of desired lines. For example, `C-2 \\[org-table-wrap]' -formats the selected text to two lines. If the region was longer than two -lines, the remaining lines remain empty. A negative prefix argument reduces -the current number of lines by that amount. The wrapped text is pasted back -into the table. If you formatted it to more lines than it was before, fields -further down in the table get overwritten - so you might need to make space in -the table first. - -If there is no region, the current field is split at the cursor position and -the text fragment to the right of the cursor is prepended to the field one -line down. - -If there is no region, but you specify a prefix ARG, the current field gets -blank, and the content is appended to the field above." - (interactive "P") - (org-table-check-inside-data-field) - (if (org-region-active-p) - ;; There is a region: fill as a paragraph - (let* ((beg (region-beginning)) - (cline (save-excursion (goto-char beg) (org-current-line))) - (ccol (save-excursion (goto-char beg) (org-table-current-column))) - nlines) - (org-table-cut-region (region-beginning) (region-end)) - (if (> (length (car org-table-clip)) 1) - (user-error "Region must be limited to single column")) - (setq nlines (if arg - (if (< arg 1) - (+ (length org-table-clip) arg) - arg) - (length org-table-clip))) - (setq org-table-clip - (mapcar 'list (org-wrap (mapconcat 'car org-table-clip " ") - nil nlines))) - (org-goto-line cline) - (org-table-goto-column ccol) - (org-table-paste-rectangle)) - ;; No region, split the current field at point - (unless (org-get-alist-option org-M-RET-may-split-line 'table) - (skip-chars-forward "^\r\n|")) - (if arg - ;; combine with field above - (let ((s (org-table-blank-field)) - (col (org-table-current-column))) - (beginning-of-line 0) - (while (org-at-table-hline-p) (beginning-of-line 0)) - (org-table-goto-column col) - (skip-chars-forward "^|") - (skip-chars-backward " ") - (insert " " (org-trim s)) - (org-table-align)) - ;; split field - (if (looking-at "\\([^|]+\\)+|") - (let ((s (match-string 1))) - (replace-match " |") - (goto-char (match-beginning 0)) - (org-table-next-row) - (insert (org-trim s) " ") - (org-table-align)) - (org-table-next-row))))) - -(defvar org-field-marker nil) - -;;;###autoload -(defun org-table-edit-field (arg) - "Edit table field in a different window. -This is mainly useful for fields that contain hidden parts. -When called with a \\[universal-argument] prefix, just make the full field visible so that -it can be edited in place." - (interactive "P") - (cond - ((equal arg '(16)) - (org-table-follow-field-mode (if org-table-follow-field-mode -1 1))) - (arg - (let ((b (save-excursion (skip-chars-backward "^|") (point))) - (e (save-excursion (skip-chars-forward "^|\r\n") (point)))) - (remove-text-properties b e '(org-cwidth t invisible t - display t intangible t)) - (if (and (boundp 'font-lock-mode) font-lock-mode) - (font-lock-fontify-block)))) - (t - (let ((pos (point-marker)) - (coord - (if (eq org-table-use-standard-references t) - (concat (org-number-to-letters (org-table-current-column)) - (int-to-string (org-table-current-dline))) - (concat "@" (int-to-string (org-table-current-dline)) - "$" (int-to-string (org-table-current-column))))) - (field (org-table-get-field)) - (cw (current-window-configuration)) - p) - (goto-char pos) - (org-switch-to-buffer-other-window "*Org Table Edit Field*") - (when (and (local-variable-p 'org-field-marker) - (markerp org-field-marker)) - (move-marker org-field-marker nil)) - (erase-buffer) - (insert "#\n# Edit field " coord " and finish with C-c C-c\n#\n") - (let ((org-inhibit-startup t)) (org-mode)) - (auto-fill-mode -1) - (setq truncate-lines nil) - (setq word-wrap t) - (goto-char (setq p (point-max))) - (insert (org-trim field)) - (remove-text-properties p (point-max) - '(invisible t org-cwidth t display t - intangible t)) - (goto-char p) - (org-set-local 'org-finish-function 'org-table-finish-edit-field) - (org-set-local 'org-window-configuration cw) - (org-set-local 'org-field-marker pos) - (message "Edit and finish with C-c C-c"))))) - -(defun org-table-finish-edit-field () - "Finish editing a table data field. -Remove all newline characters, insert the result into the table, realign -the table and kill the editing buffer." - (let ((pos org-field-marker) - (cw org-window-configuration) - (cb (current-buffer)) - text) - (goto-char (point-min)) - (while (re-search-forward "^#.*\n?" nil t) (replace-match "")) - (while (re-search-forward "\\([ \t]*\n[ \t]*\\)+" nil t) - (replace-match " ")) - (setq text (org-trim (buffer-string))) - (set-window-configuration cw) - (kill-buffer cb) - (select-window (get-buffer-window (marker-buffer pos))) - (goto-char pos) - (move-marker pos nil) - (org-table-check-inside-data-field) - (org-table-get-field nil text) - (org-table-align) - (message "New field value inserted"))) - -(define-minor-mode org-table-follow-field-mode - "Minor mode to make the table field editor window follow the cursor. -When this mode is active, the field editor window will always show the -current field. The mode exits automatically when the cursor leaves the -table (but see `org-table-exit-follow-field-mode-when-leaving-table')." - nil " TblFollow" nil - (if org-table-follow-field-mode - (org-add-hook 'post-command-hook 'org-table-follow-fields-with-editor - 'append 'local) - (remove-hook 'post-command-hook 'org-table-follow-fields-with-editor 'local) - (let* ((buf (get-buffer "*Org Table Edit Field*")) - (win (and buf (get-buffer-window buf)))) - (when win (delete-window win)) - (when buf - (with-current-buffer buf - (move-marker org-field-marker nil)) - (kill-buffer buf))))) - -(defun org-table-follow-fields-with-editor () - (if (and org-table-exit-follow-field-mode-when-leaving-table - (not (org-at-table-p))) - ;; We have left the table, exit the follow mode - (org-table-follow-field-mode -1) - (when (org-table-check-inside-data-field 'noerror) - (let ((win (selected-window))) - (org-table-edit-field nil) - (org-fit-window-to-buffer) - (select-window win))))) - -(defvar org-timecnt) ; dynamically scoped parameter - -;;;###autoload -(defun org-table-sum (&optional beg end nlast) - "Sum numbers in region of current table column. -The result will be displayed in the echo area, and will be available -as kill to be inserted with \\[yank]. - -If there is an active region, it is interpreted as a rectangle and all -numbers in that rectangle will be summed. If there is no active -region and point is located in a table column, sum all numbers in that -column. - -If at least one number looks like a time HH:MM or HH:MM:SS, all other -numbers are assumed to be times as well (in decimal hours) and the -numbers are added as such. - -If NLAST is a number, only the NLAST fields will actually be summed." - (interactive) - (save-excursion - (let (col (org-timecnt 0) diff h m s org-table-clip) - (cond - ((and beg end)) ; beg and end given explicitly - ((org-region-active-p) - (setq beg (region-beginning) end (region-end))) - (t - (setq col (org-table-current-column)) - (goto-char (org-table-begin)) - (unless (re-search-forward "^[ \t]*|[^-]" nil t) - (user-error "No table data")) - (org-table-goto-column col) - (setq beg (point)) - (goto-char (org-table-end)) - (unless (re-search-backward "^[ \t]*|[^-]" nil t) - (user-error "No table data")) - (org-table-goto-column col) - (setq end (point)))) - (let* ((items (apply 'append (org-table-copy-region beg end))) - (items1 (cond ((not nlast) items) - ((>= nlast (length items)) items) - (t (setq items (reverse items)) - (setcdr (nthcdr (1- nlast) items) nil) - (nreverse items)))) - (numbers (delq nil (mapcar 'org-table-get-number-for-summing - items1))) - (res (apply '+ numbers)) - (sres (if (= org-timecnt 0) - (number-to-string res) - (setq diff (* 3600 res) - h (floor (/ diff 3600)) diff (mod diff 3600) - m (floor (/ diff 60)) diff (mod diff 60) - s diff) - (format "%.0f:%02.0f:%02.0f" h m s)))) - (kill-new sres) - (if (org-called-interactively-p 'interactive) - (message "%s" - (substitute-command-keys - (format "Sum of %d items: %-20s (\\[yank] will insert result into buffer)" - (length numbers) sres)))) - sres)))) - -(defun org-table-get-number-for-summing (s) - (let (n) - (if (string-match "^ *|? *" s) - (setq s (replace-match "" nil nil s))) - (if (string-match " *|? *$" s) - (setq s (replace-match "" nil nil s))) - (setq n (string-to-number s)) - (cond - ((and (string-match "0" s) - (string-match "\\`[-+ \t0.edED]+\\'" s)) 0) - ((string-match "\\`[ \t]+\\'" s) nil) - ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\(:\\([0-9]+\\)\\)?\\'" s) - (let ((h (string-to-number (or (match-string 1 s) "0"))) - (m (string-to-number (or (match-string 2 s) "0"))) - (s (string-to-number (or (match-string 4 s) "0")))) - (if (boundp 'org-timecnt) (setq org-timecnt (1+ org-timecnt))) - (* 1.0 (+ h (/ m 60.0) (/ s 3600.0))))) - ((equal n 0) nil) - (t n)))) - -(defun org-table-current-field-formula (&optional key noerror) - "Return the formula active for the current field. -Assumes that specials are in place. -If KEY is given, return the key to this formula. -Otherwise return the formula preceded with \"=\" or \":=\"." - (let* ((name (car (rassoc (list (org-current-line) - (org-table-current-column)) - org-table-named-field-locations))) - (col (org-table-current-column)) - (scol (int-to-string col)) - (ref (format "@%d$%d" (org-table-current-dline) col)) - (stored-list (org-table-get-stored-formulas noerror)) - (ass (or (assoc name stored-list) - (assoc ref stored-list) - (assoc scol stored-list)))) - (if key - (car ass) - (if ass (concat (if (string-match "^[0-9]+$" (car ass)) "=" ":=") - (cdr ass)))))) - -(defun org-table-get-formula (&optional equation named) - "Read a formula from the minibuffer, offer stored formula as default. -When NAMED is non-nil, look for a named equation." - (let* ((stored-list (org-table-get-stored-formulas)) - (name (car (rassoc (list (org-current-line) - (org-table-current-column)) - org-table-named-field-locations))) - (ref (format "@%d$%d" (org-table-current-dline) - (org-table-current-column))) - (refass (assoc ref stored-list)) - (nameass (assoc name stored-list)) - (scol (if named - (if (and name (not (string-match "^LR[0-9]+$" name))) - name - ref) - (int-to-string (org-table-current-column)))) - (dummy (and (or nameass refass) (not named) - (not (y-or-n-p "Replace existing field formula with column formula? " )) - (message "Formula not replaced"))) - (name (or name ref)) - (org-table-may-need-update nil) - (stored (cdr (assoc scol stored-list))) - (eq (cond - ((and stored equation (string-match "^ *=? *$" equation)) - stored) - ((stringp equation) - equation) - (t (org-table-formula-from-user - (read-string - (org-table-formula-to-user - (format "%s formula %s%s=" - (if named "Field" "Column") - (if (member (string-to-char scol) '(?$ ?@)) "" "$") - scol)) - (if stored (org-table-formula-to-user stored) "") - 'org-table-formula-history - ))))) - mustsave) - (when (not (string-match "\\S-" eq)) - ;; remove formula - (setq stored-list (delq (assoc scol stored-list) stored-list)) - (org-table-store-formulas stored-list) - (user-error "Formula removed")) - (if (string-match "^ *=?" eq) (setq eq (replace-match "" t t eq))) - (if (string-match " *$" eq) (setq eq (replace-match "" t t eq))) - (if (and name (not named)) - ;; We set the column equation, delete the named one. - (setq stored-list (delq (assoc name stored-list) stored-list) - mustsave t)) - (if stored - (setcdr (assoc scol stored-list) eq) - (setq stored-list (cons (cons scol eq) stored-list))) - (if (or mustsave (not (equal stored eq))) - (org-table-store-formulas stored-list)) - eq)) - -(defun org-table-store-formulas (alist) - "Store the list of formulas below the current table." - (setq alist (sort alist 'org-table-formula-less-p)) - (let ((case-fold-search t)) - (save-excursion - (goto-char (org-table-end)) - (if (looking-at "\\([ \t]*\n\\)*[ \t]*\\(#\\+tblfm:\\)\\(.*\n?\\)") - (progn - ;; don't overwrite TBLFM, we might use text properties to store stuff - (goto-char (match-beginning 3)) - (delete-region (match-beginning 3) (match-end 0))) - (org-indent-line) - (insert (or (match-string 2) "#+TBLFM:"))) - (insert " " - (mapconcat (lambda (x) - (concat - (if (equal (string-to-char (car x)) ?@) "" "$") - (car x) "=" (cdr x))) - alist "::") - "\n")))) - -(defsubst org-table-formula-make-cmp-string (a) - (when (string-match "\\`$[<>]" a) - (let ((arrow (string-to-char (substring a 1)))) - ;; Fake a high number to make sure this is sorted at the end. - (setq a (org-table-formula-handle-first/last-rc a)) - (setq a (format "$%d" (+ 10000 - (if (= arrow ?<) -1000 0) - (string-to-number (substring a 1))))))) - (when (string-match - "^\\(@\\([0-9]+\\)\\)?\\(\\$?\\([0-9]+\\)\\)?\\(\\$?[a-zA-Z0-9]+\\)?" - a) - (concat - (if (match-end 2) - (format "@%05d" (string-to-number (match-string 2 a))) "") - (if (match-end 4) - (format "$%05d" (string-to-number (match-string 4 a))) "") - (if (match-end 5) - (concat "@@" (match-string 5 a)))))) - -(defun org-table-formula-less-p (a b) - "Compare two formulas for sorting." - (let ((as (org-table-formula-make-cmp-string (car a))) - (bs (org-table-formula-make-cmp-string (car b)))) - (and as bs (string< as bs)))) - -;;;###autoload -(defun org-table-get-stored-formulas (&optional noerror) - "Return an alist with the stored formulas directly after current table." - (interactive) ;; FIXME interactive? - (let ((case-fold-search t) scol eq eq-alist strings string seen) - (save-excursion - (goto-char (org-table-end)) - (when (looking-at "\\([ \t]*\n\\)*[ \t]*#\\+tblfm: *\\(.*\\)") - (setq strings (org-split-string (org-match-string-no-properties 2) - " *:: *")) - (while (setq string (pop strings)) - (when (string-match "\\`\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*[^ \t]\\)" string) - (setq scol (if (match-end 2) - (match-string 2 string) - (match-string 1 string)) - scol (if (member (string-to-char scol) '(?< ?>)) - (concat "$" scol) scol) - eq (match-string 3 string) - eq-alist (cons (cons scol eq) eq-alist)) - (if (member scol seen) - (if noerror - (progn - (message "Double definition `$%s=' in TBLFM line, please fix by hand" scol) - (ding) - (sit-for 2)) - (user-error "Double definition `$%s=' in TBLFM line, please fix by hand" scol)) - (push scol seen)))))) - (nreverse eq-alist))) - -(defun org-table-fix-formulas (key replace &optional limit delta remove) - "Modify the equations after the table structure has been edited. -KEY is \"@\" or \"$\". REPLACE is an alist of numbers to replace. -For all numbers larger than LIMIT, shift them by DELTA." - (save-excursion - (goto-char (org-table-end)) - (when (let ((case-fold-search t)) (looking-at "[ \t]*#\\+tblfm:")) - (let ((msg "The formulas in #+TBLFM have been updated") - (re (concat key "\\([0-9]+\\)")) - (re2 - (when remove - (if (or (equal key "$") (equal key "$LR")) - (format "\\(@[0-9]+\\)?%s%d=.*?\\(::\\|$\\)" - (regexp-quote key) remove) - (format "@%d\\$[0-9]+=.*?\\(::\\|$\\)" remove)))) - s n a) - (when remove - (while (re-search-forward re2 (point-at-eol) t) - (unless (save-match-data (org-in-regexp "remote([^)]+?)")) - (if (equal (char-before (match-beginning 0)) ?.) - (user-error "Change makes TBLFM term %s invalid, use undo to recover" - (match-string 0)) - (replace-match ""))))) - (while (re-search-forward re (point-at-eol) t) - (unless (save-match-data (org-in-regexp "remote([^)]+?)")) - (setq s (match-string 1) n (string-to-number s)) - (cond - ((setq a (assoc s replace)) - (replace-match (concat key (cdr a)) t t) - (message msg)) - ((and limit (> n limit)) - (replace-match (concat key (int-to-string (+ n delta))) t t) - (message msg))))))))) - -(defun org-table-get-specials () - "Get the column names and local parameters for this table." - (save-excursion - (let ((beg (org-table-begin)) (end (org-table-end)) - names name fields fields1 field cnt - c v l line col types dlines hlines last-dline) - (setq org-table-column-names nil - org-table-local-parameters nil - org-table-named-field-locations nil - org-table-current-begin-line nil - org-table-current-begin-pos nil - org-table-current-line-types nil - org-table-current-ncol 0) - (goto-char beg) - (when (re-search-forward "^[ \t]*| *! *\\(|.*\\)" end t) - (setq names (org-split-string (match-string 1) " *| *") - cnt 1) - (while (setq name (pop names)) - (setq cnt (1+ cnt)) - (if (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" name) - (push (cons name (int-to-string cnt)) org-table-column-names)))) - (setq org-table-column-names (nreverse org-table-column-names)) - (setq org-table-column-name-regexp - (concat "\\$\\(" (mapconcat 'car org-table-column-names "\\|") "\\)\\>")) - (goto-char beg) - (while (re-search-forward "^[ \t]*| *\\$ *\\(|.*\\)" end t) - (setq fields (org-split-string (match-string 1) " *| *")) - (while (setq field (pop fields)) - (if (string-match "^\\([a-zA-Z][_a-zA-Z0-9]*\\|%\\) *= *\\(.*\\)" field) - (push (cons (match-string 1 field) (match-string 2 field)) - org-table-local-parameters)))) - (goto-char beg) - (while (re-search-forward "^[ \t]*| *\\([_^]\\) *\\(|.*\\)" end t) - (setq c (match-string 1) - fields (org-split-string (match-string 2) " *| *")) - (save-excursion - (beginning-of-line (if (equal c "_") 2 0)) - (setq line (org-current-line) col 1) - (and (looking-at "^[ \t]*|[^|]*\\(|.*\\)") - (setq fields1 (org-split-string (match-string 1) " *| *")))) - (while (and fields1 (setq field (pop fields))) - (setq v (pop fields1) col (1+ col)) - (when (and (stringp field) (stringp v) - (string-match "^[a-zA-Z][_a-zA-Z0-9]*$" field)) - (push (cons field v) org-table-local-parameters) - (push (list field line col) org-table-named-field-locations)))) - ;; Analyse the line types - (goto-char beg) - (setq org-table-current-begin-line (org-current-line) - org-table-current-begin-pos (point) - l org-table-current-begin-line) - (while (looking-at "[ \t]*|\\(-\\)?") - (push (if (match-end 1) 'hline 'dline) types) - (if (match-end 1) (push l hlines) (push l dlines)) - (beginning-of-line 2) - (setq l (1+ l))) - (push 'hline types) ;; add an imaginary extra hline to the end - (setq org-table-current-line-types (apply 'vector (nreverse types)) - last-dline (car dlines) - org-table-dlines (apply 'vector (cons nil (nreverse dlines))) - org-table-hlines (apply 'vector (cons nil (nreverse hlines)))) - (org-goto-line last-dline) - (let* ((l last-dline) - (fields (org-split-string - (buffer-substring (point-at-bol) (point-at-eol)) - "[ \t]*|[ \t]*")) - (nfields (length fields)) - al al2) - (setq org-table-current-ncol nfields) - (loop for i from 1 to nfields do - (push (list (format "LR%d" i) l i) al) - (push (cons (format "LR%d" i) (nth (1- i) fields)) al2)) - (setq org-table-named-field-locations - (append org-table-named-field-locations al)) - (setq org-table-local-parameters - (append org-table-local-parameters al2)))))) - -;;;###autoload -(defun org-table-maybe-eval-formula () - "Check if the current field starts with \"=\" or \":=\". -If yes, store the formula and apply it." - ;; We already know we are in a table. Get field will only return a formula - ;; when appropriate. It might return a separator line, but no problem. - (when org-table-formula-evaluate-inline - (let* ((field (org-trim (or (org-table-get-field) ""))) - named eq) - (when (string-match "^:?=\\(.*[^=]\\)$" field) - (setq named (equal (string-to-char field) ?:) - eq (match-string 1 field)) - (if (or (fboundp 'calc-eval) - (equal (substring eq 0 (min 2 (length eq))) "'(")) - (org-table-eval-formula (if named '(4) nil) - (org-table-formula-from-user eq)) - (user-error "Calc does not seem to be installed, and is needed to evaluate the formula")))))) - -(defvar org-recalc-commands nil - "List of commands triggering the recalculation of a line. -Will be filled automatically during use.") - -(defvar org-recalc-marks - '((" " . "Unmarked: no special line, no automatic recalculation") - ("#" . "Automatically recalculate this line upon TAB, RET, and C-c C-c in the line") - ("*" . "Recalculate only when entire table is recalculated with `C-u C-c *'") - ("!" . "Column name definition line. Reference in formula as $name.") - ("$" . "Parameter definition line name=value. Reference in formula as $name.") - ("_" . "Names for values in row below this one.") - ("^" . "Names for values in row above this one."))) - -;;;###autoload -(defun org-table-rotate-recalc-marks (&optional newchar) - "Rotate the recalculation mark in the first column. -If in any row, the first field is not consistent with a mark, -insert a new column for the markers. -When there is an active region, change all the lines in the region, -after prompting for the marking character. -After each change, a message will be displayed indicating the meaning -of the new mark." - (interactive) - (unless (org-at-table-p) (user-error "Not at a table")) - (let* ((marks (append (mapcar 'car org-recalc-marks) '(" "))) - (beg (org-table-begin)) - (end (org-table-end)) - (l (org-current-line)) - (l1 (if (org-region-active-p) (org-current-line (region-beginning)))) - (l2 (if (org-region-active-p) (org-current-line (region-end)))) - (have-col - (save-excursion - (goto-char beg) - (not (re-search-forward "^[ \t]*|[^-|][^|]*[^#!$*_^| \t][^|]*|" end t)))) - (col (org-table-current-column)) - (forcenew (car (assoc newchar org-recalc-marks))) - epos new) - (when l1 - (message "Change region to what mark? Type # * ! $ or SPC: ") - (setq newchar (char-to-string (read-char-exclusive)) - forcenew (car (assoc newchar org-recalc-marks)))) - (if (and newchar (not forcenew)) - (user-error "Invalid NEWCHAR `%s' in `org-table-rotate-recalc-marks'" - newchar)) - (if l1 (org-goto-line l1)) - (save-excursion - (beginning-of-line 1) - (unless (looking-at org-table-dataline-regexp) - (user-error "Not at a table data line"))) - (unless have-col - (org-table-goto-column 1) - (org-table-insert-column) - (org-table-goto-column (1+ col))) - (setq epos (point-at-eol)) - (save-excursion - (beginning-of-line 1) - (org-table-get-field - 1 (if (looking-at "^[ \t]*| *\\([#!$*^_ ]\\) *|") - (concat " " - (setq new (or forcenew - (cadr (member (match-string 1) marks)))) - " ") - " # "))) - (if (and l1 l2) - (progn - (org-goto-line l1) - (while (progn (beginning-of-line 2) (not (= (org-current-line) l2))) - (and (looking-at org-table-dataline-regexp) - (org-table-get-field 1 (concat " " new " ")))) - (org-goto-line l1))) - (if (not (= epos (point-at-eol))) (org-table-align)) - (org-goto-line l) - (and (org-called-interactively-p 'interactive) - (message "%s" (cdr (assoc new org-recalc-marks)))))) - -;;;###autoload -(defun org-table-maybe-recalculate-line () - "Recompute the current line if marked for it, and if we haven't just done it." - (interactive) - (and org-table-allow-automatic-line-recalculation - (not (and (memq last-command org-recalc-commands) - (equal org-last-recalc-line (org-current-line)))) - (save-excursion (beginning-of-line 1) - (looking-at org-table-auto-recalculate-regexp)) - (org-table-recalculate) t)) - -(defvar org-tbl-calc-modes) ;; Dynamically bound in `org-table-eval-formula' -(defsubst org-set-calc-mode (var &optional value) - (if (stringp var) - (setq var (assoc var '(("D" calc-angle-mode deg) - ("R" calc-angle-mode rad) - ("F" calc-prefer-frac t) - ("S" calc-symbolic-mode t))) - value (nth 2 var) var (nth 1 var))) - (if (memq var org-tbl-calc-modes) - (setcar (cdr (memq var org-tbl-calc-modes)) value) - (cons var (cons value org-tbl-calc-modes))) - org-tbl-calc-modes) - -;;;###autoload -(defun org-table-eval-formula (&optional arg equation - suppress-align suppress-const - suppress-store suppress-analysis) - "Replace the table field value at the cursor by the result of a calculation. - -This function makes use of Dave Gillespie's Calc package, in my view the -most exciting program ever written for GNU Emacs. So you need to have Calc -installed in order to use this function. - -In a table, this command replaces the value in the current field with the -result of a formula. It also installs the formula as the \"current\" column -formula, by storing it in a special line below the table. When called -with a `C-u' prefix, the current field must be a named field, and the -formula is installed as valid in only this specific field. - -When called with two `C-u' prefixes, insert the active equation -for the field back into the current field, so that it can be -edited there. This is useful in order to use \\[org-table-show-reference] -to check the referenced fields. - -When called, the command first prompts for a formula, which is read in -the minibuffer. Previously entered formulas are available through the -history list, and the last used formula is offered as a default. -These stored formulas are adapted correctly when moving, inserting, or -deleting columns with the corresponding commands. - -The formula can be any algebraic expression understood by the Calc package. -For details, see the Org-mode manual. - -This function can also be called from Lisp programs and offers -additional arguments: EQUATION can be the formula to apply. If this -argument is given, the user will not be prompted. SUPPRESS-ALIGN is -used to speed-up recursive calls by by-passing unnecessary aligns. -SUPPRESS-CONST suppresses the interpretation of constants in the -formula, assuming that this has been done already outside the function. -SUPPRESS-STORE means the formula should not be stored, either because -it is already stored, or because it is a modified equation that should -not overwrite the stored one." - (interactive "P") - (org-table-check-inside-data-field) - (or suppress-analysis (org-table-get-specials)) - (if (equal arg '(16)) - (let ((eq (org-table-current-field-formula))) - (or eq (user-error "No equation active for current field")) - (org-table-get-field nil eq) - (org-table-align) - (setq org-table-may-need-update t)) - (let* (fields - (ndown (if (integerp arg) arg 1)) - (org-table-automatic-realign nil) - (case-fold-search nil) - (down (> ndown 1)) - (formula (if (and equation suppress-store) - equation - (org-table-get-formula equation (equal arg '(4))))) - (n0 (org-table-current-column)) - (org-tbl-calc-modes (copy-sequence org-calc-default-modes)) - (numbers nil) ; was a variable, now fixed default - (keep-empty nil) - n form form0 formrpl formrg bw fmt x ev orig c lispp literal - duration duration-output-format) - ;; Parse the format string. Since we have a lot of modes, this is - ;; a lot of work. However, I think calc still uses most of the time. - (if (string-match ";" formula) - (let ((tmp (org-split-string formula ";"))) - (setq formula (car tmp) - fmt (concat (cdr (assoc "%" org-table-local-parameters)) - (nth 1 tmp))) - (while (string-match "\\([pnfse]\\)\\(-?[0-9]+\\)" fmt) - (setq c (string-to-char (match-string 1 fmt)) - n (string-to-number (match-string 2 fmt))) - (if (= c ?p) - (setq org-tbl-calc-modes (org-set-calc-mode 'calc-internal-prec n)) - (setq org-tbl-calc-modes - (org-set-calc-mode - 'calc-float-format - (list (cdr (assoc c '((?n . float) (?f . fix) - (?s . sci) (?e . eng)))) - n)))) - (setq fmt (replace-match "" t t fmt))) - (if (string-match "T" fmt) - (setq duration t numbers t - duration-output-format nil - fmt (replace-match "" t t fmt))) - (if (string-match "t" fmt) - (setq duration t - duration-output-format org-table-duration-custom-format - numbers t - fmt (replace-match "" t t fmt))) - (if (string-match "N" fmt) - (setq numbers t - fmt (replace-match "" t t fmt))) - (if (string-match "L" fmt) - (setq literal t - fmt (replace-match "" t t fmt))) - (if (string-match "E" fmt) - (setq keep-empty t - fmt (replace-match "" t t fmt))) - (while (string-match "[DRFS]" fmt) - (setq org-tbl-calc-modes (org-set-calc-mode (match-string 0 fmt))) - (setq fmt (replace-match "" t t fmt))) - (unless (string-match "\\S-" fmt) - (setq fmt nil)))) - (if (and (not suppress-const) org-table-formula-use-constants) - (setq formula (org-table-formula-substitute-names formula))) - (setq orig (or (get-text-property 1 :orig-formula formula) "?")) - (while (> ndown 0) - (setq fields (org-split-string - (buffer-substring-no-properties (point-at-bol) (point-at-eol)) - " *| *")) - ;; replace fields with duration values if relevant - (if duration - (setq fields - (mapcar (lambda (x) (org-table-time-string-to-seconds x)) - fields))) - (if (eq numbers t) - (setq fields (mapcar - (lambda (x) - (if (string-match "\\S-" x) - (number-to-string (string-to-number x)) - x)) - fields))) - (setq ndown (1- ndown)) - (setq form (copy-sequence formula) - lispp (and (> (length form) 2) (equal (substring form 0 2) "'("))) - (if (and lispp literal) (setq lispp 'literal)) - - ;; Insert row and column number of formula result field - (while (string-match "[@$]#" form) - (setq form - (replace-match - (format "%d" - (save-match-data - (if (equal (substring form (match-beginning 0) - (1+ (match-beginning 0))) - "@") - (org-table-current-dline) - (org-table-current-column)))) - t t form))) - - ;; Check for old vertical references - (setq form (org-table-rewrite-old-row-references form)) - ;; Insert remote references - (while (string-match "\\<remote([ \t]*\\([-_a-zA-Z0-9]+\\)[ \t]*,[ \t]*\\([^\n)]+\\))" form) - (setq form - (replace-match - (save-match-data - (org-table-make-reference - (let ((rmtrng (org-table-get-remote-range - (match-string 1 form) (match-string 2 form)))) - (if duration - (if (listp rmtrng) - (mapcar (lambda(x) (org-table-time-string-to-seconds x)) rmtrng) - (org-table-time-string-to-seconds rmtrng)) - rmtrng)) - keep-empty numbers lispp)) - t t form))) - ;; Insert complex ranges - (while (and (string-match org-table-range-regexp form) - (> (length (match-string 0 form)) 1)) - (setq formrg (save-match-data - (org-table-get-range (match-string 0 form) nil n0))) - (setq formrpl - (save-match-data - (org-table-make-reference - ;; possibly handle durations - (if duration - (if (listp formrg) - (mapcar (lambda(x) (org-table-time-string-to-seconds x)) formrg) - (org-table-time-string-to-seconds formrg)) - formrg) - keep-empty numbers lispp))) - (if (not (save-match-data - (string-match (regexp-quote form) formrpl))) - (setq form (replace-match formrpl t t form)) - (user-error "Spreadsheet error: invalid reference \"%s\"" form))) - ;; Insert simple ranges - (while (string-match "\\$\\([0-9]+\\)\\.\\.\\$\\([0-9]+\\)" form) - (setq form - (replace-match - (save-match-data - (org-table-make-reference - (org-sublist - fields (string-to-number (match-string 1 form)) - (string-to-number (match-string 2 form))) - keep-empty numbers lispp)) - t t form))) - (setq form0 form) - ;; Insert the references to fields in same row - (while (string-match "\\$\\(\\([-+]\\)?[0-9]+\\)" form) - (setq n (+ (string-to-number (match-string 1 form)) - (if (match-end 2) n0 0)) - x (nth (1- (if (= n 0) n0 (max n 1))) fields)) - (unless x (user-error "Invalid field specifier \"%s\"" - (match-string 0 form))) - (setq form (replace-match - (save-match-data - (org-table-make-reference - x keep-empty numbers lispp)) - t t form))) - - (if lispp - (setq ev (condition-case nil - (eval (eval (read form))) - (error "#ERROR")) - ev (if (numberp ev) (number-to-string ev) ev) - ev (if duration (org-table-time-seconds-to-string - (string-to-number ev) - duration-output-format) ev)) - (or (fboundp 'calc-eval) - (user-error "Calc does not seem to be installed, and is needed to evaluate the formula")) - ;; Use <...> time-stamps so that Calc can handle them - (setq form (replace-regexp-in-string org-ts-regexp3 "<\\1>" form)) - ;; I18n-ize local time-stamps by setting (system-time-locale "C") - (when (string-match org-ts-regexp2 form) - (let* ((ts (match-string 0 form)) - (tsp (apply 'encode-time (save-match-data (org-parse-time-string ts)))) - (system-time-locale "C") - (tf (or (and (save-match-data (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts)) - (cdr org-time-stamp-formats)) - (car org-time-stamp-formats)))) - (setq form (replace-match (format-time-string tf tsp) t t form)))) - - (setq ev (if (and duration (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" form)) - form - (calc-eval (cons form org-tbl-calc-modes) - (when (and (not keep-empty) numbers) 'num))) - ev (if duration (org-table-time-seconds-to-string - (if (string-match "^[0-9]+:[0-9]+\\(?::[0-9]+\\)?$" ev) - (string-to-number (org-table-time-string-to-seconds ev)) - (string-to-number ev)) - duration-output-format) - ev))) - - (when org-table-formula-debug - (with-output-to-temp-buffer "*Substitution History*" - (princ (format "Substitution history of formula -Orig: %s -$xyz-> %s -@r$c-> %s -$1-> %s\n" orig formula form0 form)) - (if (listp ev) - (princ (format " %s^\nError: %s" - (make-string (car ev) ?\-) (nth 1 ev))) - (princ (format "Result: %s\nFormat: %s\nFinal: %s" - ev (or fmt "NONE") - (if fmt (format fmt (string-to-number ev)) ev))))) - (setq bw (get-buffer-window "*Substitution History*")) - (org-fit-window-to-buffer bw) - (unless (and (org-called-interactively-p 'any) (not ndown)) - (unless (let (inhibit-redisplay) - (y-or-n-p "Debugging Formula. Continue to next? ")) - (org-table-align) - (user-error "Abort")) - (delete-window bw) - (message ""))) - (if (listp ev) (setq fmt nil ev "#ERROR")) - (org-table-justify-field-maybe - (format org-table-formula-field-format - (if fmt (format fmt (string-to-number ev)) ev))) - (if (and down (> ndown 0) (looking-at ".*\n[ \t]*|[^-]")) - (call-interactively 'org-return) - (setq ndown 0))) - (and down (org-table-maybe-recalculate-line)) - (or suppress-align (and org-table-may-need-update - (org-table-align)))))) - -(defun org-table-put-field-property (prop value) - (save-excursion - (put-text-property (progn (skip-chars-backward "^|") (point)) - (progn (skip-chars-forward "^|") (point)) - prop value))) - -(defun org-table-get-range (desc &optional tbeg col highlight corners-only) - "Get a calc vector from a column, according to descriptor DESC. -Optional arguments TBEG and COL can give the beginning of the table and -the current column, to avoid unnecessary parsing. - -HIGHLIGHT means just highlight the range. - -When CORNERS-ONLY is set, only return the corners of the range as -a list (line1 column1 line2 column2) where line1 and line2 are line numbers -in the buffer and column1 and column2 are table column numbers." - (if (not (equal (string-to-char desc) ?@)) - (setq desc (concat "@" desc))) - (save-excursion - (or tbeg (setq tbeg (org-table-begin))) - (or col (setq col (org-table-current-column))) - (let ((thisline (org-current-line)) - beg end c1 c2 r1 r2 rangep tmp) - (unless (string-match org-table-range-regexp desc) - (user-error "Invalid table range specifier `%s'" desc)) - (setq rangep (match-end 3) - r1 (and (match-end 1) (match-string 1 desc)) - r2 (and (match-end 4) (match-string 4 desc)) - c1 (and (match-end 2) (substring (match-string 2 desc) 1)) - c2 (and (match-end 5) (substring (match-string 5 desc) 1))) - - (and c1 (setq c1 (+ (string-to-number c1) - (if (memq (string-to-char c1) '(?- ?+)) col 0)))) - (and c2 (setq c2 (+ (string-to-number c2) - (if (memq (string-to-char c2) '(?- ?+)) col 0)))) - (if (equal r1 "") (setq r1 nil)) - (if (equal r2 "") (setq r2 nil)) - (if r1 (setq r1 (org-table-get-descriptor-line r1))) - (if r2 (setq r2 (org-table-get-descriptor-line r2))) - ; (setq r2 (or r2 r1) c2 (or c2 c1)) - (if (not r1) (setq r1 thisline)) - (if (not r2) (setq r2 thisline)) - (if (or (not c1) (= 0 c1)) (setq c1 col)) - (if (or (not c2) (= 0 c2)) (setq c2 col)) - (if (and (not corners-only) - (or (not rangep) (and (= r1 r2) (= c1 c2)))) - ;; just one field - (progn - (org-goto-line r1) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 2)) - (prog1 (org-trim (org-table-get-field c1)) - (if highlight (org-table-highlight-rectangle (point) (point))))) - ;; A range, return a vector - ;; First sort the numbers to get a regular rectangle - (if (< r2 r1) (setq tmp r1 r1 r2 r2 tmp)) - (if (< c2 c1) (setq tmp c1 c1 c2 c2 tmp)) - (if corners-only - ;; Only return the corners of the range - (list r1 c1 r2 c2) - ;; Copy the range values into a list - (org-goto-line r1) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 2)) - (org-table-goto-column c1) - (setq beg (point)) - (org-goto-line r2) - (while (not (looking-at org-table-dataline-regexp)) - (beginning-of-line 0)) - (org-table-goto-column c2) - (setq end (point)) - (if highlight - (org-table-highlight-rectangle - beg (progn (skip-chars-forward "^|\n") (point)))) - ;; return string representation of calc vector - (mapcar 'org-trim - (apply 'append (org-table-copy-region beg end)))))))) - -(defun org-table-get-descriptor-line (desc &optional cline bline table) - "Analyze descriptor DESC and retrieve the corresponding line number. -The cursor is currently in line CLINE, the table begins in line BLINE, -and TABLE is a vector with line types." - (if (string-match "^[0-9]+$" desc) - (aref org-table-dlines (string-to-number desc)) - (setq cline (or cline (org-current-line)) - bline (or bline org-table-current-begin-line) - table (or table org-table-current-line-types)) - (if (or - (not (string-match "^\\(\\([-+]\\)?\\(I+\\)\\)?\\(\\([-+]\\)?\\([0-9]+\\)\\)?" desc)) - ;; 1 2 3 4 5 6 - (and (not (match-end 3)) (not (match-end 6))) - (and (match-end 3) (match-end 6) (not (match-end 5)))) - (user-error "Invalid row descriptor `%s'" desc)) - (let* ((hdir (and (match-end 2) (match-string 2 desc))) - (hn (if (match-end 3) (- (match-end 3) (match-beginning 3)) nil)) - (odir (and (match-end 5) (match-string 5 desc))) - (on (if (match-end 6) (string-to-number (match-string 6 desc)))) - (i (- cline bline)) - (rel (and (match-end 6) - (or (and (match-end 1) (not (match-end 3))) - (match-end 5))))) - (if (and hn (not hdir)) - (progn - (setq i 0 hdir "+") - (if (eq (aref table 0) 'hline) (setq hn (1- hn))))) - (if (and (not hn) on (not odir)) - (user-error "Should never happen");;(aref org-table-dlines on) - (if (and hn (> hn 0)) - (setq i (org-table-find-row-type table i 'hline (equal hdir "-") - nil hn cline desc))) - (if on - (setq i (org-table-find-row-type table i 'dline (equal odir "-") - rel on cline desc))) - (+ bline i))))) - -(defun org-table-find-row-type (table i type backwards relative n cline desc) - "FIXME: Needs more documentation." - (let ((l (length table))) - (while (> n 0) - (while (and (setq i (+ i (if backwards -1 1))) - (>= i 0) (< i l) - (not (eq (aref table i) type)) - (if (and relative (eq (aref table i) 'hline)) - (cond - ((eq org-table-relative-ref-may-cross-hline t) t) - ((eq org-table-relative-ref-may-cross-hline 'error) - (user-error "Row descriptor %s used in line %d crosses hline" desc cline)) - (t (setq i (- i (if backwards -1 1)) - n 1) - nil)) - t))) - (setq n (1- n))) - (if (or (< i 0) (>= i l)) - (user-error "Row descriptor %s used in line %d leads outside table" - desc cline) - i))) - -(defun org-table-rewrite-old-row-references (s) - (if (string-match "&[-+0-9I]" s) - (user-error "Formula contains old &row reference, please rewrite using @-syntax") - s)) - -(defun org-table-make-reference (elements keep-empty numbers lispp) - "Convert list ELEMENTS to something appropriate to insert into formula. -KEEP-EMPTY indicated to keep empty fields, default is to skip them. -NUMBERS indicates that everything should be converted to numbers. -LISPP non-nil means to return something appropriate for a Lisp -list, 'literal is for the format specifier L." - ;; Calc nan (not a number) is used for the conversion of the empty - ;; field to a reference for several reasons: (i) It is accepted in a - ;; Calc formula (e. g. "" or "()" would result in a Calc error). - ;; (ii) In a single field (not in range) it can be distinguished - ;; from "(nan)" which is the reference made from a single field - ;; containing "nan". - (if (stringp elements) - ;; field reference - (if lispp - (if (eq lispp 'literal) - elements - (if (and (eq elements "") (not keep-empty)) - "" - (prin1-to-string - (if numbers (string-to-number elements) elements)))) - (if (string-match "\\S-" elements) - (progn - (when numbers (setq elements (number-to-string - (string-to-number elements)))) - (concat "(" elements ")")) - (if (or (not keep-empty) numbers) "(0)" "nan"))) - ;; range reference - (unless keep-empty - (setq elements - (delq nil - (mapcar (lambda (x) (if (string-match "\\S-" x) x nil)) - elements)))) - (setq elements (or elements '())) ; if delq returns nil then we need '() - (if lispp - (mapconcat - (lambda (x) - (if (eq lispp 'literal) - x - (prin1-to-string (if numbers (string-to-number x) x)))) - elements " ") - (concat "[" (mapconcat - (lambda (x) - (if (string-match "\\S-" x) - (if numbers - (number-to-string (string-to-number x)) - x) - (if (or (not keep-empty) numbers) "0" "nan"))) - elements - ",") "]")))) - -;;;###autoload -(defun org-table-set-constants () - "Set `org-table-formula-constants-local' in the current buffer." - (let (cst consts const-str) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t) - (setq const-str (substring-no-properties (match-string 1))) - (setq consts (append consts (org-split-string const-str "[ \t]+"))) - (when consts - (let (e) - (while (setq e (pop consts)) - (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) - (if (assoc-string (match-string 1 e) cst) - (setq cst (delete (assoc-string (match-string 1 e) cst) cst))) - (push (cons (match-string 1 e) (match-string 2 e)) cst))) - (setq org-table-formula-constants-local cst))))))) - -;;;###autoload -(defun org-table-recalculate (&optional all noalign) - "Recalculate the current table line by applying all stored formulas. -With prefix arg ALL, do this for all lines in the table. -With the prefix argument ALL is `(16)' \ -\(a double \\[universal-prefix] \\[universal-prefix] prefix), or if -it is the symbol `iterate', recompute the table until it no longer changes. -If NOALIGN is not nil, do not re-align the table after the computations -are done. This is typically used internally to save time, if it is -known that the table will be realigned a little later anyway." - (interactive "P") - (or (memq this-command org-recalc-commands) - (setq org-recalc-commands (cons this-command org-recalc-commands))) - (unless (org-at-table-p) (user-error "Not at a table")) - (if (or (eq all 'iterate) (equal all '(16))) - (org-table-iterate) - (org-table-get-specials) - (let* ((eqlist (sort (org-table-get-stored-formulas) - (lambda (a b) (string< (car a) (car b))))) - (eqlist1 (copy-sequence eqlist)) - (inhibit-redisplay (not debug-on-error)) - (line-re org-table-dataline-regexp) - (thisline (org-current-line)) - (thiscol (org-table-current-column)) - seen-fields lhs1 - beg end entry eqlnum eqlname eqlname1 eql (cnt 0) eq a name name1) - ;; Insert constants in all formulas - (setq eqlist - (mapcar (lambda (x) - (when (string-match "\\`$[<>]" (car x)) - (setq lhs1 (car x)) - (setq x (cons (substring - (org-table-formula-handle-first/last-rc - (car x)) 1) - (cdr x))) - (if (assoc (car x) eqlist1) - (user-error "\"%s=\" formula tries to overwrite existing formula for column %s" - lhs1 (car x)))) - (cons - (org-table-formula-handle-first/last-rc (car x)) - (org-table-formula-substitute-names - (org-table-formula-handle-first/last-rc (cdr x))))) - eqlist)) - ;; Split the equation list - (while (setq eq (pop eqlist)) - (if (<= (string-to-char (car eq)) ?9) - (push eq eqlnum) - (push eq eqlname))) - (setq eqlnum (nreverse eqlnum) eqlname (nreverse eqlname)) - ;; Expand ranges in lhs of formulas - (setq eqlname (org-table-expand-lhs-ranges eqlname)) - - ;; Get the correct line range to process - (if all - (progn - (setq end (move-marker (make-marker) (1+ (org-table-end)))) - (goto-char (setq beg (org-table-begin))) - (if (re-search-forward org-table-calculate-mark-regexp end t) - ;; This is a table with marked lines, compute selected lines - (setq line-re org-table-recalculate-regexp) - ;; Move forward to the first non-header line - (if (and (re-search-forward org-table-dataline-regexp end t) - (re-search-forward org-table-hline-regexp end t) - (re-search-forward org-table-dataline-regexp end t)) - (setq beg (match-beginning 0)) - nil))) ;; just leave beg where it is - (setq beg (point-at-bol) - end (move-marker (make-marker) (1+ (point-at-eol))))) - (goto-char beg) - (and all (message "Re-applying formulas to full table...")) - - ;; First find the named fields, and mark them untouchable. - ;; Also check if several field/range formulas try to set the same field. - (remove-text-properties beg end '(org-untouchable t)) - (while (setq eq (pop eqlname)) - (setq name (car eq) - a (assoc name org-table-named-field-locations)) - (setq name1 name) - (if a (setq name1 (format "@%d$%d" (org-table-line-to-dline (nth 1 a)) - (nth 2 a)))) - (when (member name1 seen-fields) - (user-error "Several field/range formulas try to set %s" name1)) - (push name1 seen-fields) - - (and (not a) - (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" name) - (setq a (list name - (condition-case nil - (aref org-table-dlines - (string-to-number (match-string 1 name))) - (error (user-error "Invalid row number in %s" - name))) - (string-to-number (match-string 2 name))))) - (when (and a (or all (equal (nth 1 a) thisline))) - (message "Re-applying formula to field: %s" name) - (org-goto-line (nth 1 a)) - (org-table-goto-column (nth 2 a)) - (push (append a (list (cdr eq))) eqlname1) - (org-table-put-field-property :org-untouchable t))) - (setq eqlname1 (nreverse eqlname1)) - - ;; Now evaluate the column formulas, but skip fields covered by - ;; field formulas - (goto-char beg) - (while (re-search-forward line-re end t) - (unless (string-match "^ *[_^!$/] *$" (org-table-get-field 1)) - ;; Unprotected line, recalculate - (and all (message "Re-applying formulas to full table...(line %d)" - (setq cnt (1+ cnt)))) - (setq org-last-recalc-line (org-current-line)) - (setq eql eqlnum) - (while (setq entry (pop eql)) - (org-goto-line org-last-recalc-line) - (org-table-goto-column (string-to-number (car entry)) nil 'force) - (unless (get-text-property (point) :org-untouchable) - (org-table-eval-formula nil (cdr entry) - 'noalign 'nocst 'nostore 'noanalysis))))) - - ;; Now evaluate the field formulas - (while (setq eq (pop eqlname1)) - (message "Re-applying formula to field: %s" (car eq)) - (org-goto-line (nth 1 eq)) - (org-table-goto-column (nth 2 eq)) - (org-table-eval-formula nil (nth 3 eq) 'noalign 'nocst - 'nostore 'noanalysis)) - - (org-goto-line thisline) - (org-table-goto-column thiscol) - (remove-text-properties (point-min) (point-max) '(org-untouchable t)) - (or noalign (and org-table-may-need-update (org-table-align)) - (and all (message "Re-applying formulas to %d lines...done" cnt))) - - ;; back to initial position - (message "Re-applying formulas...done") - (org-goto-line thisline) - (org-table-goto-column thiscol) - (or noalign (and org-table-may-need-update (org-table-align)) - (and all (message "Re-applying formulas...done")))))) - -;;;###autoload -(defun org-table-iterate (&optional arg) - "Recalculate the table until it does not change anymore. -The maximum number of iterations is 10, but you can choose a different value -with the prefix ARG." - (interactive "P") - (let ((imax (if arg (prefix-numeric-value arg) 10)) - (i 0) - (lasttbl (buffer-substring (org-table-begin) (org-table-end))) - thistbl) - (catch 'exit - (while (< i imax) - (setq i (1+ i)) - (org-table-recalculate 'all) - (setq thistbl (buffer-substring (org-table-begin) (org-table-end))) - (if (not (string= lasttbl thistbl)) - (setq lasttbl thistbl) - (if (> i 1) - (message "Convergence after %d iterations" i) - (message "Table was already stable")) - (throw 'exit t))) - (user-error "No convergence after %d iterations" i)))) - -;;;###autoload -(defun org-table-recalculate-buffer-tables () - "Recalculate all tables in the current buffer." - (interactive) - (save-excursion - (save-restriction - (widen) - (org-table-map-tables (lambda () (org-table-recalculate t)) t)))) - -;;;###autoload -(defun org-table-iterate-buffer-tables () - "Iterate all tables in the buffer, to converge inter-table dependencies." - (interactive) - (let* ((imax 10) - (i imax) - (checksum (md5 (buffer-string))) - c1) - (save-excursion - (save-restriction - (widen) - (catch 'exit - (while (> i 0) - (setq i (1- i)) - (org-table-map-tables (lambda () (org-table-recalculate t)) t) - (if (equal checksum (setq c1 (md5 (buffer-string)))) - (progn - (message "Convergence after %d iterations" (- imax i)) - (throw 'exit t)) - (setq checksum c1))) - (user-error "No convergence after %d iterations" imax)))))) - -(defun org-table-calc-current-TBLFM (&optional arg) - "Apply the #+TBLFM in the line at point to the table." - (interactive "P") - (unless (org-at-TBLFM-p) (user-error "Not at a #+TBLFM line")) - (let ((formula (buffer-substring - (point-at-bol) - (point-at-eol))) - s e) - (save-excursion - ;; Insert a temporary formula at right after the table - (goto-char (org-table-TBLFM-begin)) - (setq s (set-marker (make-marker) (point))) - (insert (concat formula "\n")) - (setq e (set-marker (make-marker) (point))) - ;; Recalculate the table - (beginning-of-line 0) ; move to the inserted line - (skip-chars-backward " \r\n\t") - (if (org-at-table-p) - (unwind-protect - (org-call-with-arg 'org-table-recalculate (or arg t)) - ;; delete the formula inserted temporarily - (delete-region s e)))))) - -(defun org-table-TBLFM-begin () - "Find the beginning of the TBLFM lines and return its position. -Return nil when the beginning of TBLFM line was not found." - (save-excursion - (when (progn (forward-line 1) - (re-search-backward - org-table-TBLFM-begin-regexp - nil t)) - (point-at-bol 2)))) - -(defun org-table-expand-lhs-ranges (equations) - "Expand list of formulas. -If some of the RHS in the formulas are ranges or a row reference, expand -them to individual field equations for each field." - (let (e res lhs rhs range r1 r2 c1 c2) - (while (setq e (pop equations)) - (setq lhs (car e) rhs (cdr e)) - (cond - ((string-match "^@-?[-+0-9]+\\$-?[0-9]+$" lhs) - ;; This just refers to one fixed field - (push e res)) - ((string-match "^[a-zA-Z][_a-zA-Z0-9]*$" lhs) - ;; This just refers to one fixed named field - (push e res)) - ((string-match "^@[0-9]+$" lhs) - (loop for ic from 1 to org-table-current-ncol do - (push (cons (format "%s$%d" lhs ic) rhs) res) - (put-text-property 0 (length (caar res)) - :orig-eqn e (caar res)))) - (t - (setq range (org-table-get-range lhs org-table-current-begin-pos - 1 nil 'corners)) - (setq r1 (nth 0 range) c1 (nth 1 range) - r2 (nth 2 range) c2 (nth 3 range)) - (setq r1 (org-table-line-to-dline r1)) - (setq r2 (org-table-line-to-dline r2 'above)) - (loop for ir from r1 to r2 do - (loop for ic from c1 to c2 do - (push (cons (format "@%d$%d" ir ic) rhs) res) - (put-text-property 0 (length (caar res)) - :orig-eqn e (caar res))))))) - (nreverse res))) - -(defun org-table-formula-handle-first/last-rc (s) - "Replace @<, @>, $<, $> with first/last row/column of the table. -So @< and $< will always be replaced with @1 and $1, respectively. -The advantage of these special markers are that structure editing of -the table will not change them, while @1 and $1 will be modified -when a line/row is swapped out of that privileged position. So for -formulas that use a range of rows or columns, it may often be better -to anchor the formula with \"I\" row markers, or to offset from the -borders of the table using the @< @> $< $> makers." - (let (n nmax len char (start 0)) - (while (string-match "\\([@$]\\)\\(<+\\|>+\\)\\|\\(remote([^\)]+)\\)" - s start) - (if (match-end 3) - (setq start (match-end 3)) - (setq nmax (if (equal (match-string 1 s) "@") - (1- (length org-table-dlines)) - org-table-current-ncol) - len (- (match-end 2) (match-beginning 2)) - char (string-to-char (match-string 2 s)) - n (if (= char ?<) - len - (- nmax len -1))) - (if (or (< n 1) (> n nmax)) - (user-error "Reference \"%s\" in expression \"%s\" points outside table" - (match-string 0 s) s)) - (setq start (match-beginning 0)) - (setq s (replace-match (format "%s%d" (match-string 1 s) n) t t s))))) - s) - -(defun org-table-formula-substitute-names (f) - "Replace $const with values in string F." - (let ((start 0) a (f1 f) (pp (/= (string-to-char f) ?'))) - ;; First, check for column names - (while (setq start (string-match org-table-column-name-regexp f start)) - (setq start (1+ start)) - (setq a (assoc (match-string 1 f) org-table-column-names)) - (setq f (replace-match (concat "$" (cdr a)) t t f))) - ;; Parameters and constants - (setq start 0) - (while (setq start (string-match "\\$\\([a-zA-Z][_a-zA-Z0-9]*\\)\\|\\(\\<remote([^)]*)\\)" f start)) - (if (match-end 2) - (setq start (match-end 2)) - (setq start (1+ start)) - (if (setq a (save-match-data - (org-table-get-constant (match-string 1 f)))) - (setq f (replace-match - (concat (if pp "(") a (if pp ")")) t t f))))) - (if org-table-formula-debug - (put-text-property 0 (length f) :orig-formula f1 f)) - f)) - -(defun org-table-get-constant (const) - "Find the value for a parameter or constant in a formula. -Parameters get priority." - (or (cdr (assoc const org-table-local-parameters)) - (cdr (assoc const org-table-formula-constants-local)) - (cdr (assoc const org-table-formula-constants)) - (and (fboundp 'constants-get) (constants-get const)) - (and (string= (substring const 0 (min 5 (length const))) "PROP_") - (org-entry-get nil (substring const 5) 'inherit)) - "#UNDEFINED_NAME")) - -(defvar org-table-fedit-map - (let ((map (make-sparse-keymap))) - (org-defkey map "\C-x\C-s" 'org-table-fedit-finish) - (org-defkey map "\C-c\C-s" 'org-table-fedit-finish) - (org-defkey map "\C-c\C-c" 'org-table-fedit-finish) - (org-defkey map "\C-c'" 'org-table-fedit-finish) - (org-defkey map "\C-c\C-q" 'org-table-fedit-abort) - (org-defkey map "\C-c?" 'org-table-show-reference) - (org-defkey map [(meta shift up)] 'org-table-fedit-line-up) - (org-defkey map [(meta shift down)] 'org-table-fedit-line-down) - (org-defkey map [(shift up)] 'org-table-fedit-ref-up) - (org-defkey map [(shift down)] 'org-table-fedit-ref-down) - (org-defkey map [(shift left)] 'org-table-fedit-ref-left) - (org-defkey map [(shift right)] 'org-table-fedit-ref-right) - (org-defkey map [(meta up)] 'org-table-fedit-scroll-down) - (org-defkey map [(meta down)] 'org-table-fedit-scroll) - (org-defkey map [(meta tab)] 'lisp-complete-symbol) - (org-defkey map "\M-\C-i" 'lisp-complete-symbol) - (org-defkey map [(tab)] 'org-table-fedit-lisp-indent) - (org-defkey map "\C-i" 'org-table-fedit-lisp-indent) - (org-defkey map "\C-c\C-r" 'org-table-fedit-toggle-ref-type) - (org-defkey map "\C-c}" 'org-table-fedit-toggle-coordinates) - map)) - -(easy-menu-define org-table-fedit-menu org-table-fedit-map "Org Edit Formulas Menu" - '("Edit-Formulas" - ["Finish and Install" org-table-fedit-finish t] - ["Finish, Install, and Apply" (org-table-fedit-finish t) :keys "C-u C-c C-c"] - ["Abort" org-table-fedit-abort t] - "--" - ["Pretty-Print Lisp Formula" org-table-fedit-lisp-indent t] - ["Complete Lisp Symbol" lisp-complete-symbol t] - "--" - "Shift Reference at Point" - ["Up" org-table-fedit-ref-up t] - ["Down" org-table-fedit-ref-down t] - ["Left" org-table-fedit-ref-left t] - ["Right" org-table-fedit-ref-right t] - "-" - "Change Test Row for Column Formulas" - ["Up" org-table-fedit-line-up t] - ["Down" org-table-fedit-line-down t] - "--" - ["Scroll Table Window" org-table-fedit-scroll t] - ["Scroll Table Window down" org-table-fedit-scroll-down t] - ["Show Table Grid" org-table-fedit-toggle-coordinates - :style toggle :selected (with-current-buffer (marker-buffer org-pos) - org-table-overlay-coordinates)] - "--" - ["Standard Refs (B3 instead of @3$2)" org-table-fedit-toggle-ref-type - :style toggle :selected org-table-buffer-is-an])) - -(defvar org-pos) - -;;;###autoload -(defun org-table-edit-formulas () - "Edit the formulas of the current table in a separate buffer." - (interactive) - (when (save-excursion (beginning-of-line 1) (let ((case-fold-search t)) (looking-at "[ \t]*#\\+TBLFM"))) - (beginning-of-line 0)) - (unless (org-at-table-p) (user-error "Not at a table")) - (org-table-get-specials) - (let ((key (org-table-current-field-formula 'key 'noerror)) - (eql (sort (org-table-get-stored-formulas 'noerror) - 'org-table-formula-less-p)) - (pos (point-marker)) - (startline 1) - (wc (current-window-configuration)) - (sel-win (selected-window)) - (titles '((column . "# Column Formulas\n") - (field . "# Field and Range Formulas\n") - (named . "# Named Field Formulas\n"))) - entry s type title) - (org-switch-to-buffer-other-window "*Edit Formulas*") - (erase-buffer) - ;; Keep global-font-lock-mode from turning on font-lock-mode - (let ((font-lock-global-modes '(not fundamental-mode))) - (fundamental-mode)) - (org-set-local 'font-lock-global-modes (list 'not major-mode)) - (org-set-local 'org-pos pos) - (org-set-local 'org-window-configuration wc) - (org-set-local 'org-selected-window sel-win) - (use-local-map org-table-fedit-map) - (org-add-hook 'post-command-hook 'org-table-fedit-post-command t t) - (easy-menu-add org-table-fedit-menu) - (setq startline (org-current-line)) - (while (setq entry (pop eql)) - (setq type (cond - ((string-match "\\`$[<>]" (car entry)) 'column) - ((equal (string-to-char (car entry)) ?@) 'field) - ((string-match "^[0-9]" (car entry)) 'column) - (t 'named))) - (when (setq title (assq type titles)) - (or (bobp) (insert "\n")) - (insert (org-add-props (cdr title) nil 'face font-lock-comment-face)) - (setq titles (remove title titles))) - (if (equal key (car entry)) (setq startline (org-current-line))) - (setq s (concat (if (member (string-to-char (car entry)) '(?@ ?$)) "" "$") - (car entry) " = " (cdr entry) "\n")) - (remove-text-properties 0 (length s) '(face nil) s) - (insert s)) - (if (eq org-table-use-standard-references t) - (org-table-fedit-toggle-ref-type)) - (org-goto-line startline) - (message "Edit formulas, finish with `C-c C-c' or `C-c ' '. See menu for more commands."))) - -(defun org-table-fedit-post-command () - (when (not (memq this-command '(lisp-complete-symbol))) - (let ((win (selected-window))) - (save-excursion - (condition-case nil - (org-table-show-reference) - (error nil)) - (select-window win))))) - -(defun org-table-formula-to-user (s) - "Convert a formula from internal to user representation." - (if (eq org-table-use-standard-references t) - (org-table-convert-refs-to-an s) - s)) - -(defun org-table-formula-from-user (s) - "Convert a formula from user to internal representation." - (if org-table-use-standard-references - (org-table-convert-refs-to-rc s) - s)) - -(defun org-table-convert-refs-to-rc (s) - "Convert spreadsheet references from A7 to @7$28. -Works for single references, but also for entire formulas and even the -full TBLFM line." - (let ((start 0)) - (while (string-match "\\<\\([a-zA-Z]+\\)\\([0-9]+\\>\\|&\\)\\|\\(;[^\r\n:]+\\|\\<remote([^,)]*)\\)" s start) - (cond - ((match-end 3) - ;; format match, just advance - (setq start (match-end 0))) - ((and (> (match-beginning 0) 0) - (equal ?. (aref s (max (1- (match-beginning 0)) 0))) - (not (equal ?. (aref s (max (- (match-beginning 0) 2) 0))))) - ;; 3.e5 or something like this. - (setq start (match-end 0))) - ((or (> (- (match-end 1) (match-beginning 1)) 2) - ;; (member (match-string 1 s) - ;; '("arctan" "exp" "expm" "lnp" "log" "stir")) - ) - ;; function name, just advance - (setq start (match-end 0))) - (t - (setq start (match-beginning 0) - s (replace-match - (if (equal (match-string 2 s) "&") - (format "$%d" (org-letters-to-number (match-string 1 s))) - (format "@%d$%d" - (string-to-number (match-string 2 s)) - (org-letters-to-number (match-string 1 s)))) - t t s))))) - s)) - -(defun org-table-convert-refs-to-an (s) - "Convert spreadsheet references from to @7$28 to AB7. -Works for single references, but also for entire formulas and even the -full TBLFM line." - (while (string-match "@\\([0-9]+\\)\\$\\([0-9]+\\)" s) - (setq s (replace-match - (format "%s%d" - (org-number-to-letters - (string-to-number (match-string 2 s))) - (string-to-number (match-string 1 s))) - t t s))) - (while (string-match "\\(^\\|[^0-9a-zA-Z]\\)\\$\\([0-9]+\\)" s) - (setq s (replace-match (concat "\\1" - (org-number-to-letters - (string-to-number (match-string 2 s))) "&") - t nil s))) - s) - -(defun org-letters-to-number (s) - "Convert a base 26 number represented by letters into an integer. -For example: AB -> 28." - (let ((n 0)) - (setq s (upcase s)) - (while (> (length s) 0) - (setq n (+ (* n 26) (string-to-char s) (- ?A) 1) - s (substring s 1))) - n)) - -(defun org-number-to-letters (n) - "Convert an integer into a base 26 number represented by letters. -For example: 28 -> AB." - (let ((s "")) - (while (> n 0) - (setq s (concat (char-to-string (+ (mod (1- n) 26) ?A)) s) - n (/ (1- n) 26))) - s)) - -(defun org-table-time-string-to-seconds (s) - "Convert a time string into numerical duration in seconds. -S can be a string matching either -?HH:MM:SS or -?HH:MM. -If S is a string representing a number, keep this number." - (if (equal s "") - s - (let (hour minus min sec res) - (cond - ((and (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)" s)) - (setq minus (< 0 (length (match-string 1 s))) - hour (string-to-number (match-string 2 s)) - min (string-to-number (match-string 3 s)) - sec (string-to-number (match-string 4 s))) - (if minus - (setq res (- (+ (* hour 3600) (* min 60) sec))) - (setq res (+ (* hour 3600) (* min 60) sec)))) - ((and (not (string-match org-ts-regexp-both s)) - (string-match "\\(-?\\)\\([0-9]+\\):\\([0-9]+\\)" s)) - (setq minus (< 0 (length (match-string 1 s))) - hour (string-to-number (match-string 2 s)) - min (string-to-number (match-string 3 s))) - (if minus - (setq res (- (+ (* hour 3600) (* min 60)))) - (setq res (+ (* hour 3600) (* min 60))))) - (t (setq res (string-to-number s)))) - (number-to-string res)))) - -(defun org-table-time-seconds-to-string (secs &optional output-format) - "Convert a number of seconds to a time string. -If OUTPUT-FORMAT is non-nil, return a number of days, hours, -minutes or seconds." - (let* ((secs0 (abs secs)) - (res - (cond ((eq output-format 'days) - (format "%.3f" (/ (float secs0) 86400))) - ((eq output-format 'hours) - (format "%.2f" (/ (float secs0) 3600))) - ((eq output-format 'minutes) - (format "%.1f" (/ (float secs0) 60))) - ((eq output-format 'seconds) - (format "%d" secs0)) - (t (org-format-seconds "%.2h:%.2m:%.2s" secs0))))) - (if (< secs 0) (concat "-" res) res))) - -(defun org-table-fedit-convert-buffer (function) - "Convert all references in this buffer, using FUNCTION." - (let ((line (org-current-line))) - (goto-char (point-min)) - (while (not (eobp)) - (insert (funcall function (buffer-substring (point) (point-at-eol)))) - (delete-region (point) (point-at-eol)) - (or (eobp) (forward-char 1))) - (org-goto-line line))) - -(defun org-table-fedit-toggle-ref-type () - "Convert all references in the buffer from B3 to @3$2 and back." - (interactive) - (org-set-local 'org-table-buffer-is-an (not org-table-buffer-is-an)) - (org-table-fedit-convert-buffer - (if org-table-buffer-is-an - 'org-table-convert-refs-to-an 'org-table-convert-refs-to-rc)) - (message "Reference type switched to %s" - (if org-table-buffer-is-an "A1 etc" "@row$column"))) - -(defun org-table-fedit-ref-up () - "Shift the reference at point one row/hline up." - (interactive) - (org-table-fedit-shift-reference 'up)) -(defun org-table-fedit-ref-down () - "Shift the reference at point one row/hline down." - (interactive) - (org-table-fedit-shift-reference 'down)) -(defun org-table-fedit-ref-left () - "Shift the reference at point one field to the left." - (interactive) - (org-table-fedit-shift-reference 'left)) -(defun org-table-fedit-ref-right () - "Shift the reference at point one field to the right." - (interactive) - (org-table-fedit-shift-reference 'right)) - -(defun org-table-fedit-shift-reference (dir) - (cond - ((org-at-regexp-p "\\(\\<[a-zA-Z]\\)&") - (if (memq dir '(left right)) - (org-rematch-and-replace 1 (eq dir 'left)) - (user-error "Cannot shift reference in this direction"))) - ((org-at-regexp-p "\\(\\<[a-zA-Z]\\{1,2\\}\\)\\([0-9]+\\)") - ;; A B3-like reference - (if (memq dir '(up down)) - (org-rematch-and-replace 2 (eq dir 'up)) - (org-rematch-and-replace 1 (eq dir 'left)))) - ((org-at-regexp-p - "\\(@\\|\\.\\.\\)\\([-+]?\\(I+\\>\\|[0-9]+\\)\\)\\(\\$\\([-+]?[0-9]+\\)\\)?") - ;; An internal reference - (if (memq dir '(up down)) - (org-rematch-and-replace 2 (eq dir 'up) (match-end 3)) - (org-rematch-and-replace 5 (eq dir 'left)))))) - -(defun org-rematch-and-replace (n &optional decr hline) - "Re-match the group N, and replace it with the shifted reference." - (or (match-end n) (user-error "Cannot shift reference in this direction")) - (goto-char (match-beginning n)) - (and (looking-at (regexp-quote (match-string n))) - (replace-match (org-table-shift-refpart (match-string 0) decr hline) - t t))) - -(defun org-table-shift-refpart (ref &optional decr hline) - "Shift a reference part REF. -If DECR is set, decrease the references row/column, else increase. -If HLINE is set, this may be a hline reference, it certainly is not -a translation reference." - (save-match-data - (let* ((sign (string-match "^[-+]" ref)) n) - - (if sign (setq sign (substring ref 0 1) ref (substring ref 1))) - (cond - ((and hline (string-match "^I+" ref)) - (setq n (string-to-number (concat sign (number-to-string (length ref))))) - (setq n (+ n (if decr -1 1))) - (if (= n 0) (setq n (+ n (if decr -1 1)))) - (if sign - (setq sign (if (< n 0) "-" "+") n (abs n)) - (setq n (max 1 n))) - (concat sign (make-string n ?I))) - - ((string-match "^[0-9]+" ref) - (setq n (string-to-number (concat sign ref))) - (setq n (+ n (if decr -1 1))) - (if sign - (concat (if (< n 0) "-" "+") (number-to-string (abs n))) - (number-to-string (max 1 n)))) - - ((string-match "^[a-zA-Z]+" ref) - (org-number-to-letters - (max 1 (+ (org-letters-to-number ref) (if decr -1 1))))) - - (t (user-error "Cannot shift reference")))))) - -(defun org-table-fedit-toggle-coordinates () - "Toggle the display of coordinates in the referenced table." - (interactive) - (let ((pos (marker-position org-pos))) - (with-current-buffer (marker-buffer org-pos) - (save-excursion - (goto-char pos) - (org-table-toggle-coordinate-overlays))))) - -(defun org-table-fedit-finish (&optional arg) - "Parse the buffer for formula definitions and install them. -With prefix ARG, apply the new formulas to the table." - (interactive "P") - (org-table-remove-rectangle-highlight) - (if org-table-use-standard-references - (progn - (org-table-fedit-convert-buffer 'org-table-convert-refs-to-rc) - (setq org-table-buffer-is-an nil))) - (let ((pos org-pos) (sel-win org-selected-window) eql var form) - (goto-char (point-min)) - (while (re-search-forward - "^\\(@[-+I<>0-9.$@]+\\|@?[0-9]+\\|\\$\\([a-zA-Z0-9]+\\|[<>]+\\)\\) *= *\\(.*\\(\n[ \t]+.*$\\)*\\)" - nil t) - (setq var (if (match-end 2) (match-string 2) (match-string 1)) - form (match-string 3)) - (setq form (org-trim form)) - (when (not (equal form "")) - (while (string-match "[ \t]*\n[ \t]*" form) - (setq form (replace-match " " t t form))) - (when (assoc var eql) - (user-error "Double formulas for %s" var)) - (push (cons var form) eql))) - (setq org-pos nil) - (set-window-configuration org-window-configuration) - (select-window sel-win) - (goto-char pos) - (unless (org-at-table-p) - (user-error "Lost table position - cannot install formulas")) - (org-table-store-formulas eql) - (move-marker pos nil) - (kill-buffer "*Edit Formulas*") - (if arg - (org-table-recalculate 'all) - (message "New formulas installed - press C-u C-c C-c to apply.")))) - -(defun org-table-fedit-abort () - "Abort editing formulas, without installing the changes." - (interactive) - (org-table-remove-rectangle-highlight) - (let ((pos org-pos) (sel-win org-selected-window)) - (set-window-configuration org-window-configuration) - (select-window sel-win) - (goto-char pos) - (move-marker pos nil) - (message "Formula editing aborted without installing changes"))) - -(defun org-table-fedit-lisp-indent () - "Pretty-print and re-indent Lisp expressions in the Formula Editor." - (interactive) - (let ((pos (point)) beg end ind) - (beginning-of-line 1) - (cond - ((looking-at "[ \t]") - (goto-char pos) - (call-interactively 'lisp-indent-line)) - ((looking-at "[$&@0-9a-zA-Z]+ *= *[^ \t\n']") (goto-char pos)) - ((not (fboundp 'pp-buffer)) - (user-error "Cannot pretty-print. Command `pp-buffer' is not available")) - ((looking-at "[$&@0-9a-zA-Z]+ *= *'(") - (goto-char (- (match-end 0) 2)) - (setq beg (point)) - (setq ind (make-string (current-column) ?\ )) - (condition-case nil (forward-sexp 1) - (error - (user-error "Cannot pretty-print Lisp expression: Unbalanced parenthesis"))) - (setq end (point)) - (save-restriction - (narrow-to-region beg end) - (if (eq last-command this-command) - (progn - (goto-char (point-min)) - (setq this-command nil) - (while (re-search-forward "[ \t]*\n[ \t]*" nil t) - (replace-match " "))) - (pp-buffer) - (untabify (point-min) (point-max)) - (goto-char (1+ (point-min))) - (while (re-search-forward "^." nil t) - (beginning-of-line 1) - (insert ind)) - (goto-char (point-max)) - (org-delete-backward-char 1))) - (goto-char beg)) - (t nil)))) - -(defvar org-show-positions nil) - -(defun org-table-show-reference (&optional local) - "Show the location/value of the $ expression at point." - (interactive) - (org-table-remove-rectangle-highlight) - (catch 'exit - (let ((pos (if local (point) org-pos)) - (face2 'highlight) - (org-inhibit-highlight-removal t) - (win (selected-window)) - (org-show-positions nil) - var name e what match dest) - (if local (org-table-get-specials)) - (setq what (cond - ((org-at-regexp-p "^@[0-9]+[ \t=]") - (setq match (concat (substring (match-string 0) 0 -1) - "$1.." - (substring (match-string 0) 0 -1) - "$100")) - 'range) - ((or (org-at-regexp-p org-table-range-regexp2) - (org-at-regexp-p org-table-translate-regexp) - (org-at-regexp-p org-table-range-regexp)) - (setq match - (save-match-data - (org-table-convert-refs-to-rc (match-string 0)))) - 'range) - ((org-at-regexp-p "\\$[a-zA-Z][a-zA-Z0-9]*") 'name) - ((org-at-regexp-p "\\$[0-9]+") 'column) - ((not local) nil) - (t (user-error "No reference at point"))) - match (and what (or match (match-string 0)))) - (when (and match (not (equal (match-beginning 0) (point-at-bol)))) - (org-table-add-rectangle-overlay (match-beginning 0) (match-end 0) - 'secondary-selection)) - (org-add-hook 'before-change-functions - 'org-table-remove-rectangle-highlight) - (if (eq what 'name) (setq var (substring match 1))) - (when (eq what 'range) - (or (equal (string-to-char match) ?@) (setq match (concat "@" match))) - (setq match (org-table-formula-substitute-names match))) - (unless local - (save-excursion - (end-of-line 1) - (re-search-backward "^\\S-" nil t) - (beginning-of-line 1) - (when (looking-at "\\(\\$[0-9a-zA-Z]+\\|@[0-9]+\\$[0-9]+\\|[a-zA-Z]+\\([0-9]+\\|&\\)\\) *=") - (setq dest - (save-match-data - (org-table-convert-refs-to-rc (match-string 1)))) - (org-table-add-rectangle-overlay - (match-beginning 1) (match-end 1) face2)))) - (if (and (markerp pos) (marker-buffer pos)) - (if (get-buffer-window (marker-buffer pos)) - (select-window (get-buffer-window (marker-buffer pos))) - (org-switch-to-buffer-other-window (get-buffer-window - (marker-buffer pos))))) - (goto-char pos) - (org-table-force-dataline) - (when dest - (setq name (substring dest 1)) - (cond - ((string-match "^\\$[a-zA-Z][a-zA-Z0-9]*" dest) - (setq e (assoc name org-table-named-field-locations)) - (org-goto-line (nth 1 e)) - (org-table-goto-column (nth 2 e))) - ((string-match "^@\\([0-9]+\\)\\$\\([0-9]+\\)" dest) - (let ((l (string-to-number (match-string 1 dest))) - (c (string-to-number (match-string 2 dest)))) - (org-goto-line (aref org-table-dlines l)) - (org-table-goto-column c))) - (t (org-table-goto-column (string-to-number name)))) - (move-marker pos (point)) - (org-table-highlight-rectangle nil nil face2)) - (cond - ((equal dest match)) - ((not match)) - ((eq what 'range) - (condition-case nil - (save-excursion - (org-table-get-range match nil nil 'highlight)) - (error nil))) - ((setq e (assoc var org-table-named-field-locations)) - (org-goto-line (nth 1 e)) - (org-table-goto-column (nth 2 e)) - (org-table-highlight-rectangle (point) (point)) - (message "Named field, column %d of line %d" (nth 2 e) (nth 1 e))) - ((setq e (assoc var org-table-column-names)) - (org-table-goto-column (string-to-number (cdr e))) - (org-table-highlight-rectangle (point) (point)) - (goto-char (org-table-begin)) - (if (re-search-forward (concat "^[ \t]*| *! *.*?| *\\(" var "\\) *|") - (org-table-end) t) - (progn - (goto-char (match-beginning 1)) - (org-table-highlight-rectangle) - (message "Named column (column %s)" (cdr e))) - (user-error "Column name not found"))) - ((eq what 'column) - ;; column number - (org-table-goto-column (string-to-number (substring match 1))) - (org-table-highlight-rectangle (point) (point)) - (message "Column %s" (substring match 1))) - ((setq e (assoc var org-table-local-parameters)) - (goto-char (org-table-begin)) - (if (re-search-forward (concat "^[ \t]*| *\\$ *.*?| *\\(" var "=\\)") nil t) - (progn - (goto-char (match-beginning 1)) - (org-table-highlight-rectangle) - (message "Local parameter.")) - (user-error "Parameter not found"))) - (t - (cond - ((not var) (user-error "No reference at point")) - ((setq e (assoc var org-table-formula-constants-local)) - (message "Local Constant: $%s=%s in #+CONSTANTS line." - var (cdr e))) - ((setq e (assoc var org-table-formula-constants)) - (message "Constant: $%s=%s in `org-table-formula-constants'." - var (cdr e))) - ((setq e (and (fboundp 'constants-get) (constants-get var))) - (message "Constant: $%s=%s, from `constants.el'%s." - var e (format " (%s units)" constants-unit-system))) - (t (user-error "Undefined name $%s" var))))) - (goto-char pos) - (when (and org-show-positions - (not (memq this-command '(org-table-fedit-scroll - org-table-fedit-scroll-down)))) - (push pos org-show-positions) - (push org-table-current-begin-pos org-show-positions) - (let ((min (apply 'min org-show-positions)) - (max (apply 'max org-show-positions))) - (goto-char min) (recenter 0) - (goto-char max) - (or (pos-visible-in-window-p max) (recenter -1)))) - (select-window win)))) - -(defun org-table-force-dataline () - "Make sure the cursor is in a dataline in a table." - (unless (save-excursion - (beginning-of-line 1) - (looking-at org-table-dataline-regexp)) - (let* ((re org-table-dataline-regexp) - (p1 (save-excursion (re-search-forward re nil 'move))) - (p2 (save-excursion (re-search-backward re nil 'move)))) - (cond ((and p1 p2) - (goto-char (if (< (abs (- p1 (point))) (abs (- p2 (point)))) - p1 p2))) - ((or p1 p2) (goto-char (or p1 p2))) - (t (user-error "No table dataline around here")))))) - -(defun org-table-fedit-line-up () - "Move cursor one line up in the window showing the table." - (interactive) - (org-table-fedit-move 'previous-line)) - -(defun org-table-fedit-line-down () - "Move cursor one line down in the window showing the table." - (interactive) - (org-table-fedit-move 'next-line)) - -(defun org-table-fedit-move (command) - "Move the cursor in the window showing the table. -Use COMMAND to do the motion, repeat if necessary to end up in a data line." - (let ((org-table-allow-automatic-line-recalculation nil) - (pos org-pos) (win (selected-window)) p) - (select-window (get-buffer-window (marker-buffer org-pos))) - (setq p (point)) - (call-interactively command) - (while (and (org-at-table-p) - (org-at-table-hline-p)) - (call-interactively command)) - (or (org-at-table-p) (goto-char p)) - (move-marker pos (point)) - (select-window win))) - -(defun org-table-fedit-scroll (N) - (interactive "p") - (let ((other-window-scroll-buffer (marker-buffer org-pos))) - (scroll-other-window N))) - -(defun org-table-fedit-scroll-down (N) - (interactive "p") - (org-table-fedit-scroll (- N))) - -(defvar org-table-rectangle-overlays nil) - -(defun org-table-add-rectangle-overlay (beg end &optional face) - "Add a new overlay." - (let ((ov (make-overlay beg end))) - (overlay-put ov 'face (or face 'secondary-selection)) - (push ov org-table-rectangle-overlays))) - -(defun org-table-highlight-rectangle (&optional beg end face) - "Highlight rectangular region in a table." - (setq beg (or beg (point)) end (or end (point))) - (let ((b (min beg end)) - (e (max beg end)) - l1 c1 l2 c2 tmp) - (and (boundp 'org-show-positions) - (setq org-show-positions (cons b (cons e org-show-positions)))) - (goto-char (min beg end)) - (setq l1 (org-current-line) - c1 (org-table-current-column)) - (goto-char (max beg end)) - (setq l2 (org-current-line) - c2 (org-table-current-column)) - (if (> c1 c2) (setq tmp c1 c1 c2 c2 tmp)) - (org-goto-line l1) - (beginning-of-line 1) - (loop for line from l1 to l2 do - (when (looking-at org-table-dataline-regexp) - (org-table-goto-column c1) - (skip-chars-backward "^|\n") (setq beg (point)) - (org-table-goto-column c2) - (skip-chars-forward "^|\n") (setq end (point)) - (org-table-add-rectangle-overlay beg end face)) - (beginning-of-line 2)) - (goto-char b)) - (add-hook 'before-change-functions 'org-table-remove-rectangle-highlight)) - -(defun org-table-remove-rectangle-highlight (&rest ignore) - "Remove the rectangle overlays." - (unless org-inhibit-highlight-removal - (remove-hook 'before-change-functions 'org-table-remove-rectangle-highlight) - (mapc 'delete-overlay org-table-rectangle-overlays) - (setq org-table-rectangle-overlays nil))) - -(defvar org-table-coordinate-overlays nil - "Collects the coordinate grid overlays, so that they can be removed.") -(make-variable-buffer-local 'org-table-coordinate-overlays) - -(defun org-table-overlay-coordinates () - "Add overlays to the table at point, to show row/column coordinates." - (interactive) - (mapc 'delete-overlay org-table-coordinate-overlays) - (setq org-table-coordinate-overlays nil) - (save-excursion - (let ((id 0) (ih 0) hline eol s1 s2 str ic ov beg) - (goto-char (org-table-begin)) - (while (org-at-table-p) - (setq eol (point-at-eol)) - (setq ov (make-overlay (point-at-bol) (1+ (point-at-bol)))) - (push ov org-table-coordinate-overlays) - (setq hline (looking-at org-table-hline-regexp)) - (setq str (if hline (format "I*%-2d" (setq ih (1+ ih))) - (format "%4d" (setq id (1+ id))))) - (org-overlay-before-string ov str 'org-special-keyword 'evaporate) - (when hline - (setq ic 0) - (while (re-search-forward "[+|]\\(-+\\)" eol t) - (setq beg (1+ (match-beginning 0)) - ic (1+ ic) - s1 (concat "$" (int-to-string ic)) - s2 (org-number-to-letters ic) - str (if (eq org-table-use-standard-references t) s2 s1)) - (setq ov (make-overlay beg (+ beg (length str)))) - (push ov org-table-coordinate-overlays) - (org-overlay-display ov str 'org-special-keyword 'evaporate))) - (beginning-of-line 2))))) - -;;;###autoload -(defun org-table-toggle-coordinate-overlays () - "Toggle the display of Row/Column numbers in tables." - (interactive) - (setq org-table-overlay-coordinates (not org-table-overlay-coordinates)) - (message "Tables Row/Column numbers display turned %s" - (if org-table-overlay-coordinates "on" "off")) - (if (and (org-at-table-p) org-table-overlay-coordinates) - (org-table-align)) - (unless org-table-overlay-coordinates - (mapc 'delete-overlay org-table-coordinate-overlays) - (setq org-table-coordinate-overlays nil))) - -;;;###autoload -(defun org-table-toggle-formula-debugger () - "Toggle the formula debugger in tables." - (interactive) - (setq org-table-formula-debug (not org-table-formula-debug)) - (message "Formula debugging has been turned %s" - (if org-table-formula-debug "on" "off"))) - -;;; The orgtbl minor mode - -;; Define a minor mode which can be used in other modes in order to -;; integrate the org-mode table editor. - -;; This is really a hack, because the org-mode table editor uses several -;; keys which normally belong to the major mode, for example the TAB and -;; RET keys. Here is how it works: The minor mode defines all the keys -;; necessary to operate the table editor, but wraps the commands into a -;; function which tests if the cursor is currently inside a table. If that -;; is the case, the table editor command is executed. However, when any of -;; those keys is used outside a table, the function uses `key-binding' to -;; look up if the key has an associated command in another currently active -;; keymap (minor modes, major mode, global), and executes that command. -;; There might be problems if any of the keys used by the table editor is -;; otherwise used as a prefix key. - -;; Another challenge is that the key binding for TAB can be tab or \C-i, -;; likewise the binding for RET can be return or \C-m. Orgtbl-mode -;; addresses this by checking explicitly for both bindings. - -;; The optimized version (see variable `orgtbl-optimized') takes over -;; all keys which are bound to `self-insert-command' in the *global map*. -;; Some modes bind other commands to simple characters, for example -;; AUCTeX binds the double quote to `Tex-insert-quote'. With orgtbl-mode -;; active, this binding is ignored inside tables and replaced with a -;; modified self-insert. - - -(defvar orgtbl-mode-map (make-keymap) - "Keymap for `orgtbl-mode'.") - -(defvar org-old-auto-fill-inhibit-regexp nil - "Local variable used by `orgtbl-mode'.") - -(defconst orgtbl-line-start-regexp - "[ \t]*\\(|\\|#\\+\\(tblfm\\|orgtbl\\|tblname\\):\\)" - "Matches a line belonging to an orgtbl.") - -(defconst orgtbl-extra-font-lock-keywords - (list (list (concat "^" orgtbl-line-start-regexp ".*") - 0 (quote 'org-table) 'prepend)) - "Extra `font-lock-keywords' to be added when `orgtbl-mode' is active.") - -;; Install it as a minor mode. -(put 'orgtbl-mode :included t) -(put 'orgtbl-mode :menu-tag "Org Table Mode") - -;;;###autoload -(define-minor-mode orgtbl-mode - "The `org-mode' table editor as a minor mode for use in other modes." - :lighter " OrgTbl" :keymap orgtbl-mode-map - (org-load-modules-maybe) - (cond - ((derived-mode-p 'org-mode) - ;; Exit without error, in case some hook functions calls this - ;; by accident in org-mode. - (message "Orgtbl-mode is not useful in org-mode, command ignored")) - (orgtbl-mode - (and (orgtbl-setup) (defun orgtbl-setup () nil)) ;; FIXME: Yuck!?! - ;; Make sure we are first in minor-mode-map-alist - (let ((c (assq 'orgtbl-mode minor-mode-map-alist))) - ;; FIXME: maybe it should use emulation-mode-map-alists? - (and c (setq minor-mode-map-alist - (cons c (delq c minor-mode-map-alist))))) - (org-set-local (quote org-table-may-need-update) t) - (org-add-hook 'before-change-functions 'org-before-change-function - nil 'local) - (org-set-local 'org-old-auto-fill-inhibit-regexp - auto-fill-inhibit-regexp) - (org-set-local 'auto-fill-inhibit-regexp - (if auto-fill-inhibit-regexp - (concat orgtbl-line-start-regexp "\\|" - auto-fill-inhibit-regexp) - orgtbl-line-start-regexp)) - (add-to-invisibility-spec '(org-cwidth)) - (when (fboundp 'font-lock-add-keywords) - (font-lock-add-keywords nil orgtbl-extra-font-lock-keywords) - (org-restart-font-lock)) - (easy-menu-add orgtbl-mode-menu)) - (t - (setq auto-fill-inhibit-regexp org-old-auto-fill-inhibit-regexp) - (org-table-cleanup-narrow-column-properties) - (org-remove-from-invisibility-spec '(org-cwidth)) - (remove-hook 'before-change-functions 'org-before-change-function t) - (when (fboundp 'font-lock-remove-keywords) - (font-lock-remove-keywords nil orgtbl-extra-font-lock-keywords) - (org-restart-font-lock)) - (easy-menu-remove orgtbl-mode-menu) - (force-mode-line-update 'all)))) - -(defun org-table-cleanup-narrow-column-properties () - "Remove all properties related to narrow-column invisibility." - (let ((s (point-min))) - (while (setq s (text-property-any s (point-max) - 'display org-narrow-column-arrow)) - (remove-text-properties s (1+ s) '(display t))) - (setq s (point-min)) - (while (setq s (text-property-any s (point-max) 'org-cwidth 1)) - (remove-text-properties s (1+ s) '(org-cwidth t))) - (setq s (point-min)) - (while (setq s (text-property-any s (point-max) 'invisible 'org-cwidth)) - (remove-text-properties s (1+ s) '(invisible t))))) - -(defun orgtbl-make-binding (fun n &rest keys) - "Create a function for binding in the table minor mode. -FUN is the command to call inside a table. N is used to create a unique -command name. KEYS are keys that should be checked in for a command -to execute outside of tables." - (eval - (list 'defun - (intern (concat "orgtbl-hijacker-command-" (int-to-string n))) - '(arg) - (concat "In tables, run `" (symbol-name fun) "'.\n" - "Outside of tables, run the binding of `" - (mapconcat (lambda (x) (format "%s" x)) keys "' or `") - "'.") - '(interactive "p") - (list 'if - '(org-at-table-p) - (list 'call-interactively (list 'quote fun)) - (list 'let '(orgtbl-mode) - (list 'call-interactively - (append '(or) - (mapcar (lambda (k) - (list 'key-binding k)) - keys) - '('orgtbl-error)))))))) - -(defun orgtbl-error () - "Error when there is no default binding for a table key." - (interactive) - (user-error "This key has no function outside tables")) - -(defun orgtbl-setup () - "Setup orgtbl keymaps." - (let ((nfunc 0) - (bindings - '(([(meta shift left)] org-table-delete-column) - ([(meta left)] org-table-move-column-left) - ([(meta right)] org-table-move-column-right) - ([(meta shift right)] org-table-insert-column) - ([(meta shift up)] org-table-kill-row) - ([(meta shift down)] org-table-insert-row) - ([(meta up)] org-table-move-row-up) - ([(meta down)] org-table-move-row-down) - ("\C-c\C-w" org-table-cut-region) - ("\C-c\M-w" org-table-copy-region) - ("\C-c\C-y" org-table-paste-rectangle) - ("\C-c\C-w" org-table-wrap-region) - ("\C-c-" org-table-insert-hline) - ("\C-c}" org-table-toggle-coordinate-overlays) - ("\C-c{" org-table-toggle-formula-debugger) - ("\C-m" org-table-next-row) - ([(shift return)] org-table-copy-down) - ("\C-c?" org-table-field-info) - ("\C-c " org-table-blank-field) - ("\C-c+" org-table-sum) - ("\C-c=" org-table-eval-formula) - ("\C-c'" org-table-edit-formulas) - ("\C-c`" org-table-edit-field) - ("\C-c*" org-table-recalculate) - ("\C-c^" org-table-sort-lines) - ("\M-a" org-table-beginning-of-field) - ("\M-e" org-table-end-of-field) - ([(control ?#)] org-table-rotate-recalc-marks))) - elt key fun cmd) - (while (setq elt (pop bindings)) - (setq nfunc (1+ nfunc)) - (setq key (org-key (car elt)) - fun (nth 1 elt) - cmd (orgtbl-make-binding fun nfunc key)) - (org-defkey orgtbl-mode-map key cmd)) - - ;; Special treatment needed for TAB and RET - (org-defkey orgtbl-mode-map [(return)] - (orgtbl-make-binding 'orgtbl-ret 100 [(return)] "\C-m")) - (org-defkey orgtbl-mode-map "\C-m" - (orgtbl-make-binding 'orgtbl-ret 101 "\C-m" [(return)])) - - (org-defkey orgtbl-mode-map [(tab)] - (orgtbl-make-binding 'orgtbl-tab 102 [(tab)] "\C-i")) - (org-defkey orgtbl-mode-map "\C-i" - (orgtbl-make-binding 'orgtbl-tab 103 "\C-i" [(tab)])) - - (org-defkey orgtbl-mode-map [(shift tab)] - (orgtbl-make-binding 'org-table-previous-field 104 - [(shift tab)] [(tab)] "\C-i")) - - - (unless (featurep 'xemacs) - (org-defkey orgtbl-mode-map [S-iso-lefttab] - (orgtbl-make-binding 'org-table-previous-field 107 - [S-iso-lefttab] [backtab] [(shift tab)] - [(tab)] "\C-i"))) - - (org-defkey orgtbl-mode-map [backtab] - (orgtbl-make-binding 'org-table-previous-field 108 - [backtab] [S-iso-lefttab] [(shift tab)] - [(tab)] "\C-i")) - - (org-defkey orgtbl-mode-map "\M-\C-m" - (orgtbl-make-binding 'org-table-wrap-region 105 - "\M-\C-m" [(meta return)])) - (org-defkey orgtbl-mode-map [(meta return)] - (orgtbl-make-binding 'org-table-wrap-region 106 - [(meta return)] "\M-\C-m")) - - (org-defkey orgtbl-mode-map "\C-c\C-c" 'orgtbl-ctrl-c-ctrl-c) - (org-defkey orgtbl-mode-map "\C-c|" 'orgtbl-create-or-convert-from-region) - - (when orgtbl-optimized - ;; If the user wants maximum table support, we need to hijack - ;; some standard editing functions - (org-remap orgtbl-mode-map - 'self-insert-command 'orgtbl-self-insert-command - 'delete-char 'org-delete-char - 'delete-backward-char 'org-delete-backward-char) - (org-defkey orgtbl-mode-map "|" 'org-force-self-insert)) - (easy-menu-define orgtbl-mode-menu orgtbl-mode-map "OrgTbl menu" - '("OrgTbl" - ["Create or convert" org-table-create-or-convert-from-region - :active (not (org-at-table-p)) :keys "C-c |" ] - "--" - ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p) :keys "C-c C-c"] - ["Next Field" org-cycle :active (org-at-table-p) :keys "TAB"] - ["Previous Field" org-shifttab :active (org-at-table-p) :keys "S-TAB"] - ["Next Row" org-return :active (org-at-table-p) :keys "RET"] - "--" - ["Blank Field" org-table-blank-field :active (org-at-table-p) :keys "C-c SPC"] - ["Edit Field" org-table-edit-field :active (org-at-table-p) :keys "C-c ` "] - ["Copy Field from Above" - org-table-copy-down :active (org-at-table-p) :keys "S-RET"] - "--" - ("Column" - ["Move Column Left" org-metaleft :active (org-at-table-p) :keys "M-<left>"] - ["Move Column Right" org-metaright :active (org-at-table-p) :keys "M-<right>"] - ["Delete Column" org-shiftmetaleft :active (org-at-table-p) :keys "M-S-<left>"] - ["Insert Column" org-shiftmetaright :active (org-at-table-p) :keys "M-S-<right>"]) - ("Row" - ["Move Row Up" org-metaup :active (org-at-table-p) :keys "M-<up>"] - ["Move Row Down" org-metadown :active (org-at-table-p) :keys "M-<down>"] - ["Delete Row" org-shiftmetaup :active (org-at-table-p) :keys "M-S-<up>"] - ["Insert Row" org-shiftmetadown :active (org-at-table-p) :keys "M-S-<down>"] - ["Sort lines in region" org-table-sort-lines :active (org-at-table-p) :keys "C-c ^"] - "--" - ["Insert Hline" org-table-insert-hline :active (org-at-table-p) :keys "C-c -"]) - ("Rectangle" - ["Copy Rectangle" org-copy-special :active (org-at-table-p)] - ["Cut Rectangle" org-cut-special :active (org-at-table-p)] - ["Paste Rectangle" org-paste-special :active (org-at-table-p)] - ["Fill Rectangle" org-table-wrap-region :active (org-at-table-p)]) - "--" - ("Radio tables" - ["Insert table template" orgtbl-insert-radio-table - (assq major-mode orgtbl-radio-table-templates)] - ["Comment/uncomment table" orgtbl-toggle-comment t]) - "--" - ["Set Column Formula" org-table-eval-formula :active (org-at-table-p) :keys "C-c ="] - ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] - ["Edit Formulas" org-table-edit-formulas :active (org-at-table-p) :keys "C-c '"] - ["Recalculate line" org-table-recalculate :active (org-at-table-p) :keys "C-c *"] - ["Recalculate all" (org-table-recalculate '(4)) :active (org-at-table-p) :keys "C-u C-c *"] - ["Iterate all" (org-table-recalculate '(16)) :active (org-at-table-p) :keys "C-u C-u C-c *"] - ["Toggle Recalculate Mark" org-table-rotate-recalc-marks :active (org-at-table-p) :keys "C-c #"] - ["Sum Column/Rectangle" org-table-sum - :active (or (org-at-table-p) (org-region-active-p)) :keys "C-c +"] - ["Which Column?" org-table-current-column :active (org-at-table-p) :keys "C-c ?"] - ["Debug Formulas" - org-table-toggle-formula-debugger :active (org-at-table-p) - :keys "C-c {" - :style toggle :selected org-table-formula-debug] - ["Show Col/Row Numbers" - org-table-toggle-coordinate-overlays :active (org-at-table-p) - :keys "C-c }" - :style toggle :selected org-table-overlay-coordinates] - )) - t)) - -(defun orgtbl-ctrl-c-ctrl-c (arg) - "If the cursor is inside a table, realign the table. -If it is a table to be sent away to a receiver, do it. -With prefix arg, also recompute table." - (interactive "P") - (let ((case-fold-search t) (pos (point)) action) - (save-excursion - (beginning-of-line 1) - (setq action (cond - ((looking-at "[ \t]*#\\+ORGTBL:.*\n[ \t]*|") (match-end 0)) - ((looking-at "[ \t]*|") pos) - ((looking-at "[ \t]*#\\+tblfm:") 'recalc)))) - (cond - ((integerp action) - (goto-char action) - (org-table-maybe-eval-formula) - (if arg - (call-interactively 'org-table-recalculate) - (org-table-maybe-recalculate-line)) - (call-interactively 'org-table-align) - (when (orgtbl-send-table 'maybe) - (run-hooks 'orgtbl-after-send-table-hook))) - ((eq action 'recalc) - (org-table-set-constants) - (save-excursion - (beginning-of-line 1) - (skip-chars-backward " \r\n\t") - (if (org-at-table-p) - (org-call-with-arg 'org-table-recalculate t)))) - (t (let (orgtbl-mode) - (call-interactively (key-binding "\C-c\C-c"))))))) - -(defun orgtbl-create-or-convert-from-region (arg) - "Create table or convert region to table, if no conflicting binding. -This installs the table binding `C-c |', but only if there is no -conflicting binding to this key outside orgtbl-mode." - (interactive "P") - (let* (orgtbl-mode (cmd (key-binding "\C-c|"))) - (if cmd - (call-interactively cmd) - (call-interactively 'org-table-create-or-convert-from-region)))) - -(defun orgtbl-tab (arg) - "Justification and field motion for `orgtbl-mode'." - (interactive "P") - (if arg (org-table-edit-field t) - (org-table-justify-field-maybe) - (org-table-next-field))) - -(defun orgtbl-ret () - "Justification and field motion for `orgtbl-mode'." - (interactive) - (if (bobp) - (newline) - (org-table-justify-field-maybe) - (org-table-next-row))) - -(defun orgtbl-self-insert-command (N) - "Like `self-insert-command', use overwrite-mode for whitespace in tables. -If the cursor is in a table looking at whitespace, the whitespace is -overwritten, and the table is not marked as requiring realignment." - (interactive "p") - (if (and (org-at-table-p) - (or - (and org-table-auto-blank-field - (member last-command - '(orgtbl-hijacker-command-100 - orgtbl-hijacker-command-101 - orgtbl-hijacker-command-102 - orgtbl-hijacker-command-103 - orgtbl-hijacker-command-104 - orgtbl-hijacker-command-105 - yas/expand)) - (org-table-blank-field)) - t) - (eq N 1) - (looking-at "[^|\n]* +|")) - (let (org-table-may-need-update) - (goto-char (1- (match-end 0))) - (org-delete-backward-char 1) - (goto-char (match-beginning 0)) - (self-insert-command N)) - (setq org-table-may-need-update t) - (let* (orgtbl-mode - a - (cmd (or (key-binding - (or (and (listp function-key-map) - (setq a (assoc last-input-event function-key-map)) - (cdr a)) - (vector last-input-event))) - 'self-insert-command))) - (call-interactively cmd) - (if (and org-self-insert-cluster-for-undo - (eq cmd 'self-insert-command)) - (if (not (eq last-command 'orgtbl-self-insert-command)) - (setq org-self-insert-command-undo-counter 1) - (if (>= org-self-insert-command-undo-counter 20) - (setq org-self-insert-command-undo-counter 1) - (and (> org-self-insert-command-undo-counter 0) - buffer-undo-list - (not (cadr buffer-undo-list)) ; remove nil entry - (setcdr buffer-undo-list (cddr buffer-undo-list))) - (setq org-self-insert-command-undo-counter - (1+ org-self-insert-command-undo-counter)))))))) - -(defvar orgtbl-exp-regexp "^\\([-+]?[0-9][0-9.]*\\)[eE]\\([-+]?[0-9]+\\)$" - "Regular expression matching exponentials as produced by calc.") - -(defun orgtbl-gather-send-defs () - "Gather a plist of :name, :transform, :params for each destination before -a radio table." - (save-excursion - (goto-char (org-table-begin)) - (let (rtn) - (beginning-of-line 0) - (while (looking-at "[ \t]*#\\+ORGTBL[: \t][ \t]*SEND[ \t]+\\([^ \t\r\n]+\\)[ \t]+\\([^ \t\r\n]+\\)\\([ \t]+.*\\)?") - (let ((name (org-no-properties (match-string 1))) - (transform (intern (match-string 2))) - (params (if (match-end 3) - (read (concat "(" (match-string 3) ")"))))) - (push (list :name name :transform transform :params params) - rtn) - (beginning-of-line 0))) - rtn))) - -(defun orgtbl-send-replace-tbl (name txt) - "Find and replace table NAME with TXT." - (save-excursion - (goto-char (point-min)) - (unless (re-search-forward - (concat "BEGIN +RECEIVE +ORGTBL +" name "\\([ \t]\\|$\\)") nil t) - (user-error "Don't know where to insert translated table")) - (goto-char (match-beginning 0)) - (beginning-of-line 2) - (save-excursion - (let ((beg (point))) - (unless (re-search-forward - (concat "END +RECEIVE +ORGTBL +" name) nil t) - (user-error "Cannot find end of insertion region")) - (beginning-of-line 1) - (delete-region beg (point)))) - (insert txt "\n"))) - -;;;###autoload -(defun org-table-to-lisp (&optional txt) - "Convert the table at point to a Lisp structure. -The structure will be a list. Each item is either the symbol `hline' -for a horizontal separator line, or a list of field values as strings. -The table is taken from the parameter TXT, or from the buffer at point." - (unless txt - (unless (org-at-table-p) - (user-error "No table at point"))) - (let* ((txt (or txt - (buffer-substring-no-properties (org-table-begin) - (org-table-end)))) - (lines (org-split-string txt "[ \t]*\n[ \t]*"))) - - (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-split-string (org-trim x) "\\s-*|\\s-*"))) - lines))) - -(defun orgtbl-send-table (&optional maybe) - "Send a transformed version of this table to the receiver position. -With argument MAYBE, fail quietly if no transformation is defined for -this table." - (interactive) - (catch 'exit - (unless (org-at-table-p) (user-error "Not at a table")) - ;; when non-interactive, we assume align has just happened. - (when (org-called-interactively-p 'any) (org-table-align)) - (let ((dests (orgtbl-gather-send-defs)) - (txt (buffer-substring-no-properties (org-table-begin) - (org-table-end))) - (ntbl 0)) - (unless dests (if maybe (throw 'exit nil) - (user-error "Don't know how to transform this table"))) - (dolist (dest dests) - (let* ((name (plist-get dest :name)) - (transform (plist-get dest :transform)) - (params (plist-get dest :params)) - (skip (plist-get params :skip)) - (skipcols (plist-get params :skipcols)) - (no-escape (plist-get params :no-escape)) - beg - (lines (org-table-clean-before-export - (nthcdr (or skip 0) - (org-split-string txt "[ \t]*\n[ \t]*")))) - (i0 (if org-table-clean-did-remove-column 2 1)) - (lines (if no-escape lines - (mapcar (lambda(l) (replace-regexp-in-string - "\\([&%#_^]\\)" "\\\\\\1{}" l)) lines))) - (table (mapcar - (lambda (x) - (if (string-match org-table-hline-regexp x) - 'hline - (org-remove-by-index - (org-split-string (org-trim x) "\\s-*|\\s-*") - skipcols i0))) - lines)) - (fun (if (= i0 2) 'cdr 'identity)) - (org-table-last-alignment - (org-remove-by-index (funcall fun org-table-last-alignment) - skipcols i0)) - (org-table-last-column-widths - (org-remove-by-index (funcall fun org-table-last-column-widths) - skipcols i0)) - (txt (if (fboundp transform) - (funcall transform table params) - (user-error "No such transformation function %s" transform)))) - (orgtbl-send-replace-tbl name txt)) - (setq ntbl (1+ ntbl))) - (message "Table converted and installed at %d receiver location%s" - ntbl (if (> ntbl 1) "s" "")) - (if (> ntbl 0) - ntbl - nil)))) - -(defun org-remove-by-index (list indices &optional i0) - "Remove the elements in LIST with indices in INDICES. -First element has index 0, or I0 if given." - (if (not indices) - list - (if (integerp indices) (setq indices (list indices))) - (setq i0 (1- (or i0 0))) - (delq :rm (mapcar (lambda (x) - (setq i0 (1+ i0)) - (if (memq i0 indices) :rm x)) - list)))) - -(defun orgtbl-toggle-comment () - "Comment or uncomment the orgtbl at point." - (interactive) - (let* ((case-fold-search t) - (re1 (concat "^" (regexp-quote comment-start) orgtbl-line-start-regexp)) - (re2 (concat "^" orgtbl-line-start-regexp)) - (commented (save-excursion (beginning-of-line 1) - (cond ((looking-at re1) t) - ((looking-at re2) nil) - (t (user-error "Not at an org table"))))) - (re (if commented re1 re2)) - beg end) - (save-excursion - (beginning-of-line 1) - (while (looking-at re) (beginning-of-line 0)) - (beginning-of-line 2) - (setq beg (point)) - (while (looking-at re) (beginning-of-line 2)) - (setq end (point))) - (comment-region beg end (if commented '(4) nil)))) - -(defun orgtbl-insert-radio-table () - "Insert a radio table template appropriate for this major mode." - (interactive) - (let* ((e (assq major-mode orgtbl-radio-table-templates)) - (txt (nth 1 e)) - name pos) - (unless e (user-error "No radio table setup defined for %s" major-mode)) - (setq name (read-string "Table name: ")) - (while (string-match "%n" txt) - (setq txt (replace-match name t t txt))) - (or (bolp) (insert "\n")) - (setq pos (point)) - (insert txt) - (goto-char pos))) - -;; Dynamically bound input and output for table formatting. -(defvar *orgtbl-table* nil - "Carries the current table through formatting routines.") -(defvar *orgtbl-rtn* nil - "Formatting routines push the output lines here.") -;; Formatting parameters for the current table section. -(defvar *orgtbl-hline* nil "Text used for horizontal lines.") -(defvar *orgtbl-sep* nil "Text used as a column separator.") -(defvar *orgtbl-default-fmt* nil "Default format for each entry.") -(defvar *orgtbl-fmt* nil "Format for each entry.") -(defvar *orgtbl-efmt* nil "Format for numbers.") -(defvar *orgtbl-lfmt* nil "Format for an entire line, overrides fmt.") -(defvar *orgtbl-llfmt* nil "Specializes lfmt for the last row.") -(defvar *orgtbl-lstart* nil "Text starting a row.") -(defvar *orgtbl-llstart* nil "Specializes lstart for the last row.") -(defvar *orgtbl-lend* nil "Text ending a row.") -(defvar *orgtbl-llend* nil "Specializes lend for the last row.") - -(defsubst orgtbl-get-fmt (fmt i) - "Retrieve the format from FMT corresponding to the Ith column." - (if (and (not (functionp fmt)) (consp fmt)) - (plist-get fmt i) - fmt)) - -(defsubst orgtbl-apply-fmt (fmt &rest args) - "Apply format FMT to arguments ARGS. -When FMT is nil, return the first argument from ARGS." - (cond ((functionp fmt) (apply fmt args)) - (fmt (apply 'format fmt args)) - (args (car args)) - (t args))) - -(defsubst orgtbl-eval-str (str) - "If STR is a function, evaluate it with no arguments." - (if (functionp str) - (funcall str) - str)) - -(defun orgtbl-format-line (line) - "Format LINE as a table row." - (if (eq line 'hline) (if *orgtbl-hline* (push *orgtbl-hline* *orgtbl-rtn*)) - (let* ((i 0) - (line - (mapcar - (lambda (f) - (setq i (1+ i)) - (let* ((efmt (orgtbl-get-fmt *orgtbl-efmt* i)) - (f (if (and efmt (string-match orgtbl-exp-regexp f)) - (orgtbl-apply-fmt efmt (match-string 1 f) - (match-string 2 f)) - f))) - (orgtbl-apply-fmt (or (orgtbl-get-fmt *orgtbl-fmt* i) - *orgtbl-default-fmt*) - f))) - line))) - (push (if *orgtbl-lfmt* - (apply #'orgtbl-apply-fmt *orgtbl-lfmt* line) - (concat (orgtbl-eval-str *orgtbl-lstart*) - (mapconcat 'identity line *orgtbl-sep*) - (orgtbl-eval-str *orgtbl-lend*))) - *orgtbl-rtn*)))) - -(defun orgtbl-format-section (section-stopper) - "Format lines until the first occurrence of SECTION-STOPPER." - (let (prevline) - (progn - (while (not (eq (car *orgtbl-table*) section-stopper)) - (if prevline (orgtbl-format-line prevline)) - (setq prevline (pop *orgtbl-table*))) - (if prevline (let ((*orgtbl-lstart* *orgtbl-llstart*) - (*orgtbl-lend* *orgtbl-llend*) - (*orgtbl-lfmt* *orgtbl-llfmt*)) - (orgtbl-format-line prevline)))))) - -;;;###autoload -(defun orgtbl-to-generic (table params &optional backend) - "Convert the orgtbl-mode TABLE to some other format. -This generic routine can be used for many standard cases. -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. -A third optional argument BACKEND can be used to convert the content of -the cells using a specific export back-end. - -For the generic converter, some parameters are obligatory: you need to -specify either :lfmt, or all of (:lstart :lend :sep). - -Valid parameters are: - -:splice When set to t, return only table body lines, don't wrap - them into :tstart and :tend. Default is nil. When :splice - is non-nil, this also means that the exporter should not look - for and interpret header and footer sections. - -:hline String to be inserted on horizontal separation lines. - May be nil to ignore hlines. - -:sep Separator between two fields -:remove-nil-lines Do not include lines that evaluate to nil. - -Each in the following group may be either a string or a function -of no arguments returning a string: - -:tstart String to start the table. Ignored when :splice is t. -:tend String to end the table. Ignored when :splice is t. -:lstart String to start a new table line. -:llstart String to start the last table line, defaults to :lstart. -:lend String to end a table line -:llend String to end the last table line, defaults to :lend. - -Each in the following group may be a string, a function of one -argument (the field or line) returning a string, or a plist -mapping columns to either of the above: - -:lfmt Format for entire line, with enough %s to capture all fields. - If this is present, :lstart, :lend, and :sep are ignored. -:llfmt Format for the entire last line, defaults to :lfmt. -:fmt A format to be used to wrap the field, should contain - %s for the original field value. For example, to wrap - everything in dollars, you could use :fmt \"$%s$\". - This may also be a property list with column numbers and - formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\") -:hlstart :hllstart :hlend :hllend :hlsep :hlfmt :hllfmt :hfmt - Same as above, specific for the header lines in the table. - All lines before the first hline are treated as header. - If any of these is not present, the data line value is used. - -This may be either a string or a function of two arguments: - -:efmt Use this format to print numbers with exponentials. - The format should have %s twice for inserting mantissa - and exponent, for example \"%s\\\\times10^{%s}\". This - may also be a property list with column numbers and - formats. :fmt will still be applied after :efmt. - -In addition to this, the parameters :skip and :skipcols are always handled -directly by `orgtbl-send-table'. See manual." - (let* ((splicep (plist-get params :splice)) - (hline (plist-get params :hline)) - (skipheadrule (plist-get params :skipheadrule)) - (remove-nil-linesp (plist-get params :remove-nil-lines)) - (remove-newlines (plist-get params :remove-newlines)) - (*orgtbl-hline* hline) - (*orgtbl-table* table) - (*orgtbl-sep* (plist-get params :sep)) - (*orgtbl-efmt* (plist-get params :efmt)) - (*orgtbl-lstart* (plist-get params :lstart)) - (*orgtbl-llstart* (or (plist-get params :llstart) *orgtbl-lstart*)) - (*orgtbl-lend* (plist-get params :lend)) - (*orgtbl-llend* (or (plist-get params :llend) *orgtbl-lend*)) - (*orgtbl-lfmt* (plist-get params :lfmt)) - (*orgtbl-llfmt* (or (plist-get params :llfmt) *orgtbl-lfmt*)) - (*orgtbl-fmt* (plist-get params :fmt)) - *orgtbl-rtn*) - ;; Convert cells content to backend BACKEND - (when backend - (setq *orgtbl-table* - (mapcar - (lambda(r) - (if (listp r) - (mapcar - (lambda (c) - (org-trim (org-export-string-as c backend t '(:with-tables t)))) - r) - r)) - *orgtbl-table*))) - ;; Put header - (unless splicep - (when (plist-member params :tstart) - (let ((tstart (orgtbl-eval-str (plist-get params :tstart)))) - (if tstart (push tstart *orgtbl-rtn*))))) - ;; If we have a heading, format it and handle the trailing hline. - (if (and (not splicep) - (or (consp (car *orgtbl-table*)) - (consp (nth 1 *orgtbl-table*))) - (memq 'hline (cdr *orgtbl-table*))) - (progn - (when (eq 'hline (car *orgtbl-table*)) - ;; There is a hline before the first data line - (and hline (push hline *orgtbl-rtn*)) - (pop *orgtbl-table*)) - (let* ((*orgtbl-lstart* (or (plist-get params :hlstart) - *orgtbl-lstart*)) - (*orgtbl-llstart* (or (plist-get params :hllstart) - *orgtbl-llstart*)) - (*orgtbl-lend* (or (plist-get params :hlend) *orgtbl-lend*)) - (*orgtbl-llend* (or (plist-get params :hllend) - (plist-get params :hlend) *orgtbl-llend*)) - (*orgtbl-lfmt* (or (plist-get params :hlfmt) *orgtbl-lfmt*)) - (*orgtbl-llfmt* (or (plist-get params :hllfmt) - (plist-get params :hlfmt) *orgtbl-llfmt*)) - (*orgtbl-sep* (or (plist-get params :hlsep) *orgtbl-sep*)) - (*orgtbl-fmt* (or (plist-get params :hfmt) *orgtbl-fmt*))) - (orgtbl-format-section 'hline)) - (if (and hline (not skipheadrule)) (push hline *orgtbl-rtn*)) - (pop *orgtbl-table*))) - ;; Now format the main section. - (orgtbl-format-section nil) - (unless splicep - (when (plist-member params :tend) - (let ((tend (orgtbl-eval-str (plist-get params :tend)))) - (if tend (push tend *orgtbl-rtn*))))) - (mapconcat (if remove-newlines - (lambda (tend) - (replace-regexp-in-string "[\n\r\t\f]" "\\\\n" tend)) - 'identity) - (nreverse (if remove-nil-linesp - (remq nil *orgtbl-rtn*) - *orgtbl-rtn*)) "\n"))) - -;;;###autoload -(defun orgtbl-to-tsv (table params) - "Convert the orgtbl-mode table to TAB separated material." - (orgtbl-to-generic table (org-combine-plists '(:sep "\t") params))) -;;;###autoload -(defun orgtbl-to-csv (table params) - "Convert the orgtbl-mode table to CSV material. -This does take care of the proper quoting of fields with comma or quotes." - (orgtbl-to-generic table (org-combine-plists - '(:sep "," :fmt org-quote-csv-field) - params))) - -;;;###autoload -(defun orgtbl-to-latex (table params) - "Convert the orgtbl-mode TABLE to LaTeX. -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. -Supports all parameters from `orgtbl-to-generic'. Most important for -LaTeX are: - -:splice When set to t, return only table body lines, don't wrap - them into a tabular environment. Default is nil. - -:fmt A format to be used to wrap the field, should contain %s for the - original field value. For example, to wrap everything in dollars, - use :fmt \"$%s$\". This may also be a property list with column - numbers and formats. For example :fmt (2 \"$%s$\" 4 \"%s%%\") - The format may also be a function that formats its one argument. - -:efmt Format for transforming numbers with exponentials. The format - should have %s twice for inserting mantissa and exponent, for - example \"%s\\\\times10^{%s}\". LaTeX default is \"%s\\\\,(%s)\". - This may also be a property list with column numbers and formats. - The format may also be a function that formats its two arguments. - -:llend If you find too much space below the last line of a table, - pass a value of \"\" for :llend to suppress the final \\\\. - -The general parameters :skip and :skipcols have already been applied when -this function is called." - (let* ((alignment (mapconcat (lambda (x) (if x "r" "l")) - org-table-last-alignment "")) - (params2 - (list - :tstart (concat "\\begin{tabular}{" alignment "}") - :tend "\\end{tabular}" - :lstart "" :lend " \\\\" :sep " & " - :efmt "%s\\,(%s)" :hline "\\hline"))) - (require 'ox-latex) - (orgtbl-to-generic table (org-combine-plists params2 params) 'latex))) - -;;;###autoload -(defun orgtbl-to-html (table params) - "Convert the orgtbl-mode TABLE to HTML. -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. -Currently this function recognizes the following parameters: - -:splice When set to t, return only table body lines, don't wrap - them into a <table> environment. Default is nil. - -The general parameters :skip and :skipcols have already been applied when -this function is called. The function does *not* use `orgtbl-to-generic', -so you cannot specify parameters for it." - (require 'ox-html) - (let ((output (org-export-string-as - (orgtbl-to-orgtbl table nil) 'html t '(:with-tables t)))) - (if (not (plist-get params :splice)) output - (org-trim - (replace-regexp-in-string - "\\`<table .*>\n" "" - (replace-regexp-in-string "</table>\n*\\'" "" output)))))) - -;;;###autoload -(defun orgtbl-to-texinfo (table params) - "Convert the orgtbl-mode TABLE to TeXInfo. -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. -Supports all parameters from `orgtbl-to-generic'. Most important for -TeXInfo are: - -:splice nil/t When set to t, return only table body lines, don't wrap - them into a multitable environment. Default is nil. - -:fmt fmt A format to be used to wrap the field, should contain - %s for the original field value. For example, to wrap - everything in @kbd{}, you could use :fmt \"@kbd{%s}\". - This may also be a property list with column numbers and - formats. For example :fmt (2 \"@kbd{%s}\" 4 \"@code{%s}\"). - Each format also may be a function that formats its one - argument. - -:cf \"f1 f2..\" The column fractions for the table. By default these - are computed automatically from the width of the columns - under org-mode. - -The general parameters :skip and :skipcols have already been applied when -this function is called." - (let* ((total (float (apply '+ org-table-last-column-widths))) - (colfrac (or (plist-get params :cf) - (mapconcat - (lambda (x) (format "%.3f" (/ (float x) total))) - org-table-last-column-widths " "))) - (params2 - (list - :tstart (concat "@multitable @columnfractions " colfrac) - :tend "@end multitable" - :lstart "@item " :lend "" :sep " @tab " - :hlstart "@headitem "))) - (require 'ox-texinfo) - (orgtbl-to-generic table (org-combine-plists params2 params) 'texinfo))) - -;;;###autoload -(defun orgtbl-to-orgtbl (table params) - "Convert the orgtbl-mode TABLE into another orgtbl-mode table. -Useful when slicing one table into many. The :hline, :sep, -:lstart, and :lend provide orgtbl framing. The default nil :tstart -and :tend suppress strings without splicing; they can be set to -provide ORGTBL directives for the generated table." - (let* ((params2 - (list - :remove-newlines t - :tstart nil :tend nil - :hline "|---" - :sep " | " - :lstart "| " - :lend " |")) - (params (org-combine-plists params2 params))) - (with-temp-buffer - (insert (orgtbl-to-generic table params)) - (goto-char (point-min)) - (while (re-search-forward org-table-hline-regexp nil t) - (org-table-align)) - (buffer-substring 1 (buffer-size))))) - -(defun orgtbl-to-table.el (table params) - "Convert the orgtbl-mode TABLE into a table.el table." - (with-temp-buffer - (insert (orgtbl-to-orgtbl table params)) - (org-table-align) - (replace-regexp-in-string - "-|" "-+" - (replace-regexp-in-string "|-" "+-" (buffer-substring 1 (buffer-size)))))) - -(defun orgtbl-to-unicode (table params) - "Convert the orgtbl-mode TABLE into a table with unicode characters. -You need the ascii-art-to-unicode.el package for this. You can download -it here: http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el." - (with-temp-buffer - (insert (orgtbl-to-table.el table params)) - (goto-char (point-min)) - (if (or (featurep 'ascii-art-to-unicode) - (require 'ascii-art-to-unicode nil t)) - (aa2u) - (unless (delq nil (mapcar (lambda (l) (string-match "aa2u" (car l))) org-stored-links)) - (push '("http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el" - "Link to ascii-art-to-unicode.el") org-stored-links)) - (user-error "Please download ascii-art-to-unicode.el (use C-c C-l to insert the link to it)")) - (buffer-string))) - -(defun org-table-get-remote-range (name-or-id form) - "Get a field value or a list of values in a range from table at ID. - -NAME-OR-ID may be the name of a table in the current file as set -by a \"#+NAME:\" directive. The first table following this line -will then be used. Alternatively, it may be an ID referring to -any entry, also in a different file. In this case, the first -table in that entry will be referenced. -FORM is a field or range descriptor like \"@2$3\" or \"B3\" or -\"@I$2..@II$2\". All the references must be absolute, not relative. - -The return value is either a single string for a single field, or a -list of the fields in the rectangle." - (save-match-data - (let ((case-fold-search t) (id-loc nil) - ;; Protect a bunch of variables from being overwritten - ;; by the context of the remote table - org-table-column-names org-table-column-name-regexp - org-table-local-parameters org-table-named-field-locations - org-table-current-line-types org-table-current-begin-line - org-table-current-begin-pos org-table-dlines - org-table-current-ncol - org-table-hlines org-table-last-alignment - org-table-last-column-widths org-table-last-alignment - org-table-last-column-widths tbeg - buffer loc) - (setq form (org-table-convert-refs-to-rc form)) - (save-excursion - (save-restriction - (widen) - (save-excursion - (goto-char (point-min)) - (if (re-search-forward - (concat "^[ \t]*#\\+\\(tbl\\)?name:[ \t]*" - (regexp-quote name-or-id) "[ \t]*$") - nil t) - (setq buffer (current-buffer) loc (match-beginning 0)) - (setq id-loc (org-id-find name-or-id 'marker)) - (unless (and id-loc (markerp id-loc)) - (user-error "Can't find remote table \"%s\"" name-or-id)) - (setq buffer (marker-buffer id-loc) - loc (marker-position id-loc)) - (move-marker id-loc nil))) - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char loc) - (forward-char 1) - (unless (and (re-search-forward "^\\(\\*+ \\)\\|[ \t]*|" nil t) - (not (match-beginning 1))) - (user-error "Cannot find a table at NAME or ID %s" name-or-id)) - (setq tbeg (point-at-bol)) - (org-table-get-specials) - (setq form (org-table-formula-substitute-names - (org-table-formula-handle-first/last-rc form))) - (if (and (string-match org-table-range-regexp form) - (> (length (match-string 0 form)) 1)) - (save-match-data - (org-table-get-range (match-string 0 form) tbeg 1)) - form))))))))) - -(defmacro org-define-lookup-function (mode) - (let ((mode-str (symbol-name mode)) - (first-p (equal mode 'first)) - (all-p (equal mode 'all))) - (let ((plural-str (if all-p "s" ""))) - `(defun ,(intern (format "org-lookup-%s" mode-str)) (val s-list r-list &optional predicate) - ,(format "Find %s occurrence%s of VAL in S-LIST; return corresponding element%s of R-LIST. -If R-LIST is nil, return matching element%s of S-LIST. -If PREDICATE is not nil, use it instead of `equal' to match VAL. -Matching is done by (PREDICATE VAL S), where S is an element of S-LIST. -This function is generated by a call to the macro `org-define-lookup-function'." - mode-str plural-str plural-str plural-str) - (let ,(let ((lvars '((p (or predicate 'equal)) - (sl s-list) - (rl (or r-list s-list)) - (ret nil)))) - (if first-p (add-to-list 'lvars '(match-p nil))) - lvars) - (while ,(if first-p '(and (not match-p) sl) 'sl) - (progn - (if (funcall p val (car sl)) - (progn - ,(if first-p '(setq match-p t)) - (let ((rval (car rl))) - (setq ret ,(if all-p '(append ret (list rval)) 'rval))))) - (setq sl (cdr sl) rl (cdr rl)))) - ret))))) - -(org-define-lookup-function first) -(org-define-lookup-function last) -(org-define-lookup-function all) - -(provide 'org-table) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-table.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-timer.el b/xemacs-packages/lisp/org-8.2.3c/org-timer.el deleted file mode 100644 index db7760dc..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-timer.el +++ /dev/null @@ -1,451 +0,0 @@ -;;; org-timer.el --- The relative timer code for Org-mode - -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: - -;; This file contains the relative timer code for Org-mode - -;;; Code: - -(require 'org) - -(declare-function org-notify "org-clock" (notification &optional play-sound)) -(declare-function org-agenda-error "org-agenda" ()) - -(defvar org-timer-start-time nil - "t=0 for the running timer.") - -(defvar org-timer-pause-time nil - "Time when the timer was paused.") - -(defconst org-timer-re "\\([-+]?[0-9]+\\):\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)" - "Regular expression used to match timer stamps.") - -(defcustom org-timer-format "%s " - "The format to insert the time of the timer. -This format must contain one instance of \"%s\" which will be replaced by -the value of the relative timer." - :group 'org-time - :type 'string) - -(defcustom org-timer-default-timer 0 - "The default timer when a timer is set. -When 0, the user is prompted for a value." - :group 'org-time - :version "24.1" - :type 'number) - -(defcustom org-timer-display 'mode-line - "When a timer is running, org-mode can display it in the mode -line and/or frame title. -Allowed values are: - -both displays in both mode line and frame title -mode-line displays only in mode line (default) -frame-title displays only in frame title -nil current timer is not displayed" - :group 'org-time - :type '(choice - (const :tag "Mode line" mode-line) - (const :tag "Frame title" frame-title) - (const :tag "Both" both) - (const :tag "None" nil))) - -(defvar org-timer-start-hook nil - "Hook run after relative timer is started.") - -(defvar org-timer-stop-hook nil - "Hook run before relative timer is stopped.") - -(defvar org-timer-pause-hook nil - "Hook run before relative timer is paused.") - -(defvar org-timer-continue-hook nil - "Hook run after relative timer is continued.") - -(defvar org-timer-set-hook nil - "Hook run after countdown timer is set.") - -(defvar org-timer-done-hook nil - "Hook run after countdown timer reaches zero.") - -(defvar org-timer-cancel-hook nil - "Hook run before countdown timer is canceled.") - -;;;###autoload -(defun org-timer-start (&optional offset) - "Set the starting time for the relative timer to now. -When called with prefix argument OFFSET, prompt the user for an offset time, -with the default taken from a timer stamp at point, if any. -If OFFSET is a string or an integer, it is directly taken to be the offset -without user interaction. -When called with a double prefix arg, all timer strings in the active -region will be shifted by a specific amount. You will be prompted for -the amount, with the default to make the first timer string in -the region 0:00:00." - (interactive "P") - (if (equal offset '(16)) - (call-interactively 'org-timer-change-times-in-region) - (let (delta def s) - (if (not offset) - (setq org-timer-start-time (current-time)) - (cond - ((integerp offset) (setq delta offset)) - ((stringp offset) (setq delta (org-timer-hms-to-secs offset))) - (t - (setq def (if (org-in-regexp org-timer-re) - (match-string 0) - "0:00:00") - s (read-string - (format "Restart timer with offset [%s]: " def))) - (unless (string-match "\\S-" s) (setq s def)) - (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s))))) - (setq org-timer-start-time - (seconds-to-time - (- (org-float-time) delta)))) - (org-timer-set-mode-line 'on) - (message "Timer start time set to %s, current value is %s" - (format-time-string "%T" org-timer-start-time) - (org-timer-secs-to-hms (or delta 0))) - (run-hooks 'org-timer-start-hook)))) - -(defun org-timer-pause-or-continue (&optional stop) - "Pause or continue the relative timer. -With prefix arg STOP, stop it entirely." - (interactive "P") - (cond - (stop (org-timer-stop)) - ((not org-timer-start-time) (error "No timer is running")) - (org-timer-pause-time - ;; timer is paused, continue - (setq org-timer-start-time - (seconds-to-time - (- - (org-float-time) - (- (org-float-time org-timer-pause-time) - (org-float-time org-timer-start-time)))) - org-timer-pause-time nil) - (org-timer-set-mode-line 'on) - (run-hooks 'org-timer-continue-hook) - (message "Timer continues at %s" (org-timer-value-string))) - (t - ;; pause timer - (run-hooks 'org-timer-pause-hook) - (setq org-timer-pause-time (current-time)) - (org-timer-set-mode-line 'pause) - (message "Timer paused at %s" (org-timer-value-string))))) - -(defun org-timer-stop () - "Stop the relative timer." - (interactive) - (run-hooks 'org-timer-stop-hook) - (setq org-timer-start-time nil - org-timer-pause-time nil) - (org-timer-set-mode-line 'off) - (message "Timer stopped")) - -;;;###autoload -(defun org-timer (&optional restart no-insert-p) - "Insert a H:MM:SS string from the timer into the buffer. -The first time this command is used, the timer is started. When used with -a \\[universal-argument] prefix, force restarting the timer. -When used with a double prefix argument \\[universal-argument], change all the timer string -in the region by a fixed amount. This can be used to recalibrate a timer -that was not started at the correct moment. - -If NO-INSERT-P is non-nil, return the string instead of inserting -it in the buffer." - (interactive "P") - (when (or (equal restart '(4)) (not org-timer-start-time)) - (org-timer-start)) - (if no-insert-p - (org-timer-value-string) - (insert (org-timer-value-string)))) - -(defun org-timer-value-string () - (format org-timer-format (org-timer-secs-to-hms (floor (org-timer-seconds))))) - -(defvar org-timer-timer-is-countdown nil) -(defun org-timer-seconds () - (if org-timer-timer-is-countdown - (- (org-float-time org-timer-start-time) - (org-float-time (current-time))) - (- (org-float-time (or org-timer-pause-time (current-time))) - (org-float-time org-timer-start-time)))) - -;;;###autoload -(defun org-timer-change-times-in-region (beg end delta) - "Change all h:mm:ss time in region by a DELTA." - (interactive - "r\nsEnter time difference like \"-1:08:26\". Default is first time to zero: ") - (let ((re "[-+]?[0-9]+:[0-9]\\{2\\}:[0-9]\\{2\\}") p) - (unless (string-match "\\S-" delta) - (save-excursion - (goto-char beg) - (when (re-search-forward re end t) - (setq delta (match-string 0)) - (if (equal (string-to-char delta) ?-) - (setq delta (substring delta 1)) - (setq delta (concat "-" delta)))))) - (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete delta))) - (when (= delta 0) (error "No change")) - (save-excursion - (goto-char end) - (while (re-search-backward re beg t) - (setq p (point)) - (replace-match - (save-match-data - (org-timer-secs-to-hms (+ (org-timer-hms-to-secs (match-string 0)) delta))) - t t) - (goto-char p))))) - -;;;###autoload -(defun org-timer-item (&optional arg) - "Insert a description-type item with the current timer value." - (interactive "P") - (let ((itemp (org-in-item-p)) (pos (point))) - (cond - ;; In a timer list, insert with `org-list-insert-item', - ;; then fix the list. - ((and itemp (goto-char itemp) (org-at-item-timer-p)) - (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct)) - (s (concat (org-timer (when arg '(4)) t) ":: "))) - (setq struct (org-list-insert-item pos struct prevs nil s)) - (org-list-write-struct struct (org-list-parents-alist struct)) - (looking-at org-list-full-item-re) - (goto-char (match-end 0)))) - ;; In a list of another type, don't break anything: throw an error. - (itemp (goto-char pos) (error "This is not a timer list")) - ;; Else, start a new list. - (t - (beginning-of-line) - (org-indent-line) - (insert "- ") - (org-timer (when arg '(4))) - (insert ":: "))))) - -(defun org-timer-fix-incomplete (hms) - "If hms is a H:MM:SS string with missing hour or hour and minute, fix it." - (if (string-match "\\(?:\\([0-9]+:\\)?\\([0-9]+:\\)\\)?\\([0-9]+\\)" hms) - (replace-match - (format "%d:%02d:%02d" - (if (match-end 1) (string-to-number (match-string 1 hms)) 0) - (if (match-end 2) (string-to-number (match-string 2 hms)) 0) - (string-to-number (match-string 3 hms))) - t t hms) - (error "Cannot parse HMS string \"%s\"" hms))) - -(defun org-timer-hms-to-secs (hms) - "Convert h:mm:ss string to an integer time. -If the string starts with a minus sign, the integer will be negative." - (if (not (string-match - "\\([-+]?[0-9]+\\):\\([0-9]\\{2\\}\\):\\([0-9]\\{2\\}\\)" - hms)) - 0 - (let* ((h (string-to-number (match-string 1 hms))) - (m (string-to-number (match-string 2 hms))) - (s (string-to-number (match-string 3 hms))) - (sign (equal (substring (match-string 1 hms) 0 1) "-"))) - (setq h (abs h)) - (* (if sign -1 1) (+ s (* 60 (+ m (* 60 h)))))))) - -(defun org-timer-secs-to-hms (s) - "Convert integer S into h:mm:ss. -If the integer is negative, the string will start with \"-\"." - (let (sign m h) - (setq sign (if (< s 0) "-" "") - s (abs s) - m (/ s 60) s (- s (* 60 m)) - h (/ m 60) m (- m (* 60 h))) - (format "%s%d:%02d:%02d" sign h m s))) - -(defvar org-timer-mode-line-timer nil) -(defvar org-timer-mode-line-string nil) - -(defun org-timer-set-mode-line (value) - "Set the mode-line display of the relative timer. -VALUE can be `on', `off', or `pause'." - (when (or (eq org-timer-display 'mode-line) - (eq org-timer-display 'both)) - (or global-mode-string (setq global-mode-string '(""))) - (or (memq 'org-timer-mode-line-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(org-timer-mode-line-string))))) - (when (or (eq org-timer-display 'frame-title) - (eq org-timer-display 'both)) - (or (memq 'org-timer-mode-line-string frame-title-format) - (setq frame-title-format - (append frame-title-format '(org-timer-mode-line-string))))) - (cond - ((equal value 'off) - (when org-timer-mode-line-timer - (cancel-timer org-timer-mode-line-timer) - (setq org-timer-mode-line-timer nil)) - (when (or (eq org-timer-display 'mode-line) - (eq org-timer-display 'both)) - (setq global-mode-string - (delq 'org-timer-mode-line-string global-mode-string))) - (when (or (eq org-timer-display 'frame-title) - (eq org-timer-display 'both)) - (setq frame-title-format - (delq 'org-timer-mode-line-string frame-title-format))) - (force-mode-line-update)) - ((equal value 'pause) - (when org-timer-mode-line-timer - (cancel-timer org-timer-mode-line-timer) - (setq org-timer-mode-line-timer nil))) - ((equal value 'on) - (when (or (eq org-timer-display 'mode-line) - (eq org-timer-display 'both)) - (or global-mode-string (setq global-mode-string '(""))) - (or (memq 'org-timer-mode-line-string global-mode-string) - (setq global-mode-string - (append global-mode-string '(org-timer-mode-line-string))))) - (when (or (eq org-timer-display 'frame-title) - (eq org-timer-display 'both)) - (or (memq 'org-timer-mode-line-string frame-title-format) - (setq frame-title-format - (append frame-title-format '(org-timer-mode-line-string))))) - (org-timer-update-mode-line) - (when org-timer-mode-line-timer - (cancel-timer org-timer-mode-line-timer) - (setq org-timer-mode-line-timer nil)) - (when org-timer-display - (setq org-timer-mode-line-timer - (run-with-timer 1 1 'org-timer-update-mode-line)))))) - -(defun org-timer-update-mode-line () - "Update the timer time in the mode line." - (if org-timer-pause-time - nil - (setq org-timer-mode-line-string - (concat " <" (substring (org-timer-value-string) 0 -1) ">")) - (force-mode-line-update))) - -(defvar org-timer-current-timer nil) -(defun org-timer-cancel-timer () - "Cancel the current timer." - (interactive) - (when (eval org-timer-current-timer) - (run-hooks 'org-timer-cancel-hook) - (cancel-timer org-timer-current-timer) - (setq org-timer-current-timer nil) - (setq org-timer-timer-is-countdown nil) - (org-timer-set-mode-line 'off)) - (message "Last timer canceled")) - -(defun org-timer-show-remaining-time () - "Display the remaining time before the timer ends." - (interactive) - (require 'time) - (if (not org-timer-current-timer) - (message "No timer set") - (let* ((rtime (decode-time - (time-subtract (timer--time org-timer-current-timer) - (current-time)))) - (rsecs (nth 0 rtime)) - (rmins (nth 1 rtime))) - (message "%d minute(s) %d seconds left before next time out" - rmins rsecs)))) - -(defvar org-clock-sound) - -;;;###autoload -(defun org-timer-set-timer (&optional opt) - "Prompt for a duration and set a timer. - -If `org-timer-default-timer' is not zero, suggest this value as -the default duration for the timer. If a timer is already set, -prompt the user if she wants to replace it. - -Called with a numeric prefix argument, use this numeric value as -the duration of the timer. - -Called with a `C-u' prefix arguments, use `org-timer-default-timer' -without prompting the user for a duration. - -With two `C-u' prefix arguments, use `org-timer-default-timer' -without prompting the user for a duration and automatically -replace any running timer." - (interactive "P") - (let ((minutes (or (and (numberp opt) (number-to-string opt)) - (and (listp opt) (not (null opt)) - (number-to-string org-timer-default-timer)) - (read-from-minibuffer - "How many minutes left? " - (if (not (eq org-timer-default-timer 0)) - (number-to-string org-timer-default-timer)))))) - (if (not (string-match "[0-9]+" minutes)) - (org-timer-show-remaining-time) - (let* ((mins (string-to-number (match-string 0 minutes))) - (secs (* mins 60)) - (hl (cond - ((string-match "Org Agenda" (buffer-name)) - (let* ((marker (or (get-text-property (point) 'org-marker) - (org-agenda-error))) - (hdmarker (or (get-text-property (point) 'org-hd-marker) - marker)) - (pos (marker-position marker))) - (with-current-buffer (marker-buffer marker) - (widen) - (goto-char pos) - (org-show-entry) - (or (ignore-errors (org-get-heading)) - (concat "File:" (file-name-nondirectory (buffer-file-name))))))) - ((derived-mode-p 'org-mode) - (or (ignore-errors (org-get-heading)) - (concat "File:" (file-name-nondirectory (buffer-file-name))))) - (t (error "Not in an Org buffer")))) - timer-set) - (if (or (and org-timer-current-timer - (or (equal opt '(16)) - (y-or-n-p "Replace current timer? "))) - (not org-timer-current-timer)) - (progn - (require 'org-clock) - (when org-timer-current-timer - (cancel-timer org-timer-current-timer)) - (setq org-timer-current-timer - (run-with-timer - secs nil `(lambda () - (setq org-timer-current-timer nil) - (org-notify ,(format "%s: time out" hl) ,org-clock-sound) - (setq org-timer-timer-is-countdown nil) - (org-timer-set-mode-line 'off) - (run-hooks 'org-timer-done-hook)))) - (run-hooks 'org-timer-set-hook) - (setq org-timer-timer-is-countdown t - org-timer-start-time - (time-add (current-time) (seconds-to-time (* mins 60)))) - (org-timer-set-mode-line 'on)) - (message "No timer set")))))) - -(provide 'org-timer) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; org-timer.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-version.el b/xemacs-packages/lisp/org-8.2.3c/org-version.el deleted file mode 100644 index abe8bd3d..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-version.el +++ /dev/null @@ -1,27 +0,0 @@ -;;; org-version.el --- autogenerated file, do not edit -;; -;;; Code: -;;;###autoload -(defun org-release () - "The release version of org-mode. - Inserted by installing org-mode or when a release is made." - (let ((org-release "8.2.3c")) - org-release)) -;;;###autoload -(defun org-git-version () - "The Git version of org-mode. - Inserted by installing org-mode or when a release is made." - (let ((org-git-version "8.2.3c-dist")) - org-git-version)) -;;;###autoload -(defvar org-odt-data-dir "/usr/share/emacs/etc/org" - "The location of ODT styles.") - -(provide 'org-version) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; coding: utf-8 -;; End: -;;; org-version.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org-w3m.el b/xemacs-packages/lisp/org-8.2.3c/org-w3m.el deleted file mode 100644 index a2f29165..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org-w3m.el +++ /dev/null @@ -1,183 +0,0 @@ -;;; org-w3m.el --- Support from copy and paste from w3m to Org-mode - -;; Copyright (C) 2008-2013 Free Software Foundation, Inc. - -;; Author: Andy Stewart <lazycat dot manatee at gmail dot com> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; This file is 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 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 GNU Emacs. If not, see <http://www.gnu.org/licenses/>. -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Commentary: - -;; This file implements copying HTML content from a w3m buffer and -;; transforming the text on the fly so that it can be pasted into -;; an org-mode buffer with hot links. It will also work for regions -;; in gnus buffers that have been washed with w3m. - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;;; Acknowledgments: - -;; Richard Riley <rileyrgdev at googlemail dot com> -;; -;; The idea of transforming the HTML content with org-mode style is -;; proposed by Richard, I'm just coding it. -;; - -;;; Code: - -(require 'org) - -(defvar w3m-current-url) -(defvar w3m-current-title) - -(add-hook 'org-store-link-functions 'org-w3m-store-link) -(defun org-w3m-store-link () - "Store a link to a w3m buffer." - (when (eq major-mode 'w3m-mode) - (org-store-link-props - :type "w3m" - :link w3m-current-url - :url (url-view-url t) - :description (or w3m-current-title w3m-current-url)))) - -(defun org-w3m-copy-for-org-mode () - "Copy current buffer content or active region with `org-mode' style links. -This will encode `link-title' and `link-location' with -`org-make-link-string', and insert the transformed test into the kill ring, -so that it can be yanked into an Org-mode buffer with links working correctly." - (interactive) - (let* ((regionp (org-region-active-p)) - (transform-start (point-min)) - (transform-end (point-max)) - return-content - link-location link-title - temp-position out-bound) - (when regionp - (setq transform-start (region-beginning)) - (setq transform-end (region-end)) - ;; Deactivate mark if current mark is activate. - (if (fboundp 'deactivate-mark) (deactivate-mark))) - (message "Transforming links...") - (save-excursion - (goto-char transform-start) - (while (and (not out-bound) ; still inside region to copy - (not (org-w3m-no-next-link-p))) ; no next link current buffer - ;; store current point before jump next anchor - (setq temp-position (point)) - ;; move to next anchor when current point is not at anchor - (or (get-text-property (point) 'w3m-href-anchor) (org-w3m-get-next-link-start)) - (if (<= (point) transform-end) ; if point is inside transform bound - (progn - ;; get content between two links. - (if (> (point) temp-position) - (setq return-content (concat return-content - (buffer-substring - temp-position (point))))) - ;; get link location at current point. - (setq link-location (get-text-property (point) 'w3m-href-anchor)) - ;; get link title at current point. - (setq link-title (buffer-substring (point) - (org-w3m-get-anchor-end))) - ;; concat `org-mode' style url to `return-content'. - (setq return-content (concat return-content - (org-make-link-string - link-location link-title)))) - (goto-char temp-position) ; reset point before jump next anchor - (setq out-bound t) ; for break out `while' loop - )) - ;; add the rest until end of the region to be copied - (if (< (point) transform-end) - (setq return-content - (concat return-content - (buffer-substring (point) transform-end)))) - (org-kill-new return-content) - (message "Transforming links...done, use C-y to insert text into Org-mode file") - (message "Copy with link transformation complete.")))) - -(defun org-w3m-get-anchor-start () - "Move cursor to the start of current anchor. Return point." - ;; get start position of anchor or current point - (goto-char (or (previous-single-property-change (point) 'w3m-anchor-sequence) - (point)))) - -(defun org-w3m-get-anchor-end () - "Move cursor to the end of current anchor. Return point." - ;; get end position of anchor or point - (goto-char (or (next-single-property-change (point) 'w3m-anchor-sequence) - (point)))) - -(defun org-w3m-get-next-link-start () - "Move cursor to the start of next link. Return point." - (catch 'reach - (while (next-single-property-change (point) 'w3m-anchor-sequence) - ;; jump to next anchor - (goto-char (next-single-property-change (point) 'w3m-anchor-sequence)) - (when (get-text-property (point) 'w3m-href-anchor) - ;; return point when current is valid link - (throw 'reach nil)))) - (point)) - -(defun org-w3m-get-prev-link-start () - "Move cursor to the start of previous link. Return point." - (catch 'reach - (while (previous-single-property-change (point) 'w3m-anchor-sequence) - ;; jump to previous anchor - (goto-char (previous-single-property-change (point) 'w3m-anchor-sequence)) - (when (get-text-property (point) 'w3m-href-anchor) - ;; return point when current is valid link - (throw 'reach nil)))) - (point)) - -(defun org-w3m-no-next-link-p () - "Whether there is no next link after the cursor. -Return t if there is no next link; otherwise, return nil." - (save-excursion - (equal (point) (org-w3m-get-next-link-start)))) - -(defun org-w3m-no-prev-link-p () - "Whether there is no previous link after the cursor. -Return t if there is no previous link; otherwise, return nil." - (save-excursion - (equal (point) (org-w3m-get-prev-link-start)))) - -;; Install keys into the w3m keymap -(defvar w3m-mode-map) -(defvar w3m-minor-mode-map) -(when (and (boundp 'w3m-mode-map) - (keymapp w3m-mode-map)) - (define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode) - (define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)) -(when (and (boundp 'w3m-minor-mode-map) - (keymapp w3m-minor-mode-map)) - (define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode) - (define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode)) -(add-hook - 'w3m-mode-hook - (lambda () - (define-key w3m-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode) - (define-key w3m-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))) -(add-hook - 'w3m-minor-mode-hook - (lambda () - (define-key w3m-minor-mode-map "\C-c\C-x\M-w" 'org-w3m-copy-for-org-mode) - (define-key w3m-minor-mode-map "\C-c\C-x\C-w" 'org-w3m-copy-for-org-mode))) - -(provide 'org-w3m) - -;;; org-w3m.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/org.el b/xemacs-packages/lisp/org-8.2.3c/org.el deleted file mode 100644 index 8c0fe354..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/org.el +++ /dev/null @@ -1,23910 +0,0 @@ -;;; org.el --- Outline-based notes management and organizer - -;; Carstens outline-mode for keeping track of everything. -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. -;; -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Maintainer: Carsten Dominik <carsten at orgmode dot org> -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org -;; -;; 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: -;; -;; Org-mode is a mode for keeping notes, maintaining ToDo lists, and doing -;; project planning with a fast and effective plain-text system. -;; -;; Org-mode develops organizational tasks around NOTES files that contain -;; information about projects as plain text. Org-mode is implemented on -;; top of outline-mode, which makes it possible to keep the content of -;; large files well structured. Visibility cycling and structure editing -;; help to work with the tree. Tables are easily created with a built-in -;; table editor. Org-mode supports ToDo items, deadlines, time stamps, -;; and scheduling. It dynamically compiles entries into an agenda that -;; utilizes and smoothly integrates much of the Emacs calendar and diary. -;; Plain text URL-like links connect to websites, emails, Usenet -;; messages, BBDB entries, and any files related to the projects. For -;; printing and sharing of notes, an Org-mode file can be exported as a -;; structured ASCII file, as HTML, or (todo and agenda items only) as an -;; iCalendar file. It can also serve as a publishing tool for a set of -;; linked webpages. -;; -;; Installation and Activation -;; --------------------------- -;; See the corresponding sections in the manual at -;; -;; http://orgmode.org/org.html#Installation -;; -;; Documentation -;; ------------- -;; The documentation of Org-mode can be found in the TeXInfo file. The -;; distribution also contains a PDF version of it. At the homepage of -;; Org-mode, you can read the same text online as HTML. There is also an -;; excellent reference card made by Philip Rooke. This card can be found -;; in the etc/ directory of Emacs 22. -;; -;; A list of recent changes can be found at -;; http://orgmode.org/Changes.html -;; -;;; Code: - -(defvar org-inhibit-highlight-removal nil) ; dynamically scoped param -(defvar org-table-formula-constants-local nil - "Local version of `org-table-formula-constants'.") -(make-variable-buffer-local 'org-table-formula-constants-local) - -;;;; Require other packages - -(eval-when-compile - (require 'cl) - (require 'gnus-sum)) - -(require 'calendar) -(require 'find-func) -(require 'format-spec) - -(load "org-loaddefs.el" t t t) - -(require 'org-macs) -(require 'org-compat) - -;; `org-outline-regexp' ought to be a defconst but is let-bound in -;; some places -- e.g. see the macro `org-with-limited-levels'. -;; -;; In Org buffers, the value of `outline-regexp' is that of -;; `org-outline-regexp'. The only function still directly relying on -;; `outline-regexp' is `org-overview' so that `org-cycle' can do its -;; job when `orgstruct-mode' is active. -(defvar org-outline-regexp "\\*+ " - "Regexp to match Org headlines.") - -(defvar org-outline-regexp-bol "^\\*+ " - "Regexp to match Org headlines. -This is similar to `org-outline-regexp' but additionally makes -sure that we are at the beginning of the line.") - -(defvar org-heading-regexp "^\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Matches a headline, putting stars and text into groups. -Stars are put in group 1 and the trimmed body in group 2.") - -;; Emacs 22 calendar compatibility: Make sure the new variables are available -(unless (boundp 'calendar-view-holidays-initially-flag) - (org-defvaralias 'calendar-view-holidays-initially-flag - 'view-calendar-holidays-initially)) -(unless (boundp 'calendar-view-diary-initially-flag) - (org-defvaralias 'calendar-view-diary-initially-flag - 'view-diary-entries-initially)) -(unless (boundp 'diary-fancy-buffer) - (org-defvaralias 'diary-fancy-buffer 'fancy-diary-buffer)) - -(declare-function org-inlinetask-at-task-p "org-inlinetask" ()) -(declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) -(declare-function org-inlinetask-toggle-visibility "org-inlinetask" ()) -(declare-function org-pop-to-buffer-same-window "org-compat" (&optional buffer-or-name norecord label)) -(declare-function org-clock-get-last-clock-out-time "org-clock" ()) -(declare-function org-clock-timestamps-up "org-clock" (&optional n)) -(declare-function org-clock-timestamps-down "org-clock" (&optional n)) -(declare-function org-clock-sum-current-item "org-clock" (&optional tstart)) - -(declare-function orgtbl-mode "org-table" (&optional arg)) -(declare-function org-clock-out "org-clock" (&optional switch-to-state fail-quietly at-time)) -(declare-function org-beamer-mode "ox-beamer" ()) -(declare-function org-table-edit-field "org-table" (arg)) -(declare-function org-table-justify-field-maybe "org-table" (&optional new)) -(declare-function org-table-set-constants "org-table" ()) -(declare-function org-table-calc-current-TBLFM "org-table" (&optional arg)) -(declare-function org-id-get-create "org-id" (&optional force)) -(declare-function org-id-find-id-file "org-id" (id)) -(declare-function org-tags-view "org-agenda" (&optional todo-only match)) -(declare-function org-agenda-list "org-agenda" (&optional arg start-day span)) -(declare-function org-agenda-redo "org-agenda" (&optional all)) -(declare-function org-table-align "org-table" ()) -(declare-function org-table-paste-rectangle "org-table" ()) -(declare-function org-table-maybe-eval-formula "org-table" ()) -(declare-function org-table-maybe-recalculate-line "org-table" ()) - -(declare-function org-element--parse-objects "org-element" - (beg end acc restriction)) -(declare-function org-element-at-point "org-element" (&optional keep-trail)) -(declare-function org-element-contents "org-element" (element)) -(declare-function org-element-context "org-element" (&optional element)) -(declare-function org-element-interpret-data "org-element" - (data &optional parent)) -(declare-function org-element-map "org-element" - (data types fun &optional info first-match no-recursion)) -(declare-function org-element-nested-p "org-element" (elem-a elem-b)) -(declare-function org-element-parse-buffer "org-element" - (&optional granularity visible-only)) -(declare-function org-element-property "org-element" (property element)) -(declare-function org-element-put-property "org-element" - (element property value)) -(declare-function org-element-swap-A-B "org-element" (elem-a elem-b)) -(declare-function org-element--parse-objects "org-element" - (beg end acc restriction)) -(declare-function org-element-parse-buffer "org-element" - (&optional granularity visible-only)) -(declare-function org-element-restriction "org-element" (element)) -(declare-function org-element-type "org-element" (element)) - -;; load languages based on value of `org-babel-load-languages' -(defvar org-babel-load-languages) - -;;;###autoload -(defun org-babel-do-load-languages (sym value) - "Load the languages defined in `org-babel-load-languages'." - (set-default sym value) - (mapc (lambda (pair) - (let ((active (cdr pair)) (lang (symbol-name (car pair)))) - (if active - (progn - (require (intern (concat "ob-" lang)))) - (progn - (funcall 'fmakunbound - (intern (concat "org-babel-execute:" lang))) - (funcall 'fmakunbound - (intern (concat "org-babel-expand-body:" lang))))))) - org-babel-load-languages)) - -;;;###autoload -(defun org-babel-load-file (file &optional compile) - "Load Emacs Lisp source code blocks in the Org-mode FILE. -This function exports the source code using `org-babel-tangle' -and then loads the resulting file using `load-file'. With prefix -arg (noninteractively: 2nd arg) COMPILE the tangled Emacs Lisp -file to byte-code before it is loaded." - (interactive "fFile to load: \nP") - (require 'ob-core) - (let* ((age (lambda (file) - (float-time - (time-subtract (current-time) - (nth 5 (or (file-attributes (file-truename file)) - (file-attributes file))))))) - (base-name (file-name-sans-extension file)) - (exported-file (concat base-name ".el"))) - ;; tangle if the org-mode file is newer than the elisp file - (unless (and (file-exists-p exported-file) - (> (funcall age file) (funcall age exported-file))) - (setq exported-file - (car (org-babel-tangle-file file exported-file "emacs-lisp")))) - (message "%s %s" - (if compile - (progn (byte-compile-file exported-file 'load) - "Compiled and loaded") - (progn (load-file exported-file) "Loaded")) - exported-file))) - -(defcustom org-babel-load-languages '((emacs-lisp . t)) - "Languages which can be evaluated in Org-mode buffers. -This list can be used to load support for any of the languages -below, note that each language will depend on a different set of -system executables and/or Emacs modes. When a language is -\"loaded\", then code blocks in that language can be evaluated -with `org-babel-execute-src-block' bound by default to C-c -C-c (note the `org-babel-no-eval-on-ctrl-c-ctrl-c' variable can -be set to remove code block evaluation from the C-c C-c -keybinding. By default only Emacs Lisp (which has no -requirements) is loaded." - :group 'org-babel - :set 'org-babel-do-load-languages - :version "24.1" - :type '(alist :tag "Babel Languages" - :key-type - (choice - (const :tag "Awk" awk) - (const :tag "C" C) - (const :tag "R" R) - (const :tag "Asymptote" asymptote) - (const :tag "Calc" calc) - (const :tag "Clojure" clojure) - (const :tag "CSS" css) - (const :tag "Ditaa" ditaa) - (const :tag "Dot" dot) - (const :tag "Emacs Lisp" emacs-lisp) - (const :tag "Fortran" fortran) - (const :tag "Gnuplot" gnuplot) - (const :tag "Haskell" haskell) - (const :tag "IO" io) - (const :tag "Java" java) - (const :tag "Javascript" js) - (const :tag "LaTeX" latex) - (const :tag "Ledger" ledger) - (const :tag "Lilypond" lilypond) - (const :tag "Lisp" lisp) - (const :tag "Makefile" makefile) - (const :tag "Maxima" maxima) - (const :tag "Matlab" matlab) - (const :tag "Mscgen" mscgen) - (const :tag "Ocaml" ocaml) - (const :tag "Octave" octave) - (const :tag "Org" org) - (const :tag "Perl" perl) - (const :tag "Pico Lisp" picolisp) - (const :tag "PlantUML" plantuml) - (const :tag "Python" python) - (const :tag "Ruby" ruby) - (const :tag "Sass" sass) - (const :tag "Scala" scala) - (const :tag "Scheme" scheme) - (const :tag "Screen" screen) - (const :tag "Shell Script" sh) - (const :tag "Shen" shen) - (const :tag "Sql" sql) - (const :tag "Sqlite" sqlite)) - :value-type (boolean :tag "Activate" :value t))) - -;;;; Customization variables -(defcustom org-clone-delete-id nil - "Remove ID property of clones of a subtree. -When non-nil, clones of a subtree don't inherit the ID property. -Otherwise they inherit the ID property with a new unique -identifier." - :type 'boolean - :version "24.1" - :group 'org-id) - -;;; Version -(org-check-version) - -;;;###autoload -(defun org-version (&optional here full message) - "Show the org-mode version in the echo area. -With prefix argument HERE, insert it at point. -When FULL is non-nil, use a verbose version string. -When MESSAGE is non-nil, display a message with the version." - (interactive "P") - (let* ((org-dir (ignore-errors (org-find-library-dir "org"))) - (save-load-suffixes (when (boundp 'load-suffixes) load-suffixes)) - (load-suffixes (list ".el")) - (org-install-dir (ignore-errors (org-find-library-dir "org-loaddefs"))) - (org-trash (or - (and (fboundp 'org-release) (fboundp 'org-git-version)) - (org-load-noerror-mustsuffix (concat org-dir "org-version")))) - (load-suffixes save-load-suffixes) - (org-version (org-release)) - (git-version (org-git-version)) - (version (format "Org-mode version %s (%s @ %s)" - org-version - git-version - (if org-install-dir - (if (string= org-dir org-install-dir) - org-install-dir - (concat "mixed installation! " org-install-dir " and " org-dir)) - "org-loaddefs.el can not be found!"))) - (version1 (if full version org-version))) - (if (org-called-interactively-p 'interactive) - (if here - (insert version) - (message version)) - (if message (message version1)) - version1))) - -(defconst org-version (org-version)) - -;;; Compatibility constants - -;;; The custom variables - -(defgroup org nil - "Outline-based notes management and organizer." - :tag "Org" - :group 'outlines - :group 'calendar) - -(defcustom org-mode-hook nil - "Mode hook for Org-mode, run after the mode was turned on." - :group 'org - :type 'hook) - -(defcustom org-load-hook nil - "Hook that is run after org.el has been loaded." - :group 'org - :type 'hook) - -(defcustom org-log-buffer-setup-hook nil - "Hook that is run after an Org log buffer is created." - :group 'org - :version "24.1" - :type 'hook) - -(defvar org-modules) ; defined below -(defvar org-modules-loaded nil - "Have the modules been loaded already?") - -(defun org-load-modules-maybe (&optional force) - "Load all extensions listed in `org-modules'." - (when (or force (not org-modules-loaded)) - (mapc (lambda (ext) - (condition-case nil (require ext) - (error (message "Problems while trying to load feature `%s'" ext)))) - org-modules) - (setq org-modules-loaded t))) - -(defun org-set-modules (var value) - "Set VAR to VALUE and call `org-load-modules-maybe' with the force flag." - (set var value) - (when (featurep 'org) - (org-load-modules-maybe 'force))) - -(defcustom org-modules '(org-w3m org-bbdb org-bibtex org-docview org-gnus org-info org-irc org-mhe org-rmail) - "Modules that should always be loaded together with org.el. - -If a description starts with <C>, the file is not part of Emacs -and loading it will require that you have downloaded and properly -installed the Org mode distribution. - -You can also use this system to load external packages (i.e. neither Org -core modules, nor modules from the CONTRIB directory). Just add symbols -to the end of the list. If the package is called org-xyz.el, then you need -to add the symbol `xyz', and the package must have a call to: - - \(provide 'org-xyz) - -For export specific modules, see also `org-export-backends'." - :group 'org - :set 'org-set-modules - :version "24.4" - :package-version '(Org . "8.0") - :type - '(set :greedy t - (const :tag " bbdb: Links to BBDB entries" org-bbdb) - (const :tag " bibtex: Links to BibTeX entries" org-bibtex) - (const :tag " crypt: Encryption of subtrees" org-crypt) - (const :tag " ctags: Access to Emacs tags with links" org-ctags) - (const :tag " docview: Links to doc-view buffers" org-docview) - (const :tag " gnus: Links to GNUS folders/messages" org-gnus) - (const :tag " habit: Track your consistency with habits" org-habit) - (const :tag " id: Global IDs for identifying entries" org-id) - (const :tag " info: Links to Info nodes" org-info) - (const :tag " inlinetask: Tasks independent of outline hierarchy" org-inlinetask) - (const :tag " irc: Links to IRC/ERC chat sessions" org-irc) - (const :tag " mhe: Links to MHE folders/messages" org-mhe) - (const :tag " mouse: Additional mouse support" org-mouse) - (const :tag " protocol: Intercept calls from emacsclient" org-protocol) - (const :tag " rmail: Links to RMAIL folders/messages" org-rmail) - (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m) - - (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) - (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark) - (const :tag "C bullets: Add overlays to headlines stars" org-bullets) - (const :tag "C checklist: Extra functions for checklists in repeated tasks" org-checklist) - (const :tag "C choose: Use TODO keywords to mark decisions states" org-choose) - (const :tag "C collector: Collect properties into tables" org-collector) - (const :tag "C depend: TODO dependencies for Org-mode\n\t\t\t(PARTIALLY OBSOLETE, see built-in dependency support))" org-depend) - (const :tag "C drill: Flashcards and spaced repetition for Org-mode" org-drill) - (const :tag "C elisp-symbol: Org-mode links to emacs-lisp symbols" org-elisp-symbol) - (const :tag "C eshell Support for links to working directories in eshell" org-eshell) - (const :tag "C eval-light: Evaluate inbuffer-code on demand" org-eval-light) - (const :tag "C eval: Include command output as text" org-eval) - (const :tag "C expiry: Expiry mechanism for Org-mode entries" org-expiry) - (const :tag "C favtable: Lookup table of favorite references and links" org-favtable) - (const :tag "C git-link: Provide org links to specific file version" org-git-link) - (const :tag "C interactive-query: Interactive modification of tags query\n\t\t\t(PARTIALLY OBSOLETE, see secondary filtering)" org-interactive-query) - (const :tag "C invoice: Help manage client invoices in Org-mode" org-invoice) - (const :tag "C jira: Add a jira:ticket protocol to Org-mode" org-jira) - (const :tag "C learn: SuperMemo's incremental learning algorithm" org-learn) - (const :tag "C mac-iCal Imports events from iCal.app to the Emacs diary" org-mac-iCal) - (const :tag "C mac-link: Grab links and url from various mac Applications" org-mac-link) - (const :tag "C mairix: Hook mairix search into Org-mode for different MUAs" org-mairix) - (const :tag "C man: Support for links to manpages in Org-mode" org-man) - (const :tag "C mew: Links to Mew folders/messages" org-mew) - (const :tag "C mtags: Support for muse-like tags" org-mtags) - (const :tag "C notmuch: Provide org links to notmuch searches or messages" org-notmuch) - (const :tag "C panel: Simple routines for us with bad memory" org-panel) - (const :tag "C registry: A registry for Org-mode links" org-registry) - (const :tag "C screen: Visit screen sessions through Org-mode links" org-screen) - (const :tag "C secretary: Team management with org-mode" org-secretary) - (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) - (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) - (const :tag "C track: Keep up with Org-mode development" org-track) - (const :tag "C velocity Something like Notational Velocity for Org" org-velocity) - (const :tag "C vm: Links to VM folders/messages" org-vm) - (const :tag "C wikinodes: CamelCase wiki-like links" org-wikinodes) - (const :tag "C wl: Links to Wanderlust folders/messages" org-wl) - (repeat :tag "External packages" :inline t (symbol :tag "Package")))) - -(defvar org-export--registered-backends) ; From ox.el. -(declare-function org-export-derived-backend-p "ox" (backend &rest backends)) -(declare-function org-export-backend-name "ox" (backend)) -(defcustom org-export-backends '(ascii html icalendar latex) - "List of export back-ends that should be always available. - -If a description starts with <C>, the file is not part of Emacs -and loading it will require that you have downloaded and properly -installed the Org mode distribution. - -Unlike to `org-modules', libraries in this list will not be -loaded along with Org, but only once the export framework is -needed. - -This variable needs to be set before org.el is loaded. If you -need to make a change while Emacs is running, use the customize -interface or run the following code, where VAL stands for the new -value of the variable, after updating it: - - \(progn - \(setq org-export--registered-backends - \(org-remove-if-not - \(lambda (backend) - \(let ((name (org-export-backend-name backend))) - \(or (memq name val) - \(catch 'parentp - \(dolist (b val) - \(and (org-export-derived-backend-p b name) - \(throw 'parentp t))))))) - org-export--registered-backends)) - \(let ((new-list (mapcar 'org-export-backend-name - org-export--registered-backends))) - \(dolist (backend val) - \(cond - \((not (load (format \"ox-%s\" backend) t t)) - \(message \"Problems while trying to load export back-end `%s'\" - backend)) - \((not (memq backend new-list)) (push backend new-list)))) - \(set-default 'org-export-backends new-list))) - -Adding a back-end to this list will also pull the back-end it -depends on, if any." - :group 'org - :group 'org-export - :version "24.4" - :package-version '(Org . "8.0") - :initialize 'custom-initialize-set - :set (lambda (var val) - (if (not (featurep 'ox)) (set-default var val) - ;; Any back-end not required anymore (not present in VAL and not - ;; a parent of any back-end in the new value) is removed from the - ;; list of registered back-ends. - (setq org-export--registered-backends - (org-remove-if-not - (lambda (backend) - (let ((name (org-export-backend-name backend))) - (or (memq name val) - (catch 'parentp - (dolist (b val) - (and (org-export-derived-backend-p b name) - (throw 'parentp t))))))) - org-export--registered-backends)) - ;; Now build NEW-LIST of both new back-ends and required - ;; parents. - (let ((new-list (mapcar 'org-export-backend-name - org-export--registered-backends))) - (dolist (backend val) - (cond - ((not (load (format "ox-%s" backend) t t)) - (message "Problems while trying to load export back-end `%s'" - backend)) - ((not (memq backend new-list)) (push backend new-list)))) - ;; Set VAR to that list with fixed dependencies. - (set-default var new-list)))) - :type '(set :greedy t - (const :tag " ascii Export buffer to ASCII format" ascii) - (const :tag " beamer Export buffer to Beamer presentation" beamer) - (const :tag " html Export buffer to HTML format" html) - (const :tag " icalendar Export buffer to iCalendar format" icalendar) - (const :tag " latex Export buffer to LaTeX format" latex) - (const :tag " man Export buffer to MAN format" man) - (const :tag " md Export buffer to Markdown format" md) - (const :tag " odt Export buffer to ODT format" odt) - (const :tag " org Export buffer to Org format" org) - (const :tag " texinfo Export buffer to Texinfo format" texinfo) - (const :tag "C confluence Export buffer to Confluence Wiki format" confluence) - (const :tag "C deck Export buffer to deck.js presentations" deck) - (const :tag "C freemind Export buffer to Freemind mindmap format" freemind) - (const :tag "C groff Export buffer to Groff format" groff) - (const :tag "C koma-letter Export buffer to KOMA Scrlttrl2 format" koma-letter) - (const :tag "C RSS 2.0 Export buffer to RSS 2.0 format" rss) - (const :tag "C s5 Export buffer to s5 presentations" s5) - (const :tag "C taskjuggler Export buffer to TaskJuggler format" taskjuggler))) - -(eval-after-load 'ox - '(mapc - (lambda (backend) - (condition-case nil (require (intern (format "ox-%s" backend))) - (error (message "Problems while trying to load export back-end `%s'" - backend)))) - org-export-backends)) - -(defcustom org-support-shift-select nil - "Non-nil means make shift-cursor commands select text when possible. - -In Emacs 23, when `shift-select-mode' is on, shifted cursor keys -start selecting a region, or enlarge regions started in this way. -In Org-mode, in special contexts, these same keys are used for -other purposes, important enough to compete with shift selection. -Org tries to balance these needs by supporting `shift-select-mode' -outside these special contexts, under control of this variable. - -The default of this variable is nil, to avoid confusing behavior. Shifted -cursor keys will then execute Org commands in the following contexts: -- on a headline, changing TODO state (left/right) and priority (up/down) -- on a time stamp, changing the time -- in a plain list item, changing the bullet type -- in a property definition line, switching between allowed values -- in the BEGIN line of a clock table (changing the time block). -Outside these contexts, the commands will throw an error. - -When this variable is t and the cursor is not in a special -context, Org-mode will support shift-selection for making and -enlarging regions. To make this more effective, the bullet -cycling will no longer happen anywhere in an item line, but only -if the cursor is exactly on the bullet. - -If you set this variable to the symbol `always', then the keys -will not be special in headlines, property lines, and item lines, -to make shift selection work there as well. If this is what you -want, you can use the following alternative commands: `C-c C-t' -and `C-c ,' to change TODO state and priority, `C-u C-u C-c C-t' -can be used to switch TODO sets, `C-c -' to cycle item bullet -types, and properties can be edited by hand or in column view. - -However, when the cursor is on a timestamp, shift-cursor commands -will still edit the time stamp - this is just too good to give up. - -XEmacs user should have this variable set to nil, because -`shift-select-mode' is in Emacs 23 or later only." - :group 'org - :type '(choice - (const :tag "Never" nil) - (const :tag "When outside special context" t) - (const :tag "Everywhere except timestamps" always))) - -(defcustom org-loop-over-headlines-in-active-region nil - "Shall some commands act upon headlines in the active region? - -When set to `t', some commands will be performed in all headlines -within the active region. - -When set to `start-level', some commands will be performed in all -headlines within the active region, provided that these headlines -are of the same level than the first one. - -When set to a string, those commands will be performed on the -matching headlines within the active region. Such string must be -a tags/property/todo match as it is used in the agenda tags view. - -The list of commands is: `org-schedule', `org-deadline', -`org-todo', `org-archive-subtree', `org-archive-set-tag' and -`org-archive-to-archive-sibling'. The archiving commands skip -already archived entries." - :type '(choice (const :tag "Don't loop" nil) - (const :tag "All headlines in active region" t) - (const :tag "In active region, headlines at the same level than the first one" 'start-level) - (string :tag "Tags/Property/Todo matcher")) - :version "24.1" - :group 'org-todo - :group 'org-archive) - -(defgroup org-startup nil - "Options concerning startup of Org-mode." - :tag "Org Startup" - :group 'org) - -(defcustom org-startup-folded t - "Non-nil means entering Org-mode will switch to OVERVIEW. -This can also be configured on a per-file basis by adding one of -the following lines anywhere in the buffer: - - #+STARTUP: fold (or `overview', this is equivalent) - #+STARTUP: nofold (or `showall', this is equivalent) - #+STARTUP: content - #+STARTUP: showeverything - -By default, this option is ignored when Org opens agenda files -for the first time. If you want the agenda to honor the startup -option, set `org-agenda-inhibit-startup' to nil." - :group 'org-startup - :type '(choice - (const :tag "nofold: show all" nil) - (const :tag "fold: overview" t) - (const :tag "content: all headlines" content) - (const :tag "show everything, even drawers" showeverything))) - -(defcustom org-startup-truncated t - "Non-nil means entering Org-mode will set `truncate-lines'. -This is useful since some lines containing links can be very long and -uninteresting. Also tables look terrible when wrapped." - :group 'org-startup - :type 'boolean) - -(defcustom org-startup-indented nil - "Non-nil means turn on `org-indent-mode' on startup. -This can also be configured on a per-file basis by adding one of -the following lines anywhere in the buffer: - - #+STARTUP: indent - #+STARTUP: noindent" - :group 'org-structure - :type '(choice - (const :tag "Not" nil) - (const :tag "Globally (slow on startup in large files)" t))) - -(defcustom org-use-sub-superscripts t - "Non-nil means interpret \"_\" and \"^\" for display. -When this option is turned on, you can use TeX-like syntax for sub- and -superscripts. Several characters after \"_\" or \"^\" will be -considered as a single item - so grouping with {} is normally not -needed. For example, the following things will be parsed as single -sub- or superscripts. - - 10^24 or 10^tau several digits will be considered 1 item. - 10^-12 or 10^-tau a leading sign with digits or a word - x^2-y^3 will be read as x^2 - y^3, because items are - terminated by almost any nonword/nondigit char. - x_{i^2} or x^(2-i) braces or parenthesis do grouping. - -Still, ambiguity is possible - so when in doubt use {} to enclose -the sub/superscript. If you set this variable to the symbol -`{}', the braces are *required* in order to trigger -interpretations as sub/superscript. This can be helpful in -documents that need \"_\" frequently in plain text." - :group 'org-startup - :version "24.1" - :type '(choice - (const :tag "Always interpret" t) - (const :tag "Only with braces" {}) - (const :tag "Never interpret" nil))) - -(defcustom org-startup-with-beamer-mode nil - "Non-nil means turn on `org-beamer-mode' on startup. -This can also be configured on a per-file basis by adding one of -the following lines anywhere in the buffer: - - #+STARTUP: beamer" - :group 'org-startup - :version "24.1" - :type 'boolean) - -(defcustom org-startup-align-all-tables nil - "Non-nil means align all tables when visiting a file. -This is useful when the column width in tables is forced with <N> cookies -in table fields. Such tables will look correct only after the first re-align. -This can also be configured on a per-file basis by adding one of -the following lines anywhere in the buffer: - #+STARTUP: align - #+STARTUP: noalign" - :group 'org-startup - :type 'boolean) - -(defcustom org-startup-with-inline-images nil - "Non-nil means show inline images when loading a new Org file. -This can also be configured on a per-file basis by adding one of -the following lines anywhere in the buffer: - #+STARTUP: inlineimages - #+STARTUP: noinlineimages" - :group 'org-startup - :version "24.1" - :type 'boolean) - -(defcustom org-startup-with-latex-preview nil - "Non-nil means preview LaTeX fragments when loading a new Org file. - -This can also be configured on a per-file basis by adding one of -the followinglines anywhere in the buffer: - #+STARTUP: latexpreview - #+STARTUP: nolatexpreview" - :group 'org-startup - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-insert-mode-line-in-empty-file nil - "Non-nil means insert the first line setting Org-mode in empty files. -When the function `org-mode' is called interactively in an empty file, this -normally means that the file name does not automatically trigger Org-mode. -To ensure that the file will always be in Org-mode in the future, a -line enforcing Org-mode will be inserted into the buffer, if this option -has been set." - :group 'org-startup - :type 'boolean) - -(defcustom org-replace-disputed-keys nil - "Non-nil means use alternative key bindings for some keys. -Org-mode uses S-<cursor> keys for changing timestamps and priorities. -These keys are also used by other packages like shift-selection-mode' -\(built into Emacs 23), `CUA-mode' or `windmove.el'. -If you want to use Org-mode together with one of these other modes, -or more generally if you would like to move some Org-mode commands to -other keys, set this variable and configure the keys with the variable -`org-disputed-keys'. - -This option is only relevant at load-time of Org-mode, and must be set -*before* org.el is loaded. Changing it requires a restart of Emacs to -become effective." - :group 'org-startup - :type 'boolean) - -(defcustom org-use-extra-keys nil - "Non-nil means use extra key sequence definitions for certain commands. -This happens automatically if you run XEmacs or if `window-system' -is nil. This variable lets you do the same manually. You must -set it before loading org. - -Example: on Carbon Emacs 22 running graphically, with an external -keyboard on a Powerbook, the default way of setting M-left might -not work for either Alt or ESC. Setting this variable will make -it work for ESC." - :group 'org-startup - :type 'boolean) - -(org-defvaralias 'org-CUA-compatible 'org-replace-disputed-keys) - -(defcustom org-disputed-keys - '(([(shift up)] . [(meta p)]) - ([(shift down)] . [(meta n)]) - ([(shift left)] . [(meta -)]) - ([(shift right)] . [(meta +)]) - ([(control shift right)] . [(meta shift +)]) - ([(control shift left)] . [(meta shift -)])) - "Keys for which Org-mode and other modes compete. -This is an alist, cars are the default keys, second element specifies -the alternative to use when `org-replace-disputed-keys' is t. - -Keys can be specified in any syntax supported by `define-key'. -The value of this option takes effect only at Org-mode's startup, -therefore you'll have to restart Emacs to apply it after changing." - :group 'org-startup - :type 'alist) - -(defun org-key (key) - "Select key according to `org-replace-disputed-keys' and `org-disputed-keys'. -Or return the original if not disputed. -Also apply the translations defined in `org-xemacs-key-equivalents'." - (when org-replace-disputed-keys - (let* ((nkey (key-description key)) - (x (org-find-if (lambda (x) - (equal (key-description (car x)) nkey)) - org-disputed-keys))) - (setq key (if x (cdr x) key)))) - (when (featurep 'xemacs) - (setq key (or (cdr (assoc key org-xemacs-key-equivalents)) key))) - key) - -(defun org-find-if (predicate seq) - (catch 'exit - (while seq - (if (funcall predicate (car seq)) - (throw 'exit (car seq)) - (pop seq))))) - -(defun org-defkey (keymap key def) - "Define a key, possibly translated, as returned by `org-key'." - (define-key keymap (org-key key) def)) - -(defcustom org-ellipsis nil - "The ellipsis to use in the Org-mode outline. -When nil, just use the standard three dots. When a string, use that instead, -When a face, use the standard 3 dots, but with the specified face. -The change affects only Org-mode (which will then use its own display table). -Changing this requires executing `M-x org-mode' in a buffer to become -effective." - :group 'org-startup - :type '(choice (const :tag "Default" nil) - (face :tag "Face" :value org-warning) - (string :tag "String" :value "...#"))) - -(defvar org-display-table nil - "The display table for org-mode, in case `org-ellipsis' is non-nil.") - -(defgroup org-keywords nil - "Keywords in Org-mode." - :tag "Org Keywords" - :group 'org) - -(defcustom org-deadline-string "DEADLINE:" - "String to mark deadline entries. -A deadline is this string, followed by a time stamp. Should be a word, -terminated by a colon. You can insert a schedule keyword and -a timestamp with \\[org-deadline]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-scheduled-string "SCHEDULED:" - "String to mark scheduled TODO entries. -A schedule is this string, followed by a time stamp. Should be a word, -terminated by a colon. You can insert a schedule keyword and -a timestamp with \\[org-schedule]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-closed-string "CLOSED:" - "String used as the prefix for timestamps logging closing a TODO entry." - :group 'org-keywords - :type 'string) - -(defcustom org-clock-string "CLOCK:" - "String used as prefix for timestamps clocking work hours on an item." - :group 'org-keywords - :type 'string) - -(defcustom org-closed-keep-when-no-todo nil - "Remove CLOSED: time-stamp when switching back to a non-todo state?" - :group 'org-todo - :group 'org-keywords - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defconst org-planning-or-clock-line-re (concat "^[ \t]*\\(" - org-scheduled-string "\\|" - org-deadline-string "\\|" - org-closed-string "\\|" - org-clock-string "\\)") - "Matches a line with planning or clock info.") - -(defcustom org-comment-string "COMMENT" - "Entries starting with this keyword will never be exported. -An entry can be toggled between COMMENT and normal with -\\[org-toggle-comment]. -Changes become only effective after restarting Emacs." - :group 'org-keywords - :type 'string) - -(defcustom org-quote-string "QUOTE" - "Entries starting with this keyword will be exported in fixed-width font. -Quoting applies only to the text in the entry following the headline, and does -not extend beyond the next headline, even if that is lower level. -An entry can be toggled between QUOTE and normal with -\\[org-toggle-fixed-width-section]." - :group 'org-keywords - :type 'string) - -(defconst org-repeat-re - "<[0-9]\\{4\\}-[0-9][0-9]-[0-9][0-9] [^>\n]*?\\([.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)" - "Regular expression for specifying repeated events. -After a match, group 1 contains the repeat expression.") - -(defgroup org-structure nil - "Options concerning the general structure of Org-mode files." - :tag "Org Structure" - :group 'org) - -(defgroup org-reveal-location nil - "Options about how to make context of a location visible." - :tag "Org Reveal Location" - :group 'org-structure) - -(defconst org-context-choice - '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (repeat :greedy t :tag "Individual contexts" - (cons - (choice :tag "Context" - (const agenda) - (const org-goto) - (const occur-tree) - (const tags-tree) - (const link-search) - (const mark-goto) - (const bookmark-jump) - (const isearch) - (const default)) - (boolean)))) - "Contexts for the reveal options.") - -(defcustom org-show-hierarchy-above '((default . t)) - "Non-nil means show full hierarchy when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the hierarchy of headings -above the exposed location is shown. -Turning this off for example for sparse trees makes them very compact. -Instead of t, this can also be an alist specifying this option for different -contexts. Valid contexts are - agenda when exposing an entry from the agenda - org-goto when using the command `org-goto' on key C-c C-j - occur-tree when using the command `org-occur' on key C-c / - tags-tree when constructing a sparse tree based on tags matches - link-search when exposing search matches associated with a link - mark-goto when exposing the jump goal of a mark - bookmark-jump when exposing a bookmark location - isearch when exiting from an incremental search - default default for all contexts not set explicitly" - :group 'org-reveal-location - :type org-context-choice) - -(defcustom org-show-following-heading '((default . nil)) - "Non-nil means show following heading when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the heading following the -match is shown. -Turning this off for example for sparse trees makes them very compact, -but makes it harder to edit the location of the match. In such a case, -use the command \\[org-reveal] to show more context. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." - :group 'org-reveal-location - :type org-context-choice) - -(defcustom org-show-siblings '((default . nil) (isearch t) (bookmark-jump t)) - "Non-nil means show all sibling heading when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the sibling of the current entry -heading are all made visible. If `org-show-hierarchy-above' is t, -the same happens on each level of the hierarchy above the current entry. - -By default this is on for the isearch context, off for all other contexts. -Turning this off for example for sparse trees makes them very compact, -but makes it harder to edit the location of the match. In such a case, -use the command \\[org-reveal] to show more context. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." - :group 'org-reveal-location - :type org-context-choice - :version "24.4" - :package-version '(Org . "8.0")) - -(defcustom org-show-entry-below '((default . nil)) - "Non-nil means show the entry below a headline when revealing a location. -Org-mode often shows locations in an org-mode file which might have -been invisible before. When this is set, the text below the headline that is -exposed is also shown. - -By default this is off for all contexts. -Instead of t, this can also be an alist specifying this option for different -contexts. See `org-show-hierarchy-above' for valid contexts." - :group 'org-reveal-location - :type org-context-choice) - -(defcustom org-indirect-buffer-display 'other-window - "How should indirect tree buffers be displayed? -This applies to indirect buffers created with the commands -\\[org-tree-to-indirect-buffer] and \\[org-agenda-tree-to-indirect-buffer]. -Valid values are: -current-window Display in the current window -other-window Just display in another window. -dedicated-frame Create one new frame, and re-use it each time. -new-frame Make a new frame each time. Note that in this case - previously-made indirect buffers are kept, and you need to - kill these buffers yourself." - :group 'org-structure - :group 'org-agenda-windows - :type '(choice - (const :tag "In current window" current-window) - (const :tag "In current frame, other window" other-window) - (const :tag "Each time a new frame" new-frame) - (const :tag "One dedicated frame" dedicated-frame))) - -(defcustom org-use-speed-commands nil - "Non-nil means activate single letter commands at beginning of a headline. -This may also be a function to test for appropriate locations where speed -commands should be active." - :group 'org-structure - :type '(choice - (const :tag "Never" nil) - (const :tag "At beginning of headline stars" t) - (function))) - -(defcustom org-speed-commands-user nil - "Alist of additional speed commands. -This list will be checked before `org-speed-commands-default' -when the variable `org-use-speed-commands' is non-nil -and when the cursor is at the beginning of a headline. -The car if each entry is a string with a single letter, which must -be assigned to `self-insert-command' in the global map. -The cdr is either a command to be called interactively, a function -to be called, or a form to be evaluated. -An entry that is just a list with a single string will be interpreted -as a descriptive headline that will be added when listing the speed -commands in the Help buffer using the `?' speed command." - :group 'org-structure - :type '(repeat :value ("k" . ignore) - (choice :value ("k" . ignore) - (list :tag "Descriptive Headline" (string :tag "Headline")) - (cons :tag "Letter and Command" - (string :tag "Command letter") - (choice - (function) - (sexp)))))) - -(defcustom org-bookmark-names-plist - '(:last-capture "org-capture-last-stored" - :last-refile "org-refile-last-stored" - :last-capture-marker "org-capture-last-stored-marker") - "Names for bookmarks automatically set by some Org commands. -This can provide strings as names for a number of bookmakrs Org sets -automatically. The following keys are currently implemented: - :last-capture - :last-capture-marker - :last-refile -When a key does not show up in the property list, the corresponding bookmark -is not set." - :group 'org-structure - :type 'plist) - -(defgroup org-cycle nil - "Options concerning visibility cycling in Org-mode." - :tag "Org Cycle" - :group 'org-structure) - -(defcustom org-cycle-skip-children-state-if-no-children t - "Non-nil means skip CHILDREN state in entries that don't have any." - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-max-level nil - "Maximum level which should still be subject to visibility cycling. -Levels higher than this will, for cycling, be treated as text, not a headline. -When `org-odd-levels-only' is set, a value of N in this variable actually -means 2N-1 stars as the limiting headline. -When nil, cycle all levels. -Note that the limiting level of cycling is also influenced by -`org-inlinetask-min-level'. When `org-cycle-max-level' is not set but -`org-inlinetask-min-level' is, cycling will be limited to levels one less -than its value." - :group 'org-cycle - :type '(choice - (const :tag "No limit" nil) - (integer :tag "Maximum level"))) - -(defcustom org-drawers '("PROPERTIES" "CLOCK" "LOGBOOK" "RESULTS") - "Names of drawers. Drawers are not opened by cycling on the headline above. -Drawers only open with a TAB on the drawer line itself. A drawer looks like -this: - :DRAWERNAME: - ..... - :END: -The drawer \"PROPERTIES\" is special for capturing properties through -the property API. - -Drawers can be defined on the per-file basis with a line like: - -#+DRAWERS: HIDDEN STATE PROPERTIES" - :group 'org-structure - :group 'org-cycle - :type '(repeat (string :tag "Drawer Name"))) - -(defcustom org-hide-block-startup nil - "Non-nil means entering Org-mode will fold all blocks. -This can also be set in on a per-file basis with - -#+STARTUP: hideblocks -#+STARTUP: showblocks" - :group 'org-startup - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-global-at-bob nil - "Cycle globally if cursor is at beginning of buffer and not at a headline. -This makes it possible to do global cycling without having to use S-TAB or -\\[universal-argument] TAB. For this special case to work, the first line -of the buffer must not be a headline -- it may be empty or some other text. -When used in this way, `org-cycle-hook' is disabled temporarily to make -sure the cursor stays at the beginning of the buffer. When this option is -nil, don't do anything special at the beginning of the buffer." - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-level-after-item/entry-creation t - "Non-nil means cycle entry level or item indentation in new empty entries. - -When the cursor is at the end of an empty headline, i.e., with only stars -and maybe a TODO keyword, TAB will then switch the entry to become a child, -and then all possible ancestor states, before returning to the original state. -This makes data entry extremely fast: M-RET to create a new headline, -on TAB to make it a child, two or more tabs to make it a (grand-)uncle. - -When the cursor is at the end of an empty plain list item, one TAB will -make it a subitem, two or more tabs will back up to make this an item -higher up in the item hierarchy." - :group 'org-cycle - :type 'boolean) - -(defcustom org-cycle-emulate-tab t - "Where should `org-cycle' emulate TAB. -nil Never -white Only in completely white lines -whitestart Only at the beginning of lines, before the first non-white char -t Everywhere except in headlines -exc-hl-bol Everywhere except at the start of a headline -If TAB is used in a place where it does not emulate TAB, the current subtree -visibility is cycled." - :group 'org-cycle - :type '(choice (const :tag "Never" nil) - (const :tag "Only in completely white lines" white) - (const :tag "Before first char in a line" whitestart) - (const :tag "Everywhere except in headlines" t) - (const :tag "Everywhere except at bol in headlines" exc-hl-bol))) - -(defcustom org-cycle-separator-lines 2 - "Number of empty lines needed to keep an empty line between collapsed trees. -If you leave an empty line between the end of a subtree and the following -headline, this empty line is hidden when the subtree is folded. -Org-mode will leave (exactly) one empty line visible if the number of -empty lines is equal or larger to the number given in this variable. -So the default 2 means at least 2 empty lines after the end of a subtree -are needed to produce free space between a collapsed subtree and the -following headline. - -If the number is negative, and the number of empty lines is at least -N, -all empty lines are shown. - -Special case: when 0, never leave empty lines in collapsed view." - :group 'org-cycle - :type 'integer) -(put 'org-cycle-separator-lines 'safe-local-variable 'integerp) - -(defcustom org-pre-cycle-hook nil - "Hook that is run before visibility cycling is happening. -The function(s) in this hook must accept a single argument which indicates -the new state that will be set right after running this hook. The -argument is a symbol. Before a global state change, it can have the values -`overview', `content', or `all'. Before a local state change, it can have -the values `folded', `children', or `subtree'." - :group 'org-cycle - :type 'hook) - -(defcustom org-cycle-hook '(org-cycle-hide-archived-subtrees - org-cycle-hide-drawers - org-cycle-hide-inline-tasks - org-cycle-show-empty-lines - org-optimize-window-after-visibility-change) - "Hook that is run after `org-cycle' has changed the buffer visibility. -The function(s) in this hook must accept a single argument which indicates -the new state that was set by the most recent `org-cycle' command. The -argument is a symbol. After a global state change, it can have the values -`overview', `contents', or `all'. After a local state change, it can have -the values `folded', `children', or `subtree'." - :group 'org-cycle - :type 'hook) - -(defgroup org-edit-structure nil - "Options concerning structure editing in Org-mode." - :tag "Org Edit Structure" - :group 'org-structure) - -(defcustom org-odd-levels-only nil - "Non-nil means skip even levels and only use odd levels for the outline. -This has the effect that two stars are being added/taken away in -promotion/demotion commands. It also influences how levels are -handled by the exporters. -Changing it requires restart of `font-lock-mode' to become effective -for fontification also in regions already fontified. -You may also set this on a per-file basis by adding one of the following -lines to the buffer: - - #+STARTUP: odd - #+STARTUP: oddeven" - :group 'org-edit-structure - :group 'org-appearance - :type 'boolean) - -(defcustom org-adapt-indentation t - "Non-nil means adapt indentation to outline node level. - -When this variable is set, Org assumes that you write outlines by -indenting text in each node to align with the headline (after the stars). -The following issues are influenced by this variable: - -- When this is set and the *entire* text in an entry is indented, the - indentation is increased by one space in a demotion command, and - decreased by one in a promotion command. If any line in the entry - body starts with text at column 0, indentation is not changed at all. - -- Property drawers and planning information is inserted indented when - this variable s set. When nil, they will not be indented. - -- TAB indents a line relative to context. The lines below a headline - will be indented when this variable is set. - -Note that this is all about true indentation, by adding and removing -space characters. See also `org-indent.el' which does level-dependent -indentation in a virtual way, i.e. at display time in Emacs." - :group 'org-edit-structure - :type 'boolean) - -(defcustom org-special-ctrl-a/e nil - "Non-nil means `C-a' and `C-e' behave specially in headlines and items. - -When t, `C-a' will bring back the cursor to the beginning of the -headline text, i.e. after the stars and after a possible TODO -keyword. In an item, this will be the position after bullet and -check-box, if any. When the cursor is already at that position, -another `C-a' will bring it to the beginning of the line. - -`C-e' will jump to the end of the headline, ignoring the presence -of tags in the headline. A second `C-e' will then jump to the -true end of the line, after any tags. This also means that, when -this variable is non-nil, `C-e' also will never jump beyond the -end of the heading of a folded section, i.e. not after the -ellipses. - -When set to the symbol `reversed', the first `C-a' or `C-e' works -normally, going to the true line boundary first. Only a directly -following, identical keypress will bring the cursor to the -special positions. - -This may also be a cons cell where the behavior for `C-a' and -`C-e' is set separately." - :group 'org-edit-structure - :type '(choice - (const :tag "off" nil) - (const :tag "on: after stars/bullet and before tags first" t) - (const :tag "reversed: true line boundary first" reversed) - (cons :tag "Set C-a and C-e separately" - (choice :tag "Special C-a" - (const :tag "off" nil) - (const :tag "on: after stars/bullet first" t) - (const :tag "reversed: before stars/bullet first" reversed)) - (choice :tag "Special C-e" - (const :tag "off" nil) - (const :tag "on: before tags first" t) - (const :tag "reversed: after tags first" reversed))))) -(org-defvaralias 'org-special-ctrl-a 'org-special-ctrl-a/e) - -(defcustom org-special-ctrl-k nil - "Non-nil means `C-k' will behave specially in headlines. -When nil, `C-k' will call the default `kill-line' command. -When t, the following will happen while the cursor is in the headline: - -- When the cursor is at the beginning of a headline, kill the entire - line and possible the folded subtree below the line. -- When in the middle of the headline text, kill the headline up to the tags. -- When after the headline text, kill the tags." - :group 'org-edit-structure - :type 'boolean) - -(defcustom org-ctrl-k-protect-subtree nil - "Non-nil means, do not delete a hidden subtree with C-k. -When set to the symbol `error', simply throw an error when C-k is -used to kill (part-of) a headline that has hidden text behind it. -Any other non-nil value will result in a query to the user, if it is -OK to kill that hidden subtree. When nil, kill without remorse." - :group 'org-edit-structure - :version "24.1" - :type '(choice - (const :tag "Do not protect hidden subtrees" nil) - (const :tag "Protect hidden subtrees with a security query" t) - (const :tag "Never kill a hidden subtree with C-k" error))) - -(defcustom org-special-ctrl-o t - "Non-nil means, make `C-o' insert a row in tables." - :group 'org-edit-structure - :type 'boolean) - -(defcustom org-catch-invisible-edits nil - "Check if in invisible region before inserting or deleting a character. -Valid values are: - -nil Do not check, so just do invisible edits. -error Throw an error and do nothing. -show Make point visible, and do the requested edit. -show-and-error Make point visible, then throw an error and abort the edit. -smart Make point visible, and do insertion/deletion if it is - adjacent to visible text and the change feels predictable. - Never delete a previously invisible character or add in the - middle or right after an invisible region. Basically, this - allows insertion and backward-delete right before ellipses. - FIXME: maybe in this case we should not even show?" - :group 'org-edit-structure - :version "24.1" - :type '(choice - (const :tag "Do not check" nil) - (const :tag "Throw error when trying to edit" error) - (const :tag "Unhide, but do not do the edit" show-and-error) - (const :tag "Show invisible part and do the edit" show) - (const :tag "Be smart and do the right thing" smart))) - -(defcustom org-yank-folded-subtrees t - "Non-nil means when yanking subtrees, fold them. -If the kill is a single subtree, or a sequence of subtrees, i.e. if -it starts with a heading and all other headings in it are either children -or siblings, then fold all the subtrees. However, do this only if no -text after the yank would be swallowed into a folded tree by this action." - :group 'org-edit-structure - :type 'boolean) - -(defcustom org-yank-adjusted-subtrees nil - "Non-nil means when yanking subtrees, adjust the level. -With this setting, `org-paste-subtree' is used to insert the subtree, see -this function for details." - :group 'org-edit-structure - :type 'boolean) - -(defcustom org-M-RET-may-split-line '((default . t)) - "Non-nil means M-RET will split the line at the cursor position. -When nil, it will go to the end of the line before making a -new line. -You may also set this option in a different way for different -contexts. Valid contexts are: - -headline when creating a new headline -item when creating a new item -table in a table field -default the value to be used for all contexts not explicitly - customized" - :group 'org-structure - :group 'org-table - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (repeat :greedy t :tag "Individual contexts" - (cons - (choice :tag "Context" - (const headline) - (const item) - (const table) - (const default)) - (boolean))))) - - -(defcustom org-insert-heading-respect-content nil - "Non-nil means insert new headings after the current subtree. -When nil, the new heading is created directly after the current line. -The commands \\[org-insert-heading-respect-content] and \\[org-insert-todo-heading-respect-content] turn -this variable on for the duration of the command." - :group 'org-structure - :type 'boolean) - -(defcustom org-blank-before-new-entry '((heading . auto) - (plain-list-item . auto)) - "Should `org-insert-heading' leave a blank line before new heading/item? -The value is an alist, with `heading' and `plain-list-item' as CAR, -and a boolean flag as CDR. The cdr may also be the symbol `auto', in -which case Org will look at the surrounding headings/items and try to -make an intelligent decision whether to insert a blank line or not. - -For plain lists, if `org-list-empty-line-terminates-plain-lists' is set, -the setting here is ignored and no empty line is inserted to avoid breaking -the list structure." - :group 'org-edit-structure - :type '(list - (cons (const heading) - (choice (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "Auto" auto))) - (cons (const plain-list-item) - (choice (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "Auto" auto))))) - -(defcustom org-insert-heading-hook nil - "Hook being run after inserting a new heading." - :group 'org-edit-structure - :type 'hook) - -(defcustom org-enable-fixed-width-editor t - "Non-nil means lines starting with \":\" are treated as fixed-width. -This currently only means they are never auto-wrapped. -When nil, such lines will be treated like ordinary lines. -See also the QUOTE keyword." - :group 'org-edit-structure - :type 'boolean) - -(defcustom org-goto-auto-isearch t - "Non-nil means typing characters in `org-goto' starts incremental search. -When nil, you can use these keybindings to navigate the buffer: - - q Quit the org-goto interface - n Go to the next visible heading - p Go to the previous visible heading - f Go one heading forward on same level - b Go one heading backward on same level - u Go one heading up" - :group 'org-edit-structure - :type 'boolean) - -(defgroup org-sparse-trees nil - "Options concerning sparse trees in Org-mode." - :tag "Org Sparse Trees" - :group 'org-structure) - -(defcustom org-highlight-sparse-tree-matches t - "Non-nil means highlight all matches that define a sparse tree. -The highlights will automatically disappear the next time the buffer is -changed by an edit command." - :group 'org-sparse-trees - :type 'boolean) - -(defcustom org-remove-highlights-with-change t - "Non-nil means any change to the buffer will remove temporary highlights. -Such highlights are created by `org-occur' and `org-clock-display'. -When nil, `C-c C-c needs to be used to get rid of the highlights. -The highlights created by `org-preview-latex-fragment' always need -`C-c C-c' to be removed." - :group 'org-sparse-trees - :group 'org-time - :type 'boolean) - - -(defcustom org-occur-hook '(org-first-headline-recenter) - "Hook that is run after `org-occur' has constructed a sparse tree. -This can be used to recenter the window to show as much of the structure -as possible." - :group 'org-sparse-trees - :type 'hook) - -(defgroup org-imenu-and-speedbar nil - "Options concerning imenu and speedbar in Org-mode." - :tag "Org Imenu and Speedbar" - :group 'org-structure) - -(defcustom org-imenu-depth 2 - "The maximum level for Imenu access to Org-mode headlines. -This also applied for speedbar access." - :group 'org-imenu-and-speedbar - :type 'integer) - -(defgroup org-table nil - "Options concerning tables in Org-mode." - :tag "Org Table" - :group 'org) - -(defcustom org-enable-table-editor 'optimized - "Non-nil means lines starting with \"|\" are handled by the table editor. -When nil, such lines will be treated like ordinary lines. - -When equal to the symbol `optimized', the table editor will be optimized to -do the following: -- Automatic overwrite mode in front of whitespace in table fields. - This makes the structure of the table stay in tact as long as the edited - field does not exceed the column width. -- Minimize the number of realigns. Normally, the table is aligned each time - TAB or RET are pressed to move to another field. With optimization this - happens only if changes to a field might have changed the column width. -Optimization requires replacing the functions `self-insert-command', -`delete-char', and `backward-delete-char' in Org-mode buffers, with a -slight (in fact: unnoticeable) speed impact for normal typing. Org-mode is -very good at guessing when a re-align will be necessary, but you can always -force one with \\[org-ctrl-c-ctrl-c]. - -If you would like to use the optimized version in Org-mode, but the -un-optimized version in OrgTbl-mode, see the variable `orgtbl-optimized'. - -This variable can be used to turn on and off the table editor during a session, -but in order to toggle optimization, a restart is required. - -See also the variable `org-table-auto-blank-field'." - :group 'org-table - :type '(choice - (const :tag "off" nil) - (const :tag "on" t) - (const :tag "on, optimized" optimized))) - -(defcustom org-self-insert-cluster-for-undo (or (featurep 'xemacs) - (version<= emacs-version "24.1")) - "Non-nil means cluster self-insert commands for undo when possible. -If this is set, then, like in the Emacs command loop, 20 consecutive -characters will be undone together. -This is configurable, because there is some impact on typing performance." - :group 'org-table - :type 'boolean) - -(defcustom org-table-tab-recognizes-table.el t - "Non-nil means TAB will automatically notice a table.el table. -When it sees such a table, it moves point into it and - if necessary - -calls `table-recognize-table'." - :group 'org-table-editing - :type 'boolean) - -(defgroup org-link nil - "Options concerning links in Org-mode." - :tag "Org Link" - :group 'org) - -(defvar org-link-abbrev-alist-local nil - "Buffer-local version of `org-link-abbrev-alist', which see. -The value of this is taken from the #+LINK lines.") -(make-variable-buffer-local 'org-link-abbrev-alist-local) - -(defcustom org-link-abbrev-alist nil - "Alist of link abbreviations. -The car of each element is a string, to be replaced at the start of a link. -The cdrs are replacement values, like (\"linkkey\" . REPLACE). Abbreviated -links in Org-mode buffers can have an optional tag after a double colon, e.g. - - [[linkkey:tag][description]] - -The 'linkkey' must be a word word, starting with a letter, followed -by letters, numbers, '-' or '_'. - -If REPLACE is a string, the tag will simply be appended to create the link. -If the string contains \"%s\", the tag will be inserted there. If the string -contains \"%h\", it will cause a url-encoded version of the tag to be inserted -at that point (see the function `url-hexify-string'). If the string contains -the specifier \"%(my-function)\", then the custom function `my-function' will -be invoked: this function takes the tag as its only argument and must return -a string. - -REPLACE may also be a function that will be called with the tag as the -only argument to create the link, which should be returned as a string. - -See the manual for examples." - :group 'org-link - :type '(repeat - (cons - (string :tag "Protocol") - (choice - (string :tag "Format") - (function))))) - -(defcustom org-descriptive-links t - "Non-nil means Org will display descriptive links. -E.g. [[http://orgmode.org][Org website]] will be displayed as -\"Org Website\", hiding the link itself and just displaying its -description. When set to `nil', Org will display the full links -literally. - -You can interactively set the value of this variable by calling -`org-toggle-link-display' or from the menu Org>Hyperlinks menu." - :group 'org-link - :type 'boolean) - -(defcustom org-link-file-path-type 'adaptive - "How the path name in file links should be stored. -Valid values are: - -relative Relative to the current directory, i.e. the directory of the file - into which the link is being inserted. -absolute Absolute path, if possible with ~ for home directory. -noabbrev Absolute path, no abbreviation of home directory. -adaptive Use relative path for files in the current directory and sub- - directories of it. For other files, use an absolute path." - :group 'org-link - :type '(choice - (const relative) - (const absolute) - (const noabbrev) - (const adaptive))) - -(defcustom org-activate-links '(bracket angle plain radio tag date footnote) - "Types of links that should be activated in Org-mode files. -This is a list of symbols, each leading to the activation of a certain link -type. In principle, it does not hurt to turn on most link types - there may -be a small gain when turning off unused link types. The types are: - -bracket The recommended [[link][description]] or [[link]] links with hiding. -angle Links in angular brackets that may contain whitespace like - <bbdb:Carsten Dominik>. -plain Plain links in normal text, no whitespace, like http://google.com. -radio Text that is matched by a radio target, see manual for details. -tag Tag settings in a headline (link to tag search). -date Time stamps (link to calendar). -footnote Footnote labels. - -Changing this variable requires a restart of Emacs to become effective." - :group 'org-link - :type '(set :greedy t - (const :tag "Double bracket links" bracket) - (const :tag "Angular bracket links" angle) - (const :tag "Plain text links" plain) - (const :tag "Radio target matches" radio) - (const :tag "Tags" tag) - (const :tag "Timestamps" date) - (const :tag "Footnotes" footnote))) - -(defcustom org-make-link-description-function nil - "Function to use for generating link descriptions from links. -When nil, the link location will be used. This function must take -two parameters: the first one is the link, the second one is the -description generated by `org-insert-link'. The function should -return the description to use." - :group 'org-link - :type '(choice (const nil) (function))) - -(defgroup org-link-store nil - "Options concerning storing links in Org-mode." - :tag "Org Store Link" - :group 'org-link) - -(defcustom org-url-hexify-p t - "When non-nil, hexify URL when creating a link." - :type 'boolean - :version "24.3" - :group 'org-link-store) - -(defcustom org-email-link-description-format "Email %c: %.30s" - "Format of the description part of a link to an email or usenet message. -The following %-escapes will be replaced by corresponding information: - -%F full \"From\" field -%f name, taken from \"From\" field, address if no name -%T full \"To\" field -%t first name in \"To\" field, address if no name -%c correspondent. Usually \"from NAME\", but if you sent it yourself, it - will be \"to NAME\". See also the variable `org-from-is-user-regexp'. -%s subject -%d date -%m message-id. - -You may use normal field width specification between the % and the letter. -This is for example useful to limit the length of the subject. - -Examples: \"%f on: %.30s\", \"Email from %f\", \"Email %c\"" - :group 'org-link-store - :type 'string) - -(defcustom org-from-is-user-regexp - (let (r1 r2) - (when (and user-mail-address (not (string= user-mail-address ""))) - (setq r1 (concat "\\<" (regexp-quote user-mail-address) "\\>"))) - (when (and user-full-name (not (string= user-full-name ""))) - (setq r2 (concat "\\<" (regexp-quote user-full-name) "\\>"))) - (if (and r1 r2) (concat r1 "\\|" r2) (or r1 r2))) - "Regexp matched against the \"From:\" header of an email or usenet message. -It should match if the message is from the user him/herself." - :group 'org-link-store - :type 'regexp) - -(defcustom org-context-in-file-links t - "Non-nil means file links from `org-store-link' contain context. -A search string will be added to the file name with :: as separator and -used to find the context when the link is activated by the command -`org-open-at-point'. When this option is t, the entire active region -will be placed in the search string of the file link. If set to a -positive integer, only the first n lines of context will be stored. - -Using a prefix arg to the command \\[org-store-link] (`org-store-link') -negates this setting for the duration of the command." - :group 'org-link-store - :type '(choice boolean integer)) - -(defcustom org-keep-stored-link-after-insertion nil - "Non-nil means keep link in list for entire session. - -The command `org-store-link' adds a link pointing to the current -location to an internal list. These links accumulate during a session. -The command `org-insert-link' can be used to insert links into any -Org-mode file (offering completion for all stored links). When this -option is nil, every link which has been inserted once using \\[org-insert-link] -will be removed from the list, to make completing the unused links -more efficient." - :group 'org-link-store - :type 'boolean) - -(defgroup org-link-follow nil - "Options concerning following links in Org-mode." - :tag "Org Follow Link" - :group 'org-link) - -(defcustom org-link-translation-function nil - "Function to translate links with different syntax to Org syntax. -This can be used to translate links created for example by the Planner -or emacs-wiki packages to Org syntax. -The function must accept two parameters, a TYPE containing the link -protocol name like \"rmail\" or \"gnus\" as a string, and the linked path, -which is everything after the link protocol. It should return a cons -with possibly modified values of type and path. -Org contains a function for this, so if you set this variable to -`org-translate-link-from-planner', you should be able follow many -links created by planner." - :group 'org-link-follow - :type '(choice (const nil) (function))) - -(defcustom org-follow-link-hook nil - "Hook that is run after a link has been followed." - :group 'org-link-follow - :type 'hook) - -(defcustom org-tab-follows-link nil - "Non-nil means on links TAB will follow the link. -Needs to be set before org.el is loaded. -This really should not be used, it does not make sense, and the -implementation is bad." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-return-follows-link nil - "Non-nil means on links RET will follow the link. -In tables, the special behavior of RET has precedence." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-mouse-1-follows-link - (if (boundp 'mouse-1-click-follows-link) mouse-1-click-follows-link t) - "Non-nil means mouse-1 on a link will follow the link. -A longer mouse click will still set point. Does not work on XEmacs. -Needs to be set before org.el is loaded." - :group 'org-link-follow - :version "24.4" - :package-version '(Org . "8.3") - :type '(choice - (const :tag "A double click follows the link" 'double) - (const :tag "Unconditionally follow the link with mouse-1" t) - (integer :tag "mouse-1 click does not follow the link if longer than N ms" 450))) - -(defcustom org-mark-ring-length 4 - "Number of different positions to be recorded in the ring. -Changing this requires a restart of Emacs to work correctly." - :group 'org-link-follow - :type 'integer) - -(defcustom org-link-search-must-match-exact-headline 'query-to-create - "Non-nil means internal links in Org files must exactly match a headline. -When nil, the link search tries to match a phrase with all words -in the search text." - :group 'org-link-follow - :version "24.1" - :type '(choice - (const :tag "Use fuzzy text search" nil) - (const :tag "Match only exact headline" t) - (const :tag "Match exact headline or query to create it" - query-to-create))) - -(defcustom org-link-frame-setup - '((vm . vm-visit-folder-other-frame) - (vm-imap . vm-visit-imap-folder-other-frame) - (gnus . org-gnus-no-new-news) - (file . find-file-other-window) - (wl . wl-other-frame)) - "Setup the frame configuration for following links. -When following a link with Emacs, it may often be useful to display -this link in another window or frame. This variable can be used to -set this up for the different types of links. -For VM, use any of - `vm-visit-folder' - `vm-visit-folder-other-window' - `vm-visit-folder-other-frame' -For Gnus, use any of - `gnus' - `gnus-other-frame' - `org-gnus-no-new-news' -For FILE, use any of - `find-file' - `find-file-other-window' - `find-file-other-frame' -For Wanderlust use any of - `wl' - `wl-other-frame' -For the calendar, use the variable `calendar-setup'. -For BBDB, it is currently only possible to display the matches in -another window." - :group 'org-link-follow - :type '(list - (cons (const vm) - (choice - (const vm-visit-folder) - (const vm-visit-folder-other-window) - (const vm-visit-folder-other-frame))) - (cons (const vm-imap) - (choice - (const vm-visit-imap-folder) - (const vm-visit-imap-folder-other-window) - (const vm-visit-imap-folder-other-frame))) - (cons (const gnus) - (choice - (const gnus) - (const gnus-other-frame) - (const org-gnus-no-new-news))) - (cons (const file) - (choice - (const find-file) - (const find-file-other-window) - (const find-file-other-frame))) - (cons (const wl) - (choice - (const wl) - (const wl-other-frame))))) - -(defcustom org-display-internal-link-with-indirect-buffer nil - "Non-nil means use indirect buffer to display infile links. -Activating internal links (from one location in a file to another location -in the same file) normally just jumps to the location. When the link is -activated with a \\[universal-argument] prefix (or with mouse-3), the link \ -is displayed in -another window. When this option is set, the other window actually displays -an indirect buffer clone of the current buffer, to avoid any visibility -changes to the current buffer." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-open-non-existing-files nil - "Non-nil means `org-open-file' will open non-existing files. -When nil, an error will be generated. -This variable applies only to external applications because they -might choke on non-existing files. If the link is to a file that -will be opened in Emacs, the variable is ignored." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-open-directory-means-index-dot-org nil - "Non-nil means a link to a directory really means to index.org. -When nil, following a directory link will run dired or open a finder/explorer -window on that directory." - :group 'org-link-follow - :type 'boolean) - -(defcustom org-link-mailto-program '(browse-url "mailto:%a?subject=%s") - "Function and arguments to call for following mailto links. -This is a list with the first element being a Lisp function, and the -remaining elements being arguments to the function. In string arguments, -%a will be replaced by the address, and %s will be replaced by the subject -if one was given like in <mailto:arthur@galaxy.org::this subject>." - :group 'org-link-follow - :type '(choice - (const :tag "browse-url" (browse-url-mail "mailto:%a?subject=%s")) - (const :tag "compose-mail" (compose-mail "%a" "%s")) - (const :tag "message-mail" (message-mail "%a" "%s")) - (cons :tag "other" (function) (repeat :tag "argument" sexp)))) - -(defcustom org-confirm-shell-link-function 'yes-or-no-p - "Non-nil means ask for confirmation before executing shell links. -Shell links can be dangerous: just think about a link - - [[shell:rm -rf ~/*][Google Search]] - -This link would show up in your Org-mode document as \"Google Search\", -but really it would remove your entire home directory. -Therefore we advise against setting this variable to nil. -Just change it to `y-or-n-p' if you want to confirm with a -single keystroke rather than having to type \"yes\"." - :group 'org-link-follow - :type '(choice - (const :tag "with yes-or-no (safer)" yes-or-no-p) - (const :tag "with y-or-n (faster)" y-or-n-p) - (const :tag "no confirmation (dangerous)" nil))) -(put 'org-confirm-shell-link-function - 'safe-local-variable - #'(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) - -(defcustom org-confirm-shell-link-not-regexp "" - "A regexp to skip confirmation for shell links." - :group 'org-link-follow - :version "24.1" - :type 'regexp) - -(defcustom org-confirm-elisp-link-function 'yes-or-no-p - "Non-nil means ask for confirmation before executing Emacs Lisp links. -Elisp links can be dangerous: just think about a link - - [[elisp:(shell-command \"rm -rf ~/*\")][Google Search]] - -This link would show up in your Org-mode document as \"Google Search\", -but really it would remove your entire home directory. -Therefore we advise against setting this variable to nil. -Just change it to `y-or-n-p' if you want to confirm with a -single keystroke rather than having to type \"yes\"." - :group 'org-link-follow - :type '(choice - (const :tag "with yes-or-no (safer)" yes-or-no-p) - (const :tag "with y-or-n (faster)" y-or-n-p) - (const :tag "no confirmation (dangerous)" nil))) -(put 'org-confirm-shell-link-function - 'safe-local-variable - #'(lambda (x) (member x '(yes-or-no-p y-or-n-p)))) - -(defcustom org-confirm-elisp-link-not-regexp "" - "A regexp to skip confirmation for Elisp links." - :group 'org-link-follow - :version "24.1" - :type 'regexp) - -(defconst org-file-apps-defaults-gnu - '((remote . emacs) - (system . mailcap) - (t . mailcap)) - "Default file applications on a UNIX or GNU/Linux system. -See `org-file-apps'.") - -(defconst org-file-apps-defaults-macosx - '((remote . emacs) - (t . "open %s") - (system . "open %s") - ("ps.gz" . "gv %s") - ("eps.gz" . "gv %s") - ("dvi" . "xdvi %s") - ("fig" . "xfig %s")) - "Default file applications on a MacOS X system. -The system \"open\" is known as a default, but we use X11 applications -for some files for which the OS does not have a good default. -See `org-file-apps'.") - -(defconst org-file-apps-defaults-windowsnt - (list - '(remote . emacs) - (cons t - (list (if (featurep 'xemacs) - 'mswindows-shell-execute - 'w32-shell-execute) - "open" 'file)) - (cons 'system - (list (if (featurep 'xemacs) - 'mswindows-shell-execute - 'w32-shell-execute) - "open" 'file))) - "Default file applications on a Windows NT system. -The system \"open\" is used for most files. -See `org-file-apps'.") - -(defcustom org-file-apps - '((auto-mode . emacs) - ("\\.mm\\'" . default) - ("\\.x?html?\\'" . default) - ("\\.pdf\\'" . default)) - "External applications for opening `file:path' items in a document. -Org-mode uses system defaults for different file types, but -you can use this variable to set the application for a given file -extension. The entries in this list are cons cells where the car identifies -files and the cdr the corresponding command. Possible values for the -file identifier are - \"string\" A string as a file identifier can be interpreted in different - ways, depending on its contents: - - - Alphanumeric characters only: - Match links with this file extension. - Example: (\"pdf\" . \"evince %s\") - to open PDFs with evince. - - - Regular expression: Match links where the - filename matches the regexp. If you want to - use groups here, use shy groups. - - Example: (\"\\.x?html\\'\" . \"firefox %s\") - (\"\\(?:xhtml\\|html\\)\" . \"firefox %s\") - to open *.html and *.xhtml with firefox. - - - Regular expression which contains (non-shy) groups: - Match links where the whole link, including \"::\", and - anything after that, matches the regexp. - In a custom command string, %1, %2, etc. are replaced with - the parts of the link that were matched by the groups. - For backwards compatibility, if a command string is given - that does not use any of the group matches, this case is - handled identically to the second one (i.e. match against - file name only). - In a custom lisp form, you can access the group matches with - (match-string n link). - - Example: (\"\\.pdf::\\(\\d+\\)\\'\" . \"evince -p %1 %s\") - to open [[file:document.pdf::5]] with evince at page 5. - - `directory' Matches a directory - `remote' Matches a remote file, accessible through tramp or efs. - Remote files most likely should be visited through Emacs - because external applications cannot handle such paths. -`auto-mode' Matches files that are matched by any entry in `auto-mode-alist', - so all files Emacs knows how to handle. Using this with - command `emacs' will open most files in Emacs. Beware that this - will also open html files inside Emacs, unless you add - (\"html\" . default) to the list as well. - t Default for files not matched by any of the other options. - `system' The system command to open files, like `open' on Windows - and Mac OS X, and mailcap under GNU/Linux. This is the command - that will be selected if you call `C-c C-o' with a double - \\[universal-argument] \\[universal-argument] prefix. - -Possible values for the command are: - `emacs' The file will be visited by the current Emacs process. - `default' Use the default application for this file type, which is the - association for t in the list, most likely in the system-specific - part. - This can be used to overrule an unwanted setting in the - system-specific variable. - `system' Use the system command for opening files, like \"open\". - This command is specified by the entry whose car is `system'. - Most likely, the system-specific version of this variable - does define this command, but you can overrule/replace it - here. - string A command to be executed by a shell; %s will be replaced - by the path to the file. - sexp A Lisp form which will be evaluated. The file path will - be available in the Lisp variable `file'. -For more examples, see the system specific constants -`org-file-apps-defaults-macosx' -`org-file-apps-defaults-windowsnt' -`org-file-apps-defaults-gnu'." - :group 'org-link-follow - :type '(repeat - (cons (choice :value "" - (string :tag "Extension") - (const :tag "System command to open files" system) - (const :tag "Default for unrecognized files" t) - (const :tag "Remote file" remote) - (const :tag "Links to a directory" directory) - (const :tag "Any files that have Emacs modes" - auto-mode)) - (choice :value "" - (const :tag "Visit with Emacs" emacs) - (const :tag "Use default" default) - (const :tag "Use the system command" system) - (string :tag "Command") - (sexp :tag "Lisp form"))))) - -(defcustom org-doi-server-url "http://dx.doi.org/" - "The URL of the DOI server." - :type 'string - :version "24.3" - :group 'org-link-follow) - -(defgroup org-refile nil - "Options concerning refiling entries in Org-mode." - :tag "Org Refile" - :group 'org) - -(defcustom org-directory "~/org" - "Directory with org files. -This is just a default location to look for Org files. There is no need -at all to put your files into this directory. It is only used in the -following situations: - -1. When a capture template specifies a target file that is not an - absolute path. The path will then be interpreted relative to - `org-directory' -2. When a capture note is filed away in an interactive way (when exiting the - note buffer with `C-1 C-c C-c'. The user is prompted for an org file, - with `org-directory' as the default path." - :group 'org-refile - :group 'org-capture - :type 'directory) - -(defcustom org-default-notes-file (convert-standard-filename "~/.notes") - "Default target for storing notes. -Used as a fall back file for org-capture.el, for templates that -do not specify a target file." - :group 'org-refile - :group 'org-capture - :type '(choice - (const :tag "Default from remember-data-file" nil) - file)) - -(defcustom org-goto-interface 'outline - "The default interface to be used for `org-goto'. -Allowed values are: -outline The interface shows an outline of the relevant file - and the correct heading is found by moving through - the outline or by searching with incremental search. -outline-path-completion Headlines in the current buffer are offered via - completion. This is the interface also used by - the refile command." - :group 'org-refile - :type '(choice - (const :tag "Outline" outline) - (const :tag "Outline-path-completion" outline-path-completion))) - -(defcustom org-goto-max-level 5 - "Maximum target level when running `org-goto' with refile interface." - :group 'org-refile - :type 'integer) - -(defcustom org-reverse-note-order nil - "Non-nil means store new notes at the beginning of a file or entry. -When nil, new notes will be filed to the end of a file or entry. -This can also be a list with cons cells of regular expressions that -are matched against file names, and values." - :group 'org-capture - :group 'org-refile - :type '(choice - (const :tag "Reverse always" t) - (const :tag "Reverse never" nil) - (repeat :tag "By file name regexp" - (cons regexp boolean)))) - -(defcustom org-log-refile nil - "Information to record when a task is refiled. - -Possible values are: - -nil Don't add anything -time Add a time stamp to the task -note Prompt for a note and add it with template `org-log-note-headings' - -This option can also be set with on a per-file-basis with - - #+STARTUP: nologrefile - #+STARTUP: logrefile - #+STARTUP: lognoterefile - -You can have local logging settings for a subtree by setting the LOGGING -property to one or more of these keywords. - -When bulk-refiling from the agenda, the value `note' is forbidden and -will temporarily be changed to `time'." - :group 'org-refile - :group 'org-progress - :version "24.1" - :type '(choice - (const :tag "No logging" nil) - (const :tag "Record timestamp" time) - (const :tag "Record timestamp with note." note))) - -(defcustom org-refile-targets nil - "Targets for refiling entries with \\[org-refile]. -This is a list of cons cells. Each cell contains: -- a specification of the files to be considered, either a list of files, - or a symbol whose function or variable value will be used to retrieve - a file name or a list of file names. If you use `org-agenda-files' for - that, all agenda files will be scanned for targets. Nil means consider - headings in the current buffer. -- A specification of how to find candidate refile targets. This may be - any of: - - a cons cell (:tag . \"TAG\") to identify refile targets by a tag. - This tag has to be present in all target headlines, inheritance will - not be considered. - - a cons cell (:todo . \"KEYWORD\") to identify refile targets by - todo keyword. - - a cons cell (:regexp . \"REGEXP\") with a regular expression matching - headlines that are refiling targets. - - a cons cell (:level . N). Any headline of level N is considered a target. - Note that, when `org-odd-levels-only' is set, level corresponds to - order in hierarchy, not to the number of stars. - - a cons cell (:maxlevel . N). Any headline with level <= N is a target. - Note that, when `org-odd-levels-only' is set, level corresponds to - order in hierarchy, not to the number of stars. - -Each element of this list generates a set of possible targets. -The union of these sets is presented (with completion) to -the user by `org-refile'. - -You can set the variable `org-refile-target-verify-function' to a function -to verify each headline found by the simple criteria above. - -When this variable is nil, all top-level headlines in the current buffer -are used, equivalent to the value `((nil . (:level . 1))'." - :group 'org-refile - :type '(repeat - (cons - (choice :value org-agenda-files - (const :tag "All agenda files" org-agenda-files) - (const :tag "Current buffer" nil) - (function) (variable) (file)) - (choice :tag "Identify target headline by" - (cons :tag "Specific tag" (const :value :tag) (string)) - (cons :tag "TODO keyword" (const :value :todo) (string)) - (cons :tag "Regular expression" (const :value :regexp) (regexp)) - (cons :tag "Level number" (const :value :level) (integer)) - (cons :tag "Max Level number" (const :value :maxlevel) (integer)))))) - -(defcustom org-refile-target-verify-function nil - "Function to verify if the headline at point should be a refile target. -The function will be called without arguments, with point at the -beginning of the headline. It should return t and leave point -where it is if the headline is a valid target for refiling. - -If the target should not be selected, the function must return nil. -In addition to this, it may move point to a place from where the search -should be continued. For example, the function may decide that the entire -subtree of the current entry should be excluded and move point to the end -of the subtree." - :group 'org-refile - :type '(choice - (const nil) - (function))) - -(defcustom org-refile-use-cache nil - "Non-nil means cache refile targets to speed up the process. -The cache for a particular file will be updated automatically when -the buffer has been killed, or when any of the marker used for flagging -refile targets no longer points at a live buffer. -If you have added new entries to a buffer that might themselves be targets, -you need to clear the cache manually by pressing `C-0 C-c C-w' or, if you -find that easier, `C-u C-u C-u C-c C-w'." - :group 'org-refile - :version "24.1" - :type 'boolean) - -(defcustom org-refile-use-outline-path nil - "Non-nil means provide refile targets as paths. -So a level 3 headline will be available as level1/level2/level3. - -When the value is `file', also include the file name (without directory) -into the path. In this case, you can also stop the completion after -the file name, to get entries inserted as top level in the file. - -When `full-file-path', include the full file path." - :group 'org-refile - :type '(choice - (const :tag "Not" nil) - (const :tag "Yes" t) - (const :tag "Start with file name" file) - (const :tag "Start with full file path" full-file-path))) - -(defcustom org-outline-path-complete-in-steps t - "Non-nil means complete the outline path in hierarchical steps. -When Org-mode uses the refile interface to select an outline path -\(see variable `org-refile-use-outline-path'), the completion of -the path can be done is a single go, or if can be done in steps down -the headline hierarchy. Going in steps is probably the best if you -do not use a special completion package like `ido' or `icicles'. -However, when using these packages, going in one step can be very -fast, while still showing the whole path to the entry." - :group 'org-refile - :type 'boolean) - -(defcustom org-refile-allow-creating-parent-nodes nil - "Non-nil means allow to create new nodes as refile targets. -New nodes are then created by adding \"/new node name\" to the completion -of an existing node. When the value of this variable is `confirm', -new node creation must be confirmed by the user (recommended) -When nil, the completion must match an existing entry. - -Note that, if the new heading is not seen by the criteria -listed in `org-refile-targets', multiple instances of the same -heading would be created by trying again to file under the new -heading." - :group 'org-refile - :type '(choice - (const :tag "Never" nil) - (const :tag "Always" t) - (const :tag "Prompt for confirmation" confirm))) - -(defcustom org-refile-active-region-within-subtree nil - "Non-nil means also refile active region within a subtree. - -By default `org-refile' doesn't allow refiling regions if they -don't contain a set of subtrees, but it might be convenient to -do so sometimes: in that case, the first line of the region is -converted to a headline before refiling." - :group 'org-refile - :version "24.1" - :type 'boolean) - -(defgroup org-todo nil - "Options concerning TODO items in Org-mode." - :tag "Org TODO" - :group 'org) - -(defgroup org-progress nil - "Options concerning Progress logging in Org-mode." - :tag "Org Progress" - :group 'org-time) - -(defvar org-todo-interpretation-widgets - '((:tag "Sequence (cycling hits every state)" sequence) - (:tag "Type (cycling directly to DONE)" type)) - "The available interpretation symbols for customizing `org-todo-keywords'. -Interested libraries should add to this list.") - -(defcustom org-todo-keywords '((sequence "TODO" "DONE")) - "List of TODO entry keyword sequences and their interpretation. -\\<org-mode-map>This is a list of sequences. - -Each sequence starts with a symbol, either `sequence' or `type', -indicating if the keywords should be interpreted as a sequence of -action steps, or as different types of TODO items. The first -keywords are states requiring action - these states will select a headline -for inclusion into the global TODO list Org-mode produces. If one of -the \"keywords\" is the vertical bar, \"|\", the remaining keywords -signify that no further action is necessary. If \"|\" is not found, -the last keyword is treated as the only DONE state of the sequence. - -The command \\[org-todo] cycles an entry through these states, and one -additional state where no keyword is present. For details about this -cycling, see the manual. - -TODO keywords and interpretation can also be set on a per-file basis with -the special #+SEQ_TODO and #+TYP_TODO lines. - -Each keyword can optionally specify a character for fast state selection -\(in combination with the variable `org-use-fast-todo-selection') -and specifiers for state change logging, using the same syntax that -is used in the \"#+TODO:\" lines. For example, \"WAIT(w)\" says that -the WAIT state can be selected with the \"w\" key. \"WAIT(w!)\" -indicates to record a time stamp each time this state is selected. - -Each keyword may also specify if a timestamp or a note should be -recorded when entering or leaving the state, by adding additional -characters in the parenthesis after the keyword. This looks like this: -\"WAIT(w@/!)\". \"@\" means to add a note (with time), \"!\" means to -record only the time of the state change. With X and Y being either -\"@\" or \"!\", \"X/Y\" means use X when entering the state, and use -Y when leaving the state if and only if the *target* state does not -define X. You may omit any of the fast-selection key or X or /Y, -so WAIT(w@), WAIT(w/@) and WAIT(@/@) are all valid. - -For backward compatibility, this variable may also be just a list -of keywords. In this case the interpretation (sequence or type) will be -taken from the (otherwise obsolete) variable `org-todo-interpretation'." - :group 'org-todo - :group 'org-keywords - :type '(choice - (repeat :tag "Old syntax, just keywords" - (string :tag "Keyword")) - (repeat :tag "New syntax" - (cons - (choice - :tag "Interpretation" - ;;Quick and dirty way to see - ;;`org-todo-interpretations'. This takes the - ;;place of item arguments - :convert-widget - (lambda (widget) - (widget-put widget - :args (mapcar - #'(lambda (x) - (widget-convert - (cons 'const x))) - org-todo-interpretation-widgets)) - widget)) - (repeat - (string :tag "Keyword")))))) - -(defvar org-todo-keywords-1 nil - "All TODO and DONE keywords active in a buffer.") -(make-variable-buffer-local 'org-todo-keywords-1) -(defvar org-todo-keywords-for-agenda nil) -(defvar org-done-keywords-for-agenda nil) -(defvar org-drawers-for-agenda nil) -(defvar org-todo-keyword-alist-for-agenda nil) -(defvar org-tag-alist-for-agenda nil - "Alist of all tags from all agenda files.") -(defvar org-tag-groups-alist-for-agenda nil - "Alist of all groups tags from all current agenda files.") -(defvar org-tag-groups-alist nil) -(make-variable-buffer-local 'org-tag-groups-alist) -(defvar org-agenda-contributing-files nil) -(defvar org-not-done-keywords nil) -(make-variable-buffer-local 'org-not-done-keywords) -(defvar org-done-keywords nil) -(make-variable-buffer-local 'org-done-keywords) -(defvar org-todo-heads nil) -(make-variable-buffer-local 'org-todo-heads) -(defvar org-todo-sets nil) -(make-variable-buffer-local 'org-todo-sets) -(defvar org-todo-log-states nil) -(make-variable-buffer-local 'org-todo-log-states) -(defvar org-todo-kwd-alist nil) -(make-variable-buffer-local 'org-todo-kwd-alist) -(defvar org-todo-key-alist nil) -(make-variable-buffer-local 'org-todo-key-alist) -(defvar org-todo-key-trigger nil) -(make-variable-buffer-local 'org-todo-key-trigger) - -(defcustom org-todo-interpretation 'sequence - "Controls how TODO keywords are interpreted. -This variable is in principle obsolete and is only used for -backward compatibility, if the interpretation of todo keywords is -not given already in `org-todo-keywords'. See that variable for -more information." - :group 'org-todo - :group 'org-keywords - :type '(choice (const sequence) - (const type))) - -(defcustom org-use-fast-todo-selection t - "Non-nil means use the fast todo selection scheme with C-c C-t. -This variable describes if and under what circumstances the cycling -mechanism for TODO keywords will be replaced by a single-key, direct -selection scheme. - -When nil, fast selection is never used. - -When the symbol `prefix', it will be used when `org-todo' is called -with a prefix argument, i.e. `C-u C-c C-t' in an Org-mode buffer, and -`C-u t' in an agenda buffer. - -When t, fast selection is used by default. In this case, the prefix -argument forces cycling instead. - -In all cases, the special interface is only used if access keys have -actually been assigned by the user, i.e. if keywords in the configuration -are followed by a letter in parenthesis, like TODO(t)." - :group 'org-todo - :type '(choice - (const :tag "Never" nil) - (const :tag "By default" t) - (const :tag "Only with C-u C-c C-t" prefix))) - -(defcustom org-provide-todo-statistics t - "Non-nil means update todo statistics after insert and toggle. -ALL-HEADLINES means update todo statistics by including headlines -with no TODO keyword as well, counting them as not done. -A list of TODO keywords means the same, but skip keywords that are -not in this list. - -When this is set, todo statistics is updated in the parent of the -current entry each time a todo state is changed." - :group 'org-todo - :type '(choice - (const :tag "Yes, only for TODO entries" t) - (const :tag "Yes, including all entries" 'all-headlines) - (repeat :tag "Yes, for TODOs in this list" - (string :tag "TODO keyword")) - (other :tag "No TODO statistics" nil))) - -(defcustom org-hierarchical-todo-statistics t - "Non-nil means TODO statistics covers just direct children. -When nil, all entries in the subtree are considered. -This has only an effect if `org-provide-todo-statistics' is set. -To set this to nil for only a single subtree, use a COOKIE_DATA -property and include the word \"recursive\" into the value." - :group 'org-todo - :type 'boolean) - -(defcustom org-after-todo-state-change-hook nil - "Hook which is run after the state of a TODO item was changed. -The new state (a string with a TODO keyword, or nil) is available in the -Lisp variable `org-state'." - :group 'org-todo - :type 'hook) - -(defvar org-blocker-hook nil - "Hook for functions that are allowed to block a state change. - -Functions in this hook should not modify the buffer. -Each function gets as its single argument a property list, -see `org-trigger-hook' for more information about this list. - -If any of the functions in this hook returns nil, the state change -is blocked.") - -(defvar org-trigger-hook nil - "Hook for functions that are triggered by a state change. - -Each function gets as its single argument a property list with at -least the following elements: - - (:type type-of-change :position pos-at-entry-start - :from old-state :to new-state) - -Depending on the type, more properties may be present. - -This mechanism is currently implemented for: - -TODO state changes ------------------- -:type todo-state-change -:from previous state (keyword as a string), or nil, or a symbol - 'todo' or 'done', to indicate the general type of state. -:to new state, like in :from") - -(defcustom org-enforce-todo-dependencies nil - "Non-nil means undone TODO entries will block switching the parent to DONE. -Also, if a parent has an :ORDERED: property, switching an entry to DONE will -be blocked if any prior sibling is not yet done. -Finally, if the parent is blocked because of ordered siblings of its own, -the child will also be blocked." - :set (lambda (var val) - (set var val) - (if val - (add-hook 'org-blocker-hook - 'org-block-todo-from-children-or-siblings-or-parent) - (remove-hook 'org-blocker-hook - 'org-block-todo-from-children-or-siblings-or-parent))) - :group 'org-todo - :type 'boolean) - -(defcustom org-enforce-todo-checkbox-dependencies nil - "Non-nil means unchecked boxes will block switching the parent to DONE. -When this is nil, checkboxes have no influence on switching TODO states. -When non-nil, you first need to check off all check boxes before the TODO -entry can be switched to DONE. -This variable needs to be set before org.el is loaded, and you need to -restart Emacs after a change to make the change effective. The only way -to change is while Emacs is running is through the customize interface." - :set (lambda (var val) - (set var val) - (if val - (add-hook 'org-blocker-hook - 'org-block-todo-from-checkboxes) - (remove-hook 'org-blocker-hook - 'org-block-todo-from-checkboxes))) - :group 'org-todo - :type 'boolean) - -(defcustom org-treat-insert-todo-heading-as-state-change nil - "Non-nil means inserting a TODO heading is treated as state change. -So when the command \\[org-insert-todo-heading] is used, state change -logging will apply if appropriate. When nil, the new TODO item will -be inserted directly, and no logging will take place." - :group 'org-todo - :type 'boolean) - -(defcustom org-treat-S-cursor-todo-selection-as-state-change t - "Non-nil means switching TODO states with S-cursor counts as state change. -This is the default behavior. However, setting this to nil allows a -convenient way to select a TODO state and bypass any logging associated -with that." - :group 'org-todo - :type 'boolean) - -(defcustom org-todo-state-tags-triggers nil - "Tag changes that should be triggered by TODO state changes. -This is a list. Each entry is - - (state-change (tag . flag) .......) - -State-change can be a string with a state, and empty string to indicate the -state that has no TODO keyword, or it can be one of the symbols `todo' -or `done', meaning any not-done or done state, respectively." - :group 'org-todo - :group 'org-tags - :type '(repeat - (cons (choice :tag "When changing to" - (const :tag "Not-done state" todo) - (const :tag "Done state" done) - (string :tag "State")) - (repeat - (cons :tag "Tag action" - (string :tag "Tag") - (choice (const :tag "Add" t) (const :tag "Remove" nil))))))) - -(defcustom org-log-done nil - "Information to record when a task moves to the DONE state. - -Possible values are: - -nil Don't add anything, just change the keyword -time Add a time stamp to the task -note Prompt for a note and add it with template `org-log-note-headings' - -This option can also be set with on a per-file-basis with - - #+STARTUP: nologdone - #+STARTUP: logdone - #+STARTUP: lognotedone - -You can have local logging settings for a subtree by setting the LOGGING -property to one or more of these keywords." - :group 'org-todo - :group 'org-progress - :type '(choice - (const :tag "No logging" nil) - (const :tag "Record CLOSED timestamp" time) - (const :tag "Record CLOSED timestamp with note." note))) - -;; Normalize old uses of org-log-done. -(cond - ((eq org-log-done t) (setq org-log-done 'time)) - ((and (listp org-log-done) (memq 'done org-log-done)) - (setq org-log-done 'note))) - -(defcustom org-log-reschedule nil - "Information to record when the scheduling date of a tasks is modified. - -Possible values are: - -nil Don't add anything, just change the date -time Add a time stamp to the task -note Prompt for a note and add it with template `org-log-note-headings' - -This option can also be set with on a per-file-basis with - - #+STARTUP: nologreschedule - #+STARTUP: logreschedule - #+STARTUP: lognotereschedule" - :group 'org-todo - :group 'org-progress - :type '(choice - (const :tag "No logging" nil) - (const :tag "Record timestamp" time) - (const :tag "Record timestamp with note." note))) - -(defcustom org-log-redeadline nil - "Information to record when the deadline date of a tasks is modified. - -Possible values are: - -nil Don't add anything, just change the date -time Add a time stamp to the task -note Prompt for a note and add it with template `org-log-note-headings' - -This option can also be set with on a per-file-basis with - - #+STARTUP: nologredeadline - #+STARTUP: logredeadline - #+STARTUP: lognoteredeadline - -You can have local logging settings for a subtree by setting the LOGGING -property to one or more of these keywords." - :group 'org-todo - :group 'org-progress - :type '(choice - (const :tag "No logging" nil) - (const :tag "Record timestamp" time) - (const :tag "Record timestamp with note." note))) - -(defcustom org-log-note-clock-out nil - "Non-nil means record a note when clocking out of an item. -This can also be configured on a per-file basis by adding one of -the following lines anywhere in the buffer: - - #+STARTUP: lognoteclock-out - #+STARTUP: nolognoteclock-out" - :group 'org-todo - :group 'org-progress - :type 'boolean) - -(defcustom org-log-done-with-time t - "Non-nil means the CLOSED time stamp will contain date and time. -When nil, only the date will be recorded." - :group 'org-progress - :type 'boolean) - -(defcustom org-log-note-headings - '((done . "CLOSING NOTE %t") - (state . "State %-12s from %-12S %t") - (note . "Note taken on %t") - (reschedule . "Rescheduled from %S on %t") - (delschedule . "Not scheduled, was %S on %t") - (redeadline . "New deadline from %S on %t") - (deldeadline . "Removed deadline, was %S on %t") - (refile . "Refiled on %t") - (clock-out . "")) - "Headings for notes added to entries. -The value is an alist, with the car being a symbol indicating the note -context, and the cdr is the heading to be used. The heading may also be the -empty string. -%t in the heading will be replaced by a time stamp. -%T will be an active time stamp instead the default inactive one -%d will be replaced by a short-format time stamp. -%D will be replaced by an active short-format time stamp. -%s will be replaced by the new TODO state, in double quotes. -%S will be replaced by the old TODO state, in double quotes. -%u will be replaced by the user name. -%U will be replaced by the full user name. - -In fact, it is not a good idea to change the `state' entry, because -agenda log mode depends on the format of these entries." - :group 'org-todo - :group 'org-progress - :type '(list :greedy t - (cons (const :tag "Heading when closing an item" done) string) - (cons (const :tag - "Heading when changing todo state (todo sequence only)" - state) string) - (cons (const :tag "Heading when just taking a note" note) string) - (cons (const :tag "Heading when rescheduling" reschedule) string) - (cons (const :tag "Heading when an item is no longer scheduled" delschedule) string) - (cons (const :tag "Heading when changing deadline" redeadline) string) - (cons (const :tag "Heading when deleting a deadline" deldeadline) string) - (cons (const :tag "Heading when refiling" refile) string) - (cons (const :tag "Heading when clocking out" clock-out) string))) - -(unless (assq 'note org-log-note-headings) - (push '(note . "%t") org-log-note-headings)) - -(defcustom org-log-into-drawer nil - "Non-nil means insert state change notes and time stamps into a drawer. -When nil, state changes notes will be inserted after the headline and -any scheduling and clock lines, but not inside a drawer. - -The value of this variable should be the name of the drawer to use. -LOGBOOK is proposed as the default drawer for this purpose, you can -also set this to a string to define the drawer of your choice. - -A value of t is also allowed, representing \"LOGBOOK\". - -A value of t or nil can also be set with on a per-file-basis with - - #+STARTUP: logdrawer - #+STARTUP: nologdrawer - -If this variable is set, `org-log-state-notes-insert-after-drawers' -will be ignored. - -You can set the property LOG_INTO_DRAWER to overrule this setting for -a subtree." - :group 'org-todo - :group 'org-progress - :type '(choice - (const :tag "Not into a drawer" nil) - (const :tag "LOGBOOK" t) - (string :tag "Other"))) - -(org-defvaralias 'org-log-state-notes-into-drawer 'org-log-into-drawer) - -(defun org-log-into-drawer () - "Return the value of `org-log-into-drawer', but let properties overrule. -If the current entry has or inherits a LOG_INTO_DRAWER property, it will be -used instead of the default value." - (let ((p (org-entry-get nil "LOG_INTO_DRAWER" 'inherit t))) - (cond - ((not p) org-log-into-drawer) - ((equal p "nil") nil) - ((equal p "t") "LOGBOOK") - (t p)))) - -(defcustom org-log-state-notes-insert-after-drawers nil - "Non-nil means insert state change notes after any drawers in entry. -Only the drawers that *immediately* follow the headline and the -deadline/scheduled line are skipped. -When nil, insert notes right after the heading and perhaps the line -with deadline/scheduling if present. - -This variable will have no effect if `org-log-into-drawer' is -set." - :group 'org-todo - :group 'org-progress - :type 'boolean) - -(defcustom org-log-states-order-reversed t - "Non-nil means the latest state note will be directly after heading. -When nil, the state change notes will be ordered according to time. - -This option can also be set with on a per-file-basis with - - #+STARTUP: logstatesreversed - #+STARTUP: nologstatesreversed" - :group 'org-todo - :group 'org-progress - :type 'boolean) - -(defcustom org-todo-repeat-to-state nil - "The TODO state to which a repeater should return the repeating task. -By default this is the first task in a TODO sequence, or the previous state -in a TODO_TYP set. But you can specify another task here. -alternatively, set the :REPEAT_TO_STATE: property of the entry." - :group 'org-todo - :version "24.1" - :type '(choice (const :tag "Head of sequence" nil) - (string :tag "Specific state"))) - -(defcustom org-log-repeat 'time - "Non-nil means record moving through the DONE state when triggering repeat. -An auto-repeating task is immediately switched back to TODO when -marked DONE. If you are not logging state changes (by adding \"@\" -or \"!\" to the TODO keyword definition), or set `org-log-done' to -record a closing note, there will be no record of the task moving -through DONE. This variable forces taking a note anyway. - -nil Don't force a record -time Record a time stamp -note Prompt for a note and add it with template `org-log-note-headings' - -This option can also be set with on a per-file-basis with - - #+STARTUP: nologrepeat - #+STARTUP: logrepeat - #+STARTUP: lognoterepeat - -You can have local logging settings for a subtree by setting the LOGGING -property to one or more of these keywords." - :group 'org-todo - :group 'org-progress - :type '(choice - (const :tag "Don't force a record" nil) - (const :tag "Force recording the DONE state" time) - (const :tag "Force recording a note with the DONE state" note))) - - -(defgroup org-priorities nil - "Priorities in Org-mode." - :tag "Org Priorities" - :group 'org-todo) - -(defcustom org-enable-priority-commands t - "Non-nil means priority commands are active. -When nil, these commands will be disabled, so that you never accidentally -set a priority." - :group 'org-priorities - :type 'boolean) - -(defcustom org-highest-priority ?A - "The highest priority of TODO items. A character like ?A, ?B etc. -Must have a smaller ASCII number than `org-lowest-priority'." - :group 'org-priorities - :type 'character) - -(defcustom org-lowest-priority ?C - "The lowest priority of TODO items. A character like ?A, ?B etc. -Must have a larger ASCII number than `org-highest-priority'." - :group 'org-priorities - :type 'character) - -(defcustom org-default-priority ?B - "The default priority of TODO items. -This is the priority an item gets if no explicit priority is given. -When starting to cycle on an empty priority the first step in the cycle -depends on `org-priority-start-cycle-with-default'. The resulting first -step priority must not exceed the range from `org-highest-priority' to -`org-lowest-priority' which means that `org-default-priority' has to be -in this range exclusive or inclusive the range boundaries. Else the -first step refuses to set the default and the second will fall back -to (depending on the command used) the highest or lowest priority." - :group 'org-priorities - :type 'character) - -(defcustom org-priority-start-cycle-with-default t - "Non-nil means start with default priority when starting to cycle. -When this is nil, the first step in the cycle will be (depending on the -command used) one higher or lower than the default priority. -See also `org-default-priority'." - :group 'org-priorities - :type 'boolean) - -(defcustom org-get-priority-function nil - "Function to extract the priority from a string. -The string is normally the headline. If this is nil Org computes the -priority from the priority cookie like [#A] in the headline. It returns -an integer, increasing by 1000 for each priority level. -The user can set a different function here, which should take a string -as an argument and return the numeric priority." - :group 'org-priorities - :version "24.1" - :type '(choice - (const nil) - (function))) - -(defgroup org-time nil - "Options concerning time stamps and deadlines in Org-mode." - :tag "Org Time" - :group 'org) - -(defcustom org-insert-labeled-timestamps-at-point nil - "Non-nil means SCHEDULED and DEADLINE timestamps are inserted at point. -When nil, these labeled time stamps are forces into the second line of an -entry, just after the headline. When scheduling from the global TODO list, -the time stamp will always be forced into the second line." - :group 'org-time - :type 'boolean) - -(defconst org-time-stamp-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>") - "Formats for `format-time-string' which are used for time stamps. -It is not recommended to change this constant.") - -(defcustom org-time-stamp-rounding-minutes '(0 5) - "Number of minutes to round time stamps to. -These are two values, the first applies when first creating a time stamp. -The second applies when changing it with the commands `S-up' and `S-down'. -When changing the time stamp, this means that it will change in steps -of N minutes, as given by the second value. - -When a setting is 0 or 1, insert the time unmodified. Useful rounding -numbers should be factors of 60, so for example 5, 10, 15. - -When this is larger than 1, you can still force an exact time stamp by using -a double prefix argument to a time stamp command like `C-c .' or `C-c !', -and by using a prefix arg to `S-up/down' to specify the exact number -of minutes to shift." - :group 'org-time - :get #'(lambda (var) ; Make sure both elements are there - (if (integerp (default-value var)) - (list (default-value var) 5) - (default-value var))) - :type '(list - (integer :tag "when inserting times") - (integer :tag "when modifying times"))) - -;; Normalize old customizations of this variable. -(when (integerp org-time-stamp-rounding-minutes) - (setq org-time-stamp-rounding-minutes - (list org-time-stamp-rounding-minutes - org-time-stamp-rounding-minutes))) - -(defcustom org-display-custom-times nil - "Non-nil means overlay custom formats over all time stamps. -The formats are defined through the variable `org-time-stamp-custom-formats'. -To turn this on on a per-file basis, insert anywhere in the file: - #+STARTUP: customtime" - :group 'org-time - :set 'set-default - :type 'sexp) -(make-variable-buffer-local 'org-display-custom-times) - -(defcustom org-time-stamp-custom-formats - '("<%m/%d/%y %a>" . "<%m/%d/%y %a %H:%M>") ; american - "Custom formats for time stamps. See `format-time-string' for the syntax. -These are overlaid over the default ISO format if the variable -`org-display-custom-times' is set. Time like %H:%M should be at the -end of the second format. The custom formats are also honored by export -commands, if custom time display is turned on at the time of export." - :group 'org-time - :type 'sexp) - -(defun org-time-stamp-format (&optional long inactive) - "Get the right format for a time string." - (let ((f (if long (cdr org-time-stamp-formats) - (car org-time-stamp-formats)))) - (if inactive - (concat "[" (substring f 1 -1) "]") - f))) - -(defcustom org-time-clocksum-format - '(:days "%dd " :hours "%d" :require-hours t :minutes ":%02d" :require-minutes t) - "The format string used when creating CLOCKSUM lines. -This is also used when Org mode generates a time duration. - -The value can be a single format string containing two -%-sequences, which will be filled with the number of hours and -minutes in that order. - -Alternatively, the value can be a plist associating any of the -keys :years, :months, :weeks, :days, :hours or :minutes with -format strings. The time duration is formatted using only the -time components that are needed and concatenating the results. -If a time unit in absent, it falls back to the next smallest -unit. - -The keys :require-years, :require-months, :require-days, -:require-weeks, :require-hours, :require-minutes are also -meaningful. A non-nil value for these keys indicates that the -corresponding time component should always be included, even if -its value is 0. - - -For example, - - \(:days \"%dd\" :hours \"%d\" :require-hours t :minutes \":%02d\" - :require-minutes t) - -means durations longer than a day will be expressed in days, -hours and minutes, and durations less than a day will always be -expressed in hours and minutes (even for durations less than an -hour). - -The value - - \(:days \"%dd\" :minutes \"%dm\") - -means durations longer than a day will be expressed in days and -minutes, and durations less than a day will be expressed entirely -in minutes (even for durations longer than an hour)." - :group 'org-time - :group 'org-clock - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice (string :tag "Format string") - (set :tag "Plist" - (group :inline t (const :tag "Years" :years) - (string :tag "Format string")) - (group :inline t - (const :tag "Always show years" :require-years) - (const t)) - (group :inline t (const :tag "Months" :months) - (string :tag "Format string")) - (group :inline t - (const :tag "Always show months" :require-months) - (const t)) - (group :inline t (const :tag "Weeks" :weeks) - (string :tag "Format string")) - (group :inline t - (const :tag "Always show weeks" :require-weeks) - (const t)) - (group :inline t (const :tag "Days" :days) - (string :tag "Format string")) - (group :inline t - (const :tag "Always show days" :require-days) - (const t)) - (group :inline t (const :tag "Hours" :hours) - (string :tag "Format string")) - (group :inline t - (const :tag "Always show hours" :require-hours) - (const t)) - (group :inline t (const :tag "Minutes" :minutes) - (string :tag "Format string")) - (group :inline t - (const :tag "Always show minutes" :require-minutes) - (const t))))) - -(defcustom org-time-clocksum-use-fractional nil - "When non-nil, \\[org-clock-display] uses fractional times. -See `org-time-clocksum-format' for more on time clock formats." - :group 'org-time - :group 'org-clock - :version "24.3" - :type 'boolean) - -(defcustom org-time-clocksum-use-effort-durations nil - "When non-nil, \\[org-clock-display] uses effort durations. -E.g. by default, one day is considered to be a 8 hours effort, -so a task that has been clocked for 16 hours will be displayed -as during 2 days in the clock display or in the clocktable. - -See `org-effort-durations' on how to set effort durations -and `org-time-clocksum-format' for more on time clock formats." - :group 'org-time - :group 'org-clock - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-time-clocksum-fractional-format "%.2f" - "The format string used when creating CLOCKSUM lines, -or when Org mode generates a time duration, if -`org-time-clocksum-use-fractional' is enabled. - -The value can be a single format string containing one -%-sequence, which will be filled with the number of hours as -a float. - -Alternatively, the value can be a plist associating any of the -keys :years, :months, :weeks, :days, :hours or :minutes with -a format string. The time duration is formatted using the -largest time unit which gives a non-zero integer part. If all -specified formats have zero integer part, the smallest time unit -is used." - :group 'org-time - :type '(choice (string :tag "Format string") - (set (group :inline t (const :tag "Years" :years) - (string :tag "Format string")) - (group :inline t (const :tag "Months" :months) - (string :tag "Format string")) - (group :inline t (const :tag "Weeks" :weeks) - (string :tag "Format string")) - (group :inline t (const :tag "Days" :days) - (string :tag "Format string")) - (group :inline t (const :tag "Hours" :hours) - (string :tag "Format string")) - (group :inline t (const :tag "Minutes" :minutes) - (string :tag "Format string"))))) - -(defcustom org-deadline-warning-days 14 - "Number of days before expiration during which a deadline becomes active. -This variable governs the display in sparse trees and in the agenda. -When 0 or negative, it means use this number (the absolute value of it) -even if a deadline has a different individual lead time specified. - -Custom commands can set this variable in the options section." - :group 'org-time - :group 'org-agenda-daily/weekly - :type 'integer) - -(defcustom org-scheduled-delay-days 0 - "Number of days before a scheduled item becomes active. -This variable governs the display in sparse trees and in the agenda. -The default value (i.e. 0) means: don't delay scheduled item. -When negative, it means use this number (the absolute value of it) -even if a scheduled item has a different individual delay time -specified. - -Custom commands can set this variable in the options section." - :group 'org-time - :group 'org-agenda-daily/weekly - :version "24.4" - :package-version '(Org . "8.0") - :type 'integer) - -(defcustom org-read-date-prefer-future t - "Non-nil means assume future for incomplete date input from user. -This affects the following situations: -1. The user gives a month but not a year. - For example, if it is April and you enter \"feb 2\", this will be read - as Feb 2, *next* year. \"May 5\", however, will be this year. -2. The user gives a day, but no month. - For example, if today is the 15th, and you enter \"3\", Org-mode will - read this as the third of *next* month. However, if you enter \"17\", - it will be considered as *this* month. - -If you set this variable to the symbol `time', then also the following -will work: - -3. If the user gives a time. - If the time is before now, it will be interpreted as tomorrow. - -Currently none of this works for ISO week specifications. - -When this option is nil, the current day, month and year will always be -used as defaults. - -See also `org-agenda-jump-prefer-future'." - :group 'org-time - :type '(choice - (const :tag "Never" nil) - (const :tag "Check month and day" t) - (const :tag "Check month, day, and time" time))) - -(defcustom org-agenda-jump-prefer-future 'org-read-date-prefer-future - "Should the agenda jump command prefer the future for incomplete dates? -The default is to do the same as configured in `org-read-date-prefer-future'. -But you can also set a deviating value here. -This may t or nil, or the symbol `org-read-date-prefer-future'." - :group 'org-agenda - :group 'org-time - :version "24.1" - :type '(choice - (const :tag "Use org-read-date-prefer-future" - org-read-date-prefer-future) - (const :tag "Never" nil) - (const :tag "Always" t))) - -(defcustom org-read-date-force-compatible-dates t - "Should date/time prompt force dates that are guaranteed to work in Emacs? - -Depending on the system Emacs is running on, certain dates cannot -be represented with the type used internally to represent time. -Dates between 1970-1-1 and 2038-1-1 can always be represented -correctly. Some systems allow for earlier dates, some for later, -some for both. One way to find out it to insert any date into an -Org buffer, putting the cursor on the year and hitting S-up and -S-down to test the range. - -When this variable is set to t, the date/time prompt will not let -you specify dates outside the 1970-2037 range, so it is certain that -these dates will work in whatever version of Emacs you are -running, and also that you can move a file from one Emacs implementation -to another. WHenever Org is forcing the year for you, it will display -a message and beep. - -When this variable is nil, Org will check if the date is -representable in the specific Emacs implementation you are using. -If not, it will force a year, usually the current year, and beep -to remind you. Currently this setting is not recommended because -the likelihood that you will open your Org files in an Emacs that -has limited date range is not negligible. - -A workaround for this problem is to use diary sexp dates for time -stamps outside of this range." - :group 'org-time - :version "24.1" - :type 'boolean) - -(defcustom org-read-date-display-live t - "Non-nil means display current interpretation of date prompt live. -This display will be in an overlay, in the minibuffer." - :group 'org-time - :type 'boolean) - -(defcustom org-read-date-popup-calendar t - "Non-nil means pop up a calendar when prompting for a date. -In the calendar, the date can be selected with mouse-1. However, the -minibuffer will also be active, and you can simply enter the date as well. -When nil, only the minibuffer will be available." - :group 'org-time - :type 'boolean) -(org-defvaralias 'org-popup-calendar-for-date-prompt - 'org-read-date-popup-calendar) - -(make-obsolete-variable - 'org-read-date-minibuffer-setup-hook - "Set `org-read-date-minibuffer-local-map' instead." "24.4") -(defcustom org-read-date-minibuffer-setup-hook nil - "Hook to be used to set up keys for the date/time interface. -Add key definitions to `minibuffer-local-map', which will be a -temporary copy. - -WARNING: This option is obsolete, you should use -`org-read-date-minibuffer-local-map' to set up keys." - :group 'org-time - :type 'hook) - -(defcustom org-extend-today-until 0 - "The hour when your day really ends. Must be an integer. -This has influence for the following applications: -- When switching the agenda to \"today\". It it is still earlier than - the time given here, the day recognized as TODAY is actually yesterday. -- When a date is read from the user and it is still before the time given - here, the current date and time will be assumed to be yesterday, 23:59. - Also, timestamps inserted in capture templates follow this rule. - -IMPORTANT: This is a feature whose implementation is and likely will -remain incomplete. Really, it is only here because past midnight seems to -be the favorite working time of John Wiegley :-)" - :group 'org-time - :type 'integer) - -(defcustom org-use-effective-time nil - "If non-nil, consider `org-extend-today-until' when creating timestamps. -For example, if `org-extend-today-until' is 8, and it's 4am, then the -\"effective time\" of any timestamps between midnight and 8am will be -23:59 of the previous day." - :group 'org-time - :version "24.1" - :type 'boolean) - -(defcustom org-use-last-clock-out-time-as-effective-time nil - "When non-nil, use the last clock out time for `org-todo'. -Note that this option has precedence over the combined use of -`org-use-effective-time' and `org-extend-today-until'." - :group 'org-time - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-edit-timestamp-down-means-later nil - "Non-nil means S-down will increase the time in a time stamp. -When nil, S-up will increase." - :group 'org-time - :type 'boolean) - -(defcustom org-calendar-follow-timestamp-change t - "Non-nil means make the calendar window follow timestamp changes. -When a timestamp is modified and the calendar window is visible, it will be -moved to the new date." - :group 'org-time - :type 'boolean) - -(defgroup org-tags nil - "Options concerning tags in Org-mode." - :tag "Org Tags" - :group 'org) - -(defcustom org-tag-alist nil - "List of tags allowed in Org-mode files. -When this list is nil, Org-mode will base TAG input on what is already in the -buffer. -The value of this variable is an alist, the car of each entry must be a -keyword as a string, the cdr may be a character that is used to select -that tag through the fast-tag-selection interface. -See the manual for details." - :group 'org-tags - :type '(repeat - (choice - (cons (string :tag "Tag name") - (character :tag "Access char")) - (list :tag "Start radio group" - (const :startgroup) - (option (string :tag "Group description"))) - (list :tag "Group tags delimiter" - (const :grouptags)) - (list :tag "End radio group" - (const :endgroup) - (option (string :tag "Group description"))) - (const :tag "New line" (:newline))))) - -(defcustom org-tag-persistent-alist nil - "List of tags that will always appear in all Org-mode files. -This is in addition to any in buffer settings or customizations -of `org-tag-alist'. -When this list is nil, Org-mode will base TAG input on `org-tag-alist'. -The value of this variable is an alist, the car of each entry must be a -keyword as a string, the cdr may be a character that is used to select -that tag through the fast-tag-selection interface. -See the manual for details. -To disable these tags on a per-file basis, insert anywhere in the file: - #+STARTUP: noptag" - :group 'org-tags - :type '(repeat - (choice - (cons (string :tag "Tag name") - (character :tag "Access char")) - (const :tag "Start radio group" (:startgroup)) - (const :tag "Group tags delimiter" (:grouptags)) - (const :tag "End radio group" (:endgroup)) - (const :tag "New line" (:newline))))) - -(defcustom org-complete-tags-always-offer-all-agenda-tags nil - "If non-nil, always offer completion for all tags of all agenda files. -Instead of customizing this variable directly, you might want to -set it locally for capture buffers, because there no list of -tags in that file can be created dynamically (there are none). - - (add-hook 'org-capture-mode-hook - (lambda () - (set (make-local-variable - 'org-complete-tags-always-offer-all-agenda-tags) - t)))" - :group 'org-tags - :version "24.1" - :type 'boolean) - -(defvar org-file-tags nil - "List of tags that can be inherited by all entries in the file. -The tags will be inherited if the variable `org-use-tag-inheritance' -says they should be. -This variable is populated from #+FILETAGS lines.") - -(defcustom org-use-fast-tag-selection 'auto - "Non-nil means use fast tag selection scheme. -This is a special interface to select and deselect tags with single keys. -When nil, fast selection is never used. -When the symbol `auto', fast selection is used if and only if selection -characters for tags have been configured, either through the variable -`org-tag-alist' or through a #+TAGS line in the buffer. -When t, fast selection is always used and selection keys are assigned -automatically if necessary." - :group 'org-tags - :type '(choice - (const :tag "Always" t) - (const :tag "Never" nil) - (const :tag "When selection characters are configured" auto))) - -(defcustom org-fast-tag-selection-single-key nil - "Non-nil means fast tag selection exits after first change. -When nil, you have to press RET to exit it. -During fast tag 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-tags - :type '(choice - (const :tag "No" nil) - (const :tag "Yes" t) - (const :tag "Expert" expert))) - -(defvar org-fast-tag-selection-include-todo nil - "Non-nil means fast tags selection interface will also offer TODO states. -This is an undocumented feature, you should not rely on it.") - -(defcustom org-tags-column (if (featurep 'xemacs) -76 -77) - "The column to which tags should be indented in a headline. -If this number is positive, it specifies the column. If it is negative, -it means that the tags should be flushright to that column. For example, --80 works well for a normal 80 character screen. -When 0, place tags directly after headline text, with only one space in -between." - :group 'org-tags - :type 'integer) - -(defcustom org-auto-align-tags t - "Non-nil keeps tags aligned when modifying headlines. -Some operations (i.e. demoting) change the length of a headline and -therefore shift the tags around. With this option turned on, after -each such operation the tags are again aligned to `org-tags-column'." - :group 'org-tags - :type 'boolean) - -(defcustom org-use-tag-inheritance t - "Non-nil means tags in levels apply also for sublevels. -When nil, only the tags directly given in a specific line apply there. -This may also be a list of tags that should be inherited, or a regexp that -matches tags that should be inherited. Additional control is possible -with the variable `org-tags-exclude-from-inheritance' which gives an -explicit list of tags to be excluded from inheritance, even if the value of -`org-use-tag-inheritance' would select it for inheritance. - -If this option is t, a match early-on in a tree can lead to a large -number of matches in the subtree when constructing the agenda or creating -a sparse tree. If you only want to see the first match in a tree during -a search, check out the variable `org-tags-match-list-sublevels'." - :group 'org-tags - :type '(choice - (const :tag "Not" nil) - (const :tag "Always" t) - (repeat :tag "Specific tags" (string :tag "Tag")) - (regexp :tag "Tags matched by regexp"))) - -(defcustom org-tags-exclude-from-inheritance nil - "List of tags that should never be inherited. -This is a way to exclude a few tags from inheritance. For way to do -the opposite, to actively allow inheritance for selected tags, -see the variable `org-use-tag-inheritance'." - :group 'org-tags - :type '(repeat (string :tag "Tag"))) - -(defun org-tag-inherit-p (tag) - "Check if TAG is one that should be inherited." - (cond - ((member tag org-tags-exclude-from-inheritance) nil) - ((eq org-use-tag-inheritance t) t) - ((not org-use-tag-inheritance) nil) - ((stringp org-use-tag-inheritance) - (string-match org-use-tag-inheritance tag)) - ((listp org-use-tag-inheritance) - (member tag org-use-tag-inheritance)) - (t (error "Invalid setting of `org-use-tag-inheritance'")))) - -(defcustom org-tags-match-list-sublevels t - "Non-nil means list also sublevels of headlines matching a search. -This variable applies to tags/property searches, and also to stuck -projects because this search is based on a tags match as well. - -When set to the symbol `indented', sublevels are indented with -leading dots. - -Because of tag inheritance (see variable `org-use-tag-inheritance'), -the sublevels of a headline matching a tag search often also match -the same search. Listing all of them can create very long lists. -Setting this variable to nil causes subtrees of a match to be skipped. - -This variable is semi-obsolete and probably should always be true. It -is better to limit inheritance to certain tags using the variables -`org-use-tag-inheritance' and `org-tags-exclude-from-inheritance'." - :group 'org-tags - :type '(choice - (const :tag "No, don't list them" nil) - (const :tag "Yes, do list them" t) - (const :tag "List them, indented with leading dots" indented))) - -(defcustom org-tags-sort-function nil - "When set, tags are sorted using this function as a comparator." - :group 'org-tags - :type '(choice - (const :tag "No sorting" nil) - (const :tag "Alphabetical" string<) - (const :tag "Reverse alphabetical" string>) - (function :tag "Custom function" nil))) - -(defvar org-tags-history nil - "History of minibuffer reads for tags.") -(defvar org-last-tags-completion-table nil - "The last used completion table for tags.") -(defvar org-after-tags-change-hook nil - "Hook that is run after the tags in a line have changed.") - -(defgroup org-properties nil - "Options concerning properties in Org-mode." - :tag "Org Properties" - :group 'org) - -(defcustom org-property-format "%-10s %s" - "How property key/value pairs should be formatted by `indent-line'. -When `indent-line' hits a property definition, it will format the line -according to this format, mainly to make sure that the values are -lined-up with respect to each other." - :group 'org-properties - :type 'string) - -(defcustom org-properties-postprocess-alist nil - "Alist of properties and functions to adjust inserted values. -Elements of this alist must be of the form - - ([string] [function]) - -where [string] must be a property name and [function] must be a -lambda expression: this lambda expression must take one argument, -the value to adjust, and return the new value as a string. - -For example, this element will allow the property \"Remaining\" -to be updated wrt the relation between the \"Effort\" property -and the clock summary: - - ((\"Remaining\" (lambda(value) - (let ((clocksum (org-clock-sum-current-item)) - (effort (org-duration-string-to-minutes - (org-entry-get (point) \"Effort\")))) - (org-minutes-to-clocksum-string (- effort clocksum))))))" - :group 'org-properties - :version "24.1" - :type '(alist :key-type (string :tag "Property") - :value-type (function :tag "Function"))) - -(defcustom org-use-property-inheritance nil - "Non-nil means properties apply also for sublevels. - -This setting is chiefly used during property searches. Turning it on can -cause significant overhead when doing a search, which is why it is not -on by default. - -When nil, only the properties directly given in the current entry count. -When t, every property is inherited. The value may also be a list of -properties that should have inheritance, or a regular expression matching -properties that should be inherited. - -However, note that some special properties use inheritance under special -circumstances (not in searches). Examples are CATEGORY, ARCHIVE, COLUMNS, -and the properties ending in \"_ALL\" when they are used as descriptor -for valid values of a property. - -Note for programmers: -When querying an entry with `org-entry-get', you can control if inheritance -should be used. By default, `org-entry-get' looks only at the local -properties. You can request inheritance by setting the inherit argument -to t (to force inheritance) or to `selective' (to respect the setting -in this variable)." - :group 'org-properties - :type '(choice - (const :tag "Not" nil) - (const :tag "Always" t) - (repeat :tag "Specific properties" (string :tag "Property")) - (regexp :tag "Properties matched by regexp"))) - -(defun org-property-inherit-p (property) - "Check if PROPERTY is one that should be inherited." - (cond - ((eq org-use-property-inheritance t) t) - ((not org-use-property-inheritance) nil) - ((stringp org-use-property-inheritance) - (string-match org-use-property-inheritance property)) - ((listp org-use-property-inheritance) - (member property org-use-property-inheritance)) - (t (error "Invalid setting of `org-use-property-inheritance'")))) - -(defcustom org-columns-default-format "%25ITEM %TODO %3PRIORITY %TAGS" - "The default column format, if no other format has been defined. -This variable can be set on the per-file basis by inserting a line - -#+COLUMNS: %25ITEM ....." - :group 'org-properties - :type 'string) - -(defcustom org-columns-ellipses ".." - "The ellipses to be used when a field in column view is truncated. -When this is the empty string, as many characters as possible are shown, -but then there will be no visual indication that the field has been truncated. -When this is a string of length N, the last N characters of a truncated -field are replaced by this string. If the column is narrower than the -ellipses string, only part of the ellipses string will be shown." - :group 'org-properties - :type 'string) - -(defcustom org-columns-modify-value-for-display-function nil - "Function that modifies values for display in column view. -For example, it can be used to cut out a certain part from a time stamp. -The function must take 2 arguments: - -column-title The title of the column (*not* the property name) -value The value that should be modified. - -The function should return the value that should be displayed, -or nil if the normal value should be used." - :group 'org-properties - :type '(choice (const nil) (function))) - -(defcustom org-effort-property "Effort" - "The property that is being used to keep track of effort estimates. -Effort estimates given in this property need to have the format H:MM." - :group 'org-properties - :group 'org-progress - :type '(string :tag "Property")) - -(defconst org-global-properties-fixed - '(("VISIBILITY_ALL" . "folded children content all") - ("CLOCK_MODELINE_TOTAL_ALL" . "current today repeat all auto")) - "List of property/value pairs that can be inherited by any entry. - -These are fixed values, for the preset properties. The user variable -that can be used to add to this list is `org-global-properties'. - -The entries in this list are cons cells where the car is a property -name and cdr is a string with the value. If the value represents -multiple items like an \"_ALL\" property, separate the items by -spaces.") - -(defcustom org-global-properties nil - "List of property/value pairs that can be inherited by any entry. - -This list will be combined with the constant `org-global-properties-fixed'. - -The entries in this list are cons cells where the car is a property -name and cdr is a string with the value. - -You can set buffer-local values for the same purpose in the variable -`org-file-properties' this by adding lines like - -#+PROPERTY: NAME VALUE" - :group 'org-properties - :type '(repeat - (cons (string :tag "Property") - (string :tag "Value")))) - -(defvar org-file-properties nil - "List of property/value pairs that can be inherited by any entry. -Valid for the current buffer. -This variable is populated from #+PROPERTY lines.") -(make-variable-buffer-local 'org-file-properties) - -(defgroup org-agenda nil - "Options concerning agenda views in Org-mode." - :tag "Org Agenda" - :group 'org) - -(defvar org-category nil - "Variable used by org files to set a category for agenda display. -Such files should use a file variable to set it, for example - -# -*- mode: org; org-category: \"ELisp\" - -or contain a special line - -#+CATEGORY: ELisp - -If the file does not specify a category, then file's base name -is used instead.") -(make-variable-buffer-local 'org-category) -(put 'org-category 'safe-local-variable #'(lambda (x) (or (symbolp x) (stringp x)))) - -(defcustom org-agenda-files nil - "The files to be used for agenda display. -Entries may be added to this list with \\[org-agenda-file-to-front] and removed with -\\[org-remove-file]. You can also use customize to edit the list. - -If an entry is a directory, all files in that directory that are matched by -`org-agenda-file-regexp' will be part of the file list. - -If the value of the variable is not a list but a single file name, then -the list of agenda files is actually stored and maintained in that file, one -agenda file per line. In this file paths can be given relative to -`org-directory'. Tilde expansion and environment variable substitution -are also made." - :group 'org-agenda - :type '(choice - (repeat :tag "List of files and directories" file) - (file :tag "Store list in a file\n" :value "~/.agenda_files"))) - -(defcustom org-agenda-file-regexp "\\`[^.].*\\.org\\'" - "Regular expression to match files for `org-agenda-files'. -If any element in the list in that variable contains a directory instead -of a normal file, all files in that directory that are matched by this -regular expression will be included." - :group 'org-agenda - :type 'regexp) - -(defcustom org-agenda-text-search-extra-files nil - "List of extra files to be searched by text search commands. -These files will be searched in addition to the agenda files by the -commands `org-search-view' (`C-c a s') and `org-occur-in-agenda-files'. -Note that these files will only be searched for text search commands, -not for the other agenda views like todo lists, tag searches or the weekly -agenda. This variable is intended to list notes and possibly archive files -that should also be searched by these two commands. -In fact, if the first element in the list is the symbol `agenda-archives', -then all archive files of all agenda files will be added to the search -scope." - :group 'org-agenda - :type '(set :greedy t - (const :tag "Agenda Archives" agenda-archives) - (repeat :inline t (file)))) - -(org-defvaralias 'org-agenda-multi-occur-extra-files - 'org-agenda-text-search-extra-files) - -(defcustom org-agenda-skip-unavailable-files nil - "Non-nil means to just skip non-reachable files in `org-agenda-files'. -A nil value means to remove them, after a query, from the list." - :group 'org-agenda - :type 'boolean) - -(defcustom org-calendar-to-agenda-key [?c] - "The key to be installed in `calendar-mode-map' for switching to the agenda. -The command `org-calendar-goto-agenda' will be bound to this key. The -default is the character `c' because then `c' can be used to switch back and -forth between agenda and calendar." - :group 'org-agenda - :type 'sexp) - -(defcustom org-calendar-insert-diary-entry-key [?i] - "The key to be installed in `calendar-mode-map' for adding diary entries. -This option is irrelevant until `org-agenda-diary-file' has been configured -to point to an Org-mode file. When that is the case, the command -`org-agenda-diary-entry' will be bound to the key given here, by default -`i'. In the calendar, `i' normally adds entries to `diary-file'. So -if you want to continue doing this, you need to change this to a different -key." - :group 'org-agenda - :type 'sexp) - -(defcustom org-agenda-diary-file 'diary-file - "File to which to add new entries with the `i' key in agenda and calendar. -When this is the symbol `diary-file', the functionality in the Emacs -calendar will be used to add entries to the `diary-file'. But when this -points to a file, `org-agenda-diary-entry' will be used instead." - :group 'org-agenda - :type '(choice - (const :tag "The standard Emacs diary file" diary-file) - (file :tag "Special Org file diary entries"))) - -(eval-after-load "calendar" - '(progn - (org-defkey calendar-mode-map org-calendar-to-agenda-key - 'org-calendar-goto-agenda) - (add-hook 'calendar-mode-hook - (lambda () - (unless (eq org-agenda-diary-file 'diary-file) - (define-key calendar-mode-map - org-calendar-insert-diary-entry-key - 'org-agenda-diary-entry)))))) - -(defgroup org-latex nil - "Options for embedding LaTeX code into Org-mode." - :tag "Org LaTeX" - :group 'org) - -(defcustom org-format-latex-options - '(:foreground default :background default :scale 1.0 - :html-foreground "Black" :html-background "Transparent" - :html-scale 1.0 :matchers ("begin" "$1" "$" "$$" "\\(" "\\[")) - "Options for creating images from LaTeX fragments. -This is a property list with the following properties: -:foreground the foreground color for images embedded in Emacs, e.g. \"Black\". - `default' means use the foreground of the default face. - `auto' means use the foreground from the text face. -:background the background color, or \"Transparent\". - `default' means use the background of the default face. - `auto' means use the background from the text face. -:scale a scaling factor for the size of the images, to get more pixels -:html-foreground, :html-background, :html-scale - the same numbers for HTML export. -:matchers a list indicating which matchers should be used to - find LaTeX fragments. Valid members of this list are: - \"begin\" find environments - \"$1\" find single characters surrounded by $.$ - \"$\" find math expressions surrounded by $...$ - \"$$\" find math expressions surrounded by $$....$$ - \"\\(\" find math expressions surrounded by \\(...\\) - \"\\ [\" find math expressions surrounded by \\ [...\\]" - :group 'org-latex - :type 'plist) - -(defcustom org-format-latex-signal-error t - "Non-nil means signal an error when image creation of LaTeX snippets fails. -When nil, just push out a message." - :group 'org-latex - :version "24.1" - :type 'boolean) - -(defcustom org-latex-to-mathml-jar-file nil - "Value of\"%j\" in `org-latex-to-mathml-convert-command'. -Use this to specify additional executable file say a jar file. - -When using MathToWeb as the converter, specify the full-path to -your mathtoweb.jar file." - :group 'org-latex - :version "24.1" - :type '(choice - (const :tag "None" nil) - (file :tag "JAR file" :must-match t))) - -(defcustom org-latex-to-mathml-convert-command nil - "Command to convert LaTeX fragments to MathML. -Replace format-specifiers in the command as noted below and use -`shell-command' to convert LaTeX to MathML. -%j: Executable file in fully expanded form as specified by - `org-latex-to-mathml-jar-file'. -%I: Input LaTeX file in fully expanded form -%o: Output MathML file -This command is used by `org-create-math-formula'. - -When using MathToWeb as the converter, set this to -\"java -jar %j -unicode -force -df %o %I\"." - :group 'org-latex - :version "24.1" - :type '(choice - (const :tag "None" nil) - (string :tag "\nShell command"))) - -(defcustom org-latex-create-formula-image-program 'dvipng - "Program to convert LaTeX fragments with. - -dvipng Process the LaTeX fragments to dvi file, then convert - dvi files to png files using dvipng. - This will also include processing of non-math environments. -imagemagick Convert the LaTeX fragments to pdf files and use imagemagick - to convert pdf files to png files" - :group 'org-latex - :version "24.1" - :type '(choice - (const :tag "dvipng" dvipng) - (const :tag "imagemagick" imagemagick))) - -(defcustom org-latex-preview-ltxpng-directory "ltxpng/" - "Path to store latex preview images. -A relative path here creates many directories relative to the -processed org files paths. An absolute path puts all preview -images at the same place." - :group 'org-latex - :version "24.3" - :type 'string) - -(defun org-format-latex-mathml-available-p () - "Return t if `org-latex-to-mathml-convert-command' is usable." - (save-match-data - (when (and (boundp 'org-latex-to-mathml-convert-command) - org-latex-to-mathml-convert-command) - (let ((executable (car (split-string - org-latex-to-mathml-convert-command)))) - (when (executable-find executable) - (if (string-match - "%j" org-latex-to-mathml-convert-command) - (file-readable-p org-latex-to-mathml-jar-file) - t)))))) - -(defcustom org-format-latex-header "\\documentclass{article} -\\usepackage[usenames]{color} -\[PACKAGES] -\[DEFAULT-PACKAGES] -\\pagestyle{empty} % do not remove -% The settings below are copied from fullpage.sty -\\setlength{\\textwidth}{\\paperwidth} -\\addtolength{\\textwidth}{-3cm} -\\setlength{\\oddsidemargin}{1.5cm} -\\addtolength{\\oddsidemargin}{-2.54cm} -\\setlength{\\evensidemargin}{\\oddsidemargin} -\\setlength{\\textheight}{\\paperheight} -\\addtolength{\\textheight}{-\\headheight} -\\addtolength{\\textheight}{-\\headsep} -\\addtolength{\\textheight}{-\\footskip} -\\addtolength{\\textheight}{-3cm} -\\setlength{\\topmargin}{1.5cm} -\\addtolength{\\topmargin}{-2.54cm}" - "The document header used for processing LaTeX fragments. -It is imperative that this header make sure that no page number -appears on the page. The package defined in the variables -`org-latex-default-packages-alist' and `org-latex-packages-alist' -will either replace the placeholder \"[PACKAGES]\" in this -header, or they will be appended." - :group 'org-latex - :type 'string) - -(defun org-set-packages-alist (var val) - "Set the packages alist and make sure it has 3 elements per entry." - (set var (mapcar (lambda (x) - (if (and (consp x) (= (length x) 2)) - (list (car x) (nth 1 x) t) - x)) - val))) - -(defun org-get-packages-alist (var) - "Get the packages alist and make sure it has 3 elements per entry." - (mapcar (lambda (x) - (if (and (consp x) (= (length x) 2)) - (list (car x) (nth 1 x) t) - x)) - (default-value var))) - -(defcustom org-latex-default-packages-alist - '(("AUTO" "inputenc" t) - ("T1" "fontenc" t) - ("" "fixltx2e" nil) - ("" "graphicx" t) - ("" "longtable" nil) - ("" "float" nil) - ("" "wrapfig" nil) - ("" "rotating" nil) - ("normalem" "ulem" t) - ("" "amsmath" t) - ("" "textcomp" t) - ("" "marvosym" t) - ("" "wasysym" t) - ("" "amssymb" t) - ("" "hyperref" nil) - "\\tolerance=1000") - "Alist of default packages to be inserted in the header. - -Change this only if one of the packages here causes an -incompatibility with another package you are using. - -The packages in this list are needed by one part or another of -Org mode to function properly: - -- inputenc, fontenc: for basic font and character selection -- fixltx2e: Important patches of LaTeX itself -- graphicx: for including images -- longtable: For multipage tables -- float, wrapfig: for figure placement -- rotating: for sideways figures and tables -- ulem: for underline and strike-through -- amsmath: for subscript and superscript and math environments -- textcomp, marvosymb, wasysym, amssymb: for various symbols used - for interpreting the entities in `org-entities'. You can skip - some of these packages if you don't use any of their symbols. -- hyperref: for cross references - -Therefore you should not modify this variable unless you know -what you are doing. The one reason to change it anyway is that -you might be loading some other package that conflicts with one -of the default packages. Each cell is of the format -\( \"options\" \"package\" snippet-flag). If SNIPPET-FLAG is t, -the package also needs to be included when compiling LaTeX -snippets into images for inclusion into non-LaTeX output." - :group 'org-latex - :group 'org-export-latex - :set 'org-set-packages-alist - :get 'org-get-packages-alist - :version "24.1" - :type '(repeat - (choice - (list :tag "options/package pair" - (string :tag "options") - (string :tag "package") - (boolean :tag "Snippet")) - (string :tag "A line of LaTeX")))) - -(defcustom org-latex-packages-alist nil - "Alist of packages to be inserted in every LaTeX header. - -These will be inserted after `org-latex-default-packages-alist'. -Each cell is of the format: - - \(\"options\" \"package\" snippet-flag) - -SNIPPET-FLAG, when t, indicates that this package is also needed -when turning LaTeX snippets into images for inclusion into -non-LaTeX output. - -Make sure that you only list packages here which: - - - you want in every file - - do not conflict with the setup in `org-format-latex-header'. - - do not conflict with the default packages in - `org-latex-default-packages-alist'." - :group 'org-latex - :group 'org-export-latex - :set 'org-set-packages-alist - :get 'org-get-packages-alist - :type '(repeat - (choice - (list :tag "options/package pair" - (string :tag "options") - (string :tag "package") - (boolean :tag "Snippet")) - (string :tag "A line of LaTeX")))) - -(defgroup org-appearance nil - "Settings for Org-mode appearance." - :tag "Org Appearance" - :group 'org) - -(defcustom org-level-color-stars-only nil - "Non-nil means fontify only the stars in each headline. -When nil, the entire headline is fontified. -Changing it requires restart of `font-lock-mode' to become effective -also in regions already fontified." - :group 'org-appearance - :type 'boolean) - -(defcustom org-hide-leading-stars nil - "Non-nil means hide the first N-1 stars in a headline. -This works by using the face `org-hide' for these stars. This -face is white for a light background, and black for a dark -background. You may have to customize the face `org-hide' to -make this work. -Changing it requires restart of `font-lock-mode' to become effective -also in regions already fontified. -You may also set this on a per-file basis by adding one of the following -lines to the buffer: - - #+STARTUP: hidestars - #+STARTUP: showstars" - :group 'org-appearance - :type 'boolean) - -(defcustom org-hidden-keywords nil - "List of symbols corresponding to keywords to be hidden the org buffer. -For example, a value '(title) for this list will make the document's title -appear in the buffer without the initial #+TITLE: keyword." - :group 'org-appearance - :version "24.1" - :type '(set (const :tag "#+AUTHOR" author) - (const :tag "#+DATE" date) - (const :tag "#+EMAIL" email) - (const :tag "#+TITLE" title))) - -(defcustom org-custom-properties nil - "List of properties (as strings) with a special meaning. -The default use of these custom properties is to let the user -hide them with `org-toggle-custom-properties-visibility'." - :group 'org-properties - :group 'org-appearance - :version "24.3" - :type '(repeat (string :tag "Property Name"))) - -(defcustom org-fontify-done-headline nil - "Non-nil means change the face of a headline if it is marked DONE. -Normally, only the TODO/DONE keyword indicates the state of a headline. -When this is non-nil, the headline after the keyword is set to the -`org-headline-done' as an additional indication." - :group 'org-appearance - :type 'boolean) - -(defcustom org-fontify-emphasized-text t - "Non-nil means fontify *bold*, /italic/ and _underlined_ text. -Changing this variable requires a restart of Emacs to take effect." - :group 'org-appearance - :type 'boolean) - -(defcustom org-fontify-whole-heading-line nil - "Non-nil means fontify the whole line for headings. -This is useful when setting a background color for the -org-level-* faces." - :group 'org-appearance - :type 'boolean) - -(defcustom org-highlight-latex-and-related nil - "Non-nil means highlight LaTeX related syntax in the buffer. -When non nil, the value should be a list containing any of the -following symbols: - `latex' Highlight LaTeX snippets and environments. - `script' Highlight subscript and superscript. - `entities' Highlight entities." - :group 'org-appearance - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (const :tag "No highlighting" nil) - (set :greedy t :tag "Highlight" - (const :tag "LaTeX snippets and environments" latex) - (const :tag "Subscript and superscript" script) - (const :tag "Entities" entities)))) - -(defcustom org-hide-emphasis-markers nil - "Non-nil mean font-lock should hide the emphasis marker characters." - :group 'org-appearance - :type 'boolean) - -(defcustom org-pretty-entities nil - "Non-nil means show entities as UTF8 characters. -When nil, the \\name form remains in the buffer." - :group 'org-appearance - :version "24.1" - :type 'boolean) - -(defcustom org-pretty-entities-include-sub-superscripts t - "Non-nil means, pretty entity display includes formatting sub/superscripts." - :group 'org-appearance - :version "24.1" - :type 'boolean) - -(defvar org-emph-re nil - "Regular expression for matching emphasis. -After a match, the match groups contain these elements: -0 The match of the full regular expression, including the characters - before and after the proper match -1 The character before the proper match, or empty at beginning of line -2 The proper match, including the leading and trailing markers -3 The leading marker like * or /, indicating the type of highlighting -4 The text between the emphasis markers, not including the markers -5 The character after the match, empty at the end of a line") -(defvar org-verbatim-re nil - "Regular expression for matching verbatim text.") -(defvar org-emphasis-regexp-components) ; defined just below -(defvar org-emphasis-alist) ; defined just below -(defun org-set-emph-re (var val) - "Set variable and compute the emphasis regular expression." - (set var val) - (when (and (boundp 'org-emphasis-alist) - (boundp 'org-emphasis-regexp-components) - org-emphasis-alist org-emphasis-regexp-components) - (let* ((e org-emphasis-regexp-components) - (pre (car e)) - (post (nth 1 e)) - (border (nth 2 e)) - (body (nth 3 e)) - (nl (nth 4 e)) - (body1 (concat body "*?")) - (markers (mapconcat 'car org-emphasis-alist "")) - (vmarkers (mapconcat - (lambda (x) (if (eq (nth 2 x) 'verbatim) (car x) "")) - org-emphasis-alist ""))) - ;; make sure special characters appear at the right position in the class - (if (string-match "\\^" markers) - (setq markers (concat (replace-match "" t t markers) "^"))) - (if (string-match "-" markers) - (setq markers (concat (replace-match "" t t markers) "-"))) - (if (string-match "\\^" vmarkers) - (setq vmarkers (concat (replace-match "" t t vmarkers) "^"))) - (if (string-match "-" vmarkers) - (setq vmarkers (concat (replace-match "" t t vmarkers) "-"))) - (if (> nl 0) - (setq body1 (concat body1 "\\(?:\n" body "*?\\)\\{0," - (int-to-string nl) "\\}"))) - ;; Make the regexp - (setq org-emph-re - (concat "\\([" pre "]\\|^\\)" - "\\(" - "\\([" markers "]\\)" - "\\(" - "[^" border "]\\|" - "[^" border "]" - body1 - "[^" border "]" - "\\)" - "\\3\\)" - "\\([" post "]\\|$\\)")) - (setq org-verbatim-re - (concat "\\([" pre "]\\|^\\)" - "\\(" - "\\([" vmarkers "]\\)" - "\\(" - "[^" border "]\\|" - "[^" border "]" - body1 - "[^" border "]" - "\\)" - "\\3\\)" - "\\([" post "]\\|$\\)"))))) - -;; This used to be a defcustom (Org <8.0) but allowing the users to -;; set this option proved cumbersome. See this message/thread: -;; http://article.gmane.org/gmane.emacs.orgmode/68681 -(defvar org-emphasis-regexp-components - '(" \t('\"{" "- \t.,:!?;'\")}\\" " \t\r\n,\"'" "." 1) - "Components used to build the regular expression for emphasis. -This is a list with five entries. Terminology: In an emphasis string -like \" *strong word* \", we call the initial space PREMATCH, the final -space POSTMATCH, the stars MARKERS, \"s\" and \"d\" are BORDER characters -and \"trong wor\" is the body. The different components in this variable -specify what is allowed/forbidden in each part: - -pre Chars allowed as prematch. Beginning of line will be allowed too. -post Chars allowed as postmatch. End of line will be allowed too. -border The chars *forbidden* as border characters. -body-regexp A regexp like \".\" to match a body character. Don't use - non-shy groups here, and don't allow newline here. -newline The maximum number of newlines allowed in an emphasis exp. - -You need to reload Org or to restart Emacs after customizing this.") - -(defcustom org-emphasis-alist - `(("*" bold) - ("/" italic) - ("_" underline) - ("=" org-code verbatim) - ("~" org-verbatim verbatim) - ("+" ,(if (featurep 'xemacs) 'org-table '(:strike-through t)))) - "Alist of characters and faces to emphasize text. -Text starting and ending with a special character will be emphasized, -for example *bold*, _underlined_ and /italic/. This variable sets the -marker characters and the face to be used by font-lock for highlighting -in Org-mode Emacs buffers. - -You need to reload Org or to restart Emacs after customizing this." - :group 'org-appearance - :set 'org-set-emph-re - :version "24.4" - :package-version '(Org . "8.0") - :type '(repeat - (list - (string :tag "Marker character") - (choice - (face :tag "Font-lock-face") - (plist :tag "Face property list")) - (option (const verbatim))))) - -(defvar org-protecting-blocks - '("src" "example" "latex" "ascii" "html" "ditaa" "dot" "r" "R") - "Blocks that contain text that is quoted, i.e. not processed as Org syntax. -This is needed for font-lock setup.") - -;;; Miscellaneous options - -(defgroup org-completion nil - "Completion in Org-mode." - :tag "Org Completion" - :group 'org) - -(defcustom org-completion-use-ido nil - "Non-nil means use ido completion wherever possible. -Note that `ido-mode' must be active for this variable to be relevant. -If you decide to turn this variable on, you might well want to turn off -`org-outline-path-complete-in-steps'. -See also `org-completion-use-iswitchb'." - :group 'org-completion - :type 'boolean) - -(defcustom org-completion-use-iswitchb nil - "Non-nil means use iswitchb completion wherever possible. -Note that `iswitchb-mode' must be active for this variable to be relevant. -If you decide to turn this variable on, you might well want to turn off -`org-outline-path-complete-in-steps'. -Note that this variable has only an effect if `org-completion-use-ido' is nil." - :group 'org-completion - :type 'boolean) - -(defcustom org-completion-fallback-command 'hippie-expand - "The expansion command called by \\[pcomplete] in normal context. -Normal means, no org-mode-specific context." - :group 'org-completion - :type 'function) - -;;; Functions and variables from their packages -;; Declared here to avoid compiler warnings - -;; XEmacs only -(defvar outline-mode-menu-heading) -(defvar outline-mode-menu-show) -(defvar outline-mode-menu-hide) -(defvar zmacs-regions) ; XEmacs regions - -;; Emacs only -(defvar mark-active) - -;; Various packages -(declare-function calendar-absolute-from-iso "cal-iso" (date)) -(declare-function calendar-forward-day "cal-move" (arg)) -(declare-function calendar-goto-date "cal-move" (date)) -(declare-function calendar-goto-today "cal-move" ()) -(declare-function calendar-iso-from-absolute "cal-iso" (date)) -(defvar calc-embedded-close-formula) -(defvar calc-embedded-open-formula) -(declare-function cdlatex-tab "ext:cdlatex" ()) -(declare-function cdlatex-compute-tables "ext:cdlatex" ()) -(declare-function dired-get-filename "dired" (&optional localp no-error-if-not-filep)) -(defvar font-lock-unfontify-region-function) -(declare-function iswitchb-read-buffer "iswitchb" - (prompt &optional default require-match start matches-set)) -(defvar iswitchb-temp-buflist) -(declare-function org-gnus-follow-link "org-gnus" (&optional group article)) -(defvar org-agenda-tags-todo-honor-ignore-options) -(declare-function org-agenda-skip "org-agenda" ()) -(declare-function - org-agenda-format-item "org-agenda" - (extra txt &optional level category tags dotime noprefix remove-re habitp)) -(declare-function org-agenda-new-marker "org-agenda" (&optional pos)) -(declare-function org-agenda-change-all-lines "org-agenda" - (newhead hdmarker &optional fixface just-this)) -(declare-function org-agenda-set-restriction-lock "org-agenda" (&optional type)) -(declare-function org-agenda-maybe-redo "org-agenda" ()) -(declare-function org-agenda-save-markers-for-cut-and-paste "org-agenda" - (beg end)) -(declare-function org-agenda-copy-local-variable "org-agenda" (var)) -(declare-function org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item - "org-agenda" (&optional end)) -(declare-function org-inlinetask-remove-END-maybe "org-inlinetask" ()) -(declare-function org-inlinetask-in-task-p "org-inlinetask" ()) -(declare-function org-inlinetask-goto-beginning "org-inlinetask" ()) -(declare-function org-inlinetask-goto-end "org-inlinetask" ()) -(declare-function org-indent-mode "org-indent" (&optional arg)) -(declare-function parse-time-string "parse-time" (string)) -(declare-function org-attach-reveal "org-attach" (&optional if-exists)) -(declare-function orgtbl-send-table "org-table" (&optional maybe)) -(defvar remember-data-file) -(defvar texmathp-why) -(declare-function speedbar-line-directory "speedbar" (&optional depth)) -(declare-function table--at-cell-p "table" (position &optional object at-column)) - -(defvar org-latex-regexps) - -;;; Autoload and prepare some org modules - -;; Some table stuff that needs to be defined here, because it is used -;; by the functions setting up org-mode or checking for table context. - -(defconst org-table-any-line-regexp "^[ \t]*\\(|\\|\\+-[-+]\\)" - "Detect an org-type or table-type table.") -(defconst org-table-line-regexp "^[ \t]*|" - "Detect an org-type table line.") -(defconst org-table-dataline-regexp "^[ \t]*|[^-]" - "Detect an org-type table line.") -(defconst org-table-hline-regexp "^[ \t]*|-" - "Detect an org-type table hline.") -(defconst org-table1-hline-regexp "^[ \t]*\\+-[-+]" - "Detect a table-type table hline.") -(defconst org-table-any-border-regexp "^[ \t]*[^|+ \t]" - "Detect the first line outside a table when searching from within it. -This works for both table types.") - -(defconst org-TBLFM-regexp "^[ \t]*#\\+TBLFM: " - "Detect a #+TBLFM line.") - -;;;###autoload -(defun turn-on-orgtbl () - "Unconditionally turn on `orgtbl-mode'." - (require 'org-table) - (orgtbl-mode 1)) - -(defun org-at-table-p (&optional table-type) - "Return t if the cursor is inside an org-type table. -If TABLE-TYPE is non-nil, also check for table.el-type tables." - (if org-enable-table-editor - (save-excursion - (beginning-of-line 1) - (looking-at (if table-type org-table-any-line-regexp - org-table-line-regexp))) - nil)) -(defsubst org-table-p () (org-at-table-p)) - -(defun org-at-table.el-p () - "Return t if and only if we are at a table.el table." - (and (org-at-table-p 'any) - (save-excursion - (goto-char (org-table-begin 'any)) - (looking-at org-table1-hline-regexp)))) - -(defun org-table-recognize-table.el () - "If there is a table.el table nearby, recognize it and move into it." - (if org-table-tab-recognizes-table.el - (if (org-at-table.el-p) - (progn - (beginning-of-line 1) - (if (looking-at org-table-dataline-regexp) - nil - (if (looking-at org-table1-hline-regexp) - (progn - (beginning-of-line 2) - (if (looking-at org-table-any-border-regexp) - (beginning-of-line -1))))) - (if (re-search-forward "|" (org-table-end t) t) - (progn - (require 'table) - (if (table--at-cell-p (point)) - t - (message "recognizing table.el table...") - (table-recognize-table) - (message "recognizing table.el table...done"))) - (error "This should not happen")) - t) - nil) - nil)) - -(defun org-at-table-hline-p () - "Return t if the cursor is inside a hline in a table." - (if org-enable-table-editor - (save-excursion - (beginning-of-line 1) - (looking-at org-table-hline-regexp)) - nil)) - -(defun org-table-map-tables (function &optional quietly) - "Apply FUNCTION to the start of all tables in the buffer." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward org-table-any-line-regexp nil t) - (unless quietly - (message "Mapping tables: %d%%" (/ (* 100.0 (point)) (buffer-size)))) - (beginning-of-line 1) - (when (and (looking-at org-table-line-regexp) - ;; Exclude tables in src/example/verbatim/clocktable blocks - (not (org-in-block-p '("src" "example" "verbatim" "clocktable")))) - (save-excursion (funcall function)) - (or (looking-at org-table-line-regexp) - (forward-char 1))) - (re-search-forward org-table-any-border-regexp nil 1)))) - (unless quietly (message "Mapping tables: done"))) - -(declare-function org-clock-save-markers-for-cut-and-paste "org-clock" (beg end)) -(declare-function org-clock-update-mode-line "org-clock" ()) -(declare-function org-resolve-clocks "org-clock" - (&optional also-non-dangling-p prompt last-valid)) - -(defun org-at-TBLFM-p (&optional pos) - "Return t when point (or POS) is in #+TBLFM line." - (save-excursion - (let ((pos pos))) - (goto-char (or pos (point))) - (beginning-of-line 1) - (looking-at org-TBLFM-regexp))) - -(defvar org-clock-start-time) -(defvar org-clock-marker (make-marker) - "Marker recording the last clock-in.") -(defvar org-clock-hd-marker (make-marker) - "Marker recording the last clock-in, but the headline position.") -(defvar org-clock-heading "" - "The heading of the current clock entry.") -(defun org-clock-is-active () - "Return the buffer where the clock is currently running. -Return nil if no clock is running." - (marker-buffer org-clock-marker)) - -(defun org-check-running-clock () - "Check if the current buffer contains the running clock. -If yes, offer to stop it and to save the buffer with the changes." - (when (and (equal (marker-buffer org-clock-marker) (current-buffer)) - (y-or-n-p (format "Clock-out in buffer %s before killing it? " - (buffer-name)))) - (org-clock-out) - (when (y-or-n-p "Save changed buffer?") - (save-buffer)))) - -(defun org-clocktable-try-shift (dir n) - "Check if this line starts a clock table, if yes, shift the time block." - (when (org-match-line "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>") - (org-clocktable-shift dir n))) - -;;;###autoload -(defun org-clock-persistence-insinuate () - "Set up hooks for clock persistence." - (require 'org-clock) - (add-hook 'org-mode-hook 'org-clock-load) - (add-hook 'kill-emacs-hook 'org-clock-save)) - -;; Define the variable already here, to make sure we have it. -(defvar org-indent-mode nil - "Non-nil if Org-Indent mode is enabled. -Use the command `org-indent-mode' to change this variable.") - -;; Autoload archiving code -;; The stuff that is needed for cycling and tags has to be defined here. - -(defgroup org-archive nil - "Options concerning archiving in Org-mode." - :tag "Org Archive" - :group 'org-structure) - -(defcustom org-archive-location "%s_archive::" - "The location where subtrees should be archived. - -The value of this variable is a string, consisting of two parts, -separated by a double-colon. The first part is a filename and -the second part is a headline. - -When the filename is omitted, archiving happens in the same file. -%s in the filename will be replaced by the current file -name (without the directory part). Archiving to a different file -is useful to keep archived entries from contributing to the -Org-mode Agenda. - -The archived entries will be filed as subtrees of the specified -headline. When the headline is omitted, the subtrees are simply -filed away at the end of the file, as top-level entries. Also in -the heading you can use %s to represent the file name, this can be -useful when using the same archive for a number of different files. - -Here are a few examples: -\"%s_archive::\" - If the current file is Projects.org, archive in file - Projects.org_archive, as top-level trees. This is the default. - -\"::* Archived Tasks\" - Archive in the current file, under the top-level headline - \"* Archived Tasks\". - -\"~/org/archive.org::\" - Archive in file ~/org/archive.org (absolute path), as top-level trees. - -\"~/org/archive.org::* From %s\" - Archive in file ~/org/archive.org (absolute path), under headlines - \"From FILENAME\" where file name is the current file name. - -\"~/org/datetree.org::datetree/* Finished Tasks\" - The \"datetree/\" string is special, signifying to archive - items to the datetree. Items are placed in either the CLOSED - date of the item, or the current date if there is no CLOSED date. - The heading will be a subentry to the current date. There doesn't - need to be a heading, but there always needs to be a slash after - datetree. For example, to store archived items directly in the - datetree, use \"~/org/datetree.org::datetree/\". - -\"basement::** Finished Tasks\" - Archive in file ./basement (relative path), as level 3 trees - below the level 2 heading \"** Finished Tasks\". - -You may set this option on a per-file basis by adding to the buffer a -line like - -#+ARCHIVE: basement::** Finished Tasks - -You may also define it locally for a subtree by setting an ARCHIVE property -in the entry. If such a property is found in an entry, or anywhere up -the hierarchy, it will be used." - :group 'org-archive - :type 'string) - -(defcustom org-archive-tag "ARCHIVE" - "The tag that marks a subtree as archived. -An archived subtree does not open during visibility cycling, and does -not contribute to the agenda listings. -After changing this, font-lock must be restarted in the relevant buffers to -get the proper fontification." - :group 'org-archive - :group 'org-keywords - :type 'string) - -(defcustom org-agenda-skip-archived-trees t - "Non-nil means the agenda will skip any items located in archived trees. -An archived tree is a tree marked with the tag ARCHIVE. The use of this -variable is no longer recommended, you should leave it at the value t. -Instead, use the key `v' to cycle the archives-mode in the agenda." - :group 'org-archive - :group 'org-agenda-skip - :type 'boolean) - -(defcustom org-columns-skip-archived-trees t - "Non-nil means ignore archived trees when creating column view." - :group 'org-archive - :group 'org-properties - :type 'boolean) - -(defcustom org-cycle-open-archived-trees nil - "Non-nil means `org-cycle' will open archived trees. -An archived tree is a tree marked with the tag ARCHIVE. -When nil, archived trees will stay folded. You can still open them with -normal outline commands like `show-all', but not with the cycling commands." - :group 'org-archive - :group 'org-cycle - :type 'boolean) - -(defcustom org-sparse-tree-open-archived-trees nil - "Non-nil means sparse tree construction shows matches in archived trees. -When nil, matches in these trees are highlighted, but the trees are kept in -collapsed state." - :group 'org-archive - :group 'org-sparse-trees - :type 'boolean) - -(defcustom org-sparse-tree-default-date-type 'scheduled-or-deadline - "The default date type when building a sparse tree. -When this is nil, a date is a scheduled or a deadline timestamp. -Otherwise, these types are allowed: - - all: all timestamps - active: only active timestamps (<...>) - inactive: only inactive timestamps (<...) - scheduled: only scheduled timestamps - deadline: only deadline timestamps" - :type '(choice (const :tag "Scheduled or deadline" scheduled-or-deadline) - (const :tag "All timestamps" all) - (const :tag "Only active timestamps" active) - (const :tag "Only inactive timestamps" inactive) - (const :tag "Only scheduled timestamps" scheduled) - (const :tag "Only deadline timestamps" deadline) - (const :tag "Only closed timestamps" closed)) - :version "24.3" - :group 'org-sparse-trees) - -(defun org-cycle-hide-archived-subtrees (state) - "Re-hide all archived subtrees after a visibility state change." - (when (and (not org-cycle-open-archived-trees) - (not (memq state '(overview folded)))) - (save-excursion - (let* ((globalp (memq state '(contents all))) - (beg (if globalp (point-min) (point))) - (end (if globalp (point-max) (org-end-of-subtree t)))) - (org-hide-archived-subtrees beg end) - (goto-char beg) - (if (looking-at (concat ".*:" org-archive-tag ":")) - (message "%s" (substitute-command-keys - "Subtree is archived and stays closed. Use \\[org-force-cycle-archived] to cycle it anyway."))))))) - -(defun org-force-cycle-archived () - "Cycle subtree even if it is archived." - (interactive) - (setq this-command 'org-cycle) - (let ((org-cycle-open-archived-trees t)) - (call-interactively 'org-cycle))) - -(defun org-hide-archived-subtrees (beg end) - "Re-hide all archived subtrees after a visibility state change." - (save-excursion - (let* ((re (concat ":" org-archive-tag ":"))) - (goto-char beg) - (while (re-search-forward re end t) - (when (org-at-heading-p) - (org-flag-subtree t) - (org-end-of-subtree t)))))) - -(declare-function outline-end-of-heading "outline" ()) -(declare-function outline-flag-region "outline" (from to flag)) -(defun org-flag-subtree (flag) - (save-excursion - (org-back-to-heading t) - (outline-end-of-heading) - (outline-flag-region (point) - (progn (org-end-of-subtree t) (point)) - flag))) - -(defalias 'org-advertized-archive-subtree 'org-archive-subtree) - -;; Declare Column View Code - -(declare-function org-columns-number-to-string "org-colview" (n fmt &optional printf)) -(declare-function org-columns-get-format-and-top-level "org-colview" ()) -(declare-function org-columns-compute "org-colview" (property)) - -;; Declare ID code - -(declare-function org-id-store-link "org-id") -(declare-function org-id-locations-load "org-id") -(declare-function org-id-locations-save "org-id") -(defvar org-id-track-globally) - -;;; Variables for pre-computed regular expressions, all buffer local - -(defvar org-drawer-regexp "^[ \t]*:PROPERTIES:[ \t]*$" - "Matches first line of a hidden block.") -(make-variable-buffer-local 'org-drawer-regexp) -(defvar org-todo-regexp nil - "Matches any of the TODO state keywords.") -(make-variable-buffer-local 'org-todo-regexp) -(defvar org-not-done-regexp nil - "Matches any of the TODO state keywords except the last one.") -(make-variable-buffer-local 'org-not-done-regexp) -(defvar org-not-done-heading-regexp nil - "Matches a TODO headline that is not done.") -(make-variable-buffer-local 'org-not-done-regexp) -(defvar org-todo-line-regexp nil - "Matches a headline and puts TODO state into group 2 if present.") -(make-variable-buffer-local 'org-todo-line-regexp) -(defvar org-complex-heading-regexp nil - "Matches a headline and puts everything into groups: -group 1: the stars -group 2: The todo keyword, maybe -group 3: Priority cookie -group 4: True headline -group 5: Tags") -(make-variable-buffer-local 'org-complex-heading-regexp) -(defvar org-complex-heading-regexp-format nil - "Printf format to make regexp to match an exact headline. -This regexp will match the headline of any node which has the -exact headline text that is put into the format, but may have any -TODO state, priority and tags.") -(make-variable-buffer-local 'org-complex-heading-regexp-format) -(defvar org-todo-line-tags-regexp nil - "Matches a headline and puts TODO state into group 2 if present. -Also put tags into group 4 if tags are present.") -(make-variable-buffer-local 'org-todo-line-tags-regexp) -(defvar org-ds-keyword-length 12 - "Maximum length of the DEADLINE and SCHEDULED keywords.") -(make-variable-buffer-local 'org-ds-keyword-length) -(defvar org-deadline-regexp nil - "Matches the DEADLINE keyword.") -(make-variable-buffer-local 'org-deadline-regexp) -(defvar org-deadline-time-regexp nil - "Matches the DEADLINE keyword together with a time stamp.") -(make-variable-buffer-local 'org-deadline-time-regexp) -(defvar org-deadline-time-hour-regexp nil - "Matches the DEADLINE keyword together with a time-and-hour stamp.") -(make-variable-buffer-local 'org-deadline-time-hour-regexp) -(defvar org-deadline-line-regexp nil - "Matches the DEADLINE keyword and the rest of the line.") -(make-variable-buffer-local 'org-deadline-line-regexp) -(defvar org-scheduled-regexp nil - "Matches the SCHEDULED keyword.") -(make-variable-buffer-local 'org-scheduled-regexp) -(defvar org-scheduled-time-regexp nil - "Matches the SCHEDULED keyword together with a time stamp.") -(make-variable-buffer-local 'org-scheduled-time-regexp) -(defvar org-scheduled-time-hour-regexp nil - "Matches the SCHEDULED keyword together with a time-and-hour stamp.") -(make-variable-buffer-local 'org-scheduled-time-hour-regexp) -(defvar org-closed-time-regexp nil - "Matches the CLOSED keyword together with a time stamp.") -(make-variable-buffer-local 'org-closed-time-regexp) - -(defvar org-keyword-time-regexp nil - "Matches any of the 4 keywords, together with the time stamp.") -(make-variable-buffer-local 'org-keyword-time-regexp) -(defvar org-keyword-time-not-clock-regexp nil - "Matches any of the 3 keywords, together with the time stamp.") -(make-variable-buffer-local 'org-keyword-time-not-clock-regexp) -(defvar org-maybe-keyword-time-regexp nil - "Matches a timestamp, possibly preceded by a keyword.") -(make-variable-buffer-local 'org-maybe-keyword-time-regexp) -(defvar org-all-time-keywords nil - "List of time keywords.") -(make-variable-buffer-local 'org-all-time-keywords) - -(defconst org-plain-time-of-day-regexp - (concat - "\\(\\<[012]?[0-9]" - "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" - "\\(--?" - "\\(\\<[012]?[0-9]" - "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" - "\\)?") - "Regular expression to match a plain time or time range. -Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following -groups carry important information: -0 the full match -1 the first time, range or not -8 the second time, if it is a range.") - -(defconst org-plain-time-extension-regexp - (concat - "\\(\\<[012]?[0-9]" - "\\(\\(:\\([0-5][0-9]\\([AaPp][Mm]\\)?\\)\\)\\|\\([AaPp][Mm]\\)\\)\\>\\)" - "\\+\\([0-9]+\\)\\(:\\([0-5][0-9]\\)\\)?") - "Regular expression to match a time range like 13:30+2:10 = 13:30-15:40. -Examples: 11:45 or 8am-13:15 or 2:45-2:45pm. After a match, the following -groups carry important information: -0 the full match -7 hours of duration -9 minutes of duration") - -(defconst org-stamp-time-of-day-regexp - (concat - "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} +\\sw+ +\\)" - "\\([012][0-9]:[0-5][0-9]\\(-\\([012][0-9]:[0-5][0-9]\\)\\)?[^\n\r>]*?\\)>" - "\\(--?" - "<\\1\\([012][0-9]:[0-5][0-9]\\)>\\)?") - "Regular expression to match a timestamp time or time range. -After a match, the following groups carry important information: -0 the full match -1 date plus weekday, for back referencing to make sure both times are on the same day -2 the first time, range or not -4 the second time, if it is a range.") - -(defconst org-startup-options - '(("fold" org-startup-folded t) - ("overview" org-startup-folded t) - ("nofold" org-startup-folded nil) - ("showall" org-startup-folded nil) - ("showeverything" org-startup-folded showeverything) - ("content" org-startup-folded content) - ("indent" org-startup-indented t) - ("noindent" org-startup-indented nil) - ("hidestars" org-hide-leading-stars t) - ("showstars" org-hide-leading-stars nil) - ("odd" org-odd-levels-only t) - ("oddeven" org-odd-levels-only nil) - ("align" org-startup-align-all-tables t) - ("noalign" org-startup-align-all-tables nil) - ("inlineimages" org-startup-with-inline-images t) - ("noinlineimages" org-startup-with-inline-images nil) - ("latexpreview" org-startup-with-latex-preview t) - ("nolatexpreview" org-startup-with-latex-preview nil) - ("customtime" org-display-custom-times t) - ("logdone" org-log-done time) - ("lognotedone" org-log-done note) - ("nologdone" org-log-done nil) - ("lognoteclock-out" org-log-note-clock-out t) - ("nolognoteclock-out" org-log-note-clock-out nil) - ("logrepeat" org-log-repeat state) - ("lognoterepeat" org-log-repeat note) - ("logdrawer" org-log-into-drawer t) - ("nologdrawer" org-log-into-drawer nil) - ("logstatesreversed" org-log-states-order-reversed t) - ("nologstatesreversed" org-log-states-order-reversed nil) - ("nologrepeat" org-log-repeat nil) - ("logreschedule" org-log-reschedule time) - ("lognotereschedule" org-log-reschedule note) - ("nologreschedule" org-log-reschedule nil) - ("logredeadline" org-log-redeadline time) - ("lognoteredeadline" org-log-redeadline note) - ("nologredeadline" org-log-redeadline nil) - ("logrefile" org-log-refile time) - ("lognoterefile" org-log-refile note) - ("nologrefile" org-log-refile nil) - ("fninline" org-footnote-define-inline t) - ("nofninline" org-footnote-define-inline nil) - ("fnlocal" org-footnote-section nil) - ("fnauto" org-footnote-auto-label t) - ("fnprompt" org-footnote-auto-label nil) - ("fnconfirm" org-footnote-auto-label confirm) - ("fnplain" org-footnote-auto-label plain) - ("fnadjust" org-footnote-auto-adjust t) - ("nofnadjust" org-footnote-auto-adjust nil) - ("constcgs" constants-unit-system cgs) - ("constSI" constants-unit-system SI) - ("noptag" org-tag-persistent-alist nil) - ("hideblocks" org-hide-block-startup t) - ("nohideblocks" org-hide-block-startup nil) - ("beamer" org-startup-with-beamer-mode t) - ("entitiespretty" org-pretty-entities t) - ("entitiesplain" org-pretty-entities nil)) - "Variable associated with STARTUP options for org-mode. -Each element is a list of three items: the startup options (as written -in the #+STARTUP line), the corresponding variable, and the value to set -this variable to if the option is found. An optional forth element PUSH -means to push this value onto the list in the variable.") - -(defun org-update-property-plist (key val props) - "Update PROPS with KEY and VAL." - (let* ((appending (string= "+" (substring key (- (length key) 1)))) - (key (if appending (substring key 0 (- (length key) 1)) key)) - (remainder (org-remove-if (lambda (p) (string= (car p) key)) props)) - (previous (cdr (assoc key props)))) - (if appending - (cons (cons key (if previous (concat previous " " val) val)) remainder) - (cons (cons key val) remainder)))) - -(defconst org-block-regexp - "^[ \t]*#\\+begin_?\\([^ \n]+\\)\\(\\([^\n]+\\)\\)?\n\\([^\000]+?\\)#\\+end_?\\1[ \t]*$" - "Regular expression for hiding blocks.") -(defconst org-heading-keyword-regexp-format - "^\\(\\*+\\)\\(?: +%s\\)\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Printf format for a regexp matching a headline with some keyword. -This regexp will match the headline of any node which has the -exact keyword that is put into the format. The keyword isn't in -any group by default, but the stars and the body are.") -(defconst org-heading-keyword-maybe-regexp-format - "^\\(\\*+\\)\\(?: +%s\\)?\\(?: +\\(.*?\\)\\)?[ \t]*$" - "Printf format for a regexp matching a headline, possibly with some keyword. -This regexp can match any headline with the specified keyword, or -without a keyword. The keyword isn't in any group by default, -but the stars and the body are.") - -(defcustom org-group-tags t - "When non-nil (the default), use group tags. -This can be turned on/off through `org-toggle-tags-groups'." - :group 'org-tags - :group 'org-startup - :type 'boolean) - -(defvar org-inhibit-startup nil) ; Dynamically-scoped param. - -(defun org-toggle-tags-groups () - "Toggle support for group tags. -Support for group tags is controlled by the option -`org-group-tags', which is non-nil by default." - (interactive) - (setq org-group-tags (not org-group-tags)) - (cond ((and (derived-mode-p 'org-agenda-mode) - org-group-tags) - (org-agenda-redo)) - ((derived-mode-p 'org-mode) - (let ((org-inhibit-startup t)) (org-mode)))) - (message "Groups tags support has been turned %s" - (if org-group-tags "on" "off"))) - -(defun org-set-regexps-and-options-for-tags () - "Precompute variables used for tags." - (when (derived-mode-p 'org-mode) - (org-set-local 'org-file-tags nil) - (let ((re (org-make-options-regexp '("FILETAGS" "TAGS"))) - (splitre "[ \t]+") - (start 0) - tags ftags key value) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (setq key (upcase (org-match-string-no-properties 1)) - value (org-match-string-no-properties 2)) - (if (stringp value) (setq value (org-trim value))) - (cond - ((equal key "TAGS") - (setq tags (append tags (if tags '("\\n") nil) - (org-split-string value splitre)))) - ((equal key "FILETAGS") - (when (string-match "\\S-" value) - (setq ftags - (append - ftags - (apply 'append - (mapcar (lambda (x) (org-split-string x ":")) - (org-split-string value))))))))))) - ;; Process the file tags. - (and ftags (org-set-local 'org-file-tags - (mapcar 'org-add-prop-inherited ftags))) - (org-set-local 'org-tag-groups-alist nil) - ;; Process the tags. - (when (and (not tags) org-tag-alist) - (setq tags - (mapcar - (lambda (tg) (cond ((eq (car tg) :startgroup) "{") - ((eq (car tg) :endgroup) "}") - ((eq (car tg) :grouptags) ":") - ((eq (car tg) :newline) "\n") - (t (concat (car tg) - (if (characterp (cdr tg)) - (format "(%s)" (char-to-string (cdr tg))) ""))))) - org-tag-alist))) - (let (e tgs g) - (while (setq e (pop tags)) - (cond - ((equal e "{") - (progn (push '(:startgroup) tgs) - (when (equal (nth 1 tags) ":") - (push (list (replace-regexp-in-string - "(.+)$" "" (nth 0 tags))) - org-tag-groups-alist) - (setq g 0)))) - ((equal e ":") (push '(:grouptags) tgs)) - ((equal e "}") (push '(:endgroup) tgs) (if g (setq g nil))) - ((equal e "\\n") (push '(:newline) tgs)) - ((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e) - (push (cons (match-string 1 e) - (string-to-char (match-string 2 e))) tgs) - (if (and g (> g 0)) - (setcar org-tag-groups-alist - (append (car org-tag-groups-alist) - (list (match-string 1 e))))) - (if g (setq g (1+ g)))) - (t (push (list e) tgs) - (if (and g (> g 0)) - (setcar org-tag-groups-alist - (append (car org-tag-groups-alist) (list e)))) - (if g (setq g (1+ g)))))) - (org-set-local 'org-tag-alist nil) - (while (setq e (pop tgs)) - (or (and (stringp (car e)) - (assoc (car e) org-tag-alist)) - (push e org-tag-alist))) - ;; Return a list with tag variables - (list org-file-tags org-tag-alist org-tag-groups-alist))))) - -(defvar org-ota nil) -(defun org-set-regexps-and-options () - "Precompute regular expressions used in the current buffer." - (when (derived-mode-p 'org-mode) - (org-set-local 'org-todo-kwd-alist nil) - (org-set-local 'org-todo-key-alist nil) - (org-set-local 'org-todo-key-trigger nil) - (org-set-local 'org-todo-keywords-1 nil) - (org-set-local 'org-done-keywords nil) - (org-set-local 'org-todo-heads nil) - (org-set-local 'org-todo-sets nil) - (org-set-local 'org-todo-log-states nil) - (org-set-local 'org-file-properties nil) - (let ((re (org-make-options-regexp - '("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE" - "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS" - "SETUPFILE" "OPTIONS") - "\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)")) - (splitre "[ \t]+") - (scripts org-use-sub-superscripts) - kwds kws0 kwsa key log value cat arch const links hw dws - tail sep kws1 prio props drawers ext-setup-or-nil setup-contents - (start 0)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while - (or (and - ext-setup-or-nil - (not org-ota) - (let (ret) - (with-temp-buffer - (insert ext-setup-or-nil) - (let ((major-mode 'org-mode) org-ota) - (setq ret (save-match-data - (org-set-regexps-and-options-for-tags))))) - ;; Append setupfile tags to existing tags - (setq org-ota t) - (setq org-file-tags - (delq nil (append org-file-tags (nth 0 ret))) - org-tag-alist - (delq nil (append org-tag-alist (nth 1 ret))) - org-tag-groups-alist - (delq nil (append org-tag-groups-alist (nth 2 ret)))))) - (and ext-setup-or-nil - (string-match re ext-setup-or-nil start) - (setq start (match-end 0))) - (and (setq ext-setup-or-nil nil start 0) - (re-search-forward re nil t))) - (setq key (upcase (match-string 1 ext-setup-or-nil)) - value (org-match-string-no-properties 2 ext-setup-or-nil)) - (if (stringp value) (setq value (org-trim value))) - (cond - ((equal key "CATEGORY") - (setq cat value)) - ((member key '("SEQ_TODO" "TODO")) - (push (cons 'sequence (org-split-string value splitre)) kwds)) - ((equal key "TYP_TODO") - (push (cons 'type (org-split-string value splitre)) kwds)) - ((string-match "\\`\\([a-zA-Z][0-9a-zA-Z_]*\\)_TODO\\'" key) - ;; general TODO-like setup - (push (cons (intern (downcase (match-string 1 key))) - (org-split-string value splitre)) kwds)) - ((equal key "COLUMNS") - (org-set-local 'org-columns-default-format value)) - ((equal key "LINK") - (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value) - (push (cons (match-string 1 value) - (org-trim (match-string 2 value))) - links))) - ((equal key "PRIORITIES") - (setq prio (org-split-string value " +"))) - ((equal key "PROPERTY") - (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) - (setq props (org-update-property-plist (match-string 1 value) - (match-string 2 value) - props)))) - ((equal key "DRAWERS") - (setq drawers (delete-dups (append org-drawers (org-split-string value splitre))))) - ((equal key "CONSTANTS") - (org-table-set-constants)) - ((equal key "STARTUP") - (let ((opts (org-split-string value splitre)) - l var val) - (while (setq l (pop opts)) - (when (setq l (assoc l org-startup-options)) - (setq var (nth 1 l) val (nth 2 l)) - (if (not (nth 3 l)) - (set (make-local-variable var) val) - (if (not (listp (symbol-value var))) - (set (make-local-variable var) nil)) - (set (make-local-variable var) (symbol-value var)) - (add-to-list var val)))))) - ((equal key "ARCHIVE") - (setq arch value) - (remove-text-properties 0 (length arch) - '(face t fontified t) arch)) - ((equal key "OPTIONS") - (if (string-match "\\([ \t]\\|\\`\\)\\^:\\(t\\|nil\\|{}\\)" value) - (setq scripts (read (match-string 2 value))))) - ((and (equal key "SETUPFILE") - ;; Prevent checking in Gnus messages - (not buffer-read-only)) - (setq setup-contents (org-file-contents - (expand-file-name - (org-remove-double-quotes value)) - 'noerror)) - (if (not ext-setup-or-nil) - (setq ext-setup-or-nil setup-contents start 0) - (setq ext-setup-or-nil - (concat (substring ext-setup-or-nil 0 start) - "\n" setup-contents "\n" - (substring ext-setup-or-nil start))))))) - ;; search for property blocks - (goto-char (point-min)) - (while (re-search-forward org-block-regexp nil t) - (when (equal "PROPERTY" (upcase (match-string 1))) - (setq value (replace-regexp-in-string - "[\n\r]" " " (match-string 4))) - (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) - (setq props (org-update-property-plist (match-string 1 value) - (match-string 2 value) - props))))))) - (org-set-local 'org-use-sub-superscripts scripts) - (when cat - (org-set-local 'org-category (intern cat)) - (push (cons "CATEGORY" cat) props)) - (when prio - (if (< (length prio) 3) (setq prio '("A" "C" "B"))) - (setq prio (mapcar 'string-to-char prio)) - (org-set-local 'org-highest-priority (nth 0 prio)) - (org-set-local 'org-lowest-priority (nth 1 prio)) - (org-set-local 'org-default-priority (nth 2 prio))) - (and props (org-set-local 'org-file-properties (nreverse props))) - (and drawers (org-set-local 'org-drawers drawers)) - (and arch (org-set-local 'org-archive-location arch)) - (and links (setq org-link-abbrev-alist-local (nreverse links))) - ;; Process the TODO keywords - (unless kwds - ;; Use the global values as if they had been given locally. - (setq kwds (default-value 'org-todo-keywords)) - (if (stringp (car kwds)) - (setq kwds (list (cons org-todo-interpretation - (default-value 'org-todo-keywords))))) - (setq kwds (reverse kwds))) - (setq kwds (nreverse kwds)) - (let (inter kws kw) - (while (setq kws (pop kwds)) - (let ((kws (or - (run-hook-with-args-until-success - 'org-todo-setup-filter-hook kws) - kws))) - (setq inter (pop kws) sep (member "|" kws) - kws0 (delete "|" (copy-sequence kws)) - kwsa nil - kws1 (mapcar - (lambda (x) - ;; 1 2 - (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x) - (progn - (setq kw (match-string 1 x) - key (and (match-end 2) (match-string 2 x)) - log (org-extract-log-state-settings x)) - (push (cons kw (and key (string-to-char key))) kwsa) - (and log (push log org-todo-log-states)) - kw) - (error "Invalid TODO keyword %s" x))) - kws0) - kwsa (if kwsa (append '((:startgroup)) - (nreverse kwsa) - '((:endgroup)))) - hw (car kws1) - dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) - tail (list inter hw (car dws) (org-last dws)))) - (add-to-list 'org-todo-heads hw 'append) - (push kws1 org-todo-sets) - (setq org-done-keywords (append org-done-keywords dws nil)) - (setq org-todo-key-alist (append org-todo-key-alist kwsa)) - (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1) - (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) - (setq org-todo-sets (nreverse org-todo-sets) - org-todo-kwd-alist (nreverse org-todo-kwd-alist) - org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist)) - org-todo-key-alist (org-assign-fast-keys org-todo-key-alist))) - ;; Compute the regular expressions and other local variables. - ;; Using `org-outline-regexp-bol' would complicate them much, - ;; because of the fixed white space at the end of that string. - (if (not org-done-keywords) - (setq org-done-keywords (and org-todo-keywords-1 - (list (org-last org-todo-keywords-1))))) - (setq org-ds-keyword-length (+ 2 (max (length org-deadline-string) - (length org-scheduled-string) - (length org-clock-string) - (length org-closed-string))) - org-drawer-regexp - (concat "^[ \t]*:\\(" - (mapconcat 'regexp-quote org-drawers "\\|") - "\\):[ \t]*$") - org-not-done-keywords - (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1)) - org-todo-regexp - (concat "\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\)") - org-not-done-regexp - (concat "\\(" - (mapconcat 'regexp-quote org-not-done-keywords "\\|") - "\\)") - org-not-done-heading-regexp - (format org-heading-keyword-regexp-format org-not-done-regexp) - org-todo-line-regexp - (format org-heading-keyword-maybe-regexp-format org-todo-regexp) - org-complex-heading-regexp - (concat "^\\(\\*+\\)" - "\\(?: +" org-todo-regexp "\\)?" - "\\(?: +\\(\\[#.\\]\\)\\)?" - "\\(?: +\\(.*?\\)\\)??" - (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?") - "[ \t]*$") - org-complex-heading-regexp-format - (concat "^\\(\\*+\\)" - "\\(?: +" org-todo-regexp "\\)?" - "\\(?: +\\(\\[#.\\]\\)\\)?" - "\\(?: +" - ;; Stats cookies can be stuck to body. - "\\(?:\\[[0-9%%/]+\\] *\\)?" - "\\(%s\\)" - "\\(?: *\\[[0-9%%/]+\\]\\)?" - "\\)" - (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?") - "[ \t]*$") - org-todo-line-tags-regexp - (concat "^\\(\\*+\\)" - "\\(?: +" org-todo-regexp "\\)?" - "\\(?: +\\(.*?\\)\\)??" - (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?") - "[ \t]*$") - org-deadline-regexp (concat "\\<" org-deadline-string) - org-deadline-time-regexp - (concat "\\<" org-deadline-string " *<\\([^>]+\\)>") - org-deadline-time-hour-regexp - (concat "\\<" org-deadline-string - " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>") - org-deadline-line-regexp - (concat "\\<\\(" org-deadline-string "\\).*") - org-scheduled-regexp - (concat "\\<" org-scheduled-string) - org-scheduled-time-regexp - (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>") - org-scheduled-time-hour-regexp - (concat "\\<" org-scheduled-string - " *<\\([^>]+[0-9]\\{1,2\\}:[0-9]\\{2\\}[0-9-+:hdwmy \t.]*\\)>") - org-closed-time-regexp - (concat "\\<" org-closed-string " *\\[\\([^]]+\\)\\]") - org-keyword-time-regexp - (concat "\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\|" org-clock-string "\\)" - " *[[<]\\([^]>]+\\)[]>]") - org-keyword-time-not-clock-regexp - (concat "\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\)" - " *[[<]\\([^]>]+\\)[]>]") - org-maybe-keyword-time-regexp - (concat "\\(\\<\\(" org-scheduled-string - "\\|" org-deadline-string - "\\|" org-closed-string - "\\|" org-clock-string "\\)\\)?" - " *\\([[<][0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?[]>]\\|<%%([^\r\n>]*>\\)") - org-all-time-keywords - (mapcar (lambda (w) (substring w 0 -1)) - (list org-scheduled-string org-deadline-string - org-clock-string org-closed-string))) - (setq org-ota nil) - (org-compute-latex-and-related-regexp)))) - -(defun org-file-contents (file &optional noerror) - "Return the contents of FILE, as a string." - (if (or (not file) - (not (file-readable-p file))) - (if noerror - (message "Cannot read file \"%s\"" file) - (error "Cannot read file \"%s\"" file)) - (with-temp-buffer - (insert-file-contents file) - (buffer-string)))) - -(defun org-extract-log-state-settings (x) - "Extract the log state setting from a TODO keyword string. -This will extract info from a string like \"WAIT(w@/!)\"." - (let (kw key log1 log2) - (when (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?\\([!@]\\)?\\(?:/\\([!@]\\)\\)?)\\)?$" x) - (setq kw (match-string 1 x) - key (and (match-end 2) (match-string 2 x)) - log1 (and (match-end 3) (match-string 3 x)) - log2 (and (match-end 4) (match-string 4 x))) - (and (or log1 log2) - (list kw - (and log1 (if (equal log1 "!") 'time 'note)) - (and log2 (if (equal log2 "!") 'time 'note))))))) - -(defun org-remove-keyword-keys (list) - "Remove a pair of parenthesis at the end of each string in LIST." - (mapcar (lambda (x) - (if (string-match "(.*)$" x) - (substring x 0 (match-beginning 0)) - x)) - list)) - -(defun org-assign-fast-keys (alist) - "Assign fast keys to a keyword-key alist. -Respect keys that are already there." - (let (new e (alt ?0)) - (while (setq e (pop alist)) - (if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup)) - (cdr e)) ;; Key already assigned. - (push e new) - (let ((clist (string-to-list (downcase (car e)))) - (used (append new alist))) - (when (= (car clist) ?@) - (pop clist)) - (while (and clist (rassoc (car clist) used)) - (pop clist)) - (unless clist - (while (rassoc alt used) - (incf alt))) - (push (cons (car e) (or (car clist) alt)) new)))) - (nreverse new))) - -;;; Some variables used in various places - -(defvar org-window-configuration nil - "Used in various places to store a window configuration.") -(defvar org-selected-window nil - "Used in various places to store a window configuration.") -(defvar org-finish-function nil - "Function to be called when `C-c C-c' is used. -This is for getting out of special buffers like capture.") - - -;; FIXME: Occasionally check by commenting these, to make sure -;; no other functions uses these, forgetting to let-bind them. -(org-no-warnings (defvar entry)) ;; unprefixed, from calendar.el -(defvar org-last-state) -(org-no-warnings (defvar date)) ;; unprefixed, from calendar.el - -;; Defined somewhere in this file, but used before definition. -(defvar org-entities) ;; defined in org-entities.el -(defvar org-struct-menu) -(defvar org-org-menu) -(defvar org-tbl-menu) - -;;;; Define the Org-mode - -;; We use a before-change function to check if a table might need -;; an update. -(defvar org-table-may-need-update t - "Indicates that a table might need an update. -This variable is set by `org-before-change-function'. -`org-table-align' sets it back to nil.") -(defun org-before-change-function (beg end) - "Every change indicates that a table might need an update." - (setq org-table-may-need-update t)) -(defvar org-mode-map) -(defvar org-inhibit-startup-visibility-stuff nil) ; Dynamically-scoped param. -(defvar org-agenda-keep-modes nil) ; Dynamically-scoped param. -(defvar org-inhibit-logging nil) ; Dynamically-scoped param. -(defvar org-inhibit-blocking nil) ; Dynamically-scoped param. -(defvar org-table-buffer-is-an nil) - -(defvar bidi-paragraph-direction) -(defvar buffer-face-mode-face) - -(require 'outline) -(if (and (not (keymapp outline-mode-map)) (featurep 'allout)) - (error "Conflict with outdated version of allout.el. Load org.el before allout.el, or upgrade to newer allout, for example by switching to Emacs 22")) -(require 'noutline "noutline" 'noerror) ;; stock XEmacs does not have it - -;; Other stuff we need. -(require 'time-date) -(unless (fboundp 'time-subtract) (defalias 'time-subtract 'subtract-time)) -(require 'easymenu) -(require 'overlay) - -;; (require 'org-macs) moved higher up in the file before it is first used -(require 'org-entities) -;; (require 'org-compat) moved higher up in the file before it is first used -(require 'org-faces) -(require 'org-list) -(require 'org-pcomplete) -(require 'org-src) -(require 'org-footnote) -(require 'org-macro) - -;; babel -(require 'ob) - -;;;###autoload -(define-derived-mode org-mode outline-mode "Org" - "Outline-based notes management and organizer, alias -\"Carsten's outline-mode for keeping track of everything.\" - -Org-mode develops organizational tasks around a NOTES file which -contains information about projects as plain text. Org-mode is -implemented on top of outline-mode, which is ideal to keep the content -of large files well structured. It supports ToDo items, deadlines and -time stamps, which magically appear in the diary listing of the Emacs -calendar. Tables are easily created with a built-in table editor. -Plain text URL-like links connect to websites, emails (VM), Usenet -messages (Gnus), BBDB entries, and any files related to the project. -For printing and sharing of notes, an Org-mode file (or a part of it) -can be exported as a structured ASCII or HTML file. - -The following commands are available: - -\\{org-mode-map}" - - ;; Get rid of Outline menus, they are not needed - ;; Need to do this here because define-derived-mode sets up - ;; the keymap so late. Still, it is a waste to call this each time - ;; we switch another buffer into org-mode. - (if (featurep 'xemacs) - (when (boundp 'outline-mode-menu-heading) - ;; Assume this is Greg's port, it uses easymenu - (easy-menu-remove outline-mode-menu-heading) - (easy-menu-remove outline-mode-menu-show) - (easy-menu-remove outline-mode-menu-hide)) - (define-key org-mode-map [menu-bar headings] 'undefined) - (define-key org-mode-map [menu-bar hide] 'undefined) - (define-key org-mode-map [menu-bar show] 'undefined)) - - (org-load-modules-maybe) - (easy-menu-add org-org-menu) - (easy-menu-add org-tbl-menu) - (org-install-agenda-files-menu) - (if org-descriptive-links (add-to-invisibility-spec '(org-link))) - (add-to-invisibility-spec '(org-cwidth)) - (add-to-invisibility-spec '(org-hide-block . t)) - (when (featurep 'xemacs) - (org-set-local 'line-move-ignore-invisible t)) - (org-set-local 'outline-regexp org-outline-regexp) - (org-set-local 'outline-level 'org-outline-level) - (setq bidi-paragraph-direction 'left-to-right) - (when (and org-ellipsis - (fboundp 'set-display-table-slot) (boundp 'buffer-display-table) - (fboundp 'make-glyph-code)) - (unless org-display-table - (setq org-display-table (make-display-table))) - (set-display-table-slot - org-display-table 4 - (vconcat (mapcar - (lambda (c) (make-glyph-code c (and (not (stringp org-ellipsis)) - org-ellipsis))) - (if (stringp org-ellipsis) org-ellipsis "...")))) - (setq buffer-display-table org-display-table)) - (org-set-regexps-and-options-for-tags) - (org-set-regexps-and-options) - (org-set-font-lock-defaults) - (when (and org-tag-faces (not org-tags-special-faces-re)) - ;; tag faces set outside customize.... force initialization. - (org-set-tag-faces 'org-tag-faces org-tag-faces)) - ;; Calc embedded - (org-set-local 'calc-embedded-open-mode "# ") - ;; Modify a few syntax entries - (modify-syntax-entry ?@ "w") - (modify-syntax-entry ?\" "\"") - (if org-startup-truncated (setq truncate-lines t)) - (when org-startup-indented (require 'org-indent) (org-indent-mode 1)) - (org-set-local 'font-lock-unfontify-region-function - 'org-unfontify-region) - ;; Activate before-change-function - (org-set-local 'org-table-may-need-update t) - (org-add-hook 'before-change-functions 'org-before-change-function nil - 'local) - ;; Check for running clock before killing a buffer - (org-add-hook 'kill-buffer-hook 'org-check-running-clock nil 'local) - ;; Initialize macros templates. - (org-macro-initialize-templates) - ;; Initialize radio targets. - (org-update-radio-target-regexp) - ;; Indentation. - (org-set-local 'indent-line-function 'org-indent-line) - (org-set-local 'indent-region-function 'org-indent-region) - ;; Filling and auto-filling. - (org-setup-filling) - ;; Comments. - (org-setup-comments-handling) - ;; Beginning/end of defun - (org-set-local 'beginning-of-defun-function 'org-backward-element) - (org-set-local 'end-of-defun-function 'org-forward-element) - ;; Next error for sparse trees - (org-set-local 'next-error-function 'org-occur-next-match) - ;; Make sure dependence stuff works reliably, even for users who set it - ;; too late :-( - (if org-enforce-todo-dependencies - (add-hook 'org-blocker-hook - 'org-block-todo-from-children-or-siblings-or-parent) - (remove-hook 'org-blocker-hook - 'org-block-todo-from-children-or-siblings-or-parent)) - (if org-enforce-todo-checkbox-dependencies - (add-hook 'org-blocker-hook - 'org-block-todo-from-checkboxes) - (remove-hook 'org-blocker-hook - 'org-block-todo-from-checkboxes)) - - ;; Align options lines - (org-set-local - 'align-mode-rules-list - '((org-in-buffer-settings - (regexp . "^#\\+[A-Z_]+:\\(\\s-*\\)\\S-+") - (modes . '(org-mode))))) - - ;; Imenu - (org-set-local 'imenu-create-index-function - 'org-imenu-get-tree) - - ;; Make isearch reveal context - (if (or (featurep 'xemacs) - (not (boundp 'outline-isearch-open-invisible-function))) - ;; Emacs 21 and XEmacs make use of the hook - (org-add-hook 'isearch-mode-end-hook 'org-isearch-end 'append 'local) - ;; Emacs 22 deals with this through a special variable - (org-set-local 'outline-isearch-open-invisible-function - (lambda (&rest ignore) (org-show-context 'isearch))) - (org-add-hook 'isearch-mode-end-hook 'org-fix-ellipsis-at-bol 'append 'local)) - - ;; Setup the pcomplete hooks - (set (make-local-variable 'pcomplete-command-completion-function) - 'org-pcomplete-initial) - (set (make-local-variable 'pcomplete-command-name-function) - 'org-command-at-point) - (set (make-local-variable 'pcomplete-default-completion-function) - 'ignore) - (set (make-local-variable 'pcomplete-parse-arguments-function) - 'org-parse-arguments) - (set (make-local-variable 'pcomplete-termination-string) "") - (when (>= emacs-major-version 23) - (set (make-local-variable 'buffer-face-mode-face) 'org-default)) - - ;; If empty file that did not turn on org-mode automatically, make it to. - (if (and org-insert-mode-line-in-empty-file - (org-called-interactively-p 'any) - (= (point-min) (point-max))) - (insert "# -*- mode: org -*-\n\n")) - (unless org-inhibit-startup - (org-unmodified - (and org-startup-with-beamer-mode (org-beamer-mode)) - (when org-startup-align-all-tables - (org-table-map-tables 'org-table-align 'quietly)) - (when org-startup-with-inline-images - (org-display-inline-images)) - (when org-startup-with-latex-preview - (org-preview-latex-fragment)) - (unless org-inhibit-startup-visibility-stuff - (org-set-startup-visibility)))) - ;; Try to set org-hide correctly - (set-face-foreground 'org-hide (org-find-invisible-foreground))) - -;; Update `customize-package-emacs-version-alist' -(add-to-list 'customize-package-emacs-version-alist - '(Org ("6.21b" . "23.1") ("6.33x" . "23.2") - ("7.8.11" . "24.1") ("7.9.4" . "24.3") - ("8.0" . "24.4"))) - -(defvar org-mode-transpose-word-syntax-table - (let ((st (make-syntax-table))) - (mapc (lambda(c) (modify-syntax-entry - (string-to-char (car c)) "w p" st)) - org-emphasis-alist) - st)) - -(when (fboundp 'abbrev-table-put) - (abbrev-table-put org-mode-abbrev-table - :parents (list text-mode-abbrev-table))) - -(put 'org-mode 'flyspell-mode-predicate 'org-mode-flyspell-verify) - -(defsubst org-fix-ellipsis-at-bol () - (save-excursion (goto-char (window-start)) (recenter 0))) - -(defun org-find-invisible-foreground () - (let ((candidates (remove - "unspecified-bg" - (nconc - (list (face-background 'default) - (face-background 'org-default)) - (mapcar - (lambda (alist) - (when (boundp alist) - (cdr (assoc 'background-color (symbol-value alist))))) - '(default-frame-alist initial-frame-alist window-system-default-frame-alist)) - (list (face-foreground 'org-hide)))))) - (car (remove nil candidates)))) - -(defun org-current-time (&optional rounding-minutes past) - "Current time, possibly rounded to ROUNDING-MINUTES. -When ROUNDING-MINUTES is not an integer, fall back on the car of -`org-time-stamp-rounding-minutes'. When PAST is non-nil, ensure -the rounding returns a past time." - (let ((r (or (and (integerp rounding-minutes) rounding-minutes) - (car org-time-stamp-rounding-minutes))) - (time (decode-time)) res) - (if (< r 1) - (current-time) - (setq res - (apply 'encode-time - (append (list 0 (* r (floor (+ .5 (/ (float (nth 1 time)) r))))) - (nthcdr 2 time)))) - (if (and past (< (org-float-time (time-subtract (current-time) res)) 0)) - (seconds-to-time (- (org-float-time res) (* r 60))) - res)))) - -(defun org-today () - "Return today date, considering `org-extend-today-until'." - (time-to-days - (time-subtract (current-time) - (list 0 (* 3600 org-extend-today-until) 0)))) - -;;;; Font-Lock stuff, including the activators - -(defvar org-mouse-map (make-sparse-keymap)) -(org-defkey org-mouse-map [mouse-2] 'org-open-at-mouse) -(org-defkey org-mouse-map [mouse-3] 'org-find-file-at-mouse) -(when org-mouse-1-follows-link - (org-defkey org-mouse-map [follow-link] 'mouse-face)) -(when org-tab-follows-link - (org-defkey org-mouse-map [(tab)] 'org-open-at-point) - (org-defkey org-mouse-map "\C-i" 'org-open-at-point)) - -(require 'font-lock) - -(defconst org-non-link-chars "]\t\n\r<>") -(defvar org-link-types '("http" "https" "ftp" "mailto" "file" "news" - "shell" "elisp" "doi" "message")) -(defvar org-link-types-re nil - "Matches a link that has a url-like prefix like \"http:\"") -(defvar org-link-re-with-space nil - "Matches a link with spaces, optional angular brackets around it.") -(defvar org-link-re-with-space2 nil - "Matches a link with spaces, optional angular brackets around it.") -(defvar org-link-re-with-space3 nil - "Matches a link with spaces, only for internal part in bracket links.") -(defvar org-angle-link-re nil - "Matches link with angular brackets, spaces are allowed.") -(defvar org-plain-link-re nil - "Matches plain link, without spaces.") -(defvar org-bracket-link-regexp nil - "Matches a link in double brackets.") -(defvar org-bracket-link-analytic-regexp nil - "Regular expression used to analyze links. -Here is what the match groups contain after a match: -1: http: -2: http -3: path -4: [desc] -5: desc") -(defvar org-bracket-link-analytic-regexp++ nil - "Like `org-bracket-link-analytic-regexp', but include coderef internal type.") -(defvar org-any-link-re nil - "Regular expression matching any link.") - -(defconst org-match-sexp-depth 3 - "Number of stacked braces for sub/superscript matching.") - -(defun org-create-multibrace-regexp (left right n) - "Create a regular expression which will match a balanced sexp. -Opening delimiter is LEFT, and closing delimiter is RIGHT, both given -as single character strings. -The regexp returned will match the entire expression including the -delimiters. It will also define a single group which contains the -match except for the outermost delimiters. The maximum depth of -stacked delimiters is N. Escaping delimiters is not possible." - (let* ((nothing (concat "[^" left right "]*?")) - (or "\\|") - (re nothing) - (next (concat "\\(?:" nothing left nothing right "\\)+" nothing))) - (while (> n 1) - (setq n (1- n) - re (concat re or next) - next (concat "\\(?:" nothing left next right "\\)+" nothing))) - (concat left "\\(" re "\\)" right))) - -(defvar org-match-substring-regexp - (concat - "\\(\\S-\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\|" - "\\(" (org-create-multibrace-regexp "(" ")" org-match-sexp-depth) "\\)" - "\\|" - "\\(\\(?:\\*\\|[-+]?[^-+*!@#$%^_ \t\r\n,:\"?<>~;./{}=()]+\\)\\)\\)") - "The regular expression matching a sub- or superscript.") - -(defvar org-match-substring-with-braces-regexp - (concat - "\\(\\S-\\)\\([_^]\\)\\(" - "\\(" (org-create-multibrace-regexp "{" "}" org-match-sexp-depth) "\\)" - "\\)") - "The regular expression matching a sub- or superscript, forcing braces.") - -(defun org-make-link-regexps () - "Update the link regular expressions. -This should be called after the variable `org-link-types' has changed." - (setq org-link-types-re - (concat - "\\`\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):") - org-link-re-with-space - (concat - "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):" - "\\([^" org-non-link-chars " ]" - "[^" org-non-link-chars "]*" - "[^" org-non-link-chars " ]\\)>?") - org-link-re-with-space2 - (concat - "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):" - "\\([^" org-non-link-chars " ]" - "[^\t\n\r]*" - "[^" org-non-link-chars " ]\\)>?") - org-link-re-with-space3 - (concat - "<?\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):" - "\\([^" org-non-link-chars " ]" - "[^\t\n\r]*\\)") - org-angle-link-re - (concat - "<\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):" - "\\([^" org-non-link-chars " ]" - "[^" org-non-link-chars "]*" - "\\)>") - org-plain-link-re - (concat - "\\<\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):" - (org-re "\\([^ \t\n()<>]+\\(?:([[:word:]0-9_]+)\\|\\([^[:punct:] \t\n]\\|/\\)\\)\\)")) - ;; "\\([^]\t\n\r<>() ]+[^]\t\n\r<>,.;() ]\\)") - org-bracket-link-regexp - "\\[\\[\\([^][]+\\)\\]\\(\\[\\([^][]+\\)\\]\\)?\\]" - org-bracket-link-analytic-regexp - (concat - "\\[\\[" - "\\(\\(" (mapconcat 'regexp-quote org-link-types "\\|") "\\):\\)?" - "\\([^]]+\\)" - "\\]" - "\\(\\[" "\\([^]]+\\)" "\\]\\)?" - "\\]") - org-bracket-link-analytic-regexp++ - (concat - "\\[\\[" - "\\(\\(" (mapconcat 'regexp-quote (cons "coderef" org-link-types) "\\|") "\\):\\)?" - "\\([^]]+\\)" - "\\]" - "\\(\\[" "\\([^]]+\\)" "\\]\\)?" - "\\]") - org-any-link-re - (concat "\\(" org-bracket-link-regexp "\\)\\|\\(" - org-angle-link-re "\\)\\|\\(" - org-plain-link-re "\\)"))) - -(org-make-link-regexps) - -(defconst org-ts-regexp "<\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^\r\n>]*?\\)>" - "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp-both "[[<]\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^]\r\n>]*?\\)[]>]" - "Regular expression for fast time stamp matching.") -(defconst org-ts-regexp0 - "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)\\( +[^]+0-9>\r\n -]+\\)?\\( +\\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" - "Regular expression matching time strings for analysis. -This one does not require the space after the date, so it can be used -on a string that terminates immediately after the date.") -(defconst org-ts-regexp1 "\\(\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\) *\\([^]+0-9>\r\n -]*\\)\\( \\([0-9]\\{1,2\\}\\):\\([0-9]\\{2\\}\\)\\)?\\)" - "Regular expression matching time strings for analysis.") -(defconst org-ts-regexp2 (concat "<" org-ts-regexp1 "[^>\n]\\{0,16\\}>") - "Regular expression matching time stamps, with groups.") -(defconst org-ts-regexp3 (concat "[[<]" org-ts-regexp1 "[^]>\n]\\{0,16\\}[]>]") - "Regular expression matching time stamps (also [..]), with groups.") -(defconst org-tr-regexp (concat org-ts-regexp "--?-?" org-ts-regexp) - "Regular expression matching a time stamp range.") -(defconst org-tr-regexp-both - (concat org-ts-regexp-both "--?-?" org-ts-regexp-both) - "Regular expression matching a time stamp range.") -(defconst org-tsr-regexp (concat org-ts-regexp "\\(--?-?" - org-ts-regexp "\\)?") - "Regular expression matching a time stamp or time stamp range.") -(defconst org-tsr-regexp-both - (concat org-ts-regexp-both "\\(--?-?" - org-ts-regexp-both "\\)?") - "Regular expression matching a time stamp or time stamp range. -The time stamps may be either active or inactive.") - -(defvar org-emph-face nil) - -(defun org-do-emphasis-faces (limit) - "Run through the buffer and add overlays to emphasized strings." - (let (rtn a) - (while (and (not rtn) (re-search-forward org-emph-re limit t)) - (if (not (= (char-after (match-beginning 3)) - (char-after (match-beginning 4)))) - (progn - (setq rtn t) - (setq a (assoc (match-string 3) org-emphasis-alist)) - (font-lock-prepend-text-property (match-beginning 2) (match-end 2) - 'face - (nth 1 a)) - (and (nth 2 a) - (org-remove-flyspell-overlays-in - (match-beginning 0) (match-end 0))) - (add-text-properties (match-beginning 2) (match-end 2) - '(font-lock-multiline t org-emphasis t)) - (when org-hide-emphasis-markers - (add-text-properties (match-end 4) (match-beginning 5) - '(invisible org-link)) - (add-text-properties (match-beginning 3) (match-end 3) - '(invisible org-link))))) - (backward-char 1)) - rtn)) - -(defun org-emphasize (&optional char) - "Insert or change an emphasis, i.e. a font like bold or italic. -If there is an active region, change that region to a new emphasis. -If there is no region, just insert the marker characters and position -the cursor between them. -CHAR should be the marker character. If it is a space, it means to -remove the emphasis of the selected region. -If CHAR is not given (for example in an interactive call) it will be -prompted for." - (interactive) - (let ((erc org-emphasis-regexp-components) - (prompt "") - (string "") beg end move c s) - (if (org-region-active-p) - (setq beg (region-beginning) end (region-end) - string (buffer-substring beg end)) - (setq move t)) - - (unless char - (message "Emphasis marker or tag: [%s]" - (mapconcat (lambda(e) (car e)) org-emphasis-alist "")) - (setq char (read-char-exclusive))) - (if (equal char ?\ ) - (setq s "" move nil) - (unless (assoc (char-to-string char) org-emphasis-alist) - (user-error "No such emphasis marker: \"%c\"" char)) - (setq s (char-to-string char))) - (while (and (> (length string) 1) - (equal (substring string 0 1) (substring string -1)) - (assoc (substring string 0 1) org-emphasis-alist)) - (setq string (substring string 1 -1))) - (setq string (concat s string s)) - (if beg (delete-region beg end)) - (unless (or (bolp) - (string-match (concat "[" (nth 0 erc) "\n]") - (char-to-string (char-before (point))))) - (insert " ")) - (unless (or (eobp) - (string-match (concat "[" (nth 1 erc) "\n]") - (char-to-string (char-after (point))))) - (insert " ") (backward-char 1)) - (insert string) - (and move (backward-char 1)))) - -(defconst org-nonsticky-props - '(mouse-face highlight keymap invisible intangible help-echo org-linked-text htmlize-link)) - -(defsubst org-rear-nonsticky-at (pos) - (add-text-properties (1- pos) pos (list 'rear-nonsticky org-nonsticky-props))) - -(defun org-activate-plain-links (limit) - "Run through the buffer and add overlays to links." - (let (f hl) - (when (and (re-search-forward (concat org-plain-link-re) limit t) - (not (org-in-src-block-p))) - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (setq f (get-text-property (match-beginning 0) 'face)) - (setq hl (org-match-string-no-properties 0)) - (if (or (eq f 'org-tag) - (and (listp f) (memq 'org-tag f))) - nil - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'face 'org-link - 'htmlize-link `(:uri ,hl) - 'keymap org-mouse-map)) - (org-rear-nonsticky-at (match-end 0))) - t))) - -(defun org-activate-code (limit) - (if (re-search-forward "^[ \t]*\\(:\\(?: .*\\|$\\)\n?\\)" limit t) - (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) - t))) - -(defcustom org-src-fontify-natively nil - "When non-nil, fontify code in code blocks." - :type 'boolean - :version "24.1" - :group 'org-appearance - :group 'org-babel) - -(defcustom org-allow-promoting-top-level-subtree nil - "When non-nil, allow promoting a top level subtree. -The leading star of the top level headline will be replaced -by a #." - :type 'boolean - :version "24.1" - :group 'org-appearance) - -(defun org-fontify-meta-lines-and-blocks (limit) - (condition-case nil - (org-fontify-meta-lines-and-blocks-1 limit) - (error (message "org-mode fontification error")))) - -(defun org-fontify-meta-lines-and-blocks-1 (limit) - "Fontify #+ lines and blocks." - (let ((case-fold-search t)) - (if (re-search-forward - "^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)" - limit t) - (let ((beg (match-beginning 0)) - (block-start (match-end 0)) - (block-end nil) - (lang (match-string 7)) - (beg1 (line-beginning-position 2)) - (dc1 (downcase (match-string 2))) - (dc3 (downcase (match-string 3))) - end end1 quoting block-type ovl) - (cond - ((member dc1 '("+html:" "+ascii:" "+latex:")) - ;; a single line of backend-specific content - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(display t invisible t intangible t)) - (add-text-properties (match-beginning 1) (match-end 3) - '(font-lock-fontified t face org-meta-line)) - (add-text-properties (match-beginning 6) (+ (match-end 6) 1) - '(font-lock-fontified t face org-block)) - ; for backend-specific code - t) - ((and (match-end 4) (equal dc3 "+begin")) - ;; Truly a block - (setq block-type (downcase (match-string 5)) - quoting (member block-type org-protecting-blocks)) - (when (re-search-forward - (concat "^[ \t]*#\\+end" (match-string 4) "\\>.*") - nil t) ;; on purpose, we look further than LIMIT - (setq end (min (point-max) (match-end 0)) - end1 (min (point-max) (1- (match-beginning 0)))) - (setq block-end (match-beginning 0)) - (when quoting - (remove-text-properties beg end - '(display t invisible t intangible t))) - (add-text-properties - beg end - '(font-lock-fontified t font-lock-multiline t)) - (add-text-properties beg beg1 '(face org-meta-line)) - (add-text-properties end1 (min (point-max) (1+ end)) - '(face org-meta-line)) ; for end_src - (cond - ((and lang (not (string= lang "")) org-src-fontify-natively) - (org-src-font-lock-fontify-block lang block-start block-end) - ;; remove old background overlays - (mapc (lambda (ov) - (if (eq (overlay-get ov 'face) 'org-block-background) - (delete-overlay ov))) - (overlays-at (/ (+ beg1 block-end) 2))) - ;; add a background overlay - (setq ovl (make-overlay beg1 block-end)) - (overlay-put ovl 'face 'org-block-background) - (overlay-put ovl 'evaporate t)) ;; make it go away when empty - (quoting - (add-text-properties beg1 (min (point-max) (1+ end1)) - '(face org-block))) ; end of source block - ((not org-fontify-quote-and-verse-blocks)) - ((string= block-type "quote") - (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-quote))) - ((string= block-type "verse") - (add-text-properties beg1 (min (point-max) (1+ end1)) '(face org-verse)))) - (add-text-properties beg beg1 '(face org-block-begin-line)) - (add-text-properties (min (point-max) (1+ end)) (min (point-max) (1+ end1)) - '(face org-block-end-line)) - t)) - ((member dc1 '("+title:" "+author:" "+email:" "+date:")) - (add-text-properties - beg (match-end 3) - (if (member (intern (substring dc1 0 -1)) org-hidden-keywords) - '(font-lock-fontified t invisible t) - '(font-lock-fontified t face org-document-info-keyword))) - (add-text-properties - (match-beginning 6) (min (point-max) (1+ (match-end 6))) - (if (string-equal dc1 "+title:") - '(font-lock-fontified t face org-document-title) - '(font-lock-fontified t face org-document-info)))) - ((or (equal dc1 "+results") - (member dc1 '("+begin:" "+end:" "+caption:" "+label:" - "+orgtbl:" "+tblfm:" "+tblname:" "+results:" - "+call:" "+header:" "+headers:" "+name:")) - (and (match-end 4) (equal dc3 "+attr"))) - (add-text-properties - beg (match-end 0) - '(font-lock-fontified t face org-meta-line)) - t) - ((member dc3 '(" " "")) - (add-text-properties - beg (match-end 0) - '(font-lock-fontified t face font-lock-comment-face))) - ((not (member (char-after beg) '(?\ ?\t))) - ;; just any other in-buffer setting, but not indented - (add-text-properties - beg (match-end 0) - '(font-lock-fontified t face org-meta-line)) - t) - (t nil)))))) - -(defun org-activate-angle-links (limit) - "Run through the buffer and add overlays to links." - (if (and (re-search-forward org-angle-link-re limit t) - (not (org-in-src-block-p))) - (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'keymap org-mouse-map)) - (org-rear-nonsticky-at (match-end 0)) - t))) - -(defun org-activate-footnote-links (limit) - "Run through the buffer and add overlays to footnotes." - (let ((fn (org-footnote-next-reference-or-definition limit))) - (when fn - (let ((beg (nth 1 fn)) (end (nth 2 fn))) - (org-remove-flyspell-overlays-in beg end) - (add-text-properties beg end - (list 'mouse-face 'highlight - 'keymap org-mouse-map - 'help-echo - (if (= (point-at-bol) beg) - "Footnote definition" - "Footnote reference") - 'font-lock-fontified t - 'font-lock-multiline t - 'face 'org-footnote)))))) - -(defun org-activate-bracket-links (limit) - "Run through the buffer and add overlays to bracketed links." - (if (and (re-search-forward org-bracket-link-regexp limit t) - (not (org-in-src-block-p))) - (let* ((hl (org-match-string-no-properties 1)) - (help (concat "LINK: " (save-match-data (org-link-unescape hl)))) - (ip (org-maybe-intangible - (list 'invisible 'org-link - 'keymap org-mouse-map 'mouse-face 'highlight - 'font-lock-multiline t 'help-echo help - 'htmlize-link `(:uri ,hl)))) - (vp (list 'keymap org-mouse-map 'mouse-face 'highlight - 'font-lock-multiline t 'help-echo help - 'htmlize-link `(:uri ,hl)))) - ;; We need to remove the invisible property here. Table narrowing - ;; may have made some of this invisible. - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (remove-text-properties (match-beginning 0) (match-end 0) - '(invisible nil)) - (if (match-end 3) - (progn - (add-text-properties (match-beginning 0) (match-beginning 3) ip) - (org-rear-nonsticky-at (match-beginning 3)) - (add-text-properties (match-beginning 3) (match-end 3) vp) - (org-rear-nonsticky-at (match-end 3)) - (add-text-properties (match-end 3) (match-end 0) ip) - (org-rear-nonsticky-at (match-end 0))) - (add-text-properties (match-beginning 0) (match-beginning 1) ip) - (org-rear-nonsticky-at (match-beginning 1)) - (add-text-properties (match-beginning 1) (match-end 1) vp) - (org-rear-nonsticky-at (match-end 1)) - (add-text-properties (match-end 1) (match-end 0) ip) - (org-rear-nonsticky-at (match-end 0))) - t))) - -(defun org-activate-dates (limit) - "Run through the buffer and add overlays to dates." - (if (and (re-search-forward org-tsr-regexp-both limit t) - (not (equal (char-before (match-beginning 0)) 91))) - (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'keymap org-mouse-map)) - (org-rear-nonsticky-at (match-end 0)) - (when org-display-custom-times - (if (match-end 3) - (org-display-custom-time (match-beginning 3) (match-end 3))) - (org-display-custom-time (match-beginning 1) (match-end 1))) - t))) - -(defvar org-target-link-regexp nil - "Regular expression matching radio targets in plain text.") -(make-variable-buffer-local 'org-target-link-regexp) -(defvar org-target-regexp "<<\\([^<>\n\r]+\\)>>" - "Regular expression matching a link target.") -(defvar org-radio-target-regexp "<<<\\([^<>\n\r]+\\)>>>" - "Regular expression matching a radio target.") -(defvar org-any-target-regexp "<<<?\\([^<>\n\r]+\\)>>>?" ; FIXME, not exact, would match <<<aaa>> as a radio target. - "Regular expression matching any target.") - -(defun org-activate-target-links (limit) - "Run through the buffer and add overlays to target matches." - (when org-target-link-regexp - (let ((case-fold-search t)) - (if (re-search-forward org-target-link-regexp limit t) - (progn - (org-remove-flyspell-overlays-in (match-beginning 0) (match-end 0)) - (add-text-properties (match-beginning 0) (match-end 0) - (list 'mouse-face 'highlight - 'keymap org-mouse-map - 'help-echo "Radio target link" - 'org-linked-text t)) - (org-rear-nonsticky-at (match-end 0)) - t))))) - -(defun org-update-radio-target-regexp () - "Find all radio targets in this file and update the regular expression." - (interactive) - (when (memq 'radio org-activate-links) - (setq org-target-link-regexp - (org-make-target-link-regexp (org-all-targets 'radio))) - (org-restart-font-lock))) - -(defun org-hide-wide-columns (limit) - (let (s e) - (setq s (text-property-any (point) (or limit (point-max)) - 'org-cwidth t)) - (when s - (setq e (next-single-property-change s 'org-cwidth)) - (add-text-properties s e (org-maybe-intangible '(invisible org-cwidth))) - (goto-char e) - t))) - -(defvar org-latex-and-related-regexp nil - "Regular expression for highlighting LaTeX, entities and sub/superscript.") -(defvar org-match-substring-regexp) -(defvar org-match-substring-with-braces-regexp) - -(defun org-compute-latex-and-related-regexp () - "Compute regular expression for LaTeX, entities and sub/superscript. -Result depends on variable `org-highlight-latex-and-related'." - (org-set-local - 'org-latex-and-related-regexp - (let* ((re-sub - (cond ((not (memq 'script org-highlight-latex-and-related)) nil) - ((eq org-use-sub-superscripts '{}) - (list org-match-substring-with-braces-regexp)) - (org-use-sub-superscripts (list org-match-substring-regexp)))) - (re-latex - (when (memq 'latex org-highlight-latex-and-related) - (let ((matchers (plist-get org-format-latex-options :matchers))) - (delq nil - (mapcar (lambda (x) - (and (member (car x) matchers) (nth 1 x))) - org-latex-regexps))))) - (re-entities - (when (memq 'entities org-highlight-latex-and-related) - (list "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")))) - (mapconcat 'identity (append re-latex re-entities re-sub) "\\|")))) - -(defun org-do-latex-and-related (limit) - "Highlight LaTeX snippets and environments, entities and sub/superscript. -LIMIT bounds the search for syntax to highlight. Stop at first -highlighted object, if any. Return t if some highlighting was -done, nil otherwise." - (when (org-string-nw-p org-latex-and-related-regexp) - (catch 'found - (while (re-search-forward org-latex-and-related-regexp limit t) - (unless (memq (car-safe (get-text-property (1+ (match-beginning 0)) - 'face)) - '(org-code org-verbatim underline)) - (let ((offset (if (memq (char-after (1+ (match-beginning 0))) - '(?_ ?^)) - 1 - 0))) - (font-lock-prepend-text-property - (+ offset (match-beginning 0)) (match-end 0) - 'face 'org-latex-and-related) - (add-text-properties (+ offset (match-beginning 0)) (match-end 0) - '(font-lock-multiline t))) - (throw 'found t))) - nil))) - -(defun org-restart-font-lock () - "Restart `font-lock-mode', to force refontification." - (when (and (boundp 'font-lock-mode) font-lock-mode) - (font-lock-mode -1) - (font-lock-mode 1))) - -(defun org-all-targets (&optional radio) - "Return a list of all targets in this file. -When optional argument RADIO is non-nil, only find radio -targets." - (let ((re (if radio org-radio-target-regexp org-target-regexp)) rtn) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward re nil t) - ;; Make sure point is really within the object. - (backward-char) - (let ((obj (org-element-context))) - (when (memq (org-element-type obj) '(radio-target target)) - (add-to-list 'rtn (downcase (org-element-property :value obj)))))) - rtn))) - -(defun org-make-target-link-regexp (targets) - "Make regular expression matching all strings in TARGETS. -The regular expression finds the targets also if there is a line break -between words." - (and targets - (concat - "\\<\\(" - (mapconcat - (lambda (x) - (setq x (regexp-quote x)) - (while (string-match " +" x) - (setq x (replace-match "\\s-+" t t x))) - x) - targets - "\\|") - "\\)\\>"))) - -(defun org-activate-tags (limit) - (if (re-search-forward (org-re "^\\*+.*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \r\n]") limit t) - (progn - (org-remove-flyspell-overlays-in (match-beginning 1) (match-end 1)) - (add-text-properties (match-beginning 1) (match-end 1) - (list 'mouse-face 'highlight - 'keymap org-mouse-map)) - (org-rear-nonsticky-at (match-end 1)) - t))) - -(defun org-outline-level () - "Compute the outline level of the heading at point. -If this is called at a normal headline, the level is the number of stars. -Use `org-reduced-level' to remove the effect of `org-odd-levels'." - (save-excursion - (if (not (condition-case nil - (org-back-to-heading t) - (error nil))) - 0 - (looking-at org-outline-regexp) - (1- (- (match-end 0) (match-beginning 0)))))) - -(defvar org-font-lock-keywords nil) - -(defsubst org-re-property (property &optional literal) - "Return a regexp matching a PROPERTY line. -Match group 3 will be set to the value if it exists." - (concat "^\\(?4:[ \t]*\\)\\(?1::\\(?2:" - (if literal property (regexp-quote property)) - "\\):\\)[ \t]+\\(?3:[^ \t\r\n].*?\\)\\(?5:[ \t]*\\)$")) - -(defconst org-property-re - (org-re-property ".*?" 'literal) - "Regular expression matching a property line. -There are four matching groups: -1: :PROPKEY: including the leading and trailing colon, -2: PROPKEY without the leading and trailing colon, -3: PROPVAL without leading or trailing spaces, -4: the indentation of the current line, -5: trailing whitespace.") - -(defvar org-font-lock-hook nil - "Functions to be called for special font lock stuff.") - -(defvar org-font-lock-set-keywords-hook nil - "Functions that can manipulate `org-font-lock-extra-keywords'. -This is called after `org-font-lock-extra-keywords' is defined, but before -it is installed to be used by font lock. This can be useful if something -needs to be inserted at a specific position in the font-lock sequence.") - -(defun org-font-lock-hook (limit) - "Run `org-font-lock-hook' within LIMIT." - (run-hook-with-args 'org-font-lock-hook limit)) - -(defun org-set-font-lock-defaults () - "Set font lock defaults for the current buffer." - (let* ((em org-fontify-emphasized-text) - (lk org-activate-links) - (org-font-lock-extra-keywords - (list - ;; Call the hook - '(org-font-lock-hook) - ;; Headlines - `(,(if org-fontify-whole-heading-line - "^\\(\\**\\)\\(\\* \\)\\(.*\n?\\)" - "^\\(\\**\\)\\(\\* \\)\\(.*\\)") - (1 (org-get-level-face 1)) - (2 (org-get-level-face 2)) - (3 (org-get-level-face 3))) - ;; Table lines - '("^[ \t]*\\(\\(|\\|\\+-[-+]\\).*\\S-\\)" - (1 'org-table t)) - ;; Table internals - '("^[ \t]*|\\(?:.*?|\\)? *\\(:?=[^|\n]*\\)" (1 'org-formula t)) - '("^[ \t]*| *\\([#*]\\) *|" (1 'org-formula t)) - '("^[ \t]*|\\( *\\([$!_^/]\\) *|.*\\)|" (1 'org-formula t)) - '("| *\\(<[lrc]?[0-9]*>\\)" (1 'org-formula t)) - ;; Drawers - (list org-drawer-regexp '(0 'org-special-keyword t)) - (list "^[ \t]*:END:" '(0 'org-special-keyword t)) - ;; Properties - (list org-property-re - '(1 'org-special-keyword t) - '(3 'org-property-value t)) - ;; Links - (if (memq 'tag lk) '(org-activate-tags (1 'org-tag prepend))) - (if (memq 'angle lk) '(org-activate-angle-links (0 'org-link t))) - (if (memq 'plain lk) '(org-activate-plain-links (0 'org-link t))) - (if (memq 'bracket lk) '(org-activate-bracket-links (0 'org-link t))) - (if (memq 'radio lk) '(org-activate-target-links (0 'org-link t))) - (if (memq 'date lk) '(org-activate-dates (0 'org-date t))) - (if (memq 'footnote lk) '(org-activate-footnote-links)) - ;; Targets. - (list org-any-target-regexp '(0 'org-target t)) - ;; Diary sexps. - '("^&?%%(.*\\|<%%([^>\n]*?>" (0 'org-sexp-date t)) - ;; Macro - '("{{{.+}}}" (0 'org-macro t)) - '(org-hide-wide-columns (0 nil append)) - ;; TODO keyword - (list (format org-heading-keyword-regexp-format - org-todo-regexp) - '(2 (org-get-todo-face 2) t)) - ;; DONE - (if org-fontify-done-headline - (list (format org-heading-keyword-regexp-format - (concat - "\\(?:" - (mapconcat 'regexp-quote org-done-keywords "\\|") - "\\)")) - '(2 'org-headline-done t)) - nil) - ;; Priorities - '(org-font-lock-add-priority-faces) - ;; Tags - '(org-font-lock-add-tag-faces) - ;; Tags groups - (if (and org-group-tags org-tag-groups-alist) - (list (concat org-outline-regexp-bol ".+\\(:" - (regexp-opt (mapcar 'car org-tag-groups-alist)) - ":\\).*$") - '(1 'org-tag-group prepend))) - ;; Special keywords - (list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t)) - (list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t)) - (list (concat "\\<" org-closed-string) '(0 'org-special-keyword t)) - (list (concat "\\<" org-clock-string) '(0 'org-special-keyword t)) - ;; Emphasis - (if em - (if (featurep 'xemacs) - '(org-do-emphasis-faces (0 nil append)) - '(org-do-emphasis-faces))) - ;; Checkboxes - '("^[ \t]*\\(?:[-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)" - 1 'org-checkbox prepend) - (if (cdr (assq 'checkbox org-list-automatic-rules)) - '("\\[\\([0-9]*%\\)\\]\\|\\[\\([0-9]*\\)/\\([0-9]*\\)\\]" - (0 (org-get-checkbox-statistics-face) t))) - ;; Description list items - '("^[ \t]*[-+*][ \t]+\\(.*?[ \t]+::\\)\\([ \t]+\\|$\\)" - 1 'org-list-dt prepend) - ;; ARCHIVEd headings - (list (concat - org-outline-regexp-bol - "\\(.*:" org-archive-tag ":.*\\)") - '(1 'org-archived prepend)) - ;; Specials - '(org-do-latex-and-related) - '(org-fontify-entities) - '(org-raise-scripts) - ;; Code - '(org-activate-code (1 'org-code t)) - ;; COMMENT - (list (format org-heading-keyword-regexp-format - (concat "\\(" - org-comment-string "\\|" org-quote-string - "\\)")) - '(2 'org-special-keyword t)) - ;; Blocks and meta lines - '(org-fontify-meta-lines-and-blocks)))) - (setq org-font-lock-extra-keywords (delq nil org-font-lock-extra-keywords)) - (run-hooks 'org-font-lock-set-keywords-hook) - ;; Now set the full font-lock-keywords - (org-set-local 'org-font-lock-keywords org-font-lock-extra-keywords) - (org-set-local 'font-lock-defaults - '(org-font-lock-keywords t nil nil backward-paragraph)) - (kill-local-variable 'font-lock-keywords) nil)) - -(defun org-toggle-pretty-entities () - "Toggle the composition display of entities as UTF8 characters." - (interactive) - (org-set-local 'org-pretty-entities (not org-pretty-entities)) - (org-restart-font-lock) - (if org-pretty-entities - (message "Entities are now displayed as UTF8 characters") - (save-restriction - (widen) - (org-decompose-region (point-min) (point-max)) - (message "Entities are now displayed as plain text")))) - -(defvar org-custom-properties-overlays nil - "List of overlays used for custom properties.") -(make-variable-buffer-local 'org-custom-properties-overlays) - -(defun org-toggle-custom-properties-visibility () - "Display or hide properties in `org-custom-properties'." - (interactive) - (if org-custom-properties-overlays - (progn (mapc 'delete-overlay org-custom-properties-overlays) - (setq org-custom-properties-overlays nil)) - (unless (not org-custom-properties) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward org-property-re nil t) - (mapc (lambda(p) - (when (equal p (substring (match-string 1) 1 -1)) - (let ((o (make-overlay (match-beginning 0) (1+ (match-end 0))))) - (overlay-put o 'invisible t) - (overlay-put o 'org-custom-property t) - (push o org-custom-properties-overlays)))) - org-custom-properties))))))) - -(defun org-fontify-entities (limit) - "Find an entity to fontify." - (let (ee) - (when org-pretty-entities - (catch 'match - (while (re-search-forward - "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]\n]\\)" - limit t) - (if (and (not (org-in-indented-comment-line)) - (setq ee (org-entity-get (match-string 1))) - (= (length (nth 6 ee)) 1)) - (let* - ((end (if (equal (match-string 2) "{}") - (match-end 2) - (match-end 1)))) - (add-text-properties - (match-beginning 0) end - (list 'font-lock-fontified t)) - (compose-region (match-beginning 0) end - (nth 6 ee) nil) - (backward-char 1) - (throw 'match t)))) - nil)))) - -(defun org-fontify-like-in-org-mode (s &optional odd-levels) - "Fontify string S like in Org-mode." - (with-temp-buffer - (insert s) - (let ((org-odd-levels-only odd-levels)) - (org-mode) - (font-lock-fontify-buffer) - (buffer-string)))) - -(defvar org-m nil) -(defvar org-l nil) -(defvar org-f nil) -(defun org-get-level-face (n) - "Get the right face for match N in font-lock matching of headlines." - (setq org-l (- (match-end 2) (match-beginning 1) 1)) - (if org-odd-levels-only (setq org-l (1+ (/ org-l 2)))) - (if org-cycle-level-faces - (setq org-f (nth (% (1- org-l) org-n-level-faces) org-level-faces)) - (setq org-f (nth (1- (min org-l org-n-level-faces)) org-level-faces))) - (cond - ((eq n 1) (if org-hide-leading-stars 'org-hide org-f)) - ((eq n 2) org-f) - (t (if org-level-color-stars-only nil org-f)))) - - -(defun org-get-todo-face (kwd) - "Get the right face for a TODO keyword KWD. -If KWD is a number, get the corresponding match group." - (if (numberp kwd) (setq kwd (match-string kwd))) - (or (org-face-from-face-or-color - 'todo 'org-todo (cdr (assoc kwd org-todo-keyword-faces))) - (and (member kwd org-done-keywords) 'org-done) - 'org-todo)) - -(defun org-face-from-face-or-color (context inherit face-or-color) - "Create a face list that inherits INHERIT, but sets the foreground color. -When FACE-OR-COLOR is not a string, just return it." - (if (stringp face-or-color) - (list :inherit inherit - (cdr (assoc context org-faces-easy-properties)) - face-or-color) - face-or-color)) - -(defun org-font-lock-add-tag-faces (limit) - "Add the special tag faces." - (when (and org-tag-faces org-tags-special-faces-re) - (while (re-search-forward org-tags-special-faces-re limit t) - (add-text-properties (match-beginning 1) (match-end 1) - (list 'face (org-get-tag-face 1) - 'font-lock-fontified t)) - (backward-char 1)))) - -(defun org-font-lock-add-priority-faces (limit) - "Add the special priority faces." - (while (re-search-forward "\\[#\\([A-Z0-9]\\)\\]" limit t) - (when (save-match-data (org-at-heading-p)) - (add-text-properties - (match-beginning 0) (match-end 0) - (list 'face (or (org-face-from-face-or-color - 'priority 'org-priority - (cdr (assoc (char-after (match-beginning 1)) - org-priority-faces))) - 'org-priority) - 'font-lock-fontified t))))) - -(defun org-get-tag-face (kwd) - "Get the right face for a TODO keyword KWD. -If KWD is a number, get the corresponding match group." - (if (numberp kwd) (setq kwd (match-string kwd))) - (or (org-face-from-face-or-color - 'tag 'org-tag (cdr (assoc kwd org-tag-faces))) - 'org-tag)) - -(defun org-unfontify-region (beg end &optional maybe_loudly) - "Remove fontification and activation overlays from links." - (font-lock-default-unfontify-region beg end) - (let* ((buffer-undo-list t) - (inhibit-read-only t) (inhibit-point-motion-hooks t) - (inhibit-modification-hooks t) - deactivate-mark buffer-file-name buffer-file-truename) - (org-decompose-region beg end) - (remove-text-properties beg end - '(mouse-face t keymap t org-linked-text t - invisible t intangible t - org-no-flyspell t org-emphasis t)) - (org-remove-font-lock-display-properties beg end))) - -(defconst org-script-display '(((raise -0.3) (height 0.7)) - ((raise 0.3) (height 0.7)) - ((raise -0.5)) - ((raise 0.5))) - "Display properties for showing superscripts and subscripts.") - -(defun org-remove-font-lock-display-properties (beg end) - "Remove specific display properties that have been added by font lock. -The will remove the raise properties that are used to show superscripts -and subscripts." - (let (next prop) - (while (< beg end) - (setq next (next-single-property-change beg 'display nil end) - prop (get-text-property beg 'display)) - (if (member prop org-script-display) - (put-text-property beg next 'display nil)) - (setq beg next)))) - -(defun org-raise-scripts (limit) - "Add raise properties to sub/superscripts." - (when (and org-pretty-entities org-pretty-entities-include-sub-superscripts) - (if (re-search-forward - (if (eq org-use-sub-superscripts t) - org-match-substring-regexp - org-match-substring-with-braces-regexp) - limit t) - (let* ((pos (point)) table-p comment-p - (mpos (match-beginning 3)) - (emph-p (get-text-property mpos 'org-emphasis)) - (link-p (get-text-property mpos 'mouse-face)) - (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face)))) - (goto-char (point-at-bol)) - (setq table-p (org-looking-at-p org-table-dataline-regexp) - comment-p (org-looking-at-p "^[ \t]*#[ +]")) - (goto-char pos) - ;; Handle a_b^c - (if (member (char-after) '(?_ ?^)) (goto-char (1- pos))) - (if (or comment-p emph-p link-p keyw-p) - t - (put-text-property (match-beginning 3) (match-end 0) - 'display - (if (equal (char-after (match-beginning 2)) ?^) - (nth (if table-p 3 1) org-script-display) - (nth (if table-p 2 0) org-script-display))) - (add-text-properties (match-beginning 2) (match-end 2) - (list 'invisible t - 'org-dwidth t 'org-dwidth-n 1)) - (if (and (eq (char-after (match-beginning 3)) ?{) - (eq (char-before (match-end 3)) ?})) - (progn - (add-text-properties - (match-beginning 3) (1+ (match-beginning 3)) - (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)) - (add-text-properties - (1- (match-end 3)) (match-end 3) - (list 'invisible t 'org-dwidth t 'org-dwidth-n 1)))) - t))))) - -;;;; Visibility cycling, including org-goto and indirect buffer - -;;; Cycling - -(defvar org-cycle-global-status nil) -(make-variable-buffer-local 'org-cycle-global-status) -(put 'org-cycle-global-status 'org-state t) -(defvar org-cycle-subtree-status nil) -(make-variable-buffer-local 'org-cycle-subtree-status) -(put 'org-cycle-subtree-status 'org-state t) - -(defvar org-inlinetask-min-level) - -(defun org-unlogged-message (&rest args) - "Display a message, but avoid logging it in the *Messages* buffer." - (let ((message-log-max nil)) - (apply 'message args))) - -;;;###autoload -(defun org-cycle (&optional arg) - "TAB-action and visibility cycling for Org-mode. - -This is the command invoked in Org-mode by the TAB key. Its main purpose -is outline visibility cycling, but it also invokes other actions -in special contexts. - -- When this function is called with a prefix argument, rotate the entire - buffer through 3 states (global cycling) - 1. OVERVIEW: Show only top-level headlines. - 2. CONTENTS: Show all headlines of all levels, but no body text. - 3. SHOW ALL: Show everything. - When called with two `C-u C-u' prefixes, switch to the startup visibility, - determined by the variable `org-startup-folded', and by any VISIBILITY - properties in the buffer. - When called with three `C-u C-u C-u' prefixed, show the entire buffer, - including any drawers. - -- When inside a table, re-align the table and move to the next field. - -- When point is at the beginning of a headline, rotate the subtree started - by this line through 3 different states (local cycling) - 1. FOLDED: Only the main headline is shown. - 2. CHILDREN: The main headline and the direct children are shown. - From this state, you can move to one of the children - and zoom in further. - 3. SUBTREE: Show the entire subtree, including body text. - If there is no subtree, switch directly from CHILDREN to FOLDED. - -- When point is at the beginning of an empty headline and the variable - `org-cycle-level-after-item/entry-creation' is set, cycle the level - of the headline by demoting and promoting it to likely levels. This - speeds up creation document structure by pressing TAB once or several - times right after creating a new headline. - -- When there is a numeric prefix, go up to a heading with level ARG, do - a `show-subtree' and return to the previous cursor position. If ARG - is negative, go up that many levels. - -- When point is not at the beginning of a headline, execute the global - binding for TAB, which is re-indenting the line. See the option - `org-cycle-emulate-tab' for details. - -- Special case: if point is at the beginning of the buffer and there is - no headline in line 1, this function will act as if called with prefix arg - (C-u TAB, same as S-TAB) also when called without prefix arg. - But only if also the variable `org-cycle-global-at-bob' is t." - (interactive "P") - (org-load-modules-maybe) - (unless (or (run-hook-with-args-until-success 'org-tab-first-hook) - (and org-cycle-level-after-item/entry-creation - (or (org-cycle-level) - (org-cycle-item-indentation)))) - (let* ((limit-level - (or org-cycle-max-level - (and (boundp 'org-inlinetask-min-level) - org-inlinetask-min-level - (1- org-inlinetask-min-level)))) - (nstars (and limit-level - (if org-odd-levels-only - (and limit-level (1- (* limit-level 2))) - limit-level))) - (org-outline-regexp - (if (not (derived-mode-p 'org-mode)) - outline-regexp - (concat "\\*" (if nstars (format "\\{1,%d\\} " nstars) "+ ")))) - (bob-special (and org-cycle-global-at-bob (not arg) (bobp) - (not (looking-at org-outline-regexp)))) - (org-cycle-hook - (if bob-special - (delq 'org-optimize-window-after-visibility-change - (copy-sequence org-cycle-hook)) - org-cycle-hook)) - (pos (point))) - - (if (or bob-special (equal arg '(4))) - ;; special case: use global cycling - (setq arg t)) - - (cond - - ((equal arg '(16)) - (setq last-command 'dummy) - (org-set-startup-visibility) - (org-unlogged-message "Startup visibility, plus VISIBILITY properties")) - - ((equal arg '(64)) - (show-all) - (org-unlogged-message "Entire buffer visible, including drawers")) - - ;; Table: enter it or move to the next field. - ((org-at-table-p 'any) - (if (org-at-table.el-p) - (message "Use C-c ' to edit table.el tables") - (if arg (org-table-edit-field t) - (org-table-justify-field-maybe) - (call-interactively 'org-table-next-field)))) - - ((run-hook-with-args-until-success - 'org-tab-after-check-for-table-hook)) - - ;; Global cycling: delegate to `org-cycle-internal-global'. - ((eq arg t) (org-cycle-internal-global)) - - ;; Drawers: delegate to `org-flag-drawer'. - ((and org-drawers org-drawer-regexp - (save-excursion - (beginning-of-line 1) - (looking-at org-drawer-regexp))) - (org-flag-drawer ; toggle block visibility - (not (get-char-property (match-end 0) 'invisible)))) - - ;; Show-subtree, ARG levels up from here. - ((integerp arg) - (save-excursion - (org-back-to-heading) - (outline-up-heading (if (< arg 0) (- arg) - (- (funcall outline-level) arg))) - (org-show-subtree))) - - ;; Inline task: delegate to `org-inlinetask-toggle-visibility'. - ((and (featurep 'org-inlinetask) - (org-inlinetask-at-task-p) - (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) - (org-inlinetask-toggle-visibility)) - - ((org-try-cdlatex-tab)) - - ;; At an item/headline: delegate to `org-cycle-internal-local'. - ((and (or (and org-cycle-include-plain-lists (org-at-item-p)) - (save-excursion (beginning-of-line 1) - (looking-at org-outline-regexp))) - (or (bolp) (not (eq org-cycle-emulate-tab 'exc-hl-bol)))) - (org-cycle-internal-local)) - - ;; From there: TAB emulation and template completion. - (buffer-read-only (org-back-to-heading)) - - ((run-hook-with-args-until-success - 'org-tab-after-check-for-cycling-hook)) - - ((org-try-structure-completion)) - - ((run-hook-with-args-until-success - 'org-tab-before-tab-emulation-hook)) - - ((and (eq org-cycle-emulate-tab 'exc-hl-bol) - (or (not (bolp)) - (not (looking-at org-outline-regexp)))) - (call-interactively (global-key-binding "\t"))) - - ((if (and (memq org-cycle-emulate-tab '(white whitestart)) - (save-excursion (beginning-of-line 1) (looking-at "[ \t]*")) - (or (and (eq org-cycle-emulate-tab 'white) - (= (match-end 0) (point-at-eol))) - (and (eq org-cycle-emulate-tab 'whitestart) - (>= (match-end 0) pos)))) - t - (eq org-cycle-emulate-tab t)) - (call-interactively (global-key-binding "\t"))) - - (t (save-excursion - (org-back-to-heading) - (org-cycle))))))) - -(defun org-cycle-internal-global () - "Do the global cycling action." - ;; Hack to avoid display of messages for .org attachments in Gnus - (let ((ga (string-match "\\*fontification" (buffer-name)))) - (cond - ((and (eq last-command this-command) - (eq org-cycle-global-status 'overview)) - ;; We just created the overview - now do table of contents - ;; This can be slow in very large buffers, so indicate action - (run-hook-with-args 'org-pre-cycle-hook 'contents) - (unless ga (org-unlogged-message "CONTENTS...")) - (org-content) - (unless ga (org-unlogged-message "CONTENTS...done")) - (setq org-cycle-global-status 'contents) - (run-hook-with-args 'org-cycle-hook 'contents)) - - ((and (eq last-command this-command) - (eq org-cycle-global-status 'contents)) - ;; We just showed the table of contents - now show everything - (run-hook-with-args 'org-pre-cycle-hook 'all) - (show-all) - (unless ga (org-unlogged-message "SHOW ALL")) - (setq org-cycle-global-status 'all) - (run-hook-with-args 'org-cycle-hook 'all)) - - (t - ;; Default action: go to overview - (run-hook-with-args 'org-pre-cycle-hook 'overview) - (org-overview) - (unless ga (org-unlogged-message "OVERVIEW")) - (setq org-cycle-global-status 'overview) - (run-hook-with-args 'org-cycle-hook 'overview))))) - -(defvar org-called-with-limited-levels);Dyn-bound in ̀org-with-limited-levels'. - -(defun org-cycle-internal-local () - "Do the local cycling action." - (let ((goal-column 0) eoh eol eos has-children children-skipped struct) - ;; First, determine end of headline (EOH), end of subtree or item - ;; (EOS), and if item or heading has children (HAS-CHILDREN). - (save-excursion - (if (org-at-item-p) - (progn - (beginning-of-line) - (setq struct (org-list-struct)) - (setq eoh (point-at-eol)) - (setq eos (org-list-get-item-end-before-blank (point) struct)) - (setq has-children (org-list-has-child-p (point) struct))) - (org-back-to-heading) - (setq eoh (save-excursion (outline-end-of-heading) (point))) - (setq eos (save-excursion (1- (org-end-of-subtree t t)))) - (setq has-children - (or (save-excursion - (let ((level (funcall outline-level))) - (outline-next-heading) - (and (org-at-heading-p t) - (> (funcall outline-level) level)))) - (save-excursion - (org-list-search-forward (org-item-beginning-re) eos t))))) - ;; Determine end invisible part of buffer (EOL) - (beginning-of-line 2) - ;; XEmacs doesn't have `next-single-char-property-change' - (if (featurep 'xemacs) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (beginning-of-line 2)) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (goto-char (next-single-char-property-change (point) 'invisible)) - (and (eolp) (beginning-of-line 2)))) - (setq eol (point))) - ;; Find out what to do next and set `this-command' - (cond - ((= eos eoh) - ;; Nothing is hidden behind this heading - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-pre-cycle-hook 'empty)) - (org-unlogged-message "EMPTY ENTRY") - (setq org-cycle-subtree-status nil) - (save-excursion - (goto-char eos) - (outline-next-heading) - (if (outline-invisible-p) (org-flag-heading nil)))) - ((and (or (>= eol eos) - (not (string-match "\\S-" (buffer-substring eol eos)))) - (or has-children - (not (setq children-skipped - org-cycle-skip-children-state-if-no-children)))) - ;; Entire subtree is hidden in one line: children view - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-pre-cycle-hook 'children)) - (if (org-at-item-p) - (org-list-set-item-visibility (point-at-bol) struct 'children) - (org-show-entry) - (org-with-limited-levels (show-children)) - ;; FIXME: This slows down the func way too much. - ;; How keep drawers hidden in subtree anyway? - ;; (when (memq 'org-cycle-hide-drawers org-cycle-hook) - ;; (org-cycle-hide-drawers 'subtree)) - - ;; Fold every list in subtree to top-level items. - (when (eq org-cycle-include-plain-lists 'integrate) - (save-excursion - (org-back-to-heading) - (while (org-list-search-forward (org-item-beginning-re) eos t) - (beginning-of-line 1) - (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct)) - (end (org-list-get-bottom-point struct))) - (mapc (lambda (e) (org-list-set-item-visibility e struct 'folded)) - (org-list-get-all-items (point) struct prevs)) - (goto-char (if (< end eos) end eos))))))) - (org-unlogged-message "CHILDREN") - (save-excursion - (goto-char eos) - (outline-next-heading) - (if (outline-invisible-p) (org-flag-heading nil))) - (setq org-cycle-subtree-status 'children) - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-cycle-hook 'children))) - ((or children-skipped - (and (eq last-command this-command) - (eq org-cycle-subtree-status 'children))) - ;; We just showed the children, or no children are there, - ;; now show everything. - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-pre-cycle-hook 'subtree)) - (outline-flag-region eoh eos nil) - (org-unlogged-message - (if children-skipped "SUBTREE (NO CHILDREN)" "SUBTREE")) - (setq org-cycle-subtree-status 'subtree) - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-cycle-hook 'subtree))) - (t - ;; Default action: hide the subtree. - (run-hook-with-args 'org-pre-cycle-hook 'folded) - (outline-flag-region eoh eos t) - (org-unlogged-message "FOLDED") - (setq org-cycle-subtree-status 'folded) - (unless (org-before-first-heading-p) - (run-hook-with-args 'org-cycle-hook 'folded)))))) - -;;;###autoload -(defun org-global-cycle (&optional arg) - "Cycle the global visibility. For details see `org-cycle'. -With \\[universal-argument] prefix arg, switch to startup visibility. -With a numeric prefix, show all headlines up to that level." - (interactive "P") - (let ((org-cycle-include-plain-lists - (if (derived-mode-p 'org-mode) org-cycle-include-plain-lists nil))) - (cond - ((integerp arg) - (show-all) - (hide-sublevels arg) - (setq org-cycle-global-status 'contents)) - ((equal arg '(4)) - (org-set-startup-visibility) - (org-unlogged-message "Startup visibility, plus VISIBILITY properties.")) - (t - (org-cycle '(4)))))) - -(defun org-set-startup-visibility () - "Set the visibility required by startup options and properties." - (cond - ((eq org-startup-folded t) - (org-cycle '(4))) - ((eq org-startup-folded 'content) - (let ((this-command 'org-cycle) (last-command 'org-cycle)) - (org-cycle '(4)) (org-cycle '(4))))) - (unless (eq org-startup-folded 'showeverything) - (if org-hide-block-startup (org-hide-block-all)) - (org-set-visibility-according-to-property 'no-cleanup) - (org-cycle-hide-archived-subtrees 'all) - (org-cycle-hide-drawers 'all) - (org-cycle-show-empty-lines t))) - -(defun org-set-visibility-according-to-property (&optional no-cleanup) - "Switch subtree visibilities according to :VISIBILITY: property." - (interactive) - (let (org-show-entry-below state) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*:VISIBILITY:[ \t]+\\([a-z]+\\)" - nil t) - (setq state (match-string 1)) - (save-excursion - (org-back-to-heading t) - (hide-subtree) - (org-reveal) - (cond - ((equal state '("fold" "folded")) - (hide-subtree)) - ((equal state "children") - (org-show-hidden-entry) - (show-children)) - ((equal state "content") - (save-excursion - (save-restriction - (org-narrow-to-subtree) - (org-content)))) - ((member state '("all" "showall")) - (show-subtree))))) - (unless no-cleanup - (org-cycle-hide-archived-subtrees 'all) - (org-cycle-hide-drawers 'all) - (org-cycle-show-empty-lines 'all))))) - -;; This function uses outline-regexp instead of the more fundamental -;; org-outline-regexp so that org-cycle-global works outside of Org -;; buffers, where outline-regexp is needed. -(defun org-overview () - "Switch to overview mode, showing only top-level headlines. -Really, this shows all headlines with level equal or greater than the level -of the first headline in the buffer. This is important, because if the -first headline is not level one, then (hide-sublevels 1) gives confusing -results." - (interactive) - (let ((pos (point)) - (level (save-excursion - (goto-char (point-min)) - (if (re-search-forward (concat "^" outline-regexp) nil t) - (progn - (goto-char (match-beginning 0)) - (funcall outline-level)))))) - (and level (hide-sublevels level)) - (recenter '(4)) - (goto-char pos))) - -(defun org-content (&optional arg) - "Show all headlines in the buffer, like a table of contents. -With numerical argument N, show content up to level N." - (interactive "P") - (save-excursion - ;; Visit all headings and show their offspring - (and (integerp arg) (org-overview)) - (goto-char (point-max)) - (catch 'exit - (while (and (progn (condition-case nil - (outline-previous-visible-heading 1) - (error (goto-char (point-min)))) - t) - (looking-at org-outline-regexp)) - (if (integerp arg) - (show-children (1- arg)) - (show-branches)) - (if (bobp) (throw 'exit nil)))))) - - -(defun org-optimize-window-after-visibility-change (state) - "Adjust the window after a change in outline visibility. -This function is the default value of the hook `org-cycle-hook'." - (when (get-buffer-window (current-buffer)) - (cond - ((eq state 'content) nil) - ((eq state 'all) nil) - ((eq state 'folded) nil) - ((eq state 'children) (or (org-subtree-end-visible-p) (recenter 1))) - ((eq state 'subtree) (or (org-subtree-end-visible-p) (recenter 1)))))) - -(defun org-remove-empty-overlays-at (pos) - "Remove outline overlays that do not contain non-white stuff." - (mapc - (lambda (o) - (and (eq 'outline (overlay-get o 'invisible)) - (not (string-match "\\S-" (buffer-substring (overlay-start o) - (overlay-end o)))) - (delete-overlay o))) - (overlays-at pos))) - -(defun org-clean-visibility-after-subtree-move () - "Fix visibility issues after moving a subtree." - ;; First, find a reasonable region to look at: - ;; Start two siblings above, end three below - (let* ((beg (save-excursion - (and (org-get-last-sibling) - (org-get-last-sibling)) - (point))) - (end (save-excursion - (and (org-get-next-sibling) - (org-get-next-sibling) - (org-get-next-sibling)) - (if (org-at-heading-p) - (point-at-eol) - (point)))) - (level (looking-at "\\*+")) - (re (if level (concat "^" (regexp-quote (match-string 0)) " ")))) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (when re - ;; Properly fold already folded siblings - (goto-char (point-min)) - (while (re-search-forward re nil t) - (if (and (not (outline-invisible-p)) - (save-excursion - (goto-char (point-at-eol)) (outline-invisible-p))) - (hide-entry)))) - (org-cycle-show-empty-lines 'overview) - (org-cycle-hide-drawers 'overview))))) - -(defun org-cycle-show-empty-lines (state) - "Show empty lines above all visible headlines. -The region to be covered depends on STATE when called through -`org-cycle-hook'. Lisp program can use t for STATE to get the -entire buffer covered. Note that an empty line is only shown if there -are at least `org-cycle-separator-lines' empty lines before the headline." - (when (not (= org-cycle-separator-lines 0)) - (save-excursion - (let* ((n (abs org-cycle-separator-lines)) - (re (cond - ((= n 1) "\\(\n[ \t]*\n\\*+\\) ") - ((= n 2) "^[ \t]*\\(\n[ \t]*\n\\*+\\) ") - (t (let ((ns (number-to-string (- n 2)))) - (concat "^\\(?:[ \t]*\n\\)\\{" ns "," ns "\\}" - "[ \t]*\\(\n[ \t]*\n\\*+\\) "))))) - beg end b e) - (cond - ((memq state '(overview contents t)) - (setq beg (point-min) end (point-max))) - ((memq state '(children folded)) - (setq beg (point) end (progn (org-end-of-subtree t t) - (beginning-of-line 2) - (point))))) - (when beg - (goto-char beg) - (while (re-search-forward re end t) - (unless (get-char-property (match-end 1) 'invisible) - (setq e (match-end 1)) - (if (< org-cycle-separator-lines 0) - (setq b (save-excursion - (goto-char (match-beginning 0)) - (org-back-over-empty-lines) - (if (save-excursion - (goto-char (max (point-min) (1- (point)))) - (org-at-heading-p)) - (1- (point)) - (point)))) - (setq b (match-beginning 1))) - (outline-flag-region b e nil))))))) - ;; Never hide empty lines at the end of the file. - (save-excursion - (goto-char (point-max)) - (outline-previous-heading) - (outline-end-of-heading) - (if (and (looking-at "[ \t\n]+") - (= (match-end 0) (point-max))) - (outline-flag-region (point) (match-end 0) nil)))) - -(defun org-show-empty-lines-in-parent () - "Move to the parent and re-show empty lines before visible headlines." - (save-excursion - (let ((context (if (org-up-heading-safe) 'children 'overview))) - (org-cycle-show-empty-lines context)))) - -(defun org-files-list () - "Return `org-agenda-files' list, plus all open org-mode files. -This is useful for operations that need to scan all of a user's -open and agenda-wise Org files." - (let ((files (mapcar 'expand-file-name (org-agenda-files)))) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (if (and (derived-mode-p 'org-mode) (buffer-file-name)) - (let ((file (expand-file-name (buffer-file-name)))) - (unless (member file files) - (push file files)))))) - files)) - -(defsubst org-entry-beginning-position () - "Return the beginning position of the current entry." - (save-excursion (outline-back-to-heading t) (point))) - -(defsubst org-entry-end-position () - "Return the end position of the current entry." - (save-excursion (outline-next-heading) (point))) - -(defun org-cycle-hide-drawers (state) - "Re-hide all drawers after a visibility state change." - (when (and (derived-mode-p 'org-mode) - (not (memq state '(overview folded contents)))) - (save-excursion - (let* ((globalp (memq state '(contents all))) - (beg (if globalp (point-min) (point))) - (end (if globalp (point-max) - (if (eq state 'children) - (save-excursion (outline-next-heading) (point)) - (org-end-of-subtree t))))) - (goto-char beg) - (while (re-search-forward org-drawer-regexp end t) - (org-flag-drawer t)))))) - -(defun org-cycle-hide-inline-tasks (state) - "Re-hide inline tasks when switching to 'contents or 'children -visibility state." - (case state - (contents - (when (org-bound-and-true-p org-inlinetask-min-level) - (hide-sublevels (1- org-inlinetask-min-level)))) - (children - (when (featurep 'org-inlinetask) - (save-excursion - (while (and (outline-next-heading) - (org-inlinetask-at-task-p)) - (org-inlinetask-toggle-visibility) - (org-inlinetask-goto-end))))))) - -(defun org-flag-drawer (flag) - "When FLAG is non-nil, hide the drawer we are within. -Otherwise make it visible." - (save-excursion - (beginning-of-line 1) - (when (looking-at "^[ \t]*:[a-zA-Z][a-zA-Z0-9]*:") - (let ((b (match-end 0))) - (if (re-search-forward - "^[ \t]*:END:" - (save-excursion (outline-next-heading) (point)) t) - (outline-flag-region b (point-at-eol) flag) - (user-error ":END: line missing at position %s" b)))))) - -(defun org-subtree-end-visible-p () - "Is the end of the current subtree visible?" - (pos-visible-in-window-p - (save-excursion (org-end-of-subtree t) (point)))) - -(defun org-first-headline-recenter (&optional N) - "Move cursor to the first headline and recenter the headline. -Optional argument N means put the headline into the Nth line of the window." - (goto-char (point-min)) - (when (re-search-forward (concat "^\\(" org-outline-regexp "\\)") nil t) - (beginning-of-line) - (recenter (prefix-numeric-value N)))) - -;;; Saving and restoring visibility - -(defun org-outline-overlay-data (&optional use-markers) - "Return a list of the locations of all outline overlays. -These are overlays with the `invisible' property value `outline'. -The return value is a list of cons cells, with start and stop -positions for each overlay. -If USE-MARKERS is set, return the positions as markers." - (let (beg end) - (save-excursion - (save-restriction - (widen) - (delq nil - (mapcar (lambda (o) - (when (eq (overlay-get o 'invisible) 'outline) - (setq beg (overlay-start o) - end (overlay-end o)) - (and beg end (> end beg) - (if use-markers - (cons (move-marker (make-marker) beg) - (move-marker (make-marker) end)) - (cons beg end))))) - (overlays-in (point-min) (point-max)))))))) - -(defun org-set-outline-overlay-data (data) - "Create visibility overlays for all positions in DATA. -DATA should have been made by `org-outline-overlay-data'." - (let (o) - (save-excursion - (save-restriction - (widen) - (show-all) - (mapc (lambda (c) - (outline-flag-region (car c) (cdr c) t)) - data))))) - -;;; Folding of blocks - -(defvar org-hide-block-overlays nil - "Overlays hiding blocks.") -(make-variable-buffer-local 'org-hide-block-overlays) - -(defun org-block-map (function &optional start end) - "Call FUNCTION at the head of all source blocks in the current buffer. -Optional arguments START and END can be used to limit the range." - (let ((start (or start (point-min))) - (end (or end (point-max)))) - (save-excursion - (goto-char start) - (while (and (< (point) end) (re-search-forward org-block-regexp end t)) - (save-excursion - (save-match-data - (goto-char (match-beginning 0)) - (funcall function))))))) - -(defun org-hide-block-toggle-all () - "Toggle the visibility of all blocks in the current buffer." - (org-block-map #'org-hide-block-toggle)) - -(defun org-hide-block-all () - "Fold all blocks in the current buffer." - (interactive) - (org-show-block-all) - (org-block-map #'org-hide-block-toggle-maybe)) - -(defun org-show-block-all () - "Unfold all blocks in the current buffer." - (interactive) - (mapc 'delete-overlay org-hide-block-overlays) - (setq org-hide-block-overlays nil)) - -(defun org-hide-block-toggle-maybe () - "Toggle visibility of block at point." - (interactive) - (let ((case-fold-search t)) - (if (save-excursion - (beginning-of-line 1) - (looking-at org-block-regexp)) - (progn (org-hide-block-toggle) - t) ;; to signal that we took action - nil))) ;; to signal that we did not - -(defun org-hide-block-toggle (&optional force) - "Toggle the visibility of the current block." - (interactive) - (save-excursion - (beginning-of-line) - (if (re-search-forward org-block-regexp nil t) - (let ((start (- (match-beginning 4) 1)) ;; beginning of body - (end (match-end 0)) ;; end of entire body - ov) - (if (memq t (mapcar (lambda (overlay) - (eq (overlay-get overlay 'invisible) - 'org-hide-block)) - (overlays-at start))) - (if (or (not force) (eq force 'off)) - (mapc (lambda (ov) - (when (member ov org-hide-block-overlays) - (setq org-hide-block-overlays - (delq ov org-hide-block-overlays))) - (when (eq (overlay-get ov 'invisible) - 'org-hide-block) - (delete-overlay ov))) - (overlays-at start))) - (setq ov (make-overlay start end)) - (overlay-put ov 'invisible 'org-hide-block) - ;; make the block accessible to isearch - (overlay-put - ov 'isearch-open-invisible - (lambda (ov) - (when (member ov org-hide-block-overlays) - (setq org-hide-block-overlays - (delq ov org-hide-block-overlays))) - (when (eq (overlay-get ov 'invisible) - 'org-hide-block) - (delete-overlay ov)))) - (push ov org-hide-block-overlays))) - (user-error "Not looking at a source block")))) - -;; org-tab-after-check-for-cycling-hook -(add-hook 'org-tab-first-hook 'org-hide-block-toggle-maybe) -;; Remove overlays when changing major mode -(add-hook 'org-mode-hook - (lambda () (org-add-hook 'change-major-mode-hook - 'org-show-block-all 'append 'local))) - -;;; Org-goto - -(defvar org-goto-window-configuration nil) -(defvar org-goto-marker nil) -(defvar org-goto-map) -(defun org-goto-map () - "Set the keymap `org-goto'." - (setq org-goto-map - (let ((map (make-sparse-keymap))) - (let ((cmds '(isearch-forward isearch-backward kill-ring-save set-mark-command - mouse-drag-region universal-argument org-occur)) - cmd) - (while (setq cmd (pop cmds)) - (substitute-key-definition cmd cmd map global-map))) - (suppress-keymap map) - (org-defkey map "\C-m" 'org-goto-ret) - (org-defkey map [(return)] 'org-goto-ret) - (org-defkey map [(left)] 'org-goto-left) - (org-defkey map [(right)] 'org-goto-right) - (org-defkey map [(control ?g)] 'org-goto-quit) - (org-defkey map "\C-i" 'org-cycle) - (org-defkey map [(tab)] 'org-cycle) - (org-defkey map [(down)] 'outline-next-visible-heading) - (org-defkey map [(up)] 'outline-previous-visible-heading) - (if org-goto-auto-isearch - (if (fboundp 'define-key-after) - (define-key-after map [t] 'org-goto-local-auto-isearch) - nil) - (org-defkey map "q" 'org-goto-quit) - (org-defkey map "n" 'outline-next-visible-heading) - (org-defkey map "p" 'outline-previous-visible-heading) - (org-defkey map "f" 'outline-forward-same-level) - (org-defkey map "b" 'outline-backward-same-level) - (org-defkey map "u" 'outline-up-heading)) - (org-defkey map "/" 'org-occur) - (org-defkey map "\C-c\C-n" 'outline-next-visible-heading) - (org-defkey map "\C-c\C-p" 'outline-previous-visible-heading) - (org-defkey map "\C-c\C-f" 'outline-forward-same-level) - (org-defkey map "\C-c\C-b" 'outline-backward-same-level) - (org-defkey map "\C-c\C-u" 'outline-up-heading) - map))) - -(defconst org-goto-help - "Browse buffer copy, to find location or copy text.%s -RET=jump to location C-g=quit and return to previous location -\[Up]/[Down]=next/prev headline TAB=cycle visibility [/] org-occur") - -(defvar org-goto-start-pos) ; dynamically scoped parameter - -(defun org-goto (&optional alternative-interface) - "Look up a different location in the current file, keeping current visibility. - -When you want look-up or go to a different location in a -document, the fastest way is often to fold the entire buffer and -then dive into the tree. This method has the disadvantage, that -the previous location will be folded, which may not be what you -want. - -This command works around this by showing a copy of the current -buffer in an indirect buffer, in overview mode. You can dive -into the tree in that copy, use org-occur and incremental search -to find a location. When pressing RET or `Q', the command -returns to the original buffer in which the visibility is still -unchanged. After RET it will also jump to the location selected -in the indirect buffer and expose the headline hierarchy above. - -With a prefix argument, use the alternative interface: e.g. if -`org-goto-interface' is 'outline use 'outline-path-completion." - (interactive "P") - (org-goto-map) - (let* ((org-refile-targets `((nil . (:maxlevel . ,org-goto-max-level)))) - (org-refile-use-outline-path t) - (org-refile-target-verify-function nil) - (interface - (if (not alternative-interface) - org-goto-interface - (if (eq org-goto-interface 'outline) - 'outline-path-completion - 'outline))) - (org-goto-start-pos (point)) - (selected-point - (if (eq interface 'outline) - (car (org-get-location (current-buffer) org-goto-help)) - (let ((pa (org-refile-get-location "Goto" nil nil t))) - (org-refile-check-position pa) - (nth 3 pa))))) - (if selected-point - (progn - (org-mark-ring-push org-goto-start-pos) - (goto-char selected-point) - (if (or (outline-invisible-p) (org-invisible-p2)) - (org-show-context 'org-goto))) - (message "Quit")))) - -(defvar org-goto-selected-point nil) ; dynamically scoped parameter -(defvar org-goto-exit-command nil) ; dynamically scoped parameter -(defvar org-goto-local-auto-isearch-map) ; defined below - -(defun org-get-location (buf help) - "Let the user select a location in the Org-mode buffer BUF. -This function uses a recursive edit. It returns the selected position -or nil." - (org-no-popups - (let ((isearch-mode-map org-goto-local-auto-isearch-map) - (isearch-hide-immediately nil) - (isearch-search-fun-function - (lambda () 'org-goto-local-search-headings)) - (org-goto-selected-point org-goto-exit-command)) - (save-excursion - (save-window-excursion - (delete-other-windows) - (and (get-buffer "*org-goto*") (kill-buffer "*org-goto*")) - (org-pop-to-buffer-same-window - (condition-case nil - (make-indirect-buffer (current-buffer) "*org-goto*") - (error (make-indirect-buffer (current-buffer) "*org-goto*")))) - (with-output-to-temp-buffer "*Org Help*" - (princ (format help (if org-goto-auto-isearch - " Just type for auto-isearch." - " n/p/f/b/u to navigate, q to quit.")))) - (org-fit-window-to-buffer (get-buffer-window "*Org Help*")) - (setq buffer-read-only nil) - (let ((org-startup-truncated t) - (org-startup-folded nil) - (org-startup-align-all-tables nil)) - (org-mode) - (org-overview)) - (setq buffer-read-only t) - (if (and (boundp 'org-goto-start-pos) - (integer-or-marker-p org-goto-start-pos)) - (let ((org-show-hierarchy-above t) - (org-show-siblings t) - (org-show-following-heading t)) - (goto-char org-goto-start-pos) - (and (outline-invisible-p) (org-show-context))) - (goto-char (point-min))) - (let (org-special-ctrl-a/e) (org-beginning-of-line)) - (message "Select location and press RET") - (use-local-map org-goto-map) - (recursive-edit))) - (kill-buffer "*org-goto*") - (cons org-goto-selected-point org-goto-exit-command)))) - -(defvar org-goto-local-auto-isearch-map (make-sparse-keymap)) -(set-keymap-parent org-goto-local-auto-isearch-map isearch-mode-map) -(define-key org-goto-local-auto-isearch-map "\C-i" 'isearch-other-control-char) -(define-key org-goto-local-auto-isearch-map "\C-m" 'isearch-other-control-char) - -(defun org-goto-local-search-headings (string bound noerror) - "Search and make sure that any matches are in headlines." - (catch 'return - (while (if isearch-forward - (search-forward string bound noerror) - (search-backward string bound noerror)) - (when (let ((context (mapcar 'car (save-match-data (org-context))))) - (and (member :headline context) - (not (member :tags context)))) - (throw 'return (point)))))) - -(defun org-goto-local-auto-isearch () - "Start isearch." - (interactive) - (goto-char (point-min)) - (let ((keys (this-command-keys))) - (when (eq (lookup-key isearch-mode-map keys) 'isearch-printing-char) - (isearch-mode t) - (isearch-process-search-char (string-to-char keys))))) - -(defun org-goto-ret (&optional arg) - "Finish `org-goto' by going to the new location." - (interactive "P") - (setq org-goto-selected-point (point) - org-goto-exit-command 'return) - (throw 'exit nil)) - -(defun org-goto-left () - "Finish `org-goto' by going to the new location." - (interactive) - (if (org-at-heading-p) - (progn - (beginning-of-line 1) - (setq org-goto-selected-point (point) - org-goto-exit-command 'left) - (throw 'exit nil)) - (user-error "Not on a heading"))) - -(defun org-goto-right () - "Finish `org-goto' by going to the new location." - (interactive) - (if (org-at-heading-p) - (progn - (setq org-goto-selected-point (point) - org-goto-exit-command 'right) - (throw 'exit nil)) - (user-error "Not on a heading"))) - -(defun org-goto-quit () - "Finish `org-goto' without cursor motion." - (interactive) - (setq org-goto-selected-point nil) - (setq org-goto-exit-command 'quit) - (throw 'exit nil)) - -;;; Indirect buffer display of subtrees - -(defvar org-indirect-dedicated-frame nil - "This is the frame being used for indirect tree display.") -(defvar org-last-indirect-buffer nil) - -(defun org-tree-to-indirect-buffer (&optional arg) - "Create indirect buffer and narrow it to current subtree. -With a numerical prefix ARG, go up to this level and then take that tree. -If ARG is negative, go up that many levels. - -If `org-indirect-buffer-display' is not `new-frame', the command removes the -indirect buffer previously made with this command, to avoid proliferation of -indirect buffers. However, when you call the command with a \ -\\[universal-argument] prefix, or -when `org-indirect-buffer-display' is `new-frame', the last buffer -is kept so that you can work with several indirect buffers at the same time. -If `org-indirect-buffer-display' is `dedicated-frame', the \ -\\[universal-argument] prefix also -requests that a new frame be made for the new buffer, so that the dedicated -frame is not changed." - (interactive "P") - (let ((cbuf (current-buffer)) - (cwin (selected-window)) - (pos (point)) - beg end level heading ibuf) - (save-excursion - (org-back-to-heading t) - (when (numberp arg) - (setq level (org-outline-level)) - (if (< arg 0) (setq arg (+ level arg))) - (while (> (setq level (org-outline-level)) arg) - (org-up-heading-safe))) - (setq beg (point) - heading (org-get-heading)) - (org-end-of-subtree t t) - (if (org-at-heading-p) (backward-char 1)) - (setq end (point))) - (if (and (buffer-live-p org-last-indirect-buffer) - (not (eq org-indirect-buffer-display 'new-frame)) - (not arg)) - (kill-buffer org-last-indirect-buffer)) - (setq ibuf (org-get-indirect-buffer cbuf) - org-last-indirect-buffer ibuf) - (cond - ((or (eq org-indirect-buffer-display 'new-frame) - (and arg (eq org-indirect-buffer-display 'dedicated-frame))) - (select-frame (make-frame)) - (delete-other-windows) - (org-pop-to-buffer-same-window ibuf) - (org-set-frame-title heading)) - ((eq org-indirect-buffer-display 'dedicated-frame) - (raise-frame - (select-frame (or (and org-indirect-dedicated-frame - (frame-live-p org-indirect-dedicated-frame) - org-indirect-dedicated-frame) - (setq org-indirect-dedicated-frame (make-frame))))) - (delete-other-windows) - (org-pop-to-buffer-same-window ibuf) - (org-set-frame-title (concat "Indirect: " heading))) - ((eq org-indirect-buffer-display 'current-window) - (org-pop-to-buffer-same-window ibuf)) - ((eq org-indirect-buffer-display 'other-window) - (pop-to-buffer ibuf)) - (t (error "Invalid value"))) - (if (featurep 'xemacs) - (save-excursion (org-mode) (turn-on-font-lock))) - (narrow-to-region beg end) - (show-all) - (goto-char pos) - (run-hook-with-args 'org-cycle-hook 'all) - (and (window-live-p cwin) (select-window cwin)))) - -(defun org-get-indirect-buffer (&optional buffer) - (setq buffer (or buffer (current-buffer))) - (let ((n 1) (base (buffer-name buffer)) bname) - (while (buffer-live-p - (get-buffer (setq bname (concat base "-" (number-to-string n))))) - (setq n (1+ n))) - (condition-case nil - (make-indirect-buffer buffer bname 'clone) - (error (make-indirect-buffer buffer bname))))) - -(defun org-set-frame-title (title) - "Set the title of the current frame to the string TITLE." - ;; FIXME: how to name a single frame in XEmacs??? - (unless (featurep 'xemacs) - (modify-frame-parameters (selected-frame) (list (cons 'name title))))) - -;;;; Structure editing - -;;; Inserting headlines - -(defun org-previous-line-empty-p (&optional next) - "Is the previous line a blank line? -When NEXT is non-nil, check the next line instead." - (save-excursion - (and (not (bobp)) - (or (beginning-of-line (if next 2 0)) t) - (save-match-data - (looking-at "[ \t]*$"))))) - -(defun org-insert-heading (&optional arg invisible-ok) - "Insert a new heading or item with same depth at point. -If point is in a plain list and ARG is nil, create a new list item. -With one universal prefix argument, insert a heading even in lists. -With two universal prefix arguments, insert the heading at the end -of the parent subtree. - -If point is at the beginning of a headline, insert a sibling before -the current headline. If point is not at the beginning, split the line -and create a new headline with the text in the current line after point -\(see `org-M-RET-may-split-line' on how to modify this behavior). - -If point is at the beginning of a normal line, turn this line into -a heading. - -When INVISIBLE-OK is set, stop at invisible headlines when going back. -This is important for non-interactive uses of the command." - (interactive "P") - (if (org-called-interactively-p 'any) (org-reveal)) - (let ((itemp (org-in-item-p)) - (may-split (org-get-alist-option org-M-RET-may-split-line 'headline)) - (respect-content (or org-insert-heading-respect-content - (equal arg '(16)))) - (initial-content "") - (adjust-empty-lines t)) - - (cond - - ((or (= (buffer-size) 0) - (and (not (save-excursion - (and (ignore-errors (org-back-to-heading invisible-ok)) - (org-at-heading-p)))) - (or arg (not itemp)))) - ;; At beginning of buffer or so high up that only a heading - ;; makes sense. - (insert - (if (or (bobp) (org-previous-line-empty-p)) "" "\n") - (if (org-in-src-block-p) ",* " "* ")) - (run-hooks 'org-insert-heading-hook)) - - ((and itemp (not (equal arg '(4)))) - ;; Insert an item - (org-insert-item)) - - (t - ;; Insert a heading - (save-restriction - (widen) - (let* ((level nil) - (on-heading (org-at-heading-p)) - (empty-line-p (if on-heading - (org-previous-line-empty-p) - ;; We will decide later - nil)) - ;; Get a level string to fall back on - (fix-level - (save-excursion - (org-back-to-heading t) - (if (org-previous-line-empty-p) (setq empty-line-p t)) - (looking-at org-outline-regexp) - (make-string (1- (length (match-string 0))) ?*))) - (stars - (save-excursion - (condition-case nil - (progn - (org-back-to-heading invisible-ok) - (when (and (not on-heading) - (featurep 'org-inlinetask) - (integerp org-inlinetask-min-level) - (>= (length (match-string 0)) - org-inlinetask-min-level)) - ;; Find a heading level before the inline task - (while (and (setq level (org-up-heading-safe)) - (>= level org-inlinetask-min-level))) - (if (org-at-heading-p) - (org-back-to-heading invisible-ok) - (error "This should not happen"))) - (unless (and (save-excursion - (save-match-data - (org-backward-heading-same-level - 1 invisible-ok)) - (= (point) (match-beginning 0))) - (not (org-previous-line-empty-p t))) - (setq empty-line-p (or empty-line-p - (org-previous-line-empty-p)))) - (match-string 0)) - (error (or fix-level "* "))))) - (blank-a (cdr (assq 'heading org-blank-before-new-entry))) - (blank (if (eq blank-a 'auto) empty-line-p blank-a)) - pos hide-previous previous-pos) - - ;; If we insert after content, move there and clean up whitespace - (when respect-content - (org-end-of-subtree nil t) - (skip-chars-backward " \r\n") - (and (looking-at "[ \t]+") (replace-match "")) - (unless (eobp) (forward-char 1)) - (when (looking-at "^\\*") - (unless (bobp) (backward-char 1)) - (insert "\n"))) - - ;; If we are splitting, grab the text that should be moved to the new headline - (when may-split - (if (org-on-heading-p) - ;; This is a heading, we split intelligently (keeping tags) - (let ((pos (point))) - (goto-char (point-at-bol)) - (unless (looking-at org-complex-heading-regexp) - (error "This should not happen")) - (when (and (match-beginning 4) - (> pos (match-beginning 4)) - (< pos (match-end 4))) - (setq initial-content (buffer-substring pos (match-end 4))) - (goto-char pos) - (delete-region (point) (match-end 4)) - (if (looking-at "[ \t]*$") - (replace-match "") - (insert (make-string (length initial-content) ?\ ))) - (setq initial-content (org-trim initial-content))) - (goto-char pos)) - ;; a normal line - (unless (bolp) - (setq initial-content (buffer-substring (point) (point-at-eol))) - (delete-region (point) (point-at-eol)) - (setq initial-content (org-trim initial-content))))) - - ;; If we are at the beginning of the line, insert before it. Else after - (cond - ((and (bolp) (looking-at "[ \t]*$"))) - ((and (bolp) (not (looking-at "[ \t]*$"))) - (open-line 1)) - (t - (goto-char (point-at-eol)) - (insert "\n"))) - - ;; Insert the new heading - (insert stars) - (just-one-space) - (insert initial-content) - (when adjust-empty-lines - (if (or (not blank) - (and blank (not (org-previous-line-empty-p)))) - (org-N-empty-lines-before-current (if blank 1 0)))) - (run-hooks 'org-insert-heading-hook))))))) - -(defun org-N-empty-lines-before-current (N) - "Make the number of empty lines before current exactly N. -So this will delete or add empty lines." - (save-excursion - (goto-char (point-at-bol)) - (if (looking-back "\\s-+" nil 'greedy) - (replace-match "")) - (or (bobp) (insert "\n")) - (while (> N 0) - (insert "\n") - (setq N (1- N))))) - -(defun org-get-heading (&optional no-tags no-todo) - "Return the heading of the current entry, without the stars. -When NO-TAGS is non-nil, don't include tags. -When NO-TODO is non-nil, don't include TODO keywords." - (save-excursion - (org-back-to-heading t) - (cond - ((and no-tags no-todo) - (looking-at org-complex-heading-regexp) - (match-string 4)) - (no-tags - (looking-at (concat org-outline-regexp - "\\(.*?\\)" - "\\(?:[ \t]+:[[:alnum:]:_@#%]+:\\)?[ \t]*$")) - (match-string 1)) - (no-todo - (looking-at org-todo-line-regexp) - (match-string 3)) - (t (looking-at org-heading-regexp) - (match-string 2))))) - -(defvar orgstruct-mode) ; defined below - -(defun org-heading-components () - "Return the components of the current heading. -This is a list with the following elements: -- the level as an integer -- the reduced level, different if `org-odd-levels-only' is set. -- the TODO keyword, or nil -- the priority character, like ?A, or nil if no priority is given -- the headline text itself, or the tags string if no headline text -- the tags string, or nil." - (save-excursion - (org-back-to-heading t) - (if (let (case-fold-search) - (looking-at - (if orgstruct-mode - org-heading-regexp - org-complex-heading-regexp))) - (if orgstruct-mode - (list (length (match-string 1)) - (org-reduced-level (length (match-string 1))) - nil - nil - (match-string 2) - nil) - (list (length (match-string 1)) - (org-reduced-level (length (match-string 1))) - (org-match-string-no-properties 2) - (and (match-end 3) (aref (match-string 3) 2)) - (org-match-string-no-properties 4) - (org-match-string-no-properties 5)))))) - -(defun org-get-entry () - "Get the entry text, after heading, entire subtree." - (save-excursion - (org-back-to-heading t) - (buffer-substring (point-at-bol 2) (org-end-of-subtree t)))) - -(defun org-insert-heading-after-current () - "Insert a new heading with same level as current, after current subtree." - (interactive) - (org-back-to-heading) - (org-insert-heading) - (org-move-subtree-down) - (end-of-line 1)) - -(defun org-insert-heading-respect-content (&optional arg invisible-ok) - "Insert heading with `org-insert-heading-respect-content' set to t." - (interactive "P") - (let ((org-insert-heading-respect-content t)) - (org-insert-heading '(4) invisible-ok))) - -(defun org-insert-todo-heading-respect-content (&optional force-state) - "Insert TODO heading with `org-insert-heading-respect-content' set to t." - (interactive "P") - (let ((org-insert-heading-respect-content t)) - (org-insert-todo-heading force-state '(4)))) - -(defun org-insert-todo-heading (arg &optional force-heading) - "Insert a new heading with the same level and TODO state as current heading. -If the heading has no TODO state, or if the state is DONE, use the first -state (TODO by default). Also one prefix arg, force first state. With two -prefix args, force inserting at the end of the parent subtree." - (interactive "P") - (when (or force-heading (not (org-insert-item 'checkbox))) - (org-insert-heading (or (and (equal arg '(16)) '(16)) - force-heading)) - (save-excursion - (org-back-to-heading) - (outline-previous-heading) - (looking-at org-todo-line-regexp)) - (let* - ((new-mark-x - (if (or arg - (not (match-beginning 2)) - (member (match-string 2) org-done-keywords)) - (car org-todo-keywords-1) - (match-string 2))) - (new-mark - (or - (run-hook-with-args-until-success - 'org-todo-get-default-hook new-mark-x nil) - new-mark-x))) - (beginning-of-line 1) - (and (looking-at org-outline-regexp) (goto-char (match-end 0)) - (if org-treat-insert-todo-heading-as-state-change - (org-todo new-mark) - (insert new-mark " ")))) - (when org-provide-todo-statistics - (org-update-parent-todo-statistics)))) - -(defun org-insert-subheading (arg) - "Insert a new subheading and demote it. -Works for outline headings and for plain lists alike." - (interactive "P") - (org-insert-heading arg) - (cond - ((org-at-heading-p) (org-do-demote)) - ((org-at-item-p) (org-indent-item)))) - -(defun org-insert-todo-subheading (arg) - "Insert a new subheading with TODO keyword or checkbox and demote it. -Works for outline headings and for plain lists alike." - (interactive "P") - (org-insert-todo-heading arg) - (cond - ((org-at-heading-p) (org-do-demote)) - ((org-at-item-p) (org-indent-item)))) - -;;; Promotion and Demotion - -(defvar org-after-demote-entry-hook nil - "Hook run after an entry has been demoted. -The cursor will be at the beginning of the entry. -When a subtree is being demoted, the hook will be called for each node.") - -(defvar org-after-promote-entry-hook nil - "Hook run after an entry has been promoted. -The cursor will be at the beginning of the entry. -When a subtree is being promoted, the hook will be called for each node.") - -(defun org-promote-subtree () - "Promote the entire subtree. -See also `org-promote'." - (interactive) - (save-excursion - (org-with-limited-levels (org-map-tree 'org-promote))) - (org-fix-position-after-promote)) - -(defun org-demote-subtree () - "Demote the entire subtree. See `org-demote'. -See also `org-promote'." - (interactive) - (save-excursion - (org-with-limited-levels (org-map-tree 'org-demote))) - (org-fix-position-after-promote)) - - -(defun org-do-promote () - "Promote the current heading higher up the tree. -If the region is active in `transient-mark-mode', promote all headings -in the region." - (interactive) - (save-excursion - (if (org-region-active-p) - (org-map-region 'org-promote (region-beginning) (region-end)) - (org-promote))) - (org-fix-position-after-promote)) - -(defun org-do-demote () - "Demote the current heading lower down the tree. -If the region is active in `transient-mark-mode', demote all headings -in the region." - (interactive) - (save-excursion - (if (org-region-active-p) - (org-map-region 'org-demote (region-beginning) (region-end)) - (org-demote))) - (org-fix-position-after-promote)) - -(defun org-fix-position-after-promote () - "Make sure that after pro/demotion cursor position is right." - (let ((pos (point))) - (when (save-excursion - (beginning-of-line 1) - (looking-at org-todo-line-regexp) - (or (equal pos (match-end 1)) (equal pos (match-end 2)))) - (cond ((eobp) (insert " ")) - ((eolp) (insert " ")) - ((equal (char-after) ?\ ) (forward-char 1)))))) - -(defun org-current-level () - "Return the level of the current entry, or nil if before the first headline. -The level is the number of stars at the beginning of the headline." - (save-excursion - (org-with-limited-levels - (if (ignore-errors (org-back-to-heading t)) - (funcall outline-level))))) - -(defun org-get-previous-line-level () - "Return the outline depth of the last headline before the current line. -Returns 0 for the first headline in the buffer, and nil if before the -first headline." - (let ((current-level (org-current-level)) - (prev-level (when (> (line-number-at-pos) 1) - (save-excursion - (beginning-of-line 0) - (org-current-level))))) - (cond ((null current-level) nil) ; Before first headline - ((null prev-level) 0) ; At first headline - (prev-level)))) - -(defun org-reduced-level (l) - "Compute the effective level of a heading. -This takes into account the setting of `org-odd-levels-only'." - (cond - ((zerop l) 0) - (org-odd-levels-only (1+ (floor (/ l 2)))) - (t l))) - -(defun org-level-increment () - "Return the number of stars that will be added or removed at a -time to headlines when structure editing, based on the value of -`org-odd-levels-only'." - (if org-odd-levels-only 2 1)) - -(defun org-get-valid-level (level &optional change) - "Rectify a level change under the influence of `org-odd-levels-only' -LEVEL is a current level, CHANGE is by how much the level should be -modified. Even if CHANGE is nil, LEVEL may be returned modified because -even level numbers will become the next higher odd number." - (if org-odd-levels-only - (cond ((or (not change) (= 0 change)) (1+ (* 2 (/ level 2)))) - ((> change 0) (1+ (* 2 (/ (+ level (* 2 change)) 2)))) - ((< change 0) (max 1 (1+ (* 2 (/ (+ level (* 2 change)) 2)))))) - (max 1 (+ level (or change 0))))) - -(if (boundp 'define-obsolete-function-alias) - (if (or (featurep 'xemacs) (< emacs-major-version 23)) - (define-obsolete-function-alias 'org-get-legal-level - 'org-get-valid-level) - (define-obsolete-function-alias 'org-get-legal-level - 'org-get-valid-level "23.1"))) - -(defun org-promote () - "Promote the current heading higher up the tree. -If the region is active in `transient-mark-mode', promote all headings -in the region." - (org-back-to-heading t) - (let* ((level (save-match-data (funcall outline-level))) - (after-change-functions (remove 'flyspell-after-change-function - after-change-functions)) - (up-head (concat (make-string (org-get-valid-level level -1) ?*) " ")) - (diff (abs (- level (length up-head) -1)))) - (cond ((and (= level 1) org-called-with-limited-levels - org-allow-promoting-top-level-subtree) - (replace-match "# " nil t)) - ((= level 1) - (user-error "Cannot promote to level 0. UNDO to recover if necessary")) - (t (replace-match up-head nil t))) - ;; Fixup tag positioning - (unless (= level 1) - (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation (org-fixup-indentation (- diff)))) - (run-hooks 'org-after-promote-entry-hook))) - -(defun org-demote () - "Demote the current heading lower down the tree. -If the region is active in `transient-mark-mode', demote all headings -in the region." - (org-back-to-heading t) - (let* ((level (save-match-data (funcall outline-level))) - (after-change-functions (remove 'flyspell-after-change-function - after-change-functions)) - (down-head (concat (make-string (org-get-valid-level level 1) ?*) " ")) - (diff (abs (- level (length down-head) -1)))) - (replace-match down-head nil t) - ;; Fixup tag positioning - (and org-auto-align-tags (org-set-tags nil t)) - (if org-adapt-indentation (org-fixup-indentation diff)) - (run-hooks 'org-after-demote-entry-hook))) - -(defun org-cycle-level () - "Cycle the level of an empty headline through possible states. -This goes first to child, then to parent, level, then up the hierarchy. -After top level, it switches back to sibling level." - (interactive) - (let ((org-adapt-indentation nil)) - (when (org-point-at-end-of-empty-headline) - (setq this-command 'org-cycle-level) ; Only needed for caching - (let ((cur-level (org-current-level)) - (prev-level (org-get-previous-line-level))) - (cond - ;; If first headline in file, promote to top-level. - ((= prev-level 0) - (loop repeat (/ (- cur-level 1) (org-level-increment)) - do (org-do-promote))) - ;; If same level as prev, demote one. - ((= prev-level cur-level) - (org-do-demote)) - ;; If parent is top-level, promote to top level if not already. - ((= prev-level 1) - (loop repeat (/ (- cur-level 1) (org-level-increment)) - do (org-do-promote))) - ;; If top-level, return to prev-level. - ((= cur-level 1) - (loop repeat (/ (- prev-level 1) (org-level-increment)) - do (org-do-demote))) - ;; If less than prev-level, promote one. - ((< cur-level prev-level) - (org-do-promote)) - ;; If deeper than prev-level, promote until higher than - ;; prev-level. - ((> cur-level prev-level) - (loop repeat (+ 1 (/ (- cur-level prev-level) (org-level-increment))) - do (org-do-promote)))) - t)))) - -(defun org-map-tree (fun) - "Call FUN for every heading underneath the current one." - (org-back-to-heading) - (let ((level (funcall outline-level))) - (save-excursion - (funcall fun) - (while (and (progn - (outline-next-heading) - (> (funcall outline-level) level)) - (not (eobp))) - (funcall fun))))) - -(defun org-map-region (fun beg end) - "Call FUN for every heading between BEG and END." - (let ((org-ignore-region t)) - (save-excursion - (setq end (copy-marker end)) - (goto-char beg) - (if (and (re-search-forward org-outline-regexp-bol nil t) - (< (point) end)) - (funcall fun)) - (while (and (progn - (outline-next-heading) - (< (point) end)) - (not (eobp))) - (funcall fun))))) - -(defvar org-property-end-re) ; silence byte-compiler -(defun org-fixup-indentation (diff) - "Change the indentation in the current entry by DIFF. -However, if any line in the current entry has no indentation, or if it -would end up with no indentation after the change, nothing at all is done." - (save-excursion - (let ((end (save-excursion (outline-next-heading) - (point-marker))) - (prohibit (if (> diff 0) - "^\\S-" - (concat "^ \\{0," (int-to-string (- diff)) "\\}\\S-"))) - col) - (unless (save-excursion (end-of-line 1) - (re-search-forward prohibit end t)) - (while (and (< (point) end) - (re-search-forward "^[ \t]+" end t)) - (goto-char (match-end 0)) - (setq col (current-column)) - (if (< diff 0) (replace-match "")) - (org-indent-to-column (+ diff col)))) - (move-marker end nil)))) - -(defun org-convert-to-odd-levels () - "Convert an org-mode file with all levels allowed to one with odd levels. -This will leave level 1 alone, convert level 2 to level 3, level 3 to -level 5 etc." - (interactive) - (when (yes-or-no-p "Are you sure you want to globally change levels to odd? ") - (let ((outline-level 'org-outline-level) - (org-odd-levels-only nil) n) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^\\*\\*+ " nil t) - (setq n (- (length (match-string 0)) 2)) - (while (>= (setq n (1- n)) 0) - (org-demote)) - (end-of-line 1)))))) - -(defun org-convert-to-oddeven-levels () - "Convert an org-mode file with only odd levels to one with odd/even levels. -This promotes level 3 to level 2, level 5 to level 3 etc. If the -file contains a section with an even level, conversion would -destroy the structure of the file. An error is signaled in this -case." - (interactive) - (goto-char (point-min)) - ;; First check if there are no even levels - (when (re-search-forward "^\\(\\*\\*\\)+ " nil t) - (org-show-context t) - (error "Not all levels are odd in this file. Conversion not possible")) - (when (yes-or-no-p "Are you sure you want to globally change levels to odd-even? ") - (let ((outline-regexp org-outline-regexp) - (outline-level 'org-outline-level) - (org-odd-levels-only nil) n) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^\\*\\*+ " nil t) - (setq n (/ (1- (length (match-string 0))) 2)) - (while (>= (setq n (1- n)) 0) - (org-promote)) - (end-of-line 1)))))) - -(defun org-tr-level (n) - "Make N odd if required." - (if org-odd-levels-only (1+ (/ n 2)) n)) - -;;; Vertical tree motion, cutting and pasting of subtrees - -(defun org-move-subtree-up (&optional arg) - "Move the current subtree up past ARG headlines of the same level." - (interactive "p") - (org-move-subtree-down (- (prefix-numeric-value arg)))) - -(defun org-move-subtree-down (&optional arg) - "Move the current subtree down past ARG headlines of the same level." - (interactive "p") - (setq arg (prefix-numeric-value arg)) - (let ((movfunc (if (> arg 0) 'org-get-next-sibling - 'org-get-last-sibling)) - (ins-point (make-marker)) - (cnt (abs arg)) - (col (current-column)) - beg beg0 end txt folded ne-beg ne-end ne-ins ins-end) - ;; Select the tree - (org-back-to-heading) - (setq beg0 (point)) - (save-excursion - (setq ne-beg (org-back-over-empty-lines)) - (setq beg (point))) - (save-match-data - (save-excursion (outline-end-of-heading) - (setq folded (outline-invisible-p))) - (outline-end-of-subtree)) - (outline-next-heading) - (setq ne-end (org-back-over-empty-lines)) - (setq end (point)) - (goto-char beg0) - (when (and (> arg 0) (org-first-sibling-p) (< ne-end ne-beg)) - ;; include less whitespace - (save-excursion - (goto-char beg) - (forward-line (- ne-beg ne-end)) - (setq beg (point)))) - ;; Find insertion point, with error handling - (while (> cnt 0) - (or (and (funcall movfunc) (looking-at org-outline-regexp)) - (progn (goto-char beg0) - (user-error "Cannot move past superior level or buffer limit"))) - (setq cnt (1- cnt))) - (if (> arg 0) - ;; Moving forward - still need to move over subtree - (progn (org-end-of-subtree t t) - (save-excursion - (org-back-over-empty-lines) - (or (bolp) (newline))))) - (setq ne-ins (org-back-over-empty-lines)) - (move-marker ins-point (point)) - (setq txt (buffer-substring beg end)) - (org-save-markers-in-region beg end) - (delete-region beg end) - (org-remove-empty-overlays-at beg) - (or (= beg (point-min)) (outline-flag-region (1- beg) beg nil)) - (or (bobp) (outline-flag-region (1- (point)) (point) nil)) - (and (not (bolp)) (looking-at "\n") (forward-char 1)) - (let ((bbb (point))) - (insert-before-markers txt) - (org-reinstall-markers-in-region bbb) - (move-marker ins-point bbb)) - (or (bolp) (insert "\n")) - (setq ins-end (point)) - (goto-char ins-point) - (org-skip-whitespace) - (when (and (< arg 0) - (org-first-sibling-p) - (> ne-ins ne-beg)) - ;; Move whitespace back to beginning - (save-excursion - (goto-char ins-end) - (let ((kill-whole-line t)) - (kill-line (- ne-ins ne-beg)) (point))) - (insert (make-string (- ne-ins ne-beg) ?\n))) - (move-marker ins-point nil) - (if folded - (hide-subtree) - (org-show-entry) - (show-children) - (org-cycle-hide-drawers 'children)) - (org-clean-visibility-after-subtree-move) - ;; move back to the initial column we were at - (move-to-column col))) - -(defvar org-subtree-clip "" - "Clipboard for cut and paste of subtrees. -This is actually only a copy of the kill, because we use the normal kill -ring. We need it to check if the kill was created by `org-copy-subtree'.") - -(defvar org-subtree-clip-folded nil - "Was the last copied subtree folded? -This is used to fold the tree back after pasting.") - -(defun org-cut-subtree (&optional n) - "Cut the current subtree into the clipboard. -With prefix arg N, cut this many sequential subtrees. -This is a short-hand for marking the subtree and then cutting it." - (interactive "p") - (org-copy-subtree n 'cut)) - -(defun org-copy-subtree (&optional n cut force-store-markers nosubtrees) - "Copy the current subtree it in the clipboard. -With prefix arg N, copy this many sequential subtrees. -This is a short-hand for marking the subtree and then copying it. -If CUT is non-nil, actually cut the subtree. -If FORCE-STORE-MARKERS is non-nil, store the relative locations -of some markers in the region, even if CUT is non-nil. This is -useful if the caller implements cut-and-paste as copy-then-paste-then-cut." - (interactive "p") - (let (beg end folded (beg0 (point))) - (if (org-called-interactively-p 'any) - (org-back-to-heading nil) ; take what looks like a subtree - (org-back-to-heading t)) ; take what is really there - (setq beg (point)) - (skip-chars-forward " \t\r\n") - (save-match-data - (if nosubtrees - (outline-next-heading) - (save-excursion (outline-end-of-heading) - (setq folded (outline-invisible-p))) - (condition-case nil - (org-forward-heading-same-level (1- n) t) - (error nil)) - (org-end-of-subtree t t))) - (setq end (point)) - (goto-char beg0) - (when (> end beg) - (setq org-subtree-clip-folded folded) - (when (or cut force-store-markers) - (org-save-markers-in-region beg end)) - (if cut (kill-region beg end) (copy-region-as-kill beg end)) - (setq org-subtree-clip (current-kill 0)) - (message "%s: Subtree(s) with %d characters" - (if cut "Cut" "Copied") - (length org-subtree-clip))))) - -(defun org-paste-subtree (&optional level tree for-yank) - "Paste the clipboard as a subtree, with modification of headline level. -The entire subtree is promoted or demoted in order to match a new headline -level. - -If the cursor is at the beginning of a headline, the same level as -that headline is used to paste the tree. - -If not, the new level is derived from the *visible* headings -before and after the insertion point, and taken to be the inferior headline -level of the two. So if the previous visible heading is level 3 and the -next is level 4 (or vice versa), level 4 will be used for insertion. -This makes sure that the subtree remains an independent subtree and does -not swallow low level entries. - -You can also force a different level, either by using a numeric prefix -argument, or by inserting the heading marker by hand. For example, if the -cursor is after \"*****\", then the tree will be shifted to level 5. - -If optional TREE is given, use this text instead of the kill ring. - -When FOR-YANK is set, this is called by `org-yank'. In this case, do not -move back over whitespace before inserting, and move point to the end of -the inserted text when done." - (interactive "P") - (setq tree (or tree (and kill-ring (current-kill 0)))) - (unless (org-kill-is-subtree-p tree) - (user-error "%s" - (substitute-command-keys - "The kill is not a (set of) tree(s) - please use \\[yank] to yank anyway"))) - (org-with-limited-levels - (let* ((visp (not (outline-invisible-p))) - (txt tree) - (^re_ "\\(\\*+\\)[ \t]*") - (old-level (if (string-match org-outline-regexp-bol txt) - (- (match-end 0) (match-beginning 0) 1) - -1)) - (force-level (cond (level (prefix-numeric-value level)) - ((and (looking-at "[ \t]*$") - (string-match - "^\\*+$" (buffer-substring - (point-at-bol) (point)))) - (- (match-end 1) (match-beginning 1))) - ((and (bolp) - (looking-at org-outline-regexp)) - (- (match-end 0) (point) 1)))) - (previous-level (save-excursion - (condition-case nil - (progn - (outline-previous-visible-heading 1) - (if (looking-at ^re_) - (- (match-end 0) (match-beginning 0) 1) - 1)) - (error 1)))) - (next-level (save-excursion - (condition-case nil - (progn - (or (looking-at org-outline-regexp) - (outline-next-visible-heading 1)) - (if (looking-at ^re_) - (- (match-end 0) (match-beginning 0) 1) - 1)) - (error 1)))) - (new-level (or force-level (max previous-level next-level))) - (shift (if (or (= old-level -1) - (= new-level -1) - (= old-level new-level)) - 0 - (- new-level old-level))) - (delta (if (> shift 0) -1 1)) - (func (if (> shift 0) 'org-demote 'org-promote)) - (org-odd-levels-only nil) - beg end newend) - ;; Remove the forced level indicator - (if force-level - (delete-region (point-at-bol) (point))) - ;; Paste - (beginning-of-line (if (bolp) 1 2)) - (setq beg (point)) - (and (fboundp 'org-id-paste-tracker) (org-id-paste-tracker txt)) - (insert-before-markers txt) - (unless (string-match "\n\\'" txt) (insert "\n")) - (setq newend (point)) - (org-reinstall-markers-in-region beg) - (setq end (point)) - (goto-char beg) - (skip-chars-forward " \t\n\r") - (setq beg (point)) - (if (and (outline-invisible-p) visp) - (save-excursion (outline-show-heading))) - ;; Shift if necessary - (unless (= shift 0) - (save-restriction - (narrow-to-region beg end) - (while (not (= shift 0)) - (org-map-region func (point-min) (point-max)) - (setq shift (+ delta shift))) - (goto-char (point-min)) - (setq newend (point-max)))) - (when (or (org-called-interactively-p 'interactive) for-yank) - (message "Clipboard pasted as level %d subtree" new-level)) - (if (and (not for-yank) ; in this case, org-yank will decide about folding - kill-ring - (eq org-subtree-clip (current-kill 0)) - org-subtree-clip-folded) - ;; The tree was folded before it was killed/copied - (hide-subtree)) - (and for-yank (goto-char newend))))) - -(defun org-kill-is-subtree-p (&optional txt) - "Check if the current kill is an outline subtree, or a set of trees. -Returns nil if kill does not start with a headline, or if the first -headline level is not the largest headline level in the tree. -So this will actually accept several entries of equal levels as well, -which is OK for `org-paste-subtree'. -If optional TXT is given, check this string instead of the current kill." - (let* ((kill (or txt (and kill-ring (current-kill 0)) "")) - (re (org-get-limited-outline-regexp)) - (^re (concat "^" re)) - (start-level (and kill - (string-match - (concat "\\`\\([ \t\n\r]*?\n\\)?\\(" re "\\)") - kill) - (- (match-end 2) (match-beginning 2) 1))) - (start (1+ (or (match-beginning 2) -1)))) - (if (not start-level) - (progn - nil) ;; does not even start with a heading - (catch 'exit - (while (setq start (string-match ^re kill (1+ start))) - (when (< (- (match-end 0) (match-beginning 0) 1) start-level) - (throw 'exit nil))) - t)))) - -(defvar org-markers-to-move nil - "Markers that should be moved with a cut-and-paste operation. -Those markers are stored together with their positions relative to -the start of the region.") - -(defun org-save-markers-in-region (beg end) - "Check markers in region. -If these markers are between BEG and END, record their position relative -to BEG, so that after moving the block of text, we can put the markers back -into place. -This function gets called just before an entry or tree gets cut from the -buffer. After re-insertion, `org-reinstall-markers-in-region' must be -called immediately, to move the markers with the entries." - (setq org-markers-to-move nil) - (when (featurep 'org-clock) - (org-clock-save-markers-for-cut-and-paste beg end)) - (when (featurep 'org-agenda) - (org-agenda-save-markers-for-cut-and-paste beg end))) - -(defun org-check-and-save-marker (marker beg end) - "Check if MARKER is between BEG and END. -If yes, remember the marker and the distance to BEG." - (when (and (marker-buffer marker) - (equal (marker-buffer marker) (current-buffer))) - (if (and (>= marker beg) (< marker end)) - (push (cons marker (- marker beg)) org-markers-to-move)))) - -(defun org-reinstall-markers-in-region (beg) - "Move all remembered markers to their position relative to BEG." - (mapc (lambda (x) - (move-marker (car x) (+ beg (cdr x)))) - org-markers-to-move) - (setq org-markers-to-move nil)) - -(defun org-narrow-to-subtree () - "Narrow buffer to the current subtree." - (interactive) - (save-excursion - (save-match-data - (org-with-limited-levels - (narrow-to-region - (progn (org-back-to-heading t) (point)) - (progn (org-end-of-subtree t t) - (if (and (org-at-heading-p) (not (eobp))) (backward-char 1)) - (point))))))) - -(defun org-narrow-to-block () - "Narrow buffer to the current block." - (interactive) - (let* ((case-fold-search t) - (blockp (org-between-regexps-p "^[ \t]*#\\+begin_.*" - "^[ \t]*#\\+end_.*"))) - (if blockp - (narrow-to-region (car blockp) (cdr blockp)) - (user-error "Not in a block")))) - -(eval-when-compile - (defvar org-property-drawer-re)) - -(defvar org-property-start-re) ;; defined below -(defun org-clone-subtree-with-time-shift (n &optional shift) - "Clone the task (subtree) at point N times. -The clones will be inserted as siblings. - -In interactive use, the user will be prompted for the number of -clones to be produced. If the entry has a timestamp, the user -will also be prompted for a time shift, which may be a repeater -as used in time stamps, for example `+3d'. To disable this, -you can call the function with a universal prefix argument. - -When a valid repeater is given and the entry contains any time -stamps, the clones will become a sequence in time, with time -stamps in the subtree shifted for each clone produced. If SHIFT -is nil or the empty string, time stamps will be left alone. The -ID property of the original subtree is removed. - -If the original subtree did contain time stamps with a repeater, -the following will happen: -- the repeater will be removed in each clone -- an additional clone will be produced, with the current, unshifted - date(s) in the entry. -- the original entry will be placed *after* all the clones, with - repeater intact. -- the start days in the repeater in the original entry will be shifted - to past the last clone. -In this way you can spell out a number of instances of a repeating task, -and still retain the repeater to cover future instances of the task." - (interactive "nNumber of clones to produce: ") - (let ((shift - (or shift - (if (and (not (equal current-prefix-arg '(4))) - (save-excursion - (re-search-forward org-ts-regexp-both - (save-excursion - (org-end-of-subtree t) - (point)) t))) - (read-from-minibuffer - "Date shift per clone (e.g. +1w, empty to copy unchanged): ") - ""))) ;; No time shift - (n-no-remove -1) - (drawer-re org-drawer-regexp) - beg end template task idprop - shift-n shift-what doshift nmin nmax) - (if (not (and (integerp n) (> n 0))) - (error "Invalid number of replications %s" n)) - (if (and (setq doshift (and (stringp shift) (string-match "\\S-" shift))) - (not (string-match "\\`[ \t]*\\+?\\([0-9]+\\)\\([hdwmy]\\)[ \t]*\\'" - shift))) - (error "Invalid shift specification %s" shift)) - (when doshift - (setq shift-n (string-to-number (match-string 1 shift)) - shift-what (cdr (assoc (match-string 2 shift) - '(("d" . day) ("w" . week) - ("m" . month) ("y" . year)))))) - (if (eq shift-what 'week) (setq shift-n (* 7 shift-n) shift-what 'day)) - (setq nmin 1 nmax n) - (org-back-to-heading t) - (setq beg (point)) - (setq idprop (org-entry-get nil "ID")) - (org-end-of-subtree t t) - (or (bolp) (insert "\n")) - (setq end (point)) - (setq template (buffer-substring beg end)) - (when (and doshift - (string-match "<[^<>\n]+ [.+]?\\+[0-9]+[hdwmy][^<>\n]*>" template)) - (delete-region beg end) - (setq end beg) - (setq nmin 0 nmax (1+ nmax) n-no-remove nmax)) - (goto-char end) - (loop for n from nmin to nmax do - ;; prepare clone - (with-temp-buffer - (insert template) - (org-mode) - (goto-char (point-min)) - (org-show-subtree) - (and idprop (if org-clone-delete-id - (org-entry-delete nil "ID") - (org-id-get-create t))) - (unless (= n 0) - (while (re-search-forward "^[ \t]*CLOCK:.*$" nil t) - (kill-whole-line)) - (goto-char (point-min)) - (while (re-search-forward drawer-re nil t) - (mapc (lambda (d) - (org-remove-empty-drawer-at d (point))) org-drawers))) - (goto-char (point-min)) - (when doshift - (while (re-search-forward org-ts-regexp-both nil t) - (org-timestamp-change (* n shift-n) shift-what)) - (unless (= n n-no-remove) - (goto-char (point-min)) - (while (re-search-forward org-ts-regexp nil t) - (save-excursion - (goto-char (match-beginning 0)) - (if (looking-at "<[^<>\n]+\\( +[.+]?\\+[0-9]+[hdwmy]\\)") - (delete-region (match-beginning 1) (match-end 1))))))) - (setq task (buffer-string))) - (insert task)) - (goto-char beg))) - -;;; Outline Sorting - -(defun org-sort (with-case) - "Call `org-sort-entries', `org-table-sort-lines' or `org-sort-list'. -Optional argument WITH-CASE means sort case-sensitively." - (interactive "P") - (cond - ((org-at-table-p) (org-call-with-arg 'org-table-sort-lines with-case)) - ((org-at-item-p) (org-call-with-arg 'org-sort-list with-case)) - (t - (org-call-with-arg 'org-sort-entries with-case)))) - -(defun org-sort-remove-invisible (s) - "Remove invisible links from string S." - (remove-text-properties 0 (length s) org-rm-props s) - (while (string-match org-bracket-link-regexp s) - (setq s (replace-match (if (match-end 2) - (match-string 3 s) - (match-string 1 s)) t t s))) - (let ((st (format " %s " s))) - (while (string-match org-emph-re st) - (setq st (replace-match (format " %s " (match-string 4 st)) t t st))) - (setq s (substring st 1 -1))) - s) - -(defvar org-priority-regexp) ; defined later in the file - -(defvar org-after-sorting-entries-or-items-hook nil - "Hook that is run after a bunch of entries or items have been sorted. -When children are sorted, the cursor is in the parent line when this -hook gets called. When a region or a plain list is sorted, the cursor -will be in the first entry of the sorted region/list.") - -(defun org-sort-entries - (&optional with-case sorting-type getkey-func compare-func property) - "Sort entries on a certain level of an outline tree. -If there is an active region, the entries in the region are sorted. -Else, if the cursor is before the first entry, sort the top-level items. -Else, the children of the entry at point are sorted. - -Sorting can be alphabetically, numerically, by date/time as given by -a time stamp, by a property, by priority order, or by a custom function. - -The command prompts for the sorting type unless it has been given to the -function through the SORTING-TYPE argument, which needs to be a character, -\(?n ?N ?a ?A ?t ?T ?s ?S ?d ?D ?p ?P ?o ?O ?r ?R ?f ?F). Here is the -precise meaning of each character: - -n Numerically, by converting the beginning of the entry/item to a number. -a Alphabetically, ignoring the TODO keyword and the priority, if any. -o By order of TODO keywords. -t By date/time, either the first active time stamp in the entry, or, if - none exist, by the first inactive one. -s By the scheduled date/time. -d By deadline date/time. -c By creation time, which is assumed to be the first inactive time stamp - at the beginning of a line. -p By priority according to the cookie. -r By the value of a property. - -Capital letters will reverse the sort order. - -If the SORTING-TYPE is ?f or ?F, then GETKEY-FUNC specifies a function to be -called with point at the beginning of the record. It must return either -a string or a number that should serve as the sorting key for that record. - -Comparing entries ignores case by default. However, with an optional argument -WITH-CASE, the sorting considers case as well. - -Sorting is done against the visible part of the headlines, it ignores hidden -links." - (interactive "P") - (let ((case-func (if with-case 'identity 'downcase)) - (cmstr - ;; The clock marker is lost when using `sort-subr', let's - ;; store the clocking string. - (when (equal (marker-buffer org-clock-marker) (current-buffer)) - (save-excursion - (goto-char org-clock-marker) - (looking-back "^.*") (match-string-no-properties 0)))) - start beg end stars re re2 - txt what tmp) - ;; Find beginning and end of region to sort - (cond - ((org-region-active-p) - ;; we will sort the region - (setq end (region-end) - what "region") - (goto-char (region-beginning)) - (if (not (org-at-heading-p)) (outline-next-heading)) - (setq start (point))) - ((or (org-at-heading-p) - (condition-case nil (progn (org-back-to-heading) t) (error nil))) - ;; we will sort the children of the current headline - (org-back-to-heading) - (setq start (point) - end (progn (org-end-of-subtree t t) - (or (bolp) (insert "\n")) - (org-back-over-empty-lines) - (point)) - what "children") - (goto-char start) - (show-subtree) - (outline-next-heading)) - (t - ;; we will sort the top-level entries in this file - (goto-char (point-min)) - (or (org-at-heading-p) (outline-next-heading)) - (setq start (point)) - (goto-char (point-max)) - (beginning-of-line 1) - (when (looking-at ".*?\\S-") - ;; File ends in a non-white line - (end-of-line 1) - (insert "\n")) - (setq end (point-max)) - (setq what "top-level") - (goto-char start) - (show-all))) - - (setq beg (point)) - (if (>= beg end) (user-error "Nothing to sort")) - - (looking-at "\\(\\*+\\)") - (setq stars (match-string 1) - re (concat "^" (regexp-quote stars) " +") - re2 (concat "^" (regexp-quote (substring stars 0 -1)) "[ \t\n]") - txt (buffer-substring beg end)) - (if (not (equal (substring txt -1) "\n")) (setq txt (concat txt "\n"))) - (if (and (not (equal stars "*")) (string-match re2 txt)) - (user-error "Region to sort contains a level above the first entry")) - - (unless sorting-type - (message - "Sort %s: [a]lpha [n]umeric [p]riority p[r]operty todo[o]rder [f]unc - [t]ime [s]cheduled [d]eadline [c]reated - A/N/P/R/O/F/T/S/D/C means reversed:" - what) - (setq sorting-type (read-char-exclusive)) - - (unless getkey-func - (and (= (downcase sorting-type) ?f) - (setq getkey-func - (org-icompleting-read "Sort using function: " - obarray 'fboundp t nil nil)) - (setq getkey-func (intern getkey-func)))) - - (and (= (downcase sorting-type) ?r) - (not property) - (setq property - (org-icompleting-read "Property: " - (mapcar 'list (org-buffer-property-keys t)) - nil t)))) - - (message "Sorting entries...") - - (save-restriction - (narrow-to-region start end) - (let ((dcst (downcase sorting-type)) - (case-fold-search nil) - (now (current-time))) - (sort-subr - (/= dcst sorting-type) - ;; This function moves to the beginning character of the "record" to - ;; be sorted. - (lambda nil - (if (re-search-forward re nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max)))) - ;; This function moves to the last character of the "record" being - ;; sorted. - (lambda nil - (save-match-data - (condition-case nil - (outline-forward-same-level 1) - (error - (goto-char (point-max)))))) - ;; This function returns the value that gets sorted against. - (lambda nil - (cond - ((= dcst ?n) - (if (looking-at org-complex-heading-regexp) - (string-to-number (org-sort-remove-invisible (match-string 4))) - nil)) - ((= dcst ?a) - (if (looking-at org-complex-heading-regexp) - (funcall case-func (org-sort-remove-invisible (match-string 4))) - nil)) - ((= dcst ?t) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (or (re-search-forward org-ts-regexp end t) - (re-search-forward org-ts-regexp-both end t)) - (org-time-string-to-seconds (match-string 0)) - (org-float-time now)))) - ((= dcst ?c) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (re-search-forward - (concat "^[ \t]*\\[" org-ts-regexp1 "\\]") - end t) - (org-time-string-to-seconds (match-string 0)) - (org-float-time now)))) - ((= dcst ?s) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (re-search-forward org-scheduled-time-regexp end t) - (org-time-string-to-seconds (match-string 1)) - (org-float-time now)))) - ((= dcst ?d) - (let ((end (save-excursion (outline-next-heading) (point)))) - (if (re-search-forward org-deadline-time-regexp end t) - (org-time-string-to-seconds (match-string 1)) - (org-float-time now)))) - ((= dcst ?p) - (if (re-search-forward org-priority-regexp (point-at-eol) t) - (string-to-char (match-string 2)) - org-default-priority)) - ((= dcst ?r) - (or (org-entry-get nil property) "")) - ((= dcst ?o) - (if (looking-at org-complex-heading-regexp) - (- 9999 (length (member (match-string 2) - org-todo-keywords-1))))) - ((= dcst ?f) - (if getkey-func - (progn - (setq tmp (funcall getkey-func)) - (if (stringp tmp) (setq tmp (funcall case-func tmp))) - tmp) - (error "Invalid key function `%s'" getkey-func))) - (t (error "Invalid sorting type `%c'" sorting-type)))) - nil - (cond - ((= dcst ?a) 'string<) - ((= dcst ?f) compare-func) - ((member dcst '(?p ?t ?s ?d ?c)) '<))))) - (run-hooks 'org-after-sorting-entries-or-items-hook) - ;; Reset the clock marker if needed - (when cmstr - (save-excursion - (goto-char start) - (search-forward cmstr nil t) - (move-marker org-clock-marker (point)))) - (message "Sorting entries...done"))) - -(defun org-do-sort (table what &optional with-case sorting-type) - "Sort TABLE of WHAT according to SORTING-TYPE. -The user will be prompted for the SORTING-TYPE if the call to this -function does not specify it. WHAT is only for the prompt, to indicate -what is being sorted. The sorting key will be extracted from -the car of the elements of the table. -If WITH-CASE is non-nil, the sorting will be case-sensitive." - (unless sorting-type - (message - "Sort %s: [a]lphabetic, [n]umeric, [t]ime. A/N/T means reversed:" - what) - (setq sorting-type (read-char-exclusive))) - (let ((dcst (downcase sorting-type)) - extractfun comparefun) - ;; Define the appropriate functions - (cond - ((= dcst ?n) - (setq extractfun 'string-to-number - comparefun (if (= dcst sorting-type) '< '>))) - ((= dcst ?a) - (setq extractfun (if with-case (lambda(x) (org-sort-remove-invisible x)) - (lambda(x) (downcase (org-sort-remove-invisible x)))) - comparefun (if (= dcst sorting-type) - 'string< - (lambda (a b) (and (not (string< a b)) - (not (string= a b))))))) - ((= dcst ?t) - (setq extractfun - (lambda (x) - (if (or (string-match org-ts-regexp x) - (string-match org-ts-regexp-both x)) - (org-float-time - (org-time-string-to-time (match-string 0 x))) - 0)) - comparefun (if (= dcst sorting-type) '< '>))) - (t (error "Invalid sorting type `%c'" sorting-type))) - - (sort (mapcar (lambda (x) (cons (funcall extractfun (car x)) (cdr x))) - table) - (lambda (a b) (funcall comparefun (car a) (car b)))))) - - -;;; The orgstruct minor mode - -;; Define a minor mode which can be used in other modes in order to -;; integrate the org-mode structure editing commands. - -;; This is really a hack, because the org-mode structure commands use -;; keys which normally belong to the major mode. Here is how it -;; works: The minor mode defines all the keys necessary to operate the -;; structure commands, but wraps the commands into a function which -;; tests if the cursor is currently at a headline or a plain list -;; item. If that is the case, the structure command is used, -;; temporarily setting many Org-mode variables like regular -;; expressions for filling etc. However, when any of those keys is -;; used at a different location, function uses `key-binding' to look -;; up if the key has an associated command in another currently active -;; keymap (minor modes, major mode, global), and executes that -;; command. There might be problems if any of the keys is otherwise -;; used as a prefix key. - -(defcustom orgstruct-heading-prefix-regexp "" - "Regexp that matches the custom prefix of Org headlines in -orgstruct(++)-mode." - :group 'org - :version "24.4" - :package-version '(Org . "8.3") - :type 'regexp) -;;;###autoload(put 'orgstruct-heading-prefix-regexp 'safe-local-variable 'stringp) - -(defcustom orgstruct-setup-hook nil - "Hook run after orgstruct-mode-map is filled." - :group 'org - :version "24.4" - :package-version '(Org . "8.0") - :type 'hook) - -(defvar orgstruct-initialized nil) - -(defvar org-local-vars nil - "List of local variables, for use by `orgstruct-mode'.") - -;;;###autoload -(define-minor-mode orgstruct-mode - "Toggle the minor mode `orgstruct-mode'. -This mode is for using Org-mode structure commands in other -modes. The following keys behave as if Org-mode were active, if -the cursor is on a headline, or on a plain list item (both as -defined by Org-mode)." - nil " OrgStruct" (make-sparse-keymap) - (funcall (if orgstruct-mode - 'add-to-invisibility-spec - 'remove-from-invisibility-spec) - '(outline . t)) - (when orgstruct-mode - (org-load-modules-maybe) - (unless orgstruct-initialized - (orgstruct-setup) - (setq orgstruct-initialized t)))) - -;;;###autoload -(defun turn-on-orgstruct () - "Unconditionally turn on `orgstruct-mode'." - (orgstruct-mode 1)) - -(defvar org-fb-vars nil) -(make-variable-buffer-local 'org-fb-vars) -(defun orgstruct++-mode (&optional arg) - "Toggle `orgstruct-mode', the enhanced version of it. -In addition to setting orgstruct-mode, this also exports all -indentation and autofilling variables from org-mode into the -buffer. It will also recognize item context in multiline items." - (interactive "P") - (setq arg (prefix-numeric-value (or arg (if orgstruct-mode -1 1)))) - (if (< arg 1) - (progn (orgstruct-mode -1) - (mapc (lambda(v) - (org-set-local (car v) - (if (eq (car-safe (cadr v)) 'quote) (cadadr v) (cadr v)))) - org-fb-vars)) - (orgstruct-mode 1) - (setq org-fb-vars nil) - (unless org-local-vars - (setq org-local-vars (org-get-local-variables))) - (let (var val) - (mapc - (lambda (x) - (when (string-match - "^\\(paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|fill-prefix\\|indent-\\)" - (symbol-name (car x))) - (setq var (car x) val (nth 1 x)) - (push (list var `(quote ,(eval var))) org-fb-vars) - (org-set-local var (if (eq (car-safe val) 'quote) (nth 1 val) val)))) - org-local-vars) - (org-set-local 'orgstruct-is-++ t)))) - -(defvar orgstruct-is-++ nil - "Is `orgstruct-mode' in ++ version in the current-buffer?") -(make-variable-buffer-local 'orgstruct-is-++) - -;;;###autoload -(defun turn-on-orgstruct++ () - "Unconditionally turn on `orgstruct++-mode'." - (orgstruct++-mode 1)) - -(defun orgstruct-error () - "Error when there is no default binding for a structure key." - (interactive) - (funcall (if (fboundp 'user-error) - 'user-error - 'error) - "This key has no function outside structure elements")) - -(defun orgstruct-setup () - "Setup orgstruct keymap." - (dolist (cell '((org-demote . t) - (org-metaleft . t) - (org-metaright . t) - (org-promote . t) - (org-shiftmetaleft . t) - (org-shiftmetaright . t) - org-backward-element - org-backward-heading-same-level - org-ctrl-c-ret - org-ctrl-c-minus - org-ctrl-c-star - org-cycle - org-forward-heading-same-level - org-insert-heading - org-insert-heading-respect-content - org-kill-note-or-show-branches - org-mark-subtree - org-meta-return - org-metadown - org-metaup - org-narrow-to-subtree - org-promote-subtree - org-reveal - org-shiftdown - org-shiftleft - org-shiftmetadown - org-shiftmetaup - org-shiftright - org-shifttab - org-shifttab - org-shiftup - org-show-subtree - org-sort - org-up-element - outline-demote - outline-next-visible-heading - outline-previous-visible-heading - outline-promote - outline-up-heading - show-children)) - (let ((f (or (car-safe cell) cell)) - (disable-when-heading-prefix (cdr-safe cell))) - (when (fboundp f) - (let ((new-bindings)) - (dolist (binding (nconc (where-is-internal f org-mode-map) - (where-is-internal f outline-mode-map))) - (push binding new-bindings) - ;; TODO use local-function-key-map - (dolist (rep '(("<tab>" . "TAB") - ("<return>" . "RET") - ("<escape>" . "ESC") - ("<delete>" . "DEL"))) - (setq binding (read-kbd-macro - (let ((case-fold-search)) - (replace-regexp-in-string - (regexp-quote (cdr rep)) - (car rep) - (key-description binding))))) - (pushnew binding new-bindings :test 'equal))) - (dolist (binding new-bindings) - (let ((key (lookup-key orgstruct-mode-map binding))) - (when (or (not key) (numberp key)) - (condition-case nil - (org-defkey orgstruct-mode-map - binding - (orgstruct-make-binding f binding disable-when-heading-prefix)) - (error nil))))))))) - (run-hooks 'orgstruct-setup-hook)) - -(defun orgstruct-make-binding (fun key disable-when-heading-prefix) - "Create a function for binding in the structure minor mode. -FUN is the command to call inside a table. KEY is the key that -should be checked in for a command to execute outside of tables. -Non-nil `disable-when-heading-prefix' means to disable the command -if `orgstruct-heading-prefix-regexp' is not empty." - (let ((name (concat "orgstruct-hijacker-" (symbol-name fun)))) - (let ((nname name) - (i 0)) - (while (fboundp (intern nname)) - (setq nname (format "%s-%d" name (setq i (1+ i))))) - (setq name (intern nname))) - (eval - (let ((bindings '((org-heading-regexp - (concat "^" - orgstruct-heading-prefix-regexp - "\\(\\*+\\)\\(?: +\\(.*?\\)\\)?[ ]*$")) - (org-outline-regexp - (concat orgstruct-heading-prefix-regexp "\\*+ ")) - (org-outline-regexp-bol - (concat "^" org-outline-regexp)) - (outline-regexp org-outline-regexp) - (outline-heading-end-regexp "\n") - (outline-level 'org-outline-level) - (outline-heading-alist)))) - `(defun ,name (arg) - ,(concat "In Structure, run `" (symbol-name fun) "'.\n" - "Outside of structure, run the binding of `" - (key-description key) "'." - (when disable-when-heading-prefix - (concat - "\nIf `orgstruct-heading-prefix-regexp' is not empty, this command will always fall\n" - "back to the default binding due to limitations of Org's implementation of\n" - "`" (symbol-name fun) "'."))) - (interactive "p") - (let* ((disable - ,(and disable-when-heading-prefix - '(not (string= orgstruct-heading-prefix-regexp "")))) - (fallback - (or disable - (not - (let* ,bindings - (org-context-p 'headline 'item - ,(when (memq fun - '(org-insert-heading - org-insert-heading-respect-content - org-meta-return)) - '(when orgstruct-is-++ - 'item-body)))))))) - (if fallback - (let* ((orgstruct-mode) - (binding - (loop with key = ,key - for rep in - '(nil - ("<\\([^>]*\\)tab>" . "\\1TAB") - ("<\\([^>]*\\)return>" . "\\1RET") - ("<\\([^>]*\\)escape>" . "\\1ESC") - ("<\\([^>]*\\)delete>" . "\\1DEL")) - do - (when rep - (setq key (read-kbd-macro - (let ((case-fold-search)) - (replace-regexp-in-string - (car rep) - (cdr rep) - (key-description key)))))) - thereis (key-binding key)))) - (if (keymapp binding) - (set-temporary-overlay-map binding) - (let ((func (or binding - (unless disable - 'orgstruct-error)))) - (when func - (call-interactively func))))) - (org-run-like-in-org-mode - (lambda () - (interactive) - (let* ,bindings - (call-interactively ',fun))))))))) - name)) - -(defun org-contextualize-keys (alist contexts) - "Return valid elements in ALIST depending on CONTEXTS. - -`org-agenda-custom-commands' or `org-capture-templates' are the -values used for ALIST, and `org-agenda-custom-commands-contexts' -or `org-capture-templates-contexts' are the associated contexts -definitions." - (let ((contexts - ;; normalize contexts - (mapcar - (lambda(c) (cond ((listp (cadr c)) - (list (car c) (car c) (cadr c))) - ((string= "" (cadr c)) - (list (car c) (car c) (caddr c))) - (t c))) contexts)) - (a alist) c r s) - ;; loop over all commands or templates - (while (setq c (pop a)) - (let (vrules repl) - (cond - ((not (assoc (car c) contexts)) - (push c r)) - ((and (assoc (car c) contexts) - (setq vrules (org-contextualize-validate-key - (car c) contexts))) - (mapc (lambda (vr) - (when (not (equal (car vr) (cadr vr))) - (setq repl vr))) vrules) - (if (not repl) (push c r) - (push (cadr repl) s) - (push - (cons (car c) - (cdr (or (assoc (cadr repl) alist) - (error "Undefined key `%s' as contextual replacement for `%s'" - (cadr repl) (car c))))) - r)))))) - ;; Return limited ALIST, possibly with keys modified, and deduplicated - (delq - nil - (delete-dups - (mapcar (lambda (x) - (let ((tpl (car x))) - (when (not (delq - nil - (mapcar (lambda(y) - (equal y tpl)) s))) x))) - (reverse r)))))) - -(defun org-contextualize-validate-key (key contexts) - "Check CONTEXTS for agenda or capture KEY." - (let (r rr res) - (while (setq r (pop contexts)) - (mapc - (lambda (rr) - (when - (and (equal key (car r)) - (if (functionp rr) (funcall rr) - (or (and (eq (car rr) 'in-file) - (buffer-file-name) - (string-match (cdr rr) (buffer-file-name))) - (and (eq (car rr) 'in-mode) - (string-match (cdr rr) (symbol-name major-mode))) - (and (eq (car rr) 'in-buffer) - (string-match (cdr rr) (buffer-name))) - (when (and (eq (car rr) 'not-in-file) - (buffer-file-name)) - (not (string-match (cdr rr) (buffer-file-name)))) - (when (eq (car rr) 'not-in-mode) - (not (string-match (cdr rr) (symbol-name major-mode)))) - (when (eq (car rr) 'not-in-buffer) - (not (string-match (cdr rr) (buffer-name))))))) - (push r res))) - (car (last r)))) - (delete-dups (delq nil res)))) - -(defun org-context-p (&rest contexts) - "Check if local context is any of CONTEXTS. -Possible values in the list of contexts are `table', `headline', and `item'." - (let ((pos (point))) - (goto-char (point-at-bol)) - (prog1 (or (and (memq 'table contexts) - (looking-at "[ \t]*|")) - (and (memq 'headline contexts) - (looking-at org-outline-regexp)) - (and (memq 'item contexts) - (looking-at "[ \t]*\\([-+*] \\|[0-9]+[.)] \\)")) - (and (memq 'item-body contexts) - (org-in-item-p))) - (goto-char pos)))) - -(defun org-get-local-variables () - "Return a list of all local variables in an Org mode buffer." - (let (varlist) - (with-current-buffer (get-buffer-create "*Org tmp*") - (erase-buffer) - (org-mode) - (setq varlist (buffer-local-variables))) - (kill-buffer "*Org tmp*") - (delq nil - (mapcar - (lambda (x) - (setq x - (if (symbolp x) - (list x) - (list (car x) (cdr x)))) - (if (and (not (get (car x) 'org-state)) - (string-match - "^\\(org-\\|orgtbl-\\|outline-\\|comment-\\|paragraph-\\|auto-fill\\|normal-auto-fill\\|fill-paragraph\\|indent-\\)" - (symbol-name (car x)))) - x nil)) - varlist)))) - -(defun org-clone-local-variables (from-buffer &optional regexp) - "Clone local variables from FROM-BUFFER. -Optional argument REGEXP selects variables to clone." - (mapc - (lambda (pair) - (and (symbolp (car pair)) - (or (null regexp) - (string-match regexp (symbol-name (car pair)))) - (set (make-local-variable (car pair)) - (cdr pair)))) - (buffer-local-variables from-buffer))) - -;;;###autoload -(defun org-run-like-in-org-mode (cmd) - "Run a command, pretending that the current buffer is in Org-mode. -This will temporarily bind local variables that are typically bound in -Org-mode to the values they have in Org-mode, and then interactively -call CMD." - (org-load-modules-maybe) - (unless org-local-vars - (setq org-local-vars (org-get-local-variables))) - (let (binds) - (dolist (var org-local-vars) - (when (or (not (boundp (car var))) - (eq (symbol-value (car var)) - (default-value (car var)))) - (push (list (car var) `(quote ,(cadr var))) binds))) - (eval `(let ,binds - (call-interactively (quote ,cmd)))))) - -;;;; Archiving - -(defun org-get-category (&optional pos force-refresh) - "Get the category applying to position POS." - (save-match-data - (if force-refresh (org-refresh-category-properties)) - (let ((pos (or pos (point)))) - (or (get-text-property pos 'org-category) - (progn (org-refresh-category-properties) - (get-text-property pos 'org-category)))))) - -(defun org-refresh-category-properties () - "Refresh category text properties in the buffer." - (let ((case-fold-search t) - (inhibit-read-only t) - (def-cat (cond - ((null org-category) - (if buffer-file-name - (file-name-sans-extension - (file-name-nondirectory buffer-file-name)) - "???")) - ((symbolp org-category) (symbol-name org-category)) - (t org-category))) - beg end cat pos optionp) - (org-with-silent-modifications - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (put-text-property (point) (point-max) 'org-category def-cat) - (while (re-search-forward - "^\\(#\\+CATEGORY:\\|[ \t]*:CATEGORY:\\)\\(.*\\)" nil t) - (setq pos (match-end 0) - optionp (equal (char-after (match-beginning 0)) ?#) - cat (org-trim (match-string 2))) - (if optionp - (setq beg (point-at-bol) end (point-max)) - (org-back-to-heading t) - (setq beg (point) end (org-end-of-subtree t t))) - (put-text-property beg end 'org-category cat) - (put-text-property beg end 'org-category-position beg) - (goto-char pos))))))) - -(defun org-refresh-properties (dprop tprop) - "Refresh buffer text properties. -DPROP is the drawer property and TPROP is the corresponding text -property to set." - (let ((case-fold-search t) - (inhibit-read-only t) p) - (org-with-silent-modifications - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward (concat "^[ \t]*:" dprop ": +\\(.*\\)[ \t]*$") nil t) - (setq p (org-match-string-no-properties 1)) - (save-excursion - (org-back-to-heading t) - (put-text-property - (point-at-bol) (org-end-of-subtree t t) tprop p)))))))) - - -;;;; Link Stuff - -;;; Link abbreviations - -(defun org-link-expand-abbrev (link) - "Apply replacements as defined in `org-link-abbrev-alist'." - (if (string-match "^\\([^:]*\\)\\(::?\\(.*\\)\\)?$" link) - (let* ((key (match-string 1 link)) - (as (or (assoc key org-link-abbrev-alist-local) - (assoc key org-link-abbrev-alist))) - (tag (and (match-end 2) (match-string 3 link))) - rpl) - (if (not as) - link - (setq rpl (cdr as)) - (cond - ((symbolp rpl) (funcall rpl tag)) - ((string-match "%(\\([^)]+\\))" rpl) - (replace-match - (save-match-data - (funcall (intern-soft (match-string 1 rpl)) tag)) t t rpl)) - ((string-match "%s" rpl) (replace-match (or tag "") t t rpl)) - ((string-match "%h" rpl) - (replace-match (url-hexify-string (or tag "")) t t rpl)) - (t (concat rpl tag))))) - link)) - -;;; Storing and inserting links - -(defvar org-insert-link-history nil - "Minibuffer history for links inserted with `org-insert-link'.") - -(defvar org-stored-links nil - "Contains the links stored with `org-store-link'.") - -(defvar org-store-link-plist nil - "Plist with info about the most recently link created with `org-store-link'.") - -(defvar org-link-protocols nil - "Link protocols added to Org-mode using `org-add-link-type'.") - -(defvar org-store-link-functions nil - "List of functions that are called to create and store a link. -Each function will be called in turn until one returns a non-nil -value. Each function should check if it is responsible for creating -this link (for example by looking at the major mode). -If not, it must exit and return nil. -If yes, it should return a non-nil value after a calling -`org-store-link-props' with a list of properties and values. -Special properties are: - -:type The link prefix, like \"http\". This must be given. -:link The link, like \"http://www.astro.uva.nl/~dominik\". - This is obligatory as well. -:description Optional default description for the second pair - of brackets in an Org-mode link. The user can still change - this when inserting this link into an Org-mode buffer. - -In addition to these, any additional properties can be specified -and then used in capture templates.") - -(defun org-add-link-type (type &optional follow export) - "Add TYPE to the list of `org-link-types'. -Re-compute all regular expressions depending on `org-link-types' - -FOLLOW and EXPORT are two functions. - -FOLLOW should take the link path as the single argument and do whatever -is necessary to follow the link, for example find a file or display -a mail message. - -EXPORT should format the link path for export to one of the export formats. -It should be a function accepting three arguments: - - path the path of the link, the text after the prefix (like \"http:\") - desc the description of the link, if any, or a description added by - org-export-normalize-links if there is none - format the export format, a symbol like `html' or `latex' or `ascii'.. - -The function may use the FORMAT information to return different values -depending on the format. The return value will be put literally into -the exported file. If the return value is nil, this means Org should -do what it normally does with links which do not have EXPORT defined. - -Org-mode has a built-in default for exporting links. If you are happy with -this default, there is no need to define an export function for the link -type. For a simple example of an export function, see `org-bbdb.el'." - (add-to-list 'org-link-types type t) - (org-make-link-regexps) - (if (assoc type org-link-protocols) - (setcdr (assoc type org-link-protocols) (list follow export)) - (push (list type follow export) org-link-protocols))) - -(defvar org-agenda-buffer-name) ; Defined in org-agenda.el -(defvar org-id-link-to-org-use-id) ; Defined in org-id.el - -;;;###autoload -(defun org-store-link (arg) - "\\<org-mode-map>Store an org-link to the current location. -This link is added to `org-stored-links' and can later be inserted -into an org-buffer with \\[org-insert-link]. - -For some link types, a prefix arg is interpreted. -For links to Usenet articles, arg negates `org-gnus-prefer-web-links'. -For file links, arg negates `org-context-in-file-links'. - -A double prefix arg force skipping storing functions that are not -part of Org's core. - -A triple prefix arg force storing a link for each line in the -active region." - (interactive "P") - (org-load-modules-maybe) - (if (and (equal arg '(64)) (org-region-active-p)) - (save-excursion - (let ((end (region-end))) - (goto-char (region-beginning)) - (set-mark (point)) - (while (< (point-at-eol) end) - (move-end-of-line 1) (activate-mark) - (let (current-prefix-arg) - (call-interactively 'org-store-link)) - (move-beginning-of-line 2) - (set-mark (point))))) - (org-with-limited-levels - (setq org-store-link-plist nil) - (let (link cpltxt desc description search - txt custom-id agenda-link sfuns sfunsn) - (cond - - ;; Store a link using an external link type - ((and (not (equal arg '(16))) - (setq sfuns - (delq - nil (mapcar (lambda (f) - (let (fs) (if (funcall f) (push f fs)))) - org-store-link-functions)) - sfunsn (mapcar (lambda (fu) (symbol-name (car fu))) sfuns)) - (or (and (cdr sfuns) - (funcall (intern - (completing-read - "Which function for creating the link? " - sfunsn t (car sfunsn))))) - (funcall (caar sfuns))) - (setq link (plist-get org-store-link-plist :link) - desc (or (plist-get org-store-link-plist - :description) link)))) - - ;; Store a link from a source code buffer - ((org-src-edit-buffer-p) - (let (label gc) - (while (or (not label) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (re-search-forward - (regexp-quote (format org-coderef-label-format label)) - nil t)))) - (when label (message "Label exists already") (sit-for 2)) - (setq label (read-string "Code line label: " label))) - (end-of-line 1) - (setq link (format org-coderef-label-format label)) - (setq gc (- 79 (length link))) - (if (< (current-column) gc) (org-move-to-column gc t) (insert " ")) - (insert link) - (setq link (concat "(" label ")") desc nil))) - - ;; We are in the agenda, link to referenced location - ((equal (org-bound-and-true-p org-agenda-buffer-name) (buffer-name)) - (let ((m (or (get-text-property (point) 'org-hd-marker) - (get-text-property (point) 'org-marker)))) - (when m - (org-with-point-at m - (setq agenda-link - (if (org-called-interactively-p 'any) - (call-interactively 'org-store-link) - (org-store-link nil))))))) - - ((eq major-mode 'calendar-mode) - (let ((cd (calendar-cursor-to-date))) - (setq link - (format-time-string - (car org-time-stamp-formats) - (apply 'encode-time - (list 0 0 0 (nth 1 cd) (nth 0 cd) (nth 2 cd) - nil nil nil)))) - (org-store-link-props :type "calendar" :date cd))) - - ((eq major-mode 'help-mode) - (setq link (concat "help:" (save-excursion - (goto-char (point-min)) - (looking-at "^[^ ]+") - (match-string 0)))) - (org-store-link-props :type "help")) - - ((eq major-mode 'w3-mode) - (setq cpltxt (if (and (buffer-name) - (not (string-match "Untitled" (buffer-name)))) - (buffer-name) - (url-view-url t)) - link (url-view-url t)) - (org-store-link-props :type "w3" :url (url-view-url t))) - - ((eq major-mode 'image-mode) - (setq cpltxt (concat "file:" - (abbreviate-file-name buffer-file-name)) - link cpltxt) - (org-store-link-props :type "image" :file buffer-file-name)) - - ;; In dired, store a link to the file of the current line - ((eq major-mode 'dired-mode) - (let ((file (dired-get-filename nil t))) - (setq file (if file - (abbreviate-file-name - (expand-file-name (dired-get-filename nil t))) - ;; otherwise, no file so use current directory. - default-directory)) - (setq cpltxt (concat "file:" file) - link cpltxt))) - - ((setq search (run-hook-with-args-until-success - 'org-create-file-search-functions)) - (setq link (concat "file:" (abbreviate-file-name buffer-file-name) - "::" search)) - (setq cpltxt (or description link))) - - ((and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode)) - (setq custom-id (org-entry-get nil "CUSTOM_ID")) - (cond - ;; Store a link using the target at point - ((org-in-regexp "[^<]<<\\([^<>]+\\)>>[^>]" 1) - (setq cpltxt - (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))) - "::" (match-string 1)) - link cpltxt)) - ((and (featurep 'org-id) - (or (eq org-id-link-to-org-use-id t) - (and (org-called-interactively-p 'any) - (or (eq org-id-link-to-org-use-id 'create-if-interactive) - (and (eq org-id-link-to-org-use-id - 'create-if-interactive-and-no-custom-id) - (not custom-id)))) - (and org-id-link-to-org-use-id (org-entry-get nil "ID")))) - ;; Store a link using the ID at point - (setq link (condition-case nil - (prog1 (org-id-store-link) - (setq desc (plist-get org-store-link-plist - :description))) - (error - ;; Probably before first headline, link only to file - (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer)))))))) - (t - ;; Just link to current headline - (setq cpltxt (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))))) - ;; Add a context search string - (when (org-xor org-context-in-file-links arg) - (let* ((ee (org-element-at-point)) - (et (org-element-type ee)) - (ev (plist-get (cadr ee) :value)) - (ek (plist-get (cadr ee) :key)) - (eok (and (stringp ek) (string-match "name" ek)))) - (setq txt (cond - ((org-at-heading-p) nil) - ((and (eq et 'keyword) eok) ev) - ((org-region-active-p) - (buffer-substring (region-beginning) (region-end))))) - (when (or (null txt) (string-match "\\S-" txt)) - (setq cpltxt - (concat cpltxt "::" - (condition-case nil - (org-make-org-heading-search-string txt) - (error ""))) - desc (or (and (eq et 'keyword) eok ev) - (nth 4 (ignore-errors (org-heading-components))) - "NONE"))))) - (if (string-match "::\\'" cpltxt) - (setq cpltxt (substring cpltxt 0 -2))) - (setq link cpltxt)))) - - ((buffer-file-name (buffer-base-buffer)) - ;; Just link to this file here. - (setq cpltxt (concat "file:" - (abbreviate-file-name - (buffer-file-name (buffer-base-buffer))))) - ;; Add a context string. - (when (org-xor org-context-in-file-links arg) - (setq txt (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)) - (buffer-substring (point-at-bol) (point-at-eol)))) - ;; Only use search option if there is some text. - (when (string-match "\\S-" txt) - (setq cpltxt - (concat cpltxt "::" (org-make-org-heading-search-string txt)) - desc "NONE"))) - (setq link cpltxt)) - - ((org-called-interactively-p 'interactive) - (user-error "No method for storing a link from this buffer")) - - (t (setq link nil))) - - ;; We're done setting link and desc, clean up - (if (consp link) (setq cpltxt (car link) link (cdr link))) - (setq link (or link cpltxt) - desc (or desc cpltxt)) - (cond ((equal desc "NONE") (setq desc nil)) - ((string-match org-bracket-link-analytic-regexp desc) - (let ((d0 (match-string 3 desc)) - (p0 (match-string 5 desc))) - (setq desc - (replace-regexp-in-string - org-bracket-link-regexp - (concat (or p0 d0) - (if (equal (length (match-string 0 desc)) - (length desc)) "*" "")) desc))))) - - ;; Return the link - (if (not (and (or (org-called-interactively-p 'any) - executing-kbd-macro) link)) - (or agenda-link (and link (org-make-link-string link desc))) - (push (list link desc) org-stored-links) - (message "Stored: %s" (or desc link)) - (when custom-id - (setq link (concat "file:" (abbreviate-file-name - (buffer-file-name)) "::#" custom-id)) - (push (list link desc) org-stored-links))))))) - -(defun org-store-link-props (&rest plist) - "Store link properties, extract names and addresses." - (let (x adr) - (when (setq x (plist-get plist :from)) - (setq adr (mail-extract-address-components x)) - (setq plist (plist-put plist :fromname (car adr))) - (setq plist (plist-put plist :fromaddress (nth 1 adr)))) - (when (setq x (plist-get plist :to)) - (setq adr (mail-extract-address-components x)) - (setq plist (plist-put plist :toname (car adr))) - (setq plist (plist-put plist :toaddress (nth 1 adr))))) - (let ((from (plist-get plist :from)) - (to (plist-get plist :to))) - (when (and from to org-from-is-user-regexp) - (setq plist - (plist-put plist :fromto - (if (string-match org-from-is-user-regexp from) - (concat "to %t") - (concat "from %f")))))) - (setq org-store-link-plist plist)) - -(defun org-add-link-props (&rest plist) - "Add these properties to the link property list." - (let (key value) - (while plist - (setq key (pop plist) value (pop plist)) - (setq org-store-link-plist - (plist-put org-store-link-plist key value))))) - -(defun org-email-link-description (&optional fmt) - "Return the description part of an email link. -This takes information from `org-store-link-plist' and formats it -according to FMT (default from `org-email-link-description-format')." - (setq fmt (or fmt org-email-link-description-format)) - (let* ((p org-store-link-plist) - (to (plist-get p :toaddress)) - (from (plist-get p :fromaddress)) - (table - (list - (cons "%c" (plist-get p :fromto)) - (cons "%F" (plist-get p :from)) - (cons "%f" (or (plist-get p :fromname) (plist-get p :fromaddress) "?")) - (cons "%T" (plist-get p :to)) - (cons "%t" (or (plist-get p :toname) (plist-get p :toaddress) "?")) - (cons "%s" (plist-get p :subject)) - (cons "%d" (plist-get p :date)) - (cons "%m" (plist-get p :message-id))))) - (when (string-match "%c" fmt) - ;; Check if the user wrote this message - (if (and org-from-is-user-regexp from to - (save-match-data (string-match org-from-is-user-regexp from))) - (setq fmt (replace-match "to %t" t t fmt)) - (setq fmt (replace-match "from %f" t t fmt)))) - (org-replace-escapes fmt table))) - -(defun org-make-org-heading-search-string (&optional string) - "Make search string for the current headline or STRING." - (let ((s (or string - (and (derived-mode-p 'org-mode) - (save-excursion - (org-back-to-heading t) - (org-element-property :raw-value (org-element-at-point)))))) - (lines org-context-in-file-links)) - (or string (setq s (concat "*" s))) ; Add * for headlines - (setq s (replace-regexp-in-string "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" s)) - (when (and string (integerp lines) (> lines 0)) - (let ((slines (org-split-string s "\n"))) - (when (< lines (length slines)) - (setq s (mapconcat - 'identity - (reverse (nthcdr (- (length slines) lines) - (reverse slines))) "\n"))))) - (mapconcat 'identity (org-split-string s "[ \t]+") " "))) - -(defun org-make-link-string (link &optional description) - "Make a link with brackets, consisting of LINK and DESCRIPTION." - (unless (string-match "\\S-" link) - (error "Empty link")) - (when (and description - (stringp description) - (not (string-match "\\S-" description))) - (setq description nil)) - (when (stringp description) - ;; Remove brackets from the description, they are fatal. - (while (string-match "\\[" description) - (setq description (replace-match "{" t t description))) - (while (string-match "\\]" description) - (setq description (replace-match "}" t t description)))) - (when (equal link description) - ;; No description needed, it is identical - (setq description nil)) - (when (and (not description) - (not (string-match (org-image-file-name-regexp) link)) - (not (equal link (org-link-escape link)))) - (setq description (org-extract-attributes link))) - (setq link - (cond ((string-match (org-image-file-name-regexp) link) link) - ((string-match org-link-types-re link) - (concat (match-string 1 link) - (org-link-escape (substring link (match-end 1))))) - (t (org-link-escape link)))) - (concat "[[" link "]" - (if description (concat "[" description "]") "") - "]")) - -(defconst org-link-escape-chars - '(?\ ?\[ ?\] ?\; ?\= ?\+) - "List of characters that should be escaped in link. -This is the list that is used for internal purposes.") - -(defconst org-link-escape-chars-browser - '(?\ ?\") - "List of escapes for characters that are problematic in links. -This is the list that is used before handing over to the browser.") - -(defun org-link-escape (text &optional table merge) - "Return percent escaped representation of TEXT. -TEXT is a string with the text to escape. -Optional argument TABLE is a list with characters that should be -escaped. When nil, `org-link-escape-chars' is used. -If optional argument MERGE is set, merge TABLE into -`org-link-escape-chars'." - (cond - ((and table merge) - (mapc (lambda (defchr) - (unless (member defchr table) - (setq table (cons defchr table)))) org-link-escape-chars)) - ((null table) - (setq table org-link-escape-chars))) - (mapconcat - (lambda (char) - (if (or (member char table) - (and (or (< char 32) (= char 37) (> char 126)) - org-url-hexify-p)) - (mapconcat (lambda (sequence-element) - (format "%%%.2X" sequence-element)) - (or (encode-coding-char char 'utf-8) - (error "Unable to percent escape character: %s" - (char-to-string char))) "") - (char-to-string char))) text "")) - -(defun org-link-unescape (str) - "Unhex hexified Unicode strings as returned from the JavaScript function -encodeURIComponent. E.g. `%C3%B6' is the german o-Umlaut." - (unless (and (null str) (string= "" str)) - (let ((pos 0) (case-fold-search t) unhexed) - (while (setq pos (string-match "\\(%[0-9a-f][0-9a-f]\\)+" str pos)) - (setq unhexed (org-link-unescape-compound (match-string 0 str))) - (setq str (replace-match unhexed t t str)) - (setq pos (+ pos (length unhexed)))))) - str) - -(defun org-link-unescape-compound (hex) - "Unhexify Unicode hex-chars. E.g. `%C3%B6' is the German o-Umlaut. -Note: this function also decodes single byte encodings like -`%E1' (a-acute) if not followed by another `%[A-F0-9]{2}' group." - (save-match-data - (let* ((bytes (cdr (split-string hex "%"))) - (ret "") - (eat 0) - (sum 0)) - (while bytes - (let* ((val (string-to-number (pop bytes) 16)) - (shift-xor - (if (= 0 eat) - (cond - ((>= val 252) (cons 6 252)) - ((>= val 248) (cons 5 248)) - ((>= val 240) (cons 4 240)) - ((>= val 224) (cons 3 224)) - ((>= val 192) (cons 2 192)) - (t (cons 0 0))) - (cons 6 128)))) - (if (>= val 192) (setq eat (car shift-xor))) - (setq val (logxor val (cdr shift-xor))) - (setq sum (+ (lsh sum (car shift-xor)) val)) - (if (> eat 0) (setq eat (- eat 1))) - (cond - ((= 0 eat) ;multi byte - (setq ret (concat ret (org-char-to-string sum))) - (setq sum 0)) - ((not bytes) ; single byte(s) - (setq ret (org-link-unescape-single-byte-sequence hex)))) - )) ;; end (while bytes - ret ))) - -(defun org-link-unescape-single-byte-sequence (hex) - "Unhexify hex-encoded single byte character sequences." - (mapconcat (lambda (byte) - (char-to-string (string-to-number byte 16))) - (cdr (split-string hex "%")) "")) - -(defun org-xor (a b) - "Exclusive or." - (if a (not b) b)) - -(defun org-fixup-message-id-for-http (s) - "Replace special characters in a message id, so it can be used in an http query." - (when (string-match "%" s) - (setq s (mapconcat (lambda (c) - (if (eq c ?%) - "%25" - (char-to-string c))) - s ""))) - (while (string-match "<" s) - (setq s (replace-match "%3C" t t s))) - (while (string-match ">" s) - (setq s (replace-match "%3E" t t s))) - (while (string-match "@" s) - (setq s (replace-match "%40" t t s))) - s) - -(defun org-link-prettify (link) - "Return a human-readable representation of LINK. -The car of LINK must be a raw link the cdr of LINK must be either -a link description or nil." - (let ((desc (or (cadr link) "<no description>"))) - (concat (format "%-45s" (substring desc 0 (min (length desc) 40))) - "<" (car link) ">"))) - -;;;###autoload -(defun org-insert-link-global () - "Insert a link like Org-mode does. -This command can be called in any mode to insert a link in Org-mode syntax." - (interactive) - (org-load-modules-maybe) - (org-run-like-in-org-mode 'org-insert-link)) - -(defun org-insert-all-links (&optional keep) - "Insert all links in `org-stored-links'." - (interactive "P") - (let ((links (copy-sequence org-stored-links)) l) - (while (setq l (if keep (pop links) (pop org-stored-links))) - (insert "- ") - (org-insert-link nil (car l) (or (cadr l) "<no description>")) - (insert "\n")))) - -(defun org-link-fontify-links-to-this-file () - "Fontify links to the current file in `org-stored-links'." - (let ((f (buffer-file-name)) a b) - (setq a (mapcar (lambda(l) - (let ((ll (car l))) - (when (and (string-match "^file:\\(.+\\)::" ll) - (equal f (expand-file-name (match-string 1 ll)))) - ll))) - org-stored-links)) - (when (featurep 'org-id) - (setq b (mapcar (lambda(l) - (let ((ll (car l))) - (when (and (string-match "^id:\\(.+\\)$" ll) - (equal f (expand-file-name - (or (org-id-find-id-file - (match-string 1 ll)) "")))) - ll))) - org-stored-links))) - (mapcar (lambda(l) - (put-text-property 0 (length l) 'face 'font-lock-comment-face l)) - (delq nil (append a b))))) - -(defvar org-link-links-in-this-file nil) -(defun org-insert-link (&optional complete-file link-location default-description) - "Insert a link. At the prompt, enter the link. - -Completion can be used to insert any of the link protocol prefixes like -http or ftp in use. - -The history can be used to select a link previously stored with -`org-store-link'. When the empty string is entered (i.e. if you just -press RET at the prompt), the link defaults to the most recently -stored link. As SPC triggers completion in the minibuffer, you need to -use M-SPC or C-q SPC to force the insertion of a space character. - -You will also be prompted for a description, and if one is given, it will -be displayed in the buffer instead of the link. - -If there is already a link at point, this command will allow you to edit link -and description parts. - -With a \\[universal-argument] prefix, prompts for a file to link to. The file name can -be selected using completion. The path to the file will be relative to the -current directory if the file is in the current directory or a subdirectory. -Otherwise, the link will be the absolute path as completed in the minibuffer -\(i.e. normally ~/path/to/file). You can configure this behavior using the -option `org-link-file-path-type'. - -With two \\[universal-argument] prefixes, enforce an absolute path even if the file is in -the current directory or below. - -With three \\[universal-argument] prefixes, negate the meaning of -`org-keep-stored-link-after-insertion'. - -If `org-make-link-description-function' is non-nil, this function will be -called with the link target, and the result will be the default -link description. - -If the LINK-LOCATION parameter is non-nil, this value will be -used as the link location instead of reading one interactively. - -If the DEFAULT-DESCRIPTION parameter is non-nil, this value will -be used as the default description." - (interactive "P") - (let* ((wcf (current-window-configuration)) - (origbuf (current-buffer)) - (region (if (org-region-active-p) - (buffer-substring (region-beginning) (region-end)))) - (remove (and region (list (region-beginning) (region-end)))) - (desc region) - tmphist ; byte-compile incorrectly complains about this - (link link-location) - (abbrevs org-link-abbrev-alist-local) - entry file all-prefixes auto-desc) - (cond - (link-location) ; specified by arg, just use it. - ((org-in-regexp org-bracket-link-regexp 1) - ;; We do have a link at point, and we are going to edit it. - (setq remove (list (match-beginning 0) (match-end 0))) - (setq desc (if (match-end 3) (org-match-string-no-properties 3))) - (setq link (read-string "Link: " - (org-link-unescape - (org-match-string-no-properties 1))))) - ((or (org-in-regexp org-angle-link-re) - (org-in-regexp org-plain-link-re)) - ;; Convert to bracket link - (setq remove (list (match-beginning 0) (match-end 0)) - link (read-string "Link: " - (org-remove-angle-brackets (match-string 0))))) - ((member complete-file '((4) (16))) - ;; Completing read for file names. - (setq link (org-file-complete-link complete-file))) - (t - ;; Read link, with completion for stored links. - (org-link-fontify-links-to-this-file) - (org-switch-to-buffer-other-window "*Org Links*") - (with-current-buffer "*Org Links*" - (erase-buffer) - (insert "Insert a link. -Use TAB to complete link prefixes, then RET for type-specific completion support\n") - (when org-stored-links - (insert "\nStored links are available with <up>/<down> or M-p/n (most recent with RET):\n\n") - (insert (mapconcat 'org-link-prettify - (reverse org-stored-links) "\n"))) - (goto-char (point-min))) - (let ((cw (selected-window))) - (select-window (get-buffer-window "*Org Links*" 'visible)) - (with-current-buffer "*Org Links*" (setq truncate-lines t)) - (unless (pos-visible-in-window-p (point-max)) - (org-fit-window-to-buffer)) - (and (window-live-p cw) (select-window cw))) - ;; Fake a link history, containing the stored links. - (setq tmphist (append (mapcar 'car org-stored-links) - org-insert-link-history)) - (setq all-prefixes (append (mapcar 'car abbrevs) - (mapcar 'car org-link-abbrev-alist) - org-link-types)) - (unwind-protect - (progn - (setq link - (org-completing-read - "Link: " - (append - (mapcar (lambda (x) (concat x ":")) - all-prefixes) - (mapcar 'car org-stored-links)) - nil nil nil - 'tmphist - (caar org-stored-links))) - (if (not (string-match "\\S-" link)) - (user-error "No link selected")) - (mapc (lambda(l) - (when (equal link (cadr l)) (setq link (car l) auto-desc t))) - org-stored-links) - (if (or (member link all-prefixes) - (and (equal ":" (substring link -1)) - (member (substring link 0 -1) all-prefixes) - (setq link (substring link 0 -1)))) - (setq link (with-current-buffer origbuf - (org-link-try-special-completion link))))) - (set-window-configuration wcf) - (kill-buffer "*Org Links*")) - (setq entry (assoc link org-stored-links)) - (or entry (push link org-insert-link-history)) - (setq desc (or desc (nth 1 entry))))) - - (if (funcall (if (equal complete-file '(64)) 'not 'identity) - (not org-keep-stored-link-after-insertion)) - (setq org-stored-links (delq (assoc link org-stored-links) - org-stored-links))) - - (if (and (string-match org-plain-link-re link) - (not (string-match org-ts-regexp link))) - ;; URL-like link, normalize the use of angular brackets. - (setq link (org-remove-angle-brackets link))) - - ;; Check if we are linking to the current file with a search - ;; option If yes, simplify the link by using only the search - ;; option. - (when (and buffer-file-name - (string-match "^file:\\(.+?\\)::\\(.+\\)" link)) - (let* ((path (match-string 1 link)) - (case-fold-search nil) - (search (match-string 2 link))) - (save-match-data - (if (equal (file-truename buffer-file-name) (file-truename path)) - ;; We are linking to this same file, with a search option - (setq link search))))) - - ;; Check if we can/should use a relative path. If yes, simplify the link - (when (string-match "^\\(file:\\|docview:\\)\\(.*\\)" link) - (let* ((type (match-string 1 link)) - (path (match-string 2 link)) - (origpath path) - (case-fold-search nil)) - (cond - ((or (eq org-link-file-path-type 'absolute) - (equal complete-file '(16))) - (setq path (abbreviate-file-name (expand-file-name path)))) - ((eq org-link-file-path-type 'noabbrev) - (setq path (expand-file-name path))) - ((eq org-link-file-path-type 'relative) - (setq path (file-relative-name path))) - (t - (save-match-data - (if (string-match (concat "^" (regexp-quote - (expand-file-name - (file-name-as-directory - default-directory)))) - (expand-file-name path)) - ;; We are linking a file with relative path name. - (setq path (substring (expand-file-name path) - (match-end 0))) - (setq path (abbreviate-file-name (expand-file-name path))))))) - (setq link (concat type path)) - (if (equal desc origpath) - (setq desc path)))) - - (if org-make-link-description-function - (setq desc - (or (condition-case nil - (funcall org-make-link-description-function link desc) - (error (progn (message "Can't get link description from `%s'" - (symbol-name org-make-link-description-function)) - (sit-for 2) nil))) - (read-string "Description: " default-description))) - (if default-description (setq desc default-description) - (setq desc (or (and auto-desc desc) - (read-string "Description: " desc))))) - - (unless (string-match "\\S-" desc) (setq desc nil)) - (if remove (apply 'delete-region remove)) - (insert (org-make-link-string link desc)))) - -(defun org-link-try-special-completion (type) - "If there is completion support for link type TYPE, offer it." - (let ((fun (intern (concat "org-" type "-complete-link")))) - (if (functionp fun) - (funcall fun) - (read-string "Link (no completion support): " (concat type ":"))))) - -(defun org-file-complete-link (&optional arg) - "Create a file link using completion." - (let (file link) - (setq file (org-iread-file-name "File: ")) - (let ((pwd (file-name-as-directory (expand-file-name "."))) - (pwd1 (file-name-as-directory (abbreviate-file-name - (expand-file-name "."))))) - (cond - ((equal arg '(16)) - (setq link (concat - "file:" - (abbreviate-file-name (expand-file-name file))))) - ((string-match (concat "^" (regexp-quote pwd1) "\\(.+\\)") file) - (setq link (concat "file:" (match-string 1 file)))) - ((string-match (concat "^" (regexp-quote pwd) "\\(.+\\)") - (expand-file-name file)) - (setq link (concat - "file:" (match-string 1 (expand-file-name file))))) - (t (setq link (concat "file:" file))))) - link)) - -(defun org-iread-file-name (&rest args) - "Read-file-name using `ido-mode' speedup if available. -ARGS are arguments that may be passed to `ido-read-file-name' or `read-file-name'. -See `read-file-name' for a description of parameters." - (org-without-partial-completion - (if (and org-completion-use-ido - (fboundp 'ido-read-file-name) - (boundp 'ido-mode) ido-mode - (listp (second args))) - (let ((ido-enter-matching-directory nil)) - (apply 'ido-read-file-name args)) - (apply 'read-file-name args)))) - -(defun org-completing-read (&rest args) - "Completing-read with SPACE being a normal character." - (let ((enable-recursive-minibuffers t) - (minibuffer-local-completion-map - (copy-keymap minibuffer-local-completion-map))) - (org-defkey minibuffer-local-completion-map " " 'self-insert-command) - (org-defkey minibuffer-local-completion-map "?" 'self-insert-command) - (org-defkey minibuffer-local-completion-map (kbd "C-c !") 'org-time-stamp-inactive) - (apply 'org-icompleting-read args))) - -(defun org-completing-read-no-i (&rest args) - (let (org-completion-use-ido org-completion-use-iswitchb) - (apply 'org-completing-read args))) - -(defun org-iswitchb-completing-read (prompt choices &rest args) - "Use iswitch as a completing-read replacement to choose from choices. -PROMPT is a string to prompt with. CHOICES is a list of strings to choose -from." - (let* ((iswitchb-use-virtual-buffers nil) - (iswitchb-make-buflist-hook - (lambda () - (setq iswitchb-temp-buflist choices)))) - (iswitchb-read-buffer prompt))) - -(defun org-icompleting-read (&rest args) - "Completing-read using `ido-mode' or `iswitchb' speedups if available." - (org-without-partial-completion - (if (and org-completion-use-ido - (fboundp 'ido-completing-read) - (boundp 'ido-mode) ido-mode - (listp (second args))) - (let ((ido-enter-matching-directory nil)) - (apply 'ido-completing-read (concat (car args)) - (if (consp (car (nth 1 args))) - (mapcar 'car (nth 1 args)) - (nth 1 args)) - (cddr args))) - (if (and org-completion-use-iswitchb - (boundp 'iswitchb-mode) iswitchb-mode - (listp (second args))) - (apply 'org-iswitchb-completing-read (concat (car args)) - (if (consp (car (nth 1 args))) - (mapcar 'car (nth 1 args)) - (nth 1 args)) - (cddr args)) - (apply 'completing-read args))))) - -(defun org-extract-attributes (s) - "Extract the attributes cookie from a string and set as text property." - (let (a attr (start 0) key value) - (save-match-data - (when (string-match "{{\\([^}]+\\)}}$" s) - (setq a (match-string 1 s) s (substring s 0 (match-beginning 0))) - (while (string-match "\\([a-zA-Z]+\\)=\"\\([^\"]*\\)\"" a start) - (setq key (match-string 1 a) value (match-string 2 a) - start (match-end 0) - attr (plist-put attr (intern key) value)))) - (org-add-props s nil 'org-attr attr)) - s)) - -;;; Opening/following a link - -(defvar org-link-search-failed nil) - -(defvar org-open-link-functions nil - "Hook for functions finding a plain text link. -These functions must take a single argument, the link content. -They will be called for links that look like [[link text][description]] -when LINK TEXT does not have a protocol like \"http:\" and does not look -like a filename (e.g. \"./blue.png\"). - -These functions will be called *before* Org attempts to resolve the -link by doing text searches in the current buffer - so if you want a -link \"[[target]]\" to still find \"<<target>>\", your function should -handle this as a special case. - -When the function does handle the link, it must return a non-nil value. -If it decides that it is not responsible for this link, it must return -nil to indicate that that Org-mode can continue with other options -like exact and fuzzy text search.") - -(defun org-next-link (&optional search-backward) - "Move forward to the next link. -If the link is in hidden text, expose it." - (interactive "P") - (when (and org-link-search-failed (eq this-command last-command)) - (goto-char (point-min)) - (message "Link search wrapped back to beginning of buffer")) - (setq org-link-search-failed nil) - (let* ((pos (point)) - (ct (org-context)) - (a (assoc :link ct)) - (srch-fun (if search-backward 're-search-backward 're-search-forward))) - (cond (a (goto-char (nth (if search-backward 1 2) a))) - ((looking-at org-any-link-re) - ;; Don't stay stuck at link without an org-link face - (forward-char (if search-backward -1 1)))) - (if (funcall srch-fun org-any-link-re nil t) - (progn - (goto-char (match-beginning 0)) - (if (outline-invisible-p) (org-show-context))) - (goto-char pos) - (setq org-link-search-failed t) - (message "No further link found")))) - -(defun org-previous-link () - "Move backward to the previous link. -If the link is in hidden text, expose it." - (interactive) - (funcall 'org-next-link t)) - -(defun org-translate-link (s) - "Translate a link string if a translation function has been defined." - (if (and org-link-translation-function - (fboundp org-link-translation-function) - (string-match "\\([a-zA-Z0-9]+\\):\\(.*\\)" s)) - (progn - (setq s (funcall org-link-translation-function - (match-string 1 s) (match-string 2 s))) - (concat (car s) ":" (cdr s))) - s)) - -(defun org-translate-link-from-planner (type path) - "Translate a link from Emacs Planner syntax so that Org can follow it. -This is still an experimental function, your mileage may vary." - (cond - ((member type '("http" "https" "news" "ftp")) - ;; standard Internet links are the same. - nil) - ((and (equal type "irc") (string-match "^//" path)) - ;; Planner has two / at the beginning of an irc link, we have 1. - ;; We should have zero, actually.... - (setq path (substring path 1))) - ((and (equal type "lisp") (string-match "^/" path)) - ;; Planner has a slash, we do not. - (setq type "elisp" path (substring path 1))) - ((string-match "^//\\(.?*\\)/\\(<.*>\\)$" path) - ;; A typical message link. Planner has the id after the final slash, - ;; we separate it with a hash mark - (setq path (concat (match-string 1 path) "#" - (org-remove-angle-brackets (match-string 2 path)))))) - (cons type path)) - -(defun org-find-file-at-mouse (ev) - "Open file link or URL at mouse." - (interactive "e") - (mouse-set-point ev) - (org-open-at-point 'in-emacs)) - -(defun org-open-at-mouse (ev) - "Open file link or URL at mouse. -See the docstring of `org-open-file' for details." - (interactive "e") - (mouse-set-point ev) - (if (eq major-mode 'org-agenda-mode) - (org-agenda-copy-local-variable 'org-link-abbrev-alist-local)) - (org-open-at-point)) - -(defvar org-window-config-before-follow-link nil - "The window configuration before following a link. -This is saved in case the need arises to restore it.") - -(defvar org-open-link-marker (make-marker) - "Marker pointing to the location where `org-open-at-point; was called.") - -;;;###autoload -(defun org-open-at-point-global () - "Follow a link like Org-mode does. -This command can be called in any mode to follow a link that has -Org-mode syntax." - (interactive) - (org-run-like-in-org-mode 'org-open-at-point)) - -;;;###autoload -(defun org-open-link-from-string (s &optional arg reference-buffer) - "Open a link in the string S, as if it was in Org-mode." - (interactive "sLink: \nP") - (let ((reference-buffer (or reference-buffer (current-buffer)))) - (with-temp-buffer - (let ((org-inhibit-startup (not reference-buffer))) - (org-mode) - (insert s) - (goto-char (point-min)) - (when reference-buffer - (setq org-link-abbrev-alist-local - (with-current-buffer reference-buffer - org-link-abbrev-alist-local))) - (org-open-at-point arg reference-buffer))))) - -(defvar org-open-at-point-functions nil - "Hook that is run when following a link at point. - -Functions in this hook must return t if they identify and follow -a link at point. If they don't find anything interesting at point, -they must return nil.") - -(defvar org-link-search-inhibit-query nil) ;; dynamically scoped -(defvar clean-buffer-list-kill-buffer-names) ; Defined in midnight.el -(defun org-open-at-point (&optional arg reference-buffer) - "Open link at or after point. -If there is no link at point, this function will search forward up to -the end of the current line. -Normally, files will be opened by an appropriate application. If the -optional prefix argument ARG is non-nil, Emacs will visit the file. -With a double prefix argument, try to open outside of Emacs, in the -application the system uses for this file type." - (interactive "P") - ;; if in a code block, then open the block's results - (unless (call-interactively #'org-babel-open-src-block-result) - (org-load-modules-maybe) - (move-marker org-open-link-marker (point)) - (setq org-window-config-before-follow-link (current-window-configuration)) - (org-remove-occur-highlights nil nil t) - (cond - ((and (org-at-heading-p) - (not (org-at-timestamp-p t)) - (not (org-in-regexp - (concat org-plain-link-re "\\|" - org-bracket-link-regexp "\\|" - org-angle-link-re "\\|" - "[ \t]:[^ \t\n]+:[ \t]*$"))) - (not (get-text-property (point) 'org-linked-text))) - (or (let* ((lkall (org-offer-links-in-entry (current-buffer) (point) arg)) - (lk0 (car lkall)) - (lk (if (stringp lk0) (list lk0) lk0)) - (lkend (cdr lkall))) - (mapcar (lambda(l) - (search-forward l nil lkend) - (goto-char (match-beginning 0)) - (org-open-at-point)) - lk)) - (progn (require 'org-attach) (org-attach-reveal 'if-exists)))) - ((run-hook-with-args-until-success 'org-open-at-point-functions)) - ((and (org-at-timestamp-p t) - (not (org-in-regexp org-bracket-link-regexp))) - (org-follow-timestamp-link)) - ((and (or (org-footnote-at-reference-p) (org-footnote-at-definition-p)) - (not (org-in-regexp org-any-link-re))) - (org-footnote-action)) - (t - (let (type path link line search (pos (point))) - (catch 'match - (save-excursion - (skip-chars-forward "^]\n\r") - (when (org-in-regexp org-bracket-link-regexp 1) - (setq link (org-extract-attributes - (org-link-unescape (org-match-string-no-properties 1)))) - (while (string-match " *\n *" link) - (setq link (replace-match " " t t link))) - (setq link (org-link-expand-abbrev link)) - (cond - ((or (file-name-absolute-p link) - (string-match "^\\.\\.?/" link)) - (setq type "file" path link)) - ((string-match org-link-re-with-space3 link) - (setq type (match-string 1 link) path (match-string 2 link))) - ((string-match "^help:+\\(.+\\)" link) - (setq type "help" path (match-string 1 link))) - (t (setq type "thisfile" path link))) - (throw 'match t))) - - (when (get-text-property (point) 'org-linked-text) - (setq type "thisfile" - pos (if (get-text-property (1+ (point)) 'org-linked-text) - (1+ (point)) (point)) - path (buffer-substring - (or (previous-single-property-change pos 'org-linked-text) - (point-min)) - (or (next-single-property-change pos 'org-linked-text) - (point-max))) - ;; Ensure we will search for a <<<radio>>> link, not - ;; a simple reference like <<ref>> - path (concat "<" path)) - (throw 'match t)) - - (save-excursion - (when (or (org-in-regexp org-angle-link-re) - (let ((match (org-in-regexp org-plain-link-re))) - ;; Check a plain link is not within a bracket link - (and match - (save-excursion - (progn - (goto-char (car match)) - (not (org-in-regexp org-bracket-link-regexp)))))) - (let ((line_ending (save-excursion (end-of-line) (point)))) - ;; We are in a line before a plain or bracket link - (or (re-search-forward org-plain-link-re line_ending t) - (re-search-forward org-bracket-link-regexp line_ending t)))) - (setq type (match-string 1) - path (org-link-unescape (match-string 2))) - (throw 'match t))) - (save-excursion - (when (org-in-regexp (org-re "\\(:[[:alnum:]_@#%:]+\\):[ \t]*$")) - (setq type "tags" - path (match-string 1)) - (while (string-match ":" path) - (setq path (replace-match "+" t t path))) - (throw 'match t))) - (when (org-in-regexp "<\\([^><\n]+\\)>") - (setq type "tree-match" - path (match-string 1)) - (throw 'match t))) - (unless path - (user-error "No link found")) - - ;; switch back to reference buffer - ;; needed when if called in a temporary buffer through - ;; org-open-link-from-string - (with-current-buffer (or reference-buffer (current-buffer)) - - ;; Remove any trailing spaces in path - (if (string-match " +\\'" path) - (setq path (replace-match "" t t path))) - (if (and org-link-translation-function - (fboundp org-link-translation-function)) - ;; Check if we need to translate the link - (let ((tmp (funcall org-link-translation-function type path))) - (setq type (car tmp) path (cdr tmp)))) - - (cond - - ((assoc type org-link-protocols) - (funcall (nth 1 (assoc type org-link-protocols)) path)) - - ((equal type "help") - (let ((f-or-v (intern path))) - (cond ((fboundp f-or-v) - (describe-function f-or-v)) - ((boundp f-or-v) - (describe-variable f-or-v)) - (t (error "Not a known function or variable"))))) - - ((equal type "mailto") - (let ((cmd (car org-link-mailto-program)) - (args (cdr org-link-mailto-program)) args1 - (address path) (subject "") a) - (if (string-match "\\(.*\\)::\\(.*\\)" path) - (setq address (match-string 1 path) - subject (org-link-escape (match-string 2 path)))) - (while args - (cond - ((not (stringp (car args))) (push (pop args) args1)) - (t (setq a (pop args)) - (if (string-match "%a" a) - (setq a (replace-match address t t a))) - (if (string-match "%s" a) - (setq a (replace-match subject t t a))) - (push a args1)))) - (apply cmd (nreverse args1)))) - - ((member type '("http" "https" "ftp" "news")) - (browse-url - (concat type ":" - (if (org-string-match-p - (concat "[[:nonascii:]" - org-link-escape-chars-browser "]") - path) - (org-link-escape path org-link-escape-chars-browser) - path)))) - - ((string= type "doi") - (browse-url - (concat org-doi-server-url - (if (org-string-match-p - (concat "[[:nonascii:]" - org-link-escape-chars-browser "]") - path) - (org-link-escape path org-link-escape-chars-browser) - path)))) - - ((member type '("message")) - (browse-url (concat type ":" path))) - - ((string= type "tags") - (org-tags-view arg path)) - - ((string= type "tree-match") - (org-occur (concat "\\[" (regexp-quote path) "\\]"))) - - ((string= type "file") - (if (string-match "::\\([0-9]+\\)\\'" path) - (setq line (string-to-number (match-string 1 path)) - path (substring path 0 (match-beginning 0))) - (if (string-match "::\\(.+\\)\\'" path) - (setq search (match-string 1 path) - path (substring path 0 (match-beginning 0))))) - (if (string-match "[*?{]" (file-name-nondirectory path)) - (dired path) - (org-open-file path arg line search))) - - ((string= type "shell") - (let ((buf (generate-new-buffer "*Org Shell Output")) - (cmd path)) - (if (or (and (not (string= org-confirm-shell-link-not-regexp "")) - (string-match org-confirm-shell-link-not-regexp cmd)) - (not org-confirm-shell-link-function) - (funcall org-confirm-shell-link-function - (format "Execute \"%s\" in shell? " - (org-add-props cmd nil - 'face 'org-warning)))) - (progn - (message "Executing %s" cmd) - (shell-command cmd buf) - (if (featurep 'midnight) - (setq clean-buffer-list-kill-buffer-names - (cons buf clean-buffer-list-kill-buffer-names)))) - (error "Abort")))) - - ((string= type "elisp") - (let ((cmd path)) - (if (or (and (not (string= org-confirm-elisp-link-not-regexp "")) - (string-match org-confirm-elisp-link-not-regexp cmd)) - (not org-confirm-elisp-link-function) - (funcall org-confirm-elisp-link-function - (format "Execute \"%s\" as elisp? " - (org-add-props cmd nil - 'face 'org-warning)))) - (message "%s => %s" cmd - (if (equal (string-to-char cmd) ?\() - (eval (read cmd)) - (call-interactively (read cmd)))) - (error "Abort")))) - - ((and (string= type "thisfile") - (or (run-hook-with-args-until-success - 'org-open-link-functions path) - (and link - (string-match "^id:" link) - (or (featurep 'org-id) (require 'org-id)) - (progn - (funcall (nth 1 (assoc "id" org-link-protocols)) - (substring path 3)) - t))))) - - ((string= type "thisfile") - (if arg - (switch-to-buffer-other-window - (org-get-buffer-for-internal-link (current-buffer))) - (org-mark-ring-push)) - (let ((cmd `(org-link-search - ,path - ,(cond ((equal arg '(4)) ''occur) - ((equal arg '(16)) ''org-occur)) - ,pos))) - (condition-case nil (let ((org-link-search-inhibit-query t)) - (eval cmd)) - (error (progn (widen) (eval cmd)))))) - - (t (browse-url-at-point))))))) - (move-marker org-open-link-marker nil) - (run-hook-with-args 'org-follow-link-hook))) - -(defun org-offer-links-in-entry (buffer marker &optional nth zero) - "Offer links in the current entry and return the selected link. -If there is only one link, return it. -If NTH is an integer, return the NTH link found. -If ZERO is a string, check also this string for a link, and if -there is one, return it." - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char marker) - (let ((re (concat "\\(" org-bracket-link-regexp "\\)\\|" - "\\(" org-angle-link-re "\\)\\|" - "\\(" org-plain-link-re "\\)")) - (cnt ?0) - (in-emacs (if (integerp nth) nil nth)) - have-zero end links link c) - (when (and (stringp zero) (string-match org-bracket-link-regexp zero)) - (push (match-string 0 zero) links) - (setq cnt (1- cnt) have-zero t)) - (save-excursion - (org-back-to-heading t) - (setq end (save-excursion (outline-next-heading) (point))) - (while (re-search-forward re end t) - (push (match-string 0) links)) - (setq links (org-uniquify (reverse links)))) - (cond - ((null links) - (message "No links")) - ((equal (length links) 1) - (setq link (car links))) - ((and (integerp nth) (>= (length links) (if have-zero (1+ nth) nth))) - (setq link (nth (if have-zero nth (1- nth)) links))) - (t ; we have to select a link - (save-excursion - (save-window-excursion - (delete-other-windows) - (with-output-to-temp-buffer "*Select Link*" - (mapc (lambda (l) - (if (not (string-match org-bracket-link-regexp l)) - (princ (format "[%c] %s\n" (incf cnt) - (org-remove-angle-brackets l))) - (if (match-end 3) - (princ (format "[%c] %s (%s)\n" (incf cnt) - (match-string 3 l) (match-string 1 l))) - (princ (format "[%c] %s\n" (incf cnt) - (match-string 1 l)))))) - links)) - (org-fit-window-to-buffer (get-buffer-window "*Select Link*")) - (message "Select link to open, RET to open all:") - (setq c (read-char-exclusive)) - (and (get-buffer "*Select Link*") (kill-buffer "*Select Link*")))) - (when (equal c ?q) (error "Abort")) - (if (equal c ?\C-m) - (setq link links) - (setq nth (- c ?0)) - (if have-zero (setq nth (1+ nth))) - (unless (and (integerp nth) (>= (length links) nth)) - (user-error "Invalid link selection")) - (setq link (nth (1- nth) links))))) - (cons link end)))))) - -;; Add special file links that specify the way of opening - -(org-add-link-type "file+sys" 'org-open-file-with-system) -(org-add-link-type "file+emacs" 'org-open-file-with-emacs) -(defun org-open-file-with-system (path) - "Open file at PATH using the system way of opening it." - (org-open-file path 'system)) -(defun org-open-file-with-emacs (path) - "Open file at PATH in Emacs." - (org-open-file path 'emacs)) - - -;;; File search - -(defvar org-create-file-search-functions nil - "List of functions to construct the right search string for a file link. -These functions are called in turn with point at the location to -which the link should point. - -A function in the hook should first test if it would like to -handle this file type, for example by checking the `major-mode' -or the file extension. If it decides not to handle this file, it -should just return nil to give other functions a chance. If it -does handle the file, it must return the search string to be used -when following the link. The search string will be part of the -file link, given after a double colon, and `org-open-at-point' -will automatically search for it. If special measures must be -taken to make the search successful, another function should be -added to the companion hook `org-execute-file-search-functions', -which see. - -A function in this hook may also use `setq' to set the variable -`description' to provide a suggestion for the descriptive text to -be used for this link when it gets inserted into an Org-mode -buffer with \\[org-insert-link].") - -(defvar org-execute-file-search-functions nil - "List of functions to execute a file search triggered by a link. - -Functions added to this hook must accept a single argument, the -search string that was part of the file link, the part after the -double colon. The function must first check if it would like to -handle this search, for example by checking the `major-mode' or -the file extension. If it decides not to handle this search, it -should just return nil to give other functions a chance. If it -does handle the search, it must return a non-nil value to keep -other functions from trying. - -Each function can access the current prefix argument through the -variable `current-prefix-arg'. Note that a single prefix is used -to force opening a link in Emacs, so it may be good to only use a -numeric or double prefix to guide the search function. - -In case this is needed, a function in this hook can also restore -the window configuration before `org-open-at-point' was called using: - - (set-window-configuration org-window-config-before-follow-link)") - -(defun org-link-search (s &optional type avoid-pos stealth) - "Search for a link search option. -If S is surrounded by forward slashes, it is interpreted as a -regular expression. In org-mode files, this will create an `org-occur' -sparse tree. In ordinary files, `occur' will be used to list matches. -If the current buffer is in `dired-mode', grep will be used to search -in all files. If AVOID-POS is given, ignore matches near that position. - -When optional argument STEALTH is non-nil, do not modify -visibility around point, thus ignoring -`org-show-hierarchy-above', `org-show-following-heading' and -`org-show-siblings' variables." - (let ((case-fold-search t) - (s0 (mapconcat 'identity (org-split-string s "[ \t\r\n]+") " ")) - (markers (concat "\\(?:" (mapconcat (lambda (x) (regexp-quote (car x))) - (append '(("") (" ") ("\t") ("\n")) - org-emphasis-alist) - "\\|") "\\)")) - (pos (point)) - (pre nil) (post nil) - words re0 re1 re2 re3 re4_ re4 re5 re2a re2a_ reall) - (cond - ;; First check if there are any special search functions - ((run-hook-with-args-until-success 'org-execute-file-search-functions s)) - ;; Now try the builtin stuff - ((and (equal (string-to-char s0) ?#) - (> (length s0) 1) - (save-excursion - (goto-char (point-min)) - (and - (re-search-forward - (concat "^[ \t]*:CUSTOM_ID:[ \t]+" - (regexp-quote (substring s0 1)) "[ \t]*$") nil t) - (setq type 'dedicated - pos (match-beginning 0)))) - ;; There is an exact target for this - (goto-char pos) - (org-back-to-heading t))) - ((save-excursion - (goto-char (point-min)) - (and - (re-search-forward - (concat "<<" (regexp-quote s0) ">>") nil t) - (setq type 'dedicated - pos (match-beginning 0)))) - ;; There is an exact target for this - (goto-char pos)) - ((save-excursion - (goto-char (point-min)) - (and - (re-search-forward - (format "^[ \t]*#\\+NAME: %s" (regexp-quote s0)) nil t) - (setq type 'dedicated pos (match-beginning 0)))) - ;; Found an element with a matching #+name affiliated keyword. - (goto-char pos)) - ((and (string-match "^(\\(.*\\))$" s0) - (save-excursion - (goto-char (point-min)) - (and - (re-search-forward - (concat "[^[]" (regexp-quote - (format org-coderef-label-format - (match-string 1 s0)))) - nil t) - (setq type 'dedicated - pos (1+ (match-beginning 0)))))) - ;; There is a coderef target for this - (goto-char pos)) - ((string-match "^/\\(.*\\)/$" s) - ;; A regular expression - (cond - ((derived-mode-p 'org-mode) - (org-occur (match-string 1 s))) - (t (org-do-occur (match-string 1 s))))) - ((and (derived-mode-p 'org-mode) org-link-search-must-match-exact-headline) - (and (equal (string-to-char s) ?*) (setq s (substring s 1))) - (goto-char (point-min)) - (cond - ((let (case-fold-search) - (re-search-forward (format org-complex-heading-regexp-format - (regexp-quote s)) - nil t)) - ;; OK, found a match - (setq type 'dedicated) - (goto-char (match-beginning 0))) - ((and (not org-link-search-inhibit-query) - (eq org-link-search-must-match-exact-headline 'query-to-create) - (y-or-n-p "No match - create this as a new heading? ")) - (goto-char (point-max)) - (or (bolp) (newline)) - (insert "* " s "\n") - (beginning-of-line 0)) - (t - (goto-char pos) - (error "No match")))) - (t - ;; A normal search string - (when (equal (string-to-char s) ?*) - ;; Anchor on headlines, post may include tags. - (setq pre "^\\*+[ \t]+\\(?:\\sw+\\)?[ \t]*" - post (org-re "[ \t]*\\(?:[ \t]+:[[:alnum:]_@#%:+]:[ \t]*\\)?$") - s (substring s 1))) - (remove-text-properties - 0 (length s) - '(face nil mouse-face nil keymap nil fontified nil) s) - ;; Make a series of regular expressions to find a match - (setq words (org-split-string s "[ \n\r\t]+") - - re0 (concat "\\(<<" (regexp-quote s0) ">>\\)") - re2 (concat markers "\\(" (mapconcat 'downcase words "[ \t]+") - "\\)" markers) - re2a_ (concat "\\(" (mapconcat 'downcase words - "[ \t\r\n]+") "\\)[ \t\r\n]") - re2a (concat "[ \t\r\n]" re2a_) - re4_ (concat "\\(" (mapconcat 'downcase words - "[^a-zA-Z_\r\n]+") "\\)[^a-zA-Z_]") - re4 (concat "[^a-zA-Z_]" re4_) - - re1 (concat pre re2 post) - re3 (concat pre (if pre re4_ re4) post) - re5 (concat pre ".*" re4) - re2 (concat pre re2) - re2a (concat pre (if pre re2a_ re2a)) - re4 (concat pre (if pre re4_ re4)) - reall (concat "\\(" re0 "\\)\\|\\(" re1 "\\)\\|\\(" re2 - "\\)\\|\\(" re3 "\\)\\|\\(" re4 "\\)\\|\\(" - re5 "\\)")) - (cond - ((eq type 'org-occur) (org-occur reall)) - ((eq type 'occur) (org-do-occur (downcase reall) 'cleanup)) - (t (goto-char (point-min)) - (setq type 'fuzzy) - (if (or (and (org-search-not-self 1 re0 nil t) - (setq type 'dedicated)) - (org-search-not-self 1 re1 nil t) - (org-search-not-self 1 re2 nil t) - (org-search-not-self 1 re2a nil t) - (org-search-not-self 1 re3 nil t) - (org-search-not-self 1 re4 nil t) - (org-search-not-self 1 re5 nil t)) - (goto-char (match-beginning 1)) - (goto-char pos) - (error "No match")))))) - (and (derived-mode-p 'org-mode) - (not stealth) - (org-show-context 'link-search)) - type)) - -(defun org-search-not-self (group &rest args) - "Execute `re-search-forward', but only accept matches that do not -enclose the position of `org-open-link-marker'." - (let ((m org-open-link-marker)) - (catch 'exit - (while (apply 're-search-forward args) - (unless (get-text-property (match-end group) 'intangible) ; Emacs 21 - (goto-char (match-end group)) - (if (and (or (not (eq (marker-buffer m) (current-buffer))) - (> (match-beginning 0) (marker-position m)) - (< (match-end 0) (marker-position m))) - (save-match-data - (or (not (org-in-regexp - org-bracket-link-analytic-regexp 1)) - (not (match-end 4)) ; no description - (and (<= (match-beginning 4) (point)) - (>= (match-end 4) (point)))))) - (throw 'exit (point)))))))) - -(defun org-get-buffer-for-internal-link (buffer) - "Return a buffer to be used for displaying the link target of internal links." - (cond - ((not org-display-internal-link-with-indirect-buffer) - buffer) - ((string-match "(Clone)$" (buffer-name buffer)) - (message "Buffer is already a clone, not making another one") - ;; we also do not modify visibility in this case - buffer) - (t ; make a new indirect buffer for displaying the link - (let* ((bn (buffer-name buffer)) - (ibn (concat bn "(Clone)")) - (ib (or (get-buffer ibn) (make-indirect-buffer buffer ibn 'clone)))) - (with-current-buffer ib (org-overview)) - ib)))) - -(defun org-do-occur (regexp &optional cleanup) - "Call the Emacs command `occur'. -If CLEANUP is non-nil, remove the printout of the regular expression -in the *Occur* buffer. This is useful if the regex is long and not useful -to read." - (occur regexp) - (when cleanup - (let ((cwin (selected-window)) win beg end) - (when (setq win (get-buffer-window "*Occur*")) - (select-window win)) - (goto-char (point-min)) - (when (re-search-forward "match[a-z]+" nil t) - (setq beg (match-end 0)) - (if (re-search-forward "^[ \t]*[0-9]+" nil t) - (setq end (1- (match-beginning 0))))) - (and beg end (let ((inhibit-read-only t)) (delete-region beg end))) - (goto-char (point-min)) - (select-window cwin)))) - -;;; The mark ring for links jumps - -(defvar org-mark-ring nil - "Mark ring for positions before jumps in Org-mode.") -(defvar org-mark-ring-last-goto nil - "Last position in the mark ring used to go back.") -;; Fill and close the ring -(setq org-mark-ring nil org-mark-ring-last-goto nil) ;; in case file is reloaded -(loop for i from 1 to org-mark-ring-length do - (push (make-marker) org-mark-ring)) -(setcdr (nthcdr (1- org-mark-ring-length) org-mark-ring) - org-mark-ring) - -(defun org-mark-ring-push (&optional pos buffer) - "Put the current position or POS into the mark ring and rotate it." - (interactive) - (setq pos (or pos (point))) - (setq org-mark-ring (nthcdr (1- org-mark-ring-length) org-mark-ring)) - (move-marker (car org-mark-ring) - (or pos (point)) - (or buffer (current-buffer))) - (message "%s" - (substitute-command-keys - "Position saved to mark ring, go back with \\[org-mark-ring-goto]."))) - -(defun org-mark-ring-goto (&optional n) - "Jump to the previous position in the mark ring. -With prefix arg N, jump back that many stored positions. When -called several times in succession, walk through the entire ring. -Org-mode commands jumping to a different position in the current file, -or to another Org-mode file, automatically push the old position -onto the ring." - (interactive "p") - (let (p m) - (if (eq last-command this-command) - (setq p (nthcdr n (or org-mark-ring-last-goto org-mark-ring))) - (setq p org-mark-ring)) - (setq org-mark-ring-last-goto p) - (setq m (car p)) - (org-pop-to-buffer-same-window (marker-buffer m)) - (goto-char m) - (if (or (outline-invisible-p) (org-invisible-p2)) (org-show-context 'mark-goto)))) - -(defun org-remove-angle-brackets (s) - (if (equal (substring s 0 1) "<") (setq s (substring s 1))) - (if (equal (substring s -1) ">") (setq s (substring s 0 -1))) - s) -(defun org-add-angle-brackets (s) - (if (equal (substring s 0 1) "<") nil (setq s (concat "<" s))) - (if (equal (substring s -1) ">") nil (setq s (concat s ">"))) - s) -(defun org-remove-double-quotes (s) - (if (equal (substring s 0 1) "\"") (setq s (substring s 1))) - (if (equal (substring s -1) "\"") (setq s (substring s 0 -1))) - s) - -;;; Following specific links - -(defun org-follow-timestamp-link () - "Open an agenda view for the time-stamp date/range at point." - (cond - ((org-at-date-range-p t) - (let ((org-agenda-start-on-weekday) - (t1 (match-string 1)) - (t2 (match-string 2)) tt1 tt2) - (setq tt1 (time-to-days (org-time-string-to-time t1)) - tt2 (time-to-days (org-time-string-to-time t2))) - (let ((org-agenda-buffer-tmp-name - (format "*Org Agenda(a:%s)" - (concat (substring t1 0 10) "--" (substring t2 0 10))))) - (org-agenda-list nil tt1 (1+ (- tt2 tt1)))))) - ((org-at-timestamp-p t) - (let ((org-agenda-buffer-tmp-name - (format "*Org Agenda(a:%s)" (substring (match-string 1) 0 10)))) - (org-agenda-list nil (time-to-days (org-time-string-to-time - (substring (match-string 1) 0 10))) - 1))) - (t (error "This should not happen")))) - - -;;; Following file links -(declare-function mailcap-parse-mailcaps "mailcap" (&optional path force)) -(declare-function mailcap-extension-to-mime "mailcap" (extn)) -(declare-function mailcap-mime-info - "mailcap" (string &optional request no-decode)) -(defvar org-wait nil) -(defun org-open-file (path &optional in-emacs line search) - "Open the file at PATH. -First, this expands any special file name abbreviations. Then the -configuration variable `org-file-apps' is checked if it contains an -entry for this file type, and if yes, the corresponding command is launched. - -If no application is found, Emacs simply visits the file. - -With optional prefix argument IN-EMACS, Emacs will visit the file. -With a double \\[universal-argument] \\[universal-argument] \ -prefix arg, Org tries to avoid opening in Emacs -and to use an external application to visit the file. - -Optional LINE specifies a line to go to, optional SEARCH a string -to search for. If LINE or SEARCH is given, the file will be -opened in Emacs, unless an entry from org-file-apps that makes -use of groups in a regexp matches. - -If you want to change the way frames are used when following a -link, please customize `org-link-frame-setup'. - -If the file does not exist, an error is thrown." - (let* ((file (if (equal path "") - buffer-file-name - (substitute-in-file-name (expand-file-name path)))) - (file-apps (append org-file-apps (org-default-apps))) - (apps (org-remove-if - 'org-file-apps-entry-match-against-dlink-p file-apps)) - (apps-dlink (org-remove-if-not - 'org-file-apps-entry-match-against-dlink-p file-apps)) - (remp (and (assq 'remote apps) (org-file-remote-p file))) - (dirp (if remp nil (file-directory-p file))) - (file (if (and dirp org-open-directory-means-index-dot-org) - (concat (file-name-as-directory file) "index.org") - file)) - (a-m-a-p (assq 'auto-mode apps)) - (dfile (downcase file)) - ;; reconstruct the original file: link from the PATH, LINE and SEARCH args - (link (cond ((and (eq line nil) - (eq search nil)) - file) - (line - (concat file "::" (number-to-string line))) - (search - (concat file "::" search)))) - (dlink (downcase link)) - (old-buffer (current-buffer)) - (old-pos (point)) - (old-mode major-mode) - ext cmd link-match-data) - (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\.gz\\)$" dfile) - (setq ext (match-string 1 dfile)) - (if (string-match "^.*\\.\\([a-zA-Z0-9]+\\)$" dfile) - (setq ext (match-string 1 dfile)))) - (cond - ((member in-emacs '((16) system)) - (setq cmd (cdr (assoc 'system apps)))) - (in-emacs (setq cmd 'emacs)) - (t - (setq cmd (or (and remp (cdr (assoc 'remote apps))) - (and dirp (cdr (assoc 'directory apps))) - ; first, try matching against apps-dlink - ; if we get a match here, store the match data for later - (let ((match (assoc-default dlink apps-dlink - 'string-match))) - (if match - (progn (setq link-match-data (match-data)) - match) - (progn (setq in-emacs (or in-emacs line search)) - nil))) ; if we have no match in apps-dlink, - ; always open the file in emacs if line or search - ; is given (for backwards compatibility) - (assoc-default dfile (org-apps-regexp-alist apps a-m-a-p) - 'string-match) - (cdr (assoc ext apps)) - (cdr (assoc t apps)))))) - (when (eq cmd 'system) - (setq cmd (cdr (assoc 'system apps)))) - (when (eq cmd 'default) - (setq cmd (cdr (assoc t apps)))) - (when (eq cmd 'mailcap) - (require 'mailcap) - (mailcap-parse-mailcaps) - (let* ((mime-type (mailcap-extension-to-mime (or ext ""))) - (command (mailcap-mime-info mime-type))) - (if (stringp command) - (setq cmd command) - (setq cmd 'emacs)))) - (if (and (not (eq cmd 'emacs)) ; Emacs has no problems with non-ex files - (not (file-exists-p file)) - (not org-open-non-existing-files)) - (user-error "No such file: %s" file)) - (cond - ((and (stringp cmd) (not (string-match "^\\s-*$" cmd))) - ;; Remove quotes around the file name - we'll use shell-quote-argument. - (while (string-match "['\"]%s['\"]" cmd) - (setq cmd (replace-match "%s" t t cmd))) - (while (string-match "%s" cmd) - (setq cmd (replace-match - (save-match-data - (shell-quote-argument - (convert-standard-filename file))) - t t cmd))) - - ;; Replace "%1", "%2" etc. in command with group matches from regex - (save-match-data - (let ((match-index 1) - (number-of-groups (- (/ (length link-match-data) 2) 1))) - (set-match-data link-match-data) - (while (<= match-index number-of-groups) - (let ((regex (concat "%" (number-to-string match-index))) - (replace-with (match-string match-index dlink))) - (while (string-match regex cmd) - (setq cmd (replace-match replace-with t t cmd)))) - (setq match-index (+ match-index 1))))) - - (save-window-excursion - (message "Running %s...done" cmd) - (start-process-shell-command cmd nil cmd) - (and (boundp 'org-wait) (numberp org-wait) (sit-for org-wait)))) - ((or (stringp cmd) - (eq cmd 'emacs)) - (funcall (cdr (assq 'file org-link-frame-setup)) file) - (widen) - (if line (org-goto-line line) - (if search (org-link-search search)))) - ((consp cmd) - (let ((file (convert-standard-filename file))) - (save-match-data - (set-match-data link-match-data) - (eval cmd)))) - (t (funcall (cdr (assq 'file org-link-frame-setup)) file))) - (and (derived-mode-p 'org-mode) (eq old-mode 'org-mode) - (or (not (equal old-buffer (current-buffer))) - (not (equal old-pos (point)))) - (org-mark-ring-push old-pos old-buffer)))) - -(defun org-file-apps-entry-match-against-dlink-p (entry) - "This function returns non-nil if `entry' uses a regular -expression which should be matched against the whole link by -org-open-file. - -It assumes that is the case when the entry uses a regular -expression which has at least one grouping construct and the -action is either a lisp form or a command string containing -'%1', i.e. using at least one subexpression match as a -parameter." - (let ((selector (car entry)) - (action (cdr entry))) - (if (stringp selector) - (and (> (regexp-opt-depth selector) 0) - (or (and (stringp action) - (string-match "%[0-9]" action)) - (consp action))) - nil))) - -(defun org-default-apps () - "Return the default applications for this operating system." - (cond - ((eq system-type 'darwin) - org-file-apps-defaults-macosx) - ((eq system-type 'windows-nt) - org-file-apps-defaults-windowsnt) - (t org-file-apps-defaults-gnu))) - -(defun org-apps-regexp-alist (list &optional add-auto-mode) - "Convert extensions to regular expressions in the cars of LIST. -Also, weed out any non-string entries, because the return value is used -only for regexp matching. -When ADD-AUTO-MODE is set, make all matches in `auto-mode-alist' -point to the symbol `emacs', indicating that the file should -be opened in Emacs." - (append - (delq nil - (mapcar (lambda (x) - (if (not (stringp (car x))) - nil - (if (string-match "\\W" (car x)) - x - (cons (concat "\\." (car x) "\\'") (cdr x))))) - list)) - (if add-auto-mode - (mapcar (lambda (x) (cons (car x) 'emacs)) auto-mode-alist)))) - -(defvar ange-ftp-name-format) ; to silence the XEmacs compiler. -(defun org-file-remote-p (file) - "Test whether FILE specifies a location on a remote system. -Return non-nil if the location is indeed remote. - -For example, the filename \"/user@host:/foo\" specifies a location -on the system \"/user@host:\"." - (cond ((fboundp 'file-remote-p) - (file-remote-p file)) - ((fboundp 'tramp-handle-file-remote-p) - (tramp-handle-file-remote-p file)) - ((and (boundp 'ange-ftp-name-format) - (string-match (car ange-ftp-name-format) file)) - t))) - - -;;;; Refiling - -(defun org-get-org-file () - "Read a filename, with default directory `org-directory'." - (let ((default (or org-default-notes-file remember-data-file))) - (read-file-name (format "File name [%s]: " default) - (file-name-as-directory org-directory) - default))) - -(defun org-notes-order-reversed-p () - "Check if the current file should receive notes in reversed order." - (cond - ((not org-reverse-note-order) nil) - ((eq t org-reverse-note-order) t) - ((not (listp org-reverse-note-order)) nil) - (t (catch 'exit - (let ((all org-reverse-note-order) - entry) - (while (setq entry (pop all)) - (if (string-match (car entry) buffer-file-name) - (throw 'exit (cdr entry)))) - nil))))) - -(defvar org-refile-target-table nil - "The list of refile targets, created by `org-refile'.") - -(defvar org-agenda-new-buffers nil - "Buffers created to visit agenda files.") - -(defvar org-refile-cache nil - "Cache for refile targets.") - -(defvar org-refile-markers nil - "All the markers used for caching refile locations.") - -(defun org-refile-marker (pos) - "Get a new refile marker, but only if caching is in use." - (if (not org-refile-use-cache) - pos - (let ((m (make-marker))) - (move-marker m pos) - (push m org-refile-markers) - m))) - -(defun org-refile-cache-clear () - "Clear the refile cache and disable all the markers." - (mapc (lambda (m) (move-marker m nil)) org-refile-markers) - (setq org-refile-markers nil) - (setq org-refile-cache nil) - (message "Refile cache has been cleared")) - -(defun org-refile-cache-check-set (set) - "Check if all the markers in the cache still have live buffers." - (let (marker) - (catch 'exit - (while (and set (setq marker (nth 3 (pop set)))) - ;; If `org-refile-use-outline-path' is 'file, marker may be nil - (when (and marker (null (marker-buffer marker))) - (message "Please regenerate the refile cache with `C-0 C-c C-w'") - (sit-for 3) - (throw 'exit nil))) - t))) - -(defun org-refile-cache-put (set &rest identifiers) - "Push the refile targets SET into the cache, under IDENTIFIERS." - (let* ((key (sha1 (prin1-to-string identifiers))) - (entry (assoc key org-refile-cache))) - (if entry - (setcdr entry set) - (push (cons key set) org-refile-cache)))) - -(defun org-refile-cache-get (&rest identifiers) - "Retrieve the cached value for refile targets given by IDENTIFIERS." - (cond - ((not org-refile-cache) nil) - ((not org-refile-use-cache) (org-refile-cache-clear) nil) - (t - (let ((set (cdr (assoc (sha1 (prin1-to-string identifiers)) - org-refile-cache)))) - (and set (org-refile-cache-check-set set) set))))) - -(defun org-refile-get-targets (&optional default-buffer excluded-entries) - "Produce a table with refile targets." - (let ((case-fold-search nil) - ;; otherwise org confuses "TODO" as a kw and "Todo" as a word - (entries (or org-refile-targets '((nil . (:level . 1))))) - targets tgs txt re files f desc descre fast-path-p level pos0) - (message "Getting targets...") - (with-current-buffer (or default-buffer (current-buffer)) - (while (setq entry (pop entries)) - (setq files (car entry) desc (cdr entry)) - (setq fast-path-p nil) - (cond - ((null files) (setq files (list (current-buffer)))) - ((eq files 'org-agenda-files) - (setq files (org-agenda-files 'unrestricted))) - ((and (symbolp files) (fboundp files)) - (setq files (funcall files))) - ((and (symbolp files) (boundp files)) - (setq files (symbol-value files)))) - (if (stringp files) (setq files (list files))) - (cond - ((eq (car desc) :tag) - (setq descre (concat "^\\*+[ \t]+.*?:" (regexp-quote (cdr desc)) ":"))) - ((eq (car desc) :todo) - (setq descre (concat "^\\*+[ \t]+" (regexp-quote (cdr desc)) "[ \t]"))) - ((eq (car desc) :regexp) - (setq descre (cdr desc))) - ((eq (car desc) :level) - (setq descre (concat "^\\*\\{" (number-to-string - (if org-odd-levels-only - (1- (* 2 (cdr desc))) - (cdr desc))) - "\\}[ \t]"))) - ((eq (car desc) :maxlevel) - (setq fast-path-p t) - (setq descre (concat "^\\*\\{1," (number-to-string - (if org-odd-levels-only - (1- (* 2 (cdr desc))) - (cdr desc))) - "\\}[ \t]"))) - (t (error "Bad refiling target description %s" desc))) - (while (setq f (pop files)) - (with-current-buffer - (if (bufferp f) f (org-get-agenda-file-buffer f)) - (or - (setq tgs (org-refile-cache-get (buffer-file-name) descre)) - (progn - (if (bufferp f) (setq f (buffer-file-name - (buffer-base-buffer f)))) - (setq f (and f (expand-file-name f))) - (if (eq org-refile-use-outline-path 'file) - (push (list (file-name-nondirectory f) f nil nil) tgs)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward descre nil t) - (goto-char (setq pos0 (point-at-bol))) - (catch 'next - (when org-refile-target-verify-function - (save-match-data - (or (funcall org-refile-target-verify-function) - (throw 'next t)))) - (when (and (looking-at org-complex-heading-regexp) - (not (member (match-string 4) excluded-entries)) - (match-string 4)) - (setq level (org-reduced-level - (- (match-end 1) (match-beginning 1))) - txt (org-link-display-format (match-string 4)) - txt (replace-regexp-in-string "\\( *\[[0-9]+/?[0-9]*%?\]\\)+$" "" txt) - re (format org-complex-heading-regexp-format - (regexp-quote (match-string 4)))) - (when org-refile-use-outline-path - (setq txt (mapconcat - 'org-protect-slash - (append - (if (eq org-refile-use-outline-path - 'file) - (list (file-name-nondirectory - (buffer-file-name - (buffer-base-buffer)))) - (if (eq org-refile-use-outline-path - 'full-file-path) - (list (buffer-file-name - (buffer-base-buffer))))) - (org-get-outline-path fast-path-p - level txt) - (list txt)) - "/"))) - (push (list txt f re (org-refile-marker (point))) - tgs))) - (when (= (point) pos0) - ;; verification function has not moved point - (goto-char (point-at-eol)))))))) - (when org-refile-use-cache - (org-refile-cache-put tgs (buffer-file-name) descre)) - (setq targets (append tgs targets)))))) - (message "Getting targets...done") - (nreverse targets))) - -(defun org-protect-slash (s) - (while (string-match "/" s) - (setq s (replace-match "\\" t t s))) - s) - -(defvar org-olpa (make-vector 20 nil)) - -(defun org-get-outline-path (&optional fastp level heading) - "Return the outline path to the current entry, as a list. - -The parameters FASTP, LEVEL, and HEADING are for use by a scanner -routine which makes outline path derivations for an entire file, -avoiding backtracing. Refile target collection makes use of that." - (if fastp - (progn - (if (> level 19) - (error "Outline path failure, more than 19 levels")) - (loop for i from level upto 19 do - (aset org-olpa i nil)) - (prog1 - (delq nil (append org-olpa nil)) - (aset org-olpa level heading))) - (let (rtn case-fold-search) - (save-excursion - (save-restriction - (widen) - (while (org-up-heading-safe) - (when (looking-at org-complex-heading-regexp) - (push (org-trim - (replace-regexp-in-string - ;; Remove statistical/checkboxes cookies - "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" - (org-match-string-no-properties 4))) - rtn))) - rtn))))) - -(defun org-format-outline-path (path &optional width prefix separator) - "Format the outline path PATH for display. -WIDTH is the maximum number of characters that is available. -PREFIX is a prefix to be included in the returned string, -such as the file name. -SEPARATOR is inserted between the different parts of the path, -the default is \"/\"." - (setq width (or width 79)) - (if prefix (setq width (- width (length prefix)))) - (if (not path) - (or prefix "") - (let* ((nsteps (length path)) - (total-width (+ nsteps (apply '+ (mapcar 'length path)))) - (maxwidth (if (<= total-width width) - 10000 ;; everything fits - ;; we need to shorten the level headings - (/ (- width nsteps) nsteps))) - (org-odd-levels-only nil) - (n 0) - (total (1+ (length prefix)))) - (setq maxwidth (max maxwidth 10)) - (concat prefix - (if prefix (or separator "/")) - (mapconcat - (lambda (h) - (setq n (1+ n)) - (if (and (= n nsteps) (< maxwidth 10000)) - (setq maxwidth (- total-width total))) - (if (< (length h) maxwidth) - (progn (setq total (+ total (length h) 1)) h) - (setq h (substring h 0 (- maxwidth 2)) - total (+ total maxwidth 1)) - (if (string-match "[ \t]+\\'" h) - (setq h (substring h 0 (match-beginning 0)))) - (setq h (concat h ".."))) - (org-add-props h nil 'face - (nth (% (1- n) org-n-level-faces) - org-level-faces)) - h) - path (or separator "/")))))) - -(defun org-display-outline-path (&optional file current separator just-return-string) - "Display the current outline path in the echo area. - -If FILE is non-nil, prepend the output with the file name. -If CURRENT is non-nil, append the current heading to the output. -SEPARATOR is passed through to `org-format-outline-path'. It separates -the different parts of the path and defaults to \"/\". -If JUST-RETURN-STRING is non-nil, return a string, don't display a message." - (interactive "P") - (let* (case-fold-search - (bfn (buffer-file-name (buffer-base-buffer))) - (path (and (derived-mode-p 'org-mode) (org-get-outline-path))) - res) - (if current (setq path (append path - (save-excursion - (org-back-to-heading t) - (if (looking-at org-complex-heading-regexp) - (list (match-string 4))))))) - (setq res - (org-format-outline-path - path - (1- (frame-width)) - (and file bfn (concat (file-name-nondirectory bfn) separator)) - separator)) - (if just-return-string - (org-no-properties res) - (org-unlogged-message "%s" res)))) - -(defvar org-refile-history nil - "History for refiling operations.") - -(defvar org-after-refile-insert-hook nil - "Hook run after `org-refile' has inserted its stuff at the new location. -Note that this is still *before* the stuff will be removed from -the *old* location.") - -(defvar org-capture-last-stored-marker) -(defvar org-refile-keep nil - "Non-nil means `org-refile' will copy instead of refile.") - -(defun org-copy () - "Like `org-refile', but copy." - (interactive) - (let ((org-refile-keep t)) - (funcall 'org-refile nil nil nil "Copy"))) - -(defun org-refile (&optional goto default-buffer rfloc msg) - "Move the entry or entries at point to another heading. -The list of target headings is compiled using the information in -`org-refile-targets', which see. - -At the target location, the entry is filed as a subitem of the target -heading. Depending on `org-reverse-note-order', the new subitem will -either be the first or the last subitem. - -If there is an active region, all entries in that region will be moved. -However, the region must fulfill the requirement that the first heading -is the first one sets the top-level of the moved text - at most siblings -below it are allowed. - -With prefix arg GOTO, the command will only visit the target location -and not actually move anything. - -With a double prefix arg \\[universal-argument] \\[universal-argument], \ -go to the location where the last refiling operation has put the subtree. - -With a numeric prefix argument of `2', refile to the running clock. - -With a numeric prefix argument of `3', emulate `org-refile-keep' -being set to `t' and copy to the target location, don't move it. -Beware that keeping refiled entries may result in duplicated ID -properties. - -RFLOC can be a refile location obtained in a different way. - -MSG is a string to replace \"Refile\" in the default prompt with -another verb. E.g. `org-copy' sets this parameter to \"Copy\". - -See also `org-refile-use-outline-path' and `org-completion-use-ido'. - -If you are using target caching (see `org-refile-use-cache'), -you have to clear the target cache in order to find new targets. -This can be done with a 0 prefix (`C-0 C-c C-w') or a triple -prefix argument (`C-u C-u C-u C-c C-w')." - - (interactive "P") - (if (member goto '(0 (64))) - (org-refile-cache-clear) - (let* ((actionmsg (or msg "Refile")) - (cbuf (current-buffer)) - (regionp (org-region-active-p)) - (region-start (and regionp (region-beginning))) - (region-end (and regionp (region-end))) - (filename (buffer-file-name (buffer-base-buffer cbuf))) - (org-refile-keep (if (equal goto 3) t org-refile-keep)) - pos it nbuf file re level reversed) - (setq last-command nil) - (when regionp - (goto-char region-start) - (or (bolp) (goto-char (point-at-bol))) - (setq region-start (point)) - (unless (or (org-kill-is-subtree-p - (buffer-substring region-start region-end)) - (prog1 org-refile-active-region-within-subtree - (let ((s (point-at-eol))) - (org-toggle-heading) - (setq region-end (+ (- (point-at-eol) s) region-end))))) - (user-error "The region is not a (sequence of) subtree(s)"))) - (if (equal goto '(16)) - (org-refile-goto-last-stored) - (when (or - (and (equal goto 2) - org-clock-hd-marker (marker-buffer org-clock-hd-marker) - (prog1 - (setq it (list (or org-clock-heading "running clock") - (buffer-file-name - (marker-buffer org-clock-hd-marker)) - "" - (marker-position org-clock-hd-marker))) - (setq goto nil))) - (setq it (or rfloc - (let (heading-text) - (save-excursion - (unless goto - (org-back-to-heading t) - (setq heading-text - (nth 4 (org-heading-components)))) - - (org-refile-get-location - (cond (goto "Goto") - (regionp (concat actionmsg " region to")) - (t (concat actionmsg " subtree \"" - heading-text "\" to"))) - default-buffer - (and (not (equal '(4) goto)) - org-refile-allow-creating-parent-nodes) - goto)))))) - (setq file (nth 1 it) - re (nth 2 it) - pos (nth 3 it)) - (if (and (not goto) - pos - (equal (buffer-file-name) file) - (if regionp - (and (>= pos region-start) - (<= pos region-end)) - (and (>= pos (point)) - (< pos (save-excursion - (org-end-of-subtree t t)))))) - (error "Cannot refile to position inside the tree or region")) - - (setq nbuf (or (find-buffer-visiting file) - (find-file-noselect file))) - (if (and goto (not (equal goto 3))) - (progn - (org-pop-to-buffer-same-window nbuf) - (goto-char pos) - (org-show-context 'org-goto)) - (if regionp - (progn - (org-kill-new (buffer-substring region-start region-end)) - (org-save-markers-in-region region-start region-end)) - (org-copy-subtree 1 nil t)) - (with-current-buffer (setq nbuf (or (find-buffer-visiting file) - (find-file-noselect file))) - (setq reversed (org-notes-order-reversed-p)) - (save-excursion - (save-restriction - (widen) - (if pos - (progn - (goto-char pos) - (looking-at org-outline-regexp) - (setq level (org-get-valid-level (funcall outline-level) 1)) - (goto-char - (if reversed - (or (outline-next-heading) (point-max)) - (or (save-excursion (org-get-next-sibling)) - (org-end-of-subtree t t) - (point-max))))) - (setq level 1) - (if (not reversed) - (goto-char (point-max)) - (goto-char (point-min)) - (or (outline-next-heading) (goto-char (point-max))))) - (if (not (bolp)) (newline)) - (org-paste-subtree level) - (when org-log-refile - (org-add-log-setup 'refile nil nil 'findpos org-log-refile) - (unless (eq org-log-refile 'note) - (save-excursion (org-add-log-note)))) - (and org-auto-align-tags - (let ((org-loop-over-headlines-in-active-region nil)) - (org-set-tags nil t))) - (let ((bookmark-name (plist-get org-bookmark-names-plist - :last-refile))) - (when bookmark-name - (with-demoted-errors - (bookmark-set bookmark-name)))) - ;; If we are refiling for capture, make sure that the - ;; last-capture pointers point here - (when (org-bound-and-true-p org-refile-for-capture) - (let ((bookmark-name (plist-get org-bookmark-names-plist - :last-capture-marker))) - (when bookmark-name - (with-demoted-errors - (bookmark-set bookmark-name)))) - (move-marker org-capture-last-stored-marker (point))) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (run-hooks 'org-after-refile-insert-hook)))) - (unless org-refile-keep - (if regionp - (delete-region (point) (+ (point) (- region-end region-start))) - (delete-region - (and (org-back-to-heading t) (point)) - (min (buffer-size) (org-end-of-subtree t t) (point))))) - (when (featurep 'org-inlinetask) - (org-inlinetask-remove-END-maybe)) - (setq org-markers-to-move nil) - (message (concat actionmsg " to \"%s\" in file %s: done") (car it) file))))))) - -(defun org-refile-goto-last-stored () - "Go to the location where the last refile was stored." - (interactive) - (bookmark-jump "org-refile-last-stored") - (message "This is the location of the last refile")) - -(defun org-refile-get-location (&optional prompt default-buffer new-nodes - no-exclude) - "Prompt the user for a refile location, using PROMPT. -PROMPT should not be suffixed with a colon and a space, because -this function appends the default value from -`org-refile-history' automatically, if that is not empty. -When NO-EXCLUDE is set, do not exclude headlines in the current subtree, -this is used for the GOTO interface." - (let ((org-refile-targets org-refile-targets) - (org-refile-use-outline-path org-refile-use-outline-path) - excluded-entries) - (when (and (derived-mode-p 'org-mode) - (not org-refile-use-cache) - (not no-exclude)) - (org-map-tree - (lambda() - (setq excluded-entries - (append excluded-entries (list (org-get-heading t t))))))) - (setq org-refile-target-table - (org-refile-get-targets default-buffer excluded-entries))) - (unless org-refile-target-table - (user-error "No refile targets")) - (let* ((cbuf (current-buffer)) - (partial-completion-mode nil) - (cfn (buffer-file-name (buffer-base-buffer cbuf))) - (cfunc (if (and org-refile-use-outline-path - org-outline-path-complete-in-steps) - 'org-olpath-completing-read - 'org-icompleting-read)) - (extra (if org-refile-use-outline-path "/" "")) - (cbnex (concat (buffer-name) extra)) - (filename (and cfn (expand-file-name cfn))) - (tbl (mapcar - (lambda (x) - (if (and (not (member org-refile-use-outline-path - '(file full-file-path))) - (not (equal filename (nth 1 x)))) - (cons (concat (car x) extra " (" - (file-name-nondirectory (nth 1 x)) ")") - (cdr x)) - (cons (concat (car x) extra) (cdr x)))) - org-refile-target-table)) - (completion-ignore-case t) - cdef - (prompt (concat prompt - (or (and (car org-refile-history) - (concat " (default " (car org-refile-history) ")")) - (and (assoc cbnex tbl) (setq cdef cbnex) - (concat " (default " cbnex ")"))) ": ")) - pa answ parent-target child parent old-hist) - (setq old-hist org-refile-history) - (setq answ (funcall cfunc prompt tbl nil (not new-nodes) - nil 'org-refile-history (or cdef (car org-refile-history)))) - (setq pa (or (assoc answ tbl) (assoc (concat answ "/") tbl))) - (org-refile-check-position pa) - (if pa - (progn - (when (or (not org-refile-history) - (not (eq old-hist org-refile-history)) - (not (equal (car pa) (car org-refile-history)))) - (setq org-refile-history - (cons (car pa) (if (assoc (car org-refile-history) tbl) - org-refile-history - (cdr org-refile-history)))) - (if (equal (car org-refile-history) (nth 1 org-refile-history)) - (pop org-refile-history))) - pa) - (if (string-match "\\`\\(.*\\)/\\([^/]+\\)\\'" answ) - (progn - (setq parent (match-string 1 answ) - child (match-string 2 answ)) - (setq parent-target (or (assoc parent tbl) - (assoc (concat parent "/") tbl))) - (when (and parent-target - (or (eq new-nodes t) - (and (eq new-nodes 'confirm) - (y-or-n-p (format "Create new node \"%s\"? " - child))))) - (org-refile-new-child parent-target child))) - (user-error "Invalid target location"))))) - -(declare-function org-string-nw-p "org-macs" (s)) -(defun org-refile-check-position (refile-pointer) - "Check if the refile pointer matches the headline to which it points." - (let* ((file (nth 1 refile-pointer)) - (re (nth 2 refile-pointer)) - (pos (nth 3 refile-pointer)) - buffer) - (if (and (not (markerp pos)) (not file)) - (user-error "Please save the buffer to a file before refiling") - (when (org-string-nw-p re) - (setq buffer (if (markerp pos) - (marker-buffer pos) - (or (find-buffer-visiting file) - (find-file-noselect file)))) - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char pos) - (beginning-of-line 1) - (unless (org-looking-at-p re) - (user-error "Invalid refile position, please clear the cache with `C-0 C-c C-w' before refiling"))))))))) - -(defun org-refile-new-child (parent-target child) - "Use refile target PARENT-TARGET to add new CHILD below it." - (unless parent-target - (error "Cannot find parent for new node")) - (let ((file (nth 1 parent-target)) - (pos (nth 3 parent-target)) - level) - (with-current-buffer (or (find-buffer-visiting file) - (find-file-noselect file)) - (save-excursion - (save-restriction - (widen) - (if pos - (goto-char pos) - (goto-char (point-max)) - (if (not (bolp)) (newline))) - (when (looking-at org-outline-regexp) - (setq level (funcall outline-level)) - (org-end-of-subtree t t)) - (org-back-over-empty-lines) - (insert "\n" (make-string - (if pos (org-get-valid-level level 1) 1) ?*) - " " child "\n") - (beginning-of-line 0) - (list (concat (car parent-target) "/" child) file "" (point))))))) - -(defun org-olpath-completing-read (prompt collection &rest args) - "Read an outline path like a file name." - (let ((thetable collection) - (org-completion-use-ido nil) ; does not work with ido. - (org-completion-use-iswitchb nil)) ; or iswitchb - (apply - 'org-icompleting-read prompt - (lambda (string predicate &optional flag) - (let (rtn r f (l (length string))) - (cond - ((eq flag nil) - ;; try completion - (try-completion string thetable)) - ((eq flag t) - ;; all-completions - (setq rtn (all-completions string thetable predicate)) - (mapcar - (lambda (x) - (setq r (substring x l)) - (if (string-match " ([^)]*)$" x) - (setq f (match-string 0 x)) - (setq f "")) - (if (string-match "/" r) - (concat string (substring r 0 (match-end 0)) f) - x)) - rtn)) - ((eq flag 'lambda) - ;; exact match? - (assoc string thetable))))) - args))) - -;;;; Dynamic blocks - -(defun org-find-dblock (name) - "Find the first dynamic block with name NAME in the buffer. -If not found, stay at current position and return nil." - (let ((case-fold-search t) pos) - (save-excursion - (goto-char (point-min)) - (setq pos (and (re-search-forward - (concat "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+" name "\\>") nil t) - (match-beginning 0)))) - (if pos (goto-char pos)) - pos)) - -(defconst org-dblock-start-re - "^[ \t]*#\\+\\(?:BEGIN\\|begin\\):[ \t]+\\(\\S-+\\)\\([ \t]+\\(.*\\)\\)?" - "Matches the start line of a dynamic block, with parameters.") - -(defconst org-dblock-end-re "^[ \t]*#\\+\\(?:END\\|end\\)\\([: \t\r\n]\\|$\\)" - "Matches the end of a dynamic block.") - -(defun org-create-dblock (plist) - "Create a dynamic block section, with parameters taken from PLIST. -PLIST must contain a :name entry which is used as name of the block." - (when (string-match "\\S-" (buffer-substring (point-at-bol) (point-at-eol))) - (end-of-line 1) - (newline)) - (let ((col (current-column)) - (name (plist-get plist :name))) - (insert "#+BEGIN: " name) - (while plist - (if (eq (car plist) :name) - (setq plist (cddr plist)) - (insert " " (prin1-to-string (pop plist))))) - (insert "\n\n" (make-string col ?\ ) "#+END:\n") - (beginning-of-line -2))) - -(defun org-prepare-dblock () - "Prepare dynamic block for refresh. -This empties the block, puts the cursor at the insert position and returns -the property list including an extra property :name with the block name." - (unless (looking-at org-dblock-start-re) - (user-error "Not at a dynamic block")) - (let* ((begdel (1+ (match-end 0))) - (name (org-no-properties (match-string 1))) - (params (append (list :name name) - (read (concat "(" (match-string 3) ")"))))) - (save-excursion - (beginning-of-line 1) - (skip-chars-forward " \t") - (setq params (plist-put params :indentation-column (current-column)))) - (unless (re-search-forward org-dblock-end-re nil t) - (error "Dynamic block not terminated")) - (setq params - (append params - (list :content (buffer-substring - begdel (match-beginning 0))))) - (delete-region begdel (match-beginning 0)) - (goto-char begdel) - (open-line 1) - params)) - -(defun org-map-dblocks (&optional command) - "Apply COMMAND to all dynamic blocks in the current buffer. -If COMMAND is not given, use `org-update-dblock'." - (let ((cmd (or command 'org-update-dblock))) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward org-dblock-start-re nil t) - (goto-char (match-beginning 0)) - (save-excursion - (condition-case nil - (funcall cmd) - (error (message "Error during update of dynamic block")))) - (unless (re-search-forward org-dblock-end-re nil t) - (error "Dynamic block not terminated")))))) - -(defun org-dblock-update (&optional arg) - "User command for updating dynamic blocks. -Update the dynamic block at point. With prefix ARG, update all dynamic -blocks in the buffer." - (interactive "P") - (if arg - (org-update-all-dblocks) - (or (looking-at org-dblock-start-re) - (org-beginning-of-dblock)) - (org-update-dblock))) - -(defun org-update-dblock () - "Update the dynamic block at point. -This means to empty the block, parse for parameters and then call -the correct writing function." - (interactive) - (save-window-excursion - (let* ((pos (point)) - (line (org-current-line)) - (params (org-prepare-dblock)) - (name (plist-get params :name)) - (indent (plist-get params :indentation-column)) - (cmd (intern (concat "org-dblock-write:" name)))) - (message "Updating dynamic block `%s' at line %d..." name line) - (funcall cmd params) - (message "Updating dynamic block `%s' at line %d...done" name line) - (goto-char pos) - (when (and indent (> indent 0)) - (setq indent (make-string indent ?\ )) - (save-excursion - (org-beginning-of-dblock) - (forward-line 1) - (while (not (looking-at org-dblock-end-re)) - (insert indent) - (beginning-of-line 2)) - (when (looking-at org-dblock-end-re) - (and (looking-at "[ \t]+") - (replace-match "")) - (insert indent))))))) - -(defun org-beginning-of-dblock () - "Find the beginning of the dynamic block at point. -Error if there is no such block at point." - (let ((pos (point)) - beg) - (end-of-line 1) - (if (and (re-search-backward org-dblock-start-re nil t) - (setq beg (match-beginning 0)) - (re-search-forward org-dblock-end-re nil t) - (> (match-end 0) pos)) - (goto-char beg) - (goto-char pos) - (error "Not in a dynamic block")))) - -(defun org-update-all-dblocks () - "Update all dynamic blocks in the buffer. -This function can be used in a hook." - (interactive) - (when (derived-mode-p 'org-mode) - (org-map-dblocks 'org-update-dblock))) - - -;;;; Completion - -(declare-function org-export-backend-name "org-export" (cl-x)) -(declare-function org-export-backend-options "org-export" (cl-x)) -(defun org-get-export-keywords () - "Return a list of all currently understood export keywords. -Export keywords include options, block names, attributes and -keywords relative to each registered export back-end." - (let (keywords) - (dolist (backend - (org-bound-and-true-p org-export--registered-backends) - (delq nil keywords)) - ;; Back-end name (for keywords, like #+LATEX:) - (push (upcase (symbol-name (org-export-backend-name backend))) keywords) - (dolist (option-entry (org-export-backend-options backend)) - ;; Back-end options. - (push (nth 1 option-entry) keywords))))) - -(defconst org-options-keywords - '("ARCHIVE:" "AUTHOR:" "BIND:" "CATEGORY:" "COLUMNS:" "CREATOR:" "DATE:" - "DESCRIPTION:" "DRAWERS:" "EMAIL:" "EXCLUDE_TAGS:" "FILETAGS:" "INCLUDE:" - "INDEX:" "KEYWORDS:" "LANGUAGE:" "MACRO:" "OPTIONS:" "PROPERTY:" - "PRIORITIES:" "SELECT_TAGS:" "SEQ_TODO:" "SETUPFILE:" "STARTUP:" "TAGS:" - "TITLE:" "TODO:" "TYP_TODO:" "SELECT_TAGS:" "EXCLUDE_TAGS:")) - -(defcustom org-structure-template-alist - '(("s" "#+BEGIN_SRC ?\n\n#+END_SRC" "<src lang=\"?\">\n\n</src>") - ("e" "#+BEGIN_EXAMPLE\n?\n#+END_EXAMPLE" "<example>\n?\n</example>") - ("q" "#+BEGIN_QUOTE\n?\n#+END_QUOTE" "<quote>\n?\n</quote>") - ("v" "#+BEGIN_VERSE\n?\n#+END_VERSE" "<verse>\n?\n</verse>") - ("V" "#+BEGIN_VERBATIM\n?\n#+END_VERBATIM" "<verbatim>\n?\n</verbatim>") - ("c" "#+BEGIN_CENTER\n?\n#+END_CENTER" "<center>\n?\n</center>") - ("l" "#+BEGIN_LaTeX\n?\n#+END_LaTeX" - "<literal style=\"latex\">\n?\n</literal>") - ("L" "#+LaTeX: " "<literal style=\"latex\">?</literal>") - ("h" "#+BEGIN_HTML\n?\n#+END_HTML" - "<literal style=\"html\">\n?\n</literal>") - ("H" "#+HTML: " "<literal style=\"html\">?</literal>") - ("a" "#+BEGIN_ASCII\n?\n#+END_ASCII" "") - ("A" "#+ASCII: " "") - ("i" "#+INDEX: ?" "#+INDEX: ?") - ("I" "#+INCLUDE: %file ?" - "<include file=%file markup=\"?\">")) - "Structure completion elements. -This is a list of abbreviation keys and values. The value gets inserted -if you type `<' followed by the key and then press the completion key, -usually `M-TAB'. %file will be replaced by a file name after prompting -for the file using completion. The cursor will be placed at the position -of the `?` in the template. -There are two templates for each key, the first uses the original Org syntax, -the second uses Emacs Muse-like syntax tags. These Muse-like tags become -the default when the /org-mtags.el/ module has been loaded. See also the -variable `org-mtags-prefer-muse-templates'." - :group 'org-completion - :type '(repeat - (list - (string :tag "Key") - (string :tag "Template") - (string :tag "Muse Template")))) - -(defun org-try-structure-completion () - "Try to complete a structure template before point. -This looks for strings like \"<e\" on an otherwise empty line and -expands them." - (let ((l (buffer-substring (point-at-bol) (point))) - a) - (when (and (looking-at "[ \t]*$") - (string-match "^[ \t]*<\\([a-zA-Z]+\\)$" l) - (setq a (assoc (match-string 1 l) org-structure-template-alist))) - (org-complete-expand-structure-template (+ -1 (point-at-bol) - (match-beginning 1)) a) - t))) - -(defun org-complete-expand-structure-template (start cell) - "Expand a structure template." - (let* ((musep (org-bound-and-true-p org-mtags-prefer-muse-templates)) - (rpl (nth (if musep 2 1) cell)) - (ind "")) - (delete-region start (point)) - (when (string-match "\\`#\\+" rpl) - (cond - ((bolp)) - ((not (string-match "\\S-" (buffer-substring (point-at-bol) (point)))) - (setq ind (buffer-substring (point-at-bol) (point)))) - (t (newline)))) - (setq start (point)) - (if (string-match "%file" rpl) - (setq rpl (replace-match - (concat - "\"" - (save-match-data - (abbreviate-file-name (read-file-name "Include file: "))) - "\"") - t t rpl))) - (setq rpl (mapconcat 'identity (split-string rpl "\n") - (concat "\n" ind))) - (insert rpl) - (if (re-search-backward "\\?" start t) (delete-char 1)))) - -;;;; TODO, DEADLINE, Comments - -(defun org-toggle-comment () - "Change the COMMENT state of an entry." - (interactive) - (save-excursion - (org-back-to-heading) - (let (case-fold-search) - (cond - ((looking-at (format org-heading-keyword-regexp-format - org-comment-string)) - (goto-char (match-end 1)) - (looking-at (concat " +" org-comment-string)) - (replace-match "" t t) - (when (eolp) (insert " "))) - ((looking-at org-outline-regexp) - (goto-char (match-end 0)) - (insert org-comment-string " ")))))) - -(defvar org-last-todo-state-is-todo nil - "This is non-nil when the last TODO state change led to a TODO state. -If the last change removed the TODO tag or switched to DONE, then -this is nil.") - -(defvar org-setting-tags nil) ; dynamically skipped - -(defvar org-todo-setup-filter-hook nil - "Hook for functions that pre-filter todo specs. -Each function takes a todo spec and returns either nil or the spec -transformed into canonical form." ) - -(defvar org-todo-get-default-hook nil - "Hook for functions that get a default item for todo. -Each function takes arguments (NEW-MARK OLD-MARK) and returns either -nil or a string to be used for the todo mark." ) - -(defvar org-agenda-headline-snapshot-before-repeat) - -(defun org-current-effective-time () - "Return current time adjusted for `org-extend-today-until' variable." - (let* ((ct (org-current-time)) - (dct (decode-time ct)) - (ct1 - (cond - (org-use-last-clock-out-time-as-effective-time - (or (org-clock-get-last-clock-out-time) ct)) - ((and org-use-effective-time (< (nth 2 dct) org-extend-today-until)) - (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))) - (t ct)))) - ct1)) - -(defun org-todo-yesterday (&optional arg) - "Like `org-todo' but the time of change will be 23:59 of yesterday." - (interactive "P") - (if (eq major-mode 'org-agenda-mode) - (apply 'org-agenda-todo-yesterday arg) - (let* ((hour (third (decode-time - (org-current-time)))) - (org-extend-today-until (1+ hour))) - (org-todo arg)))) - -(defvar org-block-entry-blocking "" - "First entry preventing the TODO state change.") - -(defun org-todo (&optional arg) - "Change the TODO state of an item. -The state of an item is given by a keyword at the start of the heading, -like - *** TODO Write paper - *** DONE Call mom - -The different keywords are specified in the variable `org-todo-keywords'. -By default the available states are \"TODO\" and \"DONE\". -So for this example: when the item starts with TODO, it is changed to DONE. -When it starts with DONE, the DONE is removed. And when neither TODO nor -DONE are present, add TODO at the beginning of the heading. - -With \\[universal-argument] prefix arg, use completion to determine the new \ -state. -With numeric prefix arg, switch to that state. -With a double \\[universal-argument] prefix, switch to the next set of TODO \ -keywords (nextset). -With a triple \\[universal-argument] prefix, circumvent any state blocking. -With a numeric prefix arg of 0, inhibit note taking for the change. - -For calling through lisp, arg is also interpreted in the following way: -'none -> empty state -\"\"(empty string) -> switch to empty state -'done -> switch to DONE -'nextset -> switch to the next set of keywords -'previousset -> switch to the previous set of keywords -\"WAITING\" -> switch to the specified keyword, but only if it - really is a member of `org-todo-keywords'." - (interactive "P") - (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) - (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - `(org-todo ,arg) - org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (if (equal arg '(16)) (setq arg 'nextset)) - (let ((org-blocker-hook org-blocker-hook) - commentp - case-fold-search) - (when (equal arg '(64)) - (setq arg nil org-blocker-hook nil)) - (when (and org-blocker-hook - (or org-inhibit-blocking - (org-entry-get nil "NOBLOCKING"))) - (setq org-blocker-hook nil)) - (save-excursion - (catch 'exit - (org-back-to-heading t) - (when (looking-at (concat "^\\*+ " org-comment-string)) - (org-toggle-comment) - (setq commentp t)) - (if (looking-at org-outline-regexp) (goto-char (1- (match-end 0)))) - (or (looking-at (concat " +" org-todo-regexp "\\( +\\|[ \t]*$\\)")) - (looking-at "\\(?: *\\|[ \t]*$\\)")) - (let* ((match-data (match-data)) - (startpos (point-at-bol)) - (logging (save-match-data (org-entry-get nil "LOGGING" t t))) - (org-log-done org-log-done) - (org-log-repeat org-log-repeat) - (org-todo-log-states org-todo-log-states) - (org-inhibit-logging - (if (equal arg 0) - (progn (setq arg nil) 'note) org-inhibit-logging)) - (this (match-string 1)) - (hl-pos (match-beginning 0)) - (head (org-get-todo-sequence-head this)) - (ass (assoc head org-todo-kwd-alist)) - (interpret (nth 1 ass)) - (done-word (nth 3 ass)) - (final-done-word (nth 4 ass)) - (org-last-state (or this "")) - (completion-ignore-case t) - (member (member this org-todo-keywords-1)) - (tail (cdr member)) - (org-state (cond - ((and org-todo-key-trigger - (or (and (equal arg '(4)) - (eq org-use-fast-todo-selection 'prefix)) - (and (not arg) org-use-fast-todo-selection - (not (eq org-use-fast-todo-selection - 'prefix))))) - ;; Use fast selection - (org-fast-todo-selection)) - ((and (equal arg '(4)) - (or (not org-use-fast-todo-selection) - (not org-todo-key-trigger))) - ;; Read a state with completion - (org-icompleting-read - "State: " (mapcar 'list org-todo-keywords-1) - nil t)) - ((eq arg 'right) - (if this - (if tail (car tail) nil) - (car org-todo-keywords-1))) - ((eq arg 'left) - (if (equal member org-todo-keywords-1) - nil - (if this - (nth (- (length org-todo-keywords-1) - (length tail) 2) - org-todo-keywords-1) - (org-last org-todo-keywords-1)))) - ((and (eq org-use-fast-todo-selection t) (equal arg '(4)) - (setq arg nil))) ; hack to fall back to cycling - (arg - ;; user or caller requests a specific state - (cond - ((equal arg "") nil) - ((eq arg 'none) nil) - ((eq arg 'done) (or done-word (car org-done-keywords))) - ((eq arg 'nextset) - (or (car (cdr (member head org-todo-heads))) - (car org-todo-heads))) - ((eq arg 'previousset) - (let ((org-todo-heads (reverse org-todo-heads))) - (or (car (cdr (member head org-todo-heads))) - (car org-todo-heads)))) - ((car (member arg org-todo-keywords-1))) - ((stringp arg) - (user-error "State `%s' not valid in this file" arg)) - ((nth (1- (prefix-numeric-value arg)) - org-todo-keywords-1)))) - ((null member) (or head (car org-todo-keywords-1))) - ((equal this final-done-word) nil) ;; -> make empty - ((null tail) nil) ;; -> first entry - ((memq interpret '(type priority)) - (if (eq this-command last-command) - (car tail) - (if (> (length tail) 0) - (or done-word (car org-done-keywords)) - nil))) - (t - (car tail)))) - (org-state (or - (run-hook-with-args-until-success - 'org-todo-get-default-hook org-state org-last-state) - org-state)) - (next (if org-state (concat " " org-state " ") " ")) - (change-plist (list :type 'todo-state-change :from this :to org-state - :position startpos)) - dolog now-done-p) - (when org-blocker-hook - (setq org-last-todo-state-is-todo - (not (member this org-done-keywords))) - (unless (save-excursion - (save-match-data - (org-with-wide-buffer - (run-hook-with-args-until-failure - 'org-blocker-hook change-plist)))) - (if (org-called-interactively-p 'interactive) - (user-error "TODO state change from %s to %s blocked (by \"%s\")" - this org-state org-block-entry-blocking) - ;; fail silently - (message "TODO state change from %s to %s blocked (by \"%s\")" - this org-state org-block-entry-blocking) - (throw 'exit nil)))) - (store-match-data match-data) - (replace-match next t t) - (unless (pos-visible-in-window-p hl-pos) - (message "TODO state changed to %s" (org-trim next))) - (unless head - (setq head (org-get-todo-sequence-head org-state) - ass (assoc head org-todo-kwd-alist) - interpret (nth 1 ass) - done-word (nth 3 ass) - final-done-word (nth 4 ass))) - (when (memq arg '(nextset previousset)) - (message "Keyword-Set %d/%d: %s" - (- (length org-todo-sets) -1 - (length (memq (assoc org-state org-todo-sets) org-todo-sets))) - (length org-todo-sets) - (mapconcat 'identity (assoc org-state org-todo-sets) " "))) - (setq org-last-todo-state-is-todo - (not (member org-state org-done-keywords))) - (setq now-done-p (and (member org-state org-done-keywords) - (not (member this org-done-keywords)))) - (and logging (org-local-logging logging)) - (when (and (or org-todo-log-states org-log-done) - (not (eq org-inhibit-logging t)) - (not (memq arg '(nextset previousset)))) - ;; we need to look at recording a time and note - (setq dolog (or (nth 1 (assoc org-state org-todo-log-states)) - (nth 2 (assoc this org-todo-log-states)))) - (if (and (eq dolog 'note) (eq org-inhibit-logging 'note)) - (setq dolog 'time)) - (when (or (and (not org-state) (not org-closed-keep-when-no-todo)) - (and org-state - (member org-state org-not-done-keywords) - (not (member this org-not-done-keywords)))) - ;; This is now a todo state and was not one before - ;; If there was a CLOSED time stamp, get rid of it. - (org-add-planning-info nil nil 'closed)) - (when (and now-done-p org-log-done) - ;; It is now done, and it was not done before - (org-add-planning-info 'closed (org-current-effective-time)) - (if (and (not dolog) (eq 'note org-log-done)) - (org-add-log-setup 'done org-state this 'findpos 'note))) - (when (and org-state dolog) - ;; This is a non-nil state, and we need to log it - (org-add-log-setup 'state org-state this 'findpos dolog))) - ;; Fixup tag positioning - (org-todo-trigger-tag-changes org-state) - (and org-auto-align-tags (not org-setting-tags) (org-set-tags nil t)) - (when org-provide-todo-statistics - (org-update-parent-todo-statistics)) - (run-hooks 'org-after-todo-state-change-hook) - (if (and arg (not (member org-state org-done-keywords))) - (setq head (org-get-todo-sequence-head org-state))) - (put-text-property (point-at-bol) (point-at-eol) 'org-todo-head head) - ;; Do we need to trigger a repeat? - (when now-done-p - (when (boundp 'org-agenda-headline-snapshot-before-repeat) - ;; This is for the agenda, take a snapshot of the headline. - (save-match-data - (setq org-agenda-headline-snapshot-before-repeat - (org-get-heading)))) - (org-auto-repeat-maybe org-state)) - ;; Fixup cursor location if close to the keyword - (if (and (outline-on-heading-p) - (not (bolp)) - (save-excursion (beginning-of-line 1) - (looking-at org-todo-line-regexp)) - (< (point) (+ 2 (or (match-end 2) (match-end 1))))) - (progn - (goto-char (or (match-end 2) (match-end 1))) - (and (looking-at " ") (just-one-space)))) - (when org-trigger-hook - (save-excursion - (run-hook-with-args 'org-trigger-hook change-plist))) - (when commentp (org-toggle-comment)))))))) - -(defun org-block-todo-from-children-or-siblings-or-parent (change-plist) - "Block turning an entry into a TODO, using the hierarchy. -This checks whether the current task should be blocked from state -changes. Such blocking occurs when: - - 1. The task has children which are not all in a completed state. - - 2. A task has a parent with the property :ORDERED:, and there - are siblings prior to the current task with incomplete - status. - - 3. The parent of the task is blocked because it has siblings that should - be done first, or is child of a block grandparent TODO entry." - - (if (not org-enforce-todo-dependencies) - t ; if locally turned off don't block - (catch 'dont-block - ;; If this is not a todo state change, or if this entry is already DONE, - ;; do not block - (when (or (not (eq (plist-get change-plist :type) 'todo-state-change)) - (member (plist-get change-plist :from) - (cons 'done org-done-keywords)) - (member (plist-get change-plist :to) - (cons 'todo org-not-done-keywords)) - (not (plist-get change-plist :to))) - (throw 'dont-block t)) - ;; If this task has children, and any are undone, it's blocked - (save-excursion - (org-back-to-heading t) - (let ((this-level (funcall outline-level))) - (outline-next-heading) - (let ((child-level (funcall outline-level))) - (while (and (not (eobp)) - (> child-level this-level)) - ;; this todo has children, check whether they are all - ;; completed - (if (and (not (org-entry-is-done-p)) - (org-entry-is-todo-p)) - (progn (setq org-block-entry-blocking (org-get-heading)) - (throw 'dont-block nil))) - (outline-next-heading) - (setq child-level (funcall outline-level)))))) - ;; Otherwise, if the task's parent has the :ORDERED: property, and - ;; any previous siblings are undone, it's blocked - (save-excursion - (org-back-to-heading t) - (let* ((pos (point)) - (parent-pos (and (org-up-heading-safe) (point)))) - (if (not parent-pos) (throw 'dont-block t)) ; no parent - (when (and (org-not-nil (org-entry-get (point) "ORDERED")) - (forward-line 1) - (re-search-forward org-not-done-heading-regexp pos t)) - (setq org-block-entry-blocking (match-string 0)) - (throw 'dont-block nil)) ; block, there is an older sibling not done. - ;; Search further up the hierarchy, to see if an ancestor is blocked - (while t - (goto-char parent-pos) - (if (not (looking-at org-not-done-heading-regexp)) - (throw 'dont-block t)) ; do not block, parent is not a TODO - (setq pos (point)) - (setq parent-pos (and (org-up-heading-safe) (point))) - (if (not parent-pos) (throw 'dont-block t)) ; no parent - (when (and (org-not-nil (org-entry-get (point) "ORDERED")) - (forward-line 1) - (re-search-forward org-not-done-heading-regexp pos t) - (setq org-block-entry-blocking (org-get-heading))) - (throw 'dont-block nil)))))))) ; block, older sibling not done. - -(defcustom org-track-ordered-property-with-tag nil - "Should the ORDERED property also be shown as a tag? -The ORDERED property decides if an entry should require subtasks to be -completed in sequence. Since a property is not very visible, setting -this option means that toggling the ORDERED property with the command -`org-toggle-ordered-property' will also toggle a tag ORDERED. That tag is -not relevant for the behavior, but it makes things more visible. - -Note that toggling the tag with tags commands will not change the property -and therefore not influence behavior! - -This can be t, meaning the tag ORDERED should be used, It can also be a -string to select a different tag for this task." - :group 'org-todo - :type '(choice - (const :tag "No tracking" nil) - (const :tag "Track with ORDERED tag" t) - (string :tag "Use other tag"))) - -(defun org-toggle-ordered-property () - "Toggle the ORDERED property of the current entry. -For better visibility, you can track the value of this property with a tag. -See variable `org-track-ordered-property-with-tag'." - (interactive) - (let* ((t1 org-track-ordered-property-with-tag) - (tag (and t1 (if (stringp t1) t1 "ORDERED")))) - (save-excursion - (org-back-to-heading) - (if (org-entry-get nil "ORDERED") - (progn - (org-delete-property "ORDERED" "PROPERTIES") - (and tag (org-toggle-tag tag 'off)) - (message "Subtasks can be completed in arbitrary order")) - (org-entry-put nil "ORDERED" "t") - (and tag (org-toggle-tag tag 'on)) - (message "Subtasks must be completed in sequence"))))) - -(defvar org-blocked-by-checkboxes) ; dynamically scoped -(defun org-block-todo-from-checkboxes (change-plist) - "Block turning an entry into a TODO, using checkboxes. -This checks whether the current task should be blocked from state -changes because there are unchecked boxes in this entry." - (if (not org-enforce-todo-checkbox-dependencies) - t ; if locally turned off don't block - (catch 'dont-block - ;; If this is not a todo state change, or if this entry is already DONE, - ;; do not block - (when (or (not (eq (plist-get change-plist :type) 'todo-state-change)) - (member (plist-get change-plist :from) - (cons 'done org-done-keywords)) - (member (plist-get change-plist :to) - (cons 'todo org-not-done-keywords)) - (not (plist-get change-plist :to))) - (throw 'dont-block t)) - ;; If this task has checkboxes that are not checked, it's blocked - (save-excursion - (org-back-to-heading t) - (let ((beg (point)) end) - (outline-next-heading) - (setq end (point)) - (goto-char beg) - (if (org-list-search-forward - (concat (org-item-beginning-re) - "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?" - "\\[[- ]\\]") - end t) - (progn - (if (boundp 'org-blocked-by-checkboxes) - (setq org-blocked-by-checkboxes t)) - (throw 'dont-block nil))))) - t))) ; do not block - -(defun org-entry-blocked-p () - "Is the current entry blocked?" - (org-with-silent-modifications - (if (org-entry-get nil "NOBLOCKING") - nil ;; Never block this entry - (not (run-hook-with-args-until-failure - 'org-blocker-hook - (list :type 'todo-state-change - :position (point) - :from 'todo - :to 'done)))))) - -(defun org-update-statistics-cookies (all) - "Update the statistics cookie, either from TODO or from checkboxes. -This should be called with the cursor in a line with a statistics cookie." - (interactive "P") - (if all - (progn - (org-update-checkbox-count 'all) - (org-map-entries 'org-update-parent-todo-statistics)) - (if (not (org-at-heading-p)) - (org-update-checkbox-count) - (let ((pos (point-marker)) - end l1 l2) - (ignore-errors (org-back-to-heading t)) - (if (not (org-at-heading-p)) - (org-update-checkbox-count) - (setq l1 (org-outline-level)) - (setq end (save-excursion - (outline-next-heading) - (if (org-at-heading-p) (setq l2 (org-outline-level))) - (point))) - (if (and (save-excursion - (re-search-forward - "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) \\[[- X]\\]" end t)) - (not (save-excursion (re-search-forward - ":COOKIE_DATA:.*\\<todo\\>" end t)))) - (org-update-checkbox-count) - (if (and l2 (> l2 l1)) - (progn - (goto-char end) - (org-update-parent-todo-statistics)) - (goto-char pos) - (beginning-of-line 1) - (while (re-search-forward - "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)" - (point-at-eol) t) - (replace-match (if (match-end 2) "[100%]" "[0/0]") t t))))) - (goto-char pos) - (move-marker pos nil))))) - -(defvar org-entry-property-inherited-from) ;; defined below -(defun org-update-parent-todo-statistics () - "Update any statistics cookie in the parent of the current headline. -When `org-hierarchical-todo-statistics' is nil, statistics will cover -the entire subtree and this will travel up the hierarchy and update -statistics everywhere." - (let* ((prop (save-excursion (org-up-heading-safe) - (org-entry-get nil "COOKIE_DATA" 'inherit))) - (recursive (or (not org-hierarchical-todo-statistics) - (and prop (string-match "\\<recursive\\>" prop)))) - (lim (or (and prop (marker-position org-entry-property-inherited-from)) - 0)) - (first t) - (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") - level ltoggle l1 new ndel - (cnt-all 0) (cnt-done 0) is-percent kwd - checkbox-beg ov ovs ove cookie-present) - (catch 'exit - (save-excursion - (beginning-of-line 1) - (setq ltoggle (funcall outline-level)) - ;; Three situations are to consider: - - ;; 1. if `org-hierarchical-todo-statistics' is nil, repeat up - ;; to the top-level ancestor on the headline; - - ;; 2. If parent has "recursive" property, repeat up to the - ;; headline setting that property, taking inheritance into - ;; account; - - ;; 3. Else, move up to direct parent and proceed only once. - (while (and (setq level (org-up-heading-safe)) - (or recursive first) - (>= (point) lim)) - (setq first nil cookie-present nil) - (unless (and level - (not (string-match - "\\<checkbox\\>" - (downcase (or (org-entry-get nil "COOKIE_DATA") - ""))))) - (throw 'exit nil)) - (while (re-search-forward box-re (point-at-eol) t) - (setq cnt-all 0 cnt-done 0 cookie-present t) - (setq is-percent (match-end 2) checkbox-beg (match-beginning 0)) - (save-match-data - (unless (outline-next-heading) (throw 'exit nil)) - (while (and (looking-at org-complex-heading-regexp) - (> (setq l1 (length (match-string 1))) level)) - (setq kwd (and (or recursive (= l1 ltoggle)) - (match-string 2))) - (if (or (eq org-provide-todo-statistics 'all-headlines) - (and (listp org-provide-todo-statistics) - (or (member kwd org-provide-todo-statistics) - (member kwd org-done-keywords)))) - (setq cnt-all (1+ cnt-all)) - (if (eq org-provide-todo-statistics t) - (and kwd (setq cnt-all (1+ cnt-all))))) - (and (member kwd org-done-keywords) - (setq cnt-done (1+ cnt-done))) - (outline-next-heading))) - (setq new - (if is-percent - (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all))) - (format "[%d/%d]" cnt-done cnt-all)) - ndel (- (match-end 0) checkbox-beg)) - ;; handle overlays when updating cookie from column view - (when (setq ov (car (overlays-at checkbox-beg))) - (setq ovs (overlay-start ov) ove (overlay-end ov)) - (delete-overlay ov)) - (goto-char checkbox-beg) - (insert new) - (delete-region (point) (+ (point) ndel)) - (when org-auto-align-tags (org-fix-tags-on-the-fly)) - (when ov (move-overlay ov ovs ove))) - (when cookie-present - (run-hook-with-args 'org-after-todo-statistics-hook - cnt-done (- cnt-all cnt-done)))))) - (run-hooks 'org-todo-statistics-hook))) - -(defvar org-after-todo-statistics-hook nil - "Hook that is called after a TODO statistics cookie has been updated. -Each function is called with two arguments: the number of not-done entries -and the number of done entries. - -For example, the following function, when added to this hook, will switch -an entry to DONE when all children are done, and back to TODO when new -entries are set to a TODO status. Note that this hook is only called -when there is a statistics cookie in the headline! - - (defun org-summary-todo (n-done n-not-done) - \"Switch entry to DONE when all subentries are done, to TODO otherwise.\" - (let (org-log-done org-log-states) ; turn off logging - (org-todo (if (= n-not-done 0) \"DONE\" \"TODO\")))) -") - -(defvar org-todo-statistics-hook nil - "Hook that is run whenever Org thinks TODO statistics should be updated. -This hook runs even if there is no statistics cookie present, in which case -`org-after-todo-statistics-hook' would not run.") - -(defun org-todo-trigger-tag-changes (state) - "Apply the changes defined in `org-todo-state-tags-triggers'." - (let ((l org-todo-state-tags-triggers) - changes) - (when (or (not state) (equal state "")) - (setq changes (append changes (cdr (assoc "" l))))) - (when (and (stringp state) (> (length state) 0)) - (setq changes (append changes (cdr (assoc state l))))) - (when (member state org-not-done-keywords) - (setq changes (append changes (cdr (assoc 'todo l))))) - (when (member state org-done-keywords) - (setq changes (append changes (cdr (assoc 'done l))))) - (dolist (c changes) - (org-toggle-tag (car c) (if (cdr c) 'on 'off))))) - -(defun org-local-logging (value) - "Get logging settings from a property VALUE." - (let* (words w a) - ;; directly set the variables, they are already local. - (setq org-log-done nil - org-log-repeat nil - org-todo-log-states nil) - (setq words (org-split-string value)) - (while (setq w (pop words)) - (cond - ((setq a (assoc w org-startup-options)) - (and (member (nth 1 a) '(org-log-done org-log-repeat)) - (set (nth 1 a) (nth 2 a)))) - ((setq a (org-extract-log-state-settings w)) - (and (member (car a) org-todo-keywords-1) - (push a org-todo-log-states))))))) - -(defun org-get-todo-sequence-head (kwd) - "Return the head of the TODO sequence to which KWD belongs. -If KWD is not set, check if there is a text property remembering the -right sequence." - (let (p) - (cond - ((not kwd) - (or (get-text-property (point-at-bol) 'org-todo-head) - (progn - (setq p (next-single-property-change (point-at-bol) 'org-todo-head - nil (point-at-eol))) - (get-text-property p 'org-todo-head)))) - ((not (member kwd org-todo-keywords-1)) - (car org-todo-keywords-1)) - (t (nth 2 (assoc kwd org-todo-kwd-alist)))))) - -(defun org-fast-todo-selection () - "Fast TODO keyword selection with single keys. -Returns the new TODO keyword, or nil if no state change should occur." - (let* ((fulltable org-todo-key-alist) - (done-keywords org-done-keywords) ;; needed for the faces. - (maxlen (apply 'max (mapcar - (lambda (x) - (if (stringp (car x)) (string-width (car x)) 0)) - fulltable))) - (expert nil) - (fwidth (+ maxlen 3 1 3)) - (ncol (/ (- (window-width) 4) fwidth)) - tg cnt e c tbl - groups ingroup) - (save-excursion - (save-window-excursion - (if expert - (set-buffer (get-buffer-create " *Org todo*")) - (org-switch-to-buffer-other-window (get-buffer-create " *Org todo*"))) - (erase-buffer) - (org-set-local 'org-done-keywords done-keywords) - (setq tbl fulltable 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")) - ((equal e '(:newline)) - (when (not (= cnt 0)) - (setq cnt 0) - (insert "\n") - (setq e (car tbl)) - (while (equal (car tbl) '(:newline)) - (insert "\n") - (setq tbl (cdr tbl))))) - (t - (setq tg (car e) c (cdr e)) - (if ingroup (push tg (car groups))) - (setq tg (org-add-props tg nil 'face - (org-get-todo-face tg))) - (if (and (= cnt 0) (not ingroup)) (insert " ")) - (insert "[" c "] " tg (make-string - (- fwidth 4 (length tg)) ?\ )) - (when (= (setq cnt (1+ cnt)) ncol) - (insert "\n") - (if ingroup (insert " ")) - (setq cnt 0))))) - (insert "\n") - (goto-char (point-min)) - (if (not expert) (org-fit-window-to-buffer)) - (message "[a-z..]:Set [SPC]:clear") - (setq c (let ((inhibit-quit t)) (read-char-exclusive))) - (cond - ((or (= c ?\C-g) - (and (= c ?q) (not (rassoc c fulltable)))) - (setq quit-flag t)) - ((= c ?\ ) nil) - ((setq e (rassoc c fulltable) tg (car e)) - tg) - (t (setq quit-flag t))))))) - -(defun org-entry-is-todo-p () - (member (org-get-todo-state) org-not-done-keywords)) - -(defun org-entry-is-done-p () - (member (org-get-todo-state) org-done-keywords)) - -(defun org-get-todo-state () - "Return the TODO keyword of the current subtree." - (save-excursion - (org-back-to-heading t) - (and (looking-at org-todo-line-regexp) - (match-end 2) - (match-string 2)))) - -(defun org-at-date-range-p (&optional inactive-ok) - "Is the cursor inside a date range?" - (interactive) - (save-excursion - (catch 'exit - (let ((pos (point))) - (skip-chars-backward "^[<\r\n") - (skip-chars-backward "<[") - (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp)) - (>= (match-end 0) pos) - (throw 'exit t)) - (skip-chars-backward "^<[\r\n") - (skip-chars-backward "<[") - (and (looking-at (if inactive-ok org-tr-regexp-both org-tr-regexp)) - (>= (match-end 0) pos) - (throw 'exit t))) - nil))) - -(defun org-get-repeat (&optional tagline) - "Check if there is a deadline/schedule with repeater in this entry." - (save-match-data - (save-excursion - (org-back-to-heading t) - (and (re-search-forward (if tagline - (concat tagline "\\s-*" org-repeat-re) - org-repeat-re) - (org-entry-end-position) t) - (match-string-no-properties 1))))) - -(defvar org-last-changed-timestamp) -(defvar org-last-inserted-timestamp) -(defvar org-log-post-message) -(defvar org-log-note-purpose) -(defvar org-log-note-how) -(defvar org-log-note-extra) -(defun org-auto-repeat-maybe (done-word) - "Check if the current headline contains a repeated deadline/schedule. -If yes, set TODO state back to what it was and change the base date -of repeating deadline/scheduled time stamps to new date. -This function is run automatically after each state change to a DONE state." - ;; last-state is dynamically scoped into this function - (let* ((repeat (org-get-repeat)) - (aa (assoc org-last-state org-todo-kwd-alist)) - (interpret (nth 1 aa)) - (head (nth 2 aa)) - (whata '(("h" . hour) ("d" . day) ("m" . month) ("y" . year))) - (msg "Entry repeats: ") - (org-log-done nil) - (org-todo-log-states nil) - re type n what ts time to-state) - (when repeat - (if (eq org-log-repeat t) (setq org-log-repeat 'state)) - (setq to-state (or (org-entry-get nil "REPEAT_TO_STATE") - org-todo-repeat-to-state)) - (unless (and to-state (member to-state org-todo-keywords-1)) - (setq to-state (if (eq interpret 'type) org-last-state head))) - (org-todo to-state) - (when (or org-log-repeat (org-entry-get nil "CLOCK")) - (org-entry-put nil "LAST_REPEAT" (format-time-string - (org-time-stamp-format t t)))) - (when org-log-repeat - (if (or (memq 'org-add-log-note (default-value 'post-command-hook)) - (memq 'org-add-log-note post-command-hook)) - ;; OK, we are already setup for some record - (if (eq org-log-repeat 'note) - ;; make sure we take a note, not only a time stamp - (setq org-log-note-how 'note)) - ;; Set up for taking a record - (org-add-log-setup 'state (or done-word (car org-done-keywords)) - org-last-state - 'findpos org-log-repeat))) - (org-back-to-heading t) - (org-add-planning-info nil nil 'closed) - (setq re (concat "\\(" org-scheduled-time-regexp "\\)\\|\\(" - org-deadline-time-regexp "\\)\\|\\(" - org-ts-regexp "\\)")) - (while (re-search-forward - re (save-excursion (outline-next-heading) (point)) t) - (setq type (if (match-end 1) org-scheduled-string - (if (match-end 3) org-deadline-string "Plain:")) - ts (match-string (if (match-end 2) 2 (if (match-end 4) 4 0)))) - (when (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts) - (setq n (string-to-number (match-string 2 ts)) - what (match-string 3 ts)) - (if (equal what "w") (setq n (* n 7) what "d")) - (if (and (equal what "h") (not (string-match "[0-9]\\{1,2\\}:[0-9]\\{2\\}" ts))) - (user-error "Cannot repeat in Repeat in %d hour(s) because no hour has been set" n)) - ;; Preparation, see if we need to modify the start date for the change - (when (match-end 1) - (setq time (save-match-data (org-time-string-to-time ts))) - (cond - ((equal (match-string 1 ts) ".") - ;; Shift starting date to today - (org-timestamp-change - (- (org-today) (time-to-days time)) - 'day)) - ((equal (match-string 1 ts) "+") - (let ((nshiftmax 10) (nshift 0)) - (while (or (= nshift 0) - (<= (time-to-days time) - (time-to-days (current-time)))) - (when (= (incf nshift) nshiftmax) - (or (y-or-n-p (message "%d repeater intervals were not enough to shift date past today. Continue? " nshift)) - (error "Abort"))) - (org-timestamp-change n (cdr (assoc what whata))) - (org-at-timestamp-p t) - (setq ts (match-string 1)) - (setq time (save-match-data (org-time-string-to-time ts))))) - (org-timestamp-change (- n) (cdr (assoc what whata))) - ;; rematch, so that we have everything in place for the real shift - (org-at-timestamp-p t) - (setq ts (match-string 1)) - (string-match "\\([.+]\\)?\\(\\+[0-9]+\\)\\([hdwmy]\\)" ts)))) - (save-excursion (org-timestamp-change n (cdr (assoc what whata)) nil t)) - (setq msg (concat msg type " " org-last-changed-timestamp " ")))) - (setq org-log-post-message msg) - (message "%s" msg)))) - -(defun org-show-todo-tree (arg) - "Make a compact tree which shows all headlines marked with TODO. -The tree will show the lines where the regexp matches, and all higher -headlines above the match. -With a \\[universal-argument] prefix, prompt for a regexp to match. -With a numeric prefix N, construct a sparse tree for the Nth element -of `org-todo-keywords-1'." - (interactive "P") - (let ((case-fold-search nil) - (kwd-re - (cond ((null arg) org-not-done-regexp) - ((equal arg '(4)) - (let ((kwd (org-icompleting-read "Keyword (or KWD1|KWD2|...): " - (mapcar 'list org-todo-keywords-1)))) - (concat "\\(" - (mapconcat 'identity (org-split-string kwd "|") "\\|") - "\\)\\>"))) - ((<= (prefix-numeric-value arg) (length org-todo-keywords-1)) - (regexp-quote (nth (1- (prefix-numeric-value arg)) - org-todo-keywords-1))) - (t (user-error "Invalid prefix argument: %s" arg))))) - (message "%d TODO entries found" - (org-occur (concat "^" org-outline-regexp " *" kwd-re ))))) - -(defun org-deadline (arg &optional time) - "Insert the \"DEADLINE:\" string with a timestamp to make a deadline. -With one universal prefix argument, remove any deadline from the item. -With two universal prefix arguments, prompt for a warning delay. -With argument TIME, set the deadline at the corresponding date. TIME -can either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." - (interactive "P") - (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) - (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - `(org-deadline ',arg ,time) - org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (let* ((old-date (org-entry-get nil "DEADLINE")) - (old-date-time (if old-date (org-time-string-to-time old-date))) - (repeater (and old-date - (string-match - "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" - old-date) - (match-string 1 old-date)))) - (cond - ((equal arg '(4)) - (when (and old-date org-log-redeadline) - (org-add-log-setup 'deldeadline nil old-date 'findpos - org-log-redeadline)) - (org-remove-timestamp-with-keyword org-deadline-string) - (message "Item no longer has a deadline.")) - ((equal arg '(16)) - (save-excursion - (org-back-to-heading t) - (if (re-search-forward - org-deadline-time-regexp - (save-excursion (outline-next-heading) (point)) t) - (let* ((rpl0 (match-string 1)) - (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))) - (replace-match - (concat org-deadline-string - " <" rpl - (format " -%dd" - (abs - (- (time-to-days - (save-match-data - (org-read-date nil t nil "Warn starting from" old-date-time))) - (time-to-days old-date-time)))) - ">") t t)) - (user-error "No deadline information to update")))) - (t - (org-add-planning-info 'deadline time 'closed) - (when (and old-date org-log-redeadline - (not (equal old-date - (substring org-last-inserted-timestamp 1 -1)))) - (org-add-log-setup 'redeadline nil old-date 'findpos - org-log-redeadline)) - (when repeater - (save-excursion - (org-back-to-heading t) - (when (re-search-forward (concat org-deadline-string " " - org-last-inserted-timestamp) - (save-excursion - (outline-next-heading) (point)) t) - (goto-char (1- (match-end 0))) - (insert " " repeater) - (setq org-last-inserted-timestamp - (concat (substring org-last-inserted-timestamp 0 -1) - " " repeater - (substring org-last-inserted-timestamp -1)))))) - (message "Deadline on %s" org-last-inserted-timestamp)))))) - -(defun org-schedule (arg &optional time) - "Insert the SCHEDULED: string with a timestamp to schedule a TODO item. -With one universal prefix argument, remove any scheduling date from the item. -With two universal prefix arguments, prompt for a delay cookie. -With argument TIME, scheduled at the corresponding date. TIME can -either be an Org date like \"2011-07-24\" or a delta like \"+2d\"." - (interactive "P") - (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) - (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - `(org-schedule ',arg ,time) - org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (let* ((old-date (org-entry-get nil "SCHEDULED")) - (old-date-time (if old-date (org-time-string-to-time old-date))) - (repeater (and old-date - (string-match - "\\([.+-]+[0-9]+[hdwmy]\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" - old-date) - (match-string 1 old-date)))) - (cond - ((equal arg '(4)) - (progn - (when (and old-date org-log-reschedule) - (org-add-log-setup 'delschedule nil old-date 'findpos - org-log-reschedule)) - (org-remove-timestamp-with-keyword org-scheduled-string) - (message "Item is no longer scheduled."))) - ((equal arg '(16)) - (save-excursion - (org-back-to-heading t) - (if (re-search-forward - org-scheduled-time-regexp - (save-excursion (outline-next-heading) (point)) t) - (let* ((rpl0 (match-string 1)) - (rpl (replace-regexp-in-string " -[0-9]+[hdwmy]" "" rpl0))) - (replace-match - (concat org-scheduled-string - " <" rpl - (format " -%dd" - (abs - (- (time-to-days - (save-match-data - (org-read-date nil t nil "Delay until" old-date-time))) - (time-to-days old-date-time)))) - ">") t t)) - (user-error "No scheduled information to update")))) - (t - (org-add-planning-info 'scheduled time 'closed) - (when (and old-date org-log-reschedule - (not (equal old-date - (substring org-last-inserted-timestamp 1 -1)))) - (org-add-log-setup 'reschedule nil old-date 'findpos - org-log-reschedule)) - (when repeater - (save-excursion - (org-back-to-heading t) - (when (re-search-forward (concat org-scheduled-string " " - org-last-inserted-timestamp) - (save-excursion - (outline-next-heading) (point)) t) - (goto-char (1- (match-end 0))) - (insert " " repeater) - (setq org-last-inserted-timestamp - (concat (substring org-last-inserted-timestamp 0 -1) - " " repeater - (substring org-last-inserted-timestamp -1)))))) - (message "Scheduled to %s" org-last-inserted-timestamp)))))) - -(defun org-get-scheduled-time (pom &optional inherit) - "Get the scheduled time as a time tuple, of a format suitable -for calling org-schedule with, or if there is no scheduling, -returns nil." - (let ((time (org-entry-get pom "SCHEDULED" inherit))) - (when time - (apply 'encode-time (org-parse-time-string time))))) - -(defun org-get-deadline-time (pom &optional inherit) - "Get the deadline as a time tuple, of a format suitable for -calling org-deadline with, or if there is no scheduling, returns -nil." - (let ((time (org-entry-get pom "DEADLINE" inherit))) - (when time - (apply 'encode-time (org-parse-time-string time))))) - -(defun org-remove-timestamp-with-keyword (keyword) - "Remove all time stamps with KEYWORD in the current entry." - (let ((re (concat "\\<" (regexp-quote keyword) " +<[^>\n]+>[ \t]*")) - beg) - (save-excursion - (org-back-to-heading t) - (setq beg (point)) - (outline-next-heading) - (while (re-search-backward re beg t) - (replace-match "") - (if (and (string-match "\\S-" (buffer-substring (point-at-bol) (point))) - (equal (char-before) ?\ )) - (backward-delete-char 1) - (if (string-match "^[ \t]*$" (buffer-substring - (point-at-bol) (point-at-eol))) - (delete-region (point-at-bol) - (min (point-max) (1+ (point-at-eol)))))))))) - -(defvar org-time-was-given) ; dynamically scoped parameter -(defvar org-end-time-was-given) ; dynamically scoped parameter - -(defun org-add-planning-info (what &optional time &rest remove) - "Insert new timestamp with keyword in the line directly after the headline. -WHAT indicates what kind of time stamp to add. TIME indicates the time to use. -If non is given, the user is prompted for a date. -REMOVE indicates what kind of entries to remove. An old WHAT entry will also -be removed." - (interactive) - (let (org-time-was-given org-end-time-was-given ts - end default-time default-input) - - (catch 'exit - (when (and (memq what '(scheduled deadline)) - (or (not time) - (and (stringp time) - (string-match "^[-+]+[0-9]" time)))) - ;; Try to get a default date/time from existing timestamp - (save-excursion - (org-back-to-heading t) - (setq end (save-excursion (outline-next-heading) (point))) - (when (re-search-forward (if (eq what 'scheduled) - org-scheduled-time-regexp - org-deadline-time-regexp) - end t) - (setq ts (match-string 1) - default-time - (apply 'encode-time (org-parse-time-string ts)) - default-input (and ts (org-get-compact-tod ts)))))) - (when what - (setq time - (if (stringp time) - ;; This is a string (relative or absolute), set proper date - (apply 'encode-time - (org-read-date-analyze - time default-time (decode-time default-time))) - ;; If necessary, get the time from the user - (or time (org-read-date nil 'to-time nil nil - default-time default-input))))) - - (when (and org-insert-labeled-timestamps-at-point - (member what '(scheduled deadline))) - (insert - (if (eq what 'scheduled) org-scheduled-string org-deadline-string) " ") - (org-insert-time-stamp time org-time-was-given - nil nil nil (list org-end-time-was-given)) - (setq what nil)) - (save-excursion - (save-restriction - (let (col list elt ts buffer-invisibility-spec) - (org-back-to-heading t) - (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*")) - (goto-char (match-end 1)) - (setq col (current-column)) - (goto-char (match-end 0)) - (if (eobp) (insert "\n") (forward-char 1)) - (when (and (not what) - (not (looking-at - (concat "[ \t]*" - org-keyword-time-not-clock-regexp)))) - ;; Nothing to add, nothing to remove...... :-) - (throw 'exit nil)) - (if (and (not (looking-at org-outline-regexp)) - (looking-at (concat "[^\r\n]*?" org-keyword-time-regexp - "[^\r\n]*")) - (not (equal (match-string 1) org-clock-string))) - (narrow-to-region (match-beginning 0) (match-end 0)) - (insert-before-markers "\n") - (backward-char 1) - (narrow-to-region (point) (point)) - (and org-adapt-indentation (org-indent-to-column col))) - ;; Check if we have to remove something. - (setq list (cons what remove)) - (while list - (setq elt (pop list)) - (when (or (and (eq elt 'scheduled) - (re-search-forward org-scheduled-time-regexp nil t)) - (and (eq elt 'deadline) - (re-search-forward org-deadline-time-regexp nil t)) - (and (eq elt 'closed) - (re-search-forward org-closed-time-regexp nil t))) - (replace-match "") - (if (looking-at "--+<[^>]+>") (replace-match "")))) - (and (looking-at "[ \t]+") (replace-match "")) - (and org-adapt-indentation (bolp) (org-indent-to-column col)) - (when what - (insert - (if (not (or (bolp) (eq (char-before) ?\ ))) " " "") - (cond ((eq what 'scheduled) org-scheduled-string) - ((eq what 'deadline) org-deadline-string) - ((eq what 'closed) org-closed-string)) - " ") - (setq ts (org-insert-time-stamp - time - (or org-time-was-given - (and (eq what 'closed) org-log-done-with-time)) - (eq what 'closed) - nil nil (list org-end-time-was-given))) - (insert - (if (not (or (bolp) (eq (char-before) ?\ ) - (memq (char-after) '(32 10)) - (eobp))) " " "")) - (end-of-line 1)) - (goto-char (point-min)) - (widen) - (if (and (looking-at "[ \t]*\n") - (equal (char-before) ?\n)) - (delete-region (1- (point)) (point-at-eol))) - ts)))))) - -(defvar org-log-note-marker (make-marker)) -(defvar org-log-note-purpose nil) -(defvar org-log-note-state nil) -(defvar org-log-note-previous-state nil) -(defvar org-log-note-how nil) -(defvar org-log-note-extra nil) -(defvar org-log-note-window-configuration nil) -(defvar org-log-note-return-to (make-marker)) -(defvar org-log-note-effective-time nil - "Remembered current time so that dynamically scoped -`org-extend-today-until' affects tha timestamps in state change -log") - -(defvar org-log-post-message nil - "Message to be displayed after a log note has been stored. -The auto-repeater uses this.") - -(defun org-add-note () - "Add a note to the current entry. -This is done in the same way as adding a state change note." - (interactive) - (org-add-log-setup 'note nil nil 'findpos nil)) - -(defvar org-property-end-re) -(defun org-add-log-setup (&optional purpose state prev-state - findpos how extra) - "Set up the post command hook to take a note. -If this is about to TODO state change, the new state is expected in STATE. -When FINDPOS is non-nil, find the correct position for the note in -the current entry. If not, assume that it can be inserted at point. -HOW is an indicator what kind of note should be created. -EXTRA is additional text that will be inserted into the notes buffer." - (let* ((org-log-into-drawer (org-log-into-drawer)) - (drawer (cond ((stringp org-log-into-drawer) - org-log-into-drawer) - (org-log-into-drawer "LOGBOOK")))) - (save-restriction - (save-excursion - (when findpos - (org-back-to-heading t) - (narrow-to-region (point) (save-excursion - (outline-next-heading) (point))) - (looking-at (concat org-outline-regexp "\\( *\\)[^\r\n]*" - "\\(\n[^\r\n]*?" org-keyword-time-not-clock-regexp - "[^\r\n]*\\)?")) - (goto-char (match-end 0)) - (cond - (drawer - (if (re-search-forward (concat "^[ \t]*:" drawer ":[ \t]*$") - nil t) - (progn - (goto-char (match-end 0)) - (or org-log-states-order-reversed - (and (re-search-forward org-property-end-re nil t) - (goto-char (1- (match-beginning 0)))))) - (insert "\n:" drawer ":\n:END:") - (beginning-of-line 0) - (org-indent-line) - (beginning-of-line 2) - (org-indent-line) - (end-of-line 0))) - ((and org-log-state-notes-insert-after-drawers - (save-excursion - (forward-line) (looking-at org-drawer-regexp))) - (forward-line) - (while (looking-at org-drawer-regexp) - (goto-char (match-end 0)) - (re-search-forward org-property-end-re (point-max) t) - (forward-line)) - (forward-line -1))) - (unless org-log-states-order-reversed - (and (= (char-after) ?\n) (forward-char 1)) - (org-skip-over-state-notes) - (skip-chars-backward " \t\n\r"))) - (move-marker org-log-note-marker (point)) - (setq org-log-note-purpose purpose - org-log-note-state state - org-log-note-previous-state prev-state - org-log-note-how how - org-log-note-extra extra - org-log-note-effective-time (org-current-effective-time)) - (add-hook 'post-command-hook 'org-add-log-note 'append))))) - -(defun org-skip-over-state-notes () - "Skip past the list of State notes in an entry." - (if (looking-at "\n[ \t]*- State") (forward-char 1)) - (when (ignore-errors (goto-char (org-in-item-p))) - (let* ((struct (org-list-struct)) - (prevs (org-list-prevs-alist struct))) - (while (looking-at "[ \t]*- State") - (goto-char (or (org-list-get-next-item (point) struct prevs) - (org-list-get-item-end (point) struct))))))) - -(defun org-add-log-note (&optional purpose) - "Pop up a window for taking a note, and add this note later at point." - (remove-hook 'post-command-hook 'org-add-log-note) - (setq org-log-note-window-configuration (current-window-configuration)) - (delete-other-windows) - (move-marker org-log-note-return-to (point)) - (org-pop-to-buffer-same-window (marker-buffer org-log-note-marker)) - (goto-char org-log-note-marker) - (org-switch-to-buffer-other-window "*Org Note*") - (erase-buffer) - (if (memq org-log-note-how '(time state)) - (let (current-prefix-arg) (org-store-log-note)) - (let ((org-inhibit-startup t)) (org-mode)) - (insert (format "# Insert note for %s. -# Finish with C-c C-c, or cancel with C-c C-k.\n\n" - (cond - ((eq org-log-note-purpose 'clock-out) "stopped clock") - ((eq org-log-note-purpose 'done) "closed todo item") - ((eq org-log-note-purpose 'state) - (format "state change from \"%s\" to \"%s\"" - (or org-log-note-previous-state "") - (or org-log-note-state ""))) - ((eq org-log-note-purpose 'reschedule) - "rescheduling") - ((eq org-log-note-purpose 'delschedule) - "no longer scheduled") - ((eq org-log-note-purpose 'redeadline) - "changing deadline") - ((eq org-log-note-purpose 'deldeadline) - "removing deadline") - ((eq org-log-note-purpose 'refile) - "refiling") - ((eq org-log-note-purpose 'note) - "this entry") - (t (error "This should not happen"))))) - (if org-log-note-extra (insert org-log-note-extra)) - (org-set-local 'org-finish-function 'org-store-log-note) - (run-hooks 'org-log-buffer-setup-hook))) - -(defvar org-note-abort nil) ; dynamically scoped -(defun org-store-log-note () - "Finish taking a log note, and insert it to where it belongs." - (let ((txt (buffer-string))) - (kill-buffer (current-buffer)) - (let ((note (cdr (assq org-log-note-purpose org-log-note-headings))) - lines ind bul) - (while (string-match "\\`# .*\n[ \t\n]*" txt) - (setq txt (replace-match "" t t txt))) - (if (string-match "\\s-+\\'" txt) - (setq txt (replace-match "" t t txt))) - (setq lines (org-split-string txt "\n")) - (when (and note (string-match "\\S-" note)) - (setq note - (org-replace-escapes - note - (list (cons "%u" (user-login-name)) - (cons "%U" user-full-name) - (cons "%t" (format-time-string - (org-time-stamp-format 'long 'inactive) - org-log-note-effective-time)) - (cons "%T" (format-time-string - (org-time-stamp-format 'long nil) - org-log-note-effective-time)) - (cons "%d" (format-time-string - (org-time-stamp-format nil 'inactive) - org-log-note-effective-time)) - (cons "%D" (format-time-string - (org-time-stamp-format nil nil) - org-log-note-effective-time)) - (cons "%s" (if org-log-note-state - (concat "\"" org-log-note-state "\"") - "")) - (cons "%S" (if org-log-note-previous-state - (concat "\"" org-log-note-previous-state "\"") - "\"\""))))) - (if lines (setq note (concat note " \\\\"))) - (push note lines)) - (when (or current-prefix-arg org-note-abort) - (when org-log-into-drawer - (org-remove-empty-drawer-at - (if (stringp org-log-into-drawer) org-log-into-drawer "LOGBOOK") - org-log-note-marker)) - (setq lines nil)) - (when lines - (with-current-buffer (marker-buffer org-log-note-marker) - (save-excursion - (goto-char org-log-note-marker) - (move-marker org-log-note-marker nil) - (end-of-line 1) - (if (not (bolp)) (let ((inhibit-read-only t)) (insert "\n"))) - (setq ind (save-excursion - (if (ignore-errors (goto-char (org-in-item-p))) - (let ((struct (org-list-struct))) - (org-list-get-ind - (org-list-get-top-point struct) struct)) - (skip-chars-backward " \r\t\n") - (cond - ((and (org-at-heading-p) - org-adapt-indentation) - (1+ (org-current-level))) - ((org-at-heading-p) 0) - (t (org-get-indentation)))))) - (setq bul (org-list-bullet-string "-")) - (org-indent-line-to ind) - (insert bul (pop lines)) - (let ((ind-body (+ (length bul) ind))) - (while lines - (insert "\n") - (org-indent-line-to ind-body) - (insert (pop lines)))) - (message "Note stored") - (org-back-to-heading t) - (org-cycle-hide-drawers 'children)) - ;; Fix `buffer-undo-list' when `org-store-log-note' is called - ;; from within `org-add-log-note' because `buffer-undo-list' - ;; is then modified outside of `org-with-remote-undo'. - (when (eq this-command 'org-agenda-todo) - (setcdr buffer-undo-list (cddr buffer-undo-list))))))) - ;; Don't add undo information when called from `org-agenda-todo' - (let ((buffer-undo-list (eq this-command 'org-agenda-todo))) - (set-window-configuration org-log-note-window-configuration) - (with-current-buffer (marker-buffer org-log-note-return-to) - (goto-char org-log-note-return-to)) - (move-marker org-log-note-return-to nil) - (and org-log-post-message (message "%s" org-log-post-message)))) - -(defun org-remove-empty-drawer-at (drawer pos) - "Remove an empty drawer DRAWER at position POS. -POS may also be a marker." - (with-current-buffer (if (markerp pos) (marker-buffer pos) (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char pos) - (if (org-in-regexp - (concat "^[ \t]*:" drawer ":[ \t]*\n[ \t]*:END:[ \t]*\n?") 2) - (replace-match "")))))) - -(defvar org-ts-type nil) -(defun org-sparse-tree (&optional arg type) - "Create a sparse tree, prompt for the details. -This command can create sparse trees. You first need to select the type -of match used to create the tree: - -t Show all TODO entries. -T Show entries with a specific TODO keyword. -m Show entries selected by a tags/property match. -p Enter a property name and its value (both with completion on existing - names/values) and show entries with that property. -r Show entries matching a regular expression (`/' can be used as well). -b Show deadlines and scheduled items before a date. -a Show deadlines and scheduled items after a date. -d Show deadlines due within `org-deadline-warning-days'. -D Show deadlines and scheduled items between a date range." - (interactive "P") - (let (ans kwd value ts-type) - (setq type (or type org-sparse-tree-default-date-type)) - (setq org-ts-type type) - (message "Sparse tree: [/]regexp [t]odo [T]odo-kwd [m]atch [p]roperty\n [d]eadlines [b]efore-date [a]fter-date [D]ates range\n [c]ycle through date types: %s" - (cond ((eq type 'all) "all timestamps") - ((eq type 'scheduled) "only scheduled") - ((eq type 'deadline) "only deadline") - ((eq type 'active) "only active timestamps") - ((eq type 'inactive) "only inactive timestamps") - ((eq type 'scheduled-or-deadline) "scheduled/deadline") - ((eq type 'closed) "with a closed time-stamp") - (t "scheduled/deadline"))) - (setq ans (read-char-exclusive)) - (cond - ((equal ans ?c) - (org-sparse-tree - arg (cadr (member type '(scheduled-or-deadline - all scheduled deadline active inactive closed))))) - ((equal ans ?d) - (call-interactively 'org-check-deadlines)) - ((equal ans ?b) - (call-interactively 'org-check-before-date)) - ((equal ans ?a) - (call-interactively 'org-check-after-date)) - ((equal ans ?D) - (call-interactively 'org-check-dates-range)) - ((equal ans ?t) - (call-interactively 'org-show-todo-tree)) - ((equal ans ?T) - (org-show-todo-tree '(4))) - ((member ans '(?T ?m)) - (call-interactively 'org-match-sparse-tree)) - ((member ans '(?p ?P)) - (setq kwd (org-icompleting-read "Property: " - (mapcar 'list (org-buffer-property-keys)))) - (setq value (org-icompleting-read "Value: " - (mapcar 'list (org-property-values kwd)))) - (unless (string-match "\\`{.*}\\'" value) - (setq value (concat "\"" value "\""))) - (org-match-sparse-tree arg (concat kwd "=" value))) - ((member ans '(?r ?R ?/)) - (call-interactively 'org-occur)) - (t (user-error "No such sparse tree command \"%c\"" ans))))) - -(defvar org-occur-highlights nil - "List of overlays used for occur matches.") -(make-variable-buffer-local 'org-occur-highlights) -(defvar org-occur-parameters nil - "Parameters of the active org-occur calls. -This is a list, each call to org-occur pushes as cons cell, -containing the regular expression and the callback, onto the list. -The list can contain several entries if `org-occur' has been called -several time with the KEEP-PREVIOUS argument. Otherwise, this list -will only contain one set of parameters. When the highlights are -removed (for example with `C-c C-c', or with the next edit (depending -on `org-remove-highlights-with-change'), this variable is emptied -as well.") -(make-variable-buffer-local 'org-occur-parameters) - -(defun org-occur (regexp &optional keep-previous callback) - "Make a compact tree which shows all matches of REGEXP. -The tree will show the lines where the regexp matches, and all higher -headlines above the match. It will also show the heading after the match, -to make sure editing the matching entry is easy. -If KEEP-PREVIOUS is non-nil, highlighting and exposing done by a previous -call to `org-occur' will be kept, to allow stacking of calls to this -command. -If CALLBACK is non-nil, it is a function which is called to confirm -that the match should indeed be shown." - (interactive "sRegexp: \nP") - (when (equal regexp "") - (user-error "Regexp cannot be empty")) - (unless keep-previous - (org-remove-occur-highlights nil nil t)) - (push (cons regexp callback) org-occur-parameters) - (let ((cnt 0)) - (save-excursion - (goto-char (point-min)) - (if (or (not keep-previous) ; do not want to keep - (not org-occur-highlights)) ; no previous matches - ;; hide everything - (org-overview)) - (while (re-search-forward regexp nil t) - (when (or (not callback) - (save-match-data (funcall callback))) - (setq cnt (1+ cnt)) - (when org-highlight-sparse-tree-matches - (org-highlight-new-match (match-beginning 0) (match-end 0))) - (org-show-context 'occur-tree)))) - (when org-remove-highlights-with-change - (org-add-hook 'before-change-functions 'org-remove-occur-highlights - nil 'local)) - (unless org-sparse-tree-open-archived-trees - (org-hide-archived-subtrees (point-min) (point-max))) - (run-hooks 'org-occur-hook) - (if (org-called-interactively-p 'interactive) - (message "%d match(es) for regexp %s" cnt regexp)) - cnt)) - -(defun org-occur-next-match (&optional n reset) - "Function for `next-error-function' to find sparse tree matches. -N is the number of matches to move, when negative move backwards. -RESET is entirely ignored - this function always goes back to the -starting point when no match is found." - (let* ((limit (if (< n 0) (point-min) (point-max))) - (search-func (if (< n 0) - 'previous-single-char-property-change - 'next-single-char-property-change)) - (n (abs n)) - (pos (point)) - p1) - (catch 'exit - (while (setq p1 (funcall search-func (point) 'org-type)) - (when (equal p1 limit) - (goto-char pos) - (error "No more matches")) - (when (equal (get-char-property p1 'org-type) 'org-occur) - (setq n (1- n)) - (when (= n 0) - (goto-char p1) - (throw 'exit (point)))) - (goto-char p1)) - (goto-char p1) - (error "No more matches")))) - -(defun org-show-context (&optional key) - "Make sure point and context are visible. -How much context is shown depends upon the variables -`org-show-hierarchy-above', `org-show-following-heading', -`org-show-entry-below' and `org-show-siblings'." - (let ((heading-p (org-at-heading-p t)) - (hierarchy-p (org-get-alist-option org-show-hierarchy-above key)) - (following-p (org-get-alist-option org-show-following-heading key)) - (entry-p (org-get-alist-option org-show-entry-below key)) - (siblings-p (org-get-alist-option org-show-siblings key))) - ;; Show heading or entry text - (if (and heading-p (not entry-p)) - (org-flag-heading nil) ; only show the heading - (and (or entry-p (outline-invisible-p) (org-invisible-p2)) - (org-show-hidden-entry))) ; show entire entry - (when following-p - ;; Show next sibling, or heading below text - (save-excursion - (and (if heading-p (org-goto-sibling) (outline-next-heading)) - (org-flag-heading nil)))) - (when siblings-p (org-show-siblings)) - (when hierarchy-p - ;; show all higher headings, possibly with siblings - (save-excursion - (while (and (condition-case nil - (progn (org-up-heading-all 1) t) - (error nil)) - (not (bobp))) - (org-flag-heading nil) - (when siblings-p (org-show-siblings))))) - (unless (eq key 'agenda) (org-fix-ellipsis-at-bol)))) - -(defvar org-reveal-start-hook nil - "Hook run before revealing a location.") - -(defun org-reveal (&optional siblings) - "Show current entry, hierarchy above it, and the following headline. -This can be used to show a consistent set of context around locations -exposed with `org-show-hierarchy-above' or `org-show-following-heading' -not t for the search context. - -With optional argument SIBLINGS, on each level of the hierarchy all -siblings are shown. This repairs the tree structure to what it would -look like when opened with hierarchical calls to `org-cycle'. -With double optional argument \\[universal-argument] \\[universal-argument], \ -go to the parent and show the -entire tree." - (interactive "P") - (run-hooks 'org-reveal-start-hook) - (let ((org-show-hierarchy-above t) - (org-show-following-heading t) - (org-show-siblings (if siblings t org-show-siblings))) - (org-show-context nil)) - (when (equal siblings '(16)) - (save-excursion - (when (org-up-heading-safe) - (org-show-subtree) - (run-hook-with-args 'org-cycle-hook 'subtree))))) - -(defun org-highlight-new-match (beg end) - "Highlight from BEG to END and mark the highlight is an occur headline." - (let ((ov (make-overlay beg end))) - (overlay-put ov 'face 'secondary-selection) - (overlay-put ov 'org-type 'org-occur) - (push ov org-occur-highlights))) - -(defun org-remove-occur-highlights (&optional beg end noremove) - "Remove the occur highlights from the buffer. -BEG and END are ignored. If NOREMOVE is nil, remove this function -from the `before-change-functions' in the current buffer." - (interactive) - (unless org-inhibit-highlight-removal - (mapc 'delete-overlay org-occur-highlights) - (setq org-occur-highlights nil) - (setq org-occur-parameters nil) - (unless noremove - (remove-hook 'before-change-functions - 'org-remove-occur-highlights 'local)))) - -;;;; Priorities - -(defvar org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]\\)\\] ?\\)" - "Regular expression matching the priority indicator.") - -(defvar org-remove-priority-next-time nil) - -(defun org-priority-up () - "Increase the priority of the current item." - (interactive) - (org-priority 'up)) - -(defun org-priority-down () - "Decrease the priority of the current item." - (interactive) - (org-priority 'down)) - -(defun org-priority (&optional action show) - "Change the priority of an item. -ACTION can be `set', `up', `down', or a character." - (interactive "P") - (if (equal action '(4)) - (org-show-priority) - (unless org-enable-priority-commands - (user-error "Priority commands are disabled")) - (setq action (or action 'set)) - (let (current new news have remove) - (save-excursion - (org-back-to-heading t) - (if (looking-at org-priority-regexp) - (setq current (string-to-char (match-string 2)) - have t)) - (cond - ((eq action 'remove) - (setq remove t new ?\ )) - ((or (eq action 'set) - (if (featurep 'xemacs) (characterp action) (integerp action))) - (if (not (eq action 'set)) - (setq new action) - (message "Priority %c-%c, SPC to remove: " - org-highest-priority org-lowest-priority) - (save-match-data - (setq new (read-char-exclusive)))) - (if (and (= (upcase org-highest-priority) org-highest-priority) - (= (upcase org-lowest-priority) org-lowest-priority)) - (setq new (upcase new))) - (cond ((equal new ?\ ) (setq remove t)) - ((or (< (upcase new) org-highest-priority) (> (upcase new) org-lowest-priority)) - (user-error "Priority must be between `%c' and `%c'" - org-highest-priority org-lowest-priority)))) - ((eq action 'up) - (setq new (if have - (1- current) ; normal cycling - ;; last priority was empty - (if (eq last-command this-command) - org-lowest-priority ; wrap around empty to lowest - ;; default - (if org-priority-start-cycle-with-default - org-default-priority - (1- org-default-priority)))))) - ((eq action 'down) - (setq new (if have - (1+ current) ; normal cycling - ;; last priority was empty - (if (eq last-command this-command) - org-highest-priority ; wrap around empty to highest - ;; default - (if org-priority-start-cycle-with-default - org-default-priority - (1+ org-default-priority)))))) - (t (user-error "Invalid action"))) - (if (or (< (upcase new) org-highest-priority) - (> (upcase new) org-lowest-priority)) - (if (and (memq action '(up down)) - (not have) (not (eq last-command this-command))) - ;; `new' is from default priority - (error - "The default can not be set, see `org-default-priority' why") - ;; normal cycling: `new' is beyond highest/lowest priority - ;; and is wrapped around to the empty priority - (setq remove t))) - (setq news (format "%c" new)) - (if have - (if remove - (replace-match "" t t nil 1) - (replace-match news t t nil 2)) - (if remove - (user-error "No priority cookie found in line") - (let ((case-fold-search nil)) - (looking-at org-todo-line-regexp)) - (if (match-end 2) - (progn - (goto-char (match-end 2)) - (insert " [#" news "]")) - (goto-char (match-beginning 3)) - (insert "[#" news "] ")))) - (org-preserve-lc (org-set-tags nil 'align))) - (if remove - (message "Priority removed") - (message "Priority of current item set to %s" news))))) - -(defun org-show-priority () - "Show the priority of the current item. -This priority is composed of the main priority given with the [#A] cookies, -and by additional input from the age of a schedules or deadline entry." - (interactive) - (let ((pri (if (eq major-mode 'org-agenda-mode) - (org-get-at-bol 'priority) - (save-excursion - (save-match-data - (beginning-of-line) - (and (looking-at org-heading-regexp) - (org-get-priority (match-string 0)))))))) - (message "Priority is %d" (if pri pri -1000)))) - -(defun org-get-priority (s) - "Find priority cookie and return priority." - (save-match-data - (if (functionp org-get-priority-function) - (funcall org-get-priority-function) - (if (not (string-match org-priority-regexp s)) - (* 1000 (- org-lowest-priority org-default-priority)) - (* 1000 (- org-lowest-priority - (string-to-char (match-string 2 s)))))))) - -;;;; Tags - -(defvar org-agenda-archives-mode) -(defvar org-map-continue-from nil - "Position from where mapping should continue. -Can be set by the action argument to `org-scan-tags' and `org-map-entries'.") - -(defvar org-scanner-tags nil - "The current tag list while the tags scanner is running.") -(defvar org-trust-scanner-tags nil - "Should `org-get-tags-at' use the tags for the scanner. -This is for internal dynamical scoping only. -When this is non-nil, the function `org-get-tags-at' will return the value -of `org-scanner-tags' instead of building the list by itself. This -can lead to large speed-ups when the tags scanner is used in a file with -many entries, and when the list of tags is retrieved, for example to -obtain a list of properties. Building the tags list for each entry in such -a file becomes an N^2 operation - but with this variable set, it scales -as N.") - -(defun org-scan-tags (action matcher todo-only &optional start-level) - "Sca headline tags with inheritance and produce output ACTION. - -ACTION can be `sparse-tree' to produce a sparse tree in the current buffer, -or `agenda' to produce an entry list for an agenda view. It can also be -a Lisp form or a function that should be called at each matched headline, in -this case the return value is a list of all return values from these calls. - -MATCHER is a Lisp form to be evaluated, testing if a given set of tags -qualifies a headline for inclusion. When TODO-ONLY is non-nil, -only lines with a not-done TODO keyword are included in the output. -This should be the same variable that was scoped into -and set by `org-make-tags-matcher' when it constructed MATCHER. - -START-LEVEL can be a string with asterisks, reducing the scope to -headlines matching this string." - (require 'org-agenda) - (let* ((re (concat "^" - (if start-level - ;; Get the correct level to match - (concat "\\*\\{" (number-to-string start-level) "\\} ") - org-outline-regexp) - " *\\(\\<\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - (org-re "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$"))) - (props (list 'face 'default - 'done-face 'org-agenda-done - 'undone-face 'default - 'mouse-face 'highlight - 'org-not-done-regexp org-not-done-regexp - 'org-todo-regexp org-todo-regexp - 'org-complex-heading-regexp org-complex-heading-regexp - 'help-echo - (format "mouse-2 or RET jump to org file %s" - (abbreviate-file-name - (or (buffer-file-name (buffer-base-buffer)) - (buffer-name (buffer-base-buffer))))))) - (org-map-continue-from nil) - lspos tags tags-list - (tags-alist (list (cons 0 org-file-tags))) - (llast 0) rtn rtn1 level category i txt - todo marker entry priority) - (when (not (or (member action '(agenda sparse-tree)) (functionp action))) - (setq action (list 'lambda nil action))) - (save-excursion - (goto-char (point-min)) - (when (eq action 'sparse-tree) - (org-overview) - (org-remove-occur-highlights)) - (while (let (case-fold-search) - (re-search-forward re nil t)) - (setq org-map-continue-from nil) - (catch :skip - (setq todo (if (match-end 1) (org-match-string-no-properties 2)) - tags (if (match-end 4) (org-match-string-no-properties 4))) - (goto-char (setq lspos (match-beginning 0))) - (setq level (org-reduced-level (org-outline-level)) - category (org-get-category)) - (setq i llast llast level) - ;; remove tag lists from same and sublevels - (while (>= i level) - (when (setq entry (assoc i tags-alist)) - (setq tags-alist (delete entry tags-alist))) - (setq i (1- i))) - ;; add the next tags - (when tags - (setq tags (org-split-string tags ":") - tags-alist - (cons (cons level tags) tags-alist))) - ;; compile tags for current headline - (setq tags-list - (if org-use-tag-inheritance - (apply 'append (mapcar 'cdr (reverse tags-alist))) - tags) - org-scanner-tags tags-list) - (when org-use-tag-inheritance - (setcdr (car tags-alist) - (mapcar (lambda (x) - (setq x (copy-sequence x)) - (org-add-prop-inherited x)) - (cdar tags-alist)))) - (when (and tags org-use-tag-inheritance - (or (not (eq t org-use-tag-inheritance)) - org-tags-exclude-from-inheritance)) - ;; selective inheritance, remove uninherited ones - (setcdr (car tags-alist) - (org-remove-uninherited-tags (cdar tags-alist)))) - (when (and - - ;; eval matcher only when the todo condition is OK - (and (or (not todo-only) (member todo org-not-done-keywords)) - (let ((case-fold-search t) (org-trust-scanner-tags t)) - (eval matcher))) - - ;; Call the skipper, but return t if it does not skip, - ;; so that the `and' form continues evaluating - (progn - (unless (eq action 'sparse-tree) (org-agenda-skip)) - t) - - ;; Check if timestamps are deselecting this entry - (or (not todo-only) - (and (member todo org-not-done-keywords) - (or (not org-agenda-tags-todo-honor-ignore-options) - (not (org-agenda-check-for-timestamp-as-reason-to-ignore-todo-item)))))) - - ;; select this headline - (cond - ((eq action 'sparse-tree) - (and org-highlight-sparse-tree-matches - (org-get-heading) (match-end 0) - (org-highlight-new-match - (match-beginning 1) (match-end 1))) - (org-show-context 'tags-tree)) - ((eq action 'agenda) - (setq txt (org-agenda-format-item - "" - (concat - (if (eq org-tags-match-list-sublevels 'indented) - (make-string (1- level) ?.) "") - (org-get-heading)) - level category - tags-list) - priority (org-get-priority txt)) - (goto-char lspos) - (setq marker (org-agenda-new-marker)) - (org-add-props txt props - 'org-marker marker 'org-hd-marker marker 'org-category category - 'todo-state todo - 'priority priority 'type "tagsmatch") - (push txt rtn)) - ((functionp action) - (setq org-map-continue-from nil) - (save-excursion - (setq rtn1 (funcall action)) - (push rtn1 rtn))) - (t (user-error "Invalid action"))) - - ;; if we are to skip sublevels, jump to end of subtree - (unless org-tags-match-list-sublevels - (org-end-of-subtree t) - (backward-char 1)))) - ;; Get the correct position from where to continue - (if org-map-continue-from - (goto-char org-map-continue-from) - (and (= (point) lspos) (end-of-line 1))))) - (when (and (eq action 'sparse-tree) - (not org-sparse-tree-open-archived-trees)) - (org-hide-archived-subtrees (point-min) (point-max))) - (nreverse rtn))) - -(defun org-remove-uninherited-tags (tags) - "Remove all tags that are not inherited from the list TAGS." - (cond - ((eq org-use-tag-inheritance t) - (if org-tags-exclude-from-inheritance - (org-delete-all org-tags-exclude-from-inheritance tags) - tags)) - ((not org-use-tag-inheritance) nil) - ((stringp org-use-tag-inheritance) - (delq nil (mapcar - (lambda (x) - (if (and (string-match org-use-tag-inheritance x) - (not (member x org-tags-exclude-from-inheritance))) - x nil)) - tags))) - ((listp org-use-tag-inheritance) - (delq nil (mapcar - (lambda (x) - (if (member x org-use-tag-inheritance) x nil)) - tags))))) - -(defun org-match-sparse-tree (&optional todo-only match) - "Create a sparse tree according to tags string MATCH. -MATCH can contain positive and negative selection of tags, like -\"+WORK+URGENT-WITHBOSS\". -If optional argument TODO-ONLY is non-nil, only select lines that are -also TODO lines." - (interactive "P") - (org-agenda-prepare-buffers (list (current-buffer))) - (org-scan-tags 'sparse-tree (cdr (org-make-tags-matcher match)) todo-only)) - -(defalias 'org-tags-sparse-tree 'org-match-sparse-tree) - -(defvar org-cached-props nil) -(defun org-cached-entry-get (pom property) - (if (or (eq t org-use-property-inheritance) - (and (stringp org-use-property-inheritance) - (string-match org-use-property-inheritance property)) - (and (listp org-use-property-inheritance) - (member property org-use-property-inheritance))) - ;; Caching is not possible, check it directly - (org-entry-get pom property 'inherit) - ;; Get all properties, so that we can do complicated checks easily - (cdr (assoc property (or org-cached-props - (setq org-cached-props - (org-entry-properties pom))))))) - -(defun org-global-tags-completion-table (&optional files) - "Return the list of all tags in all agenda buffer/files. -Optional FILES argument is a list of files which can be used -instead of the agenda files." - (save-excursion - (org-uniquify - (delq nil - (apply 'append - (mapcar - (lambda (file) - (set-buffer (find-file-noselect file)) - (append (org-get-buffer-tags) - (mapcar (lambda (x) (if (stringp (car-safe x)) - (list (car-safe x)) nil)) - org-tag-alist))) - (if (and files (car files)) - files - (org-agenda-files)))))))) - -(defun org-make-tags-matcher (match) - "Create the TAGS/TODO matcher form for the selection string MATCH. - -The variable `todo-only' is scoped dynamically into this function. -It will be set to t if the matcher restricts matching to TODO entries, -otherwise will not be touched. - -Returns a cons of the selection string MATCH and the constructed -lisp form implementing the matcher. The matcher is to be evaluated -at an Org entry, with point on the headline, and returns t if the -entry matches the selection string MATCH. The returned lisp form -references two variables with information about the entry, which -must be bound around the form's evaluation: todo, the TODO keyword -at the entry (or nil of none); and tags-list, the list of all tags -at the entry including inherited ones. Additionally, the category -of the entry (if any) must be specified as the text property -'org-category on the headline. - -See also `org-scan-tags'. -" - (declare (special todo-only)) - (unless (boundp 'todo-only) - (error "`org-make-tags-matcher' expects todo-only to be scoped in")) - (unless match - ;; Get a new match request, with completion against the global - ;; tags table and the local tags in current buffer - (let ((org-last-tags-completion-table - (org-uniquify - (delq nil (append (org-get-buffer-tags) - (org-global-tags-completion-table)))))) - (setq match (org-completing-read-no-i - "Match: " 'org-tags-completion-function nil nil nil - 'org-tags-history)))) - - ;; Parse the string and create a lisp form - (let ((match0 match) - (re (org-re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)")) - minus tag mm - tagsmatch todomatch tagsmatcher todomatcher kwd matcher - orterms term orlist re-p str-p level-p level-op time-p - prop-p pn pv po gv rest (start 0) (ss 0)) - ;; Expand group tags - (setq match (org-tags-expand match)) - - ;; Check if there is a TODO part of this match, which would be the - ;; part after a "/". TO make sure that this slash is not part of - ;; a property value to be matched against, we also check that there - ;; is no " after that slash. - ;; First, find the last slash - (while (string-match "/+" match ss) - (setq start (match-beginning 0) ss (match-end 0))) - (if (and (string-match "/+" match start) - (not (save-match-data (string-match "\"" match start)))) - ;; match contains also a todo-matching request - (progn - (setq tagsmatch (substring match 0 (match-beginning 0)) - todomatch (substring match (match-end 0))) - (if (string-match "^!" todomatch) - (setq todo-only t todomatch (substring todomatch 1))) - (if (string-match "^\\s-*$" todomatch) - (setq todomatch nil))) - ;; only matching tags - (setq tagsmatch match todomatch nil)) - - ;; Make the tags matcher - (if (or (not tagsmatch) (not (string-match "\\S-" tagsmatch))) - (setq tagsmatcher t) - (setq orterms (org-split-string tagsmatch "|") orlist nil) - (while (setq term (pop orterms)) - (while (and (equal (substring term -1) "\\") orterms) - (setq term (concat term "|" (pop orterms)))) ; repair bad split - (while (string-match re term) - (setq rest (substring term (match-end 0)) - minus (and (match-end 1) - (equal (match-string 1 term) "-")) - tag (save-match-data (replace-regexp-in-string - "\\\\-" "-" - (match-string 2 term))) - re-p (equal (string-to-char tag) ?{) - level-p (match-end 4) - prop-p (match-end 5) - mm (cond - (re-p `(org-match-any-p ,(substring tag 1 -1) tags-list)) - (level-p - (setq level-op (org-op-to-function (match-string 3 term))) - `(,level-op level ,(string-to-number - (match-string 4 term)))) - (prop-p - (setq pn (match-string 5 term) - po (match-string 6 term) - pv (match-string 7 term) - re-p (equal (string-to-char pv) ?{) - str-p (equal (string-to-char pv) ?\") - time-p (save-match-data - (string-match "^\"[[<].*[]>]\"$" pv)) - pv (if (or re-p str-p) (substring pv 1 -1) pv)) - (if time-p (setq pv (org-matcher-time pv))) - (setq po (org-op-to-function po (if time-p 'time str-p))) - (cond - ((equal pn "CATEGORY") - (setq gv '(get-text-property (point) 'org-category))) - ((equal pn "TODO") - (setq gv 'todo)) - (t - (setq gv `(org-cached-entry-get nil ,pn)))) - (if re-p - (if (eq po 'org<>) - `(not (string-match ,pv (or ,gv ""))) - `(string-match ,pv (or ,gv ""))) - (if str-p - `(,po (or ,gv "") ,pv) - `(,po (string-to-number (or ,gv "")) - ,(string-to-number pv) )))) - (t `(member ,tag tags-list))) - mm (if minus (list 'not mm) mm) - term rest) - (push mm tagsmatcher)) - (push (if (> (length tagsmatcher) 1) - (cons 'and tagsmatcher) - (car tagsmatcher)) - orlist) - (setq tagsmatcher nil)) - (setq tagsmatcher (if (> (length orlist) 1) (cons 'or orlist) (car orlist))) - (setq tagsmatcher - (list 'progn '(setq org-cached-props nil) tagsmatcher))) - ;; Make the todo matcher - (if (or (not todomatch) (not (string-match "\\S-" todomatch))) - (setq todomatcher t) - (setq orterms (org-split-string todomatch "|") orlist nil) - (while (setq term (pop orterms)) - (while (string-match re term) - (setq minus (and (match-end 1) - (equal (match-string 1 term) "-")) - kwd (match-string 2 term) - re-p (equal (string-to-char kwd) ?{) - term (substring term (match-end 0)) - mm (if re-p - `(string-match ,(substring kwd 1 -1) todo) - (list 'equal 'todo kwd)) - mm (if minus (list 'not mm) mm)) - (push mm todomatcher)) - (push (if (> (length todomatcher) 1) - (cons 'and todomatcher) - (car todomatcher)) - orlist) - (setq todomatcher nil)) - (setq todomatcher (if (> (length orlist) 1) - (cons 'or orlist) (car orlist)))) - - ;; Return the string and lisp forms of the matcher - (setq matcher (if todomatcher - (list 'and tagsmatcher todomatcher) - tagsmatcher)) - (when todo-only - (setq matcher (list 'and '(member todo org-not-done-keywords) - matcher))) - (cons match0 matcher))) - -(defun org-tags-expand (match &optional single-as-list downcased) - "Expand group tags in MATCH. - -This replaces every group tag in MATCH with a regexp tag search. -For example, a group tag \"Work\" defined as { Work : Lab Conf } -will be replaced like this: - - Work => {\\(?:Work\\|Lab\\|Conf\\)} - +Work => +{\\(?:Work\\|Lab\\|Conf\\)} - -Work => -{\\(?:Work\\|Lab\\|Conf\\)} - -Replacing by a regexp preserves the structure of the match. -E.g., this expansion - - Work|Home => {\\(?:Work\\|Lab\\|Conf\\}|Home - -will match anything tagged with \"Lab\" and \"Home\", or tagged -with \"Conf\" and \"Home\" or tagged with \"Work\" and \"home\". - -When the optional argument SINGLE-AS-LIST is non-nil, MATCH is -assumed to be a single group tag, and the function will return -the list of tags in this group. - -When DOWNCASE is non-nil, expand downcased TAGS." - (if org-group-tags - (let* ((case-fold-search t) - (stable org-mode-syntax-table) - (tal (or org-tag-groups-alist-for-agenda - org-tag-groups-alist)) - (tal (if downcased - (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal)) - (tml (mapcar 'car tal)) - (rtnmatch match) rpl) - ;; @ and _ are allowed as word-components in tags - (modify-syntax-entry ?@ "w" stable) - (modify-syntax-entry ?_ "w" stable) - (while (and tml - (with-syntax-table stable - (string-match - (concat "\\(?1:[+-]?\\)\\(?2:\\<" - (regexp-opt tml) "\\>\\)") rtnmatch))) - (let* ((dir (match-string 1 rtnmatch)) - (tag (match-string 2 rtnmatch)) - (tag (if downcased (downcase tag) tag))) - (setq tml (delete tag tml)) - (when (not (get-text-property 0 'grouptag (match-string 2 rtnmatch))) - (setq rpl (append (org-uniquify rpl) (assoc tag tal))) - (setq rpl (concat dir "{\\<" (regexp-opt rpl) "\\>}")) - (if (stringp rpl) (org-add-props rpl '(grouptag t))) - (setq rtnmatch (replace-match rpl t t rtnmatch))))) - (if single-as-list - (or (reverse rpl) (list rtnmatch)) - rtnmatch)) - (if single-as-list (list (if downcased (downcase match) match)) - match))) - -(defun org-op-to-function (op &optional stringp) - "Turn an operator into the appropriate function." - (setq op - (cond - ((equal op "<" ) '(< string< org-time<)) - ((equal op ">" ) '(> org-string> org-time>)) - ((member op '("<=" "=<")) '(<= org-string<= org-time<=)) - ((member op '(">=" "=>")) '(>= org-string>= org-time>=)) - ((member op '("=" "==")) '(= string= org-time=)) - ((member op '("<>" "!=")) '(org<> org-string<> org-time<>)))) - (nth (if (eq stringp 'time) 2 (if stringp 1 0)) op)) - -(defun org<> (a b) (not (= a b))) -(defun org-string<= (a b) (or (string= a b) (string< a b))) -(defun org-string>= (a b) (not (string< a b))) -(defun org-string> (a b) (and (not (string= a b)) (not (string< a b)))) -(defun org-string<> (a b) (not (string= a b))) -(defun org-time= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (= a b))) -(defun org-time< (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (< a b))) -(defun org-time<= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (<= a b))) -(defun org-time> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (> a b))) -(defun org-time>= (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (>= a b))) -(defun org-time<> (a b) (setq a (org-2ft a) b (org-2ft b)) (and (> a 0) (> b 0) (org<> a b))) -(defun org-2ft (s) - "Convert S to a floating point time. -If S is already a number, just return it. If it is a string, parse -it as a time string and apply `float-time' to it. If S is nil, just return 0." - (cond - ((numberp s) s) - ((stringp s) - (condition-case nil - (float-time (apply 'encode-time (org-parse-time-string s))) - (error 0.))) - (t 0.))) - -(defun org-time-today () - "Time in seconds today at 0:00. -Returns the float number of seconds since the beginning of the -epoch to the beginning of today (00:00)." - (float-time (apply 'encode-time - (append '(0 0 0) (nthcdr 3 (decode-time)))))) - -(defun org-matcher-time (s) - "Interpret a time comparison value." - (save-match-data - (cond - ((string= s "<now>") (float-time)) - ((string= s "<today>") (org-time-today)) - ((string= s "<tomorrow>") (+ 86400.0 (org-time-today))) - ((string= s "<yesterday>") (- (org-time-today) 86400.0)) - ((string-match "^<\\([-+][0-9]+\\)\\([hdwmy]\\)>$" s) - (+ (org-time-today) - (* (string-to-number (match-string 1 s)) - (cdr (assoc (match-string 2 s) - '(("d" . 86400.0) ("w" . 604800.0) - ("m" . 2678400.0) ("y" . 31557600.0))))))) - (t (org-2ft s))))) - -(defun org-match-any-p (re list) - "Does re match any element of list?" - (setq list (mapcar (lambda (x) (string-match re x)) list)) - (delq nil list)) - -(defvar org-add-colon-after-tag-completion nil) ;; dynamically scoped param -(defvar org-tags-overlay (make-overlay 1 1)) -(org-detach-overlay org-tags-overlay) - -(defun org-get-local-tags-at (&optional pos) - "Get a list of tags defined in the current headline." - (org-get-tags-at pos 'local)) - -(defun org-get-local-tags () - "Get a list of tags defined in the current headline." - (org-get-tags-at nil 'local)) - -(defun org-get-tags-at (&optional pos local) - "Get a list of all headline tags applicable at POS. -POS defaults to point. If tags are inherited, the list contains -the targets in the same sequence as the headlines appear, i.e. -the tags of the current headline come last. -When LOCAL is non-nil, only return tags from the current headline, -ignore inherited ones." - (interactive) - (if (and org-trust-scanner-tags - (or (not pos) (equal pos (point))) - (not local)) - org-scanner-tags - (let (tags ltags lastpos parent) - (save-excursion - (save-restriction - (widen) - (goto-char (or pos (point))) - (save-match-data - (catch 'done - (condition-case nil - (progn - (org-back-to-heading t) - (while (not (equal lastpos (point))) - (setq lastpos (point)) - (when (looking-at - (org-re "[^\r\n]+?:\\([[:alnum:]_@#%:]+\\):[ \t]*$")) - (setq ltags (org-split-string - (org-match-string-no-properties 1) ":")) - (when parent - (setq ltags (mapcar 'org-add-prop-inherited ltags))) - (setq tags (append - (if parent - (org-remove-uninherited-tags ltags) - ltags) - tags))) - (or org-use-tag-inheritance (throw 'done t)) - (if local (throw 'done t)) - (or (org-up-heading-safe) (error nil)) - (setq parent t))) - (error nil))))) - (if local - tags - (reverse (delete-dups - (reverse (append - (org-remove-uninherited-tags - org-file-tags) tags))))))))) - -(defun org-add-prop-inherited (s) - (add-text-properties 0 (length s) '(inherited t) s) - s) - -(defun org-toggle-tag (tag &optional onoff) - "Toggle the tag TAG for the current line. -If ONOFF is `on' or `off', don't toggle but set to this state." - (let (res current) - (save-excursion - (org-back-to-heading t) - (if (re-search-forward (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t]*$") - (point-at-eol) t) - (progn - (setq current (match-string 1)) - (replace-match "")) - (setq current "")) - (setq current (nreverse (org-split-string current ":"))) - (cond - ((eq onoff 'on) - (setq res t) - (or (member tag current) (push tag current))) - ((eq onoff 'off) - (or (not (member tag current)) (setq current (delete tag current)))) - (t (if (member tag current) - (setq current (delete tag current)) - (setq res t) - (push tag current)))) - (end-of-line 1) - (if current - (progn - (insert " :" (mapconcat 'identity (nreverse current) ":") ":") - (org-set-tags nil t)) - (delete-horizontal-space)) - (run-hooks 'org-after-tags-change-hook)) - res)) - -(defun org-align-tags-here (to-col) - ;; Assumes that this is a headline - (let ((pos (point)) (col (current-column)) ncol tags-l p) - (beginning-of-line 1) - (if (and (looking-at (org-re ".*?\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) - (< pos (match-beginning 2))) - (progn - (setq tags-l (- (match-end 2) (match-beginning 2))) - (goto-char (match-beginning 1)) - (insert " ") - (delete-region (point) (1+ (match-beginning 2))) - (setq ncol (max (current-column) - (1+ col) - (if (> to-col 0) - to-col - (- (abs to-col) tags-l)))) - (setq p (point)) - (insert (make-string (- ncol (current-column)) ?\ )) - (setq ncol (current-column)) - (when indent-tabs-mode (tabify p (point-at-eol))) - (org-move-to-column (min ncol col) t nil t)) - (goto-char pos)))) - -(defun org-set-tags-command (&optional arg just-align) - "Call the set-tags command for the current entry." - (interactive "P") - (if (or (org-at-heading-p) (and arg (org-before-first-heading-p))) - (org-set-tags arg just-align) - (save-excursion - (unless (and (org-region-active-p) - org-loop-over-headlines-in-active-region) - (org-back-to-heading t)) - (org-set-tags arg just-align)))) - -(defun org-set-tags-to (data) - "Set the tags of the current entry to DATA, replacing the current tags. -DATA may be a tags string like :aa:bb:cc:, or a list of tags. -If DATA is nil or the empty string, any tags will be removed." - (interactive "sTags: ") - (setq data - (cond - ((eq data nil) "") - ((equal data "") "") - ((stringp data) - (concat ":" (mapconcat 'identity (org-split-string data ":+") ":") - ":")) - ((listp data) - (concat ":" (mapconcat 'identity data ":") ":")))) - (when data - (save-excursion - (org-back-to-heading t) - (when (looking-at org-complex-heading-regexp) - (if (match-end 5) - (progn - (goto-char (match-beginning 5)) - (insert data) - (delete-region (point) (point-at-eol)) - (org-set-tags nil 'align)) - (goto-char (point-at-eol)) - (insert " " data) - (org-set-tags nil 'align))) - (beginning-of-line 1) - (if (looking-at ".*?\\([ \t]+\\)$") - (delete-region (match-beginning 1) (match-end 1)))))) - -(defun org-align-all-tags () - "Align the tags i all headings." - (interactive) - (save-excursion - (or (ignore-errors (org-back-to-heading t)) - (outline-next-heading)) - (if (org-at-heading-p) - (org-set-tags t) - (message "No headings")))) - -(defvar org-indent-indentation-per-level) -(defun org-set-tags (&optional arg just-align) - "Set the tags for the current headline. -With prefix ARG, realign all tags in headings in the current buffer." - (interactive "P") - (if (and (org-region-active-p) org-loop-over-headlines-in-active-region) - (let ((cl (if (eq org-loop-over-headlines-in-active-region 'start-level) - 'region-start-level 'region)) - org-loop-over-headlines-in-active-region) - (org-map-entries - ;; We don't use ARG and JUST-ALIGN here these args are not - ;; useful when looping over headlines - `(org-set-tags) - org-loop-over-headlines-in-active-region - cl (if (outline-invisible-p) (org-end-of-subtree nil t)))) - (let* ((re org-outline-regexp-bol) - (current (unless arg (org-get-tags-string))) - (col (current-column)) - (org-setting-tags t) - table current-tags inherited-tags ; computed below when needed - tags p0 c0 c1 rpl di tc level) - (if arg - (save-excursion - (goto-char (point-min)) - (let ((buffer-invisibility-spec (org-inhibit-invisibility))) - (while (re-search-forward re nil t) - (org-set-tags nil t) - (end-of-line 1))) - (message "All tags realigned to column %d" org-tags-column)) - (if just-align - (setq tags current) - ;; Get a new set of tags from the user - (save-excursion - (setq table (append org-tag-persistent-alist - (or org-tag-alist (org-get-buffer-tags)) - (and - org-complete-tags-always-offer-all-agenda-tags - (org-global-tags-completion-table - (org-agenda-files)))) - org-last-tags-completion-table table - current-tags (org-split-string current ":") - inherited-tags (nreverse - (nthcdr (length current-tags) - (nreverse (org-get-tags-at)))) - tags - (if (or (eq t org-use-fast-tag-selection) - (and org-use-fast-tag-selection - (delq nil (mapcar 'cdr table)))) - (org-fast-tag-selection - current-tags inherited-tags table - (if org-fast-tag-selection-include-todo - org-todo-key-alist)) - (let ((org-add-colon-after-tag-completion (< 1 (length table)))) - (org-trim - (org-icompleting-read "Tags: " - 'org-tags-completion-function - nil nil current 'org-tags-history)))))) - (while (string-match "[-+&]+" tags) - ;; No boolean logic, just a list - (setq tags (replace-match ":" t t tags)))) - - (setq tags (replace-regexp-in-string "[,]" ":" tags)) - - (if org-tags-sort-function - (setq tags (mapconcat 'identity - (sort (org-split-string - tags (org-re "[^[:alnum:]_@#%]+")) - org-tags-sort-function) ":"))) - - (if (string-match "\\`[\t ]*\\'" tags) - (setq tags "") - (unless (string-match ":$" tags) (setq tags (concat tags ":"))) - (unless (string-match "^:" tags) (setq tags (concat ":" tags)))) - - ;; Insert new tags at the correct column - (beginning-of-line 1) - (setq level (or (and (looking-at org-outline-regexp) - (- (match-end 0) (point) 1)) - 1)) - (cond - ((and (equal current "") (equal tags ""))) - ((re-search-forward - (concat "\\([ \t]*" (regexp-quote current) "\\)[ \t]*$") - (point-at-eol) t) - (if (equal tags "") - (setq rpl "") - (goto-char (match-beginning 0)) - (setq c0 (current-column) - ;; compute offset for the case of org-indent-mode active - di (if org-indent-mode - (* (1- org-indent-indentation-per-level) (1- level)) - 0) - p0 (if (equal (char-before) ?*) (1+ (point)) (point)) - tc (+ org-tags-column (if (> org-tags-column 0) (- di) di)) - c1 (max (1+ c0) (if (> tc 0) tc (- (- tc) (length tags)))) - rpl (concat (make-string (max 0 (- c1 c0)) ?\ ) tags))) - (replace-match rpl t t) - (and (not (featurep 'xemacs)) c0 indent-tabs-mode (tabify p0 (point))) - tags) - (t (error "Tags alignment failed"))) - (org-move-to-column col) - (unless just-align - (run-hooks 'org-after-tags-change-hook)))))) - -(defun org-change-tag-in-region (beg end tag off) - "Add or remove TAG for each entry in the region. -This works in the agenda, and also in an org-mode buffer." - (interactive - (list (region-beginning) (region-end) - (let ((org-last-tags-completion-table - (if (derived-mode-p 'org-mode) - (org-uniquify - (delq nil (append (org-get-buffer-tags) - (org-global-tags-completion-table)))) - (org-global-tags-completion-table)))) - (org-icompleting-read - "Tag: " 'org-tags-completion-function nil nil nil - 'org-tags-history)) - (progn - (message "[s]et or [r]emove? ") - (equal (read-char-exclusive) ?r)))) - (if (fboundp 'deactivate-mark) (deactivate-mark)) - (let ((agendap (equal major-mode 'org-agenda-mode)) - l1 l2 m buf pos newhead (cnt 0)) - (goto-char end) - (setq l2 (1- (org-current-line))) - (goto-char beg) - (setq l1 (org-current-line)) - (loop for l from l1 to l2 do - (org-goto-line l) - (setq m (get-text-property (point) 'org-hd-marker)) - (when (or (and (derived-mode-p 'org-mode) (org-at-heading-p)) - (and agendap m)) - (setq buf (if agendap (marker-buffer m) (current-buffer)) - pos (if agendap m (point))) - (with-current-buffer buf - (save-excursion - (save-restriction - (goto-char pos) - (setq cnt (1+ cnt)) - (org-toggle-tag tag (if off 'off 'on)) - (setq newhead (org-get-heading))))) - (and agendap (org-agenda-change-all-lines newhead m)))) - (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt))) - -(defun org-tags-completion-function (string predicate &optional flag) - (let (s1 s2 rtn (ctable org-last-tags-completion-table) - (confirm (lambda (x) (stringp (car x))))) - (if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string) - (setq s1 (match-string 1 string) - s2 (match-string 2 string)) - (setq s1 "" s2 string)) - (cond - ((eq flag nil) - ;; try completion - (setq rtn (try-completion s2 ctable confirm)) - (if (stringp rtn) - (setq rtn - (concat s1 s2 (substring rtn (length s2)) - (if (and org-add-colon-after-tag-completion - (assoc rtn ctable)) - ":" "")))) - rtn) - ((eq flag t) - ;; all-completions - (all-completions s2 ctable confirm)) - ((eq flag 'lambda) - ;; exact match? - (assoc s2 ctable))))) - -(defun org-fast-tag-insert (kwd tags face &optional end) - "Insert KDW, and the TAGS, the latter with face FACE. -Also insert END." - (insert (format "%-12s" (concat kwd ":")) - (org-add-props (mapconcat 'identity tags " ") nil 'face face) - (or end ""))) - -(defun org-fast-tag-show-exit (flag) - (save-excursion - (org-goto-line 3) - (if (re-search-forward "[ \t]+Next change exits" (point-at-eol) t) - (replace-match "")) - (when flag - (end-of-line 1) - (org-move-to-column (- (window-width) 19) t) - (insert (org-add-props " Next change exits" nil 'face 'org-warning))))) - -(defun org-set-current-tags-overlay (current prefix) - "Add an overlay to CURRENT tag with PREFIX." - (let ((s (concat ":" (mapconcat 'identity current ":") ":"))) - (if (featurep 'xemacs) - (org-overlay-display org-tags-overlay (concat prefix s) - 'secondary-selection) - (put-text-property 0 (length s) 'face '(secondary-selection org-tag) s) - (org-overlay-display org-tags-overlay (concat prefix s))))) - -(defvar org-last-tag-selection-key nil) -(defun org-fast-tag-selection (current inherited table &optional todo-table) - "Fast tag selection with single keys. -CURRENT is the current list of tags in the headline, INHERITED is the -list of inherited tags, and 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 tags string, or nil to not change the current settings." - (let* ((fulltable (append table todo-table)) - (maxlen (apply 'max (mapcar - (lambda (x) - (if (stringp (car x)) (string-width (car x)) 0)) - fulltable))) - (buf (current-buffer)) - (expert (eq org-fast-tag-selection-single-key 'expert)) - (buffer-tags nil) - (fwidth (+ maxlen 3 1 3)) - (ncol (/ (- (window-width) 4) fwidth)) - (i-face 'org-done) - (c-face 'org-todo) - tg cnt e c char c1 c2 ntable tbl rtn - ov-start ov-end ov-prefix - (exit-after-next org-fast-tag-selection-single-key) - (done-keywords org-done-keywords) - groups ingroup) - (save-excursion - (beginning-of-line 1) - (if (looking-at - (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) - (setq ov-start (match-beginning 1) - ov-end (match-end 1) - ov-prefix "") - (setq ov-start (1- (point-at-eol)) - ov-end (1+ ov-start)) - (skip-chars-forward "^\n\r") - (setq ov-prefix - (concat - (buffer-substring (1- (point)) (point)) - (if (> (current-column) org-tags-column) - " " - (make-string (- org-tags-column (current-column)) ?\ )))))) - (move-overlay org-tags-overlay ov-start ov-end) - (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) - (org-fast-tag-insert "Inherited" inherited i-face "\n") - (org-fast-tag-insert "Current" current c-face "\n\n") - (org-fast-tag-show-exit exit-after-next) - (org-set-current-tags-overlay current ov-prefix) - (setq tbl fulltable char ?a cnt 0) - (while (setq e (pop tbl)) - (cond - ((equal (car e) :startgroup) - (push '() groups) (setq ingroup t) - (when (not (= cnt 0)) - (setq cnt 0) - (insert "\n")) - (insert (if (cdr e) (format "%s: " (cdr e)) "") "{ ")) - ((equal (car e) :endgroup) - (setq ingroup nil cnt 0) - (insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n")) - ((equal e '(:newline)) - (when (not (= cnt 0)) - (setq cnt 0) - (insert "\n") - (setq e (car tbl)) - (while (equal (car tbl) '(:newline)) - (insert "\n") - (setq tbl (cdr tbl))))) - ((equal e '(:grouptags)) nil) - (t - (setq tg (copy-sequence (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)) - ((member tg current) c-face) - ((member tg inherited) i-face)))) - (if (equal (caar tbl) :grouptags) - (org-add-props tg nil 'face 'org-tag-group)) - (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 (not expert) (org-fit-window-to-buffer)) - (setq rtn - (catch 'exit - (while t - (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free [!] %sgroups%s" - (if (not groups) "no " "") - (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi"))) - (setq c (let ((inhibit-quit t)) (read-char-exclusive))) - (setq org-last-tag-selection-key c) - (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) - (set-window-buffer (split-window-vertically) " *Org tags*") - (org-switch-to-buffer-other-window " *Org tags*") - (org-fit-window-to-buffer))) - ((or (= c ?\C-g) - (and (= c ?q) (not (rassoc c ntable)))) - (org-detach-overlay org-tags-overlay) - (setq quit-flag t)) - ((= c ?\ ) - (setq current nil) - (if exit-after-next (setq exit-after-next 'now))) - ((= c ?\t) - (condition-case nil - (setq tg (org-icompleting-read - "Tag: " - (or buffer-tags - (with-current-buffer buf - (org-get-buffer-tags))))) - (quit (setq tg ""))) - (when (string-match "\\S-" tg) - (add-to-list 'buffer-tags (list tg)) - (if (member tg current) - (setq current (delete tg current)) - (push tg current))) - (if exit-after-next (setq exit-after-next 'now))) - ((setq e (rassoc c todo-table) tg (car e)) - (with-current-buffer buf - (save-excursion (org-todo tg))) - (if exit-after-next (setq exit-after-next 'now))) - ((setq e (rassoc c ntable) tg (car e)) - (if (member tg current) - (setq current (delete tg current)) - (loop for g in groups do - (if (member tg g) - (mapc (lambda (x) - (setq current (delete x current))) - g))) - (push tg current)) - (if exit-after-next (setq exit-after-next 'now)))) - - ;; Create a sorted list - (setq current - (sort current - (lambda (a b) - (assoc b (cdr (memq (assoc a ntable) ntable)))))) - (if (eq exit-after-next 'now) (throw 'exit t)) - (goto-char (point-min)) - (beginning-of-line 2) - (delete-region (point) (point-at-eol)) - (org-fast-tag-insert "Current" current c-face) - (org-set-current-tags-overlay current ov-prefix) - (while (re-search-forward - (org-re "\\[.\\] \\([[:alnum:]_@#%]+\\)") nil t) - (setq tg (match-string 1)) - (add-text-properties - (match-beginning 1) (match-end 1) - (list 'face - (cond - ((member tg current) c-face) - ((member tg inherited) i-face) - (t (get-text-property (match-beginning 1) 'face)))))) - (goto-char (point-min))))) - (org-detach-overlay org-tags-overlay) - (if rtn - (mapconcat 'identity current ":") - nil)))) - -(defun org-get-tags-string () - "Get the TAGS string in the current headline." - (unless (org-at-heading-p t) - (user-error "Not on a heading")) - (save-excursion - (beginning-of-line 1) - (if (looking-at (org-re ".*[ \t]\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")) - (org-match-string-no-properties 1) - ""))) - -(defun org-get-tags () - "Get the list of tags specified in the current headline." - (org-split-string (org-get-tags-string) ":")) - -(defun org-get-buffer-tags () - "Get a table of all tags used in the buffer, for completion." - (let (tags) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward - (org-re "[ \t]:\\([[:alnum:]_@#%:]+\\):[ \t\r\n]") nil t) - (when (equal (char-after (point-at-bol 0)) ?*) - (mapc (lambda (x) (add-to-list 'tags x)) - (org-split-string (org-match-string-no-properties 1) ":"))))) - (mapc (lambda (s) (add-to-list 'tags s)) org-file-tags) - (mapcar 'list tags))) - -;;;; The mapping API - -(defun org-map-entries (func &optional match scope &rest skip) - "Call FUNC at each headline selected by MATCH in SCOPE. - -FUNC is a function or a lisp form. The function will be called without -arguments, with the cursor positioned at the beginning of the headline. -The return values of all calls to the function will be collected and -returned as a list. - -The call to FUNC will be wrapped into a save-excursion form, so FUNC -does not need to preserve point. After evaluation, the cursor will be -moved to the end of the line (presumably of the headline of the -processed entry) and search continues from there. Under some -circumstances, this may not produce the wanted results. For example, -if you have removed (e.g. archived) the current (sub)tree it could -mean that the next entry will be skipped entirely. In such cases, you -can specify the position from where search should continue by making -FUNC set the variable `org-map-continue-from' to the desired buffer -position. - -MATCH is a tags/property/todo match as it is used in the agenda tags view. -Only headlines that are matched by this query will be considered during -the iteration. When MATCH is nil or t, all headlines will be -visited by the iteration. - -SCOPE determines the scope of this command. It can be any of: - -nil The current buffer, respecting the restriction if any -tree The subtree started with the entry at point -region The entries within the active region, if any -region-start-level - The entries within the active region, but only those at - the same level than the first one. -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 - -The remaining args are treated as settings for the skipping facilities of -the scanner. The following items can be given here: - - archive skip trees with the archive tag - comment skip trees with the COMMENT keyword - function or Emacs Lisp form: - will be used as value for `org-agenda-skip-function', so - whenever the function returns a position, FUNC will not be - called for that entry and search will continue from the - position returned - -If your function needs to retrieve the tags including inherited tags -at the *current* entry, you can use the value of the variable -`org-scanner-tags' which will be much faster than getting the value -with `org-get-tags-at'. If your function gets properties with -`org-entry-properties' at the *current* entry, bind `org-trust-scanner-tags' -to t around the call to `org-entry-properties' to get the same speedup. -Note that if your function moves around to retrieve tags and properties at -a *different* entry, you cannot use these techniques." - (unless (and (or (eq scope 'region) (eq scope 'region-start-level)) - (not (org-region-active-p))) - (let* ((org-agenda-archives-mode nil) ; just to make sure - (org-agenda-skip-archived-trees (memq 'archive skip)) - (org-agenda-skip-comment-trees (memq 'comment skip)) - (org-agenda-skip-function - (car (org-delete-all '(comment archive) skip))) - (org-tags-match-list-sublevels t) - (start-level (eq scope 'region-start-level)) - matcher file res - org-todo-keywords-for-agenda - org-done-keywords-for-agenda - org-todo-keyword-alist-for-agenda - org-drawers-for-agenda - org-tag-alist-for-agenda - todo-only) - - (cond - ((eq match t) (setq matcher t)) - ((eq match nil) (setq matcher t)) - (t (setq matcher (if match (cdr (org-make-tags-matcher match)) t)))) - - (save-window-excursion - (save-restriction - (cond ((eq scope 'tree) - (org-back-to-heading t) - (org-narrow-to-subtree) - (setq scope nil)) - ((and (or (eq scope 'region) (eq scope 'region-start-level)) - (org-region-active-p)) - ;; If needed, set start-level to a string like "2" - (when start-level - (save-excursion - (goto-char (region-beginning)) - (unless (org-at-heading-p) (outline-next-heading)) - (setq start-level (org-current-level)))) - (narrow-to-region (region-beginning) - (save-excursion - (goto-char (region-end)) - (unless (and (bolp) (org-at-heading-p)) - (outline-next-heading)) - (point))) - (setq scope nil))) - - (if (not scope) - (progn - (org-agenda-prepare-buffers - (list (buffer-file-name (current-buffer)))) - (setq res (org-scan-tags func matcher todo-only start-level))) - ;; Get the right scope - (cond - ((and scope (listp scope) (symbolp (car scope))) - (setq scope (eval scope))) - ((eq scope 'agenda) - (setq scope (org-agenda-files t))) - ((eq scope 'agenda-with-archives) - (setq scope (org-agenda-files t)) - (setq scope (org-add-archive-files scope))) - ((eq scope 'file) - (setq scope (list (buffer-file-name)))) - ((eq scope 'file-with-archives) - (setq scope (org-add-archive-files (list (buffer-file-name)))))) - (org-agenda-prepare-buffers scope) - (while (setq file (pop scope)) - (with-current-buffer (org-find-base-buffer-visiting file) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (setq res (append res (org-scan-tags func matcher todo-only)))))))))) - res))) - -;;;; Properties - -;;; Setting and retrieving properties - -(defconst org-special-properties - '("TODO" "TAGS" "ALLTAGS" "DEADLINE" "SCHEDULED" "CLOCK" "CLOSED" "PRIORITY" - "TIMESTAMP" "TIMESTAMP_IA" "BLOCKED" "FILE" "CLOCKSUM" "CLOCKSUM_T") - "The special properties valid in Org-mode. - -These are properties that are not defined in the property drawer, -but in some other way.") - -(defconst org-default-properties - '("ARCHIVE" "CATEGORY" "SUMMARY" "DESCRIPTION" "CUSTOM_ID" - "LOCATION" "LOGGING" "COLUMNS" "VISIBILITY" - "TABLE_EXPORT_FORMAT" "TABLE_EXPORT_FILE" - "EXPORT_OPTIONS" "EXPORT_TEXT" "EXPORT_FILE_NAME" - "EXPORT_TITLE" "EXPORT_AUTHOR" "EXPORT_DATE" - "ORDERED" "NOBLOCKING" "COOKIE_DATA" "LOG_INTO_DRAWER" "REPEAT_TO_STATE" - "CLOCK_MODELINE_TOTAL" "STYLE" "HTML_CONTAINER_CLASS") - "Some properties that are used by Org-mode for various purposes. -Being in this list makes sure that they are offered for completion.") - -(defconst org-property-start-re "^[ \t]*:PROPERTIES:[ \t]*$" - "Regular expression matching the first line of a property drawer.") - -(defconst org-property-end-re "^[ \t]*:END:[ \t]*$" - "Regular expression matching the last line of a property drawer.") - -(defconst org-clock-drawer-start-re "^[ \t]*:CLOCK:[ \t]*$" - "Regular expression matching the first line of a property drawer.") - -(defconst org-clock-drawer-end-re "^[ \t]*:END:[ \t]*$" - "Regular expression matching the first line of a property drawer.") - -(defconst org-property-drawer-re - (concat "\\(" org-property-start-re "\\)[^\000]*\\(" - org-property-end-re "\\)\n?") - "Matches an entire property drawer.") - -(defconst org-clock-drawer-re - (concat "\\(" org-clock-drawer-start-re "\\)[^\000]*\\(" - org-property-end-re "\\)\n?") - "Matches an entire clock drawer.") - -(defun org-property-action () - "Do an action on properties." - (interactive) - (let (c) - (org-at-property-p) - (message "Property Action: [s]et [d]elete [D]elete globally [c]ompute") - (setq c (read-char-exclusive)) - (cond - ((equal c ?s) - (call-interactively 'org-set-property)) - ((equal c ?d) - (call-interactively 'org-delete-property)) - ((equal c ?D) - (call-interactively 'org-delete-property-globally)) - ((equal c ?c) - (call-interactively 'org-compute-property-at-point)) - (t (user-error "No such property action %c" c))))) - -(defun org-inc-effort () - "Increment the value of the effort property in the current entry." - (interactive) - (org-set-effort nil t)) - -(defvar org-clock-effort) ;; Defined in org-clock.el -(defvar org-clock-current-task) ;; Defined in org-clock.el -(defun org-set-effort (&optional value increment) - "Set the effort property of the current entry. -With numerical prefix arg, use the nth allowed value, 0 stands for the -10th allowed value. - -When INCREMENT is non-nil, set the property to the next allowed value." - (interactive "P") - (if (equal value 0) (setq value 10)) - (let* ((completion-ignore-case t) - (prop org-effort-property) - (cur (org-entry-get nil prop)) - (allowed (org-property-get-allowed-values nil prop 'table)) - (existing (mapcar 'list (org-property-values prop))) - (heading (nth 4 (org-heading-components))) - rpl - (val (cond - ((stringp value) value) - ((and allowed (integerp value)) - (or (car (nth (1- value) allowed)) - (car (org-last allowed)))) - ((and allowed increment) - (or (caadr (member (list cur) allowed)) - (user-error "Allowed effort values are not set"))) - (allowed - (message "Select 1-9,0, [RET%s]: %s" - (if cur (concat "=" cur) "") - (mapconcat 'car allowed " ")) - (setq rpl (read-char-exclusive)) - (if (equal rpl ?\r) - cur - (setq rpl (- rpl ?0)) - (if (equal rpl 0) (setq rpl 10)) - (if (and (> rpl 0) (<= rpl (length allowed))) - (car (nth (1- rpl) allowed)) - (org-completing-read "Effort: " allowed nil)))) - (t - (let (org-completion-use-ido org-completion-use-iswitchb) - (org-completing-read - (concat "Effort " (if (and cur (string-match "\\S-" cur)) - (concat "[" cur "]") "") - ": ") - existing nil nil "" nil cur)))))) - (unless (equal (org-entry-get nil prop) val) - (org-entry-put nil prop val)) - (save-excursion - (org-back-to-heading t) - (put-text-property (point-at-bol) (point-at-eol) 'org-effort val)) - (when (string= heading org-clock-current-task) - (setq org-clock-effort (get-text-property (point-at-bol) 'org-effort)) - (org-clock-update-mode-line)) - (message "%s is now %s" prop val))) - -(defun org-at-property-p () - "Is cursor inside a property drawer?" - (save-excursion - (when (equal 'node-property (car (org-element-at-point))) - (beginning-of-line 1) - (looking-at org-property-re)))) - -(defun org-get-property-block (&optional beg end force) - "Return the (beg . end) range of the body of the property drawer. -BEG and END are the beginning and end of the current subtree, or of -the part before the first headline. If they are not given, they will -be found. If the drawer does not exist and FORCE is non-nil, create -the drawer." - (catch 'exit - (save-excursion - (let* ((beg (or beg (and (org-before-first-heading-p) (point-min)) - (progn (org-back-to-heading t) (point)))) - (end (or end (and (not (outline-next-heading)) (point-max)) - (point)))) - (goto-char beg) - (if (re-search-forward org-property-start-re end t) - (setq beg (1+ (match-end 0))) - (if force - (save-excursion - (org-insert-property-drawer) - (setq end (progn (outline-next-heading) (point)))) - (throw 'exit nil)) - (goto-char beg) - (if (re-search-forward org-property-start-re end t) - (setq beg (1+ (match-end 0))))) - (if (re-search-forward org-property-end-re end t) - (setq end (match-beginning 0)) - (or force (throw 'exit nil)) - (goto-char beg) - (setq end beg) - (org-indent-line) - (insert ":END:\n")) - (cons beg end))))) - -(defun org-entry-properties (&optional pom which specific) - "Get all properties of the entry at point-or-marker POM. -This includes the TODO keyword, the tags, time strings for deadline, -scheduled, and clocking, and any additional properties defined in the -entry. The return value is an alist, keys may occur multiple times -if the property key was used several times. -POM may also be nil, in which case the current entry is used. -If WHICH is nil or `all', get all properties. If WHICH is -`special' or `standard', only get that subclass. If WHICH -is a string only get exactly this property. SPECIFIC can be a string, the -specific property we are interested in. Specifying it can speed -things up because then unnecessary parsing is avoided." - (setq which (or which 'all)) - (org-with-point-at pom - (let ((clockstr (substring org-clock-string 0 -1)) - (excluded '("TODO" "TAGS" "ALLTAGS" "PRIORITY" "BLOCKED")) - (case-fold-search nil) - beg end range props sum-props key key1 value string clocksum clocksumt) - (save-excursion - (when (condition-case nil - (and (derived-mode-p 'org-mode) (org-back-to-heading t)) - (error nil)) - (setq beg (point)) - (setq sum-props (get-text-property (point) 'org-summaries)) - (setq clocksum (get-text-property (point) :org-clock-minutes) - clocksumt (get-text-property (point) :org-clock-minutes-today)) - (outline-next-heading) - (setq end (point)) - (when (memq which '(all special)) - ;; Get the special properties, like TODO and tags - (goto-char beg) - (when (and (or (not specific) (string= specific "TODO")) - (looking-at org-todo-line-regexp) (match-end 2)) - (push (cons "TODO" (org-match-string-no-properties 2)) props)) - (when (and (or (not specific) (string= specific "PRIORITY")) - (looking-at org-priority-regexp)) - (push (cons "PRIORITY" (org-match-string-no-properties 2)) props)) - (when (or (not specific) (string= specific "FILE")) - (push (cons "FILE" buffer-file-name) props)) - (when (and (or (not specific) (string= specific "TAGS")) - (setq value (org-get-tags-string)) - (string-match "\\S-" value)) - (push (cons "TAGS" value) props)) - (when (and (or (not specific) (string= specific "ALLTAGS")) - (setq value (org-get-tags-at))) - (push (cons "ALLTAGS" (concat ":" (mapconcat 'identity value ":") - ":")) - props)) - (when (or (not specific) (string= specific "BLOCKED")) - (push (cons "BLOCKED" (if (org-entry-blocked-p) "t" "")) props)) - (when (or (not specific) - (member specific - '("SCHEDULED" "DEADLINE" "CLOCK" "CLOSED" - "TIMESTAMP" "TIMESTAMP_IA"))) - (catch 'match - (while (re-search-forward org-maybe-keyword-time-regexp end t) - (setq key (if (match-end 1) - (substring (org-match-string-no-properties 1) - 0 -1)) - string (if (equal key clockstr) - (org-trim - (buffer-substring-no-properties - (match-beginning 3) (goto-char - (point-at-eol)))) - (substring (org-match-string-no-properties 3) - 1 -1))) - ;; Get the correct property name from the key. This is - ;; necessary if the user has configured time keywords. - (setq key1 (concat key ":")) - (cond - ((not key) - (setq key - (if (= (char-after (match-beginning 3)) ?\[) - "TIMESTAMP_IA" "TIMESTAMP"))) - ((equal key1 org-scheduled-string) (setq key "SCHEDULED")) - ((equal key1 org-deadline-string) (setq key "DEADLINE")) - ((equal key1 org-closed-string) (setq key "CLOSED")) - ((equal key1 org-clock-string) (setq key "CLOCK"))) - (if (and specific (equal key specific) (not (equal key "CLOCK"))) - (progn - (push (cons key string) props) - ;; no need to search further if match is found - (throw 'match t)) - (when (or (equal key "CLOCK") (not (assoc key props))) - (push (cons key string) props))))))) - - (when (memq which '(all standard)) - ;; Get the standard properties, like :PROP: ... - (setq range (org-get-property-block beg end)) - (when range - (goto-char (car range)) - (while (re-search-forward org-property-re - (cdr range) t) - (setq key (org-match-string-no-properties 2) - value (org-trim (or (org-match-string-no-properties 3) ""))) - (unless (member key excluded) - (push (cons key (or value "")) props))))) - (if clocksum - (push (cons "CLOCKSUM" - (org-columns-number-to-string (/ (float clocksum) 60.) - 'add_times)) - props)) - (if clocksumt - (push (cons "CLOCKSUM_T" - (org-columns-number-to-string (/ (float clocksumt) 60.) - 'add_times)) - props)) - (unless (assoc "CATEGORY" props) - (push (cons "CATEGORY" (org-get-category)) props)) - (append sum-props (nreverse props))))))) - -(defun org-entry-get (pom property &optional inherit literal-nil) - "Get value of PROPERTY for entry or content at point-or-marker POM. -If INHERIT is non-nil and the entry does not have the property, -then also check higher levels of the hierarchy. -If INHERIT is the symbol `selective', use inheritance only if the setting -in `org-use-property-inheritance' selects PROPERTY for inheritance. -If the property is present but empty, the return value is the empty string. -If the property is not present at all, nil is returned. - -If LITERAL-NIL is set, return the string value \"nil\" as a string, -do not interpret it as the list atom nil. This is used for inheritance -when a \"nil\" value can supersede a non-nil value higher up the hierarchy." - (org-with-point-at pom - (if (and inherit (if (eq inherit 'selective) - (org-property-inherit-p property) - t)) - (org-entry-get-with-inheritance property literal-nil) - (if (member property org-special-properties) - ;; We need a special property. Use `org-entry-properties' to - ;; retrieve it, but specify the wanted property - (cdr (assoc property (org-entry-properties nil 'special property))) - (let ((range (org-get-property-block))) - (when (and range (not (eq (car range) (cdr range)))) - (let* ((props (list (or (assoc property org-file-properties) - (assoc property org-global-properties) - (assoc property org-global-properties-fixed)))) - (ap (lambda (key) - (when (re-search-forward - (org-re-property key) (cdr range) t) - (setq props - (org-update-property-plist - key - (if (match-end 3) - (org-match-string-no-properties 3) "") - props))))) - val) - (goto-char (car range)) - (funcall ap property) - (goto-char (car range)) - (while (funcall ap (concat property "+"))) - (setq val (cdr (assoc property props))) - (when val (if literal-nil val (org-not-nil val)))))))))) - -(defun org-property-or-variable-value (var &optional inherit) - "Check if there is a property fixing the value of VAR. -If yes, return this value. If not, return the current value of the variable." - (let ((prop (org-entry-get nil (symbol-name var) inherit))) - (if (and prop (stringp prop) (string-match "\\S-" prop)) - (read prop) - (symbol-value var)))) - -(defun org-entry-delete (pom property &optional delete-empty-drawer) - "Delete the property PROPERTY from entry at point-or-marker POM. -When optional argument DELETE-EMPTY-DRAWER is a string, it defines -an empty drawer to delete." - (org-with-point-at pom - (if (member property org-special-properties) - nil ; cannot delete these properties. - (let ((range (org-get-property-block))) - (if (and range - (goto-char (car range)) - (re-search-forward - (org-re-property property) - (cdr range) t)) - (progn - (delete-region (match-beginning 0) (1+ (point-at-eol))) - (and delete-empty-drawer - (org-remove-empty-drawer-at - delete-empty-drawer (car range))) - t) - nil))))) - -;; Multi-values properties are properties that contain multiple values -;; These values are assumed to be single words, separated by whitespace. -(defun org-entry-add-to-multivalued-property (pom property value) - "Add VALUE to the words in the PROPERTY in entry at point-or-marker POM." - (let* ((old (org-entry-get pom property)) - (values (and old (org-split-string old "[ \t]")))) - (setq value (org-entry-protect-space value)) - (unless (member value values) - (setq values (append values (list value))) - (org-entry-put pom property - (mapconcat 'identity values " "))))) - -(defun org-entry-remove-from-multivalued-property (pom property value) - "Remove VALUE from words in the PROPERTY in entry at point-or-marker POM." - (let* ((old (org-entry-get pom property)) - (values (and old (org-split-string old "[ \t]")))) - (setq value (org-entry-protect-space value)) - (when (member value values) - (setq values (delete value values)) - (org-entry-put pom property - (mapconcat 'identity values " "))))) - -(defun org-entry-member-in-multivalued-property (pom property value) - "Is VALUE one of the words in the PROPERTY in entry at point-or-marker POM?" - (let* ((old (org-entry-get pom property)) - (values (and old (org-split-string old "[ \t]")))) - (setq value (org-entry-protect-space value)) - (member value values))) - -(defun org-entry-get-multivalued-property (pom property) - "Return a list of values in a multivalued property." - (let* ((value (org-entry-get pom property)) - (values (and value (org-split-string value "[ \t]")))) - (mapcar 'org-entry-restore-space values))) - -(defun org-entry-put-multivalued-property (pom property &rest values) - "Set multivalued PROPERTY at point-or-marker POM to VALUES. -VALUES should be a list of strings. Spaces will be protected." - (org-entry-put pom property - (mapconcat 'org-entry-protect-space values " ")) - (let* ((value (org-entry-get pom property)) - (values (and value (org-split-string value "[ \t]")))) - (mapcar 'org-entry-restore-space values))) - -(defun org-entry-protect-space (s) - "Protect spaces and newline in string S." - (while (string-match " " s) - (setq s (replace-match "%20" t t s))) - (while (string-match "\n" s) - (setq s (replace-match "%0A" t t s))) - s) - -(defun org-entry-restore-space (s) - "Restore spaces and newline in string S." - (while (string-match "%20" s) - (setq s (replace-match " " t t s))) - (while (string-match "%0A" s) - (setq s (replace-match "\n" t t s))) - s) - -(defvar org-entry-property-inherited-from (make-marker) - "Marker pointing to the entry from where a property was inherited. -Each call to `org-entry-get-with-inheritance' will set this marker to the -location of the entry where the inheritance search matched. If there was -no match, the marker will point nowhere. -Note that also `org-entry-get' calls this function, if the INHERIT flag -is set.") - -(defun org-entry-get-with-inheritance (property &optional literal-nil) - "Get PROPERTY of entry or content at point, search higher levels if needed. -The search will stop at the first ancestor which has the property defined. -If the value found is \"nil\", return nil to show that the property -should be considered as undefined (this is the meaning of nil here). -However, if LITERAL-NIL is set, return the string value \"nil\" instead." - (move-marker org-entry-property-inherited-from nil) - (let (tmp) - (save-excursion - (save-restriction - (widen) - (catch 'ex - (while t - (when (setq tmp (org-entry-get nil property nil 'literal-nil)) - (or (ignore-errors (org-back-to-heading t)) - (goto-char (point-min))) - (move-marker org-entry-property-inherited-from (point)) - (throw 'ex tmp)) - (or (ignore-errors (org-up-heading-safe)) - (throw 'ex nil)))))) - (setq tmp (or tmp - (cdr (assoc property org-file-properties)) - (cdr (assoc property org-global-properties)) - (cdr (assoc property org-global-properties-fixed)))) - (if literal-nil tmp (org-not-nil tmp)))) - -(defvar org-property-changed-functions nil - "Hook called when the value of a property has changed. -Each hook function should accept two arguments, the name of the property -and the new value.") - -(defun org-entry-put (pom property value) - "Set PROPERTY to VALUE for entry at point-or-marker POM." - (org-with-point-at pom - (org-back-to-heading t) - (let ((beg (point)) (end (save-excursion (outline-next-heading) (point))) - range) - (cond - ((equal property "TODO") - (when (and (stringp value) (string-match "\\S-" value) - (not (member value org-todo-keywords-1))) - (user-error "\"%s\" is not a valid TODO state" value)) - (if (or (not value) - (not (string-match "\\S-" value))) - (setq value 'none)) - (org-todo value) - (org-set-tags nil 'align)) - ((equal property "PRIORITY") - (org-priority (if (and value (stringp value) (string-match "\\S-" value)) - (string-to-char value) ?\ )) - (org-set-tags nil 'align)) - ((equal property "CLOCKSUM") - (if (not (re-search-forward - (concat org-clock-string ".*\\]--\\(\\[[^]]+\\]\\)") nil t)) - (error "Cannot find a clock log") - (goto-char (- (match-end 1) 2)) - (cond - ((eq value 'earlier) (org-timestamp-down)) - ((eq value 'later) (org-timestamp-up))) - (org-clock-sum-current-item))) - ((equal property "SCHEDULED") - (if (re-search-forward org-scheduled-time-regexp end t) - (cond - ((eq value 'earlier) (org-timestamp-change -1 'day)) - ((eq value 'later) (org-timestamp-change 1 'day)) - (t (call-interactively 'org-schedule))) - (call-interactively 'org-schedule))) - ((equal property "DEADLINE") - (if (re-search-forward org-deadline-time-regexp end t) - (cond - ((eq value 'earlier) (org-timestamp-change -1 'day)) - ((eq value 'later) (org-timestamp-change 1 'day)) - (t (call-interactively 'org-deadline))) - (call-interactively 'org-deadline))) - ((member property org-special-properties) - (error "The %s property can not yet be set with `org-entry-put'" - property)) - (t ; a non-special property - (let ((buffer-invisibility-spec (org-inhibit-invisibility))) ; Emacs 21 - (setq range (org-get-property-block beg end 'force)) - (goto-char (car range)) - (if (re-search-forward - (org-re-property property) (cdr range) t) - (progn - (delete-region (match-beginning 0) (match-end 0)) - (goto-char (match-beginning 0))) - (goto-char (cdr range)) - (insert "\n") - (backward-char 1) - (org-indent-line)) - (insert ":" property ":") - (and value (insert " " value)) - (org-indent-line))))) - (run-hook-with-args 'org-property-changed-functions property value))) - -(defun org-buffer-property-keys (&optional include-specials include-defaults include-columns) - "Get all property keys in the current buffer. -With INCLUDE-SPECIALS, also list the special properties that reflect things -like tags and TODO state. -With INCLUDE-DEFAULTS, also include properties that has special meaning -internally: ARCHIVE, CATEGORY, SUMMARY, DESCRIPTION, LOCATION, and LOGGING -and others. -With INCLUDE-COLUMNS, also include property names given in COLUMN -formats in the current buffer." - (let (rtn range cfmt s p) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward org-property-start-re nil t) - (setq range (org-get-property-block)) - (goto-char (car range)) - (while (re-search-forward org-property-re - (cdr range) t) - (add-to-list 'rtn (org-match-string-no-properties 2))) - (outline-next-heading)))) - - (when include-specials - (setq rtn (append org-special-properties rtn))) - - (when include-defaults - (mapc (lambda (x) (add-to-list 'rtn x)) org-default-properties) - (add-to-list 'rtn org-effort-property)) - - (when include-columns - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward - "^\\(#\\+COLUMNS:\\|[ \t]*:COLUMNS:\\)[ \t]*\\(.*\\)" - nil t) - (setq cfmt (match-string 2) s 0) - (while (string-match (org-re "%[0-9]*\\([-[:alnum:]_]+\\)") - cfmt s) - (setq s (match-end 0) - p (match-string 1 cfmt)) - (unless (or (equal p "ITEM") - (member p org-special-properties)) - (add-to-list 'rtn (match-string 1 cfmt)))))))) - - (sort rtn (lambda (a b) (string< (upcase a) (upcase b)))))) - -(defun org-property-values (key) - "Return a list of all values of property KEY in the current buffer." - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (let ((re (org-re-property key)) - values) - (while (re-search-forward re nil t) - (add-to-list 'values (org-trim (match-string 3)))) - (delete "" values))))) - -(defun org-insert-property-drawer () - "Insert a property drawer into the current entry." - (org-back-to-heading t) - (looking-at org-outline-regexp) - (let ((indent (if org-adapt-indentation - (- (match-end 0) (match-beginning 0)) - 0)) - (beg (point)) - (re (concat "^[ \t]*" org-keyword-time-regexp)) - end hiddenp) - (outline-next-heading) - (setq end (point)) - (goto-char beg) - (while (re-search-forward re end t)) - (setq hiddenp (outline-invisible-p)) - (end-of-line 1) - (and (equal (char-after) ?\n) (forward-char 1)) - (while (looking-at "^[ \t]*\\(:CLOCK:\\|:LOGBOOK:\\|CLOCK:\\|:END:\\)") - (if (member (match-string 1) '("CLOCK:" ":END:")) - ;; just skip this line - (beginning-of-line 2) - ;; Drawer start, find the end - (re-search-forward "^\\*+ \\|^[ \t]*:END:" nil t) - (beginning-of-line 1))) - (org-skip-over-state-notes) - (skip-chars-backward " \t\n\r") - (if (and (eq (char-before) ?*) (not (eq (char-after) ?\n))) - (forward-char 1)) - (goto-char (point-at-eol)) - (let ((inhibit-read-only t)) (insert "\n:PROPERTIES:\n:END:")) - (beginning-of-line 0) - (org-indent-to-column indent) - (beginning-of-line 2) - (org-indent-to-column indent) - (beginning-of-line 0) - (if hiddenp - (save-excursion - (org-back-to-heading t) - (hide-entry)) - (org-flag-drawer t)))) - -(defun org-insert-drawer (&optional arg drawer) - "Insert a drawer at point. - -Optional argument DRAWER, when non-nil, is a string representing -drawer's name. Otherwise, the user is prompted for a name. - -If a region is active, insert the drawer around that region -instead. - -Point is left between drawer's boundaries." - (interactive "P") - (let* ((logbook (if (stringp org-log-into-drawer) org-log-into-drawer - "LOGBOOK")) - ;; SYSTEM-DRAWERS is a list of drawer names that are used - ;; internally by Org. They are meant to be inserted - ;; automatically. - (system-drawers `("CLOCK" ,logbook "PROPERTIES")) - ;; Remove system drawers from list. Note: For some reason, - ;; `org-completing-read' ignores the predicate while - ;; `completing-read' handles it fine. - (drawer (if arg "PROPERTIES" - (or drawer - (completing-read - "Drawer: " org-drawers - (lambda (d) (not (member d system-drawers)))))))) - (cond - ;; With C-u, fall back on `org-insert-property-drawer' - (arg (org-insert-property-drawer)) - ;; With an active region, insert a drawer at point. - ((not (org-region-active-p)) - (progn - (unless (bolp) (insert "\n")) - (insert (format ":%s:\n\n:END:\n" drawer)) - (forward-line -2))) - ;; Otherwise, insert the drawer at point - (t - (let ((rbeg (region-beginning)) - (rend (copy-marker (region-end)))) - (unwind-protect - (progn - (goto-char rbeg) - (beginning-of-line) - (when (save-excursion - (re-search-forward org-outline-regexp-bol rend t)) - (user-error "Drawers cannot contain headlines")) - ;; Position point at the beginning of the first - ;; non-blank line in region. Insert drawer's opening - ;; there, then indent it. - (org-skip-whitespace) - (beginning-of-line) - (insert ":" drawer ":\n") - (forward-line -1) - (indent-for-tab-command) - ;; Move point to the beginning of the first blank line - ;; after the last non-blank line in region. Insert - ;; drawer's closing, then indent it. - (goto-char rend) - (skip-chars-backward " \r\t\n") - (insert "\n:END:") - (deactivate-mark t) - (indent-for-tab-command) - (unless (eolp) (insert "\n"))) - ;; Clear marker, whatever the outcome of insertion is. - (set-marker rend nil))))))) - -(defvar org-property-set-functions-alist nil - "Property set function alist. -Each entry should have the following format: - - (PROPERTY . READ-FUNCTION) - -The read function will be called with the same argument as -`org-completing-read'.") - -(defun org-set-property-function (property) - "Get the function that should be used to set PROPERTY. -This is computed according to `org-property-set-functions-alist'." - (or (cdr (assoc property org-property-set-functions-alist)) - 'org-completing-read)) - -(defun org-read-property-value (property) - "Read PROPERTY value from user." - (let* ((completion-ignore-case t) - (allowed (org-property-get-allowed-values nil property 'table)) - (cur (org-entry-get nil property)) - (prompt (concat property " value" - (if (and cur (string-match "\\S-" cur)) - (concat " [" cur "]") "") ": ")) - (set-function (org-set-property-function property)) - (val (if allowed - (funcall set-function prompt allowed nil - (not (get-text-property 0 'org-unrestricted - (caar allowed)))) - (let (org-completion-use-ido org-completion-use-iswitchb) - (funcall set-function prompt - (mapcar 'list (org-property-values property)) - nil nil "" nil cur))))) - (if (equal val "") - cur - val))) - -(defvar org-last-set-property nil) -(defvar org-last-set-property-value nil) -(defun org-read-property-name () - "Read a property name." - (let* ((completion-ignore-case t) - (keys (org-buffer-property-keys nil t t)) - (default-prop (or (save-excursion - (save-match-data - (beginning-of-line) - (and (looking-at "^\\s-*:\\([^:\n]+\\):") - (null (string= (match-string 1) "END")) - (match-string 1)))) - org-last-set-property)) - (property (org-icompleting-read - (concat "Property" - (if default-prop (concat " [" default-prop "]") "") - ": ") - (mapcar 'list keys) - nil nil nil nil - default-prop))) - (if (member property keys) - property - (or (cdr (assoc (downcase property) - (mapcar (lambda (x) (cons (downcase x) x)) - keys))) - property)))) - -(defun org-set-property-and-value (use-last) - "Allow to set [PROPERTY]: [value] direction from prompt. -When use-default, don't even ask, just use the last -\"[PROPERTY]: [value]\" string from the history." - (interactive "P") - (let* ((completion-ignore-case t) - (pv (or (and use-last org-last-set-property-value) - (org-completing-read - "Enter a \"[Property]: [value]\" pair: " - nil nil nil nil nil - org-last-set-property-value))) - prop val) - (when (string-match "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*$" pv) - (setq prop (match-string 1 pv) - val (match-string 2 pv)) - (org-set-property prop val)))) - -(defun org-set-property (property value) - "In the current entry, set PROPERTY to VALUE. -When called interactively, this will prompt for a property name, offering -completion on existing and default properties. And then it will prompt -for a value, offering completion either on allowed values (via an inherited -xxx_ALL property) or on existing values in other instances of this property -in the current file." - (interactive (list nil nil)) - (let* ((property (or property (org-read-property-name))) - (value (or value (org-read-property-value property))) - (fn (cdr (assoc property org-properties-postprocess-alist)))) - (setq org-last-set-property property) - (setq org-last-set-property-value (concat property ": " value)) - ;; Possibly postprocess the inserted value: - (when fn (setq value (funcall fn value))) - (unless (equal (org-entry-get nil property) value) - (org-entry-put nil property value)))) - -(defun org-delete-property (property &optional delete-empty-drawer) - "In the current entry, delete PROPERTY. -When optional argument DELETE-EMPTY-DRAWER is a string, it defines -an empty drawer to delete." - (interactive - (let* ((completion-ignore-case t) - (prop (org-icompleting-read "Property: " - (org-entry-properties nil 'standard)))) - (list prop))) - (message "Property %s %s" property - (if (org-entry-delete nil property delete-empty-drawer) - "deleted" - "was not present in the entry"))) - -(defun org-delete-property-globally (property) - "Remove PROPERTY globally, from all entries." - (interactive - (let* ((completion-ignore-case t) - (prop (org-icompleting-read - "Globally remove property: " - (mapcar 'list (org-buffer-property-keys))))) - (list prop))) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (let ((cnt 0)) - (while (re-search-forward - (org-re-property property) - nil t) - (setq cnt (1+ cnt)) - (delete-region (match-beginning 0) (1+ (point-at-eol)))) - (message "Property \"%s\" removed from %d entries" property cnt))))) - -(defvar org-columns-current-fmt-compiled) ; defined in org-colview.el - -(defun org-compute-property-at-point () - "Compute the property at point. -This looks for an enclosing column format, extracts the operator and -then applies it to the property in the column format's scope." - (interactive) - (unless (org-at-property-p) - (user-error "Not at a property")) - (let ((prop (org-match-string-no-properties 2))) - (org-columns-get-format-and-top-level) - (unless (nth 3 (assoc prop org-columns-current-fmt-compiled)) - (user-error "No operator defined for property %s" prop)) - (org-columns-compute prop))) - -(defvar org-property-allowed-value-functions nil - "Hook for functions supplying allowed values for a specific property. -The functions must take a single argument, the name of the property, and -return a flat list of allowed values. If \":ETC\" is one of -the values, this means that these values are intended as defaults for -completion, but that other values should be allowed too. -The functions must return nil if they are not responsible for this -property.") - -(defun org-property-get-allowed-values (pom property &optional table) - "Get allowed values for the property PROPERTY. -When TABLE is non-nil, return an alist that can directly be used for -completion." - (let (vals) - (cond - ((equal property "TODO") - (setq vals (org-with-point-at pom - (append org-todo-keywords-1 '(""))))) - ((equal property "PRIORITY") - (let ((n org-lowest-priority)) - (while (>= n org-highest-priority) - (push (char-to-string n) vals) - (setq n (1- n))))) - ((member property org-special-properties)) - ((setq vals (run-hook-with-args-until-success - 'org-property-allowed-value-functions property))) - (t - (setq vals (org-entry-get pom (concat property "_ALL") 'inherit)) - (when (and vals (string-match "\\S-" vals)) - (setq vals (car (read-from-string (concat "(" vals ")")))) - (setq vals (mapcar (lambda (x) - (cond ((stringp x) x) - ((numberp x) (number-to-string x)) - ((symbolp x) (symbol-name x)) - (t "???"))) - vals))))) - (when (member ":ETC" vals) - (setq vals (remove ":ETC" vals)) - (org-add-props (car vals) '(org-unrestricted t))) - (if table (mapcar 'list vals) vals))) - -(defun org-property-previous-allowed-value (&optional previous) - "Switch to the next allowed value for this property." - (interactive) - (org-property-next-allowed-value t)) - -(defun org-property-next-allowed-value (&optional previous) - "Switch to the next allowed value for this property." - (interactive) - (unless (org-at-property-p) - (user-error "Not at a property")) - (let* ((prop (car (save-match-data (org-split-string (match-string 1) ":")))) - (key (match-string 2)) - (value (match-string 3)) - (allowed (or (org-property-get-allowed-values (point) key) - (and (member value '("[ ]" "[-]" "[X]")) - '("[ ]" "[X]")))) - (heading (save-match-data (nth 4 (org-heading-components)))) - nval) - (unless allowed - (user-error "Allowed values for this property have not been defined")) - (if previous (setq allowed (reverse allowed))) - (if (member value allowed) - (setq nval (car (cdr (member value allowed))))) - (setq nval (or nval (car allowed))) - (if (equal nval value) - (user-error "Only one allowed value for this property")) - (org-at-property-p) - (replace-match (concat " :" key ": " nval) t t) - (org-indent-line) - (beginning-of-line 1) - (skip-chars-forward " \t") - (when (equal prop org-effort-property) - (save-excursion - (org-back-to-heading t) - (put-text-property (point-at-bol) (point-at-eol) 'org-effort nval)) - (when (string= org-clock-current-task heading) - (setq org-clock-effort nval) - (org-clock-update-mode-line))) - (run-hook-with-args 'org-property-changed-functions key nval))) - -(defun org-find-olp (path &optional this-buffer) - "Return a marker pointing to the entry at outline path OLP. -If anything goes wrong, throw an error. -You can wrap this call to catch the error like this: - - (condition-case msg - (org-mobile-locate-entry (match-string 4)) - (error (nth 1 msg))) - -The return value will then be either a string with the error message, -or a marker if everything is OK. - -If THIS-BUFFER is set, the outline path does not contain a file, -only headings." - (let* ((file (if this-buffer buffer-file-name (pop path))) - (buffer (if this-buffer (current-buffer) (find-file-noselect file))) - (level 1) - (lmin 1) - (lmax 1) - limit re end found pos heading cnt flevel) - (unless buffer (error "File not found :%s" file)) - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (setq limit (point-max)) - (goto-char (point-min)) - (while (setq heading (pop path)) - (setq re (format org-complex-heading-regexp-format - (regexp-quote heading))) - (setq cnt 0 pos (point)) - (while (re-search-forward re end t) - (setq level (- (match-end 1) (match-beginning 1))) - (if (and (>= level lmin) (<= level lmax)) - (setq found (match-beginning 0) flevel level cnt (1+ cnt)))) - (when (= cnt 0) (error "Heading not found on level %d: %s" - lmax heading)) - (when (> cnt 1) (error "Heading not unique on level %d: %s" - lmax heading)) - (goto-char found) - (setq lmin (1+ flevel) lmax (+ lmin (if org-odd-levels-only 1 0))) - (setq end (save-excursion (org-end-of-subtree t t)))) - (when (org-at-heading-p) - (point-marker))))))) - -(defun org-find-exact-headline-in-buffer (heading &optional buffer pos-only) - "Find node HEADING in BUFFER. -Return a marker to the heading if it was found, or nil if not. -If POS-ONLY is set, return just the position instead of a marker. - -The heading text must match exact, but it may have a TODO keyword, -a priority cookie and tags in the standard locations." - (with-current-buffer (or buffer (current-buffer)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (let (case-fold-search) - (if (re-search-forward - (format org-complex-heading-regexp-format - (regexp-quote heading)) nil t) - (if pos-only - (match-beginning 0) - (move-marker (make-marker) (match-beginning 0))))))))) - -(defun org-find-exact-heading-in-directory (heading &optional dir) - "Find Org node headline HEADING in all .org files in directory DIR. -When the target headline is found, return a marker to this location." - (let ((files (directory-files (or dir default-directory) - nil "\\`[^.#].*\\.org\\'")) - file visiting m buffer) - (catch 'found - (while (setq file (pop files)) - (message "trying %s" file) - (setq visiting (org-find-base-buffer-visiting file)) - (setq buffer (or visiting (find-file-noselect file))) - (setq m (org-find-exact-headline-in-buffer - heading buffer)) - (when (and (not m) (not visiting)) (kill-buffer buffer)) - (and m (throw 'found m)))))) - -(defun org-find-entry-with-id (ident) - "Locate the entry that contains the ID property with exact value IDENT. -IDENT can be a string, a symbol or a number, this function will search for -the string representation of it. -Return the position where this entry starts, or nil if there is no such entry." - (interactive "sID: ") - (let ((id (cond - ((stringp ident) ident) - ((symbol-name ident) (symbol-name ident)) - ((numberp ident) (number-to-string ident)) - (t (error "IDENT %s must be a string, symbol or number" ident)))) - (case-fold-search nil)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (when (re-search-forward - (concat "^[ \t]*:ID:[ \t]+" (regexp-quote id) "[ \t]*$") - nil t) - (org-back-to-heading t) - (point)))))) - -;;;; Timestamps - -(defvar org-last-changed-timestamp nil) -(defvar org-last-inserted-timestamp nil - "The last time stamp inserted with `org-insert-time-stamp'.") -(defvar org-ts-what) ; dynamically scoped parameter - -(defun org-time-stamp (arg &optional inactive) - "Prompt for a date/time and insert a time stamp. -If the user specifies a time like HH:MM or if this command is -called with at least one prefix argument, the time stamp contains -the date and the time. Otherwise, only the date is be included. - -All parts of a date not specified by the user is filled in from -the current date/time. So if you just press return without -typing anything, the time stamp will represent the current -date/time. - -If there is already a timestamp at the cursor, it will be -modified. - -With two universal prefix arguments, insert an active timestamp -with the current time without prompting the user. - -When called from lisp, the timestamp is inactive if INACTIVE is -non-nil." - (interactive "P") - (let* ((ts nil) - (default-time - ;; Default time is either today, or, when entering a range, - ;; the range start. - (if (or (and (org-at-timestamp-p t) (setq ts (match-string 0))) - (save-excursion - (re-search-backward - (concat org-ts-regexp "--?-?\\=") ; 1-3 minuses - (- (point) 20) t))) - (apply 'encode-time (org-parse-time-string (match-string 1))) - (current-time))) - (default-input (and ts (org-get-compact-tod ts))) - (repeater (save-excursion - (save-match-data - (beginning-of-line) - (when (re-search-forward - "\\([.+-]+[0-9]+[hdwmy] ?\\)+" ;;\\(?:[/ ][-+]?[0-9]+[hdwmy]\\)?\\) ?" - (save-excursion (progn (end-of-line) (point))) t) - (match-string 0))))) - org-time-was-given org-end-time-was-given time) - (cond - ((and (org-at-timestamp-p t) - (memq last-command '(org-time-stamp org-time-stamp-inactive)) - (memq this-command '(org-time-stamp org-time-stamp-inactive))) - (insert "--") - (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil - default-time default-input inactive))) - (org-insert-time-stamp time (or org-time-was-given arg) inactive)) - ((org-at-timestamp-p t) - (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil default-time default-input inactive))) - (when (org-at-timestamp-p t) ; just to get the match data - ; (setq inactive (eq (char-after (match-beginning 0)) ?\[)) - (replace-match "") - (setq org-last-changed-timestamp - (org-insert-time-stamp - time (or org-time-was-given arg) - inactive nil nil (list org-end-time-was-given))) - (when repeater (goto-char (1- (point))) (insert " " repeater) - (setq org-last-changed-timestamp - (concat (substring org-last-inserted-timestamp 0 -1) - " " repeater ">")))) - (message "Timestamp updated")) - ((equal arg '(16)) - (org-insert-time-stamp (current-time) t inactive)) - (t - (setq time (let ((this-command this-command)) - (org-read-date arg 'totime nil nil default-time default-input inactive))) - (org-insert-time-stamp time (or org-time-was-given arg) inactive - nil nil (list org-end-time-was-given)))))) - -;; FIXME: can we use this for something else, like computing time differences? -(defun org-get-compact-tod (s) - (when (string-match "\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\(-\\(\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)\\)?" s) - (let* ((t1 (match-string 1 s)) - (h1 (string-to-number (match-string 2 s))) - (m1 (string-to-number (match-string 3 s))) - (t2 (and (match-end 4) (match-string 5 s))) - (h2 (and t2 (string-to-number (match-string 6 s)))) - (m2 (and t2 (string-to-number (match-string 7 s)))) - dh dm) - (if (not t2) - t1 - (setq dh (- h2 h1) dm (- m2 m1)) - (if (< dm 0) (setq dm (+ dm 60) dh (1- dh))) - (concat t1 "+" (number-to-string dh) - (and (/= 0 dm) (format ":%02d" dm))))))) - -(defun org-time-stamp-inactive (&optional arg) - "Insert an inactive time stamp. -An inactive time stamp is enclosed in square brackets instead of angle -brackets. It is inactive in the sense that it does not trigger agenda entries, -does not link to the calendar and cannot be changed with the S-cursor keys. -So these are more for recording a certain time/date." - (interactive "P") - (org-time-stamp arg 'inactive)) - -(defvar org-date-ovl (make-overlay 1 1)) -(overlay-put org-date-ovl 'face 'org-date-selected) -(org-detach-overlay org-date-ovl) - -(defvar org-ans1) ; dynamically scoped parameter -(defvar org-ans2) ; dynamically scoped parameter - -(defvar org-plain-time-of-day-regexp) ; defined below - -(defvar org-overriding-default-time nil) ; dynamically scoped -(defvar org-read-date-overlay nil) -(defvar org-dcst nil) ; dynamically scoped -(defvar org-read-date-history nil) -(defvar org-read-date-final-answer nil) -(defvar org-read-date-analyze-futurep nil) -(defvar org-read-date-analyze-forced-year nil) -(defvar org-read-date-inactive) - -(defvar org-read-date-minibuffer-local-map - (let* ((org-replace-disputed-keys nil) - (map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-map) - (org-defkey map (kbd ".") - (lambda () (interactive) - ;; Are we at the beginning of the prompt? - (if (looking-back "^[^:]+: ") - (org-eval-in-calendar '(calendar-goto-today)) - (insert ".")))) - (org-defkey map (kbd "C-.") - (lambda () (interactive) - (org-eval-in-calendar '(calendar-goto-today)))) - (org-defkey map [(meta shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-month 1)))) - (org-defkey map [(meta shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-month 1)))) - (org-defkey map [(meta shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-year 1)))) - (org-defkey map [(meta shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-year 1)))) - (org-defkey map [?\e (shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-month 1)))) - (org-defkey map [?\e (shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-month 1)))) - (org-defkey map [?\e (shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-year 1)))) - (org-defkey map [?\e (shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-year 1)))) - (org-defkey map [(shift up)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-week 1)))) - (org-defkey map [(shift down)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-week 1)))) - (org-defkey map [(shift left)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-day 1)))) - (org-defkey map [(shift right)] - (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-day 1)))) - (org-defkey map "!" - (lambda () (interactive) - (org-eval-in-calendar '(diary-view-entries)) - (message ""))) - (org-defkey map ">" - (lambda () (interactive) - (org-eval-in-calendar '(scroll-calendar-left 1)))) - (org-defkey map "<" - (lambda () (interactive) - (org-eval-in-calendar '(scroll-calendar-right 1)))) - (org-defkey map "\C-v" - (lambda () (interactive) - (org-eval-in-calendar - '(calendar-scroll-left-three-months 1)))) - (org-defkey map "\M-v" - (lambda () (interactive) - (org-eval-in-calendar - '(calendar-scroll-right-three-months 1)))) - map) - "Keymap for minibuffer commands when using `org-read-date'.") - -(defvar org-def) -(defvar org-defdecode) -(defvar org-with-time) - -(defun org-read-date (&optional org-with-time to-time from-string prompt - default-time default-input inactive) - "Read a date, possibly a time, and make things smooth for the user. -The prompt will suggest to enter an ISO date, but you can also enter anything -which will at least partially be understood by `parse-time-string'. -Unrecognized parts of the date will default to the current day, month, year, -hour and minute. If this command is called to replace a timestamp at point, -or to enter the second timestamp of a range, the default time is taken -from the existing stamp. Furthermore, the command prefers the future, -so if you are giving a date where the year is not given, and the day-month -combination is already past in the current year, it will assume you -mean next year. For details, see the manual. A few examples: - - 3-2-5 --> 2003-02-05 - feb 15 --> currentyear-02-15 - 2/15 --> currentyear-02-15 - sep 12 9 --> 2009-09-12 - 12:45 --> today 12:45 - 22 sept 0:34 --> currentyear-09-22 0:34 - 12 --> currentyear-currentmonth-12 - Fri --> nearest Friday after today - -Tue --> last Tuesday - etc. - -Furthermore you can specify a relative date by giving, as the *first* thing -in the input: a plus/minus sign, a number and a letter [hdwmy] to indicate -change in days weeks, months, years. -With a single plus or minus, the date is relative to today. With a double -plus or minus, it is relative to the date in DEFAULT-TIME. E.g. - +4d --> four days from today - +4 --> same as above - +2w --> two weeks from today - ++5 --> five days from default date - -The function understands only English month and weekday abbreviations. - -While prompting, a calendar is popped up - you can also select the -date with the mouse (button 1). The calendar shows a period of three -months. To scroll it to other months, use the keys `>' and `<'. -If you don't like the calendar, turn it off with - \(setq org-read-date-popup-calendar nil) - -With optional argument TO-TIME, the date will immediately be converted -to an internal time. -With an optional argument ORG-WITH-TIME, the prompt will suggest to -also insert a time. Note that when ORG-WITH-TIME is not set, you can -still enter a time, and this function will inform the calling routine -about this change. The calling routine may then choose to change the -format used to insert the time stamp into the buffer to include the time. -With optional argument FROM-STRING, read from this string instead from -the user. PROMPT can overwrite the default prompt. DEFAULT-TIME is -the time/date that is used for everything that is not specified by the -user." - (require 'parse-time) - (let* ((org-time-stamp-rounding-minutes - (if (equal org-with-time '(16)) '(0 0) org-time-stamp-rounding-minutes)) - (org-dcst org-display-custom-times) - (ct (org-current-time)) - (org-def (or org-overriding-default-time default-time ct)) - (org-defdecode (decode-time org-def)) - (dummy (progn - (when (< (nth 2 org-defdecode) org-extend-today-until) - (setcar (nthcdr 2 org-defdecode) -1) - (setcar (nthcdr 1 org-defdecode) 59) - (setq org-def (apply 'encode-time org-defdecode) - org-defdecode (decode-time org-def))))) - (mouse-autoselect-window nil) ; Don't let the mouse jump - (calendar-frame-setup nil) - (calendar-setup nil) - (calendar-move-hook nil) - (calendar-view-diary-initially-flag nil) - (calendar-view-holidays-initially-flag nil) - (timestr (format-time-string - (if org-with-time "%Y-%m-%d %H:%M" "%Y-%m-%d") org-def)) - (prompt (concat (if prompt (concat prompt " ") "") - (format "Date+time [%s]: " timestr))) - ans (org-ans0 "") org-ans1 org-ans2 final) - - (cond - (from-string (setq ans from-string)) - (org-read-date-popup-calendar - (save-excursion - (save-window-excursion - (calendar) - (org-eval-in-calendar '(setq cursor-type nil) t) - (unwind-protect - (progn - (calendar-forward-day (- (time-to-days org-def) - (calendar-absolute-from-gregorian - (calendar-current-date)))) - (org-eval-in-calendar nil t) - (let* ((old-map (current-local-map)) - (map (copy-keymap calendar-mode-map)) - (minibuffer-local-map - (copy-keymap org-read-date-minibuffer-local-map))) - (org-defkey map (kbd "RET") 'org-calendar-select) - (org-defkey map [mouse-1] 'org-calendar-select-mouse) - (org-defkey map [mouse-2] 'org-calendar-select-mouse) - (unwind-protect - (progn - (use-local-map map) - (setq org-read-date-inactive inactive) - (add-hook 'post-command-hook 'org-read-date-display) - (setq org-ans0 (read-string prompt default-input - 'org-read-date-history nil)) - ;; org-ans0: from prompt - ;; org-ans1: from mouse click - ;; org-ans2: from calendar motion - (setq ans (concat org-ans0 " " (or org-ans1 org-ans2)))) - (remove-hook 'post-command-hook 'org-read-date-display) - (use-local-map old-map) - (when org-read-date-overlay - (delete-overlay org-read-date-overlay) - (setq org-read-date-overlay nil))))) - (bury-buffer "*Calendar*"))))) - - (t ; Naked prompt only - (unwind-protect - (setq ans (read-string prompt default-input - 'org-read-date-history timestr)) - (when org-read-date-overlay - (delete-overlay org-read-date-overlay) - (setq org-read-date-overlay nil))))) - - (setq final (org-read-date-analyze ans org-def org-defdecode)) - - (when org-read-date-analyze-forced-year - (message "Year was forced into %s" - (if org-read-date-force-compatible-dates - "compatible range (1970-2037)" - "range representable on this machine")) - (ding)) - - ;; One round trip to get rid of 34th of August and stuff like that.... - (setq final (decode-time (apply 'encode-time final))) - - (setq org-read-date-final-answer ans) - - (if to-time - (apply 'encode-time final) - (if (and (boundp 'org-time-was-given) org-time-was-given) - (format "%04d-%02d-%02d %02d:%02d" - (nth 5 final) (nth 4 final) (nth 3 final) - (nth 2 final) (nth 1 final)) - (format "%04d-%02d-%02d" (nth 5 final) (nth 4 final) (nth 3 final)))))) - -(defun org-read-date-display () - "Display the current date prompt interpretation in the minibuffer." - (when org-read-date-display-live - (when org-read-date-overlay - (delete-overlay org-read-date-overlay)) - (when (minibufferp (current-buffer)) - (save-excursion - (end-of-line 1) - (while (not (equal (buffer-substring - (max (point-min) (- (point) 4)) (point)) - " ")) - (insert " "))) - (let* ((ans (concat (buffer-substring (point-at-bol) (point-max)) - " " (or org-ans1 org-ans2))) - (org-end-time-was-given nil) - (f (org-read-date-analyze ans org-def org-defdecode)) - (fmts (if org-dcst - org-time-stamp-custom-formats - org-time-stamp-formats)) - (fmt (if (or org-with-time - (and (boundp 'org-time-was-given) org-time-was-given)) - (cdr fmts) - (car fmts))) - (txt (format-time-string fmt (apply 'encode-time f))) - (txt (if org-read-date-inactive (concat "[" (substring txt 1 -1) "]") txt)) - (txt (concat "=> " txt))) - (when (and org-end-time-was-given - (string-match org-plain-time-of-day-regexp txt)) - (setq txt (concat (substring txt 0 (match-end 0)) "-" - org-end-time-was-given - (substring txt (match-end 0))))) - (when org-read-date-analyze-futurep - (setq txt (concat txt " (=>F)"))) - (setq org-read-date-overlay - (make-overlay (1- (point-at-eol)) (point-at-eol))) - (org-overlay-display org-read-date-overlay txt 'secondary-selection))))) - -(defun org-read-date-analyze (ans org-def org-defdecode) - "Analyze the combined answer of the date prompt." - ;; FIXME: cleanup and comment - (let ((nowdecode (decode-time (current-time))) - delta deltan deltaw deltadef year month day - hour minute second wday pm h2 m2 tl wday1 - iso-year iso-weekday iso-week iso-year iso-date futurep kill-year) - (setq org-read-date-analyze-futurep nil - org-read-date-analyze-forced-year nil) - (when (string-match "\\`[ \t]*\\.[ \t]*\\'" ans) - (setq ans "+0")) - - (when (setq delta (org-read-date-get-relative ans (current-time) org-def)) - (setq ans (replace-match "" t t ans) - deltan (car delta) - deltaw (nth 1 delta) - deltadef (nth 2 delta))) - - ;; Check if there is an iso week date in there. If yes, store the - ;; info and postpone interpreting it until the rest of the parsing - ;; is done. - (when (string-match "\\<\\(?:\\([0-9]+\\)-\\)?[wW]\\([0-9]\\{1,2\\}\\)\\(?:-\\([0-6]\\)\\)?\\([ \t]\\|$\\)" ans) - (setq iso-year (if (match-end 1) - (org-small-year-to-year - (string-to-number (match-string 1 ans)))) - iso-weekday (if (match-end 3) - (string-to-number (match-string 3 ans))) - iso-week (string-to-number (match-string 2 ans))) - (setq ans (replace-match "" t t ans))) - - ;; Help matching ISO dates with single digit month or day, like 2006-8-11. - (when (string-match - "^ *\\(\\([0-9]+\\)-\\)?\\([0-1]?[0-9]\\)-\\([0-3]?[0-9]\\)\\([^-0-9]\\|$\\)" ans) - (setq year (if (match-end 2) - (string-to-number (match-string 2 ans)) - (progn (setq kill-year t) - (string-to-number (format-time-string "%Y")))) - month (string-to-number (match-string 3 ans)) - day (string-to-number (match-string 4 ans))) - (if (< year 100) (setq year (+ 2000 year))) - (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) - t nil ans))) - - ;; Help matching dotted european dates - (when (string-match - "^ *\\(3[01]\\|0?[1-9]\\|[12][0-9]\\)\\. ?\\(0?[1-9]\\|1[012]\\)\\.\\( ?[1-9][0-9]\\{3\\}\\)?" ans) - (setq year (if (match-end 3) (string-to-number (match-string 3 ans)) - (setq kill-year t) - (string-to-number (format-time-string "%Y"))) - day (string-to-number (match-string 1 ans)) - month (string-to-number (match-string 2 ans)) - ans (replace-match (format "%04d-%02d-%02d" year month day) - t nil ans))) - - ;; Help matching american dates, like 5/30 or 5/30/7 - (when (string-match - "^ *\\(0?[1-9]\\|1[012]\\)/\\(0?[1-9]\\|[12][0-9]\\|3[01]\\)\\(/\\([0-9]+\\)\\)?\\([^/0-9]\\|$\\)" ans) - (setq year (if (match-end 4) - (string-to-number (match-string 4 ans)) - (progn (setq kill-year t) - (string-to-number (format-time-string "%Y")))) - month (string-to-number (match-string 1 ans)) - day (string-to-number (match-string 2 ans))) - (if (< year 100) (setq year (+ 2000 year))) - (setq ans (replace-match (format "%04d-%02d-%02d\\5" year month day) - t nil ans))) - ;; Help matching am/pm times, because `parse-time-string' does not do that. - ;; If there is a time with am/pm, and *no* time without it, we convert - ;; so that matching will be successful. - (loop for i from 1 to 2 do ; twice, for end time as well - (when (and (not (string-match "\\(\\`\\|[^+]\\)[012]?[0-9]:[0-9][0-9]\\([ \t\n]\\|$\\)" ans)) - (string-match "\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?\\(am\\|AM\\|pm\\|PM\\)\\>" ans)) - (setq hour (string-to-number (match-string 1 ans)) - minute (if (match-end 3) - (string-to-number (match-string 3 ans)) - 0) - pm (equal ?p - (string-to-char (downcase (match-string 4 ans))))) - (if (and (= hour 12) (not pm)) - (setq hour 0) - (if (and pm (< hour 12)) (setq hour (+ 12 hour)))) - (setq ans (replace-match (format "%02d:%02d" hour minute) - t t ans)))) - - ;; Check if a time range is given as a duration - (when (string-match "\\([012]?[0-9]\\):\\([0-6][0-9]\\)\\+\\([012]?[0-9]\\)\\(:\\([0-5][0-9]\\)\\)?" ans) - (setq hour (string-to-number (match-string 1 ans)) - h2 (+ hour (string-to-number (match-string 3 ans))) - minute (string-to-number (match-string 2 ans)) - m2 (+ minute (if (match-end 5) (string-to-number - (match-string 5 ans))0))) - (if (>= m2 60) (setq h2 (1+ h2) m2 (- m2 60))) - (setq ans (replace-match (format "%02d:%02d-%02d:%02d" hour minute h2 m2) - t t ans))) - - ;; Check if there is a time range - (when (boundp 'org-end-time-was-given) - (setq org-time-was-given nil) - (when (and (string-match org-plain-time-of-day-regexp ans) - (match-end 8)) - (setq org-end-time-was-given (match-string 8 ans)) - (setq ans (concat (substring ans 0 (match-beginning 7)) - (substring ans (match-end 7)))))) - - (setq tl (parse-time-string ans) - day (or (nth 3 tl) (nth 3 org-defdecode)) - month (or (nth 4 tl) - (if (and org-read-date-prefer-future - (nth 3 tl) (< (nth 3 tl) (nth 3 nowdecode))) - (prog1 (1+ (nth 4 nowdecode)) (setq futurep t)) - (nth 4 org-defdecode))) - year (or (and (not kill-year) (nth 5 tl)) - (if (and org-read-date-prefer-future - (nth 4 tl) (< (nth 4 tl) (nth 4 nowdecode))) - (prog1 (1+ (nth 5 nowdecode)) (setq futurep t)) - (nth 5 org-defdecode))) - hour (or (nth 2 tl) (nth 2 org-defdecode)) - minute (or (nth 1 tl) (nth 1 org-defdecode)) - second (or (nth 0 tl) 0) - wday (nth 6 tl)) - - (when (and (eq org-read-date-prefer-future 'time) - (not (nth 3 tl)) (not (nth 4 tl)) (not (nth 5 tl)) - (equal day (nth 3 nowdecode)) - (equal month (nth 4 nowdecode)) - (equal year (nth 5 nowdecode)) - (nth 2 tl) - (or (< (nth 2 tl) (nth 2 nowdecode)) - (and (= (nth 2 tl) (nth 2 nowdecode)) - (nth 1 tl) - (< (nth 1 tl) (nth 1 nowdecode))))) - (setq day (1+ day) - futurep t)) - - ;; Special date definitions below - (cond - (iso-week - ;; There was an iso week - (require 'cal-iso) - (setq futurep nil) - (setq year (or iso-year year) - day (or iso-weekday wday 1) - wday nil ; to make sure that the trigger below does not match - iso-date (calendar-gregorian-from-absolute - (calendar-absolute-from-iso - (list iso-week day year)))) - ; FIXME: Should we also push ISO weeks into the future? - ; (when (and org-read-date-prefer-future - ; (not iso-year) - ; (< (calendar-absolute-from-gregorian iso-date) - ; (time-to-days (current-time)))) - ; (setq year (1+ year) - ; iso-date (calendar-gregorian-from-absolute - ; (calendar-absolute-from-iso - ; (list iso-week day year))))) - (setq month (car iso-date) - year (nth 2 iso-date) - day (nth 1 iso-date))) - (deltan - (setq futurep nil) - (unless deltadef - (let ((now (decode-time (current-time)))) - (setq day (nth 3 now) month (nth 4 now) year (nth 5 now)))) - (cond ((member deltaw '("d" "")) (setq day (+ day deltan))) - ((equal deltaw "w") (setq day (+ day (* 7 deltan)))) - ((equal deltaw "m") (setq month (+ month deltan))) - ((equal deltaw "y") (setq year (+ year deltan))))) - ((and wday (not (nth 3 tl))) - ;; Weekday was given, but no day, so pick that day in the week - ;; on or after the derived date. - (setq wday1 (nth 6 (decode-time (encode-time 0 0 0 day month year)))) - (unless (equal wday wday1) - (setq day (+ day (% (- wday wday1 -7) 7)))))) - (if (and (boundp 'org-time-was-given) - (nth 2 tl)) - (setq org-time-was-given t)) - (if (< year 100) (setq year (+ 2000 year))) - ;; Check of the date is representable - (if org-read-date-force-compatible-dates - (progn - (if (< year 1970) - (setq year 1970 org-read-date-analyze-forced-year t)) - (if (> year 2037) - (setq year 2037 org-read-date-analyze-forced-year t))) - (condition-case nil - (ignore (encode-time second minute hour day month year)) - (error - (setq year (nth 5 org-defdecode)) - (setq org-read-date-analyze-forced-year t)))) - (setq org-read-date-analyze-futurep futurep) - (list second minute hour day month year))) - -(defvar parse-time-weekdays) -(defun org-read-date-get-relative (s today default) - "Check string S for special relative date string. -TODAY and DEFAULT are internal times, for today and for a default. -Return shift list (N what def-flag) -WHAT is \"d\", \"w\", \"m\", or \"y\" for day, week, month, year. -N is the number of WHATs to shift. -DEF-FLAG is t when a double ++ or -- indicates shift relative to - the DEFAULT date rather than TODAY." - (require 'parse-time) - (when (and - (string-match - (concat - "\\`[ \t]*\\([-+]\\{0,2\\}\\)" - "\\([0-9]+\\)?" - "\\([hdwmy]\\|\\(" (mapconcat 'car parse-time-weekdays "\\|") "\\)\\)?" - "\\([ \t]\\|$\\)") s) - (or (> (match-end 1) (match-beginning 1)) (match-end 4))) - (let* ((dir (if (> (match-end 1) (match-beginning 1)) - (string-to-char (substring (match-string 1 s) -1)) - ?+)) - (rel (and (match-end 1) (= 2 (- (match-end 1) (match-beginning 1))))) - (n (if (match-end 2) (string-to-number (match-string 2 s)) 1)) - (what (if (match-end 3) (match-string 3 s) "d")) - (wday1 (cdr (assoc (downcase what) parse-time-weekdays))) - (date (if rel default today)) - (wday (nth 6 (decode-time date))) - delta) - (if wday1 - (progn - (setq delta (mod (+ 7 (- wday1 wday)) 7)) - (if (= delta 0) (setq delta 7)) - (if (= dir ?-) - (progn - (setq delta (- delta 7)) - (if (= delta 0) (setq delta -7)))) - (if (> n 1) (setq delta (+ delta (* (1- n) (if (= dir ?-) -7 7))))) - (list delta "d" rel)) - (list (* n (if (= dir ?-) -1 1)) what rel))))) - -(defun org-order-calendar-date-args (arg1 arg2 arg3) - "Turn a user-specified date into the internal representation. -The internal representation needed by the calendar is (month day year). -This is a wrapper to handle the brain-dead convention in calendar that -user function argument order change dependent on argument order." - (if (boundp 'calendar-date-style) - (cond - ((eq calendar-date-style 'american) - (list arg1 arg2 arg3)) - ((eq calendar-date-style 'european) - (list arg2 arg1 arg3)) - ((eq calendar-date-style 'iso) - (list arg2 arg3 arg1))) - (org-no-warnings ;; european-calendar-style is obsolete as of version 23.1 - (if (org-bound-and-true-p european-calendar-style) - (list arg2 arg1 arg3) - (list arg1 arg2 arg3))))) - -(defun org-eval-in-calendar (form &optional keepdate) - "Eval FORM in the calendar window and return to current window. -When KEEPDATE is non-nil, update `org-ans2' from the cursor date, -otherwise stick to the current value of `org-ans2'." - (let ((sf (selected-frame)) - (sw (selected-window))) - (select-window (get-buffer-window "*Calendar*" t)) - (eval form) - (when (and (not keepdate) (calendar-cursor-to-date)) - (let* ((date (calendar-cursor-to-date)) - (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) - (setq org-ans2 (format-time-string "%Y-%m-%d" time)))) - (move-overlay org-date-ovl (1- (point)) (1+ (point)) (current-buffer)) - (select-window sw) - (org-select-frame-set-input-focus sf))) - -(defun org-calendar-select () - "Return to `org-read-date' with the date currently selected. -This is used by `org-read-date' in a temporary keymap for the calendar buffer." - (interactive) - (when (calendar-cursor-to-date) - (let* ((date (calendar-cursor-to-date)) - (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) - (setq org-ans1 (format-time-string "%Y-%m-%d" time))) - (if (active-minibuffer-window) (exit-minibuffer)))) - -(defun org-insert-time-stamp (time &optional with-hm inactive pre post extra) - "Insert a date stamp for the date given by the internal TIME. -WITH-HM means use the stamp format that includes the time of the day. -INACTIVE means use square brackets instead of angular ones, so that the -stamp will not contribute to the agenda. -PRE and POST are optional strings to be inserted before and after the -stamp. -The command returns the inserted time stamp." - (let ((fmt (funcall (if with-hm 'cdr 'car) org-time-stamp-formats)) - stamp) - (if inactive (setq fmt (concat "[" (substring fmt 1 -1) "]"))) - (insert-before-markers (or pre "")) - (when (listp extra) - (setq extra (car extra)) - (if (and (stringp extra) - (string-match "\\([0-9]+\\):\\([0-9]+\\)" extra)) - (setq extra (format "-%02d:%02d" - (string-to-number (match-string 1 extra)) - (string-to-number (match-string 2 extra)))) - (setq extra nil))) - (when extra - (setq fmt (concat (substring fmt 0 -1) extra (substring fmt -1)))) - (insert-before-markers (setq stamp (format-time-string fmt time))) - (insert-before-markers (or post "")) - (setq org-last-inserted-timestamp stamp))) - -(defun org-toggle-time-stamp-overlays () - "Toggle the use of custom time stamp formats." - (interactive) - (setq org-display-custom-times (not org-display-custom-times)) - (unless org-display-custom-times - (let ((p (point-min)) (bmp (buffer-modified-p))) - (while (setq p (next-single-property-change p 'display)) - (if (and (get-text-property p 'display) - (eq (get-text-property p 'face) 'org-date)) - (remove-text-properties - p (setq p (next-single-property-change p 'display)) - '(display t)))) - (set-buffer-modified-p bmp))) - (if (featurep 'xemacs) - (remove-text-properties (point-min) (point-max) '(end-glyph t))) - (org-restart-font-lock) - (setq org-table-may-need-update t) - (if org-display-custom-times - (message "Time stamps are overlaid with custom format") - (message "Time stamp overlays removed"))) - -(defun org-display-custom-time (beg end) - "Overlay modified time stamp format over timestamp between BEG and END." - (let* ((ts (buffer-substring beg end)) - t1 w1 with-hm tf time str w2 (off 0)) - (save-match-data - (setq t1 (org-parse-time-string ts t)) - (if (string-match "\\(-[0-9]+:[0-9]+\\)?\\( [.+]?\\+[0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)?\\'" ts) - (setq off (- (match-end 0) (match-beginning 0))))) - (setq end (- end off)) - (setq w1 (- end beg) - with-hm (and (nth 1 t1) (nth 2 t1)) - tf (funcall (if with-hm 'cdr 'car) org-time-stamp-custom-formats) - time (org-fix-decoded-time t1) - str (org-add-props - (format-time-string - (substring tf 1 -1) (apply 'encode-time time)) - nil 'mouse-face 'highlight) - w2 (length str)) - (if (not (= w2 w1)) - (add-text-properties (1+ beg) (+ 2 beg) - (list 'org-dwidth t 'org-dwidth-n (- w1 w2)))) - (if (featurep 'xemacs) - (progn - (put-text-property beg end 'invisible t) - (put-text-property beg end 'end-glyph (make-glyph str))) - (put-text-property beg end 'display str)))) - -(defun org-translate-time (string) - "Translate all timestamps in STRING to custom format. -But do this only if the variable `org-display-custom-times' is set." - (when org-display-custom-times - (save-match-data - (let* ((start 0) - (re org-ts-regexp-both) - t1 with-hm inactive tf time str beg end) - (while (setq start (string-match re string start)) - (setq beg (match-beginning 0) - end (match-end 0) - t1 (save-match-data - (org-parse-time-string (substring string beg end) t)) - with-hm (and (nth 1 t1) (nth 2 t1)) - inactive (equal (substring string beg (1+ beg)) "[") - tf (funcall (if with-hm 'cdr 'car) - org-time-stamp-custom-formats) - time (org-fix-decoded-time t1) - str (format-time-string - (concat - (if inactive "[" "<") (substring tf 1 -1) - (if inactive "]" ">")) - (apply 'encode-time time)) - string (replace-match str t t string) - start (+ start (length str))))))) - string) - -(defun org-fix-decoded-time (time) - "Set 0 instead of nil for the first 6 elements of time. -Don't touch the rest." - (let ((n 0)) - (mapcar (lambda (x) (if (< (setq n (1+ n)) 7) (or x 0) x)) time))) - -(define-obsolete-function-alias 'org-days-to-time 'org-time-stamp-to-now "24.4") - -(defun org-time-stamp-to-now (timestamp-string &optional seconds) - "Difference between TIMESTAMP-STRING and now in days. -If SECONDS is non-nil, return the difference in seconds." - (let ((fdiff (if seconds 'org-float-time 'time-to-days))) - (- (funcall fdiff (org-time-string-to-time timestamp-string)) - (funcall fdiff (current-time))))) - -(defun org-deadline-close (timestamp-string &optional ndays) - "Is the time in TIMESTAMP-STRING close to the current date?" - (setq ndays (or ndays (org-get-wdays timestamp-string))) - (and (< (org-time-stamp-to-now timestamp-string) ndays) - (not (org-entry-is-done-p)))) - -(defun org-get-wdays (ts &optional delay zero-delay) - "Get the deadline lead time appropriate for timestring TS. -When DELAY is non-nil, get the delay time for scheduled items -instead of the deadline lead time. When ZERO-DELAY is non-nil -and `org-scheduled-delay-days' is 0, enforce 0 as the delay, -don't try to find the delay cookie in the scheduled timestamp." - (let ((tv (if delay org-scheduled-delay-days - org-deadline-warning-days))) - (cond - ((or (and delay (< tv 0)) - (and delay zero-delay (<= tv 0)) - (and (not delay) (<= tv 0))) - ;; Enforce this value no matter what - (- tv)) - ((string-match "-\\([0-9]+\\)\\([hdwmy]\\)\\(\\'\\|>\\| \\)" ts) - ;; lead time is specified. - (floor (* (string-to-number (match-string 1 ts)) - (cdr (assoc (match-string 2 ts) - '(("d" . 1) ("w" . 7) - ("m" . 30.4) ("y" . 365.25) - ("h" . 0.041667))))))) - ;; go for the default. - (t tv)))) - -(defun org-calendar-select-mouse (ev) - "Return to `org-read-date' with the date currently selected. -This is used by `org-read-date' in a temporary keymap for the calendar buffer." - (interactive "e") - (mouse-set-point ev) - (when (calendar-cursor-to-date) - (let* ((date (calendar-cursor-to-date)) - (time (encode-time 0 0 0 (nth 1 date) (nth 0 date) (nth 2 date)))) - (setq org-ans1 (format-time-string "%Y-%m-%d" time))) - (if (active-minibuffer-window) (exit-minibuffer)))) - -(defun org-check-deadlines (ndays) - "Check if there are any deadlines due or past due. -A deadline is considered due if it happens within `org-deadline-warning-days' -days from today's date. If the deadline appears in an entry marked DONE, -it is not shown. The prefix arg NDAYS can be used to test that many -days. If the prefix is a raw \\[universal-argument] prefix, all deadlines are shown." - (interactive "P") - (let* ((org-warn-days - (cond - ((equal ndays '(4)) 100000) - (ndays (prefix-numeric-value ndays)) - (t (abs org-deadline-warning-days)))) - (case-fold-search nil) - (regexp (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) - (callback - (lambda () (org-deadline-close (match-string 1) org-warn-days)))) - - (message "%d deadlines past-due or due within %d days" - (org-occur regexp nil callback) - org-warn-days))) - -(defsubst org-re-timestamp (type) - "Return a regexp for timestamp TYPE. -Allowed values for TYPE are: - - all: all timestamps - active: only active timestamps (<...>) - inactive: only inactive timestamps ([...]) - scheduled: only scheduled timestamps - deadline: only deadline timestamps - closed: only closed time-stamps - -When TYPE is nil, fall back on returning a regexp that matches -both scheduled and deadline timestamps." - (cond ((eq type 'all) "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\(?: +[^]+0-9> \n -]+\\)?\\(?: +[0-9]\\{1,2\\}:[0-9]\\{2\\}\\)?\\)") - ((eq type 'active) org-ts-regexp) - ((eq type 'inactive) "\\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^ \n>]*?\\)\\]") - ((eq type 'scheduled) (concat "\\<" org-scheduled-string " *<\\([^>]+\\)>")) - ((eq type 'deadline) (concat "\\<" org-deadline-string " *<\\([^>]+\\)>")) - ((eq type 'closed) (concat org-closed-string " \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} ?[^ \n>]*?\\)\\]")) - ((eq type 'scheduled-or-deadline) - (concat "\\<\\(?:" org-deadline-string "\\|" org-scheduled-string "\\) *<\\([^>]+\\)>")))) - -(defun org-check-before-date (date) - "Check if there are deadlines or scheduled entries before DATE." - (interactive (list (org-read-date))) - (let ((case-fold-search nil) - (regexp (org-re-timestamp org-ts-type)) - (callback - (lambda () (time-less-p - (org-time-string-to-time (match-string 1)) - (org-time-string-to-time date))))) - (message "%d entries before %s" - (org-occur regexp nil callback) date))) - -(defun org-check-after-date (date) - "Check if there are deadlines or scheduled entries after DATE." - (interactive (list (org-read-date))) - (let ((case-fold-search nil) - (regexp (org-re-timestamp org-ts-type)) - (callback - (lambda () (not - (time-less-p - (org-time-string-to-time (match-string 1)) - (org-time-string-to-time date)))))) - (message "%d entries after %s" - (org-occur regexp nil callback) date))) - -(defun org-check-dates-range (start-date end-date) - "Check for deadlines/scheduled entries between START-DATE and END-DATE." - (interactive (list (org-read-date nil nil nil "Range starts") - (org-read-date nil nil nil "Range end"))) - (let ((case-fold-search nil) - (regexp (org-re-timestamp org-ts-type)) - (callback - (lambda () - (let ((match (match-string 1))) - (and - (not (time-less-p - (org-time-string-to-time match) - (org-time-string-to-time start-date))) - (time-less-p - (org-time-string-to-time match) - (org-time-string-to-time end-date))))))) - (message "%d entries between %s and %s" - (org-occur regexp nil callback) start-date end-date))) - -(defun org-evaluate-time-range (&optional to-buffer) - "Evaluate a time range by computing the difference between start and end. -Normally the result is just printed in the echo area, but with prefix arg -TO-BUFFER, the result is inserted just after the date stamp into the buffer. -If the time range is actually in a table, the result is inserted into the -next column. -For time difference computation, a year is assumed to be exactly 365 -days in order to avoid rounding problems." - (interactive "P") - (or - (org-clock-update-time-maybe) - (save-excursion - (unless (org-at-date-range-p t) - (goto-char (point-at-bol)) - (re-search-forward org-tr-regexp-both (point-at-eol) t)) - (if (not (org-at-date-range-p t)) - (user-error "Not at a time-stamp range, and none found in current line"))) - (let* ((ts1 (match-string 1)) - (ts2 (match-string 2)) - (havetime (or (> (length ts1) 15) (> (length ts2) 15))) - (match-end (match-end 0)) - (time1 (org-time-string-to-time ts1)) - (time2 (org-time-string-to-time ts2)) - (t1 (org-float-time time1)) - (t2 (org-float-time time2)) - (diff (abs (- t2 t1))) - (negative (< (- t2 t1) 0)) - ;; (ys (floor (* 365 24 60 60))) - (ds (* 24 60 60)) - (hs (* 60 60)) - (fy "%dy %dd %02d:%02d") - (fy1 "%dy %dd") - (fd "%dd %02d:%02d") - (fd1 "%dd") - (fh "%02d:%02d") - y d h m align) - (if havetime - (setq ; y (floor (/ diff ys)) diff (mod diff ys) - y 0 - d (floor (/ diff ds)) diff (mod diff ds) - h (floor (/ diff hs)) diff (mod diff hs) - m (floor (/ diff 60))) - (setq ; y (floor (/ diff ys)) diff (mod diff ys) - y 0 - d (floor (+ (/ diff ds) 0.5)) - h 0 m 0)) - (if (not to-buffer) - (message "%s" (org-make-tdiff-string y d h m)) - (if (org-at-table-p) - (progn - (goto-char match-end) - (setq align t) - (and (looking-at " *|") (goto-char (match-end 0)))) - (goto-char match-end)) - (if (looking-at - "\\( *-? *[0-9]+y\\)?\\( *[0-9]+d\\)? *[0-9][0-9]:[0-9][0-9]") - (replace-match "")) - (if negative (insert " -")) - (if (> y 0) (insert " " (format (if havetime fy fy1) y d h m)) - (if (> d 0) (insert " " (format (if havetime fd fd1) d h m)) - (insert " " (format fh h m)))) - (if align (org-table-align)) - (message "Time difference inserted"))))) - -(defun org-make-tdiff-string (y d h m) - (let ((fmt "") - (l nil)) - (if (> y 0) (setq fmt (concat fmt "%d year" (if (> y 1) "s" "") " ") - l (push y l))) - (if (> d 0) (setq fmt (concat fmt "%d day" (if (> d 1) "s" "") " ") - l (push d l))) - (if (> h 0) (setq fmt (concat fmt "%d hour" (if (> h 1) "s" "") " ") - l (push h l))) - (if (> m 0) (setq fmt (concat fmt "%d minute" (if (> m 1) "s" "") " ") - l (push m l))) - (apply 'format fmt (nreverse l)))) - -(defun org-time-string-to-time (s &optional buffer pos) - "Convert a timestamp string into internal time." - (condition-case errdata - (apply 'encode-time (org-parse-time-string s)) - (error (error "Bad timestamp `%s'%s\nError was: %s" - s (if (not (and buffer pos)) - "" - (format " at %d in buffer `%s'" pos buffer)) - (cdr errdata))))) - -(defun org-time-string-to-seconds (s) - "Convert a timestamp string to a number of seconds." - (org-float-time (org-time-string-to-time s))) - -(defun org-time-string-to-absolute (s &optional daynr prefer show-all buffer pos) - "Convert a time stamp to an absolute day number. -If there is a specifier for a cyclic time stamp, get the closest -date to DAYNR. -PREFER and SHOW-ALL are passed through to `org-closest-date'. -The variable `date' is bound by the calendar when this is called." - (cond - ((and daynr (string-match "\\`%%\\((.*)\\)" s)) - (if (org-diary-sexp-entry (match-string 1 s) "" date) - daynr - (+ daynr 1000))) - ((and daynr (string-match "\\+[0-9]+[hdwmy]" s)) - (org-closest-date s (if (and (boundp 'daynr) (integerp daynr)) daynr - (time-to-days (current-time))) (match-string 0 s) - prefer show-all)) - (t (time-to-days - (condition-case errdata - (apply 'encode-time (org-parse-time-string s)) - (error (error "Bad timestamp `%s'%s\nError was: %s" - s (if (not (and buffer pos)) - "" - (format " at %d in buffer `%s'" pos buffer)) - (cdr errdata)))))))) - -(defun org-days-to-iso-week (days) - "Return the iso week number." - (require 'cal-iso) - (car (calendar-iso-from-absolute days))) - -(defun org-small-year-to-year (year) - "Convert 2-digit years into 4-digit years. -38-99 are mapped into 1938-1999. 1-37 are mapped into 2001-2037. -The year 2000 cannot be abbreviated. Any year larger than 99 -is returned unchanged." - (if (< year 38) - (setq year (+ 2000 year)) - (if (< year 100) - (setq year (+ 1900 year)))) - year) - -(defun org-time-from-absolute (d) - "Return the time corresponding to date D. -D may be an absolute day number, or a calendar-type list (month day year)." - (if (numberp d) (setq d (calendar-gregorian-from-absolute d))) - (encode-time 0 0 0 (nth 1 d) (car d) (nth 2 d))) - -(defun org-calendar-holiday () - "List of holidays, for Diary display in Org-mode." - (require 'holidays) - (let ((hl (funcall - (if (fboundp 'calendar-check-holidays) - 'calendar-check-holidays 'check-calendar-holidays) date))) - (if hl (mapconcat 'identity hl "; ")))) - -(defun org-diary-sexp-entry (sexp entry date) - "Process a SEXP diary ENTRY for DATE." - (require 'diary-lib) - (let ((result (if calendar-debug-sexp - (let ((stack-trace-on-error t)) - (eval (car (read-from-string sexp)))) - (condition-case nil - (eval (car (read-from-string sexp))) - (error - (beep) - (message "Bad sexp at line %d in %s: %s" - (org-current-line) - (buffer-file-name) sexp) - (sleep-for 2)))))) - (cond ((stringp result) (split-string result "; ")) - ((and (consp result) - (not (consp (cdr result))) - (stringp (cdr result))) (cdr result)) - ((and (consp result) - (stringp (car result))) result) - (result entry)))) - -(defun org-diary-to-ical-string (frombuf) - "Get iCalendar entries from diary entries in buffer FROMBUF. -This uses the icalendar.el library." - (let* ((tmpdir (if (featurep 'xemacs) - (temp-directory) - temporary-file-directory)) - (tmpfile (make-temp-name - (expand-file-name "orgics" tmpdir))) - buf rtn b e) - (with-current-buffer frombuf - (icalendar-export-region (point-min) (point-max) tmpfile) - (setq buf (find-buffer-visiting tmpfile)) - (set-buffer buf) - (goto-char (point-min)) - (if (re-search-forward "^BEGIN:VEVENT" nil t) - (setq b (match-beginning 0))) - (goto-char (point-max)) - (if (re-search-backward "^END:VEVENT" nil t) - (setq e (match-end 0))) - (setq rtn (if (and b e) (concat (buffer-substring b e) "\n") ""))) - (kill-buffer buf) - (delete-file tmpfile) - rtn)) - -(defun org-closest-date (start current change prefer show-all) - "Find the date closest to CURRENT that is consistent with START and CHANGE. -When PREFER is `past', return a date that is either CURRENT or past. -When PREFER is `future', return a date that is either CURRENT or future. -When SHOW-ALL is nil, only return the current occurrence of a time stamp." - ;; Make the proper lists from the dates - (catch 'exit - (let ((a1 '(("h" . hour) - ("d" . day) - ("w" . week) - ("m" . month) - ("y" . year))) - (shour (nth 2 (org-parse-time-string start))) - dn dw sday cday n1 n2 n0 - d m y y1 y2 date1 date2 nmonths nm ny m2) - - (setq start (org-date-to-gregorian start) - current (org-date-to-gregorian - (if show-all - current - (time-to-days (current-time)))) - sday (calendar-absolute-from-gregorian start) - cday (calendar-absolute-from-gregorian current)) - - (if (<= cday sday) (throw 'exit sday)) - - (if (string-match "\\(\\+[0-9]+\\)\\([hdwmy]\\)" change) - (setq dn (string-to-number (match-string 1 change)) - dw (cdr (assoc (match-string 2 change) a1))) - (user-error "Invalid change specifier: %s" change)) - (if (eq dw 'week) (setq dw 'day dn (* 7 dn))) - (cond - ((eq dw 'hour) - (let ((missing-hours - (mod (+ (- (* 24 (- cday sday)) shour) org-extend-today-until) - dn))) - (setq n1 (if (zerop missing-hours) cday - (- cday (1+ (floor (/ missing-hours 24))))) - n2 (+ cday (floor (/ (- dn missing-hours) 24)))))) - ((eq dw 'day) - (setq n1 (+ sday (* dn (floor (/ (- cday sday) dn)))) - n2 (+ n1 dn))) - ((eq dw 'year) - (setq d (nth 1 start) m (car start) y1 (nth 2 start) y2 (nth 2 current)) - (setq y1 (+ (* (floor (/ (- y2 y1) dn)) dn) y1)) - (setq date1 (list m d y1) - n1 (calendar-absolute-from-gregorian date1) - date2 (list m d (+ y1 (* (if (< n1 cday) 1 -1) dn))) - n2 (calendar-absolute-from-gregorian date2))) - ((eq dw 'month) - ;; approx number of month between the two dates - (setq nmonths (floor (/ (- cday sday) 30.436875))) - ;; How often does dn fit in there? - (setq d (nth 1 start) m (car start) y (nth 2 start) - nm (* dn (max 0 (1- (floor (/ nmonths dn))))) - m (+ m nm) - ny (floor (/ m 12)) - y (+ y ny) - m (- m (* ny 12))) - (while (> m 12) (setq m (- m 12) y (1+ y))) - (setq n1 (calendar-absolute-from-gregorian (list m d y))) - (setq m2 (+ m dn) y2 y) - (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) - (setq n2 (calendar-absolute-from-gregorian (list m2 d y2))) - (while (<= n2 cday) - (setq n1 n2 m m2 y y2) - (setq m2 (+ m dn) y2 y) - (if (> m2 12) (setq y2 (1+ y2) m2 (- m2 12))) - (setq n2 (calendar-absolute-from-gregorian (list m2 d y2)))))) - ;; Make sure n1 is the earlier date - (setq n0 n1 n1 (min n1 n2) n2 (max n0 n2)) - (if show-all - (cond - ((eq prefer 'past) (if (= cday n2) n2 n1)) - ((eq prefer 'future) (if (= cday n1) n1 n2)) - (t (if (> (abs (- cday n1)) (abs (- cday n2))) n2 n1))) - (cond - ((eq prefer 'past) (if (= cday n2) n2 n1)) - ((eq prefer 'future) (if (= cday n1) n1 n2)) - (t (if (= cday n1) n1 n2))))))) - -(defun org-date-to-gregorian (date) - "Turn any specification of DATE into a Gregorian date for the calendar." - (cond ((integerp date) (calendar-gregorian-from-absolute date)) - ((and (listp date) (= (length date) 3)) date) - ((stringp date) - (setq date (org-parse-time-string date)) - (list (nth 4 date) (nth 3 date) (nth 5 date))) - ((listp date) - (list (nth 4 date) (nth 3 date) (nth 5 date))))) - -(defun org-parse-time-string (s &optional nodefault) - "Parse the standard Org-mode time string. -This should be a lot faster than the normal `parse-time-string'. -If time is not given, defaults to 0:00. However, with optional NODEFAULT, -hour and minute fields will be nil if not given." - (cond ((string-match org-ts-regexp0 s) - (list 0 - (if (or (match-beginning 8) (not nodefault)) - (string-to-number (or (match-string 8 s) "0"))) - (if (or (match-beginning 7) (not nodefault)) - (string-to-number (or (match-string 7 s) "0"))) - (string-to-number (match-string 4 s)) - (string-to-number (match-string 3 s)) - (string-to-number (match-string 2 s)) - nil nil nil)) - ((string-match "^<[^>]+>$" s) - (decode-time (seconds-to-time (org-matcher-time s)))) - (t (error "Not a standard Org-mode time string: %s" s)))) - -(defun org-timestamp-up (&optional arg) - "Increase the date item at the cursor by one. -If the cursor is on the year, change the year. If it is on the month, -the day or the time, change that. -With prefix ARG, change by that many units." - (interactive "p") - (org-timestamp-change (prefix-numeric-value arg) nil 'updown)) - -(defun org-timestamp-down (&optional arg) - "Decrease the date item at the cursor by one. -If the cursor is on the year, change the year. If it is on the month, -the day or the time, change that. -With prefix ARG, change by that many units." - (interactive "p") - (org-timestamp-change (- (prefix-numeric-value arg)) nil 'updown)) - -(defun org-timestamp-up-day (&optional arg) - "Increase the date in the time stamp by one day. -With prefix ARG, change that many days." - (interactive "p") - (if (and (not (org-at-timestamp-p t)) - (org-at-heading-p)) - (org-todo 'up) - (org-timestamp-change (prefix-numeric-value arg) 'day 'updown))) - -(defun org-timestamp-down-day (&optional arg) - "Decrease the date in the time stamp by one day. -With prefix ARG, change that many days." - (interactive "p") - (if (and (not (org-at-timestamp-p t)) - (org-at-heading-p)) - (org-todo 'down) - (org-timestamp-change (- (prefix-numeric-value arg)) 'day) 'updown)) - -(defun org-at-timestamp-p (&optional inactive-ok) - "Determine if the cursor is in or at a timestamp." - (interactive) - (let* ((tsr (if inactive-ok org-ts-regexp3 org-ts-regexp2)) - (pos (point)) - (ans (or (looking-at tsr) - (save-excursion - (skip-chars-backward "^[<\n\r\t") - (if (> (point) (point-min)) (backward-char 1)) - (and (looking-at tsr) - (> (- (match-end 0) pos) -1)))))) - (and ans - (boundp 'org-ts-what) - (setq org-ts-what - (cond - ((= pos (match-beginning 0)) 'bracket) - ;; Point is considered to be "on the bracket" whether - ;; it's really on it or right after it. - ((= pos (1- (match-end 0))) 'bracket) - ((= pos (match-end 0)) 'after) - ((org-pos-in-match-range pos 2) 'year) - ((org-pos-in-match-range pos 3) 'month) - ((org-pos-in-match-range pos 7) 'hour) - ((org-pos-in-match-range pos 8) 'minute) - ((or (org-pos-in-match-range pos 4) - (org-pos-in-match-range pos 5)) 'day) - ((and (> pos (or (match-end 8) (match-end 5))) - (< pos (match-end 0))) - (- pos (or (match-end 8) (match-end 5)))) - (t 'day)))) - ans)) - -(defun org-toggle-timestamp-type () - "Toggle the type (<active> or [inactive]) of a time stamp." - (interactive) - (when (org-at-timestamp-p t) - (let ((beg (match-beginning 0)) (end (match-end 0)) - (map '((?\[ . "<") (?\] . ">") (?< . "[") (?> . "]")))) - (save-excursion - (goto-char beg) - (while (re-search-forward "[][<>]" end t) - (replace-match (cdr (assoc (char-after (match-beginning 0)) map)) - t t))) - (message "Timestamp is now %sactive" - (if (equal (char-after beg) ?<) "" "in"))))) - -(defun org-at-clock-log-p nil - "Is the cursor on the clock log line?" - (save-excursion - (move-beginning-of-line 1) - (looking-at "^[ \t]*CLOCK:"))) - -(defvar org-clock-history) ; defined in org-clock.el -(defvar org-clock-adjust-closest nil) ; defined in org-clock.el -(defun org-timestamp-change (n &optional what updown suppress-tmp-delay) - "Change the date in the time stamp at point. -The date will be changed by N times WHAT. WHAT can be `day', `month', -`year', `minute', `second'. If WHAT is not given, the cursor position -in the timestamp determines what will be changed. -When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"." - (let ((origin (point)) origin-cat - with-hm inactive - (dm (max (nth 1 org-time-stamp-rounding-minutes) 1)) - org-ts-what - extra rem - ts time time0 fixnext clrgx) - (if (not (org-at-timestamp-p t)) - (user-error "Not at a timestamp")) - (if (and (not what) (eq org-ts-what 'bracket)) - (org-toggle-timestamp-type) - ;; Point isn't on brackets. Remember the part of the time-stamp - ;; the point was in. Indeed, size of time-stamps may change, - ;; but point must be kept in the same category nonetheless. - (setq origin-cat org-ts-what) - (if (and (not what) (not (eq org-ts-what 'day)) - org-display-custom-times - (get-text-property (point) 'display) - (not (get-text-property (1- (point)) 'display))) - (setq org-ts-what 'day)) - (setq org-ts-what (or what org-ts-what) - inactive (= (char-after (match-beginning 0)) ?\[) - ts (match-string 0)) - (replace-match "") - (when (string-match - "\\(\\(-[012][0-9]:[0-5][0-9]\\)?\\( +[.+]?-?[-+][0-9]+[hdwmy]\\(/[0-9]+[hdwmy]\\)?\\)*\\)[]>]" - ts) - (setq extra (match-string 1 ts)) - (if suppress-tmp-delay - (setq extra (replace-regexp-in-string " --[0-9]+[hdwmy]" "" extra)))) - (if (string-match "^.\\{10\\}.*?[0-9]+:[0-9][0-9]" ts) - (setq with-hm t)) - (setq time0 (org-parse-time-string ts)) - (when (and updown - (eq org-ts-what 'minute) - (not current-prefix-arg)) - ;; This looks like s-up and s-down. Change by one rounding step. - (setq n (* dm (cond ((> n 0) 1) ((< n 0) -1) (t 0)))) - (when (not (= 0 (setq rem (% (nth 1 time0) dm)))) - (setcar (cdr time0) (+ (nth 1 time0) - (if (> n 0) (- rem) (- dm rem)))))) - (setq time - (encode-time (or (car time0) 0) - (+ (if (eq org-ts-what 'minute) n 0) (nth 1 time0)) - (+ (if (eq org-ts-what 'hour) n 0) (nth 2 time0)) - (+ (if (eq org-ts-what 'day) n 0) (nth 3 time0)) - (+ (if (eq org-ts-what 'month) n 0) (nth 4 time0)) - (+ (if (eq org-ts-what 'year) n 0) (nth 5 time0)) - (nthcdr 6 time0))) - (when (and (member org-ts-what '(hour minute)) - extra - (string-match "-\\([012][0-9]\\):\\([0-5][0-9]\\)" extra)) - (setq extra (org-modify-ts-extra - extra - (if (eq org-ts-what 'hour) 2 5) - n dm))) - (when (integerp org-ts-what) - (setq extra (org-modify-ts-extra extra org-ts-what n dm))) - (if (eq what 'calendar) - (let ((cal-date (org-get-date-from-calendar))) - (setcar (nthcdr 4 time0) (nth 0 cal-date)) ; month - (setcar (nthcdr 3 time0) (nth 1 cal-date)) ; day - (setcar (nthcdr 5 time0) (nth 2 cal-date)) ; year - (setcar time0 (or (car time0) 0)) - (setcar (nthcdr 1 time0) (or (nth 1 time0) 0)) - (setcar (nthcdr 2 time0) (or (nth 2 time0) 0)) - (setq time (apply 'encode-time time0)))) - ;; Insert the new time-stamp, and ensure point stays in the same - ;; category as before (i.e. not after the last position in that - ;; category). - (let ((pos (point))) - ;; Stay before inserted string. `save-excursion' is of no use. - (setq org-last-changed-timestamp - (org-insert-time-stamp time with-hm inactive nil nil extra)) - (goto-char pos)) - (save-match-data - (looking-at org-ts-regexp3) - (goto-char (cond - ;; `day' category ends before `hour' if any, or at - ;; the end of the day name. - ((eq origin-cat 'day) - (min (or (match-beginning 7) (1- (match-end 5))) origin)) - ((eq origin-cat 'hour) (min (match-end 7) origin)) - ((eq origin-cat 'minute) (min (1- (match-end 8)) origin)) - ((integerp origin-cat) (min (1- (match-end 0)) origin)) - ;; `year' and `month' have both fixed size: point - ;; couldn't have moved into another part. - (t origin)))) - ;; Update clock if on a CLOCK line. - (org-clock-update-time-maybe) - ;; Maybe adjust the closest clock in `org-clock-history' - (when org-clock-adjust-closest - (if (not (and (org-at-clock-log-p) - (< 1 (length (delq nil (mapcar 'marker-position - org-clock-history)))))) - (message "No clock to adjust") - (cond ((save-excursion ; fix previous clock? - (re-search-backward org-ts-regexp0 nil t) - (org-looking-back (concat org-clock-string " \\["))) - (setq fixnext 1 clrgx (concat org-ts-regexp0 "\\] =>.*$"))) - ((save-excursion ; fix next clock? - (re-search-backward org-ts-regexp0 nil t) - (looking-at (concat org-ts-regexp0 "\\] =>"))) - (setq fixnext -1 clrgx (concat org-clock-string " \\[" org-ts-regexp0)))) - (save-window-excursion - ;; Find closest clock to point, adjust the previous/next one in history - (let* ((p (save-excursion (org-back-to-heading t))) - (cl (mapcar (lambda(c) (abs (- (marker-position c) p))) org-clock-history)) - (clfixnth - (+ fixnext (- (length cl) (or (length (member (apply #'min cl) cl)) 100)))) - (clfixpos (if (> 0 clfixnth) nil (nth clfixnth org-clock-history)))) - (if (not clfixpos) - (message "No clock to adjust") - (save-excursion - (org-goto-marker-or-bmk clfixpos) - (org-show-subtree) - (when (re-search-forward clrgx nil t) - (goto-char (match-beginning 1)) - (let (org-clock-adjust-closest) - (org-timestamp-change n org-ts-what updown)) - (message "Clock adjusted in %s for heading: %s" - (file-name-nondirectory (buffer-file-name)) - (org-get-heading t t))))))))) - ;; Try to recenter the calendar window, if any. - (if (and org-calendar-follow-timestamp-change - (get-buffer-window "*Calendar*" t) - (memq org-ts-what '(day month year))) - (org-recenter-calendar (time-to-days time)))))) - -(defun org-modify-ts-extra (s pos n dm) - "Change the different parts of the lead-time and repeat fields in timestamp." - (let ((idx '(("d" . 0) ("w" . 1) ("m" . 2) ("y" . 3) ("d" . -1) ("y" . 4))) - ng h m new rem) - (when (string-match "\\(-\\([012][0-9]\\):\\([0-5][0-9]\\)\\)?\\( +\\+\\([0-9]+\\)\\([dmwy]\\)\\)?\\( +-\\([0-9]+\\)\\([dmwy]\\)\\)?" s) - (cond - ((or (org-pos-in-match-range pos 2) - (org-pos-in-match-range pos 3)) - (setq m (string-to-number (match-string 3 s)) - h (string-to-number (match-string 2 s))) - (if (org-pos-in-match-range pos 2) - (setq h (+ h n)) - (setq n (* dm (org-no-warnings (signum n)))) - (when (not (= 0 (setq rem (% m dm)))) - (setq m (+ m (if (> n 0) (- rem) (- dm rem))))) - (setq m (+ m n))) - (if (< m 0) (setq m (+ m 60) h (1- h))) - (if (> m 59) (setq m (- m 60) h (1+ h))) - (setq h (min 24 (max 0 h))) - (setq ng 1 new (format "-%02d:%02d" h m))) - ((org-pos-in-match-range pos 6) - (setq ng 6 new (car (rassoc (+ n (cdr (assoc (match-string 6 s) idx))) idx)))) - ((org-pos-in-match-range pos 5) - (setq ng 5 new (format "%d" (max 1 (+ n (string-to-number (match-string 5 s))))))) - - ((org-pos-in-match-range pos 9) - (setq ng 9 new (car (rassoc (+ n (cdr (assoc (match-string 9 s) idx))) idx)))) - ((org-pos-in-match-range pos 8) - (setq ng 8 new (format "%d" (max 0 (+ n (string-to-number (match-string 8 s)))))))) - - (when ng - (setq s (concat - (substring s 0 (match-beginning ng)) - new - (substring s (match-end ng)))))) - s)) - -(defun org-recenter-calendar (date) - "If the calendar is visible, recenter it to DATE." - (let ((cwin (get-buffer-window "*Calendar*" t))) - (when cwin - (let ((calendar-move-hook nil)) - (with-selected-window cwin - (calendar-goto-date (if (listp date) date - (calendar-gregorian-from-absolute date)))))))) - -(defun org-goto-calendar (&optional arg) - "Go to the Emacs calendar at the current date. -If there is a time stamp in the current line, go to that date. -A prefix ARG can be used to force the current date." - (interactive "P") - (let ((tsr org-ts-regexp) diff - (calendar-move-hook nil) - (calendar-view-holidays-initially-flag nil) - (calendar-view-diary-initially-flag nil)) - (if (or (org-at-timestamp-p) - (save-excursion - (beginning-of-line 1) - (looking-at (concat ".*" tsr)))) - (let ((d1 (time-to-days (current-time))) - (d2 (time-to-days - (org-time-string-to-time (match-string 1))))) - (setq diff (- d2 d1)))) - (calendar) - (calendar-goto-today) - (if (and diff (not arg)) (calendar-forward-day diff)))) - -(defun org-get-date-from-calendar () - "Return a list (month day year) of date at point in calendar." - (with-current-buffer "*Calendar*" - (save-match-data - (calendar-cursor-to-date)))) - -(defun org-date-from-calendar () - "Insert time stamp corresponding to cursor date in *Calendar* buffer. -If there is already a time stamp at the cursor position, update it." - (interactive) - (if (org-at-timestamp-p t) - (org-timestamp-change 0 'calendar) - (let ((cal-date (org-get-date-from-calendar))) - (org-insert-time-stamp - (encode-time 0 0 0 (nth 1 cal-date) (car cal-date) (nth 2 cal-date)))))) - -(defcustom org-effort-durations - `(("h" . 60) - ("d" . ,(* 60 8)) - ("w" . ,(* 60 8 5)) - ("m" . ,(* 60 8 5 4)) - ("y" . ,(* 60 8 5 40))) - "Conversion factor to minutes for an effort modifier. - -Each entry has the form (MODIFIER . MINUTES). - -In an effort string, a number followed by MODIFIER is multiplied -by the specified number of MINUTES to obtain an effort in -minutes. - -For example, if the value of this variable is ((\"hours\" . 60)), then an -effort string \"2hours\" is equivalent to 120 minutes." - :group 'org-agenda - :version "24.1" - :type '(alist :key-type (string :tag "Modifier") - :value-type (number :tag "Minutes"))) - -(defun org-minutes-to-clocksum-string (m) - "Format number of minutes as a clocksum string. -The format is determined by `org-time-clocksum-format', -`org-time-clocksum-use-fractional' and -`org-time-clocksum-fractional-format' and -`org-time-clocksum-use-effort-durations'." - (let ((clocksum "") - (m (round m)) ; Don't allow fractions of minutes - h d w mo y fmt n) - (setq h (if org-time-clocksum-use-effort-durations - (cdr (assoc "h" org-effort-durations)) 60) - d (if org-time-clocksum-use-effort-durations - (/ (cdr (assoc "d" org-effort-durations)) h) 24) - w (if org-time-clocksum-use-effort-durations - (/ (cdr (assoc "w" org-effort-durations)) (* d h)) 7) - mo (if org-time-clocksum-use-effort-durations - (/ (cdr (assoc "m" org-effort-durations)) (* d h)) 30) - y (if org-time-clocksum-use-effort-durations - (/ (cdr (assoc "y" org-effort-durations)) (* d h)) 365)) - ;; fractional format - (if org-time-clocksum-use-fractional - (cond - ;; single format string - ((stringp org-time-clocksum-fractional-format) - (format org-time-clocksum-fractional-format (/ m (float h)))) - ;; choice of fractional formats for different time units - ((and (setq fmt (plist-get org-time-clocksum-fractional-format :years)) - (> (/ (truncate m) (* y d h)) 0)) - (format fmt (/ m (* y d (float h))))) - ((and (setq fmt (plist-get org-time-clocksum-fractional-format :months)) - (> (/ (truncate m) (* mo d h)) 0)) - (format fmt (/ m (* mo d (float h))))) - ((and (setq fmt (plist-get org-time-clocksum-fractional-format :weeks)) - (> (/ (truncate m) (* w d h)) 0)) - (format fmt (/ m (* w d (float h))))) - ((and (setq fmt (plist-get org-time-clocksum-fractional-format :days)) - (> (/ (truncate m) (* d h)) 0)) - (format fmt (/ m (* d (float h))))) - ((and (setq fmt (plist-get org-time-clocksum-fractional-format :hours)) - (> (/ (truncate m) h) 0)) - (format fmt (/ m (float h)))) - ((setq fmt (plist-get org-time-clocksum-fractional-format :minutes)) - (format fmt m)) - ;; fall back to smallest time unit with a format - ((setq fmt (plist-get org-time-clocksum-fractional-format :hours)) - (format fmt (/ m (float h)))) - ((setq fmt (plist-get org-time-clocksum-fractional-format :days)) - (format fmt (/ m (* d (float h))))) - ((setq fmt (plist-get org-time-clocksum-fractional-format :weeks)) - (format fmt (/ m (* w d (float h))))) - ((setq fmt (plist-get org-time-clocksum-fractional-format :months)) - (format fmt (/ m (* mo d (float h))))) - ((setq fmt (plist-get org-time-clocksum-fractional-format :years)) - (format fmt (/ m (* y d (float h)))))) - ;; standard (non-fractional) format, with single format string - (if (stringp org-time-clocksum-format) - (format org-time-clocksum-format (setq n (/ m h)) (- m (* h n))) - ;; separate formats components - (and (setq fmt (plist-get org-time-clocksum-format :years)) - (or (> (setq n (/ (truncate m) (* y d h))) 0) - (plist-get org-time-clocksum-format :require-years)) - (setq clocksum (concat clocksum (format fmt n)) - m (- m (* n y d h)))) - (and (setq fmt (plist-get org-time-clocksum-format :months)) - (or (> (setq n (/ (truncate m) (* mo d h))) 0) - (plist-get org-time-clocksum-format :require-months)) - (setq clocksum (concat clocksum (format fmt n)) - m (- m (* n mo d h)))) - (and (setq fmt (plist-get org-time-clocksum-format :weeks)) - (or (> (setq n (/ (truncate m) (* w d h))) 0) - (plist-get org-time-clocksum-format :require-weeks)) - (setq clocksum (concat clocksum (format fmt n)) - m (- m (* n w d h)))) - (and (setq fmt (plist-get org-time-clocksum-format :days)) - (or (> (setq n (/ (truncate m) (* d h))) 0) - (plist-get org-time-clocksum-format :require-days)) - (setq clocksum (concat clocksum (format fmt n)) - m (- m (* n d h)))) - (and (setq fmt (plist-get org-time-clocksum-format :hours)) - (or (> (setq n (/ (truncate m) h)) 0) - (plist-get org-time-clocksum-format :require-hours)) - (setq clocksum (concat clocksum (format fmt n)) - m (- m (* n h)))) - (and (setq fmt (plist-get org-time-clocksum-format :minutes)) - (or (> m 0) (plist-get org-time-clocksum-format :require-minutes)) - (setq clocksum (concat clocksum (format fmt m)))) - ;; return formatted time duration - clocksum)))) - -(defalias 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string) -(make-obsolete 'org-minutes-to-hh:mm-string 'org-minutes-to-clocksum-string - "Org mode version 8.0") - -(defun org-hours-to-clocksum-string (n) - (org-minutes-to-clocksum-string (* n 60))) - -(defun org-hh:mm-string-to-minutes (s) - "Convert a string H:MM to a number of minutes. -If the string is just a number, interpret it as minutes. -In fact, the first hh:mm or number in the string will be taken, -there can be extra stuff in the string. -If no number is found, the return value is 0." - (cond - ((integerp s) s) - ((string-match "\\([0-9]+\\):\\([0-9]+\\)" s) - (+ (* (string-to-number (match-string 1 s)) 60) - (string-to-number (match-string 2 s)))) - ((string-match "\\([0-9]+\\)" s) - (string-to-number (match-string 1 s))) - (t 0))) - -(defcustom org-image-actual-width t - "Should we use the actual width of images when inlining them? - -When set to `t', always use the image width. - -When set to a number, use imagemagick (when available) to set -the image's width to this value. - -When set to a number in a list, try to get the width from any -#+ATTR.* keyword if it matches a width specification like - - #+ATTR_HTML: :width 300px - -and fall back on that number if none is found. - -When set to nil, try to get the width from an #+ATTR.* keyword -and fall back on the original width if none is found. - -This requires Emacs >= 24.1, build with imagemagick support." - :group 'org-appearance - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (const :tag "Use the image width" t) - (integer :tag "Use a number of pixels") - (list :tag "Use #+ATTR* or a number of pixels" (integer)) - (const :tag "Use #+ATTR* or don't resize" nil))) - -(defcustom org-agenda-inhibit-startup nil - "Inhibit startup when preparing agenda buffers. -When this variable is `t' (the default), the initialization of -the Org agenda buffers is inhibited: e.g. the visibility state -is not set, the tables are not re-aligned, etc." - :type 'boolean - :version "24.3" - :group 'org-agenda) - -(defcustom org-agenda-ignore-drawer-properties nil - "Avoid updating text properties when building the agenda. -Properties are used to prepare buffers for effort estimates, appointments, -and subtree-local categories. -If you don't use these in the agenda, you can add them to this list and -agenda building will be a bit faster. -The value is a list, with zero or more of the symbols `effort', `appt', -or `category'." - :type '(set :greedy t - (const effort) - (const appt) - (const category)) - :version "24.3" - :group 'org-agenda) - -(defun org-duration-string-to-minutes (s &optional output-to-string) - "Convert a duration string S to minutes. - -A bare number is interpreted as minutes, modifiers can be set by -customizing `org-effort-durations' (which see). - -Entries containing a colon are interpreted as H:MM by -`org-hh:mm-string-to-minutes'." - (let ((result 0) - (re (concat "\\([0-9.]+\\) *\\(" - (regexp-opt (mapcar 'car org-effort-durations)) - "\\)"))) - (while (string-match re s) - (incf result (* (cdr (assoc (match-string 2 s) org-effort-durations)) - (string-to-number (match-string 1 s)))) - (setq s (replace-match "" nil t s))) - (setq result (floor result)) - (incf result (org-hh:mm-string-to-minutes s)) - (if output-to-string (number-to-string result) result))) - -;;;; Files - -(defun org-save-all-org-buffers () - "Save all Org-mode buffers without user confirmation." - (interactive) - (message "Saving all Org-mode buffers...") - (save-some-buffers t (lambda () (derived-mode-p 'org-mode))) - (when (featurep 'org-id) (org-id-locations-save)) - (message "Saving all Org-mode buffers... done")) - -(defun org-revert-all-org-buffers () - "Revert all Org-mode buffers. -Prompt for confirmation when there are unsaved changes. -Be sure you know what you are doing before letting this function -overwrite your changes. - -This function is useful in a setup where one tracks org files -with a version control system, to revert on one machine after pulling -changes from another. I believe the procedure must be like this: - -1. M-x org-save-all-org-buffers -2. Pull changes from the other machine, resolve conflicts -3. M-x org-revert-all-org-buffers" - (interactive) - (unless (yes-or-no-p "Revert all Org buffers from their files? ") - (user-error "Abort")) - (save-excursion - (save-window-excursion - (mapc - (lambda (b) - (when (and (with-current-buffer b (derived-mode-p 'org-mode)) - (with-current-buffer b buffer-file-name)) - (org-pop-to-buffer-same-window b) - (revert-buffer t 'no-confirm))) - (buffer-list)) - (when (and (featurep 'org-id) org-id-track-globally) - (org-id-locations-load))))) - -;;;; Agenda files - -;;;###autoload -(defun org-switchb (&optional arg) - "Switch between Org buffers. -With one prefix argument, restrict available buffers to files. -With two prefix arguments, restrict available buffers to agenda files. - -Defaults to `iswitchb' for buffer name completion. -Set `org-completion-use-ido' to make it use ido instead." - (interactive "P") - (let ((blist (cond ((equal arg '(4)) (org-buffer-list 'files)) - ((equal arg '(16)) (org-buffer-list 'agenda)) - (t (org-buffer-list)))) - (org-completion-use-iswitchb org-completion-use-iswitchb) - (org-completion-use-ido org-completion-use-ido)) - (unless (or org-completion-use-ido org-completion-use-iswitchb) - (setq org-completion-use-iswitchb t)) - (org-pop-to-buffer-same-window - (org-icompleting-read "Org buffer: " - (mapcar 'list (mapcar 'buffer-name blist)) - nil t)))) - -;;; Define some older names previously used for this functionality -;;;###autoload -(defalias 'org-ido-switchb 'org-switchb) -;;;###autoload -(defalias 'org-iswitchb 'org-switchb) - -(defun org-buffer-list (&optional predicate exclude-tmp) - "Return a list of Org buffers. -PREDICATE can be `export', `files' or `agenda'. - -export restrict the list to Export buffers. -files restrict the list to buffers visiting Org files. -agenda restrict the list to buffers visiting agenda files. - -If EXCLUDE-TMP is non-nil, ignore temporary buffers." - (let* ((bfn nil) - (agenda-files (and (eq predicate 'agenda) - (mapcar 'file-truename (org-agenda-files t)))) - (filter - (cond - ((eq predicate 'files) - (lambda (b) (with-current-buffer b (derived-mode-p 'org-mode)))) - ((eq predicate 'export) - (lambda (b) (string-match "\*Org .*Export" (buffer-name b)))) - ((eq predicate 'agenda) - (lambda (b) - (with-current-buffer b - (and (derived-mode-p 'org-mode) - (setq bfn (buffer-file-name b)) - (member (file-truename bfn) agenda-files))))) - (t (lambda (b) (with-current-buffer b - (or (derived-mode-p 'org-mode) - (string-match "\*Org .*Export" - (buffer-name b))))))))) - (delq nil - (mapcar - (lambda(b) - (if (and (funcall filter b) - (or (not exclude-tmp) - (not (string-match "tmp" (buffer-name b))))) - b - nil)) - (buffer-list))))) - -(defun org-agenda-files (&optional unrestricted archives) - "Get the list of agenda files. -Optional UNRESTRICTED means return the full list even if a restriction -is currently in place. -When ARCHIVES is t, include all archive files that are really being -used by the agenda files. If ARCHIVE is `ifmode', do this only if -`org-agenda-archives-mode' is t." - (let ((files - (cond - ((and (not unrestricted) (get 'org-agenda-files 'org-restrict))) - ((stringp org-agenda-files) (org-read-agenda-file-list)) - ((listp org-agenda-files) org-agenda-files) - (t (error "Invalid value of `org-agenda-files'"))))) - (setq files (apply 'append - (mapcar (lambda (f) - (if (file-directory-p f) - (directory-files - f t org-agenda-file-regexp) - (list f))) - files))) - (when org-agenda-skip-unavailable-files - (setq files (delq nil - (mapcar (function - (lambda (file) - (and (file-readable-p file) file))) - files)))) - (when (or (eq archives t) - (and (eq archives 'ifmode) (eq org-agenda-archives-mode t))) - (setq files (org-add-archive-files files))) - files)) - -(defun org-agenda-file-p (&optional file) - "Return non-nil, if FILE is an agenda file. -If FILE is omitted, use the file associated with the current -buffer." - (member (or file (buffer-file-name)) - (org-agenda-files t))) - -(defun org-edit-agenda-file-list () - "Edit the list of agenda files. -Depending on setup, this either uses customize to edit the variable -`org-agenda-files', or it visits the file that is holding the list. In the -latter case, the buffer is set up in a way that saving it automatically kills -the buffer and restores the previous window configuration." - (interactive) - (if (stringp org-agenda-files) - (let ((cw (current-window-configuration))) - (find-file org-agenda-files) - (org-set-local 'org-window-configuration cw) - (org-add-hook 'after-save-hook - (lambda () - (set-window-configuration - (prog1 org-window-configuration - (kill-buffer (current-buffer)))) - (org-install-agenda-files-menu) - (message "New agenda file list installed")) - nil 'local) - (message "%s" (substitute-command-keys - "Edit list and finish with \\[save-buffer]"))) - (customize-variable 'org-agenda-files))) - -(defun org-store-new-agenda-file-list (list) - "Set new value for the agenda file list and save it correctly." - (if (stringp org-agenda-files) - (let ((fe (org-read-agenda-file-list t)) b u) - (while (setq b (find-buffer-visiting org-agenda-files)) - (kill-buffer b)) - (with-temp-file org-agenda-files - (insert - (mapconcat - (lambda (f) ;; Keep un-expanded entries. - (if (setq u (assoc f fe)) - (cdr u) - f)) - list "\n") - "\n"))) - (let ((org-mode-hook nil) (org-inhibit-startup t) - (org-insert-mode-line-in-empty-file nil)) - (setq org-agenda-files list) - (customize-save-variable 'org-agenda-files org-agenda-files)))) - -(defun org-read-agenda-file-list (&optional pair-with-expansion) - "Read the list of agenda files from a file. -If PAIR-WITH-EXPANSION is t return pairs with un-expanded -filenames, used by `org-store-new-agenda-file-list' to write back -un-expanded file names." - (when (file-directory-p org-agenda-files) - (error "`org-agenda-files' cannot be a single directory")) - (when (stringp org-agenda-files) - (with-temp-buffer - (insert-file-contents org-agenda-files) - (mapcar - (lambda (f) - (let ((e (expand-file-name (substitute-in-file-name f) - org-directory))) - (if pair-with-expansion - (cons e f) - e))) - (org-split-string (buffer-string) "[ \t\r\n]*?[\r\n][ \t\r\n]*"))))) - -;;;###autoload -(defun org-cycle-agenda-files () - "Cycle through the files in `org-agenda-files'. -If the current buffer visits an agenda file, find the next one in the list. -If the current buffer does not, find the first agenda file." - (interactive) - (let* ((fs (org-agenda-files t)) - (files (append fs (list (car fs)))) - (tcf (if buffer-file-name (file-truename buffer-file-name))) - file) - (unless files (user-error "No agenda files")) - (catch 'exit - (while (setq file (pop files)) - (if (equal (file-truename file) tcf) - (when (car files) - (find-file (car files)) - (throw 'exit t)))) - (find-file (car fs))) - (if (buffer-base-buffer) (org-pop-to-buffer-same-window (buffer-base-buffer))))) - -(defun org-agenda-file-to-front (&optional to-end) - "Move/add the current file to the top of the agenda file list. -If the file is not present in the list, it is added to the front. If it is -present, it is moved there. With optional argument TO-END, add/move to the -end of the list." - (interactive "P") - (let ((org-agenda-skip-unavailable-files nil) - (file-alist (mapcar (lambda (x) - (cons (file-truename x) x)) - (org-agenda-files t))) - (ctf (file-truename - (or buffer-file-name - (user-error "Please save the current buffer to a file")))) - x had) - (setq x (assoc ctf file-alist) had x) - - (if (not x) (setq x (cons ctf (abbreviate-file-name buffer-file-name)))) - (if to-end - (setq file-alist (append (delq x file-alist) (list x))) - (setq file-alist (cons x (delq x file-alist)))) - (org-store-new-agenda-file-list (mapcar 'cdr file-alist)) - (org-install-agenda-files-menu) - (message "File %s to %s of agenda file list" - (if had "moved" "added") (if to-end "end" "front")))) - -(defun org-remove-file (&optional file) - "Remove current file from the list of files in variable `org-agenda-files'. -These are the files which are being checked for agenda entries. -Optional argument FILE means use this file instead of the current." - (interactive) - (let* ((org-agenda-skip-unavailable-files nil) - (file (or file buffer-file-name - (user-error "Current buffer does not visit a file"))) - (true-file (file-truename file)) - (afile (abbreviate-file-name file)) - (files (delq nil (mapcar - (lambda (x) - (if (equal true-file - (file-truename x)) - nil x)) - (org-agenda-files t))))) - (if (not (= (length files) (length (org-agenda-files t)))) - (progn - (org-store-new-agenda-file-list files) - (org-install-agenda-files-menu) - (message "Removed file: %s" afile)) - (message "File was not in list: %s (not removed)" afile)))) - -(defun org-file-menu-entry (file) - (vector file (list 'find-file file) t)) - -(defun org-check-agenda-file (file) - "Make sure FILE exists. If not, ask user what to do." - (when (not (file-exists-p file)) - (message "Non-existent agenda file %s. [R]emove from list or [A]bort?" - (abbreviate-file-name file)) - (let ((r (downcase (read-char-exclusive)))) - (cond - ((equal r ?r) - (org-remove-file file) - (throw 'nextfile t)) - (t (error "Abort")))))) - -(defun org-get-agenda-file-buffer (file) - "Get a buffer visiting FILE. If the buffer needs to be created, add -it to the list of buffers which might be released later." - (let ((buf (org-find-base-buffer-visiting file))) - (if buf - buf ; just return it - ;; Make a new buffer and remember it - (setq buf (find-file-noselect file)) - (if buf (push buf org-agenda-new-buffers)) - buf))) - -(defun org-release-buffers (blist) - "Release all buffers in list, asking the user for confirmation when needed. -When a buffer is unmodified, it is just killed. When modified, it is saved -\(if the user agrees) and then killed." - (let (buf file) - (while (setq buf (pop blist)) - (setq file (buffer-file-name buf)) - (when (and (buffer-modified-p buf) - file - (y-or-n-p (format "Save file %s? " file))) - (with-current-buffer buf (save-buffer))) - (kill-buffer buf)))) - -(defun org-agenda-prepare-buffers (files) - "Create buffers for all agenda files, protect archived trees and comments." - (interactive) - (let ((pa '(:org-archived t)) - (pc '(:org-comment t)) - (pall '(:org-archived t :org-comment t)) - (inhibit-read-only t) - (org-inhibit-startup org-agenda-inhibit-startup) - (rea (concat ":" org-archive-tag ":")) - file re pos) - (setq org-tag-alist-for-agenda nil - org-tag-groups-alist-for-agenda nil) - (save-window-excursion - (save-restriction - (while (setq file (pop files)) - (catch 'nextfile - (if (bufferp file) - (set-buffer file) - (org-check-agenda-file file) - (set-buffer (org-get-agenda-file-buffer file))) - (widen) - (org-set-regexps-and-options-for-tags) - (setq pos (point)) - (goto-char (point-min)) - (let ((case-fold-search t)) - (when (search-forward "#+setupfile" nil t) - ;; Don't set all regexps and options systematically as - ;; this is only run for setting agenda tags from setup - ;; file - (org-set-regexps-and-options))) - (or (memq 'category org-agenda-ignore-drawer-properties) - (org-refresh-category-properties)) - (or (memq 'effort org-agenda-ignore-drawer-properties) - (org-refresh-properties org-effort-property 'org-effort)) - (or (memq 'appt org-agenda-ignore-drawer-properties) - (org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime)) - (setq org-todo-keywords-for-agenda - (append org-todo-keywords-for-agenda org-todo-keywords-1)) - (setq org-done-keywords-for-agenda - (append org-done-keywords-for-agenda org-done-keywords)) - (setq org-todo-keyword-alist-for-agenda - (append org-todo-keyword-alist-for-agenda org-todo-key-alist)) - (setq org-drawers-for-agenda - (append org-drawers-for-agenda org-drawers)) - (setq org-tag-alist-for-agenda - (org-uniquify - (append org-tag-alist-for-agenda - org-tag-alist - org-tag-persistent-alist))) - (if org-group-tags - (setq org-tag-groups-alist-for-agenda - (org-uniquify-alist - (append org-tag-groups-alist-for-agenda org-tag-groups-alist)))) - (org-with-silent-modifications - (save-excursion - (remove-text-properties (point-min) (point-max) pall) - (when org-agenda-skip-archived-trees - (goto-char (point-min)) - (while (re-search-forward rea nil t) - (if (org-at-heading-p t) - (add-text-properties (point-at-bol) (org-end-of-subtree t) pa)))) - (goto-char (point-min)) - (setq re (format org-heading-keyword-regexp-format - org-comment-string)) - (while (re-search-forward re nil t) - (add-text-properties - (match-beginning 0) (org-end-of-subtree t) pc)))) - (goto-char pos))))) - (setq org-todo-keywords-for-agenda - (org-uniquify org-todo-keywords-for-agenda)) - (setq org-todo-keyword-alist-for-agenda - (org-uniquify org-todo-keyword-alist-for-agenda)))) - - -;;;; CDLaTeX minor mode - -(defvar org-cdlatex-mode-map (make-sparse-keymap) - "Keymap for the minor `org-cdlatex-mode'.") - -(org-defkey org-cdlatex-mode-map "_" 'org-cdlatex-underscore-caret) -(org-defkey org-cdlatex-mode-map "^" 'org-cdlatex-underscore-caret) -(org-defkey org-cdlatex-mode-map "`" 'cdlatex-math-symbol) -(org-defkey org-cdlatex-mode-map "'" 'org-cdlatex-math-modify) -(org-defkey org-cdlatex-mode-map "\C-c{" 'cdlatex-environment) - -(defvar org-cdlatex-texmathp-advice-is-done nil - "Flag remembering if we have applied the advice to texmathp already.") - -(define-minor-mode org-cdlatex-mode - "Toggle the minor `org-cdlatex-mode'. -This mode supports entering LaTeX environment and math in LaTeX fragments -in Org-mode. -\\{org-cdlatex-mode-map}" - nil " OCDL" nil - (when org-cdlatex-mode - (require 'cdlatex) - (run-hooks 'cdlatex-mode-hook) - (cdlatex-compute-tables)) - (unless org-cdlatex-texmathp-advice-is-done - (setq org-cdlatex-texmathp-advice-is-done t) - (defadvice texmathp (around org-math-always-on activate) - "Always return t in org-mode buffers. -This is because we want to insert math symbols without dollars even outside -the LaTeX math segments. If Orgmode thinks that point is actually inside -an embedded LaTeX fragment, let texmathp do its job. -\\[org-cdlatex-mode-map]" - (interactive) - (let (p) - (cond - ((not (derived-mode-p 'org-mode)) ad-do-it) - ((eq this-command 'cdlatex-math-symbol) - (setq ad-return-value t - texmathp-why '("cdlatex-math-symbol in org-mode" . 0))) - (t - (let ((p (org-inside-LaTeX-fragment-p))) - (if (and p (member (car p) (plist-get org-format-latex-options :matchers))) - (setq ad-return-value t - texmathp-why '("Org-mode embedded math" . 0)) - (if p ad-do-it))))))))) - -(defun turn-on-org-cdlatex () - "Unconditionally turn on `org-cdlatex-mode'." - (org-cdlatex-mode 1)) - -(defun org-try-cdlatex-tab () - "Check if it makes sense to execute `cdlatex-tab', and do it if yes. -It makes sense to do so if `org-cdlatex-mode' is active and if the cursor is - - inside a LaTeX fragment, or - - after the first word in a line, where an abbreviation expansion could - insert a LaTeX environment." - (when org-cdlatex-mode - (cond - ;; Before any word on the line: No expansion possible. - ((save-excursion (skip-chars-backward " \t") (bolp)) nil) - ;; Just after first word on the line: Expand it. Make sure it - ;; cannot happen on headlines, though. - ((save-excursion - (skip-chars-backward "a-zA-Z0-9*") - (skip-chars-backward " \t") - (and (bolp) (not (org-at-heading-p)))) - (cdlatex-tab) t) - ((org-inside-LaTeX-fragment-p) (cdlatex-tab) t)))) - -(defun org-cdlatex-underscore-caret (&optional arg) - "Execute `cdlatex-sub-superscript' in LaTeX fragments. -Revert to the normal definition outside of these fragments." - (interactive "P") - (if (org-inside-LaTeX-fragment-p) - (call-interactively 'cdlatex-sub-superscript) - (let (org-cdlatex-mode) - (call-interactively (key-binding (vector last-input-event)))))) - -(defun org-cdlatex-math-modify (&optional arg) - "Execute `cdlatex-math-modify' in LaTeX fragments. -Revert to the normal definition outside of these fragments." - (interactive "P") - (if (org-inside-LaTeX-fragment-p) - (call-interactively 'cdlatex-math-modify) - (let (org-cdlatex-mode) - (call-interactively (key-binding (vector last-input-event)))))) - - - -;;;; LaTeX fragments - -(defvar org-latex-regexps - '(("begin" "^[ \t]*\\(\\\\begin{\\([a-zA-Z0-9\\*]+\\)[^\000]+?\\\\end{\\2}\\)" 1 t) - ;; ("$" "\\([ (]\\|^\\)\\(\\(\\([$]\\)\\([^ \r\n,.$].*?\\(\n.*?\\)\\{0,5\\}[^ \r\n,.$]\\)\\4\\)\\)\\([ .,?;:'\")]\\|$\\)" 2 nil) - ;; \000 in the following regex is needed for org-inside-LaTeX-fragment-p - ("$1" "\\([^$]\\|^\\)\\(\\$[^ \r\n,;.$]\\$\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) - ("$" "\\([^$]\\|^\\)\\(\\(\\$\\([^ \r\n,;.$][^$\n\r]*?\\(\n[^$\n\r]*?\\)\\{0,2\\}[^ \r\n,.$]\\)\\$\\)\\)\\([- .,?;:'\")\000]\\|$\\)" 2 nil) - ("\\(" "\\\\([^\000]*?\\\\)" 0 nil) - ("\\[" "\\\\\\[[^\000]*?\\\\\\]" 0 nil) - ("$$" "\\$\\$[^\000]*?\\$\\$" 0 nil)) - "Regular expressions for matching embedded LaTeX.") - -(defun org-inside-LaTeX-fragment-p () - "Test if point is inside a LaTeX fragment. -I.e. after a \\begin, \\(, \\[, $, or $$, without the corresponding closing -sequence appearing also before point. -Even though the matchers for math are configurable, this function assumes -that \\begin, \\(, \\[, and $$ are always used. Only the single dollar -delimiters are skipped when they have been removed by customization. -The return value is nil, or a cons cell with the delimiter and the -position of this delimiter. - -This function does a reasonably good job, but can locally be fooled by -for example currency specifications. For example it will assume being in -inline math after \"$22.34\". The LaTeX fragment formatter will only format -fragments that are properly closed, but during editing, we have to live -with the uncertainty caused by missing closing delimiters. This function -looks only before point, not after." - (catch 'exit - (let ((pos (point)) - (dodollar (member "$" (plist-get org-format-latex-options :matchers))) - (lim (progn - (re-search-backward (concat "^\\(" paragraph-start "\\)") nil t) - (point))) - dd-on str (start 0) m re) - (goto-char pos) - (when dodollar - (setq str (concat (buffer-substring lim (point)) "\000 X$.") - re (nth 1 (assoc "$" org-latex-regexps))) - (while (string-match re str start) - (cond - ((= (match-end 0) (length str)) - (throw 'exit (cons "$" (+ lim (match-beginning 0) 1)))) - ((= (match-end 0) (- (length str) 5)) - (throw 'exit nil)) - (t (setq start (match-end 0)))))) - (when (setq m (re-search-backward "\\(\\\\begin{[^}]*}\\|\\\\(\\|\\\\\\[\\)\\|\\(\\\\end{[^}]*}\\|\\\\)\\|\\\\\\]\\)\\|\\(\\$\\$\\)" lim t)) - (goto-char pos) - (and (match-beginning 1) (throw 'exit (cons (match-string 1) m))) - (and (match-beginning 2) (throw 'exit nil)) - ;; count $$ - (while (re-search-backward "\\$\\$" lim t) - (setq dd-on (not dd-on))) - (goto-char pos) - (if dd-on (cons "$$" m)))))) - -(defun org-inside-latex-macro-p () - "Is point inside a LaTeX macro or its arguments?" - (save-match-data - (org-in-regexp - "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*"))) - -(defvar org-latex-fragment-image-overlays nil - "List of overlays carrying the images of latex fragments.") -(make-variable-buffer-local 'org-latex-fragment-image-overlays) - -(defun org-remove-latex-fragment-image-overlays () - "Remove all overlays with LaTeX fragment images in current buffer." - (mapc 'delete-overlay org-latex-fragment-image-overlays) - (setq org-latex-fragment-image-overlays nil)) - -(defun org-preview-latex-fragment (&optional subtree) - "Preview the LaTeX fragment at point, or all locally or globally. -If the cursor is in a LaTeX fragment, create the image and overlay -it over the source code. If there is no fragment at point, display -all fragments in the current text, from one headline to the next. With -prefix SUBTREE, display all fragments in the current subtree. With a -double prefix arg \\[universal-argument] \\[universal-argument], or when \ -the cursor is before the first headline, -display all fragments in the buffer. -The images can be removed again with \\[org-ctrl-c-ctrl-c]." - (interactive "P") - (unless buffer-file-name - (user-error "Can't preview LaTeX fragment in a non-file buffer")) - (when (display-graphic-p) - (org-remove-latex-fragment-image-overlays) - (save-excursion - (save-restriction - (let (beg end at msg) - (cond - ((or (equal subtree '(16)) - (not (save-excursion - (re-search-backward org-outline-regexp-bol nil t)))) - (setq beg (point-min) end (point-max) - msg "Creating images for buffer...%s")) - ((equal subtree '(4)) - (org-back-to-heading) - (setq beg (point) end (org-end-of-subtree t) - msg "Creating images for subtree...%s")) - (t - (if (setq at (org-inside-LaTeX-fragment-p)) - (goto-char (max (point-min) (- (cdr at) 2))) - (org-back-to-heading)) - (setq beg (point) end (progn (outline-next-heading) (point)) - msg (if at "Creating image...%s" - "Creating images for entry...%s")))) - (message msg "") - (narrow-to-region beg end) - (goto-char beg) - (org-format-latex - (concat org-latex-preview-ltxpng-directory (file-name-sans-extension - (file-name-nondirectory - buffer-file-name))) - default-directory 'overlays msg at 'forbuffer - org-latex-create-formula-image-program) - (message msg "done. Use `C-c C-c' to remove images.")))))) - -(defun org-format-latex (prefix &optional dir overlays msg at - forbuffer processing-type) - "Replace LaTeX fragments with links to an image, and produce images. -Some of the options can be changed using the variable -`org-format-latex-options'." - (if (and overlays (fboundp 'clear-image-cache)) (clear-image-cache)) - (let* ((prefixnodir (file-name-nondirectory prefix)) - (absprefix (expand-file-name prefix dir)) - (todir (file-name-directory absprefix)) - (opt org-format-latex-options) - (optnew org-format-latex-options) - (matchers (plist-get opt :matchers)) - (re-list org-latex-regexps) - (cnt 0) txt hash link beg end re e checkdir - string - m n block-type block linkfile movefile ov) - ;; Check the different regular expressions - (while (setq e (pop re-list)) - (setq m (car e) re (nth 1 e) n (nth 2 e) block-type (nth 3 e) - block (if block-type "\n\n" "")) - (when (member m matchers) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (when (and (or (not at) (equal (cdr at) (match-beginning n))) - (or (not overlays) - (not (eq (get-char-property (match-beginning n) - 'org-overlay-type) - 'org-latex-overlay)))) - (cond - ((eq processing-type 'verbatim)) - ((eq processing-type 'mathjax) - ;; Prepare for MathJax processing. - (setq string (match-string n)) - (when (member m '("$" "$1")) - (save-excursion - (delete-region (match-beginning n) (match-end n)) - (goto-char (match-beginning n)) - (insert (concat "\\(" (substring string 1 -1) "\\)"))))) - ((or (eq processing-type 'dvipng) - (eq processing-type 'imagemagick)) - ;; Process to an image. - (setq txt (match-string n) - beg (match-beginning n) end (match-end n) - cnt (1+ cnt)) - (let ((face (face-at-point)) - (fg (plist-get opt :foreground)) - (bg (plist-get opt :background)) - ;; Ensure full list is printed. - print-length print-level) - (when forbuffer - ;; Get the colors from the face at point. - (goto-char beg) - (when (eq fg 'auto) - (setq fg (face-attribute face :foreground nil 'default))) - (when (eq bg 'auto) - (setq bg (face-attribute face :background nil 'default))) - (setq optnew (copy-sequence opt)) - (plist-put optnew :foreground fg) - (plist-put optnew :background bg)) - (setq hash (sha1 (prin1-to-string - (list org-format-latex-header - org-latex-default-packages-alist - org-latex-packages-alist - org-format-latex-options - forbuffer txt fg bg))) - linkfile (format "%s_%s.png" prefix hash) - movefile (format "%s_%s.png" absprefix hash))) - (setq link (concat block "[[file:" linkfile "]]" block)) - (if msg (message msg cnt)) - (goto-char beg) - (unless checkdir ; Ensure the directory exists. - (setq checkdir t) - (or (file-directory-p todir) (make-directory todir t))) - (unless (file-exists-p movefile) - (org-create-formula-image - txt movefile optnew forbuffer processing-type)) - (if overlays - (progn - (mapc (lambda (o) - (if (eq (overlay-get o 'org-overlay-type) - 'org-latex-overlay) - (delete-overlay o))) - (overlays-in beg end)) - (setq ov (make-overlay beg end)) - (overlay-put ov 'org-overlay-type 'org-latex-overlay) - (if (featurep 'xemacs) - (progn - (overlay-put ov 'invisible t) - (overlay-put - ov 'end-glyph - (make-glyph (vector 'png :file movefile)))) - (overlay-put - ov 'display - (list 'image :type 'png :file movefile :ascent 'center))) - (push ov org-latex-fragment-image-overlays) - (goto-char end)) - (delete-region beg end) - (insert (org-add-props link - (list 'org-latex-src - (replace-regexp-in-string - "\"" "" txt) - 'org-latex-src-embed-type - (if block-type 'paragraph 'character)))))) - ((eq processing-type 'mathml) - ;; Process to MathML - (unless (save-match-data (org-format-latex-mathml-available-p)) - (user-error "LaTeX to MathML converter not configured")) - (setq txt (match-string n) - beg (match-beginning n) end (match-end n) - cnt (1+ cnt)) - (if msg (message msg cnt)) - (goto-char beg) - (delete-region beg end) - (insert (org-format-latex-as-mathml - txt block-type prefix dir))) - (t - (error "Unknown conversion type %s for LaTeX fragments" - processing-type))))))))) - -(defun org-create-math-formula (latex-frag &optional mathml-file) - "Convert LATEX-FRAG to MathML and store it in MATHML-FILE. -Use `org-latex-to-mathml-convert-command'. If the conversion is -sucessful, return the portion between \"<math...> </math>\" -elements otherwise return nil. When MATHML-FILE is specified, -write the results in to that file. When invoked as an -interactive command, prompt for LATEX-FRAG, with initial value -set to the current active region and echo the results for user -inspection." - (interactive (list (let ((frag (when (org-region-active-p) - (buffer-substring-no-properties - (region-beginning) (region-end))))) - (read-string "LaTeX Fragment: " frag nil frag)))) - (unless latex-frag (error "Invalid LaTeX fragment")) - (let* ((tmp-in-file (file-relative-name - (make-temp-name (expand-file-name "ltxmathml-in")))) - (ignore (write-region latex-frag nil tmp-in-file)) - (tmp-out-file (file-relative-name - (make-temp-name (expand-file-name "ltxmathml-out")))) - (cmd (format-spec - org-latex-to-mathml-convert-command - `((?j . ,(shell-quote-argument - (expand-file-name org-latex-to-mathml-jar-file))) - (?I . ,(shell-quote-argument tmp-in-file)) - (?o . ,(shell-quote-argument tmp-out-file))))) - mathml shell-command-output) - (when (org-called-interactively-p 'any) - (unless (org-format-latex-mathml-available-p) - (user-error "LaTeX to MathML converter not configured"))) - (message "Running %s" cmd) - (setq shell-command-output (shell-command-to-string cmd)) - (setq mathml - (when (file-readable-p tmp-out-file) - (with-current-buffer (find-file-noselect tmp-out-file t) - (goto-char (point-min)) - (when (re-search-forward - (concat - (regexp-quote - "<math xmlns=\"http://www.w3.org/1998/Math/MathML\">") - "\\(.\\|\n\\)*" - (regexp-quote "</math>")) nil t) - (prog1 (match-string 0) (kill-buffer)))))) - (cond - (mathml - (setq mathml - (concat "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" mathml)) - (when mathml-file - (write-region mathml nil mathml-file)) - (when (org-called-interactively-p 'any) - (message mathml))) - ((message "LaTeX to MathML conversion failed") - (message shell-command-output))) - (delete-file tmp-in-file) - (when (file-exists-p tmp-out-file) - (delete-file tmp-out-file)) - mathml)) - -(defun org-format-latex-as-mathml (latex-frag latex-frag-type - prefix &optional dir) - "Use `org-create-math-formula' but check local cache first." - (let* ((absprefix (expand-file-name prefix dir)) - (print-length nil) (print-level nil) - (formula-id (concat - "formula-" - (sha1 - (prin1-to-string - (list latex-frag - org-latex-to-mathml-convert-command))))) - (formula-cache (format "%s-%s.mathml" absprefix formula-id)) - (formula-cache-dir (file-name-directory formula-cache))) - - (unless (file-directory-p formula-cache-dir) - (make-directory formula-cache-dir t)) - - (unless (file-exists-p formula-cache) - (org-create-math-formula latex-frag formula-cache)) - - (if (file-exists-p formula-cache) - ;; Successful conversion. Return the link to MathML file. - (org-add-props - (format "[[file:%s]]" (file-relative-name formula-cache dir)) - (list 'org-latex-src (replace-regexp-in-string "\"" "" latex-frag) - 'org-latex-src-embed-type (if latex-frag-type - 'paragraph 'character))) - ;; Failed conversion. Return the LaTeX fragment verbatim - latex-frag))) - -(defun org-create-formula-image (string tofile options buffer &optional type) - "Create an image from LaTeX source using dvipng or convert. -This function calls either `org-create-formula-image-with-dvipng' -or `org-create-formula-image-with-imagemagick' depending on the -value of `org-latex-create-formula-image-program' or on the value -of the optional TYPE variable. - -Note: ultimately these two function should be combined as they -share a good deal of logic." - (org-check-external-command - "latex" "needed to convert LaTeX fragments to images") - (funcall - (case (or type org-latex-create-formula-image-program) - ('dvipng - (org-check-external-command - "dvipng" "needed to convert LaTeX fragments to images") - #'org-create-formula-image-with-dvipng) - ('imagemagick - (org-check-external-command - "convert" "you need to install imagemagick") - #'org-create-formula-image-with-imagemagick) - (t (error - "Invalid value of `org-latex-create-formula-image-program'"))) - string tofile options buffer)) - -(declare-function org-export-get-backend "ox" (name)) -(declare-function org-export--get-global-options "ox" (&optional backend)) -(declare-function org-export--get-inbuffer-options "ox" (&optional backend)) -(declare-function org-latex-guess-inputenc "ox-latex" (header)) -(declare-function org-latex-guess-babel-language "ox-latex" (header info)) -(defun org-create-formula--latex-header () - "Return LaTeX header appropriate for previewing a LaTeX snippet." - (let ((info (org-combine-plists (org-export--get-global-options - (org-export-get-backend 'latex)) - (org-export--get-inbuffer-options - (org-export-get-backend 'latex))))) - (org-latex-guess-babel-language - (org-latex-guess-inputenc - (org-splice-latex-header - org-format-latex-header - org-latex-default-packages-alist - org-latex-packages-alist t - (plist-get info :latex-header))) - info))) - -;; This function borrows from Ganesh Swami's latex2png.el -(defun org-create-formula-image-with-dvipng (string tofile options buffer) - "This calls dvipng." - (require 'ox-latex) - (let* ((tmpdir (if (featurep 'xemacs) - (temp-directory) - temporary-file-directory)) - (texfilebase (make-temp-name - (expand-file-name "orgtex" tmpdir))) - (texfile (concat texfilebase ".tex")) - (dvifile (concat texfilebase ".dvi")) - (pngfile (concat texfilebase ".png")) - (fnh (if (featurep 'xemacs) - (font-height (face-font 'default)) - (face-attribute 'default :height nil))) - (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) - (dpi (number-to-string (* scale (floor (* 0.9 (if buffer fnh 140.)))))) - (fg (or (plist-get options (if buffer :foreground :html-foreground)) - "Black")) - (bg (or (plist-get options (if buffer :background :html-background)) - "Transparent"))) - (if (eq fg 'default) (setq fg (org-dvipng-color :foreground)) - (unless (string= fg "Transparent") (setq fg (org-dvipng-color-format fg)))) - (if (eq bg 'default) (setq bg (org-dvipng-color :background)) - (unless (string= bg "Transparent") (setq bg (org-dvipng-color-format bg)))) - (let ((latex-header (org-create-formula--latex-header))) - (with-temp-file texfile - (insert latex-header) - (insert "\n\\begin{document}\n" string "\n\\end{document}\n"))) - (let ((dir default-directory)) - (condition-case nil - (progn - (cd tmpdir) - (call-process "latex" nil nil nil texfile)) - (error nil)) - (cd dir)) - (if (not (file-exists-p dvifile)) - (progn (message "Failed to create dvi file from %s" texfile) nil) - (condition-case nil - (if (featurep 'xemacs) - (call-process "dvipng" nil nil nil - "-fg" fg "-bg" bg - "-T" "tight" - "-o" pngfile - dvifile) - (call-process "dvipng" nil nil nil - "-fg" fg "-bg" bg - "-D" dpi - ;;"-x" scale "-y" scale - "-T" "tight" - "-o" pngfile - dvifile)) - (error nil)) - (if (not (file-exists-p pngfile)) - (if org-format-latex-signal-error - (error "Failed to create png file from %s" texfile) - (message "Failed to create png file from %s" texfile) - nil) - ;; Use the requested file name and clean up - (copy-file pngfile tofile 'replace) - (loop for e in '(".dvi" ".tex" ".aux" ".log" ".png" ".out") do - (if (file-exists-p (concat texfilebase e)) - (delete-file (concat texfilebase e)))) - pngfile)))) - -(declare-function org-latex-compile "ox-latex" (texfile &optional snippet)) -(defun org-create-formula-image-with-imagemagick (string tofile options buffer) - "This calls convert, which is included into imagemagick." - (require 'ox-latex) - (let* ((tmpdir (if (featurep 'xemacs) - (temp-directory) - temporary-file-directory)) - (texfilebase (make-temp-name - (expand-file-name "orgtex" tmpdir))) - (texfile (concat texfilebase ".tex")) - (pdffile (concat texfilebase ".pdf")) - (pngfile (concat texfilebase ".png")) - (fnh (if (featurep 'xemacs) - (font-height (face-font 'default)) - (face-attribute 'default :height nil))) - (scale (or (plist-get options (if buffer :scale :html-scale)) 1.0)) - (dpi (number-to-string (* scale (floor (if buffer fnh 120.))))) - (fg (or (plist-get options (if buffer :foreground :html-foreground)) - "black")) - (bg (or (plist-get options (if buffer :background :html-background)) - "white"))) - (if (eq fg 'default) (setq fg (org-latex-color :foreground)) - (setq fg (org-latex-color-format fg))) - (if (eq bg 'default) (setq bg (org-latex-color :background)) - (setq bg (org-latex-color-format - (if (string= bg "Transparent") "white" bg)))) - (let ((latex-header (org-create-formula--latex-header))) - (with-temp-file texfile - (insert latex-header) - (insert "\n\\begin{document}\n" - "\\definecolor{fg}{rgb}{" fg "}\n" - "\\definecolor{bg}{rgb}{" bg "}\n" - "\n\\pagecolor{bg}\n" - "\n{\\color{fg}\n" - string - "\n}\n" - "\n\\end{document}\n"))) - (org-latex-compile texfile t) - (if (not (file-exists-p pdffile)) - (progn (message "Failed to create pdf file from %s" texfile) nil) - (condition-case nil - (if (featurep 'xemacs) - (call-process "convert" nil nil nil - "-density" "96" - "-trim" - "-antialias" - pdffile - "-quality" "100" - ;; "-sharpen" "0x1.0" - pngfile) - (call-process "convert" nil nil nil - "-density" dpi - "-trim" - "-antialias" - pdffile - "-quality" "100" - ;; "-sharpen" "0x1.0" - pngfile)) - (error nil)) - (if (not (file-exists-p pngfile)) - (if org-format-latex-signal-error - (error "Failed to create png file from %s" texfile) - (message "Failed to create png file from %s" texfile) - nil) - ;; Use the requested file name and clean up - (copy-file pngfile tofile 'replace) - (loop for e in '(".pdf" ".tex" ".aux" ".log" ".png") do - (if (file-exists-p (concat texfilebase e)) - (delete-file (concat texfilebase e)))) - pngfile)))) - -(defun org-splice-latex-header (tpl def-pkg pkg snippets-p &optional extra) - "Fill a LaTeX header template TPL. -In the template, the following place holders will be recognized: - - [DEFAULT-PACKAGES] \\usepackage statements for DEF-PKG - [NO-DEFAULT-PACKAGES] do not include DEF-PKG - [PACKAGES] \\usepackage statements for PKG - [NO-PACKAGES] do not include PKG - [EXTRA] the string EXTRA - [NO-EXTRA] do not include EXTRA - -For backward compatibility, if both the positive and the negative place -holder is missing, the positive one (without the \"NO-\") will be -assumed to be present at the end of the template. -DEF-PKG and PKG are assumed to be alists of options/packagename lists. -EXTRA is a string. -SNIPPETS-P indicates if this is run to create snippet images for HTML." - (let (rpl (end "")) - (if (string-match "^[ \t]*\\[\\(NO-\\)?DEFAULT-PACKAGES\\][ \t]*\n?" tpl) - (setq rpl (if (or (match-end 1) (not def-pkg)) - "" (org-latex-packages-to-string def-pkg snippets-p t)) - tpl (replace-match rpl t t tpl)) - (if def-pkg (setq end (org-latex-packages-to-string def-pkg snippets-p)))) - - (if (string-match "\\[\\(NO-\\)?PACKAGES\\][ \t]*\n?" tpl) - (setq rpl (if (or (match-end 1) (not pkg)) - "" (org-latex-packages-to-string pkg snippets-p t)) - tpl (replace-match rpl t t tpl)) - (if pkg (setq end - (concat end "\n" - (org-latex-packages-to-string pkg snippets-p))))) - - (if (string-match "\\[\\(NO-\\)?EXTRA\\][ \t]*\n?" tpl) - (setq rpl (if (or (match-end 1) (not extra)) - "" (concat extra "\n")) - tpl (replace-match rpl t t tpl)) - (if (and extra (string-match "\\S-" extra)) - (setq end (concat end "\n" extra)))) - - (if (string-match "\\S-" end) - (concat tpl "\n" end) - tpl))) - -(defun org-latex-packages-to-string (pkg &optional snippets-p newline) - "Turn an alist of packages into a string with the \\usepackage macros." - (setq pkg (mapconcat (lambda(p) - (cond - ((stringp p) p) - ((and snippets-p (>= (length p) 3) (not (nth 2 p))) - (format "%% Package %s omitted" (cadr p))) - ((equal "" (car p)) - (format "\\usepackage{%s}" (cadr p))) - (t - (format "\\usepackage[%s]{%s}" - (car p) (cadr p))))) - pkg - "\n")) - (if newline (concat pkg "\n") pkg)) - -(defun org-dvipng-color (attr) - "Return a RGB color specification for dvipng." - (apply 'format "rgb %s %s %s" - (mapcar 'org-normalize-color - (if (featurep 'xemacs) - (color-rgb-components - (face-property 'default - (cond ((eq attr :foreground) 'foreground) - ((eq attr :background) 'background)))) - (color-values (face-attribute 'default attr nil)))))) - -(defun org-dvipng-color-format (color-name) - "Convert COLOR-NAME to a RGB color value for dvipng." - (apply 'format "rgb %s %s %s" - (mapcar 'org-normalize-color - (color-values color-name)))) - -(defun org-latex-color (attr) - "Return a RGB color for the LaTeX color package." - (apply 'format "%s,%s,%s" - (mapcar 'org-normalize-color - (if (featurep 'xemacs) - (color-rgb-components - (face-property 'default - (cond ((eq attr :foreground) 'foreground) - ((eq attr :background) 'background)))) - (color-values (face-attribute 'default attr nil)))))) - -(defun org-latex-color-format (color-name) - "Convert COLOR-NAME to a RGB color value." - (apply 'format "%s,%s,%s" - (mapcar 'org-normalize-color - (color-values color-name)))) - -(defun org-normalize-color (value) - "Return string to be used as color value for an RGB component." - (format "%g" (/ value 65535.0))) - - - -;; Image display - -(defvar org-inline-image-overlays nil) -(make-variable-buffer-local 'org-inline-image-overlays) - -(defun org-toggle-inline-images (&optional include-linked) - "Toggle the display of inline images. -INCLUDE-LINKED is passed to `org-display-inline-images'." - (interactive "P") - (if org-inline-image-overlays - (progn - (org-remove-inline-images) - (message "Inline image display turned off")) - (org-display-inline-images include-linked) - (if (and (org-called-interactively-p) - org-inline-image-overlays) - (message "%d images displayed inline" - (length org-inline-image-overlays)) - (message "No images to display inline")))) - -(defun org-redisplay-inline-images () - "Refresh the display of inline images." - (interactive) - (if (not org-inline-image-overlays) - (org-toggle-inline-images) - (org-toggle-inline-images) - (org-toggle-inline-images))) - -(defun org-display-inline-images (&optional include-linked refresh beg end) - "Display inline images. -Normally only links without a description part are inlined, because this -is how it will work for export. When INCLUDE-LINKED is set, also links -with a description part will be inlined. This can be nice for a quick -look at those images, but it does not reflect what exported files will look -like. -When REFRESH is set, refresh existing images between BEG and END. -This will create new image displays only if necessary. -BEG and END default to the buffer boundaries." - (interactive "P") - (when (display-graphic-p) - (unless refresh - (org-remove-inline-images) - (if (fboundp 'clear-image-cache) (clear-image-cache))) - (save-excursion - (save-restriction - (widen) - (setq beg (or beg (point-min)) end (or end (point-max))) - (goto-char beg) - (let ((re (concat "\\[\\[\\(\\(file:\\)\\|\\([./~]\\)\\)\\([^]\n]+?" - (substring (org-image-file-name-regexp) 0 -2) - "\\)\\]" (if include-linked "" "\\]"))) - (case-fold-search t) - old file ov img type attrwidth width) - (while (re-search-forward re end t) - (setq old (get-char-property-and-overlay (match-beginning 1) - 'org-image-overlay) - file (expand-file-name - (concat (or (match-string 3) "") (match-string 4)))) - (when (image-type-available-p 'imagemagick) - (setq attrwidth (if (or (listp org-image-actual-width) - (null org-image-actual-width)) - (save-excursion - (save-match-data - (when (re-search-backward - "#\\+attr.*:width[ \t]+\\([^ ]+\\)" - (save-excursion - (re-search-backward "^[ \t]*$\\|\\`" nil t)) t) - (string-to-number (match-string 1)))))) - width (cond ((eq org-image-actual-width t) nil) - ((null org-image-actual-width) attrwidth) - ((numberp org-image-actual-width) - org-image-actual-width) - ((listp org-image-actual-width) - (or attrwidth (car org-image-actual-width)))) - type (if width 'imagemagick))) - (when (file-exists-p file) - (if (and (car-safe old) refresh) - (image-refresh (overlay-get (cdr old) 'display)) - (setq img (save-match-data (create-image file type nil :width width))) - (when img - (setq ov (make-overlay (match-beginning 0) (match-end 0))) - (overlay-put ov 'display img) - (overlay-put ov 'face 'default) - (overlay-put ov 'org-image-overlay t) - (overlay-put ov 'modification-hooks - (list 'org-display-inline-remove-overlay)) - (push ov org-inline-image-overlays)))))))))) - -(define-obsolete-function-alias - 'org-display-inline-modification-hook 'org-display-inline-remove-overlay "24.3") - -(defun org-display-inline-remove-overlay (ov after beg end &optional len) - "Remove inline-display overlay if a corresponding region is modified." - (let ((inhibit-modification-hooks t)) - (when (and ov after) - (delete ov org-inline-image-overlays) - (delete-overlay ov)))) - -(defun org-remove-inline-images () - "Remove inline display of images." - (interactive) - (mapc 'delete-overlay org-inline-image-overlays) - (setq org-inline-image-overlays nil)) - -;;;; Key bindings - -;; Outline functions from `outline-mode-prefix-map' -;; that can be remapped in Org: -(define-key org-mode-map [remap outline-mark-subtree] 'org-mark-subtree) -(define-key org-mode-map [remap show-subtree] 'org-show-subtree) -(define-key org-mode-map [remap outline-forward-same-level] - 'org-forward-heading-same-level) -(define-key org-mode-map [remap outline-backward-same-level] - 'org-backward-heading-same-level) -(define-key org-mode-map [remap show-branches] - 'org-kill-note-or-show-branches) -(define-key org-mode-map [remap outline-promote] 'org-promote-subtree) -(define-key org-mode-map [remap outline-demote] 'org-demote-subtree) -(define-key org-mode-map [remap outline-insert-heading] 'org-ctrl-c-ret) - -;; Outline functions from `outline-mode-prefix-map' that can not -;; be remapped in Org: -;; -;; - the column "key binding" shows whether the Outline function is still -;; available in Org mode on the same key that it has been bound to in -;; Outline mode: -;; - "overridden": key used for a different functionality in Org mode -;; - else: key still bound to the same Outline function in Org mode -;; -;; | Outline function | key binding | Org replacement | -;; |------------------------------------+-------------+-----------------------| -;; | `outline-next-visible-heading' | `C-c C-n' | still same function | -;; | `outline-previous-visible-heading' | `C-c C-p' | still same function | -;; | `outline-up-heading' | `C-c C-u' | still same function | -;; | `outline-move-subtree-up' | overridden | better: org-shiftup | -;; | `outline-move-subtree-down' | overridden | better: org-shiftdown | -;; | `show-entry' | overridden | no replacement | -;; | `show-children' | `C-c C-i' | visibility cycling | -;; | `show-branches' | `C-c C-k' | still same function | -;; | `show-subtree' | overridden | visibility cycling | -;; | `show-all' | overridden | no replacement | -;; | `hide-subtree' | overridden | visibility cycling | -;; | `hide-body' | overridden | no replacement | -;; | `hide-entry' | overridden | visibility cycling | -;; | `hide-leaves' | overridden | no replacement | -;; | `hide-sublevels' | overridden | no replacement | -;; | `hide-other' | overridden | no replacement | - -;; Make `C-c C-x' a prefix key -(org-defkey org-mode-map "\C-c\C-x" (make-sparse-keymap)) - -;; TAB key with modifiers -(org-defkey org-mode-map "\C-i" 'org-cycle) -(org-defkey org-mode-map [(tab)] 'org-cycle) -(org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) -(org-defkey org-mode-map "\M-\t" 'pcomplete) -;; The following line is necessary under Suse GNU/Linux -(unless (featurep 'xemacs) - (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) -(org-defkey org-mode-map [(shift tab)] 'org-shifttab) -(define-key org-mode-map [backtab] 'org-shifttab) - -(org-defkey org-mode-map [(shift return)] 'org-table-copy-down) -(org-defkey org-mode-map [(meta shift return)] 'org-insert-todo-heading) -(org-defkey org-mode-map [(meta return)] 'org-meta-return) - -;; Cursor keys with modifiers -(org-defkey org-mode-map [(meta left)] 'org-metaleft) -(org-defkey org-mode-map [(meta right)] 'org-metaright) -(org-defkey org-mode-map [(meta up)] 'org-metaup) -(org-defkey org-mode-map [(meta down)] 'org-metadown) - -(org-defkey org-mode-map [(meta shift left)] 'org-shiftmetaleft) -(org-defkey org-mode-map [(meta shift right)] 'org-shiftmetaright) -(org-defkey org-mode-map [(meta shift up)] 'org-shiftmetaup) -(org-defkey org-mode-map [(meta shift down)] 'org-shiftmetadown) - -(org-defkey org-mode-map [(shift up)] 'org-shiftup) -(org-defkey org-mode-map [(shift down)] 'org-shiftdown) -(org-defkey org-mode-map [(shift left)] 'org-shiftleft) -(org-defkey org-mode-map [(shift right)] 'org-shiftright) - -(org-defkey org-mode-map [(control shift right)] 'org-shiftcontrolright) -(org-defkey org-mode-map [(control shift left)] 'org-shiftcontrolleft) -(org-defkey org-mode-map [(control shift up)] 'org-shiftcontrolup) -(org-defkey org-mode-map [(control shift down)] 'org-shiftcontroldown) - -;; Babel keys -(define-key org-mode-map org-babel-key-prefix org-babel-map) -(mapc (lambda (pair) - (define-key org-babel-map (car pair) (cdr pair))) - org-babel-key-bindings) - -;;; Extra keys for tty access. -;; We only set them when really needed because otherwise the -;; menus don't show the simple keys - -(when (or org-use-extra-keys - (featurep 'xemacs) ;; because XEmacs supports multi-device stuff - (not window-system)) - (org-defkey org-mode-map "\C-c\C-xc" 'org-table-copy-down) - (org-defkey org-mode-map "\C-c\C-xM" 'org-insert-todo-heading) - (org-defkey org-mode-map "\C-c\C-xm" 'org-meta-return) - (org-defkey org-mode-map [?\e (return)] 'org-meta-return) - (org-defkey org-mode-map [?\e (left)] 'org-metaleft) - (org-defkey org-mode-map "\C-c\C-xl" 'org-metaleft) - (org-defkey org-mode-map [?\e (right)] 'org-metaright) - (org-defkey org-mode-map "\C-c\C-xr" 'org-metaright) - (org-defkey org-mode-map [?\e (up)] 'org-metaup) - (org-defkey org-mode-map "\C-c\C-xu" 'org-metaup) - (org-defkey org-mode-map [?\e (down)] 'org-metadown) - (org-defkey org-mode-map "\C-c\C-xd" 'org-metadown) - (org-defkey org-mode-map "\C-c\C-xL" 'org-shiftmetaleft) - (org-defkey org-mode-map "\C-c\C-xR" 'org-shiftmetaright) - (org-defkey org-mode-map "\C-c\C-xU" 'org-shiftmetaup) - (org-defkey org-mode-map "\C-c\C-xD" 'org-shiftmetadown) - (org-defkey org-mode-map [?\C-c (up)] 'org-shiftup) - (org-defkey org-mode-map [?\C-c (down)] 'org-shiftdown) - (org-defkey org-mode-map [?\C-c (left)] 'org-shiftleft) - (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright) - (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright) - (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft) - (org-defkey org-mode-map [?\e (tab)] 'pcomplete) - (org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading) - (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft) - (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright) - (org-defkey org-mode-map [?\e (shift up)] 'org-shiftmetaup) - (org-defkey org-mode-map [?\e (shift down)] 'org-shiftmetadown)) - -;; All the other keys - -(org-defkey org-mode-map "\C-c\C-a" 'show-all) ; in case allout messed up. -(org-defkey org-mode-map "\C-c\C-r" 'org-reveal) -(if (boundp 'narrow-map) - (org-defkey narrow-map "s" 'org-narrow-to-subtree) - (org-defkey org-mode-map "\C-xns" 'org-narrow-to-subtree)) -(if (boundp 'narrow-map) - (org-defkey narrow-map "b" 'org-narrow-to-block) - (org-defkey org-mode-map "\C-xnb" 'org-narrow-to-block)) -(if (boundp 'narrow-map) - (org-defkey narrow-map "e" 'org-narrow-to-element) - (org-defkey org-mode-map "\C-xne" 'org-narrow-to-element)) -(org-defkey org-mode-map "\C-\M-t" 'org-transpose-element) -(org-defkey org-mode-map "\M-}" 'org-forward-element) -(org-defkey org-mode-map "\M-{" 'org-backward-element) -(org-defkey org-mode-map "\C-c\C-^" 'org-up-element) -(org-defkey org-mode-map "\C-c\C-_" 'org-down-element) -(org-defkey org-mode-map "\C-c\C-f" 'org-forward-heading-same-level) -(org-defkey org-mode-map "\C-c\C-b" 'org-backward-heading-same-level) -(org-defkey org-mode-map "\C-c\M-f" 'org-next-block) -(org-defkey org-mode-map "\C-c\M-b" 'org-previous-block) -(org-defkey org-mode-map "\C-c$" 'org-archive-subtree) -(org-defkey org-mode-map "\C-c\C-x\C-s" 'org-advertized-archive-subtree) -(org-defkey org-mode-map "\C-c\C-x\C-a" 'org-archive-subtree-default) -(org-defkey org-mode-map "\C-c\C-xd" 'org-insert-drawer) -(org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag) -(org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling) -(org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer) -(org-defkey org-mode-map "\C-c\C-xq" 'org-toggle-tags-groups) -(org-defkey org-mode-map "\C-c\C-j" 'org-goto) -(org-defkey org-mode-map "\C-c\C-t" 'org-todo) -(org-defkey org-mode-map "\C-c\C-q" 'org-set-tags-command) -(org-defkey org-mode-map "\C-c\C-s" 'org-schedule) -(org-defkey org-mode-map "\C-c\C-d" 'org-deadline) -(org-defkey org-mode-map "\C-c;" 'org-toggle-comment) -(org-defkey org-mode-map "\C-c\C-w" 'org-refile) -(org-defkey org-mode-map "\C-c\M-w" 'org-copy) -(org-defkey org-mode-map "\C-c/" 'org-sparse-tree) ; Minor-mode reserved -(org-defkey org-mode-map "\C-c\\" 'org-match-sparse-tree) ; Minor-mode res. -(org-defkey org-mode-map "\C-c\C-m" 'org-ctrl-c-ret) -(org-defkey org-mode-map "\M-\C-m" 'org-insert-heading) -(org-defkey org-mode-map "\C-c\C-xc" 'org-clone-subtree-with-time-shift) -(org-defkey org-mode-map "\C-c\C-xv" 'org-copy-visible) -(org-defkey org-mode-map [(control return)] 'org-insert-heading-respect-content) -(org-defkey org-mode-map [(shift control return)] 'org-insert-todo-heading-respect-content) -(org-defkey org-mode-map "\C-c\C-x\C-n" 'org-next-link) -(org-defkey org-mode-map "\C-c\C-x\C-p" 'org-previous-link) -(org-defkey org-mode-map "\C-c\C-l" 'org-insert-link) -(org-defkey org-mode-map "\C-c\C-\M-l" 'org-insert-all-links) -(org-defkey org-mode-map "\C-c\C-o" 'org-open-at-point) -(org-defkey org-mode-map "\C-c%" 'org-mark-ring-push) -(org-defkey org-mode-map "\C-c&" 'org-mark-ring-goto) -(org-defkey org-mode-map "\C-c\C-z" 'org-add-note) ; Alternative binding -(org-defkey org-mode-map "\C-c." 'org-time-stamp) ; Minor-mode reserved -(org-defkey org-mode-map "\C-c!" 'org-time-stamp-inactive) ; Minor-mode r. -(org-defkey org-mode-map "\C-c," 'org-priority) ; Minor-mode reserved -(org-defkey org-mode-map "\C-c\C-y" 'org-evaluate-time-range) -(org-defkey org-mode-map "\C-c>" 'org-goto-calendar) -(org-defkey org-mode-map "\C-c<" 'org-date-from-calendar) -(org-defkey org-mode-map [(control ?,)] 'org-cycle-agenda-files) -(org-defkey org-mode-map [(control ?\')] 'org-cycle-agenda-files) -(org-defkey org-mode-map "\C-c[" 'org-agenda-file-to-front) -(org-defkey org-mode-map "\C-c]" 'org-remove-file) -(org-defkey org-mode-map "\C-c\C-x<" 'org-agenda-set-restriction-lock) -(org-defkey org-mode-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) -(org-defkey org-mode-map "\C-c-" 'org-ctrl-c-minus) -(org-defkey org-mode-map "\C-c*" 'org-ctrl-c-star) -(org-defkey org-mode-map "\C-c^" 'org-sort) -(org-defkey org-mode-map "\C-c\C-c" 'org-ctrl-c-ctrl-c) -(org-defkey org-mode-map "\C-c\C-k" 'org-kill-note-or-show-branches) -(org-defkey org-mode-map "\C-c#" 'org-update-statistics-cookies) -(org-defkey org-mode-map [remap open-line] 'org-open-line) -(org-defkey org-mode-map [remap forward-paragraph] 'org-forward-paragraph) -(org-defkey org-mode-map [remap backward-paragraph] 'org-backward-paragraph) -(org-defkey org-mode-map "\C-m" 'org-return) -(org-defkey org-mode-map "\C-j" 'org-return-indent) -(org-defkey org-mode-map "\C-c?" 'org-table-field-info) -(org-defkey org-mode-map "\C-c " 'org-table-blank-field) -(org-defkey org-mode-map "\C-c+" 'org-table-sum) -(org-defkey org-mode-map "\C-c=" 'org-table-eval-formula) -(org-defkey org-mode-map "\C-c'" 'org-edit-special) -(org-defkey org-mode-map "\C-c`" 'org-table-edit-field) -(org-defkey org-mode-map "\C-c|" 'org-table-create-or-convert-from-region) -(org-defkey org-mode-map [(control ?#)] 'org-table-rotate-recalc-marks) -(org-defkey org-mode-map "\C-c~" 'org-table-create-with-table.el) -(org-defkey org-mode-map "\C-c\C-a" 'org-attach) -(org-defkey org-mode-map "\C-c}" 'org-table-toggle-coordinate-overlays) -(org-defkey org-mode-map "\C-c{" 'org-table-toggle-formula-debugger) -(org-defkey org-mode-map "\C-c\C-e" 'org-export-dispatch) -(org-defkey org-mode-map "\C-c:" 'org-toggle-fixed-width-section) -(org-defkey org-mode-map "\C-c\C-x\C-f" 'org-emphasize) -(org-defkey org-mode-map "\C-c\C-xf" 'org-footnote-action) -(org-defkey org-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull) -(org-defkey org-mode-map "\C-c\C-x\C-mp" 'org-mobile-push) -(org-defkey org-mode-map "\C-c@" 'org-mark-subtree) -(org-defkey org-mode-map "\M-h" 'org-mark-element) -(org-defkey org-mode-map [?\C-c (control ?*)] 'org-list-make-subtree) -;;(org-defkey org-mode-map [?\C-c (control ?-)] 'org-list-make-list-from-subtree) - -(org-defkey org-mode-map "\C-c\C-x\C-w" 'org-cut-special) -(org-defkey org-mode-map "\C-c\C-x\M-w" 'org-copy-special) -(org-defkey org-mode-map "\C-c\C-x\C-y" 'org-paste-special) - -(org-defkey org-mode-map "\C-c\C-x\C-t" 'org-toggle-time-stamp-overlays) -(org-defkey org-mode-map "\C-c\C-x\C-i" 'org-clock-in) -(org-defkey org-mode-map "\C-c\C-x\C-x" 'org-clock-in-last) -(org-defkey org-mode-map "\C-c\C-x\C-z" 'org-resolve-clocks) -(org-defkey org-mode-map "\C-c\C-x\C-o" 'org-clock-out) -(org-defkey org-mode-map "\C-c\C-x\C-j" 'org-clock-goto) -(org-defkey org-mode-map "\C-c\C-x\C-q" 'org-clock-cancel) -(org-defkey org-mode-map "\C-c\C-x\C-d" 'org-clock-display) -(org-defkey org-mode-map "\C-c\C-x\C-r" 'org-clock-report) -(org-defkey org-mode-map "\C-c\C-x\C-u" 'org-dblock-update) -(org-defkey org-mode-map "\C-c\C-x\C-l" 'org-preview-latex-fragment) -(org-defkey org-mode-map "\C-c\C-x\C-v" 'org-toggle-inline-images) -(org-defkey org-mode-map "\C-c\C-x\C-\M-v" 'org-redisplay-inline-images) -(org-defkey org-mode-map "\C-c\C-x\\" 'org-toggle-pretty-entities) -(org-defkey org-mode-map "\C-c\C-x\C-b" 'org-toggle-checkbox) -(org-defkey org-mode-map "\C-c\C-xp" 'org-set-property) -(org-defkey org-mode-map "\C-c\C-xP" 'org-set-property-and-value) -(org-defkey org-mode-map "\C-c\C-xe" 'org-set-effort) -(org-defkey org-mode-map "\C-c\C-xE" 'org-inc-effort) -(org-defkey org-mode-map "\C-c\C-xo" 'org-toggle-ordered-property) -(org-defkey org-mode-map "\C-c\C-xi" 'org-insert-columns-dblock) -(org-defkey org-mode-map [(control ?c) (control ?x) ?\;] 'org-timer-set-timer) -(org-defkey org-mode-map [(control ?c) (control ?x) ?\:] 'org-timer-cancel-timer) - -(org-defkey org-mode-map "\C-c\C-x." 'org-timer) -(org-defkey org-mode-map "\C-c\C-x-" 'org-timer-item) -(org-defkey org-mode-map "\C-c\C-x0" 'org-timer-start) -(org-defkey org-mode-map "\C-c\C-x_" 'org-timer-stop) -(org-defkey org-mode-map "\C-c\C-x," 'org-timer-pause-or-continue) - -(define-key org-mode-map "\C-c\C-x\C-c" 'org-columns) - -(define-key org-mode-map "\C-c\C-x!" 'org-reload) - -(define-key org-mode-map "\C-c\C-xg" 'org-feed-update-all) -(define-key org-mode-map "\C-c\C-xG" 'org-feed-goto-inbox) - -(define-key org-mode-map "\C-c\C-x[" 'org-reftex-citation) - - -(when (featurep 'xemacs) - (org-defkey org-mode-map 'button3 'popup-mode-menu)) - - -(defconst org-speed-commands-default - '( - ("Outline Navigation") - ("n" . (org-speed-move-safe 'outline-next-visible-heading)) - ("p" . (org-speed-move-safe 'outline-previous-visible-heading)) - ("f" . (org-speed-move-safe 'org-forward-heading-same-level)) - ("b" . (org-speed-move-safe 'org-backward-heading-same-level)) - ("F" . org-next-block) - ("B" . org-previous-block) - ("u" . (org-speed-move-safe 'outline-up-heading)) - ("j" . org-goto) - ("g" . (org-refile t)) - ("Outline Visibility") - ("c" . org-cycle) - ("C" . org-shifttab) - (" " . org-display-outline-path) - ("s" . org-narrow-to-subtree) - ("=" . org-columns) - ("Outline Structure Editing") - ("U" . org-shiftmetaup) - ("D" . org-shiftmetadown) - ("r" . org-metaright) - ("l" . org-metaleft) - ("R" . org-shiftmetaright) - ("L" . org-shiftmetaleft) - ("i" . (progn (forward-char 1) (call-interactively - 'org-insert-heading-respect-content))) - ("^" . org-sort) - ("w" . org-refile) - ("a" . org-archive-subtree-default-with-confirmation) - ("@" . org-mark-subtree) - ("#" . org-toggle-comment) - ("Clock Commands") - ("I" . org-clock-in) - ("O" . org-clock-out) - ("Meta Data Editing") - ("t" . org-todo) - ("," . (org-priority)) - ("0" . (org-priority ?\ )) - ("1" . (org-priority ?A)) - ("2" . (org-priority ?B)) - ("3" . (org-priority ?C)) - (":" . org-set-tags-command) - ("e" . org-set-effort) - ("E" . org-inc-effort) - ("W" . (lambda(m) (interactive "sMinutes before warning: ") - (org-entry-put (point) "APPT_WARNTIME" m))) - ("Agenda Views etc") - ("v" . org-agenda) - ("/" . org-sparse-tree) - ("Misc") - ("o" . org-open-at-point) - ("?" . org-speed-command-help) - ("<" . (org-agenda-set-restriction-lock 'subtree)) - (">" . (org-agenda-remove-restriction-lock)) - ) - "The default speed commands.") - -(defun org-print-speed-command (e) - (if (> (length (car e)) 1) - (progn - (princ "\n") - (princ (car e)) - (princ "\n") - (princ (make-string (length (car e)) ?-)) - (princ "\n")) - (princ (car e)) - (princ " ") - (if (symbolp (cdr e)) - (princ (symbol-name (cdr e))) - (prin1 (cdr e))) - (princ "\n"))) - -(defun org-speed-command-help () - "Show the available speed commands." - (interactive) - (if (not org-use-speed-commands) - (user-error "Speed commands are not activated, customize `org-use-speed-commands'") - (with-output-to-temp-buffer "*Help*" - (princ "User-defined Speed commands\n===========================\n") - (mapc 'org-print-speed-command org-speed-commands-user) - (princ "\n") - (princ "Built-in Speed commands\n=======================\n") - (mapc 'org-print-speed-command org-speed-commands-default)) - (with-current-buffer "*Help*" - (setq truncate-lines t)))) - -(defun org-speed-move-safe (cmd) - "Execute CMD, but make sure that the cursor always ends up in a headline. -If not, return to the original position and throw an error." - (interactive) - (let ((pos (point))) - (call-interactively cmd) - (unless (and (bolp) (org-at-heading-p)) - (goto-char pos) - (error "Boundary reached while executing %s" cmd)))) - -(defvar org-self-insert-command-undo-counter 0) - -(defvar org-table-auto-blank-field) ; defined in org-table.el -(defvar org-speed-command nil) - -(define-obsolete-function-alias - 'org-speed-command-default-hook 'org-speed-command-activate "24.3") - -(defun org-speed-command-activate (keys) - "Hook for activating single-letter speed commands. -`org-speed-commands-default' specifies a minimal command set. -Use `org-speed-commands-user' for further customization." - (when (or (and (bolp) (looking-at org-outline-regexp)) - (and (functionp org-use-speed-commands) - (funcall org-use-speed-commands))) - (cdr (assoc keys (append org-speed-commands-user - org-speed-commands-default))))) - -(define-obsolete-function-alias - 'org-babel-speed-command-hook 'org-babel-speed-command-activate "24.3") - -(defun org-babel-speed-command-activate (keys) - "Hook for activating single-letter code block commands." - (when (and (bolp) (looking-at org-babel-src-block-regexp)) - (cdr (assoc keys org-babel-key-bindings)))) - -(defcustom org-speed-command-hook - '(org-speed-command-default-hook org-babel-speed-command-hook) - "Hook for activating speed commands at strategic locations. -Hook functions are called in sequence until a valid handler is -found. - -Each hook takes a single argument, a user-pressed command key -which is also a `self-insert-command' from the global map. - -Within the hook, examine the cursor position and the command key -and return nil or a valid handler as appropriate. Handler could -be one of an interactive command, a function, or a form. - -Set `org-use-speed-commands' to non-nil value to enable this -hook. The default setting is `org-speed-command-activate'." - :group 'org-structure - :version "24.1" - :type 'hook) - -(defun org-self-insert-command (N) - "Like `self-insert-command', use overwrite-mode for whitespace in tables. -If the cursor is in a table looking at whitespace, the whitespace is -overwritten, and the table is not marked as requiring realignment." - (interactive "p") - (org-check-before-invisible-edit 'insert) - (cond - ((and org-use-speed-commands - (setq org-speed-command - (run-hook-with-args-until-success - 'org-speed-command-hook (this-command-keys)))) - (cond - ((commandp org-speed-command) - (setq this-command org-speed-command) - (call-interactively org-speed-command)) - ((functionp org-speed-command) - (funcall org-speed-command)) - ((and org-speed-command (listp org-speed-command)) - (eval org-speed-command)) - (t (let (org-use-speed-commands) - (call-interactively 'org-self-insert-command))))) - ((and - (org-table-p) - (progn - ;; check if we blank the field, and if that triggers align - (and (featurep 'org-table) org-table-auto-blank-field - (member last-command - '(org-cycle org-return org-shifttab org-ctrl-c-ctrl-c yas/expand)) - (if (or (equal (char-after) ?\ ) (looking-at "[^|\n]* |")) - ;; got extra space, this field does not determine column width - (let (org-table-may-need-update) (org-table-blank-field)) - ;; no extra space, this field may determine column width - (org-table-blank-field))) - t) - (eq N 1) - (looking-at "[^|\n]* |")) - (let (org-table-may-need-update) - (goto-char (1- (match-end 0))) - (backward-delete-char 1) - (goto-char (match-beginning 0)) - (self-insert-command N))) - (t - (setq org-table-may-need-update t) - (self-insert-command N) - (org-fix-tags-on-the-fly) - (if org-self-insert-cluster-for-undo - (if (not (eq last-command 'org-self-insert-command)) - (setq org-self-insert-command-undo-counter 1) - (if (>= org-self-insert-command-undo-counter 20) - (setq org-self-insert-command-undo-counter 1) - (and (> org-self-insert-command-undo-counter 0) - buffer-undo-list (listp buffer-undo-list) - (not (cadr buffer-undo-list)) ; remove nil entry - (setcdr buffer-undo-list (cddr buffer-undo-list))) - (setq org-self-insert-command-undo-counter - (1+ org-self-insert-command-undo-counter)))))))) - -(defun org-check-before-invisible-edit (kind) - "Check is editing if kind KIND would be dangerous with invisible text around. -The detailed reaction depends on the user option `org-catch-invisible-edits'." - ;; First, try to get out of here as quickly as possible, to reduce overhead - (if (and org-catch-invisible-edits - (or (not (boundp 'visible-mode)) (not visible-mode)) - (or (get-char-property (point) 'invisible) - (get-char-property (max (point-min) (1- (point))) 'invisible))) - ;; OK, we need to take a closer look - (let* ((invisible-at-point (get-char-property (point) 'invisible)) - (invisible-before-point (if (bobp) nil (get-char-property - (1- (point)) 'invisible))) - (border-and-ok-direction - (or - ;; Check if we are acting predictably before invisible text - (and invisible-at-point (not invisible-before-point) - (memq kind '(insert delete-backward))) - ;; Check if we are acting predictably after invisible text - ;; This works not well, and I have turned it off. It seems - ;; better to always show and stop after invisible text. - ;; (and (not invisible-at-point) invisible-before-point - ;; (memq kind '(insert delete))) - ))) - (when (or (memq invisible-at-point '(outline org-hide-block t)) - (memq invisible-before-point '(outline org-hide-block t))) - (if (eq org-catch-invisible-edits 'error) - (user-error "Editing in invisible areas is prohibited, make them visible first")) - (if (and org-custom-properties-overlays - (y-or-n-p "Display invisible properties in this buffer? ")) - (org-toggle-custom-properties-visibility) - ;; Make the area visible - (save-excursion - (if invisible-before-point - (goto-char (previous-single-char-property-change - (point) 'invisible))) - (org-cycle)) - (cond - ((eq org-catch-invisible-edits 'show) - ;; That's it, we do the edit after showing - (message - "Unfolding invisible region around point before editing") - (sit-for 1)) - ((and (eq org-catch-invisible-edits 'smart) - border-and-ok-direction) - (message "Unfolding invisible region around point before editing")) - (t - ;; Don't do the edit, make the user repeat it in full visibility - (user-error "Edit in invisible region aborted, repeat to confirm with text visible")))))))) - -(defun org-fix-tags-on-the-fly () - (when (and (equal (char-after (point-at-bol)) ?*) - (org-at-heading-p)) - (org-align-tags-here org-tags-column))) - -(defun org-delete-backward-char (N) - "Like `delete-backward-char', insert whitespace at field end in tables. -When deleting backwards, in tables this function will insert whitespace in -front of the next \"|\" separator, to keep the table aligned. The table will -still be marked for re-alignment if the field did fill the entire column, -because, in this case the deletion might narrow the column." - (interactive "p") - (save-match-data - (org-check-before-invisible-edit 'delete-backward) - (if (and (org-table-p) - (eq N 1) - (string-match "|" (buffer-substring (point-at-bol) (point))) - (looking-at ".*?|")) - (let ((pos (point)) - (noalign (looking-at "[^|\n\r]* |")) - (c org-table-may-need-update)) - (backward-delete-char N) - (if (not overwrite-mode) - (progn - (skip-chars-forward "^|") - (insert " ") - (goto-char (1- pos)))) - ;; noalign: if there were two spaces at the end, this field - ;; does not determine the width of the column. - (if noalign (setq org-table-may-need-update c))) - (backward-delete-char N) - (org-fix-tags-on-the-fly)))) - -(defun org-delete-char (N) - "Like `delete-char', but insert whitespace at field end in tables. -When deleting characters, in tables this function will insert whitespace in -front of the next \"|\" separator, to keep the table aligned. The table will -still be marked for re-alignment if the field did fill the entire column, -because, in this case the deletion might narrow the column." - (interactive "p") - (save-match-data - (org-check-before-invisible-edit 'delete) - (if (and (org-table-p) - (not (bolp)) - (not (= (char-after) ?|)) - (eq N 1)) - (if (looking-at ".*?|") - (let ((pos (point)) - (noalign (looking-at "[^|\n\r]* |")) - (c org-table-may-need-update)) - (replace-match - (concat (substring (match-string 0) 1 -1) " |") nil t) - (goto-char pos) - ;; noalign: if there were two spaces at the end, this field - ;; does not determine the width of the column. - (if noalign (setq org-table-may-need-update c))) - (delete-char N)) - (delete-char N) - (org-fix-tags-on-the-fly)))) - -;; Make `delete-selection-mode' work with org-mode and orgtbl-mode -(put 'org-self-insert-command 'delete-selection t) -(put 'orgtbl-self-insert-command 'delete-selection t) -(put 'org-delete-char 'delete-selection 'supersede) -(put 'org-delete-backward-char 'delete-selection 'supersede) -(put 'org-yank 'delete-selection 'yank) - -;; Make `flyspell-mode' delay after some commands -(put 'org-self-insert-command 'flyspell-delayed t) -(put 'orgtbl-self-insert-command 'flyspell-delayed t) -(put 'org-delete-char 'flyspell-delayed t) -(put 'org-delete-backward-char 'flyspell-delayed t) - -;; Make pabbrev-mode expand after org-mode commands -(put 'org-self-insert-command 'pabbrev-expand-after-command t) -(put 'orgtbl-self-insert-command 'pabbrev-expand-after-command t) - -;; How to do this: Measure non-white length of current string -;; If equal to column width, we should realign. - -(defun org-remap (map &rest commands) - "In MAP, remap the functions given in COMMANDS. -COMMANDS is a list of alternating OLDDEF NEWDEF command names." - (let (new old) - (while commands - (setq old (pop commands) new (pop commands)) - (if (fboundp 'command-remapping) - (org-defkey map (vector 'remap old) new) - (substitute-key-definition old new map global-map))))) - -(defun org-transpose-words () - "Transpose words for Org. -This uses the `org-mode-transpose-word-syntax-table' syntax -table, which interprets characters in `org-emphasis-alist' as -word constituants." - (interactive) - (with-syntax-table org-mode-transpose-word-syntax-table - (call-interactively 'transpose-words))) -(org-remap org-mode-map 'transpose-words 'org-transpose-words) - -(when (eq org-enable-table-editor 'optimized) - ;; If the user wants maximum table support, we need to hijack - ;; some standard editing functions - (org-remap org-mode-map - 'self-insert-command 'org-self-insert-command - 'delete-char 'org-delete-char - 'delete-backward-char 'org-delete-backward-char) - (org-defkey org-mode-map "|" 'org-force-self-insert)) - -(defvar org-ctrl-c-ctrl-c-hook nil - "Hook for functions attaching themselves to `C-c C-c'. - -This can be used to add additional functionality to the C-c C-c -key which executes context-dependent commands. This hook is run -before any other test, while `org-ctrl-c-ctrl-c-final-hook' is -run after the last test. - -Each function will be called with no arguments. The function -must check if the context is appropriate for it to act. If yes, -it should do its thing and then return a non-nil value. If the -context is wrong, just do nothing and return nil.") - -(defvar org-ctrl-c-ctrl-c-final-hook nil - "Hook for functions attaching themselves to `C-c C-c'. - -This can be used to add additional functionality to the C-c C-c -key which executes context-dependent commands. This hook is run -after any other test, while `org-ctrl-c-ctrl-c-hook' is run -before the first test. - -Each function will be called with no arguments. The function -must check if the context is appropriate for it to act. If yes, -it should do its thing and then return a non-nil value. If the -context is wrong, just do nothing and return nil.") - -(defvar org-tab-first-hook nil - "Hook for functions to attach themselves to TAB. -See `org-ctrl-c-ctrl-c-hook' for more information. -This hook runs as the first action when TAB is pressed, even before -`org-cycle' messes around with the `outline-regexp' to cater for -inline tasks and plain list item folding. -If any function in this hook returns t, any other actions that -would have been caused by TAB (such as table field motion or visibility -cycling) will not occur.") - -(defvar org-tab-after-check-for-table-hook nil - "Hook for functions to attach themselves to TAB. -See `org-ctrl-c-ctrl-c-hook' for more information. -This hook runs after it has been established that the cursor is not in a -table, but before checking if the cursor is in a headline or if global cycling -should be done. -If any function in this hook returns t, not other actions like visibility -cycling will be done.") - -(defvar org-tab-after-check-for-cycling-hook nil - "Hook for functions to attach themselves to TAB. -See `org-ctrl-c-ctrl-c-hook' for more information. -This hook runs after it has been established that not table field motion and -not visibility should be done because of current context. This is probably -the place where a package like yasnippets can hook in.") - -(defvar org-tab-before-tab-emulation-hook nil - "Hook for functions to attach themselves to TAB. -See `org-ctrl-c-ctrl-c-hook' for more information. -This hook runs after every other options for TAB have been exhausted, but -before indentation and \t insertion takes place.") - -(defvar org-metaleft-hook nil - "Hook for functions attaching themselves to `M-left'. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-metaright-hook nil - "Hook for functions attaching themselves to `M-right'. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-metaup-hook nil - "Hook for functions attaching themselves to `M-up'. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-metadown-hook nil - "Hook for functions attaching themselves to `M-down'. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-shiftmetaleft-hook nil - "Hook for functions attaching themselves to `M-S-left'. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-shiftmetaright-hook nil - "Hook for functions attaching themselves to `M-S-right'. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-shiftmetaup-hook nil - "Hook for functions attaching themselves to `M-S-up'. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-shiftmetadown-hook nil - "Hook for functions attaching themselves to `M-S-down'. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-metareturn-hook nil - "Hook for functions attaching themselves to `M-RET'. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-shiftup-hook nil - "Hook for functions attaching themselves to `S-up'. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-shiftup-final-hook nil - "Hook for functions attaching themselves to `S-up'. -This one runs after all other options except shift-select have been excluded. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-shiftdown-hook nil - "Hook for functions attaching themselves to `S-down'. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-shiftdown-final-hook nil - "Hook for functions attaching themselves to `S-down'. -This one runs after all other options except shift-select have been excluded. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-shiftleft-hook nil - "Hook for functions attaching themselves to `S-left'. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-shiftleft-final-hook nil - "Hook for functions attaching themselves to `S-left'. -This one runs after all other options except shift-select have been excluded. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-shiftright-hook nil - "Hook for functions attaching themselves to `S-right'. -See `org-ctrl-c-ctrl-c-hook' for more information.") -(defvar org-shiftright-final-hook nil - "Hook for functions attaching themselves to `S-right'. -This one runs after all other options except shift-select have been excluded. -See `org-ctrl-c-ctrl-c-hook' for more information.") - -(defun org-modifier-cursor-error () - "Throw an error, a modified cursor command was applied in wrong context." - (user-error "This command is active in special context like tables, headlines or items")) - -(defun org-shiftselect-error () - "Throw an error because Shift-Cursor command was applied in wrong context." - (if (and (boundp 'shift-select-mode) shift-select-mode) - (user-error "To use shift-selection with Org-mode, customize `org-support-shift-select'") - (user-error "This command works only in special context like headlines or timestamps"))) - -(defun org-call-for-shift-select (cmd) - (let ((this-command-keys-shift-translated t)) - (call-interactively cmd))) - -(defun org-shifttab (&optional arg) - "Global visibility cycling or move to previous table field. -Call `org-table-previous-field' within a table. -When ARG is nil, cycle globally through visibility states. -When ARG is a numeric prefix, show contents of this level." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-previous-field)) - ((integerp arg) - (let ((arg2 (if org-odd-levels-only (1- (* 2 arg)) arg))) - (message "Content view to level: %d" arg) - (org-content (prefix-numeric-value arg2)) - (org-cycle-show-empty-lines t) - (setq org-cycle-global-status 'overview))) - (t (call-interactively 'org-global-cycle)))) - -(defun org-shiftmetaleft () - "Promote subtree or delete table column. -Calls `org-promote-subtree', `org-outdent-item-tree', or -`org-table-delete-column', depending on context. See the -individual commands for more information." - (interactive) - (cond - ((run-hook-with-args-until-success 'org-shiftmetaleft-hook)) - ((org-at-table-p) (call-interactively 'org-table-delete-column)) - ((org-at-heading-p) (call-interactively 'org-promote-subtree)) - ((if (not (org-region-active-p)) (org-at-item-p) - (save-excursion (goto-char (region-beginning)) - (org-at-item-p))) - (call-interactively 'org-outdent-item-tree)) - (t (org-modifier-cursor-error)))) - -(defun org-shiftmetaright () - "Demote subtree or insert table column. -Calls `org-demote-subtree', `org-indent-item-tree', or -`org-table-insert-column', depending on context. See the -individual commands for more information." - (interactive) - (cond - ((run-hook-with-args-until-success 'org-shiftmetaright-hook)) - ((org-at-table-p) (call-interactively 'org-table-insert-column)) - ((org-at-heading-p) (call-interactively 'org-demote-subtree)) - ((if (not (org-region-active-p)) (org-at-item-p) - (save-excursion (goto-char (region-beginning)) - (org-at-item-p))) - (call-interactively 'org-indent-item-tree)) - (t (org-modifier-cursor-error)))) - -(defun org-shiftmetaup (&optional arg) - "Move subtree up or kill table row. -Calls `org-move-subtree-up' or `org-table-kill-row' or -`org-move-item-up' or `org-timestamp-up', depending on context. -See the individual commands for more information." - (interactive "P") - (cond - ((run-hook-with-args-until-success 'org-shiftmetaup-hook)) - ((org-at-table-p) (call-interactively 'org-table-kill-row)) - ((org-at-heading-p) (call-interactively 'org-move-subtree-up)) - ((org-at-item-p) (call-interactively 'org-move-item-up)) - ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) - (call-interactively 'org-timestamp-up))) - (t (call-interactively 'org-drag-line-backward)))) - -(defun org-shiftmetadown (&optional arg) - "Move subtree down or insert table row. -Calls `org-move-subtree-down' or `org-table-insert-row' or -`org-move-item-down' or `org-timestamp-up', depending on context. -See the individual commands for more information." - (interactive "P") - (cond - ((run-hook-with-args-until-success 'org-shiftmetadown-hook)) - ((org-at-table-p) (call-interactively 'org-table-insert-row)) - ((org-at-heading-p) (call-interactively 'org-move-subtree-down)) - ((org-at-item-p) (call-interactively 'org-move-item-down)) - ((org-at-clock-log-p) (let ((org-clock-adjust-closest t)) - (call-interactively 'org-timestamp-down))) - (t (call-interactively 'org-drag-line-forward)))) - -(defsubst org-hidden-tree-error () - (user-error - "Hidden subtree, open with TAB or use subtree command M-S-<left>/<right>")) - -(defun org-metaleft (&optional arg) - "Promote heading or move table column to left. -Calls `org-do-promote' or `org-table-move-column', depending on context. -With no specific context, calls the Emacs default `backward-word'. -See the individual commands for more information." - (interactive "P") - (cond - ((run-hook-with-args-until-success 'org-metaleft-hook)) - ((org-at-table-p) (org-call-with-arg 'org-table-move-column 'left)) - ((org-with-limited-levels - (or (org-at-heading-p) - (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (org-at-heading-p))))) - (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) - (call-interactively 'org-do-promote)) - ;; At an inline task. - ((org-at-heading-p) - (call-interactively 'org-inlinetask-promote)) - ((or (org-at-item-p) - (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (org-at-item-p)))) - (when (org-check-for-hidden 'items) (org-hidden-tree-error)) - (call-interactively 'org-outdent-item)) - (t (call-interactively 'backward-word)))) - -(defun org-metaright (&optional arg) - "Demote a subtree, a list item or move table column to right. -In front of a drawer or a block keyword, indent it correctly. -With no specific context, calls the Emacs default `forward-word'. -See the individual commands for more information." - (interactive "P") - (cond - ((run-hook-with-args-until-success 'org-metaright-hook)) - ((org-at-table-p) (call-interactively 'org-table-move-column)) - ((org-at-drawer-p) (call-interactively 'org-indent-drawer)) - ((org-at-block-p) (call-interactively 'org-indent-block)) - ((org-with-limited-levels - (or (org-at-heading-p) - (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (org-at-heading-p))))) - (when (org-check-for-hidden 'headlines) (org-hidden-tree-error)) - (call-interactively 'org-do-demote)) - ;; At an inline task. - ((org-at-heading-p) - (call-interactively 'org-inlinetask-demote)) - ((or (org-at-item-p) - (and (org-region-active-p) - (save-excursion - (goto-char (region-beginning)) - (org-at-item-p)))) - (when (org-check-for-hidden 'items) (org-hidden-tree-error)) - (call-interactively 'org-indent-item)) - (t (call-interactively 'forward-word)))) - -(defun org-check-for-hidden (what) - "Check if there are hidden headlines/items in the current visual line. -WHAT can be either `headlines' or `items'. If the current line is -an outline or item heading and it has a folded subtree below it, -this function returns t, nil otherwise." - (let ((re (cond - ((eq what 'headlines) org-outline-regexp-bol) - ((eq what 'items) (org-item-beginning-re)) - (t (error "This should not happen")))) - beg end) - (save-excursion - (catch 'exit - (unless (org-region-active-p) - (setq beg (point-at-bol)) - (beginning-of-line 2) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (beginning-of-line 2)) - (setq end (point)) - (goto-char beg) - (goto-char (point-at-eol)) - (setq end (max end (point))) - (while (re-search-forward re end t) - (if (get-char-property (match-beginning 0) 'invisible) - (throw 'exit t)))) - nil)))) - -(defun org-metaup (&optional arg) - "Move subtree up or move table row up. -Calls `org-move-subtree-up' or `org-table-move-row' or -`org-move-item-up', depending on context. See the individual commands -for more information." - (interactive "P") - (cond - ((run-hook-with-args-until-success 'org-metaup-hook)) - ((org-region-active-p) - (let* ((a (min (region-beginning) (region-end))) - (b (1- (max (region-beginning) (region-end)))) - (c (save-excursion (goto-char a) - (move-beginning-of-line 0))) - (d (save-excursion (goto-char a) - (move-end-of-line 0) (point)))) - (transpose-regions a b c d) - (goto-char c))) - ((org-at-table-p) (org-call-with-arg 'org-table-move-row 'up)) - ((org-at-heading-p) (call-interactively 'org-move-subtree-up)) - ((org-at-item-p) (call-interactively 'org-move-item-up)) - (t (org-drag-element-backward)))) - -(defun org-metadown (&optional arg) - "Move subtree down or move table row down. -Calls `org-move-subtree-down' or `org-table-move-row' or -`org-move-item-down', depending on context. See the individual -commands for more information." - (interactive "P") - (cond - ((run-hook-with-args-until-success 'org-metadown-hook)) - ((org-region-active-p) - (let* ((a (min (region-beginning) (region-end))) - (b (max (region-beginning) (region-end))) - (c (save-excursion (goto-char b) - (move-beginning-of-line 1))) - (d (save-excursion (goto-char b) - (move-end-of-line 1) (1+ (point))))) - (transpose-regions a b c d) - (goto-char d))) - ((org-at-table-p) (call-interactively 'org-table-move-row)) - ((org-at-heading-p) (call-interactively 'org-move-subtree-down)) - ((org-at-item-p) (call-interactively 'org-move-item-down)) - (t (org-drag-element-forward)))) - -(defun org-shiftup (&optional arg) - "Increase item in timestamp or increase priority of current headline. -Calls `org-timestamp-up' or `org-priority-up', or `org-previous-item', -depending on context. See the individual commands for more information." - (interactive "P") - (cond - ((run-hook-with-args-until-success 'org-shiftup-hook)) - ((and org-support-shift-select (org-region-active-p)) - (org-call-for-shift-select 'previous-line)) - ((org-at-timestamp-p t) - (call-interactively (if org-edit-timestamp-down-means-later - 'org-timestamp-down 'org-timestamp-up))) - ((and (not (eq org-support-shift-select 'always)) - org-enable-priority-commands - (org-at-heading-p)) - (call-interactively 'org-priority-up)) - ((and (not org-support-shift-select) (org-at-item-p)) - (call-interactively 'org-previous-item)) - ((org-clocktable-try-shift 'up arg)) - ((run-hook-with-args-until-success 'org-shiftup-final-hook)) - (org-support-shift-select - (org-call-for-shift-select 'previous-line)) - (t (org-shiftselect-error)))) - -(defun org-shiftdown (&optional arg) - "Decrease item in timestamp or decrease priority of current headline. -Calls `org-timestamp-down' or `org-priority-down', or `org-next-item' -depending on context. See the individual commands for more information." - (interactive "P") - (cond - ((run-hook-with-args-until-success 'org-shiftdown-hook)) - ((and org-support-shift-select (org-region-active-p)) - (org-call-for-shift-select 'next-line)) - ((org-at-timestamp-p t) - (call-interactively (if org-edit-timestamp-down-means-later - 'org-timestamp-up 'org-timestamp-down))) - ((and (not (eq org-support-shift-select 'always)) - org-enable-priority-commands - (org-at-heading-p)) - (call-interactively 'org-priority-down)) - ((and (not org-support-shift-select) (org-at-item-p)) - (call-interactively 'org-next-item)) - ((org-clocktable-try-shift 'down arg)) - ((run-hook-with-args-until-success 'org-shiftdown-final-hook)) - (org-support-shift-select - (org-call-for-shift-select 'next-line)) - (t (org-shiftselect-error)))) - -(defun org-shiftright (&optional arg) - "Cycle the thing at point or in the current line, depending on context. -Depending on context, this does one of the following: - -- switch a timestamp at point one day into the future -- on a headline, switch to the next TODO keyword. -- on an item, switch entire list to the next bullet type -- on a property line, switch to the next allowed value -- on a clocktable definition line, move time block into the future" - (interactive "P") - (cond - ((run-hook-with-args-until-success 'org-shiftright-hook)) - ((and org-support-shift-select (org-region-active-p)) - (org-call-for-shift-select 'forward-char)) - ((org-at-timestamp-p t) (call-interactively 'org-timestamp-up-day)) - ((and (not (eq org-support-shift-select 'always)) - (org-at-heading-p)) - (let ((org-inhibit-logging - (not org-treat-S-cursor-todo-selection-as-state-change)) - (org-inhibit-blocking - (not org-treat-S-cursor-todo-selection-as-state-change))) - (org-call-with-arg 'org-todo 'right))) - ((or (and org-support-shift-select - (not (eq org-support-shift-select 'always)) - (org-at-item-bullet-p)) - (and (not org-support-shift-select) (org-at-item-p))) - (org-call-with-arg 'org-cycle-list-bullet nil)) - ((and (not (eq org-support-shift-select 'always)) - (org-at-property-p)) - (call-interactively 'org-property-next-allowed-value)) - ((org-clocktable-try-shift 'right arg)) - ((run-hook-with-args-until-success 'org-shiftright-final-hook)) - (org-support-shift-select - (org-call-for-shift-select 'forward-char)) - (t (org-shiftselect-error)))) - -(defun org-shiftleft (&optional arg) - "Cycle the thing at point or in the current line, depending on context. -Depending on context, this does one of the following: - -- switch a timestamp at point one day into the past -- on a headline, switch to the previous TODO keyword. -- on an item, switch entire list to the previous bullet type -- on a property line, switch to the previous allowed value -- on a clocktable definition line, move time block into the past" - (interactive "P") - (cond - ((run-hook-with-args-until-success 'org-shiftleft-hook)) - ((and org-support-shift-select (org-region-active-p)) - (org-call-for-shift-select 'backward-char)) - ((org-at-timestamp-p t) (call-interactively 'org-timestamp-down-day)) - ((and (not (eq org-support-shift-select 'always)) - (org-at-heading-p)) - (let ((org-inhibit-logging - (not org-treat-S-cursor-todo-selection-as-state-change)) - (org-inhibit-blocking - (not org-treat-S-cursor-todo-selection-as-state-change))) - (org-call-with-arg 'org-todo 'left))) - ((or (and org-support-shift-select - (not (eq org-support-shift-select 'always)) - (org-at-item-bullet-p)) - (and (not org-support-shift-select) (org-at-item-p))) - (org-call-with-arg 'org-cycle-list-bullet 'previous)) - ((and (not (eq org-support-shift-select 'always)) - (org-at-property-p)) - (call-interactively 'org-property-previous-allowed-value)) - ((org-clocktable-try-shift 'left arg)) - ((run-hook-with-args-until-success 'org-shiftleft-final-hook)) - (org-support-shift-select - (org-call-for-shift-select 'backward-char)) - (t (org-shiftselect-error)))) - -(defun org-shiftcontrolright () - "Switch to next TODO set." - (interactive) - (cond - ((and org-support-shift-select (org-region-active-p)) - (org-call-for-shift-select 'forward-word)) - ((and (not (eq org-support-shift-select 'always)) - (org-at-heading-p)) - (org-call-with-arg 'org-todo 'nextset)) - (org-support-shift-select - (org-call-for-shift-select 'forward-word)) - (t (org-shiftselect-error)))) - -(defun org-shiftcontrolleft () - "Switch to previous TODO set." - (interactive) - (cond - ((and org-support-shift-select (org-region-active-p)) - (org-call-for-shift-select 'backward-word)) - ((and (not (eq org-support-shift-select 'always)) - (org-at-heading-p)) - (org-call-with-arg 'org-todo 'previousset)) - (org-support-shift-select - (org-call-for-shift-select 'backward-word)) - (t (org-shiftselect-error)))) - -(defun org-shiftcontrolup (&optional n) - "Change timestamps synchronously up in CLOCK log lines. -Optional argument N tells to change by that many units." - (interactive "P") - (cond ((and (not org-support-shift-select) - (org-at-clock-log-p) - (org-at-timestamp-p t)) - (org-clock-timestamps-up n)) - (t (org-shiftselect-error)))) - -(defun org-shiftcontroldown (&optional n) - "Change timestamps synchronously down in CLOCK log lines. -Optional argument N tells to change by that many units." - (interactive "P") - (cond ((and (not org-support-shift-select) - (org-at-clock-log-p) - (org-at-timestamp-p t)) - (org-clock-timestamps-down n)) - (t (org-shiftselect-error)))) - -(defun org-ctrl-c-ret () - "Call `org-table-hline-and-move' or `org-insert-heading' dep. on context." - (interactive) - (cond - ((org-at-table-p) (call-interactively 'org-table-hline-and-move)) - (t (call-interactively 'org-insert-heading)))) - -(defun org-find-visible () - (let ((s (point))) - (while (and (not (= (point-max) (setq s (next-overlay-change s)))) - (get-char-property s 'invisible))) - s)) -(defun org-find-invisible () - (let ((s (point))) - (while (and (not (= (point-max) (setq s (next-overlay-change s)))) - (not (get-char-property s 'invisible)))) - s)) - -(defun org-copy-visible (beg end) - "Copy the visible parts of the region." - (interactive "r") - (let (snippets s) - (save-excursion - (save-restriction - (narrow-to-region beg end) - (setq s (goto-char (point-min))) - (while (not (= (point) (point-max))) - (goto-char (org-find-invisible)) - (push (buffer-substring s (point)) snippets) - (setq s (goto-char (org-find-visible)))))) - (kill-new (apply 'concat (nreverse snippets))))) - -(defun org-copy-special () - "Copy region in table or copy current subtree. -Calls `org-table-copy' or `org-copy-subtree', depending on context. -See the individual commands for more information." - (interactive) - (call-interactively - (if (org-at-table-p) 'org-table-copy-region 'org-copy-subtree))) - -(defun org-cut-special () - "Cut region in table or cut current subtree. -Calls `org-table-copy' or `org-cut-subtree', depending on context. -See the individual commands for more information." - (interactive) - (call-interactively - (if (org-at-table-p) 'org-table-cut-region 'org-cut-subtree))) - -(defun org-paste-special (arg) - "Paste rectangular region into table, or past subtree relative to level. -Calls `org-table-paste-rectangle' or `org-paste-subtree', depending on context. -See the individual commands for more information." - (interactive "P") - (if (org-at-table-p) - (org-table-paste-rectangle) - (org-paste-subtree arg))) - -(defsubst org-in-fixed-width-region-p () - "Is point in a fixed-width region?" - (save-match-data - (eq 'fixed-width (org-element-type (org-element-at-point))))) - -(defun org-edit-special (&optional arg) - "Call a special editor for the element at point. -When at a table, call the formula editor with `org-table-edit-formulas'. -When in a source code block, call `org-edit-src-code'. -When in a fixed-width region, call `org-edit-fixed-width-region'. -When at an #+INCLUDE keyword, visit the included file. -On a link, call `ffap' to visit the link at point. -Otherwise, return a user error." - (interactive "P") - (let ((element (org-element-at-point))) - (assert (not buffer-read-only) nil - "Buffer is read-only: %s" (buffer-name)) - (case (org-element-type element) - (src-block - (if (not arg) (org-edit-src-code) - (let* ((info (org-babel-get-src-block-info)) - (lang (nth 0 info)) - (params (nth 2 info)) - (session (cdr (assq :session params)))) - (if (not session) (org-edit-src-code) - ;; At a src-block with a session and function called with - ;; an ARG: switch to the buffer related to the inferior - ;; process. - (switch-to-buffer - (funcall (intern (concat "org-babel-prep-session:" lang)) - session params)))))) - (keyword - (if (member (org-element-property :key element) '("INCLUDE" "SETUPFILE")) - (find-file - (org-remove-double-quotes - (car (org-split-string (org-element-property :value element))))) - (user-error "No special environment to edit here"))) - (table - (if (eq (org-element-property :type element) 'table.el) - (org-edit-src-code) - (call-interactively 'org-table-edit-formulas))) - ;; Only Org tables contain `table-row' type elements. - (table-row (call-interactively 'org-table-edit-formulas)) - ((example-block export-block) (org-edit-src-code)) - (fixed-width (org-edit-fixed-width-region)) - (otherwise - ;; No notable element at point. Though, we may be at a link, - ;; which is an object. Thus, scan deeper. - (if (eq (org-element-type (org-element-context element)) 'link) - (call-interactively 'ffap) - (user-error "No special environment to edit here")))))) - -(defvar org-table-coordinate-overlays) ; defined in org-table.el -(defun org-ctrl-c-ctrl-c (&optional arg) - "Set tags in headline, or update according to changed information at point. - -This command does many different things, depending on context: - -- If a function in `org-ctrl-c-ctrl-c-hook' recognizes this location, - this is what we do. - -- If the cursor is on a statistics cookie, update it. - -- If the cursor is in a headline, prompt for tags and insert them - into the current line, aligned to `org-tags-column'. When called - with prefix arg, realign all tags in the current buffer. - -- If the cursor is in one of the special #+KEYWORD lines, this - triggers scanning the buffer for these lines and updating the - information. - -- If the cursor is inside a table, realign the table. This command - works even if the automatic table editor has been turned off. - -- If the cursor is on a #+TBLFM line, re-apply the formulas to - the entire table. - -- If the cursor is at a footnote reference or definition, jump to - the corresponding definition or references, respectively. - -- If the cursor is a the beginning of a dynamic block, update it. - -- If the current buffer is a capture buffer, close note and file it. - -- If the cursor is on a <<<target>>>, update radio targets and - corresponding links in this buffer. - -- If the cursor is on a numbered item in a plain list, renumber the - ordered list. - -- If the cursor is on a checkbox, toggle it. - -- If the cursor is on a code block, evaluate it. The variable - `org-confirm-babel-evaluate' can be used to control prompting - before code block evaluation, by default every code block - evaluation requires confirmation. Code block evaluation can be - inhibited by setting `org-babel-no-eval-on-ctrl-c-ctrl-c'." - (interactive "P") - (cond - ((or (and (boundp 'org-clock-overlays) org-clock-overlays) - org-occur-highlights - org-latex-fragment-image-overlays) - (and (boundp 'org-clock-overlays) (org-clock-remove-overlays)) - (org-remove-occur-highlights) - (org-remove-latex-fragment-image-overlays) - (message "Temporary highlights/overlays removed from current buffer")) - ((and (local-variable-p 'org-finish-function (current-buffer)) - (fboundp org-finish-function)) - (funcall org-finish-function)) - ((run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-hook)) - (t - (let* ((context (org-element-context)) (type (org-element-type context))) - ;; Test if point is within a blank line. - (if (save-excursion (beginning-of-line) (looking-at "[ \t]*$")) - (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) - (user-error "C-c C-c can do nothing useful at this location")) - ;; When at a link, act according to the parent instead. - (when (eq type 'link) - (setq context (org-element-property :parent context)) - (setq type (org-element-type context))) - ;; For convenience: at the first line of a paragraph on the - ;; same line as an item, apply function on that item instead. - (when (eq type 'paragraph) - (let ((parent (org-element-property :parent context))) - (when (and (eq (org-element-type parent) 'item) - (= (point-at-bol) (org-element-property :begin parent))) - (setq context parent type 'item)))) - ;; Act according to type of element or object at point. - (case type - (clock (org-clock-update-time-maybe)) - (dynamic-block - (save-excursion - (goto-char (org-element-property :post-affiliated context)) - (org-update-dblock))) - (footnote-definition - (goto-char (org-element-property :post-affiliated context)) - (call-interactively 'org-footnote-action)) - (footnote-reference (call-interactively 'org-footnote-action)) - ((headline inlinetask) - (save-excursion (goto-char (org-element-property :begin context)) - (call-interactively 'org-set-tags))) - (item - ;; At an item: a double C-u set checkbox to "[-]" - ;; unconditionally, whereas a single one will toggle its - ;; presence. Without an universal argument, if the item - ;; has a checkbox, toggle it. Otherwise repair the list. - (let* ((box (org-element-property :checkbox context)) - (struct (org-element-property :structure context)) - (old-struct (copy-tree struct)) - (parents (org-list-parents-alist struct)) - (prevs (org-list-prevs-alist struct)) - (orderedp (org-not-nil (org-entry-get nil "ORDERED")))) - (org-list-set-checkbox - (org-element-property :begin context) struct - (cond ((equal arg '(16)) "[-]") - ((and (not box) (equal arg '(4))) "[ ]") - ((or (not box) (equal arg '(4))) nil) - ((eq box 'on) "[ ]") - (t "[X]"))) - ;; Mimic `org-list-write-struct' but with grabbing - ;; a return value from `org-list-struct-fix-box'. - (org-list-struct-fix-ind struct parents 2) - (org-list-struct-fix-item-end struct) - (org-list-struct-fix-bul struct prevs) - (org-list-struct-fix-ind struct parents) - (let ((block-item - (org-list-struct-fix-box struct parents prevs orderedp))) - (if (and box (equal struct old-struct)) - (if (equal arg '(16)) - (message "Checkboxes already reset") - (user-error "Cannot toggle this checkbox: %s" - (if (eq box 'on) - "all subitems checked" - "unchecked subitems"))) - (org-list-struct-apply-struct struct old-struct) - (org-update-checkbox-count-maybe)) - (when block-item - (message "Checkboxes were removed due to empty box at line %d" - (org-current-line block-item)))))) - (keyword - (let ((org-inhibit-startup-visibility-stuff t) - (org-startup-align-all-tables nil)) - (when (boundp 'org-table-coordinate-overlays) - (mapc 'delete-overlay org-table-coordinate-overlays) - (setq org-table-coordinate-overlays nil)) - (org-save-outline-visibility 'use-markers (org-mode-restart))) - (message "Local setup has been refreshed")) - (plain-list - ;; At a plain list, with a double C-u argument, set - ;; checkboxes of each item to "[-]", whereas a single one - ;; will toggle their presence according to the state of the - ;; first item in the list. Without an argument, repair the - ;; list. - (let* ((begin (org-element-property :contents-begin context)) - (beginm (move-marker (make-marker) begin)) - (struct (org-element-property :structure context)) - (old-struct (copy-tree struct)) - (first-box (save-excursion - (goto-char begin) - (looking-at org-list-full-item-re) - (match-string-no-properties 3))) - (new-box (cond ((equal arg '(16)) "[-]") - ((equal arg '(4)) (unless first-box "[ ]")) - ((equal first-box "[X]") "[ ]") - (t "[X]")))) - (cond - (arg - (mapc (lambda (pos) (org-list-set-checkbox pos struct new-box)) - (org-list-get-all-items - begin struct (org-list-prevs-alist struct)))) - ((and first-box (eq (point) begin)) - ;; For convenience, when point is at bol on the first - ;; item of the list and no argument is provided, simply - ;; toggle checkbox of that item, if any. - (org-list-set-checkbox begin struct new-box))) - (org-list-write-struct - struct (org-list-parents-alist struct) old-struct) - (org-update-checkbox-count-maybe) - (save-excursion (goto-char beginm) (org-list-send-list 'maybe)))) - ((property-drawer node-property) - (call-interactively 'org-property-action)) - ((radio-target target) - (call-interactively 'org-update-radio-target-regexp)) - (statistics-cookie - (call-interactively 'org-update-statistics-cookies)) - ((table table-cell table-row) - ;; At a table, recalculate every field and align it. Also - ;; send the table if necessary. If the table has - ;; a `table.el' type, just give up. At a table row or - ;; cell, maybe recalculate line but always align table. - (if (eq (org-element-property :type context) 'table.el) - (message "Use C-c ' to edit table.el tables") - (let ((org-enable-table-editor t)) - (if (or (eq type 'table) - ;; Check if point is at a TBLFM line. - (and (eq type 'table-row) - (= (point) (org-element-property :end context)))) - (save-excursion - (if (org-at-TBLFM-p) - (progn (require 'org-table) - (org-table-calc-current-TBLFM)) - (goto-char (org-element-property :contents-begin context)) - (org-call-with-arg 'org-table-recalculate (or arg t)) - (orgtbl-send-table 'maybe))) - (org-table-maybe-eval-formula) - (cond (arg (call-interactively 'org-table-recalculate)) - ((org-table-maybe-recalculate-line)) - (t (org-table-align))))))) - (timestamp (org-timestamp-change 0 'day)) - (otherwise - (or (run-hook-with-args-until-success 'org-ctrl-c-ctrl-c-final-hook) - (user-error - "C-c C-c can do nothing useful at this location"))))))))) - -(defun org-mode-restart () - "Restart Org-mode, to scan again for special lines. -Also updates the keyword regular expressions." - (interactive) - (org-mode) - (message "Org-mode restarted")) - -(defun org-kill-note-or-show-branches () - "If this is a Note buffer, abort storing the note. Else call `show-branches'." - (interactive) - (if (not org-finish-function) - (progn - (hide-subtree) - (call-interactively 'show-branches)) - (let ((org-note-abort t)) - (funcall org-finish-function)))) - -(defun org-open-line (n) - "Insert a new row in tables, call `open-line' elsewhere. -If `org-special-ctrl-o' is nil, just call `open-line' everywhere." - (interactive "*p") - (cond - ((not org-special-ctrl-o) - (open-line n)) - ((org-at-table-p) - (org-table-insert-row)) - (t - (open-line n)))) - -(defun org-return (&optional indent) - "Goto next table row or insert a newline. -Calls `org-table-next-row' or `newline', depending on context. -See the individual commands for more information." - (interactive) - (let (org-ts-what) - (cond - ((or (bobp) (org-in-src-block-p)) - (if indent (newline-and-indent) (newline))) - ((org-at-table-p) - (org-table-justify-field-maybe) - (call-interactively 'org-table-next-row)) - ;; when `newline-and-indent' is called within a list, make sure - ;; text moved stays inside the item. - ((and (org-in-item-p) indent) - (if (and (org-at-item-p) (>= (point) (match-end 0))) - (progn - (save-match-data (newline)) - (org-indent-line-to (length (match-string 0)))) - (let ((ind (org-get-indentation))) - (newline) - (if (org-looking-back org-list-end-re) - (org-indent-line) - (org-indent-line-to ind))))) - ((and org-return-follows-link - (org-at-timestamp-p t) - (not (eq org-ts-what 'after))) - (org-follow-timestamp-link)) - ((and org-return-follows-link - (let ((tprop (get-text-property (point) 'face))) - (or (eq tprop 'org-link) - (and (listp tprop) (memq 'org-link tprop))))) - (call-interactively 'org-open-at-point)) - ((and (org-at-heading-p) - (looking-at - (org-re "\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$"))) - (org-show-entry) - (end-of-line 1) - (newline)) - (t (if indent (newline-and-indent) (newline)))))) - -(defun org-return-indent () - "Goto next table row or insert a newline and indent. -Calls `org-table-next-row' or `newline-and-indent', depending on -context. See the individual commands for more information." - (interactive) - (org-return t)) - -(defun org-ctrl-c-star () - "Compute table, or change heading status of lines. -Calls `org-table-recalculate' or `org-toggle-heading', -depending on context." - (interactive) - (cond - ((org-at-table-p) - (call-interactively 'org-table-recalculate)) - (t - ;; Convert all lines in region to list items - (call-interactively 'org-toggle-heading)))) - -(defun org-ctrl-c-minus () - "Insert separator line in table or modify bullet status of line. -Also turns a plain line or a region of lines into list items. -Calls `org-table-insert-hline', `org-toggle-item', or -`org-cycle-list-bullet', depending on context." - (interactive) - (cond - ((org-at-table-p) - (call-interactively 'org-table-insert-hline)) - ((org-region-active-p) - (call-interactively 'org-toggle-item)) - ((org-in-item-p) - (call-interactively 'org-cycle-list-bullet)) - (t - (call-interactively 'org-toggle-item)))) - -(defun org-toggle-item (arg) - "Convert headings or normal lines to items, items to normal lines. -If there is no active region, only the current line is considered. - -If the first non blank line in the region is a headline, convert -all headlines to items, shifting text accordingly. - -If it is an item, convert all items to normal lines. - -If it is normal text, change region into a list of items. -With a prefix argument ARG, change the region in a single item." - (interactive "P") - (let ((shift-text - (function - ;; Shift text in current section to IND, from point to END. - ;; The function leaves point to END line. - (lambda (ind end) - (let ((min-i 1000) (end (copy-marker end))) - ;; First determine the minimum indentation (MIN-I) of - ;; the text. - (save-excursion - (catch 'exit - (while (< (point) end) - (let ((i (org-get-indentation))) - (cond - ;; Skip blank lines and inline tasks. - ((looking-at "^[ \t]*$")) - ((looking-at org-outline-regexp-bol)) - ;; We can't find less than 0 indentation. - ((zerop i) (throw 'exit (setq min-i 0))) - ((< i min-i) (setq min-i i)))) - (forward-line)))) - ;; Then indent each line so that a line indented to - ;; MIN-I becomes indented to IND. Ignore blank lines - ;; and inline tasks in the process. - (let ((delta (- ind min-i))) - (while (< (point) end) - (unless (or (looking-at "^[ \t]*$") - (looking-at org-outline-regexp-bol)) - (org-indent-line-to (+ (org-get-indentation) delta))) - (forward-line))))))) - (skip-blanks - (function - ;; Return beginning of first non-blank line, starting from - ;; line at POS. - (lambda (pos) - (save-excursion - (goto-char pos) - (skip-chars-forward " \r\t\n") - (point-at-bol))))) - beg end) - ;; Determine boundaries of changes. - (if (org-region-active-p) - (setq beg (funcall skip-blanks (region-beginning)) - end (copy-marker (region-end))) - (setq beg (funcall skip-blanks (point-at-bol)) - end (copy-marker (point-at-eol)))) - ;; Depending on the starting line, choose an action on the text - ;; between BEG and END. - (org-with-limited-levels - (save-excursion - (goto-char beg) - (cond - ;; Case 1. Start at an item: de-itemize. Note that it only - ;; happens when a region is active: `org-ctrl-c-minus' - ;; would call `org-cycle-list-bullet' otherwise. - ((org-at-item-p) - (while (< (point) end) - (when (org-at-item-p) - (skip-chars-forward " \t") - (delete-region (point) (match-end 0))) - (forward-line))) - ;; Case 2. Start at an heading: convert to items. - ((org-at-heading-p) - (let* ((bul (org-list-bullet-string "-")) - (bul-len (length bul)) - ;; Indentation of the first heading. It should be - ;; relative to the indentation of its parent, if any. - (start-ind (save-excursion - (cond - ((not org-adapt-indentation) 0) - ((not (outline-previous-heading)) 0) - (t (length (match-string 0)))))) - ;; Level of first heading. Further headings will be - ;; compared to it to determine hierarchy in the list. - (ref-level (org-reduced-level (org-outline-level)))) - (while (< (point) end) - (let* ((level (org-reduced-level (org-outline-level))) - (delta (max 0 (- level ref-level)))) - ;; If current headline is less indented than the first - ;; one, set it as reference, in order to preserve - ;; subtrees. - (when (< level ref-level) (setq ref-level level)) - (replace-match bul t t) - (org-indent-line-to (+ start-ind (* delta bul-len))) - ;; Ensure all text down to END (or SECTION-END) belongs - ;; to the newly created item. - (let ((section-end (save-excursion - (or (outline-next-heading) (point))))) - (forward-line) - (funcall shift-text - (+ start-ind (* (1+ delta) bul-len)) - (min end section-end))))))) - ;; Case 3. Normal line with ARG: make the first line of region - ;; an item, and shift indentation of others lines to - ;; set them as item's body. - (arg (let* ((bul (org-list-bullet-string "-")) - (bul-len (length bul)) - (ref-ind (org-get-indentation))) - (skip-chars-forward " \t") - (insert bul) - (forward-line) - (while (< (point) end) - ;; Ensure that lines less indented than first one - ;; still get included in item body. - (funcall shift-text - (+ ref-ind bul-len) - (min end (save-excursion (or (outline-next-heading) - (point))))) - (forward-line)))) - ;; Case 4. Normal line without ARG: turn each non-item line - ;; into an item. - (t - (while (< (point) end) - (unless (or (org-at-heading-p) (org-at-item-p)) - (if (looking-at "\\([ \t]*\\)\\(\\S-\\)") - (replace-match - (concat "\\1" (org-list-bullet-string "-") "\\2")))) - (forward-line)))))))) - -(defun org-toggle-heading (&optional nstars) - "Convert headings to normal text, or items or text to headings. -If there is no active region, only convert the current line. - -With a \\[universal-argument] prefix, convert the whole list at -point into heading. - -In a region: - -- If the first non blank line is a headline, remove the stars - from all headlines in the region. - -- If it is a normal line, turn each and every normal line (i.e., - not an heading or an item) in the region into headings. If you - want to convert only the first line of this region, use one - universal prefix argument. - -- If it is a plain list item, turn all plain list items into headings. - -When converting a line into a heading, the number of stars is chosen -such that the lines become children of the current entry. However, -when a numeric prefix argument is given, its value determines the -number of stars to add." - (interactive "P") - (let ((skip-blanks - (function - ;; Return beginning of first non-blank line, starting from - ;; line at POS. - (lambda (pos) - (save-excursion - (goto-char pos) - (while (org-at-comment-p) (forward-line)) - (skip-chars-forward " \r\t\n") - (point-at-bol))))) - beg end toggled) - ;; Determine boundaries of changes. If a universal prefix has - ;; been given, put the list in a region. If region ends at a bol, - ;; do not consider the last line to be in the region. - - (when (and current-prefix-arg (org-at-item-p)) - (if (listp current-prefix-arg) (setq current-prefix-arg 1)) - (org-mark-element)) - - (if (org-region-active-p) - (setq beg (funcall skip-blanks (region-beginning)) - end (copy-marker (save-excursion - (goto-char (region-end)) - (if (bolp) (point) (point-at-eol))))) - (setq beg (funcall skip-blanks (point-at-bol)) - end (copy-marker (point-at-eol)))) - ;; Ensure inline tasks don't count as headings. - (org-with-limited-levels - (save-excursion - (goto-char beg) - (cond - ;; Case 1. Started at an heading: de-star headings. - ((org-at-heading-p) - (while (< (point) end) - (when (org-at-heading-p t) - (looking-at org-outline-regexp) (replace-match "") - (setq toggled t)) - (forward-line))) - ;; Case 2. Started at an item: change items into headlines. - ;; One star will be added by `org-list-to-subtree'. - ((org-at-item-p) - (let* ((stars (make-string - ;; subtract the star that will be added again by - ;; `org-list-to-subtree' - (if (numberp nstars) (1- nstars) - (or (org-current-level) 0)) - ?*)) - (add-stars - (cond (nstars "") ; stars from prefix only - ((equal stars "") "") ; before first heading - (org-odd-levels-only "*") ; inside heading, odd - (t "")))) ; inside heading, oddeven - (while (< (point) end) - (when (org-at-item-p) - ;; Pay attention to cases when region ends before list. - (let* ((struct (org-list-struct)) - (list-end (min (org-list-get-bottom-point struct) (1+ end)))) - (save-restriction - (narrow-to-region (point) list-end) - (insert - (org-list-to-subtree - (org-list-parse-list t) - '(:istart (concat stars add-stars (funcall get-stars depth)) - :icount (concat stars add-stars (funcall get-stars depth))))))) - (setq toggled t)) - (forward-line)))) - ;; Case 3. Started at normal text: make every line an heading, - ;; skipping headlines and items. - (t (let* ((stars - (make-string - (if (numberp nstars) nstars (or (org-current-level) 0)) ?*)) - (add-stars - (cond (nstars "") ; stars from prefix only - ((equal stars "") "*") ; before first heading - (org-odd-levels-only "**") ; inside heading, odd - (t "*"))) ; inside heading, oddeven - (rpl (concat stars add-stars " ")) - (lend (if (listp nstars) (save-excursion (end-of-line) (point))))) - (while (< (point) (if (equal nstars '(4)) lend end)) - (when (and (not (or (org-at-heading-p) (org-at-item-p) (org-at-comment-p))) - (looking-at "\\([ \t]*\\)\\(\\S-\\)")) - (replace-match (concat rpl (match-string 2))) (setq toggled t)) - (forward-line))))))) - (unless toggled (message "Cannot toggle heading from here")))) - -(defun org-meta-return (&optional arg) - "Insert a new heading or wrap a region in a table. -Calls `org-insert-heading' or `org-table-wrap-region', depending -on context. See the individual commands for more information." - (interactive "P") - (org-check-before-invisible-edit 'insert) - (or (run-hook-with-args-until-success 'org-metareturn-hook) - (let* ((element (org-element-at-point)) - (type (org-element-type element))) - (when (eq type 'table-row) - (setq element (org-element-property :parent element)) - (setq type 'table)) - (if (and (eq type 'table) - (eq (org-element-property :type element) 'org) - (>= (point) (org-element-property :contents-begin element)) - (< (point) (org-element-property :contents-end element))) - (call-interactively 'org-table-wrap-region) - (call-interactively 'org-insert-heading))))) - -;;; Menu entries - -(defsubst org-in-subtree-not-table-p () - "Are we in a subtree and not in a table?" - (and (not (org-before-first-heading-p)) - (not (org-at-table-p)))) - -;; Define the Org-mode menus -(easy-menu-define org-tbl-menu org-mode-map "Tbl menu" - '("Tbl" - ["Align" org-ctrl-c-ctrl-c :active (org-at-table-p)] - ["Next Field" org-cycle (org-at-table-p)] - ["Previous Field" org-shifttab (org-at-table-p)] - ["Next Row" org-return (org-at-table-p)] - "--" - ["Blank Field" org-table-blank-field (org-at-table-p)] - ["Edit Field" org-table-edit-field (org-at-table-p)] - ["Copy Field from Above" org-table-copy-down (org-at-table-p)] - "--" - ("Column" - ["Move Column Left" org-metaleft (org-at-table-p)] - ["Move Column Right" org-metaright (org-at-table-p)] - ["Delete Column" org-shiftmetaleft (org-at-table-p)] - ["Insert Column" org-shiftmetaright (org-at-table-p)]) - ("Row" - ["Move Row Up" org-metaup (org-at-table-p)] - ["Move Row Down" org-metadown (org-at-table-p)] - ["Delete Row" org-shiftmetaup (org-at-table-p)] - ["Insert Row" org-shiftmetadown (org-at-table-p)] - ["Sort lines in region" org-table-sort-lines (org-at-table-p)] - "--" - ["Insert Hline" org-ctrl-c-minus (org-at-table-p)]) - ("Rectangle" - ["Copy Rectangle" org-copy-special (org-at-table-p)] - ["Cut Rectangle" org-cut-special (org-at-table-p)] - ["Paste Rectangle" org-paste-special (org-at-table-p)] - ["Fill Rectangle" org-table-wrap-region (org-at-table-p)]) - "--" - ("Calculate" - ["Set Column Formula" org-table-eval-formula (org-at-table-p)] - ["Set Field Formula" (org-table-eval-formula '(4)) :active (org-at-table-p) :keys "C-u C-c ="] - ["Edit Formulas" org-edit-special (org-at-table-p)] - "--" - ["Recalculate line" org-table-recalculate (org-at-table-p)] - ["Recalculate all" (lambda () (interactive) (org-table-recalculate '(4))) :active (org-at-table-p) :keys "C-u C-c *"] - ["Iterate all" (lambda () (interactive) (org-table-recalculate '(16))) :active (org-at-table-p) :keys "C-u C-u C-c *"] - "--" - ["Toggle Recalculate Mark" org-table-rotate-recalc-marks (org-at-table-p)] - "--" - ["Sum Column/Rectangle" org-table-sum - (or (org-at-table-p) (org-region-active-p))] - ["Which Column?" org-table-current-column (org-at-table-p)]) - ["Debug Formulas" - org-table-toggle-formula-debugger - :style toggle :selected (org-bound-and-true-p org-table-formula-debug)] - ["Show Col/Row Numbers" - org-table-toggle-coordinate-overlays - :style toggle - :selected (org-bound-and-true-p org-table-overlay-coordinates)] - "--" - ["Create" org-table-create (and (not (org-at-table-p)) - org-enable-table-editor)] - ["Convert Region" org-table-convert-region (not (org-at-table-p 'any))] - ["Import from File" org-table-import (not (org-at-table-p))] - ["Export to File" org-table-export (org-at-table-p)] - "--" - ["Create/Convert from/to table.el" org-table-create-with-table.el t])) - -(easy-menu-define org-org-menu org-mode-map "Org menu" - '("Org" - ("Show/Hide" - ["Cycle Visibility" org-cycle :active (or (bobp) (outline-on-heading-p))] - ["Cycle Global Visibility" org-shifttab :active (not (org-at-table-p))] - ["Sparse Tree..." org-sparse-tree t] - ["Reveal Context" org-reveal t] - ["Show All" show-all t] - "--" - ["Subtree to indirect buffer" org-tree-to-indirect-buffer t]) - "--" - ["New Heading" org-insert-heading t] - ("Navigate Headings" - ["Up" outline-up-heading t] - ["Next" outline-next-visible-heading t] - ["Previous" outline-previous-visible-heading t] - ["Next Same Level" outline-forward-same-level t] - ["Previous Same Level" outline-backward-same-level t] - "--" - ["Jump" org-goto t]) - ("Edit Structure" - ["Refile Subtree" org-refile (org-in-subtree-not-table-p)] - "--" - ["Move Subtree Up" org-shiftmetaup (org-in-subtree-not-table-p)] - ["Move Subtree Down" org-shiftmetadown (org-in-subtree-not-table-p)] - "--" - ["Copy Subtree" org-copy-special (org-in-subtree-not-table-p)] - ["Cut Subtree" org-cut-special (org-in-subtree-not-table-p)] - ["Paste Subtree" org-paste-special (not (org-at-table-p))] - "--" - ["Clone subtree, shift time" org-clone-subtree-with-time-shift t] - "--" - ["Copy visible text" org-copy-visible t] - "--" - ["Promote Heading" org-metaleft (org-in-subtree-not-table-p)] - ["Promote Subtree" org-shiftmetaleft (org-in-subtree-not-table-p)] - ["Demote Heading" org-metaright (org-in-subtree-not-table-p)] - ["Demote Subtree" org-shiftmetaright (org-in-subtree-not-table-p)] - "--" - ["Sort Region/Children" org-sort t] - "--" - ["Convert to odd levels" org-convert-to-odd-levels t] - ["Convert to odd/even levels" org-convert-to-oddeven-levels t]) - ("Editing" - ["Emphasis..." org-emphasize t] - ["Edit Source Example" org-edit-special t] - "--" - ["Footnote new/jump" org-footnote-action t] - ["Footnote extra" (org-footnote-action t) :active t :keys "C-u C-c C-x f"]) - ("Archive" - ["Archive (default method)" org-archive-subtree-default (org-in-subtree-not-table-p)] - "--" - ["Move Subtree to Archive file" org-advertized-archive-subtree (org-in-subtree-not-table-p)] - ["Toggle ARCHIVE tag" org-toggle-archive-tag (org-in-subtree-not-table-p)] - ["Move subtree to Archive sibling" org-archive-to-archive-sibling (org-in-subtree-not-table-p)] - ) - "--" - ("Hyperlinks" - ["Store Link (Global)" org-store-link t] - ["Find existing link to here" org-occur-link-in-agenda-files t] - ["Insert Link" org-insert-link t] - ["Follow Link" org-open-at-point t] - "--" - ["Next link" org-next-link t] - ["Previous link" org-previous-link t] - "--" - ["Descriptive Links" - org-toggle-link-display - :style radio - :selected org-descriptive-links - ] - ["Literal Links" - org-toggle-link-display - :style radio - :selected (not org-descriptive-links)]) - "--" - ("TODO Lists" - ["TODO/DONE/-" org-todo t] - ("Select keyword" - ["Next keyword" org-shiftright (org-at-heading-p)] - ["Previous keyword" org-shiftleft (org-at-heading-p)] - ["Complete Keyword" pcomplete (assq :todo-keyword (org-context))] - ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))] - ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-at-heading-p))]) - ["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"] - ["Global TODO list" org-todo-list :active t :keys "C-c a t"] - "--" - ["Enforce dependencies" (customize-variable 'org-enforce-todo-dependencies) - :selected org-enforce-todo-dependencies :style toggle :active t] - "Settings for tree at point" - ["Do Children sequentially" org-toggle-ordered-property :style radio - :selected (org-entry-get nil "ORDERED") - :active org-enforce-todo-dependencies :keys "C-c C-x o"] - ["Do Children parallel" org-toggle-ordered-property :style radio - :selected (not (org-entry-get nil "ORDERED")) - :active org-enforce-todo-dependencies :keys "C-c C-x o"] - "--" - ["Set Priority" org-priority t] - ["Priority Up" org-shiftup t] - ["Priority Down" org-shiftdown t] - "--" - ["Get news from all feeds" org-feed-update-all t] - ["Go to the inbox of a feed..." org-feed-goto-inbox t] - ["Customize feeds" (customize-variable 'org-feed-alist) t]) - ("TAGS and Properties" - ["Set Tags" org-set-tags-command (not (org-before-first-heading-p))] - ["Change tag in region" org-change-tag-in-region (org-region-active-p)] - "--" - ["Set property" org-set-property (not (org-before-first-heading-p))] - ["Column view of properties" org-columns t] - ["Insert Column View DBlock" org-insert-columns-dblock t]) - ("Dates and Scheduling" - ["Timestamp" org-time-stamp (not (org-before-first-heading-p))] - ["Timestamp (inactive)" org-time-stamp-inactive (not (org-before-first-heading-p))] - ("Change Date" - ["1 Day Later" org-shiftright (org-at-timestamp-p)] - ["1 Day Earlier" org-shiftleft (org-at-timestamp-p)] - ["1 ... Later" org-shiftup (org-at-timestamp-p)] - ["1 ... Earlier" org-shiftdown (org-at-timestamp-p)]) - ["Compute Time Range" org-evaluate-time-range t] - ["Schedule Item" org-schedule (not (org-before-first-heading-p))] - ["Deadline" org-deadline (not (org-before-first-heading-p))] - "--" - ["Custom time format" org-toggle-time-stamp-overlays - :style radio :selected org-display-custom-times] - "--" - ["Goto Calendar" org-goto-calendar t] - ["Date from Calendar" org-date-from-calendar t] - "--" - ["Start/Restart Timer" org-timer-start t] - ["Pause/Continue Timer" org-timer-pause-or-continue t] - ["Stop Timer" org-timer-pause-or-continue :active t :keys "C-u C-c C-x ,"] - ["Insert Timer String" org-timer t] - ["Insert Timer Item" org-timer-item t]) - ("Logging work" - ["Clock in" org-clock-in :active t :keys "C-c C-x C-i"] - ["Switch task" (lambda () (interactive) (org-clock-in '(4))) :active t :keys "C-u C-c C-x C-i"] - ["Clock out" org-clock-out t] - ["Clock cancel" org-clock-cancel t] - "--" - ["Mark as default task" org-clock-mark-default-task t] - ["Clock in, mark as default" (lambda () (interactive) (org-clock-in '(16))) :active t :keys "C-u C-u C-c C-x C-i"] - ["Goto running clock" org-clock-goto t] - "--" - ["Display times" org-clock-display t] - ["Create clock table" org-clock-report t] - "--" - ["Record DONE time" - (progn (setq org-log-done (not org-log-done)) - (message "Switching to %s will %s record a timestamp" - (car org-done-keywords) - (if org-log-done "automatically" "not"))) - :style toggle :selected org-log-done]) - "--" - ["Agenda Command..." org-agenda t] - ["Set Restriction Lock" org-agenda-set-restriction-lock t] - ("File List for Agenda") - ("Special views current file" - ["TODO Tree" org-show-todo-tree t] - ["Check Deadlines" org-check-deadlines t] - ["Timeline" org-timeline t] - ["Tags/Property tree" org-match-sparse-tree t]) - "--" - ["Export/Publish..." org-export-dispatch t] - ("LaTeX" - ["Org CDLaTeX mode" org-cdlatex-mode :style toggle - :selected org-cdlatex-mode] - ["Insert Environment" cdlatex-environment (fboundp 'cdlatex-environment)] - ["Insert math symbol" cdlatex-math-symbol (fboundp 'cdlatex-math-symbol)] - ["Modify math symbol" org-cdlatex-math-modify - (org-inside-LaTeX-fragment-p)] - ["Insert citation" org-reftex-citation t] - "--" - ["Template for BEAMER" (org-beamer-insert-options-template) t]) - "--" - ("MobileOrg" - ["Push Files and Views" org-mobile-push t] - ["Get Captured and Flagged" org-mobile-pull t] - ["Find FLAGGED Tasks" (org-agenda nil "?") :active t :keys "C-c a ?"] - "--" - ["Setup" (progn (require 'org-mobile) (customize-group 'org-mobile)) t]) - "--" - ("Documentation" - ["Show Version" org-version t] - ["Info Documentation" org-info t]) - ("Customize" - ["Browse Org Group" org-customize t] - "--" - ["Expand This Menu" org-create-customize-menu - (fboundp 'customize-menu-create)]) - ["Send bug report" org-submit-bug-report t] - "--" - ("Refresh/Reload" - ["Refresh setup current buffer" org-mode-restart t] - ["Reload Org (after update)" org-reload t] - ["Reload Org uncompiled" (org-reload t) :active t :keys "C-u C-c C-x !"]) - )) - -(defun org-info (&optional node) - "Read documentation for Org-mode in the info system. -With optional NODE, go directly to that node." - (interactive) - (info (format "(org)%s" (or node "")))) - -;;;###autoload -(defun org-submit-bug-report () - "Submit a bug report on Org-mode via mail. - -Don't hesitate to report any problems or inaccurate documentation. - -If you don't have setup sending mail from (X)Emacs, please copy the -output buffer into your mail program, as it gives us important -information about your Org-mode version and configuration." - (interactive) - (require 'reporter) - (org-load-modules-maybe) - (org-require-autoloaded-modules) - (let ((reporter-prompt-for-summary-p "Bug report subject: ")) - (reporter-submit-bug-report - "emacs-orgmode@gnu.org" - (org-version nil 'full) - (let (list) - (save-window-excursion - (org-pop-to-buffer-same-window (get-buffer-create "*Warn about privacy*")) - (delete-other-windows) - (erase-buffer) - (insert "You are about to submit a bug report to the Org-mode mailing list. - -We would like to add your full Org-mode and Outline configuration to the -bug report. This greatly simplifies the work of the maintainer and -other experts on the mailing list. - -HOWEVER, some variables you have customized may contain private -information. The names of customers, colleagues, or friends, might -appear in the form of file names, tags, todo states, or search strings. -If you answer yes to the prompt, you might want to check and remove -such private information before sending the email.") - (add-text-properties (point-min) (point-max) '(face org-warning)) - (when (yes-or-no-p "Include your Org-mode configuration ") - (mapatoms - (lambda (v) - (and (boundp v) - (string-match "\\`\\(org-\\|outline-\\)" (symbol-name v)) - (or (and (symbol-value v) - (string-match "\\(-hook\\|-function\\)\\'" (symbol-name v))) - (and - (get v 'custom-type) (get v 'standard-value) - (not (equal (symbol-value v) (eval (car (get v 'standard-value))))))) - (push v list))))) - (kill-buffer (get-buffer "*Warn about privacy*")) - list)) - nil nil - "Remember to cover the basics, that is, what you expected to happen and -what in fact did happen. You don't know how to make a good report? See - - http://orgmode.org/manual/Feedback.html#Feedback - -Your bug report will be posted to the Org-mode mailing list. -------------------------------------------------------------------------") - (save-excursion - (if (re-search-backward "^\\(Subject: \\)Org-mode version \\(.*?\\);[ \t]*\\(.*\\)" nil t) - (replace-match "\\1Bug: \\3 [\\2]"))))) - - -(defun org-install-agenda-files-menu () - (let ((bl (buffer-list))) - (save-excursion - (while bl - (set-buffer (pop bl)) - (if (derived-mode-p 'org-mode) (setq bl nil))) - (when (derived-mode-p 'org-mode) - (easy-menu-change - '("Org") "File List for Agenda" - (append - (list - ["Edit File List" (org-edit-agenda-file-list) t] - ["Add/Move Current File to Front of List" org-agenda-file-to-front t] - ["Remove Current File from List" org-remove-file t] - ["Cycle through agenda files" org-cycle-agenda-files t] - ["Occur in all agenda files" org-occur-in-agenda-files t] - "--") - (mapcar 'org-file-menu-entry (org-agenda-files t)))))))) - -;;;; Documentation - -(defun org-require-autoloaded-modules () - (interactive) - (mapc 'require - '(org-agenda org-archive org-attach org-clock org-colview org-id - org-table org-timer))) - -;;;###autoload -(defun org-reload (&optional uncompiled) - "Reload all org lisp files. -With prefix arg UNCOMPILED, load the uncompiled versions." - (interactive "P") - (require 'loadhist) - (let* ((org-dir (org-find-library-dir "org")) - (contrib-dir (or (org-find-library-dir "org-contribdir") org-dir)) - (feature-re "^\\(org\\|ob\\|ox\\)\\(-.*\\)?") - (remove-re (mapconcat 'identity - (mapcar (lambda (f) (concat "^" f "$")) - (list (if (featurep 'xemacs) - "org-colview" - "org-colview-xemacs") - "org" "org-loaddefs" "org-version")) - "\\|")) - (feats (delete-dups - (mapcar 'file-name-sans-extension - (mapcar 'file-name-nondirectory - (delq nil - (mapcar 'feature-file - features)))))) - (lfeat (append - (sort - (setq feats - (delq nil (mapcar - (lambda (f) - (if (and (string-match feature-re f) - (not (string-match remove-re f))) - f nil)) - feats))) - 'string-lessp) - (list "org-version" "org"))) - (load-suffixes (when (boundp 'load-suffixes) load-suffixes)) - (load-suffixes (if uncompiled (reverse load-suffixes) load-suffixes)) - load-uncore load-misses) - (setq load-misses - (delq 't - (mapcar (lambda (f) - (or (org-load-noerror-mustsuffix (concat org-dir f)) - (and (string= org-dir contrib-dir) - (org-load-noerror-mustsuffix (concat contrib-dir f))) - (and (org-load-noerror-mustsuffix (concat (org-find-library-dir f) f)) - (add-to-list 'load-uncore f 'append) - 't) - f)) - lfeat))) - (if load-uncore - (message "The following feature%s found in load-path, please check if that's correct:\n%s" - (if (> (length load-uncore) 1) "s were" " was") load-uncore)) - (if load-misses - (message "Some error occured while reloading Org feature%s\n%s\nPlease check *Messages*!\n%s" - (if (> (length load-misses) 1) "s" "") load-misses (org-version nil 'full)) - (message "Successfully reloaded Org\n%s" (org-version nil 'full))))) - -;;;###autoload -(defun org-customize () - "Call the customize function with org as argument." - (interactive) - (org-load-modules-maybe) - (org-require-autoloaded-modules) - (customize-browse 'org)) - -(defun org-create-customize-menu () - "Create a full customization menu for Org-mode, insert it into the menu." - (interactive) - (org-load-modules-maybe) - (org-require-autoloaded-modules) - (if (fboundp 'customize-menu-create) - (progn - (easy-menu-change - '("Org") "Customize" - `(["Browse Org group" org-customize t] - "--" - ,(customize-menu-create 'org) - ["Set" Custom-set t] - ["Save" Custom-save t] - ["Reset to Current" Custom-reset-current t] - ["Reset to Saved" Custom-reset-saved t] - ["Reset to Standard Settings" Custom-reset-standard t])) - (message "\"Org\"-menu now contains full customization menu")) - (error "Cannot expand menu (outdated version of cus-edit.el)"))) - -;;;; Miscellaneous stuff - -;;; Generally useful functions - -(defun org-get-at-bol (property) - "Get text property PROPERTY at beginning of line." - (get-text-property (point-at-bol) property)) - -(defun org-find-text-property-in-string (prop s) - "Return the first non-nil value of property PROP in string S." - (or (get-text-property 0 prop s) - (get-text-property (or (next-single-property-change 0 prop s) 0) - prop s))) - -(defun org-display-warning (message) ;; Copied from Emacs-Muse - "Display the given MESSAGE as a warning." - (if (fboundp 'display-warning) - (display-warning 'org message - (if (featurep 'xemacs) 'warning :warning)) - (let ((buf (get-buffer-create "*Org warnings*"))) - (with-current-buffer buf - (goto-char (point-max)) - (insert "Warning (Org): " message) - (unless (bolp) - (newline))) - (display-buffer buf) - (sit-for 0)))) - -(defun org-eval (form) - "Eval FORM and return result." - (condition-case error - (eval form) - (error (format "%%![Error: %s]" error)))) - -(defun org-in-clocktable-p () - "Check if the cursor is in a clocktable." - (let ((pos (point)) start) - (save-excursion - (end-of-line 1) - (and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t) - (setq start (match-beginning 0)) - (re-search-forward "^[ \t]*#\\+END:.*" nil t) - (>= (match-end 0) pos) - start)))) - -(defun org-in-commented-line () - "Is point in a line starting with `#'?" - (equal (char-after (point-at-bol)) ?#)) - -(defun org-in-indented-comment-line () - "Is point in a line starting with `#' after some white space?" - (save-excursion - (save-match-data - (goto-char (point-at-bol)) - (looking-at "[ \t]*#")))) - -(defun org-in-verbatim-emphasis () - (save-match-data - (and (org-in-regexp org-emph-re 2) - (>= (point) (match-beginning 3)) - (<= (point) (match-end 4)) - (member (match-string 3) '("=" "~"))))) - -(defun org-goto-marker-or-bmk (marker &optional bookmark) - "Go to MARKER, widen if necessary. When marker is not live, try BOOKMARK." - (if (and marker (marker-buffer marker) - (buffer-live-p (marker-buffer marker))) - (progn - (org-pop-to-buffer-same-window (marker-buffer marker)) - (if (or (> marker (point-max)) (< marker (point-min))) - (widen)) - (goto-char marker) - (org-show-context 'org-goto)) - (if bookmark - (bookmark-jump bookmark) - (error "Cannot find location")))) - -(defun org-quote-csv-field (s) - "Quote field for inclusion in CSV material." - (if (string-match "[\",]" s) - (concat "\"" (mapconcat 'identity (split-string s "\"") "\"\"") "\"") - s)) - -(defun org-force-self-insert (N) - "Needed to enforce self-insert under remapping." - (interactive "p") - (self-insert-command N)) - -(defun org-string-width (s) - "Compute width of string, ignoring invisible characters. -This ignores character with invisibility property `org-link', and also -characters with property `org-cwidth', because these will become invisible -upon the next fontification round." - (let (b l) - (when (or (eq t buffer-invisibility-spec) - (assq 'org-link buffer-invisibility-spec)) - (while (setq b (text-property-any 0 (length s) - 'invisible 'org-link s)) - (setq s (concat (substring s 0 b) - (substring s (or (next-single-property-change - b 'invisible s) (length s))))))) - (while (setq b (text-property-any 0 (length s) 'org-cwidth t s)) - (setq s (concat (substring s 0 b) - (substring s (or (next-single-property-change - b 'org-cwidth s) (length s)))))) - (setq l (string-width s) b -1) - (while (setq b (text-property-any (1+ b) (length s) 'org-dwidth t s)) - (setq l (- l (get-text-property b 'org-dwidth-n s)))) - l)) - -(defun org-shorten-string (s maxlength) - "Shorten string S so tht it is no longer than MAXLENGTH characters. -If the string is shorter or has length MAXLENGTH, just return the -original string. If it is longer, the functions finds a space in the -string, breaks this string off at that locations and adds three dots -as ellipsis. Including the ellipsis, the string will not be longer -than MAXLENGTH. If finding a good breaking point in the string does -not work, the string is just chopped off in the middle of a word -if necessary." - (if (<= (length s) maxlength) - s - (let* ((n (max (- maxlength 4) 1)) - (re (concat "\\`\\(.\\{1," (int-to-string n) "\\}[^ ]\\)\\([ ]\\|\\'\\)"))) - (if (string-match re s) - (concat (match-string 1 s) "...") - (concat (substring s 0 (max (- maxlength 3) 0)) "..."))))) - -(defun org-get-indentation (&optional line) - "Get the indentation of the current line, interpreting tabs. -When LINE is given, assume it represents a line and compute its indentation." - (if line - (if (string-match "^ *" (org-remove-tabs line)) - (match-end 0)) - (save-excursion - (beginning-of-line 1) - (skip-chars-forward " \t") - (current-column)))) - -(defun org-get-string-indentation (s) - "What indentation has S due to SPACE and TAB at the beginning of the string?" - (let ((n -1) (i 0) (w tab-width) c) - (catch 'exit - (while (< (setq n (1+ n)) (length s)) - (setq c (aref s n)) - (cond ((= c ?\ ) (setq i (1+ i))) - ((= c ?\t) (setq i (* (/ (+ w i) w) w))) - (t (throw 'exit t))))) - i)) - -(defun org-remove-tabs (s &optional width) - "Replace tabulators in S with spaces. -Assumes that s is a single line, starting in column 0." - (setq width (or width tab-width)) - (while (string-match "\t" s) - (setq s (replace-match - (make-string - (- (* width (/ (+ (match-beginning 0) width) width)) - (match-beginning 0)) ?\ ) - t t s))) - s) - -(defun org-fix-indentation (line ind) - "Fix indentation in LINE. -IND is a cons cell with target and minimum indentation. -If the current indentation in LINE is smaller than the minimum, -leave it alone. If it is larger than ind, set it to the target." - (let* ((l (org-remove-tabs line)) - (i (org-get-indentation l)) - (i1 (car ind)) (i2 (cdr ind))) - (if (>= i i2) (setq l (substring line i2))) - (if (> i1 0) - (concat (make-string i1 ?\ ) l) - l))) - -(defun org-remove-indentation (code &optional n) - "Remove the maximum common indentation from the lines in CODE. -N may optionally be the number of spaces to remove." - (with-temp-buffer - (insert code) - (org-do-remove-indentation n) - (buffer-string))) - -(defun org-do-remove-indentation (&optional n) - "Remove the maximum common indentation from the buffer." - (untabify (point-min) (point-max)) - (let ((min 10000) re) - (if n - (setq min n) - (goto-char (point-min)) - (while (re-search-forward "^ *[^ \n]" nil t) - (setq min (min min (1- (- (match-end 0) (match-beginning 0))))))) - (unless (or (= min 0) (= min 10000)) - (setq re (format "^ \\{%d\\}" min)) - (goto-char (point-min)) - (while (re-search-forward re nil t) - (replace-match "") - (end-of-line 1)) - min))) - -(defun org-fill-template (template alist) - "Find each %key of ALIST in TEMPLATE and replace it." - (let ((case-fold-search nil) - entry key value) - (setq alist (sort (copy-sequence alist) - (lambda (a b) (< (length (car a)) (length (car b)))))) - (while (setq entry (pop alist)) - (setq template - (replace-regexp-in-string - (concat "%" (regexp-quote (car entry))) - (or (cdr entry) "") template t t))) - template)) - -(defun org-base-buffer (buffer) - "Return the base buffer of BUFFER, if it has one. Else return the buffer." - (if (not buffer) - buffer - (or (buffer-base-buffer buffer) - buffer))) - -(defun org-trim (s) - "Remove whitespace at beginning and end of string." - (if (string-match "\\`[ \t\n\r]+" s) (setq s (replace-match "" t t s))) - (if (string-match "[ \t\n\r]+\\'" s) (setq s (replace-match "" t t s))) - s) - -(defun org-wrap (string &optional width lines) - "Wrap string to either a number of lines, or a width in characters. -If WIDTH is non-nil, the string is wrapped to that width, however many lines -that costs. If there is a word longer than WIDTH, the text is actually -wrapped to the length of that word. -IF WIDTH is nil and LINES is non-nil, the string is forced into at most that -many lines, whatever width that takes. -The return value is a list of lines, without newlines at the end." - (let* ((words (org-split-string string "[ \t\n]+")) - (maxword (apply 'max (mapcar 'org-string-width words))) - w ll) - (cond (width - (org-do-wrap words (max maxword width))) - (lines - (setq w maxword) - (setq ll (org-do-wrap words maxword)) - (if (<= (length ll) lines) - ll - (setq ll words) - (while (> (length ll) lines) - (setq w (1+ w)) - (setq ll (org-do-wrap words w))) - ll)) - (t (error "Cannot wrap this"))))) - -(defun org-do-wrap (words width) - "Create lines of maximum width WIDTH (in characters) from word list WORDS." - (let (lines line) - (while words - (setq line (pop words)) - (while (and words (< (+ (length line) (length (car words))) width)) - (setq line (concat line " " (pop words)))) - (setq lines (push line lines))) - (nreverse lines))) - -(defun org-split-string (string &optional separators) - "Splits STRING into substrings at SEPARATORS. -No empty strings are returned if there are matches at the beginning -and end of string." - (let ((rexp (or separators "[ \f\t\n\r\v]+")) - (start 0) - notfirst - (list nil)) - (while (and (string-match rexp string - (if (and notfirst - (= start (match-beginning 0)) - (< start (length string))) - (1+ start) start)) - (< (match-beginning 0) (length string))) - (setq notfirst t) - (or (eq (match-beginning 0) 0) - (and (eq (match-beginning 0) (match-end 0)) - (eq (match-beginning 0) start)) - (setq list - (cons (substring string start (match-beginning 0)) - list))) - (setq start (match-end 0))) - (or (eq start (length string)) - (setq list - (cons (substring string start) - list))) - (nreverse list))) - -(defun org-quote-vert (s) - "Replace \"|\" with \"\\vert\"." - (while (string-match "|" s) - (setq s (replace-match "\\vert" t t s))) - s) - -(defun org-uuidgen-p (s) - "Is S an ID created by UUIDGEN?" - (string-match "\\`[0-9a-f]\\{8\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{4\\}-[0-9a-f]\\{12\\}\\'" (downcase s))) - -(defun org-in-src-block-p (&optional inside) - "Whether point is in a code source block. -When INSIDE is non-nil, don't consider we are within a src block -when point is at #+BEGIN_SRC or #+END_SRC." - (let ((case-fold-search t) ov) - (or (and (setq ov (overlays-at (point))) - (memq 'org-block-background - (overlay-properties (car ov)))) - (and (not inside) - (save-match-data - (save-excursion - (beginning-of-line) - (looking-at ".*#\\+\\(begin\\|end\\)_src"))))))) - -(defun org-context () - "Return a list of contexts of the current cursor position. -If several contexts apply, all are returned. -Each context entry is a list with a symbol naming the context, and -two positions indicating start and end of the context. Possible -contexts are: - -:headline anywhere in a headline -:headline-stars on the leading stars in a headline -:todo-keyword on a TODO keyword (including DONE) in a headline -:tags on the TAGS in a headline -:priority on the priority cookie in a headline -:item on the first line of a plain list item -:item-bullet on the bullet/number of a plain list item -:checkbox on the checkbox in a plain list item -:table in an org-mode table -:table-special on a special filed in a table -:table-table in a table.el table -:clocktable in a clocktable -:src-block in a source block -:link on a hyperlink -:keyword on a keyword: SCHEDULED, DEADLINE, CLOSE, COMMENT, QUOTE. -:target on a <<target>> -:radio-target on a <<<radio-target>>> -:latex-fragment on a LaTeX fragment -:latex-preview on a LaTeX fragment with overlaid preview image - -This function expects the position to be visible because it uses font-lock -faces as a help to recognize the following contexts: :table-special, :link, -and :keyword." - (let* ((f (get-text-property (point) 'face)) - (faces (if (listp f) f (list f))) - (case-fold-search t) - (p (point)) clist o) - ;; First the large context - (cond - ((org-at-heading-p t) - (push (list :headline (point-at-bol) (point-at-eol)) clist) - (when (progn - (beginning-of-line 1) - (looking-at org-todo-line-tags-regexp)) - (push (org-point-in-group p 1 :headline-stars) clist) - (push (org-point-in-group p 2 :todo-keyword) clist) - (push (org-point-in-group p 4 :tags) clist)) - (goto-char p) - (skip-chars-backward "^[\n\r \t") (or (bobp) (backward-char 1)) - (if (looking-at "\\[#[A-Z0-9]\\]") - (push (org-point-in-group p 0 :priority) clist))) - - ((org-at-item-p) - (push (org-point-in-group p 2 :item-bullet) clist) - (push (list :item (point-at-bol) - (save-excursion (org-end-of-item) (point))) - clist) - (and (org-at-item-checkbox-p) - (push (org-point-in-group p 0 :checkbox) clist))) - - ((org-at-table-p) - (push (list :table (org-table-begin) (org-table-end)) clist) - (if (memq 'org-formula faces) - (push (list :table-special - (previous-single-property-change p 'face) - (next-single-property-change p 'face)) clist))) - ((org-at-table-p 'any) - (push (list :table-table) clist))) - (goto-char p) - - (let ((case-fold-search t)) - ;; New the "medium" contexts: clocktables, source blocks - (cond ((org-in-clocktable-p) - (push (list :clocktable - (and (or (looking-at "#\\+BEGIN: clocktable") - (search-backward "#+BEGIN: clocktable" nil t)) - (match-beginning 0)) - (and (re-search-forward "#\\+END:?" nil t) - (match-end 0))) clist)) - ((org-in-src-block-p) - (push (list :src-block - (and (or (looking-at "#\\+BEGIN_SRC") - (search-backward "#+BEGIN_SRC" nil t)) - (match-beginning 0)) - (and (search-forward "#+END_SRC" nil t) - (match-beginning 0))) clist)))) - (goto-char p) - - ;; Now the small context - (cond - ((org-at-timestamp-p) - (push (org-point-in-group p 0 :timestamp) clist)) - ((memq 'org-link faces) - (push (list :link - (previous-single-property-change p 'face) - (next-single-property-change p 'face)) clist)) - ((memq 'org-special-keyword faces) - (push (list :keyword - (previous-single-property-change p 'face) - (next-single-property-change p 'face)) clist)) - ((org-at-target-p) - (push (org-point-in-group p 0 :target) clist) - (goto-char (1- (match-beginning 0))) - (if (looking-at org-radio-target-regexp) - (push (org-point-in-group p 0 :radio-target) clist)) - (goto-char p)) - ((setq o (car (delq nil - (mapcar - (lambda (x) - (if (memq x org-latex-fragment-image-overlays) x)) - (overlays-at (point)))))) - (push (list :latex-fragment - (overlay-start o) (overlay-end o)) clist) - (push (list :latex-preview - (overlay-start o) (overlay-end o)) clist)) - ((org-inside-LaTeX-fragment-p) - ;; FIXME: positions wrong. - (push (list :latex-fragment (point) (point)) clist))) - - (setq clist (nreverse (delq nil clist))) - clist)) - -;; FIXME: Compare with at-regexp-p Do we need both? -(defun org-in-regexp (re &optional nlines visually) - "Check if point is inside a match of regexp. -Normally only the current line is checked, but you can include NLINES extra -lines both before and after point into the search. -If VISUALLY is set, require that the cursor is not after the match but -really on, so that the block visually is on the match." - (catch 'exit - (let ((pos (point)) - (eol (point-at-eol (+ 1 (or nlines 0)))) - (inc (if visually 1 0))) - (save-excursion - (beginning-of-line (- 1 (or nlines 0))) - (while (re-search-forward re eol t) - (if (and (<= (match-beginning 0) pos) - (>= (+ inc (match-end 0)) pos)) - (throw 'exit (cons (match-beginning 0) (match-end 0))))))))) - -(defun org-at-regexp-p (regexp) - "Is point inside a match of REGEXP in the current line?" - (catch 'exit - (save-excursion - (let ((pos (point)) (end (point-at-eol))) - (beginning-of-line 1) - (while (re-search-forward regexp end t) - (if (and (<= (match-beginning 0) pos) - (>= (match-end 0) pos)) - (throw 'exit t))) - nil)))) - -(defun org-between-regexps-p (start-re end-re &optional lim-up lim-down) - "Non-nil when point is between matches of START-RE and END-RE. - -Also return a non-nil value when point is on one of the matches. - -Optional arguments LIM-UP and LIM-DOWN bound the search; they are -buffer positions. Default values are the positions of headlines -surrounding the point. - -The functions returns a cons cell whose car (resp. cdr) is the -position before START-RE (resp. after END-RE)." - (save-match-data - (let ((pos (point)) - (limit-up (or lim-up (save-excursion (outline-previous-heading)))) - (limit-down (or lim-down (save-excursion (outline-next-heading)))) - beg end) - (save-excursion - ;; Point is on a block when on START-RE or if START-RE can be - ;; found before it... - (and (or (org-at-regexp-p start-re) - (re-search-backward start-re limit-up t)) - (setq beg (match-beginning 0)) - ;; ... and END-RE after it... - (goto-char (match-end 0)) - (re-search-forward end-re limit-down t) - (> (setq end (match-end 0)) pos) - ;; ... without another START-RE in-between. - (goto-char (match-beginning 0)) - (not (re-search-backward start-re (1+ beg) t)) - ;; Return value. - (cons beg end)))))) - -(defun org-in-block-p (names) - "Non-nil when point belongs to a block whose name belongs to NAMES. - -NAMES is a list of strings containing names of blocks. - -Return first block name matched, or nil. Beware that in case of -nested blocks, the returned name may not belong to the closest -block from point." - (save-match-data - (catch 'exit - (let ((case-fold-search t) - (lim-up (save-excursion (outline-previous-heading))) - (lim-down (save-excursion (outline-next-heading)))) - (mapc (lambda (name) - (let ((n (regexp-quote name))) - (when (org-between-regexps-p - (concat "^[ \t]*#\\+begin_" n) - (concat "^[ \t]*#\\+end_" n) - lim-up lim-down) - (throw 'exit n)))) - names)) - nil))) - -(defun org-in-drawer-p () - "Is point within a drawer?" - (save-match-data - (let ((case-fold-search t) - (lim-up (save-excursion (outline-previous-heading))) - (lim-down (save-excursion (outline-next-heading)))) - (org-between-regexps-p - (concat "^[ \t]*:" (regexp-opt org-drawers) ":") - "^[ \t]*:end:.*$" - lim-up lim-down)))) - -(defun org-occur-in-agenda-files (regexp &optional nlines) - "Call `multi-occur' with buffers for all agenda files." - (interactive "sOrg-files matching: \np") - (let* ((files (org-agenda-files)) - (tnames (mapcar 'file-truename files)) - (extra org-agenda-text-search-extra-files) - f) - (when (eq (car extra) 'agenda-archives) - (setq extra (cdr extra)) - (setq files (org-add-archive-files files))) - (while (setq f (pop extra)) - (unless (member (file-truename f) tnames) - (add-to-list 'files f 'append) - (add-to-list 'tnames (file-truename f) 'append))) - (multi-occur - (mapcar (lambda (x) - (with-current-buffer - (or (get-file-buffer x) (find-file-noselect x)) - (widen) - (current-buffer))) - files) - regexp))) - -(if (boundp 'occur-mode-find-occurrence-hook) - ;; Emacs 23 - (add-hook 'occur-mode-find-occurrence-hook - (lambda () - (when (derived-mode-p 'org-mode) - (org-reveal)))) - ;; Emacs 22 - (defadvice occur-mode-goto-occurrence - (after org-occur-reveal activate) - (and (derived-mode-p 'org-mode) (org-reveal))) - (defadvice occur-mode-goto-occurrence-other-window - (after org-occur-reveal activate) - (and (derived-mode-p 'org-mode) (org-reveal))) - (defadvice occur-mode-display-occurrence - (after org-occur-reveal activate) - (when (derived-mode-p 'org-mode) - (let ((pos (occur-mode-find-occurrence))) - (with-current-buffer (marker-buffer pos) - (save-excursion - (goto-char pos) - (org-reveal))))))) - -(defun org-occur-link-in-agenda-files () - "Create a link and search for it in the agendas. -The link is not stored in `org-stored-links', it is just created -for the search purpose." - (interactive) - (let ((link (condition-case nil - (org-store-link nil) - (error "Unable to create a link to here")))) - (org-occur-in-agenda-files (regexp-quote link)))) - -(defun org-reverse-string (string) - "Return the reverse of STRING." - (apply 'string (reverse (string-to-list string)))) - -(defsubst org-uniquify (list) - "Non-destructively remove duplicate elements from LIST." - (let ((res (copy-sequence list))) (delete-dups res))) - -(defun org-uniquify-alist (alist) - "Merge elements of ALIST with the same key. - -For example, in this alist: - -\(org-uniquify-alist '((a 1) (b 2) (a 3))) - => '((a 1 3) (b 2)) - -merge (a 1) and (a 3) into (a 1 3). - -The function returns the new ALIST." - (let (rtn) - (mapc - (lambda (e) - (let (n) - (if (not (assoc (car e) rtn)) - (push e rtn) - (setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e)))) - (setq rtn (assq-delete-all (car e) rtn)) - (push n rtn)))) - alist) - rtn)) - -(defun org-delete-all (elts list) - "Remove all elements in ELTS from LIST." - (while elts - (setq list (delete (pop elts) list))) - list) - -(defun org-count (cl-item cl-seq) - "Count the number of occurrences of ITEM in SEQ. -Taken from `count' in cl-seq.el with all keyword arguments removed." - (let ((cl-end (length cl-seq)) (cl-start 0) (cl-count 0) cl-x) - (when (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq))) - (while (< cl-start cl-end) - (setq cl-x (if (consp cl-seq) (pop cl-seq) (aref cl-seq cl-start))) - (if (equal cl-item cl-x) (setq cl-count (1+ cl-count))) - (setq cl-start (1+ cl-start))) - cl-count)) - -(defun org-remove-if (predicate seq) - "Remove everything from SEQ that fulfills PREDICATE." - (let (res e) - (while seq - (setq e (pop seq)) - (if (not (funcall predicate e)) (push e res))) - (nreverse res))) - -(defun org-remove-if-not (predicate seq) - "Remove everything from SEQ that does not fulfill PREDICATE." - (let (res e) - (while seq - (setq e (pop seq)) - (if (funcall predicate e) (push e res))) - (nreverse res))) - -(defun org-reduce (cl-func cl-seq &rest cl-keys) - "Reduce two-argument FUNCTION across SEQ. -Taken from `reduce' in cl-seq.el with all keyword arguments but -\":initial-value\" removed." - (let ((cl-accum (cond ((memq :initial-value cl-keys) - (cadr (memq :initial-value cl-keys))) - (cl-seq (pop cl-seq)) - (t (funcall cl-func))))) - (while cl-seq - (setq cl-accum (funcall cl-func cl-accum (pop cl-seq)))) - cl-accum)) - -(defun org-every (pred seq) - "Return true if PREDICATE is true of every element of SEQ. -Adapted from `every' in cl.el." - (catch 'org-every - (mapc (lambda (e) (unless (funcall pred e) (throw 'org-every nil))) seq) - t)) - -(defun org-some (pred seq) - "Return true if PREDICATE is true of any element of SEQ. -Adapted from `some' in cl.el." - (catch 'org-some - (mapc (lambda (e) (when (funcall pred e) (throw 'org-some t))) seq) - nil)) - -(defun org-back-over-empty-lines () - "Move backwards over whitespace, to the beginning of the first empty line. -Returns the number of empty lines passed." - (let ((pos (point))) - (if (cdr (assoc 'heading org-blank-before-new-entry)) - (skip-chars-backward " \t\n\r") - (unless (eobp) - (forward-line -1))) - (beginning-of-line 2) - (goto-char (min (point) pos)) - (count-lines (point) pos))) - -(defun org-skip-whitespace () - (skip-chars-forward " \t\n\r")) - -(defun org-point-in-group (point group &optional context) - "Check if POINT is in match-group GROUP. -If CONTEXT is non-nil, return a list with CONTEXT and the boundaries of the -match. If the match group does not exist or point is not inside it, -return nil." - (and (match-beginning group) - (>= point (match-beginning group)) - (<= point (match-end group)) - (if context - (list context (match-beginning group) (match-end group)) - t))) - -(defun org-switch-to-buffer-other-window (&rest args) - "Switch to buffer in a second window on the current frame. -In particular, do not allow pop-up frames. -Returns the newly created buffer." - (org-no-popups - (apply 'switch-to-buffer-other-window args))) - -(defun org-combine-plists (&rest plists) - "Create a single property list from all plists in PLISTS. -The process starts by copying the first list, and then setting properties -from the other lists. Settings in the last list are the most significant -ones and overrule settings in the other lists." - (let ((rtn (copy-sequence (pop plists))) - p v ls) - (while plists - (setq ls (pop plists)) - (while ls - (setq p (pop ls) v (pop ls)) - (setq rtn (plist-put rtn p v)))) - rtn)) - -(defun org-replace-escapes (string table) - "Replace %-escapes in STRING with values in TABLE. -TABLE is an association list with keys like \"%a\" and string values. -The sequences in STRING may contain normal field width and padding information, -for example \"%-5s\". Replacements happen in the sequence given by TABLE, -so values can contain further %-escapes if they are define later in TABLE." - (let ((tbl (copy-alist table)) - (case-fold-search nil) - (pchg 0) - e re rpl) - (while (setq e (pop tbl)) - (setq re (concat "%-?[0-9.]*" (substring (car e) 1))) - (when (and (cdr e) (string-match re (cdr e))) - (let ((sref (substring (cdr e) (match-beginning 0) (match-end 0))) - (safe "SREF")) - (add-text-properties 0 3 (list 'sref sref) safe) - (setcdr e (replace-match safe t t (cdr e))))) - (while (string-match re string) - (setq rpl (format (concat (substring (match-string 0 string) 0 -1) "s") - (cdr e))) - (setq string (replace-match rpl t t string)))) - (while (setq pchg (next-property-change pchg string)) - (let ((sref (get-text-property pchg 'sref string))) - (when (and sref (string-match "SREF" string pchg)) - (setq string (replace-match sref t t string))))) - string)) - -(defun org-sublist (list start end) - "Return a section of LIST, from START to END. -Counting starts at 1." - (let (rtn (c start)) - (setq list (nthcdr (1- start) list)) - (while (and list (<= c end)) - (push (pop list) rtn) - (setq c (1+ c))) - (nreverse rtn))) - -(defun org-find-base-buffer-visiting (file) - "Like `find-buffer-visiting' but always return the base buffer and -not an indirect buffer." - (let ((buf (or (get-file-buffer file) - (find-buffer-visiting file)))) - (if buf - (or (buffer-base-buffer buf) buf) - nil))) - -(defun org-image-file-name-regexp (&optional extensions) - "Return regexp matching the file names of images. -If EXTENSIONS is given, only match these." - (if (and (not extensions) (fboundp 'image-file-name-regexp)) - (image-file-name-regexp) - (let ((image-file-name-extensions - (or extensions - '("png" "jpeg" "jpg" "gif" "tiff" "tif" - "xbm" "xpm" "pbm" "pgm" "ppm")))) - (concat "\\." - (regexp-opt (nconc (mapcar 'upcase - image-file-name-extensions) - image-file-name-extensions) - t) - "\\'")))) - -(defun org-file-image-p (file &optional extensions) - "Return non-nil if FILE is an image." - (save-match-data - (string-match (org-image-file-name-regexp extensions) file))) - -(defun org-get-cursor-date (&optional with-time) - "Return the date at cursor in as a time. -This works in the calendar and in the agenda, anywhere else it just -returns the current time. -If WITH-TIME is non-nil, returns the time of the event at point (in -the agenda) or the current time of the day." - (let (date day defd tp tm hod mod) - (when with-time - (setq tp (get-text-property (point) 'time)) - (when (and tp (string-match "\\([0-9][0-9]\\):\\([0-9][0-9]\\)" tp)) - (setq hod (string-to-number (match-string 1 tp)) - mod (string-to-number (match-string 2 tp)))) - (or tp (setq hod (nth 2 (decode-time (current-time))) - mod (nth 1 (decode-time (current-time)))))) - (cond - ((eq major-mode 'calendar-mode) - (setq date (calendar-cursor-to-date) - defd (encode-time 0 (or mod 0) (or hod 0) - (nth 1 date) (nth 0 date) (nth 2 date)))) - ((eq major-mode 'org-agenda-mode) - (setq day (get-text-property (point) 'day)) - (if day - (setq date (calendar-gregorian-from-absolute day) - defd (encode-time 0 (or mod 0) (or hod 0) - (nth 1 date) (nth 0 date) (nth 2 date)))))) - (or defd (current-time)))) - -(defun org-mark-subtree (&optional up) - "Mark the current subtree. -This puts point at the start of the current subtree, and mark at -the end. If a numeric prefix UP is given, move up into the -hierarchy of headlines by UP levels before marking the subtree." - (interactive "P") - (org-with-limited-levels - (cond ((org-at-heading-p) (beginning-of-line)) - ((org-before-first-heading-p) (user-error "Not in a subtree")) - (t (outline-previous-visible-heading 1)))) - (when up (while (and (> up 0) (org-up-heading-safe)) (decf up))) - (if (org-called-interactively-p 'any) - (call-interactively 'org-mark-element) - (org-mark-element))) - - -;;; Indentation - -(defun org-indent-line () - "Indent line depending on context." - (interactive) - (let* ((pos (point)) - (itemp (org-at-item-p)) - (case-fold-search t) - (org-drawer-regexp (or org-drawer-regexp "\000")) - (inline-task-p (and (featurep 'org-inlinetask) - (org-inlinetask-in-task-p))) - (inline-re (and inline-task-p - (org-inlinetask-outline-regexp))) - column) - (if (and orgstruct-is-++ (eq pos (point))) - (let ((indent-line-function (cadadr (assoc 'indent-line-function org-fb-vars)))) - (indent-according-to-mode)) - (beginning-of-line 1) - (cond - ;; Headings - ((looking-at org-outline-regexp) (setq column 0)) - ;; Footnote definition - ((looking-at org-footnote-definition-re) (setq column 0)) - ;; Literal examples - ((looking-at "[ \t]*:\\( \\|$\\)") - (setq column (org-get-indentation))) ; do nothing - ;; Lists - ((ignore-errors (goto-char (org-in-item-p))) - (setq column (if itemp - (org-get-indentation) - (org-list-item-body-column (point)))) - (goto-char pos)) - ;; Drawers - ((and (looking-at "[ \t]*:END:") - (save-excursion (re-search-backward org-drawer-regexp nil t))) - (save-excursion - (goto-char (1- (match-beginning 1))) - (setq column (current-column)))) - ;; Special blocks - ((and (looking-at "[ \t]*#\\+end_\\([a-z]+\\)") - (save-excursion - (re-search-backward - (concat "^[ \t]*#\\+begin_" (downcase (match-string 1))) nil t))) - (setq column (org-get-indentation (match-string 0)))) - ((and (not (looking-at "[ \t]*#\\+begin_")) - (org-between-regexps-p "^[ \t]*#\\+begin_" "[ \t]*#\\+end_")) - (save-excursion - (re-search-backward "^[ \t]*#\\+begin_\\([a-z]+\\)" nil t)) - (setq column - (cond ((equal (downcase (match-string 1)) "src") - ;; src blocks: let `org-edit-src-exit' handle them - (org-get-indentation)) - ((equal (downcase (match-string 1)) "example") - (max (org-get-indentation) - (org-get-indentation (match-string 0)))) - (t - (org-get-indentation (match-string 0)))))) - ;; This line has nothing special, look at the previous relevant - ;; line to compute indentation - (t - (beginning-of-line 0) - (while (and (not (bobp)) - (not (looking-at org-table-line-regexp)) - (not (looking-at org-drawer-regexp)) - ;; When point started in an inline task, do not move - ;; above task starting line. - (not (and inline-task-p (looking-at inline-re))) - ;; Skip drawers, blocks, empty lines, verbatim, - ;; comments, tables, footnotes definitions, lists, - ;; inline tasks. - (or (and (looking-at "[ \t]*:END:") - (re-search-backward org-drawer-regexp nil t)) - (and (looking-at "[ \t]*#\\+end_") - (re-search-backward "[ \t]*#\\+begin_"nil t)) - (looking-at "[ \t]*[\n:#|]") - (looking-at org-footnote-definition-re) - (and (not inline-task-p) - (featurep 'org-inlinetask) - (org-inlinetask-in-task-p) - (or (org-inlinetask-goto-beginning) t)))) - (beginning-of-line 0)) - (cond - ;; There was a list item above. - ((ignore-errors (goto-char (org-in-item-p))) - (goto-char (org-list-get-top-point (org-list-struct))) - (setq column (org-get-indentation))) - ;; There was an heading above. - ((looking-at "\\*+[ \t]+") - (if (not org-adapt-indentation) - (setq column 0) - (goto-char (match-end 0)) - (setq column (current-column)))) - ;; A drawer had started and is unfinished - ((looking-at org-drawer-regexp) - (goto-char (1- (match-beginning 1))) - (setq column (current-column))) - ;; Else, nothing noticeable found: get indentation and go on. - (t (setq column (org-get-indentation)))))) - ;; Now apply indentation and move cursor accordingly - (goto-char pos) - (if (<= (current-column) (current-indentation)) - (org-indent-line-to column) - (save-excursion (org-indent-line-to column))) - ;; Special polishing for properties, see `org-property-format' - (setq column (current-column)) - (beginning-of-line 1) - (if (looking-at org-property-re) - (replace-match (concat (match-string 4) - (format org-property-format - (match-string 1) (match-string 3))) - t t)) - (org-move-to-column column)))) - -(defun org-indent-drawer () - "Indent the drawer at point." - (interactive) - (let ((p (point)) - (e (and (save-excursion (re-search-forward ":END:" nil t)) - (match-end 0))) - (folded - (save-excursion - (end-of-line) - (when (overlays-at (point)) - (member 'invisible (overlay-properties - (car (overlays-at (point))))))))) - (when folded (org-cycle)) - (indent-for-tab-command) - (while (and (move-beginning-of-line 2) (< (point) e)) - (indent-for-tab-command)) - (goto-char p) - (when folded (org-cycle))) - (message "Drawer at point indented")) - -(defun org-indent-block () - "Indent the block at point." - (interactive) - (let ((p (point)) - (case-fold-search t) - (e (and (save-excursion (re-search-forward "#\\+end_?\\(?:[a-z]+\\)?" nil t)) - (match-end 0))) - (folded - (save-excursion - (end-of-line) - (when (overlays-at (point)) - (member 'invisible (overlay-properties - (car (overlays-at (point))))))))) - (when folded (org-cycle)) - (indent-for-tab-command) - (while (and (move-beginning-of-line 2) (< (point) e)) - (indent-for-tab-command)) - (goto-char p) - (when folded (org-cycle))) - (message "Block at point indented")) - -(defun org-indent-region (start end) - "Indent region." - (interactive "r") - (save-excursion - (let ((line-end (org-current-line end))) - (goto-char start) - (while (< (org-current-line) line-end) - (cond ((org-in-src-block-p t) (org-src-native-tab-command-maybe)) - (t (call-interactively 'org-indent-line))) - (move-beginning-of-line 2))))) - - -;;; Filling - -;; We use our own fill-paragraph and auto-fill functions. - -;; `org-fill-paragraph' relies on adaptive filling and context -;; checking. Appropriate `fill-prefix' is computed with -;; `org-adaptive-fill-function'. - -;; `org-auto-fill-function' takes care of auto-filling. It calls -;; `do-auto-fill' only on valid areas with `fill-prefix' shadowed with -;; `org-adaptive-fill-function' value. Internally, -;; `org-comment-line-break-function' breaks the line. - -;; `org-setup-filling' installs filling and auto-filling related -;; variables during `org-mode' initialization. - -(defvar org-element-paragraph-separate) ; org-element.el -(defun org-setup-filling () - (require 'org-element) - ;; Prevent auto-fill from inserting unwanted new items. - (when (boundp 'fill-nobreak-predicate) - (org-set-local - 'fill-nobreak-predicate - (org-uniquify - (append fill-nobreak-predicate - '(org-fill-line-break-nobreak-p - org-fill-paragraph-with-timestamp-nobreak-p))))) - (let ((paragraph-ending (substring org-element-paragraph-separate 1))) - (org-set-local 'paragraph-start paragraph-ending) - (org-set-local 'paragraph-separate paragraph-ending)) - (org-set-local 'fill-paragraph-function 'org-fill-paragraph) - (org-set-local 'auto-fill-inhibit-regexp nil) - (org-set-local 'adaptive-fill-function 'org-adaptive-fill-function) - (org-set-local 'normal-auto-fill-function 'org-auto-fill-function) - (org-set-local 'comment-line-break-function 'org-comment-line-break-function)) - -(defun org-fill-line-break-nobreak-p () - "Non-nil when a new line at point would create an Org line break." - (save-excursion - (skip-chars-backward "[ \t]") - (skip-chars-backward "\\\\") - (looking-at "\\\\\\\\\\($\\|[^\\\\]\\)"))) - -(defun org-fill-paragraph-with-timestamp-nobreak-p () - "Non-nil when a new line at point would split a timestamp." - (and (org-at-timestamp-p t) - (not (looking-at org-ts-regexp-both)))) - -(declare-function message-in-body-p "message" ()) -(defvar orgtbl-line-start-regexp) ; From org-table.el -(defun org-adaptive-fill-function () - "Compute a fill prefix for the current line. -Return fill prefix, as a string, or nil if current line isn't -meant to be filled. For convenience, if `adaptive-fill-regexp' -matches in paragraphs or comments, use it." - (catch 'exit - (when (derived-mode-p 'message-mode) - (save-excursion - (beginning-of-line) - (cond ((or (not (message-in-body-p)) - (looking-at orgtbl-line-start-regexp)) - (throw 'exit nil)) - ((looking-at message-cite-prefix-regexp) - (throw 'exit (match-string-no-properties 0))) - ((looking-at org-outline-regexp) - (throw 'exit (make-string (length (match-string 0)) ? )))))) - (org-with-wide-buffer - (let* ((p (line-beginning-position)) - (element (save-excursion - (beginning-of-line) - (or (ignore-errors (org-element-at-point)) - (user-error "An element cannot be parsed line %d" - (line-number-at-pos (point)))))) - (type (org-element-type element)) - (post-affiliated (org-element-property :post-affiliated element))) - (unless (and post-affiliated (< p post-affiliated)) - (case type - (comment - (save-excursion - (beginning-of-line) - (looking-at "[ \t]*") - (concat (match-string 0) "# "))) - (footnote-definition "") - ((item plain-list) - (make-string (org-list-item-body-column - (or post-affiliated - (org-element-property :begin element))) - ? )) - (paragraph - ;; Fill prefix is usually the same as the current line, - ;; unless the paragraph is at the beginning of an item. - (let ((parent (org-element-property :parent element))) - (save-excursion - (beginning-of-line) - (cond ((eq (org-element-type parent) 'item) - (make-string (org-list-item-body-column - (org-element-property :begin parent)) - ? )) - ((and adaptive-fill-regexp - ;; Locally disable - ;; `adaptive-fill-function' to let - ;; `fill-context-prefix' handle - ;; `adaptive-fill-regexp' variable. - (let (adaptive-fill-function) - (fill-context-prefix - post-affiliated - (org-element-property :end element))))) - ((looking-at "[ \t]+") (match-string 0)) - (t ""))))) - (comment-block - ;; Only fill contents if P is within block boundaries. - (let* ((cbeg (save-excursion (goto-char post-affiliated) - (forward-line) - (point))) - (cend (save-excursion - (goto-char (org-element-property :end element)) - (skip-chars-backward " \r\t\n") - (line-beginning-position)))) - (when (and (>= p cbeg) (< p cend)) - (if (save-excursion (beginning-of-line) (looking-at "[ \t]+")) - (match-string 0) - "")))))))))) - -(declare-function message-goto-body "message" ()) -(defvar message-cite-prefix-regexp) ; From message.el -(defun org-fill-paragraph (&optional justify) - "Fill element at point, when applicable. - -This function only applies to comment blocks, comments, example -blocks and paragraphs. Also, as a special case, re-align table -when point is at one. - -If JUSTIFY is non-nil (interactively, with prefix argument), -justify as well. If `sentence-end-double-space' is non-nil, then -period followed by one space does not end a sentence, so don't -break a line there. The variable `fill-column' controls the -width for filling. - -For convenience, when point is at a plain list, an item or -a footnote definition, try to fill the first paragraph within." - (interactive) - (if (and (derived-mode-p 'message-mode) - (or (not (message-in-body-p)) - (save-excursion (move-beginning-of-line 1) - (looking-at message-cite-prefix-regexp)))) - ;; First ensure filling is correct in message-mode. - (let ((fill-paragraph-function - (cadadr (assoc 'fill-paragraph-function org-fb-vars))) - (fill-prefix (cadadr (assoc 'fill-prefix org-fb-vars))) - (paragraph-start (cadadr (assoc 'paragraph-start org-fb-vars))) - (paragraph-separate - (cadadr (assoc 'paragraph-separate org-fb-vars)))) - (fill-paragraph nil)) - (with-syntax-table org-mode-transpose-word-syntax-table - ;; Move to end of line in order to get the first paragraph - ;; within a plain list or a footnote definition. - (let ((element (save-excursion - (end-of-line) - (or (ignore-errors (org-element-at-point)) - (user-error "An element cannot be parsed line %d" - (line-number-at-pos (point))))))) - ;; First check if point is in a blank line at the beginning of - ;; the buffer. In that case, ignore filling. - (case (org-element-type element) - ;; Use major mode filling function is src blocks. - (src-block (org-babel-do-key-sequence-in-edit-buffer (kbd "M-q"))) - ;; Align Org tables, leave table.el tables as-is. - (table-row (org-table-align) t) - (table - (when (eq (org-element-property :type element) 'org) - (save-excursion - (goto-char (org-element-property :post-affiliated element)) - (org-table-align))) - t) - (paragraph - ;; Paragraphs may contain `line-break' type objects. - (let ((beg (max (point-min) - (org-element-property :contents-begin element))) - (end (min (point-max) - (org-element-property :contents-end element)))) - ;; Do nothing if point is at an affiliated keyword. - (if (< (line-end-position) beg) t - (when (derived-mode-p 'message-mode) - ;; In `message-mode', do not fill following citation - ;; in current paragraph nor text before message body. - (let ((body-start (save-excursion (message-goto-body)))) - (when body-start (setq beg (max body-start beg)))) - (when (save-excursion - (re-search-forward - (concat "^" message-cite-prefix-regexp) end t)) - (setq end (match-beginning 0)))) - ;; Fill paragraph, taking line breaks into account. - ;; For that, slice the paragraph using line breaks as - ;; separators, and fill the parts in reverse order to - ;; avoid messing with markers. - (save-excursion - (goto-char end) - (mapc - (lambda (pos) - (fill-region-as-paragraph pos (point) justify) - (goto-char pos)) - ;; Find the list of ending positions for line breaks - ;; in the current paragraph. Add paragraph - ;; beginning to include first slice. - (nreverse - (cons beg - (org-element-map - (org-element--parse-objects - beg end nil (org-element-restriction 'paragraph)) - 'line-break - (lambda (lb) (org-element-property :end lb))))))) - t))) - ;; Contents of `comment-block' type elements should be - ;; filled as plain text, but only if point is within block - ;; markers. - (comment-block - (let* ((case-fold-search t) - (beg (save-excursion - (goto-char (org-element-property :begin element)) - (re-search-forward "^[ \t]*#\\+begin_comment" nil t) - (forward-line) - (point))) - (end (save-excursion - (goto-char (org-element-property :end element)) - (re-search-backward "^[ \t]*#\\+end_comment" nil t) - (line-beginning-position)))) - (if (or (< (point) beg) (> (point) end)) t - (fill-region-as-paragraph - (save-excursion (end-of-line) - (re-search-backward "^[ \t]*$" beg 'move) - (line-beginning-position)) - (save-excursion (beginning-of-line) - (re-search-forward "^[ \t]*$" end 'move) - (line-beginning-position)) - justify)))) - ;; Fill comments. - (comment - (let ((begin (org-element-property :post-affiliated element)) - (end (org-element-property :end element))) - (when (and (>= (point) begin) (<= (point) end)) - (let ((begin (save-excursion - (end-of-line) - (if (re-search-backward "^[ \t]*#[ \t]*$" begin t) - (progn (forward-line) (point)) - begin))) - (end (save-excursion - (end-of-line) - (if (re-search-forward "^[ \t]*#[ \t]*$" end 'move) - (1- (line-beginning-position)) - (skip-chars-backward " \r\t\n") - (line-end-position))))) - ;; Do not fill comments when at a blank line. - (when (> end begin) - (let ((fill-prefix - (save-excursion - (beginning-of-line) - (looking-at "[ \t]*#") - (let ((comment-prefix (match-string 0))) - (goto-char (match-end 0)) - (if (looking-at adaptive-fill-regexp) - (concat comment-prefix (match-string 0)) - (concat comment-prefix " ")))))) - (save-excursion - (fill-region-as-paragraph begin end justify)))))) - t)) - ;; Ignore every other element. - (otherwise t)))))) - -(defun org-auto-fill-function () - "Auto-fill function." - ;; Check if auto-filling is meaningful. - (let ((fc (current-fill-column))) - (when (and fc (> (current-column) fc)) - (let* ((fill-prefix (org-adaptive-fill-function)) - ;; Enforce empty fill prefix, if required. Otherwise, it - ;; will be computed again. - (adaptive-fill-mode (not (equal fill-prefix "")))) - (when fill-prefix (do-auto-fill)))))) - -(defun org-comment-line-break-function (&optional soft) - "Break line at point and indent, continuing comment if within one. -The inserted newline is marked hard if variable -`use-hard-newlines' is true, unless optional argument SOFT is -non-nil." - (if soft (insert-and-inherit ?\n) (newline 1)) - (save-excursion (forward-char -1) (delete-horizontal-space)) - (delete-horizontal-space) - (indent-to-left-margin) - (insert-before-markers-and-inherit fill-prefix)) - - -;;; Comments - -;; Org comments syntax is quite complex. It requires the entire line -;; to be just a comment. Also, even with the right syntax at the -;; beginning of line, some some elements (i.e. verse-block or -;; example-block) don't accept comments. Usual Emacs comment commands -;; cannot cope with those requirements. Therefore, Org replaces them. - -;; Org still relies on `comment-dwim', but cannot trust -;; `comment-only-p'. So, `comment-region-function' and -;; `uncomment-region-function' both point -;; to`org-comment-or-uncomment-region'. Eventually, -;; `org-insert-comment' takes care of insertion of comments at the -;; beginning of line. - -;; `org-setup-comments-handling' install comments related variables -;; during `org-mode' initialization. - -(defun org-setup-comments-handling () - (interactive) - (org-set-local 'comment-use-syntax nil) - (org-set-local 'comment-start "# ") - (org-set-local 'comment-start-skip "^\\s-*#\\(?: \\|$\\)") - (org-set-local 'comment-insert-comment-function 'org-insert-comment) - (org-set-local 'comment-region-function 'org-comment-or-uncomment-region) - (org-set-local 'uncomment-region-function 'org-comment-or-uncomment-region)) - -(defun org-insert-comment () - "Insert an empty comment above current line. -If the line is empty, insert comment at its beginning." - (beginning-of-line) - (if (looking-at "\\s-*$") (replace-match "") (open-line 1)) - (org-indent-line) - (insert "# ")) - -(defvar comment-empty-lines) ; From newcomment.el. -(defun org-comment-or-uncomment-region (beg end &rest ignore) - "Comment or uncomment each non-blank line in the region. -Uncomment each non-blank line between BEG and END if it only -contains commented lines. Otherwise, comment them." - (save-restriction - ;; Restrict region - (narrow-to-region (save-excursion (goto-char beg) - (skip-chars-forward " \r\t\n" end) - (line-beginning-position)) - (save-excursion (goto-char end) - (skip-chars-backward " \r\t\n" beg) - (line-end-position))) - (let ((uncommentp - ;; UNCOMMENTP is non-nil when every non blank line between - ;; BEG and END is a comment. - (save-excursion - (goto-char (point-min)) - (while (and (not (eobp)) - (let ((element (org-element-at-point))) - (and (eq (org-element-type element) 'comment) - (goto-char (min (point-max) - (org-element-property - :end element))))))) - (eobp)))) - (if uncommentp - ;; Only blank lines and comments in region: uncomment it. - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (when (looking-at "[ \t]*\\(#\\(?: \\|$\\)\\)") - (replace-match "" nil nil nil 1)) - (forward-line))) - ;; Comment each line in region. - (let ((min-indent (point-max))) - ;; First find the minimum indentation across all lines. - (save-excursion - (goto-char (point-min)) - (while (and (not (eobp)) (not (zerop min-indent))) - (unless (looking-at "[ \t]*$") - (setq min-indent (min min-indent (current-indentation)))) - (forward-line))) - ;; Then loop over all lines. - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (unless (and (not comment-empty-lines) (looking-at "[ \t]*$")) - ;; Don't get fooled by invisible text (e.g. link path) - ;; when moving to column MIN-INDENT. - (let ((buffer-invisibility-spec nil)) - (org-move-to-column min-indent t)) - (insert comment-start)) - (forward-line)))))))) - - -;;; Planning - -;; This section contains tools to operate on timestamp objects, as -;; returned by, e.g. `org-element-context'. - -(defun org-timestamp-has-time-p (timestamp) - "Non-nil when TIMESTAMP has a time specified." - (org-element-property :hour-start timestamp)) - -(defun org-timestamp-format (timestamp format &optional end utc) - "Format a TIMESTAMP element into a string. - -FORMAT is a format specifier to be passed to -`format-time-string'. - -When optional argument END is non-nil, use end of date-range or -time-range, if possible. - -When optional argument UTC is non-nil, time will be expressed as -Universal Time." - (format-time-string - format - (apply 'encode-time - (cons 0 - (mapcar - (lambda (prop) (or (org-element-property prop timestamp) 0)) - (if end '(:minute-end :hour-end :day-end :month-end :year-end) - '(:minute-start :hour-start :day-start :month-start - :year-start))))) - utc)) - -(defun org-timestamp-split-range (timestamp &optional end) - "Extract a timestamp object from a date or time range. - -TIMESTAMP is a timestamp object. END, when non-nil, means extract -the end of the range. Otherwise, extract its start. - -Return a new timestamp object sharing the same parent as -TIMESTAMP." - (let ((type (org-element-property :type timestamp))) - (if (memq type '(active inactive diary)) timestamp - (let ((split-ts (list 'timestamp (copy-sequence (nth 1 timestamp))))) - ;; Set new type. - (org-element-put-property - split-ts :type (if (eq type 'active-range) 'active 'inactive)) - ;; Copy start properties over end properties if END is - ;; non-nil. Otherwise, copy end properties over `start' ones. - (let ((p-alist '((:minute-start . :minute-end) - (:hour-start . :hour-end) - (:day-start . :day-end) - (:month-start . :month-end) - (:year-start . :year-end)))) - (dolist (p-cell p-alist) - (org-element-put-property - split-ts - (funcall (if end 'car 'cdr) p-cell) - (org-element-property - (funcall (if end 'cdr 'car) p-cell) split-ts))) - ;; Eventually refresh `:raw-value'. - (org-element-put-property split-ts :raw-value nil) - (org-element-put-property - split-ts :raw-value (org-element-interpret-data split-ts))))))) - -(defun org-timestamp-translate (timestamp &optional boundary) - "Apply `org-translate-time' on a TIMESTAMP object. -When optional argument BOUNDARY is non-nil, it is either the -symbol `start' or `end'. In this case, only translate the -starting or ending part of TIMESTAMP if it is a date or time -range. Otherwise, translate both parts." - (if (and (not boundary) - (memq (org-element-property :type timestamp) - '(active-range inactive-range))) - (concat - (org-translate-time - (org-element-property :raw-value - (org-timestamp-split-range timestamp))) - "--" - (org-translate-time - (org-element-property :raw-value - (org-timestamp-split-range timestamp t)))) - (org-translate-time - (org-element-property - :raw-value - (if (not boundary) timestamp - (org-timestamp-split-range timestamp (eq boundary 'end))))))) - - - -;;; Other stuff. - -(defun org-toggle-fixed-width-section (arg) - "Toggle the fixed-width export. -If there is no active region, the QUOTE keyword at the current headline is -inserted or removed. When present, it causes the text between this headline -and the next to be exported as fixed-width text, and unmodified. -If there is an active region, this command adds or removes a colon as the -first character of this line. If the first character of a line is a colon, -this line is also exported in fixed-width font." - (interactive "P") - (let* ((cc 0) - (regionp (org-region-active-p)) - (beg (if regionp (region-beginning) (point))) - (end (if regionp (region-end))) - (nlines (or arg (if (and beg end) (count-lines beg end) 1))) - (case-fold-search nil) - (re "[ \t]*\\(:\\(?: \\|$\\)\\)") - off) - (if regionp - (save-excursion - (goto-char beg) - (setq cc (current-column)) - (beginning-of-line 1) - (setq off (looking-at re)) - (while (> nlines 0) - (setq nlines (1- nlines)) - (beginning-of-line 1) - (cond - (arg - (org-move-to-column cc t) - (insert ": \n") - (forward-line -1)) - ((and off (looking-at re)) - (replace-match "" t t nil 1)) - ((not off) (org-move-to-column cc t) (insert ": "))) - (forward-line 1))) - (save-excursion - (org-back-to-heading) - (cond - ((looking-at (format org-heading-keyword-regexp-format - org-quote-string)) - (goto-char (match-end 1)) - (looking-at (concat " +" org-quote-string)) - (replace-match "" t t) - (when (eolp) (insert " "))) - ((looking-at org-outline-regexp) - (goto-char (match-end 0)) - (insert org-quote-string " "))))))) - -(defun org-reftex-citation () - "Use reftex-citation to insert a citation into the buffer. -This looks for a line like - -#+BIBLIOGRAPHY: foo plain option:-d - -and derives from it that foo.bib is the bibliography file relevant -for this document. It then installs the necessary environment for RefTeX -to work in this buffer and calls `reftex-citation' to insert a citation -into the buffer. - -Export of such citations to both LaTeX and HTML is handled by the contributed -package ox-bibtex by Taru Karttunen." - (interactive) - (let ((reftex-docstruct-symbol 'rds) - (reftex-cite-format "\\cite{%l}") - rds bib) - (save-excursion - (save-restriction - (widen) - (let ((case-fold-search t) - (re "^#\\+bibliography:[ \t]+\\([^ \t\n]+\\)")) - (if (not (save-excursion - (or (re-search-forward re nil t) - (re-search-backward re nil t)))) - (error "No bibliography defined in file") - (setq bib (concat (match-string 1) ".bib") - rds (list (list 'bib bib))))))) - (call-interactively 'reftex-citation))) - -;;;; Functions extending outline functionality - -(defun org-beginning-of-line (&optional arg) - "Go to the beginning of the current line. If that is invisible, continue -to a visible line beginning. This makes the function of C-a more intuitive. -If this is a headline, and `org-special-ctrl-a/e' is set, ignore tags on the -first attempt, and only move to after the tags when the cursor is already -beyond the end of the headline." - (interactive "P") - (let ((pos (point)) - (special (if (consp org-special-ctrl-a/e) - (car org-special-ctrl-a/e) - org-special-ctrl-a/e)) - deactivate-mark refpos) - (if (org-bound-and-true-p visual-line-mode) - (beginning-of-visual-line 1) - (beginning-of-line 1)) - (if (and arg (fboundp 'move-beginning-of-line)) - (call-interactively 'move-beginning-of-line) - (if (bobp) - nil - (backward-char 1) - (if (org-truely-invisible-p) - (while (and (not (bobp)) (org-truely-invisible-p)) - (backward-char 1) - (beginning-of-line 1)) - (forward-char 1)))) - (when special - (cond - ((and (looking-at org-complex-heading-regexp) - (= (char-after (match-end 1)) ?\ )) - (setq refpos (min (1+ (or (match-end 3) (match-end 2) (match-end 1))) - (point-at-eol))) - (goto-char - (if (eq special t) - (cond ((> pos refpos) refpos) - ((= pos (point)) refpos) - (t (point))) - (cond ((> pos (point)) (point)) - ((not (eq last-command this-command)) (point)) - (t refpos))))) - ((org-at-item-p) - ;; Being at an item and not looking at an the item means point - ;; was previously moved to beginning of a visual line, which - ;; doesn't contain the item. Therefore, do nothing special, - ;; just stay here. - (when (looking-at org-list-full-item-re) - ;; Set special position at first white space character after - ;; bullet, and check-box, if any. - (let ((after-bullet - (let ((box (match-end 3))) - (if (not box) (match-end 1) - (let ((after (char-after box))) - (if (and after (= after ? )) (1+ box) box)))))) - ;; Special case: Move point to special position when - ;; currently after it or at beginning of line. - (if (eq special t) - (when (or (> pos after-bullet) (= (point) pos)) - (goto-char after-bullet)) - ;; Reversed case: Move point to special position when - ;; point was already at beginning of line and command is - ;; repeated. - (when (and (= (point) pos) (eq last-command this-command)) - (goto-char after-bullet)))))))) - (org-no-warnings - (and (featurep 'xemacs) (setq zmacs-region-stays t)))) - (setq disable-point-adjustment - (or (not (invisible-p (point))) - (not (invisible-p (max (point-min) (1- (point)))))))) - -(defun org-end-of-line (&optional arg) - "Go to the end of the line. -If this is a headline, and `org-special-ctrl-a/e' is set, ignore -tags on the first attempt, and only move to after the tags when -the cursor is already beyond the end of the headline." - (interactive "P") - (let ((special (if (consp org-special-ctrl-a/e) (cdr org-special-ctrl-a/e) - org-special-ctrl-a/e)) - (move-fun (cond ((org-bound-and-true-p visual-line-mode) - 'end-of-visual-line) - ((fboundp 'move-end-of-line) 'move-end-of-line) - (t 'end-of-line))) - deactivate-mark) - (if (or (not special) arg) (call-interactively move-fun) - (let* ((element (save-excursion (beginning-of-line) - (org-element-at-point))) - (type (org-element-type element))) - (cond - ((memq type '(headline inlinetask)) - (let ((pos (point))) - (beginning-of-line 1) - (if (looking-at (org-re ".*?\\(?:\\([ \t]*\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\)?$")) - (if (eq special t) - (if (or (< pos (match-beginning 1)) (= pos (match-end 0))) - (goto-char (match-beginning 1)) - (goto-char (match-end 0))) - (if (or (< pos (match-end 0)) - (not (eq this-command last-command))) - (goto-char (match-end 0)) - (goto-char (match-beginning 1)))) - (call-interactively move-fun)))) - ((org-element-property :hiddenp element) - ;; If element is hidden, `move-end-of-line' would put point - ;; after it. Use `end-of-line' to stay on current line. - (call-interactively 'end-of-line)) - (t (call-interactively move-fun))))) - (org-no-warnings (and (featurep 'xemacs) (setq zmacs-region-stays t)))) - (setq disable-point-adjustment - (or (not (invisible-p (point))) - (not (invisible-p (max (point-min) (1- (point)))))))) - -(define-key org-mode-map "\C-a" 'org-beginning-of-line) -(define-key org-mode-map "\C-e" 'org-end-of-line) - -(defun org-backward-sentence (&optional arg) - "Go to beginning of sentence, or beginning of table field. -This will call `backward-sentence' or `org-table-beginning-of-field', -depending on context." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-beginning-of-field)) - (t (call-interactively 'backward-sentence)))) - -(defun org-forward-sentence (&optional arg) - "Go to end of sentence, or end of table field. -This will call `forward-sentence' or `org-table-end-of-field', -depending on context." - (interactive "P") - (cond - ((org-at-table-p) (call-interactively 'org-table-end-of-field)) - (t (call-interactively 'forward-sentence)))) - -(define-key org-mode-map "\M-a" 'org-backward-sentence) -(define-key org-mode-map "\M-e" 'org-forward-sentence) - -(defun org-kill-line (&optional arg) - "Kill line, to tags or end of line." - (interactive "P") - (cond - ((or (not org-special-ctrl-k) - (bolp) - (not (org-at-heading-p))) - (if (and (get-char-property (min (point-max) (point-at-eol)) 'invisible) - org-ctrl-k-protect-subtree) - (if (or (eq org-ctrl-k-protect-subtree 'error) - (not (y-or-n-p "Kill hidden subtree along with headline? "))) - (user-error "C-k aborted as it would kill a hidden subtree"))) - (call-interactively - (if (org-bound-and-true-p visual-line-mode) 'kill-visual-line 'kill-line))) - ((looking-at (org-re ".*?\\S-\\([ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)[ \t]*$")) - (kill-region (point) (match-beginning 1)) - (org-set-tags nil t)) - (t (kill-region (point) (point-at-eol))))) - -(define-key org-mode-map "\C-k" 'org-kill-line) - -(defun org-yank (&optional arg) - "Yank. If the kill is a subtree, treat it specially. -This command will look at the current kill and check if is a single -subtree, or a series of subtrees[1]. If it passes the test, and if the -cursor is at the beginning of a line or after the stars of a currently -empty headline, then the yank is handled specially. How exactly depends -on the value of the following variables, both set by default. - -org-yank-folded-subtrees - When set, the subtree(s) will be folded after insertion, but only - if doing so would now swallow text after the yanked text. - -org-yank-adjusted-subtrees - When set, the subtree will be promoted or demoted in order to - fit into the local outline tree structure, which means that the level - will be adjusted so that it becomes the smaller one of the two - *visible* surrounding headings. - -Any prefix to this command will cause `yank' to be called directly with -no special treatment. In particular, a simple \\[universal-argument] prefix \ -will just -plainly yank the text as it is. - -\[1] The test checks if the first non-white line is a heading - and if there are no other headings with fewer stars." - (interactive "P") - (org-yank-generic 'yank arg)) - -(defun org-yank-generic (command arg) - "Perform some yank-like command. - -This function implements the behavior described in the `org-yank' -documentation. However, it has been generalized to work for any -interactive command with similar behavior." - - ;; pretend to be command COMMAND - (setq this-command command) - - (if arg - (call-interactively command) - - (let ((subtreep ; is kill a subtree, and the yank position appropriate? - (and (org-kill-is-subtree-p) - (or (bolp) - (and (looking-at "[ \t]*$") - (string-match - "\\`\\*+\\'" - (buffer-substring (point-at-bol) (point))))))) - swallowp) - (cond - ((and subtreep org-yank-folded-subtrees) - (let ((beg (point)) - end) - (if (and subtreep org-yank-adjusted-subtrees) - (org-paste-subtree nil nil 'for-yank) - (call-interactively command)) - - (setq end (point)) - (goto-char beg) - (when (and (bolp) subtreep - (not (setq swallowp - (org-yank-folding-would-swallow-text beg end)))) - (org-with-limited-levels - (or (looking-at org-outline-regexp) - (re-search-forward org-outline-regexp-bol end t)) - (while (and (< (point) end) (looking-at org-outline-regexp)) - (hide-subtree) - (org-cycle-show-empty-lines 'folded) - (condition-case nil - (outline-forward-same-level 1) - (error (goto-char end)))))) - (when swallowp - (message - "Inserted text not folded because that would swallow text")) - - (goto-char end) - (skip-chars-forward " \t\n\r") - (beginning-of-line 1) - (push-mark beg 'nomsg))) - ((and subtreep org-yank-adjusted-subtrees) - (let ((beg (point-at-bol))) - (org-paste-subtree nil nil 'for-yank) - (push-mark beg 'nomsg))) - (t - (call-interactively command)))))) - -(defun org-yank-folding-would-swallow-text (beg end) - "Would hide-subtree at BEG swallow any text after END?" - (let (level) - (org-with-limited-levels - (save-excursion - (goto-char beg) - (when (or (looking-at org-outline-regexp) - (re-search-forward org-outline-regexp-bol end t)) - (setq level (org-outline-level))) - (goto-char end) - (skip-chars-forward " \t\r\n\v\f") - (if (or (eobp) - (and (bolp) (looking-at org-outline-regexp) - (<= (org-outline-level) level))) - nil ; Nothing would be swallowed - t))))) ; something would swallow - -(define-key org-mode-map "\C-y" 'org-yank) - -(defun org-truely-invisible-p () - "Check if point is at a character currently not visible. -This version does not only check the character property, but also -`visible-mode'." - ;; Early versions of noutline don't have `outline-invisible-p'. - (if (org-bound-and-true-p visible-mode) - nil - (outline-invisible-p))) - -(defun org-invisible-p2 () - "Check if point is at a character currently not visible." - (save-excursion - (if (and (eolp) (not (bobp))) (backward-char 1)) - ;; Early versions of noutline don't have `outline-invisible-p'. - (outline-invisible-p))) - -(defun org-back-to-heading (&optional invisible-ok) - "Call `outline-back-to-heading', but provide a better error message." - (condition-case nil - (outline-back-to-heading invisible-ok) - (error (error "Before first headline at position %d in buffer %s" - (point) (current-buffer))))) - -(defun org-before-first-heading-p () - "Before first heading?" - (save-excursion - (end-of-line) - (null (re-search-backward org-outline-regexp-bol nil t)))) - -(defun org-at-heading-p (&optional ignored) - (outline-on-heading-p t)) -;; Compatibility alias with Org versions < 7.8.03 -(defalias 'org-on-heading-p 'org-at-heading-p) - -(defun org-at-comment-p nil - "Is cursor in a line starting with a # character?" - (save-excursion - (beginning-of-line) - (looking-at "^#"))) - -(defun org-at-drawer-p nil - "Is cursor at a drawer keyword?" - (save-excursion - (move-beginning-of-line 1) - (looking-at org-drawer-regexp))) - -(defun org-at-block-p nil - "Is cursor at a block keyword?" - (save-excursion - (move-beginning-of-line 1) - (looking-at org-block-regexp))) - -(defun org-point-at-end-of-empty-headline () - "If point is at the end of an empty headline, return t, else nil. -If the heading only contains a TODO keyword, it is still still considered -empty." - (and (looking-at "[ \t]*$") - (when org-todo-line-regexp - (save-excursion - (beginning-of-line 1) - (let ((case-fold-search nil)) - (looking-at org-todo-line-regexp) - (string= (match-string 3) "")))))) - -(defun org-at-heading-or-item-p () - (or (org-at-heading-p) (org-at-item-p))) - -(defun org-at-target-p () - (or (org-in-regexp org-radio-target-regexp) - (org-in-regexp org-target-regexp))) -;; Compatibility alias with Org versions < 7.8.03 -(defalias 'org-on-target-p 'org-at-target-p) - -(defun org-up-heading-all (arg) - "Move to the heading line of which the present line is a subheading. -This function considers both visible and invisible heading lines. -With argument, move up ARG levels." - (if (fboundp 'outline-up-heading-all) - (outline-up-heading-all arg) ; emacs 21 version of outline.el - (outline-up-heading arg t))) ; emacs 22 version of outline.el - -(defun org-up-heading-safe () - "Move to the heading line of which the present line is a subheading. -This version will not throw an error. It will return the level of the -headline found, or nil if no higher level is found. - -Also, this function will be a lot faster than `outline-up-heading', -because it relies on stars being the outline starters. This can really -make a significant difference in outlines with very many siblings." - (let (start-level re) - (org-back-to-heading t) - (setq start-level (funcall outline-level)) - (if (equal start-level 1) - nil - (setq re (concat "^\\*\\{1," (number-to-string (1- start-level)) "\\} ")) - (if (re-search-backward re nil t) - (funcall outline-level))))) - -(defun org-first-sibling-p () - "Is this heading the first child of its parents?" - (interactive) - (let ((re org-outline-regexp-bol) - level l) - (unless (org-at-heading-p t) - (user-error "Not at a heading")) - (setq level (funcall outline-level)) - (save-excursion - (if (not (re-search-backward re nil t)) - t - (setq l (funcall outline-level)) - (< l level))))) - -(defun org-goto-sibling (&optional previous) - "Goto the next sibling, even if it is invisible. -When PREVIOUS is set, go to the previous sibling instead. Returns t -when a sibling was found. When none is found, return nil and don't -move point." - (let ((fun (if previous 're-search-backward 're-search-forward)) - (pos (point)) - (re org-outline-regexp-bol) - level l) - (when (condition-case nil (org-back-to-heading t) (error nil)) - (setq level (funcall outline-level)) - (catch 'exit - (or previous (forward-char 1)) - (while (funcall fun re nil t) - (setq l (funcall outline-level)) - (when (< l level) (goto-char pos) (throw 'exit nil)) - (when (= l level) (goto-char (match-beginning 0)) (throw 'exit t))) - (goto-char pos) - nil)))) - -(defun org-show-siblings () - "Show all siblings of the current headline." - (save-excursion - (while (org-goto-sibling) (org-flag-heading nil))) - (save-excursion - (while (org-goto-sibling 'previous) - (org-flag-heading nil)))) - -(defun org-goto-first-child () - "Goto the first child, even if it is invisible. -Return t when a child was found. Otherwise don't move point and -return nil." - (let (level (pos (point)) (re org-outline-regexp-bol)) - (when (condition-case nil (org-back-to-heading t) (error nil)) - (setq level (outline-level)) - (forward-char 1) - (if (and (re-search-forward re nil t) (> (outline-level) level)) - (progn (goto-char (match-beginning 0)) t) - (goto-char pos) nil)))) - -(defun org-show-hidden-entry () - "Show an entry where even the heading is hidden." - (save-excursion - (org-show-entry))) - -(defun org-flag-heading (flag &optional entry) - "Flag the current heading. FLAG non-nil means make invisible. -When ENTRY is non-nil, show the entire entry." - (save-excursion - (org-back-to-heading t) - ;; Check if we should show the entire entry - (if entry - (progn - (org-show-entry) - (save-excursion - (and (outline-next-heading) - (org-flag-heading nil)))) - (outline-flag-region (max (point-min) (1- (point))) - (save-excursion (outline-end-of-heading) (point)) - flag)))) - -(defun org-get-next-sibling () - "Move to next heading of the same level, and return point. -If there is no such heading, return nil. -This is like outline-next-sibling, but invisible headings are ok." - (let ((level (funcall outline-level))) - (outline-next-heading) - (while (and (not (eobp)) (> (funcall outline-level) level)) - (outline-next-heading)) - (if (or (eobp) (< (funcall outline-level) level)) - nil - (point)))) - -(defun org-get-last-sibling () - "Move to previous heading of the same level, and return point. -If there is no such heading, return nil." - (let ((opoint (point)) - (level (funcall outline-level))) - (outline-previous-heading) - (when (and (/= (point) opoint) (outline-on-heading-p t)) - (while (and (> (funcall outline-level) level) - (not (bobp))) - (outline-previous-heading)) - (if (< (funcall outline-level) level) - nil - (point))))) - -(defun org-end-of-subtree (&optional invisible-ok to-heading) - "Goto to the end of a subtree." - ;; This contains an exact copy of the original function, but it uses - ;; `org-back-to-heading', to make it work also in invisible - ;; trees. And is uses an invisible-ok argument. - ;; Under Emacs this is not needed, but the old outline.el needs this fix. - ;; Furthermore, when used inside Org, finding the end of a large subtree - ;; with many children and grandchildren etc, this can be much faster - ;; than the outline version. - (org-back-to-heading invisible-ok) - (let ((first t) - (level (funcall outline-level))) - (if (and (derived-mode-p 'org-mode) (< level 1000)) - ;; A true heading (not a plain list item), in Org-mode - ;; This means we can easily find the end by looking - ;; only for the right number of stars. Using a regexp to do - ;; this is so much faster than using a Lisp loop. - (let ((re (concat "^\\*\\{1," (int-to-string level) "\\} "))) - (forward-char 1) - (and (re-search-forward re nil 'move) (beginning-of-line 1))) - ;; something else, do it the slow way - (while (and (not (eobp)) - (or first (> (funcall outline-level) level))) - (setq first nil) - (outline-next-heading))) - (unless to-heading - (if (memq (preceding-char) '(?\n ?\^M)) - (progn - ;; Go to end of line before heading - (forward-char -1) - (if (memq (preceding-char) '(?\n ?\^M)) - ;; leave blank line before heading - (forward-char -1)))))) - (point)) - -(defadvice outline-end-of-subtree (around prefer-org-version activate compile) - "Use Org version in org-mode, for dramatic speed-up." - (if (derived-mode-p 'org-mode) - (progn - (org-end-of-subtree nil t) - (unless (eobp) (backward-char 1))) - ad-do-it)) - -(defun org-end-of-meta-data-and-drawers () - "Jump to the first text after meta data and drawers in the current entry. -This will move over empty lines, lines with planning time stamps, -clocking lines, and drawers." - (org-back-to-heading t) - (let ((end (save-excursion (outline-next-heading) (point))) - (re (concat "\\(" org-drawer-regexp "\\)" - "\\|" "[ \t]*" org-keyword-time-regexp))) - (forward-line 1) - (while (re-search-forward re end t) - (if (not (match-end 1)) - ;; empty or planning line - (forward-line 1) - ;; a drawer, find the end - (re-search-forward "^[ \t]*:END:" end 'move) - (forward-line 1))) - (and (re-search-forward "[^\n]" nil t) (backward-char 1)) - (point))) - -(defun org-forward-heading-same-level (arg &optional invisible-ok) - "Move forward to the ARG'th subheading at same level as this one. -Stop at the first and last subheadings of a superior heading. -Normally this only looks at visible headings, but when INVISIBLE-OK is -non-nil it will also look at invisible ones." - (interactive "p") - (if (not (ignore-errors (org-back-to-heading invisible-ok))) - (if (and arg (< arg 0)) - (goto-char (point-min)) - (outline-next-heading)) - (org-at-heading-p) - (let ((level (- (match-end 0) (match-beginning 0) 1)) - (f (if (and arg (< arg 0)) - 're-search-backward - 're-search-forward)) - (count (if arg (abs arg) 1)) - (result (point))) - (while (and (prog1 (> count 0) - (forward-char (if (and arg (< arg 0)) -1 1))) - (funcall f org-outline-regexp-bol nil 'move)) - (let ((l (- (match-end 0) (match-beginning 0) 1))) - (cond ((< l level) (setq count 0)) - ((and (= l level) - (or invisible-ok - (progn - (goto-char (line-beginning-position)) - (not (outline-invisible-p))))) - (setq count (1- count)) - (when (eq l level) - (setq result (point))))))) - (goto-char result)) - (beginning-of-line 1))) - -(defun org-backward-heading-same-level (arg &optional invisible-ok) - "Move backward to the ARG'th subheading at same level as this one. -Stop at the first and last subheadings of a superior heading." - (interactive "p") - (org-forward-heading-same-level (if arg (- arg) -1) invisible-ok)) - -(defun org-next-block (arg &optional backward block-regexp) - "Jump to the next block. -With a prefix argument ARG, jump forward ARG many source blocks. -When BACKWARD is non-nil, jump to the previous block. -When BLOCK-REGEXP is non-nil, use this regexp to find blocks." - (interactive "p") - (let ((re (or block-regexp org-block-regexp)) - (re-search-fn (or (and backward 're-search-backward) - 're-search-forward))) - (if (looking-at re) (forward-char 1)) - (condition-case nil - (funcall re-search-fn re nil nil arg) - (error (error "No %s code blocks" (if backward "previous" "further" )))) - (goto-char (match-beginning 0)) (org-show-context))) - -(defun org-previous-block (arg &optional block-regexp) - "Jump to the previous block. -With a prefix argument ARG, jump backward ARG many source blocks. -When BLOCK-REGEXP is non-nil, use this regexp to find blocks." - (interactive "p") - (org-next-block arg t block-regexp)) - -(defun org-forward-paragraph () - "Move forward to beginning of next paragraph or equivalent. - -The function moves point to the beginning of the next visible -structural element, which can be a paragraph, a table, a list -item, etc. It also provides some special moves for convenience: - - - On an affiliated keyword, jump to the beginning of the - relative element. - - On an item or a footnote definition, move to the second - element inside, if any. - - On a table or a property drawer, jump after it. - - On a verse or source block, stop after blank lines." - (interactive) - (when (eobp) (user-error "Cannot move further down")) - (let* ((deactivate-mark nil) - (element (org-element-at-point)) - (type (org-element-type element)) - (post-affiliated (org-element-property :post-affiliated element)) - (contents-begin (org-element-property :contents-begin element)) - (contents-end (org-element-property :contents-end element)) - (end (let ((end (org-element-property :end element)) (parent element)) - (while (and (setq parent (org-element-property :parent parent)) - (= (org-element-property :contents-end parent) end)) - (setq end (org-element-property :end parent))) - end))) - (cond ((not element) - (skip-chars-forward " \r\t\n") - (or (eobp) (beginning-of-line))) - ;; On affiliated keywords, move to element's beginning. - ((and post-affiliated (< (point) post-affiliated)) - (goto-char post-affiliated)) - ;; At a table row, move to the end of the table. Similarly, - ;; at a node property, move to the end of the property - ;; drawer. - ((memq type '(node-property table-row)) - (goto-char (org-element-property - :end (org-element-property :parent element)))) - ((memq type '(property-drawer table)) (goto-char end)) - ;; Consider blank lines as separators in verse and source - ;; blocks to ease editing. - ((memq type '(src-block verse-block)) - (when (eq type 'src-block) - (setq contents-end - (save-excursion (goto-char end) - (skip-chars-backward " \r\t\n") - (line-beginning-position)))) - (beginning-of-line) - (when (looking-at "[ \t]*$") (skip-chars-forward " \r\t\n")) - (if (not (re-search-forward "^[ \t]*$" contents-end t)) - (goto-char end) - (skip-chars-forward " \r\t\n") - (if (= (point) contents-end) (goto-char end) - (beginning-of-line)))) - ;; With no contents, just skip element. - ((not contents-begin) (goto-char end)) - ;; If contents are invisible, skip the element altogether. - ((outline-invisible-p (line-end-position)) - (case type - (headline - (org-with-limited-levels (outline-next-visible-heading 1))) - ;; At a plain list, make sure we move to the next item - ;; instead of skipping the whole list. - (plain-list (forward-char) - (org-forward-paragraph)) - (otherwise (goto-char end)))) - ((>= (point) contents-end) (goto-char end)) - ((>= (point) contents-begin) - ;; This can only happen on paragraphs and plain lists. - (case type - (paragraph (goto-char end)) - ;; At a plain list, try to move to second element in - ;; first item, if possible. - (plain-list (end-of-line) - (org-forward-paragraph)))) - ;; When contents start on the middle of a line (e.g. in - ;; items and footnote definitions), try to reach first - ;; element starting after current line. - ((> (line-end-position) contents-begin) - (end-of-line) - (org-forward-paragraph)) - (t (goto-char contents-begin))))) - -(defun org-backward-paragraph () - "Move backward to start of previous paragraph or equivalent. - -The function moves point to the beginning of the current -structural element, which can be a paragraph, a table, a list -item, etc., or to the beginning of the previous visible one if -point is already there. It also provides some special moves for -convenience: - - - On an affiliated keyword, jump to the first one. - - On a table or a property drawer, move to its beginning. - - On a verse or source block, stop before blank lines." - (interactive) - (when (bobp) (user-error "Cannot move further up")) - (let* ((deactivate-mark nil) - (element (org-element-at-point)) - (type (org-element-type element)) - (contents-begin (org-element-property :contents-begin element)) - (contents-end (org-element-property :contents-end element)) - (post-affiliated (org-element-property :post-affiliated element)) - (begin (org-element-property :begin element))) - (cond - ((not element) (goto-char (point-min))) - ((= (point) begin) - (backward-char) - (org-backward-paragraph)) - ((and post-affiliated (<= (point) post-affiliated)) (goto-char begin)) - ((memq type '(node-property table-row)) - (goto-char (org-element-property - :post-affiliated (org-element-property :parent element)))) - ((memq type '(property-drawer table)) (goto-char begin)) - ((memq type '(src-block verse-block)) - (when (eq type 'src-block) - (setq contents-begin - (save-excursion (goto-char begin) (forward-line) (point)))) - (if (= (point) contents-begin) (goto-char post-affiliated) - ;; Inside a verse block, see blank lines as paragraph - ;; separators. - (let ((origin (point))) - (skip-chars-backward " \r\t\n" contents-begin) - (when (re-search-backward "^[ \t]*$" contents-begin 'move) - (skip-chars-forward " \r\t\n" origin) - (if (= (point) origin) (goto-char contents-begin) - (beginning-of-line)))))) - ((not contents-begin) (goto-char (or post-affiliated begin))) - ((eq type 'paragraph) - (goto-char contents-begin) - ;; When at first paragraph in an item or a footnote definition, - ;; move directly to beginning of line. - (let ((parent-contents - (org-element-property - :contents-begin (org-element-property :parent element)))) - (when (and parent-contents (= parent-contents contents-begin)) - (beginning-of-line)))) - ;; At the end of a greater element, move to the beginning of the - ;; last element within. - ((>= (point) contents-end) - (goto-char (1- contents-end)) - (org-backward-paragraph)) - (t (goto-char (or post-affiliated begin)))) - ;; Ensure we never leave point invisible. - (when (outline-invisible-p (point)) (beginning-of-visual-line)))) - -(defun org-forward-element () - "Move forward by one element. -Move to the next element at the same level, when possible." - (interactive) - (cond ((eobp) (user-error "Cannot move further down")) - ((org-with-limited-levels (org-at-heading-p)) - (let ((origin (point))) - (goto-char (org-end-of-subtree nil t)) - (unless (org-with-limited-levels (org-at-heading-p)) - (goto-char origin) - (user-error "Cannot move further down")))) - (t - (let* ((elem (org-element-at-point)) - (end (org-element-property :end elem)) - (parent (org-element-property :parent elem))) - (cond ((and parent (= (org-element-property :contents-end parent) end)) - (goto-char (org-element-property :end parent))) - ((integer-or-marker-p end) (goto-char end)) - (t (message "No element at point"))))))) - -(defun org-backward-element () - "Move backward by one element. -Move to the previous element at the same level, when possible." - (interactive) - (cond ((bobp) (user-error "Cannot move further up")) - ((org-with-limited-levels (org-at-heading-p)) - ;; At a headline, move to the previous one, if any, or stay - ;; here. - (let ((origin (point))) - (org-with-limited-levels (org-backward-heading-same-level 1)) - ;; When current headline has no sibling above, move to its - ;; parent. - (when (= (point) origin) - (or (org-with-limited-levels (org-up-heading-safe)) - (progn (goto-char origin) - (user-error "Cannot move further up")))))) - (t - (let* ((trail (org-element-at-point 'keep-trail)) - (elem (car trail)) - (prev-elem (nth 1 trail)) - (beg (org-element-property :begin elem))) - (cond - ;; Move to beginning of current element if point isn't - ;; there already. - ((null beg) (message "No element at point")) - ((/= (point) beg) (goto-char beg)) - (prev-elem (goto-char (org-element-property :begin prev-elem))) - ((org-before-first-heading-p) (goto-char (point-min))) - (t (org-back-to-heading))))))) - -(defun org-up-element () - "Move to upper element." - (interactive) - (if (org-with-limited-levels (org-at-heading-p)) - (unless (org-up-heading-safe) (user-error "No surrounding element")) - (let* ((elem (org-element-at-point)) - (parent (org-element-property :parent elem))) - (if parent (goto-char (org-element-property :begin parent)) - (if (org-with-limited-levels (org-before-first-heading-p)) - (user-error "No surrounding element") - (org-with-limited-levels (org-back-to-heading))))))) - -(defvar org-element-greater-elements) -(defun org-down-element () - "Move to inner element." - (interactive) - (let ((element (org-element-at-point))) - (cond - ((memq (org-element-type element) '(plain-list table)) - (goto-char (org-element-property :contents-begin element)) - (forward-char)) - ((memq (org-element-type element) org-element-greater-elements) - ;; If contents are hidden, first disclose them. - (when (org-element-property :hiddenp element) (org-cycle)) - (goto-char (or (org-element-property :contents-begin element) - (user-error "No content for this element")))) - (t (user-error "No inner element"))))) - -(defun org-drag-element-backward () - "Move backward element at point." - (interactive) - (if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up) - (let* ((trail (org-element-at-point 'keep-trail)) - (elem (car trail)) - (prev-elem (nth 1 trail))) - ;; Error out if no previous element or previous element is - ;; a parent of the current one. - (if (or (not prev-elem) (org-element-nested-p elem prev-elem)) - (user-error "Cannot drag element backward") - (let ((pos (point))) - (org-element-swap-A-B prev-elem elem) - (goto-char (+ (org-element-property :begin prev-elem) - (- pos (org-element-property :begin elem))))))))) - -(defun org-drag-element-forward () - "Move forward element at point." - (interactive) - (let* ((pos (point)) - (elem (org-element-at-point))) - (when (= (point-max) (org-element-property :end elem)) - (user-error "Cannot drag element forward")) - (goto-char (org-element-property :end elem)) - (let ((next-elem (org-element-at-point))) - (when (or (org-element-nested-p elem next-elem) - (and (eq (org-element-type next-elem) 'headline) - (not (eq (org-element-type elem) 'headline)))) - (goto-char pos) - (user-error "Cannot drag element forward")) - ;; Compute new position of point: it's shifted by NEXT-ELEM - ;; body's length (without final blanks) and by the length of - ;; blanks between ELEM and NEXT-ELEM. - (let ((size-next (- (save-excursion - (goto-char (org-element-property :end next-elem)) - (skip-chars-backward " \r\t\n") - (forward-line) - ;; Small correction if buffer doesn't end - ;; with a newline character. - (if (and (eolp) (not (bolp))) (1+ (point)) (point))) - (org-element-property :begin next-elem))) - (size-blank (- (org-element-property :end elem) - (save-excursion - (goto-char (org-element-property :end elem)) - (skip-chars-backward " \r\t\n") - (forward-line) - (point))))) - (org-element-swap-A-B elem next-elem) - (goto-char (+ pos size-next size-blank)))))) - -(defun org-drag-line-forward (arg) - "Drag the line at point ARG lines forward." - (interactive "p") - (dotimes (n (abs arg)) - (let ((c (current-column))) - (if (< 0 arg) - (progn - (beginning-of-line 2) - (transpose-lines 1) - (beginning-of-line 0)) - (transpose-lines 1) - (beginning-of-line -1)) - (org-move-to-column c)))) - -(defun org-drag-line-backward (arg) - "Drag the line at point ARG lines backward." - (interactive "p") - (org-drag-line-forward (- arg))) - -(defun org-mark-element () - "Put point at beginning of this element, mark at end. - -Interactively, if this command is repeated or (in Transient Mark -mode) if the mark is active, it marks the next element after the -ones already marked." - (interactive) - (let (deactivate-mark) - (if (and (org-called-interactively-p 'any) - (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active))) - (set-mark - (save-excursion - (goto-char (mark)) - (goto-char (org-element-property :end (org-element-at-point))))) - (let ((element (org-element-at-point))) - (end-of-line) - (push-mark (org-element-property :end element) t t) - (goto-char (org-element-property :begin element)))))) - -(defun org-narrow-to-element () - "Narrow buffer to current element." - (interactive) - (let ((elem (org-element-at-point))) - (cond - ((eq (car elem) 'headline) - (narrow-to-region - (org-element-property :begin elem) - (org-element-property :end elem))) - ((memq (car elem) org-element-greater-elements) - (narrow-to-region - (org-element-property :contents-begin elem) - (org-element-property :contents-end elem))) - (t - (narrow-to-region - (org-element-property :begin elem) - (org-element-property :end elem)))))) - -(defun org-transpose-element () - "Transpose current and previous elements, keeping blank lines between. -Point is moved after both elements." - (interactive) - (org-skip-whitespace) - (let ((end (org-element-property :end (org-element-at-point)))) - (org-drag-element-backward) - (goto-char end))) - -(defun org-unindent-buffer () - "Un-indent the visible part of the buffer. -Relative indentation (between items, inside blocks, etc.) isn't -modified." - (interactive) - (unless (eq major-mode 'org-mode) - (user-error "Cannot un-indent a buffer not in Org mode")) - (let* ((parse-tree (org-element-parse-buffer 'greater-element)) - unindent-tree ; For byte-compiler. - (unindent-tree - (function - (lambda (contents) - (mapc - (lambda (element) - (if (memq (org-element-type element) '(headline section)) - (funcall unindent-tree (org-element-contents element)) - (save-excursion - (save-restriction - (narrow-to-region - (org-element-property :begin element) - (org-element-property :end element)) - (org-do-remove-indentation))))) - (reverse contents)))))) - (funcall unindent-tree (org-element-contents parse-tree)))) - -(defun org-show-subtree () - "Show everything after this heading at deeper levels." - (interactive) - (outline-flag-region - (point) - (save-excursion - (org-end-of-subtree t t)) - nil)) - -(defun org-show-entry () - "Show the body directly following this heading. -Show the heading too, if it is currently invisible." - (interactive) - (save-excursion - (condition-case nil - (progn - (org-back-to-heading t) - (outline-flag-region - (max (point-min) (1- (point))) - (save-excursion - (if (re-search-forward - (concat "[\r\n]\\(" org-outline-regexp "\\)") nil t) - (match-beginning 1) - (point-max))) - nil) - (org-cycle-hide-drawers 'children)) - (error nil)))) - -(defun org-make-options-regexp (kwds &optional extra) - "Make a regular expression for keyword lines." - (concat - "^#\\+\\(" - (mapconcat 'regexp-quote kwds "\\|") - (if extra (concat "\\|" extra)) - "\\):[ \t]*\\(.*\\)")) - -;; Make isearch reveal the necessary context -(defun org-isearch-end () - "Reveal context after isearch exits." - (when isearch-success ; only if search was successful - (if (featurep 'xemacs) - ;; Under XEmacs, the hook is run in the correct place, - ;; we directly show the context. - (org-show-context 'isearch) - ;; In Emacs the hook runs *before* restoring the overlays. - ;; So we have to use a one-time post-command-hook to do this. - ;; (Emacs 22 has a special variable, see function `org-mode') - (unless (and (boundp 'isearch-mode-end-hook-quit) - isearch-mode-end-hook-quit) - ;; Only when the isearch was not quitted. - (org-add-hook 'post-command-hook 'org-isearch-post-command - 'append 'local))) - (org-fix-ellipsis-at-bol))) - -(defun org-isearch-post-command () - "Remove self from hook, and show context." - (remove-hook 'post-command-hook 'org-isearch-post-command 'local) - (org-show-context 'isearch)) - - -;;;; Integration with and fixes for other packages - -;;; Imenu support - -(defvar org-imenu-markers nil - "All markers currently used by Imenu.") -(make-variable-buffer-local 'org-imenu-markers) - -(defun org-imenu-new-marker (&optional pos) - "Return a new marker for use by Imenu, and remember the marker." - (let ((m (make-marker))) - (move-marker m (or pos (point))) - (push m org-imenu-markers) - m)) - -(defun org-imenu-get-tree () - "Produce the index for Imenu." - (mapc (lambda (x) (move-marker x nil)) org-imenu-markers) - (setq org-imenu-markers nil) - (let* ((n org-imenu-depth) - (re (concat "^" (org-get-limited-outline-regexp))) - (subs (make-vector (1+ n) nil)) - (last-level 0) - m level head0 head) - (save-excursion - (save-restriction - (widen) - (goto-char (point-max)) - (while (re-search-backward re nil t) - (setq level (org-reduced-level (funcall outline-level))) - (when (and (<= level n) - (looking-at org-complex-heading-regexp) - (setq head0 (org-match-string-no-properties 4))) - (setq head (org-link-display-format head0) - m (org-imenu-new-marker)) - (org-add-props head nil 'org-imenu-marker m 'org-imenu t) - (if (>= level last-level) - (push (cons head m) (aref subs level)) - (push (cons head (aref subs (1+ level))) (aref subs level)) - (loop for i from (1+ level) to n do (aset subs i nil))) - (setq last-level level))))) - (aref subs 1))) - -(eval-after-load "imenu" - '(progn - (add-hook 'imenu-after-jump-hook - (lambda () - (if (derived-mode-p 'org-mode) - (org-show-context 'org-goto)))))) - -(defun org-link-display-format (link) - "Replace a link with its the description. -If there is no description, use the link target." - (save-match-data - (if (string-match org-bracket-link-analytic-regexp link) - (replace-match (if (match-end 5) - (match-string 5 link) - (concat (match-string 1 link) - (match-string 3 link))) - nil t link) - link))) - -(defun org-toggle-link-display () - "Toggle the literal or descriptive display of links." - (interactive) - (if org-descriptive-links - (progn (org-remove-from-invisibility-spec '(org-link)) - (org-restart-font-lock) - (setq org-descriptive-links nil)) - (progn (add-to-invisibility-spec '(org-link)) - (org-restart-font-lock) - (setq org-descriptive-links t)))) - -;; Speedbar support - -(defvar org-speedbar-restriction-lock-overlay (make-overlay 1 1) - "Overlay marking the agenda restriction line in speedbar.") -(overlay-put org-speedbar-restriction-lock-overlay - 'face 'org-agenda-restriction-lock) -(overlay-put org-speedbar-restriction-lock-overlay - 'help-echo "Agendas are currently limited to this item.") -(org-detach-overlay org-speedbar-restriction-lock-overlay) - -(defun org-speedbar-set-agenda-restriction () - "Restrict future agenda commands to the location at point in speedbar. -To get rid of the restriction, use \\[org-agenda-remove-restriction-lock]." - (interactive) - (require 'org-agenda) - (let (p m tp np dir txt) - (cond - ((setq p (text-property-any (point-at-bol) (point-at-eol) - 'org-imenu t)) - (setq m (get-text-property p 'org-imenu-marker)) - (with-current-buffer (marker-buffer m) - (goto-char m) - (org-agenda-set-restriction-lock 'subtree))) - ((setq p (text-property-any (point-at-bol) (point-at-eol) - 'speedbar-function 'speedbar-find-file)) - (setq tp (previous-single-property-change - (1+ p) 'speedbar-function) - np (next-single-property-change - tp 'speedbar-function) - dir (speedbar-line-directory) - txt (buffer-substring-no-properties (or tp (point-min)) - (or np (point-max)))) - (with-current-buffer (find-file-noselect - (let ((default-directory dir)) - (expand-file-name txt))) - (unless (derived-mode-p 'org-mode) - (user-error "Cannot restrict to non-Org-mode file")) - (org-agenda-set-restriction-lock 'file))) - (t (user-error "Don't know how to restrict Org-mode's agenda"))) - (move-overlay org-speedbar-restriction-lock-overlay - (point-at-bol) (point-at-eol)) - (setq current-prefix-arg nil) - (org-agenda-maybe-redo))) - -(defvar speedbar-file-key-map) -(declare-function speedbar-add-supported-extension "speedbar" (extension)) -(eval-after-load "speedbar" - '(progn - (speedbar-add-supported-extension ".org") - (define-key speedbar-file-key-map "<" 'org-speedbar-set-agenda-restriction) - (define-key speedbar-file-key-map "\C-c\C-x<" 'org-speedbar-set-agenda-restriction) - (define-key speedbar-file-key-map ">" 'org-agenda-remove-restriction-lock) - (define-key speedbar-file-key-map "\C-c\C-x>" 'org-agenda-remove-restriction-lock) - (add-hook 'speedbar-visiting-tag-hook - (lambda () (and (derived-mode-p 'org-mode) (org-show-context 'org-goto)))))) - -;;; Fixes and Hacks for problems with other packages - -;; Make flyspell not check words in links, to not mess up our keymap -(defvar org-element-affiliated-keywords) ; From org-element.el -(defvar org-element-block-name-alist) ; From org-element.el -(defun org-mode-flyspell-verify () - "Don't let flyspell put overlays at active buttons, or on - {todo,all-time,additional-option-like}-keywords." - (require 'org-element) ; For `org-element-affiliated-keywords' - (let ((pos (max (1- (point)) (point-min))) - (word (thing-at-point 'word))) - (and (not (get-text-property pos 'keymap)) - (not (get-text-property pos 'org-no-flyspell)) - (not (member word org-todo-keywords-1)) - (not (member word org-all-time-keywords)) - (not (member word org-options-keywords)) - (not (member word (mapcar 'car org-startup-options))) - (not (member-ignore-case word org-element-affiliated-keywords)) - (not (member-ignore-case word (org-get-export-keywords))) - (not (member-ignore-case - word (mapcar 'car org-element-block-name-alist))) - (not (member-ignore-case word '("BEGIN" "END" "ATTR"))) - (not (org-in-src-block-p))))) - -(defun org-remove-flyspell-overlays-in (beg end) - "Remove flyspell overlays in region." - (and (org-bound-and-true-p flyspell-mode) - (fboundp 'flyspell-delete-region-overlays) - (flyspell-delete-region-overlays beg end)) - (add-text-properties beg end '(org-no-flyspell t))) - -;; Make `bookmark-jump' shows the jump location if it was hidden. -(eval-after-load "bookmark" - '(if (boundp 'bookmark-after-jump-hook) - ;; We can use the hook - (add-hook 'bookmark-after-jump-hook 'org-bookmark-jump-unhide) - ;; Hook not available, use advice - (defadvice bookmark-jump (after org-make-visible activate) - "Make the position visible." - (org-bookmark-jump-unhide)))) - -;; Make sure saveplace shows the location if it was hidden -(eval-after-load "saveplace" - '(defadvice save-place-find-file-hook (after org-make-visible activate) - "Make the position visible." - (org-bookmark-jump-unhide))) - -;; Make sure ecb shows the location if it was hidden -(eval-after-load "ecb" - '(defadvice ecb-method-clicked (after esf/org-show-context activate) - "Make hierarchy visible when jumping into location from ECB tree buffer." - (if (derived-mode-p 'org-mode) - (org-show-context)))) - -(defun org-bookmark-jump-unhide () - "Unhide the current position, to show the bookmark location." - (and (derived-mode-p 'org-mode) - (or (outline-invisible-p) - (save-excursion (goto-char (max (point-min) (1- (point)))) - (outline-invisible-p))) - (org-show-context 'bookmark-jump))) - -;; Make session.el ignore our circular variable -(defvar session-globals-exclude) -(eval-after-load "session" - '(add-to-list 'session-globals-exclude 'org-mark-ring)) - -;;;; Finish up - -(provide 'org) - -(run-hooks 'org-load-hook) - -;;; org.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ox-ascii.el b/xemacs-packages/lisp/org-8.2.3c/ox-ascii.el deleted file mode 100644 index b2a38d55..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ox-ascii.el +++ /dev/null @@ -1,1944 +0,0 @@ -;;; ox-ascii.el --- ASCII Back-End for Org Export Engine - -;; Copyright (C) 2012-2013 Free Software Foundation, Inc. - -;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> -;; Keywords: outlines, hypermedia, calendar, wp - -;; 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: -;; -;; This library implements an ASCII back-end for Org generic exporter. -;; See Org manual for more information. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'ox) -(require 'ox-publish) - -(declare-function aa2u "ext:ascii-art-to-unicode" ()) - -;;; Define Back-End -;; -;; The following setting won't allow to modify preferred charset -;; through a buffer keyword or an option item, but, since the property -;; will appear in communication channel nonetheless, it allows to -;; override `org-ascii-charset' variable on the fly by the ext-plist -;; mechanism. -;; -;; We also install a filter for headlines and sections, in order to -;; control blank lines separating them in output string. - -(org-export-define-backend 'ascii - '((bold . org-ascii-bold) - (center-block . org-ascii-center-block) - (clock . org-ascii-clock) - (code . org-ascii-code) - (comment . (lambda (&rest args) "")) - (comment-block . (lambda (&rest args) "")) - (drawer . org-ascii-drawer) - (dynamic-block . org-ascii-dynamic-block) - (entity . org-ascii-entity) - (example-block . org-ascii-example-block) - (export-block . org-ascii-export-block) - (export-snippet . org-ascii-export-snippet) - (fixed-width . org-ascii-fixed-width) - (footnote-reference . org-ascii-footnote-reference) - (headline . org-ascii-headline) - (horizontal-rule . org-ascii-horizontal-rule) - (inline-src-block . org-ascii-inline-src-block) - (inlinetask . org-ascii-inlinetask) - (inner-template . org-ascii-inner-template) - (italic . org-ascii-italic) - (item . org-ascii-item) - (keyword . org-ascii-keyword) - (latex-environment . org-ascii-latex-environment) - (latex-fragment . org-ascii-latex-fragment) - (line-break . org-ascii-line-break) - (link . org-ascii-link) - (paragraph . org-ascii-paragraph) - (plain-list . org-ascii-plain-list) - (plain-text . org-ascii-plain-text) - (planning . org-ascii-planning) - (quote-block . org-ascii-quote-block) - (quote-section . org-ascii-quote-section) - (radio-target . org-ascii-radio-target) - (section . org-ascii-section) - (special-block . org-ascii-special-block) - (src-block . org-ascii-src-block) - (statistics-cookie . org-ascii-statistics-cookie) - (strike-through . org-ascii-strike-through) - (subscript . org-ascii-subscript) - (superscript . org-ascii-superscript) - (table . org-ascii-table) - (table-cell . org-ascii-table-cell) - (table-row . org-ascii-table-row) - (target . org-ascii-target) - (template . org-ascii-template) - (timestamp . org-ascii-timestamp) - (underline . org-ascii-underline) - (verbatim . org-ascii-verbatim) - (verse-block . org-ascii-verse-block)) - :export-block "ASCII" - :menu-entry - '(?t "Export to Plain Text" - ((?A "As ASCII buffer" - (lambda (a s v b) - (org-ascii-export-as-ascii a s v b '(:ascii-charset ascii)))) - (?a "As ASCII file" - (lambda (a s v b) - (org-ascii-export-to-ascii a s v b '(:ascii-charset ascii)))) - (?L "As Latin1 buffer" - (lambda (a s v b) - (org-ascii-export-as-ascii a s v b '(:ascii-charset latin1)))) - (?l "As Latin1 file" - (lambda (a s v b) - (org-ascii-export-to-ascii a s v b '(:ascii-charset latin1)))) - (?U "As UTF-8 buffer" - (lambda (a s v b) - (org-ascii-export-as-ascii a s v b '(:ascii-charset utf-8)))) - (?u "As UTF-8 file" - (lambda (a s v b) - (org-ascii-export-to-ascii a s v b '(:ascii-charset utf-8)))))) - :filters-alist '((:filter-headline . org-ascii-filter-headline-blank-lines) - (:filter-parse-tree org-ascii-filter-paragraph-spacing - org-ascii-filter-comment-spacing) - (:filter-section . org-ascii-filter-headline-blank-lines)) - :options-alist '((:ascii-charset nil nil org-ascii-charset))) - - - -;;; User Configurable Variables - -(defgroup org-export-ascii nil - "Options for exporting Org mode files to ASCII." - :tag "Org Export ASCII" - :group 'org-export) - -(defcustom org-ascii-text-width 72 - "Maximum width of exported text. -This number includes margin size, as set in -`org-ascii-global-margin'." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type 'integer) - -(defcustom org-ascii-global-margin 0 - "Width of the left margin, in number of characters." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type 'integer) - -(defcustom org-ascii-inner-margin 2 - "Width of the inner margin, in number of characters. -Inner margin is applied between each headline." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type 'integer) - -(defcustom org-ascii-quote-margin 6 - "Width of margin used for quoting text, in characters. -This margin is applied on both sides of the text." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type 'integer) - -(defcustom org-ascii-inlinetask-width 30 - "Width of inline tasks, in number of characters. -This number ignores any margin." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type 'integer) - -(defcustom org-ascii-headline-spacing '(1 . 2) - "Number of blank lines inserted around headlines. - -This variable can be set to a cons cell. In that case, its car -represents the number of blank lines present before headline -contents whereas its cdr reflects the number of blank lines after -contents. - -A nil value replicates the number of blank lines found in the -original Org buffer at the same place." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (const :tag "Replicate original spacing" nil) - (cons :tag "Set an uniform spacing" - (integer :tag "Number of blank lines before contents") - (integer :tag "Number of blank lines after contents")))) - -(defcustom org-ascii-indented-line-width 'auto - "Additional indentation width for the first line in a paragraph. -If the value is an integer, indent the first line of each -paragraph by this number. If it is the symbol `auto' preserve -indentation from original document." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (integer :tag "Number of white spaces characters") - (const :tag "Preserve original width" auto))) - -(defcustom org-ascii-paragraph-spacing 'auto - "Number of white lines between paragraphs. -If the value is an integer, add this number of blank lines -between contiguous paragraphs. If is it the symbol `auto', keep -the same number of blank lines as in the original document." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (integer :tag "Number of blank lines") - (const :tag "Preserve original spacing" auto))) - -(defcustom org-ascii-charset 'ascii - "The charset allowed to represent various elements and objects. -Possible values are: -`ascii' Only use plain ASCII characters -`latin1' Include Latin-1 characters -`utf-8' Use all UTF-8 characters" - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (const :tag "ASCII" ascii) - (const :tag "Latin-1" latin1) - (const :tag "UTF-8" utf-8))) - -(defcustom org-ascii-underline '((ascii ?= ?~ ?-) - (latin1 ?= ?~ ?-) - (utf-8 ?═ ?─ ?╌ ?┄ ?┈)) - "Characters for underlining headings in ASCII export. - -Alist whose key is a symbol among `ascii', `latin1' and `utf-8' -and whose value is a list of characters. - -For each supported charset, this variable associates a sequence -of underline characters. In a sequence, the characters will be -used in order for headlines level 1, 2, ... If no character is -available for a given level, the headline won't be underlined." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type '(list - (cons :tag "Underline characters sequence" - (const :tag "ASCII charset" ascii) - (repeat character)) - (cons :tag "Underline characters sequence" - (const :tag "Latin-1 charset" latin1) - (repeat character)) - (cons :tag "Underline characters sequence" - (const :tag "UTF-8 charset" utf-8) - (repeat character)))) - -(defcustom org-ascii-bullets '((ascii ?* ?+ ?-) - (latin1 ?§ ?¶) - (utf-8 ?◊)) - "Bullet characters for headlines converted to lists in ASCII export. - -Alist whose key is a symbol among `ascii', `latin1' and `utf-8' -and whose value is a list of characters. - -The first character is used for the first level considered as low -level, and so on. If there are more levels than characters given -here, the list will be repeated. - -Note that this variable doesn't affect plain lists -representation." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type '(list - (cons :tag "Bullet characters for low level headlines" - (const :tag "ASCII charset" ascii) - (repeat character)) - (cons :tag "Bullet characters for low level headlines" - (const :tag "Latin-1 charset" latin1) - (repeat character)) - (cons :tag "Bullet characters for low level headlines" - (const :tag "UTF-8 charset" utf-8) - (repeat character)))) - -(defcustom org-ascii-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-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-ascii-table-keep-all-vertical-lines nil - "Non-nil means keep all vertical lines in ASCII tables. -When nil, vertical lines will be removed except for those needed -for column grouping." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-ascii-table-widen-columns t - "Non-nil means widen narrowed columns for export. -When nil, narrowed columns will look in ASCII export just like in -Org mode, i.e. with \"=>\" as ellipsis." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-ascii-table-use-ascii-art nil - "Non-nil means table.el tables are turned into ascii-art. - -It only makes sense when export charset is `utf-8'. It is nil by -default since it requires ascii-art-to-unicode.el package. You -can download it here: - - http://gnuvola.org/software/j/aa2u/ascii-art-to-unicode.el." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-ascii-caption-above nil - "When non-nil, place caption string before the element. -Otherwise, place it right after it." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-ascii-verbatim-format "`%s'" - "Format string used for verbatim text and inline code." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defcustom org-ascii-format-drawer-function - (lambda (name contents width) contents) - "Function called to format a drawer in ASCII. - -The function must accept three parameters: - NAME the drawer name, like \"LOGBOOK\" - CONTENTS the contents of the drawer. - WIDTH the text width within the drawer. - -The function should return either the string to be exported or -nil to ignore the drawer. - -The default value simply returns the value of CONTENTS." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.0") - :type 'function) - -(defcustom org-ascii-format-inlinetask-function - 'org-ascii-format-inlinetask-default - "Function called to format an inlinetask in ASCII. - -The function must accept nine parameters: - TODO the todo keyword, as a string - TODO-TYPE the todo type, a symbol among `todo', `done' and nil. - PRIORITY the inlinetask priority, as a string - NAME the inlinetask name, as a string. - TAGS the inlinetask tags, as a list of strings. - CONTENTS the contents of the inlinetask, as a string. - WIDTH the width of the inlinetask, as a number. - INLINETASK the inlinetask itself. - INFO the info channel. - -The function should return either the string to be exported or -nil to ignore the inline task." - :group 'org-export-ascii - :version "24.4" - :package-version '(Org . "8.3") - :type 'function) - - - -;;; Internal Functions - -;; Internal functions fall into three categories. - -;; The first one is about text formatting. The core function is -;; `org-ascii--current-text-width', which determines the current -;; text width allowed to a given element. In other words, it helps -;; keeping each line width within maximum text width defined in -;; `org-ascii-text-width'. Once this information is known, -;; `org-ascii--fill-string', `org-ascii--justify-string', -;; `org-ascii--box-string' and `org-ascii--indent-string' can -;; operate on a given output string. - -;; The second category contains functions handling elements listings, -;; triggered by "#+TOC:" keyword. As such, `org-ascii--build-toc' -;; returns a complete table of contents, `org-ascii--list-listings' -;; returns a list of referenceable src-block elements, and -;; `org-ascii--list-tables' does the same for table elements. - -;; The third category includes general helper functions. -;; `org-ascii--build-title' creates the title for a given headline -;; or inlinetask element. `org-ascii--build-caption' returns the -;; caption string associated to a table or a src-block. -;; `org-ascii--describe-links' creates notes about links for -;; insertion at the end of a section. It uses -;; `org-ascii--unique-links' to get the list of links to describe. -;; Eventually, `org-ascii--translate' translates a string according -;; to language and charset specification. - - -(defun org-ascii--fill-string (s text-width info &optional justify) - "Fill a string with specified text-width and return it. - -S is the string being filled. TEXT-WIDTH is an integer -specifying maximum length of a line. INFO is the plist used as -a communication channel. - -Optional argument JUSTIFY can specify any type of justification -among `left', `center', `right' or `full'. A nil value is -equivalent to `left'. For a justification that doesn't also fill -string, see `org-ascii--justify-string'. - -Return nil if S isn't a string." - ;; Don't fill paragraph when break should be preserved. - (cond ((not (stringp s)) nil) - ((plist-get info :preserve-breaks) s) - (t (let ((double-space-p sentence-end-double-space)) - (with-temp-buffer - (let ((fill-column text-width) - (use-hard-newlines t) - (sentence-end-double-space double-space-p)) - (insert s) - (fill-region (point-min) (point-max) justify)) - (buffer-string)))))) - -(defun org-ascii--justify-string (s text-width how) - "Justify string S. -TEXT-WIDTH is an integer specifying maximum length of a line. -HOW determines the type of justification: it can be `left', -`right', `full' or `center'." - (with-temp-buffer - (insert s) - (goto-char (point-min)) - (let ((fill-column text-width) - ;; Disable `adaptive-fill-mode' so it doesn't prevent - ;; filling lines matching `adaptive-fill-regexp'. - (adaptive-fill-mode nil)) - (while (< (point) (point-max)) - (justify-current-line how) - (forward-line))) - (buffer-string))) - -(defun org-ascii--indent-string (s width) - "Indent string S by WIDTH white spaces. -Empty lines are not indented." - (when (stringp s) - (replace-regexp-in-string - "\\(^\\)\\(?:.*\\S-\\)" (make-string width ? ) s nil nil 1))) - -(defun org-ascii--box-string (s info) - "Return string S with a partial box to its left. -INFO is a plist used as a communicaton channel." - (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) - (format (if utf8p "╭────\n%s\n╰────" ",----\n%s\n`----") - (replace-regexp-in-string - "^" (if utf8p "│ " "| ") - ;; Remove last newline character. - (replace-regexp-in-string "\n[ \t]*\\'" "" s))))) - -(defun org-ascii--current-text-width (element info) - "Return maximum text width for ELEMENT's contents. -INFO is a plist used as a communication channel." - (case (org-element-type element) - ;; Elements with an absolute width: `headline' and `inlinetask'. - (inlinetask org-ascii-inlinetask-width) - ('headline - (- org-ascii-text-width - (let ((low-level-rank (org-export-low-level-p element info))) - (if low-level-rank (* low-level-rank 2) org-ascii-global-margin)))) - ;; Elements with a relative width: store maximum text width in - ;; TOTAL-WIDTH. - (otherwise - (let* ((genealogy (cons element (org-export-get-genealogy element))) - ;; Total width is determined by the presence, or not, of an - ;; inline task among ELEMENT parents. - (total-width - (if (loop for parent in genealogy - thereis (eq (org-element-type parent) 'inlinetask)) - org-ascii-inlinetask-width - ;; No inlinetask: Remove global margin from text width. - (- org-ascii-text-width - org-ascii-global-margin - (let ((parent (org-export-get-parent-headline element))) - ;; Inner margin doesn't apply to text before first - ;; headline. - (if (not parent) 0 - (let ((low-level-rank - (org-export-low-level-p parent info))) - ;; Inner margin doesn't apply to contents of - ;; low level headlines, since they've got their - ;; own indentation mechanism. - (if low-level-rank (* low-level-rank 2) - org-ascii-inner-margin)))))))) - (- total-width - ;; Each `quote-block', `quote-section' and `verse-block' above - ;; narrows text width by twice the standard margin size. - (+ (* (loop for parent in genealogy - when (memq (org-element-type parent) - '(quote-block quote-section verse-block)) - count parent) - 2 org-ascii-quote-margin) - ;; Text width within a plain-list is restricted by - ;; indentation of current item. If that's the case, - ;; compute it with the help of `:structure' property from - ;; parent item, if any. - (let ((parent-item - (if (eq (org-element-type element) 'item) element - (loop for parent in genealogy - when (eq (org-element-type parent) 'item) - return parent)))) - (if (not parent-item) 0 - ;; Compute indentation offset of the current item, - ;; that is the sum of the difference between its - ;; indentation and the indentation of the top item in - ;; the list and current item bullet's length. Also - ;; remove checkbox length, and tag length (for - ;; description lists) or bullet length. - (let ((struct (org-element-property :structure parent-item)) - (beg-item (org-element-property :begin parent-item))) - (+ (- (org-list-get-ind beg-item struct) - (org-list-get-ind - (org-list-get-top-point struct) struct)) - (length (org-ascii--checkbox parent-item info)) - (length - (or (org-list-get-tag beg-item struct) - (org-list-get-bullet beg-item struct))))))))))))) - -(defun org-ascii--build-title - (element info text-width &optional underline notags toc) - "Format ELEMENT title and return it. - -ELEMENT is either an `headline' or `inlinetask' element. INFO is -a plist used as a communication channel. TEXT-WIDTH is an -integer representing the maximum length of a line. - -When optional argument UNDERLINE is non-nil, underline title, -without the tags, according to `org-ascii-underline' -specifications. - -If optional argument NOTAGS is non-nil, no tags will be added to -the title. - -When optional argument TOC is non-nil, use optional title if -possible. It doesn't apply to `inlinetask' elements." - (let* ((headlinep (eq (org-element-type element) 'headline)) - (numbers - ;; Numbering is specific to headlines. - (and headlinep (org-export-numbered-headline-p element info) - ;; All tests passed: build numbering string. - (concat - (mapconcat - 'number-to-string - (org-export-get-headline-number element info) ".") - " "))) - (text - (org-trim - (org-export-data - (if (and toc headlinep) (org-export-get-alt-title element info) - (org-element-property :title element)) - info))) - (todo - (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword element))) - (and todo (concat (org-export-data todo info) " "))))) - (tags (and (not notags) - (plist-get info :with-tags) - (let ((tag-list (org-export-get-tags element info))) - (and tag-list - (format ":%s:" - (mapconcat 'identity tag-list ":")))))) - (priority - (and (plist-get info :with-priority) - (let ((char (org-element-property :priority element))) - (and char (format "(#%c) " char))))) - (first-part (concat numbers todo priority text))) - (concat - first-part - ;; Align tags, if any. - (when tags - (format - (format " %%%ds" - (max (- text-width (1+ (length first-part))) (length tags))) - tags)) - ;; Maybe underline text, if ELEMENT type is `headline' and an - ;; underline character has been defined. - (when (and underline headlinep) - (let ((under-char - (nth (1- (org-export-get-relative-level element info)) - (cdr (assq (plist-get info :ascii-charset) - org-ascii-underline))))) - (and under-char - (concat "\n" - (make-string (length first-part) under-char)))))))) - -(defun org-ascii--has-caption-p (element info) - "Non-nil when ELEMENT has a caption affiliated keyword. -INFO is a plist used as a communication channel. This function -is meant to be used as a predicate for `org-export-get-ordinal'." - (org-element-property :caption element)) - -(defun org-ascii--build-caption (element info) - "Return caption string for ELEMENT, if applicable. - -INFO is a plist used as a communication channel. - -The caption string contains the sequence number of ELEMENT along -with its real caption. Return nil when ELEMENT has no affiliated -caption keyword." - (let ((caption (org-export-get-caption element))) - (when caption - ;; Get sequence number of current src-block among every - ;; src-block with a caption. - (let ((reference - (org-export-get-ordinal - element info nil 'org-ascii--has-caption-p)) - (title-fmt (org-ascii--translate - (case (org-element-type element) - (table "Table %d:") - (src-block "Listing %d:")) - info))) - (org-ascii--fill-string - (concat (format title-fmt reference) - " " - (org-export-data caption info)) - (org-ascii--current-text-width element info) info))))) - -(defun org-ascii--build-toc (info &optional n keyword) - "Return a table of contents. - -INFO is a plist used as a communication channel. - -Optional argument N, when non-nil, is an integer specifying the -depth of the table. - -Optional argument KEYWORD specifies the TOC keyword, if any, from -which the table of contents generation has been initiated." - (let ((title (org-ascii--translate "Table of Contents" info))) - (concat - title "\n" - (make-string (length title) - (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)) - "\n\n" - (let ((text-width - (if keyword (org-ascii--current-text-width keyword info) - (- org-ascii-text-width org-ascii-global-margin)))) - (mapconcat - (lambda (headline) - (let* ((level (org-export-get-relative-level headline info)) - (indent (* (1- level) 3))) - (concat - (unless (zerop indent) (concat (make-string (1- indent) ?.) " ")) - (org-ascii--build-title - headline info (- text-width indent) nil - (or (not (plist-get info :with-tags)) - (eq (plist-get info :with-tags) 'not-in-toc)) - 'toc)))) - (org-export-collect-headlines info n) "\n"))))) - -(defun org-ascii--list-listings (keyword info) - "Return a list of listings. - -KEYWORD is the keyword that initiated the list of listings -generation. INFO is a plist used as a communication channel." - (let ((title (org-ascii--translate "List of Listings" info))) - (concat - title "\n" - (make-string (length title) - (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)) - "\n\n" - (let ((text-width - (if keyword (org-ascii--current-text-width keyword info) - (- org-ascii-text-width org-ascii-global-margin))) - ;; Use a counter instead of retreiving ordinal of each - ;; src-block. - (count 0)) - (mapconcat - (lambda (src-block) - ;; Store initial text so its length can be computed. This is - ;; used to properly align caption right to it in case of - ;; filling (like contents of a description list item). - (let ((initial-text - (format (org-ascii--translate "Listing %d:" info) - (incf count)))) - (concat - initial-text " " - (org-trim - (org-ascii--indent-string - (org-ascii--fill-string - ;; Use short name in priority, if available. - (let ((caption (or (org-export-get-caption src-block t) - (org-export-get-caption src-block)))) - (org-export-data caption info)) - (- text-width (length initial-text)) info) - (length initial-text)))))) - (org-export-collect-listings info) "\n"))))) - -(defun org-ascii--list-tables (keyword info) - "Return a list of tables. - -KEYWORD is the keyword that initiated the list of tables -generation. INFO is a plist used as a communication channel." - (let ((title (org-ascii--translate "List of Tables" info))) - (concat - title "\n" - (make-string (length title) - (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)) - "\n\n" - (let ((text-width - (if keyword (org-ascii--current-text-width keyword info) - (- org-ascii-text-width org-ascii-global-margin))) - ;; Use a counter instead of retreiving ordinal of each - ;; src-block. - (count 0)) - (mapconcat - (lambda (table) - ;; Store initial text so its length can be computed. This is - ;; used to properly align caption right to it in case of - ;; filling (like contents of a description list item). - (let ((initial-text - (format (org-ascii--translate "Table %d:" info) - (incf count)))) - (concat - initial-text " " - (org-trim - (org-ascii--indent-string - (org-ascii--fill-string - ;; Use short name in priority, if available. - (let ((caption (or (org-export-get-caption table t) - (org-export-get-caption table)))) - (org-export-data caption info)) - (- text-width (length initial-text)) info) - (length initial-text)))))) - (org-export-collect-tables info) "\n"))))) - -(defun org-ascii--unique-links (element info) - "Return a list of unique link references in ELEMENT. - -ELEMENT is either a headline element or a section element. INFO -is a plist used as a communication channel." - (let* (seen - (unique-link-p - (function - ;; Return LINK if it wasn't referenced so far, or nil. - ;; Update SEEN links along the way. - (lambda (link) - (let ((footprint - (cons (org-element-property :raw-link link) - (org-element-contents link)))) - ;; Ignore LINK if it hasn't been translated already. - ;; It can happen if it is located in an affiliated - ;; keyword that was ignored. - (when (and (org-string-nw-p - (gethash link (plist-get info :exported-data))) - (not (member footprint seen))) - (push footprint seen) link))))) - ;; If at a section, find parent headline, if any, in order to - ;; count links that might be in the title. - (headline - (if (eq (org-element-type element) 'headline) element - (or (org-export-get-parent-headline element) element)))) - ;; Get all links in HEADLINE. - (org-element-map headline 'link - (lambda (l) (funcall unique-link-p l)) info nil nil t))) - -(defun org-ascii--describe-links (links width info) - "Return a string describing a list of links. - -LINKS is a list of link type objects, as returned by -`org-ascii--unique-links'. WIDTH is the text width allowed for -the output string. INFO is a plist used as a communication -channel." - (mapconcat - (lambda (link) - (let ((type (org-element-property :type link)) - (anchor (let ((desc (org-element-contents link))) - (if desc (org-export-data desc info) - (org-element-property :raw-link link))))) - (cond - ;; Coderefs, radio links and fuzzy links are ignored. - ((member type '("coderef" "radio" "fuzzy")) nil) - ;; Id and custom-id links: Headlines refer to their numbering. - ((member type '("custom-id" "id")) - (let ((dest (org-export-resolve-id-link link info))) - (concat - (org-ascii--fill-string - (format - "[%s] %s" - anchor - (if (not dest) (org-ascii--translate "Unknown reference" info) - (format - (org-ascii--translate "See section %s" info) - (mapconcat 'number-to-string - (org-export-get-headline-number dest info) ".")))) - width info) "\n\n"))) - ;; Do not add a link that cannot be resolved and doesn't have - ;; any description: destination is already visible in the - ;; paragraph. - ((not (org-element-contents link)) nil) - (t - (concat - (org-ascii--fill-string - (format "[%s] %s" anchor (org-element-property :raw-link link)) - width info) - "\n\n"))))) - links "")) - -(defun org-ascii--checkbox (item info) - "Return checkbox string for ITEM or nil. -INFO is a plist used as a communication channel." - (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) - (case (org-element-property :checkbox item) - (on (if utf8p "☑ " "[X] ")) - (off (if utf8p "☐ " "[ ] ")) - (trans (if utf8p "☒ " "[-] "))))) - - - -;;; Template - -(defun org-ascii-template--document-title (info) - "Return document title, as a string. -INFO is a plist used as a communication channel." - (let* ((text-width org-ascii-text-width) - ;; Links in the title will not be resolved later, so we make - ;; sure their path is located right after them. - (org-ascii-links-to-notes nil) - (title (org-export-data (plist-get info :title) info)) - (author (and (plist-get info :with-author) - (let ((auth (plist-get info :author))) - (and auth (org-export-data auth info))))) - (email (and (plist-get info :with-email) - (org-export-data (plist-get info :email) info))) - (date (and (plist-get info :with-date) - (org-export-data (org-export-get-date info) info)))) - ;; There are two types of title blocks depending on the presence - ;; of a title to display. - (if (string= title "") - ;; Title block without a title. DATE is positioned at the top - ;; right of the document, AUTHOR to the top left and EMAIL - ;; just below. - (cond - ((and (org-string-nw-p date) (org-string-nw-p author)) - (concat - author - (make-string (- text-width (length date) (length author)) ? ) - date - (when (org-string-nw-p email) (concat "\n" email)) - "\n\n\n")) - ((and (org-string-nw-p date) (org-string-nw-p email)) - (concat - email - (make-string (- text-width (length date) (length email)) ? ) - date "\n\n\n")) - ((org-string-nw-p date) - (concat - (org-ascii--justify-string date text-width 'right) - "\n\n\n")) - ((and (org-string-nw-p author) (org-string-nw-p email)) - (concat author "\n" email "\n\n\n")) - ((org-string-nw-p author) (concat author "\n\n\n")) - ((org-string-nw-p email) (concat email "\n\n\n"))) - ;; Title block with a title. Document's TITLE, along with the - ;; AUTHOR and its EMAIL are both overlined and an underlined, - ;; centered. Date is just below, also centered. - (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)) - ;; Format TITLE. It may be filled if it is too wide, - ;; that is wider than the two thirds of the total width. - (title-len (min (length title) (/ (* 2 text-width) 3))) - (formatted-title (org-ascii--fill-string title title-len info)) - (line - (make-string - (min (+ (max title-len (length author) (length email)) 2) - text-width) (if utf8p ?━ ?_)))) - (org-ascii--justify-string - (concat line "\n" - (unless utf8p "\n") - (upcase formatted-title) - (cond - ((and (org-string-nw-p author) (org-string-nw-p email)) - (concat (if utf8p "\n\n\n" "\n\n") author "\n" email)) - ((org-string-nw-p author) - (concat (if utf8p "\n\n\n" "\n\n") author)) - ((org-string-nw-p email) - (concat (if utf8p "\n\n\n" "\n\n") email))) - "\n" line - (when (org-string-nw-p date) (concat "\n\n\n" date)) - "\n\n\n") text-width 'center))))) - -(defun org-ascii-inner-template (contents info) - "Return complete document string after ASCII conversion. -CONTENTS is the transcoded contents string. INFO is a plist -holding export options." - (org-element-normalize-string - (org-ascii--indent-string - (concat - ;; 1. Document's body. - contents - ;; 2. Footnote definitions. - (let ((definitions (org-export-collect-footnote-definitions - (plist-get info :parse-tree) info)) - ;; Insert full links right inside the footnote definition - ;; as they have no chance to be inserted later. - (org-ascii-links-to-notes nil)) - (when definitions - (concat - "\n\n\n" - (let ((title (org-ascii--translate "Footnotes" info))) - (concat - title "\n" - (make-string - (length title) - (if (eq (plist-get info :ascii-charset) 'utf-8) ?─ ?_)))) - "\n\n" - (let ((text-width (- org-ascii-text-width org-ascii-global-margin))) - (mapconcat - (lambda (ref) - (let ((id (format "[%s] " (car ref)))) - ;; Distinguish between inline definitions and - ;; full-fledged definitions. - (org-trim - (let ((def (nth 2 ref))) - (if (eq (org-element-type def) 'org-data) - ;; Full-fledged definition: footnote ID is - ;; inserted inside the first parsed paragraph - ;; (FIRST), if any, to be sure filling will - ;; take it into consideration. - (let ((first (car (org-element-contents def)))) - (if (not (eq (org-element-type first) 'paragraph)) - (concat id "\n" (org-export-data def info)) - (push id (nthcdr 2 first)) - (org-export-data def info))) - ;; Fill paragraph once footnote ID is inserted - ;; in order to have a correct length for first - ;; line. - (org-ascii--fill-string - (concat id (org-export-data def info)) - text-width info)))))) - definitions "\n\n")))))) - org-ascii-global-margin))) - -(defun org-ascii-template (contents info) - "Return complete document string after ASCII conversion. -CONTENTS is the transcoded contents string. INFO is a plist -holding export options." - (concat - ;; 1. Build title block. - (org-ascii--indent-string - (concat (org-ascii-template--document-title info) - ;; 2. Table of contents. - (let ((depth (plist-get info :with-toc))) - (when depth - (concat - (org-ascii--build-toc info (and (wholenump depth) depth)) - "\n\n\n")))) - org-ascii-global-margin) - ;; 3. Document's body. - contents - ;; 4. Creator. Ignore `comment' value as there are no comments in - ;; ASCII. Justify it to the bottom right. - (org-ascii--indent-string - (let ((creator-info (plist-get info :with-creator)) - (text-width (- org-ascii-text-width org-ascii-global-margin))) - (unless (or (not creator-info) (eq creator-info 'comment)) - (concat - "\n\n\n" - (org-ascii--fill-string - (plist-get info :creator) text-width info 'right)))) - org-ascii-global-margin))) - -(defun org-ascii--translate (s info) - "Translate string S according to specified language and charset. -INFO is a plist used as a communication channel." - (let ((charset (intern (format ":%s" (plist-get info :ascii-charset))))) - (org-export-translate s charset info))) - - - -;;; Transcode Functions - -;;;; Bold - -(defun org-ascii-bold (bold contents info) - "Transcode BOLD from Org to ASCII. -CONTENTS is the text with bold markup. INFO is a plist holding -contextual information." - (format "*%s*" contents)) - - -;;;; Center Block - -(defun org-ascii-center-block (center-block contents info) - "Transcode a CENTER-BLOCK element from Org to ASCII. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (org-ascii--justify-string - contents (org-ascii--current-text-width center-block info) 'center)) - - -;;;; Clock - -(defun org-ascii-clock (clock contents info) - "Transcode a CLOCK object from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual -information." - (concat org-clock-string " " - (org-translate-time - (org-element-property :raw-value - (org-element-property :value clock))) - (let ((time (org-element-property :duration clock))) - (and time - (concat " => " - (apply 'format - "%2s:%02s" - (org-split-string time ":"))))))) - - -;;;; Code - -(defun org-ascii-code (code contents info) - "Return a CODE object from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual -information." - (format org-ascii-verbatim-format (org-element-property :value code))) - - -;;;; Drawer - -(defun org-ascii-drawer (drawer contents info) - "Transcode a DRAWER element from Org to ASCII. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let ((name (org-element-property :drawer-name drawer)) - (width (org-ascii--current-text-width drawer info))) - (funcall org-ascii-format-drawer-function name contents width))) - - -;;;; Dynamic Block - -(defun org-ascii-dynamic-block (dynamic-block contents info) - "Transcode a DYNAMIC-BLOCK element from Org to ASCII. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - contents) - - -;;;; Entity - -(defun org-ascii-entity (entity contents info) - "Transcode an ENTITY object from Org to ASCII. -CONTENTS are the definition itself. INFO is a plist holding -contextual information." - (org-element-property - (intern (concat ":" (symbol-name (plist-get info :ascii-charset)))) - entity)) - - -;;;; Example Block - -(defun org-ascii-example-block (example-block contents info) - "Transcode a EXAMPLE-BLOCK element from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-ascii--box-string - (org-export-format-code-default example-block info) info)) - - -;;;; Export Snippet - -(defun org-ascii-export-snippet (export-snippet contents info) - "Transcode a EXPORT-SNIPPET object from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (eq (org-export-snippet-backend export-snippet) 'ascii) - (org-element-property :value export-snippet))) - - -;;;; Export Block - -(defun org-ascii-export-block (export-block contents info) - "Transcode a EXPORT-BLOCK element from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (string= (org-element-property :type export-block) "ASCII") - (org-remove-indentation (org-element-property :value export-block)))) - - -;;;; Fixed Width - -(defun org-ascii-fixed-width (fixed-width contents info) - "Transcode a FIXED-WIDTH element from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-ascii--box-string - (org-remove-indentation - (org-element-property :value fixed-width)) info)) - - -;;;; Footnote Definition - -;; Footnote Definitions are ignored. They are compiled at the end of -;; the document, by `org-ascii-inner-template'. - - -;;;; Footnote Reference - -(defun org-ascii-footnote-reference (footnote-reference contents info) - "Transcode a FOOTNOTE-REFERENCE element from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual information." - (format "[%s]" (org-export-get-footnote-number footnote-reference info))) - - -;;;; Headline - -(defun org-ascii-headline (headline contents info) - "Transcode a HEADLINE element from Org to ASCII. -CONTENTS holds the contents of the headline. INFO is a plist -holding contextual information." - ;; Don't export footnote section, which will be handled at the end - ;; of the template. - (unless (org-element-property :footnote-section-p headline) - (let* ((low-level-rank (org-export-low-level-p headline info)) - (width (org-ascii--current-text-width headline info)) - ;; Blank lines between headline and its contents. - ;; `org-ascii-headline-spacing', when set, overwrites - ;; original buffer's spacing. - (pre-blanks - (make-string - (if org-ascii-headline-spacing (car org-ascii-headline-spacing) - (org-element-property :pre-blank headline)) ?\n)) - ;; Even if HEADLINE has no section, there might be some - ;; links in its title that we shouldn't forget to describe. - (links - (unless (or (eq (caar (org-element-contents headline)) 'section)) - (let ((title (org-element-property :title headline))) - (when (consp title) - (org-ascii--describe-links - (org-ascii--unique-links title info) width info)))))) - ;; Deep subtree: export it as a list item. - (if low-level-rank - (concat - ;; Bullet. - (let ((bullets (cdr (assq (plist-get info :ascii-charset) - org-ascii-bullets)))) - (char-to-string - (nth (mod (1- low-level-rank) (length bullets)) bullets))) - " " - ;; Title. - (org-ascii--build-title headline info width) "\n" - ;; Contents, indented by length of bullet. - pre-blanks - (org-ascii--indent-string - (concat contents - (when (org-string-nw-p links) (concat "\n\n" links))) - 2)) - ;; Else: Standard headline. - (concat - (org-ascii--build-title headline info width 'underline) - "\n" pre-blanks - (concat (when (org-string-nw-p links) links) contents)))))) - - -;;;; Horizontal Rule - -(defun org-ascii-horizontal-rule (horizontal-rule contents info) - "Transcode an HORIZONTAL-RULE object from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual -information." - (let ((text-width (org-ascii--current-text-width horizontal-rule info)) - (spec-width - (org-export-read-attribute :attr_ascii horizontal-rule :width))) - (org-ascii--justify-string - (make-string (if (and spec-width (string-match "^[0-9]+$" spec-width)) - (string-to-number spec-width) - text-width) - (if (eq (plist-get info :ascii-charset) 'utf-8) ?― ?-)) - text-width 'center))) - - -;;;; Inline Src Block - -(defun org-ascii-inline-src-block (inline-src-block contents info) - "Transcode an INLINE-SRC-BLOCK element from Org to ASCII. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (format org-ascii-verbatim-format - (org-element-property :value inline-src-block))) - - -;;;; Inlinetask - -(defun org-ascii-format-inlinetask-default - (todo type priority name tags contents width inlinetask info) - "Format an inline task element for ASCII export. -See `org-ascii-format-inlinetask-function' for a description -of the paramaters." - (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)) - (width (or width org-ascii-inlinetask-width))) - (org-ascii--indent-string - (concat - ;; Top line, with an additional blank line if not in UTF-8. - (make-string width (if utf8p ?━ ?_)) "\n" - (unless utf8p (concat (make-string width ? ) "\n")) - ;; Add title. Fill it if wider than inlinetask. - (let ((title (org-ascii--build-title inlinetask info width))) - (if (<= (length title) width) title - (org-ascii--fill-string title width info))) - "\n" - ;; If CONTENTS is not empty, insert it along with - ;; a separator. - (when (org-string-nw-p contents) - (concat (make-string width (if utf8p ?─ ?-)) "\n" contents)) - ;; Bottom line. - (make-string width (if utf8p ?━ ?_))) - ;; Flush the inlinetask to the right. - (- org-ascii-text-width org-ascii-global-margin - (if (not (org-export-get-parent-headline inlinetask)) 0 - org-ascii-inner-margin) - (org-ascii--current-text-width inlinetask info))))) - -(defun org-ascii-inlinetask (inlinetask contents info) - "Transcode an INLINETASK element from Org to ASCII. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let ((width (org-ascii--current-text-width inlinetask info))) - (funcall org-ascii-format-inlinetask-function - ;; todo. - (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property - :todo-keyword inlinetask))) - (and todo (org-export-data todo info)))) - ;; todo-type - (org-element-property :todo-type inlinetask) - ;; priority - (and (plist-get info :with-priority) - (org-element-property :priority inlinetask)) - ;; title - (org-export-data (org-element-property :title inlinetask) info) - ;; tags - (and (plist-get info :with-tags) - (org-element-property :tags inlinetask)) - ;; contents and width - contents width inlinetask info))) - - -;;;; Italic - -(defun org-ascii-italic (italic contents info) - "Transcode italic from Org to ASCII. -CONTENTS is the text with italic markup. INFO is a plist holding -contextual information." - (format "/%s/" contents)) - - -;;;; Item - -(defun org-ascii-item (item contents info) - "Transcode an ITEM element from Org to ASCII. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((utf8p (eq (plist-get info :ascii-charset) 'utf-8)) - (checkbox (org-ascii--checkbox item info)) - (list-type (org-element-property :type (org-export-get-parent item))) - (bullet - ;; First parent of ITEM is always the plain-list. Get - ;; `:type' property from it. - (org-list-bullet-string - (case list-type - (descriptive - (concat checkbox - (org-export-data (org-element-property :tag item) info) - ": ")) - (ordered - ;; Return correct number for ITEM, paying attention to - ;; counters. - (let* ((struct (org-element-property :structure item)) - (bul (org-element-property :bullet item)) - (num (number-to-string - (car (last (org-list-get-item-number - (org-element-property :begin item) - struct - (org-list-prevs-alist struct) - (org-list-parents-alist struct))))))) - (replace-regexp-in-string "[0-9]+" num bul))) - (t (let ((bul (org-element-property :bullet item))) - ;; Change bullets into more visible form if UTF-8 is active. - (if (not utf8p) bul - (replace-regexp-in-string - "-" "•" - (replace-regexp-in-string - "+" "⁃" - (replace-regexp-in-string "*" "‣" bul)))))))))) - (concat - bullet - (unless (eq list-type 'descriptive) checkbox) - ;; Contents: Pay attention to indentation. Note: check-boxes are - ;; already taken care of at the paragraph level so they don't - ;; interfere with indentation. - (let ((contents (org-ascii--indent-string contents (length bullet)))) - (if (eq (org-element-type (car (org-element-contents item))) 'paragraph) - (org-trim contents) - (concat "\n" contents)))))) - - -;;;; Keyword - -(defun org-ascii-keyword (keyword contents info) - "Transcode a KEYWORD element from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual -information." - (let ((key (org-element-property :key keyword)) - (value (org-element-property :value keyword))) - (cond - ((string= key "ASCII") value) - ((string= key "TOC") - (let ((value (downcase value))) - (cond - ((string-match "\\<headlines\\>" value) - (let ((depth (or (and (string-match "[0-9]+" value) - (string-to-number (match-string 0 value))) - (plist-get info :with-toc)))) - (org-ascii--build-toc - info (and (wholenump depth) depth) keyword))) - ((string= "tables" value) - (org-ascii--list-tables keyword info)) - ((string= "listings" value) - (org-ascii--list-listings keyword info)))))))) - - -;;;; Latex Environment - -(defun org-ascii-latex-environment (latex-environment contents info) - "Transcode a LATEX-ENVIRONMENT element from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual -information." - (when (plist-get info :with-latex) - (org-remove-indentation (org-element-property :value latex-environment)))) - - -;;;; Latex Fragment - -(defun org-ascii-latex-fragment (latex-fragment contents info) - "Transcode a LATEX-FRAGMENT object from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual -information." - (when (plist-get info :with-latex) - (org-element-property :value latex-fragment))) - - -;;;; Line Break - -(defun org-ascii-line-break (line-break contents info) - "Transcode a LINE-BREAK object from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual - information." hard-newline) - - -;;;; Link - -(defun org-ascii-link (link desc info) - "Transcode a LINK object from Org to ASCII. - -DESC is the description part of the link, or the empty string. -INFO is a plist holding contextual information." - (let ((raw-link (org-element-property :raw-link link)) - (type (org-element-property :type link))) - (cond - ((string= type "coderef") - (let ((ref (org-element-property :path link))) - (format (org-export-get-coderef-format ref desc) - (org-export-resolve-coderef ref info)))) - ;; Do not apply a special syntax on radio links. Though, use - ;; transcoded target's contents as output. - ((string= type "radio") - (let ((destination (org-export-resolve-radio-link link info))) - (when destination - (org-export-data (org-element-contents destination) info)))) - ;; Do not apply a special syntax on fuzzy links pointing to - ;; targets. - ((string= type "fuzzy") - (let ((destination (org-export-resolve-fuzzy-link link info))) - (if (org-string-nw-p desc) desc - (when destination - (let ((number - (org-export-get-ordinal - destination info nil 'org-ascii--has-caption-p))) - (when number - (if (atom number) (number-to-string number) - (mapconcat 'number-to-string number ".")))))))) - (t - (if (not (org-string-nw-p desc)) (format "[%s]" raw-link) - (concat - (format "[%s]" desc) - (unless org-ascii-links-to-notes (format " (%s)" raw-link)))))))) - - -;;;; Paragraph - -(defun org-ascii-paragraph (paragraph contents info) - "Transcode a PARAGRAPH element from Org to ASCII. -CONTENTS is the contents of the paragraph, as a string. INFO is -the plist used as a communication channel." - (let ((contents (if (not (wholenump org-ascii-indented-line-width)) contents - (concat - (make-string org-ascii-indented-line-width ? ) - (replace-regexp-in-string "\\`[ \t]+" "" contents))))) - (org-ascii--fill-string - contents (org-ascii--current-text-width paragraph info) info))) - - -;;;; Plain List - -(defun org-ascii-plain-list (plain-list contents info) - "Transcode a PLAIN-LIST element from Org to ASCII. -CONTENTS is the contents of the list. INFO is a plist holding -contextual information." - contents) - - -;;;; Plain Text - -(defun org-ascii-plain-text (text info) - "Transcode a TEXT string from Org to ASCII. -INFO is a plist used as a communication channel." - (let ((utf8p (eq (plist-get info :ascii-charset) 'utf-8))) - (when (and utf8p (plist-get info :with-smart-quotes)) - (setq text (org-export-activate-smart-quotes text :utf-8 info))) - (if (not (plist-get info :with-special-strings)) text - (setq text (replace-regexp-in-string "\\\\-" "" text)) - (if (not utf8p) text - ;; Usual replacements in utf-8 with proper option set. - (replace-regexp-in-string - "\\.\\.\\." "…" - (replace-regexp-in-string - "--" "–" - (replace-regexp-in-string "---" "—" text))))))) - - -;;;; Planning - -(defun org-ascii-planning (planning contents info) - "Transcode a PLANNING element from Org to ASCII. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (mapconcat - 'identity - (delq nil - (list (let ((closed (org-element-property :closed planning))) - (when closed - (concat org-closed-string " " - (org-translate-time - (org-element-property :raw-value closed))))) - (let ((deadline (org-element-property :deadline planning))) - (when deadline - (concat org-deadline-string " " - (org-translate-time - (org-element-property :raw-value deadline))))) - (let ((scheduled (org-element-property :scheduled planning))) - (when scheduled - (concat org-scheduled-string " " - (org-translate-time - (org-element-property :raw-value scheduled))))))) - " ")) - - -;;;; Quote Block - -(defun org-ascii-quote-block (quote-block contents info) - "Transcode a QUOTE-BLOCK element from Org to ASCII. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (org-ascii--indent-string contents org-ascii-quote-margin)) - - -;;;; Quote Section - -(defun org-ascii-quote-section (quote-section contents info) - "Transcode a QUOTE-SECTION element from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((width (org-ascii--current-text-width quote-section info)) - (value - (org-export-data - (org-remove-indentation (org-element-property :value quote-section)) - info))) - (org-ascii--indent-string - value - (+ org-ascii-quote-margin - ;; Don't apply inner margin if parent headline is low level. - (let ((headline (org-export-get-parent-headline quote-section))) - (if (org-export-low-level-p headline info) 0 - org-ascii-inner-margin)))))) - - -;;;; Radio Target - -(defun org-ascii-radio-target (radio-target contents info) - "Transcode a RADIO-TARGET object from Org to ASCII. -CONTENTS is the contents of the target. INFO is a plist holding -contextual information." - contents) - - -;;;; Section - -(defun org-ascii-section (section contents info) - "Transcode a SECTION element from Org to ASCII. -CONTENTS is the contents of the section. INFO is a plist holding -contextual information." - (org-ascii--indent-string - (concat - contents - (when org-ascii-links-to-notes - ;; Add list of links at the end of SECTION. - (let ((links (org-ascii--describe-links - (org-ascii--unique-links section info) - (org-ascii--current-text-width section info) info))) - ;; Separate list of links and section contents. - (when (org-string-nw-p links) (concat "\n\n" links))))) - ;; Do not apply inner margin if parent headline is low level. - (let ((headline (org-export-get-parent-headline section))) - (if (or (not headline) (org-export-low-level-p headline info)) 0 - org-ascii-inner-margin)))) - - -;;;; Special Block - -(defun org-ascii-special-block (special-block contents info) - "Transcode a SPECIAL-BLOCK element from Org to ASCII. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - contents) - - -;;;; Src Block - -(defun org-ascii-src-block (src-block contents info) - "Transcode a SRC-BLOCK element from Org to ASCII. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let ((caption (org-ascii--build-caption src-block info)) - (code (org-export-format-code-default src-block info))) - (if (equal code "") "" - (concat - (when (and caption org-ascii-caption-above) (concat caption "\n")) - (org-ascii--box-string code info) - (when (and caption (not org-ascii-caption-above)) - (concat "\n" caption)))))) - - -;;;; Statistics Cookie - -(defun org-ascii-statistics-cookie (statistics-cookie contents info) - "Transcode a STATISTICS-COOKIE object from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-element-property :value statistics-cookie)) - - -;;;; Subscript - -(defun org-ascii-subscript (subscript contents info) - "Transcode a SUBSCRIPT object from Org to ASCII. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (if (org-element-property :use-brackets-p subscript) - (format "_{%s}" contents) - (format "_%s" contents))) - - -;;;; Superscript - -(defun org-ascii-superscript (superscript contents info) - "Transcode a SUPERSCRIPT object from Org to ASCII. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (if (org-element-property :use-brackets-p superscript) - (format "_{%s}" contents) - (format "_%s" contents))) - - -;;;; Strike-through - -(defun org-ascii-strike-through (strike-through contents info) - "Transcode STRIKE-THROUGH from Org to ASCII. -CONTENTS is text with strike-through markup. INFO is a plist -holding contextual information." - (format "+%s+" contents)) - - -;;;; Table - -(defun org-ascii-table (table contents info) - "Transcode a TABLE element from Org to ASCII. -CONTENTS is the contents of the table. INFO is a plist holding -contextual information." - (let ((caption (org-ascii--build-caption table info))) - (concat - ;; Possibly add a caption string above. - (when (and caption org-ascii-caption-above) (concat caption "\n")) - ;; Insert table. Note: "table.el" tables are left unmodified. - (cond ((eq (org-element-property :type table) 'org) contents) - ((and org-ascii-table-use-ascii-art - (eq (plist-get info :ascii-charset) 'utf-8) - (require 'ascii-art-to-unicode nil t)) - (with-temp-buffer - (insert (org-remove-indentation - (org-element-property :value table))) - (goto-char (point-min)) - (aa2u) - (goto-char (point-max)) - (skip-chars-backward " \r\t\n") - (buffer-substring (point-min) (point)))) - (t (org-remove-indentation (org-element-property :value table)))) - ;; Possible add a caption string below. - (and (not org-ascii-caption-above) caption)))) - - -;;;; Table Cell - -(defun org-ascii--table-cell-width (table-cell info) - "Return width of TABLE-CELL. - -INFO is a plist used as a communication channel. - -Width of a cell is determined either by a width cookie in the -same column as the cell, or by the maximum cell's length in that -column. - -When `org-ascii-table-widen-columns' is non-nil, width cookies -are ignored." - (let* ((row (org-export-get-parent table-cell)) - (table (org-export-get-parent row)) - (col (let ((cells (org-element-contents row))) - (- (length cells) (length (memq table-cell cells))))) - (cache - (or (plist-get info :ascii-table-cell-width-cache) - (plist-get (setq info - (plist-put info :ascii-table-cell-width-cache - (make-hash-table :test 'equal))) - :ascii-table-cell-width-cache))) - (key (cons table col))) - (or (gethash key cache) - (puthash - key - (or (and (not org-ascii-table-widen-columns) - (org-export-table-cell-width table-cell info)) - (let* ((max-width 0)) - (org-element-map table 'table-row - (lambda (row) - (setq max-width - (max (length - (org-export-data - (org-element-contents - (elt (org-element-contents row) col)) - info)) - max-width))) - info) - max-width)) - cache)))) - -(defun org-ascii-table-cell (table-cell contents info) - "Transcode a TABLE-CELL object from Org to ASCII. -CONTENTS is the cell contents. INFO is a plist used as -a communication channel." - ;; Determine column width. When `org-ascii-table-widen-columns' - ;; is nil and some width cookie has set it, use that value. - ;; Otherwise, compute the maximum width among transcoded data of - ;; each cell in the column. - (let ((width (org-ascii--table-cell-width table-cell info))) - ;; When contents are too large, truncate them. - (unless (or org-ascii-table-widen-columns (<= (length contents) width)) - (setq contents (concat (substring contents 0 (- width 2)) "=>"))) - ;; Align contents correctly within the cell. - (let* ((indent-tabs-mode nil) - (data - (when contents - (org-ascii--justify-string - contents width - (org-export-table-cell-alignment table-cell info))))) - (setq contents (concat data (make-string (- width (length data)) ? )))) - ;; Return cell. - (concat (format " %s " contents) - (when (memq 'right (org-export-table-cell-borders table-cell info)) - (if (eq (plist-get info :ascii-charset) 'utf-8) "│" "|"))))) - - -;;;; Table Row - -(defun org-ascii-table-row (table-row contents info) - "Transcode a TABLE-ROW element from Org to ASCII. -CONTENTS is the row contents. INFO is a plist used as -a communication channel." - (when (eq (org-element-property :type table-row) 'standard) - (let ((build-hline - (function - (lambda (lcorner horiz vert rcorner) - (concat - (apply - 'concat - (org-element-map table-row 'table-cell - (lambda (cell) - (let ((width (org-ascii--table-cell-width cell info)) - (borders (org-export-table-cell-borders cell info))) - (concat - ;; In order to know if CELL starts the row, do - ;; not compare it with the first cell in the - ;; row as there might be a special column. - ;; Instead, compare it with first exportable - ;; cell, obtained with `org-element-map'. - (when (and (memq 'left borders) - (eq (org-element-map table-row 'table-cell - 'identity info t) - cell)) - lcorner) - (make-string (+ 2 width) (string-to-char horiz)) - (cond - ((not (memq 'right borders)) nil) - ((eq (car (last (org-element-contents table-row))) cell) - rcorner) - (t vert))))) - info)) "\n")))) - (utf8p (eq (plist-get info :ascii-charset) 'utf-8)) - (borders (org-export-table-cell-borders - (org-element-map table-row 'table-cell 'identity info t) - info))) - (concat (cond - ((and (memq 'top borders) (or utf8p (memq 'above borders))) - (if utf8p (funcall build-hline "┍" "━" "┯" "┑") - (funcall build-hline "+" "-" "+" "+"))) - ((memq 'above borders) - (if utf8p (funcall build-hline "├" "─" "┼" "┤") - (funcall build-hline "+" "-" "+" "+")))) - (when (memq 'left borders) (if utf8p "│" "|")) - contents "\n" - (when (and (memq 'bottom borders) (or utf8p (memq 'below borders))) - (if utf8p (funcall build-hline "┕" "━" "┷" "┙") - (funcall build-hline "+" "-" "+" "+"))))))) - - -;;;; Timestamp - -(defun org-ascii-timestamp (timestamp contents info) - "Transcode a TIMESTAMP object from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-ascii-plain-text (org-timestamp-translate timestamp) info)) - - -;;;; Underline - -(defun org-ascii-underline (underline contents info) - "Transcode UNDERLINE from Org to ASCII. -CONTENTS is the text with underline markup. INFO is a plist -holding contextual information." - (format "_%s_" contents)) - - -;;;; Verbatim - -(defun org-ascii-verbatim (verbatim contents info) - "Return a VERBATIM object from Org to ASCII. -CONTENTS is nil. INFO is a plist holding contextual information." - (format org-ascii-verbatim-format - (org-element-property :value verbatim))) - - -;;;; Verse Block - -(defun org-ascii-verse-block (verse-block contents info) - "Transcode a VERSE-BLOCK element from Org to ASCII. -CONTENTS is verse block contents. INFO is a plist holding -contextual information." - (let ((verse-width (org-ascii--current-text-width verse-block info))) - (org-ascii--indent-string - (org-ascii--justify-string contents verse-width 'left) - org-ascii-quote-margin))) - - - -;;; Filters - -(defun org-ascii-filter-headline-blank-lines (headline back-end info) - "Filter controlling number of blank lines after a headline. - -HEADLINE is a string representing a transcoded headline. -BACK-END is symbol specifying back-end used for export. INFO is -plist containing the communication channel. - -This function only applies to `ascii' back-end. See -`org-ascii-headline-spacing' for information." - (if (not org-ascii-headline-spacing) headline - (let ((blanks (make-string (1+ (cdr org-ascii-headline-spacing)) ?\n))) - (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline)))) - -(defun org-ascii-filter-paragraph-spacing (tree back-end info) - "Filter controlling number of blank lines between paragraphs. - -TREE is the parse tree. BACK-END is the symbol specifying -back-end used for export. INFO is a plist used as -a communication channel. - -See `org-ascii-paragraph-spacing' for information." - (when (wholenump org-ascii-paragraph-spacing) - (org-element-map tree 'paragraph - (lambda (p) - (when (eq (org-element-type (org-export-get-next-element p info)) - 'paragraph) - (org-element-put-property - p :post-blank org-ascii-paragraph-spacing))))) - tree) - -(defun org-ascii-filter-comment-spacing (tree backend info) - "Filter removing blank lines between comments. -TREE is the parse tree. BACK-END is the symbol specifying -back-end used for export. INFO is a plist used as -a communication channel." - (org-element-map tree '(comment comment-block) - (lambda (c) - (when (memq (org-element-type (org-export-get-next-element c info)) - '(comment comment-block)) - (org-element-put-property c :post-blank 0)))) - tree) - - - -;;; End-user functions - -;;;###autoload -(defun org-ascii-export-as-ascii - (&optional async subtreep visible-only body-only ext-plist) - "Export current buffer to a text buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should be accessible -through the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, strip title and -table of contents from output. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Export is done in a buffer named \"*Org ASCII Export*\", which -will be displayed when `org-export-show-temporary-export-buffer' -is non-nil." - (interactive) - (org-export-to-buffer 'ascii "*Org ASCII Export*" - async subtreep visible-only body-only ext-plist (lambda () (text-mode)))) - -;;;###autoload -(defun org-ascii-export-to-ascii - (&optional async subtreep visible-only body-only ext-plist) - "Export current buffer to a text file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, strip title and -table of contents from output. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return output file's name." - (interactive) - (let ((file (org-export-output-file-name ".txt" subtreep))) - (org-export-to-file 'ascii file - async subtreep visible-only body-only ext-plist))) - -;;;###autoload -(defun org-ascii-publish-to-ascii (plist filename pub-dir) - "Publish an Org file to ASCII. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (org-publish-org-to - 'ascii filename ".txt" `(:ascii-charset ascii ,@plist) pub-dir)) - -;;;###autoload -(defun org-ascii-publish-to-latin1 (plist filename pub-dir) - "Publish an Org file to Latin-1. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (org-publish-org-to - 'ascii filename ".txt" `(:ascii-charset latin1 ,@plist) pub-dir)) - -;;;###autoload -(defun org-ascii-publish-to-utf8 (plist filename pub-dir) - "Publish an org file to UTF-8. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (org-publish-org-to - 'ascii filename ".txt" `(:ascii-charset utf-8 ,@plist) pub-dir)) - - -(provide 'ox-ascii) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; coding: utf-8-emacs -;; End: - -;;; ox-ascii.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ox-beamer.el b/xemacs-packages/lisp/org-8.2.3c/ox-beamer.el deleted file mode 100644 index 2868944c..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ox-beamer.el +++ /dev/null @@ -1,1181 +0,0 @@ -;;; ox-beamer.el --- Beamer Back-End for Org Export Engine - -;; Copyright (C) 2007-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten.dominik AT gmail DOT com> -;; Nicolas Goaziou <n.goaziou AT gmail DOT com> -;; Keywords: org, wp, tex - -;; 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: -;; -;; This library implements both a Beamer back-end, derived from the -;; LaTeX one and a minor mode easing structure edition of the -;; document. See Org manual for more information. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'ox-latex) - -;; Install a default set-up for Beamer export. -(unless (assoc "beamer" org-latex-classes) - (add-to-list 'org-latex-classes - '("beamer" - "\\documentclass[presentation]{beamer} -\[DEFAULT-PACKAGES] -\[PACKAGES] -\[EXTRA]" - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}")))) - - - -;;; User-Configurable Variables - -(defgroup org-export-beamer nil - "Options specific for using the beamer class in LaTeX export." - :tag "Org Beamer" - :group 'org-export - :version "24.2") - -(defcustom org-beamer-frame-level 1 - "The level at which headlines become frames. - -Headlines at a lower level will be translated into a sectioning -structure. At a higher level, they will be translated into -blocks. - -If a headline with a \"BEAMER_env\" property set to \"frame\" is -found within a tree, its level locally overrides this number. - -This variable has no effect on headlines with the \"BEAMER_env\" -property set to either \"ignoreheading\", \"appendix\", or -\"note\", which will respectively, be invisible, become an -appendix or a note. - -This integer is relative to the minimal level of a headline -within the parse tree, defined as 1." - :group 'org-export-beamer - :type 'integer) - -(defcustom org-beamer-frame-default-options "" - "Default options string to use for frames. -For example, it could be set to \"allowframebreaks\"." - :group 'org-export-beamer - :type '(string :tag "[options]")) - -(defcustom org-beamer-column-view-format - "%45ITEM %10BEAMER_env(Env) %10BEAMER_act(Act) %4BEAMER_col(Col) %8BEAMER_opt(Opt)" - "Column view format that should be used to fill the template." - :group 'org-export-beamer - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (const :tag "Do not insert Beamer column view format" nil) - (string :tag "Beamer column view format"))) - -(defcustom org-beamer-theme "default" - "Default theme used in Beamer presentations." - :group 'org-export-beamer - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (const :tag "Do not insert a Beamer theme" nil) - (string :tag "Beamer theme"))) - -(defcustom org-beamer-environments-extra nil - "Environments triggered by tags in Beamer export. -Each entry has 4 elements: - -name Name of the environment -key Selection key for `org-beamer-select-environment' -open The opening template for the environment, with the following escapes - %a the action/overlay specification - %A the default action/overlay specification - %o the options argument of the template - %h the headline text - %r the raw headline text (i.e. without any processing) - %H if there is headline text, that raw text in {} braces - %U if there is headline text, that raw text in [] brackets -close The closing string of the environment." - :group 'org-export-beamer - :version "24.4" - :package-version '(Org . "8.1") - :type '(repeat - (list - (string :tag "Environment") - (string :tag "Selection key") - (string :tag "Begin") - (string :tag "End")))) - -(defcustom org-beamer-outline-frame-title "Outline" - "Default title of a frame containing an outline." - :group 'org-export-beamer - :type '(string :tag "Outline frame title")) - -(defcustom org-beamer-outline-frame-options "" - "Outline frame options appended after \\begin{frame}. -You might want to put e.g. \"allowframebreaks=0.9\" here." - :group 'org-export-beamer - :type '(string :tag "Outline frame options")) - - - -;;; Internal Variables - -(defconst org-beamer-column-widths - "0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 0.0 :ETC" -"The column widths that should be installed as allowed property values.") - -(defconst org-beamer-environments-special - '(("againframe" "A") - ("appendix" "x") - ("column" "c") - ("columns" "C") - ("frame" "f") - ("fullframe" "F") - ("ignoreheading" "i") - ("note" "n") - ("noteNH" "N")) - "Alist of environments treated in a special way by the back-end. -Keys are environment names, as strings, values are bindings used -in `org-beamer-select-environment'. Environments listed here, -along with their binding, are hard coded and cannot be modified -through `org-beamer-environments-extra' variable.") - -(defconst org-beamer-environments-default - '(("block" "b" "\\begin{block}%a{%h}" "\\end{block}") - ("alertblock" "a" "\\begin{alertblock}%a{%h}" "\\end{alertblock}") - ("verse" "v" "\\begin{verse}%a %% %h" "\\end{verse}") - ("quotation" "q" "\\begin{quotation}%a %% %h" "\\end{quotation}") - ("quote" "Q" "\\begin{quote}%a %% %h" "\\end{quote}") - ("structureenv" "s" "\\begin{structureenv}%a %% %h" "\\end{structureenv}") - ("theorem" "t" "\\begin{theorem}%a%U" "\\end{theorem}") - ("definition" "d" "\\begin{definition}%a%U" "\\end{definition}") - ("example" "e" "\\begin{example}%a%U" "\\end{example}") - ("exampleblock" "E" "\\begin{exampleblock}%a{%h}" "\\end{exampleblock}") - ("proof" "p" "\\begin{proof}%a%U" "\\end{proof}") - ("beamercolorbox" "o" "\\begin{beamercolorbox}%o{%h}" "\\end{beamercolorbox}")) - "Environments triggered by properties in Beamer export. -These are the defaults - for user definitions, see -`org-beamer-environments-extra'.") - -(defconst org-beamer-verbatim-elements - '(code example-block fixed-width inline-src-block src-block verbatim) - "List of element or object types producing verbatim text. -This is used internally to determine when a frame should have the -\"fragile\" option.") - - - -;;; Internal functions - -(defun org-beamer--normalize-argument (argument type) - "Return ARGUMENT string with proper boundaries. - -TYPE is a symbol among the following: -`action' Return ARGUMENT within angular brackets. -`defaction' Return ARGUMENT within both square and angular brackets. -`option' Return ARGUMENT within square brackets." - (if (not (string-match "\\S-" argument)) "" - (case type - (action (if (string-match "\\`<.*>\\'" argument) argument - (format "<%s>" argument))) - (defaction (cond - ((string-match "\\`\\[<.*>\\]\\'" argument) argument) - ((string-match "\\`<.*>\\'" argument) - (format "[%s]" argument)) - ((string-match "\\`\\[\\(.*\\)\\]\\'" argument) - (format "[<%s>]" (match-string 1 argument))) - (t (format "[<%s>]" argument)))) - (option (if (string-match "\\`\\[.*\\]\\'" argument) argument - (format "[%s]" argument))) - (otherwise argument)))) - -(defun org-beamer--element-has-overlay-p (element) - "Non-nil when ELEMENT has an overlay specified. -An element has an overlay specification when it starts with an -`beamer' export-snippet whose value is between angular brackets. -Return overlay specification, as a string, or nil." - (let ((first-object (car (org-element-contents element)))) - (when (eq (org-element-type first-object) 'export-snippet) - (let ((value (org-element-property :value first-object))) - (and (string-match "\\`<.*>\\'" value) value))))) - - - -;;; Define Back-End - -(org-export-define-derived-backend 'beamer 'latex - :export-block "BEAMER" - :menu-entry - '(?l 1 - ((?B "As LaTeX buffer (Beamer)" org-beamer-export-as-latex) - (?b "As LaTeX file (Beamer)" org-beamer-export-to-latex) - (?P "As PDF file (Beamer)" org-beamer-export-to-pdf) - (?O "As PDF file and open (Beamer)" - (lambda (a s v b) - (if a (org-beamer-export-to-pdf t s v b) - (org-open-file (org-beamer-export-to-pdf nil s v b))))))) - :options-alist - '((:beamer-theme "BEAMER_THEME" nil org-beamer-theme) - (:beamer-color-theme "BEAMER_COLOR_THEME" nil nil t) - (:beamer-font-theme "BEAMER_FONT_THEME" nil nil t) - (:beamer-inner-theme "BEAMER_INNER_THEME" nil nil t) - (:beamer-outer-theme "BEAMER_OUTER_THEME" nil nil t) - (:beamer-header-extra "BEAMER_HEADER" nil nil newline) - ;; Modify existing properties. - (:headline-levels nil "H" org-beamer-frame-level) - (:latex-class "LATEX_CLASS" nil "beamer" t)) - :translate-alist '((bold . org-beamer-bold) - (export-block . org-beamer-export-block) - (export-snippet . org-beamer-export-snippet) - (headline . org-beamer-headline) - (item . org-beamer-item) - (keyword . org-beamer-keyword) - (link . org-beamer-link) - (plain-list . org-beamer-plain-list) - (radio-target . org-beamer-radio-target) - (target . org-beamer-target) - (template . org-beamer-template))) - - - -;;; Transcode Functions - -;;;; Bold - -(defun org-beamer-bold (bold contents info) - "Transcode BLOCK object into Beamer code. -CONTENTS is the text being bold. INFO is a plist used as -a communication channel." - (format "\\alert%s{%s}" - (or (org-beamer--element-has-overlay-p bold) "") - contents)) - - -;;;; Export Block - -(defun org-beamer-export-block (export-block contents info) - "Transcode an EXPORT-BLOCK element into Beamer code. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (when (member (org-element-property :type export-block) '("BEAMER" "LATEX")) - (org-remove-indentation (org-element-property :value export-block)))) - - -;;;; Export Snippet - -(defun org-beamer-export-snippet (export-snippet contents info) - "Transcode an EXPORT-SNIPPET object into Beamer code. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (let ((backend (org-export-snippet-backend export-snippet)) - (value (org-element-property :value export-snippet))) - ;; Only "latex" and "beamer" snippets are retained. - (cond ((eq backend 'latex) value) - ;; Ignore "beamer" snippets specifying overlays. - ((and (eq backend 'beamer) - (or (org-export-get-previous-element export-snippet info) - (not (string-match "\\`<.*>\\'" value)))) - value)))) - - -;;;; Headline -;; -;; The main function to translate a headline is -;; `org-beamer-headline'. -;; -;; Depending on the level at which a headline is considered as -;; a frame (given by `org-beamer--frame-level'), the headline is -;; either a section (`org-beamer--format-section'), a frame -;; (`org-beamer--format-frame') or a block -;; (`org-beamer--format-block'). -;; -;; `org-beamer-headline' also takes care of special environments -;; like "ignoreheading", "note", "noteNH", "appendix" and -;; "againframe". - -(defun org-beamer--get-label (headline info) - "Return label for HEADLINE, as a string. - -INFO is a plist used as a communication channel. - -The value is either the label specified in \"BEAMER_opt\" -property, or a fallback value built from headline's number. This -function assumes HEADLINE will be treated as a frame." - (let ((opt (org-element-property :BEAMER_OPT headline))) - (if (and (org-string-nw-p opt) - (string-match "\\(?:^\\|,\\)label=\\(.*?\\)\\(?:$\\|,\\)" opt)) - (match-string 1 opt) - (format "sec-%s" - (mapconcat 'number-to-string - (org-export-get-headline-number headline info) - "-"))))) - -(defun org-beamer--frame-level (headline info) - "Return frame level in subtree containing HEADLINE. -INFO is a plist used as a communication channel." - (or - ;; 1. Look for "frame" environment in parents, starting from the - ;; farthest. - (catch 'exit - (mapc (lambda (parent) - (let ((env (org-element-property :BEAMER_ENV parent))) - (when (and env (member-ignore-case env '("frame" "fullframe"))) - (throw 'exit (org-export-get-relative-level parent info))))) - (nreverse (org-export-get-genealogy headline))) - nil) - ;; 2. Look for "frame" environment in HEADLINE. - (let ((env (org-element-property :BEAMER_ENV headline))) - (and env (member-ignore-case env '("frame" "fullframe")) - (org-export-get-relative-level headline info))) - ;; 3. Look for "frame" environment in sub-tree. - (org-element-map headline 'headline - (lambda (hl) - (let ((env (org-element-property :BEAMER_ENV hl))) - (when (and env (member-ignore-case env '("frame" "fullframe"))) - (org-export-get-relative-level hl info)))) - info 'first-match) - ;; 4. No "frame" environment in tree: use default value. - (plist-get info :headline-levels))) - -(defun org-beamer--format-section (headline contents info) - "Format HEADLINE as a sectioning part. -CONTENTS holds the contents of the headline. INFO is a plist -used as a communication channel." - (let ((latex-headline - (org-export-with-backend - ;; We create a temporary export back-end which behaves the - ;; same as current one, but adds "\protect" in front of the - ;; output of some objects. - (org-export-create-backend - :parent 'latex - :transcoders - (let ((protected-output - (function - (lambda (object contents info) - (let ((code (org-export-with-backend - 'beamer object contents info))) - (if (org-string-nw-p code) (concat "\\protect" code) - code)))))) - (mapcar #'(lambda (type) (cons type protected-output)) - '(bold footnote-reference italic strike-through timestamp - underline)))) - headline - contents - info)) - (mode-specs (org-element-property :BEAMER_ACT headline))) - (if (and mode-specs - (string-match "\\`\\\\\\(.*?\\)\\(?:\\*\\|\\[.*\\]\\)?{" - latex-headline)) - ;; Insert overlay specifications. - (replace-match (concat (match-string 1 latex-headline) - (format "<%s>" mode-specs)) - nil nil latex-headline 1) - latex-headline))) - -(defun org-beamer--format-frame (headline contents info) - "Format HEADLINE as a frame. -CONTENTS holds the contents of the headline. INFO is a plist -used as a communication channel." - (let ((fragilep - ;; FRAGILEP is non-nil when HEADLINE contains an element - ;; among `org-beamer-verbatim-elements'. - (org-element-map headline org-beamer-verbatim-elements 'identity - info 'first-match))) - (concat "\\begin{frame}" - ;; Overlay specification, if any. When surrounded by - ;; square brackets, consider it as a default - ;; specification. - (let ((action (org-element-property :BEAMER_ACT headline))) - (cond - ((not action) "") - ((string-match "\\`\\[.*\\]\\'" action ) - (org-beamer--normalize-argument action 'defaction)) - (t (org-beamer--normalize-argument action 'action)))) - ;; Options, if any. - (let* ((beamer-opt (org-element-property :BEAMER_OPT headline)) - (options - ;; Collect options from default value and headline's - ;; properties. Also add a label for links. - (append - (org-split-string org-beamer-frame-default-options ",") - (and beamer-opt - (org-split-string - ;; Remove square brackets if user provided - ;; them. - (and (string-match "^\\[?\\(.*\\)\\]?$" beamer-opt) - (match-string 1 beamer-opt)) - ",")) - ;; Provide an automatic label for the frame - ;; unless the user specified one. - (unless (and beamer-opt - (string-match "\\(^\\|,\\)label=" beamer-opt)) - (list - (format "label=%s" - (org-beamer--get-label headline info))))))) - ;; Change options list into a string. - (org-beamer--normalize-argument - (mapconcat - 'identity - (if (or (not fragilep) (member "fragile" options)) options - (cons "fragile" options)) - ",") - 'option)) - ;; Title. - (let ((env (org-element-property :BEAMER_ENV headline))) - (format "{%s}" - (if (and env (equal (downcase env) "fullframe")) "" - (org-export-data - (org-element-property :title headline) info)))) - "\n" - ;; The following workaround is required in fragile frames - ;; as Beamer will append "\par" to the beginning of the - ;; contents. So we need to make sure the command is - ;; separated from the contents by at least one space. If - ;; it isn't, it will create "\parfirst-word" command and - ;; remove the first word from the contents in the PDF - ;; output. - (if (not fragilep) contents - (replace-regexp-in-string "\\`\n*" "\\& " (or contents ""))) - "\\end{frame}"))) - -(defun org-beamer--format-block (headline contents info) - "Format HEADLINE as a block. -CONTENTS holds the contents of the headline. INFO is a plist -used as a communication channel." - (let* ((column-width (org-element-property :BEAMER_COL headline)) - ;; ENVIRONMENT defaults to "block" if none is specified and - ;; there is no column specification. If there is a column - ;; specified but still no explicit environment, ENVIRONMENT - ;; is "column". - (environment (let ((env (org-element-property :BEAMER_ENV headline))) - (cond - ;; "block" is the fallback environment. - ((and (not env) (not column-width)) "block") - ;; "column" only. - ((not env) "column") - ;; Use specified environment. - (t env)))) - (raw-title (org-element-property :raw-value headline)) - (env-format - (cond ((member environment '("column" "columns")) nil) - ((assoc environment - (append org-beamer-environments-extra - org-beamer-environments-default))) - (t (user-error "Wrong block type at a headline named \"%s\"" - raw-title)))) - (title (org-export-data (org-element-property :title headline) info)) - (options (let ((options (org-element-property :BEAMER_OPT headline))) - (if (not options) "" - (org-beamer--normalize-argument options 'option)))) - ;; Start a "columns" environment when explicitly requested or - ;; when there is no previous headline or the previous - ;; headline do not have a BEAMER_column property. - (parent-env (org-element-property - :BEAMER_ENV (org-export-get-parent-headline headline))) - (start-columns-p - (or (equal environment "columns") - (and column-width - (not (and parent-env - (equal (downcase parent-env) "columns"))) - (or (org-export-first-sibling-p headline info) - (not (org-element-property - :BEAMER_COL - (org-export-get-previous-element - headline info))))))) - ;; End the "columns" environment when explicitly requested or - ;; when there is no next headline or the next headline do not - ;; have a BEAMER_column property. - (end-columns-p - (or (equal environment "columns") - (and column-width - (not (and parent-env - (equal (downcase parent-env) "columns"))) - (or (org-export-last-sibling-p headline info) - (not (org-element-property - :BEAMER_COL - (org-export-get-next-element headline info)))))))) - (concat - (when start-columns-p - ;; Column can accept options only when the environment is - ;; explicitly defined. - (if (not (equal environment "columns")) "\\begin{columns}\n" - (format "\\begin{columns}%s\n" options))) - (when column-width - (format "\\begin{column}%s{%s}\n" - ;; One can specify placement for column only when - ;; HEADLINE stands for a column on its own. - (if (equal environment "column") options "") - (format "%s\\textwidth" column-width))) - ;; Block's opening string. - (when (nth 2 env-format) - (concat - (org-fill-template - (nth 2 env-format) - (nconc - ;; If BEAMER_act property has its value enclosed in square - ;; brackets, it is a default overlay specification and - ;; overlay specification is empty. Otherwise, it is an - ;; overlay specification and the default one is nil. - (let ((action (org-element-property :BEAMER_ACT headline))) - (cond - ((not action) (list (cons "a" "") (cons "A" ""))) - ((string-match "\\`\\[.*\\]\\'" action) - (list - (cons "A" (org-beamer--normalize-argument action 'defaction)) - (cons "a" ""))) - (t - (list (cons "a" (org-beamer--normalize-argument action 'action)) - (cons "A" ""))))) - (list (cons "o" options) - (cons "h" title) - (cons "r" raw-title) - (cons "H" (if (equal raw-title "") "" - (format "{%s}" raw-title))) - (cons "U" (if (equal raw-title "") "" - (format "[%s]" raw-title)))))) - "\n")) - contents - ;; Block's closing string, if any. - (and (nth 3 env-format) (concat (nth 3 env-format) "\n")) - (when column-width "\\end{column}\n") - (when end-columns-p "\\end{columns}")))) - -(defun org-beamer-headline (headline contents info) - "Transcode HEADLINE element into Beamer code. -CONTENTS is the contents of the headline. INFO is a plist used -as a communication channel." - (unless (org-element-property :footnote-section-p headline) - (let ((level (org-export-get-relative-level headline info)) - (frame-level (org-beamer--frame-level headline info)) - (environment (let ((env (org-element-property :BEAMER_ENV headline))) - (or (org-string-nw-p env) "block")))) - (cond - ;; Case 1: Resume frame specified by "BEAMER_ref" property. - ((equal environment "againframe") - (let ((ref (org-element-property :BEAMER_REF headline))) - ;; Reference to frame being resumed is mandatory. Ignore - ;; the whole headline if it isn't provided. - (when (org-string-nw-p ref) - (concat "\\againframe" - ;; Overlay specification. - (let ((overlay (org-element-property :BEAMER_ACT headline))) - (when overlay - (org-beamer--normalize-argument - overlay - (if (string-match "^\\[.*\\]$" overlay) 'defaction - 'action)))) - ;; Options. - (let ((options (org-element-property :BEAMER_OPT headline))) - (when options - (org-beamer--normalize-argument options 'option))) - ;; Resolve reference provided by "BEAMER_ref" - ;; property. This is done by building a minimal fake - ;; link and calling the appropriate resolve function, - ;; depending on the reference syntax. - (let* ((type - (progn - (string-match "^\\(id:\\|#\\|\\*\\)?\\(.*\\)" ref) - (cond - ((or (not (match-string 1 ref)) - (equal (match-string 1 ref) "*")) 'fuzzy) - ((equal (match-string 1 ref) "id:") 'id) - (t 'custom-id)))) - (link (list 'link (list :path (match-string 2 ref)))) - (target (if (eq type 'fuzzy) - (org-export-resolve-fuzzy-link link info) - (org-export-resolve-id-link link info)))) - ;; Now use user-defined label provided in TARGET - ;; headline, or fallback to standard one. - (format "{%s}" (org-beamer--get-label target info))))))) - ;; Case 2: Creation of an appendix is requested. - ((equal environment "appendix") - (concat "\\appendix" - (org-element-property :BEAMER_ACT headline) - "\n" - (make-string (org-element-property :pre-blank headline) ?\n) - contents)) - ;; Case 3: Ignore heading. - ((equal environment "ignoreheading") - (concat (make-string (org-element-property :pre-blank headline) ?\n) - contents)) - ;; Case 4: HEADLINE is a note. - ((member environment '("note" "noteNH")) - (format "\\note{%s}" - (concat (and (equal environment "note") - (concat - (org-export-data - (org-element-property :title headline) info) - "\n")) - (org-trim contents)))) - ;; Case 5: HEADLINE is a frame. - ((= level frame-level) - (org-beamer--format-frame headline contents info)) - ;; Case 6: Regular section, extracted from - ;; `org-latex-classes'. - ((< level frame-level) - (org-beamer--format-section headline contents info)) - ;; Case 7: Otherwise, HEADLINE is a block. - (t (org-beamer--format-block headline contents info)))))) - - -;;;; Item - -(defun org-beamer-item (item contents info) - "Transcode an ITEM element into Beamer code. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let ((action (let ((first-element (car (org-element-contents item)))) - (and (eq (org-element-type first-element) 'paragraph) - (org-beamer--element-has-overlay-p first-element)))) - (output (org-export-with-backend 'latex item contents info))) - (if (not action) output - ;; If the item starts with a paragraph and that paragraph starts - ;; with an export snippet specifying an overlay, insert it after - ;; \item command. - (replace-regexp-in-string "\\\\item" (concat "\\\\item" action) output)))) - - -;;;; Keyword - -(defun org-beamer-keyword (keyword contents info) - "Transcode a KEYWORD element into Beamer code. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (let ((key (org-element-property :key keyword)) - (value (org-element-property :value keyword))) - ;; Handle specifically BEAMER and TOC (headlines only) keywords. - ;; Otherwise, fallback to `latex' back-end. - (cond - ((equal key "BEAMER") value) - ((and (equal key "TOC") (string-match "\\<headlines\\>" value)) - (let ((depth (or (and (string-match "[0-9]+" value) - (string-to-number (match-string 0 value))) - (plist-get info :with-toc))) - (options (and (string-match "\\[.*?\\]" value) - (match-string 0 value)))) - (concat - (when (wholenump depth) (format "\\setcounter{tocdepth}{%s}\n" depth)) - "\\tableofcontents" options))) - (t (org-export-with-backend 'latex keyword contents info))))) - - -;;;; Link - -(defun org-beamer-link (link contents info) - "Transcode a LINK object into Beamer code. -CONTENTS is the description part of the link. INFO is a plist -used as a communication channel." - (let ((type (org-element-property :type link)) - (path (org-element-property :path link))) - ;; Use \hyperlink command for all internal links. - (cond - ((equal type "radio") - (let ((destination (org-export-resolve-radio-link link info))) - (when destination - (format "\\hyperlink%s{%s}{%s}" - (or (org-beamer--element-has-overlay-p link) "") - (org-export-solidify-link-text path) - (org-export-data (org-element-contents destination) info))))) - ((and (member type '("custom-id" "fuzzy" "id")) - (let ((destination (if (string= type "fuzzy") - (org-export-resolve-fuzzy-link link info) - (org-export-resolve-id-link link info)))) - (case (org-element-type destination) - (headline - (let ((label - (format "sec-%s" - (mapconcat - 'number-to-string - (org-export-get-headline-number - destination info) - "-")))) - (if (and (plist-get info :section-numbers) (not contents)) - (format "\\ref{%s}" label) - (format "\\hyperlink%s{%s}{%s}" - (or (org-beamer--element-has-overlay-p link) "") - label - contents)))) - (target - (let ((path (org-export-solidify-link-text path))) - (if (not contents) (format "\\ref{%s}" path) - (format "\\hyperlink%s{%s}{%s}" - (or (org-beamer--element-has-overlay-p link) "") - path - contents)))))))) - ;; Otherwise, use `latex' back-end. - (t (org-export-with-backend 'latex link contents info))))) - - -;;;; Plain List -;; -;; Plain lists support `:environment', `:overlay' and `:options' -;; attributes. - -(defun org-beamer-plain-list (plain-list contents info) - "Transcode a PLAIN-LIST element into Beamer code. -CONTENTS is the contents of the list. INFO is a plist holding -contextual information." - (let* ((type (org-element-property :type plain-list)) - (attributes (org-combine-plists - (org-export-read-attribute :attr_latex plain-list) - (org-export-read-attribute :attr_beamer plain-list))) - (latex-type (let ((env (plist-get attributes :environment))) - (cond (env) - ((eq type 'ordered) "enumerate") - ((eq type 'descriptive) "description") - (t "itemize"))))) - (org-latex--wrap-label - plain-list - (format "\\begin{%s}%s%s\n%s\\end{%s}" - latex-type - ;; Default overlay specification, if any. - (org-beamer--normalize-argument - (or (plist-get attributes :overlay) "") - 'defaction) - ;; Second optional argument depends on the list type. - (org-beamer--normalize-argument - (or (plist-get attributes :options) "") - 'option) - ;; Eventually insert contents and close environment. - contents - latex-type)))) - - -;;;; Radio Target - -(defun org-beamer-radio-target (radio-target text info) - "Transcode a RADIO-TARGET object into Beamer code. -TEXT is the text of the target. INFO is a plist holding -contextual information." - (format "\\hypertarget%s{%s}{%s}" - (or (org-beamer--element-has-overlay-p radio-target) "") - (org-export-solidify-link-text - (org-element-property :value radio-target)) - text)) - - -;;;; Target - -(defun org-beamer-target (target contents info) - "Transcode a TARGET object into Beamer code. -CONTENTS is nil. INFO is a plist holding contextual -information." - (format "\\hypertarget{%s}{}" - (org-export-solidify-link-text (org-element-property :value target)))) - - -;;;; Template -;; -;; Template used is similar to the one used in `latex' back-end, -;; excepted for the table of contents and Beamer themes. - -(defun org-beamer-template (contents info) - "Return complete document string after Beamer conversion. -CONTENTS is the transcoded contents string. INFO is a plist -holding export options." - (let ((title (org-export-data (plist-get info :title) info))) - (concat - ;; 1. Time-stamp. - (and (plist-get info :time-stamp-file) - (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) - ;; 2. Document class and packages. - (let* ((class (plist-get info :latex-class)) - (class-options (plist-get info :latex-class-options)) - (header (nth 1 (assoc class org-latex-classes))) - (document-class-string - (and (stringp header) - (if (not class-options) header - (replace-regexp-in-string - "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" - class-options header t nil 1))))) - (if (not document-class-string) - (user-error "Unknown LaTeX class `%s'" class) - (org-latex-guess-babel-language - (org-latex-guess-inputenc - (org-element-normalize-string - (org-splice-latex-header - document-class-string - org-latex-default-packages-alist - org-latex-packages-alist nil - (concat (org-element-normalize-string - (plist-get info :latex-header)) - (org-element-normalize-string - (plist-get info :latex-header-extra)) - (plist-get info :beamer-header-extra))))) - info))) - ;; 3. Insert themes. - (let ((format-theme - (function - (lambda (prop command) - (let ((theme (plist-get info prop))) - (when theme - (concat command - (if (not (string-match "\\[.*\\]" theme)) - (format "{%s}\n" theme) - (format "%s{%s}\n" - (match-string 0 theme) - (org-trim - (replace-match "" nil nil theme))))))))))) - (mapconcat (lambda (args) (apply format-theme args)) - '((:beamer-theme "\\usetheme") - (:beamer-color-theme "\\usecolortheme") - (:beamer-font-theme "\\usefonttheme") - (:beamer-inner-theme "\\useinnertheme") - (:beamer-outer-theme "\\useoutertheme")) - "")) - ;; 4. Possibly limit depth for headline numbering. - (let ((sec-num (plist-get info :section-numbers))) - (when (integerp sec-num) - (format "\\setcounter{secnumdepth}{%d}\n" sec-num))) - ;; 5. Author. - (let ((author (and (plist-get info :with-author) - (let ((auth (plist-get info :author))) - (and auth (org-export-data auth info))))) - (email (and (plist-get info :with-email) - (org-export-data (plist-get info :email) info)))) - (cond ((and author email (not (string= "" email))) - (format "\\author{%s\\thanks{%s}}\n" author email)) - (author (format "\\author{%s}\n" author)) - (t "\\author{}\n"))) - ;; 6. Date. - (let ((date (and (plist-get info :with-date) (org-export-get-date info)))) - (format "\\date{%s}\n" (org-export-data date info))) - ;; 7. Title - (format "\\title{%s}\n" title) - ;; 8. Hyperref options. - (when (plist-get info :latex-hyperref-p) - (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" - (or (plist-get info :keywords) "") - (or (plist-get info :description) "") - (if (not (plist-get info :with-creator)) "" - (plist-get info :creator)))) - ;; 9. Document start. - "\\begin{document}\n\n" - ;; 10. Title command. - (org-element-normalize-string - (cond ((string= "" title) nil) - ((not (stringp org-latex-title-command)) nil) - ((string-match "\\(?:[^%]\\|^\\)%s" - org-latex-title-command) - (format org-latex-title-command title)) - (t org-latex-title-command))) - ;; 11. Table of contents. - (let ((depth (plist-get info :with-toc))) - (when depth - (concat - (format "\\begin{frame}%s{%s}\n" - (org-beamer--normalize-argument - org-beamer-outline-frame-options 'option) - org-beamer-outline-frame-title) - (when (wholenump depth) - (format "\\setcounter{tocdepth}{%d}\n" depth)) - "\\tableofcontents\n" - "\\end{frame}\n\n"))) - ;; 12. Document's body. - contents - ;; 13. Creator. - (let ((creator-info (plist-get info :with-creator))) - (cond - ((not creator-info) "") - ((eq creator-info 'comment) - (format "%% %s\n" (plist-get info :creator))) - (t (concat (plist-get info :creator) "\n")))) - ;; 14. Document end. - "\\end{document}"))) - - - -;;; Minor Mode - - -(defvar org-beamer-mode-map (make-sparse-keymap) - "The keymap for `org-beamer-mode'.") -(define-key org-beamer-mode-map "\C-c\C-b" 'org-beamer-select-environment) - -;;;###autoload -(define-minor-mode org-beamer-mode - "Support for editing Beamer oriented Org mode files." - nil " Bm" 'org-beamer-mode-map) - -(when (fboundp 'font-lock-add-keywords) - (font-lock-add-keywords - 'org-mode - '((":\\(B_[a-z]+\\|BMCOL\\):" 1 'org-beamer-tag prepend)) - 'prepend)) - -(defface org-beamer-tag '((t (:box (:line-width 1 :color grey40)))) - "The special face for beamer tags." - :group 'org-export-beamer) - -(defun org-beamer-property-changed (property value) - "Track the BEAMER_env property with tags. -PROPERTY is the name of the modified property. VALUE is its new -value." - (cond - ((equal property "BEAMER_env") - (save-excursion - (org-back-to-heading t) - ;; Filter out Beamer-related tags and install environment tag. - (let ((tags (org-remove-if (lambda (x) (string-match "^B_" x)) - (org-get-tags))) - (env-tag (and (org-string-nw-p value) (concat "B_" value)))) - (org-set-tags-to (if env-tag (cons env-tag tags) tags)) - (when env-tag (org-toggle-tag env-tag 'on))))) - ((equal property "BEAMER_col") - (org-toggle-tag "BMCOL" (if (org-string-nw-p value) 'on 'off))))) - -(add-hook 'org-property-changed-functions 'org-beamer-property-changed) - -(defun org-beamer-allowed-property-values (property) - "Supply allowed values for PROPERTY." - (cond - ((and (equal property "BEAMER_env") - (not (org-entry-get nil (concat property "_ALL") 'inherit))) - ;; If no allowed values for BEAMER_env have been defined, - ;; supply all defined environments - (mapcar 'car (append org-beamer-environments-special - org-beamer-environments-extra - org-beamer-environments-default))) - ((and (equal property "BEAMER_col") - (not (org-entry-get nil (concat property "_ALL") 'inherit))) - ;; If no allowed values for BEAMER_col have been defined, - ;; supply some - (org-split-string org-beamer-column-widths " ")))) - -(add-hook 'org-property-allowed-value-functions - 'org-beamer-allowed-property-values) - - - -;;; Commands - -;;;###autoload -(defun org-beamer-export-as-latex - (&optional async subtreep visible-only body-only ext-plist) - "Export current buffer as a Beamer buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should be accessible -through the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Export is done in a buffer named \"*Org BEAMER Export*\", which -will be displayed when `org-export-show-temporary-export-buffer' -is non-nil." - (interactive) - (org-export-to-buffer 'beamer "*Org BEAMER Export*" - async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) - -;;;###autoload -(defun org-beamer-export-to-latex - (&optional async subtreep visible-only body-only ext-plist) - "Export current buffer as a Beamer presentation (tex). - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return output file's name." - (interactive) - (let ((file (org-export-output-file-name ".tex" subtreep))) - (org-export-to-file 'beamer file - async subtreep visible-only body-only ext-plist))) - -;;;###autoload -(defun org-beamer-export-to-pdf - (&optional async subtreep visible-only body-only ext-plist) - "Export current buffer as a Beamer presentation (PDF). - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return PDF file's name." - (interactive) - (let ((file (org-export-output-file-name ".tex" subtreep))) - (org-export-to-file 'beamer file - async subtreep visible-only body-only ext-plist - (lambda (file) (org-latex-compile file))))) - -;;;###autoload -(defun org-beamer-select-environment () - "Select the environment to be used by beamer for this entry. -While this uses (for convenience) a tag selection interface, the -result of this command will be that the BEAMER_env *property* of -the entry is set. - -In addition to this, the command will also set a tag as a visual -aid, but the tag does not have any semantic meaning." - (interactive) - ;; Make sure `org-beamer-environments-special' has a higher - ;; priority than `org-beamer-environments-extra'. - (let* ((envs (append org-beamer-environments-special - org-beamer-environments-extra - org-beamer-environments-default)) - (org-tag-alist - (append '((:startgroup)) - (mapcar (lambda (e) (cons (concat "B_" (car e)) - (string-to-char (nth 1 e)))) - envs) - '((:endgroup)) - '(("BMCOL" . ?|)))) - (org-fast-tag-selection-single-key t)) - (org-set-tags) - (let ((tags (or (ignore-errors (org-get-tags-string)) ""))) - (cond - ;; For a column, automatically ask for its width. - ((eq org-last-tag-selection-key ?|) - (if (string-match ":BMCOL:" tags) - (org-set-property "BEAMER_col" (read-string "Column width: ")) - (org-delete-property "BEAMER_col"))) - ;; For an "againframe" section, automatically ask for reference - ;; to resumed frame and overlay specifications. - ((eq org-last-tag-selection-key ?A) - (if (equal (org-entry-get nil "BEAMER_env") "againframe") - (progn (org-entry-delete nil "BEAMER_env") - (org-entry-delete nil "BEAMER_ref") - (org-entry-delete nil "BEAMER_act")) - (org-entry-put nil "BEAMER_env" "againframe") - (org-set-property - "BEAMER_ref" - (read-string "Frame reference (*Title, #custom-id, id:...): ")) - (org-set-property "BEAMER_act" - (read-string "Overlay specification: ")))) - ((string-match (concat ":B_\\(" (mapconcat 'car envs "\\|") "\\):") tags) - (org-entry-put nil "BEAMER_env" (match-string 1 tags))) - (t (org-entry-delete nil "BEAMER_env")))))) - -;;;###autoload -(defun org-beamer-insert-options-template (&optional kind) - "Insert a settings template, to make sure users do this right." - (interactive (progn - (message "Current [s]ubtree or [g]lobal?") - (if (eq (read-char-exclusive) ?g) (list 'global) - (list 'subtree)))) - (if (eq kind 'subtree) - (progn - (org-back-to-heading t) - (org-reveal) - (org-entry-put nil "EXPORT_LaTeX_CLASS" "beamer") - (org-entry-put nil "EXPORT_LaTeX_CLASS_OPTIONS" "[presentation]") - (org-entry-put nil "EXPORT_FILE_NAME" "presentation.pdf") - (when org-beamer-column-view-format - (org-entry-put nil "COLUMNS" org-beamer-column-view-format)) - (org-entry-put nil "BEAMER_col_ALL" org-beamer-column-widths)) - (insert "#+LaTeX_CLASS: beamer\n") - (insert "#+LaTeX_CLASS_OPTIONS: [presentation]\n") - (when org-beamer-theme (insert "#+BEAMER_THEME: " org-beamer-theme "\n")) - (when org-beamer-column-view-format - (insert "#+COLUMNS: " org-beamer-column-view-format "\n")) - (insert "#+PROPERTY: BEAMER_col_ALL " org-beamer-column-widths "\n"))) - -;;;###autoload -(defun org-beamer-publish-to-latex (plist filename pub-dir) - "Publish an Org file to a Beamer presentation (LaTeX). - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (org-publish-org-to 'beamer filename ".tex" plist pub-dir)) - -;;;###autoload -(defun org-beamer-publish-to-pdf (plist filename pub-dir) - "Publish an Org file to a Beamer presentation (PDF, via LaTeX). - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - ;; Unlike to `org-beamer-publish-to-latex', PDF file is generated in - ;; working directory and then moved to publishing directory. - (org-publish-attachment - plist - (org-latex-compile (org-publish-org-to 'beamer filename ".tex" plist)) - pub-dir)) - - -(provide 'ox-beamer) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ox-beamer.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ox-html.el b/xemacs-packages/lisp/org-8.2.3c/ox-html.el deleted file mode 100644 index 5f387915..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ox-html.el +++ /dev/null @@ -1,3438 +0,0 @@ -;;; ox-html.el --- HTML Back-End for Org Export Engine - -;; Copyright (C) 2011-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik <carsten at orgmode dot org> -;; Jambunathan K <kjambunathan at gmail dot com> -;; Keywords: outlines, hypermedia, calendar, wp - -;; 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: - -;; This library implements a HTML back-end for Org generic exporter. -;; See Org manual for more information. - -;;; Code: - -;;; Dependencies - -(require 'ox) -(require 'ox-publish) -(require 'format-spec) -(eval-when-compile (require 'cl) (require 'table nil 'noerror)) - - -;;; Function Declarations - -(declare-function org-id-find-id-file "org-id" (id)) -(declare-function htmlize-region "ext:htmlize" (beg end)) -(declare-function org-pop-to-buffer-same-window - "org-compat" (&optional buffer-or-name norecord label)) -(declare-function mm-url-decode-entities "mm-url" ()) - -;;; Define Back-End - -(org-export-define-backend 'html - '((bold . org-html-bold) - (center-block . org-html-center-block) - (clock . org-html-clock) - (code . org-html-code) - (drawer . org-html-drawer) - (dynamic-block . org-html-dynamic-block) - (entity . org-html-entity) - (example-block . org-html-example-block) - (export-block . org-html-export-block) - (export-snippet . org-html-export-snippet) - (fixed-width . org-html-fixed-width) - (footnote-definition . org-html-footnote-definition) - (footnote-reference . org-html-footnote-reference) - (headline . org-html-headline) - (horizontal-rule . org-html-horizontal-rule) - (inline-src-block . org-html-inline-src-block) - (inlinetask . org-html-inlinetask) - (inner-template . org-html-inner-template) - (italic . org-html-italic) - (item . org-html-item) - (keyword . org-html-keyword) - (latex-environment . org-html-latex-environment) - (latex-fragment . org-html-latex-fragment) - (line-break . org-html-line-break) - (link . org-html-link) - (paragraph . org-html-paragraph) - (plain-list . org-html-plain-list) - (plain-text . org-html-plain-text) - (planning . org-html-planning) - (property-drawer . org-html-property-drawer) - (quote-block . org-html-quote-block) - (quote-section . org-html-quote-section) - (radio-target . org-html-radio-target) - (section . org-html-section) - (special-block . org-html-special-block) - (src-block . org-html-src-block) - (statistics-cookie . org-html-statistics-cookie) - (strike-through . org-html-strike-through) - (subscript . org-html-subscript) - (superscript . org-html-superscript) - (table . org-html-table) - (table-cell . org-html-table-cell) - (table-row . org-html-table-row) - (target . org-html-target) - (template . org-html-template) - (timestamp . org-html-timestamp) - (underline . org-html-underline) - (verbatim . org-html-verbatim) - (verse-block . org-html-verse-block)) - :export-block "HTML" - :filters-alist '((:filter-options . org-html-infojs-install-script) - (:filter-final-output . org-html-final-function)) - :menu-entry - '(?h "Export to HTML" - ((?H "As HTML buffer" org-html-export-as-html) - (?h "As HTML file" org-html-export-to-html) - (?o "As HTML file and open" - (lambda (a s v b) - (if a (org-html-export-to-html t s v b) - (org-open-file (org-html-export-to-html nil s v b))))))) - :options-alist - '((:html-extension nil nil org-html-extension) - (:html-link-org-as-html nil nil org-html-link-org-files-as-html) - (:html-doctype "HTML_DOCTYPE" nil org-html-doctype) - (:html-container "HTML_CONTAINER" nil org-html-container-element) - (:html-html5-fancy nil "html5-fancy" org-html-html5-fancy) - (:html-link-use-abs-url nil "html-link-use-abs-url" org-html-link-use-abs-url) - (:html-link-home "HTML_LINK_HOME" nil org-html-link-home) - (:html-link-up "HTML_LINK_UP" nil org-html-link-up) - (:html-mathjax "HTML_MATHJAX" nil "" space) - (:html-postamble nil "html-postamble" org-html-postamble) - (:html-preamble nil "html-preamble" org-html-preamble) - (:html-head "HTML_HEAD" nil org-html-head newline) - (:html-head-extra "HTML_HEAD_EXTRA" nil org-html-head-extra newline) - (:html-head-include-default-style nil "html-style" org-html-head-include-default-style) - (:html-head-include-scripts nil "html-scripts" org-html-head-include-scripts) - (:html-table-attributes nil nil org-html-table-default-attributes) - (:html-table-row-tags nil nil org-html-table-row-tags) - (:html-xml-declaration nil nil org-html-xml-declaration) - (:html-inline-images nil nil org-html-inline-images) - (:infojs-opt "INFOJS_OPT" nil nil) - ;; Redefine regular options. - (:creator "CREATOR" nil org-html-creator-string) - (:with-latex nil "tex" org-html-with-latex))) - - -;;; Internal Variables - -(defvar org-html-format-table-no-css) -(defvar htmlize-buffer-places) ; from htmlize.el - -(defvar org-html--pre/postamble-class "status" - "CSS class used for pre/postamble") - -(defconst org-html-doctype-alist - '(("html4-strict" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01//EN\" -\"http://www.w3.org/TR/html4/strict.dtd\">") - ("html4-transitional" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" -\"http://www.w3.org/TR/html4/loose.dtd\">") - ("html4-frameset" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\" -\"http://www.w3.org/TR/html4/frameset.dtd\">") - - ("xhtml-strict" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" -\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">") - ("xhtml-transitional" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Transitional//EN\" -\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd\">") - ("xhtml-framset" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Frameset//EN\" -\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd\">") - ("xhtml-11" . "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.1//EN\" -\"http://www.w3.org/TR/xhtml1/DTD/xhtml11.dtd\">") - - ("html5" . "<!DOCTYPE html>") - ("xhtml5" . "<!DOCTYPE html>")) - "An alist mapping (x)html flavors to specific doctypes.") - -(defconst org-html-html5-elements - '("article" "aside" "audio" "canvas" "details" "figcaption" - "figure" "footer" "header" "menu" "meter" "nav" "output" - "progress" "section" "video") - "New elements in html5. - -<hgroup> is not included because it's currently impossible to -wrap special blocks around multiple headlines. For other blocks -that should contain headlines, use the HTML_CONTAINER property on -the headline itself.") - -(defconst org-html-special-string-regexps - '(("\\\\-" . "­") ; shy - ("---\\([^-]\\)" . "—\\1") ; mdash - ("--\\([^-]\\)" . "–\\1") ; ndash - ("\\.\\.\\." . "…")) ; hellip - "Regular expressions for special string conversion.") - -(defconst org-html-scripts - "<script type=\"text/javascript\"> -/* -@licstart The following is the entire license notice for the -JavaScript code in this tag. - -Copyright (C) 2012-2013 Free Software Foundation, Inc. - -The JavaScript code in this tag is free software: you can -redistribute it and/or modify it under the terms of the GNU -General Public License (GNU GPL) as published by the Free Software -Foundation, either version 3 of the License, or (at your option) -any later version. The code is distributed WITHOUT ANY WARRANTY; -without even the implied warranty of MERCHANTABILITY or FITNESS -FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. - -As additional permission under GNU GPL version 3 section 7, you -may distribute non-source (e.g., minimized or compacted) forms of -that code without the copy of the GNU GPL normally required by -section 4, provided you include this license notice and a URL -through which recipients can access the Corresponding Source. - - -@licend The above is the entire license notice -for the JavaScript code in this tag. -*/ -<!--/*--><![CDATA[/*><!--*/ - function CodeHighlightOn(elem, id) - { - var target = document.getElementById(id); - if(null != target) { - elem.cacheClassElem = elem.className; - elem.cacheClassTarget = target.className; - target.className = \"code-highlighted\"; - elem.className = \"code-highlighted\"; - } - } - function CodeHighlightOff(elem, id) - { - var target = document.getElementById(id); - if(elem.cacheClassElem) - elem.className = elem.cacheClassElem; - if(elem.cacheClassTarget) - target.className = elem.cacheClassTarget; - } -/*]]>*///--> -</script>" - "Basic JavaScript that is needed by HTML files produced by Org mode.") - -(defconst org-html-style-default - "<style type=\"text/css\"> - <!--/*--><![CDATA[/*><!--*/ - .title { text-align: center; } - .todo { font-family: monospace; color: red; } - .done { color: green; } - .tag { background-color: #eee; font-family: monospace; - padding: 2px; font-size: 80%; font-weight: normal; } - .timestamp { color: #bebebe; } - .timestamp-kwd { color: #5f9ea0; } - .right { margin-left: auto; margin-right: 0px; text-align: right; } - .left { margin-left: 0px; margin-right: auto; text-align: left; } - .center { margin-left: auto; margin-right: auto; text-align: center; } - .underline { text-decoration: underline; } - #postamble p, #preamble p { font-size: 90%; margin: .2em; } - p.verse { margin-left: 3%; } - pre { - border: 1px solid #ccc; - box-shadow: 3px 3px 3px #eee; - padding: 8pt; - font-family: monospace; - overflow: auto; - margin: 1.2em; - } - pre.src { - position: relative; - overflow: visible; - padding-top: 1.2em; - } - pre.src:before { - display: none; - position: absolute; - background-color: white; - top: -10px; - right: 10px; - padding: 3px; - border: 1px solid black; - } - pre.src:hover:before { display: inline;} - pre.src-sh:before { content: 'sh'; } - pre.src-bash:before { content: 'sh'; } - pre.src-emacs-lisp:before { content: 'Emacs Lisp'; } - pre.src-R:before { content: 'R'; } - pre.src-perl:before { content: 'Perl'; } - pre.src-java:before { content: 'Java'; } - pre.src-sql:before { content: 'SQL'; } - - table { border-collapse:collapse; } - td, th { vertical-align:top; } - th.right { text-align: center; } - th.left { text-align: center; } - th.center { text-align: center; } - td.right { text-align: right; } - td.left { text-align: left; } - td.center { text-align: center; } - dt { font-weight: bold; } - .footpara:nth-child(2) { display: inline; } - .footpara { display: block; } - .footdef { margin-bottom: 1em; } - .figure { padding: 1em; } - .figure p { text-align: center; } - .inlinetask { - padding: 10px; - border: 2px solid gray; - margin: 10px; - background: #ffffcc; - } - #org-div-home-and-up - { text-align: right; font-size: 70%; white-space: nowrap; } - textarea { overflow-x: auto; } - .linenr { font-size: smaller } - .code-highlighted { background-color: #ffff00; } - .org-info-js_info-navigation { border-style: none; } - #org-info-js_console-label - { font-size: 10px; font-weight: bold; white-space: nowrap; } - .org-info-js_search-highlight - { background-color: #ffff00; color: #000000; font-weight: bold; } - /*]]>*/--> -</style>" - "The default style specification for exported HTML files. -You can use `org-html-head' and `org-html-head-extra' to add to -this style. If you don't want to include this default style, -customize `org-html-head-include-default-style'.") - - -;;; User Configuration Variables - -(defgroup org-export-html nil - "Options for exporting Org mode files to HTML." - :tag "Org Export HTML" - :group 'org-export) - -;;;; Handle infojs - -(defvar org-html-infojs-opts-table - '((path PATH "http://orgmode.org/org-info.js") - (view VIEW "info") - (toc TOC :with-toc) - (ftoc FIXED_TOC "0") - (tdepth TOC_DEPTH "max") - (sdepth SECTION_DEPTH "max") - (mouse MOUSE_HINT "underline") - (buttons VIEW_BUTTONS "0") - (ltoc LOCAL_TOC "1") - (up LINK_UP :html-link-up) - (home LINK_HOME :html-link-home)) - "JavaScript options, long form for script, default values.") - -(defcustom org-html-use-infojs 'when-configured - "Non-nil when Sebastian Rose's Java Script org-info.js should be active. -This option can be nil or t to never or always use the script. -It can also be the symbol `when-configured', meaning that the -script will be linked into the export file if and only if there -is a \"#+INFOJS_OPT:\" line in the buffer. See also the variable -`org-html-infojs-options'." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (const :tag "Never" nil) - (const :tag "When configured in buffer" when-configured) - (const :tag "Always" t))) - -(defcustom org-html-infojs-options - (mapcar (lambda (x) (cons (car x) (nth 2 x))) org-html-infojs-opts-table) - "Options settings for the INFOJS JavaScript. -Each of the options must have an entry in `org-html-infojs-opts-table'. -The value can either be a string that will be passed to the script, or -a property. This property is then assumed to be a property that is defined -by the Export/Publishing setup of Org. -The `sdepth' and `tdepth' parameters can also be set to \"max\", which -means to use the maximum value consistent with other options." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type - `(set :greedy t :inline t - ,@(mapcar - (lambda (x) - (list 'cons (list 'const (car x)) - '(choice - (symbol :tag "Publishing/Export property") - (string :tag "Value")))) - org-html-infojs-opts-table))) - -(defcustom org-html-infojs-template - "<script type=\"text/javascript\" src=\"%SCRIPT_PATH\"> -/** - * - * @source: %SCRIPT_PATH - * - * @licstart The following is the entire license notice for the - * JavaScript code in %SCRIPT_PATH. - * - * Copyright (C) 2012-2013 Free Software Foundation, Inc. - * - * - * The JavaScript code in this tag is free software: you can - * redistribute it and/or modify it under the terms of the GNU - * General Public License (GNU GPL) as published by the Free Software - * Foundation, either version 3 of the License, or (at your option) - * any later version. The code is distributed WITHOUT ANY WARRANTY; - * without even the implied warranty of MERCHANTABILITY or FITNESS - * FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. - * - * As additional permission under GNU GPL version 3 section 7, you - * may distribute non-source (e.g., minimized or compacted) forms of - * that code without the copy of the GNU GPL normally required by - * section 4, provided you include this license notice and a URL - * through which recipients can access the Corresponding Source. - * - * @licend The above is the entire license notice - * for the JavaScript code in %SCRIPT_PATH. - * - */ -</script> - -<script type=\"text/javascript\"> - -/* -@licstart The following is the entire license notice for the -JavaScript code in this tag. - -Copyright (C) 2012-2013 Free Software Foundation, Inc. - -The JavaScript code in this tag is free software: you can -redistribute it and/or modify it under the terms of the GNU -General Public License (GNU GPL) as published by the Free Software -Foundation, either version 3 of the License, or (at your option) -any later version. The code is distributed WITHOUT ANY WARRANTY; -without even the implied warranty of MERCHANTABILITY or FITNESS -FOR A PARTICULAR PURPOSE. See the GNU GPL for more details. - -As additional permission under GNU GPL version 3 section 7, you -may distribute non-source (e.g., minimized or compacted) forms of -that code without the copy of the GNU GPL normally required by -section 4, provided you include this license notice and a URL -through which recipients can access the Corresponding Source. - - -@licend The above is the entire license notice -for the JavaScript code in this tag. -*/ - -<!--/*--><![CDATA[/*><!--*/ -%MANAGER_OPTIONS -org_html_manager.setup(); // activate after the parameters are set -/*]]>*///--> -</script>" - "The template for the export style additions when org-info.js is used. -Option settings will replace the %MANAGER-OPTIONS cookie." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defun org-html-infojs-install-script (exp-plist backend) - "Install script in export options when appropriate. -EXP-PLIST is a plist containing export options. BACKEND is the -export back-end currently used." - (unless (or (memq 'body-only (plist-get exp-plist :export-options)) - (not org-html-use-infojs) - (and (eq org-html-use-infojs 'when-configured) - (or (not (plist-get exp-plist :infojs-opt)) - (string-match "\\<view:nil\\>" - (plist-get exp-plist :infojs-opt))))) - (let* ((template org-html-infojs-template) - (ptoc (plist-get exp-plist :with-toc)) - (hlevels (plist-get exp-plist :headline-levels)) - (sdepth hlevels) - (tdepth (if (integerp ptoc) (min ptoc hlevels) hlevels)) - (options (plist-get exp-plist :infojs-opt)) - (table org-html-infojs-opts-table) - style) - (dolist (entry table) - (let* ((opt (car entry)) - (var (nth 1 entry)) - ;; Compute default values for script option OPT from - ;; `org-html-infojs-options' variable. - (default - (let ((default (cdr (assq opt org-html-infojs-options)))) - (if (and (symbolp default) (not (memq default '(t nil)))) - (plist-get exp-plist default) - default))) - ;; Value set through INFOJS_OPT keyword has precedence - ;; over the default one. - (val (if (and options - (string-match (format "\\<%s:\\(\\S-+\\)" opt) - options)) - (match-string 1 options) - default))) - (case opt - (path (setq template - (replace-regexp-in-string - "%SCRIPT_PATH" val template t t))) - (sdepth (when (integerp (read val)) - (setq sdepth (min (read val) sdepth)))) - (tdepth (when (integerp (read val)) - (setq tdepth (min (read val) tdepth)))) - (otherwise (setq val - (cond - ((or (eq val t) (equal val "t")) "1") - ((or (eq val nil) (equal val "nil")) "0") - ((stringp val) val) - (t (format "%s" val)))) - (push (cons var val) style))))) - ;; Now we set the depth of the *generated* TOC to SDEPTH, - ;; because the toc will actually determine the splitting. How - ;; much of the toc will actually be displayed is governed by the - ;; TDEPTH option. - (setq exp-plist (plist-put exp-plist :with-toc sdepth)) - ;; The table of contents should not show more sections than we - ;; generate. - (setq tdepth (min tdepth sdepth)) - (push (cons "TOC_DEPTH" tdepth) style) - ;; Build style string. - (setq style (mapconcat - (lambda (x) (format "org_html_manager.set(\"%s\", \"%s\");" - (car x) - (cdr x))) - style "\n")) - (when (and style (> (length style) 0)) - (and (string-match "%MANAGER_OPTIONS" template) - (setq style (replace-match style t t template)) - (setq exp-plist - (plist-put - exp-plist :html-head-extra - (concat (or (plist-get exp-plist :html-head-extra) "") - "\n" - style))))) - ;; This script absolutely needs the table of contents, so we - ;; change that setting. - (unless (plist-get exp-plist :with-toc) - (setq exp-plist (plist-put exp-plist :with-toc t))) - ;; Return the modified property list. - exp-plist))) - -;;;; Bold, etc. - -(defcustom org-html-text-markup-alist - '((bold . "<b>%s</b>") - (code . "<code>%s</code>") - (italic . "<i>%s</i>") - (strike-through . "<del>%s</del>") - (underline . "<span class=\"underline\">%s</span>") - (verbatim . "<code>%s</code>")) - "Alist of HTML expressions to convert text markup. - -The key must be a symbol among `bold', `code', `italic', -`strike-through', `underline' and `verbatim'. The value is -a formatting string to wrap fontified text with. - -If no association can be found for a given markup, text will be -returned as-is." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type '(alist :key-type (symbol :tag "Markup type") - :value-type (string :tag "Format string")) - :options '(bold code italic strike-through underline verbatim)) - -(defcustom org-html-indent nil - "Non-nil means to indent the generated HTML. -Warning: non-nil may break indentation of source code blocks." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-html-use-unicode-chars nil - "Non-nil means to use unicode characters instead of HTML entities." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -;;;; Drawers - -(defcustom org-html-format-drawer-function - (lambda (name contents) contents) - "Function called to format a drawer in HTML code. - -The function must accept two parameters: - NAME the drawer name, like \"LOGBOOK\" - CONTENTS the contents of the drawer. - -The function should return the string to be exported. - -For example, the variable could be set to the following function -in order to mimic default behaviour: - -The default value simply returns the value of CONTENTS." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'function) - -;;;; Footnotes - -(defcustom org-html-footnotes-section "<div id=\"footnotes\"> -<h2 class=\"footnotes\">%s: </h2> -<div id=\"text-footnotes\"> -%s -</div> -</div>" - "Format for the footnotes section. -Should contain a two instances of %s. The first will be replaced with the -language-specific word for \"Footnotes\", the second one will be replaced -by the footnotes themselves." - :group 'org-export-html - :type 'string) - -(defcustom org-html-footnote-format "<sup>%s</sup>" - "The format for the footnote reference. -%s will be replaced by the footnote reference itself." - :group 'org-export-html - :type 'string) - -(defcustom org-html-footnote-separator "<sup>, </sup>" - "Text used to separate footnotes." - :group 'org-export-html - :type 'string) - -;;;; Headline - -(defcustom org-html-toplevel-hlevel 2 - "The <H> level for level 1 headings in HTML export. -This is also important for the classes that will be wrapped around headlines -and outline structure. If this variable is 1, the top-level headlines will -be <h1>, and the corresponding classes will be outline-1, section-number-1, -and outline-text-1. If this is 2, all of these will get a 2 instead. -The default for this variable is 2, because we use <h1> for formatting the -document title." - :group 'org-export-html - :type 'integer) - -(defcustom org-html-format-headline-function 'ignore - "Function to format headline text. - -This function will be called with 5 arguments: -TODO the todo keyword (string or nil). -TODO-TYPE the type of todo (symbol: `todo', `done', nil) -PRIORITY the priority of the headline (integer or nil) -TEXT the main headline text (string). -TAGS the tags (string or nil). - -The function result will be used in the section format string." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'function) - -;;;; HTML-specific - -(defcustom org-html-allow-name-attribute-in-anchors t - "When nil, do not set \"name\" attribute in anchors. -By default, anchors are formatted with both \"id\" and \"name\" -attributes, when appropriate." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -;;;; Inlinetasks - -(defcustom org-html-format-inlinetask-function 'ignore - "Function called to format an inlinetask in HTML code. - -The function must accept six parameters: - TODO the todo keyword, as a string - TODO-TYPE the todo type, a symbol among `todo', `done' and nil. - PRIORITY the inlinetask priority, as a string - NAME the inlinetask name, as a string. - TAGS the inlinetask tags, as a list of strings. - CONTENTS the contents of the inlinetask, as a string. - -The function should return the string to be exported." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'function) - -;;;; LaTeX - -(defcustom org-html-with-latex org-export-with-latex - "Non-nil means process LaTeX math snippets. - -When set, the exporter will process LaTeX environments and -fragments. - -This option can also be set with the +OPTIONS line, -e.g. \"tex:mathjax\". Allowed values are: - -nil Ignore math snippets. -`verbatim' Keep everything in verbatim -`dvipng' Process the LaTeX fragments to images. This will also - include processing of non-math environments. -`imagemagick' Convert the LaTeX fragments to pdf files and use - imagemagick to convert pdf files to png files. -`mathjax' Do MathJax preprocessing and arrange for MathJax.js to - be loaded. -t Synonym for `mathjax'." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (const :tag "Do not process math in any way" nil) - (const :tag "Use dvipng to make images" dvipng) - (const :tag "Use imagemagick to make images" imagemagick) - (const :tag "Use MathJax to display math" mathjax) - (const :tag "Leave math verbatim" verbatim))) - -;;;; Links :: Generic - -(defcustom org-html-link-org-files-as-html t - "Non-nil means make file links to `file.org' point to `file.html'. -When `org-mode' is exporting an `org-mode' file to HTML, links to -non-html files are directly put into a href tag in HTML. -However, links to other Org-mode files (recognized by the -extension `.org.) should become links to the corresponding html -file, assuming that the linked `org-mode' file will also be -converted to HTML. -When nil, the links still point to the plain `.org' file." - :group 'org-export-html - :type 'boolean) - -;;;; Links :: Inline images - -(defcustom org-html-inline-images t - "Non-nil means inline images into exported HTML pages. -This is done using an <img> tag. When nil, an anchor with href is used to -link to the image." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.1") - :type 'boolean) - -(defcustom org-html-inline-image-rules - '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") - ("http" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'") - ("https" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")) - "Rules characterizing image files that can be inlined into HTML. -A rule consists in an association whose key is the type of link -to consider, and value is a regexp that will be matched against -link's path." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type '(alist :key-type (string :tag "Type") - :value-type (regexp :tag "Path"))) - -;;;; Plain Text - -(defcustom org-html-protect-char-alist - '(("&" . "&") - ("<" . "<") - (">" . ">")) - "Alist of characters to be converted by `org-html-protect'." - :group 'org-export-html - :type '(repeat (cons (string :tag "Character") - (string :tag "HTML equivalent")))) - -;;;; Src Block - -(defcustom org-html-htmlize-output-type 'inline-css - "Output type to be used by htmlize when formatting code snippets. -Choices are `css', to export the CSS selectors only, or `inline-css', to -export the CSS attribute values inline in the HTML. We use as default -`inline-css', in order to make the resulting HTML self-containing. - -However, this will fail when using Emacs in batch mode for export, because -then no rich font definitions are in place. It will also not be good if -people with different Emacs setup contribute HTML files to a website, -because the fonts will represent the individual setups. In these cases, -it is much better to let Org/Htmlize assign classes only, and to use -a style file to define the look of these classes. -To get a start for your css file, start Emacs session and make sure that -all the faces you are interested in are defined, for example by loading files -in all modes you want. Then, use the command -\\[org-html-htmlize-generate-css] to extract class definitions." - :group 'org-export-html - :type '(choice (const css) (const inline-css))) - -(defcustom org-html-htmlize-font-prefix "org-" - "The prefix for CSS class names for htmlize font specifications." - :group 'org-export-html - :type 'string) - -;;;; Table - -(defcustom org-html-table-default-attributes - '(:border "2" :cellspacing "0" :cellpadding "6" :rules "groups" :frame "hsides") - "Default attributes and values which will be used in table tags. -This is a plist where attributes are symbols, starting with -colons, and values are strings. - -When exporting to HTML5, these values will be disregarded." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type '(plist :key-type (symbol :tag "Property") - :value-type (string :tag "Value"))) - -(defcustom org-html-table-header-tags '("<th scope=\"%s\"%s>" . "</th>") - "The opening tag for table header fields. -This is customizable so that alignment options can be specified. -The first %s will be filled with the scope of the field, either row or col. -The second %s will be replaced by a style entry to align the field. -See also the variable `org-html-table-use-header-tags-for-first-column'. -See also the variable `org-html-table-align-individual-fields'." - :group 'org-export-html - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-html-table-data-tags '("<td%s>" . "</td>") - "The opening tag for table data fields. -This is customizable so that alignment options can be specified. -The first %s will be filled with the scope of the field, either row or col. -The second %s will be replaced by a style entry to align the field. -See also the variable `org-html-table-align-individual-fields'." - :group 'org-export-html - :type '(cons (string :tag "Opening tag") (string :tag "Closing tag"))) - -(defcustom org-html-table-row-tags '("<tr>" . "</tr>") - "The opening and ending tags for table rows. -This is customizable so that alignment options can be specified. -Instead of strings, these can be Lisp forms that will be -evaluated for each row in order to construct the table row tags. - -During evaluation, these variables will be dynamically bound so that -you can reuse them: - - `row-number': row number (0 is the first row) - `rowgroup-number': group number of current row - `start-rowgroup-p': non-nil means the row starts a group - `end-rowgroup-p': non-nil means the row ends a group - `top-row-p': non-nil means this is the top row - `bottom-row-p': non-nil means this is the bottom row - -For example: - -\(setq org-html-table-row-tags - (cons '(cond (top-row-p \"<tr class=\\\"tr-top\\\">\") - (bottom-row-p \"<tr class=\\\"tr-bottom\\\">\") - (t (if (= (mod row-number 2) 1) - \"<tr class=\\\"tr-odd\\\">\" - \"<tr class=\\\"tr-even\\\">\"))) - \"</tr>\")) - -will use the \"tr-top\" and \"tr-bottom\" classes for the top row -and the bottom row, and otherwise alternate between \"tr-odd\" and -\"tr-even\" for odd and even rows." - :group 'org-export-html - :type '(cons - (choice :tag "Opening tag" - (string :tag "Specify") - (sexp)) - (choice :tag "Closing tag" - (string :tag "Specify") - (sexp)))) - -(defcustom org-html-table-align-individual-fields t - "Non-nil means attach style attributes for alignment to each table field. -When nil, alignment will only be specified in the column tags, but this -is ignored by some browsers (like Firefox, Safari). Opera does it right -though." - :group 'org-export-html - :type 'boolean) - -(defcustom org-html-table-use-header-tags-for-first-column nil - "Non-nil means format column one in tables with header tags. -When nil, also column one will use data tags." - :group 'org-export-html - :type 'boolean) - -(defcustom org-html-table-caption-above t - "When non-nil, place caption string at the beginning of the table. -Otherwise, place it near the end." - :group 'org-export-html - :type 'boolean) - -;;;; Tags - -(defcustom org-html-tag-class-prefix "" - "Prefix to class names for TODO keywords. -Each tag gets a class given by the tag itself, with this prefix. -The default prefix is empty because it is nice to just use the keyword -as a class name. But if you get into conflicts with other, existing -CSS classes, then this prefix can be very useful." - :group 'org-export-html - :type 'string) - -;;;; Template :: Generic - -(defcustom org-html-extension "html" - "The extension for exported HTML files." - :group 'org-export-html - :type 'string) - -(defcustom org-html-xml-declaration - '(("html" . "<?xml version=\"1.0\" encoding=\"%s\"?>") - ("php" . "<?php echo \"<?xml version=\\\"1.0\\\" encoding=\\\"%s\\\" ?>\"; ?>")) - "The extension for exported HTML files. -%s will be replaced with the charset of the exported file. -This may be a string, or an alist with export extensions -and corresponding declarations. - -This declaration only applies when exporting to XHTML." - :group 'org-export-html - :type '(choice - (string :tag "Single declaration") - (repeat :tag "Dependent on extension" - (cons (string :tag "Extension") - (string :tag "Declaration"))))) - -(defcustom org-html-coding-system 'utf-8 - "Coding system for HTML export. -Use utf-8 as the default value." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'coding-system) - -(defcustom org-html-doctype "xhtml-strict" - "Document type definition to use for exported HTML files. -Can be set with the in-buffer HTML_DOCTYPE property or for -publishing, with :html-doctype." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defcustom org-html-html5-fancy nil - "Non-nil means using new HTML5 elements. -This variable is ignored for anything other than HTML5 export. - -For compatibility with Internet Explorer, it's probably a good -idea to download some form of the html5shiv (for instance -https://code.google.com/p/html5shiv/) and add it to your -HTML_HEAD_EXTRA, so that your pages don't break for users of IE -versions 8 and below." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-html-container-element "div" - "HTML element to use for wrapping top level sections. -Can be set with the in-buffer HTML_CONTAINER property or for -publishing, with :html-container. - -Note that changing the default will prevent you from using -org-info.js for your website." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defcustom org-html-divs - '((preamble "div" "preamble") - (content "div" "content") - (postamble "div" "postamble")) - "Alist of the three section elements for HTML export. -The car of each entry is one of 'preamble, 'content or 'postamble. -The cdrs of each entry are the ELEMENT_TYPE and ID for each -section of the exported document. - -Note that changing the default will prevent you from using -org-info.js for your website." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type '(list :greedy t - (list :tag "Preamble" - (const :format "" preamble) - (string :tag "element") (string :tag " id")) - (list :tag "Content" - (const :format "" content) - (string :tag "element") (string :tag " id")) - (list :tag "Postamble" (const :format "" postamble) - (string :tag " id") (string :tag "element")))) - -(defcustom org-html-metadata-timestamp-format "%Y-%m-%d %a %H:%M" - "Format used for timestamps in preamble, postamble and metadata. -See `format-time-string' for more information on its components." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -;;;; Template :: Mathjax - -(defcustom org-html-mathjax-options - '((path "http://orgmode.org/mathjax/MathJax.js") - (scale "100") - (align "center") - (indent "2em") - (mathml nil)) - "Options for MathJax setup. - -path The path where to find MathJax -scale Scaling for the HTML-CSS backend, usually between 100 and 133 -align How to align display math: left, center, or right -indent If align is not center, how far from the left/right side? -mathml Should a MathML player be used if available? - This is faster and reduces bandwidth use, but currently - sometimes has lower spacing quality. Therefore, the default is - nil. When browsers get better, this switch can be flipped. - -You can also customize this for each buffer, using something like - -#+MATHJAX: scale:\"133\" align:\"right\" mathml:t path:\"/MathJax/\"" - :group 'org-export-html - :type '(list :greedy t - (list :tag "path (the path from where to load MathJax.js)" - (const :format " " path) (string)) - (list :tag "scale (scaling for the displayed math)" - (const :format " " scale) (string)) - (list :tag "align (alignment of displayed equations)" - (const :format " " align) (string)) - (list :tag "indent (indentation with left or right alignment)" - (const :format " " indent) (string)) - (list :tag "mathml (should MathML display be used is possible)" - (const :format " " mathml) (boolean)))) - -(defcustom org-html-mathjax-template - "<script type=\"text/javascript\" src=\"%PATH\"></script> -<script type=\"text/javascript\"> -<!--/*--><![CDATA[/*><!--*/ - MathJax.Hub.Config({ - // Only one of the two following lines, depending on user settings - // First allows browser-native MathML display, second forces HTML/CSS - :MMLYES: config: [\"MMLorHTML.js\"], jax: [\"input/TeX\"], - :MMLNO: jax: [\"input/TeX\", \"output/HTML-CSS\"], - extensions: [\"tex2jax.js\",\"TeX/AMSmath.js\",\"TeX/AMSsymbols.js\", - \"TeX/noUndefined.js\"], - tex2jax: { - inlineMath: [ [\"\\\\(\",\"\\\\)\"] ], - displayMath: [ ['$$','$$'], [\"\\\\[\",\"\\\\]\"], [\"\\\\begin{displaymath}\",\"\\\\end{displaymath}\"] ], - skipTags: [\"script\",\"noscript\",\"style\",\"textarea\",\"pre\",\"code\"], - ignoreClass: \"tex2jax_ignore\", - processEscapes: false, - processEnvironments: true, - preview: \"TeX\" - }, - showProcessingMessages: true, - displayAlign: \"%ALIGN\", - displayIndent: \"%INDENT\", - - \"HTML-CSS\": { - scale: %SCALE, - availableFonts: [\"STIX\",\"TeX\"], - preferredFont: \"TeX\", - webFont: \"TeX\", - imageFont: \"TeX\", - showMathMenu: true, - }, - MMLorHTML: { - prefer: { - MSIE: \"MML\", - Firefox: \"MML\", - Opera: \"HTML\", - other: \"HTML\" - } - } - }); -/*]]>*///--> -</script>" - "The MathJax setup for XHTML files." - :group 'org-export-html - :type 'string) - -;;;; Template :: Postamble - -(defcustom org-html-postamble 'auto - "Non-nil means insert a postamble in HTML export. - -When set to 'auto, check against the -`org-export-with-author/email/creator/date' variables to set the -content of the postamble. When set to a string, use this string -as the postamble. When t, insert a string as defined by the -formatting string in `org-html-postamble-format'. - -When set to a function, apply this function and insert the -returned string. The function takes the property list of export -options as its only argument. - -Setting :html-postamble in publishing projects will take -precedence over this variable." - :group 'org-export-html - :type '(choice (const :tag "No postamble" nil) - (const :tag "Auto postamble" auto) - (const :tag "Default formatting string" t) - (string :tag "Custom formatting string") - (function :tag "Function (must return a string)"))) - -(defcustom org-html-postamble-format - '(("en" "<p class=\"author\">Author: %a (%e)</p> -<p class=\"date\">Date: %d</p> -<p class=\"creator\">%c</p> -<p class=\"validation\">%v</p>")) - "Alist of languages and format strings for the HTML postamble. - -The first element of each list is the language code, as used for -the LANGUAGE keyword. See `org-export-default-language'. - -The second element of each list is a format string to format the -postamble itself. This format string can contain these elements: - - %t stands for the title. - %a stands for the author's name. - %e stands for the author's email. - %d stands for the date. - %c will be replaced by `org-html-creator-string'. - %v will be replaced by `org-html-validation-link'. - %T will be replaced by the export time. - %C will be replaced by the last modification time. - -If you need to use a \"%\" character, you need to escape it -like that: \"%%\"." - :group 'org-export-html - :type '(repeat - (list (string :tag "Language") - (string :tag "Format string")))) - -(defcustom org-html-validation-link - "<a href=\"http://validator.w3.org/check?uri=referer\">Validate</a>" - "Link to HTML validation service." - :group 'org-export-html - :type 'string) - -(defcustom org-html-creator-string - (format "<a href=\"http://www.gnu.org/software/emacs/\">Emacs</a> %s (<a href=\"http://orgmode.org\">Org</a> mode %s)" - emacs-version - (if (fboundp 'org-version) (org-version) "unknown version")) - "Information about the creator of the HTML document. -This option can also be set on with the CREATOR keyword." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type '(string :tag "Creator string")) - -;;;; Template :: Preamble - -(defcustom org-html-preamble t - "Non-nil means insert a preamble in HTML export. - -When t, insert a string as defined by the formatting string in -`org-html-preamble-format'. When set to a string, use this -formatting string instead (see `org-html-postamble-format' for an -example of such a formatting string). - -When set to a function, apply this function and insert the -returned string. The function takes the property list of export -options as its only argument. - -Setting :html-preamble in publishing projects will take -precedence over this variable." - :group 'org-export-html - :type '(choice (const :tag "No preamble" nil) - (const :tag "Default preamble" t) - (string :tag "Custom formatting string") - (function :tag "Function (must return a string)"))) - -(defcustom org-html-preamble-format '(("en" "")) - "Alist of languages and format strings for the HTML preamble. - -The first element of each list is the language code, as used for -the LANGUAGE keyword. See `org-export-default-language'. - -The second element of each list is a format string to format the -preamble itself. This format string can contain these elements: - - %t stands for the title. - %a stands for the author's name. - %e stands for the author's email. - %d stands for the date. - %c will be replaced by `org-html-creator-string'. - %v will be replaced by `org-html-validation-link'. - %T will be replaced by the export time. - %C will be replaced by the last modification time. - -If you need to use a \"%\" character, you need to escape it -like that: \"%%\". - -See the default value of `org-html-postamble-format' for an -example." - :group 'org-export-html - :type '(repeat - (list (string :tag "Language") - (string :tag "Format string")))) - -(defcustom org-html-link-up "" - "Where should the \"UP\" link of exported HTML pages lead?" - :group 'org-export-html - :type '(string :tag "File or URL")) - -(defcustom org-html-link-home "" - "Where should the \"HOME\" link of exported HTML pages lead?" - :group 'org-export-html - :type '(string :tag "File or URL")) - -(defcustom org-html-link-use-abs-url nil - "Should we prepend relative links with HTML_LINK_HOME?" - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.1") - :type 'boolean) - -(defcustom org-html-home/up-format - "<div id=\"org-div-home-and-up\"> - <a accesskey=\"h\" href=\"%s\"> UP </a> - | - <a accesskey=\"H\" href=\"%s\"> HOME </a> -</div>" - "Snippet used to insert the HOME and UP links. -This is a format string, the first %s will receive the UP link, -the second the HOME link. If both `org-html-link-up' and -`org-html-link-home' are empty, the entire snippet will be -ignored." - :group 'org-export-html - :type 'string) - -;;;; Template :: Scripts - -(define-obsolete-variable-alias - 'org-html-style-include-scripts 'org-html-head-include-scripts "24.4") -(defcustom org-html-head-include-scripts t - "Non-nil means include the JavaScript snippets in exported HTML files. -The actual script is defined in `org-html-scripts' and should -not be modified." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -;;;; Template :: Styles - -(define-obsolete-variable-alias - 'org-html-style-include-default 'org-html-head-include-default-style "24.4") -(defcustom org-html-head-include-default-style t - "Non-nil means include the default style in exported HTML files. -The actual style is defined in `org-html-style-default' and -should not be modified. Use `org-html-head' to use your own -style information." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) -;;;###autoload -(put 'org-html-head-include-default-style 'safe-local-variable 'booleanp) - -(define-obsolete-variable-alias 'org-html-style 'org-html-head "24.4") -(defcustom org-html-head "" - "Org-wide head definitions for exported HTML files. - -This variable can contain the full HTML structure to provide a -style, including the surrounding HTML tags. You can consider -including definitions for the following classes: title, todo, -done, timestamp, timestamp-kwd, tag, target. - -For example, a valid value would be: - - <style type=\"text/css\"> - <![CDATA[ - p { font-weight: normal; color: gray; } - h1 { color: black; } - .title { text-align: center; } - .todo, .timestamp-kwd { color: red; } - .done { color: green; } - ]]> - </style> - -If you want to refer to an external style, use something like - - <link rel=\"stylesheet\" type=\"text/css\" href=\"mystyles.css\" /> - -As the value of this option simply gets inserted into the HTML -<head> header, you can use it to add any arbitrary text to the -header. - -You can set this on a per-file basis using #+HTML_HEAD:, -or for publication projects using the :html-head property." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) -;;;###autoload -(put 'org-html-head 'safe-local-variable 'stringp) - -(defcustom org-html-head-extra "" - "More head information to add in the HTML output. - -You can set this on a per-file basis using #+HTML_HEAD_EXTRA:, -or for publication projects using the :html-head-extra property." - :group 'org-export-html - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) -;;;###autoload -(put 'org-html-head-extra 'safe-local-variable 'stringp) - -;;;; Todos - -(defcustom org-html-todo-kwd-class-prefix "" - "Prefix to class names for TODO keywords. -Each TODO keyword gets a class given by the keyword itself, with this prefix. -The default prefix is empty because it is nice to just use the keyword -as a class name. But if you get into conflicts with other, existing -CSS classes, then this prefix can be very useful." - :group 'org-export-html - :type 'string) - - -;;; Internal Functions - -(defun org-html-xhtml-p (info) - (let ((dt (downcase (plist-get info :html-doctype)))) - (string-match-p "xhtml" dt))) - -(defun org-html-html5-p (info) - (let ((dt (downcase (plist-get info :html-doctype)))) - (member dt '("html5" "xhtml5" "<!doctype html>")))) - -(defun org-html-close-tag (tag attr info) - (concat "<" tag " " attr - (if (org-html-xhtml-p info) " />" ">"))) - -(defun org-html-doctype (info) - "Return correct html doctype tag from `org-html-doctype-alist', -or the literal value of :html-doctype from INFO if :html-doctype -is not found in the alist. -INFO is a plist used as a communication channel." - (let ((dt (plist-get info :html-doctype))) - (or (cdr (assoc dt org-html-doctype-alist)) dt))) - -(defun org-html--make-attribute-string (attributes) - "Return a list of attributes, as a string. -ATTRIBUTES is a plist where values are either strings or nil. An -attributes with a nil value will be omitted from the result." - (let (output) - (dolist (item attributes (mapconcat 'identity (nreverse output) " ")) - (cond ((null item) (pop output)) - ((symbolp item) (push (substring (symbol-name item) 1) output)) - (t (let ((key (car output)) - (value (replace-regexp-in-string - "\"" """ (org-html-encode-plain-text item)))) - (setcar output (format "%s=\"%s\"" key value)))))))) - -(defun org-html--wrap-image (contents info &optional caption label) - "Wrap CONTENTS string within an appropriate environment for images. -INFO is a plist used as a communication channel. When optional -arguments CAPTION and LABEL are given, use them for caption and -\"id\" attribute." - (let ((html5-fancy (and (org-html-html5-p info) - (plist-get info :html-html5-fancy)))) - (format (if html5-fancy "\n<figure%s>%s%s\n</figure>" - "\n<div%s class=\"figure\">%s%s\n</div>") - ;; ID. - (if (not (org-string-nw-p label)) "" - (format " id=\"%s\"" (org-export-solidify-link-text label))) - ;; Contents. - (format "\n<p>%s</p>" contents) - ;; Caption. - (if (not (org-string-nw-p caption)) "" - (format (if html5-fancy "\n<figcaption>%s</figcaption>" - "\n<p>%s</p>") - caption))))) - -(defun org-html--format-image (source attributes info) - "Return \"img\" tag with given SOURCE and ATTRIBUTES. -SOURCE is a string specifying the location of the image. -ATTRIBUTES is a plist, as returned by -`org-export-read-attribute'. INFO is a plist used as -a communication channel." - (org-html-close-tag - "img" - (org-html--make-attribute-string - (org-combine-plists - (list :src source - :alt (if (string-match-p "^ltxpng/" source) - (org-html-encode-plain-text - (org-find-text-property-in-string 'org-latex-src source)) - (file-name-nondirectory source))) - attributes)) - info)) - -(defun org-html--textarea-block (element) - "Transcode ELEMENT into a textarea block. -ELEMENT is either a src block or an example block." - (let* ((code (car (org-export-unravel-code element))) - (attr (org-export-read-attribute :attr_html element))) - (format "<p>\n<textarea cols=\"%s\" rows=\"%s\">\n%s</textarea>\n</p>" - (or (plist-get attr :width) 80) - (or (plist-get attr :height) (org-count-lines code)) - code))) - -(defun org-html--has-caption-p (element &optional info) - "Non-nil when ELEMENT has a caption affiliated keyword. -INFO is a plist used as a communication channel. This function -is meant to be used as a predicate for `org-export-get-ordinal' or -a value to `org-html-standalone-image-predicate'." - (org-element-property :caption element)) - -;;;; Table - -(defun org-html-htmlize-region-for-paste (beg end) - "Convert the region between BEG and END to HTML, using htmlize.el. -This is much like `htmlize-region-for-paste', only that it uses -the settings define in the org-... variables." - (let* ((htmlize-output-type org-html-htmlize-output-type) - (htmlize-css-name-prefix org-html-htmlize-font-prefix) - (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)))) - -;;;###autoload -(defun org-html-htmlize-generate-css () - "Create the CSS for all font definitions in the current Emacs session. -Use this to create face definitions in your CSS style file that can then -be used by code snippets transformed by htmlize. -This command just produces a buffer that contains class definitions for all -faces used in the current Emacs session. You can copy and paste the ones you -need into your CSS file. - -If you then set `org-html-htmlize-output-type' to `css', calls -to the function `org-html-htmlize-region-for-paste' will -produce code that uses these same face definitions." - (interactive) - (require 'htmlize) - (and (get-buffer "*html*") (kill-buffer "*html*")) - (with-temp-buffer - (let ((fl (face-list)) - (htmlize-css-name-prefix "org-") - (htmlize-output-type 'css) - f i) - (while (setq f (pop fl) - i (and f (face-attribute f :inherit))) - (when (and (symbolp f) (or (not i) (not (listp i)))) - (insert (org-add-props (copy-sequence "1") nil 'face f)))) - (htmlize-region (point-min) (point-max)))) - (org-pop-to-buffer-same-window "*html*") - (goto-char (point-min)) - (if (re-search-forward "<style" nil t) - (delete-region (point-min) (match-beginning 0))) - (if (re-search-forward "</style>" nil t) - (delete-region (1+ (match-end 0)) (point-max))) - (beginning-of-line 1) - (if (looking-at " +") (replace-match "")) - (goto-char (point-min))) - -(defun org-html--make-string (n string) - "Build a string by concatenating N times STRING." - (let (out) (dotimes (i n out) (setq out (concat string out))))) - -(defun org-html-fix-class-name (kwd) ; audit callers of this function - "Turn todo keyword KWD into a valid class name. -Replaces invalid characters with \"_\"." - (save-match-data - (while (string-match "[^a-zA-Z0-9_]" kwd) - (setq kwd (replace-match "_" t t kwd)))) - kwd) - -(defun org-html-format-footnote-reference (n def refcnt) - "Format footnote reference N with definition DEF into HTML." - (let ((extra (if (= refcnt 1) "" (format ".%d" refcnt)))) - (format org-html-footnote-format - (let* ((id (format "fnr.%s%s" n extra)) - (href (format " href=\"#fn.%s\"" n)) - (attributes (concat " class=\"footref\"" href))) - (org-html--anchor id n attributes))))) - -(defun org-html-format-footnotes-section (section-name definitions) - "Format footnotes section SECTION-NAME." - (if (not definitions) "" - (format org-html-footnotes-section section-name definitions))) - -(defun org-html-format-footnote-definition (fn) - "Format the footnote definition FN." - (let ((n (car fn)) (def (cdr fn))) - (format - "<div class=\"footdef\">%s %s</div>\n" - (format org-html-footnote-format - (let* ((id (format "fn.%s" n)) - (href (format " href=\"#fnr.%s\"" n)) - (attributes (concat " class=\"footnum\"" href))) - (org-html--anchor id n attributes))) - def))) - -(defun org-html-footnote-section (info) - "Format the footnote section. -INFO is a plist used as a communication channel." - (let* ((fn-alist (org-export-collect-footnote-definitions - (plist-get info :parse-tree) info)) - (fn-alist - (loop for (n type raw) in fn-alist collect - (cons n (if (eq (org-element-type raw) 'org-data) - (org-trim (org-export-data raw info)) - (format "<p>%s</p>" - (org-trim (org-export-data raw info)))))))) - (when fn-alist - (org-html-format-footnotes-section - (org-html--translate "Footnotes" info) - (format - "\n%s\n" - (mapconcat 'org-html-format-footnote-definition fn-alist "\n")))))) - - -;;; Template - -(defun org-html--build-meta-info (info) - "Return meta tags for exported document. -INFO is a plist used as a communication channel." - (let ((protect-string - (lambda (str) - (replace-regexp-in-string - "\"" """ (org-html-encode-plain-text str)))) - (title (org-export-data (plist-get info :title) info)) - (author (and (plist-get info :with-author) - (let ((auth (plist-get info :author))) - (and auth - ;; Return raw Org syntax, skipping non - ;; exportable objects. - (org-element-interpret-data - (org-element-map auth - (cons 'plain-text org-element-all-objects) - 'identity info)))))) - (description (plist-get info :description)) - (keywords (plist-get info :keywords)) - (charset (or (and org-html-coding-system - (fboundp 'coding-system-get) - (coding-system-get org-html-coding-system - 'mime-charset)) - "iso-8859-1"))) - (concat - (format "<title>%s\n" title) - (when (plist-get info :time-stamp-file) - (format-time-string - (concat "\n"))) - (format - (if (org-html-html5-p info) - (org-html-close-tag "meta" " charset=\"%s\"" info) - (org-html-close-tag - "meta" " http-equiv=\"Content-Type\" content=\"text/html;charset=%s\"" - info)) - charset) "\n" - (org-html-close-tag "meta" " name=\"generator\" content=\"Org-mode\"" info) - "\n" - (and (org-string-nw-p author) - (concat - (org-html-close-tag "meta" - (format " name=\"author\" content=\"%s\"" - (funcall protect-string author)) - info) - "\n")) - (and (org-string-nw-p description) - (concat - (org-html-close-tag "meta" - (format " name=\"description\" content=\"%s\"\n" - (funcall protect-string description)) - info) - "\n")) - (and (org-string-nw-p keywords) - (concat - (org-html-close-tag "meta" - (format " name=\"keywords\" content=\"%s\"" - (funcall protect-string keywords)) - info) - "\n"))))) - -(defun org-html--build-head (info) - "Return information for the .. of the HTML output. -INFO is a plist used as a communication channel." - (org-element-normalize-string - (concat - (when (plist-get info :html-head-include-default-style) - (org-element-normalize-string org-html-style-default)) - (org-element-normalize-string (plist-get info :html-head)) - (org-element-normalize-string (plist-get info :html-head-extra)) - (when (and (plist-get info :html-htmlized-css-url) - (eq org-html-htmlize-output-type 'css)) - (org-html-close-tag "link" - (format " rel=\"stylesheet\" href=\"%s\" type=\"text/css\"" - (plist-get info :html-htmlized-css-url)) - info)) - (when (plist-get info :html-head-include-scripts) org-html-scripts)))) - -(defun org-html--build-mathjax-config (info) - "Insert the user setup into the mathjax template. -INFO is a plist used as a communication channel." - (when (and (memq (plist-get info :with-latex) '(mathjax t)) - (org-element-map (plist-get info :parse-tree) - '(latex-fragment latex-environment) 'identity info t)) - (let ((template org-html-mathjax-template) - (options org-html-mathjax-options) - (in-buffer (or (plist-get info :html-mathjax) "")) - name val (yes " ") (no "// ") x) - (mapc - (lambda (e) - (setq name (car e) val (nth 1 e)) - (if (string-match (concat "\\<" (symbol-name name) ":") in-buffer) - (setq val (car (read-from-string - (substring in-buffer (match-end 0)))))) - (if (not (stringp val)) (setq val (format "%s" val))) - (if (string-match (concat "%" (upcase (symbol-name name))) template) - (setq template (replace-match val t t template)))) - options) - (setq val (nth 1 (assq 'mathml options))) - (if (string-match (concat "\\%s" e e)) - (split-string (plist-get info :email) ",+ *") - ", ")) - (?c . ,(plist-get info :creator)) - (?C . ,(let ((file (plist-get info :input-file))) - (format-time-string org-html-metadata-timestamp-format - (if file (nth 5 (file-attributes file)) - (current-time))))) - (?v . ,(or org-html-validation-link "")))) - -(defun org-html--build-pre/postamble (type info) - "Return document preamble or postamble as a string, or nil. -TYPE is either 'preamble or 'postamble, INFO is a plist used as a -communication channel." - (let ((section (plist-get info (intern (format ":html-%s" type)))) - (spec (org-html-format-spec info))) - (when section - (let ((section-contents - (if (functionp section) (funcall section info) - (cond - ((stringp section) (format-spec section spec)) - ((eq section 'auto) - (let ((date (cdr (assq ?d spec))) - (author (cdr (assq ?a spec))) - (email (cdr (assq ?e spec))) - (creator (cdr (assq ?c spec))) - (timestamp (cdr (assq ?T spec))) - (validation-link (cdr (assq ?v spec)))) - (concat - (when (and (plist-get info :with-date) - (org-string-nw-p date)) - (format "

    %s: %s

    \n" - (org-html--translate "Date" info) - date)) - (when (and (plist-get info :with-author) - (org-string-nw-p author)) - (format "

    %s: %s

    \n" - (org-html--translate "Author" info) - author)) - (when (and (plist-get info :with-email) - (org-string-nw-p email)) - (format "

    %s: %s

    \n" - (org-html--translate "Email" info) - email)) - (when (plist-get info :time-stamp-file) - (format - "

    %s: %s

    \n" - (org-html--translate "Created" info) - (format-time-string org-html-metadata-timestamp-format))) - (when (plist-get info :with-creator) - (format "

    %s

    \n" creator)) - (format "

    %s

    \n" - validation-link)))) - (t (format-spec - (or (cadr (assoc - (plist-get info :language) - (eval (intern - (format "org-html-%s-format" type))))) - (cadr - (assoc - "en" - (eval - (intern (format "org-html-%s-format" type)))))) - spec)))))) - (when (org-string-nw-p section-contents) - (concat - (format "<%s id=\"%s\" class=\"%s\">\n" - (nth 1 (assq type org-html-divs)) - (nth 2 (assq type org-html-divs)) - org-html--pre/postamble-class) - (org-element-normalize-string section-contents) - (format "\n" (nth 1 (assq type org-html-divs))))))))) - -(defun org-html-inner-template (contents info) - "Return body of document string after HTML conversion. -CONTENTS is the transcoded contents string. INFO is a plist -holding export options." - (concat - ;; Table of contents. - (let ((depth (plist-get info :with-toc))) - (when depth (org-html-toc depth info))) - ;; Document contents. - contents - ;; Footnotes section. - (org-html-footnote-section info))) - -(defun org-html-template (contents info) - "Return complete document string after HTML conversion. -CONTENTS is the transcoded contents string. INFO is a plist -holding export options." - (concat - (when (and (not (org-html-html5-p info)) (org-html-xhtml-p info)) - (let ((decl (or (and (stringp org-html-xml-declaration) - org-html-xml-declaration) - (cdr (assoc (plist-get info :html-extension) - org-html-xml-declaration)) - (cdr (assoc "html" org-html-xml-declaration)) - - ""))) - (when (not (or (eq nil decl) (string= "" decl))) - (format "%s\n" - (format decl - (or (and org-html-coding-system - (fboundp 'coding-system-get) - (coding-system-get org-html-coding-system 'mime-charset)) - "iso-8859-1")))))) - (org-html-doctype info) - "\n" - (concat "\n") - "\n" - (org-html--build-meta-info info) - (org-html--build-head info) - (org-html--build-mathjax-config info) - "\n" - "\n" - (let ((link-up (org-trim (plist-get info :html-link-up))) - (link-home (org-trim (plist-get info :html-link-home)))) - (unless (and (string= link-up "") (string= link-home "")) - (format org-html-home/up-format - (or link-up link-home) - (or link-home link-up)))) - ;; Preamble. - (org-html--build-pre/postamble 'preamble info) - ;; Document contents. - (format "<%s id=\"%s\">\n" - (nth 1 (assq 'content org-html-divs)) - (nth 2 (assq 'content org-html-divs))) - ;; Document title. - (let ((title (plist-get info :title))) - (format "

    %s

    \n" (org-export-data (or title "") info))) - contents - (format "\n" - (nth 1 (assq 'content org-html-divs))) - ;; Postamble. - (org-html--build-pre/postamble 'postamble info) - ;; Closing document. - "\n")) - -(defun org-html--translate (s info) - "Translate string S according to specified language. -INFO is a plist used as a communication channel." - (org-export-translate s :html info)) - -;;;; Anchor - -(defun org-html--anchor (&optional id desc attributes) - "Format a HTML anchor." - (let* ((name (and org-html-allow-name-attribute-in-anchors id)) - (attributes (concat (and id (format " id=\"%s\"" id)) - (and name (format " name=\"%s\"" name)) - attributes))) - (format "%s" attributes (or desc "")))) - -;;;; Todo - -(defun org-html--todo (todo) - "Format TODO keywords into HTML." - (when todo - (format "%s" - (if (member todo org-done-keywords) "done" "todo") - org-html-todo-kwd-class-prefix (org-html-fix-class-name todo) - todo))) - -;;;; Tags - -(defun org-html--tags (tags) - "Format TAGS into HTML." - (when tags - (format "%s" - (mapconcat - (lambda (tag) - (format "%s" - (concat org-html-tag-class-prefix - (org-html-fix-class-name tag)) - tag)) - tags " ")))) - -;;;; Headline - -(defun* org-html-format-headline - (todo todo-type priority text tags - &key level section-number headline-label &allow-other-keys) - "Format a headline in HTML." - (let ((section-number - (when section-number - (format "%s " - level section-number))) - (todo (org-html--todo todo)) - (tags (org-html--tags tags))) - (concat section-number todo (and todo " ") text - (and tags "   ") tags))) - -;;;; Src Code - -(defun org-html-fontify-code (code lang) - "Color CODE with htmlize library. -CODE is a string representing the source code to colorize. LANG -is the language used for CODE, as a string, or nil." - (when code - (cond - ;; Case 1: No lang. Possibly an example block. - ((not lang) - ;; Simple transcoding. - (org-html-encode-plain-text code)) - ;; Case 2: No htmlize or an inferior version of htmlize - ((not (and (require 'htmlize nil t) (fboundp 'htmlize-region-for-paste))) - ;; Emit a warning. - (message "Cannot fontify src block (htmlize.el >= 1.34 required)") - ;; Simple transcoding. - (org-html-encode-plain-text code)) - (t - ;; Map language - (setq lang (or (assoc-default lang org-src-lang-modes) lang)) - (let* ((lang-mode (and lang (intern (format "%s-mode" lang))))) - (cond - ;; Case 1: Language is not associated with any Emacs mode - ((not (functionp lang-mode)) - ;; Simple transcoding. - (org-html-encode-plain-text code)) - ;; Case 2: Default. Fontify code. - (t - ;; htmlize - (setq code (with-temp-buffer - ;; Switch to language-specific mode. - (funcall lang-mode) - (insert code) - ;; Fontify buffer. - (font-lock-fontify-buffer) - ;; Remove formatting on newline characters. - (save-excursion - (let ((beg (point-min)) - (end (point-max))) - (goto-char beg) - (while (progn (end-of-line) (< (point) end)) - (put-text-property (point) (1+ (point)) 'face nil) - (forward-char 1)))) - (org-src-mode) - (set-buffer-modified-p nil) - ;; Htmlize region. - (org-html-htmlize-region-for-paste - (point-min) (point-max)))) - ;; Strip any enclosing
     tags.
    -	  (let* ((beg (and (string-match "\\`]*>\n*" code) (match-end 0)))
    -		 (end (and beg (string-match "\\'" code))))
    -	    (if (and beg end) (substring code beg end) code)))))))))
    -
    -(defun org-html-do-format-code
    -  (code &optional lang refs retain-labels num-start)
    -  "Format CODE string as source code.
    -Optional arguments LANG, REFS, RETAIN-LABELS and NUM-START are,
    -respectively, the language of the source code, as a string, an
    -alist between line numbers and references (as returned by
    -`org-export-unravel-code'), a boolean specifying if labels should
    -appear in the source code, and the number associated to the first
    -line of code."
    -  (let* ((code-lines (org-split-string code "\n"))
    -	 (code-length (length code-lines))
    -	 (num-fmt
    -	  (and num-start
    -	       (format "%%%ds: "
    -		       (length (number-to-string (+ code-length num-start))))))
    -	 (code (org-html-fontify-code code lang)))
    -    (org-export-format-code
    -     code
    -     (lambda (loc line-num ref)
    -       (setq loc
    -	     (concat
    -	      ;; Add line number, if needed.
    -	      (when num-start
    -		(format "%s"
    -			(format num-fmt line-num)))
    -	      ;; Transcoded src line.
    -	      loc
    -	      ;; Add label, if needed.
    -	      (when (and ref retain-labels) (format " (%s)" ref))))
    -       ;; Mark transcoded line as an anchor, if needed.
    -       (if (not ref) loc
    -	 (format "%s"
    -		 ref loc)))
    -     num-start refs)))
    -
    -(defun org-html-format-code (element info)
    -  "Format contents of ELEMENT as source code.
    -ELEMENT is either an example block or a src block.  INFO is
    -a plist used as a communication channel."
    -  (let* ((lang (org-element-property :language element))
    -	 ;; Extract code and references.
    -	 (code-info (org-export-unravel-code element))
    -	 (code (car code-info))
    -	 (refs (cdr code-info))
    -	 ;; Does the src block contain labels?
    -	 (retain-labels (org-element-property :retain-labels element))
    -	 ;; Does it have line numbers?
    -	 (num-start (case (org-element-property :number-lines element)
    -		      (continued (org-export-get-loc element info))
    -		      (new 0))))
    -    (org-html-do-format-code code lang refs retain-labels num-start)))
    -
    -
    -;;; Tables of Contents
    -
    -(defun org-html-toc (depth info)
    -  "Build a table of contents.
    -DEPTH is an integer specifying the depth of the table.  INFO is a
    -plist used as a communication channel.  Return the table of
    -contents as a string, or nil if it is empty."
    -  (let ((toc-entries
    -	 (mapcar (lambda (headline)
    -		   (cons (org-html--format-toc-headline headline info)
    -			 (org-export-get-relative-level headline info)))
    -		 (org-export-collect-headlines info depth)))
    -	(outer-tag (if (and (org-html-html5-p info)
    -			    (plist-get info :html-html5-fancy))
    -		       "nav"
    -		     "div")))
    -    (when toc-entries
    -      (concat (format "<%s id=\"table-of-contents\">\n" outer-tag)
    -	      (format "%s\n"
    -		      org-html-toplevel-hlevel
    -		      (org-html--translate "Table of Contents" info)
    -		      org-html-toplevel-hlevel)
    -	      "
    " - (org-html--toc-text toc-entries) - "
    \n" - (format "\n" outer-tag))))) - -(defun org-html--toc-text (toc-entries) - "Return innards of a table of contents, as a string. -TOC-ENTRIES is an alist where key is an entry title, as a string, -and value is its relative level, as an integer." - (let* ((prev-level (1- (cdar toc-entries))) - (start-level prev-level)) - (concat - (mapconcat - (lambda (entry) - (let ((headline (car entry)) - (level (cdr entry))) - (concat - (let* ((cnt (- level prev-level)) - (times (if (> cnt 0) (1- cnt) (- cnt))) - rtn) - (setq prev-level level) - (concat - (org-html--make-string - times (cond ((> cnt 0) "\n
      \n
    • ") - ((< cnt 0) "
    • \n
    \n"))) - (if (> cnt 0) "\n
      \n
    • " "
    • \n
    • "))) - headline))) - toc-entries "") - (org-html--make-string (- prev-level start-level) "
    • \n
    \n")))) - -(defun org-html--format-toc-headline (headline info) - "Return an appropriate table of contents entry for HEADLINE. -INFO is a plist used as a communication channel." - (let* ((todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword headline))) - (and todo (org-export-data todo info))))) - (todo-type (and todo (org-element-property :todo-type headline))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority headline))) - (text (org-export-data-with-backend - (org-export-get-alt-title headline info) - ;; Create an anonymous back-end that will ignore any - ;; footnote-reference, link, radio-target and target - ;; in table of contents. - (org-export-create-backend - :parent 'html - :transcoders '((footnote-reference . ignore) - (link . (lambda (object c i) c)) - (radio-target . (lambda (object c i) c)) - (target . ignore))) - info)) - (tags (and (eq (plist-get info :with-tags) t) - (org-export-get-tags headline info)))) - (format "%s" - (org-export-solidify-link-text - (or (org-element-property :CUSTOM_ID headline) - (concat "sec-" - (mapconcat - #'number-to-string - (org-export-get-headline-number headline info) - "-")))) - (apply (if (not (eq org-html-format-headline-function 'ignore)) - (lambda (todo todo-type priority text tags &rest ignore) - (funcall org-html-format-headline-function - todo todo-type priority text tags)) - #'org-html-format-headline) - todo todo-type priority text tags :section-number nil)))) - -(defun org-html-list-of-listings (info) - "Build a list of listings. -INFO is a plist used as a communication channel. Return the list -of listings as a string, or nil if it is empty." - (let ((lol-entries (org-export-collect-listings info))) - (when lol-entries - (concat "
    \n" - (format "%s\n" - org-html-toplevel-hlevel - (org-html--translate "List of Listings" info) - org-html-toplevel-hlevel) - "
    \n
      \n" - (let ((count 0) - (initial-fmt (format "%s" - (org-html--translate "Listing %d:" info)))) - (mapconcat - (lambda (entry) - (let ((label (org-element-property :name entry)) - (title (org-trim - (org-export-data - (or (org-export-get-caption entry t) - (org-export-get-caption entry)) - info)))) - (concat - "
    • " - (if (not label) - (concat (format initial-fmt (incf count)) " " title) - (format "%s %s" - (org-export-solidify-link-text label) - (format initial-fmt (incf count)) - title)) - "
    • "))) - lol-entries "\n")) - "\n
    \n
    \n
    ")))) - -(defun org-html-list-of-tables (info) - "Build a list of tables. -INFO is a plist used as a communication channel. Return the list -of tables as a string, or nil if it is empty." - (let ((lol-entries (org-export-collect-tables info))) - (when lol-entries - (concat "
    \n" - (format "%s\n" - org-html-toplevel-hlevel - (org-html--translate "List of Tables" info) - org-html-toplevel-hlevel) - "
    \n
      \n" - (let ((count 0) - (initial-fmt (format "%s" - (org-html--translate "Table %d:" info)))) - (mapconcat - (lambda (entry) - (let ((label (org-element-property :name entry)) - (title (org-trim - (org-export-data - (or (org-export-get-caption entry t) - (org-export-get-caption entry)) - info)))) - (concat - "
    • " - (if (not label) - (concat (format initial-fmt (incf count)) " " title) - (format "%s %s" - (org-export-solidify-link-text label) - (format initial-fmt (incf count)) - title)) - "
    • "))) - lol-entries "\n")) - "\n
    \n
    \n
    ")))) - - -;;; Transcode Functions - -;;;; Bold - -(defun org-html-bold (bold contents info) - "Transcode BOLD from Org to HTML. -CONTENTS is the text with bold markup. INFO is a plist holding -contextual information." - (format (or (cdr (assq 'bold org-html-text-markup-alist)) "%s") - contents)) - -;;;; Center Block - -(defun org-html-center-block (center-block contents info) - "Transcode a CENTER-BLOCK element from Org to HTML. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (format "
    \n%s
    " contents)) - -;;;; Clock - -(defun org-html-clock (clock contents info) - "Transcode a CLOCK element from Org to HTML. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (format "

    - -%s %s%s - -

    " - org-clock-string - (org-translate-time - (org-element-property :raw-value - (org-element-property :value clock))) - (let ((time (org-element-property :duration clock))) - (and time (format " (%s)" time))))) - -;;;; Code - -(defun org-html-code (code contents info) - "Transcode CODE from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual -information." - (format (or (cdr (assq 'code org-html-text-markup-alist)) "%s") - (org-html-encode-plain-text (org-element-property :value code)))) - -;;;; Drawer - -(defun org-html-drawer (drawer contents info) - "Transcode a DRAWER element from Org to HTML. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (if (functionp org-html-format-drawer-function) - (funcall org-html-format-drawer-function - (org-element-property :drawer-name drawer) - contents) - ;; If there's no user defined function: simply - ;; display contents of the drawer. - contents)) - -;;;; Dynamic Block - -(defun org-html-dynamic-block (dynamic-block contents info) - "Transcode a DYNAMIC-BLOCK element from Org to HTML. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information. See `org-export-data'." - contents) - -;;;; Entity - -(defun org-html-entity (entity contents info) - "Transcode an ENTITY object from Org to HTML. -CONTENTS are the definition itself. INFO is a plist holding -contextual information." - (org-element-property :html entity)) - -;;;; Example Block - -(defun org-html-example-block (example-block contents info) - "Transcode a EXAMPLE-BLOCK element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual -information." - (if (org-export-read-attribute :attr_html example-block :textarea) - (org-html--textarea-block example-block) - (format "
    \n%s
    " - (org-html-format-code example-block info)))) - -;;;; Export Snippet - -(defun org-html-export-snippet (export-snippet contents info) - "Transcode a EXPORT-SNIPPET object from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual -information." - (when (eq (org-export-snippet-backend export-snippet) 'html) - (org-element-property :value export-snippet))) - -;;;; Export Block - -(defun org-html-export-block (export-block contents info) - "Transcode a EXPORT-BLOCK element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (string= (org-element-property :type export-block) "HTML") - (org-remove-indentation (org-element-property :value export-block)))) - -;;;; Fixed Width - -(defun org-html-fixed-width (fixed-width contents info) - "Transcode a FIXED-WIDTH element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (format "
    \n%s
    " - (org-html-do-format-code - (org-remove-indentation - (org-element-property :value fixed-width))))) - -;;;; Footnote Reference - -(defun org-html-footnote-reference (footnote-reference contents info) - "Transcode a FOOTNOTE-REFERENCE element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (concat - ;; Insert separator between two footnotes in a row. - (let ((prev (org-export-get-previous-element footnote-reference info))) - (when (eq (org-element-type prev) 'footnote-reference) - org-html-footnote-separator)) - (cond - ((not (org-export-footnote-first-reference-p footnote-reference info)) - (org-html-format-footnote-reference - (org-export-get-footnote-number footnote-reference info) - "IGNORED" 100)) - ;; Inline definitions are secondary strings. - ((eq (org-element-property :type footnote-reference) 'inline) - (org-html-format-footnote-reference - (org-export-get-footnote-number footnote-reference info) - "IGNORED" 1)) - ;; Non-inline footnotes definitions are full Org data. - (t (org-html-format-footnote-reference - (org-export-get-footnote-number footnote-reference info) - "IGNORED" 1))))) - -;;;; Headline - -(defun org-html-format-headline--wrap - (headline info &optional format-function &rest extra-keys) - "Transcode a HEADLINE element from Org to HTML. -CONTENTS holds the contents of the headline. INFO is a plist -holding contextual information." - (let* ((level (+ (org-export-get-relative-level headline info) - (1- org-html-toplevel-hlevel))) - (headline-number (org-export-get-headline-number headline info)) - (section-number (and (not (org-export-low-level-p headline info)) - (org-export-numbered-headline-p headline info) - (mapconcat 'number-to-string - headline-number "."))) - (todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword headline))) - (and todo (org-export-data todo info))))) - (todo-type (and todo (org-element-property :todo-type headline))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority headline))) - (text (org-export-data (org-element-property :title headline) info)) - (tags (and (plist-get info :with-tags) - (org-export-get-tags headline info))) - (headline-label (or (org-element-property :CUSTOM_ID headline) - (concat "sec-" (mapconcat 'number-to-string - headline-number "-")))) - (format-function - (cond ((functionp format-function) format-function) - ((not (eq org-html-format-headline-function 'ignore)) - (lambda (todo todo-type priority text tags &rest ignore) - (funcall org-html-format-headline-function - todo todo-type priority text tags))) - (t 'org-html-format-headline)))) - (apply format-function - todo todo-type priority text tags - :headline-label headline-label :level level - :section-number section-number extra-keys))) - -(defun org-html-headline (headline contents info) - "Transcode a HEADLINE element from Org to HTML. -CONTENTS holds the contents of the headline. INFO is a plist -holding contextual information." - ;; Empty contents? - (setq contents (or contents "")) - (let* ((numberedp (org-export-numbered-headline-p headline info)) - (level (org-export-get-relative-level headline info)) - (text (org-export-data (org-element-property :title headline) info)) - (todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword headline))) - (and todo (org-export-data todo info))))) - (todo-type (and todo (org-element-property :todo-type headline))) - (tags (and (plist-get info :with-tags) - (org-export-get-tags headline info))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority headline))) - (section-number (and (org-export-numbered-headline-p headline info) - (mapconcat 'number-to-string - (org-export-get-headline-number - headline info) "."))) - ;; Create the headline text. - (full-text (org-html-format-headline--wrap headline info))) - (cond - ;; Case 1: This is a footnote section: ignore it. - ((org-element-property :footnote-section-p headline) nil) - ;; Case 2. This is a deep sub-tree: export it as a list item. - ;; Also export as items headlines for which no section - ;; format has been found. - ((org-export-low-level-p headline info) - ;; Build the real contents of the sub-tree. - (let* ((type (if numberedp 'ordered 'unordered)) - (itemized-body (org-html-format-list-item - contents type nil info nil full-text))) - (concat - (and (org-export-first-sibling-p headline info) - (org-html-begin-plain-list type)) - itemized-body - (and (org-export-last-sibling-p headline info) - (org-html-end-plain-list type))))) - ;; Case 3. Standard headline. Export it as a section. - (t - (let* ((section-number (mapconcat 'number-to-string - (org-export-get-headline-number - headline info) "-")) - (ids (remove 'nil - (list (org-element-property :CUSTOM_ID headline) - (concat "sec-" section-number) - (org-element-property :ID headline)))) - (preferred-id (car ids)) - (extra-ids (cdr ids)) - (extra-class (org-element-property :HTML_CONTAINER_CLASS headline)) - (level1 (+ level (1- org-html-toplevel-hlevel))) - (first-content (car (org-element-contents headline)))) - (format "<%s id=\"%s\" class=\"%s\">%s%s\n" - (org-html--container headline info) - (format "outline-container-%s" - (or (org-element-property :CUSTOM_ID headline) - (concat "sec-" section-number))) - (concat (format "outline-%d" level1) (and extra-class " ") - extra-class) - (format "\n%s%s\n" - level1 - preferred-id - (mapconcat - (lambda (x) - (let ((id (org-export-solidify-link-text - (if (org-uuidgen-p x) (concat "ID-" x) - x)))) - (org-html--anchor id))) - extra-ids "") - full-text - level1) - ;; When there is no section, pretend there is an empty - ;; one to get the correct
    \n" class extra) text "
    \n"))) - -(defun org-html-inlinetask (inlinetask contents info) - "Transcode an INLINETASK element from Org to HTML. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (cond - ;; If `org-html-format-inlinetask-function' is not 'ignore, call it - ;; with appropriate arguments. - ((not (eq org-html-format-inlinetask-function 'ignore)) - (let ((format-function - (function* - (lambda (todo todo-type priority text tags - &key contents &allow-other-keys) - (funcall org-html-format-inlinetask-function - todo todo-type priority text tags contents))))) - (org-html-format-headline--wrap - inlinetask info format-function :contents contents))) - ;; Otherwise, use a default template. - (t (format "
    \n%s%s\n%s
    " - (org-html-format-headline--wrap inlinetask info) - (org-html-close-tag "br" nil info) - contents)))) - -;;;; Italic - -(defun org-html-italic (italic contents info) - "Transcode ITALIC from Org to HTML. -CONTENTS is the text with italic markup. INFO is a plist holding -contextual information." - (format (or (cdr (assq 'italic org-html-text-markup-alist)) "%s") contents)) - -;;;; Item - -(defun org-html-checkbox (checkbox) - "Format CHECKBOX into HTML." - (case checkbox (on "[X]") - (off "[ ]") - (trans "[-]") - (t ""))) - -(defun org-html-format-list-item (contents type checkbox info - &optional term-counter-id - headline) - "Format a list item into HTML." - (let ((checkbox (concat (org-html-checkbox checkbox) (and checkbox " "))) - (br (org-html-close-tag "br" nil info))) - (concat - (case type - (ordered - (let* ((counter term-counter-id) - (extra (if counter (format " value=\"%s\"" counter) ""))) - (concat - (format "" extra) - (when headline (concat headline br))))) - (unordered - (let* ((id term-counter-id) - (extra (if id (format " id=\"%s\"" id) ""))) - (concat - (format "" extra) - (when headline (concat headline br))))) - (descriptive - (let* ((term term-counter-id)) - (setq term (or term "(no term)")) - ;; Check-boxes in descriptive lists are associated to tag. - (concat (format "
    %s
    " - (concat checkbox term)) - "
    ")))) - (unless (eq type 'descriptive) checkbox) - contents - (case type - (ordered "") - (unordered "") - (descriptive "
    "))))) - -(defun org-html-item (item contents info) - "Transcode an ITEM element from Org to HTML. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((plain-list (org-export-get-parent item)) - (type (org-element-property :type plain-list)) - (counter (org-element-property :counter item)) - (checkbox (org-element-property :checkbox item)) - (tag (let ((tag (org-element-property :tag item))) - (and tag (org-export-data tag info))))) - (org-html-format-list-item - contents type checkbox info (or tag counter)))) - -;;;; Keyword - -(defun org-html-keyword (keyword contents info) - "Transcode a KEYWORD element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((key (org-element-property :key keyword)) - (value (org-element-property :value keyword))) - (cond - ((string= key "HTML") value) - ((string= key "TOC") - (let ((value (downcase value))) - (cond - ((string-match "\\" value) - (let ((depth (or (and (string-match "[0-9]+" value) - (string-to-number (match-string 0 value))) - (plist-get info :with-toc)))) - (org-html-toc depth info))) - ((string= "listings" value) (org-html-list-of-listings info)) - ((string= "tables" value) (org-html-list-of-tables info)))))))) - -;;;; Latex Environment - -(defun org-html-format-latex (latex-frag processing-type) - "Format a LaTeX fragment LATEX-FRAG into HTML." - (let ((cache-relpath "") (cache-dir "")) - (unless (eq processing-type 'mathjax) - (let ((bfn (or (buffer-file-name) - (make-temp-name - (expand-file-name "latex" temporary-file-directory))))) - (setq cache-relpath - (concat "ltxpng/" - (file-name-sans-extension - (file-name-nondirectory bfn))) - cache-dir (file-name-directory bfn)))) - (with-temp-buffer - (insert latex-frag) - (org-format-latex cache-relpath cache-dir nil "Creating LaTeX Image..." - nil nil processing-type) - (buffer-string)))) - -(defun org-html-latex-environment (latex-environment contents info) - "Transcode a LATEX-ENVIRONMENT element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((processing-type (plist-get info :with-latex)) - (latex-frag (org-remove-indentation - (org-element-property :value latex-environment))) - (attributes (org-export-read-attribute :attr_html latex-environment))) - (case processing-type - ((t mathjax) - (org-html-format-latex latex-frag 'mathjax)) - ((dvipng imagemagick) - (let ((formula-link (org-html-format-latex latex-frag processing-type))) - (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) - ;; Do not provide a caption or a name to be consistent with - ;; `mathjax' handling. - (org-html--wrap-image - (org-html--format-image - (match-string 1 formula-link) attributes info) info)))) - (t latex-frag)))) - -;;;; Latex Fragment - -(defun org-html-latex-fragment (latex-fragment contents info) - "Transcode a LATEX-FRAGMENT object from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((latex-frag (org-element-property :value latex-fragment)) - (processing-type (plist-get info :with-latex))) - (case processing-type - ((t mathjax) - (org-html-format-latex latex-frag 'mathjax)) - ((dvipng imagemagick) - (let ((formula-link (org-html-format-latex latex-frag processing-type))) - (when (and formula-link (string-match "file:\\([^]]*\\)" formula-link)) - (org-html--format-image (match-string 1 formula-link) nil info)))) - (t latex-frag)))) - -;;;; Line Break - -(defun org-html-line-break (line-break contents info) - "Transcode a LINE-BREAK object from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (concat (org-html-close-tag "br" nil info) "\n")) - -;;;; Link - -(defun org-html-inline-image-p (link info) - "Non-nil when LINK is meant to appear as an image. -INFO is a plist used as a communication channel. LINK is an -inline image when it has no description and targets an image -file (see `org-html-inline-image-rules' for more information), or -if its description is a single link targeting an image file." - (if (not (org-element-contents link)) - (org-export-inline-image-p link org-html-inline-image-rules) - (not - (let ((link-count 0)) - (org-element-map (org-element-contents link) - (cons 'plain-text org-element-all-objects) - (lambda (obj) - (case (org-element-type obj) - (plain-text (org-string-nw-p obj)) - (link (if (= link-count 1) t - (incf link-count) - (not (org-export-inline-image-p - obj org-html-inline-image-rules)))) - (otherwise t))) - info t))))) - -(defvar org-html-standalone-image-predicate) -(defun org-html-standalone-image-p (element info) - "Test if ELEMENT is a standalone image. - -INFO is a plist holding contextual information. - -Return non-nil, if ELEMENT is of type paragraph and its sole -content, save for white spaces, is a link that qualifies as an -inline image. - -Return non-nil, if ELEMENT is of type link and its containing -paragraph has no other content save white spaces. - -Return nil, otherwise. - -Bind `org-html-standalone-image-predicate' to constrain paragraph -further. For example, to check for only captioned standalone -images, set it to: - - \(lambda (paragraph) (org-element-property :caption paragraph))" - (let ((paragraph (case (org-element-type element) - (paragraph element) - (link (org-export-get-parent element))))) - (and (eq (org-element-type paragraph) 'paragraph) - (or (not (and (boundp 'org-html-standalone-image-predicate) - (functionp org-html-standalone-image-predicate))) - (funcall org-html-standalone-image-predicate paragraph)) - (not (let ((link-count 0)) - (org-element-map (org-element-contents paragraph) - (cons 'plain-text org-element-all-objects) - (lambda (obj) (case (org-element-type obj) - (plain-text (org-string-nw-p obj)) - (link - (or (> (incf link-count) 1) - (not (org-html-inline-image-p obj info)))) - (otherwise t))) - info 'first-match 'link)))))) - -(defun org-html-link (link desc info) - "Transcode a LINK object from Org to HTML. - -DESC is the description part of the link, or the empty string. -INFO is a plist holding contextual information. See -`org-export-data'." - (let* ((home (when (plist-get info :html-link-home) - (org-trim (plist-get info :html-link-home)))) - (use-abs-url (plist-get info :html-link-use-abs-url)) - (link-org-files-as-html-maybe - (function - (lambda (raw-path info) - "Treat links to `file.org' as links to `file.html', if needed. - See `org-html-link-org-files-as-html'." - (cond - ((and org-html-link-org-files-as-html - (string= ".org" - (downcase (file-name-extension raw-path ".")))) - (concat (file-name-sans-extension raw-path) "." - (plist-get info :html-extension))) - (t raw-path))))) - (type (org-element-property :type link)) - (raw-path (org-element-property :path link)) - ;; Ensure DESC really exists, or set it to nil. - (desc (org-string-nw-p desc)) - (path - (cond - ((member type '("http" "https" "ftp" "mailto")) - (concat type ":" raw-path)) - ((string= type "file") - ;; Treat links to ".org" files as ".html", if needed. - (setq raw-path - (funcall link-org-files-as-html-maybe raw-path info)) - ;; If file path is absolute, prepend it with protocol - ;; component - "file://". - (cond ((file-name-absolute-p raw-path) - (setq raw-path - (concat "file://" (expand-file-name - raw-path)))) - ((and home use-abs-url) - (setq raw-path (concat (file-name-as-directory home) raw-path)))) - ;; Add search option, if any. A search option can be - ;; relative to a custom-id or a headline title. Any other - ;; option is ignored. - (let ((option (org-element-property :search-option link))) - (cond ((not option) raw-path) - ((eq (aref option 0) ?#) (concat raw-path option)) - ;; External fuzzy link: try to resolve it if path - ;; belongs to current project, if any. - ((eq (aref option 0) ?*) - (concat - raw-path - (let ((numbers - (org-publish-resolve-external-fuzzy-link - (org-element-property :path link) option))) - (and numbers (concat "#sec-" - (mapconcat 'number-to-string - numbers "-")))))) - (t raw-path)))) - (t raw-path))) - ;; Extract attributes from parent's paragraph. HACK: Only do - ;; this for the first link in parent (inner image link for - ;; inline images). This is needed as long as attributes - ;; cannot be set on a per link basis. - (attributes-plist - (let* ((parent (org-export-get-parent-element link)) - (link (let ((container (org-export-get-parent link))) - (if (and (eq (org-element-type container) 'link) - (org-html-inline-image-p link info)) - container - link)))) - (and (eq (org-element-map parent 'link 'identity info t) link) - (org-export-read-attribute :attr_html parent)))) - (attributes - (let ((attr (org-html--make-attribute-string attributes-plist))) - (if (org-string-nw-p attr) (concat " " attr) ""))) - protocol) - (cond - ;; Image file. - ((and org-html-inline-images - (org-export-inline-image-p link org-html-inline-image-rules)) - (org-html--format-image path attributes-plist info)) - ;; Radio target: Transcode target's contents and use them as - ;; link's description. - ((string= type "radio") - (let ((destination (org-export-resolve-radio-link link info))) - (when destination - (format "%s" - (org-export-solidify-link-text path) - attributes - (org-export-data (org-element-contents destination) info))))) - ;; Links pointing to a headline: Find destination and build - ;; appropriate referencing command. - ((member type '("custom-id" "fuzzy" "id")) - (let ((destination (if (string= type "fuzzy") - (org-export-resolve-fuzzy-link link info) - (org-export-resolve-id-link link info)))) - (case (org-element-type destination) - ;; ID link points to an external file. - (plain-text - (let ((fragment (concat "ID-" path)) - ;; Treat links to ".org" files as ".html", if needed. - (path (funcall link-org-files-as-html-maybe - destination info))) - (format "%s" - path fragment attributes (or desc destination)))) - ;; Fuzzy link points nowhere. - ((nil) - (format "%s" - (or desc - (org-export-data - (org-element-property :raw-link link) info)))) - ;; Link points to a headline. - (headline - (let ((href - ;; What href to use? - (cond - ;; Case 1: Headline is linked via it's CUSTOM_ID - ;; property. Use CUSTOM_ID. - ((string= type "custom-id") - (org-element-property :CUSTOM_ID destination)) - ;; Case 2: Headline is linked via it's ID property - ;; or through other means. Use the default href. - ((member type '("id" "fuzzy")) - (format "sec-%s" - (mapconcat 'number-to-string - (org-export-get-headline-number - destination info) "-"))) - (t (error "Shouldn't reach here")))) - ;; What description to use? - (desc - ;; Case 1: Headline is numbered and LINK has no - ;; description. Display section number. - (if (and (org-export-numbered-headline-p destination info) - (not desc)) - (mapconcat 'number-to-string - (org-export-get-headline-number - destination info) ".") - ;; Case 2: Either the headline is un-numbered or - ;; LINK has a custom description. Display LINK's - ;; description or headline's title. - (or desc (org-export-data (org-element-property - :title destination) info))))) - (format "%s" - (org-export-solidify-link-text href) attributes desc))) - ;; Fuzzy link points to a target or an element. - (t - (let* ((path (org-export-solidify-link-text path)) - (org-html-standalone-image-predicate 'org-html--has-caption-p) - (number (cond - (desc nil) - ((org-html-standalone-image-p destination info) - (org-export-get-ordinal - (org-element-map destination 'link - 'identity info t) - info 'link 'org-html-standalone-image-p)) - (t (org-export-get-ordinal - destination info nil 'org-html--has-caption-p)))) - (desc (cond (desc) - ((not number) "No description for this link") - ((numberp number) (number-to-string number)) - (t (mapconcat 'number-to-string number "."))))) - (format "%s" path attributes desc)))))) - ;; Coderef: replace link with the reference name or the - ;; equivalent line number. - ((string= type "coderef") - (let ((fragment (concat "coderef-" path))) - (format "%s" - fragment - (org-trim - (format (concat "class=\"coderef\"" - " onmouseover=\"CodeHighlightOn(this, '%s');\"" - " onmouseout=\"CodeHighlightOff(this, '%s');\"") - fragment fragment)) - attributes - (format (org-export-get-coderef-format path desc) - (org-export-resolve-coderef path info))))) - ;; Link type is handled by a special function. - ((functionp (setq protocol (nth 2 (assoc type org-link-protocols)))) - (funcall protocol (org-link-unescape path) desc 'html)) - ;; External link with a description part. - ((and path desc) (format "%s" path attributes desc)) - ;; External link without a description part. - (path (format "%s" path attributes path)) - ;; No path, only description. Try to do something useful. - (t (format "%s" desc))))) - -;;;; Paragraph - -(defun org-html-paragraph (paragraph contents info) - "Transcode a PARAGRAPH element from Org to HTML. -CONTENTS is the contents of the paragraph, as a string. INFO is -the plist used as a communication channel." - (let* ((parent (org-export-get-parent paragraph)) - (parent-type (org-element-type parent)) - (style '((footnote-definition " class=\"footpara\""))) - (extra (or (cadr (assoc parent-type style)) ""))) - (cond - ((and (eq (org-element-type parent) 'item) - (= (org-element-property :begin paragraph) - (org-element-property :contents-begin parent))) - ;; Leading paragraph in a list item have no tags. - contents) - ((org-html-standalone-image-p paragraph info) - ;; Standalone image. - (let ((caption - (let ((raw (org-export-data - (org-export-get-caption paragraph) info)) - (org-html-standalone-image-predicate - 'org-html--has-caption-p)) - (if (not (org-string-nw-p raw)) raw - (concat - "" - (format (org-html--translate "Figure %d:" info) - (org-export-get-ordinal - (org-element-map paragraph 'link - 'identity info t) - info nil 'org-html-standalone-image-p)) - " " raw)))) - (label (org-element-property :name paragraph))) - (org-html--wrap-image contents info caption label))) - ;; Regular paragraph. - (t (format "\n%s

    " extra contents))))) - -;;;; Plain List - -;; FIXME Maybe arg1 is not needed because
  • already sets -;; the correct value for the item counter -(defun org-html-begin-plain-list (type &optional arg1) - "Insert the beginning of the HTML list depending on TYPE. -When ARG1 is a string, use it as the start parameter for ordered -lists." - (case type - (ordered - (format "
      " - (if arg1 (format " start=\"%d\"" arg1) ""))) - (unordered "
        ") - (descriptive "
        "))) - -(defun org-html-end-plain-list (type) - "Insert the end of the HTML list depending on TYPE." - (case type - (ordered "
    ") - (unordered "") - (descriptive ""))) - -(defun org-html-plain-list (plain-list contents info) - "Transcode a PLAIN-LIST element from Org to HTML. -CONTENTS is the contents of the list. INFO is a plist holding -contextual information." - (let* (arg1 ;; (assoc :counter (org-element-map plain-list 'item - (type (org-element-property :type plain-list))) - (format "%s\n%s%s" - (org-html-begin-plain-list type) - contents (org-html-end-plain-list type)))) - -;;;; Plain Text - -(defun org-html-convert-special-strings (string) - "Convert special characters in STRING to HTML." - (let ((all org-html-special-string-regexps) - e a re rpl start) - (while (setq a (pop all)) - (setq re (car a) rpl (cdr a) start 0) - (while (string-match re string start) - (setq string (replace-match rpl t nil string)))) - string)) - -(defun org-html-encode-plain-text (text) - "Convert plain text characters from TEXT to HTML equivalent. -Possible conversions are set in `org-html-protect-char-alist'." - (mapc - (lambda (pair) - (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))) - org-html-protect-char-alist) - text) - -(defun org-html-plain-text (text info) - "Transcode a TEXT string from Org to HTML. -TEXT is the string to transcode. INFO is a plist holding -contextual information." - (let ((output text)) - ;; Protect following characters: <, >, &. - (setq output (org-html-encode-plain-text output)) - ;; Handle smart quotes. Be sure to provide original string since - ;; OUTPUT may have been modified. - (when (plist-get info :with-smart-quotes) - (setq output (org-export-activate-smart-quotes output :html info text))) - ;; Handle special strings. - (when (plist-get info :with-special-strings) - (setq output (org-html-convert-special-strings output))) - ;; Handle break preservation if required. - (when (plist-get info :preserve-breaks) - (setq output - (replace-regexp-in-string - "\\(\\\\\\\\\\)?[ \t]*\n" - (concat (org-html-close-tag "br" nil info) "\n") output))) - ;; Return value. - output)) - - -;; Planning - -(defun org-html-planning (planning contents info) - "Transcode a PLANNING element from Org to HTML. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (let ((span-fmt "%s %s")) - (format - "

    %s

    " - (mapconcat - 'identity - (delq nil - (list - (let ((closed (org-element-property :closed planning))) - (when closed - (format span-fmt org-closed-string - (org-translate-time - (org-element-property :raw-value closed))))) - (let ((deadline (org-element-property :deadline planning))) - (when deadline - (format span-fmt org-deadline-string - (org-translate-time - (org-element-property :raw-value deadline))))) - (let ((scheduled (org-element-property :scheduled planning))) - (when scheduled - (format span-fmt org-scheduled-string - (org-translate-time - (org-element-property :raw-value scheduled))))))) - " ")))) - -;;;; Property Drawer - -(defun org-html-property-drawer (property-drawer contents info) - "Transcode a PROPERTY-DRAWER element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual -information." - ;; The property drawer isn't exported but we want separating blank - ;; lines nonetheless. - "") - -;;;; Quote Block - -(defun org-html-quote-block (quote-block contents info) - "Transcode a QUOTE-BLOCK element from Org to HTML. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (format "
    \n%s
    " contents)) - -;;;; Quote Section - -(defun org-html-quote-section (quote-section contents info) - "Transcode a QUOTE-SECTION element from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((value (org-remove-indentation - (org-element-property :value quote-section)))) - (when value (format "
    \n%s
    " value)))) - -;;;; Section - -(defun org-html-section (section contents info) - "Transcode a SECTION element from Org to HTML. -CONTENTS holds the contents of the section. INFO is a plist -holding contextual information." - (let ((parent (org-export-get-parent-headline section))) - ;; Before first headline: no container, just return CONTENTS. - (if (not parent) contents - ;; Get div's class and id references. - (let* ((class-num (+ (org-export-get-relative-level parent info) - (1- org-html-toplevel-hlevel))) - (section-number - (mapconcat - 'number-to-string - (org-export-get-headline-number parent info) "-"))) - ;; Build return value. - (format "
    \n%s
    " - class-num - (or (org-element-property :CUSTOM_ID parent) section-number) - contents))))) - -;;;; Radio Target - -(defun org-html-radio-target (radio-target text info) - "Transcode a RADIO-TARGET object from Org to HTML. -TEXT is the text of the target. INFO is a plist holding -contextual information." - (let ((id (org-export-solidify-link-text - (org-element-property :value radio-target)))) - (org-html--anchor id text))) - -;;;; Special Block - -(defun org-html-special-block (special-block contents info) - "Transcode a SPECIAL-BLOCK element from Org to HTML. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let* ((block-type (downcase - (org-element-property :type special-block))) - (contents (or contents "")) - (html5-fancy (and (org-html-html5-p info) - (plist-get info :html-html5-fancy) - (member block-type org-html-html5-elements))) - (attributes (org-export-read-attribute :attr_html special-block))) - (unless html5-fancy - (let ((class (plist-get attributes :class))) - (setq attributes (plist-put attributes :class - (if class (concat class " " block-type) - block-type))))) - (setq attributes (org-html--make-attribute-string attributes)) - (when (not (equal attributes "")) - (setq attributes (concat " " attributes))) - (if html5-fancy - (format "<%s%s>\n%s" block-type attributes - contents block-type) - (format "\n%s\n" attributes contents)))) - -;;;; Src Block - -(defun org-html-src-block (src-block contents info) - "Transcode a SRC-BLOCK element from Org to HTML. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (if (org-export-read-attribute :attr_html src-block :textarea) - (org-html--textarea-block src-block) - (let ((lang (org-element-property :language src-block)) - (caption (org-export-get-caption src-block)) - (code (org-html-format-code src-block info)) - (label (let ((lbl (org-element-property :name src-block))) - (if (not lbl) "" - (format " id=\"%s\"" - (org-export-solidify-link-text lbl)))))) - (if (not lang) (format "
    \n%s
    " label code) - (format - "
    \n%s%s\n
    " - (if (not caption) "" - (format "" - (org-export-data caption info))) - (format "\n
    %s
    " lang label code)))))) - -;;;; Statistics Cookie - -(defun org-html-statistics-cookie (statistics-cookie contents info) - "Transcode a STATISTICS-COOKIE object from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((cookie-value (org-element-property :value statistics-cookie))) - (format "%s" cookie-value))) - -;;;; Strike-Through - -(defun org-html-strike-through (strike-through contents info) - "Transcode STRIKE-THROUGH from Org to HTML. -CONTENTS is the text with strike-through markup. INFO is a plist -holding contextual information." - (format (or (cdr (assq 'strike-through org-html-text-markup-alist)) "%s") - contents)) - -;;;; Subscript - -(defun org-html-subscript (subscript contents info) - "Transcode a SUBSCRIPT object from Org to HTML. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (format "%s" contents)) - -;;;; Superscript - -(defun org-html-superscript (superscript contents info) - "Transcode a SUPERSCRIPT object from Org to HTML. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (format "%s" contents)) - -;;;; Tabel Cell - -(defun org-html-table-cell (table-cell contents info) - "Transcode a TABLE-CELL element from Org to HTML. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (let* ((table-row (org-export-get-parent table-cell)) - (table (org-export-get-parent-table table-cell)) - (cell-attrs - (if (not org-html-table-align-individual-fields) "" - (format (if (and (boundp 'org-html-format-table-no-css) - org-html-format-table-no-css) - " align=\"%s\"" " class=\"%s\"") - (org-export-table-cell-alignment table-cell info))))) - (when (or (not contents) (string= "" (org-trim contents))) - (setq contents " ")) - (cond - ((and (org-export-table-has-header-p table info) - (= 1 (org-export-table-row-group table-row info))) - (concat "\n" (format (car org-html-table-header-tags) "col" cell-attrs) - contents (cdr org-html-table-header-tags))) - ((and org-html-table-use-header-tags-for-first-column - (zerop (cdr (org-export-table-cell-address table-cell info)))) - (concat "\n" (format (car org-html-table-header-tags) "row" cell-attrs) - contents (cdr org-html-table-header-tags))) - (t (concat "\n" (format (car org-html-table-data-tags) cell-attrs) - contents (cdr org-html-table-data-tags)))))) - -;;;; Table Row - -(defun org-html-table-row (table-row contents info) - "Transcode a TABLE-ROW element from Org to HTML. -CONTENTS is the contents of the row. INFO is a plist used as a -communication channel." - ;; Rules are ignored since table separators are deduced from - ;; borders of the current row. - (when (eq (org-element-property :type table-row) 'standard) - (let* ((rowgroup-number (org-export-table-row-group table-row info)) - (row-number (org-export-table-row-number table-row info)) - (start-rowgroup-p - (org-export-table-row-starts-rowgroup-p table-row info)) - (end-rowgroup-p - (org-export-table-row-ends-rowgroup-p table-row info)) - ;; `top-row-p' and `end-rowgroup-p' are not used directly - ;; but should be set so that `org-html-table-row-tags' can - ;; use them (see the docstring of this variable.) - (top-row-p (and (equal start-rowgroup-p '(top)) - (equal end-rowgroup-p '(below top)))) - (bottom-row-p (and (equal start-rowgroup-p '(above)) - (equal end-rowgroup-p '(bottom above)))) - (rowgroup-tags - (cond - ;; Case 1: Row belongs to second or subsequent rowgroups. - ((not (= 1 rowgroup-number)) - '("" . "\n")) - ;; Case 2: Row is from first rowgroup. Table has >=1 rowgroups. - ((org-export-table-has-header-p - (org-export-get-parent-table table-row) info) - '("" . "\n")) - ;; Case 2: Row is from first and only row group. - (t '("" . "\n"))))) - (concat - ;; Begin a rowgroup? - (when start-rowgroup-p (car rowgroup-tags)) - ;; Actual table row - (concat "\n" (eval (car org-html-table-row-tags)) - contents - "\n" - (eval (cdr org-html-table-row-tags))) - ;; End a rowgroup? - (when end-rowgroup-p (cdr rowgroup-tags)))))) - -;;;; Table - -(defun org-html-table-first-row-data-cells (table info) - "Transcode the first row of TABLE. -INFO is a plist used as a communication channel." - (let ((table-row - (org-element-map table 'table-row - (lambda (row) - (unless (eq (org-element-property :type row) 'rule) row)) - info 'first-match)) - (special-column-p (org-export-table-has-special-column-p table))) - (if (not special-column-p) (org-element-contents table-row) - (cdr (org-element-contents table-row))))) - -(defun org-html-table--table.el-table (table info) - "Format table.el tables into HTML. -INFO is a plist used as a communication channel." - (when (eq (org-element-property :type table) 'table.el) - (require 'table) - (let ((outbuf (with-current-buffer - (get-buffer-create "*org-export-table*") - (erase-buffer) (current-buffer)))) - (with-temp-buffer - (insert (org-element-property :value table)) - (goto-char 1) - (re-search-forward "^[ \t]*|[^|]" nil t) - (table-generate-source 'html outbuf)) - (with-current-buffer outbuf - (prog1 (org-trim (buffer-string)) - (kill-buffer) ))))) - -(defun org-html-table (table contents info) - "Transcode a TABLE element from Org to HTML. -CONTENTS is the contents of the table. INFO is a plist holding -contextual information." - (case (org-element-property :type table) - ;; Case 1: table.el table. Convert it using appropriate tools. - (table.el (org-html-table--table.el-table table info)) - ;; Case 2: Standard table. - (t - (let* ((label (org-element-property :name table)) - (caption (org-export-get-caption table)) - (number (org-export-get-ordinal - table info nil 'org-html--has-caption-p)) - (attributes - (org-html--make-attribute-string - (org-combine-plists - (and label (list :id (org-export-solidify-link-text label))) - (and (not (org-html-html5-p info)) - (plist-get info :html-table-attributes)) - (org-export-read-attribute :attr_html table)))) - (alignspec - (if (and (boundp 'org-html-format-table-no-css) - org-html-format-table-no-css) - "align=\"%s\"" "class=\"%s\"")) - (table-column-specs - (function - (lambda (table info) - (mapconcat - (lambda (table-cell) - (let ((alignment (org-export-table-cell-alignment - table-cell info))) - (concat - ;; Begin a colgroup? - (when (org-export-table-cell-starts-colgroup-p - table-cell info) - "\n") - ;; Add a column. Also specify it's alignment. - (format "\n%s" - (org-html-close-tag - "col" (concat " " (format alignspec alignment)) info)) - ;; End a colgroup? - (when (org-export-table-cell-ends-colgroup-p - table-cell info) - "\n")))) - (org-html-table-first-row-data-cells table info) "\n"))))) - (format "\n%s\n%s\n%s" - (if (equal attributes "") "" (concat " " attributes)) - (if (not caption) "" - (format (if org-html-table-caption-above - "%s" - "%s") - (concat - "" - (format (org-html--translate "Table %d:" info) number) - " " (org-export-data caption info)))) - (funcall table-column-specs table info) - contents))))) - -;;;; Target - -(defun org-html-target (target contents info) - "Transcode a TARGET object from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual -information." - (let ((id (org-export-solidify-link-text - (org-element-property :value target)))) - (org-html--anchor id))) - -;;;; Timestamp - -(defun org-html-timestamp (timestamp contents info) - "Transcode a TIMESTAMP object from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual -information." - (let ((value (org-html-plain-text - (org-timestamp-translate timestamp) info))) - (format "%s" - (replace-regexp-in-string "--" "–" value)))) - -;;;; Underline - -(defun org-html-underline (underline contents info) - "Transcode UNDERLINE from Org to HTML. -CONTENTS is the text with underline markup. INFO is a plist -holding contextual information." - (format (or (cdr (assq 'underline org-html-text-markup-alist)) "%s") - contents)) - -;;;; Verbatim - -(defun org-html-verbatim (verbatim contents info) - "Transcode VERBATIM from Org to HTML. -CONTENTS is nil. INFO is a plist holding contextual -information." - (format (or (cdr (assq 'verbatim org-html-text-markup-alist)) "%s") - (org-html-encode-plain-text (org-element-property :value verbatim)))) - -;;;; Verse Block - -(defun org-html-verse-block (verse-block contents info) - "Transcode a VERSE-BLOCK element from Org to HTML. -CONTENTS is verse block contents. INFO is a plist holding -contextual information." - ;; Replace each newline character with line break. Also replace - ;; each blank line with a line break. - (setq contents (replace-regexp-in-string - "^ *\\\\\\\\$" (format "%s\n" (org-html-close-tag "br" nil info)) - (replace-regexp-in-string - "\\(\\\\\\\\\\)?[ \t]*\n" - (format "%s\n" (org-html-close-tag "br" nil info)) contents))) - ;; Replace each white space at beginning of a line with a - ;; non-breaking space. - (while (string-match "^[ \t]+" contents) - (let* ((num-ws (length (match-string 0 contents))) - (ws (let (out) (dotimes (i num-ws out) - (setq out (concat out " ")))))) - (setq contents (replace-match ws nil t contents)))) - (format "

    \n%s

    " contents)) - - -;;; Filter Functions - -(defun org-html-final-function (contents backend info) - "Filter to indent the HTML and convert HTML entities." - (with-temp-buffer - (insert contents) - (set-auto-mode t) - (if org-html-indent - (indent-region (point-min) (point-max))) - (when org-html-use-unicode-chars - (require 'mm-url) - (mm-url-decode-entities)) - (buffer-substring-no-properties (point-min) (point-max)))) - - -;;; End-user functions - -;;;###autoload -(defun org-html-export-as-html - (&optional async subtreep visible-only body-only ext-plist) - "Export current buffer to an HTML buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should be accessible -through the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\" and \"\" tags. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Export is done in a buffer named \"*Org HTML Export*\", which -will be displayed when `org-export-show-temporary-export-buffer' -is non-nil." - (interactive) - (org-export-to-buffer 'html "*Org HTML Export*" - async subtreep visible-only body-only ext-plist - (lambda () (set-auto-mode t)))) - -;;;###autoload -(defun org-html-convert-region-to-html () - "Assume the current region has org-mode syntax, and convert it to HTML. -This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in an HTML buffer and use this -command to convert it." - (interactive) - (org-export-replace-region-by 'html)) - -;;;###autoload -(defun org-html-export-to-html - (&optional async subtreep visible-only body-only ext-plist) - "Export current buffer to a HTML file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\" and \"\" tags. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return output file's name." - (interactive) - (let* ((extension (concat "." org-html-extension)) - (file (org-export-output-file-name extension subtreep)) - (org-export-coding-system org-html-coding-system)) - (org-export-to-file 'html file - async subtreep visible-only body-only ext-plist))) - -;;;###autoload -(defun org-html-publish-to-html (plist filename pub-dir) - "Publish an org file to HTML. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (org-publish-org-to 'html filename - (concat "." (or (plist-get plist :html-extension) - org-html-extension "html")) - plist pub-dir)) - - -;;; FIXME - -;;;; org-format-table-html -;;;; org-format-org-table-html -;;;; org-format-table-table-html -;;;; org-table-number-fraction -;;;; org-table-number-regexp -;;;; org-html-inline-image-extensions -;;;; org-export-preferred-target-alist -;;;; class for anchors -;;;; org-export-mark-todo-in-toc -;;;; org-html-format-org-link -;;;; (caption (and caption (org-xml-encode-org-text caption))) -;;;; alt = (file-name-nondirectory path) - -(provide 'ox-html) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ox-html.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ox-icalendar.el b/xemacs-packages/lisp/org-8.2.3c/ox-icalendar.el deleted file mode 100644 index 7c4b4bfb..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ox-icalendar.el +++ /dev/null @@ -1,981 +0,0 @@ -;;; ox-icalendar.el --- iCalendar Back-End for Org Export Engine - -;; Copyright (C) 2004-2013 Free Software Foundation, Inc. - -;; Author: Carsten Dominik -;; Nicolas Goaziou -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: -;; -;; This library implements an iCalendar back-end for Org generic -;; exporter. See Org manual for more information. -;; -;; It is expected to conform to RFC 5545. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'ox-ascii) -(declare-function org-bbdb-anniv-export-ical "org-bbdb" nil) - - - -;;; User-Configurable Variables - -(defgroup org-export-icalendar nil - "Options specific for iCalendar export back-end." - :tag "Org Export iCalendar" - :group 'org-export) - -(defcustom org-icalendar-combined-agenda-file "~/org.ics" - "The file name for the iCalendar file covering all agenda files. -This file is created with the command \\[org-icalendar-combine-agenda-files]. -The file name should be absolute. It will be overwritten without warning." - :group 'org-export-icalendar - :type 'file) - -(defcustom org-icalendar-alarm-time 0 - "Number of minutes for triggering an alarm for exported timed events. - -A zero value (the default) turns off the definition of an alarm trigger -for timed events. If non-zero, alarms are created. - -- a single alarm per entry is defined -- The alarm will go off N minutes before the event -- only a DISPLAY action is defined." - :group 'org-export-icalendar - :version "24.1" - :type 'integer) - -(defcustom org-icalendar-combined-name "OrgMode" - "Calendar name for the combined iCalendar representing all agenda files." - :group 'org-export-icalendar - :type 'string) - -(defcustom org-icalendar-combined-description "" - "Calendar description for the combined iCalendar (all agenda files)." - :group 'org-export-icalendar - :type 'string) - -(defcustom org-icalendar-exclude-tags nil - "Tags that exclude a tree from export. -This variable allows to specify different exclude tags from other -back-ends. It can also be set with the ICAL_EXCLUDE_TAGS -keyword." - :group 'org-export-icalendar - :type '(repeat (string :tag "Tag"))) - -(defcustom org-icalendar-use-deadline '(event-if-not-todo todo-due) - "Contexts where iCalendar 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 'org-export-icalendar - :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-icalendar-use-scheduled '(todo-start) - "Contexts where iCalendar 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 'org-export-icalendar - :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-icalendar-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 'org-export-icalendar - :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-icalendar-with-timestamps 'active - "Non-nil means make an event from plain time stamps. - -It can be set to `active', `inactive', t or nil, in order to make -an event from, respectively, only active timestamps, only -inactive ones, all of them or none. - -This variable has precedence over `org-export-with-timestamps'. -It can also be set with the #+OPTIONS line, e.g. \"<:t\"." - :group 'org-export-icalendar - :type '(choice - (const :tag "All timestamps" t) - (const :tag "Only active timestamps" active) - (const :tag "Only inactive timestamps" inactive) - (const :tag "No timestamp" nil))) - -(defcustom org-icalendar-include-todo nil - "Non-nil means create VTODO components from TODO items. - -Valid values are: -nil don't include any task. -t include tasks that are not in DONE state. -`unblocked' include all TODO items that are not blocked. -`all' include both done and not done items." - :group 'org-export-icalendar - :type '(choice - (const :tag "None" nil) - (const :tag "Unfinished" t) - (const :tag "Unblocked" unblocked) - (const :tag "All" all) - (repeat :tag "Specific TODO keywords" - (string :tag "Keyword")))) - -(defcustom org-icalendar-include-bbdb-anniversaries nil - "Non-nil means a combined iCalendar file should include anniversaries. -The anniversaries are defined in the BBDB database." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-include-sexps t - "Non-nil means export to iCalendar files should also cover sexp entries. -These are entries like in the diary, but directly in an Org mode -file." - :group 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-include-body t - "Amount of text below headline to be included in iCalendar 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 'org-export-icalendar - :type '(choice - (const :tag "Nothing" nil) - (const :tag "Everything" t) - (integer :tag "Max characters"))) - -(defcustom org-icalendar-store-UID nil - "Non-nil means store any created UIDs in properties. - -The iCalendar standard requires that all entries have a unique identifier. -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, -superseding 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 'org-export-icalendar - :type 'boolean) - -(defcustom org-icalendar-timezone (getenv "TZ") - "The time zone string for iCalendar export. -When nil or the empty string, use output -from (current-time-zone)." - :group 'org-export-icalendar - :type '(choice - (const :tag "Unspecified" nil) - (string :tag "Time zone"))) - -(defcustom org-icalendar-date-time-format ":%Y%m%dT%H%M%S" - "Format-string for exporting icalendar DATE-TIME. - -See `format-time-string' for a full documentation. The only -difference is that `org-icalendar-timezone' is used for %Z. - -Interesting value are: - - \":%Y%m%dT%H%M%S\" for local time - - \";TZID=%Z:%Y%m%dT%H%M%S\" for local time with explicit timezone - - \":%Y%m%dT%H%M%SZ\" for time expressed in Universal Time" - :group 'org-export-icalendar - :version "24.1" - :type '(choice - (const :tag "Local time" ":%Y%m%dT%H%M%S") - (const :tag "Explicit local time" ";TZID=%Z:%Y%m%dT%H%M%S") - (const :tag "Universal time" ":%Y%m%dT%H%M%SZ") - (string :tag "Explicit format"))) - -(defvar org-icalendar-after-save-hook nil - "Hook run after an iCalendar file has been saved. -This hook is run with the name of the file as argument. A good -way to use this is to tell a desktop calendar application to -re-read the iCalendar file.") - - - -;;; Define Back-End - -(org-export-define-derived-backend 'icalendar 'ascii - :translate-alist '((clock . ignore) - (footnote-definition . ignore) - (footnote-reference . ignore) - (headline . org-icalendar-entry) - (inlinetask . ignore) - (planning . ignore) - (section . ignore) - (inner-template . (lambda (c i) c)) - (template . org-icalendar-template)) - :options-alist - '((:exclude-tags - "ICALENDAR_EXCLUDE_TAGS" nil org-icalendar-exclude-tags split) - (:with-timestamps nil "<" org-icalendar-with-timestamps) - (:with-vtodo nil nil org-icalendar-include-todo) - ;; The following property will be non-nil when export has been - ;; started from org-agenda-mode. In this case, any entry without - ;; a non-nil "ICALENDAR_MARK" property will be ignored. - (:icalendar-agenda-view nil nil nil)) - :filters-alist - '((:filter-headline . org-icalendar-clear-blank-lines)) - :menu-entry - '(?c "Export to iCalendar" - ((?f "Current file" org-icalendar-export-to-ics) - (?a "All agenda files" - (lambda (a s v b) (org-icalendar-export-agenda-files a))) - (?c "Combine all agenda files" - (lambda (a s v b) (org-icalendar-combine-agenda-files a)))))) - - - -;;; Internal Functions - -(defun org-icalendar-create-uid (file &optional bell h-markers) - "Set ID property on headlines missing it in FILE. -When optional argument BELL is non-nil, inform the user with -a message if the file was modified. With optional argument -H-MARKERS non-nil, it is a list of markers for the headlines -which will be updated." - (let ((pt (if h-markers (goto-char (car h-markers)) (point-min))) - modified-flag) - (org-map-entries - (lambda () - (let ((entry (org-element-at-point))) - (unless (or (< (point) pt) (org-element-property :ID entry)) - (org-id-get-create) - (setq modified-flag t) - (forward-line)) - (when h-markers (setq org-map-continue-from (pop h-markers))))) - nil nil 'comment) - (when (and bell modified-flag) - (message "ID properties created in file \"%s\"" file) - (sit-for 2)))) - -(defun org-icalendar-blocked-headline-p (headline info) - "Non-nil when HEADLINE is considered to be blocked. - -INFO is a plist used as a communication channel. - -a headline is blocked when either: - - - It has children which are not all in a completed state. - - - It has a parent with the property :ORDERED:, and there are - siblings prior to it with incomplete status. - - - Its parent is blocked because it has siblings that should be - done first or is a child of a blocked grandparent entry." - (or - ;; Check if any child is not done. - (org-element-map headline 'headline - (lambda (hl) (eq (org-element-property :todo-type hl) 'todo)) - info 'first-match) - ;; Check :ORDERED: node property. - (catch 'blockedp - (let ((current headline)) - (mapc (lambda (parent) - (cond - ((not (org-element-property :todo-keyword parent)) - (throw 'blockedp nil)) - ((org-not-nil (org-element-property :ORDERED parent)) - (let ((sibling current)) - (while (setq sibling (org-export-get-previous-element - sibling info)) - (when (eq (org-element-property :todo-type sibling) 'todo) - (throw 'blockedp t))))) - (t (setq current parent)))) - (org-export-get-genealogy headline)) - nil)))) - -(defun org-icalendar-use-UTC-date-time-p () - "Non-nil when `org-icalendar-date-time-format' requires UTC time." - (char-equal (elt org-icalendar-date-time-format - (1- (length org-icalendar-date-time-format))) ?Z)) - -(defvar org-agenda-default-appointment-duration) ; From org-agenda.el. -(defun org-icalendar-convert-timestamp (timestamp keyword &optional end utc) - "Convert TIMESTAMP to iCalendar format. - -TIMESTAMP is a timestamp object. KEYWORD is added in front of -it, in order to make a complete line (e.g. \"DTSTART\"). - -When optional argument END is non-nil, use end of time range. -Also increase the hour by two (if time string contains a time), -or the day by one (if it does not contain a time) when no -explicit ending time is specified. - -When optional argument UTC is non-nil, time will be expressed in -Universal Time, ignoring `org-icalendar-date-time-format'." - (let* ((year-start (org-element-property :year-start timestamp)) - (year-end (org-element-property :year-end timestamp)) - (month-start (org-element-property :month-start timestamp)) - (month-end (org-element-property :month-end timestamp)) - (day-start (org-element-property :day-start timestamp)) - (day-end (org-element-property :day-end timestamp)) - (hour-start (org-element-property :hour-start timestamp)) - (hour-end (org-element-property :hour-end timestamp)) - (minute-start (org-element-property :minute-start timestamp)) - (minute-end (org-element-property :minute-end timestamp)) - (with-time-p minute-start) - (equal-bounds-p - (equal (list year-start month-start day-start hour-start minute-start) - (list year-end month-end day-end hour-end minute-end))) - (mi (cond ((not with-time-p) 0) - ((not end) minute-start) - ((and org-agenda-default-appointment-duration equal-bounds-p) - (+ minute-end org-agenda-default-appointment-duration)) - (t minute-end))) - (h (cond ((not with-time-p) 0) - ((not end) hour-start) - ((or (not equal-bounds-p) - org-agenda-default-appointment-duration) - hour-end) - (t (+ hour-end 2)))) - (d (cond ((not end) day-start) - ((not with-time-p) (1+ day-end)) - (t day-end))) - (m (if end month-end month-start)) - (y (if end year-end year-start))) - (concat - keyword - (format-time-string - (cond (utc ":%Y%m%dT%H%M%SZ") - ((not with-time-p) ";VALUE=DATE:%Y%m%d") - (t (replace-regexp-in-string "%Z" - org-icalendar-timezone - org-icalendar-date-time-format - t))) - ;; Convert timestamp into internal time in order to use - ;; `format-time-string' and fix any mistake (i.e. MI >= 60). - (encode-time 0 mi h d m y) - (or utc (and with-time-p (org-icalendar-use-UTC-date-time-p))))))) - -(defun org-icalendar-dtstamp () - "Return DTSTAMP property, as a string." - (format-time-string "DTSTAMP:%Y%m%dT%H%M%SZ" nil t)) - -(defun org-icalendar-get-categories (entry info) - "Return categories according to `org-icalendar-categories'. -ENTRY is a headline or an inlinetask element. INFO is a plist -used as a communication channel." - (mapconcat - 'identity - (org-uniquify - (let (categories) - (mapc (lambda (type) - (case type - (category - (push (org-export-get-category entry info) categories)) - (todo-state - (let ((todo (org-element-property :todo-keyword entry))) - (and todo (push todo categories)))) - (local-tags - (setq categories - (append (nreverse (org-export-get-tags entry info)) - categories))) - (all-tags - (setq categories - (append (nreverse (org-export-get-tags entry info nil t)) - categories))))) - org-icalendar-categories) - ;; Return list of categories, following specified order. - (nreverse categories))) ",")) - -(defun org-icalendar-transcode-diary-sexp (sexp uid summary) - "Transcode a diary sexp into iCalendar format. -SEXP is the diary sexp being transcoded, as a string. UID is the -unique identifier for the entry. SUMMARY defines a short summary -or subject for the event." - (when (require 'icalendar nil t) - (org-element-normalize-string - (with-temp-buffer - (let ((sexp (if (not (string-match "\\`<%%" sexp)) sexp - (concat (substring sexp 1 -1) " " summary)))) - (put-text-property 0 1 'uid uid sexp) - (insert sexp "\n")) - (org-diary-to-ical-string (current-buffer)))))) - -(defun org-icalendar-cleanup-string (s) - "Cleanup string S according to RFC 5545." - (when s - ;; Protect "\", "," and ";" characters. and replace newline - ;; characters with literal \n. - (replace-regexp-in-string - "[ \t]*\n" "\\n" - (replace-regexp-in-string "[\\,;]" "\\\&" s) - nil t))) - -(defun org-icalendar-fold-string (s) - "Fold string S according to RFC 5545." - (org-element-normalize-string - (mapconcat - (lambda (line) - ;; Limit each line to a maximum of 75 characters. If it is - ;; longer, fold it by using "\n " as a continuation marker. - (let ((len (length line))) - (if (<= len 75) line - (let ((folded-line (substring line 0 75)) - (chunk-start 75) - chunk-end) - ;; Since continuation marker takes up one character on the - ;; line, real contents must be split at 74 chars. - (while (< (setq chunk-end (+ chunk-start 74)) len) - (setq folded-line - (concat folded-line "\n " - (substring line chunk-start chunk-end)) - chunk-start chunk-end)) - (concat folded-line "\n " (substring line chunk-start)))))) - (org-split-string s "\n") "\n"))) - - - -;;; Filters - -(defun org-icalendar-clear-blank-lines (headline back-end info) - "Remove trailing blank lines in HEADLINE export. -HEADLINE is a string representing a transcoded headline. -BACK-END and INFO are ignored." - (replace-regexp-in-string "^\\(?:[ \t]*\n\\)*" "" headline)) - - - -;;; Transcode Functions - -;;;; Headline and Inlinetasks - -;; The main function is `org-icalendar-entry', which extracts -;; information from a headline or an inlinetask (summary, -;; description...) and then delegates code generation to -;; `org-icalendar--vtodo' and `org-icalendar--vevent', depending -;; on the component needed. - -;; Obviously, `org-icalendar--valarm' handles alarms, which can -;; happen within a VTODO component. - -(defun org-icalendar-entry (entry contents info) - "Transcode ENTRY element into iCalendar format. - -ENTRY is either a headline or an inlinetask. CONTENTS is -ignored. INFO is a plist used as a communication channel. - -This function is called on every headline, the section below -it (minus inlinetasks) being its contents. It tries to create -VEVENT and VTODO components out of scheduled date, deadline date, -plain timestamps, diary sexps. It also calls itself on every -inlinetask within the section." - (unless (org-element-property :footnote-section-p entry) - (let* ((type (org-element-type entry)) - ;; Determine contents really associated to the entry. For - ;; a headline, limit them to section, if any. For an - ;; inlinetask, this is every element within the task. - (inside - (if (eq type 'inlinetask) - (cons 'org-data (cons nil (org-element-contents entry))) - (let ((first (car (org-element-contents entry)))) - (and (eq (org-element-type first) 'section) - (cons 'org-data - (cons nil (org-element-contents first)))))))) - (concat - (unless (and (plist-get info :icalendar-agenda-view) - (not (org-element-property :ICALENDAR-MARK entry))) - (let ((todo-type (org-element-property :todo-type entry)) - (uid (or (org-element-property :ID entry) (org-id-new))) - (summary (org-icalendar-cleanup-string - (or (org-element-property :SUMMARY entry) - (org-export-data - (org-element-property :title entry) info)))) - (loc (org-icalendar-cleanup-string - (org-element-property :LOCATION entry))) - ;; Build description of the entry from associated - ;; section (headline) or contents (inlinetask). - (desc - (org-icalendar-cleanup-string - (or (org-element-property :DESCRIPTION entry) - (let ((contents (org-export-data inside info))) - (cond - ((not (org-string-nw-p contents)) nil) - ((wholenump org-icalendar-include-body) - (let ((contents (org-trim contents))) - (substring - contents 0 (min (length contents) - org-icalendar-include-body)))) - (org-icalendar-include-body (org-trim contents))))))) - (cat (org-icalendar-get-categories entry info))) - (concat - ;; Events: Delegate to `org-icalendar--vevent' to - ;; generate "VEVENT" component from scheduled, deadline, - ;; or any timestamp in the entry. - (let ((deadline (org-element-property :deadline entry))) - (and deadline - (memq (if todo-type 'event-if-todo 'event-if-not-todo) - org-icalendar-use-deadline) - (org-icalendar--vevent - entry deadline (concat "DL-" uid) - (concat "DL: " summary) loc desc cat))) - (let ((scheduled (org-element-property :scheduled entry))) - (and scheduled - (memq (if todo-type 'event-if-todo 'event-if-not-todo) - org-icalendar-use-scheduled) - (org-icalendar--vevent - entry scheduled (concat "SC-" uid) - (concat "S: " summary) loc desc cat))) - ;; When collecting plain timestamps from a headline and - ;; its title, skip inlinetasks since collection will - ;; happen once ENTRY is one of them. - (let ((counter 0)) - (mapconcat - 'identity - (org-element-map (cons (org-element-property :title entry) - (org-element-contents inside)) - 'timestamp - (lambda (ts) - (let ((uid (format "TS%d-%s" (incf counter) uid))) - (org-icalendar--vevent entry ts uid summary loc desc cat))) - info nil (and (eq type 'headline) 'inlinetask)) - "")) - ;; Task: First check if it is appropriate to export it. - ;; If so, call `org-icalendar--vtodo' to transcode it - ;; into a "VTODO" component. - (when (and todo-type - (case (plist-get info :with-vtodo) - (all t) - (unblocked - (and (eq type 'headline) - (not (org-icalendar-blocked-headline-p - entry info)))) - ('t (eq todo-type 'todo)))) - (org-icalendar--vtodo entry uid summary loc desc cat)) - ;; Diary-sexp: Collect every diary-sexp element within - ;; ENTRY and its title, and transcode them. If ENTRY is - ;; a headline, skip inlinetasks: they will be handled - ;; separately. - (when org-icalendar-include-sexps - (let ((counter 0)) - (mapconcat 'identity - (org-element-map - (cons (org-element-property :title entry) - (org-element-contents inside)) - 'diary-sexp - (lambda (sexp) - (org-icalendar-transcode-diary-sexp - (org-element-property :value sexp) - (format "DS%d-%s" (incf counter) uid) - summary)) - info nil (and (eq type 'headline) 'inlinetask)) - "")))))) - ;; If ENTRY is a headline, call current function on every - ;; inlinetask within it. In agenda export, this is independent - ;; from the mark (or lack thereof) on the entry. - (when (eq type 'headline) - (mapconcat 'identity - (org-element-map inside 'inlinetask - (lambda (task) (org-icalendar-entry task nil info)) - info) "")) - ;; Don't forget components from inner entries. - contents)))) - -(defun org-icalendar--vevent - (entry timestamp uid summary location description categories) - "Create a VEVENT component. - -ENTRY is either a headline or an inlinetask element. TIMESTAMP -is a timestamp object defining the date-time of the event. UID -is the unique identifier for the event. SUMMARY defines a short -summary or subject for the event. LOCATION defines the intended -venue for the event. DESCRIPTION provides the complete -description of the event. CATEGORIES defines the categories the -event belongs to. - -Return VEVENT component as a string." - (org-icalendar-fold-string - (if (eq (org-element-property :type timestamp) 'diary) - (org-icalendar-transcode-diary-sexp - (org-element-property :raw-value timestamp) uid summary) - (concat "BEGIN:VEVENT\n" - (org-icalendar-dtstamp) "\n" - "UID:" uid "\n" - (org-icalendar-convert-timestamp timestamp "DTSTART") "\n" - (org-icalendar-convert-timestamp timestamp "DTEND" t) "\n" - ;; RRULE. - (when (org-element-property :repeater-type timestamp) - (format "RRULE:FREQ=%s;INTERVAL=%d\n" - (case (org-element-property :repeater-unit timestamp) - (hour "HOURLY") (day "DAILY") (week "WEEKLY") - (month "MONTHLY") (year "YEARLY")) - (org-element-property :repeater-value timestamp))) - "SUMMARY:" summary "\n" - (and (org-string-nw-p location) (format "LOCATION:%s\n" location)) - (and (org-string-nw-p description) - (format "DESCRIPTION:%s\n" description)) - "CATEGORIES:" categories "\n" - ;; VALARM. - (org-icalendar--valarm entry timestamp summary) - "END:VEVENT")))) - -(defun org-icalendar--vtodo - (entry uid summary location description categories) - "Create a VTODO component. - -ENTRY is either a headline or an inlinetask element. UID is the -unique identifier for the task. SUMMARY defines a short summary -or subject for the task. LOCATION defines the intended venue for -the task. DESCRIPTION provides the complete description of the -task. CATEGORIES defines the categories the task belongs to. - -Return VTODO component as a string." - (let ((start (or (and (memq 'todo-start org-icalendar-use-scheduled) - (org-element-property :scheduled entry)) - ;; If we can't use a scheduled time for some - ;; reason, start task now. - (let ((now (decode-time (current-time)))) - (list 'timestamp - (list :type 'active - :minute-start (nth 1 now) - :hour-start (nth 2 now) - :day-start (nth 3 now) - :month-start (nth 4 now) - :year-start (nth 5 now))))))) - (org-icalendar-fold-string - (concat "BEGIN:VTODO\n" - "UID:TODO-" uid "\n" - (org-icalendar-dtstamp) "\n" - (org-icalendar-convert-timestamp start "DTSTART") "\n" - (and (memq 'todo-due org-icalendar-use-deadline) - (org-element-property :deadline entry) - (concat (org-icalendar-convert-timestamp - (org-element-property :deadline entry) "DUE") - "\n")) - "SUMMARY:" summary "\n" - (and (org-string-nw-p location) (format "LOCATION:%s\n" location)) - (and (org-string-nw-p description) - (format "DESCRIPTION:%s\n" description)) - "CATEGORIES:" categories "\n" - "SEQUENCE:1\n" - (format "PRIORITY:%d\n" - (let ((pri (or (org-element-property :priority entry) - org-default-priority))) - (floor (- 9 (* 8. (/ (float (- org-lowest-priority pri)) - (- org-lowest-priority - org-highest-priority))))))) - (format "STATUS:%s\n" - (if (eq (org-element-property :todo-type entry) 'todo) - "NEEDS-ACTION" - "COMPLETED")) - "END:VTODO")))) - -(defun org-icalendar--valarm (entry timestamp summary) - "Create a VALARM component. - -ENTRY is the calendar entry triggering the alarm. TIMESTAMP is -the start date-time of the entry. SUMMARY defines a short -summary or subject for the task. - -Return VALARM component as a string, or nil if it isn't allowed." - ;; Create a VALARM entry if the entry is timed. This is not very - ;; general in that: - ;; (a) only one alarm per entry is defined, - ;; (b) only minutes are allowed for the trigger period ahead of the - ;; start time, - ;; (c) only a DISPLAY action is defined. [ESF] - (let ((alarm-time - (let ((warntime - (org-element-property :APPT_WARNTIME entry))) - (if warntime (string-to-number warntime) 0)))) - (and (or (> alarm-time 0) (> org-icalendar-alarm-time 0)) - (org-element-property :hour-start timestamp) - (format "BEGIN:VALARM -ACTION:DISPLAY -DESCRIPTION:%s -TRIGGER:-P0DT0H%dM0S -END:VALARM\n" - summary - (if (zerop alarm-time) org-icalendar-alarm-time alarm-time))))) - - -;;;; Template - -(defun org-icalendar-template (contents info) - "Return complete document string after iCalendar conversion. -CONTENTS is the transcoded contents string. INFO is a plist used -as a communication channel." - (org-icalendar--vcalendar - ;; Name. - (if (not (plist-get info :input-file)) (buffer-name (buffer-base-buffer)) - (file-name-nondirectory - (file-name-sans-extension (plist-get info :input-file)))) - ;; Owner. - (if (not (plist-get info :with-author)) "" - (org-export-data (plist-get info :author) info)) - ;; Timezone. - (if (org-string-nw-p org-icalendar-timezone) org-icalendar-timezone - (cadr (current-time-zone))) - ;; Description. - (org-export-data (plist-get info :title) info) - contents)) - -(defun org-icalendar--vcalendar (name owner tz description contents) - "Create a VCALENDAR component. -NAME, OWNER, TZ, DESCRIPTION and CONTENTS are all strings giving, -respectively, the name of the calendar, its owner, the timezone -used, a short description and the other components included." - (concat (format "BEGIN:VCALENDAR -VERSION:2.0 -X-WR-CALNAME:%s -PRODID:-//%s//Emacs with Org mode//EN -X-WR-TIMEZONE:%s -X-WR-CALDESC:%s -CALSCALE:GREGORIAN\n" - (org-icalendar-cleanup-string name) - (org-icalendar-cleanup-string owner) - (org-icalendar-cleanup-string tz) - (org-icalendar-cleanup-string description)) - contents - "END:VCALENDAR\n")) - - - -;;; Interactive Functions - -;;;###autoload -(defun org-icalendar-export-to-ics - (&optional async subtreep visible-only body-only) - "Export current buffer to an iCalendar file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"BEGIN:VCALENDAR\" and \"END:VCALENDAR\". - -Return ICS file name." - (interactive) - (let ((file (buffer-file-name (buffer-base-buffer)))) - (when (and file org-icalendar-store-UID) - (org-icalendar-create-uid file 'warn-user))) - ;; Export part. Since this back-end is backed up by `ascii', ensure - ;; links will not be collected at the end of sections. - (let ((outfile (org-export-output-file-name ".ics" subtreep))) - (org-export-to-file 'icalendar outfile - async subtreep visible-only body-only '(:ascii-charset utf-8) - (lambda (file) - (run-hook-with-args 'org-icalendar-after-save-hook file) nil)))) - -;;;###autoload -(defun org-icalendar-export-agenda-files (&optional async) - "Export all agenda files to iCalendar files. -When optional argument ASYNC is non-nil, export happens in an -external process." - (interactive) - (if async - ;; Asynchronous export is not interactive, so we will not call - ;; `org-check-agenda-file'. Instead we remove any non-existent - ;; agenda file from the list. - (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t)))) - (org-export-async-start - (lambda (results) - (mapc (lambda (f) (org-export-add-to-stack f 'icalendar)) - results)) - `(let (output-files) - (mapc (lambda (file) - (with-current-buffer (org-get-agenda-file-buffer file) - (push (expand-file-name (org-icalendar-export-to-ics)) - output-files))) - ',files) - output-files))) - (let ((files (org-agenda-files t))) - (org-agenda-prepare-buffers files) - (unwind-protect - (mapc (lambda (file) - (catch 'nextfile - (org-check-agenda-file file) - (with-current-buffer (org-get-agenda-file-buffer file) - (org-icalendar-export-to-ics)))) - files) - (org-release-buffers org-agenda-new-buffers))))) - -;;;###autoload -(defun org-icalendar-combine-agenda-files (&optional async) - "Combine all agenda files into a single iCalendar file. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -The file is stored under the name chosen in -`org-icalendar-combined-agenda-file'." - (interactive) - (if async - (let ((files (org-remove-if-not 'file-exists-p (org-agenda-files t)))) - (org-export-async-start - (lambda (dummy) - (org-export-add-to-stack - (expand-file-name org-icalendar-combined-agenda-file) - 'icalendar)) - `(apply 'org-icalendar--combine-files nil ',files))) - (apply 'org-icalendar--combine-files nil (org-agenda-files t)))) - -(defun org-icalendar-export-current-agenda (file) - "Export current agenda view to an iCalendar FILE. -This function assumes major mode for current buffer is -`org-agenda-mode'." - (let (org-export-babel-evaluate ; Don't evaluate Babel block - (org-icalendar-combined-agenda-file file) - (marker-list - ;; Collect the markers pointing to entries in the current - ;; agenda buffer. - (let (markers) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (let ((m (or (org-get-at-bol 'org-hd-marker) - (org-get-at-bol 'org-marker)))) - (and m (push m markers))) - (beginning-of-line 2))) - (nreverse markers)))) - (apply 'org-icalendar--combine-files - ;; Build restriction alist. - (let (restriction) - ;; Sort markers in each association within RESTRICTION. - (mapcar (lambda (x) (setcdr x (sort (copy-sequence (cdr x)) '<)) x) - (dolist (m marker-list restriction) - (let* ((pos (marker-position m)) - (file (buffer-file-name - (org-base-buffer (marker-buffer m)))) - (file-markers (assoc file restriction))) - ;; Add POS in FILE association if one exists - ;; or create a new association for FILE. - (if file-markers (push pos (cdr file-markers)) - (push (list file pos) restriction)))))) - (org-agenda-files nil 'ifmode)))) - -(defun org-icalendar--combine-files (restriction &rest files) - "Combine entries from multiple files into an iCalendar file. -RESTRICTION, when non-nil, is an alist where key is a file name -and value a list of buffer positions pointing to entries that -should appear in the calendar. It only makes sense if the -function was called from an agenda buffer. FILES is a list of -files to build the calendar from." - (org-agenda-prepare-buffers files) - (unwind-protect - (progn - (with-temp-file org-icalendar-combined-agenda-file - (insert - (org-icalendar--vcalendar - ;; Name. - org-icalendar-combined-name - ;; Owner. - user-full-name - ;; Timezone. - (or (org-string-nw-p org-icalendar-timezone) - (cadr (current-time-zone))) - ;; Description. - org-icalendar-combined-description - ;; Contents. - (concat - ;; Agenda contents. - (mapconcat - (lambda (file) - (catch 'nextfile - (org-check-agenda-file file) - (with-current-buffer (org-get-agenda-file-buffer file) - (let ((marks (cdr (assoc (expand-file-name file) - restriction)))) - ;; Create ID if necessary. - (when org-icalendar-store-UID - (org-icalendar-create-uid file t marks)) - (unless (and restriction (not marks)) - ;; Add a hook adding :ICALENDAR_MARK: property - ;; to each entry appearing in agenda view. - ;; Use `apply-partially' because the function - ;; still has to accept one argument. - (let ((org-export-before-processing-hook - (cons (apply-partially - (lambda (m-list dummy) - (mapc (lambda (m) - (org-entry-put - m "ICALENDAR-MARK" "t")) - m-list)) - (sort marks '>)) - org-export-before-processing-hook))) - (org-export-as - 'icalendar nil nil t - (list :ascii-charset 'utf-8 - :icalendar-agenda-view restriction)))))))) - files "") - ;; BBDB anniversaries. - (when (and org-icalendar-include-bbdb-anniversaries - (require 'org-bbdb nil t)) - (with-temp-buffer - (org-bbdb-anniv-export-ical) - (buffer-string))))))) - (run-hook-with-args 'org-icalendar-after-save-hook - org-icalendar-combined-agenda-file)) - (org-release-buffers org-agenda-new-buffers))) - - -(provide 'ox-icalendar) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ox-icalendar.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ox-latex.el b/xemacs-packages/lisp/org-8.2.3c/ox-latex.el deleted file mode 100644 index 014ed266..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ox-latex.el +++ /dev/null @@ -1,2916 +0,0 @@ -;;; ox-latex.el --- LaTeX Back-End for Org Export Engine - -;; Copyright (C) 2011-2013 Free Software Foundation, Inc. - -;; Author: Nicolas Goaziou -;; Keywords: outlines, hypermedia, calendar, wp - -;; 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 . - -;;; Commentary: -;; -;; See Org manual for details. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'ox) -(require 'ox-publish) - -(defvar org-latex-default-packages-alist) -(defvar org-latex-packages-alist) -(defvar orgtbl-exp-regexp) - - - -;;; Define Back-End - -(org-export-define-backend 'latex - '((bold . org-latex-bold) - (center-block . org-latex-center-block) - (clock . org-latex-clock) - (code . org-latex-code) - (comment . (lambda (&rest args) "")) - (comment-block . (lambda (&rest args) "")) - (drawer . org-latex-drawer) - (dynamic-block . org-latex-dynamic-block) - (entity . org-latex-entity) - (example-block . org-latex-example-block) - (export-block . org-latex-export-block) - (export-snippet . org-latex-export-snippet) - (fixed-width . org-latex-fixed-width) - (footnote-definition . org-latex-footnote-definition) - (footnote-reference . org-latex-footnote-reference) - (headline . org-latex-headline) - (horizontal-rule . org-latex-horizontal-rule) - (inline-src-block . org-latex-inline-src-block) - (inlinetask . org-latex-inlinetask) - (italic . org-latex-italic) - (item . org-latex-item) - (keyword . org-latex-keyword) - (latex-environment . org-latex-latex-environment) - (latex-fragment . org-latex-latex-fragment) - (line-break . org-latex-line-break) - (link . org-latex-link) - (paragraph . org-latex-paragraph) - (plain-list . org-latex-plain-list) - (plain-text . org-latex-plain-text) - (planning . org-latex-planning) - (property-drawer . (lambda (&rest args) "")) - (quote-block . org-latex-quote-block) - (quote-section . org-latex-quote-section) - (radio-target . org-latex-radio-target) - (section . org-latex-section) - (special-block . org-latex-special-block) - (src-block . org-latex-src-block) - (statistics-cookie . org-latex-statistics-cookie) - (strike-through . org-latex-strike-through) - (subscript . org-latex-subscript) - (superscript . org-latex-superscript) - (table . org-latex-table) - (table-cell . org-latex-table-cell) - (table-row . org-latex-table-row) - (target . org-latex-target) - (template . org-latex-template) - (timestamp . org-latex-timestamp) - (underline . org-latex-underline) - (verbatim . org-latex-verbatim) - (verse-block . org-latex-verse-block)) - :export-block '("LATEX" "TEX") - :menu-entry - '(?l "Export to LaTeX" - ((?L "As LaTeX buffer" org-latex-export-as-latex) - (?l "As LaTeX file" org-latex-export-to-latex) - (?p "As PDF file" org-latex-export-to-pdf) - (?o "As PDF file and open" - (lambda (a s v b) - (if a (org-latex-export-to-pdf t s v b) - (org-open-file (org-latex-export-to-pdf nil s v b))))))) - :options-alist '((:latex-class "LATEX_CLASS" nil org-latex-default-class t) - (:latex-class-options "LATEX_CLASS_OPTIONS" nil nil t) - (:latex-header "LATEX_HEADER" nil nil newline) - (:latex-header-extra "LATEX_HEADER_EXTRA" nil nil newline) - (:latex-hyperref-p nil "texht" org-latex-with-hyperref t) - ;; Redefine regular options. - (:date "DATE" nil "\\today" t))) - - - -;;; Internal Variables - -(defconst org-latex-babel-language-alist - '(("af" . "afrikaans") - ("bg" . "bulgarian") - ("bt-br" . "brazilian") - ("ca" . "catalan") - ("cs" . "czech") - ("cy" . "welsh") - ("da" . "danish") - ("de" . "germanb") - ("de-at" . "naustrian") - ("de-de" . "ngerman") - ("el" . "greek") - ("en" . "english") - ("en-au" . "australian") - ("en-ca" . "canadian") - ("en-gb" . "british") - ("en-ie" . "irish") - ("en-nz" . "newzealand") - ("en-us" . "american") - ("es" . "spanish") - ("et" . "estonian") - ("eu" . "basque") - ("fi" . "finnish") - ("fr" . "frenchb") - ("fr-ca" . "canadien") - ("gl" . "galician") - ("hr" . "croatian") - ("hu" . "hungarian") - ("id" . "indonesian") - ("is" . "icelandic") - ("it" . "italian") - ("la" . "latin") - ("ms" . "malay") - ("nl" . "dutch") - ("nb" . "norsk") - ("nn" . "nynorsk") - ("no" . "norsk") - ("pl" . "polish") - ("pt" . "portuguese") - ("ro" . "romanian") - ("ru" . "russian") - ("sa" . "sanskrit") - ("sb" . "uppersorbian") - ("sk" . "slovak") - ("sl" . "slovene") - ("sq" . "albanian") - ("sr" . "serbian") - ("sv" . "swedish") - ("ta" . "tamil") - ("tr" . "turkish") - ("uk" . "ukrainian")) - "Alist between language code and corresponding Babel option.") - -(defconst org-latex-table-matrix-macros '(("bordermatrix" . "\\cr") - ("qbordermatrix" . "\\cr") - ("kbordermatrix" . "\\\\")) - "Alist between matrix macros and their row ending.") - - - -;;; User Configurable Variables - -(defgroup org-export-latex nil - "Options for exporting Org mode files to LaTeX." - :tag "Org Export LaTeX" - :group 'org-export) - - -;;;; Preamble - -(defcustom org-latex-default-class "article" - "The default LaTeX class." - :group 'org-export-latex - :type '(string :tag "LaTeX class")) - -(defcustom org-latex-classes - '(("article" - "\\documentclass[11pt]{article}" - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}") - ("\\paragraph{%s}" . "\\paragraph*{%s}") - ("\\subparagraph{%s}" . "\\subparagraph*{%s}")) - ("report" - "\\documentclass[11pt]{report}" - ("\\part{%s}" . "\\part*{%s}") - ("\\chapter{%s}" . "\\chapter*{%s}") - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}")) - ("book" - "\\documentclass[11pt]{book}" - ("\\part{%s}" . "\\part*{%s}") - ("\\chapter{%s}" . "\\chapter*{%s}") - ("\\section{%s}" . "\\section*{%s}") - ("\\subsection{%s}" . "\\subsection*{%s}") - ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))) - "Alist of LaTeX classes and associated header and structure. -If #+LATEX_CLASS is set in the buffer, use its value and the -associated information. Here is the structure of each cell: - - \(class-name - header-string - \(numbered-section . unnumbered-section) - ...) - -The header string ------------------ - -The HEADER-STRING is the header that will be inserted into the -LaTeX file. It should contain the \\documentclass macro, and -anything else that is needed for this setup. To this header, the -following commands will be added: - -- Calls to \\usepackage for all packages mentioned in the - variables `org-latex-default-packages-alist' and - `org-latex-packages-alist'. Thus, your header definitions - should avoid to also request these packages. - -- Lines specified via \"#+LATEX_HEADER:\" and - \"#+LATEX_HEADER_EXTRA:\" keywords. - -If you need more control about the sequence in which the header -is built up, or if you want to exclude one of these building -blocks for a particular class, you can use the following -macro-like placeholders. - - [DEFAULT-PACKAGES] \\usepackage statements for default packages - [NO-DEFAULT-PACKAGES] do not include any of the default packages - [PACKAGES] \\usepackage statements for packages - [NO-PACKAGES] do not include the packages - [EXTRA] the stuff from #+LATEX_HEADER(_EXTRA) - [NO-EXTRA] do not include #+LATEX_HEADER(_EXTRA) stuff - -So a header like - - \\documentclass{article} - [NO-DEFAULT-PACKAGES] - [EXTRA] - \\providecommand{\\alert}[1]{\\textbf{#1}} - [PACKAGES] - -will omit the default packages, and will include the -#+LATEX_HEADER and #+LATEX_HEADER_EXTRA lines, then have a call -to \\providecommand, and then place \\usepackage commands based -on the content of `org-latex-packages-alist'. - -If your header, `org-latex-default-packages-alist' or -`org-latex-packages-alist' inserts \"\\usepackage[AUTO]{inputenc}\", -AUTO will automatically be replaced with a coding system derived -from `buffer-file-coding-system'. See also the variable -`org-latex-inputenc-alist' for a way to influence this mechanism. - -Likewise, if your header contains \"\\usepackage[AUTO]{babel}\", -AUTO will be replaced with the language related to the language -code specified by `org-export-default-language', which see. Note -that constructions such as \"\\usepackage[french,AUTO,english]{babel}\" -are permitted. - -The sectioning structure ------------------------- - -The sectioning structure of the class is given by the elements -following the header string. For each sectioning level, a number -of strings is specified. A %s formatter is mandatory in each -section string and will be replaced by the title of the section. - -Instead of a cons cell (numbered . unnumbered), you can also -provide a list of 2 or 4 elements, - - \(numbered-open numbered-close) - -or - - \(numbered-open numbered-close unnumbered-open unnumbered-close) - -providing opening and closing strings for a LaTeX environment -that should represent the document section. The opening clause -should have a %s to represent the section title. - -Instead of a list of sectioning commands, you can also specify -a function name. That function will be called with two -parameters, the (reduced) level of the headline, and a predicate -non-nil when the headline should be numbered. It must return -a format string in which the section title will be added." - :group 'org-export-latex - :type '(repeat - (list (string :tag "LaTeX class") - (string :tag "LaTeX header") - (repeat :tag "Levels" :inline t - (choice - (cons :tag "Heading" - (string :tag " numbered") - (string :tag "unnumbered")) - (list :tag "Environment" - (string :tag "Opening (numbered)") - (string :tag "Closing (numbered)") - (string :tag "Opening (unnumbered)") - (string :tag "Closing (unnumbered)")) - (function :tag "Hook computing sectioning")))))) - -(defcustom org-latex-inputenc-alist nil - "Alist of inputenc coding system names, and what should really be used. -For example, adding an entry - - (\"utf8\" . \"utf8x\") - -will cause \\usepackage[utf8x]{inputenc} to be used for buffers that -are written as utf8 files." - :group 'org-export-latex - :type '(repeat - (cons - (string :tag "Derived from buffer") - (string :tag "Use this instead")))) - -(defcustom org-latex-title-command "\\maketitle" - "The command used to insert the title just after \\begin{document}. -If this string contains the formatting specification \"%s\" then -it will be used as a formatting string, passing the title as an -argument." - :group 'org-export-latex - :type 'string) - -(defcustom org-latex-toc-command "\\tableofcontents\n\n" - "LaTeX command to set the table of contents, list of figures, etc. -This command only applies to the table of contents generated with -the toc:nil option, not to those generated with #+TOC keyword." - :group 'org-export-latex - :type 'string) - -(defcustom org-latex-with-hyperref t - "Toggle insertion of \\hypersetup{...} in the preamble." - :group 'org-export-latex - :type 'boolean) - -;;;; Headline - -(defcustom org-latex-format-headline-function - 'org-latex-format-headline-default-function - "Function for formatting the headline's text. - -This function will be called with 5 arguments: -TODO the todo keyword (string or nil). -TODO-TYPE the type of todo (symbol: `todo', `done', nil) -PRIORITY the priority of the headline (integer or nil) -TEXT the main headline text (string). -TAGS the tags as a list of strings (list of strings or nil). - -The function result will be used in the section format string. - -Use `org-latex-format-headline-default-function' by default, -which format headlines like for Org version prior to 8.0." - :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.0") - :type 'function) - - -;;;; Footnotes - -(defcustom org-latex-footnote-separator "\\textsuperscript{,}\\," - "Text used to separate footnotes." - :group 'org-export-latex - :type 'string) - - -;;;; Timestamps - -(defcustom org-latex-active-timestamp-format "\\textit{%s}" - "A printf format string to be applied to active timestamps." - :group 'org-export-latex - :type 'string) - -(defcustom org-latex-inactive-timestamp-format "\\textit{%s}" - "A printf format string to be applied to inactive timestamps." - :group 'org-export-latex - :type 'string) - -(defcustom org-latex-diary-timestamp-format "\\textit{%s}" - "A printf format string to be applied to diary timestamps." - :group 'org-export-latex - :type 'string) - - -;;;; Links - -(defcustom org-latex-image-default-option "" - "Default option for images." - :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defcustom org-latex-image-default-width ".9\\linewidth" - "Default width for images. -This value will not be used if a height is provided." - :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defcustom org-latex-image-default-height "" - "Default height for images. -This value will not be used if a width is provided, or if the -image is wrapped within a \"figure\" or \"wrapfigure\" -environment." - :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defcustom org-latex-default-figure-position "htb" - "Default position for latex figures." - :group 'org-export-latex - :type 'string) - -(defcustom org-latex-inline-image-rules - '(("file" . "\\.\\(pdf\\|jpeg\\|jpg\\|png\\|ps\\|eps\\|tikz\\|pgf\\|svg\\)\\'")) - "Rules characterizing image files that can be inlined into LaTeX. - -A rule consists in an association whose key is the type of link -to consider, and value is a regexp that will be matched against -link's path. - -Note that, by default, the image extension *actually* allowed -depend on the way the LaTeX file is processed. When used with -pdflatex, pdf, jpg and png images are OK. When processing -through dvi to Postscript, only ps and eps are allowed. The -default we use here encompasses both." - :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.0") - :type '(alist :key-type (string :tag "Type") - :value-type (regexp :tag "Path"))) - -(defcustom org-latex-link-with-unknown-path-format "\\texttt{%s}" - "Format string for links with unknown path type." - :group 'org-export-latex - :type 'string) - - -;;;; Tables - -(defcustom org-latex-default-table-environment "tabular" - "Default environment used to build tables." - :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.0") - :type 'string) - -(defcustom org-latex-default-table-mode 'table - "Default mode for tables. - -Value can be a symbol among: - - `table' Regular LaTeX table. - - `math' In this mode, every cell is considered as being in math - mode and the complete table will be wrapped within a math - environment. It is particularly useful to write matrices. - - `inline-math' This mode is almost the same as `math', but the - math environment will be inlined. - - `verbatim' The table is exported as it appears in the Org - buffer, within a verbatim environment. - -This value can be overridden locally with, i.e. \":mode math\" in -LaTeX attributes. - -When modifying this variable, it may be useful to change -`org-latex-default-table-environment' accordingly." - :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice (const :tag "Table" table) - (const :tag "Matrix" math) - (const :tag "Inline matrix" inline-math) - (const :tag "Verbatim" verbatim))) - -(defcustom org-latex-tables-centered t - "When non-nil, tables are exported in a center environment." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-latex-tables-booktabs nil - "When non-nil, display tables in a formal \"booktabs\" style. -This option assumes that the \"booktabs\" package is properly -loaded in the header of the document. This value can be ignored -locally with \":booktabs t\" and \":booktabs nil\" LaTeX -attributes." - :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-latex-table-caption-above t - "When non-nil, place caption string at the beginning of the table. -Otherwise, place it near the end." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-latex-table-scientific-notation "%s\\,(%s)" - "Format string to display numbers in scientific notation. -The format should have \"%s\" twice, for mantissa and exponent -\(i.e., \"%s\\\\times10^{%s}\"). - -When nil, no transformation is made." - :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (string :tag "Format string") - (const :tag "No formatting"))) - - -;;;; Text markup - -(defcustom org-latex-text-markup-alist '((bold . "\\textbf{%s}") - (code . verb) - (italic . "\\emph{%s}") - (strike-through . "\\sout{%s}") - (underline . "\\uline{%s}") - (verbatim . protectedtexttt)) - "Alist of LaTeX expressions to convert text markup. - -The key must be a symbol among `bold', `code', `italic', -`strike-through', `underline' and `verbatim'. The value is -a formatting string to wrap fontified text with. - -Value can also be set to the following symbols: `verb' and -`protectedtexttt'. For the former, Org will use \"\\verb\" to -create a format string and select a delimiter character that -isn't in the string. For the latter, Org will use \"\\texttt\" -to typeset and try to protect special characters. - -If no association can be found for a given markup, text will be -returned as-is." - :group 'org-export-latex - :type 'alist - :options '(bold code italic strike-through underline verbatim)) - - -;;;; Drawers - -(defcustom org-latex-format-drawer-function - (lambda (name contents) contents) - "Function called to format a drawer in LaTeX code. - -The function must accept two parameters: - NAME the drawer name, like \"LOGBOOK\" - CONTENTS the contents of the drawer. - -The function should return the string to be exported. - -The default function simply returns the value of CONTENTS." - :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.3") - :type 'function) - - -;;;; Inlinetasks - -(defcustom org-latex-format-inlinetask-function 'ignore - "Function called to format an inlinetask in LaTeX code. - -The function must accept six parameters: - TODO the todo keyword, as a string - TODO-TYPE the todo type, a symbol among `todo', `done' and nil. - PRIORITY the inlinetask priority, as a string - NAME the inlinetask name, as a string. - TAGS the inlinetask tags, as a list of strings. - CONTENTS the contents of the inlinetask, as a string. - -The function should return the string to be exported. - -For example, the variable could be set to the following function -in order to mimic default behaviour: - -\(defun org-latex-format-inlinetask \(todo type priority name tags contents\) -\"Format an inline task element for LaTeX export.\" - \(let ((full-title - \(concat - \(when todo - \(format \"\\\\textbf{\\\\textsf{\\\\textsc{%s}}} \" todo)) - \(when priority (format \"\\\\framebox{\\\\#%c} \" priority)) - title - \(when tags - \(format \"\\\\hfill{}\\\\textsc{:%s:}\" - \(mapconcat 'identity tags \":\"))))) - \(format (concat \"\\\\begin{center}\\n\" - \"\\\\fbox{\\n\" - \"\\\\begin{minipage}[c]{.6\\\\textwidth}\\n\" - \"%s\\n\\n\" - \"\\\\rule[.8em]{\\\\textwidth}{2pt}\\n\\n\" - \"%s\" - \"\\\\end{minipage}}\" - \"\\\\end{center}\") - full-title contents))" - :group 'org-export-latex - :type 'function) - - -;; Src blocks - -(defcustom org-latex-listings nil - "Non-nil means export source code using the listings package. - -This package will fontify source code, possibly even with color. -If you want to use this, you also need to make LaTeX use the -listings package, and if you want to have color, the color -package. Just add these to `org-latex-packages-alist', for -example using customize, or with something like: - - \(require 'ox-latex) - \(add-to-list 'org-latex-packages-alist '(\"\" \"listings\")) - \(add-to-list 'org-latex-packages-alist '(\"\" \"color\")) - -Alternatively, - - \(setq org-latex-listings 'minted) - -causes source code to be exported using the minted package as -opposed to listings. If you want to use minted, you need to add -the minted package to `org-latex-packages-alist', for example -using customize, or with - - \(require 'ox-latex) - \(add-to-list 'org-latex-packages-alist '(\"\" \"minted\")) - -In addition, it is necessary to install pygments -\(http://pygments.org), and to configure the variable -`org-latex-pdf-process' so that the -shell-escape option is -passed to pdflatex. - -The minted choice has possible repercussions on the preview of -latex fragments (see `org-preview-latex-fragment'). If you run -into previewing problems, please consult - - http://orgmode.org/worg/org-tutorials/org-latex-preview.html" - :group 'org-export-latex - :type '(choice - (const :tag "Use listings" t) - (const :tag "Use minted" minted) - (const :tag "Export verbatim" nil))) - -(defcustom org-latex-listings-langs - '((emacs-lisp "Lisp") (lisp "Lisp") (clojure "Lisp") - (c "C") (cc "C++") - (fortran "fortran") - (perl "Perl") (cperl "Perl") (python "Python") (ruby "Ruby") - (html "HTML") (xml "XML") - (tex "TeX") (latex "[LaTeX]TeX") - (shell-script "bash") - (gnuplot "Gnuplot") - (ocaml "Caml") (caml "Caml") - (sql "SQL") (sqlite "sql")) - "Alist mapping languages to their listing language counterpart. -The key is a symbol, the major mode symbol without the \"-mode\". -The value is the string that should be inserted as the language -parameter for the listings package. If the mode name and the -listings name are the same, the language does not need an entry -in this list - but it does not hurt if it is present." - :group 'org-export-latex - :type '(repeat - (list - (symbol :tag "Major mode ") - (string :tag "Listings language")))) - -(defcustom org-latex-listings-options nil - "Association list of options for the latex listings package. - -These options are supplied as a comma-separated list to the -\\lstset command. Each element of the association list should be -a list containing two strings: the name of the option, and the -value. For example, - - (setq org-latex-listings-options - '((\"basicstyle\" \"\\\\small\") - (\"keywordstyle\" \"\\\\color{black}\\\\bfseries\\\\underbar\"))) - -will typeset the code in a small size font with underlined, bold -black keywords. - -Note that the same options will be applied to blocks of all -languages." - :group 'org-export-latex - :type '(repeat - (list - (string :tag "Listings option name ") - (string :tag "Listings option value")))) - -(defcustom org-latex-minted-langs - '((emacs-lisp "common-lisp") - (cc "c++") - (cperl "perl") - (shell-script "bash") - (caml "ocaml")) - "Alist mapping languages to their minted language counterpart. -The key is a symbol, the major mode symbol without the \"-mode\". -The value is the string that should be inserted as the language -parameter for the minted package. If the mode name and the -listings name are the same, the language does not need an entry -in this list - but it does not hurt if it is present. - -Note that minted uses all lower case for language identifiers, -and that the full list of language identifiers can be obtained -with: - - pygmentize -L lexers" - :group 'org-export-latex - :type '(repeat - (list - (symbol :tag "Major mode ") - (string :tag "Minted language")))) - -(defcustom org-latex-minted-options nil - "Association list of options for the latex minted package. - -These options are supplied within square brackets in -\\begin{minted} environments. Each element of the alist should -be a list containing two strings: the name of the option, and the -value. For example, - - \(setq org-latex-minted-options - '\((\"bgcolor\" \"bg\") \(\"frame\" \"lines\"))) - -will result in src blocks being exported with - -\\begin{minted}[bgcolor=bg,frame=lines]{} - -as the start of the minted environment. Note that the same -options will be applied to blocks of all languages." - :group 'org-export-latex - :type '(repeat - (list - (string :tag "Minted option name ") - (string :tag "Minted option value")))) - -(defvar org-latex-custom-lang-environments nil - "Alist mapping languages to language-specific LaTeX environments. - -It is used during export of src blocks by the listings and minted -latex packages. For example, - - \(setq org-latex-custom-lang-environments - '\(\(python \"pythoncode\"\)\)\) - -would have the effect that if org encounters begin_src python -during latex export it will output - - \\begin{pythoncode} - - \\end{pythoncode}") - - -;;;; Compilation - -(defcustom org-latex-pdf-process - '("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f") - "Commands to process a LaTeX file to a PDF file. -This is a list of strings, each of them will be given to the -shell as a command. %f in the command will be replaced by the -full file name, %b by the file base name (i.e. without directory -and extension parts) and %o by the base directory of the file. - -The reason why this is a list is that it usually takes several -runs of `pdflatex', maybe mixed with a call to `bibtex'. Org -does not have a clever mechanism to detect which of these -commands have to be run to get to a stable result, and it also -does not do any error checking. - -By default, Org uses 3 runs of `pdflatex' to do the processing. -If you have texi2dvi on your system and if that does not cause -the infamous egrep/locale bug: - - http://lists.gnu.org/archive/html/bug-texinfo/2010-03/msg00031.html - -then `texi2dvi' is the superior choice as it automates the LaTeX -build process by calling the \"correct\" combinations of -auxiliary programs. Org does offer `texi2dvi' as one of the -customize options. Alternatively, `rubber' and `latexmk' also -provide similar functionality. The latter supports `biber' out -of the box. - -Alternatively, this may be a Lisp function that does the -processing, so you could use this to apply the machinery of -AUCTeX or the Emacs LaTeX mode. This function should accept the -file name as its single argument." - :group 'org-export-pdf - :type '(choice - (repeat :tag "Shell command sequence" - (string :tag "Shell command")) - (const :tag "2 runs of pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "3 runs of pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "pdflatex,bibtex,pdflatex,pdflatex" - ("pdflatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "pdflatex -interaction nonstopmode -output-directory %o %f" - "pdflatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "2 runs of xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "3 runs of xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "xelatex,bibtex,xelatex,xelatex" - ("xelatex -interaction nonstopmode -output-directory %o %f" - "bibtex %b" - "xelatex -interaction nonstopmode -output-directory %o %f" - "xelatex -interaction nonstopmode -output-directory %o %f")) - (const :tag "texi2dvi" - ("texi2dvi -p -b -V %f")) - (const :tag "rubber" - ("rubber -d --into %o %f")) - (const :tag "latexmk" - ("latexmk -g -pdf %f")) - (function))) - -(defcustom org-latex-logfiles-extensions - '("aux" "idx" "log" "out" "toc" "nav" "snm" "vrb") - "The list of file extensions to consider as LaTeX logfiles. -The logfiles will be remove if `org-latex-remove-logfiles' is -non-nil." - :group 'org-export-latex - :type '(repeat (string :tag "Extension"))) - -(defcustom org-latex-remove-logfiles t - "Non-nil means remove the logfiles produced by PDF production. -By default, logfiles are files with these extensions: .aux, .idx, -.log, .out, .toc, .nav, .snm and .vrb. To define the set of -logfiles to remove, set `org-latex-logfiles-extensions'." - :group 'org-export-latex - :type 'boolean) - -(defcustom org-latex-known-errors - '(("Reference.*?undefined" . "[undefined reference]") - ("Citation.*?undefined" . "[undefined citation]") - ("Undefined control sequence" . "[undefined control sequence]") - ("^! LaTeX.*?Error" . "[LaTeX error]") - ("^! Package.*?Error" . "[package error]") - ("Runaway argument" . "Runaway argument")) - "Alist of regular expressions and associated messages for the user. -The regular expressions are used to find possible errors in the -log of a latex-run." - :group 'org-export-latex - :version "24.4" - :package-version '(Org . "8.0") - :type '(repeat - (cons - (string :tag "Regexp") - (string :tag "Message")))) - - - -;;; Internal Functions - -(defun org-latex--caption/label-string (element info) - "Return caption and label LaTeX string for ELEMENT. - -INFO is a plist holding contextual information. If there's no -caption nor label, return the empty string. - -For non-floats, see `org-latex--wrap-label'." - (let* ((label (org-element-property :name element)) - (label-str (if (not (org-string-nw-p label)) "" - (format "\\label{%s}" - (org-export-solidify-link-text label)))) - (main (org-export-get-caption element)) - (short (org-export-get-caption element t)) - (caption-from-attr-latex (org-export-read-attribute :attr_latex element :caption))) - (cond - ((org-string-nw-p caption-from-attr-latex) - (concat caption-from-attr-latex "\n")) - ((and (not main) (equal label-str "")) "") - ((not main) (concat label-str "\n")) - ;; Option caption format with short name. - (short (format "\\caption[%s]{%s%s}\n" - (org-export-data short info) - label-str - (org-export-data main info))) - ;; Standard caption format. - (t (format "\\caption{%s%s}\n" label-str (org-export-data main info)))))) - -(defun org-latex-guess-inputenc (header) - "Set the coding system in inputenc to what the buffer is. - -HEADER is the LaTeX header string. This function only applies -when specified inputenc option is \"AUTO\". - -Return the new header, as a string." - (let* ((cs (or (ignore-errors - (latexenc-coding-system-to-inputenc - (or org-export-coding-system buffer-file-coding-system))) - "utf8"))) - (if (not cs) header - ;; First translate if that is requested. - (setq cs (or (cdr (assoc cs org-latex-inputenc-alist)) cs)) - ;; Then find the \usepackage statement and replace the option. - (replace-regexp-in-string "\\\\usepackage\\[\\(AUTO\\)\\]{inputenc}" - cs header t nil 1)))) - -(defun org-latex-guess-babel-language (header info) - "Set Babel's language according to LANGUAGE keyword. - -HEADER is the LaTeX header string. INFO is the plist used as -a communication channel. - -Insertion of guessed language only happens when Babel package has -explicitly been loaded. Then it is added to the rest of -package's options. - -The argument to Babel may be \"AUTO\" which is then replaced with -the language of the document or `org-export-default-language' -unless language in question is already loaded. - -Return the new header." - (let ((language-code (plist-get info :language))) - ;; If no language is set or Babel package is not loaded, return - ;; HEADER as-is. - (if (or (not (stringp language-code)) - (not (string-match "\\\\usepackage\\[\\(.*\\)\\]{babel}" header))) - header - (let ((options (save-match-data - (org-split-string (match-string 1 header) ",[ \t]*"))) - (language (cdr (assoc language-code - org-latex-babel-language-alist)))) - ;; If LANGUAGE is already loaded, return header without AUTO. - ;; Otherwise, replace AUTO with language or append language if - ;; AUTO is not present. - (replace-match - (mapconcat (lambda (option) (if (equal "AUTO" option) language option)) - (cond ((member language options) (delete "AUTO" options)) - ((member "AUTO" options) options) - (t (append options (list language)))) - ", ") - t nil header 1))))) - -(defun org-latex--find-verb-separator (s) - "Return a character not used in string S. -This is used to choose a separator for constructs like \\verb." - (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) - (loop for c across ll - when (not (string-match (regexp-quote (char-to-string c)) s)) - return (char-to-string c)))) - -(defun org-latex--make-option-string (options) - "Return a comma separated string of keywords and values. -OPTIONS is an alist where the key is the options keyword as -a string, and the value a list containing the keyword value, or -nil." - (mapconcat (lambda (pair) - (concat (first pair) - (when (> (length (second pair)) 0) - (concat "=" (second pair))))) - options - ",")) - -(defun org-latex--wrap-label (element output) - "Wrap label associated to ELEMENT around OUTPUT, if appropriate. -This function shouldn't be used for floats. See -`org-latex--caption/label-string'." - (let ((label (org-element-property :name element))) - (if (not (and (org-string-nw-p output) (org-string-nw-p label))) output - (concat (format "\\label{%s}\n" (org-export-solidify-link-text label)) - output)))) - -(defun org-latex--text-markup (text markup) - "Format TEXT depending on MARKUP text markup. -See `org-latex-text-markup-alist' for details." - (let ((fmt (cdr (assq markup org-latex-text-markup-alist)))) - (cond - ;; No format string: Return raw text. - ((not fmt) text) - ;; Handle the `verb' special case: Find and appropriate separator - ;; and use "\\verb" command. - ((eq 'verb fmt) - (let ((separator (org-latex--find-verb-separator text))) - (concat "\\verb" separator text separator))) - ;; Handle the `protectedtexttt' special case: Protect some - ;; special chars and use "\texttt{%s}" format string. - ((eq 'protectedtexttt fmt) - (let ((start 0) - (trans '(("\\" . "\\textbackslash{}") - ("~" . "\\textasciitilde{}") - ("^" . "\\textasciicircum{}"))) - (rtn "") - char) - (while (string-match "[\\{}$%&_#~^]" text) - (setq char (match-string 0 text)) - (if (> (match-beginning 0) 0) - (setq rtn (concat rtn (substring text 0 (match-beginning 0))))) - (setq text (substring text (1+ (match-beginning 0)))) - (setq char (or (cdr (assoc char trans)) (concat "\\" char)) - rtn (concat rtn char))) - (setq text (concat rtn text) - fmt "\\texttt{%s}") - (while (string-match "--" text) - (setq text (replace-match "-{}-" t t text))) - (format fmt text))) - ;; Else use format string. - (t (format fmt text))))) - -(defun org-latex--delayed-footnotes-definitions (element info) - "Return footnotes definitions in ELEMENT as a string. - -INFO is a plist used as a communication channel. - -Footnotes definitions are returned within \"\\footnotetxt{}\" -commands. - -This function is used within constructs that don't support -\"\\footnote{}\" command (i.e. an item's tag). In that case, -\"\\footnotemark\" is used within the construct and the function -just outside of it." - (mapconcat - (lambda (ref) - (format - "\\footnotetext[%s]{%s}" - (org-export-get-footnote-number ref info) - (org-trim - (org-export-data - (org-export-get-footnote-definition ref info) info)))) - ;; Find every footnote reference in ELEMENT. - (let* (all-refs - search-refs ; For byte-compiler. - (search-refs - (function - (lambda (data) - ;; Return a list of all footnote references never seen - ;; before in DATA. - (org-element-map data 'footnote-reference - (lambda (ref) - (when (org-export-footnote-first-reference-p ref info) - (push ref all-refs) - (when (eq (org-element-property :type ref) 'standard) - (funcall search-refs - (org-export-get-footnote-definition ref info))))) - info) - (reverse all-refs))))) - (funcall search-refs element)) - "")) - - - -;;; Template - -(defun org-latex-template (contents info) - "Return complete document string after LaTeX conversion. -CONTENTS is the transcoded contents string. INFO is a plist -holding export options." - (let ((title (org-export-data (plist-get info :title) info))) - (concat - ;; Time-stamp. - (and (plist-get info :time-stamp-file) - (format-time-string "%% Created %Y-%m-%d %a %H:%M\n")) - ;; Document class and packages. - (let* ((class (plist-get info :latex-class)) - (class-options (plist-get info :latex-class-options)) - (header (nth 1 (assoc class org-latex-classes))) - (document-class-string - (and (stringp header) - (if (not class-options) header - (replace-regexp-in-string - "^[ \t]*\\\\documentclass\\(\\(\\[[^]]*\\]\\)?\\)" - class-options header t nil 1))))) - (if (not document-class-string) - (user-error "Unknown LaTeX class `%s'" class) - (org-latex-guess-babel-language - (org-latex-guess-inputenc - (org-element-normalize-string - (org-splice-latex-header - document-class-string - org-latex-default-packages-alist - org-latex-packages-alist nil - (concat (org-element-normalize-string - (plist-get info :latex-header)) - (plist-get info :latex-header-extra))))) - info))) - ;; Possibly limit depth for headline numbering. - (let ((sec-num (plist-get info :section-numbers))) - (when (integerp sec-num) - (format "\\setcounter{secnumdepth}{%d}\n" sec-num))) - ;; Author. - (let ((author (and (plist-get info :with-author) - (let ((auth (plist-get info :author))) - (and auth (org-export-data auth info))))) - (email (and (plist-get info :with-email) - (org-export-data (plist-get info :email) info)))) - (cond ((and author email (not (string= "" email))) - (format "\\author{%s\\thanks{%s}}\n" author email)) - ((or author email) (format "\\author{%s}\n" (or author email))))) - ;; Date. - (let ((date (and (plist-get info :with-date) (org-export-get-date info)))) - (format "\\date{%s}\n" (org-export-data date info))) - ;; Title - (format "\\title{%s}\n" title) - ;; Hyperref options. - (when (plist-get info :latex-hyperref-p) - (format "\\hypersetup{\n pdfkeywords={%s},\n pdfsubject={%s},\n pdfcreator={%s}}\n" - (or (plist-get info :keywords) "") - (or (plist-get info :description) "") - (if (not (plist-get info :with-creator)) "" - (plist-get info :creator)))) - ;; Document start. - "\\begin{document}\n\n" - ;; Title command. - (org-element-normalize-string - (cond ((string= "" title) nil) - ((not (stringp org-latex-title-command)) nil) - ((string-match "\\(?:[^%]\\|^\\)%s" - org-latex-title-command) - (format org-latex-title-command title)) - (t org-latex-title-command))) - ;; Table of contents. - (let ((depth (plist-get info :with-toc))) - (when depth - (concat (when (wholenump depth) - (format "\\setcounter{tocdepth}{%d}\n" depth)) - org-latex-toc-command))) - ;; Document's body. - contents - ;; Creator. - (let ((creator-info (plist-get info :with-creator))) - (cond - ((not creator-info) "") - ((eq creator-info 'comment) - (format "%% %s\n" (plist-get info :creator))) - (t (concat (plist-get info :creator) "\n")))) - ;; Document end. - "\\end{document}"))) - - - -;;; Transcode Functions - -;;;; Bold - -(defun org-latex-bold (bold contents info) - "Transcode BOLD from Org to LaTeX. -CONTENTS is the text with bold markup. INFO is a plist holding -contextual information." - (org-latex--text-markup contents 'bold)) - - -;;;; Center Block - -(defun org-latex-center-block (center-block contents info) - "Transcode a CENTER-BLOCK element from Org to LaTeX. -CONTENTS holds the contents of the center block. INFO is a plist -holding contextual information." - (org-latex--wrap-label - center-block - (format "\\begin{center}\n%s\\end{center}" contents))) - - -;;;; Clock - -(defun org-latex-clock (clock contents info) - "Transcode a CLOCK element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual -information." - (concat - "\\noindent" - (format "\\textbf{%s} " org-clock-string) - (format org-latex-inactive-timestamp-format - (concat (org-translate-time - (org-element-property :raw-value - (org-element-property :value clock))) - (let ((time (org-element-property :duration clock))) - (and time (format " (%s)" time))))) - "\\\\")) - - -;;;; Code - -(defun org-latex-code (code contents info) - "Transcode a CODE object from Org to LaTeX. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (org-latex--text-markup (org-element-property :value code) 'code)) - - -;;;; Drawer - -(defun org-latex-drawer (drawer contents info) - "Transcode a DRAWER element from Org to LaTeX. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let* ((name (org-element-property :drawer-name drawer)) - (output (funcall org-latex-format-drawer-function - name contents))) - (org-latex--wrap-label drawer output))) - - -;;;; Dynamic Block - -(defun org-latex-dynamic-block (dynamic-block contents info) - "Transcode a DYNAMIC-BLOCK element from Org to LaTeX. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information. See `org-export-data'." - (org-latex--wrap-label dynamic-block contents)) - - -;;;; Entity - -(defun org-latex-entity (entity contents info) - "Transcode an ENTITY object from Org to LaTeX. -CONTENTS are the definition itself. INFO is a plist holding -contextual information." - (let ((ent (org-element-property :latex entity))) - (if (org-element-property :latex-math-p entity) (format "$%s$" ent) ent))) - - -;;;; Example Block - -(defun org-latex-example-block (example-block contents info) - "Transcode an EXAMPLE-BLOCK element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual -information." - (when (org-string-nw-p (org-element-property :value example-block)) - (org-latex--wrap-label - example-block - (format "\\begin{verbatim}\n%s\\end{verbatim}" - (org-export-format-code-default example-block info))))) - - -;;;; Export Block - -(defun org-latex-export-block (export-block contents info) - "Transcode a EXPORT-BLOCK element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (member (org-element-property :type export-block) '("LATEX" "TEX")) - (org-remove-indentation (org-element-property :value export-block)))) - - -;;;; Export Snippet - -(defun org-latex-export-snippet (export-snippet contents info) - "Transcode a EXPORT-SNIPPET object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (eq (org-export-snippet-backend export-snippet) 'latex) - (org-element-property :value export-snippet))) - - -;;;; Fixed Width - -(defun org-latex-fixed-width (fixed-width contents info) - "Transcode a FIXED-WIDTH element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-latex--wrap-label - fixed-width - (format "\\begin{verbatim}\n%s\\end{verbatim}" - (org-remove-indentation - (org-element-property :value fixed-width))))) - - -;;;; Footnote Reference - -(defun org-latex-footnote-reference (footnote-reference contents info) - "Transcode a FOOTNOTE-REFERENCE element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (concat - ;; Insert separator between two footnotes in a row. - (let ((prev (org-export-get-previous-element footnote-reference info))) - (when (eq (org-element-type prev) 'footnote-reference) - org-latex-footnote-separator)) - (cond - ;; Use \footnotemark if the footnote has already been defined. - ((not (org-export-footnote-first-reference-p footnote-reference info)) - (format "\\footnotemark[%s]{}" - (org-export-get-footnote-number footnote-reference info))) - ;; Use \footnotemark if reference is within another footnote - ;; reference, footnote definition or table cell. - ((loop for parent in (org-export-get-genealogy footnote-reference) - thereis (memq (org-element-type parent) - '(footnote-reference footnote-definition table-cell))) - "\\footnotemark") - ;; Otherwise, define it with \footnote command. - (t - (let ((def (org-export-get-footnote-definition footnote-reference info))) - (concat - (format "\\footnote{%s}" (org-trim (org-export-data def info))) - ;; Retrieve all footnote references within the footnote and - ;; add their definition after it, since LaTeX doesn't support - ;; them inside. - (org-latex--delayed-footnotes-definitions def info))))))) - - -;;;; Headline - -(defun org-latex-headline (headline contents info) - "Transcode a HEADLINE element from Org to LaTeX. -CONTENTS holds the contents of the headline. INFO is a plist -holding contextual information." - (unless (org-element-property :footnote-section-p headline) - (let* ((class (plist-get info :latex-class)) - (level (org-export-get-relative-level headline info)) - (numberedp (org-export-numbered-headline-p headline info)) - (class-sectionning (assoc class org-latex-classes)) - ;; Section formatting will set two placeholders: one for - ;; the title and the other for the contents. - (section-fmt - (let ((sec (if (functionp (nth 2 class-sectionning)) - (funcall (nth 2 class-sectionning) level numberedp) - (nth (1+ level) class-sectionning)))) - (cond - ;; No section available for that LEVEL. - ((not sec) nil) - ;; Section format directly returned by a function. Add - ;; placeholder for contents. - ((stringp sec) (concat sec "\n%s")) - ;; (numbered-section . unnumbered-section) - ((not (consp (cdr sec))) - (concat (funcall (if numberedp #'car #'cdr) sec) "\n%s")) - ;; (numbered-open numbered-close) - ((= (length sec) 2) - (when numberedp (concat (car sec) "\n%s" (nth 1 sec)))) - ;; (num-in num-out no-num-in no-num-out) - ((= (length sec) 4) - (if numberedp (concat (car sec) "\n%s" (nth 1 sec)) - (concat (nth 2 sec) "\n%s" (nth 3 sec))))))) - (text (org-export-data (org-element-property :title headline) info)) - (todo - (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword headline))) - (and todo (org-export-data todo info))))) - (todo-type (and todo (org-element-property :todo-type headline))) - (tags (and (plist-get info :with-tags) - (org-export-get-tags headline info))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority headline))) - ;; Create the headline text along with a no-tag version. - ;; The latter is required to remove tags from toc. - (full-text (funcall org-latex-format-headline-function - todo todo-type priority text tags)) - ;; Associate \label to the headline for internal links. - (headline-label - (format "\\label{sec-%s}\n" - (mapconcat 'number-to-string - (org-export-get-headline-number headline info) - "-"))) - (pre-blanks - (make-string (org-element-property :pre-blank headline) 10))) - (if (or (not section-fmt) (org-export-low-level-p headline info)) - ;; This is a deep sub-tree: export it as a list item. Also - ;; export as items headlines for which no section format has - ;; been found. - (let ((low-level-body - (concat - ;; If headline is the first sibling, start a list. - (when (org-export-first-sibling-p headline info) - (format "\\begin{%s}\n" (if numberedp 'enumerate 'itemize))) - ;; Itemize headline - "\\item " full-text "\n" headline-label pre-blanks contents))) - ;; If headline is not the last sibling simply return - ;; LOW-LEVEL-BODY. Otherwise, also close the list, before - ;; any blank line. - (if (not (org-export-last-sibling-p headline info)) low-level-body - (replace-regexp-in-string - "[ \t\n]*\\'" - (format "\n\\\\end{%s}" (if numberedp 'enumerate 'itemize)) - low-level-body))) - ;; This is a standard headline. Export it as a section. Add - ;; an alternative heading when possible, and when this is not - ;; identical to the usual heading. - (let ((opt-title - (funcall org-latex-format-headline-function - todo todo-type priority - (org-export-data - (org-export-get-alt-title headline info) info) - (and (eq (plist-get info :with-tags) t) tags)))) - (if (and numberedp opt-title - (not (equal opt-title full-text)) - (string-match "\\`\\\\\\(.*?[^*]\\){" section-fmt)) - (format (replace-match "\\1[%s]" nil nil section-fmt 1) - ;; Replace square brackets with parenthesis - ;; since square brackets are not supported in - ;; optional arguments. - (replace-regexp-in-string - "\\[" "(" (replace-regexp-in-string "\\]" ")" opt-title)) - full-text - (concat headline-label pre-blanks contents)) - ;; Impossible to add an alternative heading. Fallback to - ;; regular sectioning format string. - (format section-fmt full-text - (concat headline-label pre-blanks contents)))))))) - -(defun org-latex-format-headline-default-function - (todo todo-type priority text tags) - "Default format function for a headline. -See `org-latex-format-headline-function' for details." - (concat - (and todo (format "{\\bfseries\\sffamily %s} " todo)) - (and priority (format "\\framebox{\\#%c} " priority)) - text - (and tags - (format "\\hfill{}\\textsc{%s}" (mapconcat 'identity tags ":"))))) - - -;;;; Horizontal Rule - -(defun org-latex-horizontal-rule (horizontal-rule contents info) - "Transcode an HORIZONTAL-RULE object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((attr (org-export-read-attribute :attr_latex horizontal-rule)) - (prev (org-export-get-previous-element horizontal-rule info))) - (concat - ;; Make sure the rule doesn't start at the end of the current - ;; line by separating it with a blank line from previous element. - (when (and prev - (let ((prev-blank (org-element-property :post-blank prev))) - (or (not prev-blank) (zerop prev-blank)))) - "\n") - (org-latex--wrap-label - horizontal-rule - (format "\\rule{%s}{%s}" - (or (plist-get attr :width) "\\linewidth") - (or (plist-get attr :thickness) "0.5pt")))))) - - -;;;; Inline Src Block - -(defun org-latex-inline-src-block (inline-src-block contents info) - "Transcode an INLINE-SRC-BLOCK element from Org to LaTeX. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((code (org-element-property :value inline-src-block)) - (separator (org-latex--find-verb-separator code))) - (cond - ;; Do not use a special package: transcode it verbatim. - ((not org-latex-listings) - (concat "\\verb" separator code separator)) - ;; Use minted package. - ((eq org-latex-listings 'minted) - (let* ((org-lang (org-element-property :language inline-src-block)) - (mint-lang (or (cadr (assq (intern org-lang) - org-latex-minted-langs)) - org-lang)) - (options (org-latex--make-option-string - org-latex-minted-options))) - (concat (format "\\mint%s{%s}" - (if (string= options "") "" (format "[%s]" options)) - mint-lang) - separator code separator))) - ;; Use listings package. - (t - ;; Maybe translate language's name. - (let* ((org-lang (org-element-property :language inline-src-block)) - (lst-lang (or (cadr (assq (intern org-lang) - org-latex-listings-langs)) - org-lang)) - (options (org-latex--make-option-string - (append org-latex-listings-options - `(("language" ,lst-lang)))))) - (concat (format "\\lstinline[%s]" options) - separator code separator)))))) - - -;;;; Inlinetask - -(defun org-latex-inlinetask (inlinetask contents info) - "Transcode an INLINETASK element from Org to LaTeX. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let ((title (org-export-data (org-element-property :title inlinetask) info)) - (todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword inlinetask))) - (and todo (org-export-data todo info))))) - (todo-type (org-element-property :todo-type inlinetask)) - (tags (and (plist-get info :with-tags) - (org-export-get-tags inlinetask info))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority inlinetask)))) - ;; If `org-latex-format-inlinetask-function' is provided, call it - ;; with appropriate arguments. - (if (not (eq org-latex-format-inlinetask-function 'ignore)) - (funcall org-latex-format-inlinetask-function - todo todo-type priority title tags contents) - ;; Otherwise, use a default template. - (org-latex--wrap-label - inlinetask - (let ((full-title - (concat - (when todo (format "\\textbf{\\textsf{\\textsc{%s}}} " todo)) - (when priority (format "\\framebox{\\#%c} " priority)) - title - (when tags (format "\\hfill{}\\textsc{:%s:}" - (mapconcat 'identity tags ":")))))) - (format (concat "\\begin{center}\n" - "\\fbox{\n" - "\\begin{minipage}[c]{.6\\textwidth}\n" - "%s\n\n" - "\\rule[.8em]{\\textwidth}{2pt}\n\n" - "%s" - "\\end{minipage}\n" - "}\n" - "\\end{center}") - full-title contents)))))) - - -;;;; Italic - -(defun org-latex-italic (italic contents info) - "Transcode ITALIC from Org to LaTeX. -CONTENTS is the text with italic markup. INFO is a plist holding -contextual information." - (org-latex--text-markup contents 'italic)) - - -;;;; Item - -(defun org-latex-item (item contents info) - "Transcode an ITEM element from Org to LaTeX. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((counter - (let ((count (org-element-property :counter item)) - (level - ;; Determine level of current item to determine the - ;; correct LaTeX counter to use (enumi, enumii...). - (let ((parent item) (level 0)) - (while (memq (org-element-type - (setq parent (org-export-get-parent parent))) - '(plain-list item)) - (when (and (eq (org-element-type parent) 'plain-list) - (eq (org-element-property :type parent) - 'ordered)) - (incf level))) - level))) - (and count - (< level 5) - (format "\\setcounter{enum%s}{%s}\n" - (nth (1- level) '("i" "ii" "iii" "iv")) - (1- count))))) - (checkbox (case (org-element-property :checkbox item) - (on "$\\boxtimes$ ") - (off "$\\square$ ") - (trans "$\\boxminus$ "))) - (tag (let ((tag (org-element-property :tag item))) - ;; Check-boxes must belong to the tag. - (and tag (format "[{%s}] " - (concat checkbox - (org-export-data tag info))))))) - (concat counter "\\item" (or tag (concat " " checkbox)) - (and contents (org-trim contents)) - ;; If there are footnotes references in tag, be sure to - ;; add their definition at the end of the item. This - ;; workaround is necessary since "\footnote{}" command is - ;; not supported in tags. - (and tag - (org-latex--delayed-footnotes-definitions - (org-element-property :tag item) info))))) - - -;;;; Keyword - -(defun org-latex-keyword (keyword contents info) - "Transcode a KEYWORD element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((key (org-element-property :key keyword)) - (value (org-element-property :value keyword))) - (cond - ((string= key "LATEX") value) - ((string= key "INDEX") (format "\\index{%s}" value)) - ((string= key "TOC") - (let ((value (downcase value))) - (cond - ((string-match "\\" value) - (let ((depth (or (and (string-match "[0-9]+" value) - (string-to-number (match-string 0 value))) - (plist-get info :with-toc)))) - (concat - (when (wholenump depth) - (format "\\setcounter{tocdepth}{%s}\n" depth)) - "\\tableofcontents"))) - ((string= "tables" value) "\\listoftables") - ((string= "listings" value) - (cond - ((eq org-latex-listings 'minted) "\\listoflistings") - (org-latex-listings "\\lstlistoflistings") - ;; At the moment, src blocks with a caption are wrapped - ;; into a figure environment. - (t "\\listoffigures"))))))))) - - -;;;; Latex Environment - -(defun org-latex-latex-environment (latex-environment contents info) - "Transcode a LATEX-ENVIRONMENT element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (plist-get info :with-latex) - (let ((label (org-element-property :name latex-environment)) - (value (org-remove-indentation - (org-element-property :value latex-environment)))) - (if (not (org-string-nw-p label)) value - ;; Environment is labelled: label must be within the environment - ;; (otherwise, a reference pointing to that element will count - ;; the section instead). - (with-temp-buffer - (insert value) - (goto-char (point-min)) - (forward-line) - (insert - (format "\\label{%s}\n" (org-export-solidify-link-text label))) - (buffer-string)))))) - - -;;;; Latex Fragment - -(defun org-latex-latex-fragment (latex-fragment contents info) - "Transcode a LATEX-FRAGMENT object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (plist-get info :with-latex) - (org-element-property :value latex-fragment))) - - -;;;; Line Break - -(defun org-latex-line-break (line-break contents info) - "Transcode a LINE-BREAK object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - "\\\\\n") - - -;;;; Link - -(defun org-latex--inline-image (link info) - "Return LaTeX code for an inline image. -LINK is the link pointing to the inline image. INFO is a plist -used as a communication channel." - (let* ((parent (org-export-get-parent-element link)) - (path (let ((raw-path (org-element-property :path link))) - (if (not (file-name-absolute-p raw-path)) raw-path - (expand-file-name raw-path)))) - (filetype (file-name-extension path)) - (caption (org-latex--caption/label-string parent info)) - ;; Retrieve latex attributes from the element around. - (attr (org-export-read-attribute :attr_latex parent)) - (float (let ((float (plist-get attr :float))) - (cond ((and (not float) (plist-member attr :float)) nil) - ((string= float "wrap") 'wrap) - ((string= float "multicolumn") 'multicolumn) - ((or float - (org-element-property :caption parent) - (org-string-nw-p (plist-get attr :caption))) - 'figure)))) - (placement - (let ((place (plist-get attr :placement))) - (cond (place (format "%s" place)) - ((eq float 'wrap) "{l}{0.5\\textwidth}") - ((eq float 'figure) - (format "[%s]" org-latex-default-figure-position)) - (t "")))) - (comment-include (if (plist-get attr :comment-include) "%" "")) - ;; It is possible to specify width and height in the - ;; ATTR_LATEX line, and also via default variables. - (width (cond ((plist-get attr :width)) - ((plist-get attr :height) "") - ((eq float 'wrap) "0.48\\textwidth") - (t org-latex-image-default-width))) - (height (cond ((plist-get attr :height)) - ((or (plist-get attr :width) - (memq float '(figure wrap))) "") - (t org-latex-image-default-height))) - (options (let ((opt (or (plist-get attr :options) - org-latex-image-default-option))) - (if (not (string-match "\\`\\[\\(.*\\)\\]\\'" opt)) opt - (match-string 1 opt)))) - image-code) - (if (member filetype '("tikz" "pgf")) - ;; For tikz images: - ;; - use \input to read in image file. - ;; - if options are present, wrap in a tikzpicture environment. - ;; - if width or height are present, use \resizebox to change - ;; the image size. - (progn - (setq image-code (format "\\input{%s}" path)) - (when (org-string-nw-p options) - (setq image-code - (format "\\begin{tikzpicture}[%s]\n%s\n\\end{tikzpicture}" - options - image-code))) - (when (or (org-string-nw-p width) (org-string-nw-p height)) - (setq image-code (format "\\resizebox{%s}{%s}{%s}" - (if (org-string-nw-p width) width "!") - (if (org-string-nw-p height) height "!") - image-code)))) - ;; For other images: - ;; - add width and height to options. - ;; - include the image with \includegraphics. - (when (org-string-nw-p width) - (setq options (concat options ",width=" width))) - (when (org-string-nw-p height) - (setq options (concat options ",height=" height))) - (setq image-code - (format "\\includegraphics%s{%s}" - (cond ((not (org-string-nw-p options)) "") - ((= (aref options 0) ?,) - (format "[%s]"(substring options 1))) - (t (format "[%s]" options))) - path)) - (when (equal filetype "svg") - (setq image-code (replace-regexp-in-string "^\\\\includegraphics" - "\\includesvg" - image-code - nil t)) - (setq image-code (replace-regexp-in-string "\\.svg}" - "}" - image-code - nil t)))) - ;; Return proper string, depending on FLOAT. - (case float - (wrap (format "\\begin{wrapfigure}%s -\\centering -%s%s -%s\\end{wrapfigure}" placement comment-include image-code caption)) - (multicolumn (format "\\begin{figure*}%s -\\centering -%s%s -%s\\end{figure*}" placement comment-include image-code caption)) - (figure (format "\\begin{figure}%s -\\centering -%s%s -%s\\end{figure}" placement comment-include image-code caption)) - (otherwise image-code)))) - -(defun org-latex-link (link desc info) - "Transcode a LINK object from Org to LaTeX. - -DESC is the description part of the link, or the empty string. -INFO is a plist holding contextual information. See -`org-export-data'." - (let* ((type (org-element-property :type link)) - (raw-path (org-element-property :path link)) - ;; Ensure DESC really exists, or set it to nil. - (desc (and (not (string= desc "")) desc)) - (imagep (org-export-inline-image-p - link org-latex-inline-image-rules)) - (path (cond - ((member type '("http" "https" "ftp" "mailto")) - (concat type ":" raw-path)) - ((string= type "file") - (if (not (file-name-absolute-p raw-path)) raw-path - (concat "file://" (expand-file-name raw-path)))) - (t raw-path))) - protocol) - (cond - ;; Image file. - (imagep (org-latex--inline-image link info)) - ;; Radio link: Transcode target's contents and use them as link's - ;; description. - ((string= type "radio") - (let ((destination (org-export-resolve-radio-link link info))) - (when destination - (format "\\hyperref[%s]{%s}" - (org-export-solidify-link-text path) - (org-export-data (org-element-contents destination) info))))) - ;; Links pointing to a headline: Find destination and build - ;; appropriate referencing command. - ((member type '("custom-id" "fuzzy" "id")) - (let ((destination (if (string= type "fuzzy") - (org-export-resolve-fuzzy-link link info) - (org-export-resolve-id-link link info)))) - (case (org-element-type destination) - ;; Id link points to an external file. - (plain-text - (if desc (format "\\href{%s}{%s}" destination desc) - (format "\\url{%s}" destination))) - ;; Fuzzy link points nowhere. - ('nil - (format org-latex-link-with-unknown-path-format - (or desc - (org-export-data - (org-element-property :raw-link link) info)))) - ;; LINK points to a headline. If headlines are numbered - ;; and the link has no description, display headline's - ;; number. Otherwise, display description or headline's - ;; title. - (headline - (let ((label - (format "sec-%s" - (mapconcat - 'number-to-string - (org-export-get-headline-number destination info) - "-")))) - (if (and (plist-get info :section-numbers) (not desc)) - (format "\\ref{%s}" label) - (format "\\hyperref[%s]{%s}" label - (or desc - (org-export-data - (org-element-property :title destination) info)))))) - ;; Fuzzy link points to a target. Do as above. - (otherwise - (let ((path (org-export-solidify-link-text path))) - (if (not desc) (format "\\ref{%s}" path) - (format "\\hyperref[%s]{%s}" path desc))))))) - ;; Coderef: replace link with the reference name or the - ;; equivalent line number. - ((string= type "coderef") - (format (org-export-get-coderef-format path desc) - (org-export-resolve-coderef path info))) - ;; Link type is handled by a special function. - ((functionp (setq protocol (nth 2 (assoc type org-link-protocols)))) - (funcall protocol (org-link-unescape path) desc 'latex)) - ;; External link with a description part. - ((and path desc) (format "\\href{%s}{%s}" path desc)) - ;; External link without a description part. - (path (format "\\url{%s}" path)) - ;; No path, only description. Try to do something useful. - (t (format org-latex-link-with-unknown-path-format desc))))) - - -;;;; Paragraph - -(defun org-latex-paragraph (paragraph contents info) - "Transcode a PARAGRAPH element from Org to LaTeX. -CONTENTS is the contents of the paragraph, as a string. INFO is -the plist used as a communication channel." - contents) - - -;;;; Plain List - -(defun org-latex-plain-list (plain-list contents info) - "Transcode a PLAIN-LIST element from Org to LaTeX. -CONTENTS is the contents of the list. INFO is a plist holding -contextual information." - (let* ((type (org-element-property :type plain-list)) - (attr (org-export-read-attribute :attr_latex plain-list)) - (latex-type (let ((env (plist-get attr :environment))) - (cond (env (format "%s" env)) - ((eq type 'ordered) "enumerate") - ((eq type 'unordered) "itemize") - ((eq type 'descriptive) "description"))))) - (org-latex--wrap-label - plain-list - (format "\\begin{%s}%s\n%s\\end{%s}" - latex-type - ;; Put optional arguments, if any inside square brackets - ;; when necessary. - (let ((options (format "%s" (or (plist-get attr :options) "")))) - (cond ((equal options "") "") - ((string-match "\\`\\[.*\\]\\'" options) options) - (t (format "[%s]" options)))) - contents - latex-type)))) - - -;;;; Plain Text - -(defun org-latex-plain-text (text info) - "Transcode a TEXT string from Org to LaTeX. -TEXT is the string to transcode. INFO is a plist holding -contextual information." - (let ((specialp (plist-get info :with-special-strings)) - (output text)) - ;; Protect %, #, &, $, _, { and }. - (while (string-match "\\([^\\]\\|^\\)\\([%$#&{}_]\\)" output) - (setq output - (replace-match - (format "\\%s" (match-string 2 output)) nil t output 2))) - ;; Protect ^. - (setq output - (replace-regexp-in-string - "\\([^\\]\\|^\\)\\(\\^\\)" "\\\\^{}" output nil nil 2)) - ;; Protect \. If special strings are used, be careful not to - ;; protect "\" in "\-" constructs. - (let ((symbols (if specialp "-%$#&{}^_\\" "%$#&{}^_\\"))) - (setq output - (replace-regexp-in-string - (format "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%s]\\|$\\)" symbols) - "$\\backslash$" output nil t 1))) - ;; Protect ~. - (setq output - (replace-regexp-in-string - "\\([^\\]\\|^\\)\\(~\\)" "\\textasciitilde{}" output nil t 2)) - ;; Activate smart quotes. Be sure to provide original TEXT string - ;; since OUTPUT may have been modified. - (when (plist-get info :with-smart-quotes) - (setq output (org-export-activate-smart-quotes output :latex info text))) - ;; LaTeX into \LaTeX{} and TeX into \TeX{}. - (let ((case-fold-search nil) - (start 0)) - (while (string-match "\\<\\(\\(?:La\\)?TeX\\)\\>" output start) - (setq output (replace-match - (format "\\%s{}" (match-string 1 output)) nil t output) - start (match-end 0)))) - ;; Convert special strings. - (when specialp - (setq output - (replace-regexp-in-string "\\.\\.\\." "\\ldots{}" output nil t))) - ;; Handle break preservation if required. - (when (plist-get info :preserve-breaks) - (setq output (replace-regexp-in-string - "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" output))) - ;; Return value. - output)) - - -;;;; Planning - -(defun org-latex-planning (planning contents info) - "Transcode a PLANNING element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual -information." - (concat - "\\noindent" - (mapconcat - 'identity - (delq nil - (list - (let ((closed (org-element-property :closed planning))) - (when closed - (concat - (format "\\textbf{%s} " org-closed-string) - (format org-latex-inactive-timestamp-format - (org-translate-time - (org-element-property :raw-value closed)))))) - (let ((deadline (org-element-property :deadline planning))) - (when deadline - (concat - (format "\\textbf{%s} " org-deadline-string) - (format org-latex-active-timestamp-format - (org-translate-time - (org-element-property :raw-value deadline)))))) - (let ((scheduled (org-element-property :scheduled planning))) - (when scheduled - (concat - (format "\\textbf{%s} " org-scheduled-string) - (format org-latex-active-timestamp-format - (org-translate-time - (org-element-property :raw-value scheduled)))))))) - " ") - "\\\\")) - - -;;;; Quote Block - -(defun org-latex-quote-block (quote-block contents info) - "Transcode a QUOTE-BLOCK element from Org to LaTeX. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (org-latex--wrap-label - quote-block - (format "\\begin{quote}\n%s\\end{quote}" contents))) - - -;;;; Quote Section - -(defun org-latex-quote-section (quote-section contents info) - "Transcode a QUOTE-SECTION element from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((value (org-remove-indentation - (org-element-property :value quote-section)))) - (when value (format "\\begin{verbatim}\n%s\\end{verbatim}" value)))) - - -;;;; Radio Target - -(defun org-latex-radio-target (radio-target text info) - "Transcode a RADIO-TARGET object from Org to LaTeX. -TEXT is the text of the target. INFO is a plist holding -contextual information." - (format "\\label{%s}%s" - (org-export-solidify-link-text - (org-element-property :value radio-target)) - text)) - - -;;;; Section - -(defun org-latex-section (section contents info) - "Transcode a SECTION element from Org to LaTeX. -CONTENTS holds the contents of the section. INFO is a plist -holding contextual information." - contents) - - -;;;; Special Block - -(defun org-latex-special-block (special-block contents info) - "Transcode a SPECIAL-BLOCK element from Org to LaTeX. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let ((type (downcase (org-element-property :type special-block))) - (opt (org-export-read-attribute :attr_latex special-block :options))) - (concat (format "\\begin{%s}%s\n" type (or opt "")) - ;; Insert any label or caption within the block - ;; (otherwise, a reference pointing to that element will - ;; count the section instead). - (org-latex--caption/label-string special-block info) - contents - (format "\\end{%s}" type)))) - - -;;;; Src Block - -(defun org-latex-src-block (src-block contents info) - "Transcode a SRC-BLOCK element from Org to LaTeX. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (when (org-string-nw-p (org-element-property :value src-block)) - (let* ((lang (org-element-property :language src-block)) - (caption (org-element-property :caption src-block)) - (label (org-element-property :name src-block)) - (custom-env (and lang - (cadr (assq (intern lang) - org-latex-custom-lang-environments)))) - (num-start (case (org-element-property :number-lines src-block) - (continued (org-export-get-loc src-block info)) - (new 0))) - (retain-labels (org-element-property :retain-labels src-block)) - (attributes (org-export-read-attribute :attr_latex src-block)) - (float (plist-get attributes :float))) - (cond - ;; Case 1. No source fontification. - ((not org-latex-listings) - (let* ((caption-str (org-latex--caption/label-string src-block info)) - (float-env - (cond ((and (not float) (plist-member attributes :float)) "%s") - ((string= "multicolumn" float) - (format "\\begin{figure*}[%s]\n%%s%s\n\\end{figure*}" - org-latex-default-figure-position - caption-str)) - ((or caption float) - (format "\\begin{figure}[H]\n%%s%s\n\\end{figure}" - caption-str)) - (t "%s")))) - (format - float-env - (concat (format "\\begin{verbatim}\n%s\\end{verbatim}" - (org-export-format-code-default src-block info)))))) - ;; Case 2. Custom environment. - (custom-env (format "\\begin{%s}\n%s\\end{%s}\n" - custom-env - (org-export-format-code-default src-block info) - custom-env)) - ;; Case 3. Use minted package. - ((eq org-latex-listings 'minted) - (let* ((caption-str (org-latex--caption/label-string src-block info)) - (float-env - (cond ((and (not float) (plist-member attributes :float)) "%s") - ((string= "multicolumn" float) - (format "\\begin{listing*}\n%%s\n%s\\end{listing*}" - caption-str)) - ((or caption float) - (format "\\begin{listing}[H]\n%%s\n%s\\end{listing}" - caption-str)) - (t "%s"))) - (body - (format - "\\begin{minted}[%s]{%s}\n%s\\end{minted}" - ;; Options. - (org-latex--make-option-string - (if (or (not num-start) - (assoc "linenos" org-latex-minted-options)) - org-latex-minted-options - (append - `(("linenos") - ("firstnumber" ,(number-to-string (1+ num-start)))) - org-latex-minted-options))) - ;; Language. - (or (cadr (assq (intern lang) org-latex-minted-langs)) lang) - ;; Source code. - (let* ((code-info (org-export-unravel-code src-block)) - (max-width - (apply 'max - (mapcar 'length - (org-split-string (car code-info) - "\n"))))) - (org-export-format-code - (car code-info) - (lambda (loc num ref) - (concat - loc - (when ref - ;; Ensure references are flushed to the right, - ;; separated with 6 spaces from the widest line - ;; of code. - (concat (make-string (+ (- max-width (length loc)) 6) - ?\s) - (format "(%s)" ref))))) - nil (and retain-labels (cdr code-info))))))) - ;; Return value. - (format float-env body))) - ;; Case 4. Use listings package. - (t - (let ((lst-lang - (or (cadr (assq (intern lang) org-latex-listings-langs)) lang)) - (caption-str - (when caption - (let ((main (org-export-get-caption src-block)) - (secondary (org-export-get-caption src-block t))) - (if (not secondary) - (format "{%s}" (org-export-data main info)) - (format "{[%s]%s}" - (org-export-data secondary info) - (org-export-data main info))))))) - (concat - ;; Options. - (format - "\\lstset{%s}\n" - (org-latex--make-option-string - (append - org-latex-listings-options - (cond - ((and (not float) (plist-member attributes :float)) nil) - ((string= "multicolumn" float) '(("float" "*"))) - ((and float (not (assoc "float" org-latex-listings-options))) - `(("float" ,org-latex-default-figure-position)))) - `(("language" ,lst-lang)) - (when label `(("label" ,label))) - (when caption-str `(("caption" ,caption-str))) - (cond ((assoc "numbers" org-latex-listings-options) nil) - ((not num-start) '(("numbers" "none"))) - ((zerop num-start) '(("numbers" "left"))) - (t `(("numbers" "left") - ("firstnumber" - ,(number-to-string (1+ num-start))))))))) - ;; Source code. - (format - "\\begin{lstlisting}\n%s\\end{lstlisting}" - (let* ((code-info (org-export-unravel-code src-block)) - (max-width - (apply 'max - (mapcar 'length - (org-split-string (car code-info) "\n"))))) - (org-export-format-code - (car code-info) - (lambda (loc num ref) - (concat - loc - (when ref - ;; Ensure references are flushed to the right, - ;; separated with 6 spaces from the widest line of - ;; code - (concat (make-string (+ (- max-width (length loc)) 6) ? ) - (format "(%s)" ref))))) - nil (and retain-labels (cdr code-info)))))))))))) - - -;;;; Statistics Cookie - -(defun org-latex-statistics-cookie (statistics-cookie contents info) - "Transcode a STATISTICS-COOKIE object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual information." - (replace-regexp-in-string - "%" "\\%" (org-element-property :value statistics-cookie) nil t)) - - -;;;; Strike-Through - -(defun org-latex-strike-through (strike-through contents info) - "Transcode STRIKE-THROUGH from Org to LaTeX. -CONTENTS is the text with strike-through markup. INFO is a plist -holding contextual information." - (org-latex--text-markup contents 'strike-through)) - - -;;;; Subscript - -(defun org-latex--script-size (object info) - "Transcode a subscript or superscript object. -OBJECT is an Org object. INFO is a plist used as a communication -channel." - (let ((in-script-p - ;; Non-nil if object is already in a sub/superscript. - (let ((parent object)) - (catch 'exit - (while (setq parent (org-export-get-parent parent)) - (let ((type (org-element-type parent))) - (cond ((memq type '(subscript superscript)) - (throw 'exit t)) - ((memq type org-element-all-elements) - (throw 'exit nil)))))))) - (type (org-element-type object)) - (output "")) - (org-element-map (org-element-contents object) - (cons 'plain-text org-element-all-objects) - (lambda (obj) - (case (org-element-type obj) - ((entity latex-fragment) - (let ((data (org-trim (org-export-data obj info)))) - (string-match - "\\`\\(?:\\\\[([]\\|\\$+\\)?\\(.*?\\)\\(?:\\\\[])]\\|\\$+\\)?\\'" - data) - (setq output - (concat output - (match-string 1 data) - (let ((blank (org-element-property :post-blank obj))) - (and blank (> blank 0) "\\ ")))))) - (plain-text - (setq output - (format "%s\\text{%s}" output (org-export-data obj info)))) - (otherwise - (setq output - (concat output - (org-export-data obj info) - (let ((blank (org-element-property :post-blank obj))) - (and blank (> blank 0) "\\ "))))))) - info nil org-element-recursive-objects) - ;; Result. Do not wrap into math mode if already in a subscript - ;; or superscript. Do not wrap into curly brackets if OUTPUT is - ;; a single character. Also merge consecutive subscript and - ;; superscript into the same math snippet. - (concat (and (not in-script-p) - (let ((prev (org-export-get-previous-element object info))) - (or (not prev) - (not (eq (org-element-type prev) - (if (eq type 'subscript) 'superscript - 'subscript))) - (let ((blank (org-element-property :post-blank prev))) - (and blank (> blank 0))))) - "$") - (if (eq (org-element-type object) 'subscript) "_" "^") - (and (> (length output) 1) "{") - output - (and (> (length output) 1) "}") - (and (not in-script-p) - (or (let ((blank (org-element-property :post-blank object))) - (and blank (> blank 0))) - (not (eq (org-element-type - (org-export-get-next-element object info)) - (if (eq type 'subscript) 'superscript - 'subscript)))) - "$")))) - -(defun org-latex-subscript (subscript contents info) - "Transcode a SUBSCRIPT object from Org to LaTeX. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (org-latex--script-size subscript info)) - - -;;;; Superscript - -(defun org-latex-superscript (superscript contents info) - "Transcode a SUPERSCRIPT object from Org to LaTeX. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (org-latex--script-size superscript info)) - - -;;;; Table -;; -;; `org-latex-table' is the entry point for table transcoding. It -;; takes care of tables with a "verbatim" mode. Otherwise, it -;; delegates the job to either `org-latex--table.el-table', -;; `org-latex--org-table' or `org-latex--math-table' functions, -;; depending of the type of the table and the mode requested. -;; -;; `org-latex--align-string' is a subroutine used to build alignment -;; string for Org tables. - -(defun org-latex-table (table contents info) - "Transcode a TABLE element from Org to LaTeX. -CONTENTS is the contents of the table. INFO is a plist holding -contextual information." - (if (eq (org-element-property :type table) 'table.el) - ;; "table.el" table. Convert it using appropriate tools. - (org-latex--table.el-table table info) - (let ((type (or (org-export-read-attribute :attr_latex table :mode) - org-latex-default-table-mode))) - (cond - ;; Case 1: Verbatim table. - ((string= type "verbatim") - (format "\\begin{verbatim}\n%s\n\\end{verbatim}" - ;; Re-create table, without affiliated keywords. - (org-trim (org-element-interpret-data - `(table nil ,@(org-element-contents table)))))) - ;; Case 2: Matrix. - ((or (string= type "math") (string= type "inline-math")) - (org-latex--math-table table info)) - ;; Case 3: Standard table. - (t (concat (org-latex--org-table table contents info) - ;; When there are footnote references within the - ;; table, insert their definition just after it. - (org-latex--delayed-footnotes-definitions table info))))))) - -(defun org-latex--align-string (table info) - "Return an appropriate LaTeX alignment string. -TABLE is the considered table. INFO is a plist used as -a communication channel." - (or (org-export-read-attribute :attr_latex table :align) - (let (align) - ;; Extract column groups and alignment from first (non-rule) - ;; row. - (org-element-map - (org-element-map table 'table-row - (lambda (row) - (and (eq (org-element-property :type row) 'standard) row)) - info 'first-match) - 'table-cell - (lambda (cell) - (let ((borders (org-export-table-cell-borders cell info))) - ;; Check left border for the first cell only. - (when (and (memq 'left borders) (not align)) - (push "|" align)) - (push (case (org-export-table-cell-alignment cell info) - (left "l") - (right "r") - (center "c")) - align) - (when (memq 'right borders) (push "|" align)))) - info) - (apply 'concat (nreverse align))))) - -(defun org-latex--org-table (table contents info) - "Return appropriate LaTeX code for an Org table. - -TABLE is the table type element to transcode. CONTENTS is its -contents, as a string. INFO is a plist used as a communication -channel. - -This function assumes TABLE has `org' as its `:type' property and -`table' as its `:mode' attribute." - (let* ((caption (org-latex--caption/label-string table info)) - (attr (org-export-read-attribute :attr_latex table)) - ;; Determine alignment string. - (alignment (org-latex--align-string table info)) - ;; Determine environment for the table: longtable, tabular... - (table-env (or (plist-get attr :environment) - org-latex-default-table-environment)) - ;; If table is a float, determine environment: table, table* - ;; or sidewaystable. - (float-env (unless (member table-env '("longtable" "longtabu")) - (let ((float (plist-get attr :float))) - (cond - ((and (not float) (plist-member attr :float)) nil) - ((string= float "sidewaystable") "sidewaystable") - ((string= float "multicolumn") "table*") - ((or float - (org-element-property :caption table) - (org-string-nw-p (plist-get attr :caption))) - "table"))))) - ;; Extract others display options. - (fontsize (let ((font (plist-get attr :font))) - (and font (concat font "\n")))) - (width (plist-get attr :width)) - (spreadp (plist-get attr :spread)) - (placement (or (plist-get attr :placement) - (format "[%s]" org-latex-default-figure-position))) - (centerp (if (plist-member attr :center) (plist-get attr :center) - org-latex-tables-centered))) - ;; Prepare the final format string for the table. - (cond - ;; Longtable. - ((equal "longtable" table-env) - (concat (and fontsize (concat "{" fontsize)) - (format "\\begin{longtable}{%s}\n" alignment) - (and org-latex-table-caption-above - (org-string-nw-p caption) - (concat caption "\\\\\n")) - contents - (and (not org-latex-table-caption-above) - (org-string-nw-p caption) - (concat caption "\\\\\n")) - "\\end{longtable}\n" - (and fontsize "}"))) - ;; Longtabu - ((equal "longtabu" table-env) - (concat (and fontsize (concat "{" fontsize)) - (format "\\begin{longtabu}%s{%s}\n" - (if width - (format " %s %s " - (if spreadp "spread" "to") width) "") - alignment) - (and org-latex-table-caption-above - (org-string-nw-p caption) - (concat caption "\\\\\n")) - contents - (and (not org-latex-table-caption-above) - (org-string-nw-p caption) - (concat caption "\\\\\n")) - "\\end{longtabu}\n" - (and fontsize "}"))) - ;; Others. - (t (concat (cond - (float-env - (concat (format "\\begin{%s}%s\n" float-env placement) - (if org-latex-table-caption-above caption "") - (when centerp "\\centering\n") - fontsize)) - (centerp (concat "\\begin{center}\n" fontsize)) - (fontsize (concat "{" fontsize))) - (cond ((equal "tabu" table-env) - (format "\\begin{tabu}%s{%s}\n%s\\end{tabu}" - (if width (format - (if spreadp " spread %s " " to %s ") - width) "") - alignment - contents)) - (t (format "\\begin{%s}%s{%s}\n%s\\end{%s}" - table-env - (if width (format "{%s}" width) "") - alignment - contents - table-env))) - (cond - (float-env - (concat (if org-latex-table-caption-above "" caption) - (format "\n\\end{%s}" float-env))) - (centerp "\n\\end{center}") - (fontsize "}"))))))) - -(defun org-latex--table.el-table (table info) - "Return appropriate LaTeX code for a table.el table. - -TABLE is the table type element to transcode. INFO is a plist -used as a communication channel. - -This function assumes TABLE has `table.el' as its `:type' -property." - (require 'table) - ;; Ensure "*org-export-table*" buffer is empty. - (with-current-buffer (get-buffer-create "*org-export-table*") - (erase-buffer)) - (let ((output (with-temp-buffer - (insert (org-element-property :value table)) - (goto-char 1) - (re-search-forward "^[ \t]*|[^|]" nil t) - (table-generate-source 'latex "*org-export-table*") - (with-current-buffer "*org-export-table*" - (org-trim (buffer-string)))))) - (kill-buffer (get-buffer "*org-export-table*")) - ;; Remove left out comments. - (while (string-match "^%.*\n" output) - (setq output (replace-match "" t t output))) - (let ((attr (org-export-read-attribute :attr_latex table))) - (when (plist-get attr :rmlines) - ;; When the "rmlines" attribute is provided, remove all hlines - ;; but the the one separating heading from the table body. - (let ((n 0) (pos 0)) - (while (and (< (length output) pos) - (setq pos (string-match "^\\\\hline\n?" output pos))) - (incf n) - (unless (= n 2) (setq output (replace-match "" nil nil output)))))) - (let ((centerp (if (plist-member attr :center) (plist-get attr :center) - org-latex-tables-centered))) - (if (not centerp) output - (format "\\begin{center}\n%s\n\\end{center}" output)))))) - -(defun org-latex--math-table (table info) - "Return appropriate LaTeX code for a matrix. - -TABLE is the table type element to transcode. INFO is a plist -used as a communication channel. - -This function assumes TABLE has `org' as its `:type' property and -`inline-math' or `math' as its `:mode' attribute.." - (let* ((caption (org-latex--caption/label-string table info)) - (attr (org-export-read-attribute :attr_latex table)) - (inlinep (equal (plist-get attr :mode) "inline-math")) - (env (or (plist-get attr :environment) - org-latex-default-table-environment)) - (contents - (mapconcat - (lambda (row) - ;; Ignore horizontal rules. - (when (eq (org-element-property :type row) 'standard) - ;; Return each cell unmodified. - (concat - (mapconcat - (lambda (cell) - (substring (org-element-interpret-data cell) 0 -1)) - (org-element-map row 'table-cell 'identity info) "&") - (or (cdr (assoc env org-latex-table-matrix-macros)) "\\\\") - "\n"))) - (org-element-map table 'table-row 'identity info) "")) - ;; Variables related to math clusters (contiguous math tables - ;; of the same type). - (mode (org-export-read-attribute :attr_latex table :mode)) - (prev (org-export-get-previous-element table info)) - (next (org-export-get-next-element table info)) - (same-mode-p - (lambda (table) - ;; Non-nil when TABLE has the same mode as current table. - (string= (or (org-export-read-attribute :attr_latex table :mode) - org-latex-default-table-mode) - mode)))) - (concat - ;; Opening string. If TABLE is in the middle of a table cluster, - ;; do not insert any. - (cond ((and prev - (eq (org-element-type prev) 'table) - (memq (org-element-property :post-blank prev) '(0 nil)) - (funcall same-mode-p prev)) - nil) - (inlinep "\\(") - ((org-string-nw-p caption) (concat "\\begin{equation}\n" caption)) - (t "\\[")) - ;; Prefix. - (or (plist-get attr :math-prefix) "") - ;; Environment. Also treat special cases. - (cond ((equal env "array") - (let ((align (org-latex--align-string table info))) - (format "\\begin{array}{%s}\n%s\\end{array}" align contents))) - ((assoc env org-latex-table-matrix-macros) - (format "\\%s%s{\n%s}" - env - (or (plist-get attr :math-arguments) "") - contents)) - (t (format "\\begin{%s}\n%s\\end{%s}" env contents env))) - ;; Suffix. - (or (plist-get attr :math-suffix) "") - ;; Closing string. If TABLE is in the middle of a table cluster, - ;; do not insert any. If it closes such a cluster, be sure to - ;; close the cluster with a string matching the opening string. - (cond ((and next - (eq (org-element-type next) 'table) - (memq (org-element-property :post-blank table) '(0 nil)) - (funcall same-mode-p next)) - nil) - (inlinep "\\)") - ;; Find cluster beginning to know which environment to use. - ((let ((cluster-beg table) prev) - (while (and (setq prev (org-export-get-previous-element - cluster-beg info)) - (memq (org-element-property :post-blank prev) - '(0 nil)) - (funcall same-mode-p prev)) - (setq cluster-beg prev)) - (and (or (org-element-property :caption cluster-beg) - (org-element-property :name cluster-beg)) - "\n\\end{equation}"))) - (t "\\]"))))) - - -;;;; Table Cell - -(defun org-latex-table-cell (table-cell contents info) - "Transcode a TABLE-CELL element from Org to LaTeX. -CONTENTS is the cell contents. INFO is a plist used as -a communication channel." - (concat (if (and contents - org-latex-table-scientific-notation - (string-match orgtbl-exp-regexp contents)) - ;; Use appropriate format string for scientific - ;; notation. - (format org-latex-table-scientific-notation - (match-string 1 contents) - (match-string 2 contents)) - contents) - (when (org-export-get-next-element table-cell info) " & "))) - - -;;;; Table Row - -(defun org-latex-table-row (table-row contents info) - "Transcode a TABLE-ROW element from Org to LaTeX. -CONTENTS is the contents of the row. INFO is a plist used as -a communication channel." - ;; Rules are ignored since table separators are deduced from - ;; borders of the current row. - (when (eq (org-element-property :type table-row) 'standard) - (let* ((attr (org-export-read-attribute :attr_latex - (org-export-get-parent table-row))) - (longtablep (member (or (plist-get attr :environment) - org-latex-default-table-environment) - '("longtable" "longtabu"))) - (booktabsp (if (plist-member attr :booktabs) - (plist-get attr :booktabs) - org-latex-tables-booktabs)) - ;; TABLE-ROW's borders are extracted from its first cell. - (borders (org-export-table-cell-borders - (car (org-element-contents table-row)) info))) - (concat - ;; When BOOKTABS are activated enforce top-rule even when no - ;; hline was specifically marked. - (cond ((and booktabsp (memq 'top borders)) "\\toprule\n") - ((and (memq 'top borders) (memq 'above borders)) "\\hline\n")) - contents "\\\\\n" - (cond - ;; Special case for long tables. Define header and footers. - ((and longtablep (org-export-table-row-ends-header-p table-row info)) - (format "%s -\\endhead -%s\\multicolumn{%d}{r}{Continued on next page} \\\\ -\\endfoot -\\endlastfoot" - (if booktabsp "\\midrule" "\\hline") - (if booktabsp "\\midrule" "\\hline") - ;; Number of columns. - (cdr (org-export-table-dimensions - (org-export-get-parent-table table-row) info)))) - ;; When BOOKTABS are activated enforce bottom rule even when - ;; no hline was specifically marked. - ((and booktabsp (memq 'bottom borders)) "\\bottomrule") - ((and (memq 'bottom borders) (memq 'below borders)) "\\hline") - ((memq 'below borders) (if booktabsp "\\midrule" "\\hline"))))))) - - -;;;; Target - -(defun org-latex-target (target contents info) - "Transcode a TARGET object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual -information." - (format "\\label{%s}" - (org-export-solidify-link-text (org-element-property :value target)))) - - -;;;; Timestamp - -(defun org-latex-timestamp (timestamp contents info) - "Transcode a TIMESTAMP object from Org to LaTeX. -CONTENTS is nil. INFO is a plist holding contextual -information." - (let ((value (org-latex-plain-text - (org-timestamp-translate timestamp) info))) - (case (org-element-property :type timestamp) - ((active active-range) (format org-latex-active-timestamp-format value)) - ((inactive inactive-range) - (format org-latex-inactive-timestamp-format value)) - (otherwise (format org-latex-diary-timestamp-format value))))) - - -;;;; Underline - -(defun org-latex-underline (underline contents info) - "Transcode UNDERLINE from Org to LaTeX. -CONTENTS is the text with underline markup. INFO is a plist -holding contextual information." - (org-latex--text-markup contents 'underline)) - - -;;;; Verbatim - -(defun org-latex-verbatim (verbatim contents info) - "Transcode a VERBATIM object from Org to LaTeX. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (org-latex--text-markup (org-element-property :value verbatim) 'verbatim)) - - -;;;; Verse Block - -(defun org-latex-verse-block (verse-block contents info) - "Transcode a VERSE-BLOCK element from Org to LaTeX. -CONTENTS is verse block contents. INFO is a plist holding -contextual information." - (org-latex--wrap-label - verse-block - ;; In a verse environment, add a line break to each newline - ;; character and change each white space at beginning of a line - ;; into a space of 1 em. Also change each blank line with - ;; a vertical space of 1 em. - (progn - (setq contents (replace-regexp-in-string - "^ *\\\\\\\\$" "\\\\vspace*{1em}" - (replace-regexp-in-string - "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" contents))) - (while (string-match "^[ \t]+" contents) - (let ((new-str (format "\\hspace*{%dem}" - (length (match-string 0 contents))))) - (setq contents (replace-match new-str nil t contents)))) - (format "\\begin{verse}\n%s\\end{verse}" contents)))) - - - -;;; End-user functions - -;;;###autoload -(defun org-latex-export-as-latex - (&optional async subtreep visible-only body-only ext-plist) - "Export current buffer as a LaTeX buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should be accessible -through the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Export is done in a buffer named \"*Org LATEX Export*\", which -will be displayed when `org-export-show-temporary-export-buffer' -is non-nil." - (interactive) - (org-export-to-buffer 'latex "*Org LATEX Export*" - async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) - -;;;###autoload -(defun org-latex-convert-region-to-latex () - "Assume the current region has org-mode syntax, and convert it to LaTeX. -This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in an LaTeX buffer and use this -command to convert it." - (interactive) - (org-export-replace-region-by 'latex)) - -;;;###autoload -(defun org-latex-export-to-latex - (&optional async subtreep visible-only body-only ext-plist) - "Export current buffer to a LaTeX file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings." - (interactive) - (let ((outfile (org-export-output-file-name ".tex" subtreep))) - (org-export-to-file 'latex outfile - async subtreep visible-only body-only ext-plist))) - -;;;###autoload -(defun org-latex-export-to-pdf - (&optional async subtreep visible-only body-only ext-plist) - "Export current buffer to LaTeX then process through to PDF. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return PDF file's name." - (interactive) - (let ((outfile (org-export-output-file-name ".tex" subtreep))) - (org-export-to-file 'latex outfile - async subtreep visible-only body-only ext-plist - (lambda (file) (org-latex-compile file))))) - -(defun org-latex-compile (texfile &optional snippet) - "Compile a TeX file. - -TEXFILE is the name of the file being compiled. Processing is -done through the command specified in `org-latex-pdf-process'. - -When optional argument SNIPPET is non-nil, TEXFILE is a temporary -file used to preview a LaTeX snippet. In this case, do not -create a log buffer and do not bother removing log files. - -Return PDF file name or an error if it couldn't be produced." - (let* ((base-name (file-name-sans-extension (file-name-nondirectory texfile))) - (full-name (file-truename texfile)) - (out-dir (file-name-directory texfile)) - ;; Properly set working directory for compilation. - (default-directory (if (file-name-absolute-p texfile) - (file-name-directory full-name) - default-directory)) - errors) - (unless snippet (message (format "Processing LaTeX file %s..." texfile))) - (save-window-excursion - (cond - ;; A function is provided: Apply it. - ((functionp org-latex-pdf-process) - (funcall org-latex-pdf-process (shell-quote-argument texfile))) - ;; A list is provided: Replace %b, %f and %o with appropriate - ;; values in each command before applying it. Output is - ;; redirected to "*Org PDF LaTeX Output*" buffer. - ((consp org-latex-pdf-process) - (let ((outbuf (and (not snippet) - (get-buffer-create "*Org PDF LaTeX Output*")))) - (mapc - (lambda (command) - (shell-command - (replace-regexp-in-string - "%b" (shell-quote-argument base-name) - (replace-regexp-in-string - "%f" (shell-quote-argument full-name) - (replace-regexp-in-string - "%o" (shell-quote-argument out-dir) command t t) t t) t t) - outbuf)) - org-latex-pdf-process) - ;; Collect standard errors from output buffer. - (setq errors (and (not snippet) (org-latex--collect-errors outbuf))))) - (t (error "No valid command to process to PDF"))) - (let ((pdffile (concat out-dir base-name ".pdf"))) - ;; Check for process failure. Provide collected errors if - ;; possible. - (if (not (file-exists-p pdffile)) - (error (concat (format "PDF file %s wasn't produced" pdffile) - (when errors (concat ": " errors)))) - ;; Else remove log files, when specified, and signal end of - ;; process to user, along with any error encountered. - (when (and (not snippet) org-latex-remove-logfiles) - (dolist (file (directory-files - out-dir t - (concat (regexp-quote base-name) - "\\(?:\\.[0-9]+\\)?" - "\\." - (regexp-opt org-latex-logfiles-extensions)))) - (delete-file file))) - (message (concat "Process completed" - (if (not errors) "." - (concat " with errors: " errors))))) - ;; Return output file name. - pdffile)))) - -(defun org-latex--collect-errors (buffer) - "Collect some kind of errors from \"pdflatex\" command output. - -BUFFER is the buffer containing output. - -Return collected error types as a string, or nil if there was -none." - (with-current-buffer buffer - (save-excursion - (goto-char (point-max)) - (when (re-search-backward "^[ \t]*This is .*?TeX.*?Version" nil t) - (let ((case-fold-search t) - (errors "")) - (dolist (latex-error org-latex-known-errors) - (when (save-excursion (re-search-forward (car latex-error) nil t)) - (setq errors (concat errors " " (cdr latex-error))))) - (and (org-string-nw-p errors) (org-trim errors))))))) - -;;;###autoload -(defun org-latex-publish-to-latex (plist filename pub-dir) - "Publish an Org file to LaTeX. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (org-publish-org-to 'latex filename ".tex" plist pub-dir)) - -;;;###autoload -(defun org-latex-publish-to-pdf (plist filename pub-dir) - "Publish an Org file to PDF (via LaTeX). - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - ;; Unlike to `org-latex-publish-to-latex', PDF file is generated - ;; in working directory and then moved to publishing directory. - (org-publish-attachment - plist - (org-latex-compile (org-publish-org-to 'latex filename ".tex" plist)) - pub-dir)) - - -(provide 'ox-latex) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ox-latex.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ox-man.el b/xemacs-packages/lisp/org-8.2.3c/ox-man.el deleted file mode 100644 index a160e4cf..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ox-man.el +++ /dev/null @@ -1,1260 +0,0 @@ -;; ox-man.el --- Man Back-End for Org Export Engine - -;; Copyright (C) 2011-2013 Free Software Foundation, Inc. - -;; Author: Nicolas Goaziou -;; Luis R Anaya -;; Keywords: outlines, hypermedia, calendar, wp - -;; 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 . - -;;; Commentary: -;; -;; This library implements a Man back-end for Org generic exporter. -;; -;; To test it, run -;; -;; M-: (org-export-to-buffer 'man "*Test Man*") RET -;; -;; in an org-mode buffer then switch to the buffer to see the Man -;; export. See ox.el for more details on how this exporter works. -;; -;; It introduces one new buffer keywords: -;; "MAN_CLASS_OPTIONS". - -;;; Code: - -(require 'ox) - -(eval-when-compile (require 'cl)) - -(defvar org-export-man-default-packages-alist) -(defvar org-export-man-packages-alist) -(defvar orgtbl-exp-regexp) - - - -;;; Define Back-End - -(org-export-define-backend 'man - '((babel-call . org-man-babel-call) - (bold . org-man-bold) - (center-block . org-man-center-block) - (clock . org-man-clock) - (code . org-man-code) - (comment . (lambda (&rest args) "")) - (comment-block . (lambda (&rest args) "")) - (drawer . org-man-drawer) - (dynamic-block . org-man-dynamic-block) - (entity . org-man-entity) - (example-block . org-man-example-block) - (export-block . org-man-export-block) - (export-snippet . org-man-export-snippet) - (fixed-width . org-man-fixed-width) - (footnote-definition . org-man-footnote-definition) - (footnote-reference . org-man-footnote-reference) - (headline . org-man-headline) - (horizontal-rule . org-man-horizontal-rule) - (inline-babel-call . org-man-inline-babel-call) - (inline-src-block . org-man-inline-src-block) - (inlinetask . org-man-inlinetask) - (italic . org-man-italic) - (item . org-man-item) - (keyword . org-man-keyword) - (line-break . org-man-line-break) - (link . org-man-link) - (paragraph . org-man-paragraph) - (plain-list . org-man-plain-list) - (plain-text . org-man-plain-text) - (planning . org-man-planning) - (property-drawer . (lambda (&rest args) "")) - (quote-block . org-man-quote-block) - (quote-section . org-man-quote-section) - (radio-target . org-man-radio-target) - (section . org-man-section) - (special-block . org-man-special-block) - (src-block . org-man-src-block) - (statistics-cookie . org-man-statistics-cookie) - (strike-through . org-man-strike-through) - (subscript . org-man-subscript) - (superscript . org-man-superscript) - (table . org-man-table) - (table-cell . org-man-table-cell) - (table-row . org-man-table-row) - (target . org-man-target) - (template . org-man-template) - (timestamp . org-man-timestamp) - (underline . org-man-underline) - (verbatim . org-man-verbatim) - (verse-block . org-man-verse-block)) - :export-block "MAN" - :menu-entry - '(?m "Export to MAN" - ((?m "As MAN file" org-man-export-to-man) - (?p "As PDF file" org-man-export-to-pdf) - (?o "As PDF file and open" - (lambda (a s v b) - (if a (org-man-export-to-pdf t s v b) - (org-open-file (org-man-export-to-pdf nil s v b))))))) - :options-alist - '((:man-class "MAN_CLASS" nil nil t) - (:man-class-options "MAN_CLASS_OPTIONS" nil nil t) - (:man-header-extra "MAN_HEADER" nil nil newline))) - - - -;;; User Configurable Variables - -(defgroup org-export-man nil - "Options for exporting Org mode files to Man." - :tag "Org Export Man" - :group 'org-export) - -;;; Tables - -(defcustom org-man-tables-centered t - "When non-nil, tables are exported in a center environment." - :group 'org-export-man - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-man-tables-verbatim nil - "When non-nil, tables are exported verbatim." - :group 'org-export-man - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - - -(defcustom org-man-table-scientific-notation "%sE%s" - "Format string to display numbers in scientific notation. -The format should have \"%s\" twice, for mantissa and exponent -\(i.e. \"%s\\\\times10^{%s}\"). - -When nil, no transformation is made." - :group 'org-export-man - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (string :tag "Format string") - (const :tag "No formatting"))) - - -;;; Inlinetasks -;; Src blocks - -(defcustom org-man-source-highlight nil - "Use GNU source highlight to embellish source blocks " - :group 'org-export-man - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - - -(defcustom org-man-source-highlight-langs - '((emacs-lisp "lisp") (lisp "lisp") (clojure "lisp") - (scheme "scheme") - (c "c") (cc "cpp") (csharp "csharp") (d "d") - (fortran "fortran") (cobol "cobol") (pascal "pascal") - (ada "ada") (asm "asm") - (perl "perl") (cperl "perl") - (python "python") (ruby "ruby") (tcl "tcl") (lua "lua") - (java "java") (javascript "javascript") - (tex "latex") - (shell-script "sh") (awk "awk") (diff "diff") (m4 "m4") - (ocaml "caml") (caml "caml") - (sql "sql") (sqlite "sql") - (html "html") (css "css") (xml "xml") - (bat "bat") (bison "bison") (clipper "clipper") - (ldap "ldap") (opa "opa") - (php "php") (postscript "postscript") (prolog "prolog") - (properties "properties") (makefile "makefile") - (tml "tml") (vala "vala") (vbscript "vbscript") (xorg "xorg")) - "Alist mapping languages to their listing language counterpart. -The key is a symbol, the major mode symbol without the \"-mode\". -The value is the string that should be inserted as the language -parameter for the listings package. If the mode name and the -listings name are the same, the language does not need an entry -in this list - but it does not hurt if it is present." - :group 'org-export-man - :version "24.4" - :package-version '(Org . "8.0") - :type '(repeat - (list - (symbol :tag "Major mode ") - (string :tag "Listings language")))) - - - -(defvar org-man-custom-lang-environments nil - "Alist mapping languages to language-specific Man environments. - -It is used during export of src blocks by the listings and -man packages. For example, - - \(setq org-man-custom-lang-environments - '\(\(python \"pythoncode\"\)\)\) - -would have the effect that if org encounters begin_src python -during man export." -) - - -;;; Compilation - -(defcustom org-man-pdf-process - '("tbl %f | eqn | groff -man | ps2pdf - > %b.pdf" - "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf" - "tbl %f | eqn | groff -man | ps2pdf - > %b.pdf") - - "Commands to process a Man file to a PDF file. -This is a list of strings, each of them will be given to the -shell as a command. %f in the command will be replaced by the -full file name, %b by the file base name (i.e. without directory -and extension parts) and %o by the base directory of the file. - - -By default, Org uses 3 runs of to do the processing. - -Alternatively, this may be a Lisp function that does the -processing. This function should accept the file name as -its single argument." - :group 'org-export-pdf - :group 'org-export-man - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (repeat :tag "Shell command sequence" - (string :tag "Shell command")) - (const :tag "2 runs of pdfgroff" - ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" - "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" )) - (const :tag "3 runs of pdfgroff" - ("tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" - "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf" - "tbl %f | eqn | groff -mm | ps2pdf - > %b.pdf")) - (function))) - -(defcustom org-man-logfiles-extensions - '("log" "out" "toc") - "The list of file extensions to consider as Man logfiles." - :group 'org-export-man - :version "24.4" - :package-version '(Org . "8.0") - :type '(repeat (string :tag "Extension"))) - -(defcustom org-man-remove-logfiles t - "Non-nil means remove the logfiles produced by PDF production. -These are the .aux, .log, .out, and .toc files." - :group 'org-export-man - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - - - -;;; Internal Functions - -(defun org-man--caption/label-string (element info) - "Return caption and label Man string for ELEMENT. - -INFO is a plist holding contextual information. If there's no -caption nor label, return the empty string. - -For non-floats, see `org-man--wrap-label'." - (let ((label (org-element-property :label element)) - (main (org-export-get-caption element)) - (short (org-export-get-caption element t))) - (cond ((and (not main) (not label)) "") - ((not main) (format "\\fI%s\\fP" label)) - ;; Option caption format with short name. - (short (format "\\fR%s\\fP - \\fI\\P - %s\n" - (org-export-data short info) - (org-export-data main info))) - ;; Standard caption format. - (t (format "\\fR%s\\fP" (org-export-data main info)))))) - -(defun org-man--wrap-label (element output) - "Wrap label associated to ELEMENT around OUTPUT, if appropriate. -This function shouldn't be used for floats. See -`org-man--caption/label-string'." - (let ((label (org-element-property :name element))) - (if (or (not output) (not label) (string= output "") (string= label "")) - output - (concat (format "%s\n.br\n" label) output)))) - - - -;;; Template - -(defun org-man-template (contents info) - "Return complete document string after Man conversion. -CONTENTS is the transcoded contents string. INFO is a plist -holding export options." - (let* ((title (org-export-data (plist-get info :title) info)) - (attr (read (format "(%s)" - (mapconcat - #'identity - (list (plist-get info :man-class-options)) - " ")))) - (section-item (plist-get attr :section-id))) - - (concat - - (cond - ((and title (stringp section-item)) - (format ".TH \"%s\" \"%s\" \n" title section-item)) - ((and (string= "" title) (stringp section-item)) - (format ".TH \"%s\" \"%s\" \n" " " section-item)) - (title - (format ".TH \"%s\" \"1\" \n" title)) - (t - ".TH \" \" \"1\" ")) - contents))) - - - - -;;; Transcode Functions - -;;; Babel Call -;; -;; Babel Calls are ignored. - - -;;; Bold - -(defun org-man-bold (bold contents info) - "Transcode BOLD from Org to Man. -CONTENTS is the text with bold markup. INFO is a plist holding -contextual information." - (format "\\fB%s\\fP" contents)) - - -;;; Center Block - -(defun org-man-center-block (center-block contents info) - "Transcode a CENTER-BLOCK element from Org to Man. -CONTENTS holds the contents of the center block. INFO is a plist -holding contextual information." - (org-man--wrap-label - center-block - (format ".ce %d\n.nf\n%s\n.fi" - (- (length (split-string contents "\n")) 1 ) - contents))) - - -;;; Clock - -(defun org-man-clock (clock contents info) - "Transcode a CLOCK element from Org to Man. -CONTENTS is nil. INFO is a plist holding contextual -information." - "" ) - - -;;; Code - -(defun org-man-code (code contents info) - "Transcode a CODE object from Org to Man. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (format "\\fC%s\\fP" code)) - - -;;; Comment -;; -;; Comments are ignored. - - -;;; Comment Block -;; -;; Comment Blocks are ignored. - - -;;; Drawer - -(defun org-man-drawer (drawer contents info) - "Transcode a DRAWER element from Org to Man. - DRAWER holds the drawer information - CONTENTS holds the contents of the block. - INFO is a plist holding contextual information. " - contents) - - -;;; Dynamic Block - -(defun org-man-dynamic-block (dynamic-block contents info) - "Transcode a DYNAMIC-BLOCK element from Org to Man. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information. See `org-export-data'." - (org-man--wrap-label dynamic-block contents)) - - -;;; Entity - -(defun org-man-entity (entity contents info) - "Transcode an ENTITY object from Org to Man. -CONTENTS are the definition itself. INFO is a plist holding -contextual information." - (org-element-property :utf-8 entity)) - - -;;; Example Block - -(defun org-man-example-block (example-block contents info) - "Transcode an EXAMPLE-BLOCK element from Org to Man. -CONTENTS is nil. INFO is a plist holding contextual -information." - (org-man--wrap-label - example-block - (format ".RS\n.nf\n%s\n.fi\n.RE" - (org-export-format-code-default example-block info)))) - - -;;; Export Block - -(defun org-man-export-block (export-block contents info) - "Transcode a EXPORT-BLOCK element from Org to Man. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (string= (org-element-property :type export-block) "MAN") - (org-remove-indentation (org-element-property :value export-block)))) - - -;;; Export Snippet - -(defun org-man-export-snippet (export-snippet contents info) - "Transcode a EXPORT-SNIPPET object from Org to Man. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (eq (org-export-snippet-backend export-snippet) 'man) - (org-element-property :value export-snippet))) - - -;;; Fixed Width - -(defun org-man-fixed-width (fixed-width contents info) - "Transcode a FIXED-WIDTH element from Org to Man. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-man--wrap-label - fixed-width - (format "\\fC\n%s\\fP" - (org-remove-indentation - (org-element-property :value fixed-width))))) - - -;;; Footnote Definition -;; -;; Footnote Definitions are ignored. - -;;; Footnote References -;; -;; Footnote References are Ignored - - -;;; Headline - -(defun org-man-headline (headline contents info) - "Transcode a HEADLINE element from Org to Man. -CONTENTS holds the contents of the headline. INFO is a plist -holding contextual information." - (let* ((level (org-export-get-relative-level headline info)) - (numberedp (org-export-numbered-headline-p headline info)) - ;; Section formatting will set two placeholders: one for the - ;; title and the other for the contents. - (section-fmt - (case level - (1 ".SH \"%s\"\n%s") - (2 ".SS \"%s\"\n%s") - (3 ".SS \"%s\"\n%s") - (t nil))) - (text (org-export-data (org-element-property :title headline) info))) - - (cond - ;; Case 1: This is a footnote section: ignore it. - ((org-element-property :footnote-section-p headline) nil) - - ;; Case 2. This is a deep sub-tree: export it as a list item. - ;; Also export as items headlines for which no section - ;; format has been found. - ((or (not section-fmt) (org-export-low-level-p headline info)) - ;; Build the real contents of the sub-tree. - (let ((low-level-body - (concat - ;; If the headline is the first sibling, start a list. - (when (org-export-first-sibling-p headline info) - (format "%s\n" ".RS")) - ;; Itemize headline - ".TP\n.ft I\n" text "\n.ft\n" - contents ".RE"))) - ;; If headline is not the last sibling simply return - ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any - ;; blank line. - (if (not (org-export-last-sibling-p headline info)) low-level-body - (replace-regexp-in-string - "[ \t\n]*\\'" "" - low-level-body)))) - - ;; Case 3. Standard headline. Export it as a section. - (t (format section-fmt text contents ))))) - -;;; Horizontal Rule -;; Not supported - -;;; Inline Babel Call -;; -;; Inline Babel Calls are ignored. - -;;; Inline Src Block - -(defun org-man-inline-src-block (inline-src-block contents info) - "Transcode an INLINE-SRC-BLOCK element from Org to Man. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((code (org-element-property :value inline-src-block))) - (cond - (org-man-source-highlight - (let* ((tmpdir (if (featurep 'xemacs) - temp-directory - temporary-file-directory )) - (in-file (make-temp-name - (expand-file-name "srchilite" tmpdir))) - (out-file (make-temp-name - (expand-file-name "reshilite" tmpdir))) - (org-lang (org-element-property :language inline-src-block)) - (lst-lang (cadr (assq (intern org-lang) - org-man-source-highlight-langs))) - - (cmd (concat (expand-file-name "source-highlight") - " -s " lst-lang - " -f groff_man" - " -i " in-file - " -o " out-file ))) - - (if lst-lang - (let ((code-block "" )) - (with-temp-file in-file (insert code)) - (shell-command cmd) - (setq code-block (org-file-contents out-file)) - (delete-file in-file) - (delete-file out-file) - code-block) - (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE\n" - code)))) - - ;; Do not use a special package: transcode it verbatim. - (t - (concat ".RS\n.nf\n" "\\fC" "\n" code "\n" - "\\fP\n.fi\n.RE\n"))))) - - -;;; Inlinetask -;;; Italic - -(defun org-man-italic (italic contents info) - "Transcode ITALIC from Org to Man. -CONTENTS is the text with italic markup. INFO is a plist holding -contextual information." - (format "\\fI%s\\fP" contents)) - - -;;; Item - - -(defun org-man-item (item contents info) - - "Transcode an ITEM element from Org to Man. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - - (let* ((bullet (org-element-property :bullet item)) - (type (org-element-property :type (org-element-property :parent item))) - (checkbox (case (org-element-property :checkbox item) - (on "\\o'\\(sq\\(mu'") ;; - (off "\\(sq ") ;; - (trans "\\o'\\(sq\\(mi'" ))) ;; - - (tag (let ((tag (org-element-property :tag item))) - ;; Check-boxes must belong to the tag. - (and tag (format "\\fB%s\\fP" - (concat checkbox - (org-export-data tag info))))))) - - (if (and (null tag ) - (null checkbox)) - (let* ((bullet (org-trim bullet)) - (marker (cond ((string= "-" bullet) "\\(em") - ((string= "*" bullet) "\\(bu") - ((eq type 'ordered) - (format "%s " (org-trim bullet))) - (t "\\(dg")))) - (concat ".IP " marker " 4\n" - (org-trim (or contents " " )))) - ; else - (concat ".TP\n" (or tag (concat " " checkbox)) "\n" - (org-trim (or contents " " )))))) - -;;; Keyword - - -(defun org-man-keyword (keyword contents info) - "Transcode a KEYWORD element from Org to Man. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((key (org-element-property :key keyword)) - (value (org-element-property :value keyword))) - (cond - ((string= key "MAN") value) - ((string= key "INDEX") nil) - ((string= key "TOC" ) nil)))) - - -;;; Line Break - -(defun org-man-line-break (line-break contents info) - "Transcode a LINE-BREAK object from Org to Man. -CONTENTS is nil. INFO is a plist holding contextual information." - ".br\n") - - -;;; Link - - -(defun org-man-link (link desc info) - "Transcode a LINK object from Org to Man. - -DESC is the description part of the link, or the empty string. -INFO is a plist holding contextual information. See -`org-export-data'." - - (let* ((type (org-element-property :type link)) - (raw-path (org-element-property :path link)) - ;; Ensure DESC really exists, or set it to nil. - (desc (and (not (string= desc "")) desc)) - - (path (cond - ((member type '("http" "https" "ftp" "mailto")) - (concat type ":" raw-path)) - ((string= type "file") - (when (string-match "\\(.+\\)::.+" raw-path) - (setq raw-path (match-string 1 raw-path))) - (if (file-name-absolute-p raw-path) - (concat "file://" (expand-file-name raw-path)) - (concat "file://" raw-path))) - (t raw-path))) - protocol) - (cond - ;; External link with a description part. - ((and path desc) (format "%s \\fBat\\fP \\fI%s\\fP" path desc)) - ;; External link without a description part. - (path (format "\\fI%s\\fP" path)) - ;; No path, only description. Try to do something useful. - (t (format "\\fI%s\\fP" desc))))) - - -;;; Paragraph - -(defun org-man-paragraph (paragraph contents info) - "Transcode a PARAGRAPH element from Org to Man. -CONTENTS is the contents of the paragraph, as a string. INFO is -the plist used as a communication channel." - (let ((parent (plist-get (nth 1 paragraph) :parent))) - (when parent - (let ((parent-type (car parent)) - (fixed-paragraph "")) - (cond ((and (eq parent-type 'item) - (plist-get (nth 1 parent) :bullet )) - (setq fixed-paragraph (concat "" contents))) - ((eq parent-type 'section) - (setq fixed-paragraph (concat ".PP\n" contents))) - ((eq parent-type 'footnote-definition) - (setq fixed-paragraph contents)) - (t (setq fixed-paragraph (concat "" contents)))) - fixed-paragraph )))) - - -;;; Plain List - -(defun org-man-plain-list (plain-list contents info) - "Transcode a PLAIN-LIST element from Org to Man. -CONTENTS is the contents of the list. INFO is a plist holding -contextual information." - contents) - -;;; Plain Text - -(defun org-man-plain-text (text info) - "Transcode a TEXT string from Org to Man. -TEXT is the string to transcode. INFO is a plist holding -contextual information." - (let ((output text)) - ;; Protect various chars. - (setq output (replace-regexp-in-string - "\\(?:[^\\]\\|^\\)\\(\\\\\\)\\(?:[^%$#&{}~^_\\]\\|$\\)" - "$\\" output nil t 1)) - ;; Activate smart quotes. Be sure to provide original TEXT string - ;; since OUTPUT may have been modified. - (when (plist-get info :with-smart-quotes) - (setq output (org-export-activate-smart-quotes output :utf-8 info text))) - ;; Handle break preservation if required. - (when (plist-get info :preserve-breaks) - (setq output (replace-regexp-in-string "\\(\\\\\\\\\\)?[ \t]*\n" ".br\n" - output))) - ;; Return value. - output)) - - - -;;; Planning - - -;;; Property Drawer - - -;;; Quote Block - -(defun org-man-quote-block (quote-block contents info) - "Transcode a QUOTE-BLOCK element from Org to Man. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (org-man--wrap-label - quote-block - (format ".RS\n%s\n.RE" contents))) - -;;; Quote Section - -(defun org-man-quote-section (quote-section contents info) - "Transcode a QUOTE-SECTION element from Org to Man. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((value (org-remove-indentation - (org-element-property :value quote-section)))) - (when value (format ".RS\\fI%s\\fP\n.RE\n" value)))) - - -;;; Radio Target - -(defun org-man-radio-target (radio-target text info) - "Transcode a RADIO-TARGET object from Org to Man. -TEXT is the text of the target. INFO is a plist holding -contextual information." - text ) - - -;;; Section - -(defun org-man-section (section contents info) - "Transcode a SECTION element from Org to Man. -CONTENTS holds the contents of the section. INFO is a plist -holding contextual information." - contents) - - -;;; Special Block - -(defun org-man-special-block (special-block contents info) - "Transcode a SPECIAL-BLOCK element from Org to Man. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let ((type (downcase (org-element-property :type special-block)))) - (org-man--wrap-label - special-block - (format "%s\n" contents)))) - - -;;; Src Block - -(defun org-man-src-block (src-block contents info) - "Transcode a SRC-BLOCK element from Org to Man. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((lang (org-element-property :language src-block)) - (code (org-element-property :value src-block)) - (custom-env (and lang - (cadr (assq (intern lang) - org-man-custom-lang-environments)))) - (num-start (case (org-element-property :number-lines src-block) - (continued (org-export-get-loc src-block info)) - (new 0))) - (retain-labels (org-element-property :retain-labels src-block))) - (cond - ;; Case 1. No source fontification. - ((not org-man-source-highlight) - (format ".RS\n.nf\n\\fC%s\\fP\n.fi\n.RE\n\n" - (org-export-format-code-default src-block info))) - (org-man-source-highlight - (let* ((tmpdir (if (featurep 'xemacs) - temp-directory - temporary-file-directory )) - - (in-file (make-temp-name - (expand-file-name "srchilite" tmpdir))) - (out-file (make-temp-name - (expand-file-name "reshilite" tmpdir))) - - (org-lang (org-element-property :language src-block)) - (lst-lang (cadr (assq (intern org-lang) - org-man-source-highlight-langs))) - - (cmd (concat "source-highlight" - " -s " lst-lang - " -f groff_man " - " -i " in-file - " -o " out-file))) - - (if lst-lang - (let ((code-block "")) - (with-temp-file in-file (insert code)) - (shell-command cmd) - (setq code-block (org-file-contents out-file)) - (delete-file in-file) - (delete-file out-file) - code-block) - (format ".RS\n.nf\n\\fC\\m[black]%s\\m[]\\fP\n.fi\n.RE" code))))))) - - -;;; Statistics Cookie - -(defun org-man-statistics-cookie (statistics-cookie contents info) - "Transcode a STATISTICS-COOKIE object from Org to Man. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-element-property :value statistics-cookie)) - - -;;; Strike-Through - -(defun org-man-strike-through (strike-through contents info) - "Transcode STRIKE-THROUGH from Org to Man. -CONTENTS is the text with strike-through markup. INFO is a plist -holding contextual information." - (format "\\fI%s\\fP" contents)) - -;;; Subscript - -(defun org-man-subscript (subscript contents info) - "Transcode a SUBSCRIPT object from Org to Man. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (format "\\d\\s-2%s\\s+2\\u" contents)) - -;;; Superscript "^_%s$ - -(defun org-man-superscript (superscript contents info) - "Transcode a SUPERSCRIPT object from Org to Man. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (format "\\u\\s-2%s\\s+2\\d" contents)) - - -;;; Table -;; -;; `org-man-table' is the entry point for table transcoding. It -;; takes care of tables with a "verbatim" attribute. Otherwise, it -;; delegates the job to either `org-man-table--table.el-table' or -;; `org-man-table--org-table' functions, depending of the type of -;; the table. -;; -;; `org-man-table--align-string' is a subroutine used to build -;; alignment string for Org tables. - -(defun org-man-table (table contents info) - "Transcode a TABLE element from Org to Man. -CONTENTS is the contents of the table. INFO is a plist holding -contextual information." - (cond - ;; Case 1: verbatim table. - ((or org-man-tables-verbatim - (let ((attr (read (format "(%s)" - (mapconcat - #'identity - (org-element-property :attr_man table) - " "))))) - - (and attr (plist-get attr :verbatim)))) - - (format ".nf\n\\fC%s\\fP\n.fi" - ;; Re-create table, without affiliated keywords. - (org-trim - (org-element-interpret-data - `(table nil ,@(org-element-contents table)))))) - ;; Case 2: Standard table. - (t (org-man-table--org-table table contents info)))) - -(defun org-man-table--align-string (divider table info) - "Return an appropriate Man alignment string. -TABLE is the considered table. INFO is a plist used as -a communication channel." - (let (alignment) - ;; Extract column groups and alignment from first (non-rule) row. - (org-element-map - (org-element-map table 'table-row - (lambda (row) - (and (eq (org-element-property :type row) 'standard) row)) - info 'first-match) - 'table-cell - (lambda (cell) - (let* ((borders (org-export-table-cell-borders cell info)) - (raw-width (org-export-table-cell-width cell info)) - (width-cm (when raw-width (/ raw-width 5))) - (width (if raw-width (format "w(%dc)" - (if (< width-cm 1) 1 width-cm)) ""))) - ;; Check left border for the first cell only. - (when (and (memq 'left borders) (not alignment)) - (push "|" alignment)) - (push - (case (org-export-table-cell-alignment cell info) - (left (concat "l" width divider)) - (right (concat "r" width divider)) - (center (concat "c" width divider))) - alignment) - (when (memq 'right borders) (push "|" alignment)))) - info) - (apply 'concat (reverse alignment)))) - -(defun org-man-table--org-table (table contents info) - "Return appropriate Man code for an Org table. - -TABLE is the table type element to transcode. CONTENTS is its -contents, as a string. INFO is a plist used as a communication -channel. - -This function assumes TABLE has `org' as its `:type' attribute." - (let* ((attr (org-export-read-attribute :attr_man table)) - (label (org-element-property :name table)) - (caption (and (not (plist-get attr :disable-caption)) - (org-man--caption/label-string table info))) - (divider (if (plist-get attr :divider) "|" " ")) - - ;; Determine alignment string. - (alignment (org-man-table--align-string divider table info)) - ;; Extract others display options. - - (lines (org-split-string contents "\n")) - - (attr-list - (delq nil - (list - (and (plist-get attr :expand) "expand") - (let ((placement (plist-get attr :placement))) - (cond ((string= placement 'center) "center") - ((string= placement 'left) nil) - (t (if org-man-tables-centered "center" "")))) - (or (plist-get attr :boxtype) "box")))) - - (title-line (plist-get attr :title-line)) - (long-cells (plist-get attr :long-cells)) - - (table-format (concat - (format "%s" (or (car attr-list) "" )) - (or - (let ((output-list '())) - (when (cdr attr-list) - (dolist (attr-item (cdr attr-list)) - (setq output-list (concat output-list (format ",%s" attr-item))))) - output-list) - ""))) - - (first-line (when lines (org-split-string (car lines) "\t")))) - ;; Prepare the final format string for the table. - - - (cond - ;; Others. - (lines (concat ".TS\n " table-format ";\n" - - (format "%s.\n" - (let ((final-line "")) - (when title-line - (dotimes (i (length first-line)) - (setq final-line (concat final-line "cb" divider)))) - - (setq final-line (concat final-line "\n")) - - (if alignment - (setq final-line (concat final-line alignment)) - (dotimes (i (length first-line)) - (setq final-line (concat final-line "c" divider)))) - final-line )) - - (format "%s.TE\n" - (let ((final-line "") - (long-line "") - (lines (org-split-string contents "\n"))) - - (dolist (line-item lines) - (setq long-line "") - - (if long-cells - (progn - (if (string= line-item "_") - (setq long-line (format "%s\n" line-item)) - ;; else string = - (let ((cell-item-list (org-split-string line-item "\t"))) - (dolist (cell-item cell-item-list) - - (cond ((eq cell-item (car (last cell-item-list))) - (setq long-line (concat long-line - (format "T{\n%s\nT}\t\n" cell-item )))) - (t - (setq long-line (concat long-line - (format "T{\n%s\nT}\t" cell-item )))))) - long-line)) - ;; else long cells - (setq final-line (concat final-line long-line ))) - - (setq final-line (concat final-line line-item "\n")))) - final-line)) - - (and caption (format ".TB \"%s\"" caption))))))) - -;;; Table Cell - -(defun org-man-table-cell (table-cell contents info) - "Transcode a TABLE-CELL element from Org to Man -CONTENTS is the cell contents. INFO is a plist used as -a communication channel." - (concat (if (and contents - org-man-table-scientific-notation - (string-match orgtbl-exp-regexp contents)) - ;; Use appropriate format string for scientific - ;; notation. - (format org-man-table-scientific-notation - (match-string 1 contents) - (match-string 2 contents)) - contents ) - (when (org-export-get-next-element table-cell info) "\t"))) - - -;;; Table Row - -(defun org-man-table-row (table-row contents info) - "Transcode a TABLE-ROW element from Org to Man -CONTENTS is the contents of the row. INFO is a plist used as -a communication channel." - ;; Rules are ignored since table separators are deduced from - ;; borders of the current row. - (when (eq (org-element-property :type table-row) 'standard) - (let* ((attr (mapconcat 'identity - (org-element-property - :attr_man (org-export-get-parent table-row)) - " ")) - ;; TABLE-ROW's borders are extracted from its first cell. - (borders - (org-export-table-cell-borders - (car (org-element-contents table-row)) info))) - (concat - ;; Mark horizontal lines - (cond ((and (memq 'top borders) (memq 'above borders)) "_\n")) - contents - - (cond - ;; When BOOKTABS are activated enforce bottom rule even when - ;; no hline was specifically marked. - ((and (memq 'bottom borders) (memq 'below borders)) "\n_") - ((memq 'below borders) "\n_")))))) - - -;;; Target - -(defun org-man-target (target contents info) - "Transcode a TARGET object from Org to Man. -CONTENTS is nil. INFO is a plist holding contextual -information." - (format "\\fI%s\\fP" - (org-export-solidify-link-text (org-element-property :value target)))) - - -;;; Timestamp - -(defun org-man-timestamp (timestamp contents info) - "Transcode a TIMESTAMP object from Org to Man. - CONTENTS is nil. INFO is a plist holding contextual - information." - "" ) - - -;;; Underline - -(defun org-man-underline (underline contents info) - "Transcode UNDERLINE from Org to Man. -CONTENTS is the text with underline markup. INFO is a plist -holding contextual information." - (format "\\fI%s\\fP" contents)) - - -;;; Verbatim - -(defun org-man-verbatim (verbatim contents info) - "Transcode a VERBATIM object from Org to Man. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (format ".nf\n%s\n.fi" contents)) - - -;;; Verse Block - -(defun org-man-verse-block (verse-block contents info) - "Transcode a VERSE-BLOCK element from Org to Man. -CONTENTS is verse block contents. INFO is a plist holding -contextual information." - (format ".RS\n.ft I\n%s\n.ft\n.RE" contents)) - - - -;;; Interactive functions - -(defun org-man-export-to-man - (&optional async subtreep visible-only body-only ext-plist) - "Export current buffer to a Man file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only the body -without any markers. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return output file's name." - (interactive) - (let ((outfile (org-export-output-file-name ".man" subtreep))) - (org-export-to-file 'man outfile - async subtreep visible-only body-only ext-plist))) - -(defun org-man-export-to-pdf - (&optional async subtreep visible-only body-only ext-plist) - "Export current buffer to Groff then process through to PDF. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write between -markers. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return PDF file's name." - (interactive) - (let ((outfile (org-export-output-file-name ".man" subtreep))) - (org-export-to-file 'man outfile - async subtreep visible-only body-only ext-plist - (lambda (file) (org-latex-compile file))))) - -(defun org-man-compile (file) - "Compile a Groff file. - -FILE is the name of the file being compiled. Processing is done -through the command specified in `org-man-pdf-process'. - -Return PDF file name or an error if it couldn't be produced." - (let* ((base-name (file-name-sans-extension (file-name-nondirectory file))) - (full-name (file-truename file)) - (out-dir (file-name-directory file)) - ;; Properly set working directory for compilation. - (default-directory (if (file-name-absolute-p file) - (file-name-directory full-name) - default-directory)) - errors) - (message (format "Processing Groff file %s..." file)) - (save-window-excursion - (cond - ;; A function is provided: Apply it. - ((functionp org-man-pdf-process) - (funcall org-man-pdf-process (shell-quote-argument file))) - ;; A list is provided: Replace %b, %f and %o with appropriate - ;; values in each command before applying it. Output is - ;; redirected to "*Org PDF Groff Output*" buffer. - ((consp org-man-pdf-process) - (let ((outbuf (get-buffer-create "*Org PDF Groff Output*"))) - (mapc - (lambda (command) - (shell-command - (replace-regexp-in-string - "%b" (shell-quote-argument base-name) - (replace-regexp-in-string - "%f" (shell-quote-argument full-name) - (replace-regexp-in-string - "%o" (shell-quote-argument out-dir) command t t) t t) t t) - outbuf)) - org-man-pdf-process) - ;; Collect standard errors from output buffer. - (setq errors (org-man-collect-errors outbuf)))) - (t (error "No valid command to process to PDF"))) - (let ((pdffile (concat out-dir base-name ".pdf"))) - ;; Check for process failure. Provide collected errors if - ;; possible. - (if (not (file-exists-p pdffile)) - (error (concat (format "PDF file %s wasn't produced" pdffile) - (when errors (concat ": " errors)))) - ;; Else remove log files, when specified, and signal end of - ;; process to user, along with any error encountered. - (when org-man-remove-logfiles - (dolist (ext org-man-logfiles-extensions) - (let ((file (concat out-dir base-name "." ext))) - (when (file-exists-p file) (delete-file file))))) - (message (concat "Process completed" - (if (not errors) "." - (concat " with errors: " errors))))) - ;; Return output file name. - pdffile)))) - -(defun org-man-collect-errors (buffer) - "Collect some kind of errors from \"groff\" output -BUFFER is the buffer containing output. -Return collected error types as a string, or nil if there was -none." - (with-current-buffer buffer - (save-excursion - (goto-char (point-max)) - ;; Find final run - nil ))) - - -(provide 'ox-man) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ox-man.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ox-md.el b/xemacs-packages/lisp/org-8.2.3c/ox-md.el deleted file mode 100644 index 811c4e58..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ox-md.el +++ /dev/null @@ -1,485 +0,0 @@ -;;; ox-md.el --- Markdown Back-End for Org Export Engine - -;; Copyright (C) 2012-2013 Free Software Foundation, Inc. - -;; Author: Nicolas Goaziou -;; Keywords: org, wp, markdown - -;; 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 . - -;;; Commentary: - -;; This library implements a Markdown back-end (vanilla flavour) for -;; Org exporter, based on `html' back-end. See Org manual for more -;; information. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'ox-html) - - - -;;; User-Configurable Variables - -(defgroup org-export-md nil - "Options specific to Markdown export back-end." - :tag "Org Markdown" - :group 'org-export - :version "24.4" - :package-version '(Org . "8.0")) - -(defcustom org-md-headline-style 'atx - "Style used to format headlines. -This variable can be set to either `atx' or `setext'." - :group 'org-export-md - :type '(choice - (const :tag "Use \"atx\" style" atx) - (const :tag "Use \"Setext\" style" setext))) - - - -;;; Define Back-End - -(org-export-define-derived-backend 'md 'html - :export-block '("MD" "MARKDOWN") - :filters-alist '((:filter-parse-tree . org-md-separate-elements)) - :menu-entry - '(?m "Export to Markdown" - ((?M "To temporary buffer" - (lambda (a s v b) (org-md-export-as-markdown a s v))) - (?m "To file" (lambda (a s v b) (org-md-export-to-markdown a s v))) - (?o "To file and open" - (lambda (a s v b) - (if a (org-md-export-to-markdown t s v) - (org-open-file (org-md-export-to-markdown nil s v))))))) - :translate-alist '((bold . org-md-bold) - (code . org-md-verbatim) - (comment . (lambda (&rest args) "")) - (comment-block . (lambda (&rest args) "")) - (example-block . org-md-example-block) - (fixed-width . org-md-example-block) - (footnote-definition . ignore) - (footnote-reference . ignore) - (headline . org-md-headline) - (horizontal-rule . org-md-horizontal-rule) - (inline-src-block . org-md-verbatim) - (italic . org-md-italic) - (item . org-md-item) - (line-break . org-md-line-break) - (link . org-md-link) - (paragraph . org-md-paragraph) - (plain-list . org-md-plain-list) - (plain-text . org-md-plain-text) - (quote-block . org-md-quote-block) - (quote-section . org-md-example-block) - (section . org-md-section) - (src-block . org-md-example-block) - (template . org-md-template) - (verbatim . org-md-verbatim))) - - - -;;; Filters - -(defun org-md-separate-elements (tree backend info) - "Make sure elements are separated by at least one blank line. - -TREE is the parse tree being exported. BACKEND is the export -back-end used. INFO is a plist used as a communication channel. - -Assume BACKEND is `md'." - (org-element-map tree org-element-all-elements - (lambda (elem) - (unless (eq (org-element-type elem) 'org-data) - (org-element-put-property - elem :post-blank - (let ((post-blank (org-element-property :post-blank elem))) - (if (not post-blank) 1 (max 1 post-blank))))))) - ;; Return updated tree. - tree) - - - -;;; Transcode Functions - -;;;; Bold - -(defun org-md-bold (bold contents info) - "Transcode BOLD object into Markdown format. -CONTENTS is the text within bold markup. INFO is a plist used as -a communication channel." - (format "**%s**" contents)) - - -;;;; Code and Verbatim - -(defun org-md-verbatim (verbatim contents info) - "Transcode VERBATIM object into Markdown format. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (let ((value (org-element-property :value verbatim))) - (format (cond ((not (string-match "`" value)) "`%s`") - ((or (string-match "\\``" value) - (string-match "`\\'" value)) - "`` %s ``") - (t "``%s``")) - value))) - - -;;;; Example Block and Src Block - -(defun org-md-example-block (example-block contents info) - "Transcode EXAMPLE-BLOCK element into Markdown format. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (replace-regexp-in-string - "^" " " - (org-remove-indentation - (org-element-property :value example-block)))) - - -;;;; Headline - -(defun org-md-headline (headline contents info) - "Transcode HEADLINE element into Markdown format. -CONTENTS is the headline contents. INFO is a plist used as -a communication channel." - (unless (org-element-property :footnote-section-p headline) - (let* ((level (org-export-get-relative-level headline info)) - (title (org-export-data (org-element-property :title headline) info)) - (todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword - headline))) - (and todo (concat (org-export-data todo info) " "))))) - (tags (and (plist-get info :with-tags) - (let ((tag-list (org-export-get-tags headline info))) - (and tag-list - (format " :%s:" - (mapconcat 'identity tag-list ":")))))) - (priority - (and (plist-get info :with-priority) - (let ((char (org-element-property :priority headline))) - (and char (format "[#%c] " char))))) - ;; Headline text without tags. - (heading (concat todo priority title))) - (cond - ;; Cannot create a headline. Fall-back to a list. - ((or (org-export-low-level-p headline info) - (not (memq org-md-headline-style '(atx setext))) - (and (eq org-md-headline-style 'atx) (> level 6)) - (and (eq org-md-headline-style 'setext) (> level 2))) - (let ((bullet - (if (not (org-export-numbered-headline-p headline info)) "-" - (concat (number-to-string - (car (last (org-export-get-headline-number - headline info)))) - ".")))) - (concat bullet (make-string (- 4 (length bullet)) ? ) heading tags - "\n\n" - (and contents - (replace-regexp-in-string "^" " " contents))))) - ;; Use "Setext" style. - ((eq org-md-headline-style 'setext) - (concat heading tags "\n" - (make-string (length heading) (if (= level 1) ?= ?-)) - "\n\n" - contents)) - ;; Use "atx" style. - (t (concat (make-string level ?#) " " heading tags "\n\n" contents)))))) - - -;;;; Horizontal Rule - -(defun org-md-horizontal-rule (horizontal-rule contents info) - "Transcode HORIZONTAL-RULE element into Markdown format. -CONTENTS is the horizontal rule contents. INFO is a plist used -as a communication channel." - "---") - - -;;;; Italic - -(defun org-md-italic (italic contents info) - "Transcode ITALIC object into Markdown format. -CONTENTS is the text within italic markup. INFO is a plist used -as a communication channel." - (format "*%s*" contents)) - - -;;;; Item - -(defun org-md-item (item contents info) - "Transcode ITEM element into Markdown format. -CONTENTS is the item contents. INFO is a plist used as -a communication channel." - (let* ((type (org-element-property :type (org-export-get-parent item))) - (struct (org-element-property :structure item)) - (bullet (if (not (eq type 'ordered)) "-" - (concat (number-to-string - (car (last (org-list-get-item-number - (org-element-property :begin item) - struct - (org-list-prevs-alist struct) - (org-list-parents-alist struct))))) - ".")))) - (concat bullet - (make-string (- 4 (length bullet)) ? ) - (case (org-element-property :checkbox item) - (on "[X] ") - (trans "[-] ") - (off "[ ] ")) - (let ((tag (org-element-property :tag item))) - (and tag (format "**%s:** "(org-export-data tag info)))) - (org-trim (replace-regexp-in-string "^" " " contents))))) - - -;;;; Line Break - -(defun org-md-line-break (line-break contents info) - "Transcode LINE-BREAK object into Markdown format. -CONTENTS is nil. INFO is a plist used as a communication -channel." - " \n") - - -;;;; Link - -(defun org-md-link (link contents info) - "Transcode LINE-BREAK object into Markdown format. -CONTENTS is the link's description. INFO is a plist used as -a communication channel." - (let ((--link-org-files-as-html-maybe - (function - (lambda (raw-path info) - ;; Treat links to `file.org' as links to `file.html', if - ;; needed. See `org-html-link-org-files-as-html'. - (cond - ((and org-html-link-org-files-as-html - (string= ".org" - (downcase (file-name-extension raw-path ".")))) - (concat (file-name-sans-extension raw-path) "." - (plist-get info :html-extension))) - (t raw-path))))) - (type (org-element-property :type link))) - (cond ((member type '("custom-id" "id")) - (let ((destination (org-export-resolve-id-link link info))) - (if (stringp destination) ; External file. - (let ((path (funcall --link-org-files-as-html-maybe - destination info))) - (if (not contents) (format "<%s>" path) - (format "[%s](%s)" contents path))) - (concat - (and contents (concat contents " ")) - (format "(%s)" - (format (org-export-translate "See section %s" :html info) - (mapconcat 'number-to-string - (org-export-get-headline-number - destination info) - "."))))))) - ((org-export-inline-image-p link org-html-inline-image-rules) - (let ((path (let ((raw-path (org-element-property :path link))) - (if (not (file-name-absolute-p raw-path)) raw-path - (expand-file-name raw-path))))) - (format "![%s](%s)" - (let ((caption (org-export-get-caption - (org-export-get-parent-element link)))) - (when caption (org-export-data caption info))) - path))) - ((string= type "coderef") - (let ((ref (org-element-property :path link))) - (format (org-export-get-coderef-format ref contents) - (org-export-resolve-coderef ref info)))) - ((equal type "radio") - (let ((destination (org-export-resolve-radio-link link info))) - (org-export-data (org-element-contents destination) info))) - ((equal type "fuzzy") - (let ((destination (org-export-resolve-fuzzy-link link info))) - (if (org-string-nw-p contents) contents - (when destination - (let ((number (org-export-get-ordinal destination info))) - (when number - (if (atom number) (number-to-string number) - (mapconcat 'number-to-string number ".")))))))) - (t (let* ((raw-path (org-element-property :path link)) - (path (cond - ((member type '("http" "https" "ftp")) - (concat type ":" raw-path)) - ((equal type "file") - ;; Treat links to ".org" files as ".html", - ;; if needed. - (setq raw-path - (funcall --link-org-files-as-html-maybe - raw-path info)) - ;; If file path is absolute, prepend it - ;; with protocol component - "file://". - (if (not (file-name-absolute-p raw-path)) raw-path - (concat "file://" (expand-file-name raw-path)))) - (t raw-path)))) - (if (not contents) (format "<%s>" path) - (format "[%s](%s)" contents path))))))) - - -;;;; Paragraph - -(defun org-md-paragraph (paragraph contents info) - "Transcode PARAGRAPH element into Markdown format. -CONTENTS is the paragraph contents. INFO is a plist used as -a communication channel." - (let ((first-object (car (org-element-contents paragraph)))) - ;; If paragraph starts with a #, protect it. - (if (and (stringp first-object) (string-match "\\`#" first-object)) - (replace-regexp-in-string "\\`#" "\\#" contents nil t) - contents))) - - -;;;; Plain List - -(defun org-md-plain-list (plain-list contents info) - "Transcode PLAIN-LIST element into Markdown format. -CONTENTS is the plain-list contents. INFO is a plist used as -a communication channel." - contents) - - -;;;; Plain Text - -(defun org-md-plain-text (text info) - "Transcode a TEXT string into Markdown format. -TEXT is the string to transcode. INFO is a plist holding -contextual information." - (when (plist-get info :with-smart-quotes) - (setq text (org-export-activate-smart-quotes text :html info))) - ;; Protect ambiguous #. This will protect # at the beginning of - ;; a line, but not at the beginning of a paragraph. See - ;; `org-md-paragraph'. - (setq text (replace-regexp-in-string "\n#" "\n\\\\#" text)) - ;; Protect ambiguous ! - (setq text (replace-regexp-in-string "\\(!\\)\\[" "\\\\!" text nil nil 1)) - ;; Protect `, *, _ and \ - (setq text (replace-regexp-in-string "[`*_\\]" "\\\\\\&" text)) - ;; Handle special strings, if required. - (when (plist-get info :with-special-strings) - (setq text (org-html-convert-special-strings text))) - ;; Handle break preservation, if required. - (when (plist-get info :preserve-breaks) - (setq text (replace-regexp-in-string "[ \t]*\n" " \n" text))) - ;; Return value. - text) - - -;;;; Quote Block - -(defun org-md-quote-block (quote-block contents info) - "Transcode QUOTE-BLOCK element into Markdown format. -CONTENTS is the quote-block contents. INFO is a plist used as -a communication channel." - (replace-regexp-in-string - "^" "> " - (replace-regexp-in-string "\n\\'" "" contents))) - - -;;;; Section - -(defun org-md-section (section contents info) - "Transcode SECTION element into Markdown format. -CONTENTS is the section contents. INFO is a plist used as -a communication channel." - contents) - - -;;;; Template - -(defun org-md-template (contents info) - "Return complete document string after Markdown conversion. -CONTENTS is the transcoded contents string. INFO is a plist used -as a communication channel." - contents) - - - -;;; Interactive function - -;;;###autoload -(defun org-md-export-as-markdown (&optional async subtreep visible-only) - "Export current buffer to a Markdown buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should be accessible -through the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -Export is done in a buffer named \"*Org MD Export*\", which will -be displayed when `org-export-show-temporary-export-buffer' is -non-nil." - (interactive) - (org-export-to-buffer 'md "*Org MD Export*" - async subtreep visible-only nil nil (lambda () (text-mode)))) - -;;;###autoload -(defun org-md-convert-region-to-md () - "Assume the current region has org-mode syntax, and convert it to Markdown. -This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in a Markdown buffer and use -this command to convert it." - (interactive) - (org-export-replace-region-by 'md)) - - -;;;###autoload -(defun org-md-export-to-markdown (&optional async subtreep visible-only) - "Export current buffer to a Markdown file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -Return output file's name." - (interactive) - (let ((outfile (org-export-output-file-name ".md" subtreep))) - (org-export-to-file 'md outfile async subtreep visible-only))) - - -(provide 'ox-md) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ox-md.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ox-odt.el b/xemacs-packages/lisp/org-8.2.3c/ox-odt.el deleted file mode 100644 index 99c1353c..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ox-odt.el +++ /dev/null @@ -1,4411 +0,0 @@ -;;; ox-odt.el --- OpenDocument Text Exporter for Org Mode - -;; Copyright (C) 2010-2013 Free Software Foundation, Inc. - -;; Author: Jambunathan K -;; Keywords: outlines, hypermedia, calendar, wp -;; Homepage: http://orgmode.org - -;; 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 . - -;;; Commentary: - -;;; Code: - -(eval-when-compile - (require 'cl) - (require 'table nil 'noerror)) -(require 'format-spec) -(require 'ox) -(require 'org-compat) - -;;; Define Back-End - -(org-export-define-backend 'odt - '((bold . org-odt-bold) - (center-block . org-odt-center-block) - (clock . org-odt-clock) - (code . org-odt-code) - (drawer . org-odt-drawer) - (dynamic-block . org-odt-dynamic-block) - (entity . org-odt-entity) - (example-block . org-odt-example-block) - (export-block . org-odt-export-block) - (export-snippet . org-odt-export-snippet) - (fixed-width . org-odt-fixed-width) - (footnote-definition . org-odt-footnote-definition) - (footnote-reference . org-odt-footnote-reference) - (headline . org-odt-headline) - (horizontal-rule . org-odt-horizontal-rule) - (inline-src-block . org-odt-inline-src-block) - (inlinetask . org-odt-inlinetask) - (italic . org-odt-italic) - (item . org-odt-item) - (keyword . org-odt-keyword) - (latex-environment . org-odt-latex-environment) - (latex-fragment . org-odt-latex-fragment) - (line-break . org-odt-line-break) - (link . org-odt-link) - (paragraph . org-odt-paragraph) - (plain-list . org-odt-plain-list) - (plain-text . org-odt-plain-text) - (planning . org-odt-planning) - (property-drawer . org-odt-property-drawer) - (quote-block . org-odt-quote-block) - (quote-section . org-odt-quote-section) - (radio-target . org-odt-radio-target) - (section . org-odt-section) - (special-block . org-odt-special-block) - (src-block . org-odt-src-block) - (statistics-cookie . org-odt-statistics-cookie) - (strike-through . org-odt-strike-through) - (subscript . org-odt-subscript) - (superscript . org-odt-superscript) - (table . org-odt-table) - (table-cell . org-odt-table-cell) - (table-row . org-odt-table-row) - (target . org-odt-target) - (template . org-odt-template) - (timestamp . org-odt-timestamp) - (underline . org-odt-underline) - (verbatim . org-odt-verbatim) - (verse-block . org-odt-verse-block)) - :export-block "ODT" - :filters-alist '((:filter-parse-tree - . (org-odt--translate-latex-fragments - org-odt--translate-description-lists - org-odt--translate-list-tables))) - :menu-entry - '(?o "Export to ODT" - ((?o "As ODT file" org-odt-export-to-odt) - (?O "As ODT file and open" - (lambda (a s v b) - (if a (org-odt-export-to-odt t s v) - (org-open-file (org-odt-export-to-odt nil s v) 'system)))))) - :options-alist - '((:odt-styles-file "ODT_STYLES_FILE" nil nil t) - ;; Redefine regular option. - (:with-latex nil "tex" org-odt-with-latex))) - - -;;; Dependencies - -;;; Hooks - -;;; Function Declarations - -(declare-function org-id-find-id-file "org-id" (id)) -(declare-function hfy-face-to-style "htmlfontify" (fn)) -(declare-function hfy-face-or-def-to-name "htmlfontify" (fn)) -(declare-function archive-zip-extract "arc-mode" (archive name)) -(declare-function org-create-math-formula "org" (latex-frag &optional mathml-file)) -(declare-function browse-url-file-url "browse-url" (file)) - - - -;;; Internal Variables - -(defconst org-odt-lib-dir - (file-name-directory load-file-name) - "Location of ODT exporter. -Use this to infer values of `org-odt-styles-dir' and -`org-odt-schema-dir'.") - -(defvar org-odt-data-dir - (expand-file-name "../../etc/" org-odt-lib-dir) - "Data directory for ODT exporter. -Use this to infer values of `org-odt-styles-dir' and -`org-odt-schema-dir'.") - -(defconst org-odt-special-string-regexps - '(("\\\\-" . "­\\1") ; shy - ("---\\([^-]\\)" . "—\\1") ; mdash - ("--\\([^-]\\)" . "–\\1") ; ndash - ("\\.\\.\\." . "…")) ; hellip - "Regular expressions for special string conversion.") - -(defconst org-odt-schema-dir-list - (list - (and org-odt-data-dir - (expand-file-name "./schema/" org-odt-data-dir)) ; bail out - (eval-when-compile - (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install - (expand-file-name "./schema/" org-odt-data-dir)))) - "List of directories to search for OpenDocument schema files. -Use this list to set the default value of -`org-odt-schema-dir'. The entries in this list are -populated heuristically based on the values of `org-odt-lib-dir' -and `org-odt-data-dir'.") - -(defconst org-odt-styles-dir-list - (list - (and org-odt-data-dir - (expand-file-name "./styles/" org-odt-data-dir)) ; bail out - (eval-when-compile - (and (boundp 'org-odt-data-dir) org-odt-data-dir ; see make install - (expand-file-name "./styles/" org-odt-data-dir))) - (expand-file-name "../../etc/styles/" org-odt-lib-dir) ; git - (expand-file-name "./etc/styles/" org-odt-lib-dir) ; elpa - (expand-file-name "./org/" data-directory) ; system - ) - "List of directories to search for OpenDocument styles files. -See `org-odt-styles-dir'. The entries in this list are populated -heuristically based on the values of `org-odt-lib-dir' and -`org-odt-data-dir'.") - -(defconst org-odt-styles-dir - (let* ((styles-dir - (catch 'styles-dir - (message "Debug (ox-odt): Searching for OpenDocument styles files...") - (mapc (lambda (styles-dir) - (when styles-dir - (message "Debug (ox-odt): Trying %s..." styles-dir) - (when (and (file-readable-p - (expand-file-name - "OrgOdtContentTemplate.xml" styles-dir)) - (file-readable-p - (expand-file-name - "OrgOdtStyles.xml" styles-dir))) - (message "Debug (ox-odt): Using styles under %s" - styles-dir) - (throw 'styles-dir styles-dir)))) - org-odt-styles-dir-list) - nil))) - (unless styles-dir - (error "Error (ox-odt): Cannot find factory styles files, aborting")) - styles-dir) - "Directory that holds auxiliary XML files used by the ODT exporter. - -This directory contains the following XML files - - \"OrgOdtStyles.xml\" and \"OrgOdtContentTemplate.xml\". These - XML files are used as the default values of - `org-odt-styles-file' and - `org-odt-content-template-file'. - -The default value of this variable varies depending on the -version of org in use and is initialized from -`org-odt-styles-dir-list'. Note that the user could be using org -from one of: org's own private git repository, GNU ELPA tar or -standard Emacs.") - -(defconst org-odt-bookmark-prefix "OrgXref.") - -(defconst org-odt-manifest-file-entry-tag - "\n") - -(defconst org-odt-file-extensions - '(("odt" . "OpenDocument Text") - ("ott" . "OpenDocument Text Template") - ("odm" . "OpenDocument Master Document") - ("ods" . "OpenDocument Spreadsheet") - ("ots" . "OpenDocument Spreadsheet Template") - ("odg" . "OpenDocument Drawing (Graphics)") - ("otg" . "OpenDocument Drawing Template") - ("odp" . "OpenDocument Presentation") - ("otp" . "OpenDocument Presentation Template") - ("odi" . "OpenDocument Image") - ("odf" . "OpenDocument Formula") - ("odc" . "OpenDocument Chart"))) - -(defconst org-odt-table-style-format - " - - - -" - "Template for auto-generated Table styles.") - -(defvar org-odt-automatic-styles '() - "Registry of automatic styles for various OBJECT-TYPEs. -The variable has the following form: -\(\(OBJECT-TYPE-A - \(\(OBJECT-NAME-A.1 OBJECT-PROPS-A.1\) - \(OBJECT-NAME-A.2 OBJECT-PROPS-A.2\) ...\)\) - \(OBJECT-TYPE-B - \(\(OBJECT-NAME-B.1 OBJECT-PROPS-B.1\) - \(OBJECT-NAME-B.2 OBJECT-PROPS-B.2\) ...\)\) - ...\). - -OBJECT-TYPEs could be \"Section\", \"Table\", \"Figure\" etc. -OBJECT-PROPS is (typically) a plist created by passing -\"#+ATTR_ODT: \" option to `org-odt-parse-block-attributes'. - -Use `org-odt-add-automatic-style' to add update this variable.'") - -(defvar org-odt-object-counters nil - "Running counters for various OBJECT-TYPEs. -Use this to generate automatic names and style-names. See -`org-odt-add-automatic-style'.") - -(defvar org-odt-src-block-paragraph-format - " - - - - - " - "Custom paragraph style for colorized source and example blocks. -This style is much the same as that of \"OrgFixedWidthBlock\" -except that the foreground and background colors are set -according to the default face identified by the `htmlfontify'.") - -(defvar hfy-optimisations) -(defvar org-odt-embedded-formulas-count 0) -(defvar org-odt-embedded-images-count 0) -(defvar org-odt-image-size-probe-method - (append (and (executable-find "identify") '(imagemagick)) ; See Bug#10675 - '(emacs fixed)) - "Ordered list of methods for determining image sizes.") - -(defvar org-odt-default-image-sizes-alist - '(("as-char" . (5 . 0.4)) - ("paragraph" . (5 . 5))) - "Hardcoded image dimensions one for each of the anchor - methods.") - -;; A4 page size is 21.0 by 29.7 cms -;; The default page settings has 2cm margin on each of the sides. So -;; the effective text area is 17.0 by 25.7 cm -(defvar org-odt-max-image-size '(17.0 . 20.0) - "Limiting dimensions for an embedded image.") - -(defconst org-odt-label-styles - '(("math-formula" "%c" "text" "(%n)") - ("math-label" "(%n)" "text" "(%n)") - ("category-and-value" "%e %n: %c" "category-and-value" "%e %n") - ("value" "%e %n: %c" "value" "%n")) - "Specify how labels are applied and referenced. - -This is an alist where each element is of the form: - - \(STYLE-NAME ATTACH-FMT REF-MODE REF-FMT) - -ATTACH-FMT controls how labels and captions are attached to an -entity. It may contain following specifiers - %e and %c. %e is -replaced with the CATEGORY-NAME. %n is replaced with -\" SEQNO \". %c is replaced -with CAPTION. - -REF-MODE and REF-FMT controls how label references are generated. -The following XML is generated for a label reference - -\" -REF-FMT \". REF-FMT may contain following -specifiers - %e and %n. %e is replaced with the CATEGORY-NAME. -%n is replaced with SEQNO. - -See also `org-odt-format-label'.") - -(defvar org-odt-category-map-alist - '(("__Table__" "Table" "value" "Table" org-odt--enumerable-p) - ("__Figure__" "Illustration" "value" "Figure" org-odt--enumerable-image-p) - ("__MathFormula__" "Text" "math-formula" "Equation" org-odt--enumerable-formula-p) - ("__DvipngImage__" "Equation" "value" "Equation" org-odt--enumerable-latex-image-p) - ("__Listing__" "Listing" "value" "Listing" org-odt--enumerable-p)) - "Map a CATEGORY-HANDLE to OD-VARIABLE and LABEL-STYLE. - -This is a list where each entry is of the form: - - \(CATEGORY-HANDLE OD-VARIABLE LABEL-STYLE CATEGORY-NAME ENUMERATOR-PREDICATE) - -CATEGORY_HANDLE identifies the captionable entity in question. - -OD-VARIABLE is the OpenDocument sequence counter associated with -the entity. These counters are declared within -\"...\" block of -`org-odt-content-template-file'. - -LABEL-STYLE is a key into `org-odt-label-styles' and specifies -how a given entity should be captioned and referenced. - -CATEGORY-NAME is used for qualifying captions on export. - -ENUMERATOR-PREDICATE is used for assigning a sequence number to -the entity. See `org-odt--enumerate'.") - -(defvar org-odt-manifest-file-entries nil) -(defvar hfy-user-sheet-assoc) - -(defvar org-odt-zip-dir nil - "Temporary work directory for OpenDocument exporter.") - - - -;;; User Configuration Variables - -(defgroup org-export-odt nil - "Options for exporting Org mode files to ODT." - :tag "Org Export ODT" - :group 'org-export) - - -;;;; Debugging - -(defcustom org-odt-prettify-xml nil - "Specify whether or not the xml output should be prettified. -When this option is turned on, `indent-region' is run on all -component xml buffers before they are saved. Turn this off for -regular use. Turn this on if you need to examine the xml -visually." - :group 'org-export-odt - :version "24.1" - :type 'boolean) - - -;;;; Document schema - -(require 'rng-loc) -(defcustom org-odt-schema-dir - (let* ((schema-dir - (catch 'schema-dir - (message "Debug (ox-odt): Searching for OpenDocument schema files...") - (mapc - (lambda (schema-dir) - (when schema-dir - (message "Debug (ox-odt): Trying %s..." schema-dir) - (when (and (file-expand-wildcards - (expand-file-name "od-manifest-schema*.rnc" - schema-dir)) - (file-expand-wildcards - (expand-file-name "od-schema*.rnc" - schema-dir)) - (file-readable-p - (expand-file-name "schemas.xml" schema-dir))) - (message "Debug (ox-odt): Using schema files under %s" - schema-dir) - (throw 'schema-dir schema-dir)))) - org-odt-schema-dir-list) - (message "Debug (ox-odt): No OpenDocument schema files installed") - nil))) - schema-dir) - "Directory that contains OpenDocument schema files. - -This directory contains: -1. rnc files for OpenDocument schema -2. a \"schemas.xml\" file that specifies locating rules needed - for auto validation of OpenDocument XML files. - -Use the customize interface to set this variable. This ensures -that `rng-schema-locating-files' is updated and auto-validation -of OpenDocument XML takes place based on the value -`rng-nxml-auto-validate-flag'. - -The default value of this variable varies depending on the -version of org in use and is initialized from -`org-odt-schema-dir-list'. The OASIS schema files are available -only in the org's private git repository. It is *not* bundled -with GNU ELPA tar or standard Emacs distribution." - :type '(choice - (const :tag "Not set" nil) - (directory :tag "Schema directory")) - :group 'org-export-odt - :version "24.1" - :set - (lambda (var value) - "Set `org-odt-schema-dir'. -Also add it to `rng-schema-locating-files'." - (let ((schema-dir value)) - (set var - (if (and - (file-expand-wildcards - (expand-file-name "od-manifest-schema*.rnc" schema-dir)) - (file-expand-wildcards - (expand-file-name "od-schema*.rnc" schema-dir)) - (file-readable-p - (expand-file-name "schemas.xml" schema-dir))) - schema-dir - (when value - (message "Error (ox-odt): %s has no OpenDocument schema files" - value)) - nil))) - (when org-odt-schema-dir - (eval-after-load 'rng-loc - '(add-to-list 'rng-schema-locating-files - (expand-file-name "schemas.xml" - org-odt-schema-dir)))))) - - -;;;; Document styles - -(defcustom org-odt-content-template-file nil - "Template file for \"content.xml\". -The exporter embeds the exported content just before -\"\" element. - -If unspecified, the file named \"OrgOdtContentTemplate.xml\" -under `org-odt-styles-dir' is used." - :type '(choice (const nil) - (file)) - :group 'org-export-odt - :version "24.3") - -(defcustom org-odt-styles-file nil - "Default styles file for use with ODT export. -Valid values are one of: -1. nil -2. path to a styles.xml file -3. path to a *.odt or a *.ott file -4. list of the form (ODT-OR-OTT-FILE (FILE-MEMBER-1 FILE-MEMBER-2 -...)) - -In case of option 1, an in-built styles.xml is used. See -`org-odt-styles-dir' for more information. - -In case of option 3, the specified file is unzipped and the -styles.xml embedded therein is used. - -In case of option 4, the specified ODT-OR-OTT-FILE is unzipped -and FILE-MEMBER-1, FILE-MEMBER-2 etc are copied in to the -generated odt file. Use relative path for specifying the -FILE-MEMBERS. styles.xml must be specified as one of the -FILE-MEMBERS. - -Use options 1, 2 or 3 only if styles.xml alone suffices for -achieving the desired formatting. Use option 4, if the styles.xml -references additional files like header and footer images for -achieving the desired formatting. - -Use \"#+ODT_STYLES_FILE: ...\" directive to set this variable on -a per-file basis. For example, - -#+ODT_STYLES_FILE: \"/path/to/styles.xml\" or -#+ODT_STYLES_FILE: (\"/path/to/file.ott\" (\"styles.xml\" \"image/hdr.png\"))." - :group 'org-export-odt - :version "24.1" - :type - '(choice - (const :tag "Factory settings" nil) - (file :must-match t :tag "styles.xml") - (file :must-match t :tag "ODT or OTT file") - (list :tag "ODT or OTT file + Members" - (file :must-match t :tag "ODF Text or Text Template file") - (cons :tag "Members" - (file :tag " Member" "styles.xml") - (repeat (file :tag "Member")))))) - -(defcustom org-odt-display-outline-level 2 - "Outline levels considered for enumerating captioned entities." - :group 'org-export-odt - :version "24.4" - :package-version '(Org . "8.0") - :type 'integer) - -;;;; Document conversion - -(defcustom org-odt-convert-processes - '(("LibreOffice" - "soffice --headless --convert-to %f%x --outdir %d %i") - ("unoconv" - "unoconv -f %f -o %d %i")) - "Specify a list of document converters and their usage. -The converters in this list are offered as choices while -customizing `org-odt-convert-process'. - -This variable is a list where each element is of the -form (CONVERTER-NAME CONVERTER-CMD). CONVERTER-NAME is the name -of the converter. CONVERTER-CMD is the shell command for the -converter and can contain format specifiers. These format -specifiers are interpreted as below: - -%i input file name in full -%I input file name as a URL -%f format of the output file -%o output file name in full -%O output file name as a URL -%d output dir in full -%D output dir as a URL. -%x extra options as set in `org-odt-convert-capabilities'." - :group 'org-export-odt - :version "24.1" - :type - '(choice - (const :tag "None" nil) - (alist :tag "Converters" - :key-type (string :tag "Converter Name") - :value-type (group (string :tag "Command line"))))) - -(defcustom org-odt-convert-process "LibreOffice" - "Use this converter to convert from \"odt\" format to other formats. -During customization, the list of converter names are populated -from `org-odt-convert-processes'." - :group 'org-export-odt - :version "24.1" - :type '(choice :convert-widget - (lambda (w) - (apply 'widget-convert (widget-type w) - (eval (car (widget-get w :args))))) - `((const :tag "None" nil) - ,@(mapcar (lambda (c) - `(const :tag ,(car c) ,(car c))) - org-odt-convert-processes)))) - -(defcustom org-odt-convert-capabilities - '(("Text" - ("odt" "ott" "doc" "rtf" "docx") - (("pdf" "pdf") ("odt" "odt") ("rtf" "rtf") ("ott" "ott") - ("doc" "doc" ":\"MS Word 97\"") ("docx" "docx") ("html" "html"))) - ("Web" - ("html") - (("pdf" "pdf") ("odt" "odt") ("html" "html"))) - ("Spreadsheet" - ("ods" "ots" "xls" "csv" "xlsx") - (("pdf" "pdf") ("ots" "ots") ("html" "html") ("csv" "csv") ("ods" "ods") - ("xls" "xls") ("xlsx" "xlsx"))) - ("Presentation" - ("odp" "otp" "ppt" "pptx") - (("pdf" "pdf") ("swf" "swf") ("odp" "odp") ("otp" "otp") ("ppt" "ppt") - ("pptx" "pptx") ("odg" "odg")))) - "Specify input and output formats of `org-odt-convert-process'. -More correctly, specify the set of input and output formats that -the user is actually interested in. - -This variable is an alist where each element is of the -form (DOCUMENT-CLASS INPUT-FMT-LIST OUTPUT-FMT-ALIST). -INPUT-FMT-LIST is a list of INPUT-FMTs. OUTPUT-FMT-ALIST is an -alist where each element is of the form (OUTPUT-FMT -OUTPUT-FILE-EXTENSION EXTRA-OPTIONS). - -The variable is interpreted as follows: -`org-odt-convert-process' can take any document that is in -INPUT-FMT-LIST and produce any document that is in the -OUTPUT-FMT-LIST. A document converted to OUTPUT-FMT will have -OUTPUT-FILE-EXTENSION as the file name extension. OUTPUT-FMT -serves dual purposes: -- It is used for populating completion candidates during - `org-odt-convert' commands. -- It is used as the value of \"%f\" specifier in - `org-odt-convert-process'. - -EXTRA-OPTIONS is used as the value of \"%x\" specifier in -`org-odt-convert-process'. - -DOCUMENT-CLASS is used to group a set of file formats in -INPUT-FMT-LIST in to a single class. - -Note that this variable inherently captures how LibreOffice based -converters work. LibreOffice maps documents of various formats -to classes like Text, Web, Spreadsheet, Presentation etc and -allow document of a given class (irrespective of it's source -format) to be converted to any of the export formats associated -with that class. - -See default setting of this variable for an typical -configuration." - :group 'org-export-odt - :version "24.1" - :type - '(choice - (const :tag "None" nil) - (alist :tag "Capabilities" - :key-type (string :tag "Document Class") - :value-type - (group (repeat :tag "Input formats" (string :tag "Input format")) - (alist :tag "Output formats" - :key-type (string :tag "Output format") - :value-type - (group (string :tag "Output file extension") - (choice - (const :tag "None" nil) - (string :tag "Extra options")))))))) - -(defcustom org-odt-preferred-output-format nil - "Automatically post-process to this format after exporting to \"odt\". -Command `org-odt-export-to-odt' exports first to \"odt\" format -and then uses `org-odt-convert-process' to convert the -resulting document to this format. During customization of this -variable, the list of valid values are populated based on -`org-odt-convert-capabilities'. - -You can set this option on per-file basis using file local -values. See Info node `(emacs) File Variables'." - :group 'org-export-odt - :version "24.1" - :type '(choice :convert-widget - (lambda (w) - (apply 'widget-convert (widget-type w) - (eval (car (widget-get w :args))))) - `((const :tag "None" nil) - ,@(mapcar (lambda (c) - `(const :tag ,c ,c)) - (org-odt-reachable-formats "odt"))))) -;;;###autoload -(put 'org-odt-preferred-output-format 'safe-local-variable 'stringp) - - -;;;; Drawers - -(defcustom org-odt-format-drawer-function - (lambda (name contents) contents) - "Function called to format a drawer in ODT code. - -The function must accept two parameters: - NAME the drawer name, like \"LOGBOOK\" - CONTENTS the contents of the drawer. - -The function should return the string to be exported. - -The default value simply returns the value of CONTENTS." - :group 'org-export-odt - :version "24.4" - :package-version '(Org . "8.3") - :type 'function) - - -;;;; Headline - -(defcustom org-odt-format-headline-function 'ignore - "Function to format headline text. - -This function will be called with 5 arguments: -TODO the todo keyword \(string or nil\). -TODO-TYPE the type of todo \(symbol: `todo', `done', nil\) -PRIORITY the priority of the headline \(integer or nil\) -TEXT the main headline text \(string\). -TAGS the tags string, separated with colons \(string or nil\). - -The function result will be used as headline text." - :group 'org-export-odt - :version "24.4" - :package-version '(Org . "8.0") - :type 'function) - - -;;;; Inlinetasks - -(defcustom org-odt-format-inlinetask-function 'ignore - "Function called to format an inlinetask in ODT code. - -The function must accept six parameters: - TODO the todo keyword, as a string - TODO-TYPE the todo type, a symbol among `todo', `done' and nil. - PRIORITY the inlinetask priority, as a string - NAME the inlinetask name, as a string. - TAGS the inlinetask tags, as a string. - CONTENTS the contents of the inlinetask, as a string. - -The function should return the string to be exported." - :group 'org-export-odt - :version "24.4" - :package-version '(Org . "8.0") - :type 'function) - - -;;;; LaTeX - -(defcustom org-odt-with-latex org-export-with-latex - "Non-nil means process LaTeX math snippets. - -When set, the exporter will process LaTeX environments and -fragments. - -This option can also be set with the +OPTIONS line, -e.g. \"tex:mathjax\". Allowed values are: - -nil Ignore math snippets. -`verbatim' Keep everything in verbatim -`dvipng' Process the LaTeX fragments to images. This will also - include processing of non-math environments. -`imagemagick' Convert the LaTeX fragments to pdf files and use - imagemagick to convert pdf files to png files. -`mathjax' Do MathJax preprocessing and arrange for MathJax.js to - be loaded. -t Synonym for `mathjax'." - :group 'org-export-odt - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (const :tag "Do not process math in any way" nil) - (const :tag "Use dvipng to make images" dvipng) - (const :tag "Use imagemagick to make images" imagemagick) - (const :tag "Use MathJax to display math" mathjax) - (const :tag "Leave math verbatim" verbatim))) - - -;;;; Links - -(defcustom org-odt-inline-formula-rules - '(("file" . "\\.\\(mathml\\|mml\\|odf\\)\\'")) - "Rules characterizing formula files that can be inlined into ODT. - -A rule consists in an association whose key is the type of link -to consider, and value is a regexp that will be matched against -link's path." - :group 'org-export-odt - :version "24.4" - :package-version '(Org . "8.0") - :type '(alist :key-type (string :tag "Type") - :value-type (regexp :tag "Path"))) - -(defcustom org-odt-inline-image-rules - '(("file" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\)\\'")) - "Rules characterizing image files that can be inlined into ODT. - -A rule consists in an association whose key is the type of link -to consider, and value is a regexp that will be matched against -link's path." - :group 'org-export-odt - :version "24.4" - :package-version '(Org . "8.0") - :type '(alist :key-type (string :tag "Type") - :value-type (regexp :tag "Path"))) - -(defcustom org-odt-pixels-per-inch 96.0 - "Scaling factor for converting images pixels to inches. -Use this for sizing of embedded images. See Info node `(org) -Images in ODT export' for more information." - :type 'float - :group 'org-export-odt - :version "24.4" - :package-version '(Org . "8.1")) - - -;;;; Src Block - -(defcustom org-odt-create-custom-styles-for-srcblocks t - "Whether custom styles for colorized source blocks be automatically created. -When this option is turned on, the exporter creates custom styles -for source blocks based on the advice of `htmlfontify'. Creation -of custom styles happen as part of `org-odt-hfy-face-to-css'. - -When this option is turned off exporter does not create such -styles. - -Use the latter option if you do not want the custom styles to be -based on your current display settings. It is necessary that the -styles.xml already contains needed styles for colorizing to work. - -This variable is effective only if -`org-odt-fontify-srcblocks' is turned on." - :group 'org-export-odt - :version "24.1" - :type 'boolean) - -(defcustom org-odt-fontify-srcblocks t - "Specify whether or not source blocks need to be fontified. -Turn this option on if you want to colorize the source code -blocks in the exported file. For colorization to work, you need -to make available an enhanced version of `htmlfontify' library." - :type 'boolean - :group 'org-export-odt - :version "24.1") - - -;;;; Table - -(defcustom org-odt-table-styles - '(("OrgEquation" "OrgEquation" - ((use-first-column-styles . t) - (use-last-column-styles . t))) - ("TableWithHeaderRowAndColumn" "Custom" - ((use-first-row-styles . t) - (use-first-column-styles . t))) - ("TableWithFirstRowandLastRow" "Custom" - ((use-first-row-styles . t) - (use-last-row-styles . t))) - ("GriddedTable" "Custom" nil)) - "Specify how Table Styles should be derived from a Table Template. -This is a list where each element is of the -form (TABLE-STYLE-NAME TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS). - -TABLE-STYLE-NAME is the style associated with the table through -\"#+ATTR_ODT: :style TABLE-STYLE-NAME\" line. - -TABLE-TEMPLATE-NAME is a set of - upto 9 - automatic -TABLE-CELL-STYLE-NAMEs and PARAGRAPH-STYLE-NAMEs (as defined -below) that is included in -`org-odt-content-template-file'. - -TABLE-CELL-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + - \"TableCell\" -PARAGRAPH-STYLE-NAME := TABLE-TEMPLATE-NAME + TABLE-CELL-TYPE + - \"TableParagraph\" -TABLE-CELL-TYPE := \"FirstRow\" | \"LastColumn\" | - \"FirstRow\" | \"LastRow\" | - \"EvenRow\" | \"OddRow\" | - \"EvenColumn\" | \"OddColumn\" | \"\" -where \"+\" above denotes string concatenation. - -TABLE-CELL-OPTIONS is an alist where each element is of the -form (TABLE-CELL-STYLE-SELECTOR . ON-OR-OFF). -TABLE-CELL-STYLE-SELECTOR := `use-first-row-styles' | - `use-last-row-styles' | - `use-first-column-styles' | - `use-last-column-styles' | - `use-banding-rows-styles' | - `use-banding-columns-styles' | - `use-first-row-styles' -ON-OR-OFF := `t' | `nil' - -For example, with the following configuration - -\(setq org-odt-table-styles - '\(\(\"TableWithHeaderRowsAndColumns\" \"Custom\" - \(\(use-first-row-styles . t\) - \(use-first-column-styles . t\)\)\) - \(\"TableWithHeaderColumns\" \"Custom\" - \(\(use-first-column-styles . t\)\)\)\)\) - -1. A table associated with \"TableWithHeaderRowsAndColumns\" - style will use the following table-cell styles - - \"CustomFirstRowTableCell\", \"CustomFirstColumnTableCell\", - \"CustomTableCell\" and the following paragraph styles - \"CustomFirstRowTableParagraph\", - \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" - as appropriate. - -2. A table associated with \"TableWithHeaderColumns\" style will - use the following table-cell styles - - \"CustomFirstColumnTableCell\", \"CustomTableCell\" and the - following paragraph styles - \"CustomFirstColumnTableParagraph\", \"CustomTableParagraph\" - as appropriate.. - -Note that TABLE-TEMPLATE-NAME corresponds to the -\"\" elements contained within -\"\". The entries (TABLE-STYLE-NAME -TABLE-TEMPLATE-NAME TABLE-CELL-OPTIONS) correspond to -\"table:template-name\" and \"table:use-first-row-styles\" etc -attributes of \"\" element. Refer ODF-1.2 -specification for more information. Also consult the -implementation filed under `org-odt-get-table-cell-styles'. - -The TABLE-STYLE-NAME \"OrgEquation\" is used internally for -formatting of numbered display equations. Do not delete this -style from the list." - :group 'org-export-odt - :version "24.1" - :type '(choice - (const :tag "None" nil) - (repeat :tag "Table Styles" - (list :tag "Table Style Specification" - (string :tag "Table Style Name") - (string :tag "Table Template Name") - (alist :options (use-first-row-styles - use-last-row-styles - use-first-column-styles - use-last-column-styles - use-banding-rows-styles - use-banding-columns-styles) - :key-type symbol - :value-type (const :tag "True" t)))))) - -;;;; Timestamps - -(defcustom org-odt-use-date-fields nil - "Non-nil, if timestamps should be exported as date fields. - -When nil, export timestamps as plain text. - -When non-nil, map `org-time-stamp-custom-formats' to a pair of -OpenDocument date-styles with names \"OrgDate1\" and \"OrgDate2\" -respectively. A timestamp with no time component is formatted -with style \"OrgDate1\" while one with explicit hour and minutes -is formatted with style \"OrgDate2\". - -This feature is experimental. Most (but not all) of the common -%-specifiers in `format-time-string' are supported. -Specifically, locale-dependent specifiers like \"%c\", \"%x\" are -formatted as canonical Org timestamps. For finer control, avoid -these %-specifiers. - -Textutal specifiers like \"%b\", \"%h\", \"%B\", \"%a\", \"%A\" -etc., are displayed by the application in the default language -and country specified in `org-odt-styles-file'. Note that the -default styles file uses language \"en\" and country \"GB\". You -can localize the week day and month strings in the exported -document by setting the default language and country either using -the application UI or through a custom styles file. - -See `org-odt--build-date-styles' for implementation details." - :group 'org-export-odt - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - - - -;;; Internal functions - -;;;; Date - -(defun org-odt--format-timestamp (timestamp &optional end iso-date-p) - (let* ((format-timestamp - (lambda (timestamp format &optional end utc) - (if timestamp - (org-timestamp-format timestamp format end utc) - (format-time-string format nil utc)))) - (has-time-p (or (not timestamp) - (org-timestamp-has-time-p timestamp))) - (iso-date (let ((format (if has-time-p "%Y-%m-%dT%H:%M:%S" - "%Y-%m-%dT%H:%M:%S"))) - (funcall format-timestamp timestamp format end)))) - (if iso-date-p iso-date - (let* ((style (if has-time-p "OrgDate2" "OrgDate1")) - ;; LibreOffice does not care about end goes as content - ;; within the "..." field. The - ;; displayed date is automagically corrected to match the - ;; format requested by "style:data-style-name" attribute. So - ;; don't bother about formatting the date contents to be - ;; compatible with "OrgDate1" and "OrgDateTime" styles. A - ;; simple Org-style date should suffice. - (date (let* ((formats - (if org-display-custom-times - (cons (substring - (car org-time-stamp-custom-formats) 1 -1) - (substring - (cdr org-time-stamp-custom-formats) 1 -1)) - '("%Y-%m-%d %a" . "%Y-%m-%d %a %H:%M"))) - (format (if has-time-p (cdr formats) (car formats)))) - (funcall format-timestamp timestamp format end))) - (repeater (let ((repeater-type (org-element-property - :repeater-type timestamp)) - (repeater-value (org-element-property - :repeater-value timestamp)) - (repeater-unit (org-element-property - :repeater-unit timestamp))) - (concat - (case repeater-type - (catchup "++") (restart ".+") (cumulate "+")) - (when repeater-value - (number-to-string repeater-value)) - (case repeater-unit - (hour "h") (day "d") (week "w") (month "m") - (year "y")))))) - (concat - (format "%s" - iso-date style date) - (and (not (string= repeater "")) " ") - repeater))))) - -;;;; Frame - -(defun org-odt--frame (text width height style &optional extra - anchor-type &rest title-and-desc) - (let ((frame-attrs - (concat - (if width (format " svg:width=\"%0.2fcm\"" width) "") - (if height (format " svg:height=\"%0.2fcm\"" height) "") - extra - (format " text:anchor-type=\"%s\"" (or anchor-type "paragraph"))))) - (format - "\n\n%s\n" - style frame-attrs - (concat text - (let ((title (car title-and-desc)) - (desc (cadr title-and-desc))) - (concat (when title - (format "%s" - (org-odt--encode-plain-text title t))) - (when desc - (format "%s" - (org-odt--encode-plain-text desc t))))))))) - - -;;;; Library wrappers - -(defun org-odt--zip-extract (archive members target) - (when (atom members) (setq members (list members))) - (mapc (lambda (member) - (require 'arc-mode) - (let* ((--quote-file-name - ;; This is shamelessly stolen from `archive-zip-extract'. - (lambda (name) - (if (or (not (memq system-type '(windows-nt ms-dos))) - (and (boundp 'w32-quote-process-args) - (null w32-quote-process-args))) - (shell-quote-argument name) - name))) - (target (funcall --quote-file-name target)) - (archive (expand-file-name archive)) - (archive-zip-extract - (list "unzip" "-qq" "-o" "-d" target)) - exit-code command-output) - (setq command-output - (with-temp-buffer - (setq exit-code (archive-zip-extract archive member)) - (buffer-string))) - (unless (zerop exit-code) - (message command-output) - (error "Extraction failed")))) - members)) - -;;;; Target - -(defun org-odt--target (text id) - (if (not id) text - (concat - (format "\n" id) - (format "\n" id) text - (format "\n" id)))) - -;;;; Textbox - -(defun org-odt--textbox (text width height style &optional - extra anchor-type) - (org-odt--frame - (format "\n%s\n" - (concat (format " fo:min-height=\"%0.2fcm\"" (or height .2)) - (and (not width) - (format " fo:min-width=\"%0.2fcm\"" (or width .2)))) - text) - width nil style extra anchor-type)) - - - -;;;; Table of Contents - -(defun org-odt-begin-toc (index-title depth) - (concat - (format " - - - %s -" depth index-title) - - (let ((levels (number-sequence 1 10))) - (mapconcat - (lambda (level) - (format - " - - - - - - -" level level)) levels "")) - - (format " - - - - - %s - - " index-title))) - -(defun org-odt-end-toc () - (format " - - -")) - -(defun* org-odt-format-toc-headline - (todo todo-type priority text tags - &key level section-number headline-label &allow-other-keys) - (setq text - (concat - ;; Section number. - (when section-number (concat section-number ". ")) - ;; Todo. - (when todo - (let ((style (if (member todo org-done-keywords) - "OrgDone" "OrgTodo"))) - (format "%s " - style todo))) - (when priority - (let* ((style (format "OrgPriority-%s" priority)) - (priority (format "[#%c]" priority))) - (format "%s " - style priority))) - ;; Title. - text - ;; Tags. - (when tags - (concat - (format " [%s]" - "OrgTags" - (mapconcat - (lambda (tag) - (format - "%s" - "OrgTag" tag)) tags " : ")))))) - (format "%s" - headline-label text)) - -(defun org-odt-toc (depth info) - (assert (wholenump depth)) - ;; When a headline is marked as a radio target, as in the example below: - ;; - ;; ** <<>> - ;; Some text. - ;; - ;; suppress generation of radio targets. i.e., Radio targets are to - ;; be marked as targets within /document body/ and *not* within - ;; /TOC/, as otherwise there will be duplicated anchors one in TOC - ;; and one in the document body. - ;; - ;; FIXME-1: Currently exported headings are memoized. `org-export.el' - ;; doesn't provide a way to disable memoization. So this doesn't - ;; work. - ;; - ;; FIXME-2: Are there any other objects that need to be suppressed - ;; within TOC? - (let* ((title (org-export-translate "Table of Contents" :utf-8 info)) - (headlines (org-export-collect-headlines - info (and (wholenump depth) depth))) - (backend (org-export-create-backend - :parent (org-export-backend-name - (plist-get info :back-end)) - :transcoders (mapcar - (lambda (type) (cons type (lambda (d c i) c))) - (list 'radio-target))))) - (when headlines - (concat - (org-odt-begin-toc title depth) - (mapconcat - (lambda (headline) - (let* ((entry (org-odt-format-headline--wrap - headline backend info 'org-odt-format-toc-headline)) - (level (org-export-get-relative-level headline info)) - (style (format "Contents_20_%d" level))) - (format "\n%s" - style entry))) - headlines "\n") - (org-odt-end-toc))))) - - -;;;; Document styles - -(defun org-odt-add-automatic-style (object-type &optional object-props) - "Create an automatic style of type OBJECT-TYPE with param OBJECT-PROPS. -OBJECT-PROPS is (typically) a plist created by passing -\"#+ATTR_ODT: \" option of the object in question to -`org-odt-parse-block-attributes'. - -Use `org-odt-object-counters' to generate an automatic -OBJECT-NAME and STYLE-NAME. If OBJECT-PROPS is non-nil, add a -new entry in `org-odt-automatic-styles'. Return (OBJECT-NAME -. STYLE-NAME)." - (assert (stringp object-type)) - (let* ((object (intern object-type)) - (seqvar object) - (seqno (1+ (or (plist-get org-odt-object-counters seqvar) 0))) - (object-name (format "%s%d" object-type seqno)) style-name) - (setq org-odt-object-counters - (plist-put org-odt-object-counters seqvar seqno)) - (when object-props - (setq style-name (format "Org%s" object-name)) - (setq org-odt-automatic-styles - (plist-put org-odt-automatic-styles object - (append (list (list style-name object-props)) - (plist-get org-odt-automatic-styles object))))) - (cons object-name style-name))) - -;;;; Checkbox - -(defun org-odt--checkbox (item) - "Return check-box string associated to ITEM." - (let ((checkbox (org-element-property :checkbox item))) - (if (not checkbox) "" - (format "%s" - "OrgCode" (case checkbox - (on "[✓] ") ; CHECK MARK - (off "[ ] ") - (trans "[-] ")))))) - -;;; Template - -(defun org-odt--build-date-styles (fmt style) - ;; In LibreOffice 3.4.6, there doesn't seem to be a convenient way - ;; to modify the date fields. A date could be modified by - ;; offsetting in days. That's about it. Also, date and time may - ;; have to be emitted as two fields - a date field and a time field - ;; - separately. - - ;; One can add Form Controls to date and time fields so that they - ;; can be easily modified. But then, the exported document will - ;; become tightly coupled with LibreOffice and may not function - ;; properly with other OpenDocument applications. - - ;; I have a strange feeling that Date styles are a bit flaky at the - ;; moment. - - ;; The feature is experimental. - (when (and fmt style) - (let* ((fmt-alist - '(("%A" . "") - ("%B" . "") - ("%H" . "") - ("%M" . "") - ("%S" . "") - ("%V" . "") - ("%Y" . "") - ("%a" . "") - ("%b" . "") - ("%d" . "") - ("%e" . "") - ("%h" . "") - ("%k" . "") - ("%m" . "") - ("%p" . "") - ("%y" . ""))) - (case-fold-search nil) - (re (mapconcat 'identity (mapcar 'car fmt-alist) "\\|")) - match rpl (start 0) (filler-beg 0) filler-end filler output) - (mapc - (lambda (pair) - (setq fmt (replace-regexp-in-string (car pair) (cdr pair) fmt t t))) - '(("\\(?:%[[:digit:]]*N\\)" . "") ; strip ns, us and ns - ("%C" . "Y") ; replace century with year - ("%D" . "%m/%d/%y") - ("%G" . "Y") ; year corresponding to iso week - ("%I" . "%H") ; hour on a 12-hour clock - ("%R" . "%H:%M") - ("%T" . "%H:%M:%S") - ("%U\\|%W" . "%V") ; week no. starting on Sun./Mon. - ("%Z" . "") ; time zone name - ("%c" . "%Y-%M-%d %a %H:%M" ) ; locale's date and time format - ("%g" . "%y") - ("%X" . "%x" ) ; locale's pref. time format - ("%j" . "") ; day of the year - ("%l" . "%k") ; like %I blank-padded - ("%s" . "") ; no. of secs since 1970-01-01 00:00:00 +0000 - ("%n" . "") - ("%r" . "%I:%M:%S %p") - ("%t" . "") - ("%u\\|%w" . "") ; numeric day of week - Mon (1-7), Sun(0-6) - ("%x" . "%Y-%M-%d %a") ; locale's pref. time format - ("%z" . "") ; time zone in numeric form - )) - (while (string-match re fmt start) - (setq match (match-string 0 fmt)) - (setq rpl (assoc-default match fmt-alist)) - (setq start (match-end 0)) - (setq filler-end (match-beginning 0)) - (setq filler (substring fmt (prog1 filler-beg - (setq filler-beg (match-end 0))) - filler-end)) - (setq filler (and (not (string= filler "")) - (format "%s" - (org-odt--encode-plain-text filler)))) - (setq output (concat output "\n" filler "\n" rpl))) - (setq filler (substring fmt filler-beg)) - (unless (string= filler "") - (setq output (concat output - (format "\n%s" - (org-odt--encode-plain-text filler))))) - (format "\n%s\n" - style - (concat " number:automatic-order=\"true\"" - " number:format-source=\"fixed\"") - output )))) - -(defun org-odt-template (contents info) - "Return complete document string after ODT conversion. -CONTENTS is the transcoded contents string. RAW-DATA is the -original parsed data. INFO is a plist holding export options." - ;; Write meta file. - (let ((title (org-export-data (plist-get info :title) info)) - (author (let ((author (plist-get info :author))) - (if (not author) "" (org-export-data author info)))) - (email (plist-get info :email)) - (keywords (plist-get info :keywords)) - (description (plist-get info :description))) - (write-region - (concat - " - - \n" - (format "%s\n" author) - (format "%s\n" author) - ;; Date, if required. - (when (plist-get info :with-date) - ;; Check if DATE is specified as an Org-timestamp. If yes, - ;; include it as meta information. Otherwise, just use - ;; today's date. - (let* ((date (let ((date (plist-get info :date))) - (and (not (cdr date)) - (eq (org-element-type (car date)) 'timestamp) - (car date))))) - (let ((iso-date (org-odt--format-timestamp date nil 'iso-date))) - (concat - (format "%s\n" iso-date) - (format "%s\n" - iso-date))))) - (format "%s\n" - (let ((creator-info (plist-get info :with-creator))) - (if (or (not creator-info) (eq creator-info 'comment)) "" - (plist-get info :creator)))) - (format "%s\n" keywords) - (format "%s\n" description) - (format "%s\n" title) - "\n" - " \n" "") - nil (concat org-odt-zip-dir "meta.xml")) - ;; Add meta.xml in to manifest. - (org-odt-create-manifest-file-entry "text/xml" "meta.xml")) - - ;; Update styles file. - ;; Copy styles.xml. Also dump htmlfontify styles, if there is any. - ;; Write styles file. - (let* ((styles-file (plist-get info :odt-styles-file)) - (styles-file (and styles-file (read (org-trim styles-file)))) - ;; Non-availability of styles.xml is not a critical - ;; error. For now, throw an error. - (styles-file (or styles-file - org-odt-styles-file - (expand-file-name "OrgOdtStyles.xml" - org-odt-styles-dir) - (error "org-odt: Missing styles file?")))) - (cond - ((listp styles-file) - (let ((archive (nth 0 styles-file)) - (members (nth 1 styles-file))) - (org-odt--zip-extract archive members org-odt-zip-dir) - (mapc - (lambda (member) - (when (org-file-image-p member) - (let* ((image-type (file-name-extension member)) - (media-type (format "image/%s" image-type))) - (org-odt-create-manifest-file-entry media-type member)))) - members))) - ((and (stringp styles-file) (file-exists-p styles-file)) - (let ((styles-file-type (file-name-extension styles-file))) - (cond - ((string= styles-file-type "xml") - (copy-file styles-file (concat org-odt-zip-dir "styles.xml") t)) - ((member styles-file-type '("odt" "ott")) - (org-odt--zip-extract styles-file "styles.xml" org-odt-zip-dir))))) - (t - (error (format "Invalid specification of styles.xml file: %S" - org-odt-styles-file)))) - - ;; create a manifest entry for styles.xml - (org-odt-create-manifest-file-entry "text/xml" "styles.xml") - - ;; FIXME: Who is opening an empty styles.xml before this point? - (with-current-buffer - (find-file-noselect (concat org-odt-zip-dir "styles.xml") t) - (revert-buffer t t) - - ;; Write custom styles for source blocks - ;; Save STYLES used for colorizing of source blocks. - ;; Update styles.xml with styles that were collected as part of - ;; `org-odt-hfy-face-to-css' callbacks. - (let ((styles (mapconcat (lambda (style) (format " %s\n" (cddr style))) - hfy-user-sheet-assoc ""))) - (when styles - (goto-char (point-min)) - (when (re-search-forward "" nil t) - (goto-char (match-beginning 0)) - (insert "\n\n" styles "\n")))) - - ;; Update styles.xml - take care of outline numbering - - ;; Don't make automatic backup of styles.xml file. This setting - ;; prevents the backed-up styles.xml file from being zipped in to - ;; odt file. This is more of a hackish fix. Better alternative - ;; would be to fix the zip command so that the output odt file - ;; includes only the needed files and excludes any auto-generated - ;; extra files like backups and auto-saves etc etc. Note that - ;; currently the zip command zips up the entire temp directory so - ;; that any auto-generated files created under the hood ends up in - ;; the resulting odt file. - (set (make-local-variable 'backup-inhibited) t) - - ;; Outline numbering is retained only upto LEVEL. - ;; To disable outline numbering pass a LEVEL of 0. - - (goto-char (point-min)) - (let ((regex - "]*\\)text:level=\"\\([^\"]*\\)\"\\([^>]*\\)>") - (replacement - "")) - (while (re-search-forward regex nil t) - (unless (let ((sec-num (plist-get info :section-numbers)) - (level (string-to-number (match-string 2)))) - (if (wholenump sec-num) (<= level sec-num) sec-num)) - (replace-match replacement t nil)))) - (save-buffer 0))) - ;; Update content.xml. - - (let* ( ;; `org-display-custom-times' should be accessed right - ;; within the context of the Org buffer. So obtain it's - ;; value before moving on to temp-buffer context down below. - (custom-time-fmts - (if org-display-custom-times - (cons (substring (car org-time-stamp-custom-formats) 1 -1) - (substring (cdr org-time-stamp-custom-formats) 1 -1)) - '("%Y-%M-%d %a" . "%Y-%M-%d %a %H:%M")))) - (with-temp-buffer - (insert-file-contents - (or org-odt-content-template-file - (expand-file-name "OrgOdtContentTemplate.xml" - org-odt-styles-dir))) - ;; Write automatic styles. - ;; - Position the cursor. - (goto-char (point-min)) - (re-search-forward " " nil t) - (goto-char (match-beginning 0)) - ;; - Dump automatic table styles. - (loop for (style-name props) in - (plist-get org-odt-automatic-styles 'Table) do - (when (setq props (or (plist-get props :rel-width) "96")) - (insert (format org-odt-table-style-format style-name props)))) - ;; - Dump date-styles. - (when org-odt-use-date-fields - (insert (org-odt--build-date-styles (car custom-time-fmts) - "OrgDate1") - (org-odt--build-date-styles (cdr custom-time-fmts) - "OrgDate2"))) - ;; Update display level. - ;; - Remove existing sequence decls. Also position the cursor. - (goto-char (point-min)) - (when (re-search-forward "" nil nil))) - ;; Update sequence decls according to user preference. - (insert - (format - "\n\n%s\n" - (mapconcat - (lambda (x) - (format - "" - org-odt-display-outline-level (nth 1 x))) - org-odt-category-map-alist "\n"))) - ;; Position the cursor to document body. - (goto-char (point-min)) - (re-search-forward "" nil nil) - (goto-char (match-beginning 0)) - - ;; Preamble - Title, Author, Date etc. - (insert - (let* ((title (org-export-data (plist-get info :title) info)) - (author (and (plist-get info :with-author) - (let ((auth (plist-get info :author))) - (and auth (org-export-data auth info))))) - (email (plist-get info :email)) - ;; Switch on or off above vars based on user settings - (author (and (plist-get info :with-author) (or author email))) - (email (and (plist-get info :with-email) email))) - (concat - ;; Title. - (when title - (concat - (format "\n%s" - "OrgTitle" (format "\n%s" title)) - ;; Separator. - "\n")) - (cond - ((and author (not email)) - ;; Author only. - (concat - (format "\n%s" - "OrgSubtitle" - (format "%s" author)) - ;; Separator. - "\n")) - ((and author email) - ;; Author and E-mail. - (concat - (format - "\n%s" - "OrgSubtitle" - (format - "%s" - (concat "mailto:" email) - (format "%s" author))) - ;; Separator. - "\n"))) - ;; Date, if required. - (when (plist-get info :with-date) - (let* ((date (plist-get info :date)) - ;; Check if DATE is specified as a timestamp. - (timestamp (and (not (cdr date)) - (eq (org-element-type (car date)) 'timestamp) - (car date)))) - (concat - (format "\n%s" - "OrgSubtitle" - (if (and org-odt-use-date-fields timestamp) - (org-odt--format-timestamp (car date)) - (org-export-data (plist-get info :date) info))) - ;; Separator - "")))))) - ;; Table of Contents - (let* ((with-toc (plist-get info :with-toc)) - (depth (and with-toc (if (wholenump with-toc) - with-toc - (plist-get info :headline-levels))))) - (when depth (insert (or (org-odt-toc depth info) "")))) - ;; Contents. - (insert contents) - ;; Return contents. - (buffer-substring-no-properties (point-min) (point-max))))) - - - -;;; Transcode Functions - -;;;; Bold - -(defun org-odt-bold (bold contents info) - "Transcode BOLD from Org to ODT. -CONTENTS is the text with bold markup. INFO is a plist holding -contextual information." - (format "%s" - "Bold" contents)) - - -;;;; Center Block - -(defun org-odt-center-block (center-block contents info) - "Transcode a CENTER-BLOCK element from Org to ODT. -CONTENTS holds the contents of the center block. INFO is a plist -holding contextual information." - contents) - - -;;;; Clock - -(defun org-odt-clock (clock contents info) - "Transcode a CLOCK element from Org to ODT. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (let ((timestamp (org-element-property :value clock)) - (duration (org-element-property :duration clock))) - (format "\n%s" - (if (eq (org-element-type (org-export-get-next-element clock info)) - 'clock) "OrgClock" "OrgClockLastLine") - (concat - (format "%s" - "OrgClockKeyword" org-clock-string) - (org-odt-timestamp timestamp contents info) - (and duration (format " (%s)" duration)))))) - - -;;;; Code - -(defun org-odt-code (code contents info) - "Transcode a CODE object from Org to ODT. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (format "%s" - "OrgCode" (org-odt--encode-plain-text - (org-element-property :value code)))) - - -;;;; Comment - -;; Comments are ignored. - - -;;;; Comment Block - -;; Comment Blocks are ignored. - - -;;;; Drawer - -(defun org-odt-drawer (drawer contents info) - "Transcode a DRAWER element from Org to ODT. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let* ((name (org-element-property :drawer-name drawer)) - (output (funcall org-odt-format-drawer-function - name contents))) - output)) - - -;;;; Dynamic Block - -(defun org-odt-dynamic-block (dynamic-block contents info) - "Transcode a DYNAMIC-BLOCK element from Org to ODT. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information. See `org-export-data'." - contents) - - -;;;; Entity - -(defun org-odt-entity (entity contents info) - "Transcode an ENTITY object from Org to ODT. -CONTENTS are the definition itself. INFO is a plist holding -contextual information." - (org-element-property :utf-8 entity)) - - -;;;; Example Block - -(defun org-odt-example-block (example-block contents info) - "Transcode a EXAMPLE-BLOCK element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-odt-format-code example-block info)) - - -;;;; Export Snippet - -(defun org-odt-export-snippet (export-snippet contents info) - "Transcode a EXPORT-SNIPPET object from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (eq (org-export-snippet-backend export-snippet) 'odt) - (org-element-property :value export-snippet))) - - -;;;; Export Block - -(defun org-odt-export-block (export-block contents info) - "Transcode a EXPORT-BLOCK element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (string= (org-element-property :type export-block) "ODT") - (org-remove-indentation (org-element-property :value export-block)))) - - -;;;; Fixed Width - -(defun org-odt-fixed-width (fixed-width contents info) - "Transcode a FIXED-WIDTH element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-odt-do-format-code (org-element-property :value fixed-width))) - - -;;;; Footnote Definition - -;; Footnote Definitions are ignored. - - -;;;; Footnote Reference - -(defun org-odt-footnote-reference (footnote-reference contents info) - "Transcode a FOOTNOTE-REFERENCE element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((--format-footnote-definition - (function - (lambda (n def) - (setq n (format "%d" n)) - (let ((id (concat "fn" n)) - (note-class "footnote") - (par-style "Footnote")) - (format - "%s" - id note-class - (concat - (format "%s" n) - (format "%s" def))))))) - (--format-footnote-reference - (function - (lambda (n) - (setq n (format "%d" n)) - (let ((note-class "footnote") - (ref-format "text") - (ref-name (concat "fn" n))) - (format - "%s" - "OrgSuperscript" - (format "%s" - note-class ref-format ref-name n))))))) - (concat - ;; Insert separator between two footnotes in a row. - (let ((prev (org-export-get-previous-element footnote-reference info))) - (and (eq (org-element-type prev) 'footnote-reference) - (format "%s" - "OrgSuperscript" ","))) - ;; Trancode footnote reference. - (let ((n (org-export-get-footnote-number footnote-reference info))) - (cond - ((not (org-export-footnote-first-reference-p footnote-reference info)) - (funcall --format-footnote-reference n)) - ;; Inline definitions are secondary strings. - ;; Non-inline footnotes definitions are full Org data. - (t - (let* ((raw (org-export-get-footnote-definition - footnote-reference info)) - (def - (let ((def (org-trim - (org-export-data-with-backend - raw - (org-export-create-backend - :parent 'odt - :transcoders - '((paragraph . (lambda (p c i) - (org-odt--format-paragraph - p c "Footnote" - "OrgFootnoteCenter" - "OrgFootnoteQuotations"))))) - info)))) - (if (eq (org-element-type raw) 'org-data) def - (format "\n%s" - "Footnote" def))))) - (funcall --format-footnote-definition n def)))))))) - - -;;;; Headline - -(defun* org-odt-format-headline - (todo todo-type priority text tags - &key level section-number headline-label &allow-other-keys) - (concat - ;; Todo. - (when todo - (let ((style (if (member todo org-done-keywords) "OrgDone" "OrgTodo"))) - (format "%s " - style todo))) - (when priority - (let* ((style (format "OrgPriority-%s" priority)) - (priority (format "[#%c]" priority))) - (format "%s " - style priority))) - ;; Title. - text - ;; Tags. - (when tags - (concat - "" - (format "[%s]" - "OrgTags" (mapconcat - (lambda (tag) - (format - "%s" - "OrgTag" tag)) tags " : ")))))) - -(defun org-odt-format-headline--wrap (headline backend info - &optional format-function - &rest extra-keys) - "Transcode a HEADLINE element using BACKEND. -INFO is a plist holding contextual information." - (setq backend (or backend (plist-get info :back-end))) - (let* ((level (+ (org-export-get-relative-level headline info))) - (headline-number (org-export-get-headline-number headline info)) - (section-number (and (org-export-numbered-headline-p headline info) - (mapconcat 'number-to-string - headline-number "."))) - (todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword headline))) - (and todo - (org-export-data-with-backend todo backend info))))) - (todo-type (and todo (org-element-property :todo-type headline))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority headline))) - (text (org-export-data-with-backend - (org-element-property :title headline) backend info)) - (tags (and (plist-get info :with-tags) - (org-export-get-tags headline info))) - (headline-label (concat "sec-" (mapconcat 'number-to-string - headline-number "-"))) - (format-function (cond - ((functionp format-function) format-function) - ((not (eq org-odt-format-headline-function 'ignore)) - (function* - (lambda (todo todo-type priority text tags - &allow-other-keys) - (funcall org-odt-format-headline-function - todo todo-type priority text tags)))) - (t 'org-odt-format-headline)))) - (apply format-function - todo todo-type priority text tags - :headline-label headline-label :level level - :section-number section-number extra-keys))) - -(defun org-odt-headline (headline contents info) - "Transcode a HEADLINE element from Org to ODT. -CONTENTS holds the contents of the headline. INFO is a plist -holding contextual information." - ;; Case 1: This is a footnote section: ignore it. - (unless (org-element-property :footnote-section-p headline) - (let* ((text (org-export-data (org-element-property :title headline) info)) - ;; Create the headline text. - (full-text (org-odt-format-headline--wrap headline nil info)) - ;; Get level relative to current parsed data. - (level (org-export-get-relative-level headline info)) - ;; Get canonical label for the headline. - (id (concat "sec-" (mapconcat 'number-to-string - (org-export-get-headline-number - headline info) "-"))) - ;; Get user-specified labels for the headline. - (extra-ids (list (org-element-property :CUSTOM_ID headline) - (org-element-property :ID headline))) - ;; Extra targets. - (extra-targets - (mapconcat (lambda (x) - (when x - (let ((x (if (org-uuidgen-p x) (concat "ID-" x) x))) - (org-odt--target - "" (org-export-solidify-link-text x))))) - extra-ids "")) - ;; Title. - (anchored-title (org-odt--target full-text id))) - (cond - ;; Case 2. This is a deep sub-tree: export it as a list item. - ;; Also export as items headlines for which no section - ;; format has been found. - ((org-export-low-level-p headline info) - ;; Build the real contents of the sub-tree. - (concat - (and (org-export-first-sibling-p headline info) - (format "\n" - ;; Choose style based on list type. - (if (org-export-numbered-headline-p headline info) - "OrgNumberedList" "OrgBulletedList") - ;; If top-level list, re-start numbering. Otherwise, - ;; continue numbering. - (format "text:continue-numbering=\"%s\"" - (let* ((parent (org-export-get-parent-headline - headline))) - (if (and parent - (org-export-low-level-p parent info)) - "true" "false"))))) - (let ((headline-has-table-p - (let ((section (assq 'section (org-element-contents headline)))) - (assq 'table (and section (org-element-contents section)))))) - (format "\n\n%s\n%s" - (concat - (format "\n%s" - "Text_20_body" - (concat extra-targets anchored-title)) - contents) - (if headline-has-table-p - "" - ""))) - (and (org-export-last-sibling-p headline info) - ""))) - ;; Case 3. Standard headline. Export it as a section. - (t - (concat - (format - "\n%s" - (format "Heading_20_%s" level) - level - (concat extra-targets anchored-title)) - contents)))))) - - -;;;; Horizontal Rule - -(defun org-odt-horizontal-rule (horizontal-rule contents info) - "Transcode an HORIZONTAL-RULE object from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (format "\n%s" - "Horizontal_20_Line" "")) - - -;;;; Inline Babel Call - -;; Inline Babel Calls are ignored. - - -;;;; Inline Src Block - -(defun org-odt--find-verb-separator (s) - "Return a character not used in string S. -This is used to choose a separator for constructs like \\verb." - (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) - (loop for c across ll - when (not (string-match (regexp-quote (char-to-string c)) s)) - return (char-to-string c)))) - -(defun org-odt-inline-src-block (inline-src-block contents info) - "Transcode an INLINE-SRC-BLOCK element from Org to ODT. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((org-lang (org-element-property :language inline-src-block)) - (code (org-element-property :value inline-src-block)) - (separator (org-odt--find-verb-separator code))) - (error "FIXME"))) - - -;;;; Inlinetask - -(defun org-odt-inlinetask (inlinetask contents info) - "Transcode an INLINETASK element from Org to ODT. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (cond - ;; If `org-odt-format-inlinetask-function' is not 'ignore, call it - ;; with appropriate arguments. - ((not (eq org-odt-format-inlinetask-function 'ignore)) - (let ((format-function - (function* - (lambda (todo todo-type priority text tags - &key contents &allow-other-keys) - (funcall org-odt-format-inlinetask-function - todo todo-type priority text tags contents))))) - (org-odt-format-headline--wrap - inlinetask nil info format-function :contents contents))) - ;; Otherwise, use a default template. - (t - (format "\n%s" - "Text_20_body" - (org-odt--textbox - (concat - (format "\n%s" - "OrgInlineTaskHeading" - (org-odt-format-headline--wrap inlinetask nil info)) - contents) - nil nil "OrgInlineTaskFrame" " style:rel-width=\"100%\""))))) - -;;;; Italic - -(defun org-odt-italic (italic contents info) - "Transcode ITALIC from Org to ODT. -CONTENTS is the text with italic markup. INFO is a plist holding -contextual information." - (format "%s" - "Emphasis" contents)) - - -;;;; Item - -(defun org-odt-item (item contents info) - "Transcode an ITEM element from Org to ODT. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((plain-list (org-export-get-parent item)) - (type (org-element-property :type plain-list)) - (counter (org-element-property :counter item)) - (tag (let ((tag (org-element-property :tag item))) - (and tag - (concat (org-odt--checkbox item) - (org-export-data tag info)))))) - (case type - ((ordered unordered descriptive-1 descriptive-2) - (format "\n\n%s\n%s" - contents - (let* ((--element-has-a-table-p - (function - (lambda (element info) - (loop for el in (org-element-contents element) - thereis (eq (org-element-type el) 'table)))))) - (cond - ((funcall --element-has-a-table-p item info) - "") - (t ""))))) - (t (error "Unknown list type: %S" type))))) - -;;;; Keyword - -(defun org-odt-keyword (keyword contents info) - "Transcode a KEYWORD element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((key (org-element-property :key keyword)) - (value (org-element-property :value keyword))) - (cond - ((string= key "ODT") value) - ((string= key "INDEX") - ;; FIXME - (ignore)) - ((string= key "TOC") - (let ((value (downcase value))) - (cond - ((string-match "\\" value) - (let ((depth (or (and (string-match "[0-9]+" value) - (string-to-number (match-string 0 value))) - (plist-get info :with-toc)))) - (when (wholenump depth) (org-odt-toc depth info)))) - ((member value '("tables" "figures" "listings")) - ;; FIXME - (ignore)))))))) - - -;;;; Latex Environment - - -;; (eval-after-load 'ox-odt '(ad-deactivate 'org-format-latex-as-mathml)) -;; (defadvice org-format-latex-as-mathml ; FIXME -;; (after org-odt-protect-latex-fragment activate) -;; "Encode LaTeX fragment as XML. -;; Do this when translation to MathML fails." -;; (unless (> (length ad-return-value) 0) -;; (setq ad-return-value (org-odt--encode-plain-text (ad-get-arg 0))))) - -(defun org-odt-latex-environment (latex-environment contents info) - "Transcode a LATEX-ENVIRONMENT element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (let* ((latex-frag (org-remove-indentation - (org-element-property :value latex-environment)))) - (org-odt-do-format-code latex-frag))) - - -;;;; Latex Fragment - -;; (when latex-frag ; FIXME -;; (setq href (org-propertize href :title "LaTeX Fragment" -;; :description latex-frag))) -;; handle verbatim -;; provide descriptions - -(defun org-odt-latex-fragment (latex-fragment contents info) - "Transcode a LATEX-FRAGMENT object from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (let* ((latex-frag (org-element-property :value latex-fragment)) - (processing-type (plist-get info :with-latex))) - (format "%s" - "OrgCode" (org-odt--encode-plain-text latex-frag t)))) - - -;;;; Line Break - -(defun org-odt-line-break (line-break contents info) - "Transcode a LINE-BREAK object from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - "") - - -;;;; Link - -;;;; Links :: Label references - -(defun org-odt--enumerate (element info &optional predicate n) - (when predicate (assert (funcall predicate element info))) - (let* ((--numbered-parent-headline-at-<=-n - (function - (lambda (element n info) - (loop for x in (org-export-get-genealogy element) - thereis (and (eq (org-element-type x) 'headline) - (<= (org-export-get-relative-level x info) n) - (org-export-numbered-headline-p x info) - x))))) - (--enumerate - (function - (lambda (element scope info &optional predicate) - (let ((counter 0)) - (org-element-map (or scope (plist-get info :parse-tree)) - (org-element-type element) - (lambda (el) - (and (or (not predicate) (funcall predicate el info)) - (incf counter) - (eq element el) - counter)) - info 'first-match))))) - (scope (funcall --numbered-parent-headline-at-<=-n - element (or n org-odt-display-outline-level) info)) - (ordinal (funcall --enumerate element scope info predicate)) - (tag - (concat - ;; Section number. - (and scope - (mapconcat 'number-to-string - (org-export-get-headline-number scope info) ".")) - ;; Separator. - (and scope ".") - ;; Ordinal. - (number-to-string ordinal)))) - tag)) - -(defun org-odt-format-label (element info op) - "Return a label for ELEMENT. - -ELEMENT is a `link', `table', `src-block' or `paragraph' type -element. INFO is a plist used as a communication channel. OP is -either `definition' or `reference', depending on the purpose of -the generated string. - -Return value is a string if OP is set to `reference' or a cons -cell like CAPTION . SHORT-CAPTION) where CAPTION and -SHORT-CAPTION are strings." - (assert (memq (org-element-type element) '(link table src-block paragraph))) - (let* ((caption-from - (case (org-element-type element) - (link (org-export-get-parent-element element)) - (t element))) - ;; Get label and caption. - (label (org-element-property :name caption-from)) - (caption (org-export-get-caption caption-from)) - (short-caption (org-export-get-caption caption-from t)) - ;; Transcode captions. - (caption (and caption (org-export-data caption info))) - ;; Currently short caption are sneaked in as object names. - ;; - ;; The advantages are: - ;; - ;; - Table Of Contents: Currently, there is no support for - ;; building TOC for figures, listings and tables. See - ;; `org-odt-keyword'. User instead has to rely on - ;; external application for building such indices. Within - ;; LibreOffice, building an "Illustration Index" or "Index - ;; of Tables" will create a table with long captions (only) - ;; and building a table with "Object names" will create a - ;; table with short captions. - ;; - ;; - Easy navigation: In LibreOffice, object names are - ;; offered via the navigation bar. This way one can - ;; quickly locate and jump to object of his choice in the - ;; exported document. - ;; - ;; The main disadvantage is that there cannot be any markups - ;; within object names i.e., one cannot embolden, italicize - ;; or underline text within short caption. So suppress - ;; generation of ... and other - ;; markups by overriding the default translators. We - ;; probably shouldn't be suppressing translators for all - ;; elements in `org-element-all-objects', but for now this - ;; will do. - (short-caption - (let ((short-caption (or short-caption caption)) - (backend (org-export-create-backend - :parent (org-export-backend-name - (plist-get info :back-end)) - :transcoders - (mapcar (lambda (type) (cons type (lambda (o c i) c))) - org-element-all-objects)))) - (when short-caption - (org-export-data-with-backend short-caption backend info))))) - (when (or label caption) - (let* ((default-category - (case (org-element-type element) - (table "__Table__") - (src-block "__Listing__") - ((link paragraph) - (cond - ((org-odt--enumerable-latex-image-p element info) - "__DvipngImage__") - ((org-odt--enumerable-image-p element info) - "__Figure__") - ((org-odt--enumerable-formula-p element info) - "__MathFormula__") - (t (error "Don't know how to format label for link: %S" - element)))) - (t (error "Don't know how to format label for element type: %s" - (org-element-type element))))) - seqno) - (assert default-category) - (destructuring-bind (counter label-style category predicate) - (assoc-default default-category org-odt-category-map-alist) - ;; Compute sequence number of the element. - (setq seqno (org-odt--enumerate element info predicate)) - ;; Localize category string. - (setq category (org-export-translate category :utf-8 info)) - (case op - ;; Case 1: Handle Label definition. - (definition - ;; Assign an internal label, if user has not provided one - (setq label (org-export-solidify-link-text - (or label (format "%s-%s" default-category seqno)))) - (cons - (concat - ;; Sneak in a bookmark. The bookmark is used when the - ;; labeled element is referenced with a link that - ;; provides it's own description. - (format "\n" label) - ;; Label definition: Typically formatted as below: - ;; CATEGORY SEQ-NO: LONG CAPTION - ;; with translation for correct punctuation. - (format-spec - (org-export-translate - (cadr (assoc-string label-style org-odt-label-styles t)) - :utf-8 info) - `((?e . ,category) - (?n . ,(format - "%s" - label counter counter seqno)) - (?c . ,(or caption ""))))) - short-caption)) - ;; Case 2: Handle Label reference. - (reference - (assert label) - (setq label (org-export-solidify-link-text label)) - (let* ((fmt (cddr (assoc-string label-style org-odt-label-styles t))) - (fmt1 (car fmt)) - (fmt2 (cadr fmt))) - (format "%s" - fmt1 label (format-spec fmt2 `((?e . ,category) - (?n . ,seqno)))))) - (t (error "Unknown %S on label" op)))))))) - - -;;;; Links :: Inline Images - -(defun org-odt--copy-image-file (path) - "Returns the internal name of the file" - (let* ((image-type (file-name-extension path)) - (media-type (format "image/%s" image-type)) - (target-dir "Images/") - (target-file - (format "%s%04d.%s" target-dir - (incf org-odt-embedded-images-count) image-type))) - (message "Embedding %s as %s..." - (substring-no-properties path) target-file) - - (when (= 1 org-odt-embedded-images-count) - (make-directory (concat org-odt-zip-dir target-dir)) - (org-odt-create-manifest-file-entry "" target-dir)) - - (copy-file path (concat org-odt-zip-dir target-file) 'overwrite) - (org-odt-create-manifest-file-entry media-type target-file) - target-file)) - -(defun org-odt--image-size (file &optional user-width - user-height scale dpi embed-as) - (let* ((--pixels-to-cms - (function (lambda (pixels dpi) - (let ((cms-per-inch 2.54) - (inches (/ pixels dpi))) - (* cms-per-inch inches))))) - (--size-in-cms - (function - (lambda (size-in-pixels dpi) - (and size-in-pixels - (cons (funcall --pixels-to-cms (car size-in-pixels) dpi) - (funcall --pixels-to-cms (cdr size-in-pixels) dpi)))))) - (dpi (or dpi org-odt-pixels-per-inch)) - (anchor-type (or embed-as "paragraph")) - (user-width (and (not scale) user-width)) - (user-height (and (not scale) user-height)) - (size - (and - (not (and user-height user-width)) - (or - ;; Use Imagemagick. - (and (executable-find "identify") - (let ((size-in-pixels - (let ((dim (shell-command-to-string - (format "identify -format \"%%w:%%h\" \"%s\"" - file)))) - (when (string-match "\\([0-9]+\\):\\([0-9]+\\)" dim) - (cons (string-to-number (match-string 1 dim)) - (string-to-number (match-string 2 dim))))))) - (funcall --size-in-cms size-in-pixels dpi))) - ;; Use Emacs. - (let ((size-in-pixels - (ignore-errors ; Emacs could be in batch mode - (clear-image-cache) - (image-size (create-image file) 'pixels)))) - (funcall --size-in-cms size-in-pixels dpi)) - ;; Use hard-coded values. - (cdr (assoc-string anchor-type - org-odt-default-image-sizes-alist)) - ;; Error out. - (error "Cannot determine image size, aborting")))) - (width (car size)) (height (cdr size))) - (cond - (scale - (setq width (* width scale) height (* height scale))) - ((and user-height user-width) - (setq width user-width height user-height)) - (user-height - (setq width (* user-height (/ width height)) height user-height)) - (user-width - (setq height (* user-width (/ height width)) width user-width)) - (t (ignore))) - ;; ensure that an embedded image fits comfortably within a page - (let ((max-width (car org-odt-max-image-size)) - (max-height (cdr org-odt-max-image-size))) - (when (or (> width max-width) (> height max-height)) - (let* ((scale1 (/ max-width width)) - (scale2 (/ max-height height)) - (scale (min scale1 scale2))) - (setq width (* scale width) height (* scale height))))) - (cons width height))) - -(defun org-odt-link--inline-image (element info) - "Return ODT code for an inline image. -LINK is the link pointing to the inline image. INFO is a plist -used as a communication channel." - (assert (eq (org-element-type element) 'link)) - (let* ((src (let* ((type (org-element-property :type element)) - (raw-path (org-element-property :path element))) - (cond ((member type '("http" "https")) - (concat type ":" raw-path)) - ((file-name-absolute-p raw-path) - (expand-file-name raw-path)) - (t raw-path)))) - (src-expanded (if (file-name-absolute-p src) src - (expand-file-name src (file-name-directory - (plist-get info :input-file))))) - (href (format - "\n" - (org-odt--copy-image-file src-expanded))) - ;; Extract attributes from #+ATTR_ODT line. - (attr-from (case (org-element-type element) - (link (org-export-get-parent-element element)) - (t element))) - ;; Convert attributes to a plist. - (attr-plist (org-export-read-attribute :attr_odt attr-from)) - ;; Handle `:anchor', `:style' and `:attributes' properties. - (user-frame-anchor - (car (assoc-string (plist-get attr-plist :anchor) - '(("as-char") ("paragraph") ("page")) t))) - (user-frame-style - (and user-frame-anchor (plist-get attr-plist :style))) - (user-frame-attrs - (and user-frame-anchor (plist-get attr-plist :attributes))) - (user-frame-params - (list user-frame-style user-frame-attrs user-frame-anchor)) - ;; (embed-as (or embed-as user-frame-anchor "paragraph")) - ;; extrac - ;; - ;; Handle `:width', `:height' and `:scale' properties. Read - ;; them as numbers since we need them for computations. - (size (org-odt--image-size - src-expanded - (let ((width (plist-get attr-plist :width))) - (and width (read width))) - (let ((length (plist-get attr-plist :length))) - (and length (read length))) - (let ((scale (plist-get attr-plist :scale))) - (and scale (read scale))) - nil ; embed-as - "paragraph" ; FIXME - )) - (width (car size)) (height (cdr size)) - (standalone-link-p (org-odt--standalone-link-p element info)) - (embed-as (if standalone-link-p "paragraph" "as-char")) - (captions (org-odt-format-label element info 'definition)) - (caption (car captions)) (short-caption (cdr captions)) - (entity (concat (and caption "Captioned") embed-as "Image")) - ;; Check if this link was created by LaTeX-to-PNG converter. - (replaces (org-element-property - :replaces (if (not standalone-link-p) element - (org-export-get-parent-element element)))) - ;; If yes, note down the type of the element - LaTeX Fragment - ;; or LaTeX environment. It will go in to frame title. - (title (and replaces (capitalize - (symbol-name (org-element-type replaces))))) - - ;; If yes, note down it's contents. It will go in to frame - ;; description. This quite useful for debugging. - (desc (and replaces (org-element-property :value replaces)))) - (org-odt--render-image/formula entity href width height - captions user-frame-params title desc))) - - -;;;; Links :: Math formula - -(defun org-odt-link--inline-formula (element info) - (let* ((src (let* ((type (org-element-property :type element)) - (raw-path (org-element-property :path element))) - (cond - ((file-name-absolute-p raw-path) - (expand-file-name raw-path)) - (t raw-path)))) - (src-expanded (if (file-name-absolute-p src) src - (expand-file-name src (file-name-directory - (plist-get info :input-file))))) - (href - (format - "\n" - " xlink:show=\"embed\" xlink:actuate=\"onLoad\"" - (file-name-directory (org-odt--copy-formula-file src-expanded)))) - (standalone-link-p (org-odt--standalone-link-p element info)) - (embed-as (if standalone-link-p 'paragraph 'character)) - (captions (org-odt-format-label element info 'definition)) - (caption (car captions)) (short-caption (cdr captions)) - ;; Check if this link was created by LaTeX-to-MathML - ;; converter. - (replaces (org-element-property - :replaces (if (not standalone-link-p) element - (org-export-get-parent-element element)))) - ;; If yes, note down the type of the element - LaTeX Fragment - ;; or LaTeX environment. It will go in to frame title. - (title (and replaces (capitalize - (symbol-name (org-element-type replaces))))) - - ;; If yes, note down it's contents. It will go in to frame - ;; description. This quite useful for debugging. - (desc (and replaces (org-element-property :value replaces))) - width height) - (cond - ((eq embed-as 'character) - (org-odt--render-image/formula "InlineFormula" href width height - nil nil title desc)) - (t - (let* ((equation (org-odt--render-image/formula - "CaptionedDisplayFormula" href width height - captions nil title desc)) - (label - (let* ((org-odt-category-map-alist - '(("__MathFormula__" "Text" "math-label" "Equation" - org-odt--enumerable-formula-p)))) - (car (org-odt-format-label element info 'definition))))) - (concat equation "" label)))))) - -(defun org-odt--copy-formula-file (src-file) - "Returns the internal name of the file" - (let* ((target-dir (format "Formula-%04d/" - (incf org-odt-embedded-formulas-count))) - (target-file (concat target-dir "content.xml"))) - ;; Create a directory for holding formula file. Also enter it in - ;; to manifest. - (make-directory (concat org-odt-zip-dir target-dir)) - (org-odt-create-manifest-file-entry - "application/vnd.oasis.opendocument.formula" target-dir "1.2") - ;; Copy over the formula file from user directory to zip - ;; directory. - (message "Embedding %s as %s..." src-file target-file) - (let ((case-fold-search nil)) - (cond - ;; Case 1: Mathml. - ((string-match "\\.\\(mathml\\|mml\\)\\'" src-file) - (copy-file src-file (concat org-odt-zip-dir target-file) 'overwrite)) - ;; Case 2: OpenDocument formula. - ((string-match "\\.odf\\'" src-file) - (org-odt--zip-extract src-file "content.xml" - (concat org-odt-zip-dir target-dir))) - (t (error "%s is not a formula file" src-file)))) - ;; Enter the formula file in to manifest. - (org-odt-create-manifest-file-entry "text/xml" target-file) - target-file)) - -;;;; Targets - -(defun org-odt--render-image/formula (cfg-key href width height &optional - captions user-frame-params - &rest title-and-desc) - (let* ((frame-cfg-alist - ;; Each element of this alist is of the form (CFG-HANDLE - ;; INNER-FRAME-PARAMS OUTER-FRAME-PARAMS). - - ;; CFG-HANDLE is the key to the alist. - - ;; INNER-FRAME-PARAMS and OUTER-FRAME-PARAMS specify the - ;; frame params for INNER-FRAME and OUTER-FRAME - ;; respectively. See below. - - ;; Configurations that are meant to be applied to - ;; non-captioned image/formula specifies no - ;; OUTER-FRAME-PARAMS. - - ;; TERMINOLOGY - ;; =========== - ;; INNER-FRAME :: Frame that directly surrounds an - ;; image/formula. - - ;; OUTER-FRAME :: Frame that encloses the INNER-FRAME. This - ;; frame also contains the caption, if any. - - ;; FRAME-PARAMS :: List of the form (FRAME-STYLE-NAME - ;; FRAME-ATTRIBUTES FRAME-ANCHOR). Note - ;; that these are the last three arguments - ;; to `org-odt--frame'. - - ;; Note that an un-captioned image/formula requires just an - ;; INNER-FRAME, while a captioned image/formula requires - ;; both an INNER and an OUTER-FRAME. - '(("As-CharImage" ("OrgInlineImage" nil "as-char")) - ("ParagraphImage" ("OrgDisplayImage" nil "paragraph")) - ("PageImage" ("OrgPageImage" nil "page")) - ("CaptionedAs-CharImage" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgInlineImage" nil "as-char")) - ("CaptionedParagraphImage" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgImageCaptionFrame" nil "paragraph")) - ("CaptionedPageImage" - ("OrgCaptionedImage" - " style:rel-width=\"100%\" style:rel-height=\"scale\"" "paragraph") - ("OrgPageImageCaptionFrame" nil "page")) - ("InlineFormula" ("OrgInlineFormula" nil "as-char")) - ("DisplayFormula" ("OrgDisplayFormula" nil "as-char")) - ("CaptionedDisplayFormula" - ("OrgCaptionedFormula" nil "paragraph") - ("OrgFormulaCaptionFrame" nil "paragraph")))) - (caption (car captions)) (short-caption (cdr captions)) - ;; Retrieve inner and outer frame params, from configuration. - (frame-cfg (assoc-string cfg-key frame-cfg-alist t)) - (inner (nth 1 frame-cfg)) - (outer (nth 2 frame-cfg)) - ;; User-specified frame params (from #+ATTR_ODT spec) - (user user-frame-params) - (--merge-frame-params (function - (lambda (default user) - "Merge default and user frame params." - (if (not user) default - (assert (= (length default) 3)) - (assert (= (length user) 3)) - (loop for u in user - for d in default - collect (or u d))))))) - (cond - ;; Case 1: Image/Formula has no caption. - ;; There is only one frame, one that surrounds the image - ;; or formula. - ((not caption) - ;; Merge user frame params with that from configuration. - (setq inner (funcall --merge-frame-params inner user)) - (apply 'org-odt--frame href width height - (append inner title-and-desc))) - ;; Case 2: Image/Formula is captioned or labeled. - ;; There are two frames: The inner one surrounds the - ;; image or formula. The outer one contains the - ;; caption/sequence number. - (t - ;; Merge user frame params with outer frame params. - (setq outer (funcall --merge-frame-params outer user)) - ;; Short caption, if specified, goes as part of inner frame. - (setq inner (let ((frame-params (copy-sequence inner))) - (setcar (cdr frame-params) - (concat - (cadr frame-params) - (when short-caption - (format " draw:name=\"%s\" " short-caption)))) - frame-params)) - (apply 'org-odt--textbox - (format "\n%s" - "Illustration" - (concat - (apply 'org-odt--frame href width height - (append inner title-and-desc)) - caption)) - width height outer))))) - -(defun org-odt--enumerable-p (element info) - ;; Element should have a caption or label. - (or (org-element-property :caption element) - (org-element-property :name element))) - -(defun org-odt--enumerable-image-p (element info) - (org-odt--standalone-link-p - element info - ;; Paragraph should have a caption or label. It SHOULD NOT be a - ;; replacement element. (i.e., It SHOULD NOT be a result of LaTeX - ;; processing.) - (lambda (p) - (and (not (org-element-property :replaces p)) - (or (org-element-property :caption p) - (org-element-property :name p)))) - ;; Link should point to an image file. - (lambda (l) - (assert (eq (org-element-type l) 'link)) - (org-export-inline-image-p l org-odt-inline-image-rules)))) - -(defun org-odt--enumerable-latex-image-p (element info) - (org-odt--standalone-link-p - element info - ;; Paragraph should have a caption or label. It SHOULD also be a - ;; replacement element. (i.e., It SHOULD be a result of LaTeX - ;; processing.) - (lambda (p) - (and (org-element-property :replaces p) - (or (org-element-property :caption p) - (org-element-property :name p)))) - ;; Link should point to an image file. - (lambda (l) - (assert (eq (org-element-type l) 'link)) - (org-export-inline-image-p l org-odt-inline-image-rules)))) - -(defun org-odt--enumerable-formula-p (element info) - (org-odt--standalone-link-p - element info - ;; Paragraph should have a caption or label. - (lambda (p) - (or (org-element-property :caption p) - (org-element-property :name p))) - ;; Link should point to a MathML or ODF file. - (lambda (l) - (assert (eq (org-element-type l) 'link)) - (org-export-inline-image-p l org-odt-inline-formula-rules)))) - -(defun org-odt--standalone-link-p (element info &optional - paragraph-predicate - link-predicate) - "Test if ELEMENT is a standalone link for the purpose ODT export. -INFO is a plist holding contextual information. - -Return non-nil, if ELEMENT is of type paragraph satisfying -PARAGRAPH-PREDICATE and it's sole content, save for whitespaces, -is a link that satisfies LINK-PREDICATE. - -Return non-nil, if ELEMENT is of type link satisfying -LINK-PREDICATE and it's containing paragraph satisfies -PARAGRAPH-PREDICATE inaddtion to having no other content save for -leading and trailing whitespaces. - -Return nil, otherwise." - (let ((p (case (org-element-type element) - (paragraph element) - (link (and (or (not link-predicate) - (funcall link-predicate element)) - (org-export-get-parent element))) - (t nil)))) - (when (and p (eq (org-element-type p) 'paragraph)) - (when (or (not paragraph-predicate) - (funcall paragraph-predicate p)) - (let ((contents (org-element-contents p))) - (loop for x in contents - with inline-image-count = 0 - always (case (org-element-type x) - (plain-text - (not (org-string-nw-p x))) - (link - (and (or (not link-predicate) - (funcall link-predicate x)) - (= (incf inline-image-count) 1))) - (t nil)))))))) - -(defun org-odt-link--infer-description (destination info) - ;; DESTINATION is a HEADLINE, a "<>" or an element (like - ;; paragraph, verse-block etc) to which a "#+NAME: label" can be - ;; attached. Note that labels that are attached to captioned - ;; entities - inline images, math formulae and tables - get resolved - ;; as part of `org-odt-format-label' and `org-odt--enumerate'. - - ;; Create a cross-reference to DESTINATION but make best-efforts to - ;; create a *meaningful* description. Check item numbers, section - ;; number and section title in that order. - - ;; NOTE: Counterpart of `org-export-get-ordinal'. - ;; FIXME: Handle footnote-definition footnote-reference? - (let* ((genealogy (org-export-get-genealogy destination)) - (data (reverse genealogy)) - (label (case (org-element-type destination) - (headline - (format "sec-%s" (mapconcat 'number-to-string - (org-export-get-headline-number - destination info) "-"))) - (target - (org-element-property :value destination)) - (t (error "FIXME: Resolve %S" destination))))) - (or - (let* ( ;; Locate top-level list. - (top-level-list - (loop for x on data - when (eq (org-element-type (car x)) 'plain-list) - return x)) - ;; Get list item nos. - (item-numbers - (loop for (plain-list item . rest) on top-level-list by #'cddr - until (not (eq (org-element-type plain-list) 'plain-list)) - collect (when (eq (org-element-property :type - plain-list) - 'ordered) - (1+ (length (org-export-get-previous-element - item info t)))))) - ;; Locate top-most listified headline. - (listified-headlines - (loop for x on data - when (and (eq (org-element-type (car x)) 'headline) - (org-export-low-level-p (car x) info)) - return x)) - ;; Get listified headline numbers. - (listified-headline-nos - (loop for el in listified-headlines - when (eq (org-element-type el) 'headline) - collect (when (org-export-numbered-headline-p el info) - (1+ (length (org-export-get-previous-element - el info t))))))) - ;; Combine item numbers from both the listified headlines and - ;; regular list items. - - ;; Case 1: Check if all the parents of list item are numbered. - ;; If yes, link to the item proper. - (let ((item-numbers (append listified-headline-nos item-numbers))) - (when (and item-numbers (not (memq nil item-numbers))) - (format "%s" - (org-export-solidify-link-text label) - (mapconcat (lambda (n) (if (not n) " " - (concat (number-to-string n) "."))) - item-numbers ""))))) - ;; Case 2: Locate a regular and numbered headline in the - ;; hierarchy. Display it's section number. - (let ((headline (loop for el in (cons destination genealogy) - when (and (eq (org-element-type el) 'headline) - (not (org-export-low-level-p el info)) - (org-export-numbered-headline-p el info)) - return el))) - ;; We found one. - (when headline - (format "%s" - (org-export-solidify-link-text label) - (mapconcat 'number-to-string (org-export-get-headline-number - headline info) ".")))) - ;; Case 4: Locate a regular headline in the hierarchy. Display - ;; it's title. - (let ((headline (loop for el in (cons destination genealogy) - when (and (eq (org-element-type el) 'headline) - (not (org-export-low-level-p el info))) - return el))) - ;; We found one. - (when headline - (format "%s" - (org-export-solidify-link-text label) - (let ((title (org-element-property :title headline))) - (org-export-data title info))))) - (error "FIXME?")))) - -(defun org-odt-link (link desc info) - "Transcode a LINK object from Org to ODT. - -DESC is the description part of the link, or the empty string. -INFO is a plist holding contextual information. See -`org-export-data'." - (let* ((type (org-element-property :type link)) - (raw-path (org-element-property :path link)) - ;; Ensure DESC really exists, or set it to nil. - (desc (and (not (string= desc "")) desc)) - (imagep (org-export-inline-image-p - link org-odt-inline-image-rules)) - (path (cond - ((member type '("http" "https" "ftp" "mailto")) - (concat type ":" raw-path)) - ((string= type "file") - (if (file-name-absolute-p raw-path) - (concat "file://" (expand-file-name raw-path)) - (concat "file://" raw-path))) - (t raw-path))) - ;; Convert & to & for correct XML representation - (path (replace-regexp-in-string "&" "&" path)) - protocol) - (cond - ;; Image file. - ((and (not desc) (org-export-inline-image-p - link org-odt-inline-image-rules)) - (org-odt-link--inline-image link info)) - ;; Formula file. - ((and (not desc) (org-export-inline-image-p - link org-odt-inline-formula-rules)) - (org-odt-link--inline-formula link info)) - ;; Radio target: Transcode target's contents and use them as - ;; link's description. - ((string= type "radio") - (let ((destination (org-export-resolve-radio-link link info))) - (when destination - (let ((desc (org-export-data (org-element-contents destination) info)) - (href (org-export-solidify-link-text path))) - (format - "%s" - href desc))))) - ;; Links pointing to a headline: Find destination and build - ;; appropriate referencing command. - ((member type '("custom-id" "fuzzy" "id")) - (let ((destination (if (string= type "fuzzy") - (org-export-resolve-fuzzy-link link info) - (org-export-resolve-id-link link info)))) - (case (org-element-type destination) - ;; Case 1: Fuzzy link points nowhere. - ('nil - (format "%s" - "Emphasis" - (or desc - (org-export-data (org-element-property :raw-link link) - info)))) - ;; Case 2: Fuzzy link points to a headline. - (headline - ;; If there's a description, create a hyperlink. - ;; Otherwise, try to provide a meaningful description. - (if (not desc) (org-odt-link--infer-description destination info) - (let* ((headline-no - (org-export-get-headline-number destination info)) - (label - (format "sec-%s" - (mapconcat 'number-to-string headline-no "-")))) - (format - "%s" - label desc)))) - ;; Case 3: Fuzzy link points to a target. - (target - ;; If there's a description, create a hyperlink. - ;; Otherwise, try to provide a meaningful description. - (if (not desc) (org-odt-link--infer-description destination info) - (let ((label (org-element-property :value destination))) - (format "%s" - (org-export-solidify-link-text label) - desc)))) - ;; Case 4: Fuzzy link points to some element (e.g., an - ;; inline image, a math formula or a table). - (otherwise - (let ((label-reference - (ignore-errors (org-odt-format-label - destination info 'reference)))) - (cond ((not label-reference) - (org-odt-link--infer-description destination info)) - ;; LINK has no description. Create - ;; a cross-reference showing entity's sequence - ;; number. - ((not desc) label-reference) - ;; LINK has description. Insert a hyperlink with - ;; user-provided description. - (t - (let ((label (org-element-property :name destination))) - (format "%s" - (org-export-solidify-link-text label) - desc))))))))) - ;; Coderef: replace link with the reference name or the - ;; equivalent line number. - ((string= type "coderef") - (let* ((line-no (format "%d" (org-export-resolve-coderef path info))) - (href (concat "coderef-" path))) - (format - (org-export-get-coderef-format path desc) - (format - "%s" - href line-no)))) - ;; Link type is handled by a special function. - ((functionp (setq protocol (nth 2 (assoc type org-link-protocols)))) - (funcall protocol (org-link-unescape path) desc 'odt)) - ;; External link with a description part. - ((and path desc) - (let ((link-contents (org-element-contents link))) - ;; Check if description is a link to an inline image. - (if (and (not (cdr link-contents)) - (let ((desc-element (car link-contents))) - (and (eq (org-element-type desc-element) 'link) - (org-export-inline-image-p - desc-element org-odt-inline-image-rules)))) - ;; Format link as a clickable image. - (format "\n\n%s\n" - path desc) - ;; Otherwise, format it as a regular link. - (format "%s" - path desc)))) - ;; External link without a description part. - (path - (format "%s" - path path)) - ;; No path, only description. Try to do something useful. - (t (format "%s" - "Emphasis" desc))))) - - -;;;; Paragraph - -(defun org-odt--format-paragraph (paragraph contents default center quote) - "Format paragraph according to given styles. -PARAGRAPH is a paragraph type element. CONTENTS is the -transcoded contents of that paragraph, as a string. DEFAULT, -CENTER and QUOTE are, respectively, style to use when paragraph -belongs to no special environment, a center block, or a quote -block." - (let* ((parent (org-export-get-parent paragraph)) - (parent-type (org-element-type parent)) - (style (case parent-type - (quote-block quote) - (center-block center) - (t default)))) - ;; If this paragraph is a leading paragraph in an item and the - ;; item has a checkbox, splice the checkbox and paragraph contents - ;; together. - (when (and (eq (org-element-type parent) 'item) - (eq paragraph (car (org-element-contents parent)))) - (setq contents (concat (org-odt--checkbox parent) contents))) - (format "\n%s" style contents))) - -(defun org-odt-paragraph (paragraph contents info) - "Transcode a PARAGRAPH element from Org to ODT. -CONTENTS is the contents of the paragraph, as a string. INFO is -the plist used as a communication channel." - (org-odt--format-paragraph - paragraph contents - (or (org-element-property :style paragraph) "Text_20_body") - "OrgCenter" - "Quotations")) - - -;;;; Plain List - -(defun org-odt-plain-list (plain-list contents info) - "Transcode a PLAIN-LIST element from Org to ODT. -CONTENTS is the contents of the list. INFO is a plist holding -contextual information." - (format "\n\n%s" - ;; Choose style based on list type. - (case (org-element-property :type plain-list) - (ordered "OrgNumberedList") - (unordered "OrgBulletedList") - (descriptive-1 "OrgDescriptionList") - (descriptive-2 "OrgDescriptionList")) - ;; If top-level list, re-start numbering. Otherwise, - ;; continue numbering. - (format "text:continue-numbering=\"%s\"" - (let* ((parent (org-export-get-parent plain-list))) - (if (and parent (eq (org-element-type parent) 'item)) - "true" "false"))) - contents)) - -;;;; Plain Text - -(defun org-odt--encode-tabs-and-spaces (line) - (replace-regexp-in-string - "\\([\t]\\|\\([ ]+\\)\\)" - (lambda (s) - (cond - ((string= s "\t") "") - (t (let ((n (length s))) - (cond - ((= n 1) " ") - ((> n 1) (concat " " (format "" (1- n)))) - (t "")))))) - line)) - -(defun org-odt--encode-plain-text (text &optional no-whitespace-filling) - (mapc - (lambda (pair) - (setq text (replace-regexp-in-string (car pair) (cdr pair) text t t))) - '(("&" . "&") ("<" . "<") (">" . ">"))) - (if no-whitespace-filling text - (org-odt--encode-tabs-and-spaces text))) - -(defun org-odt-plain-text (text info) - "Transcode a TEXT string from Org to ODT. -TEXT is the string to transcode. INFO is a plist holding -contextual information." - (let ((output text)) - ;; Protect &, < and >. - (setq output (org-odt--encode-plain-text output t)) - ;; Handle smart quotes. Be sure to provide original string since - ;; OUTPUT may have been modified. - (when (plist-get info :with-smart-quotes) - (setq output (org-export-activate-smart-quotes output :utf-8 info text))) - ;; Convert special strings. - (when (plist-get info :with-special-strings) - (mapc - (lambda (pair) - (setq output - (replace-regexp-in-string (car pair) (cdr pair) output t nil))) - org-odt-special-string-regexps)) - ;; Handle break preservation if required. - (when (plist-get info :preserve-breaks) - (setq output (replace-regexp-in-string - "\\(\\\\\\\\\\)?[ \t]*\n" "" output t))) - ;; Return value. - output)) - - -;;;; Planning - -(defun org-odt-planning (planning contents info) - "Transcode a PLANNING element from Org to ODT. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (format "\n%s" - "OrgPlanning" - (concat - (let ((closed (org-element-property :closed planning))) - (when closed - (concat - (format "%s" - "OrgClosedKeyword" org-closed-string) - (org-odt-timestamp closed contents info)))) - (let ((deadline (org-element-property :deadline planning))) - (when deadline - (concat - (format "%s" - "OrgDeadlineKeyword" org-deadline-string) - (org-odt-timestamp deadline contents info)))) - (let ((scheduled (org-element-property :scheduled planning))) - (when scheduled - (concat - (format "%s" - "OrgScheduledKeyword" org-deadline-string) - (org-odt-timestamp scheduled contents info))))))) - - -;;;; Property Drawer - -(defun org-odt-property-drawer (property-drawer contents info) - "Transcode a PROPERTY-DRAWER element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual -information." - ;; The property drawer isn't exported but we want separating blank - ;; lines nonetheless. - "") - - -;;;; Quote Block - -(defun org-odt-quote-block (quote-block contents info) - "Transcode a QUOTE-BLOCK element from Org to ODT. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - contents) - - -;;;; Quote Section - -(defun org-odt-quote-section (quote-section contents info) - "Transcode a QUOTE-SECTION element from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((value (org-remove-indentation - (org-element-property :value quote-section)))) - (when value (org-odt-do-format-code value)))) - - -;;;; Section - -(defun org-odt-format-section (text style &optional name) - (let ((default-name (car (org-odt-add-automatic-style "Section")))) - (format "\n\n%s\n" - style - (format "text:name=\"%s\"" (or name default-name)) - text))) - - -(defun org-odt-section (section contents info) ; FIXME - "Transcode a SECTION element from Org to ODT. -CONTENTS holds the contents of the section. INFO is a plist -holding contextual information." - contents) - -;;;; Radio Target - -(defun org-odt-radio-target (radio-target text info) - "Transcode a RADIO-TARGET object from Org to ODT. -TEXT is the text of the target. INFO is a plist holding -contextual information." - (org-odt--target - text (org-export-solidify-link-text - (org-element-property :value radio-target)))) - - -;;;; Special Block - -(defun org-odt-special-block (special-block contents info) - "Transcode a SPECIAL-BLOCK element from Org to ODT. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let ((type (downcase (org-element-property :type special-block))) - (attributes (org-export-read-attribute :attr_odt special-block))) - (cond - ;; Annotation. - ((string= type "annotation") - (let* ((author (or (plist-get attributes :author) - (let ((author (plist-get info :author))) - (and author (org-export-data author info))))) - (date (or (plist-get attributes :date) - ;; FIXME: Is `car' right thing to do below? - (car (plist-get info :date))))) - (format "\n%s" - (format "\n%s\n" - (concat - (and author - (format "%s" author)) - (and date - (format "%s" - (org-odt--format-timestamp date nil 'iso-date))) - contents))))) - ;; Textbox. - ((string= type "textbox") - (let ((width (plist-get attributes :width)) - (height (plist-get attributes :height)) - (style (plist-get attributes :style)) - (extra (plist-get attributes :extra)) - (anchor (plist-get attributes :anchor))) - (format "\n%s" - "Text_20_body" (org-odt--textbox contents width height - style extra anchor)))) - (t contents)))) - - -;;;; Src Block - -(defun org-odt-hfy-face-to-css (fn) - "Create custom style for face FN. -When FN is the default face, use it's foreground and background -properties to create \"OrgSrcBlock\" paragraph style. Otherwise -use it's color attribute to create a character style whose name -is obtained from FN. Currently all attributes of FN other than -color are ignored. - -The style name for a face FN is derived using the following -operations on the face name in that order - de-dash, CamelCase -and prefix with \"OrgSrc\". For example, -`font-lock-function-name-face' is associated with -\"OrgSrcFontLockFunctionNameFace\"." - (let* ((css-list (hfy-face-to-style fn)) - (style-name (concat "OrgSrc" - (mapconcat - 'capitalize (split-string - (hfy-face-or-def-to-name fn) "-") - ""))) - (color-val (cdr (assoc "color" css-list))) - (background-color-val (cdr (assoc "background" css-list))) - (style (and org-odt-create-custom-styles-for-srcblocks - (cond - ((eq fn 'default) - (format org-odt-src-block-paragraph-format - background-color-val color-val)) - (t - (format - " - - - " style-name color-val)))))) - (cons style-name style))) - -(defun org-odt-htmlfontify-string (line) - (let* ((hfy-html-quote-regex "\\([<\"&> ]\\)") - (hfy-html-quote-map '(("\"" """) - ("<" "<") - ("&" "&") - (">" ">") - (" " "") - (" " ""))) - (hfy-face-to-css 'org-odt-hfy-face-to-css) - (hfy-optimisations-1 (copy-sequence hfy-optimisations)) - (hfy-optimisations (add-to-list 'hfy-optimisations-1 - 'body-text-only)) - (hfy-begin-span-handler - (lambda (style text-block text-id text-begins-block-p) - (insert (format "" style)))) - (hfy-end-span-handler (lambda nil (insert "")))) - (org-no-warnings (htmlfontify-string line)))) - -(defun org-odt-do-format-code - (code &optional lang refs retain-labels num-start) - (let* ((lang (or (assoc-default lang org-src-lang-modes) lang)) - (lang-mode (and lang (intern (format "%s-mode" lang)))) - (code-lines (org-split-string code "\n")) - (code-length (length code-lines)) - (use-htmlfontify-p (and (functionp lang-mode) - org-odt-fontify-srcblocks - (require 'htmlfontify nil t) - (fboundp 'htmlfontify-string))) - (code (if (not use-htmlfontify-p) code - (with-temp-buffer - (insert code) - (funcall lang-mode) - (font-lock-fontify-buffer) - (buffer-string)))) - (fontifier (if use-htmlfontify-p 'org-odt-htmlfontify-string - 'org-odt--encode-plain-text)) - (par-style (if use-htmlfontify-p "OrgSrcBlock" - "OrgFixedWidthBlock")) - (i 0)) - (assert (= code-length (length (org-split-string code "\n")))) - (setq code - (org-export-format-code - code - (lambda (loc line-num ref) - (setq par-style - (concat par-style (and (= (incf i) code-length) "LastLine"))) - - (setq loc (concat loc (and ref retain-labels (format " (%s)" ref)))) - (setq loc (funcall fontifier loc)) - (when ref - (setq loc (org-odt--target loc (concat "coderef-" ref)))) - (assert par-style) - (setq loc (format "\n%s" - par-style loc)) - (if (not line-num) loc - (format "\n%s\n" loc))) - num-start refs)) - (cond - ((not num-start) code) - ((= num-start 0) - (format - "\n%s" - " text:continue-numbering=\"false\"" code)) - (t - (format - "\n%s" - " text:continue-numbering=\"true\"" code))))) - -(defun org-odt-format-code (element info) - (let* ((lang (org-element-property :language element)) - ;; Extract code and references. - (code-info (org-export-unravel-code element)) - (code (car code-info)) - (refs (cdr code-info)) - ;; Does the src block contain labels? - (retain-labels (org-element-property :retain-labels element)) - ;; Does it have line numbers? - (num-start (case (org-element-property :number-lines element) - (continued (org-export-get-loc element info)) - (new 0)))) - (org-odt-do-format-code code lang refs retain-labels num-start))) - -(defun org-odt-src-block (src-block contents info) - "Transcode a SRC-BLOCK element from Org to ODT. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((lang (org-element-property :language src-block)) - (attributes (org-export-read-attribute :attr_odt src-block)) - (captions (org-odt-format-label src-block info 'definition)) - (caption (car captions)) (short-caption (cdr captions))) - (concat - (and caption - (format "\n%s" - "Listing" caption)) - (let ((--src-block (org-odt-format-code src-block info))) - (if (not (plist-get attributes :textbox)) --src-block - (format "\n%s" - "Text_20_body" - (org-odt--textbox --src-block nil nil nil))))))) - - -;;;; Statistics Cookie - -(defun org-odt-statistics-cookie (statistics-cookie contents info) - "Transcode a STATISTICS-COOKIE object from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((cookie-value (org-element-property :value statistics-cookie))) - (format "%s" - "OrgCode" cookie-value))) - - -;;;; Strike-Through - -(defun org-odt-strike-through (strike-through contents info) - "Transcode STRIKE-THROUGH from Org to ODT. -CONTENTS is the text with strike-through markup. INFO is a plist -holding contextual information." - (format "%s" - "Strikethrough" contents)) - - -;;;; Subscript - -(defun org-odt-subscript (subscript contents info) - "Transcode a SUBSCRIPT object from Org to ODT. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (format "%s" - "OrgSubscript" contents)) - - -;;;; Superscript - -(defun org-odt-superscript (superscript contents info) - "Transcode a SUPERSCRIPT object from Org to ODT. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (format "%s" - "OrgSuperscript" contents)) - - -;;;; Table Cell - -(defun org-odt-table-style-spec (element info) - (let* ((table (org-export-get-parent-table element)) - (table-attributes (org-export-read-attribute :attr_odt table)) - (table-style (plist-get table-attributes :style))) - (assoc table-style org-odt-table-styles))) - -(defun org-odt-get-table-cell-styles (table-cell info) - "Retrieve styles applicable to a table cell. -R and C are (zero-based) row and column numbers of the table -cell. STYLE-SPEC is an entry in `org-odt-table-styles' -applicable to the current table. It is `nil' if the table is not -associated with any style attributes. - -Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME). - -When STYLE-SPEC is nil, style the table cell the conventional way -- choose cell borders based on row and column groupings and -choose paragraph alignment based on `org-col-cookies' text -property. See also -`org-odt-get-paragraph-style-cookie-for-table-cell'. - -When STYLE-SPEC is non-nil, ignore the above cookie and return -styles congruent with the ODF-1.2 specification." - (let* ((table-cell-address (org-export-table-cell-address table-cell info)) - (r (car table-cell-address)) (c (cdr table-cell-address)) - (style-spec (org-odt-table-style-spec table-cell info)) - (table-dimensions (org-export-table-dimensions - (org-export-get-parent-table table-cell) - info))) - (when style-spec - ;; LibreOffice - particularly the Writer - honors neither table - ;; templates nor custom table-cell styles. Inorder to retain - ;; inter-operability with LibreOffice, only automatic styles are - ;; used for styling of table-cells. The current implementation is - ;; congruent with ODF-1.2 specification and hence is - ;; future-compatible. - - ;; Additional Note: LibreOffice's AutoFormat facility for tables - - ;; which recognizes as many as 16 different cell types - is much - ;; richer. Unfortunately it is NOT amenable to easy configuration - ;; by hand. - (let* ((template-name (nth 1 style-spec)) - (cell-style-selectors (nth 2 style-spec)) - (cell-type - (cond - ((and (cdr (assoc 'use-first-column-styles cell-style-selectors)) - (= c 0)) "FirstColumn") - ((and (cdr (assoc 'use-last-column-styles cell-style-selectors)) - (= (1+ c) (cdr table-dimensions))) - "LastColumn") - ((and (cdr (assoc 'use-first-row-styles cell-style-selectors)) - (= r 0)) "FirstRow") - ((and (cdr (assoc 'use-last-row-styles cell-style-selectors)) - (= (1+ r) (car table-dimensions))) - "LastRow") - ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) - (= (% r 2) 1)) "EvenRow") - ((and (cdr (assoc 'use-banding-rows-styles cell-style-selectors)) - (= (% r 2) 0)) "OddRow") - ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) - (= (% c 2) 1)) "EvenColumn") - ((and (cdr (assoc 'use-banding-columns-styles cell-style-selectors)) - (= (% c 2) 0)) "OddColumn") - (t "")))) - (concat template-name cell-type))))) - -(defun org-odt-table-cell (table-cell contents info) - "Transcode a TABLE-CELL element from Org to ODT. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (let* ((table-cell-address (org-export-table-cell-address table-cell info)) - (r (car table-cell-address)) - (c (cdr table-cell-address)) - (horiz-span (or (org-export-table-cell-width table-cell info) 0)) - (table-row (org-export-get-parent table-cell)) - (custom-style-prefix (org-odt-get-table-cell-styles - table-cell info)) - (paragraph-style - (or - (and custom-style-prefix - (format "%sTableParagraph" custom-style-prefix)) - (concat - (cond - ((and (= 1 (org-export-table-row-group table-row info)) - (org-export-table-has-header-p - (org-export-get-parent-table table-row) info)) - "OrgTableHeading") - ((let* ((table (org-export-get-parent-table table-cell)) - (table-attrs (org-export-read-attribute :attr_odt table)) - (table-header-columns - (let ((cols (plist-get table-attrs :header-columns))) - (and cols (read cols))))) - (<= c (cond ((wholenump table-header-columns) - (- table-header-columns 1)) - (table-header-columns 0) - (t -1)))) - "OrgTableHeading") - (t "OrgTableContents")) - (capitalize (symbol-name (org-export-table-cell-alignment - table-cell info)))))) - (cell-style-name - (or - (and custom-style-prefix (format "%sTableCell" - custom-style-prefix)) - (concat - "OrgTblCell" - (when (or (org-export-table-row-starts-rowgroup-p table-row info) - (zerop r)) "T") - (when (org-export-table-row-ends-rowgroup-p table-row info) "B") - (when (and (org-export-table-cell-starts-colgroup-p table-cell info) - (not (zerop c)) ) "L")))) - (cell-attributes - (concat - (format " table:style-name=\"%s\"" cell-style-name) - (and (> horiz-span 0) - (format " table:number-columns-spanned=\"%d\"" - (1+ horiz-span)))))) - (unless contents (setq contents "")) - (concat - (assert paragraph-style) - (format "\n\n%s\n" - cell-attributes - (let ((table-cell-contents (org-element-contents table-cell))) - (if (memq (org-element-type (car table-cell-contents)) - org-element-all-elements) - contents - (format "\n%s" - paragraph-style contents)))) - (let (s) - (dotimes (i horiz-span s) - (setq s (concat s "\n")))) - "\n"))) - - -;;;; Table Row - -(defun org-odt-table-row (table-row contents info) - "Transcode a TABLE-ROW element from Org to ODT. -CONTENTS is the contents of the row. INFO is a plist used as a -communication channel." - ;; Rules are ignored since table separators are deduced from - ;; borders of the current row. - (when (eq (org-element-property :type table-row) 'standard) - (let* ((rowgroup-tags - (if (and (= 1 (org-export-table-row-group table-row info)) - (org-export-table-has-header-p - (org-export-get-parent-table table-row) info)) - ;; If the row belongs to the first rowgroup and the - ;; table has more than one row groups, then this row - ;; belongs to the header row group. - '("\n" . "\n") - ;; Otherwise, it belongs to non-header row group. - '("\n" . "\n")))) - (concat - ;; Does this row begin a rowgroup? - (when (org-export-table-row-starts-rowgroup-p table-row info) - (car rowgroup-tags)) - ;; Actual table row - (format "\n\n%s\n" contents) - ;; Does this row end a rowgroup? - (when (org-export-table-row-ends-rowgroup-p table-row info) - (cdr rowgroup-tags)))))) - - -;;;; Table - -(defun org-odt-table-first-row-data-cells (table info) - (let ((table-row - (org-element-map table 'table-row - (lambda (row) - (unless (eq (org-element-property :type row) 'rule) row)) - info 'first-match)) - (special-column-p (org-export-table-has-special-column-p table))) - (if (not special-column-p) (org-element-contents table-row) - (cdr (org-element-contents table-row))))) - -(defun org-odt--table (table contents info) - "Transcode a TABLE element from Org to ODT. -CONTENTS is the contents of the table. INFO is a plist holding -contextual information." - (case (org-element-property :type table) - ;; Case 1: table.el doesn't support export to OD format. Strip - ;; such tables from export. - (table.el - (prog1 nil - (message - (concat - "(ox-odt): Found table.el-type table in the source Org file." - " table.el doesn't support export to ODT format." - " Stripping the table from export.")))) - ;; Case 2: Native Org tables. - (otherwise - (let* ((captions (org-odt-format-label table info 'definition)) - (caption (car captions)) (short-caption (cdr captions)) - (attributes (org-export-read-attribute :attr_odt table)) - (custom-table-style (nth 1 (org-odt-table-style-spec table info))) - (table-column-specs - (function - (lambda (table info) - (let* ((table-style (or custom-table-style "OrgTable")) - (column-style (format "%sColumn" table-style))) - (mapconcat - (lambda (table-cell) - (let ((width (1+ (or (org-export-table-cell-width - table-cell info) 0))) - (s (format - "\n" - column-style)) - out) - (dotimes (i width out) (setq out (concat s out))))) - (org-odt-table-first-row-data-cells table info) "\n")))))) - (concat - ;; caption. - (when caption - (format "\n%s" - "Table" caption)) - ;; begin table. - (let* ((automatic-name - (org-odt-add-automatic-style "Table" attributes))) - (format - "\n" - (or custom-table-style (cdr automatic-name) "OrgTable") - (concat (when short-caption - (format " table:name=\"%s\"" short-caption))))) - ;; column specification. - (funcall table-column-specs table info) - ;; actual contents. - "\n" contents - ;; end table. - ""))))) - -(defun org-odt-table (table contents info) - "Transcode a TABLE element from Org to ODT. -CONTENTS is the contents of the table. INFO is a plist holding -contextual information. - -Use `org-odt--table' to typeset the table. Handle details -pertaining to indentation here." - (let* ((--element-preceded-by-table-p - (function - (lambda (element info) - (loop for el in (org-export-get-previous-element element info t) - thereis (eq (org-element-type el) 'table))))) - (--walk-list-genealogy-and-collect-tags - (function - (lambda (table info) - (let* ((genealogy (org-export-get-genealogy table)) - (list-genealogy - (when (eq (org-element-type (car genealogy)) 'item) - (loop for el in genealogy - when (memq (org-element-type el) - '(item plain-list)) - collect el))) - (llh-genealogy - (apply 'nconc - (loop for el in genealogy - when (and (eq (org-element-type el) 'headline) - (org-export-low-level-p el info)) - collect - (list el - (assq 'headline - (org-element-contents - (org-export-get-parent el))))))) - parent-list) - (nconc - ;; Handle list genealogy. - (loop for el in list-genealogy collect - (case (org-element-type el) - (plain-list - (setq parent-list el) - (cons "" - (format "\n" - (case (org-element-property :type el) - (ordered "OrgNumberedList") - (unordered "OrgBulletedList") - (descriptive-1 "OrgDescriptionList") - (descriptive-2 "OrgDescriptionList")) - "text:continue-numbering=\"true\""))) - (item - (cond - ((not parent-list) - (if (funcall --element-preceded-by-table-p table info) - '("" . "") - '("" . ""))) - ((funcall --element-preceded-by-table-p - parent-list info) - '("" . "")) - (t '("" . "")))))) - ;; Handle low-level headlines. - (loop for el in llh-genealogy - with step = 'item collect - (case step - (plain-list - (setq step 'item) ; Flip-flop - (setq parent-list el) - (cons "" - (format "\n" - (if (org-export-numbered-headline-p - el info) - "OrgNumberedList" - "OrgBulletedList") - "text:continue-numbering=\"true\""))) - (item - (setq step 'plain-list) ; Flip-flop - (cond - ((not parent-list) - (if (funcall --element-preceded-by-table-p table info) - '("" . "") - '("" . ""))) - ((let ((section? (org-export-get-previous-element - parent-list info))) - (and section? - (eq (org-element-type section?) 'section) - (assq 'table (org-element-contents section?)))) - '("" . "")) - (t - '("" . ""))))))))))) - (close-open-tags (funcall --walk-list-genealogy-and-collect-tags - table info))) - ;; OpenDocument schema does not permit table to occur within a - ;; list item. - - ;; One solution - the easiest and lightweight, in terms of - ;; implementation - is to put the table in an indented text box - ;; and make the text box part of the list-item. Unfortunately if - ;; the table is big and spans multiple pages, the text box could - ;; overflow. In this case, the following attribute will come - ;; handy. - - ;; ,---- From OpenDocument-v1.1.pdf - ;; | 15.27.28 Overflow behavior - ;; | - ;; | For text boxes contained within text document, the - ;; | style:overflow-behavior property specifies the behavior of text - ;; | boxes where the containing text does not fit into the text - ;; | box. - ;; | - ;; | If the attribute's value is clip, the text that does not fit - ;; | into the text box is not displayed. - ;; | - ;; | If the attribute value is auto-create-new-frame, a new frame - ;; | will be created on the next page, with the same position and - ;; | dimensions of the original frame. - ;; | - ;; | If the style:overflow-behavior property's value is - ;; | auto-create-new-frame and the text box has a minimum width or - ;; | height specified, then the text box will grow until the page - ;; | bounds are reached before a new frame is created. - ;; `---- - - ;; Unfortunately, LibreOffice-3.4.6 doesn't honor - ;; auto-create-new-frame property and always resorts to clipping - ;; the text box. This results in table being truncated. - - ;; So we solve the problem the hard (and fun) way using list - ;; continuations. - - ;; The problem only becomes more interesting if you take in to - ;; account the following facts: - ;; - ;; - Description lists are simulated as plain lists. - ;; - Low-level headlines can be listified. - ;; - In Org-mode, a table can occur not only as a regular list - ;; item, but also within description lists and low-level - ;; headlines. - - ;; See `org-odt-translate-description-lists' and - ;; `org-odt-translate-low-level-headlines' for how this is - ;; tackled. - - (concat "\n" - ;; Discontinue the list. - (mapconcat 'car close-open-tags "\n") - ;; Put the table in an indented section. - (let* ((table (org-odt--table table contents info)) - (level (/ (length (mapcar 'car close-open-tags)) 2)) - (style (format "OrgIndentedSection-Level-%d" level))) - (when table (org-odt-format-section table style))) - ;; Continue the list. - (mapconcat 'cdr (nreverse close-open-tags) "\n")))) - - -;;;; Target - -(defun org-odt-target (target contents info) - "Transcode a TARGET object from Org to ODT. -CONTENTS is nil. INFO is a plist holding contextual -information." - (let ((value (org-element-property :value target))) - (org-odt--target "" (org-export-solidify-link-text value)))) - - -;;;; Timestamp - -(defun org-odt-timestamp (timestamp contents info) - "Transcode a TIMESTAMP object from Org to ODT. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (let* ((raw-value (org-element-property :raw-value timestamp)) - (type (org-element-property :type timestamp))) - (if (not org-odt-use-date-fields) - (let ((value (org-odt-plain-text - (org-timestamp-translate timestamp) info))) - (case (org-element-property :type timestamp) - ((active active-range) - (format "%s" - "OrgActiveTimestamp" value)) - ((inactive inactive-range) - (format "%s" - "OrgInactiveTimestamp" value)) - (otherwise value))) - (case type - (active - (format "%s" - "OrgActiveTimestamp" - (format "<%s>" (org-odt--format-timestamp timestamp)))) - (inactive - (format "%s" - "OrgInactiveTimestamp" - (format "[%s]" (org-odt--format-timestamp timestamp)))) - (active-range - (format "%s" - "OrgActiveTimestamp" - (format "<%s>–<%s>" - (org-odt--format-timestamp timestamp) - (org-odt--format-timestamp timestamp 'end)))) - (inactive-range - (format "%s" - "OrgInactiveTimestamp" - (format "[%s]–[%s]" - (org-odt--format-timestamp timestamp) - (org-odt--format-timestamp timestamp 'end)))) - (otherwise - (format "%s" - "OrgDiaryTimestamp" - (org-odt-plain-text (org-timestamp-translate timestamp) - info))))))) - - -;;;; Underline - -(defun org-odt-underline (underline contents info) - "Transcode UNDERLINE from Org to ODT. -CONTENTS is the text with underline markup. INFO is a plist -holding contextual information." - (format "%s" - "Underline" contents)) - - -;;;; Verbatim - -(defun org-odt-verbatim (verbatim contents info) - "Transcode a VERBATIM object from Org to ODT. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (format "%s" - "OrgCode" (org-odt--encode-plain-text - (org-element-property :value verbatim)))) - - -;;;; Verse Block - -(defun org-odt-verse-block (verse-block contents info) - "Transcode a VERSE-BLOCK element from Org to ODT. -CONTENTS is verse block contents. INFO is a plist holding -contextual information." - ;; Add line breaks to each line of verse. - (setq contents (replace-regexp-in-string - "\\(\\)?[ \t]*\n" - "" contents)) - ;; Replace tabs and spaces. - (setq contents (org-odt--encode-tabs-and-spaces contents)) - ;; Surround it in a verse environment. - (format "\n%s" - "OrgVerse" contents)) - - - -;;; Filters - -;;;; LaTeX fragments - -(defun org-odt--translate-latex-fragments (tree backend info) - (let ((processing-type (plist-get info :with-latex)) - (count 0)) - ;; Normalize processing-type to one of dvipng, mathml or verbatim. - ;; If the desired converter is not available, force verbatim - ;; processing. - (case processing-type - ((t mathml) - (if (and (fboundp 'org-format-latex-mathml-available-p) - (org-format-latex-mathml-available-p)) - (setq processing-type 'mathml) - (message "LaTeX to MathML converter not available.") - (setq processing-type 'verbatim))) - ((dvipng imagemagick) - (unless (and (org-check-external-command "latex" "" t) - (org-check-external-command - (if (eq processing-type 'dvipng) "dvipng" "convert") "" t)) - (message "LaTeX to PNG converter not available.") - (setq processing-type 'verbatim))) - (otherwise - (message "Unknown LaTeX option. Forcing verbatim.") - (setq processing-type 'verbatim))) - - ;; Store normalized value for later use. - (when (plist-get info :with-latex) - (plist-put info :with-latex processing-type)) - (message "Formatting LaTeX using %s" processing-type) - - ;; Convert `latex-fragment's and `latex-environment's. - (when (memq processing-type '(mathml dvipng imagemagick)) - (org-element-map tree '(latex-fragment latex-environment) - (lambda (latex-*) - (incf count) - (let* ((latex-frag (org-element-property :value latex-*)) - (input-file (plist-get info :input-file)) - (cache-dir (file-name-directory input-file)) - (cache-subdir (concat - (case processing-type - ((dvipng imagemagick) "ltxpng/") - (mathml "ltxmathml/")) - (file-name-sans-extension - (file-name-nondirectory input-file)))) - (display-msg - (case processing-type - ((dvipng imagemagick) (format "Creating LaTeX Image %d..." count)) - (mathml (format "Creating MathML snippet %d..." count)))) - ;; Get an Org-style link to PNG image or the MathML - ;; file. - (org-link - (let ((link (with-temp-buffer - (insert latex-frag) - (org-format-latex cache-subdir cache-dir - nil display-msg - nil nil processing-type) - (buffer-substring-no-properties - (point-min) (point-max))))) - (if (not (string-match "file:\\([^]]*\\)" link)) - (prog1 nil (message "LaTeX Conversion failed.")) - link)))) - (when org-link - ;; Conversion succeeded. Parse above Org-style link to a - ;; `link' object. - (let* ((link (car (org-element-map (with-temp-buffer - (org-mode) - (insert org-link) - (org-element-parse-buffer)) - 'link 'identity)))) - ;; Orphan the link. - (org-element-put-property link :parent nil) - (let* ( - (replacement - (case (org-element-type latex-*) - ;; Case 1: LaTeX environment. - ;; Mimic a "standalone image or formula" by - ;; enclosing the `link' in a `paragraph'. - ;; Copy over original attributes, captions to - ;; the enclosing paragraph. - (latex-environment - (org-element-adopt-elements - (list 'paragraph - (list :style "OrgFormula" - :name (org-element-property :name - latex-*) - :caption (org-element-property :caption - latex-*))) - link)) - ;; Case 2: LaTeX fragment. - ;; No special action. - (latex-fragment link)))) - ;; Note down the object that link replaces. - (org-element-put-property replacement :replaces - (list (org-element-type latex-*) - (list :value latex-frag))) - ;; Replace now. - (org-element-set-element latex-* replacement)))))) - info))) - tree) - - -;;;; Description lists - -;; This translator is necessary to handle indented tables in a uniform -;; manner. See comment in `org-odt--table'. - -(defun org-odt--translate-description-lists (tree backend info) - ;; OpenDocument has no notion of a description list. So simulate it - ;; using plain lists. Description lists in the exported document - ;; are typeset in the same manner as they are in a typical HTML - ;; document. - ;; - ;; Specifically, a description list like this: - ;; - ;; ,---- - ;; | - term-1 :: definition-1 - ;; | - term-2 :: definition-2 - ;; `---- - ;; - ;; gets translated in to the following form: - ;; - ;; ,---- - ;; | - term-1 - ;; | - definition-1 - ;; | - term-2 - ;; | - definition-2 - ;; `---- - ;; - ;; Further effect is achieved by fixing the OD styles as below: - ;; - ;; 1. Set the :type property of the simulated lists to - ;; `descriptive-1' and `descriptive-2'. Map these to list-styles - ;; that has *no* bullets whatsoever. - ;; - ;; 2. The paragraph containing the definition term is styled to be - ;; in bold. - ;; - (org-element-map tree 'plain-list - (lambda (el) - (when (equal (org-element-property :type el) 'descriptive) - (org-element-set-element - el - (apply 'org-element-adopt-elements - (list 'plain-list (list :type 'descriptive-1)) - (mapcar - (lambda (item) - (org-element-adopt-elements - (list 'item (list :checkbox (org-element-property - :checkbox item))) - (list 'paragraph (list :style "Text_20_body_20_bold") - (or (org-element-property :tag item) "(no term)")) - (org-element-adopt-elements - (list 'plain-list (list :type 'descriptive-2)) - (apply 'org-element-adopt-elements - (list 'item nil) - (org-element-contents item))))) - (org-element-contents el))))) - nil) - info) - tree) - -;;;; List tables - -;; Lists that are marked with attribute `:list-table' are called as -;; list tables. They will be rendered as a table within the exported -;; document. - -;; Consider an example. The following list table -;; -;; #+attr_odt :list-table t -;; - Row 1 -;; - 1.1 -;; - 1.2 -;; - 1.3 -;; - Row 2 -;; - 2.1 -;; - 2.2 -;; - 2.3 -;; -;; will be exported as though it were an Org table like the one show -;; below. -;; -;; | Row 1 | 1.1 | 1.2 | 1.3 | -;; | Row 2 | 2.1 | 2.2 | 2.3 | -;; -;; Note that org-tables are NOT multi-line and each line is mapped to -;; a unique row in the exported document. So if an exported table -;; needs to contain a single paragraph (with copious text) it needs to -;; be typed up in a single line. Editing such long lines using the -;; table editor will be a cumbersome task. Furthermore inclusion of -;; multi-paragraph text in a table cell is well-nigh impossible. -;; -;; A LIST-TABLE circumvents above problems. -;; -;; Note that in the example above the list items could be paragraphs -;; themselves and the list can be arbitrarily deep. -;; -;; Inspired by following thread: -;; https://lists.gnu.org/archive/html/emacs-orgmode/2011-03/msg01101.html - -;; Translate lists to tables - -(defun org-odt--translate-list-tables (tree backend info) - (org-element-map tree 'plain-list - (lambda (l1-list) - (when (org-export-read-attribute :attr_odt l1-list :list-table) - ;; Replace list with table. - (org-element-set-element - l1-list - ;; Build replacement table. - (apply 'org-element-adopt-elements - (list 'table '(:type org :attr_odt (":style \"GriddedTable\""))) - (org-element-map l1-list 'item - (lambda (l1-item) - (let* ((l1-item-contents (org-element-contents l1-item)) - l1-item-leading-text l2-list) - ;; Remove Level-2 list from the Level-item. It - ;; will be subsequently attached as table-cells. - (let ((cur l1-item-contents) prev) - (while (and cur (not (eq (org-element-type (car cur)) - 'plain-list))) - (setq prev cur) - (setq cur (cdr cur))) - (when prev - (setcdr prev nil) - (setq l2-list (car cur))) - (setq l1-item-leading-text l1-item-contents)) - ;; Level-1 items start a table row. - (apply 'org-element-adopt-elements - (list 'table-row (list :type 'standard)) - ;; Leading text of level-1 item define - ;; the first table-cell. - (apply 'org-element-adopt-elements - (list 'table-cell nil) - l1-item-leading-text) - ;; Level-2 items define subsequent - ;; table-cells of the row. - (org-element-map l2-list 'item - (lambda (l2-item) - (apply 'org-element-adopt-elements - (list 'table-cell nil) - (org-element-contents l2-item))) - info nil 'item)))) - info nil 'item)))) - nil) - info) - tree) - - -;;; Interactive functions - -(defun org-odt-create-manifest-file-entry (&rest args) - (push args org-odt-manifest-file-entries)) - -(defun org-odt-write-manifest-file () - (make-directory (concat org-odt-zip-dir "META-INF")) - (let ((manifest-file (concat org-odt-zip-dir "META-INF/manifest.xml"))) - (with-current-buffer - (let ((nxml-auto-insert-xml-declaration-flag nil)) - (find-file-noselect manifest-file t)) - (insert - " - \n") - (mapc - (lambda (file-entry) - (let* ((version (nth 2 file-entry)) - (extra (if (not version) "" - (format " manifest:version=\"%s\"" version)))) - (insert - (format org-odt-manifest-file-entry-tag - (nth 0 file-entry) (nth 1 file-entry) extra)))) - org-odt-manifest-file-entries) - (insert "\n")))) - -(defmacro org-odt--export-wrap (out-file &rest body) - `(let* ((--out-file ,out-file) - (out-file-type (file-name-extension --out-file)) - (org-odt-xml-files '("META-INF/manifest.xml" "content.xml" - "meta.xml" "styles.xml")) - ;; Initialize temporary workarea. All files that end up in - ;; the exported document get parked/created here. - (org-odt-zip-dir (file-name-as-directory - (make-temp-file (format "%s-" out-file-type) t))) - (org-odt-manifest-file-entries nil) - (--cleanup-xml-buffers - (function - (lambda nil - ;; Kill all XML buffers. - (mapc (lambda (file) - (let ((buf (find-buffer-visiting - (concat org-odt-zip-dir file)))) - (when buf - (with-current-buffer buf - (set-buffer-modified-p nil) - (kill-buffer buf))))) - org-odt-xml-files) - ;; Delete temporary directory and also other embedded - ;; files that get copied there. - (delete-directory org-odt-zip-dir t))))) - (condition-case err - (progn - (unless (executable-find "zip") - ;; Not at all OSes ship with zip by default - (error "Executable \"zip\" needed for creating OpenDocument files")) - ;; Do export. This creates a bunch of xml files ready to be - ;; saved and zipped. - (progn ,@body) - ;; Create a manifest entry for content.xml. - (org-odt-create-manifest-file-entry "text/xml" "content.xml") - ;; Write mimetype file - (let* ((mimetypes - '(("odt" . "application/vnd.oasis.opendocument.text") - ("odf" . "application/vnd.oasis.opendocument.formula"))) - (mimetype (cdr (assoc-string out-file-type mimetypes t)))) - (unless mimetype - (error "Unknown OpenDocument backend %S" out-file-type)) - (write-region mimetype nil (concat org-odt-zip-dir "mimetype")) - (org-odt-create-manifest-file-entry mimetype "/" "1.2")) - ;; Write out the manifest entries before zipping - (org-odt-write-manifest-file) - ;; Save all XML files. - (mapc (lambda (file) - (let ((buf (find-buffer-visiting - (concat org-odt-zip-dir file)))) - (when buf - (with-current-buffer buf - ;; Prettify output if needed. - (when org-odt-prettify-xml - (indent-region (point-min) (point-max))) - (save-buffer 0))))) - org-odt-xml-files) - ;; Run zip. - (let* ((target --out-file) - (target-name (file-name-nondirectory target)) - (cmds `(("zip" "-mX0" ,target-name "mimetype") - ("zip" "-rmTq" ,target-name ".")))) - ;; If a file with same name as the desired output file - ;; exists, remove it. - (when (file-exists-p target) - (delete-file target)) - ;; Zip up the xml files. - (let ((coding-system-for-write 'no-conversion) exitcode err-string) - (message "Creating ODT file...") - ;; Switch temporarily to content.xml. This way Zip - ;; process will inherit `org-odt-zip-dir' as the current - ;; directory. - (with-current-buffer - (find-file-noselect (concat org-odt-zip-dir "content.xml") t) - (mapc - (lambda (cmd) - (message "Running %s" (mapconcat 'identity cmd " ")) - (setq err-string - (with-output-to-string - (setq exitcode - (apply 'call-process (car cmd) - nil standard-output nil (cdr cmd))))) - (or (zerop exitcode) - (error (concat "Unable to create OpenDocument file." - (format " Zip failed with error (%s)" - err-string))))) - cmds))) - ;; Move the zip file from temporary work directory to - ;; user-mandated location. - (rename-file (concat org-odt-zip-dir target-name) target) - (message "Created %s" (expand-file-name target)) - ;; Cleanup work directory and work files. - (funcall --cleanup-xml-buffers) - ;; Open the OpenDocument file in archive-mode for - ;; examination. - (find-file-noselect target t) - ;; Return exported file. - (cond - ;; Case 1: Conversion desired on exported file. Run the - ;; converter on the OpenDocument file. Return the - ;; converted file. - (org-odt-preferred-output-format - (or (org-odt-convert target org-odt-preferred-output-format) - target)) - ;; Case 2: No further conversion. Return exported - ;; OpenDocument file. - (t target)))) - (error - ;; Cleanup work directory and work files. - (funcall --cleanup-xml-buffers) - (message "OpenDocument export failed: %s" - (error-message-string err)))))) - - -;;;; Export to OpenDocument formula - -;;;###autoload -(defun org-odt-export-as-odf (latex-frag &optional odf-file) - "Export LATEX-FRAG as OpenDocument formula file ODF-FILE. -Use `org-create-math-formula' to convert LATEX-FRAG first to -MathML. When invoked as an interactive command, use -`org-latex-regexps' to infer LATEX-FRAG from currently active -region. If no LaTeX fragments are found, prompt for it. Push -MathML source to kill ring depending on the value of -`org-export-copy-to-kill-ring'." - (interactive - `(,(let (frag) - (setq frag (and (setq frag (and (region-active-p) - (buffer-substring (region-beginning) - (region-end)))) - (loop for e in org-latex-regexps - thereis (when (string-match (nth 1 e) frag) - (match-string (nth 2 e) frag))))) - (read-string "LaTeX Fragment: " frag nil frag)) - ,(let ((odf-filename (expand-file-name - (concat - (file-name-sans-extension - (or (file-name-nondirectory buffer-file-name))) - "." "odf") - (file-name-directory buffer-file-name)))) - (read-file-name "ODF filename: " nil odf-filename nil - (file-name-nondirectory odf-filename))))) - (let ((filename (or odf-file - (expand-file-name - (concat - (file-name-sans-extension - (or (file-name-nondirectory buffer-file-name))) - "." "odf") - (file-name-directory buffer-file-name))))) - (org-odt--export-wrap - filename - (let* ((buffer (progn - (require 'nxml-mode) - (let ((nxml-auto-insert-xml-declaration-flag nil)) - (find-file-noselect (concat org-odt-zip-dir - "content.xml") t)))) - (coding-system-for-write 'utf-8) - (save-buffer-coding-system 'utf-8)) - (set-buffer buffer) - (set-buffer-file-coding-system coding-system-for-write) - (let ((mathml (org-create-math-formula latex-frag))) - (unless mathml (error "No Math formula created")) - (insert mathml) - ;; Add MathML to kill ring, if needed. - (when (org-export--copy-to-kill-ring-p) - (org-kill-new (buffer-string)))))))) - -;;;###autoload -(defun org-odt-export-as-odf-and-open () - "Export LaTeX fragment as OpenDocument formula and immediately open it. -Use `org-odt-export-as-odf' to read LaTeX fragment and OpenDocument -formula file." - (interactive) - (org-open-file (call-interactively 'org-odt-export-as-odf) 'system)) - - -;;;; Export to OpenDocument Text - -;;;###autoload -(defun org-odt-export-to-odt (&optional async subtreep visible-only ext-plist) - "Export current buffer to a ODT file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return output file's name." - (interactive) - (let ((outfile (org-export-output-file-name ".odt" subtreep))) - (if async - (org-export-async-start (lambda (f) (org-export-add-to-stack f 'odt)) - `(expand-file-name - (org-odt--export-wrap - ,outfile - (let* ((org-odt-embedded-images-count 0) - (org-odt-embedded-formulas-count 0) - (org-odt-automatic-styles nil) - (org-odt-object-counters nil) - ;; Let `htmlfontify' know that we are interested in - ;; collecting styles. - (hfy-user-sheet-assoc nil)) - ;; Initialize content.xml and kick-off the export - ;; process. - (let ((out-buf - (progn - (require 'nxml-mode) - (let ((nxml-auto-insert-xml-declaration-flag nil)) - (find-file-noselect - (concat org-odt-zip-dir "content.xml") t)))) - (output (org-export-as - 'odt ,subtreep ,visible-only nil ,ext-plist))) - (with-current-buffer out-buf - (erase-buffer) - (insert output))))))) - (org-odt--export-wrap - outfile - (let* ((org-odt-embedded-images-count 0) - (org-odt-embedded-formulas-count 0) - (org-odt-automatic-styles nil) - (org-odt-object-counters nil) - ;; Let `htmlfontify' know that we are interested in collecting - ;; styles. - (hfy-user-sheet-assoc nil)) - ;; Initialize content.xml and kick-off the export process. - (let ((output (org-export-as 'odt subtreep visible-only nil ext-plist)) - (out-buf (progn - (require 'nxml-mode) - (let ((nxml-auto-insert-xml-declaration-flag nil)) - (find-file-noselect - (concat org-odt-zip-dir "content.xml") t))))) - (with-current-buffer out-buf (erase-buffer) (insert output)))))))) - - -;;;; Convert between OpenDocument and other formats - -(defun org-odt-reachable-p (in-fmt out-fmt) - "Return non-nil if IN-FMT can be converted to OUT-FMT." - (catch 'done - (let ((reachable-formats (org-odt-do-reachable-formats in-fmt))) - (dolist (e reachable-formats) - (let ((out-fmt-spec (assoc out-fmt (cdr e)))) - (when out-fmt-spec - (throw 'done (cons (car e) out-fmt-spec)))))))) - -(defun org-odt-do-convert (in-file out-fmt &optional prefix-arg) - "Workhorse routine for `org-odt-convert'." - (require 'browse-url) - (let* ((in-file (expand-file-name (or in-file buffer-file-name))) - (dummy (or (file-readable-p in-file) - (error "Cannot read %s" in-file))) - (in-fmt (file-name-extension in-file)) - (out-fmt (or out-fmt (error "Output format unspecified"))) - (how (or (org-odt-reachable-p in-fmt out-fmt) - (error "Cannot convert from %s format to %s format?" - in-fmt out-fmt))) - (convert-process (car how)) - (out-file (concat (file-name-sans-extension in-file) "." - (nth 1 (or (cdr how) out-fmt)))) - (extra-options (or (nth 2 (cdr how)) "")) - (out-dir (file-name-directory in-file)) - (cmd (format-spec convert-process - `((?i . ,(shell-quote-argument in-file)) - (?I . ,(browse-url-file-url in-file)) - (?f . ,out-fmt) - (?o . ,out-file) - (?O . ,(browse-url-file-url out-file)) - (?d . , (shell-quote-argument out-dir)) - (?D . ,(browse-url-file-url out-dir)) - (?x . ,extra-options))))) - (when (file-exists-p out-file) - (delete-file out-file)) - - (message "Executing %s" cmd) - (let ((cmd-output (shell-command-to-string cmd))) - (message "%s" cmd-output)) - - (cond - ((file-exists-p out-file) - (message "Exported to %s" out-file) - (when prefix-arg - (message "Opening %s..." out-file) - (org-open-file out-file 'system)) - out-file) - (t - (message "Export to %s failed" out-file) - nil)))) - -(defun org-odt-do-reachable-formats (in-fmt) - "Return verbose info about formats to which IN-FMT can be converted. -Return a list where each element is of the -form (CONVERTER-PROCESS . OUTPUT-FMT-ALIST). See -`org-odt-convert-processes' for CONVERTER-PROCESS and see -`org-odt-convert-capabilities' for OUTPUT-FMT-ALIST." - (let* ((converter - (and org-odt-convert-process - (cadr (assoc-string org-odt-convert-process - org-odt-convert-processes t)))) - (capabilities - (and org-odt-convert-process - (cadr (assoc-string org-odt-convert-process - org-odt-convert-processes t)) - org-odt-convert-capabilities)) - reachable-formats) - (when converter - (dolist (c capabilities) - (when (member in-fmt (nth 1 c)) - (push (cons converter (nth 2 c)) reachable-formats)))) - reachable-formats)) - -(defun org-odt-reachable-formats (in-fmt) - "Return list of formats to which IN-FMT can be converted. -The list of the form (OUTPUT-FMT-1 OUTPUT-FMT-2 ...)." - (let (l) - (mapc (lambda (e) (add-to-list 'l e)) - (apply 'append (mapcar - (lambda (e) (mapcar 'car (cdr e))) - (org-odt-do-reachable-formats in-fmt)))) - l)) - -(defun org-odt-convert-read-params () - "Return IN-FILE and OUT-FMT params for `org-odt-do-convert'. -This is a helper routine for interactive use." - (let* ((input (if (featurep 'ido) 'ido-completing-read 'completing-read)) - (in-file (read-file-name "File to be converted: " - nil buffer-file-name t)) - (in-fmt (file-name-extension in-file)) - (out-fmt-choices (org-odt-reachable-formats in-fmt)) - (out-fmt - (or (and out-fmt-choices - (funcall input "Output format: " - out-fmt-choices nil nil nil)) - (error - "No known converter or no known output formats for %s files" - in-fmt)))) - (list in-file out-fmt))) - -;;;###autoload -(defun org-odt-convert (&optional in-file out-fmt prefix-arg) - "Convert IN-FILE to format OUT-FMT using a command line converter. -IN-FILE is the file to be converted. If unspecified, it defaults -to variable `buffer-file-name'. OUT-FMT is the desired output -format. Use `org-odt-convert-process' as the converter. -If PREFIX-ARG is non-nil then the newly converted file is opened -using `org-open-file'." - (interactive - (append (org-odt-convert-read-params) current-prefix-arg)) - (org-odt-do-convert in-file out-fmt prefix-arg)) - -;;; Library Initializations - -(mapc - (lambda (desc) - ;; Let Emacs open all OpenDocument files in archive mode - (add-to-list 'auto-mode-alist - (cons (concat "\\." (car desc) "\\'") 'archive-mode))) - org-odt-file-extensions) - -(provide 'ox-odt) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ox-odt.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ox-org.el b/xemacs-packages/lisp/org-8.2.3c/ox-org.el deleted file mode 100644 index cecad563..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ox-org.el +++ /dev/null @@ -1,257 +0,0 @@ -;;; ox-org.el --- Org Back-End for Org Export Engine - -;; Copyright (C) 2013 Free Software Foundation, Inc. - -;; Author: Nicolas Goaziou -;; Keywords: org, wp - -;; 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 . - -;;; Commentary: - -;; This library implements an Org back-end for Org exporter. -;; -;; It introduces two interactive functions, `org-org-export-as-org' -;; and `org-org-export-to-org', which export, respectively, to -;; a temporary buffer and to a file. -;; -;; A publishing function is also provided: `org-org-publish-to-org'. - -;;; Code: -(require 'ox) -(declare-function htmlize-buffer "htmlize" (&optional buffer)) - -(defgroup org-export-org nil - "Options for exporting Org mode files to Org." - :tag "Org Export Org" - :group 'org-export - :version "24.4" - :package-version '(Org . "8.0")) - -(define-obsolete-variable-alias - 'org-export-htmlized-org-css-url 'org-org-htmlized-css-url "24.4") -(defcustom org-org-htmlized-css-url nil - "URL pointing to the CSS defining colors for htmlized Emacs buffers. -Normally when creating an htmlized version of an Org buffer, -htmlize will create the CSS to define the font colors. However, -this does not work when converting in batch mode, and it also can -look bad if different people with different fontification setup -work on the same website. When this variable is non-nil, -creating an htmlized version of an Org buffer using -`org-org-export-as-org' will include a link to this URL if the -setting of `org-html-htmlize-output-type' is 'css." - :group 'org-export-org - :type '(choice - (const :tag "Don't include external stylesheet link" nil) - (string :tag "URL or local href"))) - -(org-export-define-backend 'org - '((babel-call . org-org-identity) - (bold . org-org-identity) - (center-block . org-org-identity) - (clock . org-org-identity) - (code . org-org-identity) - (comment . (lambda (&rest args) "")) - (comment-block . (lambda (&rest args) "")) - (diary-sexp . org-org-identity) - (drawer . org-org-identity) - (dynamic-block . org-org-identity) - (entity . org-org-identity) - (example-block . org-org-identity) - (fixed-width . org-org-identity) - (footnote-definition . org-org-identity) - (footnote-reference . org-org-identity) - (headline . org-org-headline) - (horizontal-rule . org-org-identity) - (inline-babel-call . org-org-identity) - (inline-src-block . org-org-identity) - (inlinetask . org-org-identity) - (italic . org-org-identity) - (item . org-org-identity) - (keyword . org-org-keyword) - (latex-environment . org-org-identity) - (latex-fragment . org-org-identity) - (line-break . org-org-identity) - (link . org-org-identity) - (node-property . org-org-identity) - (paragraph . org-org-identity) - (plain-list . org-org-identity) - (planning . org-org-identity) - (property-drawer . org-org-identity) - (quote-block . org-org-identity) - (quote-section . org-org-identity) - (radio-target . org-org-identity) - (section . org-org-identity) - (special-block . org-org-identity) - (src-block . org-org-identity) - (statistics-cookie . org-org-identity) - (strike-through . org-org-identity) - (subscript . org-org-identity) - (superscript . org-org-identity) - (table . org-org-identity) - (table-cell . org-org-identity) - (table-row . org-org-identity) - (target . org-org-identity) - (timestamp . org-org-identity) - (underline . org-org-identity) - (verbatim . org-org-identity) - (verse-block . org-org-identity)) - :menu-entry - '(?O "Export to Org" - ((?O "As Org buffer" org-org-export-as-org) - (?o "As Org file" org-org-export-to-org) - (?v "As Org file and open" - (lambda (a s v b) - (if a (org-org-export-to-org t s v b) - (org-open-file (org-org-export-to-org nil s v b)))))))) - -(defun org-org-identity (blob contents info) - "Transcode BLOB element or object back into Org syntax. -CONTENTS is its contents, as a string or nil. INFO is ignored." - (org-export-expand blob contents t)) - -(defun org-org-headline (headline contents info) - "Transcode HEADLINE element back into Org syntax. -CONTENTS is its contents, as a string or nil. INFO is ignored." - (unless (plist-get info :with-todo-keywords) - (org-element-put-property headline :todo-keyword nil)) - (unless (plist-get info :with-tags) - (org-element-put-property headline :tags nil)) - (unless (plist-get info :with-priority) - (org-element-put-property headline :priority nil)) - (org-element-put-property headline :level - (org-export-get-relative-level headline info)) - (org-element-headline-interpreter headline contents)) - -(defun org-org-keyword (keyword contents info) - "Transcode KEYWORD element back into Org syntax. -CONTENTS is nil. INFO is ignored. This function ignores -keywords targeted at other export back-ends." - (unless (member (org-element-property :key keyword) - (mapcar - (lambda (block-cons) - (and (eq (cdr block-cons) 'org-element-export-block-parser) - (car block-cons))) - org-element-block-name-alist)) - (org-element-keyword-interpreter keyword nil))) - -;;;###autoload -(defun org-org-export-as-org (&optional async subtreep visible-only ext-plist) - "Export current buffer to an Org buffer. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should be accessible -through the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Export is done in a buffer named \"*Org ORG Export*\", which will -be displayed when `org-export-show-temporary-export-buffer' is -non-nil." - (interactive) - (org-export-to-buffer 'org "*Org ORG Export*" - async subtreep visible-only nil ext-plist (lambda () (org-mode)))) - -;;;###autoload -(defun org-org-export-to-org (&optional async subtreep visible-only ext-plist) - "Export current buffer to an org file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return output file name." - (interactive) - (let ((outfile (org-export-output-file-name ".org" subtreep))) - (org-export-to-file 'org outfile - async subtreep visible-only nil ext-plist))) - -;;;###autoload -(defun org-org-publish-to-org (plist filename pub-dir) - "Publish an org file to org. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (org-publish-org-to 'org filename ".org" plist pub-dir) - (when (plist-get plist :htmlized-source) - (require 'htmlize) - (require 'ox-html) - (let* ((org-inhibit-startup t) - (htmlize-output-type 'css) - (html-ext (concat "." (or (plist-get plist :html-extension) - org-html-extension "html"))) - (visitingp (find-buffer-visiting filename)) - (work-buffer (or visitingp (find-file filename))) - newbuf) - (font-lock-fontify-buffer) - (show-all) - (org-show-block-all) - (setq newbuf (htmlize-buffer)) - (with-current-buffer newbuf - (when org-org-htmlized-css-url - (goto-char (point-min)) - (and (re-search-forward - ".*" nil t) - (replace-match - (format - "" - org-org-htmlized-css-url) t t))) - (write-file (concat pub-dir (file-name-nondirectory filename) html-ext))) - (kill-buffer newbuf) - (unless visitingp (kill-buffer work-buffer))) - (set-buffer-modified-p nil))) - - -(provide 'ox-org) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ox-org.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ox-publish.el b/xemacs-packages/lisp/org-8.2.3c/ox-publish.el deleted file mode 100644 index 67a57fa3..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ox-publish.el +++ /dev/null @@ -1,1238 +0,0 @@ -;;; ox-publish.el --- Publish Related Org Mode Files as a Website -;; Copyright (C) 2006-2013 Free Software Foundation, Inc. - -;; Author: David O'Toole -;; Maintainer: Carsten Dominik -;; Keywords: hypermedia, outlines, wp - -;; 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 . - -;;; Commentary: - -;; This program allow configurable publishing of related sets of -;; Org mode files as a complete website. -;; -;; ox-publish.el can do the following: -;; -;; + Publish all one's Org files to a given export back-end -;; + Upload HTML, images, attachments and other files to a web server -;; + Exclude selected private pages from publishing -;; + Publish a clickable sitemap of pages -;; + Manage local timestamps for publishing only changed files -;; + Accept plugin functions to extend range of publishable content -;; -;; Documentation for publishing is in the manual. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'format-spec) -(require 'ox) - - - -;;; Variables - -(defvar org-publish-temp-files nil - "Temporary list of files to be published.") - -;; Here, so you find the variable right before it's used the first time: -(defvar org-publish-cache nil - "This will cache timestamps and titles for files in publishing projects. -Blocks could hash sha1 values here.") - -(defgroup org-publish nil - "Options for publishing a set of Org-mode and related files." - :tag "Org Publishing" - :group 'org) - -(defcustom org-publish-project-alist nil - "Association list to control publishing behavior. -Each element of the alist is a publishing 'project.' The CAR of -each element is a string, uniquely identifying the project. The -CDR of each element is in one of the following forms: - -1. A well-formed property list with an even number of elements, - alternating keys and values, specifying parameters for the - publishing process. - - \(:property value :property value ... ) - -2. A meta-project definition, specifying of a list of - sub-projects: - - \(:components (\"project-1\" \"project-2\" ...)) - -When the CDR of an element of org-publish-project-alist is in -this second form, the elements of the list after `:components' -are taken to be components of the project, which group together -files requiring different publishing options. When you publish -such a project with \\[org-publish], the components all publish. - -When a property is given a value in `org-publish-project-alist', -its setting overrides the value of the corresponding user -variable (if any) during publishing. However, options set within -a file override everything. - -Most properties are optional, but some should always be set: - - `:base-directory' - - Directory containing publishing source files. - - `:base-extension' - - Extension (without the dot!) of source files. This can be - a regular expression. If not given, \"org\" will be used as - default extension. - - `:publishing-directory' - - Directory (possibly remote) where output files will be - published. - -The `:exclude' property may be used to prevent certain files from -being published. Its value may be a string or regexp matching -file names you don't want to be published. - -The `:include' property may be used to include extra files. Its -value may be a list of filenames to include. The filenames are -considered relative to the base directory. - -When both `:include' and `:exclude' properties are given values, -the exclusion step happens first. - -One special property controls which back-end function to use for -publishing files in the project. This can be used to extend the -set of file types publishable by `org-publish', as well as the -set of output formats. - - `:publishing-function' - - Function to publish file. Each back-end may define its - own (i.e. `org-latex-publish-to-pdf', - `org-html-publish-to-html'). May be a list of functions, in - which case each function in the list is invoked in turn. - -Another property allows you to insert code that prepares -a project for publishing. For example, you could call GNU Make -on a certain makefile, to ensure published files are built up to -date. - - `:preparation-function' - - Function to be called before publishing this project. This - may also be a list of functions. - - `:completion-function' - - Function to be called after publishing this project. This - may also be a list of functions. - -Some properties control details of the Org publishing process, -and are equivalent to the corresponding user variables listed in -the right column. Back-end specific properties may also be -included. See the back-end documentation for more information. - - :author `user-full-name' - :creator `org-export-creator-string' - :email `user-mail-address' - :exclude-tags `org-export-exclude-tags' - :headline-levels `org-export-headline-levels' - :language `org-export-default-language' - :preserve-breaks `org-export-preserve-breaks' - :section-numbers `org-export-with-section-numbers' - :select-tags `org-export-select-tags' - :time-stamp-file `org-export-time-stamp-file' - :with-archived-trees `org-export-with-archived-trees' - :with-author `org-export-with-author' - :with-creator `org-export-with-creator' - :with-date `org-export-with-date' - :with-drawers `org-export-with-drawers' - :with-email `org-export-with-email' - :with-emphasize `org-export-with-emphasize' - :with-entities `org-export-with-entities' - :with-fixed-width `org-export-with-fixed-width' - :with-footnotes `org-export-with-footnotes' - :with-inlinetasks `org-export-with-inlinetasks' - :with-latex `org-export-with-latex' - :with-priority `org-export-with-priority' - :with-smart-quotes `org-export-with-smart-quotes' - :with-special-strings `org-export-with-special-strings' - :with-statistics-cookies' `org-export-with-statistics-cookies' - :with-sub-superscript `org-export-with-sub-superscripts' - :with-toc `org-export-with-toc' - :with-tables `org-export-with-tables' - :with-tags `org-export-with-tags' - :with-tasks `org-export-with-tasks' - :with-timestamps `org-export-with-timestamps' - :with-planning `org-export-with-planning' - :with-todo-keywords `org-export-with-todo-keywords' - -The following properties may be used to control publishing of -a site-map of files or summary page for a given project. - - `:auto-sitemap' - - Whether to publish a site-map during - `org-publish-current-project' or `org-publish-all'. - - `:sitemap-filename' - - Filename for output of sitemap. Defaults to \"sitemap.org\". - - `:sitemap-title' - - Title of site-map page. Defaults to name of file. - - `:sitemap-function' - - Plugin function to use for generation of site-map. Defaults - to `org-publish-org-sitemap', which generates a plain list of - links to all files in the project. - - `:sitemap-style' - - Can be `list' (site-map is just an itemized list of the - titles of the files involved) or `tree' (the directory - structure of the source files is reflected in the site-map). - Defaults to `tree'. - - `:sitemap-sans-extension' - - Remove extension from site-map's file-names. Useful to have - cool URIs (see http://www.w3.org/Provider/Style/URI). - Defaults to nil. - -If you create a site-map file, adjust the sorting like this: - - `:sitemap-sort-folders' - - Where folders should appear in the site-map. Set this to - `first' (default) or `last' to display folders first or last, - respectively. Any other value will mix files and folders. - - `:sitemap-sort-files' - - The site map is normally sorted alphabetically. You can - change this behaviour setting this to `anti-chronologically', - `chronologically', or nil. - - `:sitemap-ignore-case' - - Should sorting be case-sensitive? Default nil. - -The following property control the creation of a concept index. - - `:makeindex' - - Create a concept index. The file containing the index has to - be called \"theindex.org\". If it doesn't exist in the - project, it will be generated. Contents of the index are - stored in the file \"theindex.inc\", which can be included in - \"theindex.org\". - -Other properties affecting publication. - - `:body-only' - - Set this to t to publish only the body of the documents." - :group 'org-export-publish - :type 'alist) - -(defcustom org-publish-use-timestamps-flag t - "Non-nil means use timestamp checking to publish only changed files. -When nil, do no timestamp checking and always publish all files." - :group 'org-export-publish - :type 'boolean) - -(defcustom org-publish-timestamp-directory - (convert-standard-filename "~/.org-timestamps/") - "Name of directory in which to store publishing timestamps." - :group 'org-export-publish - :type 'directory) - -(defcustom org-publish-list-skipped-files t - "Non-nil means show message about files *not* published." - :group 'org-export-publish - :type 'boolean) - -(defcustom org-publish-sitemap-sort-files 'alphabetically - "Method to sort files in site-maps. -Possible values are `alphabetically', `chronologically', -`anti-chronologically' and nil. - -If `alphabetically', files will be sorted alphabetically. If -`chronologically', files will be sorted with older modification -time first. If `anti-chronologically', files will be sorted with -newer modification time first. nil won't sort files. - -You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-sort-files'." - :group 'org-export-publish - :type 'symbol) - -(defcustom org-publish-sitemap-sort-folders 'first - "A symbol, denoting if folders are sorted first in sitemaps. -Possible values are `first', `last', and nil. -If `first', folders will be sorted before files. -If `last', folders are sorted to the end after the files. -Any other value will not mix files and folders. - -You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-sort-folders'." - :group 'org-export-publish - :type 'symbol) - -(defcustom org-publish-sitemap-sort-ignore-case nil - "Non-nil when site-map sorting should ignore case. - -You can overwrite this default per project in your -`org-publish-project-alist', using `:sitemap-ignore-case'." - :group 'org-export-publish - :type 'boolean) - -(defcustom org-publish-sitemap-date-format "%Y-%m-%d" - "Format for printing a date in the sitemap. -See `format-time-string' for allowed formatters." - :group 'org-export-publish - :type 'string) - -(defcustom org-publish-sitemap-file-entry-format "%t" - "Format string for site-map file entry. -You could use brackets to delimit on what part the link will be. - -%t is the title. -%a is the author. -%d is the date formatted using `org-publish-sitemap-date-format'." - :group 'org-export-publish - :type 'string) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Timestamp-related functions - -(defun org-publish-timestamp-filename (filename &optional pub-dir pub-func) - "Return path to timestamp file for filename FILENAME." - (setq filename (concat filename "::" (or pub-dir "") "::" - (format "%s" (or pub-func "")))) - (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename)))) - -(defun org-publish-needed-p - (filename &optional pub-dir pub-func true-pub-dir base-dir) - "Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC. -TRUE-PUB-DIR is where the file will truly end up. Currently we -are not using this - maybe it can eventually be used to check if -the file is present at the target location, and how old it is. -Right now we cannot do this, because we do not know under what -file name the file will be stored - the publishing function can -still decide about that independently." - (let ((rtn (if (not org-publish-use-timestamps-flag) t - (org-publish-cache-file-needs-publishing - filename pub-dir pub-func base-dir)))) - (if rtn (message "Publishing file %s using `%s'" filename pub-func) - (when org-publish-list-skipped-files - (message "Skipping unmodified file %s" filename))) - rtn)) - -(defun org-publish-update-timestamp - (filename &optional pub-dir pub-func base-dir) - "Update publishing timestamp for file FILENAME. -If there is no timestamp, create one." - (let ((key (org-publish-timestamp-filename filename pub-dir pub-func)) - (stamp (org-publish-cache-ctime-of-src filename))) - (org-publish-cache-set key stamp))) - -(defun org-publish-remove-all-timestamps () - "Remove all files in the timestamp directory." - (let ((dir org-publish-timestamp-directory) - files) - (when (and (file-exists-p dir) (file-directory-p dir)) - (mapc 'delete-file (directory-files dir 'full "[^.]\\'")) - (org-publish-reset-cache)))) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Getting project information out of `org-publish-project-alist' - -(defun org-publish-expand-projects (projects-alist) - "Expand projects in PROJECTS-ALIST. -This splices all the components into the list." - (let ((rest projects-alist) rtn p components) - (while (setq p (pop rest)) - (if (setq components (plist-get (cdr p) :components)) - (setq rest (append - (mapcar (lambda (x) (assoc x org-publish-project-alist)) - components) - rest)) - (push p rtn))) - (nreverse (delete-dups (delq nil rtn))))) - -(defvar org-publish-sitemap-sort-files) -(defvar org-publish-sitemap-sort-folders) -(defvar org-publish-sitemap-ignore-case) -(defvar org-publish-sitemap-requested) -(defvar org-publish-sitemap-date-format) -(defvar org-publish-sitemap-file-entry-format) -(defun org-publish-compare-directory-files (a b) - "Predicate for `sort', that sorts folders and files for sitemap." - (let ((retval t)) - (when (or org-publish-sitemap-sort-files org-publish-sitemap-sort-folders) - ;; First we sort files: - (when org-publish-sitemap-sort-files - (case org-publish-sitemap-sort-files - (alphabetically - (let* ((adir (file-directory-p a)) - (aorg (and (string-match "\\.org$" a) (not adir))) - (bdir (file-directory-p b)) - (borg (and (string-match "\\.org$" b) (not bdir))) - (A (if aorg (concat (file-name-directory a) - (org-publish-find-title a)) a)) - (B (if borg (concat (file-name-directory b) - (org-publish-find-title b)) b))) - (setq retval (if org-publish-sitemap-ignore-case - (not (string-lessp (upcase B) (upcase A))) - (not (string-lessp B A)))))) - ((anti-chronologically chronologically) - (let* ((adate (org-publish-find-date a)) - (bdate (org-publish-find-date b)) - (A (+ (lsh (car adate) 16) (cadr adate))) - (B (+ (lsh (car bdate) 16) (cadr bdate)))) - (setq retval - (if (eq org-publish-sitemap-sort-files 'chronologically) (<= A B) - (>= A B))))))) - ;; Directory-wise wins: - (when org-publish-sitemap-sort-folders - ;; a is directory, b not: - (cond - ((and (file-directory-p a) (not (file-directory-p b))) - (setq retval (equal org-publish-sitemap-sort-folders 'first))) - ;; a is not a directory, but b is: - ((and (not (file-directory-p a)) (file-directory-p b)) - (setq retval (equal org-publish-sitemap-sort-folders 'last)))))) - retval)) - -(defun org-publish-get-base-files-1 - (base-dir &optional recurse match skip-file skip-dir) - "Set `org-publish-temp-files' with files from BASE-DIR directory. -If RECURSE is non-nil, check BASE-DIR recursively. If MATCH is -non-nil, restrict this list to the files matching the regexp -MATCH. If SKIP-FILE is non-nil, skip file matching the regexp -SKIP-FILE. If SKIP-DIR is non-nil, don't check directories -matching the regexp SKIP-DIR when recursing through BASE-DIR." - (mapc (lambda (f) - (let ((fd-p (file-directory-p f)) - (fnd (file-name-nondirectory f))) - (if (and fd-p recurse - (not (string-match "^\\.+$" fnd)) - (if skip-dir (not (string-match skip-dir fnd)) t)) - (org-publish-get-base-files-1 - f recurse match skip-file skip-dir) - (unless (or fd-p ;; this is a directory - (and skip-file (string-match skip-file fnd)) - (not (file-exists-p (file-truename f))) - (not (string-match match fnd))) - - (pushnew f org-publish-temp-files))))) - (let ((all-files (if (not recurse) (directory-files base-dir t match) - ;; If RECURSE is non-nil, we want all files - ;; matching MATCH and sub-directories. - (org-remove-if-not - (lambda (file) - (or (file-directory-p file) - (and match (string-match match file)))) - (directory-files base-dir t))))) - (if (not org-publish-sitemap-requested) all-files - (sort all-files 'org-publish-compare-directory-files))))) - -(defun org-publish-get-base-files (project &optional exclude-regexp) - "Return a list of all files in PROJECT. -If EXCLUDE-REGEXP is set, this will be used to filter out -matching filenames." - (let* ((project-plist (cdr project)) - (base-dir (file-name-as-directory - (plist-get project-plist :base-directory))) - (include-list (plist-get project-plist :include)) - (recurse (plist-get project-plist :recursive)) - (extension (or (plist-get project-plist :base-extension) "org")) - ;; sitemap-... variables are dynamically scoped for - ;; org-publish-compare-directory-files: - (org-publish-sitemap-requested - (plist-get project-plist :auto-sitemap)) - (sitemap-filename - (or (plist-get project-plist :sitemap-filename) "sitemap.org")) - (org-publish-sitemap-sort-folders - (if (plist-member project-plist :sitemap-sort-folders) - (plist-get project-plist :sitemap-sort-folders) - org-publish-sitemap-sort-folders)) - (org-publish-sitemap-sort-files - (cond ((plist-member project-plist :sitemap-sort-files) - (plist-get project-plist :sitemap-sort-files)) - ;; For backward compatibility: - ((plist-member project-plist :sitemap-alphabetically) - (if (plist-get project-plist :sitemap-alphabetically) - 'alphabetically nil)) - (t org-publish-sitemap-sort-files))) - (org-publish-sitemap-ignore-case - (if (plist-member project-plist :sitemap-ignore-case) - (plist-get project-plist :sitemap-ignore-case) - org-publish-sitemap-sort-ignore-case)) - (match (if (eq extension 'any) "^[^\\.]" - (concat "^[^\\.].*\\.\\(" extension "\\)$")))) - ;; Make sure `org-publish-sitemap-sort-folders' has an accepted - ;; value. - (unless (memq org-publish-sitemap-sort-folders '(first last)) - (setq org-publish-sitemap-sort-folders nil)) - - (setq org-publish-temp-files nil) - (if org-publish-sitemap-requested - (pushnew (expand-file-name (concat base-dir sitemap-filename)) - org-publish-temp-files)) - (org-publish-get-base-files-1 base-dir recurse match - ;; FIXME distinguish exclude regexp - ;; for skip-file and skip-dir? - exclude-regexp exclude-regexp) - (mapc (lambda (f) - (pushnew - (expand-file-name (concat base-dir f)) - org-publish-temp-files)) - include-list) - org-publish-temp-files)) - -(defun org-publish-get-project-from-filename (filename &optional up) - "Return the project that FILENAME belongs to." - (let* ((filename (expand-file-name filename)) - project-name) - - (catch 'p-found - (dolist (prj org-publish-project-alist) - (unless (plist-get (cdr prj) :components) - ;; [[info:org:Selecting%20files]] shows how this is supposed to work: - (let* ((r (plist-get (cdr prj) :recursive)) - (b (expand-file-name (file-name-as-directory - (plist-get (cdr prj) :base-directory)))) - (x (or (plist-get (cdr prj) :base-extension) "org")) - (e (plist-get (cdr prj) :exclude)) - (i (plist-get (cdr prj) :include)) - (xm (concat "^" b (if r ".+" "[^/]+") "\\.\\(" x "\\)$"))) - (when - (or (and i - (member filename - (mapcar (lambda (file) - (expand-file-name file b)) - i))) - (and (not (and e (string-match e filename))) - (string-match xm filename))) - (setq project-name (car prj)) - (throw 'p-found project-name)))))) - (when up - (dolist (prj org-publish-project-alist) - (if (member project-name (plist-get (cdr prj) :components)) - (setq project-name (car prj))))) - (assoc project-name org-publish-project-alist))) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Tools for publishing functions in back-ends - -(defun org-publish-org-to (backend filename extension plist &optional pub-dir) - "Publish an Org file to a specified back-end. - -BACKEND is a symbol representing the back-end used for -transcoding. FILENAME is the filename of the Org file to be -published. EXTENSION is the extension used for the output -string, with the leading dot. PLIST is the property list for the -given project. - -Optional argument PUB-DIR, when non-nil is the publishing -directory. - -Return output file name." - (unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t)) - ;; Check if a buffer visiting FILENAME is already open. - (let* ((org-inhibit-startup t) - (visitingp (find-buffer-visiting filename)) - (work-buffer (or visitingp (find-file-noselect filename)))) - (prog1 (with-current-buffer work-buffer - (let ((output-file - (org-export-output-file-name extension nil pub-dir)) - (body-p (plist-get plist :body-only))) - (org-export-to-file backend output-file - nil nil nil body-p - ;; Add `org-publish-collect-numbering' and - ;; `org-publish-collect-index' to final output - ;; filters. The latter isn't dependent on - ;; `:makeindex', since we want to keep it up-to-date - ;; in cache anyway. - (org-combine-plists - plist - `(:filter-final-output - ,(cons 'org-publish-collect-numbering - (cons 'org-publish-collect-index - (plist-get plist :filter-final-output)))))))) - ;; Remove opened buffer in the process. - (unless visitingp (kill-buffer work-buffer))))) - -(defun org-publish-attachment (plist filename pub-dir) - "Publish a file with no transformation of any kind. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (unless (file-directory-p pub-dir) - (make-directory pub-dir t)) - (or (equal (expand-file-name (file-name-directory filename)) - (file-name-as-directory (expand-file-name pub-dir))) - (copy-file filename - (expand-file-name (file-name-nondirectory filename) pub-dir) - t))) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Publishing files, sets of files, and indices - -(defun org-publish-file (filename &optional project no-cache) - "Publish file FILENAME from PROJECT. -If NO-CACHE is not nil, do not initialize org-publish-cache and -write it to disk. This is needed, since this function is used to -publish single files, when entire projects are published. -See `org-publish-projects'." - (let* ((project - (or project - (or (org-publish-get-project-from-filename filename) - (error "File %s not part of any known project" - (abbreviate-file-name filename))))) - (project-plist (cdr project)) - (ftname (expand-file-name filename)) - (publishing-function - (or (plist-get project-plist :publishing-function) - (error "No publishing function chosen"))) - (base-dir - (file-name-as-directory - (expand-file-name - (or (plist-get project-plist :base-directory) - (error "Project %s does not have :base-directory defined" - (car project)))))) - (pub-dir - (file-name-as-directory - (file-truename - (or (eval (plist-get project-plist :publishing-directory)) - (error "Project %s does not have :publishing-directory defined" - (car project)))))) - tmp-pub-dir) - - (unless no-cache (org-publish-initialize-cache (car project))) - - (setq tmp-pub-dir - (file-name-directory - (concat pub-dir - (and (string-match (regexp-quote base-dir) ftname) - (substring ftname (match-end 0)))))) - (if (listp publishing-function) - ;; allow chain of publishing functions - (mapc (lambda (f) - (when (org-publish-needed-p - filename pub-dir f tmp-pub-dir base-dir) - (funcall f project-plist filename tmp-pub-dir) - (org-publish-update-timestamp filename pub-dir f base-dir))) - publishing-function) - (when (org-publish-needed-p - filename pub-dir publishing-function tmp-pub-dir base-dir) - (funcall publishing-function project-plist filename tmp-pub-dir) - (org-publish-update-timestamp - filename pub-dir publishing-function base-dir))) - (unless no-cache (org-publish-write-cache-file)))) - -(defun org-publish-projects (projects) - "Publish all files belonging to the PROJECTS alist. -If `:auto-sitemap' is set, publish the sitemap too. If -`:makeindex' is set, also produce a file theindex.org." - (mapc - (lambda (project) - ;; Each project uses its own cache file: - (org-publish-initialize-cache (car project)) - (let* ((project-plist (cdr project)) - (exclude-regexp (plist-get project-plist :exclude)) - (sitemap-p (plist-get project-plist :auto-sitemap)) - (sitemap-filename (or (plist-get project-plist :sitemap-filename) - "sitemap.org")) - (sitemap-function (or (plist-get project-plist :sitemap-function) - 'org-publish-org-sitemap)) - (org-publish-sitemap-date-format - (or (plist-get project-plist :sitemap-date-format) - org-publish-sitemap-date-format)) - (org-publish-sitemap-file-entry-format - (or (plist-get project-plist :sitemap-file-entry-format) - org-publish-sitemap-file-entry-format)) - (preparation-function - (plist-get project-plist :preparation-function)) - (completion-function (plist-get project-plist :completion-function)) - (files (org-publish-get-base-files project exclude-regexp)) - (theindex - (expand-file-name "theindex.org" - (plist-get project-plist :base-directory)))) - (when preparation-function (run-hooks 'preparation-function)) - (if sitemap-p (funcall sitemap-function project sitemap-filename)) - ;; Publish all files from PROJECT excepted "theindex.org". Its - ;; publishing will be deferred until "theindex.inc" is - ;; populated. - (dolist (file files) - (unless (equal file theindex) - (org-publish-file file project t))) - ;; Populate "theindex.inc", if needed, and publish - ;; "theindex.org". - (when (plist-get project-plist :makeindex) - (org-publish-index-generate-theindex - project (plist-get project-plist :base-directory)) - (org-publish-file theindex project t)) - (when completion-function (run-hooks 'completion-function)) - (org-publish-write-cache-file))) - (org-publish-expand-projects projects))) - -(defun org-publish-org-sitemap (project &optional sitemap-filename) - "Create a sitemap of pages in set defined by PROJECT. -Optionally set the filename of the sitemap with SITEMAP-FILENAME. -Default for SITEMAP-FILENAME is 'sitemap.org'." - (let* ((project-plist (cdr project)) - (dir (file-name-as-directory - (plist-get project-plist :base-directory))) - (localdir (file-name-directory dir)) - (indent-str (make-string 2 ?\ )) - (exclude-regexp (plist-get project-plist :exclude)) - (files (nreverse - (org-publish-get-base-files project exclude-regexp))) - (sitemap-filename (concat dir (or sitemap-filename "sitemap.org"))) - (sitemap-title (or (plist-get project-plist :sitemap-title) - (concat "Sitemap for project " (car project)))) - (sitemap-style (or (plist-get project-plist :sitemap-style) - 'tree)) - (sitemap-sans-extension - (plist-get project-plist :sitemap-sans-extension)) - (visiting (find-buffer-visiting sitemap-filename)) - (ifn (file-name-nondirectory sitemap-filename)) - file sitemap-buffer) - (with-current-buffer - (let ((org-inhibit-startup t)) - (setq sitemap-buffer - (or visiting (find-file sitemap-filename)))) - (erase-buffer) - (insert (concat "#+TITLE: " sitemap-title "\n\n")) - (while (setq file (pop files)) - (let ((fn (file-name-nondirectory file)) - (link (file-relative-name file dir)) - (oldlocal localdir)) - (when sitemap-sans-extension - (setq link (file-name-sans-extension link))) - ;; sitemap shouldn't list itself - (unless (equal (file-truename sitemap-filename) - (file-truename file)) - (if (eq sitemap-style 'list) - (message "Generating list-style sitemap for %s" sitemap-title) - (message "Generating tree-style sitemap for %s" sitemap-title) - (setq localdir (concat (file-name-as-directory dir) - (file-name-directory link))) - (unless (string= localdir oldlocal) - (if (string= localdir dir) - (setq indent-str (make-string 2 ?\ )) - (let ((subdirs - (split-string - (directory-file-name - (file-name-directory - (file-relative-name localdir dir))) "/")) - (subdir "") - (old-subdirs (split-string - (file-relative-name oldlocal dir) "/"))) - (setq indent-str (make-string 2 ?\ )) - (while (string= (car old-subdirs) (car subdirs)) - (setq indent-str (concat indent-str (make-string 2 ?\ ))) - (pop old-subdirs) - (pop subdirs)) - (dolist (d subdirs) - (setq subdir (concat subdir d "/")) - (insert (concat indent-str " + " d "\n")) - (setq indent-str (make-string - (+ (length indent-str) 2) ?\ ))))))) - ;; This is common to 'flat and 'tree - (let ((entry - (org-publish-format-file-entry - org-publish-sitemap-file-entry-format file project-plist)) - (regexp "\\(.*\\)\\[\\([^][]+\\)\\]\\(.*\\)")) - (cond ((string-match-p regexp entry) - (string-match regexp entry) - (insert (concat indent-str " + " (match-string 1 entry) - "[[file:" link "][" - (match-string 2 entry) - "]]" (match-string 3 entry) "\n"))) - (t - (insert (concat indent-str " + [[file:" link "][" - entry - "]]\n")))))))) - (save-buffer)) - (or visiting (kill-buffer sitemap-buffer)))) - -(defun org-publish-format-file-entry (fmt file project-plist) - (format-spec - fmt - `((?t . ,(org-publish-find-title file t)) - (?d . ,(format-time-string org-publish-sitemap-date-format - (org-publish-find-date file))) - (?a . ,(or (plist-get project-plist :author) user-full-name))))) - -(defun org-publish-find-title (file &optional reset) - "Find the title of FILE in project." - (or - (and (not reset) (org-publish-cache-get-file-property file :title nil t)) - (let* ((org-inhibit-startup t) - (visiting (find-buffer-visiting file)) - (buffer (or visiting (find-file-noselect file)))) - (with-current-buffer buffer - (org-mode) - (let ((title - (let ((property (plist-get (org-export-get-environment) :title))) - (if property (org-element-interpret-data property) - (file-name-nondirectory (file-name-sans-extension file)))))) - (unless visiting (kill-buffer buffer)) - (org-publish-cache-set-file-property file :title title) - title))))) - -(defun org-publish-find-date (file) - "Find the date of FILE in project. -This function assumes FILE is either a directory or an Org file. -If FILE is an Org file and provides a DATE keyword use it. In -any other case use the file system's modification time. Return -time in `current-time' format." - (if (file-directory-p file) (nth 5 (file-attributes file)) - (let* ((visiting (find-buffer-visiting file)) - (file-buf (or visiting (find-file-noselect file nil))) - (date (plist-get - (with-current-buffer file-buf - (let ((org-inhibit-startup t)) (org-mode)) - (org-export-get-environment)) - :date))) - (unless visiting (kill-buffer file-buf)) - ;; DATE is either a timestamp object or a secondary string. If it - ;; is a timestamp or if the secondary string contains a timestamp, - ;; convert it to internal format. Otherwise, use FILE - ;; modification time. - (cond ((eq (org-element-type date) 'timestamp) - (org-time-string-to-time (org-element-interpret-data date))) - ((let ((ts (and (consp date) (assq 'timestamp date)))) - (and ts - (let ((value (org-element-interpret-data ts))) - (and (org-string-nw-p value) - (org-time-string-to-time value)))))) - ((file-exists-p file) (nth 5 (file-attributes file))) - (t (error "No such file: \"%s\"" file)))))) - - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Interactive publishing functions - -;;;###autoload -(defalias 'org-publish-project 'org-publish) - -;;;###autoload -(defun org-publish (project &optional force async) - "Publish PROJECT. - -PROJECT is either a project name, as a string, or a project -alist (see `org-publish-project-alist' variable). - -When optional argument FORCE is non-nil, force publishing all -files in PROJECT. With a non-nil optional argument ASYNC, -publishing will be done asynchronously, in another process." - (interactive - (list - (assoc (org-icompleting-read - "Publish project: " - org-publish-project-alist nil t) - org-publish-project-alist) - current-prefix-arg)) - (let ((project-alist (if (not (stringp project)) (list project) - ;; If this function is called in batch mode, - ;; project is still a string here. - (list (assoc project org-publish-project-alist))))) - (if async - (org-export-async-start 'ignore - `(let ((org-publish-use-timestamps-flag - (if ',force nil ,org-publish-use-timestamps-flag))) - (org-publish-projects ',project-alist))) - (save-window-excursion - (let* ((org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (org-publish-projects project-alist)))))) - -;;;###autoload -(defun org-publish-all (&optional force async) - "Publish all projects. -With prefix argument FORCE, remove all files in the timestamp -directory and force publishing all projects. With a non-nil -optional argument ASYNC, publishing will be done asynchronously, -in another process." - (interactive "P") - (if async - (org-export-async-start 'ignore - `(progn - (when ',force (org-publish-remove-all-timestamps)) - (let ((org-publish-use-timestamps-flag - (if ',force nil ,org-publish-use-timestamps-flag))) - (org-publish-projects ',org-publish-project-alist)))) - (when force (org-publish-remove-all-timestamps)) - (save-window-excursion - (let ((org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (org-publish-projects org-publish-project-alist))))) - - -;;;###autoload -(defun org-publish-current-file (&optional force async) - "Publish the current file. -With prefix argument FORCE, force publish the file. When -optional argument ASYNC is non-nil, publishing will be done -asynchronously, in another process." - (interactive "P") - (let ((file (buffer-file-name (buffer-base-buffer)))) - (if async - (org-export-async-start 'ignore - `(let ((org-publish-use-timestamps-flag - (if ',force nil ,org-publish-use-timestamps-flag))) - (org-publish-file ,file))) - (save-window-excursion - (let ((org-publish-use-timestamps-flag - (if force nil org-publish-use-timestamps-flag))) - (org-publish-file file)))))) - -;;;###autoload -(defun org-publish-current-project (&optional force async) - "Publish the project associated with the current file. -With a prefix argument, force publishing of all files in -the project." - (interactive "P") - (save-window-excursion - (let ((project (org-publish-get-project-from-filename - (buffer-file-name (buffer-base-buffer)) 'up))) - (if project (org-publish project force async) - (error "File %s is not part of any known project" - (buffer-file-name (buffer-base-buffer))))))) - - - -;;; Index generation - -(defun org-publish-collect-index (output backend info) - "Update index for a file in cache. - -OUTPUT is the output from transcoding current file. BACKEND is -the back-end that was used for transcoding. INFO is a plist -containing publishing and export options. - -The index relative to current file is stored as an alist. An -association has the following shape: (TERM FILE-NAME PARENT), -where TERM is the indexed term, as a string, FILE-NAME is the -original full path of the file where the term in encountered, and -PARENT is a reference to the headline, if any, containing the -original index keyword. When non-nil, this reference is a cons -cell. Its CAR is a symbol among `id', `custom-id' and `name' and -its CDR is a string." - (let ((file (plist-get info :input-file))) - (org-publish-cache-set-file-property - file :index - (delete-dups - (org-element-map (plist-get info :parse-tree) 'keyword - (lambda (k) - (when (equal (org-element-property :key k) "INDEX") - (let ((parent (org-export-get-parent-headline k))) - (list (org-element-property :value k) - file - (cond - ((not parent) nil) - ((let ((id (org-element-property :ID parent))) - (and id (cons 'id id)))) - ((let ((id (org-element-property :CUSTOM_ID parent))) - (and id (cons 'custom-id id)))) - (t (cons 'name - ;; Remove statistics cookie. - (replace-regexp-in-string - "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" - (org-element-property :raw-value parent))))))))) - info)))) - ;; Return output unchanged. - output) - -(defun org-publish-index-generate-theindex (project directory) - "Retrieve full index from cache and build \"theindex.org\". -PROJECT is the project the index relates to. DIRECTORY is the -publishing directory." - (let ((all-files (org-publish-get-base-files - project (plist-get (cdr project) :exclude))) - full-index) - ;; Compile full index and sort it alphabetically. - (dolist (file all-files - (setq full-index - (sort (nreverse full-index) - (lambda (a b) (string< (downcase (car a)) - (downcase (car b))))))) - (let ((index (org-publish-cache-get-file-property file :index))) - (dolist (term index) - (unless (member term full-index) (push term full-index))))) - ;; Write "theindex.inc" in DIRECTORY. - (with-temp-file (expand-file-name "theindex.inc" directory) - (let ((current-letter nil) (last-entry nil)) - (dolist (idx full-index) - (let* ((entry (org-split-string (car idx) "!")) - (letter (upcase (substring (car entry) 0 1))) - ;; Transform file into a path relative to publishing - ;; directory. - (file (file-relative-name - (nth 1 idx) - (plist-get (cdr project) :base-directory)))) - ;; Check if another letter has to be inserted. - (unless (string= letter current-letter) - (insert (format "* %s\n" letter))) - ;; Compute the first difference between last entry and - ;; current one: it tells the level at which new items - ;; should be added. - (let* ((rank (if (equal entry last-entry) (1- (length entry)) - (loop for n from 0 to (length entry) - unless (equal (nth n entry) (nth n last-entry)) - return n))) - (len (length (nthcdr rank entry)))) - ;; For each term after the first difference, create - ;; a new sub-list with the term as body. Moreover, - ;; linkify the last term. - (dotimes (n len) - (insert - (concat - (make-string (* (+ rank n) 2) ? ) " - " - (if (not (= (1- len) n)) (nth (+ rank n) entry) - ;; Last term: Link it to TARGET, if possible. - (let ((target (nth 2 idx))) - (format - "[[%s][%s]]" - ;; Destination. - (case (car target) - ('nil (format "file:%s" file)) - (id (format "id:%s" (cdr target))) - (custom-id (format "file:%s::#%s" file (cdr target))) - (otherwise (format "file:%s::*%s" file (cdr target)))) - ;; Description. - (car (last entry))))) - "\n")))) - (setq current-letter letter last-entry entry)))) - ;; Create "theindex.org", if it doesn't exist yet, and provide - ;; a default index file. - (let ((index.org (expand-file-name "theindex.org" directory))) - (unless (file-exists-p index.org) - (with-temp-file index.org - (insert "#+TITLE: Index\n\n#+INCLUDE: \"theindex.inc\"\n\n"))))))) - - - -;;; External Fuzzy Links Resolution -;; -;; This part implements tools to resolve [[file.org::*Some headline]] -;; links, where "file.org" belongs to the current project. - -(defun org-publish-collect-numbering (output backend info) - (org-publish-cache-set-file-property - (plist-get info :input-file) :numbering - (mapcar (lambda (entry) - (cons (org-split-string - (replace-regexp-in-string - "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" - (org-element-property :raw-value (car entry)))) - (cdr entry))) - (plist-get info :headline-numbering))) - ;; Return output unchanged. - output) - -(defun org-publish-resolve-external-fuzzy-link (file fuzzy) - "Return numbering for headline matching FUZZY search in FILE. - -Return value is a list of numbers, or nil. This function allows -to resolve external fuzzy links like: - - [[file.org::*fuzzy][description]" - (when org-publish-cache - (cdr (assoc (org-split-string - (if (eq (aref fuzzy 0) ?*) (substring fuzzy 1) fuzzy)) - (org-publish-cache-get-file-property - (expand-file-name file) :numbering nil t))))) - - - -;;; Caching functions - -(defun org-publish-write-cache-file (&optional free-cache) - "Write `org-publish-cache' to file. -If FREE-CACHE, empty the cache." - (unless org-publish-cache - (error "`org-publish-write-cache-file' called, but no cache present")) - - (let ((cache-file (org-publish-cache-get ":cache-file:"))) - (unless cache-file - (error "Cannot find cache-file name in `org-publish-write-cache-file'")) - (with-temp-file cache-file - (let (print-level print-length) - (insert "(setq org-publish-cache (make-hash-table :test 'equal :weakness nil :size 100))\n") - (maphash (lambda (k v) - (insert - (format (concat "(puthash %S " - (if (or (listp v) (symbolp v)) - "'" "") - "%S org-publish-cache)\n") k v))) - org-publish-cache))) - (when free-cache (org-publish-reset-cache)))) - -(defun org-publish-initialize-cache (project-name) - "Initialize the projects cache if not initialized yet and return it." - - (unless project-name - (error "Cannot initialize `org-publish-cache' without projects name in `org-publish-initialize-cache'")) - - (unless (file-exists-p org-publish-timestamp-directory) - (make-directory org-publish-timestamp-directory t)) - (unless (file-directory-p org-publish-timestamp-directory) - (error "Org publish timestamp: %s is not a directory" - org-publish-timestamp-directory)) - - (unless (and org-publish-cache - (string= (org-publish-cache-get ":project:") project-name)) - (let* ((cache-file - (concat - (expand-file-name org-publish-timestamp-directory) - project-name ".cache")) - (cexists (file-exists-p cache-file))) - - (when org-publish-cache (org-publish-reset-cache)) - - (if cexists (load-file cache-file) - (setq org-publish-cache - (make-hash-table :test 'equal :weakness nil :size 100)) - (org-publish-cache-set ":project:" project-name) - (org-publish-cache-set ":cache-file:" cache-file)) - (unless cexists (org-publish-write-cache-file nil)))) - org-publish-cache) - -(defun org-publish-reset-cache () - "Empty org-publish-cache and reset it nil." - (message "%s" "Resetting org-publish-cache") - (when (hash-table-p org-publish-cache) - (clrhash org-publish-cache)) - (setq org-publish-cache nil)) - -(defun org-publish-cache-file-needs-publishing - (filename &optional pub-dir pub-func base-dir) - "Check the timestamp of the last publishing of FILENAME. -Return non-nil if the file needs publishing. Also check if -any included files have been more recently published, so that -the file including them will be republished as well." - (unless org-publish-cache - (error - "`org-publish-cache-file-needs-publishing' called, but no cache present")) - (let* ((case-fold-search t) - (key (org-publish-timestamp-filename filename pub-dir pub-func)) - (pstamp (org-publish-cache-get key)) - (org-inhibit-startup t) - (visiting (find-buffer-visiting filename)) - included-files-ctime buf) - - (when (equal (file-name-extension filename) "org") - (setq buf (find-file (expand-file-name filename))) - (with-current-buffer buf - (goto-char (point-min)) - (while (re-search-forward - "^#\\+INCLUDE:[ \t]+\"\\([^\t\n\r\"]*\\)\"[ \t]*.*$" nil t) - (let* ((included-file (expand-file-name (match-string 1)))) - (add-to-list 'included-files-ctime - (org-publish-cache-ctime-of-src included-file) t)))) - (unless visiting (kill-buffer buf))) - (if (null pstamp) t - (let ((ctime (org-publish-cache-ctime-of-src filename))) - (or (< pstamp ctime) - (when included-files-ctime - (not (null (delq nil (mapcar (lambda(ct) (< ctime ct)) - included-files-ctime)))))))))) - -(defun org-publish-cache-set-file-property - (filename property value &optional project-name) - "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE. -Use cache file of PROJECT-NAME. If the entry does not exist, it -will be created. Return VALUE." - ;; Evtl. load the requested cache file: - (if project-name (org-publish-initialize-cache project-name)) - (let ((pl (org-publish-cache-get filename))) - (if pl (progn (plist-put pl property value) value) - (org-publish-cache-get-file-property - filename property value nil project-name)))) - -(defun org-publish-cache-get-file-property - (filename property &optional default no-create project-name) - "Return the value for a PROPERTY of file FILENAME in publishing cache. -Use cache file of PROJECT-NAME. Return the value of that PROPERTY -or DEFAULT, if the value does not yet exist. If the entry will -be created, unless NO-CREATE is not nil." - ;; Evtl. load the requested cache file: - (if project-name (org-publish-initialize-cache project-name)) - (let ((pl (org-publish-cache-get filename)) retval) - (if pl - (if (plist-member pl property) - (setq retval (plist-get pl property)) - (setq retval default)) - ;; no pl yet: - (unless no-create - (org-publish-cache-set filename (list property default))) - (setq retval default)) - retval)) - -(defun org-publish-cache-get (key) - "Return the value stored in `org-publish-cache' for key KEY. -Returns nil, if no value or nil is found, or the cache does not -exist." - (unless org-publish-cache - (error "`org-publish-cache-get' called, but no cache present")) - (gethash key org-publish-cache)) - -(defun org-publish-cache-set (key value) - "Store KEY VALUE pair in `org-publish-cache'. -Returns value on success, else nil." - (unless org-publish-cache - (error "`org-publish-cache-set' called, but no cache present")) - (puthash key value org-publish-cache)) - -(defun org-publish-cache-ctime-of-src (file) - "Get the ctime of FILE as an integer." - (let ((attr (file-attributes - (expand-file-name (or (file-symlink-p file) file) - (file-name-directory file))))) - (+ (lsh (car (nth 5 attr)) 16) - (cadr (nth 5 attr))))) - - -(provide 'ox-publish) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ox-publish.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ox-texinfo.el b/xemacs-packages/lisp/org-8.2.3c/ox-texinfo.el deleted file mode 100644 index 0df660da..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ox-texinfo.el +++ /dev/null @@ -1,1885 +0,0 @@ -;;; ox-texinfo.el --- Texinfo Back-End for Org Export Engine - -;; Copyright (C) 2012-2013 Free Software Foundation, Inc. -;; Author: Jonathan Leech-Pepin -;; Keywords: outlines, hypermedia, calendar, wp - -;; 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 . - -;;; Commentary: -;; -;; This library implements a Texinfo back-end for Org generic -;; exporter. -;; -;; To test it, run -;; -;; M-: (org-export-to-buffer 'texinfo "*Test Texinfo*") RET -;; -;; in an Org mode buffer then switch to the buffer to see the Texinfo -;; export. See ox.el for more details on how this exporter works. -;; - -;; It introduces nine new buffer keywords: "TEXINFO_CLASS", -;; "TEXINFO_FILENAME", "TEXINFO_HEADER", "TEXINFO_POST_HEADER", -;; "TEXINFO_DIR_CATEGORY", "TEXINFO_DIR_TITLE", "TEXINFO_DIR_DESC" -;; "SUBTITLE" and "SUBAUTHOR". - -;; -;; It introduces 1 new headline property keywords: -;; "TEXINFO_MENU_TITLE" for optional menu titles. -;; -;; To include inline code snippets (for example for generating @kbd{} -;; and @key{} commands), the following export-snippet keys are -;; accepted: -;; -;; texinfo -;; info -;; -;; You can add them for export snippets via any of the below: -;; -;; (add-to-list 'org-export-snippet-translation-alist -;; '("info" . "texinfo")) -;; - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'ox) - -(defvar orgtbl-exp-regexp) - - - -;;; Define Back-End - -(org-export-define-backend 'texinfo - '((bold . org-texinfo-bold) - (center-block . org-texinfo-center-block) - (clock . org-texinfo-clock) - (code . org-texinfo-code) - (comment . org-texinfo-comment) - (comment-block . org-texinfo-comment-block) - (drawer . org-texinfo-drawer) - (dynamic-block . org-texinfo-dynamic-block) - (entity . org-texinfo-entity) - (example-block . org-texinfo-example-block) - (export-block . org-texinfo-export-block) - (export-snippet . org-texinfo-export-snippet) - (fixed-width . org-texinfo-fixed-width) - (footnote-definition . org-texinfo-footnote-definition) - (footnote-reference . org-texinfo-footnote-reference) - (headline . org-texinfo-headline) - (inline-src-block . org-texinfo-inline-src-block) - (inlinetask . org-texinfo-inlinetask) - (italic . org-texinfo-italic) - (item . org-texinfo-item) - (keyword . org-texinfo-keyword) - (line-break . org-texinfo-line-break) - (link . org-texinfo-link) - (paragraph . org-texinfo-paragraph) - (plain-list . org-texinfo-plain-list) - (plain-text . org-texinfo-plain-text) - (planning . org-texinfo-planning) - (property-drawer . org-texinfo-property-drawer) - (quote-block . org-texinfo-quote-block) - (quote-section . org-texinfo-quote-section) - (radio-target . org-texinfo-radio-target) - (section . org-texinfo-section) - (special-block . org-texinfo-special-block) - (src-block . org-texinfo-src-block) - (statistics-cookie . org-texinfo-statistics-cookie) - (subscript . org-texinfo-subscript) - (superscript . org-texinfo-superscript) - (table . org-texinfo-table) - (table-cell . org-texinfo-table-cell) - (table-row . org-texinfo-table-row) - (target . org-texinfo-target) - (template . org-texinfo-template) - (timestamp . org-texinfo-timestamp) - (verbatim . org-texinfo-verbatim) - (verse-block . org-texinfo-verse-block)) - :export-block "TEXINFO" - :filters-alist - '((:filter-headline . org-texinfo-filter-section-blank-lines) - (:filter-section . org-texinfo-filter-section-blank-lines)) - :menu-entry - '(?i "Export to Texinfo" - ((?t "As TEXI file" org-texinfo-export-to-texinfo) - (?i "As INFO file" org-texinfo-export-to-info))) - :options-alist - '((:texinfo-filename "TEXINFO_FILENAME" nil org-texinfo-filename t) - (:texinfo-class "TEXINFO_CLASS" nil org-texinfo-default-class t) - (:texinfo-header "TEXINFO_HEADER" nil nil newline) - (:texinfo-post-header "TEXINFO_POST_HEADER" nil nil newline) - (:subtitle "SUBTITLE" nil nil newline) - (:subauthor "SUBAUTHOR" nil nil newline) - (:texinfo-dircat "TEXINFO_DIR_CATEGORY" nil nil t) - (:texinfo-dirtitle "TEXINFO_DIR_TITLE" nil nil t) - (:texinfo-dirdesc "TEXINFO_DIR_DESC" nil nil t))) - - - -;;; User Configurable Variables - -(defgroup org-export-texinfo nil - "Options for exporting Org mode files to Texinfo." - :tag "Org Export Texinfo" - :version "24.4" - :package-version '(Org . "8.0") - :group 'org-export) - -;;; Preamble - -(defcustom org-texinfo-filename "" - "Default filename for Texinfo output." - :group 'org-export-texinfo - :type '(string :tag "Export Filename")) - -(defcustom org-texinfo-coding-system nil - "Default document encoding for Texinfo output. - -If `nil' it will default to `buffer-file-coding-system'." - :group 'org-export-texinfo - :type 'coding-system) - -(defcustom org-texinfo-default-class "info" - "The default Texinfo class." - :group 'org-export-texinfo - :type '(string :tag "Texinfo class")) - -(defcustom org-texinfo-classes - '(("info" - "\\input texinfo @c -*- texinfo -*-" - ("@chapter %s" . "@unnumbered %s") - ("@section %s" . "@unnumberedsec %s") - ("@subsection %s" . "@unnumberedsubsec %s") - ("@subsubsection %s" . "@unnumberedsubsubsec %s"))) - "Alist of Texinfo classes and associated header and structure. -If #+Texinfo_CLASS is set in the buffer, use its value and the -associated information. Here is the structure of each cell: - - \(class-name - header-string - \(numbered-section . unnumbered-section\) - ...\) - -The sectioning structure ------------------------- - -The sectioning structure of the class is given by the elements -following the header string. For each sectioning level, a number -of strings is specified. A %s formatter is mandatory in each -section string and will be replaced by the title of the section. - -Instead of a list of sectioning commands, you can also specify -a function name. That function will be called with two -parameters, the \(reduced) level of the headline, and a predicate -non-nil when the headline should be numbered. It must return -a format string in which the section title will be added." - :group 'org-export-texinfo - :type '(repeat - (list (string :tag "Texinfo class") - (string :tag "Texinfo header") - (repeat :tag "Levels" :inline t - (choice - (cons :tag "Heading" - (string :tag " numbered") - (string :tag "unnumbered")) - (function :tag "Hook computing sectioning")))))) - -;;; Headline - -(defcustom org-texinfo-format-headline-function 'ignore - "Function to format headline text. - -This function will be called with 5 arguments: -TODO the todo keyword (string or nil). -TODO-TYPE the type of todo (symbol: `todo', `done', nil) -PRIORITY the priority of the headline (integer or nil) -TEXT the main headline text (string). -TAGS the tags as a list of strings (list of strings or nil). - -The function result will be used in the section format string. - -As an example, one could set the variable to the following, in -order to reproduce the default set-up: - -\(defun org-texinfo-format-headline (todo todo-type priority text tags) - \"Default format function for a headline.\" - \(concat (when todo - \(format \"\\\\textbf{\\\\textsc{\\\\textsf{%s}}} \" todo)) - \(when priority - \(format \"\\\\framebox{\\\\#%c} \" priority)) - text - \(when tags - \(format \"\\\\hfill{}\\\\textsc{%s}\" - \(mapconcat 'identity tags \":\"))))" - :group 'org-export-texinfo - :type 'function) - -;;; Node listing (menu) - -(defcustom org-texinfo-node-description-column 32 - "Column at which to start the description in the node - listings. - -If a node title is greater than this length, the description will -be placed after the end of the title." - :group 'org-export-texinfo - :type 'integer) - -;;; Footnotes -;; -;; Footnotes are inserted directly - -;;; Timestamps - -(defcustom org-texinfo-active-timestamp-format "@emph{%s}" - "A printf format string to be applied to active timestamps." - :group 'org-export-texinfo - :type 'string) - -(defcustom org-texinfo-inactive-timestamp-format "@emph{%s}" - "A printf format string to be applied to inactive timestamps." - :group 'org-export-texinfo - :type 'string) - -(defcustom org-texinfo-diary-timestamp-format "@emph{%s}" - "A printf format string to be applied to diary timestamps." - :group 'org-export-texinfo - :type 'string) - -;;; Links - -(defcustom org-texinfo-link-with-unknown-path-format "@indicateurl{%s}" - "Format string for links with unknown path type." - :group 'org-export-texinfo - :type 'string) - -;;; Tables - -(defcustom org-texinfo-tables-verbatim nil - "When non-nil, tables are exported verbatim." - :group 'org-export-texinfo - :type 'boolean) - -(defcustom org-texinfo-table-scientific-notation "%s\\,(%s)" - "Format string to display numbers in scientific notation. -The format should have \"%s\" twice, for mantissa and exponent -\(i.e. \"%s\\\\times10^{%s}\"). - -When nil, no transformation is made." - :group 'org-export-texinfo - :type '(choice - (string :tag "Format string") - (const :tag "No formatting"))) - -(defcustom org-texinfo-def-table-markup "@samp" - "Default setting for @table environments.") - -;;; Text markup - -(defcustom org-texinfo-text-markup-alist '((bold . "@strong{%s}") - (code . code) - (italic . "@emph{%s}") - (verbatim . verb) - (comment . "@c %s")) - "Alist of Texinfo expressions to convert text markup. - -The key must be a symbol among `bold', `italic' and `comment'. -The value is a formatting string to wrap fontified text with. - -Value can also be set to the following symbols: `verb' and -`code'. For the former, Org will use \"@verb\" to -create a format string and select a delimiter character that -isn't in the string. For the latter, Org will use \"@code\" -to typeset and try to protect special characters. - -If no association can be found for a given markup, text will be -returned as-is." - :group 'org-export-texinfo - :type 'alist - :options '(bold code italic verbatim comment)) - -;;; Drawers - -(defcustom org-texinfo-format-drawer-function - (lambda (name contents) contents) - "Function called to format a drawer in Texinfo code. - -The function must accept two parameters: - NAME the drawer name, like \"LOGBOOK\" - CONTENTS the contents of the drawer. - -The function should return the string to be exported. - -The default function simply returns the value of CONTENTS." - :group 'org-export-texinfo - :version "24.4" - :package-version '(Org . "8.3") - :type 'function) - -;;; Inlinetasks - -(defcustom org-texinfo-format-inlinetask-function 'ignore - "Function called to format an inlinetask in Texinfo code. - -The function must accept six parameters: - TODO the todo keyword, as a string - TODO-TYPE the todo type, a symbol among `todo', `done' and nil. - PRIORITY the inlinetask priority, as a string - NAME the inlinetask name, as a string. - TAGS the inlinetask tags, as a list of strings. - CONTENTS the contents of the inlinetask, as a string. - -The function should return the string to be exported. - -For example, the variable could be set to the following function -in order to mimic default behaviour: - -\(defun org-texinfo-format-inlinetask \(todo type priority name tags contents\) -\"Format an inline task element for Texinfo export.\" - \(let ((full-title - \(concat - \(when todo - \(format \"@strong{%s} \" todo)) - \(when priority (format \"#%c \" priority)) - title - \(when tags - \(format \":%s:\" - \(mapconcat 'identity tags \":\"))))) - \(format (concat \"@center %s\n\n\" - \"%s\" - \"\n\")) - full-title contents))" - :group 'org-export-texinfo - :type 'function) - -;;; Src blocks -;; -;; Src Blocks are example blocks, except for LISP - -;;; Compilation - -(defcustom org-texinfo-info-process - '("makeinfo %f") - "Commands to process a Texinfo file to an INFO file. -This is list of strings, each of them will be given to the shell -as a command. %f in the command will be replaced by the full -file name, %b by the file base name \(i.e without extension) and -%o by the base directory of the file." - :group 'org-export-texinfo - :type '(repeat :tag "Shell command sequence" - (string :tag "Shell command"))) - -(defcustom org-texinfo-logfiles-extensions - '("aux" "toc" "cp" "fn" "ky" "pg" "tp" "vr") - "The list of file extensions to consider as Texinfo logfiles. -The logfiles will be remove if `org-texinfo-remove-logfiles' is -non-nil." - :group 'org-export-texinfo - :type '(repeat (string :tag "Extension"))) - -(defcustom org-texinfo-remove-logfiles t - "Non-nil means remove the logfiles produced by compiling a Texinfo file. -By default, logfiles are files with these extensions: .aux, .toc, -.cp, .fn, .ky, .pg and .tp. To define the set of logfiles to remove, -set `org-texinfo-logfiles-extensions'." - :group 'org-export-latex - :type 'boolean) - - -;;; Constants -(defconst org-texinfo-max-toc-depth 4 - "Maximum depth for creation of detailed menu listings. Beyond - this depth Texinfo will not recognize the nodes and will cause - errors. Left as a constant in case this value ever changes.") - -(defconst org-texinfo-supported-coding-systems - '("US-ASCII" "UTF-8" "ISO-8859-15" "ISO-8859-1" "ISO-8859-2" "koi8-r" "koi8-u") - "List of coding systems supported by Texinfo, as strings. -Specified coding system will be matched against these strings. -If two strings share the same prefix (e.g. \"ISO-8859-1\" and -\"ISO-8859-15\"), the most specific one has to be listed first.") - - -;;; Internal Functions - -(defun org-texinfo-filter-section-blank-lines (headline back-end info) - "Filter controlling number of blank lines after a section." - (let ((blanks (make-string 2 ?\n))) - (replace-regexp-in-string "\n\\(?:\n[ \t]*\\)*\\'" blanks headline))) - -(defun org-texinfo--find-verb-separator (s) - "Return a character not used in string S. -This is used to choose a separator for constructs like \\verb." - (let ((ll "~,./?;':\"|!@#%^&-_=+abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ<>()[]{}")) - (loop for c across ll - when (not (string-match (regexp-quote (char-to-string c)) s)) - return (char-to-string c)))) - -(defun org-texinfo--make-option-string (options) - "Return a comma separated string of keywords and values. -OPTIONS is an alist where the key is the options keyword as -a string, and the value a list containing the keyword value, or -nil." - (mapconcat (lambda (pair) - (concat (first pair) - (when (> (length (second pair)) 0) - (concat "=" (second pair))))) - options - ",")) - -(defun org-texinfo--text-markup (text markup) - "Format TEXT depending on MARKUP text markup. -See `org-texinfo-text-markup-alist' for details." - (let ((fmt (cdr (assq markup org-texinfo-text-markup-alist)))) - (cond - ;; No format string: Return raw text. - ((not fmt) text) - ((eq 'verb fmt) - (let ((separator (org-texinfo--find-verb-separator text))) - (concat "@verb{" separator text separator "}"))) - ((eq 'code fmt) - (let ((start 0) - (rtn "") - char) - (while (string-match "[@{}]" text) - (setq char (match-string 0 text)) - (if (> (match-beginning 0) 0) - (setq rtn (concat rtn (substring text 0 (match-beginning 0))))) - (setq text (substring text (1+ (match-beginning 0)))) - (setq char (concat "@" char) - rtn (concat rtn char))) - (setq text (concat rtn text) - fmt "@code{%s}") - (format fmt text))) - ;; Else use format string. - (t (format fmt text))))) - -(defun org-texinfo--get-node (headline info) - "Return node entry associated to HEADLINE. -INFO is a plist used as a communication channel." - (let ((menu-title (org-export-get-alt-title headline info))) - (org-texinfo--sanitize-menu - (replace-regexp-in-string - "%" "%%" - (if menu-title (org-export-data menu-title info) - (org-texinfo--sanitize-headline - (org-element-property :title headline) info)))))) - -;;; Headline sanitizing - -(defun org-texinfo--sanitize-headline (headline info) - "Remove all formatting from the text of a headline for use in - node and menu listing." - (mapconcat 'identity - (org-texinfo--sanitize-headline-contents headline info) " ")) - -(defun org-texinfo--sanitize-headline-contents (headline info) - "Retrieve the content of the headline. - -Any content that can contain further formatting is checked -recursively, to ensure that nested content is also properly -retrieved." - (loop for contents in headline append - (cond - ;; already a string - ((stringp contents) - (list (replace-regexp-in-string " $" "" contents))) - ;; Is exported as-is (value) - ((org-element-map contents '(verbatim code) - (lambda (value) (org-element-property :value value)) info)) - ;; Has content and recurse into the content - ((org-element-contents contents) - (org-texinfo--sanitize-headline-contents - (org-element-contents contents) info))))) - -;;; Menu sanitizing - -(defun org-texinfo--sanitize-menu (title) - "Remove invalid characters from TITLE for use in menus and -nodes. - -Based on Texinfo specifications, the following must be removed: -@ { } ( ) : . ," - (replace-regexp-in-string "[@{}():,.]" "" title)) - -;;; Content sanitizing - -(defun org-texinfo--sanitize-content (text) - "Ensure characters are properly escaped when used in headlines or blocks. - -Escape characters are: @ { }" - (replace-regexp-in-string "\\\([@{}]\\\)" "@\\1" text)) - -;;; Menu creation - -(defun org-texinfo--build-menu (tree level info &optional detailed) - "Create the @menu/@end menu information from TREE at headline -level LEVEL. - -TREE contains the parse-tree to work with, either of the entire -document or of a specific parent headline. LEVEL indicates what -level of headlines to look at when generating the menu. INFO is -a plist containing contextual information. - -Detailed determines whether to build a single level of menu, or -recurse into all children as well." - (let ((menu (org-texinfo--generate-menu-list tree level info)) - output text-menu) - (cond - (detailed - ;; Looping is done within the menu generation. - (setq text-menu (org-texinfo--generate-detailed menu level info))) - (t - (setq text-menu (org-texinfo--generate-menu-items menu info)))) - (when text-menu - (setq output (org-texinfo--format-menu text-menu)) - (mapconcat 'identity output "\n")))) - -(defun org-texinfo--generate-detailed (menu level info) - "Generate a detailed listing of all subheadings within MENU starting at LEVEL. - -MENU is the parse-tree to work with. LEVEL is the starting level -for the menu headlines and from which recursion occurs. INFO is -a plist containing contextual information." - (when level - (let ((max-depth (min org-texinfo-max-toc-depth - (plist-get info :headline-levels)))) - (when (> max-depth level) - (loop for headline in menu append - (let* ((title (org-texinfo--menu-headlines headline info)) - ;; Create list of menu entries for the next level - (sublist (org-texinfo--generate-menu-list - headline (1+ level) info)) - ;; Generate the menu items for that level. If - ;; there are none omit that heading completely, - ;; otherwise join the title to it's related entries. - (submenu (if (org-texinfo--generate-menu-items sublist info) - (append (list title) - (org-texinfo--generate-menu-items sublist info)) - 'nil)) - ;; Start the process over the next level down. - (recursion (org-texinfo--generate-detailed sublist (1+ level) info))) - (setq recursion (append submenu recursion)) - recursion)))))) - -(defun org-texinfo--generate-menu-list (tree level info) - "Generate the list of headlines that are within a given level -of the tree for further formatting. - -TREE is the parse-tree containing the headlines. LEVEL is the -headline level to generate a list of. INFO is a plist holding -contextual information." - (org-element-map tree 'headline - (lambda (head) - (and (= (org-export-get-relative-level head info) level) - ;; Do not take note of footnotes or copying headlines. - (not (org-element-property :COPYING head)) - (not (org-element-property :footnote-section-p head)) - ;; Collect headline. - head)) - info)) - -(defun org-texinfo--generate-menu-items (items info) - "Generate a list of headline information from the listing ITEMS. - -ITEMS is a list of the headlines to be converted into entries. -INFO is a plist containing contextual information. - -Returns a list containing the following information from each -headline: length, title, description. This is used to format the -menu using `org-texinfo--format-menu'." - (loop for headline in items collect - (let* ((menu-title (org-texinfo--sanitize-menu - (org-export-data - (org-export-get-alt-title headline info) - info))) - (title (org-texinfo--sanitize-menu - (org-texinfo--sanitize-headline - (org-element-property :title headline) info))) - (descr (org-export-data - (org-element-property :DESCRIPTION headline) - info)) - (menu-entry (if (string= "" menu-title) title menu-title)) - (len (length menu-entry)) - (output (list len menu-entry descr))) - output))) - -(defun org-texinfo--menu-headlines (headline info) - "Retrieve the title from HEADLINE. - -INFO is a plist holding contextual information. - -Return the headline as a list of (length title description) with -length of -1 and nil description. This is used in -`org-texinfo--format-menu' to identify headlines as opposed to -entries." - (let ((title (org-export-data - (org-element-property :title headline) info))) - (list -1 title 'nil))) - -(defun org-texinfo--format-menu (text-menu) - "Format the TEXT-MENU items to be properly printed in the menu. - -Each entry in the menu should be provided as (length title -description). - -Headlines in the detailed menu are given length -1 to ensure they -are never confused with other entries. They also have no -description. - -Other menu items are output as: - Title:: description - -With the spacing between :: and description based on the length -of the longest menu entry." - - (let (output) - (setq output - (mapcar (lambda (name) - (let* ((title (nth 1 name)) - (desc (nth 2 name)) - (length (nth 0 name)) - (column (max - ;;6 is "* " ":: " for inserted text - length - (- - org-texinfo-node-description-column - 6))) - (spacing (- column length) - )) - (if (> length -1) - (concat "* " title ":: " - (make-string spacing ?\s) - (if desc - (concat desc))) - (concat "\n" title "\n")))) - text-menu)) - output)) - -;;; Template - -(defun org-texinfo-template (contents info) - "Return complete document string after Texinfo conversion. -CONTENTS is the transcoded contents string. INFO is a plist -holding export options." - (let* ((title (org-export-data (plist-get info :title) info)) - (info-filename (or (plist-get info :texinfo-filename) - (file-name-nondirectory - (org-export-output-file-name ".info")))) - (author (org-export-data (plist-get info :author) info)) - (lang (org-export-data (plist-get info :language) info)) - (texinfo-header (plist-get info :texinfo-header)) - (texinfo-post-header (plist-get info :texinfo-post-header)) - (subtitle (plist-get info :subtitle)) - (subauthor (plist-get info :subauthor)) - (class (plist-get info :texinfo-class)) - (header (nth 1 (assoc class org-texinfo-classes))) - (copying - (org-element-map (plist-get info :parse-tree) 'headline - (lambda (hl) (and (org-element-property :COPYING hl) hl)) info t)) - (dircat (plist-get info :texinfo-dircat)) - (dirtitle (plist-get info :texinfo-dirtitle)) - (dirdesc (plist-get info :texinfo-dirdesc)) - ;; Spacing to align description (column 32 - 3 for `* ' and - ;; `.' in text. - (dirspacing (- 29 (length dirtitle))) - (menu (org-texinfo-make-menu info 'main)) - (detail-menu (org-texinfo-make-menu info 'detailed))) - (concat - ;; Header - header "\n" - "@c %**start of header\n" - ;; Filename and Title - "@setfilename " info-filename "\n" - "@settitle " title "\n" - ;; Coding system. - (format - "@documentencoding %s\n" - (catch 'coding-system - (let ((case-fold-search t) - (name (symbol-name (or org-texinfo-coding-system - buffer-file-coding-system)))) - (dolist (system org-texinfo-supported-coding-systems "UTF-8") - (when (org-string-match-p (regexp-quote system) name) - (throw 'coding-system system)))))) - "\n" - (format "@documentlanguage %s\n" lang) - "\n\n" - "@c Version and Contact Info\n" - "@set AUTHOR " author "\n" - - ;; Additional Header Options set by `#+TEXINFO_HEADER - (if texinfo-header - (concat "\n" - texinfo-header - "\n")) - - "@c %**end of header\n" - "@finalout\n" - "\n\n" - - ;; Additional Header Options set by #+TEXINFO_POST_HEADER - (if texinfo-post-header - (concat "\n" - texinfo-post-header - "\n")) - - ;; Copying - "@copying\n" - ;; Only export the content of the headline, do not need the - ;; initial headline. - (org-export-data (nth 2 copying) info) - "@end copying\n" - "\n\n" - - ;; Info directory information - ;; Only supply if both title and category are provided - (if (and dircat dirtitle) - (concat "@dircategory " dircat "\n" - "@direntry\n" - "* " dirtitle "." - (make-string dirspacing ?\s) - dirdesc "\n" - "@end direntry\n")) - "\n\n" - - ;; Title - "@titlepage\n" - "@title " title "\n\n" - (if subtitle - (concat "@subtitle " subtitle "\n")) - "@author " author "\n" - (if subauthor - (concat subauthor "\n")) - "\n" - "@c The following two commands start the copyright page.\n" - "@page\n" - "@vskip 0pt plus 1filll\n" - "@insertcopying\n" - "@end titlepage\n\n" - "@c Output the table of contents at the beginning.\n" - "@contents\n\n" - - ;; Configure Top Node when not for Tex - "@ifnottex\n" - "@node Top\n" - "@top " title " Manual\n" - "@insertcopying\n" - "@end ifnottex\n\n" - - ;; Do not output menus if they are empty - (if menu - ;; Menu - (concat "@menu\n" - menu - "\n\n" - ;; Detailed Menu - (if detail-menu - (concat "@detailmenu\n" - " --- The Detailed Node Listing ---\n" - detail-menu - "\n\n" - "@end detailmenu\n")) - "@end menu\n")) - "\n\n" - - ;; Document's body. - contents - "\n" - ;; Creator. - (let ((creator-info (plist-get info :with-creator))) - (cond - ((not creator-info) "") - ((eq creator-info 'comment) - (format "@c %s\n" (plist-get info :creator))) - (t (concat (plist-get info :creator) "\n")))) - ;; Document end. - "\n@bye"))) - - - -;;; Transcode Functions - -;;; Bold - -(defun org-texinfo-bold (bold contents info) - "Transcode BOLD from Org to Texinfo. -CONTENTS is the text with bold markup. INFO is a plist holding -contextual information." - (org-texinfo--text-markup contents 'bold)) - -;;; Center Block - -(defun org-texinfo-center-block (center-block contents info) - "Transcode a CENTER-BLOCK element from Org to Texinfo. -CONTENTS holds the contents of the block. INFO is a plist used -as a communication channel." - contents) - -;;; Clock - -(defun org-texinfo-clock (clock contents info) - "Transcode a CLOCK element from Org to Texinfo. -CONTENTS is nil. INFO is a plist holding contextual -information." - (concat - "@noindent" - (format "@strong{%s} " org-clock-string) - (format org-texinfo-inactive-timestamp-format - (concat (org-translate-time - (org-element-property :raw-value - (org-element-property :value clock))) - (let ((time (org-element-property :duration clock))) - (and time (format " (%s)" time))))) - "@*")) - -;;; Code - -(defun org-texinfo-code (code contents info) - "Transcode a CODE object from Org to Texinfo. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (org-texinfo--text-markup (org-element-property :value code) 'code)) - -;;; Comment - -(defun org-texinfo-comment (comment contents info) - "Transcode a COMMENT object from Org to Texinfo. -CONTENTS is the text in the comment. INFO is a plist holding -contextual information." - (org-texinfo--text-markup (org-element-property :value comment) 'comment)) - -;;; Comment Block - -(defun org-texinfo-comment-block (comment-block contents info) - "Transcode a COMMENT-BLOCK object from Org to Texinfo. -CONTENTS is the text within the block. INFO is a plist holding -contextual information." - (format "@ignore\n%s@end ignore" (org-element-property :value comment-block))) - -;;; Drawer - -(defun org-texinfo-drawer (drawer contents info) - "Transcode a DRAWER element from Org to Texinfo. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let* ((name (org-element-property :drawer-name drawer)) - (output (funcall org-texinfo-format-drawer-function - name contents))) - output)) - -;;; Dynamic Block - -(defun org-texinfo-dynamic-block (dynamic-block contents info) - "Transcode a DYNAMIC-BLOCK element from Org to Texinfo. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information. See `org-export-data'." - contents) - -;;; Entity - -(defun org-texinfo-entity (entity contents info) - "Transcode an ENTITY object from Org to Texinfo. -CONTENTS are the definition itself. INFO is a plist holding -contextual information." - (let ((ent (org-element-property :latex entity))) - (if (org-element-property :latex-math-p entity) (format "@math{%s}" ent) ent))) - -;;; Example Block - -(defun org-texinfo-example-block (example-block contents info) - "Transcode an EXAMPLE-BLOCK element from Org to Texinfo. -CONTENTS is nil. INFO is a plist holding contextual -information." - (format "@verbatim\n%s@end verbatim" - (org-export-format-code-default example-block info))) - -;;; Export Block - -(defun org-texinfo-export-block (export-block contents info) - "Transcode a EXPORT-BLOCK element from Org to Texinfo. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (string= (org-element-property :type export-block) "TEXINFO") - (org-remove-indentation (org-element-property :value export-block)))) - -;;; Export Snippet - -(defun org-texinfo-export-snippet (export-snippet contents info) - "Transcode a EXPORT-SNIPPET object from Org to Texinfo. -CONTENTS is nil. INFO is a plist holding contextual information." - (when (eq (org-export-snippet-backend export-snippet) 'texinfo) - (org-element-property :value export-snippet))) - -;;; Fixed Width - -(defun org-texinfo-fixed-width (fixed-width contents info) - "Transcode a FIXED-WIDTH element from Org to Texinfo. -CONTENTS is nil. INFO is a plist holding contextual information." - (format "@example\n%s\n@end example" - (org-remove-indentation - (org-texinfo--sanitize-content - (org-element-property :value fixed-width))))) - -;;; Footnote Reference -;; - -(defun org-texinfo-footnote-reference (footnote contents info) - "Create a footnote reference for FOOTNOTE. - -FOOTNOTE is the footnote to define. CONTENTS is nil. INFO is a -plist holding contextual information." - (let ((def (org-export-get-footnote-definition footnote info))) - (format "@footnote{%s}" - (org-trim (org-export-data def info))))) - -;;; Headline - -(defun org-texinfo-headline (headline contents info) - "Transcode a HEADLINE element from Org to Texinfo. -CONTENTS holds the contents of the headline. INFO is a plist -holding contextual information." - (let* ((class (plist-get info :texinfo-class)) - (level (org-export-get-relative-level headline info)) - (numberedp (org-export-numbered-headline-p headline info)) - (class-sectionning (assoc class org-texinfo-classes)) - ;; Find the index type, if any - (index (org-element-property :INDEX headline)) - ;; Check if it is an appendix - (appendix (org-element-property :APPENDIX headline)) - ;; Retrieve headline text - (text (org-texinfo--sanitize-headline - (org-element-property :title headline) info)) - ;; Create node info, to insert it before section formatting. - ;; Use custom menu title if present - (node (format "@node %s\n" (org-texinfo--get-node headline info))) - ;; Menus must be generated with first child, otherwise they - ;; will not nest properly - (menu (let* ((first (org-export-first-sibling-p headline info)) - (parent (org-export-get-parent-headline headline)) - (title (org-texinfo--sanitize-headline - (org-element-property :title parent) info)) - heading listing - (tree (plist-get info :parse-tree))) - (if first - (org-element-map (plist-get info :parse-tree) 'headline - (lambda (ref) - (if (member title (org-element-property :title ref)) - (push ref heading))) - info t)) - (setq listing (org-texinfo--build-menu - (car heading) level info)) - (if listing - (setq listing (replace-regexp-in-string - "%" "%%" listing) - listing (format - "\n@menu\n%s\n@end menu\n\n" listing)) - 'nil))) - ;; Section formatting will set two placeholders: one for the - ;; title and the other for the contents. - (section-fmt - (let ((sec (if (and (symbolp (nth 2 class-sectionning)) - (fboundp (nth 2 class-sectionning))) - (funcall (nth 2 class-sectionning) level numberedp) - (nth (1+ level) class-sectionning)))) - (cond - ;; No section available for that LEVEL. - ((not sec) nil) - ;; Section format directly returned by a function. - ((stringp sec) sec) - ;; (numbered-section . unnumbered-section) - ((not (consp (cdr sec))) - (cond - ;;If an index, always unnumbered - (index - (concat menu node (cdr sec) "\n%s")) - (appendix - (concat menu node (replace-regexp-in-string - "unnumbered" - "appendix" - (cdr sec)) "\n%s")) - ;; Otherwise number as needed. - (t - (concat menu node - (funcall - (if numberedp #'car #'cdr) sec) "\n%s"))))))) - (todo - (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword headline))) - (and todo (org-export-data todo info))))) - (todo-type (and todo (org-element-property :todo-type headline))) - (tags (and (plist-get info :with-tags) - (org-export-get-tags headline info))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority headline))) - ;; Create the headline text along with a no-tag version. The - ;; latter is required to remove tags from table of contents. - (full-text (org-texinfo--sanitize-content - (if (not (eq org-texinfo-format-headline-function 'ignore)) - ;; User-defined formatting function. - (funcall org-texinfo-format-headline-function - todo todo-type priority text tags) - ;; Default formatting. - (concat - (when todo - (format "@strong{%s} " todo)) - (when priority (format "@emph{#%s} " priority)) - text - (when tags - (format " :%s:" - (mapconcat 'identity tags ":"))))))) - (full-text-no-tag - (org-texinfo--sanitize-content - (if (not (eq org-texinfo-format-headline-function 'ignore)) - ;; User-defined formatting function. - (funcall org-texinfo-format-headline-function - todo todo-type priority text nil) - ;; Default formatting. - (concat - (when todo (format "@strong{%s} " todo)) - (when priority (format "@emph{#%c} " priority)) - text)))) - (pre-blanks - (make-string (org-element-property :pre-blank headline) 10))) - (cond - ;; Case 1: This is a footnote section: ignore it. - ((org-element-property :footnote-section-p headline) nil) - ;; Case 2: This is the `copying' section: ignore it - ;; This is used elsewhere. - ((org-element-property :COPYING headline) nil) - ;; Case 3: An index. If it matches one of the known indexes, - ;; print it as such following the contents, otherwise - ;; print the contents and leave the index up to the user. - (index - (format - section-fmt full-text - (concat pre-blanks contents "\n" - (if (member index '("cp" "fn" "ky" "pg" "tp" "vr")) - (concat "@printindex " index))))) - ;; Case 4: This is a deep sub-tree: export it as a list item. - ;; Also export as items headlines for which no section - ;; format has been found. - ((or (not section-fmt) (org-export-low-level-p headline info)) - ;; Build the real contents of the sub-tree. - (let ((low-level-body - (concat - ;; If the headline is the first sibling, start a list. - (when (org-export-first-sibling-p headline info) - (format "@%s\n" (if numberedp 'enumerate 'itemize))) - ;; Itemize headline - "@item\n" full-text "\n" pre-blanks contents))) - ;; If headline is not the last sibling simply return - ;; LOW-LEVEL-BODY. Otherwise, also close the list, before any - ;; blank line. - (if (not (org-export-last-sibling-p headline info)) low-level-body - (replace-regexp-in-string - "[ \t\n]*\\'" - (format "\n@end %s" (if numberedp 'enumerate 'itemize)) - low-level-body)))) - ;; Case 5: Standard headline. Export it as a section. - (t - (cond - ((not (and tags (eq (plist-get info :with-tags) 'not-in-toc))) - ;; Regular section. Use specified format string. - (format (replace-regexp-in-string "%]" "%%]" section-fmt) full-text - (concat pre-blanks contents))) - ((string-match "\\`@\\(.*?\\){" section-fmt) - ;; If tags should be removed from table of contents, insert - ;; title without tags as an alternative heading in sectioning - ;; command. - (format (replace-match (concat (match-string 1 section-fmt) "[%s]") - nil nil section-fmt 1) - ;; Replace square brackets with parenthesis since - ;; square brackets are not supported in optional - ;; arguments. - (replace-regexp-in-string - "\\[" "(" - (replace-regexp-in-string - "\\]" ")" - full-text-no-tag)) - full-text - (concat pre-blanks contents))) - (t - ;; Impossible to add an alternative heading. Fallback to - ;; regular sectioning format string. - (format (replace-regexp-in-string "%]" "%%]" section-fmt) full-text - (concat pre-blanks contents)))))))) - -;;; Inline Src Block - -(defun org-texinfo-inline-src-block (inline-src-block contents info) - "Transcode an INLINE-SRC-BLOCK element from Org to Texinfo. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((code (org-element-property :value inline-src-block)) - (separator (org-texinfo--find-verb-separator code))) - (concat "@verb{" separator code separator "}"))) - -;;; Inlinetask - -(defun org-texinfo-inlinetask (inlinetask contents info) - "Transcode an INLINETASK element from Org to Texinfo. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let ((title (org-export-data (org-element-property :title inlinetask) info)) - (todo (and (plist-get info :with-todo-keywords) - (let ((todo (org-element-property :todo-keyword inlinetask))) - (and todo (org-export-data todo info))))) - (todo-type (org-element-property :todo-type inlinetask)) - (tags (and (plist-get info :with-tags) - (org-export-get-tags inlinetask info))) - (priority (and (plist-get info :with-priority) - (org-element-property :priority inlinetask)))) - ;; If `org-texinfo-format-inlinetask-function' is provided, call it - ;; with appropriate arguments. - (if (not (eq org-texinfo-format-inlinetask-function 'ignore)) - (funcall org-texinfo-format-inlinetask-function - todo todo-type priority title tags contents) - ;; Otherwise, use a default template. - (let ((full-title - (concat - (when todo (format "@strong{%s} " todo)) - (when priority (format "#%c " priority)) - title - (when tags (format ":%s:" - (mapconcat 'identity tags ":")))))) - (format (concat "@center %s\n\n" - "%s" - "\n") - full-title contents))))) - -;;; Italic - -(defun org-texinfo-italic (italic contents info) - "Transcode ITALIC from Org to Texinfo. -CONTENTS is the text with italic markup. INFO is a plist holding -contextual information." - (org-texinfo--text-markup contents 'italic)) - -;;; Item - -(defun org-texinfo-item (item contents info) - "Transcode an ITEM element from Org to Texinfo. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((tag (org-element-property :tag item)) - (desc (org-export-data tag info))) - (concat "\n@item " (if tag desc) "\n" - (and contents (org-trim contents)) "\n"))) - -;;; Keyword - -(defun org-texinfo-keyword (keyword contents info) - "Transcode a KEYWORD element from Org to Texinfo. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((key (org-element-property :key keyword)) - (value (org-element-property :value keyword))) - (cond - ((string= key "TEXINFO") value) - ((string= key "CINDEX") (format "@cindex %s" value)) - ((string= key "FINDEX") (format "@findex %s" value)) - ((string= key "KINDEX") (format "@kindex %s" value)) - ((string= key "PINDEX") (format "@pindex %s" value)) - ((string= key "TINDEX") (format "@tindex %s" value)) - ((string= key "VINDEX") (format "@vindex %s" value))))) - -;;; Line Break - -(defun org-texinfo-line-break (line-break contents info) - "Transcode a LINE-BREAK object from Org to Texinfo. -CONTENTS is nil. INFO is a plist holding contextual information." - "@*\n") - -;;; Link - -(defun org-texinfo-link (link desc info) - "Transcode a LINK object from Org to Texinfo. - -DESC is the description part of the link, or the empty string. -INFO is a plist holding contextual information. See -`org-export-data'." - (let* ((type (org-element-property :type link)) - (raw-path (org-element-property :path link)) - ;; Ensure DESC really exists, or set it to nil. - (desc (and (not (string= desc "")) desc)) - (path (cond - ((member type '("http" "https" "ftp")) - (concat type ":" raw-path)) - ((string= type "file") - (if (file-name-absolute-p raw-path) - (concat "file://" (expand-file-name raw-path)) - (concat "file://" raw-path))) - (t raw-path))) - (email (if (string= type "mailto") - (let ((text (replace-regexp-in-string - "@" "@@" raw-path))) - (concat text (if desc (concat "," desc)))))) - protocol) - (cond - ;; Links pointing to a headline: Find destination and build - ;; appropriate referencing command. - ((member type '("custom-id" "id")) - (let ((destination (org-export-resolve-id-link link info))) - (case (org-element-type destination) - ;; Id link points to an external file. - (plain-text - (if desc (format "@uref{file://%s,%s}" destination desc) - (format "@uref{file://%s}" destination))) - ;; LINK points to a headline. Use the headline as the NODE target - (headline - (format "@ref{%s,%s}" - (org-texinfo--get-node destination info) - (or desc ""))) - (otherwise - (let ((path (org-export-solidify-link-text path))) - (if (not desc) (format "@ref{%s}" path) - (format "@ref{%s,,%s}" path desc))))))) - ((member type '("info")) - (let* ((info-path (split-string path "[:#]")) - (info-manual (car info-path)) - (info-node (or (cadr info-path) "top")) - (title (or desc ""))) - (format "@ref{%s,%s,,%s,}" info-node title info-manual))) - ((member type '("fuzzy")) - (let ((destination (org-export-resolve-fuzzy-link link info))) - (case (org-element-type destination) - ;; Id link points to an external file. - (plain-text - (if desc (format "@uref{file://%s,%s}" destination desc) - (format "@uref{file://%s}" destination))) - ;; LINK points to a headline. Use the headline as the NODE target - (headline - (format "@ref{%s,%s}" - (org-texinfo--get-node destination info) - (or desc ""))) - (otherwise - (let ((path (org-export-solidify-link-text path))) - (if (not desc) (format "@ref{%s}" path) - (format "@ref{%s,,%s}" path desc))))))) - ;; Special case for email addresses - (email - (format "@email{%s}" email)) - ;; External link with a description part. - ((and path desc) (format "@uref{%s,%s}" path desc)) - ;; External link without a description part. - (path (format "@uref{%s}" path)) - ;; No path, only description. Try to do something useful. - (t (format org-texinfo-link-with-unknown-path-format desc))))) - - -;;; Menu - -(defun org-texinfo-make-menu (info level) - "Create the menu for inclusion in the texifo document. - -INFO is the parsed buffer that contains the headlines. LEVEL -determines whether to make the main menu, or the detailed menu. - -This is only used for generating the primary menu. In-Node menus -are generated directly." - (let ((parse (plist-get info :parse-tree))) - (cond - ;; Generate the main menu - ((eq level 'main) (org-texinfo--build-menu parse 1 info)) - ;; Generate the detailed (recursive) menu - ((eq level 'detailed) - ;; Requires recursion - ;;(org-texinfo--build-detailed-menu parse top info) - (org-texinfo--build-menu parse 1 info 'detailed))))) - -;;; Paragraph - -(defun org-texinfo-paragraph (paragraph contents info) - "Transcode a PARAGRAPH element from Org to Texinfo. -CONTENTS is the contents of the paragraph, as a string. INFO is -the plist used as a communication channel." - contents) - -;;; Plain List - -(defun org-texinfo-plain-list (plain-list contents info) - "Transcode a PLAIN-LIST element from Org to Texinfo. -CONTENTS is the contents of the list. INFO is a plist holding -contextual information." - (let* ((attr (org-export-read-attribute :attr_texinfo plain-list)) - (indic (or (plist-get attr :indic) - org-texinfo-def-table-markup)) - (type (org-element-property :type plain-list)) - (table-type (plist-get attr :table-type)) - ;; Ensure valid texinfo table type. - (table-type (if (member table-type '("ftable" "vtable")) table-type - "table")) - (list-type (cond - ((eq type 'ordered) "enumerate") - ((eq type 'unordered) "itemize") - ((eq type 'descriptive) table-type)))) - (format "@%s%s\n@end %s" - (if (eq type 'descriptive) - (concat list-type " " indic) - list-type) - contents - list-type))) - -;;; Plain Text - -(defun org-texinfo-plain-text (text info) - "Transcode a TEXT string from Org to Texinfo. -TEXT is the string to transcode. INFO is a plist holding -contextual information." - ;; First protect @, { and }. - (let ((output (org-texinfo--sanitize-content text))) - ;; Activate smart quotes. Be sure to provide original TEXT string - ;; since OUTPUT may have been modified. - (when (plist-get info :with-smart-quotes) - (setq output - (org-export-activate-smart-quotes output :texinfo info text))) - ;; LaTeX into @LaTeX{} and TeX into @TeX{} - (let ((case-fold-search nil) - (start 0)) - (while (string-match "\\(\\(?:La\\)?TeX\\)" output start) - (setq output (replace-match - (format "@%s{}" (match-string 1 output)) nil t output) - start (match-end 0)))) - ;; Convert special strings. - (when (plist-get info :with-special-strings) - (while (string-match (regexp-quote "...") output) - (setq output (replace-match "@dots{}" nil t output)))) - ;; Handle break preservation if required. - (when (plist-get info :preserve-breaks) - (setq output (replace-regexp-in-string - "\\(\\\\\\\\\\)?[ \t]*\n" " @*\n" output))) - ;; Return value. - output)) - -;;; Planning - -(defun org-texinfo-planning (planning contents info) - "Transcode a PLANNING element from Org to Texinfo. -CONTENTS is nil. INFO is a plist holding contextual -information." - (concat - "@noindent" - (mapconcat - 'identity - (delq nil - (list - (let ((closed (org-element-property :closed planning))) - (when closed - (concat - (format "@strong{%s} " org-closed-string) - (format org-texinfo-inactive-timestamp-format - (org-translate-time - (org-element-property :raw-value closed)))))) - (let ((deadline (org-element-property :deadline planning))) - (when deadline - (concat - (format "@strong{%s} " org-deadline-string) - (format org-texinfo-active-timestamp-format - (org-translate-time - (org-element-property :raw-value deadline)))))) - (let ((scheduled (org-element-property :scheduled planning))) - (when scheduled - (concat - (format "@strong{%s} " org-scheduled-string) - (format org-texinfo-active-timestamp-format - (org-translate-time - (org-element-property :raw-value scheduled)))))))) - " ") - "@*")) - -;;; Property Drawer - -(defun org-texinfo-property-drawer (property-drawer contents info) - "Transcode a PROPERTY-DRAWER element from Org to Texinfo. -CONTENTS is nil. INFO is a plist holding contextual -information." - ;; The property drawer isn't exported but we want separating blank - ;; lines nonetheless. - "") - -;;; Quote Block - -(defun org-texinfo-quote-block (quote-block contents info) - "Transcode a QUOTE-BLOCK element from Org to Texinfo. -CONTENTS holds the contents of the block. INFO is a plist -holding contextual information." - (let* ((title (org-element-property :name quote-block)) - (start-quote (concat "@quotation" - (if title - (format " %s" title))))) - (format "%s\n%s@end quotation" start-quote contents))) - -;;; Quote Section - -(defun org-texinfo-quote-section (quote-section contents info) - "Transcode a QUOTE-SECTION element from Org to Texinfo. -CONTENTS is nil. INFO is a plist holding contextual information." - (let ((value (org-remove-indentation - (org-element-property :value quote-section)))) - (when value (format "@verbatim\n%s@end verbatim" value)))) - -;;; Radio Target - -(defun org-texinfo-radio-target (radio-target text info) - "Transcode a RADIO-TARGET object from Org to Texinfo. -TEXT is the text of the target. INFO is a plist holding -contextual information." - (format "@anchor{%s}%s" - (org-export-solidify-link-text - (org-element-property :value radio-target)) - text)) - -;;; Section - -(defun org-texinfo-section (section contents info) - "Transcode a SECTION element from Org to Texinfo. -CONTENTS holds the contents of the section. INFO is a plist -holding contextual information." - contents) - -;;; Special Block - -(defun org-texinfo-special-block (special-block contents info) - "Transcode a SPECIAL-BLOCK element from Org to Texinfo. -CONTENTS holds the contents of the block. INFO is a plist used -as a communication channel." - contents) - -;;; Src Block - -(defun org-texinfo-src-block (src-block contents info) - "Transcode a SRC-BLOCK element from Org to Texinfo. -CONTENTS holds the contents of the item. INFO is a plist holding -contextual information." - (let* ((lang (org-element-property :language src-block)) - (lisp-p (string-match-p "lisp" lang)) - (src-contents (org-texinfo--sanitize-content - (org-export-format-code-default src-block info)))) - (cond - ;; Case 1. Lisp Block - (lisp-p - (format "@lisp\n%s@end lisp" - src-contents)) - ;; Case 2. Other blocks - (t - (format "@example\n%s@end example" - src-contents))))) - -;;; Statistics Cookie - -(defun org-texinfo-statistics-cookie (statistics-cookie contents info) - "Transcode a STATISTICS-COOKIE object from Org to Texinfo. -CONTENTS is nil. INFO is a plist holding contextual information." - (org-element-property :value statistics-cookie)) - -;;; Subscript - -(defun org-texinfo-subscript (subscript contents info) - "Transcode a SUBSCRIPT object from Org to Texinfo. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (format "@math{_%s}" contents)) - -;;; Superscript - -(defun org-texinfo-superscript (superscript contents info) - "Transcode a SUPERSCRIPT object from Org to Texinfo. -CONTENTS is the contents of the object. INFO is a plist holding -contextual information." - (format "@math{^%s}" contents)) - -;;; Table -;; -;; `org-texinfo-table' is the entry point for table transcoding. It -;; takes care of tables with a "verbatim" attribute. Otherwise, it -;; delegates the job to either `org-texinfo-table--table.el-table' or -;; `org-texinfo-table--org-table' functions, depending of the type of -;; the table. -;; -;; `org-texinfo-table--align-string' is a subroutine used to build -;; alignment string for Org tables. - -(defun org-texinfo-table (table contents info) - "Transcode a TABLE element from Org to Texinfo. -CONTENTS is the contents of the table. INFO is a plist holding -contextual information." - (cond - ;; Case 1: verbatim table. - ((or org-texinfo-tables-verbatim - (let ((attr (mapconcat 'identity - (org-element-property :attr_latex table) - " "))) - (and attr (string-match "\\" attr)))) - (format "@verbatim \n%s\n@end verbatim" - ;; Re-create table, without affiliated keywords. - (org-trim - (org-element-interpret-data - `(table nil ,@(org-element-contents table)))))) - ;; Case 2: table.el table. Convert it using appropriate tools. - ((eq (org-element-property :type table) 'table.el) - (org-texinfo-table--table.el-table table contents info)) - ;; Case 3: Standard table. - (t (org-texinfo-table--org-table table contents info)))) - -(defun org-texinfo-table-column-widths (table info) - "Determine the largest table cell in each column to process alignment. - -TABLE is the table element to transcode. INFO is a plist used as -a communication channel." - (let* ((rows (org-element-map table 'table-row 'identity info)) - (collected (loop for row in rows collect - (org-element-map row 'table-cell 'identity info))) - (number-cells (length (car collected))) - cells counts) - (loop for row in collected do - (push (mapcar (lambda (ref) - (let* ((start (org-element-property :contents-begin ref)) - (end (org-element-property :contents-end ref)) - (length (- end start))) - length)) row) cells)) - (setq cells (org-remove-if 'null cells)) - (push (loop for count from 0 to (- number-cells 1) collect - (loop for item in cells collect - (nth count item))) counts) - (mapconcat (lambda (size) - (make-string size ?a)) (mapcar (lambda (ref) - (apply 'max `(,@ref))) (car counts)) - "} {"))) - -(defun org-texinfo-table--org-table (table contents info) - "Return appropriate Texinfo code for an Org table. - -TABLE is the table type element to transcode. CONTENTS is its -contents, as a string. INFO is a plist used as a communication -channel. - -This function assumes TABLE has `org' as its `:type' attribute." - (let* ((attr (org-export-read-attribute :attr_texinfo table)) - (col-width (plist-get attr :columns)) - (columns (if col-width - (format "@columnfractions %s" - col-width) - (format "{%s}" - (org-texinfo-table-column-widths - table info))))) - ;; Prepare the final format string for the table. - (cond - ;; Longtable. - ;; Others. - (t (concat - (format "@multitable %s\n%s@end multitable" - columns - contents)))))) - -(defun org-texinfo-table--table.el-table (table contents info) - "Returns nothing. - -Rather than return an invalid table, nothing is returned." - 'nil) - -;;; Table Cell - -(defun org-texinfo-table-cell (table-cell contents info) - "Transcode a TABLE-CELL element from Org to Texinfo. -CONTENTS is the cell contents. INFO is a plist used as -a communication channel." - (concat (if (and contents - org-texinfo-table-scientific-notation - (string-match orgtbl-exp-regexp contents)) - ;; Use appropriate format string for scientific - ;; notation. - (format org-texinfo-table-scientific-notation - (match-string 1 contents) - (match-string 2 contents)) - contents) - (when (org-export-get-next-element table-cell info) "\n@tab "))) - -;;; Table Row - -(defun org-texinfo-table-row (table-row contents info) - "Transcode a TABLE-ROW element from Org to Texinfo. -CONTENTS is the contents of the row. INFO is a plist used as -a communication channel." - ;; Rules are ignored since table separators are deduced from - ;; borders of the current row. - (when (eq (org-element-property :type table-row) 'standard) - (let ((rowgroup-tag - (cond - ;; Case 1: Belongs to second or subsequent rowgroup. - ((not (= 1 (org-export-table-row-group table-row info))) - "@item ") - ;; Case 2: Row is from first rowgroup. Table has >=1 rowgroups. - ((org-export-table-has-header-p - (org-export-get-parent-table table-row) info) - "@headitem ") - ;; Case 3: Row is from first and only row group. - (t "@item ")))) - (when (eq (org-element-property :type table-row) 'standard) - (concat rowgroup-tag contents "\n"))))) - -;;; Target - -(defun org-texinfo-target (target contents info) - "Transcode a TARGET object from Org to Texinfo. -CONTENTS is nil. INFO is a plist holding contextual -information." - (format "@anchor{%s}" - (org-export-solidify-link-text (org-element-property :value target)))) - -;;; Timestamp - -(defun org-texinfo-timestamp (timestamp contents info) - "Transcode a TIMESTAMP object from Org to Texinfo. -CONTENTS is nil. INFO is a plist holding contextual -information." - (let ((value (org-texinfo-plain-text - (org-timestamp-translate timestamp) info))) - (case (org-element-property :type timestamp) - ((active active-range) - (format org-texinfo-active-timestamp-format value)) - ((inactive inactive-range) - (format org-texinfo-inactive-timestamp-format value)) - (t (format org-texinfo-diary-timestamp-format value))))) - -;;; Verbatim - -(defun org-texinfo-verbatim (verbatim contents info) - "Transcode a VERBATIM object from Org to Texinfo. -CONTENTS is nil. INFO is a plist used as a communication -channel." - (org-texinfo--text-markup (org-element-property :value verbatim) 'verbatim)) - -;;; Verse Block - -(defun org-texinfo-verse-block (verse-block contents info) - "Transcode a VERSE-BLOCK element from Org to Texinfo. -CONTENTS is verse block contents. INFO is a plist holding -contextual information." - ;; In a verse environment, add a line break to each newline - ;; character and change each white space at beginning of a line - ;; into a space of 1 em. Also change each blank line with - ;; a vertical space of 1 em. - (progn - (setq contents (replace-regexp-in-string - "^ *\\\\\\\\$" "\\\\vspace*{1em}" - (replace-regexp-in-string - "\\(\\\\\\\\\\)?[ \t]*\n" " \\\\\\\\\n" contents))) - (while (string-match "^[ \t]+" contents) - (let ((new-str (format "\\hspace*{%dem}" - (length (match-string 0 contents))))) - (setq contents (replace-match new-str nil t contents)))) - (format "\\begin{verse}\n%s\\end{verse}" contents))) - - -;;; Interactive functions - -(defun org-texinfo-export-to-texinfo - (&optional async subtreep visible-only body-only ext-plist) - "Export current buffer to a Texinfo file. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -Return output file's name." - (interactive) - (let ((outfile (org-export-output-file-name ".texi" subtreep)) - (org-export-coding-system `,org-texinfo-coding-system)) - (org-export-to-file 'texinfo outfile - async subtreep visible-only body-only ext-plist))) - -(defun org-texinfo-export-to-info - (&optional async subtreep visible-only body-only ext-plist) - "Export current buffer to Texinfo then process through to INFO. - -If narrowing is active in the current buffer, only export its -narrowed part. - -If a region is active, export that region. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting file should be accessible through -the `org-export-stack' interface. - -When optional argument SUBTREEP is non-nil, export the sub-tree -at point, extracting information from the headline properties -first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only write code -between \"\\begin{document}\" and \"\\end{document}\". - -EXT-PLIST, when provided, is a property list with external -parameters overriding Org default settings, but still inferior to -file-local settings. - -When optional argument PUB-DIR is set, use it as the publishing -directory. - -Return INFO file's name." - (interactive) - (let ((outfile (org-export-output-file-name ".texi" subtreep)) - (org-export-coding-system `,org-texinfo-coding-system)) - (org-export-to-file 'texinfo outfile - async subtreep visible-only body-only ext-plist - (lambda (file) (org-texinfo-compile file))))) - -;;;###autoload -(defun org-texinfo-publish-to-texinfo (plist filename pub-dir) - "Publish an org file to Texinfo. - -FILENAME is the filename of the Org file to be published. PLIST -is the property list for the given project. PUB-DIR is the -publishing directory. - -Return output file name." - (org-publish-org-to 'texinfo filename ".texi" plist pub-dir)) - -;;;###autoload -(defun org-texinfo-convert-region-to-texinfo () - "Assume the current region has org-mode syntax, and convert it to Texinfo. -This can be used in any buffer. For example, you can write an -itemized list in org-mode syntax in an Texinfo buffer and use -this command to convert it." - (interactive) - (org-export-replace-region-by 'texinfo)) - -(defun org-texinfo-compile (file) - "Compile a texinfo file. - -FILE is the name of the file being compiled. Processing is -done through the command specified in `org-texinfo-info-process'. - -Return INFO file name or an error if it couldn't be produced." - (let* ((base-name (file-name-sans-extension (file-name-nondirectory file))) - (full-name (file-truename file)) - (out-dir (file-name-directory file)) - ;; Properly set working directory for compilation. - (default-directory (if (file-name-absolute-p file) - (file-name-directory full-name) - default-directory)) - errors) - (message (format "Processing Texinfo file %s..." file)) - (save-window-excursion - (cond - ;; A function is provided: Apply it. - ((functionp org-texinfo-info-process) - (funcall org-texinfo-info-process (shell-quote-argument file))) - ;; A list is provided: Replace %b, %f and %o with appropriate - ;; values in each command before applying it. Output is - ;; redirected to "*Org INFO Texinfo Output*" buffer. - ((consp org-texinfo-info-process) - (let ((outbuf (get-buffer-create "*Org INFO Texinfo Output*"))) - (mapc - (lambda (command) - (shell-command - (replace-regexp-in-string - "%b" (shell-quote-argument base-name) - (replace-regexp-in-string - "%f" (shell-quote-argument full-name) - (replace-regexp-in-string - "%o" (shell-quote-argument out-dir) command t t) t t) t t) - outbuf)) - org-texinfo-info-process) - ;; Collect standard errors from output buffer. - (setq errors (org-texinfo-collect-errors outbuf)))) - (t (error "No valid command to process to Info"))) - (let ((infofile (concat out-dir base-name ".info"))) - ;; Check for process failure. Provide collected errors if - ;; possible. - (if (not (file-exists-p infofile)) - (error (concat (format "INFO file %s wasn't produced" infofile) - (when errors (concat ": " errors)))) - ;; Else remove log files, when specified, and signal end of - ;; process to user, along with any error encountered. - (when org-texinfo-remove-logfiles - (dolist (ext org-texinfo-logfiles-extensions) - (let ((file (concat out-dir base-name "." ext))) - (when (file-exists-p file) (delete-file file))))) - (message (concat "Process completed" - (if (not errors) "." - (concat " with errors: " errors))))) - ;; Return output file name. - infofile)))) - -(defun org-texinfo-collect-errors (buffer) - "Collect some kind of errors from \"makeinfo\" command output. - -BUFFER is the buffer containing output. - -Return collected error types as a string, or nil if there was -none." - (with-current-buffer buffer - (save-excursion - (goto-char (point-min)) - ;; Find final "makeinfo" run. - (when t - (let ((case-fold-search t) - (errors "")) - (when (save-excursion - (re-search-forward "perhaps incorrect sectioning?" nil t)) - (setq errors (concat errors " [incorrect sectioning]"))) - (when (save-excursion - (re-search-forward "missing close brace" nil t)) - (setq errors (concat errors " [syntax error]"))) - (when (save-excursion - (re-search-forward "Unknown command" nil t)) - (setq errors (concat errors " [undefined @command]"))) - (when (save-excursion - (re-search-forward "No matching @end" nil t)) - (setq errors (concat errors " [block incomplete]"))) - (when (save-excursion - (re-search-forward "requires a sectioning" nil t)) - (setq errors (concat errors " [invalid section command]"))) - (when (save-excursion - (re-search-forward "\\[unexpected\]" nil t)) - (setq errors (concat errors " [unexpected error]"))) - (when (save-excursion - (re-search-forward "misplaced " nil t)) - (setq errors (concat errors " [syntax error]"))) - (and (org-string-nw-p errors) (org-trim errors))))))) - - -(provide 'ox-texinfo) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ox-texinfo.el ends here diff --git a/xemacs-packages/lisp/org-8.2.3c/ox.el b/xemacs-packages/lisp/org-8.2.3c/ox.el deleted file mode 100644 index 69dca685..00000000 --- a/xemacs-packages/lisp/org-8.2.3c/ox.el +++ /dev/null @@ -1,6210 +0,0 @@ -;;; ox.el --- Generic Export Engine for Org Mode - -;; Copyright (C) 2012-2013 Free Software Foundation, Inc. - -;; Author: Nicolas Goaziou -;; Keywords: outlines, hypermedia, calendar, wp - -;; 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 . - -;;; Commentary: -;; -;; This library implements a generic export engine for Org, built on -;; its syntactical parser: Org Elements. -;; -;; Besides that parser, the generic exporter is made of three distinct -;; parts: -;; -;; - The communication channel consists in a property list, which is -;; created and updated during the process. Its use is to offer -;; every piece of information, would it be about initial environment -;; or contextual data, all in a single place. The exhaustive list -;; of properties is given in "The Communication Channel" section of -;; this file. -;; -;; - The transcoder walks the parse tree, ignores or treat as plain -;; text elements and objects according to export options, and -;; eventually calls back-end specific functions to do the real -;; transcoding, concatenating their return value along the way. -;; -;; - The filter system is activated at the very beginning and the very -;; end of the export process, and each time an element or an object -;; has been converted. It is the entry point to fine-tune standard -;; output from back-end transcoders. See "The Filter System" -;; section for more information. -;; -;; The core function is `org-export-as'. It returns the transcoded -;; buffer as a string. -;; -;; An export back-end is defined with `org-export-define-backend'. -;; This function can also support specific buffer keywords, OPTION -;; keyword's items and filters. Refer to function's documentation for -;; more information. -;; -;; If the new back-end shares most properties with another one, -;; `org-export-define-derived-backend' can be used to simplify the -;; process. -;; -;; Any back-end can define its own variables. Among them, those -;; customizable should belong to the `org-export-BACKEND' group. -;; -;; Tools for common tasks across back-ends are implemented in the -;; following part of the file. -;; -;; Then, a wrapper macro for asynchronous export, -;; `org-export-async-start', along with tools to display results. are -;; given in the penultimate part. -;; -;; Eventually, a dispatcher (`org-export-dispatch') for standard -;; back-ends is provided in the last one. - -;;; Code: - -(eval-when-compile (require 'cl)) -(require 'org-element) -(require 'org-macro) -(require 'ob-exp) - -(declare-function org-publish "ox-publish" (project &optional force async)) -(declare-function org-publish-all "ox-publish" (&optional force async)) -(declare-function - org-publish-current-file "ox-publish" (&optional force async)) -(declare-function org-publish-current-project "ox-publish" - (&optional force async)) - -(defvar org-publish-project-alist) -(defvar org-table-number-fraction) -(defvar org-table-number-regexp) - - - -;;; Internal Variables -;; -;; Among internal variables, the most important is -;; `org-export-options-alist'. This variable define the global export -;; options, shared between every exporter, and how they are acquired. - -(defconst org-export-max-depth 19 - "Maximum nesting depth for headlines, counting from 0.") - -(defconst org-export-options-alist - '((:author "AUTHOR" nil user-full-name t) - (:creator "CREATOR" nil org-export-creator-string) - (:date "DATE" nil nil t) - (:description "DESCRIPTION" nil nil newline) - (:email "EMAIL" nil user-mail-address t) - (:exclude-tags "EXCLUDE_TAGS" nil org-export-exclude-tags split) - (:headline-levels nil "H" org-export-headline-levels) - (:keywords "KEYWORDS" nil nil space) - (:language "LANGUAGE" nil org-export-default-language t) - (:preserve-breaks nil "\\n" org-export-preserve-breaks) - (:section-numbers nil "num" org-export-with-section-numbers) - (:select-tags "SELECT_TAGS" nil org-export-select-tags split) - (:time-stamp-file nil "timestamp" org-export-time-stamp-file) - (:title "TITLE" nil nil space) - (:with-archived-trees nil "arch" org-export-with-archived-trees) - (:with-author nil "author" org-export-with-author) - (:with-clocks nil "c" org-export-with-clocks) - (:with-creator nil "creator" org-export-with-creator) - (:with-date nil "date" org-export-with-date) - (:with-drawers nil "d" org-export-with-drawers) - (:with-email nil "email" org-export-with-email) - (:with-emphasize nil "*" org-export-with-emphasize) - (:with-entities nil "e" org-export-with-entities) - (:with-fixed-width nil ":" org-export-with-fixed-width) - (:with-footnotes nil "f" org-export-with-footnotes) - (:with-inlinetasks nil "inline" org-export-with-inlinetasks) - (:with-latex nil "tex" org-export-with-latex) - (:with-planning nil "p" org-export-with-planning) - (:with-priority nil "pri" org-export-with-priority) - (:with-smart-quotes nil "'" org-export-with-smart-quotes) - (:with-special-strings nil "-" org-export-with-special-strings) - (:with-statistics-cookies nil "stat" org-export-with-statistics-cookies) - (:with-sub-superscript nil "^" org-export-with-sub-superscripts) - (:with-toc nil "toc" org-export-with-toc) - (:with-tables nil "|" org-export-with-tables) - (:with-tags nil "tags" org-export-with-tags) - (:with-tasks nil "tasks" org-export-with-tasks) - (:with-timestamps nil "<" org-export-with-timestamps) - (:with-todo-keywords nil "todo" org-export-with-todo-keywords)) - "Alist between export properties and ways to set them. - -The CAR of the alist is the property name, and the CDR is a list -like (KEYWORD OPTION DEFAULT BEHAVIOUR) where: - -KEYWORD is a string representing a buffer keyword, or nil. Each - property defined this way can also be set, during subtree - export, through a headline property named after the keyword - with the \"EXPORT_\" prefix (i.e. DATE keyword and EXPORT_DATE - property). -OPTION is a string that could be found in an #+OPTIONS: line. -DEFAULT is the default value for the property. -BEHAVIOUR determines how Org should handle multiple keywords for - the same property. It is a symbol among: - nil Keep old value and discard the new one. - t Replace old value with the new one. - `space' Concatenate the values, separating them with a space. - `newline' Concatenate the values, separating them with - a newline. - `split' Split values at white spaces, and cons them to the - previous list. - -Values set through KEYWORD and OPTION have precedence over -DEFAULT. - -All these properties should be back-end agnostic. Back-end -specific properties are set through `org-export-define-backend'. -Properties redefined there have precedence over these.") - -(defconst org-export-special-keywords '("FILETAGS" "SETUPFILE" "OPTIONS") - "List of in-buffer keywords that require special treatment. -These keywords are not directly associated to a property. The -way they are handled must be hard-coded into -`org-export--get-inbuffer-options' function.") - -(defconst org-export-filters-alist - '((:filter-bold . org-export-filter-bold-functions) - (:filter-babel-call . org-export-filter-babel-call-functions) - (:filter-center-block . org-export-filter-center-block-functions) - (:filter-clock . org-export-filter-clock-functions) - (:filter-code . org-export-filter-code-functions) - (:filter-comment . org-export-filter-comment-functions) - (:filter-comment-block . org-export-filter-comment-block-functions) - (:filter-diary-sexp . org-export-filter-diary-sexp-functions) - (:filter-drawer . org-export-filter-drawer-functions) - (:filter-dynamic-block . org-export-filter-dynamic-block-functions) - (:filter-entity . org-export-filter-entity-functions) - (:filter-example-block . org-export-filter-example-block-functions) - (:filter-export-block . org-export-filter-export-block-functions) - (:filter-export-snippet . org-export-filter-export-snippet-functions) - (:filter-final-output . org-export-filter-final-output-functions) - (:filter-fixed-width . org-export-filter-fixed-width-functions) - (:filter-footnote-definition . org-export-filter-footnote-definition-functions) - (:filter-footnote-reference . org-export-filter-footnote-reference-functions) - (:filter-headline . org-export-filter-headline-functions) - (:filter-horizontal-rule . org-export-filter-horizontal-rule-functions) - (:filter-inline-babel-call . org-export-filter-inline-babel-call-functions) - (:filter-inline-src-block . org-export-filter-inline-src-block-functions) - (:filter-inlinetask . org-export-filter-inlinetask-functions) - (:filter-italic . org-export-filter-italic-functions) - (:filter-item . org-export-filter-item-functions) - (:filter-keyword . org-export-filter-keyword-functions) - (:filter-latex-environment . org-export-filter-latex-environment-functions) - (:filter-latex-fragment . org-export-filter-latex-fragment-functions) - (:filter-line-break . org-export-filter-line-break-functions) - (:filter-link . org-export-filter-link-functions) - (:filter-node-property . org-export-filter-node-property-functions) - (:filter-options . org-export-filter-options-functions) - (:filter-paragraph . org-export-filter-paragraph-functions) - (:filter-parse-tree . org-export-filter-parse-tree-functions) - (:filter-plain-list . org-export-filter-plain-list-functions) - (:filter-plain-text . org-export-filter-plain-text-functions) - (:filter-planning . org-export-filter-planning-functions) - (:filter-property-drawer . org-export-filter-property-drawer-functions) - (:filter-quote-block . org-export-filter-quote-block-functions) - (:filter-quote-section . org-export-filter-quote-section-functions) - (:filter-radio-target . org-export-filter-radio-target-functions) - (:filter-section . org-export-filter-section-functions) - (:filter-special-block . org-export-filter-special-block-functions) - (:filter-src-block . org-export-filter-src-block-functions) - (:filter-statistics-cookie . org-export-filter-statistics-cookie-functions) - (:filter-strike-through . org-export-filter-strike-through-functions) - (:filter-subscript . org-export-filter-subscript-functions) - (:filter-superscript . org-export-filter-superscript-functions) - (:filter-table . org-export-filter-table-functions) - (:filter-table-cell . org-export-filter-table-cell-functions) - (:filter-table-row . org-export-filter-table-row-functions) - (:filter-target . org-export-filter-target-functions) - (:filter-timestamp . org-export-filter-timestamp-functions) - (:filter-underline . org-export-filter-underline-functions) - (:filter-verbatim . org-export-filter-verbatim-functions) - (:filter-verse-block . org-export-filter-verse-block-functions)) - "Alist between filters properties and initial values. - -The key of each association is a property name accessible through -the communication channel. Its value is a configurable global -variable defining initial filters. - -This list is meant to install user specified filters. Back-end -developers may install their own filters using -`org-export-define-backend'. Filters defined there will always -be prepended to the current list, so they always get applied -first.") - -(defconst org-export-default-inline-image-rule - `(("file" . - ,(format "\\.%s\\'" - (regexp-opt - '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" - "xpm" "pbm" "pgm" "ppm") t)))) - "Default rule for link matching an inline image. -This rule applies to links with no description. By default, it -will be considered as an inline image if it targets a local file -whose extension is either \"png\", \"jpeg\", \"jpg\", \"gif\", -\"tiff\", \"tif\", \"xbm\", \"xpm\", \"pbm\", \"pgm\" or \"ppm\". -See `org-export-inline-image-p' for more information about -rules.") - -(defvar org-export-async-debug nil - "Non-nil means asynchronous export process should leave data behind. - -This data is found in the appropriate \"*Org Export Process*\" -buffer, and in files prefixed with \"org-export-process\" and -located in `temporary-file-directory'. - -When non-nil, it will also set `debug-on-error' to a non-nil -value in the external process.") - -(defvar org-export-stack-contents nil - "Record asynchronously generated export results and processes. -This is an alist: its CAR is the source of the -result (destination file or buffer for a finished process, -original buffer for a running one) and its CDR is a list -containing the back-end used, as a symbol, and either a process -or the time at which it finished. It is used to build the menu -from `org-export-stack'.") - -(defvar org-export--registered-backends nil - "List of backends currently available in the exporter. -This variable is set with `org-export-define-backend' and -`org-export-define-derived-backend' functions.") - -(defvar org-export-dispatch-last-action nil - "Last command called from the dispatcher. -The value should be a list. Its CAR is the action, as a symbol, -and its CDR is a list of export options.") - -(defvar org-export-dispatch-last-position (make-marker) - "The position where the last export command was created using the dispatcher. -This marker will be used with `C-u C-c C-e' to make sure export repetition -uses the same subtree if the previous command was restricted to a subtree.") - -;; For compatibility with Org < 8 -(defvar org-export-current-backend nil - "Name, if any, of the back-end used during an export process. - -Its value is a symbol such as `html', `latex', `ascii', or nil if -the back-end is anonymous (see `org-export-create-backend') or if -there is no export process in progress. - -It can be used to teach Babel blocks how to act differently -according to the back-end used.") - - -;;; User-configurable Variables -;; -;; Configuration for the masses. -;; -;; They should never be accessed directly, as their value is to be -;; stored in a property list (cf. `org-export-options-alist'). -;; Back-ends will read their value from there instead. - -(defgroup org-export nil - "Options for exporting Org mode files." - :tag "Org Export" - :group 'org) - -(defgroup org-export-general nil - "General options for export engine." - :tag "Org Export General" - :group 'org-export) - -(defcustom org-export-with-archived-trees 'headline - "Whether sub-trees with the ARCHIVE tag should be exported. - -This can have three different values: -nil Do not export, pretend this tree is not present. -t Do export the entire tree. -`headline' Only export the headline, but skip the tree below it. - -This option can also be set with the OPTIONS keyword, -e.g. \"arch:nil\"." - :group 'org-export-general - :type '(choice - (const :tag "Not at all" nil) - (const :tag "Headline only" headline) - (const :tag "Entirely" t))) - -(defcustom org-export-with-author t - "Non-nil means insert author name into the exported file. -This option can also be set with the OPTIONS keyword, -e.g. \"author:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-clocks nil - "Non-nil means export CLOCK keywords. -This option can also be set with the OPTIONS keyword, -e.g. \"c:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-creator 'comment - "Non-nil means the postamble should contain a creator sentence. - -The sentence can be set in `org-export-creator-string' and -defaults to \"Generated by Org mode XX in Emacs XXX.\". - -If the value is `comment' insert it as a comment." - :group 'org-export-general - :type '(choice - (const :tag "No creator sentence" nil) - (const :tag "Sentence as a comment" 'comment) - (const :tag "Insert the sentence" t))) - -(defcustom org-export-with-date t - "Non-nil means insert date in the exported document. -This option can also be set with the OPTIONS keyword, -e.g. \"date:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-date-timestamp-format nil - "Time-stamp format string to use for DATE keyword. - -The format string, when specified, only applies if date consists -in a single time-stamp. Otherwise its value will be ignored. - -See `format-time-string' for details on how to build this -string." - :group 'org-export-general - :type '(choice - (string :tag "Time-stamp format string") - (const :tag "No format string" nil))) - -(defcustom org-export-creator-string - (format "Emacs %s (Org mode %s)" - emacs-version - (if (fboundp 'org-version) (org-version) "unknown version")) - "Information about the creator of the document. -This option can also be set on with the CREATOR keyword." - :group 'org-export-general - :type '(string :tag "Creator string")) - -(defcustom org-export-with-drawers '(not "LOGBOOK") - "Non-nil means export contents of standard drawers. - -When t, all drawers are exported. This may also be a list of -drawer names to export. If that list starts with `not', only -drawers with such names will be ignored. - -This variable doesn't apply to properties drawers. - -This option can also be set with the OPTIONS keyword, -e.g. \"d:nil\"." - :group 'org-export-general - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (const :tag "All drawers" t) - (const :tag "None" nil) - (repeat :tag "Selected drawers" - (string :tag "Drawer name")) - (list :tag "Ignored drawers" - (const :format "" not) - (repeat :tag "Specify names of drawers to ignore during export" - :inline t - (string :tag "Drawer name"))))) - -(defcustom org-export-with-email nil - "Non-nil means insert author email into the exported file. -This option can also be set with the OPTIONS keyword, -e.g. \"email:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-emphasize t - "Non-nil means interpret *word*, /word/, _word_ and +word+. - -If the export target supports emphasizing text, the word will be -typeset in bold, italic, with an underline or strike-through, -respectively. - -This option can also be set with the OPTIONS keyword, -e.g. \"*:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-exclude-tags '("noexport") - "Tags that exclude a tree from export. - -All trees carrying any of these tags will be excluded from -export. This is without condition, so even subtrees inside that -carry one of the `org-export-select-tags' will be removed. - -This option can also be set with the EXCLUDE_TAGS keyword." - :group 'org-export-general - :type '(repeat (string :tag "Tag"))) - -(defcustom org-export-with-fixed-width t - "Non-nil means lines starting with \":\" will be in fixed width font. - -This can be used to have pre-formatted text, fragments of code -etc. For example: - : ;; Some Lisp examples - : (while (defc cnt) - : (ding)) -will be looking just like this in also HTML. See also the QUOTE -keyword. Not all export backends support this. - -This option can also be set with the OPTIONS keyword, -e.g. \"::nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-footnotes t - "Non-nil means Org footnotes should be exported. -This option can also be set with the OPTIONS keyword, -e.g. \"f:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-latex t - "Non-nil means process LaTeX environments and fragments. - -This option can also be set with the OPTIONS line, -e.g. \"tex:verbatim\". Allowed values are: - -nil Ignore math snippets. -`verbatim' Keep everything in verbatim. -t Allow export of math snippets." - :group 'org-export-general - :version "24.4" - :package-version '(Org . "8.0") - :type '(choice - (const :tag "Do not process math in any way" nil) - (const :tag "Interpret math snippets" t) - (const :tag "Leave math verbatim" verbatim))) - -(defcustom org-export-headline-levels 3 - "The last level which is still exported as a headline. - -Inferior levels will usually produce itemize or enumerate lists -when exported, but back-end behaviour may differ. - -This option can also be set with the OPTIONS keyword, -e.g. \"H:2\"." - :group 'org-export-general - :type 'integer) - -(defcustom org-export-default-language "en" - "The default language for export and clocktable translations, as a string. -This may have an association in -`org-clock-clocktable-language-setup', -`org-export-smart-quotes-alist' and `org-export-dictionary'. -This option can also be set with the LANGUAGE keyword." - :group 'org-export-general - :type '(string :tag "Language")) - -(defcustom org-export-preserve-breaks nil - "Non-nil means preserve all line breaks when exporting. -This option can also be set with the OPTIONS keyword, -e.g. \"\\n:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-entities t - "Non-nil means interpret entities when exporting. - -For example, HTML export converts \\alpha to α and \\AA to -Å. - -For a list of supported names, see the constant `org-entities' -and the user option `org-entities-user'. - -This option can also be set with the OPTIONS keyword, -e.g. \"e:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-inlinetasks t - "Non-nil means inlinetasks should be exported. -This option can also be set with the OPTIONS keyword, -e.g. \"inline:nil\"." - :group 'org-export-general - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-export-with-planning nil - "Non-nil means include planning info in export. - -Planning info is the line containing either SCHEDULED:, -DEADLINE:, CLOSED: time-stamps, or a combination of them. - -This option can also be set with the OPTIONS keyword, -e.g. \"p:t\"." - :group 'org-export-general - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-export-with-priority nil - "Non-nil means include priority cookies in export. -This option can also be set with the OPTIONS keyword, -e.g. \"pri:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-section-numbers t - "Non-nil means add section numbers to headlines when exporting. - -When set to an integer n, numbering will only happen for -headlines whose relative level is higher or equal to n. - -This option can also be set with the OPTIONS keyword, -e.g. \"num:t\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-select-tags '("export") - "Tags that select a tree for export. - -If any such tag is found in a buffer, all trees that do not carry -one of these tags will be ignored during export. Inside trees -that are selected like this, you can still deselect a subtree by -tagging it with one of the `org-export-exclude-tags'. - -This option can also be set with the SELECT_TAGS keyword." - :group 'org-export-general - :type '(repeat (string :tag "Tag"))) - -(defcustom org-export-with-smart-quotes nil - "Non-nil means activate smart quotes during export. -This option can also be set with the OPTIONS keyword, -e.g., \"':t\". - -When setting this to non-nil, you need to take care of -using the correct Babel package when exporting to LaTeX. -E.g., you can load Babel for french like this: - -#+LATEX_HEADER: \\usepackage[french]{babel}" - :group 'org-export-general - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-export-with-special-strings t - "Non-nil means interpret \"\\-\", \"--\" and \"---\" for export. - -When this option is turned on, these strings will be exported as: - - Org HTML LaTeX UTF-8 - -----+----------+--------+------- - \\- ­ \\- - -- – -- – - --- — --- — - ... … \\ldots … - -This option can also be set with the OPTIONS keyword, -e.g. \"-:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-statistics-cookies t - "Non-nil means include statistics cookies in export. -This option can also be set with the OPTIONS keyword, -e.g. \"stat:nil\"" - :group 'org-export-general - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-export-with-sub-superscripts t - "Non-nil means interpret \"_\" and \"^\" for export. - -When this option is turned on, you can use TeX-like syntax for -sub- and superscripts. Several characters after \"_\" or \"^\" -will be considered as a single item - so grouping with {} is -normally not needed. For example, the following things will be -parsed as single sub- or superscripts. - - 10^24 or 10^tau several digits will be considered 1 item. - 10^-12 or 10^-tau a leading sign with digits or a word - x^2-y^3 will be read as x^2 - y^3, because items are - terminated by almost any nonword/nondigit char. - x_{i^2} or x^(2-i) braces or parenthesis do grouping. - -Still, ambiguity is possible - so when in doubt use {} to enclose -the sub/superscript. If you set this variable to the symbol -`{}', the braces are *required* in order to trigger -interpretations as sub/superscript. This can be helpful in -documents that need \"_\" frequently in plain text. - -This option can also be set with the OPTIONS keyword, -e.g. \"^:nil\"." - :group 'org-export-general - :type '(choice - (const :tag "Interpret them" t) - (const :tag "Curly brackets only" {}) - (const :tag "Do not interpret them" nil))) - -(defcustom org-export-with-toc t - "Non-nil means create a table of contents in exported files. - -The TOC contains headlines with levels up -to`org-export-headline-levels'. When an integer, include levels -up to N in the toc, this may then be different from -`org-export-headline-levels', but it will not be allowed to be -larger than the number of headline levels. When nil, no table of -contents is made. - -This option can also be set with the OPTIONS keyword, -e.g. \"toc:nil\" or \"toc:3\"." - :group 'org-export-general - :type '(choice - (const :tag "No Table of Contents" nil) - (const :tag "Full Table of Contents" t) - (integer :tag "TOC to level"))) - -(defcustom org-export-with-tables t - "If non-nil, lines starting with \"|\" define a table. -For example: - - | Name | Address | Birthday | - |-------------+----------+-----------| - | Arthur Dent | England | 29.2.2100 | - -This option can also be set with the OPTIONS keyword, -e.g. \"|:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-tags t - "If nil, do not export tags, just remove them from headlines. - -If this is the symbol `not-in-toc', tags will be removed from -table of contents entries, but still be shown in the headlines of -the document. - -This option can also be set with the OPTIONS keyword, -e.g. \"tags:nil\"." - :group 'org-export-general - :type '(choice - (const :tag "Off" nil) - (const :tag "Not in TOC" not-in-toc) - (const :tag "On" t))) - -(defcustom org-export-with-tasks t - "Non-nil means include TODO items for export. - -This may have the following values: -t include tasks independent of state. -`todo' include only tasks that are not yet done. -`done' include only tasks that are already done. -nil ignore all tasks. -list of keywords include tasks with these keywords. - -This option can also be set with the OPTIONS keyword, -e.g. \"tasks:nil\"." - :group 'org-export-general - :type '(choice - (const :tag "All tasks" t) - (const :tag "No tasks" nil) - (const :tag "Not-done tasks" todo) - (const :tag "Only done tasks" done) - (repeat :tag "Specific TODO keywords" - (string :tag "Keyword")))) - -(defcustom org-export-time-stamp-file t - "Non-nil means insert a time stamp into the exported file. -The time stamp shows when the file was created. This option can -also be set with the OPTIONS keyword, e.g. \"timestamp:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-with-timestamps t - "Non nil means allow timestamps in export. - -It can be set to any of the following values: - t export all timestamps. - `active' export active timestamps only. - `inactive' export inactive timestamps only. - nil do not export timestamps - -This only applies to timestamps isolated in a paragraph -containing only timestamps. Other timestamps are always -exported. - -This option can also be set with the OPTIONS keyword, e.g. -\"<:nil\"." - :group 'org-export-general - :type '(choice - (const :tag "All timestamps" t) - (const :tag "Only active timestamps" active) - (const :tag "Only inactive timestamps" inactive) - (const :tag "No timestamp" nil))) - -(defcustom org-export-with-todo-keywords t - "Non-nil means include TODO keywords in export. -When nil, remove all these keywords from the export. This option -can also be set with the OPTIONS keyword, e.g. \"todo:nil\"." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-allow-bind-keywords nil - "Non-nil means BIND keywords can define local variable values. -This is a potential security risk, which is why the default value -is nil. You can also allow them through local buffer variables." - :group 'org-export-general - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-export-snippet-translation-alist nil - "Alist between export snippets back-ends and exporter back-ends. - -This variable allows to provide shortcuts for export snippets. - -For example, with a value of '\(\(\"h\" . \"html\"\)\), the -HTML back-end will recognize the contents of \"@@h:@@\" as -HTML code while every other back-end will ignore it." - :group 'org-export-general - :version "24.4" - :package-version '(Org . "8.0") - :type '(repeat - (cons (string :tag "Shortcut") - (string :tag "Back-end")))) - -(defcustom org-export-coding-system nil - "Coding system for the exported file." - :group 'org-export-general - :version "24.4" - :package-version '(Org . "8.0") - :type 'coding-system) - -(defcustom org-export-copy-to-kill-ring 'if-interactive - "Should we push exported content to the kill ring?" - :group 'org-export-general - :version "24.3" - :type '(choice - (const :tag "Always" t) - (const :tag "When export is done interactively" if-interactive) - (const :tag "Never" nil))) - -(defcustom org-export-initial-scope 'buffer - "The initial scope when exporting with `org-export-dispatch'. -This variable can be either set to `buffer' or `subtree'." - :group 'org-export-general - :type '(choice - (const :tag "Export current buffer" buffer) - (const :tag "Export current subtree" subtree))) - -(defcustom org-export-show-temporary-export-buffer t - "Non-nil means show buffer after exporting to temp buffer. -When Org exports to a file, the buffer visiting that file is ever -shown, but remains buried. However, when exporting to -a temporary buffer, that buffer is popped up in a second window. -When this variable is nil, the buffer remains buried also in -these cases." - :group 'org-export-general - :type 'boolean) - -(defcustom org-export-in-background nil - "Non-nil means export and publishing commands will run in background. -Results from an asynchronous export are never displayed -automatically. But you can retrieve them with \\[org-export-stack]." - :group 'org-export-general - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - -(defcustom org-export-async-init-file user-init-file - "File used to initialize external export process. -Value must be an absolute file name. It defaults to user's -initialization file. Though, a specific configuration makes the -process faster and the export more portable." - :group 'org-export-general - :version "24.4" - :package-version '(Org . "8.0") - :type '(file :must-match t)) - -(defcustom org-export-dispatch-use-expert-ui nil - "Non-nil means using a non-intrusive `org-export-dispatch'. -In that case, no help buffer is displayed. Though, an indicator -for current export scope is added to the prompt (\"b\" when -output is restricted to body only, \"s\" when it is restricted to -the current subtree, \"v\" when only visible elements are -considered for export, \"f\" when publishing functions should be -passed the FORCE argument and \"a\" when the export should be -asynchronous). Also, \[?] allows to switch back to standard -mode." - :group 'org-export-general - :version "24.4" - :package-version '(Org . "8.0") - :type 'boolean) - - - -;;; Defining Back-ends -;; -;; An export back-end is a structure with `org-export-backend' type -;; and `name', `parent', `transcoders', `options', `filters', `blocks' -;; and `menu' slots. -;; -;; At the lowest level, a back-end is created with -;; `org-export-create-backend' function. -;; -;; A named back-end can be registered with -;; `org-export-register-backend' function. A registered back-end can -;; later be referred to by its name, with `org-export-get-backend' -;; function. Also, such a back-end can become the parent of a derived -;; back-end from which slot values will be inherited by default. -;; `org-export-derived-backend-p' can check if a given back-end is -;; derived from a list of back-end names. -;; -;; `org-export-get-all-transcoders', `org-export-get-all-options' and -;; `org-export-get-all-filters' return the full alist of transcoders, -;; options and filters, including those inherited from ancestors. -;; -;; At a higher level, `org-export-define-backend' is the standard way -;; to define an export back-end. If the new back-end is similar to -;; a registered back-end, `org-export-define-derived-backend' may be -;; used instead. -;; -;; Eventually `org-export-barf-if-invalid-backend' returns an error -;; when a given back-end hasn't been registered yet. - -(defstruct (org-export-backend (:constructor org-export-create-backend) - (:copier nil)) - name parent transcoders options filters blocks menu) - -(defun org-export-get-backend (name) - "Return export back-end named after NAME. -NAME is a symbol. Return nil if no such back-end is found." - (catch 'found - (dolist (b org-export--registered-backends) - (when (eq (org-export-backend-name b) name) - (throw 'found b))))) - -(defun org-export-register-backend (backend) - "Register BACKEND as a known export back-end. -BACKEND is a structure with `org-export-backend' type." - ;; Refuse to register an unnamed back-end. - (unless (org-export-backend-name backend) - (error "Cannot register a unnamed export back-end")) - ;; Refuse to register a back-end with an unknown parent. - (let ((parent (org-export-backend-parent backend))) - (when (and parent (not (org-export-get-backend parent))) - (error "Cannot use unknown \"%s\" back-end as a parent" parent))) - ;; Register dedicated export blocks in the parser. - (dolist (name (org-export-backend-blocks backend)) - (add-to-list 'org-element-block-name-alist - (cons name 'org-element-export-block-parser))) - ;; If a back-end with the same name as BACKEND is already - ;; registered, replace it with BACKEND. Otherwise, simply add - ;; BACKEND to the list of registered back-ends. - (let ((old (org-export-get-backend (org-export-backend-name backend)))) - (if old (setcar (memq old org-export--registered-backends) backend) - (push backend org-export--registered-backends)))) - -(defun org-export-barf-if-invalid-backend (backend) - "Signal an error if BACKEND isn't defined." - (unless (org-export-backend-p backend) - (error "Unknown \"%s\" back-end: Aborting export" backend))) - -(defun org-export-derived-backend-p (backend &rest backends) - "Non-nil if BACKEND is derived from one of BACKENDS. -BACKEND is an export back-end, as returned by, e.g., -`org-export-create-backend', or a symbol referring to -a registered back-end. BACKENDS is constituted of symbols." - (when (symbolp backend) (setq backend (org-export-get-backend backend))) - (when backend - (catch 'exit - (while (org-export-backend-parent backend) - (when (memq (org-export-backend-name backend) backends) - (throw 'exit t)) - (setq backend - (org-export-get-backend (org-export-backend-parent backend)))) - (memq (org-export-backend-name backend) backends)))) - -(defun org-export-get-all-transcoders (backend) - "Return full translation table for BACKEND. - -BACKEND is an export back-end, as return by, e.g,, -`org-export-create-backend'. Return value is an alist where -keys are element or object types, as symbols, and values are -transcoders. - -Unlike to `org-export-backend-transcoders', this function -also returns transcoders inherited from parent back-ends, -if any." - (when (symbolp backend) (setq backend (org-export-get-backend backend))) - (when backend - (let ((transcoders (org-export-backend-transcoders backend)) - parent) - (while (setq parent (org-export-backend-parent backend)) - (setq backend (org-export-get-backend parent)) - (setq transcoders - (append transcoders (org-export-backend-transcoders backend)))) - transcoders))) - -(defun org-export-get-all-options (backend) - "Return export options for BACKEND. - -BACKEND is an export back-end, as return by, e.g,, -`org-export-create-backend'. See `org-export-options-alist' -for the shape of the return value. - -Unlike to `org-export-backend-options', this function also -returns options inherited from parent back-ends, if any." - (when (symbolp backend) (setq backend (org-export-get-backend backend))) - (when backend - (let ((options (org-export-backend-options backend)) - parent) - (while (setq parent (org-export-backend-parent backend)) - (setq backend (org-export-get-backend parent)) - (setq options (append options (org-export-backend-options backend)))) - options))) - -(defun org-export-get-all-filters (backend) - "Return complete list of filters for BACKEND. - -BACKEND is an export back-end, as return by, e.g,, -`org-export-create-backend'. Return value is an alist where -keys are symbols and values lists of functions. - -Unlike to `org-export-backend-filters', this function also -returns filters inherited from parent back-ends, if any." - (when (symbolp backend) (setq backend (org-export-get-backend backend))) - (when backend - (let ((filters (org-export-backend-filters backend)) - parent) - (while (setq parent (org-export-backend-parent backend)) - (setq backend (org-export-get-backend parent)) - (setq filters (append filters (org-export-backend-filters backend)))) - filters))) - -(defun org-export-define-backend (backend transcoders &rest body) - "Define a new back-end BACKEND. - -TRANSCODERS is an alist between object or element types and -functions handling them. - -These functions should return a string without any trailing -space, or nil. They must accept three arguments: the object or -element itself, its contents or nil when it isn't recursive and -the property list used as a communication channel. - -Contents, when not nil, are stripped from any global indentation -\(although the relative one is preserved). They also always end -with a single newline character. - -If, for a given type, no function is found, that element or -object type will simply be ignored, along with any blank line or -white space at its end. The same will happen if the function -returns the nil value. If that function returns the empty -string, the type will be ignored, but the blank lines or white -spaces will be kept. - -In addition to element and object types, one function can be -associated to the `template' (or `inner-template') symbol and -another one to the `plain-text' symbol. - -The former returns the final transcoded string, and can be used -to add a preamble and a postamble to document's body. It must -accept two arguments: the transcoded string and the property list -containing export options. A function associated to `template' -will not be applied if export has option \"body-only\". -A function associated to `inner-template' is always applied. - -The latter, when defined, is to be called on every text not -recognized as an element or an object. It must accept two -arguments: the text string and the information channel. It is an -appropriate place to protect special chars relative to the -back-end. - -BODY can start with pre-defined keyword arguments. The following -keywords are understood: - - :export-block - - String, or list of strings, representing block names that - will not be parsed. This is used to specify blocks that will - contain raw code specific to the back-end. These blocks - still have to be handled by the relative `export-block' type - translator. - - :filters-alist - - Alist between filters and function, or list of functions, - specific to the back-end. See `org-export-filters-alist' for - a list of all allowed filters. Filters defined here - shouldn't make a back-end test, as it may prevent back-ends - derived from this one to behave properly. - - :menu-entry - - Menu entry for the export dispatcher. It should be a list - like: - - '(KEY DESCRIPTION-OR-ORDINAL ACTION-OR-MENU) - - where : - - KEY is a free character selecting the back-end. - - DESCRIPTION-OR-ORDINAL is either a string or a number. - - If it is a string, is will be used to name the back-end in - its menu entry. If it is a number, the following menu will - be displayed as a sub-menu of the back-end with the same - KEY. Also, the number will be used to determine in which - order such sub-menus will appear (lowest first). - - ACTION-OR-MENU is either a function or an alist. - - If it is an action, it will be called with four - arguments (booleans): ASYNC, SUBTREEP, VISIBLE-ONLY and - BODY-ONLY. See `org-export-as' for further explanations on - some of them. - - If it is an alist, associations should follow the - pattern: - - '(KEY DESCRIPTION ACTION) - - where KEY, DESCRIPTION and ACTION are described above. - - Valid values include: - - '(?m \"My Special Back-end\" my-special-export-function) - - or - - '(?l \"Export to LaTeX\" - \(?p \"As PDF file\" org-latex-export-to-pdf) - \(?o \"As PDF file and open\" - \(lambda (a s v b) - \(if a (org-latex-export-to-pdf t s v b) - \(org-open-file - \(org-latex-export-to-pdf nil s v b))))))) - - or the following, which will be added to the previous - sub-menu, - - '(?l 1 - \((?B \"As TEX buffer (Beamer)\" org-beamer-export-as-latex) - \(?P \"As PDF file (Beamer)\" org-beamer-export-to-pdf))) - - :options-alist - - Alist between back-end specific properties introduced in - communication channel and how their value are acquired. See - `org-export-options-alist' for more information about - structure of the values." - (declare (indent 1)) - (let (blocks filters menu-entry options contents) - (while (keywordp (car body)) - (case (pop body) - (:export-block (let ((names (pop body))) - (setq blocks (if (consp names) (mapcar 'upcase names) - (list (upcase names)))))) - (:filters-alist (setq filters (pop body))) - (:menu-entry (setq menu-entry (pop body))) - (:options-alist (setq options (pop body))) - (t (pop body)))) - (org-export-register-backend - (org-export-create-backend :name backend - :transcoders transcoders - :options options - :filters filters - :blocks blocks - :menu menu-entry)))) - -(defun org-export-define-derived-backend (child parent &rest body) - "Create a new back-end as a variant of an existing one. - -CHILD is the name of the derived back-end. PARENT is the name of -the parent back-end. - -BODY can start with pre-defined keyword arguments. The following -keywords are understood: - - :export-block - - String, or list of strings, representing block names that - will not be parsed. This is used to specify blocks that will - contain raw code specific to the back-end. These blocks - still have to be handled by the relative `export-block' type - translator. - - :filters-alist - - Alist of filters that will overwrite or complete filters - defined in PARENT back-end. See `org-export-filters-alist' - for a list of allowed filters. - - :menu-entry - - Menu entry for the export dispatcher. See - `org-export-define-backend' for more information about the - expected value. - - :options-alist - - Alist of back-end specific properties that will overwrite or - complete those defined in PARENT back-end. Refer to - `org-export-options-alist' for more information about - structure of the values. - - :translate-alist - - Alist of element and object types and transcoders that will - overwrite or complete transcode table from PARENT back-end. - Refer to `org-export-define-backend' for detailed information - about transcoders. - -As an example, here is how one could define \"my-latex\" back-end -as a variant of `latex' back-end with a custom template function: - - \(org-export-define-derived-backend 'my-latex 'latex - :translate-alist '((template . my-latex-template-fun))) - -The back-end could then be called with, for example: - - \(org-export-to-buffer 'my-latex \"*Test my-latex*\")" - (declare (indent 2)) - (let (blocks filters menu-entry options transcoders contents) - (while (keywordp (car body)) - (case (pop body) - (:export-block (let ((names (pop body))) - (setq blocks (if (consp names) (mapcar 'upcase names) - (list (upcase names)))))) - (:filters-alist (setq filters (pop body))) - (:menu-entry (setq menu-entry (pop body))) - (:options-alist (setq options (pop body))) - (:translate-alist (setq transcoders (pop body))) - (t (pop body)))) - (org-export-register-backend - (org-export-create-backend :name child - :parent parent - :transcoders transcoders - :options options - :filters filters - :blocks blocks - :menu menu-entry)))) - - - -;;; The Communication Channel -;; -;; During export process, every function has access to a number of -;; properties. They are of two types: -;; -;; 1. Environment options are collected once at the very beginning of -;; the process, out of the original buffer and configuration. -;; Collecting them is handled by `org-export-get-environment' -;; function. -;; -;; Most environment options are defined through the -;; `org-export-options-alist' variable. -;; -;; 2. Tree properties are extracted directly from the parsed tree, -;; just before export, by `org-export-collect-tree-properties'. -;; -;; Here is the full list of properties available during transcode -;; process, with their category and their value type. -;; -;; + `:author' :: Author's name. -;; - category :: option -;; - type :: string -;; -;; + `:back-end' :: Current back-end used for transcoding. -;; - category :: tree -;; - type :: symbol -;; -;; + `:creator' :: String to write as creation information. -;; - category :: option -;; - type :: string -;; -;; + `:date' :: String to use as date. -;; - category :: option -;; - type :: string -;; -;; + `:description' :: Description text for the current data. -;; - category :: option -;; - type :: string -;; -;; + `:email' :: Author's email. -;; - category :: option -;; - type :: string -;; -;; + `:exclude-tags' :: Tags for exclusion of subtrees from export -;; process. -;; - category :: option -;; - type :: list of strings -;; -;; + `:export-options' :: List of export options available for current -;; process. -;; - category :: none -;; - type :: list of symbols, among `subtree', `body-only' and -;; `visible-only'. -;; -;; + `:exported-data' :: Hash table used for memoizing -;; `org-export-data'. -;; - category :: tree -;; - type :: hash table -;; -;; + `:filetags' :: List of global tags for buffer. Used by -;; `org-export-get-tags' to get tags with inheritance. -;; - category :: option -;; - type :: list of strings -;; -;; + `:footnote-definition-alist' :: Alist between footnote labels and -;; their definition, as parsed data. Only non-inlined footnotes -;; are represented in this alist. Also, every definition isn't -;; guaranteed to be referenced in the parse tree. The purpose of -;; this property is to preserve definitions from oblivion -;; (i.e. when the parse tree comes from a part of the original -;; buffer), it isn't meant for direct use in a back-end. To -;; retrieve a definition relative to a reference, use -;; `org-export-get-footnote-definition' instead. -;; - category :: option -;; - type :: alist (STRING . LIST) -;; -;; + `:headline-levels' :: Maximum level being exported as an -;; headline. Comparison is done with the relative level of -;; headlines in the parse tree, not necessarily with their -;; actual level. -;; - category :: option -;; - type :: integer -;; -;; + `:headline-offset' :: Difference between relative and real level -;; of headlines in the parse tree. For example, a value of -1 -;; means a level 2 headline should be considered as level -;; 1 (cf. `org-export-get-relative-level'). -;; - category :: tree -;; - type :: integer -;; -;; + `:headline-numbering' :: Alist between headlines and their -;; numbering, as a list of numbers -;; (cf. `org-export-get-headline-number'). -;; - category :: tree -;; - type :: alist (INTEGER . LIST) -;; -;; + `:id-alist' :: Alist between ID strings and destination file's -;; path, relative to current directory. It is used by -;; `org-export-resolve-id-link' to resolve ID links targeting an -;; external file. -;; - category :: option -;; - type :: alist (STRING . STRING) -;; -;; + `:ignore-list' :: List of elements and objects that should be -;; ignored during export. -;; - category :: tree -;; - type :: list of elements and objects -;; -;; + `:input-file' :: Full path to input file, if any. -;; - category :: option -;; - type :: string or nil -;; -;; + `:keywords' :: List of keywords attached to data. -;; - category :: option -;; - type :: string -;; -;; + `:language' :: Default language used for translations. -;; - category :: option -;; - type :: string -;; -;; + `:parse-tree' :: Whole parse tree, available at any time during -;; transcoding. -;; - category :: option -;; - type :: list (as returned by `org-element-parse-buffer') -;; -;; + `:preserve-breaks' :: Non-nil means transcoding should preserve -;; all line breaks. -;; - category :: option -;; - type :: symbol (nil, t) -;; -;; + `:section-numbers' :: Non-nil means transcoding should add -;; section numbers to headlines. -;; - category :: option -;; - type :: symbol (nil, t) -;; -;; + `:select-tags' :: List of tags enforcing inclusion of sub-trees -;; in transcoding. When such a tag is present, subtrees without -;; it are de facto excluded from the process. See -;; `use-select-tags'. -;; - category :: option -;; - type :: list of strings -;; -;; + `:time-stamp-file' :: Non-nil means transcoding should insert -;; a time stamp in the output. -;; - category :: option -;; - type :: symbol (nil, t) -;; -;; + `:translate-alist' :: Alist between element and object types and -;; transcoding functions relative to the current back-end. -;; Special keys `inner-template', `template' and `plain-text' are -;; also possible. -;; - category :: option -;; - type :: alist (SYMBOL . FUNCTION) -;; -;; + `:with-archived-trees' :: Non-nil when archived subtrees should -;; also be transcoded. If it is set to the `headline' symbol, -;; only the archived headline's name is retained. -;; - category :: option -;; - type :: symbol (nil, t, `headline') -;; -;; + `:with-author' :: Non-nil means author's name should be included -;; in the output. -;; - category :: option -;; - type :: symbol (nil, t) -;; -;; + `:with-clocks' :: Non-nil means clock keywords should be exported. -;; - category :: option -;; - type :: symbol (nil, t) -;; -;; + `:with-creator' :: Non-nil means a creation sentence should be -;; inserted at the end of the transcoded string. If the value -;; is `comment', it should be commented. -;; - category :: option -;; - type :: symbol (`comment', nil, t) -;; -;; + `:with-date' :: Non-nil means output should contain a date. -;; - category :: option -;; - type :. symbol (nil, t) -;; -;; + `:with-drawers' :: Non-nil means drawers should be exported. If -;; its value is a list of names, only drawers with such names -;; will be transcoded. If that list starts with `not', drawer -;; with these names will be skipped. -;; - category :: option -;; - type :: symbol (nil, t) or list of strings -;; -;; + `:with-email' :: Non-nil means output should contain author's -;; email. -;; - category :: option -;; - type :: symbol (nil, t) -;; -;; + `:with-emphasize' :: Non-nil means emphasized text should be -;; interpreted. -;; - category :: option -;; - type :: symbol (nil, t) -;; -;; + `:with-fixed-width' :: Non-nil if transcoder should interpret -;; strings starting with a colon as a fixed-with (verbatim) area. -;; - category :: option -;; - type :: symbol (nil, t) -;; -;; + `:with-footnotes' :: Non-nil if transcoder should interpret -;; footnotes. -;; - category :: option -;; - type :: symbol (nil, t) -;; -;; + `:with-latex' :: Non-nil means `latex-environment' elements and -;; `latex-fragment' objects should appear in export output. When -;; this property is set to `verbatim', they will be left as-is. -;; - category :: option -;; - type :: symbol (`verbatim', nil, t) -;; -;; + `:with-planning' :: Non-nil means transcoding should include -;; planning info. -;; - category :: option -;; - type :: symbol (nil, t) -;; -;; + `:with-priority' :: Non-nil means transcoding should include -;; priority cookies. -;; - category :: option -;; - type :: symbol (nil, t) -;; -;; + `:with-smart-quotes' :: Non-nil means activate smart quotes in -;; plain text. -;; - category :: option -;; - type :: symbol (nil, t) -;; -;; + `:with-special-strings' :: Non-nil means transcoding should -;; interpret special strings in plain text. -;; - category :: option -;; - type :: symbol (nil, t) -;; -;; + `:with-sub-superscript' :: Non-nil means transcoding should -;; interpret subscript and superscript. With a value of "{}", -;; only interpret those using curly brackets. -;; - category :: option -;; - type :: symbol (nil, {}, t) -;; -;; + `:with-tables' :: Non-nil means transcoding should interpret -;; tables. -;; - category :: option -;; - type :: symbol (nil, t) -;; -;; + `:with-tags' :: Non-nil means transcoding should keep tags in -;; headlines. A `not-in-toc' value will remove them from the -;; table of contents, if any, nonetheless. -;; - category :: option -;; - type :: symbol (nil, t, `not-in-toc') -;; -;; + `:with-tasks' :: Non-nil means transcoding should include -;; headlines with a TODO keyword. A `todo' value will only -;; include headlines with a todo type keyword while a `done' -;; value will do the contrary. If a list of strings is provided, -;; only tasks with keywords belonging to that list will be kept. -;; - category :: option -;; - type :: symbol (t, todo, done, nil) or list of strings -;; -;; + `:with-timestamps' :: Non-nil means transcoding should include -;; time stamps. Special value `active' (resp. `inactive') ask to -;; export only active (resp. inactive) timestamps. Otherwise, -;; completely remove them. -;; - category :: option -;; - type :: symbol: (`active', `inactive', t, nil) -;; -;; + `:with-toc' :: Non-nil means that a table of contents has to be -;; added to the output. An integer value limits its depth. -;; - category :: option -;; - type :: symbol (nil, t or integer) -;; -;; + `:with-todo-keywords' :: Non-nil means transcoding should -;; include TODO keywords. -;; - category :: option -;; - type :: symbol (nil, t) - - -;;;; Environment Options -;; -;; Environment options encompass all parameters defined outside the -;; scope of the parsed data. They come from five sources, in -;; increasing precedence order: -;; -;; - Global variables, -;; - Buffer's attributes, -;; - Options keyword symbols, -;; - Buffer keywords, -;; - Subtree properties. -;; -;; The central internal function with regards to environment options -;; is `org-export-get-environment'. It updates global variables with -;; "#+BIND:" keywords, then retrieve and prioritize properties from -;; the different sources. -;; -;; The internal functions doing the retrieval are: -;; `org-export--get-global-options', -;; `org-export--get-buffer-attributes', -;; `org-export--parse-option-keyword', -;; `org-export--get-subtree-options' and -;; `org-export--get-inbuffer-options' -;; -;; Also, `org-export--list-bound-variables' collects bound variables -;; along with their value in order to set them as buffer local -;; variables later in the process. - -(defun org-export-get-environment (&optional backend subtreep ext-plist) - "Collect export options from the current buffer. - -Optional argument BACKEND is an export back-end, as returned by -`org-export-create-backend'. - -When optional argument SUBTREEP is non-nil, assume the export is -done against the current sub-tree. - -Third optional argument EXT-PLIST is a property list with -external parameters overriding Org default settings, but still -inferior to file-local settings." - ;; First install #+BIND variables since these must be set before - ;; global options are read. - (dolist (pair (org-export--list-bound-variables)) - (org-set-local (car pair) (nth 1 pair))) - ;; Get and prioritize export options... - (org-combine-plists - ;; ... from global variables... - (org-export--get-global-options backend) - ;; ... from an external property list... - ext-plist - ;; ... from in-buffer settings... - (org-export--get-inbuffer-options backend) - ;; ... and from subtree, when appropriate. - (and subtreep (org-export--get-subtree-options backend)) - ;; Eventually add misc. properties. - (list - :back-end - backend - :translate-alist (org-export-get-all-transcoders backend) - :footnote-definition-alist - ;; Footnotes definitions must be collected in the original - ;; buffer, as there's no insurance that they will still be in - ;; the parse tree, due to possible narrowing. - (let (alist) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward org-footnote-definition-re nil t) - (let ((def (save-match-data (org-element-at-point)))) - (when (eq (org-element-type def) 'footnote-definition) - (push - (cons (org-element-property :label def) - (let ((cbeg (org-element-property :contents-begin def))) - (when cbeg - (org-element--parse-elements - cbeg (org-element-property :contents-end def) - nil nil nil nil (list 'org-data nil))))) - alist)))) - alist)) - :id-alist - ;; Collect id references. - (let (alist) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward "\\[\\[id:\\S-+?\\]" nil t) - (let ((link (org-element-context))) - (when (eq (org-element-type link) 'link) - (let* ((id (org-element-property :path link)) - (file (org-id-find-id-file id))) - (when file - (push (cons id (file-relative-name file)) alist))))))) - alist)))) - -(defun org-export--parse-option-keyword (options &optional backend) - "Parse an OPTIONS line and return values as a plist. -Optional argument BACKEND is an export back-end, as returned by, -e.g., `org-export-create-backend'. It specifies which back-end -specific items to read, if any." - (let* ((all - ;; Priority is given to back-end specific options. - (append (and backend (org-export-get-all-options backend)) - org-export-options-alist)) - plist) - (dolist (option all) - (let ((property (car option)) - (item (nth 2 option))) - (when (and item - (not (plist-member plist property)) - (string-match (concat "\\(\\`\\|[ \t]\\)" - (regexp-quote item) - ":\\(([^)\n]+)\\|[^ \t\n\r;,.]*\\)") - options)) - (setq plist (plist-put plist - property - (car (read-from-string - (match-string 2 options)))))))) - plist)) - -(defun org-export--get-subtree-options (&optional backend) - "Get export options in subtree at point. -Optional argument BACKEND is an export back-end, as returned by, -e.g., `org-export-create-backend'. It specifies back-end used -for export. Return options as a plist." - ;; For each buffer keyword, create a headline property setting the - ;; same property in communication channel. The name for the property - ;; is the keyword with "EXPORT_" appended to it. - (org-with-wide-buffer - (let (prop plist) - ;; Make sure point is at a heading. - (if (org-at-heading-p) (org-up-heading-safe) (org-back-to-heading t)) - ;; Take care of EXPORT_TITLE. If it isn't defined, use headline's - ;; title as its fallback value. - (when (setq prop (or (org-entry-get (point) "EXPORT_TITLE") - (progn (looking-at org-todo-line-regexp) - (org-match-string-no-properties 3)))) - (setq plist - (plist-put - plist :title - (org-element-parse-secondary-string - prop (org-element-restriction 'keyword))))) - ;; EXPORT_OPTIONS are parsed in a non-standard way. - (when (setq prop (org-entry-get (point) "EXPORT_OPTIONS")) - (setq plist - (nconc plist (org-export--parse-option-keyword prop backend)))) - ;; Handle other keywords. TITLE keyword is excluded as it has - ;; been handled already. - (let ((seen '("TITLE"))) - (mapc - (lambda (option) - (let ((property (car option)) - (keyword (nth 1 option))) - (when (and keyword (not (member keyword seen))) - (let* ((subtree-prop (concat "EXPORT_" keyword)) - ;; Export properties are not case-sensitive. - (value (let ((case-fold-search t)) - (org-entry-get (point) subtree-prop)))) - (push keyword seen) - (when (and value (not (plist-member plist property))) - (setq plist - (plist-put - plist - property - (cond - ;; Parse VALUE if required. - ((member keyword org-element-document-properties) - (org-element-parse-secondary-string - value (org-element-restriction 'keyword))) - ;; If BEHAVIOUR is `split' expected value is - ;; a list of strings, not a string. - ((eq (nth 4 option) 'split) (org-split-string value)) - (t value))))))))) - ;; Look for both general keywords and back-end specific - ;; options, with priority given to the latter. - (append (and backend (org-export-get-all-options backend)) - org-export-options-alist))) - ;; Return value. - plist))) - -(defun org-export--get-inbuffer-options (&optional backend) - "Return current buffer export options, as a plist. - -Optional argument BACKEND, when non-nil, is an export back-end, -as returned by, e.g., `org-export-create-backend'. It specifies -which back-end specific options should also be read in the -process. - -Assume buffer is in Org mode. Narrowing, if any, is ignored." - (let* (plist - get-options ; For byte-compiler. - (case-fold-search t) - (options (append - ;; Priority is given to back-end specific options. - (and backend (org-export-get-all-options backend)) - org-export-options-alist)) - (regexp (format "^[ \t]*#\\+%s:" - (regexp-opt (nconc (delq nil (mapcar 'cadr options)) - org-export-special-keywords)))) - (find-properties - (lambda (keyword) - ;; Return all properties associated to KEYWORD. - (let (properties) - (dolist (option options properties) - (when (equal (nth 1 option) keyword) - (pushnew (car option) properties)))))) - (get-options - (lambda (&optional files plist) - ;; Recursively read keywords in buffer. FILES is a list - ;; of files read so far. PLIST is the current property - ;; list obtained. - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) - (let ((key (org-element-property :key element)) - (val (org-element-property :value element))) - (cond - ;; Options in `org-export-special-keywords'. - ((equal key "SETUPFILE") - (let ((file (expand-file-name - (org-remove-double-quotes (org-trim val))))) - ;; Avoid circular dependencies. - (unless (member file files) - (with-temp-buffer - (insert (org-file-contents file 'noerror)) - (let ((org-inhibit-startup t)) (org-mode)) - (setq plist (funcall get-options - (cons file files) plist)))))) - ((equal key "OPTIONS") - (setq plist - (org-combine-plists - plist - (org-export--parse-option-keyword val backend)))) - ((equal key "FILETAGS") - (setq plist - (org-combine-plists - plist - (list :filetags - (org-uniquify - (append (org-split-string val ":") - (plist-get plist :filetags))))))) - (t - ;; Options in `org-export-options-alist'. - (dolist (property (funcall find-properties key)) - (let ((behaviour (nth 4 (assq property options)))) - (setq plist - (plist-put - plist property - ;; Handle value depending on specified - ;; BEHAVIOUR. - (case behaviour - (space - (if (not (plist-get plist property)) - (org-trim val) - (concat (plist-get plist property) - " " - (org-trim val)))) - (newline - (org-trim - (concat (plist-get plist property) - "\n" - (org-trim val)))) - (split `(,@(plist-get plist property) - ,@(org-split-string val))) - ('t val) - (otherwise - (if (not (plist-member plist property)) val - (plist-get plist property)))))))))))))) - ;; Return final value. - plist)))) - ;; Read options in the current buffer. - (setq plist (funcall get-options - (and buffer-file-name (list buffer-file-name)) nil)) - ;; Parse keywords specified in `org-element-document-properties' - ;; and return PLIST. - (dolist (keyword org-element-document-properties plist) - (dolist (property (funcall find-properties keyword)) - (let ((value (plist-get plist property))) - (when (stringp value) - (setq plist - (plist-put plist property - (org-element-parse-secondary-string - value (org-element-restriction 'keyword)))))))))) - -(defun org-export--get-buffer-attributes () - "Return properties related to buffer attributes, as a plist." - ;; Store full path of input file name, or nil. For internal use. - (let ((visited-file (buffer-file-name (buffer-base-buffer)))) - (list :input-file visited-file - :title (if (not visited-file) (buffer-name (buffer-base-buffer)) - (file-name-sans-extension - (file-name-nondirectory visited-file)))))) - -(defun org-export--get-global-options (&optional backend) - "Return global export options as a plist. -Optional argument BACKEND, if non-nil, is an export back-end, as -returned by, e.g., `org-export-create-backend'. It specifies -which back-end specific export options should also be read in the -process." - (let (plist - ;; Priority is given to back-end specific options. - (all (append (and backend (org-export-get-all-options backend)) - org-export-options-alist))) - (dolist (cell all plist) - (let ((prop (car cell)) - (default-value (nth 3 cell))) - (unless (or (not default-value) (plist-member plist prop)) - (setq plist - (plist-put - plist - prop - ;; Eval default value provided. If keyword is - ;; a member of `org-element-document-properties', - ;; parse it as a secondary string before storing it. - (let ((value (eval (nth 3 cell)))) - (if (not (stringp value)) value - (let ((keyword (nth 1 cell))) - (if (member keyword org-element-document-properties) - (org-element-parse-secondary-string - value (org-element-restriction 'keyword)) - value))))))))))) - -(defun org-export--list-bound-variables () - "Return variables bound from BIND keywords in current buffer. -Also look for BIND keywords in setup files. The return value is -an alist where associations are (VARIABLE-NAME VALUE)." - (when org-export-allow-bind-keywords - (let* (collect-bind ; For byte-compiler. - (collect-bind - (lambda (files alist) - ;; Return an alist between variable names and their - ;; value. FILES is a list of setup files names read so - ;; far, used to avoid circular dependencies. ALIST is - ;; the alist collected so far. - (let ((case-fold-search t)) - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward - "^[ \t]*#\\+\\(BIND\\|SETUPFILE\\):" nil t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) - (let ((val (org-element-property :value element))) - (if (equal (org-element-property :key element) "BIND") - (push (read (format "(%s)" val)) alist) - ;; Enter setup file. - (let ((file (expand-file-name - (org-remove-double-quotes val)))) - (unless (member file files) - (with-temp-buffer - (let ((org-inhibit-startup t)) (org-mode)) - (insert (org-file-contents file 'noerror)) - (setq alist - (funcall collect-bind - (cons file files) - alist)))))))))) - alist))))) - ;; Return value in appropriate order of appearance. - (nreverse (funcall collect-bind nil nil))))) - - -;;;; Tree Properties -;; -;; Tree properties are information extracted from parse tree. They -;; are initialized at the beginning of the transcoding process by -;; `org-export-collect-tree-properties'. -;; -;; Dedicated functions focus on computing the value of specific tree -;; properties during initialization. Thus, -;; `org-export--populate-ignore-list' lists elements and objects that -;; should be skipped during export, `org-export--get-min-level' gets -;; the minimal exportable level, used as a basis to compute relative -;; level for headlines. Eventually -;; `org-export--collect-headline-numbering' builds an alist between -;; headlines and their numbering. - -(defun org-export-collect-tree-properties (data info) - "Extract tree properties from parse tree. - -DATA is the parse tree from which information is retrieved. INFO -is a list holding export options. - -Following tree properties are set or updated: - -`:exported-data' Hash table used to memoize results from - `org-export-data'. - -`:footnote-definition-alist' List of footnotes definitions in - original buffer and current parse tree. - -`:headline-offset' Offset between true level of headlines and - local level. An offset of -1 means a headline - of level 2 should be considered as a level - 1 headline in the context. - -`:headline-numbering' Alist of all headlines as key an the - associated numbering as value. - -`:ignore-list' List of elements that should be ignored during - export. - -Return updated plist." - ;; Install the parse tree in the communication channel, in order to - ;; use `org-export-get-genealogy' and al. - (setq info (plist-put info :parse-tree data)) - ;; Get the list of elements and objects to ignore, and put it into - ;; `:ignore-list'. Do not overwrite any user ignore that might have - ;; been done during parse tree filtering. - (setq info - (plist-put info - :ignore-list - (append (org-export--populate-ignore-list data info) - (plist-get info :ignore-list)))) - ;; Compute `:headline-offset' in order to be able to use - ;; `org-export-get-relative-level'. - (setq info - (plist-put info - :headline-offset - (- 1 (org-export--get-min-level data info)))) - ;; Update footnotes definitions list with definitions in parse tree. - ;; This is required since buffer expansion might have modified - ;; boundaries of footnote definitions contained in the parse tree. - ;; This way, definitions in `footnote-definition-alist' are bound to - ;; match those in the parse tree. - (let ((defs (plist-get info :footnote-definition-alist))) - (org-element-map data 'footnote-definition - (lambda (fn) - (push (cons (org-element-property :label fn) - `(org-data nil ,@(org-element-contents fn))) - defs))) - (setq info (plist-put info :footnote-definition-alist defs))) - ;; Properties order doesn't matter: get the rest of the tree - ;; properties. - (nconc - `(:headline-numbering ,(org-export--collect-headline-numbering data info) - :exported-data ,(make-hash-table :test 'eq :size 4001)) - info)) - -(defun org-export--get-min-level (data options) - "Return minimum exportable headline's level in DATA. -DATA is parsed tree as returned by `org-element-parse-buffer'. -OPTIONS is a plist holding export options." - (catch 'exit - (let ((min-level 10000)) - (mapc - (lambda (blob) - (when (and (eq (org-element-type blob) 'headline) - (not (org-element-property :footnote-section-p blob)) - (not (memq blob (plist-get options :ignore-list)))) - (setq min-level (min (org-element-property :level blob) min-level))) - (when (= min-level 1) (throw 'exit 1))) - (org-element-contents data)) - ;; If no headline was found, for the sake of consistency, set - ;; minimum level to 1 nonetheless. - (if (= min-level 10000) 1 min-level)))) - -(defun org-export--collect-headline-numbering (data options) - "Return numbering of all exportable headlines in a parse tree. - -DATA is the parse tree. OPTIONS is the plist holding export -options. - -Return an alist whose key is a headline and value is its -associated numbering \(in the shape of a list of numbers\) or nil -for a footnotes section." - (let ((numbering (make-vector org-export-max-depth 0))) - (org-element-map data 'headline - (lambda (headline) - (unless (org-element-property :footnote-section-p headline) - (let ((relative-level - (1- (org-export-get-relative-level headline options)))) - (cons - headline - (loop for n across numbering - for idx from 0 to org-export-max-depth - when (< idx relative-level) collect n - when (= idx relative-level) collect (aset numbering idx (1+ n)) - when (> idx relative-level) do (aset numbering idx 0)))))) - options))) - -(defun org-export--populate-ignore-list (data options) - "Return list of elements and objects to ignore during export. -DATA is the parse tree to traverse. OPTIONS is the plist holding -export options." - (let* (ignore - walk-data - ;; First find trees containing a select tag, if any. - (selected (org-export--selected-trees data options)) - (walk-data - (lambda (data) - ;; Collect ignored elements or objects into IGNORE-LIST. - (let ((type (org-element-type data))) - (if (org-export--skip-p data options selected) (push data ignore) - (if (and (eq type 'headline) - (eq (plist-get options :with-archived-trees) 'headline) - (org-element-property :archivedp data)) - ;; If headline is archived but tree below has - ;; to be skipped, add it to ignore list. - (mapc (lambda (e) (push e ignore)) - (org-element-contents data)) - ;; Move into secondary string, if any. - (let ((sec-prop - (cdr (assq type org-element-secondary-value-alist)))) - (when sec-prop - (mapc walk-data (org-element-property sec-prop data)))) - ;; Move into recursive objects/elements. - (mapc walk-data (org-element-contents data)))))))) - ;; Main call. - (funcall walk-data data) - ;; Return value. - ignore)) - -(defun org-export--selected-trees (data info) - "Return list of headlines and inlinetasks with a select tag in their tree. -DATA is parsed data as returned by `org-element-parse-buffer'. -INFO is a plist holding export options." - (let* (selected-trees - walk-data ; For byte-compiler. - (walk-data - (function - (lambda (data genealogy) - (let ((type (org-element-type data))) - (cond - ((memq type '(headline inlinetask)) - (let ((tags (org-element-property :tags data))) - (if (loop for tag in (plist-get info :select-tags) - thereis (member tag tags)) - ;; When a select tag is found, mark full - ;; genealogy and every headline within the tree - ;; as acceptable. - (setq selected-trees - (append - genealogy - (org-element-map data '(headline inlinetask) - 'identity) - selected-trees)) - ;; If at a headline, continue searching in tree, - ;; recursively. - (when (eq type 'headline) - (mapc (lambda (el) - (funcall walk-data el (cons data genealogy))) - (org-element-contents data)))))) - ((or (eq type 'org-data) - (memq type org-element-greater-elements)) - (mapc (lambda (el) (funcall walk-data el genealogy)) - (org-element-contents data))))))))) - (funcall walk-data data nil) - selected-trees)) - -(defun org-export--skip-p (blob options selected) - "Non-nil when element or object BLOB should be skipped during export. -OPTIONS is the plist holding export options. SELECTED, when -non-nil, is a list of headlines or inlinetasks belonging to -a tree with a select tag." - (case (org-element-type blob) - (clock (not (plist-get options :with-clocks))) - (drawer - (let ((with-drawers-p (plist-get options :with-drawers))) - (or (not with-drawers-p) - (and (consp with-drawers-p) - ;; If `:with-drawers' value starts with `not', ignore - ;; every drawer whose name belong to that list. - ;; Otherwise, ignore drawers whose name isn't in that - ;; list. - (let ((name (org-element-property :drawer-name blob))) - (if (eq (car with-drawers-p) 'not) - (member-ignore-case name (cdr with-drawers-p)) - (not (member-ignore-case name with-drawers-p)))))))) - ((footnote-definition footnote-reference) - (not (plist-get options :with-footnotes))) - ((headline inlinetask) - (let ((with-tasks (plist-get options :with-tasks)) - (todo (org-element-property :todo-keyword blob)) - (todo-type (org-element-property :todo-type blob)) - (archived (plist-get options :with-archived-trees)) - (tags (org-element-property :tags blob))) - (or - (and (eq (org-element-type blob) 'inlinetask) - (not (plist-get options :with-inlinetasks))) - ;; Ignore subtrees with an exclude tag. - (loop for k in (plist-get options :exclude-tags) - thereis (member k tags)) - ;; When a select tag is present in the buffer, ignore any tree - ;; without it. - (and selected (not (memq blob selected))) - ;; Ignore commented sub-trees. - (org-element-property :commentedp blob) - ;; Ignore archived subtrees if `:with-archived-trees' is nil. - (and (not archived) (org-element-property :archivedp blob)) - ;; Ignore tasks, if specified by `:with-tasks' property. - (and todo - (or (not with-tasks) - (and (memq with-tasks '(todo done)) - (not (eq todo-type with-tasks))) - (and (consp with-tasks) (not (member todo with-tasks)))))))) - ((latex-environment latex-fragment) (not (plist-get options :with-latex))) - (planning (not (plist-get options :with-planning))) - (statistics-cookie (not (plist-get options :with-statistics-cookies))) - (table-cell - (and (org-export-table-has-special-column-p - (org-export-get-parent-table blob)) - (not (org-export-get-previous-element blob options)))) - (table-row (org-export-table-row-is-special-p blob options)) - (timestamp - ;; `:with-timestamps' only applies to isolated timestamps - ;; objects, i.e. timestamp objects in a paragraph containing only - ;; timestamps and whitespaces. - (when (let ((parent (org-export-get-parent-element blob))) - (and (memq (org-element-type parent) '(paragraph verse-block)) - (not (org-element-map parent - (cons 'plain-text - (remq 'timestamp org-element-all-objects)) - (lambda (obj) - (or (not (stringp obj)) (org-string-nw-p obj))) - options t)))) - (case (plist-get options :with-timestamps) - ('nil t) - (active - (not (memq (org-element-property :type blob) '(active active-range)))) - (inactive - (not (memq (org-element-property :type blob) - '(inactive inactive-range))))))))) - - -;;; The Transcoder -;; -;; `org-export-data' reads a parse tree (obtained with, i.e. -;; `org-element-parse-buffer') and transcodes it into a specified -;; back-end output. It takes care of filtering out elements or -;; objects according to export options and organizing the output blank -;; lines and white space are preserved. The function memoizes its -;; results, so it is cheap to call it within transcoders. -;; -;; It is possible to modify locally the back-end used by -;; `org-export-data' or even use a temporary back-end by using -;; `org-export-data-with-backend'. -;; -;; Internally, three functions handle the filtering of objects and -;; elements during the export. In particular, -;; `org-export-ignore-element' marks an element or object so future -;; parse tree traversals skip it, `org-export--interpret-p' tells which -;; elements or objects should be seen as real Org syntax and -;; `org-export-expand' transforms the others back into their original -;; shape -;; -;; `org-export-transcoder' is an accessor returning appropriate -;; translator function for a given element or object. - -(defun org-export-transcoder (blob info) - "Return appropriate transcoder for BLOB. -INFO is a plist containing export directives." - (let ((type (org-element-type blob))) - ;; Return contents only for complete parse trees. - (if (eq type 'org-data) (lambda (blob contents info) contents) - (let ((transcoder (cdr (assq type (plist-get info :translate-alist))))) - (and (functionp transcoder) transcoder))))) - -(defun org-export-data (data info) - "Convert DATA into current back-end format. - -DATA is a parse tree, an element or an object or a secondary -string. INFO is a plist holding export options. - -Return transcoded string." - (let ((memo (gethash data (plist-get info :exported-data) 'no-memo))) - (if (not (eq memo 'no-memo)) memo - (let* ((type (org-element-type data)) - (results - (cond - ;; Ignored element/object. - ((memq data (plist-get info :ignore-list)) nil) - ;; Plain text. - ((eq type 'plain-text) - (org-export-filter-apply-functions - (plist-get info :filter-plain-text) - (let ((transcoder (org-export-transcoder data info))) - (if transcoder (funcall transcoder data info) data)) - info)) - ;; Uninterpreted element/object: change it back to Org - ;; syntax and export again resulting raw string. - ((not (org-export--interpret-p data info)) - (org-export-data - (org-export-expand - data - (mapconcat (lambda (blob) (org-export-data blob info)) - (org-element-contents data) - "")) - info)) - ;; Secondary string. - ((not type) - (mapconcat (lambda (obj) (org-export-data obj info)) data "")) - ;; Element/Object without contents or, as a special case, - ;; headline with archive tag and archived trees restricted - ;; to title only. - ((or (not (org-element-contents data)) - (and (eq type 'headline) - (eq (plist-get info :with-archived-trees) 'headline) - (org-element-property :archivedp data))) - (let ((transcoder (org-export-transcoder data info))) - (or (and (functionp transcoder) - (funcall transcoder data nil info)) - ;; Export snippets never return a nil value so - ;; that white spaces following them are never - ;; ignored. - (and (eq type 'export-snippet) "")))) - ;; Element/Object with contents. - (t - (let ((transcoder (org-export-transcoder data info))) - (when transcoder - (let* ((greaterp (memq type org-element-greater-elements)) - (objectp - (and (not greaterp) - (memq type org-element-recursive-objects))) - (contents - (mapconcat - (lambda (element) (org-export-data element info)) - (org-element-contents - (if (or greaterp objectp) data - ;; Elements directly containing objects - ;; must have their indentation normalized - ;; first. - (org-element-normalize-contents - data - ;; When normalizing contents of the first - ;; paragraph in an item or a footnote - ;; definition, ignore first line's - ;; indentation: there is none and it - ;; might be misleading. - (when (eq type 'paragraph) - (let ((parent (org-export-get-parent data))) - (and - (eq (car (org-element-contents parent)) - data) - (memq (org-element-type parent) - '(footnote-definition item)))))))) - ""))) - (funcall transcoder data - (if (not greaterp) contents - (org-element-normalize-string contents)) - info)))))))) - ;; Final result will be memoized before being returned. - (puthash - data - (cond - ((not results) nil) - ((memq type '(org-data plain-text nil)) results) - ;; Append the same white space between elements or objects as in - ;; the original buffer, and call appropriate filters. - (t - (let ((results - (org-export-filter-apply-functions - (plist-get info (intern (format ":filter-%s" type))) - (let ((post-blank (or (org-element-property :post-blank data) - 0))) - (if (memq type org-element-all-elements) - (concat (org-element-normalize-string results) - (make-string post-blank ?\n)) - (concat results (make-string post-blank ? )))) - info))) - results))) - (plist-get info :exported-data)))))) - -(defun org-export-data-with-backend (data backend info) - "Convert DATA into BACKEND format. - -DATA is an element, an object, a secondary string or a string. -BACKEND is a symbol. INFO is a plist used as a communication -channel. - -Unlike to `org-export-with-backend', this function will -recursively convert DATA using BACKEND translation table." - (when (symbolp backend) (setq backend (org-export-get-backend backend))) - (org-export-data - data - ;; Set-up a new communication channel with translations defined in - ;; BACKEND as the translate table and a new hash table for - ;; memoization. - (org-combine-plists - info - (list :back-end backend - :translate-alist (org-export-get-all-transcoders backend) - ;; Size of the hash table is reduced since this function - ;; will probably be used on small trees. - :exported-data (make-hash-table :test 'eq :size 401))))) - -(defun org-export--interpret-p (blob info) - "Non-nil if element or object BLOB should be interpreted during export. -If nil, BLOB will appear as raw Org syntax. Check is done -according to export options INFO, stored as a plist." - (case (org-element-type blob) - ;; ... entities... - (entity (plist-get info :with-entities)) - ;; ... emphasis... - ((bold italic strike-through underline) - (plist-get info :with-emphasize)) - ;; ... fixed-width areas. - (fixed-width (plist-get info :with-fixed-width)) - ;; ... LaTeX environments and fragments... - ((latex-environment latex-fragment) - (let ((with-latex-p (plist-get info :with-latex))) - (and with-latex-p (not (eq with-latex-p 'verbatim))))) - ;; ... sub/superscripts... - ((subscript superscript) - (let ((sub/super-p (plist-get info :with-sub-superscript))) - (if (eq sub/super-p '{}) - (org-element-property :use-brackets-p blob) - sub/super-p))) - ;; ... tables... - (table (plist-get info :with-tables)) - (otherwise t))) - -(defun org-export-expand (blob contents &optional with-affiliated) - "Expand a parsed element or object to its original state. - -BLOB is either an element or an object. CONTENTS is its -contents, as a string or nil. - -When optional argument WITH-AFFILIATED is non-nil, add affiliated -keywords before output." - (let ((type (org-element-type blob))) - (concat (and with-affiliated (memq type org-element-all-elements) - (org-element--interpret-affiliated-keywords blob)) - (funcall (intern (format "org-element-%s-interpreter" type)) - blob contents)))) - -(defun org-export-ignore-element (element info) - "Add ELEMENT to `:ignore-list' in INFO. - -Any element in `:ignore-list' will be skipped when using -`org-element-map'. INFO is modified by side effects." - (plist-put info :ignore-list (cons element (plist-get info :ignore-list)))) - - - -;;; The Filter System -;; -;; Filters allow end-users to tweak easily the transcoded output. -;; They are the functional counterpart of hooks, as every filter in -;; a set is applied to the return value of the previous one. -;; -;; Every set is back-end agnostic. Although, a filter is always -;; called, in addition to the string it applies to, with the back-end -;; used as argument, so it's easy for the end-user to add back-end -;; specific filters in the set. The communication channel, as -;; a plist, is required as the third argument. -;; -;; From the developer side, filters sets can be installed in the -;; process with the help of `org-export-define-backend', which -;; internally stores filters as an alist. Each association has a key -;; among the following symbols and a function or a list of functions -;; as value. -;; -;; - `:filter-options' applies to the property list containing export -;; options. Unlike to other filters, functions in this list accept -;; two arguments instead of three: the property list containing -;; export options and the back-end. Users can set its value through -;; `org-export-filter-options-functions' variable. -;; -;; - `:filter-parse-tree' applies directly to the complete parsed -;; tree. Users can set it through -;; `org-export-filter-parse-tree-functions' variable. -;; -;; - `:filter-final-output' applies to the final transcoded string. -;; Users can set it with `org-export-filter-final-output-functions' -;; variable -;; -;; - `:filter-plain-text' applies to any string not recognized as Org -;; syntax. `org-export-filter-plain-text-functions' allows users to -;; configure it. -;; -;; - `:filter-TYPE' applies on the string returned after an element or -;; object of type TYPE has been transcoded. A user can modify -;; `org-export-filter-TYPE-functions' -;; -;; All filters sets are applied with -;; `org-export-filter-apply-functions' function. Filters in a set are -;; applied in a LIFO fashion. It allows developers to be sure that -;; their filters will be applied first. -;; -;; Filters properties are installed in communication channel with -;; `org-export-install-filters' function. -;; -;; Eventually, two hooks (`org-export-before-processing-hook' and -;; `org-export-before-parsing-hook') are run at the beginning of the -;; export process and just before parsing to allow for heavy structure -;; modifications. - - -;;;; Hooks - -(defvar org-export-before-processing-hook nil - "Hook run at the beginning of the export process. - -This is run before include keywords and macros are expanded and -Babel code blocks executed, on a copy of the original buffer -being exported. Visibility and narrowing are preserved. Point -is at the beginning of the buffer. - -Every function in this hook will be called with one argument: the -back-end currently used, as a symbol.") - -(defvar org-export-before-parsing-hook nil - "Hook run before parsing an export buffer. - -This is run after include keywords and macros have been expanded -and Babel code blocks executed, on a copy of the original buffer -being exported. Visibility and narrowing are preserved. Point -is at the beginning of the buffer. - -Every function in this hook will be called with one argument: the -back-end currently used, as a symbol.") - - -;;;; Special Filters - -(defvar org-export-filter-options-functions nil - "List of functions applied to the export options. -Each filter is called with two arguments: the export options, as -a plist, and the back-end, as a symbol. It must return -a property list containing export options.") - -(defvar org-export-filter-parse-tree-functions nil - "List of functions applied to the parsed tree. -Each filter is called with three arguments: the parse tree, as -returned by `org-element-parse-buffer', the back-end, as -a symbol, and the communication channel, as a plist. It must -return the modified parse tree to transcode.") - -(defvar org-export-filter-plain-text-functions nil - "List of functions applied to plain text. -Each filter is called with three arguments: a string which -contains no Org syntax, the back-end, as a symbol, and the -communication channel, as a plist. It must return a string or -nil.") - -(defvar org-export-filter-final-output-functions nil - "List of functions applied to the transcoded string. -Each filter is called with three arguments: the full transcoded -string, the back-end, as a symbol, and the communication channel, -as a plist. It must return a string that will be used as the -final export output.") - - -;;;; Elements Filters - -(defvar org-export-filter-babel-call-functions nil - "List of functions applied to a transcoded babel-call. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-center-block-functions nil - "List of functions applied to a transcoded center block. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-clock-functions nil - "List of functions applied to a transcoded clock. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-comment-functions nil - "List of functions applied to a transcoded comment. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-comment-block-functions nil - "List of functions applied to a transcoded comment-block. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-diary-sexp-functions nil - "List of functions applied to a transcoded diary-sexp. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-drawer-functions nil - "List of functions applied to a transcoded drawer. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-dynamic-block-functions nil - "List of functions applied to a transcoded dynamic-block. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-example-block-functions nil - "List of functions applied to a transcoded example-block. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-export-block-functions nil - "List of functions applied to a transcoded export-block. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-fixed-width-functions nil - "List of functions applied to a transcoded fixed-width. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-footnote-definition-functions nil - "List of functions applied to a transcoded footnote-definition. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-headline-functions nil - "List of functions applied to a transcoded headline. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-horizontal-rule-functions nil - "List of functions applied to a transcoded horizontal-rule. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-inlinetask-functions nil - "List of functions applied to a transcoded inlinetask. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-item-functions nil - "List of functions applied to a transcoded item. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-keyword-functions nil - "List of functions applied to a transcoded keyword. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-latex-environment-functions nil - "List of functions applied to a transcoded latex-environment. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-node-property-functions nil - "List of functions applied to a transcoded node-property. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-paragraph-functions nil - "List of functions applied to a transcoded paragraph. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-plain-list-functions nil - "List of functions applied to a transcoded plain-list. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-planning-functions nil - "List of functions applied to a transcoded planning. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-property-drawer-functions nil - "List of functions applied to a transcoded property-drawer. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-quote-block-functions nil - "List of functions applied to a transcoded quote block. -Each filter is called with three arguments: the transcoded quote -data, as a string, the back-end, as a symbol, and the -communication channel, as a plist. It must return a string or -nil.") - -(defvar org-export-filter-quote-section-functions nil - "List of functions applied to a transcoded quote-section. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-section-functions nil - "List of functions applied to a transcoded section. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-special-block-functions nil - "List of functions applied to a transcoded special block. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-src-block-functions nil - "List of functions applied to a transcoded src-block. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-table-functions nil - "List of functions applied to a transcoded table. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-table-cell-functions nil - "List of functions applied to a transcoded table-cell. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-table-row-functions nil - "List of functions applied to a transcoded table-row. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-verse-block-functions nil - "List of functions applied to a transcoded verse block. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - - -;;;; Objects Filters - -(defvar org-export-filter-bold-functions nil - "List of functions applied to transcoded bold text. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-code-functions nil - "List of functions applied to transcoded code text. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-entity-functions nil - "List of functions applied to a transcoded entity. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-export-snippet-functions nil - "List of functions applied to a transcoded export-snippet. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-footnote-reference-functions nil - "List of functions applied to a transcoded footnote-reference. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-inline-babel-call-functions nil - "List of functions applied to a transcoded inline-babel-call. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-inline-src-block-functions nil - "List of functions applied to a transcoded inline-src-block. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-italic-functions nil - "List of functions applied to transcoded italic text. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-latex-fragment-functions nil - "List of functions applied to a transcoded latex-fragment. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-line-break-functions nil - "List of functions applied to a transcoded line-break. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-link-functions nil - "List of functions applied to a transcoded link. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-radio-target-functions nil - "List of functions applied to a transcoded radio-target. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-statistics-cookie-functions nil - "List of functions applied to a transcoded statistics-cookie. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-strike-through-functions nil - "List of functions applied to transcoded strike-through text. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-subscript-functions nil - "List of functions applied to a transcoded subscript. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-superscript-functions nil - "List of functions applied to a transcoded superscript. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-target-functions nil - "List of functions applied to a transcoded target. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-timestamp-functions nil - "List of functions applied to a transcoded timestamp. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-underline-functions nil - "List of functions applied to transcoded underline text. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - -(defvar org-export-filter-verbatim-functions nil - "List of functions applied to transcoded verbatim text. -Each filter is called with three arguments: the transcoded data, -as a string, the back-end, as a symbol, and the communication -channel, as a plist. It must return a string or nil.") - - -;;;; Filters Tools -;; -;; Internal function `org-export-install-filters' installs filters -;; hard-coded in back-ends (developer filters) and filters from global -;; variables (user filters) in the communication channel. -;; -;; Internal function `org-export-filter-apply-functions' takes care -;; about applying each filter in order to a given data. It ignores -;; filters returning a nil value but stops whenever a filter returns -;; an empty string. - -(defun org-export-filter-apply-functions (filters value info) - "Call every function in FILTERS. - -Functions are called with arguments VALUE, current export -back-end's name and INFO. A function returning a nil value will -be skipped. If it returns the empty string, the process ends and -VALUE is ignored. - -Call is done in a LIFO fashion, to be sure that developer -specified filters, if any, are called first." - (catch 'exit - (let* ((backend (plist-get info :back-end)) - (backend-name (and backend (org-export-backend-name backend)))) - (dolist (filter filters value) - (let ((result (funcall filter value backend-name info))) - (cond ((not result) value) - ((equal value "") (throw 'exit nil)) - (t (setq value result)))))))) - -(defun org-export-install-filters (info) - "Install filters properties in communication channel. -INFO is a plist containing the current communication channel. -Return the updated communication channel." - (let (plist) - ;; Install user-defined filters with `org-export-filters-alist' - ;; and filters already in INFO (through ext-plist mechanism). - (mapc (lambda (p) - (let* ((prop (car p)) - (info-value (plist-get info prop)) - (default-value (symbol-value (cdr p)))) - (setq plist - (plist-put plist prop - ;; Filters in INFO will be called - ;; before those user provided. - (append (if (listp info-value) info-value - (list info-value)) - default-value))))) - org-export-filters-alist) - ;; Prepend back-end specific filters to that list. - (mapc (lambda (p) - ;; Single values get consed, lists are appended. - (let ((key (car p)) (value (cdr p))) - (when value - (setq plist - (plist-put - plist key - (if (atom value) (cons value (plist-get plist key)) - (append value (plist-get plist key)))))))) - (org-export-get-all-filters (plist-get info :back-end))) - ;; Return new communication channel. - (org-combine-plists info plist))) - - - -;;; Core functions -;; -;; This is the room for the main function, `org-export-as', along with -;; its derivative, `org-export-string-as'. -;; `org-export--copy-to-kill-ring-p' determines if output of these -;; function should be added to kill ring. -;; -;; Note that `org-export-as' doesn't really parse the current buffer, -;; but a copy of it (with the same buffer-local variables and -;; visibility), where macros and include keywords are expanded and -;; Babel blocks are executed, if appropriate. -;; `org-export-with-buffer-copy' macro prepares that copy. -;; -;; File inclusion is taken care of by -;; `org-export-expand-include-keyword' and -;; `org-export--prepare-file-contents'. Structure wise, including -;; a whole Org file in a buffer often makes little sense. For -;; example, if the file contains a headline and the include keyword -;; was within an item, the item should contain the headline. That's -;; why file inclusion should be done before any structure can be -;; associated to the file, that is before parsing. -;; -;; `org-export-insert-default-template' is a command to insert -;; a default template (or a back-end specific template) at point or in -;; current subtree. - -(defun org-export-copy-buffer () - "Return a copy of the current buffer. -The copy preserves Org buffer-local variables, visibility and -narrowing." - (let ((copy-buffer-fun (org-export--generate-copy-script (current-buffer))) - (new-buf (generate-new-buffer (buffer-name)))) - (with-current-buffer new-buf - (funcall copy-buffer-fun) - (set-buffer-modified-p nil)) - new-buf)) - -(defmacro org-export-with-buffer-copy (&rest body) - "Apply BODY in a copy of the current buffer. -The copy preserves local variables, visibility and contents of -the original buffer. Point is at the beginning of the buffer -when BODY is applied." - (declare (debug t)) - (org-with-gensyms (buf-copy) - `(let ((,buf-copy (org-export-copy-buffer))) - (unwind-protect - (with-current-buffer ,buf-copy - (goto-char (point-min)) - (progn ,@body)) - (and (buffer-live-p ,buf-copy) - ;; Kill copy without confirmation. - (progn (with-current-buffer ,buf-copy - (restore-buffer-modified-p nil)) - (kill-buffer ,buf-copy))))))) - -(defun org-export--generate-copy-script (buffer) - "Generate a function duplicating BUFFER. - -The copy will preserve local variables, visibility, contents and -narrowing of the original buffer. If a region was active in -BUFFER, contents will be narrowed to that region instead. - -The resulting function can be evaled at a later time, from -another buffer, effectively cloning the original buffer there. - -The function assumes BUFFER's major mode is `org-mode'." - (with-current-buffer buffer - `(lambda () - (let ((inhibit-modification-hooks t)) - ;; Set major mode. Ignore `org-mode-hook' as it has been run - ;; already in BUFFER. - (let ((org-mode-hook nil) (org-inhibit-startup t)) (org-mode)) - ;; Copy specific buffer local variables and variables set - ;; through BIND keywords. - ,@(let ((bound-variables (org-export--list-bound-variables)) - vars) - (dolist (entry (buffer-local-variables (buffer-base-buffer)) vars) - (when (consp entry) - (let ((var (car entry)) - (val (cdr entry))) - (and (not (eq var 'org-font-lock-keywords)) - (or (memq var - '(default-directory - buffer-file-name - buffer-file-coding-system)) - (assq var bound-variables) - (string-match "^\\(org-\\|orgtbl-\\)" - (symbol-name var))) - ;; Skip unreadable values, as they cannot be - ;; sent to external process. - (or (not val) (ignore-errors (read (format "%S" val)))) - (push `(set (make-local-variable (quote ,var)) - (quote ,val)) - vars)))))) - ;; Whole buffer contents. - (insert - ,(org-with-wide-buffer - (buffer-substring-no-properties - (point-min) (point-max)))) - ;; Narrowing. - ,(if (org-region-active-p) - `(narrow-to-region ,(region-beginning) ,(region-end)) - `(narrow-to-region ,(point-min) ,(point-max))) - ;; Current position of point. - (goto-char ,(point)) - ;; Overlays with invisible property. - ,@(let (ov-set) - (mapc - (lambda (ov) - (let ((invis-prop (overlay-get ov 'invisible))) - (when invis-prop - (push `(overlay-put - (make-overlay ,(overlay-start ov) - ,(overlay-end ov)) - 'invisible (quote ,invis-prop)) - ov-set)))) - (overlays-in (point-min) (point-max))) - ov-set))))) - -;;;###autoload -(defun org-export-as - (backend &optional subtreep visible-only body-only ext-plist) - "Transcode current Org buffer into BACKEND code. - -BACKEND is either an export back-end, as returned by, e.g., -`org-export-create-backend', or a symbol referring to -a registered back-end. - -If narrowing is active in the current buffer, only transcode its -narrowed part. - -If a region is active, transcode that region. - -When optional argument SUBTREEP is non-nil, transcode the -sub-tree at point, extracting information from the headline -properties first. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -When optional argument BODY-ONLY is non-nil, only return body -code, without surrounding template. - -Optional argument EXT-PLIST, when provided, is a property list -with external parameters overriding Org default settings, but -still inferior to file-local settings. - -Return code as a string." - (when (symbolp backend) (setq backend (org-export-get-backend backend))) - (org-export-barf-if-invalid-backend backend) - (save-excursion - (save-restriction - ;; Narrow buffer to an appropriate region or subtree for - ;; parsing. If parsing subtree, be sure to remove main headline - ;; too. - (cond ((org-region-active-p) - (narrow-to-region (region-beginning) (region-end))) - (subtreep - (org-narrow-to-subtree) - (goto-char (point-min)) - (forward-line) - (narrow-to-region (point) (point-max)))) - ;; Initialize communication channel with original buffer - ;; attributes, unavailable in its copy. - (let* ((org-export-current-backend (org-export-backend-name backend)) - (info (org-combine-plists - (list :export-options - (delq nil - (list (and subtreep 'subtree) - (and visible-only 'visible-only) - (and body-only 'body-only)))) - (org-export--get-buffer-attributes))) - tree) - ;; Update communication channel and get parse tree. Buffer - ;; isn't parsed directly. Instead, a temporary copy is - ;; created, where include keywords, macros are expanded and - ;; code blocks are evaluated. - (org-export-with-buffer-copy - ;; Run first hook with current back-end's name as argument. - (run-hook-with-args 'org-export-before-processing-hook - (org-export-backend-name backend)) - (org-export-expand-include-keyword) - ;; Update macro templates since #+INCLUDE keywords might have - ;; added some new ones. - (org-macro-initialize-templates) - (org-macro-replace-all org-macro-templates) - (org-export-execute-babel-code) - ;; Update radio targets since keyword inclusion might have - ;; added some more. - (org-update-radio-target-regexp) - ;; Run last hook with current back-end's name as argument. - (goto-char (point-min)) - (save-excursion - (run-hook-with-args 'org-export-before-parsing-hook - (org-export-backend-name backend))) - ;; Update communication channel with environment. Also - ;; install user's and developer's filters. - (setq info - (org-export-install-filters - (org-combine-plists - info (org-export-get-environment backend subtreep ext-plist)))) - ;; Expand export-specific set of macros: {{{author}}}, - ;; {{{date}}}, {{{email}}} and {{{title}}}. It must be done - ;; once regular macros have been expanded, since document - ;; keywords may contain one of them. - (org-macro-replace-all - (list (cons "author" - (org-element-interpret-data (plist-get info :author))) - (cons "date" - (org-element-interpret-data (plist-get info :date))) - ;; EMAIL is not a parsed keyword: store it as-is. - (cons "email" (or (plist-get info :email) "")) - (cons "title" - (org-element-interpret-data (plist-get info :title))))) - ;; Call options filters and update export options. We do not - ;; use `org-export-filter-apply-functions' here since the - ;; arity of such filters is different. - (let ((backend-name (org-export-backend-name backend))) - (dolist (filter (plist-get info :filter-options)) - (let ((result (funcall filter info backend-name))) - (when result (setq info result))))) - ;; Parse buffer and call parse-tree filter on it. - (setq tree - (org-export-filter-apply-functions - (plist-get info :filter-parse-tree) - (org-element-parse-buffer nil visible-only) info)) - ;; Now tree is complete, compute its properties and add them - ;; to communication channel. - (setq info - (org-combine-plists - info (org-export-collect-tree-properties tree info))) - ;; Eventually transcode TREE. Wrap the resulting string into - ;; a template. - (let* ((body (org-element-normalize-string - (or (org-export-data tree info) ""))) - (inner-template (cdr (assq 'inner-template - (plist-get info :translate-alist)))) - (full-body (if (not (functionp inner-template)) body - (funcall inner-template body info))) - (template (cdr (assq 'template - (plist-get info :translate-alist))))) - ;; Remove all text properties since they cannot be - ;; retrieved from an external process. Finally call - ;; final-output filter and return result. - (org-no-properties - (org-export-filter-apply-functions - (plist-get info :filter-final-output) - (if (or (not (functionp template)) body-only) full-body - (funcall template full-body info)) - info)))))))) - -;;;###autoload -(defun org-export-string-as (string backend &optional body-only ext-plist) - "Transcode STRING into BACKEND code. - -BACKEND is either an export back-end, as returned by, e.g., -`org-export-create-backend', or a symbol referring to -a registered back-end. - -When optional argument BODY-ONLY is non-nil, only return body -code, without preamble nor postamble. - -Optional argument EXT-PLIST, when provided, is a property list -with external parameters overriding Org default settings, but -still inferior to file-local settings. - -Return code as a string." - (with-temp-buffer - (insert string) - (let ((org-inhibit-startup t)) (org-mode)) - (org-export-as backend nil nil body-only ext-plist))) - -;;;###autoload -(defun org-export-replace-region-by (backend) - "Replace the active region by its export to BACKEND. -BACKEND is either an export back-end, as returned by, e.g., -`org-export-create-backend', or a symbol referring to -a registered back-end." - (if (not (org-region-active-p)) - (user-error "No active region to replace") - (let* ((beg (region-beginning)) - (end (region-end)) - (str (buffer-substring beg end)) rpl) - (setq rpl (org-export-string-as str backend t)) - (delete-region beg end) - (insert rpl)))) - -;;;###autoload -(defun org-export-insert-default-template (&optional backend subtreep) - "Insert all export keywords with default values at beginning of line. - -BACKEND is a symbol referring to the name of a registered export -back-end, for which specific export options should be added to -the template, or `default' for default template. When it is nil, -the user will be prompted for a category. - -If SUBTREEP is non-nil, export configuration will be set up -locally for the subtree through node properties." - (interactive) - (unless (derived-mode-p 'org-mode) (user-error "Not in an Org mode buffer")) - (when (and subtreep (org-before-first-heading-p)) - (user-error "No subtree to set export options for")) - (let ((node (and subtreep (save-excursion (org-back-to-heading t) (point)))) - (backend - (or backend - (intern - (org-completing-read - "Options category: " - (cons "default" - (mapcar (lambda (b) - (symbol-name (org-export-backend-name b))) - org-export--registered-backends)))))) - options keywords) - ;; Populate OPTIONS and KEYWORDS. - (dolist (entry (cond ((eq backend 'default) org-export-options-alist) - ((org-export-backend-p backend) - (org-export-get-all-options backend)) - (t (org-export-get-all-options - (org-export-get-backend backend))))) - (let ((keyword (nth 1 entry)) - (option (nth 2 entry))) - (cond - (keyword (unless (assoc keyword keywords) - (let ((value - (if (eq (nth 4 entry) 'split) - (mapconcat 'identity (eval (nth 3 entry)) " ") - (eval (nth 3 entry))))) - (push (cons keyword value) keywords)))) - (option (unless (assoc option options) - (push (cons option (eval (nth 3 entry))) options)))))) - ;; Move to an appropriate location in order to insert options. - (unless subtreep (beginning-of-line)) - ;; First get TITLE, DATE, AUTHOR and EMAIL if they belong to the - ;; list of available keywords. - (when (assoc "TITLE" keywords) - (let ((title - (or (let ((visited-file (buffer-file-name (buffer-base-buffer)))) - (and visited-file - (file-name-sans-extension - (file-name-nondirectory visited-file)))) - (buffer-name (buffer-base-buffer))))) - (if (not subtreep) (insert (format "#+TITLE: %s\n" title)) - (org-entry-put node "EXPORT_TITLE" title)))) - (when (assoc "DATE" keywords) - (let ((date (with-temp-buffer (org-insert-time-stamp (current-time))))) - (if (not subtreep) (insert "#+DATE: " date "\n") - (org-entry-put node "EXPORT_DATE" date)))) - (when (assoc "AUTHOR" keywords) - (let ((author (cdr (assoc "AUTHOR" keywords)))) - (if subtreep (org-entry-put node "EXPORT_AUTHOR" author) - (insert - (format "#+AUTHOR:%s\n" - (if (not (org-string-nw-p author)) "" - (concat " " author))))))) - (when (assoc "EMAIL" keywords) - (let ((email (cdr (assoc "EMAIL" keywords)))) - (if subtreep (org-entry-put node "EXPORT_EMAIL" email) - (insert - (format "#+EMAIL:%s\n" - (if (not (org-string-nw-p email)) "" - (concat " " email))))))) - ;; Then (multiple) OPTIONS lines. Never go past fill-column. - (when options - (let ((items - (mapcar - #'(lambda (opt) (format "%s:%S" (car opt) (cdr opt))) - (sort options (lambda (k1 k2) (string< (car k1) (car k2))))))) - (if subtreep - (org-entry-put - node "EXPORT_OPTIONS" (mapconcat 'identity items " ")) - (while items - (insert "#+OPTIONS:") - (let ((width 10)) - (while (and items - (< (+ width (length (car items)) 1) fill-column)) - (let ((item (pop items))) - (insert " " item) - (incf width (1+ (length item)))))) - (insert "\n"))))) - ;; And the rest of keywords. - (dolist (key (sort keywords (lambda (k1 k2) (string< (car k1) (car k2))))) - (unless (member (car key) '("TITLE" "DATE" "AUTHOR" "EMAIL")) - (let ((val (cdr key))) - (if subtreep (org-entry-put node (concat "EXPORT_" (car key)) val) - (insert - (format "#+%s:%s\n" - (car key) - (if (org-string-nw-p val) (format " %s" val) ""))))))))) - -(defun org-export-expand-include-keyword (&optional included dir) - "Expand every include keyword in buffer. -Optional argument INCLUDED is a list of included file names along -with their line restriction, when appropriate. It is used to -avoid infinite recursion. Optional argument DIR is the current -working directory. It is used to properly resolve relative -paths." - (let ((case-fold-search t)) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t) - (let ((element (save-match-data (org-element-at-point)))) - (when (eq (org-element-type element) 'keyword) - (beginning-of-line) - ;; Extract arguments from keyword's value. - (let* ((value (org-element-property :value element)) - (ind (org-get-indentation)) - (file (and (string-match - "^\\(\".+?\"\\|\\S-+\\)\\(?:\\s-+\\|$\\)" value) - (prog1 (expand-file-name - (org-remove-double-quotes - (match-string 1 value)) - dir) - (setq value (replace-match "" nil nil value))))) - (lines - (and (string-match - ":lines +\"\\(\\(?:[0-9]+\\)?-\\(?:[0-9]+\\)?\\)\"" - value) - (prog1 (match-string 1 value) - (setq value (replace-match "" nil nil value))))) - (env (cond ((string-match "\\" value) 'example) - ((string-match "\\ level limit) (- level limit)))))) - -(defun org-export-get-headline-number (headline info) - "Return HEADLINE numbering as a list of numbers. -INFO is a plist holding contextual information." - (cdr (assoc headline (plist-get info :headline-numbering)))) - -(defun org-export-numbered-headline-p (headline info) - "Return a non-nil value if HEADLINE element should be numbered. -INFO is a plist used as a communication channel." - (let ((sec-num (plist-get info :section-numbers)) - (level (org-export-get-relative-level headline info))) - (if (wholenump sec-num) (<= level sec-num) sec-num))) - -(defun org-export-number-to-roman (n) - "Convert integer N into a roman numeral." - (let ((roman '((1000 . "M") (900 . "CM") (500 . "D") (400 . "CD") - ( 100 . "C") ( 90 . "XC") ( 50 . "L") ( 40 . "XL") - ( 10 . "X") ( 9 . "IX") ( 5 . "V") ( 4 . "IV") - ( 1 . "I"))) - (res "")) - (if (<= n 0) - (number-to-string n) - (while roman - (if (>= n (caar roman)) - (setq n (- n (caar roman)) - res (concat res (cdar roman))) - (pop roman))) - res))) - -(defun org-export-get-tags (element info &optional tags inherited) - "Return list of tags associated to ELEMENT. - -ELEMENT has either an `headline' or an `inlinetask' type. INFO -is a plist used as a communication channel. - -Select tags (see `org-export-select-tags') and exclude tags (see -`org-export-exclude-tags') are removed from the list. - -When non-nil, optional argument TAGS should be a list of strings. -Any tag belonging to this list will also be removed. - -When optional argument INHERITED is non-nil, tags can also be -inherited from parent headlines and FILETAGS keywords." - (org-remove-if - (lambda (tag) (or (member tag (plist-get info :select-tags)) - (member tag (plist-get info :exclude-tags)) - (member tag tags))) - (if (not inherited) (org-element-property :tags element) - ;; Build complete list of inherited tags. - (let ((current-tag-list (org-element-property :tags element))) - (mapc - (lambda (parent) - (mapc - (lambda (tag) - (when (and (memq (org-element-type parent) '(headline inlinetask)) - (not (member tag current-tag-list))) - (push tag current-tag-list))) - (org-element-property :tags parent))) - (org-export-get-genealogy element)) - ;; Add FILETAGS keywords and return results. - (org-uniquify (append (plist-get info :filetags) current-tag-list)))))) - -(defun org-export-get-node-property (property blob &optional inherited) - "Return node PROPERTY value for BLOB. - -PROPERTY is an upcase symbol (i.e. `:COOKIE_DATA'). BLOB is an -element or object. - -If optional argument INHERITED is non-nil, the value can be -inherited from a parent headline. - -Return value is a string or nil." - (let ((headline (if (eq (org-element-type blob) 'headline) blob - (org-export-get-parent-headline blob)))) - (if (not inherited) (org-element-property property blob) - (let ((parent headline) value) - (catch 'found - (while parent - (when (plist-member (nth 1 parent) property) - (throw 'found (org-element-property property parent))) - (setq parent (org-element-property :parent parent)))))))) - -(defun org-export-get-category (blob info) - "Return category for element or object BLOB. - -INFO is a plist used as a communication channel. - -CATEGORY is automatically inherited from a parent headline, from -#+CATEGORY: keyword or created out of original file name. If all -fail, the fall-back value is \"???\"." - (or (let ((headline (if (eq (org-element-type blob) 'headline) blob - (org-export-get-parent-headline blob)))) - ;; Almost like `org-export-node-property', but we cannot trust - ;; `plist-member' as every headline has a `:CATEGORY' - ;; property, would it be nil or equal to "???" (which has the - ;; same meaning). - (let ((parent headline) value) - (catch 'found - (while parent - (let ((category (org-element-property :CATEGORY parent))) - (and category (not (equal "???" category)) - (throw 'found category))) - (setq parent (org-element-property :parent parent)))))) - (org-element-map (plist-get info :parse-tree) 'keyword - (lambda (kwd) - (when (equal (org-element-property :key kwd) "CATEGORY") - (org-element-property :value kwd))) - info 'first-match) - (let ((file (plist-get info :input-file))) - (and file (file-name-sans-extension (file-name-nondirectory file)))) - "???")) - -(defun org-export-get-alt-title (headline info) - "Return alternative title for HEADLINE, as a secondary string. -INFO is a plist used as a communication channel. If no optional -title is defined, fall-back to the regular title." - (or (org-element-property :alt-title headline) - (org-element-property :title headline))) - -(defun org-export-first-sibling-p (headline info) - "Non-nil when HEADLINE is the first sibling in its sub-tree. -INFO is a plist used as a communication channel." - (not (eq (org-element-type (org-export-get-previous-element headline info)) - 'headline))) - -(defun org-export-last-sibling-p (headline info) - "Non-nil when HEADLINE is the last sibling in its sub-tree. -INFO is a plist used as a communication channel." - (not (org-export-get-next-element headline info))) - - -;;;; For Keywords -;; -;; `org-export-get-date' returns a date appropriate for the document -;; to about to be exported. In particular, it takes care of -;; `org-export-date-timestamp-format'. - -(defun org-export-get-date (info &optional fmt) - "Return date value for the current document. - -INFO is a plist used as a communication channel. FMT, when -non-nil, is a time format string that will be applied on the date -if it consists in a single timestamp object. It defaults to -`org-export-date-timestamp-format' when nil. - -A proper date can be a secondary string, a string or nil. It is -meant to be translated with `org-export-data' or alike." - (let ((date (plist-get info :date)) - (fmt (or fmt org-export-date-timestamp-format))) - (cond ((not date) nil) - ((and fmt - (not (cdr date)) - (eq (org-element-type (car date)) 'timestamp)) - (org-timestamp-format (car date) fmt)) - (t date)))) - - -;;;; For Links -;; -;; `org-export-solidify-link-text' turns a string into a safer version -;; for links, replacing most non-standard characters with hyphens. -;; -;; `org-export-get-coderef-format' returns an appropriate format -;; string for coderefs. -;; -;; `org-export-inline-image-p' returns a non-nil value when the link -;; provided should be considered as an inline image. -;; -;; `org-export-resolve-fuzzy-link' searches destination of fuzzy links -;; (i.e. links with "fuzzy" as type) within the parsed tree, and -;; returns an appropriate unique identifier when found, or nil. -;; -;; `org-export-resolve-id-link' returns the first headline with -;; specified id or custom-id in parse tree, the path to the external -;; file with the id or nil when neither was found. -;; -;; `org-export-resolve-coderef' associates a reference to a line -;; number in the element it belongs, or returns the reference itself -;; when the element isn't numbered. - -(defun org-export-solidify-link-text (s) - "Take link text S and make a safe target out of it." - (save-match-data - (mapconcat 'identity (org-split-string s "[^a-zA-Z0-9_.-:]+") "-"))) - -(defun org-export-get-coderef-format (path desc) - "Return format string for code reference link. -PATH is the link path. DESC is its description." - (save-match-data - (cond ((not desc) "%s") - ((string-match (regexp-quote (concat "(" path ")")) desc) - (replace-match "%s" t t desc)) - (t desc)))) - -(defun org-export-inline-image-p (link &optional rules) - "Non-nil if LINK object points to an inline image. - -Optional argument is a set of RULES defining inline images. It -is an alist where associations have the following shape: - - \(TYPE . REGEXP) - -Applying a rule means apply REGEXP against LINK's path when its -type is TYPE. The function will return a non-nil value if any of -the provided rules is non-nil. The default rule is -`org-export-default-inline-image-rule'. - -This only applies to links without a description." - (and (not (org-element-contents link)) - (let ((case-fold-search t) - (rules (or rules org-export-default-inline-image-rule))) - (catch 'exit - (mapc - (lambda (rule) - (and (string= (org-element-property :type link) (car rule)) - (string-match (cdr rule) - (org-element-property :path link)) - (throw 'exit t))) - rules) - ;; Return nil if no rule matched. - nil)))) - -(defun org-export-resolve-coderef (ref info) - "Resolve a code reference REF. - -INFO is a plist used as a communication channel. - -Return associated line number in source code, or REF itself, -depending on src-block or example element's switches." - (org-element-map (plist-get info :parse-tree) '(example-block src-block) - (lambda (el) - (with-temp-buffer - (insert (org-trim (org-element-property :value el))) - (let* ((label-fmt (regexp-quote - (or (org-element-property :label-fmt el) - org-coderef-label-format))) - (ref-re - (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)\\)[ \t]*$" - (replace-regexp-in-string "%s" ref label-fmt nil t)))) - ;; Element containing REF is found. Resolve it to either - ;; a label or a line number, as needed. - (when (re-search-backward ref-re nil t) - (cond - ((org-element-property :use-labels el) ref) - ((eq (org-element-property :number-lines el) 'continued) - (+ (org-export-get-loc el info) (line-number-at-pos))) - (t (line-number-at-pos))))))) - info 'first-match)) - -(defun org-export-resolve-fuzzy-link (link info) - "Return LINK destination. - -INFO is a plist holding contextual information. - -Return value can be an object, an element, or nil: - -- If LINK path matches a target object (i.e. <>) return it. - -- If LINK path exactly matches the name affiliated keyword - \(i.e. #+NAME: path) of an element, return that element. - -- If LINK path exactly matches any headline name, return that - element. If more than one headline share that name, priority - will be given to the one with the closest common ancestor, if - any, or the first one in the parse tree otherwise. - -- Otherwise, return nil. - -Assume LINK type is \"fuzzy\". White spaces are not -significant." - (let* ((raw-path (org-element-property :path link)) - (match-title-p (eq (aref raw-path 0) ?*)) - ;; Split PATH at white spaces so matches are space - ;; insensitive. - (path (org-split-string - (if match-title-p (substring raw-path 1) raw-path))) - ;; Cache for destinations that are not position dependent. - (link-cache - (or (plist-get info :resolve-fuzzy-link-cache) - (plist-get (setq info (plist-put info :resolve-fuzzy-link-cache - (make-hash-table :test 'equal))) - :resolve-fuzzy-link-cache))) - (cached (gethash path link-cache 'not-found))) - (cond - ;; Destination is not position dependent: use cached value. - ((and (not match-title-p) (not (eq cached 'not-found))) cached) - ;; First try to find a matching "<>" unless user specified - ;; he was looking for a headline (path starts with a "*" - ;; character). - ((and (not match-title-p) - (let ((match (org-element-map (plist-get info :parse-tree) 'target - (lambda (blob) - (and (equal (org-split-string - (org-element-property :value blob)) - path) - blob)) - info 'first-match))) - (and match (puthash path match link-cache))))) - ;; Then try to find an element with a matching "#+NAME: path" - ;; affiliated keyword. - ((and (not match-title-p) - (let ((match (org-element-map (plist-get info :parse-tree) - org-element-all-elements - (lambda (el) - (let ((name (org-element-property :name el))) - (when (and name - (equal (org-split-string name) path)) - el))) - info 'first-match))) - (and match (puthash path match link-cache))))) - ;; Last case: link either points to a headline or to nothingness. - ;; Try to find the source, with priority given to headlines with - ;; the closest common ancestor. If such candidate is found, - ;; return it, otherwise return nil. - (t - (let ((find-headline - (function - ;; Return first headline whose `:raw-value' property is - ;; NAME in parse tree DATA, or nil. Statistics cookies - ;; are ignored. - (lambda (name data) - (org-element-map data 'headline - (lambda (headline) - (when (equal (org-split-string - (replace-regexp-in-string - "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" "" - (org-element-property :raw-value headline))) - name) - headline)) - info 'first-match))))) - ;; Search among headlines sharing an ancestor with link, from - ;; closest to farthest. - (catch 'exit - (mapc - (lambda (parent) - (let ((foundp (funcall find-headline path parent))) - (when foundp (throw 'exit foundp)))) - (let ((parent-hl (org-export-get-parent-headline link))) - (if (not parent-hl) (list (plist-get info :parse-tree)) - (cons parent-hl (org-export-get-genealogy parent-hl))))) - ;; No destination found: return nil. - (and (not match-title-p) (puthash path nil link-cache)))))))) - -(defun org-export-resolve-id-link (link info) - "Return headline referenced as LINK destination. - -INFO is a plist used as a communication channel. - -Return value can be the headline element matched in current parse -tree, a file name or nil. Assume LINK type is either \"id\" or -\"custom-id\"." - (let ((id (org-element-property :path link))) - ;; First check if id is within the current parse tree. - (or (org-element-map (plist-get info :parse-tree) 'headline - (lambda (headline) - (when (or (string= (org-element-property :ID headline) id) - (string= (org-element-property :CUSTOM_ID headline) id)) - headline)) - info 'first-match) - ;; Otherwise, look for external files. - (cdr (assoc id (plist-get info :id-alist)))))) - -(defun org-export-resolve-radio-link (link info) - "Return radio-target object referenced as LINK destination. - -INFO is a plist used as a communication channel. - -Return value can be a radio-target object or nil. Assume LINK -has type \"radio\"." - (let ((path (replace-regexp-in-string - "[ \r\t\n]+" " " (org-element-property :path link)))) - (org-element-map (plist-get info :parse-tree) 'radio-target - (lambda (radio) - (and (eq (compare-strings - (replace-regexp-in-string - "[ \r\t\n]+" " " (org-element-property :value radio)) - nil nil path nil nil t) - t) - radio)) - info 'first-match))) - - -;;;; For References -;; -;; `org-export-get-ordinal' associates a sequence number to any object -;; or element. - -(defun org-export-get-ordinal (element info &optional types predicate) - "Return ordinal number of an element or object. - -ELEMENT is the element or object considered. INFO is the plist -used as a communication channel. - -Optional argument TYPES, when non-nil, is a list of element or -object types, as symbols, that should also be counted in. -Otherwise, only provided element's type is considered. - -Optional argument PREDICATE is a function returning a non-nil -value if the current element or object should be counted in. It -accepts two arguments: the element or object being considered and -the plist used as a communication channel. This allows to count -only a certain type of objects (i.e. inline images). - -Return value is a list of numbers if ELEMENT is a headline or an -item. It is nil for keywords. It represents the footnote number -for footnote definitions and footnote references. If ELEMENT is -a target, return the same value as if ELEMENT was the closest -table, item or headline containing the target. In any other -case, return the sequence number of ELEMENT among elements or -objects of the same type." - ;; Ordinal of a target object refer to the ordinal of the closest - ;; table, item, or headline containing the object. - (when (eq (org-element-type element) 'target) - (setq element - (loop for parent in (org-export-get-genealogy element) - when - (memq - (org-element-type parent) - '(footnote-definition footnote-reference headline item - table)) - return parent))) - (case (org-element-type element) - ;; Special case 1: A headline returns its number as a list. - (headline (org-export-get-headline-number element info)) - ;; Special case 2: An item returns its number as a list. - (item (let ((struct (org-element-property :structure element))) - (org-list-get-item-number - (org-element-property :begin element) - struct - (org-list-prevs-alist struct) - (org-list-parents-alist struct)))) - ((footnote-definition footnote-reference) - (org-export-get-footnote-number element info)) - (otherwise - (let ((counter 0)) - ;; Increment counter until ELEMENT is found again. - (org-element-map (plist-get info :parse-tree) - (or types (org-element-type element)) - (lambda (el) - (cond - ((eq element el) (1+ counter)) - ((not predicate) (incf counter) nil) - ((funcall predicate el info) (incf counter) nil))) - info 'first-match))))) - - -;;;; For Src-Blocks -;; -;; `org-export-get-loc' counts number of code lines accumulated in -;; src-block or example-block elements with a "+n" switch until -;; a given element, excluded. Note: "-n" switches reset that count. -;; -;; `org-export-unravel-code' extracts source code (along with a code -;; references alist) from an `element-block' or `src-block' type -;; element. -;; -;; `org-export-format-code' applies a formatting function to each line -;; of code, providing relative line number and code reference when -;; appropriate. Since it doesn't access the original element from -;; which the source code is coming, it expects from the code calling -;; it to know if lines should be numbered and if code references -;; should appear. -;; -;; Eventually, `org-export-format-code-default' is a higher-level -;; function (it makes use of the two previous functions) which handles -;; line numbering and code references inclusion, and returns source -;; code in a format suitable for plain text or verbatim output. - -(defun org-export-get-loc (element info) - "Return accumulated lines of code up to ELEMENT. - -INFO is the plist used as a communication channel. - -ELEMENT is excluded from count." - (let ((loc 0)) - (org-element-map (plist-get info :parse-tree) - `(src-block example-block ,(org-element-type element)) - (lambda (el) - (cond - ;; ELEMENT is reached: Quit the loop. - ((eq el element)) - ;; Only count lines from src-block and example-block elements - ;; with a "+n" or "-n" switch. A "-n" switch resets counter. - ((not (memq (org-element-type el) '(src-block example-block))) nil) - ((let ((linums (org-element-property :number-lines el))) - (when linums - ;; Accumulate locs or reset them. - (let ((lines (org-count-lines - (org-trim (org-element-property :value el))))) - (setq loc (if (eq linums 'new) lines (+ loc lines)))))) - ;; Return nil to stay in the loop. - nil))) - info 'first-match) - ;; Return value. - loc)) - -(defun org-export-unravel-code (element) - "Clean source code and extract references out of it. - -ELEMENT has either a `src-block' an `example-block' type. - -Return a cons cell whose CAR is the source code, cleaned from any -reference and protective comma and CDR is an alist between -relative line number (integer) and name of code reference on that -line (string)." - (let* ((line 0) refs - ;; Get code and clean it. Remove blank lines at its - ;; beginning and end. - (code (replace-regexp-in-string - "\\`\\([ \t]*\n\\)+" "" - (replace-regexp-in-string - "\\([ \t]*\n\\)*[ \t]*\\'" "\n" - (org-element-property :value element)))) - ;; Get format used for references. - (label-fmt (regexp-quote - (or (org-element-property :label-fmt element) - org-coderef-label-format))) - ;; Build a regexp matching a loc with a reference. - (with-ref-re - (format "^.*?\\S-.*?\\([ \t]*\\(%s\\)[ \t]*\\)$" - (replace-regexp-in-string - "%s" "\\([-a-zA-Z0-9_ ]+\\)" label-fmt nil t)))) - ;; Return value. - (cons - ;; Code with references removed. - (org-element-normalize-string - (mapconcat - (lambda (loc) - (incf line) - (if (not (string-match with-ref-re loc)) loc - ;; Ref line: remove ref, and signal its position in REFS. - (push (cons line (match-string 3 loc)) refs) - (replace-match "" nil nil loc 1))) - (org-split-string code "\n") "\n")) - ;; Reference alist. - refs))) - -(defun org-export-format-code (code fun &optional num-lines ref-alist) - "Format CODE by applying FUN line-wise and return it. - -CODE is a string representing the code to format. FUN is -a function. It must accept three arguments: a line of -code (string), the current line number (integer) or nil and the -reference associated to the current line (string) or nil. - -Optional argument NUM-LINES can be an integer representing the -number of code lines accumulated until the current code. Line -numbers passed to FUN will take it into account. If it is nil, -FUN's second argument will always be nil. This number can be -obtained with `org-export-get-loc' function. - -Optional argument REF-ALIST can be an alist between relative line -number (i.e. ignoring NUM-LINES) and the name of the code -reference on it. If it is nil, FUN's third argument will always -be nil. It can be obtained through the use of -`org-export-unravel-code' function." - (let ((--locs (org-split-string code "\n")) - (--line 0)) - (org-element-normalize-string - (mapconcat - (lambda (--loc) - (incf --line) - (let ((--ref (cdr (assq --line ref-alist)))) - (funcall fun --loc (and num-lines (+ num-lines --line)) --ref))) - --locs "\n")))) - -(defun org-export-format-code-default (element info) - "Return source code from ELEMENT, formatted in a standard way. - -ELEMENT is either a `src-block' or `example-block' element. INFO -is a plist used as a communication channel. - -This function takes care of line numbering and code references -inclusion. Line numbers, when applicable, appear at the -beginning of the line, separated from the code by two white -spaces. Code references, on the other hand, appear flushed to -the right, separated by six white spaces from the widest line of -code." - ;; Extract code and references. - (let* ((code-info (org-export-unravel-code element)) - (code (car code-info)) - (code-lines (org-split-string code "\n"))) - (if (null code-lines) "" - (let* ((refs (and (org-element-property :retain-labels element) - (cdr code-info))) - ;; Handle line numbering. - (num-start (case (org-element-property :number-lines element) - (continued (org-export-get-loc element info)) - (new 0))) - (num-fmt - (and num-start - (format "%%%ds " - (length (number-to-string - (+ (length code-lines) num-start)))))) - ;; Prepare references display, if required. Any reference - ;; should start six columns after the widest line of code, - ;; wrapped with parenthesis. - (max-width - (+ (apply 'max (mapcar 'length code-lines)) - (if (not num-start) 0 (length (format num-fmt num-start)))))) - (org-export-format-code - code - (lambda (loc line-num ref) - (let ((number-str (and num-fmt (format num-fmt line-num)))) - (concat - number-str - loc - (and ref - (concat (make-string - (- (+ 6 max-width) - (+ (length loc) (length number-str))) ? ) - (format "(%s)" ref)))))) - num-start refs))))) - - -;;;; For Tables -;; -;; `org-export-table-has-special-column-p' and and -;; `org-export-table-row-is-special-p' are predicates used to look for -;; meta-information about the table structure. -;; -;; `org-table-has-header-p' tells when the rows before the first rule -;; should be considered as table's header. -;; -;; `org-export-table-cell-width', `org-export-table-cell-alignment' -;; and `org-export-table-cell-borders' extract information from -;; a table-cell element. -;; -;; `org-export-table-dimensions' gives the number on rows and columns -;; in the table, ignoring horizontal rules and special columns. -;; `org-export-table-cell-address', given a table-cell object, returns -;; the absolute address of a cell. On the other hand, -;; `org-export-get-table-cell-at' does the contrary. -;; -;; `org-export-table-cell-starts-colgroup-p', -;; `org-export-table-cell-ends-colgroup-p', -;; `org-export-table-row-starts-rowgroup-p', -;; `org-export-table-row-ends-rowgroup-p', -;; `org-export-table-row-starts-header-p' and -;; `org-export-table-row-ends-header-p' indicate position of current -;; row or cell within the table. - -(defun org-export-table-has-special-column-p (table) - "Non-nil when TABLE has a special column. -All special columns will be ignored during export." - ;; The table has a special column when every first cell of every row - ;; has an empty value or contains a symbol among "/", "#", "!", "$", - ;; "*" "_" and "^". Though, do not consider a first row containing - ;; only empty cells as special. - (let ((special-column-p 'empty)) - (catch 'exit - (mapc - (lambda (row) - (when (eq (org-element-property :type row) 'standard) - (let ((value (org-element-contents - (car (org-element-contents row))))) - (cond ((member value '(("/") ("#") ("!") ("$") ("*") ("_") ("^"))) - (setq special-column-p 'special)) - ((not value)) - (t (throw 'exit nil)))))) - (org-element-contents table)) - (eq special-column-p 'special)))) - -(defun org-export-table-has-header-p (table info) - "Non-nil when TABLE has a header. - -INFO is a plist used as a communication channel. - -A table has a header when it contains at least two row groups." - (let ((cache (or (plist-get info :table-header-cache) - (plist-get (setq info - (plist-put info :table-header-cache - (make-hash-table :test 'eq))) - :table-header-cache)))) - (or (gethash table cache) - (let ((rowgroup 1) row-flag) - (puthash - table - (org-element-map table 'table-row - (lambda (row) - (cond - ((> rowgroup 1) t) - ((and row-flag (eq (org-element-property :type row) 'rule)) - (incf rowgroup) (setq row-flag nil)) - ((and (not row-flag) (eq (org-element-property :type row) - 'standard)) - (setq row-flag t) nil))) - info 'first-match) - cache))))) - -(defun org-export-table-row-is-special-p (table-row info) - "Non-nil if TABLE-ROW is considered special. - -INFO is a plist used as the communication channel. - -All special rows will be ignored during export." - (when (eq (org-element-property :type table-row) 'standard) - (let ((first-cell (org-element-contents - (car (org-element-contents table-row))))) - ;; A row is special either when... - (or - ;; ... it starts with a field only containing "/", - (equal first-cell '("/")) - ;; ... the table contains a special column and the row start - ;; with a marking character among, "^", "_", "$" or "!", - (and (org-export-table-has-special-column-p - (org-export-get-parent table-row)) - (member first-cell '(("^") ("_") ("$") ("!")))) - ;; ... it contains only alignment cookies and empty cells. - (let ((special-row-p 'empty)) - (catch 'exit - (mapc - (lambda (cell) - (let ((value (org-element-contents cell))) - ;; Since VALUE is a secondary string, the following - ;; checks avoid expanding it with `org-export-data'. - (cond ((not value)) - ((and (not (cdr value)) - (stringp (car value)) - (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" - (car value))) - (setq special-row-p 'cookie)) - (t (throw 'exit nil))))) - (org-element-contents table-row)) - (eq special-row-p 'cookie))))))) - -(defun org-export-table-row-group (table-row info) - "Return TABLE-ROW's group number, as an integer. - -INFO is a plist used as the communication channel. - -Return value is the group number, as an integer, or nil for -special rows and rows separators. First group is also table's -header." - (let ((cache (or (plist-get info :table-row-group-cache) - (plist-get (setq info - (plist-put info :table-row-group-cache - (make-hash-table :test 'eq))) - :table-row-group-cache)))) - (cond ((gethash table-row cache)) - ((eq (org-element-property :type table-row) 'rule) nil) - (t (let ((group 0) row-flag) - (org-element-map (org-export-get-parent table-row) 'table-row - (lambda (row) - (if (eq (org-element-property :type row) 'rule) - (setq row-flag nil) - (unless row-flag (incf group) (setq row-flag t))) - (when (eq table-row row) (puthash table-row group cache))) - info 'first-match)))))) - -(defun org-export-table-cell-width (table-cell info) - "Return TABLE-CELL contents width. - -INFO is a plist used as the communication channel. - -Return value is the width given by the last width cookie in the -same column as TABLE-CELL, or nil." - (let* ((row (org-export-get-parent table-cell)) - (table (org-export-get-parent row)) - (cells (org-element-contents row)) - (columns (length cells)) - (column (- columns (length (memq table-cell cells)))) - (cache (or (plist-get info :table-cell-width-cache) - (plist-get (setq info - (plist-put info :table-cell-width-cache - (make-hash-table :test 'eq))) - :table-cell-width-cache))) - (width-vector (or (gethash table cache) - (puthash table (make-vector columns 'empty) cache))) - (value (aref width-vector column))) - (if (not (eq value 'empty)) value - (let (cookie-width) - (dolist (row (org-element-contents table) - (aset width-vector column cookie-width)) - (when (org-export-table-row-is-special-p row info) - ;; In a special row, try to find a width cookie at COLUMN. - (let* ((value (org-element-contents - (elt (org-element-contents row) column))) - (cookie (car value))) - ;; The following checks avoid expanding unnecessarily - ;; the cell with `org-export-data'. - (when (and value - (not (cdr value)) - (stringp cookie) - (string-match "\\`<[lrc]?\\([0-9]+\\)?>\\'" cookie) - (match-string 1 cookie)) - (setq cookie-width - (string-to-number (match-string 1 cookie))))))))))) - -(defun org-export-table-cell-alignment (table-cell info) - "Return TABLE-CELL contents alignment. - -INFO is a plist used as the communication channel. - -Return alignment as specified by the last alignment cookie in the -same column as TABLE-CELL. If no such cookie is found, a default -alignment value will be deduced from fraction of numbers in the -column (see `org-table-number-fraction' for more information). -Possible values are `left', `right' and `center'." - ;; Load `org-table-number-fraction' and `org-table-number-regexp'. - (require 'org-table) - (let* ((row (org-export-get-parent table-cell)) - (table (org-export-get-parent row)) - (cells (org-element-contents row)) - (columns (length cells)) - (column (- columns (length (memq table-cell cells)))) - (cache (or (plist-get info :table-cell-alignment-cache) - (plist-get (setq info - (plist-put info :table-cell-alignment-cache - (make-hash-table :test 'eq))) - :table-cell-alignment-cache))) - (align-vector (or (gethash table cache) - (puthash table (make-vector columns nil) cache)))) - (or (aref align-vector column) - (let ((number-cells 0) - (total-cells 0) - cookie-align - previous-cell-number-p) - (dolist (row (org-element-contents (org-export-get-parent row))) - (cond - ;; In a special row, try to find an alignment cookie at - ;; COLUMN. - ((org-export-table-row-is-special-p row info) - (let ((value (org-element-contents - (elt (org-element-contents row) column)))) - ;; Since VALUE is a secondary string, the following - ;; checks avoid useless expansion through - ;; `org-export-data'. - (when (and value - (not (cdr value)) - (stringp (car value)) - (string-match "\\`<\\([lrc]\\)?\\([0-9]+\\)?>\\'" - (car value)) - (match-string 1 (car value))) - (setq cookie-align (match-string 1 (car value)))))) - ;; Ignore table rules. - ((eq (org-element-property :type row) 'rule)) - ;; In a standard row, check if cell's contents are - ;; expressing some kind of number. Increase NUMBER-CELLS - ;; accordingly. Though, don't bother if an alignment - ;; cookie has already defined cell's alignment. - ((not cookie-align) - (let ((value (org-export-data - (org-element-contents - (elt (org-element-contents row) column)) - info))) - (incf total-cells) - ;; Treat an empty cell as a number if it follows - ;; a number. - (if (not (or (string-match org-table-number-regexp value) - (and (string= value "") previous-cell-number-p))) - (setq previous-cell-number-p nil) - (setq previous-cell-number-p t) - (incf number-cells)))))) - ;; Return value. Alignment specified by cookies has - ;; precedence over alignment deduced from cell's contents. - (aset align-vector - column - (cond ((equal cookie-align "l") 'left) - ((equal cookie-align "r") 'right) - ((equal cookie-align "c") 'center) - ((>= (/ (float number-cells) total-cells) - org-table-number-fraction) - 'right) - (t 'left))))))) - -(defun org-export-table-cell-borders (table-cell info) - "Return TABLE-CELL borders. - -INFO is a plist used as a communication channel. - -Return value is a list of symbols, or nil. Possible values are: -`top', `bottom', `above', `below', `left' and `right'. Note: -`top' (resp. `bottom') only happen for a cell in the first -row (resp. last row) of the table, ignoring table rules, if any. - -Returned borders ignore special rows." - (let* ((row (org-export-get-parent table-cell)) - (table (org-export-get-parent-table table-cell)) - borders) - ;; Top/above border? TABLE-CELL has a border above when a rule - ;; used to demarcate row groups can be found above. Hence, - ;; finding a rule isn't sufficient to push `above' in BORDERS: - ;; another regular row has to be found above that rule. - (let (rule-flag) - (catch 'exit - (mapc (lambda (row) - (cond ((eq (org-element-property :type row) 'rule) - (setq rule-flag t)) - ((not (org-export-table-row-is-special-p row info)) - (if rule-flag (throw 'exit (push 'above borders)) - (throw 'exit nil))))) - ;; Look at every row before the current one. - (cdr (memq row (reverse (org-element-contents table))))) - ;; No rule above, or rule found starts the table (ignoring any - ;; special row): TABLE-CELL is at the top of the table. - (when rule-flag (push 'above borders)) - (push 'top borders))) - ;; Bottom/below border? TABLE-CELL has a border below when next - ;; non-regular row below is a rule. - (let (rule-flag) - (catch 'exit - (mapc (lambda (row) - (cond ((eq (org-element-property :type row) 'rule) - (setq rule-flag t)) - ((not (org-export-table-row-is-special-p row info)) - (if rule-flag (throw 'exit (push 'below borders)) - (throw 'exit nil))))) - ;; Look at every row after the current one. - (cdr (memq row (org-element-contents table)))) - ;; No rule below, or rule found ends the table (modulo some - ;; special row): TABLE-CELL is at the bottom of the table. - (when rule-flag (push 'below borders)) - (push 'bottom borders))) - ;; Right/left borders? They can only be specified by column - ;; groups. Column groups are defined in a row starting with "/". - ;; Also a column groups row only contains "<", "<>", ">" or blank - ;; cells. - (catch 'exit - (let ((column (let ((cells (org-element-contents row))) - (- (length cells) (length (memq table-cell cells)))))) - (mapc - (lambda (row) - (unless (eq (org-element-property :type row) 'rule) - (when (equal (org-element-contents - (car (org-element-contents row))) - '("/")) - (let ((column-groups - (mapcar - (lambda (cell) - (let ((value (org-element-contents cell))) - (when (member value '(("<") ("<>") (">") nil)) - (car value)))) - (org-element-contents row)))) - ;; There's a left border when previous cell, if - ;; any, ends a group, or current one starts one. - (when (or (and (not (zerop column)) - (member (elt column-groups (1- column)) - '(">" "<>"))) - (member (elt column-groups column) '("<" "<>"))) - (push 'left borders)) - ;; There's a right border when next cell, if any, - ;; starts a group, or current one ends one. - (when (or (and (/= (1+ column) (length column-groups)) - (member (elt column-groups (1+ column)) - '("<" "<>"))) - (member (elt column-groups column) '(">" "<>"))) - (push 'right borders)) - (throw 'exit nil))))) - ;; Table rows are read in reverse order so last column groups - ;; row has precedence over any previous one. - (reverse (org-element-contents table))))) - ;; Return value. - borders)) - -(defun org-export-table-cell-starts-colgroup-p (table-cell info) - "Non-nil when TABLE-CELL is at the beginning of a row group. -INFO is a plist used as a communication channel." - ;; A cell starts a column group either when it is at the beginning - ;; of a row (or after the special column, if any) or when it has - ;; a left border. - (or (eq (org-element-map (org-export-get-parent table-cell) 'table-cell - 'identity info 'first-match) - table-cell) - (memq 'left (org-export-table-cell-borders table-cell info)))) - -(defun org-export-table-cell-ends-colgroup-p (table-cell info) - "Non-nil when TABLE-CELL is at the end of a row group. -INFO is a plist used as a communication channel." - ;; A cell ends a column group either when it is at the end of a row - ;; or when it has a right border. - (or (eq (car (last (org-element-contents - (org-export-get-parent table-cell)))) - table-cell) - (memq 'right (org-export-table-cell-borders table-cell info)))) - -(defun org-export-table-row-starts-rowgroup-p (table-row info) - "Non-nil when TABLE-ROW is at the beginning of a column group. -INFO is a plist used as a communication channel." - (unless (or (eq (org-element-property :type table-row) 'rule) - (org-export-table-row-is-special-p table-row info)) - (let ((borders (org-export-table-cell-borders - (car (org-element-contents table-row)) info))) - (or (memq 'top borders) (memq 'above borders))))) - -(defun org-export-table-row-ends-rowgroup-p (table-row info) - "Non-nil when TABLE-ROW is at the end of a column group. -INFO is a plist used as a communication channel." - (unless (or (eq (org-element-property :type table-row) 'rule) - (org-export-table-row-is-special-p table-row info)) - (let ((borders (org-export-table-cell-borders - (car (org-element-contents table-row)) info))) - (or (memq 'bottom borders) (memq 'below borders))))) - -(defun org-export-table-row-starts-header-p (table-row info) - "Non-nil when TABLE-ROW is the first table header's row. -INFO is a plist used as a communication channel." - (and (org-export-table-has-header-p - (org-export-get-parent-table table-row) info) - (org-export-table-row-starts-rowgroup-p table-row info) - (= (org-export-table-row-group table-row info) 1))) - -(defun org-export-table-row-ends-header-p (table-row info) - "Non-nil when TABLE-ROW is the last table header's row. -INFO is a plist used as a communication channel." - (and (org-export-table-has-header-p - (org-export-get-parent-table table-row) info) - (org-export-table-row-ends-rowgroup-p table-row info) - (= (org-export-table-row-group table-row info) 1))) - -(defun org-export-table-row-number (table-row info) - "Return TABLE-ROW number. -INFO is a plist used as a communication channel. Return value is -zero-based and ignores separators. The function returns nil for -special colums and separators." - (when (and (eq (org-element-property :type table-row) 'standard) - (not (org-export-table-row-is-special-p table-row info))) - (let ((number 0)) - (org-element-map (org-export-get-parent-table table-row) 'table-row - (lambda (row) - (cond ((eq row table-row) number) - ((eq (org-element-property :type row) 'standard) - (incf number) nil))) - info 'first-match)))) - -(defun org-export-table-dimensions (table info) - "Return TABLE dimensions. - -INFO is a plist used as a communication channel. - -Return value is a CONS like (ROWS . COLUMNS) where -ROWS (resp. COLUMNS) is the number of exportable -rows (resp. columns)." - (let (first-row (columns 0) (rows 0)) - ;; Set number of rows, and extract first one. - (org-element-map table 'table-row - (lambda (row) - (when (eq (org-element-property :type row) 'standard) - (incf rows) - (unless first-row (setq first-row row)))) info) - ;; Set number of columns. - (org-element-map first-row 'table-cell (lambda (cell) (incf columns)) info) - ;; Return value. - (cons rows columns))) - -(defun org-export-table-cell-address (table-cell info) - "Return address of a regular TABLE-CELL object. - -TABLE-CELL is the cell considered. INFO is a plist used as -a communication channel. - -Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are -zero-based index. Only exportable cells are considered. The -function returns nil for other cells." - (let* ((table-row (org-export-get-parent table-cell)) - (row-number (org-export-table-row-number table-row info))) - (when row-number - (cons row-number - (let ((col-count 0)) - (org-element-map table-row 'table-cell - (lambda (cell) - (if (eq cell table-cell) col-count (incf col-count) nil)) - info 'first-match)))))) - -(defun org-export-get-table-cell-at (address table info) - "Return regular table-cell object at ADDRESS in TABLE. - -Address is a CONS cell (ROW . COLUMN), where ROW and COLUMN are -zero-based index. TABLE is a table type element. INFO is -a plist used as a communication channel. - -If no table-cell, among exportable cells, is found at ADDRESS, -return nil." - (let ((column-pos (cdr address)) (column-count 0)) - (org-element-map - ;; Row at (car address) or nil. - (let ((row-pos (car address)) (row-count 0)) - (org-element-map table 'table-row - (lambda (row) - (cond ((eq (org-element-property :type row) 'rule) nil) - ((= row-count row-pos) row) - (t (incf row-count) nil))) - info 'first-match)) - 'table-cell - (lambda (cell) - (if (= column-count column-pos) cell - (incf column-count) nil)) - info 'first-match))) - - -;;;; For Tables Of Contents -;; -;; `org-export-collect-headlines' builds a list of all exportable -;; headline elements, maybe limited to a certain depth. One can then -;; easily parse it and transcode it. -;; -;; Building lists of tables, figures or listings is quite similar. -;; Once the generic function `org-export-collect-elements' is defined, -;; `org-export-collect-tables', `org-export-collect-figures' and -;; `org-export-collect-listings' can be derived from it. - -(defun org-export-collect-headlines (info &optional n) - "Collect headlines in order to build a table of contents. - -INFO is a plist used as a communication channel. - -When optional argument N is an integer, it specifies the depth of -the table of contents. Otherwise, it is set to the value of the -last headline level. See `org-export-headline-levels' for more -information. - -Return a list of all exportable headlines as parsed elements. -Footnote sections, if any, will be ignored." - (let ((limit (plist-get info :headline-levels))) - (setq n (if (wholenump n) (min n limit) limit)) - (org-element-map (plist-get info :parse-tree) 'headline - #'(lambda (headline) - (unless (org-element-property :footnote-section-p headline) - (let ((level (org-export-get-relative-level headline info))) - (and (<= level n) headline)))) - info))) - -(defun org-export-collect-elements (type info &optional predicate) - "Collect referenceable elements of a determined type. - -TYPE can be a symbol or a list of symbols specifying element -types to search. Only elements with a caption are collected. - -INFO is a plist used as a communication channel. - -When non-nil, optional argument PREDICATE is a function accepting -one argument, an element of type TYPE. It returns a non-nil -value when that element should be collected. - -Return a list of all elements found, in order of appearance." - (org-element-map (plist-get info :parse-tree) type - (lambda (element) - (and (org-element-property :caption element) - (or (not predicate) (funcall predicate element)) - element)) - info)) - -(defun org-export-collect-tables (info) - "Build a list of tables. -INFO is a plist used as a communication channel. - -Return a list of table elements with a caption." - (org-export-collect-elements 'table info)) - -(defun org-export-collect-figures (info predicate) - "Build a list of figures. - -INFO is a plist used as a communication channel. PREDICATE is -a function which accepts one argument: a paragraph element and -whose return value is non-nil when that element should be -collected. - -A figure is a paragraph type element, with a caption, verifying -PREDICATE. The latter has to be provided since a \"figure\" is -a vague concept that may depend on back-end. - -Return a list of elements recognized as figures." - (org-export-collect-elements 'paragraph info predicate)) - -(defun org-export-collect-listings (info) - "Build a list of src blocks. - -INFO is a plist used as a communication channel. - -Return a list of src-block elements with a caption." - (org-export-collect-elements 'src-block info)) - - -;;;; Smart Quotes -;; -;; The main function for the smart quotes sub-system is -;; `org-export-activate-smart-quotes', which replaces every quote in -;; a given string from the parse tree with its "smart" counterpart. -;; -;; Dictionary for smart quotes is stored in -;; `org-export-smart-quotes-alist'. -;; -;; Internally, regexps matching potential smart quotes (checks at -;; string boundaries are also necessary) are defined in -;; `org-export-smart-quotes-regexps'. - -(defconst org-export-smart-quotes-alist - '(("da" - ;; one may use: »...«, "...", ›...‹, or '...'. - ;; http://sproget.dk/raad-og-regler/retskrivningsregler/retskrivningsregler/a7-40-60/a7-58-anforselstegn/ - ;; LaTeX quotes require Babel! - (opening-double-quote :utf-8 "»" :html "»" :latex ">>" - :texinfo "@guillemetright{}") - (closing-double-quote :utf-8 "«" :html "«" :latex "<<" - :texinfo "@guillemetleft{}") - (opening-single-quote :utf-8 "›" :html "›" :latex "\\frq{}" - :texinfo "@guilsinglright{}") - (closing-single-quote :utf-8 "‹" :html "‹" :latex "\\flq{}" - :texinfo "@guilsingleft{}") - (apostrophe :utf-8 "’" :html "’")) - ("de" - (opening-double-quote :utf-8 "„" :html "„" :latex "\"`" - :texinfo "@quotedblbase{}") - (closing-double-quote :utf-8 "“" :html "“" :latex "\"'" - :texinfo "@quotedblleft{}") - (opening-single-quote :utf-8 "‚" :html "‚" :latex "\\glq{}" - :texinfo "@quotesinglbase{}") - (closing-single-quote :utf-8 "‘" :html "‘" :latex "\\grq{}" - :texinfo "@quoteleft{}") - (apostrophe :utf-8 "’" :html "’")) - ("en" - (opening-double-quote :utf-8 "“" :html "“" :latex "``" :texinfo "``") - (closing-double-quote :utf-8 "”" :html "”" :latex "''" :texinfo "''") - (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") - (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") - (apostrophe :utf-8 "’" :html "’")) - ("es" - (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" - :texinfo "@guillemetleft{}") - (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" - :texinfo "@guillemetright{}") - (opening-single-quote :utf-8 "“" :html "“" :latex "``" :texinfo "``") - (closing-single-quote :utf-8 "”" :html "”" :latex "''" :texinfo "''") - (apostrophe :utf-8 "’" :html "’")) - ("fr" - (opening-double-quote :utf-8 "« " :html "« " :latex "\\og " - :texinfo "@guillemetleft{}@tie{}") - (closing-double-quote :utf-8 " »" :html " »" :latex "\\fg{}" - :texinfo "@tie{}@guillemetright{}") - (opening-single-quote :utf-8 "« " :html "« " :latex "\\og " - :texinfo "@guillemetleft{}@tie{}") - (closing-single-quote :utf-8 " »" :html " »" :latex "\\fg{}" - :texinfo "@tie{}@guillemetright{}") - (apostrophe :utf-8 "’" :html "’")) - ("no" - ;; https://nn.wikipedia.org/wiki/Sitatteikn - (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" - :texinfo "@guillemetleft{}") - (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" - :texinfo "@guillemetright{}") - (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") - (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") - (apostrophe :utf-8 "’" :html "’")) - ("nb" - ;; https://nn.wikipedia.org/wiki/Sitatteikn - (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" - :texinfo "@guillemetleft{}") - (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" - :texinfo "@guillemetright{}") - (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") - (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") - (apostrophe :utf-8 "’" :html "’")) - ("nn" - ;; https://nn.wikipedia.org/wiki/Sitatteikn - (opening-double-quote :utf-8 "«" :html "«" :latex "\\guillemotleft{}" - :texinfo "@guillemetleft{}") - (closing-double-quote :utf-8 "»" :html "»" :latex "\\guillemotright{}" - :texinfo "@guillemetright{}") - (opening-single-quote :utf-8 "‘" :html "‘" :latex "`" :texinfo "`") - (closing-single-quote :utf-8 "’" :html "’" :latex "'" :texinfo "'") - (apostrophe :utf-8 "’" :html "’")) - ("sv" - ;; based on https://sv.wikipedia.org/wiki/Citattecken - (opening-double-quote :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") - (closing-double-quote :utf-8 "”" :html "”" :latex "’’" :texinfo "’’") - (opening-single-quote :utf-8 "’" :html "’" :latex "’" :texinfo "`") - (closing-single-quote :utf-8 "’" :html "’" :latex "’" :texinfo "'") - (apostrophe :utf-8 "’" :html "’")) - ) - "Smart quotes translations. - -Alist whose CAR is a language string and CDR is an alist with -quote type as key and a plist associating various encodings to -their translation as value. - -A quote type can be any symbol among `opening-double-quote', -`closing-double-quote', `opening-single-quote', -`closing-single-quote' and `apostrophe'. - -Valid encodings include `:utf-8', `:html', `:latex' and -`:texinfo'. - -If no translation is found, the quote character is left as-is.") - -(defconst org-export-smart-quotes-regexps - (list - ;; Possible opening quote at beginning of string. - "\\`\\([\"']\\)\\(\\w\\|\\s.\\|\\s_\\)" - ;; Possible closing quote at beginning of string. - "\\`\\([\"']\\)\\(\\s-\\|\\s)\\|\\s.\\)" - ;; Possible apostrophe at beginning of string. - "\\`\\('\\)\\S-" - ;; Opening single and double quotes. - "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\(?:\\w\\|\\s.\\|\\s_\\)" - ;; Closing single and double quotes. - "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\(?:\\s-\\|\\s)\\|\\s.\\)" - ;; Apostrophe. - "\\S-\\('\\)\\S-" - ;; Possible opening quote at end of string. - "\\(?:\\s-\\|\\s(\\)\\([\"']\\)\\'" - ;; Possible closing quote at end of string. - "\\(?:\\w\\|\\s.\\|\\s_\\)\\([\"']\\)\\'" - ;; Possible apostrophe at end of string. - "\\S-\\('\\)\\'") - "List of regexps matching a quote or an apostrophe. -In every regexp, quote or apostrophe matched is put in group 1.") - -(defun org-export-activate-smart-quotes (s encoding info &optional original) - "Replace regular quotes with \"smart\" quotes in string S. - -ENCODING is a symbol among `:html', `:latex', `:texinfo' and -`:utf-8'. INFO is a plist used as a communication channel. - -The function has to retrieve information about string -surroundings in parse tree. It can only happen with an -unmodified string. Thus, if S has already been through another -process, a non-nil ORIGINAL optional argument will provide that -original string. - -Return the new string." - (if (equal s "") "" - (let* ((prev (org-export-get-previous-element (or original s) info)) - ;; Try to be flexible when computing number of blanks - ;; before object. The previous object may be a string - ;; introduced by the back-end and not completely parsed. - (pre-blank (and prev - (or (org-element-property :post-blank prev) - ;; A string with missing `:post-blank' - ;; property. - (and (stringp prev) - (string-match " *\\'" prev) - (length (match-string 0 prev))) - ;; Fallback value. - 0))) - (next (org-export-get-next-element (or original s) info)) - (get-smart-quote - (lambda (q type) - ;; Return smart quote associated to a give quote Q, as - ;; a string. TYPE is a symbol among `open', `close' and - ;; `apostrophe'. - (let ((key (case type - (apostrophe 'apostrophe) - (open (if (equal "'" q) 'opening-single-quote - 'opening-double-quote)) - (otherwise (if (equal "'" q) 'closing-single-quote - 'closing-double-quote))))) - (or (plist-get - (cdr (assq key - (cdr (assoc (plist-get info :language) - org-export-smart-quotes-alist)))) - encoding) - q))))) - (if (or (equal "\"" s) (equal "'" s)) - ;; Only a quote: no regexp can match. We have to check both - ;; sides and decide what to do. - (cond ((and (not prev) (not next)) s) - ((not prev) (funcall get-smart-quote s 'open)) - ((and (not next) (zerop pre-blank)) - (funcall get-smart-quote s 'close)) - ((not next) s) - ((zerop pre-blank) (funcall get-smart-quote s 'apostrophe)) - (t (funcall get-smart-quote 'open))) - ;; 1. Replace quote character at the beginning of S. - (cond - ;; Apostrophe? - ((and prev (zerop pre-blank) - (string-match (nth 2 org-export-smart-quotes-regexps) s)) - (setq s (replace-match - (funcall get-smart-quote (match-string 1 s) 'apostrophe) - nil t s 1))) - ;; Closing quote? - ((and prev (zerop pre-blank) - (string-match (nth 1 org-export-smart-quotes-regexps) s)) - (setq s (replace-match - (funcall get-smart-quote (match-string 1 s) 'close) - nil t s 1))) - ;; Opening quote? - ((and (or (not prev) (> pre-blank 0)) - (string-match (nth 0 org-export-smart-quotes-regexps) s)) - (setq s (replace-match - (funcall get-smart-quote (match-string 1 s) 'open) - nil t s 1)))) - ;; 2. Replace quotes in the middle of the string. - (setq s (replace-regexp-in-string - ;; Opening quotes. - (nth 3 org-export-smart-quotes-regexps) - (lambda (text) - (funcall get-smart-quote (match-string 1 text) 'open)) - s nil t 1)) - (setq s (replace-regexp-in-string - ;; Closing quotes. - (nth 4 org-export-smart-quotes-regexps) - (lambda (text) - (funcall get-smart-quote (match-string 1 text) 'close)) - s nil t 1)) - (setq s (replace-regexp-in-string - ;; Apostrophes. - (nth 5 org-export-smart-quotes-regexps) - (lambda (text) - (funcall get-smart-quote (match-string 1 text) 'apostrophe)) - s nil t 1)) - ;; 3. Replace quote character at the end of S. - (cond - ;; Apostrophe? - ((and next (string-match (nth 8 org-export-smart-quotes-regexps) s)) - (setq s (replace-match - (funcall get-smart-quote (match-string 1 s) 'apostrophe) - nil t s 1))) - ;; Closing quote? - ((and (not next) - (string-match (nth 7 org-export-smart-quotes-regexps) s)) - (setq s (replace-match - (funcall get-smart-quote (match-string 1 s) 'close) - nil t s 1))) - ;; Opening quote? - ((and next (string-match (nth 6 org-export-smart-quotes-regexps) s)) - (setq s (replace-match - (funcall get-smart-quote (match-string 1 s) 'open) - nil t s 1)))) - ;; Return string with smart quotes. - s)))) - -;;;; Topology -;; -;; Here are various functions to retrieve information about the -;; neighbourhood of a given element or object. Neighbours of interest -;; are direct parent (`org-export-get-parent'), parent headline -;; (`org-export-get-parent-headline'), first element containing an -;; object, (`org-export-get-parent-element'), parent table -;; (`org-export-get-parent-table'), previous element or object -;; (`org-export-get-previous-element') and next element or object -;; (`org-export-get-next-element'). -;; -;; `org-export-get-genealogy' returns the full genealogy of a given -;; element or object, from closest parent to full parse tree. - -(defsubst org-export-get-parent (blob) - "Return BLOB parent or nil. -BLOB is the element or object considered." - (org-element-property :parent blob)) - -(defun org-export-get-genealogy (blob) - "Return full genealogy relative to a given element or object. - -BLOB is the element or object being considered. - -Ancestors are returned from closest to farthest, the last one -being the full parse tree." - (let (genealogy (parent blob)) - (while (setq parent (org-element-property :parent parent)) - (push parent genealogy)) - (nreverse genealogy))) - -(defun org-export-get-parent-headline (blob) - "Return BLOB parent headline or nil. -BLOB is the element or object being considered." - (let ((parent blob)) - (while (and (setq parent (org-element-property :parent parent)) - (not (eq (org-element-type parent) 'headline)))) - parent)) - -(defun org-export-get-parent-element (object) - "Return first element containing OBJECT or nil. -OBJECT is the object to consider." - (let ((parent object)) - (while (and (setq parent (org-element-property :parent parent)) - (memq (org-element-type parent) org-element-all-objects))) - parent)) - -(defun org-export-get-parent-table (object) - "Return OBJECT parent table or nil. -OBJECT is either a `table-cell' or `table-element' type object." - (let ((parent object)) - (while (and (setq parent (org-element-property :parent parent)) - (not (eq (org-element-type parent) 'table)))) - parent)) - -(defun org-export-get-previous-element (blob info &optional n) - "Return previous element or object. - -BLOB is an element or object. INFO is a plist used as -a communication channel. Return previous exportable element or -object, a string, or nil. - -When optional argument N is a positive integer, return a list -containing up to N siblings before BLOB, from farthest to -closest. With any other non-nil value, return a list containing -all of them." - (let ((siblings - ;; An object can belong to the contents of its parent or - ;; to a secondary string. We check the latter option - ;; first. - (let ((parent (org-export-get-parent blob))) - (or (let ((sec-value (org-element-property - (cdr (assq (org-element-type parent) - org-element-secondary-value-alist)) - parent))) - (and (memq blob sec-value) sec-value)) - (org-element-contents parent)))) - prev) - (catch 'exit - (mapc (lambda (obj) - (cond ((memq obj (plist-get info :ignore-list))) - ((null n) (throw 'exit obj)) - ((not (wholenump n)) (push obj prev)) - ((zerop n) (throw 'exit prev)) - (t (decf n) (push obj prev)))) - (cdr (memq blob (reverse siblings)))) - prev))) - -(defun org-export-get-next-element (blob info &optional n) - "Return next element or object. - -BLOB is an element or object. INFO is a plist used as -a communication channel. Return next exportable element or -object, a string, or nil. - -When optional argument N is a positive integer, return a list -containing up to N siblings after BLOB, from closest to farthest. -With any other non-nil value, return a list containing all of -them." - (let ((siblings - ;; An object can belong to the contents of its parent or to - ;; a secondary string. We check the latter option first. - (let ((parent (org-export-get-parent blob))) - (or (let ((sec-value (org-element-property - (cdr (assq (org-element-type parent) - org-element-secondary-value-alist)) - parent))) - (cdr (memq blob sec-value))) - (cdr (memq blob (org-element-contents parent)))))) - next) - (catch 'exit - (mapc (lambda (obj) - (cond ((memq obj (plist-get info :ignore-list))) - ((null n) (throw 'exit obj)) - ((not (wholenump n)) (push obj next)) - ((zerop n) (throw 'exit (nreverse next))) - (t (decf n) (push obj next)))) - siblings) - (nreverse next)))) - - -;;;; Translation -;; -;; `org-export-translate' translates a string according to the language -;; specified by the LANGUAGE keyword. `org-export-dictionary' contains -;; the dictionary used for the translation. - -(defconst org-export-dictionary - '(("%e %n: %c" - ("fr" :default "%e %n : %c" :html "%e %n : %c")) - ("Author" - ("ca" :default "Autor") - ("cs" :default "Autor") - ("da" :default "Forfatter") - ("de" :default "Autor") - ("eo" :html "Aŭtoro") - ("es" :default "Autor") - ("fi" :html "Tekijä") - ("fr" :default "Auteur") - ("hu" :default "Szerzõ") - ("is" :html "Höfundur") - ("it" :default "Autore") - ("ja" :html "著者" :utf-8 "著者") - ("nl" :default "Auteur") - ("no" :default "Forfatter") - ("nb" :default "Forfatter") - ("nn" :default "Forfattar") - ("pl" :default "Autor") - ("ru" :html "Автор" :utf-8 "Автор") - ("sv" :html "Författare") - ("uk" :html "Автор" :utf-8 "Автор") - ("zh-CN" :html "作者" :utf-8 "作者") - ("zh-TW" :html "作者" :utf-8 "作者")) - ("Date" - ("ca" :default "Data") - ("cs" :default "Datum") - ("da" :default "Dato") - ("de" :default "Datum") - ("eo" :default "Dato") - ("es" :default "Fecha") - ("fi" :html "Päivämäärä") - ("hu" :html "Dátum") - ("is" :default "Dagsetning") - ("it" :default "Data") - ("ja" :html "日付" :utf-8 "日付") - ("nl" :default "Datum") - ("no" :default "Dato") - ("nb" :default "Dato") - ("nn" :default "Dato") - ("pl" :default "Data") - ("ru" :html "Дата" :utf-8 "Дата") - ("sv" :default "Datum") - ("uk" :html "Дата" :utf-8 "Дата") - ("zh-CN" :html "日期" :utf-8 "日期") - ("zh-TW" :html "日期" :utf-8 "日期")) - ("Equation" - ("da" :default "Ligning") - ("de" :default "Gleichung") - ("es" :html "Ecuación" :default "Ecuación") - ("fr" :ascii "Equation" :default "Équation") - ("no" :default "Ligning") - ("nb" :default "Ligning") - ("nn" :default "Likning") - ("sv" :default "Ekvation") - ("zh-CN" :html "方程" :utf-8 "方程")) - ("Figure" - ("da" :default "Figur") - ("de" :default "Abbildung") - ("es" :default "Figura") - ("ja" :html "図" :utf-8 "図") - ("no" :default "Illustrasjon") - ("nb" :default "Illustrasjon") - ("nn" :default "Illustrasjon") - ("sv" :default "Illustration") - ("zh-CN" :html "图" :utf-8 "图")) - ("Figure %d:" - ("da" :default "Figur %d") - ("de" :default "Abbildung %d:") - ("es" :default "Figura %d:") - ("fr" :default "Figure %d :" :html "Figure %d :") - ("ja" :html "図%d: " :utf-8 "図%d: ") - ("no" :default "Illustrasjon %d") - ("nb" :default "Illustrasjon %d") - ("nn" :default "Illustrasjon %d") - ("sv" :default "Illustration %d") - ("zh-CN" :html "图%d " :utf-8 "图%d ")) - ("Footnotes" - ("ca" :html "Peus de pàgina") - ("cs" :default "Pozn\xe1mky pod carou") - ("da" :default "Fodnoter") - ("de" :html "Fußnoten" :default "Fußnoten") - ("eo" :default "Piednotoj") - ("es" :html "Nota al pie de página" :default "Nota al pie de página") - ("fi" :default "Alaviitteet") - ("fr" :default "Notes de bas de page") - ("hu" :html "Lábjegyzet") - ("is" :html "Aftanmálsgreinar") - ("it" :html "Note a piè di pagina") - ("ja" :html "脚注" :utf-8 "脚注") - ("nl" :default "Voetnoten") - ("no" :default "Fotnoter") - ("nb" :default "Fotnoter") - ("nn" :default "Fotnotar") - ("pl" :default "Przypis") - ("ru" :html "Сноски" :utf-8 "Сноски") - ("sv" :default "Fotnoter") - ("uk" :html "Примітки" - :utf-8 "Примітки") - ("zh-CN" :html "脚注" :utf-8 "脚注") - ("zh-TW" :html "腳註" :utf-8 "腳註")) - ("List of Listings" - ("da" :default "Programmer") - ("de" :default "Programmauflistungsverzeichnis") - ("es" :default "Indice de Listados de programas") - ("fr" :default "Liste des programmes") - ("no" :default "Dataprogrammer") - ("nb" :default "Dataprogrammer") - ("zh-CN" :html "代码目录" :utf-8 "代码目录")) - ("List of Tables" - ("da" :default "Tabeller") - ("de" :default "Tabellenverzeichnis") - ("es" :default "Indice de tablas") - ("fr" :default "Liste des tableaux") - ("no" :default "Tabeller") - ("nb" :default "Tabeller") - ("nn" :default "Tabeller") - ("sv" :default "Tabeller") - ("zh-CN" :html "表格目录" :utf-8 "表格目录")) - ("Listing %d:" - ("da" :default "Program %d") - ("de" :default "Programmlisting %d") - ("es" :default "Listado de programa %d") - ("fr" :default "Programme %d :" :html "Programme %d :") - ("no" :default "Dataprogram") - ("nb" :default "Dataprogram") - ("zh-CN" :html "代码%d " :utf-8 "代码%d ")) - ("See section %s" - ("da" :default "jævnfør afsnit %s") - ("de" :default "siehe Abschnitt %s") - ("es" :default "vea seccion %s") - ("fr" :default "cf. section %s") - ("zh-CN" :html "参见第%d节" :utf-8 "参见第%s节")) - ("Table" - ("de" :default "Tabelle") - ("es" :default "Tabla") - ("fr" :default "Tableau") - ("ja" :html "表" :utf-8 "表") - ("zh-CN" :html "表" :utf-8 "表")) - ("Table %d:" - ("da" :default "Tabel %d") - ("de" :default "Tabelle %d") - ("es" :default "Tabla %d") - ("fr" :default "Tableau %d :") - ("ja" :html "表%d:" :utf-8 "表%d:") - ("no" :default "Tabell %d") - ("nb" :default "Tabell %d") - ("nn" :default "Tabell %d") - ("sv" :default "Tabell %d") - ("zh-CN" :html "表%d " :utf-8 "表%d ")) - ("Table of Contents" - ("ca" :html "Índex") - ("cs" :default "Obsah") - ("da" :default "Indhold") - ("de" :default "Inhaltsverzeichnis") - ("eo" :default "Enhavo") - ("es" :html "Índice") - ("fi" :html "Sisällysluettelo") - ("fr" :ascii "Sommaire" :default "Table des matières") - ("hu" :html "Tartalomjegyzék") - ("is" :default "Efnisyfirlit") - ("it" :default "Indice") - ("ja" :html "目次" :utf-8 "目次") - ("nl" :default "Inhoudsopgave") - ("no" :default "Innhold") - ("nb" :default "Innhold") - ("nn" :default "Innhald") - ("pl" :html "Spis treści") - ("ru" :html "Содержание" - :utf-8 "Содержание") - ("sv" :html "Innehåll") - ("uk" :html "Зміст" :utf-8 "Зміст") - ("zh-CN" :html "目录" :utf-8 "目录") - ("zh-TW" :html "目錄" :utf-8 "目錄")) - ("Unknown reference" - ("da" :default "ukendt reference") - ("de" :default "Unbekannter Verweis") - ("es" :default "referencia desconocida") - ("fr" :ascii "Destination inconnue" :default "Référence inconnue") - ("zh-CN" :html "未知引用" :utf-8 "未知引用"))) - "Dictionary for export engine. - -Alist whose CAR is the string to translate and CDR is an alist -whose CAR is the language string and CDR is a plist whose -properties are possible charsets and values translated terms. - -It is used as a database for `org-export-translate'. Since this -function returns the string as-is if no translation was found, -the variable only needs to record values different from the -entry.") - -(defun org-export-translate (s encoding info) - "Translate string S according to language specification. - -ENCODING is a symbol among `:ascii', `:html', `:latex', `:latin1' -and `:utf-8'. INFO is a plist used as a communication channel. - -Translation depends on `:language' property. Return the -translated string. If no translation is found, try to fall back -to `:default' encoding. If it fails, return S." - (let* ((lang (plist-get info :language)) - (translations (cdr (assoc lang - (cdr (assoc s org-export-dictionary)))))) - (or (plist-get translations encoding) - (plist-get translations :default) - s))) - - - -;;; Asynchronous Export -;; -;; `org-export-async-start' is the entry point for asynchronous -;; export. It recreates current buffer (including visibility, -;; narrowing and visited file) in an external Emacs process, and -;; evaluates a command there. It then applies a function on the -;; returned results in the current process. -;; -;; At a higher level, `org-export-to-buffer' and `org-export-to-file' -;; allow to export to a buffer or a file, asynchronously or not. -;; -;; `org-export-output-file-name' is an auxiliary function meant to be -;; used with `org-export-to-file'. With a given extension, it tries -;; to provide a canonical file name to write export output to. -;; -;; Asynchronously generated results are never displayed directly. -;; Instead, they are stored in `org-export-stack-contents'. They can -;; then be retrieved by calling `org-export-stack'. -;; -;; Export Stack is viewed through a dedicated major mode -;;`org-export-stack-mode' and tools: `org-export-stack-refresh', -;;`org-export-stack-delete', `org-export-stack-view' and -;;`org-export-stack-clear'. -;; -;; For back-ends, `org-export-add-to-stack' add a new source to stack. -;; It should be used whenever `org-export-async-start' is called. - -(defmacro org-export-async-start (fun &rest body) - "Call function FUN on the results returned by BODY evaluation. - -BODY evaluation happens in an asynchronous process, from a buffer -which is an exact copy of the current one. - -Use `org-export-add-to-stack' in FUN in order to register results -in the stack. - -This is a low level function. See also `org-export-to-buffer' -and `org-export-to-file' for more specialized functions." - (declare (indent 1) (debug t)) - (org-with-gensyms (process temp-file copy-fun proc-buffer coding) - ;; Write the full sexp evaluating BODY in a copy of the current - ;; buffer to a temporary file, as it may be too long for program - ;; args in `start-process'. - `(with-temp-message "Initializing asynchronous export process" - (let ((,copy-fun (org-export--generate-copy-script (current-buffer))) - (,temp-file (make-temp-file "org-export-process")) - (,coding buffer-file-coding-system)) - (with-temp-file ,temp-file - (insert - ;; Null characters (from variable values) are inserted - ;; within the file. As a consequence, coding system for - ;; buffer contents will not be recognized properly. So, - ;; we make sure it is the same as the one used to display - ;; the original buffer. - (format ";; -*- coding: %s; -*-\n%S" - ,coding - `(with-temp-buffer - (when org-export-async-debug '(setq debug-on-error t)) - ;; Ignore `kill-emacs-hook' and code evaluation - ;; queries from Babel as we need a truly - ;; non-interactive process. - (setq kill-emacs-hook nil - org-babel-confirm-evaluate-answer-no t) - ;; Initialize export framework. - (require 'ox) - ;; Re-create current buffer there. - (funcall ,,copy-fun) - (restore-buffer-modified-p nil) - ;; Sexp to evaluate in the buffer. - (print (progn ,,@body)))))) - ;; Start external process. - (let* ((process-connection-type nil) - (,proc-buffer (generate-new-buffer-name "*Org Export Process*")) - (,process - (start-process - "org-export-process" ,proc-buffer - (expand-file-name invocation-name invocation-directory) - "-Q" "--batch" - "-l" org-export-async-init-file - "-l" ,temp-file))) - ;; Register running process in stack. - (org-export-add-to-stack (get-buffer ,proc-buffer) nil ,process) - ;; Set-up sentinel in order to catch results. - (let ((handler ,fun)) - (set-process-sentinel - ,process - `(lambda (p status) - (let ((proc-buffer (process-buffer p))) - (when (eq (process-status p) 'exit) - (unwind-protect - (if (zerop (process-exit-status p)) - (unwind-protect - (let ((results - (with-current-buffer proc-buffer - (goto-char (point-max)) - (backward-sexp) - (read (current-buffer))))) - (funcall ,handler results)) - (unless org-export-async-debug - (and (get-buffer proc-buffer) - (kill-buffer proc-buffer)))) - (org-export-add-to-stack proc-buffer nil p) - (ding) - (message "Process '%s' exited abnormally" p)) - (unless org-export-async-debug - (delete-file ,,temp-file))))))))))))) - -;;;###autoload -(defun org-export-to-buffer - (backend buffer - &optional async subtreep visible-only body-only ext-plist - post-process) - "Call `org-export-as' with output to a specified buffer. - -BACKEND is either an export back-end, as returned by, e.g., -`org-export-create-backend', or a symbol referring to -a registered back-end. - -BUFFER is the name of the output buffer. If it already exists, -it will be erased first, otherwise, it will be created. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer should then be accessible -through the `org-export-stack' interface. When ASYNC is nil, the -buffer is displayed if `org-export-show-temporary-export-buffer' -is non-nil. - -Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and -EXT-PLIST are similar to those used in `org-export-as', which -see. - -Optional argument POST-PROCESS is a function which should accept -no argument. It is always called within the current process, -from BUFFER, with point at its beginning. Export back-ends can -use it to set a major mode there, e.g, - - \(defun org-latex-export-as-latex - \(&optional async subtreep visible-only body-only ext-plist) - \(interactive) - \(org-export-to-buffer 'latex \"*Org LATEX Export*\" - async subtreep visible-only body-only ext-plist (lambda () (LaTeX-mode)))) - -This function returns BUFFER." - (declare (indent 2)) - (if async - (org-export-async-start - `(lambda (output) - (with-current-buffer (get-buffer-create ,buffer) - (erase-buffer) - (setq buffer-file-coding-system ',buffer-file-coding-system) - (insert output) - (goto-char (point-min)) - (org-export-add-to-stack (current-buffer) ',backend) - (ignore-errors (funcall ,post-process)))) - `(org-export-as - ',backend ,subtreep ,visible-only ,body-only ',ext-plist)) - (let ((output - (org-export-as backend subtreep visible-only body-only ext-plist)) - (buffer (get-buffer-create buffer)) - (encoding buffer-file-coding-system)) - (when (and (org-string-nw-p output) (org-export--copy-to-kill-ring-p)) - (org-kill-new output)) - (with-current-buffer buffer - (erase-buffer) - (setq buffer-file-coding-system encoding) - (insert output) - (goto-char (point-min)) - (and (functionp post-process) (funcall post-process))) - (when org-export-show-temporary-export-buffer - (switch-to-buffer-other-window buffer)) - buffer))) - -;;;###autoload -(defun org-export-to-file - (backend file &optional async subtreep visible-only body-only ext-plist - post-process) - "Call `org-export-as' with output to a specified file. - -BACKEND is either an export back-end, as returned by, e.g., -`org-export-create-backend', or a symbol referring to -a registered back-end. FILE is the name of the output file, as -a string. - -A non-nil optional argument ASYNC means the process should happen -asynchronously. The resulting buffer file then be accessible -through the `org-export-stack' interface. - -Optional arguments SUBTREEP, VISIBLE-ONLY, BODY-ONLY and -EXT-PLIST are similar to those used in `org-export-as', which -see. - -Optional argument POST-PROCESS is called with FILE as its -argument and happens asynchronously when ASYNC is non-nil. It -has to return a file name, or nil. Export back-ends can use this -to send the output file through additional processing, e.g, - - \(defun org-latex-export-to-latex - \(&optional async subtreep visible-only body-only ext-plist) - \(interactive) - \(let ((outfile (org-export-output-file-name \".tex\" subtreep))) - \(org-export-to-file 'latex outfile - async subtreep visible-only body-only ext-plist - \(lambda (file) (org-latex-compile file))) - -The function returns either a file name returned by POST-PROCESS, -or FILE." - (declare (indent 2)) - (if (not (file-writable-p file)) (error "Output file not writable") - (let ((encoding (or org-export-coding-system buffer-file-coding-system))) - (if async - (org-export-async-start - `(lambda (file) - (org-export-add-to-stack (expand-file-name file) ',backend)) - `(let ((output - (org-export-as - ',backend ,subtreep ,visible-only ,body-only - ',ext-plist))) - (with-temp-buffer - (insert output) - (let ((coding-system-for-write ',encoding)) - (write-file ,file))) - (or (ignore-errors (funcall ',post-process ,file)) ,file))) - (let ((output (org-export-as - backend subtreep visible-only body-only ext-plist))) - (with-temp-buffer - (insert output) - (let ((coding-system-for-write encoding)) - (write-file file))) - (when (and (org-export--copy-to-kill-ring-p) (org-string-nw-p output)) - (org-kill-new output)) - ;; Get proper return value. - (or (and (functionp post-process) (funcall post-process file)) - file)))))) - -(defun org-export-output-file-name (extension &optional subtreep pub-dir) - "Return output file's name according to buffer specifications. - -EXTENSION is a string representing the output file extension, -with the leading dot. - -With a non-nil optional argument SUBTREEP, try to determine -output file's name by looking for \"EXPORT_FILE_NAME\" property -of subtree at point. - -When optional argument PUB-DIR is set, use it as the publishing -directory. - -When optional argument VISIBLE-ONLY is non-nil, don't export -contents of hidden elements. - -Return file name as a string." - (let* ((visited-file (buffer-file-name (buffer-base-buffer))) - (base-name - ;; File name may come from EXPORT_FILE_NAME subtree - ;; property, assuming point is at beginning of said - ;; sub-tree. - (file-name-sans-extension - (or (and subtreep - (org-entry-get - (save-excursion - (ignore-errors (org-back-to-heading) (point))) - "EXPORT_FILE_NAME" t)) - ;; File name may be extracted from buffer's associated - ;; file, if any. - (and visited-file (file-name-nondirectory visited-file)) - ;; Can't determine file name on our own: Ask user. - (let ((read-file-name-function - (and org-completion-use-ido 'ido-read-file-name))) - (read-file-name - "Output file: " pub-dir nil nil nil - (lambda (name) - (string= (file-name-extension name t) extension))))))) - (output-file - ;; Build file name. Enforce EXTENSION over whatever user - ;; may have come up with. PUB-DIR, if defined, always has - ;; precedence over any provided path. - (cond - (pub-dir - (concat (file-name-as-directory pub-dir) - (file-name-nondirectory base-name) - extension)) - ((file-name-absolute-p base-name) (concat base-name extension)) - (t (concat (file-name-as-directory ".") base-name extension))))) - ;; If writing to OUTPUT-FILE would overwrite original file, append - ;; EXTENSION another time to final name. - (if (and visited-file (org-file-equal-p visited-file output-file)) - (concat output-file extension) - output-file))) - -(defun org-export-add-to-stack (source backend &optional process) - "Add a new result to export stack if not present already. - -SOURCE is a buffer or a file name containing export results. -BACKEND is a symbol representing export back-end used to generate -it. - -Entries already pointing to SOURCE and unavailable entries are -removed beforehand. Return the new stack." - (setq org-export-stack-contents - (cons (list source backend (or process (current-time))) - (org-export-stack-remove source)))) - -(defun org-export-stack () - "Menu for asynchronous export results and running processes." - (interactive) - (let ((buffer (get-buffer-create "*Org Export Stack*"))) - (set-buffer buffer) - (when (zerop (buffer-size)) (org-export-stack-mode)) - (org-export-stack-refresh) - (pop-to-buffer buffer)) - (message "Type \"q\" to quit, \"?\" for help")) - -(defun org-export--stack-source-at-point () - "Return source from export results at point in stack." - (let ((source (car (nth (1- (org-current-line)) org-export-stack-contents)))) - (if (not source) (error "Source unavailable, please refresh buffer") - (let ((source-name (if (stringp source) source (buffer-name source)))) - (if (save-excursion - (beginning-of-line) - (looking-at (concat ".* +" (regexp-quote source-name) "$"))) - source - ;; SOURCE is not consistent with current line. The stack - ;; view is outdated. - (error "Source unavailable; type `g' to update buffer")))))) - -(defun org-export-stack-clear () - "Remove all entries from export stack." - (interactive) - (setq org-export-stack-contents nil)) - -(defun org-export-stack-refresh (&rest dummy) - "Refresh the asynchronous export stack. -DUMMY is ignored. Unavailable sources are removed from the list. -Return the new stack." - (let ((inhibit-read-only t)) - (org-preserve-lc - (erase-buffer) - (insert (concat - (let ((counter 0)) - (mapconcat - (lambda (entry) - (let ((proc-p (processp (nth 2 entry)))) - (concat - ;; Back-end. - (format " %-12s " (or (nth 1 entry) "")) - ;; Age. - (let ((data (nth 2 entry))) - (if proc-p (format " %6s " (process-status data)) - ;; Compute age of the results. - (org-format-seconds - "%4h:%.2m " - (float-time (time-since data))))) - ;; Source. - (format " %s" - (let ((source (car entry))) - (if (stringp source) source - (buffer-name source))))))) - ;; Clear stack from exited processes, dead buffers or - ;; non-existent files. - (setq org-export-stack-contents - (org-remove-if-not - (lambda (el) - (if (processp (nth 2 el)) - (buffer-live-p (process-buffer (nth 2 el))) - (let ((source (car el))) - (if (bufferp source) (buffer-live-p source) - (file-exists-p source))))) - org-export-stack-contents)) "\n"))))))) - -(defun org-export-stack-remove (&optional source) - "Remove export results at point from stack. -If optional argument SOURCE is non-nil, remove it instead." - (interactive) - (let ((source (or source (org-export--stack-source-at-point)))) - (setq org-export-stack-contents - (org-remove-if (lambda (el) (equal (car el) source)) - org-export-stack-contents)))) - -(defun org-export-stack-view (&optional in-emacs) - "View export results at point in stack. -With an optional prefix argument IN-EMACS, force viewing files -within Emacs." - (interactive "P") - (let ((source (org-export--stack-source-at-point))) - (cond ((processp source) - (org-switch-to-buffer-other-window (process-buffer source))) - ((bufferp source) (org-switch-to-buffer-other-window source)) - (t (org-open-file source in-emacs))))) - -(defvar org-export-stack-mode-map - (let ((km (make-sparse-keymap))) - (define-key km " " 'next-line) - (define-key km "n" 'next-line) - (define-key km "\C-n" 'next-line) - (define-key km [down] 'next-line) - (define-key km "p" 'previous-line) - (define-key km "\C-p" 'previous-line) - (define-key km "\C-?" 'previous-line) - (define-key km [up] 'previous-line) - (define-key km "C" 'org-export-stack-clear) - (define-key km "v" 'org-export-stack-view) - (define-key km (kbd "RET") 'org-export-stack-view) - (define-key km "d" 'org-export-stack-remove) - km) - "Keymap for Org Export Stack.") - -(define-derived-mode org-export-stack-mode special-mode "Org-Stack" - "Mode for displaying asynchronous export stack. - -Type \\[org-export-stack] to visualize the asynchronous export -stack. - -In an Org Export Stack buffer, use \\\\[org-export-stack-view] to view export output -on current line, \\[org-export-stack-remove] to remove it from the stack and \\[org-export-stack-clear] to clear -stack completely. - -Removing entries in an Org Export Stack buffer doesn't affect -files or buffers, only the display. - -\\{org-export-stack-mode-map}" - (abbrev-mode 0) - (auto-fill-mode 0) - (setq buffer-read-only t - buffer-undo-list t - truncate-lines t - header-line-format - '(:eval - (format " %-12s | %6s | %s" "Back-End" "Age" "Source"))) - (org-add-hook 'post-command-hook 'org-export-stack-refresh nil t) - (set (make-local-variable 'revert-buffer-function) - 'org-export-stack-refresh)) - - - -;;; The Dispatcher -;; -;; `org-export-dispatch' is the standard interactive way to start an -;; export process. It uses `org-export--dispatch-ui' as a subroutine -;; for its interface, which, in turn, delegates response to key -;; pressed to `org-export--dispatch-action'. - -;;;###autoload -(defun org-export-dispatch (&optional arg) - "Export dispatcher for Org mode. - -It provides an access to common export related tasks in a buffer. -Its interface comes in two flavours: standard and expert. - -While both share the same set of bindings, only the former -displays the valid keys associations in a dedicated buffer. -Scrolling (resp. line-wise motion) in this buffer is done with -SPC and DEL (resp. C-n and C-p) keys. - -Set variable `org-export-dispatch-use-expert-ui' to switch to one -flavour or the other. - -When ARG is \\[universal-argument], repeat the last export action, with the same set -of options used back then, on the current buffer. - -When ARG is \\[universal-argument] \\[universal-argument], display the asynchronous export stack." - (interactive "P") - (let* ((input - (cond ((equal arg '(16)) '(stack)) - ((and arg org-export-dispatch-last-action)) - (t (save-window-excursion - (unwind-protect - (progn - ;; Remember where we are - (move-marker org-export-dispatch-last-position - (point) - (org-base-buffer (current-buffer))) - ;; Get and store an export command - (setq org-export-dispatch-last-action - (org-export--dispatch-ui - (list org-export-initial-scope - (and org-export-in-background 'async)) - nil - org-export-dispatch-use-expert-ui))) - (and (get-buffer "*Org Export Dispatcher*") - (kill-buffer "*Org Export Dispatcher*"))))))) - (action (car input)) - (optns (cdr input))) - (unless (memq 'subtree optns) - (move-marker org-export-dispatch-last-position nil)) - (case action - ;; First handle special hard-coded actions. - (template (org-export-insert-default-template nil optns)) - (stack (org-export-stack)) - (publish-current-file - (org-publish-current-file (memq 'force optns) (memq 'async optns))) - (publish-current-project - (org-publish-current-project (memq 'force optns) (memq 'async optns))) - (publish-choose-project - (org-publish (assoc (org-icompleting-read - "Publish project: " - org-publish-project-alist nil t) - org-publish-project-alist) - (memq 'force optns) - (memq 'async optns))) - (publish-all (org-publish-all (memq 'force optns) (memq 'async optns))) - (otherwise - (save-excursion - (when arg - ;; Repeating command, maybe move cursor to restore subtree - ;; context. - (if (eq (marker-buffer org-export-dispatch-last-position) - (org-base-buffer (current-buffer))) - (goto-char org-export-dispatch-last-position) - ;; We are in a different buffer, forget position. - (move-marker org-export-dispatch-last-position nil))) - (funcall action - ;; Return a symbol instead of a list to ease - ;; asynchronous export macro use. - (and (memq 'async optns) t) - (and (memq 'subtree optns) t) - (and (memq 'visible optns) t) - (and (memq 'body optns) t))))))) - -(defun org-export--dispatch-ui (options first-key expertp) - "Handle interface for `org-export-dispatch'. - -OPTIONS is a list containing current interactive options set for -export. It can contain any of the following symbols: -`body' toggles a body-only export -`subtree' restricts export to current subtree -`visible' restricts export to visible part of buffer. -`force' force publishing files. -`async' use asynchronous export process - -FIRST-KEY is the key pressed to select the first level menu. It -is nil when this menu hasn't been selected yet. - -EXPERTP, when non-nil, triggers expert UI. In that case, no help -buffer is provided, but indications about currently active -options are given in the prompt. Moreover, \[?] allows to switch -back to standard interface." - (let* ((fontify-key - (lambda (key &optional access-key) - ;; Fontify KEY string. Optional argument ACCESS-KEY, when - ;; non-nil is the required first-level key to activate - ;; KEY. When its value is t, activate KEY independently - ;; on the first key, if any. A nil value means KEY will - ;; only be activated at first level. - (if (or (eq access-key t) (eq access-key first-key)) - (org-propertize key 'face 'org-warning) - key))) - (fontify-value - (lambda (value) - ;; Fontify VALUE string. - (org-propertize value 'face 'font-lock-variable-name-face))) - ;; Prepare menu entries by extracting them from registered - ;; back-ends and sorting them by access key and by ordinal, - ;; if any. - (entries - (sort (sort (delq nil - (mapcar 'org-export-backend-menu - org-export--registered-backends)) - (lambda (a b) - (let ((key-a (nth 1 a)) - (key-b (nth 1 b))) - (cond ((and (numberp key-a) (numberp key-b)) - (< key-a key-b)) - ((numberp key-b) t))))) - 'car-less-than-car)) - ;; Compute a list of allowed keys based on the first key - ;; pressed, if any. Some keys - ;; (?^B, ?^V, ?^S, ?^F, ?^A, ?&, ?# and ?q) are always - ;; available. - (allowed-keys - (nconc (list 2 22 19 6 1) - (if (not first-key) (org-uniquify (mapcar 'car entries)) - (let (sub-menu) - (dolist (entry entries (sort (mapcar 'car sub-menu) '<)) - (when (eq (car entry) first-key) - (setq sub-menu (append (nth 2 entry) sub-menu)))))) - (cond ((eq first-key ?P) (list ?f ?p ?x ?a)) - ((not first-key) (list ?P))) - (list ?& ?#) - (when expertp (list ??)) - (list ?q))) - ;; Build the help menu for standard UI. - (help - (unless expertp - (concat - ;; Options are hard-coded. - (format "[%s] Body only: %s [%s] Visible only: %s -\[%s] Export scope: %s [%s] Force publishing: %s -\[%s] Async export: %s\n\n" - (funcall fontify-key "C-b" t) - (funcall fontify-value - (if (memq 'body options) "On " "Off")) - (funcall fontify-key "C-v" t) - (funcall fontify-value - (if (memq 'visible options) "On " "Off")) - (funcall fontify-key "C-s" t) - (funcall fontify-value - (if (memq 'subtree options) "Subtree" "Buffer ")) - (funcall fontify-key "C-f" t) - (funcall fontify-value - (if (memq 'force options) "On " "Off")) - (funcall fontify-key "C-a" t) - (funcall fontify-value - (if (memq 'async options) "On " "Off"))) - ;; Display registered back-end entries. When a key - ;; appears for the second time, do not create another - ;; entry, but append its sub-menu to existing menu. - (let (last-key) - (mapconcat - (lambda (entry) - (let ((top-key (car entry))) - (concat - (unless (eq top-key last-key) - (setq last-key top-key) - (format "\n[%s] %s\n" - (funcall fontify-key (char-to-string top-key)) - (nth 1 entry))) - (let ((sub-menu (nth 2 entry))) - (unless (functionp sub-menu) - ;; Split sub-menu into two columns. - (let ((index -1)) - (concat - (mapconcat - (lambda (sub-entry) - (incf index) - (format - (if (zerop (mod index 2)) " [%s] %-26s" - "[%s] %s\n") - (funcall fontify-key - (char-to-string (car sub-entry)) - top-key) - (nth 1 sub-entry))) - sub-menu "") - (when (zerop (mod index 2)) "\n")))))))) - entries "")) - ;; Publishing menu is hard-coded. - (format "\n[%s] Publish - [%s] Current file [%s] Current project - [%s] Choose project [%s] All projects\n\n\n" - (funcall fontify-key "P") - (funcall fontify-key "f" ?P) - (funcall fontify-key "p" ?P) - (funcall fontify-key "x" ?P) - (funcall fontify-key "a" ?P)) - (format "[%s] Export stack [%s] Insert template\n" - (funcall fontify-key "&" t) - (funcall fontify-key "#" t)) - (format "[%s] %s" - (funcall fontify-key "q" t) - (if first-key "Main menu" "Exit"))))) - ;; Build prompts for both standard and expert UI. - (standard-prompt (unless expertp "Export command: ")) - (expert-prompt - (when expertp - (format - "Export command (C-%s%s%s%s%s) [%s]: " - (if (memq 'body options) (funcall fontify-key "b" t) "b") - (if (memq 'visible options) (funcall fontify-key "v" t) "v") - (if (memq 'subtree options) (funcall fontify-key "s" t) "s") - (if (memq 'force options) (funcall fontify-key "f" t) "f") - (if (memq 'async options) (funcall fontify-key "a" t) "a") - (mapconcat (lambda (k) - ;; Strip control characters. - (unless (< k 27) (char-to-string k))) - allowed-keys ""))))) - ;; With expert UI, just read key with a fancy prompt. In standard - ;; UI, display an intrusive help buffer. - (if expertp - (org-export--dispatch-action - expert-prompt allowed-keys entries options first-key expertp) - ;; At first call, create frame layout in order to display menu. - (unless (get-buffer "*Org Export Dispatcher*") - (delete-other-windows) - (org-switch-to-buffer-other-window - (get-buffer-create "*Org Export Dispatcher*")) - (setq cursor-type nil - header-line-format "Use SPC, DEL, C-n or C-p to navigate.") - ;; Make sure that invisible cursor will not highlight square - ;; brackets. - (set-syntax-table (copy-syntax-table)) - (modify-syntax-entry ?\[ "w")) - ;; At this point, the buffer containing the menu exists and is - ;; visible in the current window. So, refresh it. - (with-current-buffer "*Org Export Dispatcher*" - ;; Refresh help. Maintain display continuity by re-visiting - ;; previous window position. - (let ((pos (window-start))) - (erase-buffer) - (insert help) - (set-window-start nil pos))) - (org-fit-window-to-buffer) - (org-export--dispatch-action - standard-prompt allowed-keys entries options first-key expertp)))) - -(defun org-export--dispatch-action - (prompt allowed-keys entries options first-key expertp) - "Read a character from command input and act accordingly. - -PROMPT is the displayed prompt, as a string. ALLOWED-KEYS is -a list of characters available at a given step in the process. -ENTRIES is a list of menu entries. OPTIONS, FIRST-KEY and -EXPERTP are the same as defined in `org-export--dispatch-ui', -which see. - -Toggle export options when required. Otherwise, return value is -a list with action as CAR and a list of interactive export -options as CDR." - (let (key) - ;; Scrolling: when in non-expert mode, act on motion keys (C-n, - ;; C-p, SPC, DEL). - (while (and (setq key (read-char-exclusive prompt)) - (not expertp) - (memq key '(14 16 ?\s ?\d))) - (case key - (14 (if (not (pos-visible-in-window-p (point-max))) - (ignore-errors (scroll-up 1)) - (message "End of buffer") - (sit-for 1))) - (16 (if (not (pos-visible-in-window-p (point-min))) - (ignore-errors (scroll-down 1)) - (message "Beginning of buffer") - (sit-for 1))) - (?\s (if (not (pos-visible-in-window-p (point-max))) - (scroll-up nil) - (message "End of buffer") - (sit-for 1))) - (?\d (if (not (pos-visible-in-window-p (point-min))) - (scroll-down nil) - (message "Beginning of buffer") - (sit-for 1))))) - (cond - ;; Ignore undefined associations. - ((not (memq key allowed-keys)) - (ding) - (unless expertp (message "Invalid key") (sit-for 1)) - (org-export--dispatch-ui options first-key expertp)) - ;; q key at first level aborts export. At second level, cancel - ;; first key instead. - ((eq key ?q) (if (not first-key) (error "Export aborted") - (org-export--dispatch-ui options nil expertp))) - ;; Help key: Switch back to standard interface if expert UI was - ;; active. - ((eq key ??) (org-export--dispatch-ui options first-key nil)) - ;; Send request for template insertion along with export scope. - ((eq key ?#) (cons 'template (memq 'subtree options))) - ;; Switch to asynchronous export stack. - ((eq key ?&) '(stack)) - ;; Toggle options: C-b (2) C-v (22) C-s (19) C-f (6) C-a (1). - ((memq key '(2 22 19 6 1)) - (org-export--dispatch-ui - (let ((option (case key (2 'body) (22 'visible) (19 'subtree) - (6 'force) (1 'async)))) - (if (memq option options) (remq option options) - (cons option options))) - first-key expertp)) - ;; Action selected: Send key and options back to - ;; `org-export-dispatch'. - ((or first-key (functionp (nth 2 (assq key entries)))) - (cons (cond - ((not first-key) (nth 2 (assq key entries))) - ;; Publishing actions are hard-coded. Send a special - ;; signal to `org-export-dispatch'. - ((eq first-key ?P) - (case key - (?f 'publish-current-file) - (?p 'publish-current-project) - (?x 'publish-choose-project) - (?a 'publish-all))) - ;; Return first action associated to FIRST-KEY + KEY - ;; path. Indeed, derived backends can share the same - ;; FIRST-KEY. - (t (catch 'found - (mapc (lambda (entry) - (let ((match (assq key (nth 2 entry)))) - (when match (throw 'found (nth 2 match))))) - (member (assq first-key entries) entries))))) - options)) - ;; Otherwise, enter sub-menu. - (t (org-export--dispatch-ui options key expertp))))) - - - -(provide 'ox) - -;; Local variables: -;; generated-autoload-file: "org-loaddefs.el" -;; End: - -;;; ox.el ends here